add/update monad code
[lambda.git] / code / reader2.ml
diff --git a/code/reader2.ml b/code/reader2.ml
new file mode 100644 (file)
index 0000000..10d61e3
--- /dev/null
@@ -0,0 +1,37 @@
+module rec E : sig
+  type bound = Int of int | Fun of (int R.t -> int R.t)
+  type env = char -> bound
+end = E
+and R : Monad.READER with type env = E.env = struct
+  type env = E.env
+  module Made = Monad.Reader(E)
+  include Made.M
+end
+
+
+let env0 = fun var -> raise Not_found
+let insert var value e = fun sought -> if sought = var then value else e sought
+
+let getint (var : char) = R.asks (fun e -> let (E.Int x) = e var in x)
+
+let getfun (var : char) = R.asks (fun e -> let (E.Fun f) = e var in f)
+
+(* monadic versions of `x` and `y` and `f` *)
+let getx = getint 'x'
+let gety = getint 'y'
+let getf = getfun 'f'
+
+(* monadic version of `y + x` *)
+let (expr1 : int R.t) = R.(map2 (+) gety getx)
+
+(* monadic version of `\y -> y + x` *)
+let lambda1 = R.(fun yy -> yy >>= fun y -> shift (insert 'y' (E.Int y)) expr1)
+
+let letx xx body = R.(xx >>= fun x -> shift (insert 'x' (E.Int x)) body)
+let letf ff body = R.(ff >>= fun f -> shift (insert 'f' (E.Fun f)) body)
+
+(* monadic version of `let x = 2 in let f = \y -> y + x in f 3` *)
+let (expr4 : int R.t) = R.(letx (mid 2) (letf (mid lambda1) (getf >>= fun f -> f (mid 3))))
+
+let res = R.run expr4 env0
+