code/reader1.ml

   1 module E = struct
   2   type bound = int
   3   type env = char -> bound
   4 end
   5 module R_E = Monad.Reader(E)
   6 module R = R_E.M
   7
   8
   9 let env0 = fun var -> raise Not_found
  10 let insert var value e = fun sought -> if sought = var then value else e sought
  11
  12 let getint (var : char) : int R.t = R.asks (fun e -> let x = e var in x)
  13
  14 (* monadic versions of `x` and `y` *)
  15 let getx = getint 'x'
  16 let gety = getint 'y'
  17
  18 (* monadic version of `y + x` *)
  19 let (expr1 : int R.t) = R.(gety >>= fun y -> getx >>= fun x -> mid (y + x))
  20 (* or *)
  21 let (expr1 : int R.t) = R.(map2 (+) gety getx)
  22
  23 (* monadic version of `3 + x` *)
  24 let (expr2 : int R.t) = R.(map2 (+) (mid 3) getx)
  25
  26 let letx xx body = R.(xx >>= fun x -> shift (insert 'x' x) body)
  27
  28 (* monadic version of `let x = 2 in 3 + x` *)
  29 let (expr3 : int R.t) = R.(letx (mid 2) expr2)
  30
  31 let res = R.run expr3 env0 (* will be 5 *)
  32