code/reader2.ml

   1 module rec E : sig
   2   type bound = Int of int | Fun of (int R.t -> int R.t)
   3   type env = char -> bound
   4 end = E
   5 and R : Monad.READER with type env = E.env = struct
   6   type env = E.env
   7   module R_E = Monad.Reader(E)
   8   include = R_E.M
   9 end
  10
  11
  12 let env0 = fun var -> raise Not_found
  13 let insert var value e = fun sought -> if sought = var then value else e sought
  14
  15 let getint (var : char) = R.asks (fun e -> let (E.Int x) = e var in x)
  16
  17 let getfun (var : char) = R.asks (fun e -> let (E.Fun f) = e var in f)
  18
  19 (* monadic versions of `x` and `y` and `f` *)
  20 let getx = getint 'x'
  21 let gety = getint 'y'
  22 let getf = getfun 'f'
  23
  24 (* monadic version of `y + x` *)
  25 let (expr1 : int R.t) = R.(map2 (+) gety getx)
  26
  27 (* monadic version of `\y -> y + x` *)
  28 let lambda1 = R.(fun yy -> yy >>= fun y -> shift (insert 'y' (E.Int y)) expr1)
  29
  30 let letx xx body = R.(xx >>= fun x -> shift (insert 'x' (E.Int x)) body)
  31 let letf ff body = R.(ff >>= fun f -> shift (insert 'f' (E.Fun f)) body)
  32
  33 (* monadic version of `let x = 2 in let f = \y -> y + x in f 3` *)
  34 let (expr4 : int R.t) = R.(letx (mid 2) (letf (mid lambda1) (getf >>= fun f -> f (mid 3))))
  35
  36 let res = R.run expr4 env0 (* will be 5 *)
  37