From: Jim <jim.pryor@nyu.edu>
Date: Sat, 4 Apr 2015 15:41:31 +0000 (-0400)
Subject: Merge branch 'working'
X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=commitdiff_plain;h=9fa2ebb32617d76b9dde81b4d6adfada2f15d48d;hp=d0396f8a13e61cdf84a30778ed88948114acbb41

Merge branch 'working'

* working:
  add/update monad code
---

diff --git a/code/juli8.ml b/code/juli8.ml
index f8f9cb3c..821a09f3 100644
--- a/code/juli8.ml
+++ b/code/juli8.ml
@@ -1519,3 +1519,5 @@ module Juli8 = struct
 end (* Juli8 *)
 
 open Juli8
+
+#use "monad.ml"
diff --git a/code/monad.ml b/code/monad.ml
index 79dbf4f6..f17d953b 100644
--- a/code/monad.ml
+++ b/code/monad.ml
@@ -33,24 +33,28 @@ module Monad = struct
   end
 
   module type MONADT = sig
-    include MONAD
     type 'a ut
+    include MONAD
     val hoist : 'a ut -> 'a t
   end
 
-  module type MONADZERO = sig
-    include MONAD
+  module type ZERO = sig
+    type 'a t
     (* mzero is a value of type α that is exemplified by Nothing for the box type Maybe α and by [] for the box type List α. It has the behavior that anything ¢ mzero == mzero == mzero ¢ anything == mzero >>= anything. In Haskell, this notion is called Control.Applicative.empty or Control.Monad.mzero. *)
     val mzero : 'a t
     val guard : bool -> unit t
+  end 
+
+  module type MONADZERO = sig
+    include MONAD
+    include ZERO with type 'a t := 'a t
   end
 
   module type MONADZEROT = sig
-    include MONADZERO
-    type 'a ut
-    val hoist : 'a ut -> 'a t
+    include MONADT
+    include ZERO with type 'a t := 'a t
   end
-
+    
   module type MAPPABLE2 = sig
     type ('a,'d) t
     val map : ('a -> 'b) -> ('a,'d) t -> ('b,'d) t
@@ -296,7 +300,7 @@ module Monad = struct
       let do_unless res xx = if res then mid () else xx
     end
 
-    module MonadFromT(B : TRANS) : MONADT with type 'a t = 'a B.t and type 'a ut := 'a B.U.t and type 'a result = 'a B.result = struct
+    module MonadFromT(B : TRANS) : MONADT with type 'a t = 'a B.t and type 'a result = 'a B.result and type 'a ut := 'a B.U.t = struct
       include MonadFromBind(struct
         include B
         let mid x = hoist U.(mid x)
@@ -305,7 +309,7 @@ module Monad = struct
       let hoist = B.hoist
     end
 
-    module MonadFromTUZ(B : TRANSUZ) : MONADZEROT with type 'a t = 'a B.t and type 'a ut := 'a B.U.t and type 'a result = 'a B.result = struct
+    module MonadFromTUZ(B : TRANSUZ) : MONADZEROT with type 'a t = 'a B.t and type 'a result = 'a B.result and type 'a ut := 'a B.U.t = struct
       let mzero = Obj.magic (B.hoist (B.U.mzero)) (* Obj.magic hack to generate enough polymorphism without having to thunk mzero *)
       include MonadFromBind(struct
         include B
@@ -317,7 +321,7 @@ module Monad = struct
       let guard res = if res then mid () else mzero
     end
 
-    module MonadFromTZ(B : TRANSZ) : MONADZEROT with type 'a t = 'a B.t and type 'a ut := 'a B.U.t and type 'a result = 'a B.result = struct
+    module MonadFromTZ(B : TRANSZ) : MONADZEROT with type 'a t = 'a B.t and type 'a result = 'a B.result and type 'a ut := 'a B.U.t = struct
       include MonadFromBind(struct
         include B
         let (>>=) xx k = xx >>= fun x -> try k x with Match_failure _ -> mzero
@@ -548,7 +552,17 @@ module Monad = struct
   end (* Make *)
 
 
+  module type OPTION = sig
+    include MONADZERO with type 'a result = 'a option
+    val test : ('a option -> bool) -> 'a t -> 'a t
+  end
 
+  module type OPTIONT = sig
+    type 'a uresult
+    include MONADT with type 'a result = 'a option uresult
+    val test : ('a option ut -> bool) -> 'a t -> 'a t
+  end
+    
   module Option = struct
     include Juli8.Option
     module type EXTRA = sig
@@ -559,10 +573,7 @@ module Monad = struct
       type ('a,'d) t
       val test : ('a option -> bool) -> ('a,'d) t -> ('a,'d) t
     end
-    module M : sig
-      include MONADZERO with type 'a result = 'a option
-      include EXTRA with type 'a t := 'a t
-    end = struct
+    module M : OPTION = struct
       include Make.MonadFromBind(struct
         type 'a t = 'a option
         type 'a result = 'a t let run xx = xx
@@ -590,11 +601,7 @@ module Monad = struct
       let guard res : (unit,'d) t = if res then Some () else None
       let test p xx = if p xx then xx else None
     end (* Option.M2 *)
-    module T(U : MONAD) : sig
-      include MONADZEROT with type 'a result = 'a option U.result and type 'a ut := 'a U.t
-      include EXTRA with type 'a t := 'a t
-      val test : ('a option U.t -> bool) -> 'a t -> 'a t
-    end = struct
+    module T(U : MONAD) : OPTIONT with type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
       include Make.MonadFromTZ(struct
         module U = U
         type 'a t = 'a option U.t
@@ -622,24 +629,38 @@ module Monad = struct
     end (* Option.T2 *)
   end (* Option *)
 
+
+  module type LIST = sig
+    include MONADZERO with type 'a result = 'a list
+    val (++) : 'a t -> 'a t -> 'a t (* monadically append *)
+    val pick : 'a t -> ('a * 'a t) t (* monadically pick each element *)
+    val test : ('a list -> bool) -> 'a t -> 'a t
+  end
+
+  module type LISTT = sig
+    type 'a uresult
+    include MONADZEROT with type 'a result = 'a list uresult
+    val (++) : 'a t -> 'a t -> 'a t (* monadically append *)
+    val pick : 'a t -> ('a * 'a t) t (* monadically pick each element *)
+    val test : ('a list ut -> bool) -> 'a t -> 'a t
+    (*
+        Monadically seq k over box<a>.
+        OptionM.seq (List.map (\a -> OptionM.mid $ a+1) int_list) == (after running)
+        ListOption.distribute (\a -> OptionM.mid $ a+1) int_list == Some [x+1,x+1,...]
+        TreeOption.distribute (\a -> OptionM.mid $ a+1) int_tree: works similarly
+    *)
+    val distribute : ('a -> 'b ut) -> 'a list -> 'b t
+  end
+    
   module List = struct
     include Juli8.List
-    module type EXTRA = sig
-      type 'a t
-      val (++) : 'a t -> 'a t -> 'a t (* monadically append *)
-      val pick : 'a t -> ('a * 'a t) t (* monadically pick each element *)
-      val test : ('a list (* U.t *) -> bool) -> 'a t -> 'a t
-    end
     module type EXTRA2 = sig
       type ('a,'d) t
       val (++) : ('a,'d) t -> ('a,'d) t -> ('a,'d) t
       val pick : ('a,'d) t -> ('a * ('a,'d) t,'d) t
       val test : ('a list -> bool) -> ('a,'d) t -> ('a,'d) t
     end
-    module M : sig
-      include MONADZERO with type 'a result = 'a list
-      include EXTRA with type 'a t := 'a t
-    end = struct
+    module M : LIST = struct
       include Make.MonadFromBind(struct
         type 'a t = 'a list
         type 'a result = 'a t let run xx = xx
@@ -671,18 +692,7 @@ module Monad = struct
       let rec pick = function [] -> mzero | x::xs -> mid (x,xs) ++ (pick xs >>= fun (y,ys) -> mid (y, x::ys))
       let test p xx = if p xx then xx else []
     end (* List.M2 *)
-    module T(U : MONAD) : sig
-      include MONADZEROT with type 'a result = 'a list U.result and type 'a ut := 'a U.t
-      include EXTRA with type 'a t := 'a t
-      val test : ('a list U.t -> bool) -> 'a t -> 'a t
-      (*
-          Monadically seq k over box<a>.
-          OptionM.seq (List.map (\a -> OptionM.mid $ a+1) int_list) == (after running)
-          ListOption.distribute (\a -> OptionM.mid $ a+1) int_list == Some [x+1,x+1,...]
-          TreeOption.distribute (\a -> OptionM.mid $ a+1) int_tree: works similarly
-      *)
-      val distribute : ('a -> 'b U.t) -> 'a list -> 'b t
-    end = struct
+    module T(U : MONAD) : LISTT with type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
       let distribute k xs = U.seq (List.map k xs)
       include Make.MonadFromTZ(struct
         module U = U
@@ -721,6 +731,26 @@ module Monad = struct
   (* LTree, unit centers, has natural ++ *)
   (* ITree, unit leaves, has natural mzero *)
 
+  module type TREE = sig
+    type 'a tree
+    include MONAD with type 'a result = 'a tree
+    val (++) : 'a t -> 'a t -> 'a t (* monadically append *)
+  end
+
+  module type TREET = sig
+    type 'a tree
+    type 'a uresult
+    include MONADT with type 'a result = 'a tree uresult
+    val (++) : 'a t -> 'a t -> 'a t (* monadically append *)
+    (*
+        Monadically seq k over box<a>.
+        OptionM.seq (List.map (\a -> OptionM.mid $ a+1) int_list) == (after running)
+        ListOption.distribute (\a -> OptionM.mid $ a+1) int_list == Some [x+1,x+1,...]
+        TreeOption.distribute (\a -> OptionM.mid $ a+1) int_tree: works similarly
+    *)
+    val distribute : ('a -> 'b ut) -> 'a tree -> 'b t
+  end
+
   module LTree = struct
     type 'a tree = Leaf of 'a | Branch of 'a tree * 'a tree
     let branch x y = Branch(x,y)
@@ -735,14 +765,7 @@ module Monad = struct
       | Leaf x -> Leaf (f x)
       | Branch(l, r) -> Branch(aux l, aux r) in
       aux xt
-    module type EXTRA = sig
-      type 'a t
-      val (++) : 'a t -> 'a t -> 'a t (* monadically append *)
-    end
-    module M : sig
-      include MONAD with type 'a result = 'a tree
-      include EXTRA with type 'a t := 'a t
-    end = struct
+    module M : TREE with type 'a tree := 'a tree = struct
       include Make.MonadFromBind(struct
         type 'a t = 'a tree
         type 'a result = 'a t let run xx = xx
@@ -752,17 +775,7 @@ module Monad = struct
       end)
       let (++) xx yy = Branch(xx, yy)
     end (* Tree.M *)
-    module T(U : MONAD) : sig
-      include MONADT with type 'a result = 'a tree U.result and type 'a ut := 'a U.t
-      include EXTRA with type 'a t := 'a t
-      (*
-          Monadically seq k over box<a>.
-          OptionM.seq (List.map (\a -> OptionM.mid $ a+1) int_list) == (after running)
-          ListOption.distribute (\a -> OptionM.mid $ a+1) int_list == Some [x+1,x+1,...]
-          TreeOption.distribute (\a -> OptionM.mid $ a+1) int_tree: works similarly
-      *)
-      val distribute : ('a -> 'b U.t) -> 'a tree -> 'b t
-    end = struct
+    module T(U : MONAD) : TREET with type 'a tree := 'a tree and type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
       let hoist uu = U.(uu >>= fun u -> mid (Leaf u)) 
       let distribute k xt = traverse (U.map2 branch) (fun x -> hoist (k x)) xt
       include Make.MonadFromT(struct
@@ -776,9 +789,8 @@ module Monad = struct
       let (++) xx yy = U.(xx >>= fun xt -> yy >>= fun yt -> mid (Branch(xt,yt)))
     end (* Tree.T *)
     module Z(U : MONADZERO) : sig
-      include MONADZEROT with type 'a result = 'a tree U.result and type 'a ut := 'a U.t
-      include EXTRA with type 'a t := 'a t
-      val distribute : ('a -> 'b U.t) -> 'a tree -> 'b t
+      include TREET with type 'a tree := 'a tree and type 'a uresult := 'a U.result and type 'a ut := 'a U.t
+      include ZERO with type 'a t := 'a t
     end = struct
       let hoist uu = U.(uu >>= fun u -> mid (Leaf u)) 
       let distribute k xt = traverse (U.map2 branch) (fun x -> hoist (k x)) xt
@@ -809,19 +821,28 @@ module Monad = struct
     end
   end
 
+
+  module type READER = sig
+    type env
+    include MONAD with type 'a result = env -> 'a
+    val ask : env t
+    val asks : (env -> 'a) -> 'a t
+    val shift : (env -> env) -> 'a t -> 'a t
+  end
+
+  module type READERT = sig
+    type env
+    type 'a uresult
+    include MONADT with type 'a result = env -> 'a uresult
+    val ask : env t
+    val asks : (env -> 'a) -> 'a t
+    val shift : (env -> env) -> 'a t -> 'a t
+  end
+
   (* must be parameterized on `struct type env = ... end` *)
   module Reader(E : sig type env end) = struct
     type env = E.env
-    module type EXTRA = sig
-      type 'a t
-      val ask : env t
-      val asks : (env -> 'a) -> 'a t
-      val shift : (env -> env) -> 'a t -> 'a t
-    end
-    module M : sig
-      include MONAD with type 'a result = env -> 'a
-      include EXTRA with type 'a t := 'a t
-    end = struct
+    module M : READER with type env := env = struct
       include Make.MonadFromBind(struct
         type 'a t = env -> 'a
         type 'a result = 'a t let run xx = fun e -> xx e
@@ -833,10 +854,7 @@ module Monad = struct
       let asks selector = ask >>= (fun e -> mid (selector e)) (* may fail with Not_found *)
       let shift modifier xx = fun e -> xx (modifier e)
     end (* Reader.M *)
-    module T(U : MONAD) : sig
-      include MONADT with type 'a result = env -> 'a U.result and type 'a ut := 'a U.t
-      include EXTRA with type 'a t := 'a t
-    end = struct
+    module T(U : MONAD) : READERT with type env := env and type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
       include Make.MonadFromT(struct
         module U = U
         type 'a t = env -> 'a U.t
@@ -849,8 +867,8 @@ module Monad = struct
       let shift modifier xx = fun e -> xx (modifier e)
     end (* Reader.T *)
     module Z(U : MONADZERO) : sig
-      include MONADZEROT with type 'a result = env -> 'a U.result and type 'a ut := 'a U.t
-      include EXTRA with type 'a t := 'a t
+      include READERT with type env := env and type 'a uresult := 'a U.result and type 'a ut := 'a U.t
+      include ZERO with type 'a t := 'a t
     end = struct
       include Make.MonadFromTUZ(struct
         module U = U
@@ -865,20 +883,30 @@ module Monad = struct
     end (* Reader.Z *)
   end (* Reader *)
 
+
+  module type STATE = sig
+    type store
+    include MONAD with type 'a result = store -> 'a * store
+    val get : store t
+    val gets : (store -> 'a) -> 'a t
+    val put : store -> unit t
+    val modify : (store -> store) -> unit t
+  end
+
+  module type STATET = sig
+    type store
+    type 'a uresult
+    include MONADT with type 'a result = store -> ('a * store) uresult
+    val get : store t
+    val gets : (store -> 'a) -> 'a t
+    val put : store -> unit t
+    val modify : (store -> store) -> unit t
+  end
+
   (* must be parameterized on `struct type store = ... end` *)
   module State(S : sig type store end) = struct
     type store = S.store
-    module type EXTRA = sig
-      type 'a t
-      val get : store t
-      val gets : (store -> 'a) -> 'a t
-      val put : store -> unit t
-      val modify : (store -> store) -> unit t
-    end
-    module M : sig
-      include MONAD with type 'a result = store -> 'a * store
-      include EXTRA with type 'a t := 'a t
-    end = struct
+    module M : STATE with type store := store = struct
       include Make.MonadFromBind(struct
         type 'a t = store -> 'a * store
         type 'a result = 'a t let run xx = fun s -> xx s
@@ -892,10 +920,7 @@ module Monad = struct
       let put s = fun _ -> (), s
       let modify modifier = fun s -> (), modifier s
     end (* State.M *)
-    module T(U : MONAD) : sig
-      include MONADT with type 'a result = store -> ('a * store) U.result and type 'a ut := 'a U.t
-      include EXTRA with type 'a t := 'a t
-    end = struct
+    module T(U : MONAD) : STATET with type store := store and type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
       include Make.MonadFromT(struct
         module U = U
         type 'a t = store -> ('a * store) U.t
@@ -909,8 +934,8 @@ module Monad = struct
       let modify modifier = fun s -> U.mid ((), modifier s)
     end (* State.T *)
     module Z(U : MONADZERO) : sig
-      include MONADZEROT with type 'a result = store -> ('a * store) U.result and type 'a ut := 'a U.t
-      include EXTRA with type 'a t := 'a t
+      include STATET with type store := store and type 'a uresult := 'a U.result and type 'a ut := 'a U.t
+      include ZERO with type 'a t := 'a t
     end = struct
       include Make.MonadFromTUZ(struct
         module U = U
@@ -926,6 +951,26 @@ module Monad = struct
     end (* State.Z *)
   end (* State *)
 
+
+  module type REF = sig
+    type ref
+    type value
+    include MONAD with type 'a result = 'a
+    val newref : value -> ref t
+    val deref : ref -> value t
+    val change : ref -> value -> unit t
+  end
+
+  module type REFT = sig
+    type ref
+    type value
+    type 'a uresult
+    include MONADT with type 'a result = 'a uresult
+    val newref : value -> ref t
+    val deref : ref -> value t
+    val change : ref -> value -> unit t
+  end
+
   (* State with a different interface; must be parameterized on `struct type value = ... end` *)
   module Ref(V : sig type value end) = struct
     type ref = int
@@ -936,16 +981,7 @@ module Monad = struct
     let alloc v d = d.next, { next = succ d.next; tree = D.add d.next v d.tree}
     let read (k : ref) d = D.find k d.tree
     let write (k : ref) v d = { next = d.next; tree = D.add k v d.tree }
-    module type EXTRA = sig
-      type 'a t
-      val newref : value -> ref t
-      val deref : ref -> value t
-      val change : ref -> value -> unit t
-    end
-    module M : sig
-      include MONAD with type 'a result = 'a
-      include EXTRA with type 'a t := 'a t
-    end = struct
+    module M : REF with type value := value and type ref := ref = struct
       include Make.MonadFromBind(struct
         type 'a t = dict -> 'a * dict
         type 'a result = 'a let run xx = fst (xx empty)
@@ -957,10 +993,7 @@ module Monad = struct
       let deref k = fun s -> read k s, s (* shouldn't fail because k will have an abstract type? and we never GC *)
       let change k v = fun s -> (), write k v s (* shouldn't allocate because k will have an abstract type *)
     end (* Ref.M *)
-    module T(U : MONAD) : sig
-      include MONADT with type 'a result = 'a U.result and type 'a ut := 'a U.t
-      include EXTRA with type 'a t := 'a t
-    end = struct
+    module T(U : MONAD) : REFT with type value := value and type ref := ref and type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
       include Make.MonadFromT(struct
         module U = U
         type 'a t = dict -> ('a * dict) U.t
@@ -973,8 +1006,8 @@ module Monad = struct
       let change k v = fun s -> U.mid ((), write k v s)
     end (* Ref.T *)
     module Z(U : MONADZERO) : sig
-      include MONADZEROT with type 'a result = 'a U.result and type 'a ut := 'a U.t
-      include EXTRA with type 'a t := 'a t
+      include REFT with type value := value and type ref := ref and type 'a uresult := 'a U.result and type 'a ut := 'a U.t
+      include ZERO with type 'a t := 'a t
     end = struct
       include Make.MonadFromTUZ(struct
         module U = U
@@ -989,21 +1022,32 @@ module Monad = struct
     end (* Ref.Z *)
   end (* Ref *)
 
+
+  module type WRITER = sig
+    type log
+    include MONAD with type 'a result = 'a * log
+    val listen : 'a t -> ('a * log) t
+    val listens : (log -> 'b) -> 'a t -> ('a * 'b) t
+    val tell : log -> unit t
+    (* val pass : ('a * (log -> log)) t -> 'a t *)
+    val censor : (log -> log) -> 'a t -> 'a t
+  end
+
+  module type WRITERT = sig
+    type log
+    type 'a uresult
+    include MONADT with type 'a result = ('a * log) uresult
+    val listen : 'a t -> ('a * log) t
+    val listens : (log -> 'b) -> 'a t -> ('a * 'b) t
+    val tell : log -> unit t
+    (* val pass : ('a * (log -> log)) t -> 'a t *)
+    val censor : (log -> log) -> 'a t -> 'a t
+  end
+
   (* must be parameterized on `struct type log = ... end` *)
   module Writer(W : sig type log val empty : log val append : log -> log -> log end) = struct
     type log = W.log
-    module type EXTRA = sig
-      type 'a t
-      val listen : 'a t -> ('a * log) t
-      val listens : (log -> 'b) -> 'a t -> ('a * 'b) t
-      val tell : log -> unit t
-      (* val pass : ('a * (log -> log)) t -> 'a t *)
-      val censor : (log -> log) -> 'a t -> 'a t
-    end
-    module M : sig
-      include MONAD with type 'a result = 'a * log
-      include EXTRA with type 'a t := 'a t
-    end = struct
+    module M : WRITER with type log := log = struct
       include Make.MonadFromBind(struct
         type 'a t = 'a * log
         type 'a result = 'a t let run xx = xx
@@ -1017,10 +1061,7 @@ module Monad = struct
       let pass ((x,c),w) = (x, c w) (* usually use censor *)
       let censor c xx = pass (xx >>= fun x -> mid (x,c)) (* ==> (x, c w) *)
     end (* Writer.M *)
-    module T(U : MONAD) : sig
-      include MONADT with type 'a result = ('a * log) U.result and type 'a ut := 'a U.t
-      include EXTRA with type 'a t := 'a t
-    end = struct
+    module T(U : MONAD) : WRITERT with type log := log and type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
       include Make.MonadFromT(struct
         module U = U
         type 'a t = ('a * log) U.t
@@ -1035,8 +1076,8 @@ module Monad = struct
       let censor c xx = pass (xx >>= fun x -> mid (x,c))
     end (* Writer.T *)
     module Z(U : MONADZERO) : sig
-      include MONADZEROT with type 'a result = ('a * log) U.result and type 'a ut := 'a U.t
-      include EXTRA with type 'a t := 'a t
+      include WRITERT with type log := log and type 'a uresult := 'a U.result and type 'a ut := 'a U.t
+      include ZERO with type 'a t := 'a t
     end = struct
       include Make.MonadFromTUZ(struct
         module U = U
@@ -1053,22 +1094,34 @@ module Monad = struct
     end (* Writer.Z *)
   end (* Writer *)
 
-  (* must be parameterized on `struct type err = ... end` *)
-  module Error(E : sig type err exception Exc of err end) = struct
-    type err = E.err
-    type 'a error = Error of err | OK of 'a
-    module type EXTRA = sig
-      type 'a t
-      val throw : err -> 'a t
-      val catch : 'a t -> (err -> 'a t) -> 'a t
-    end
-    module M : sig
-      include MONAD with type 'a result = 'a error
-      include EXTRA with type 'a t := 'a t
-    end = struct
+
+  module type ERROR = sig
+    type msg
+    type 'a error
+    include MONAD with type 'a result = 'a error
+    val throw : msg -> 'a t
+    val catch : 'a t -> (msg -> 'a t) -> 'a t
+  end
+
+  module type ERRORT = sig
+    type msg
+    type 'a error
+    type 'a uresult
+    include MONADT with type 'a result = 'a uresult (* note the difference from ERROR *)
+    val throw : msg -> 'a t
+    val catch : 'a t -> (msg -> 'a t) -> 'a t
+  end
+
+  (* must be parameterized on `struct type msg = ... end` *)
+  module Error(E : sig type msg exception Exc of msg (* Exc used only by T *) end) = struct
+    type msg = E.msg
+    type 'a error = Error of msg | OK of 'a
+    module M : ERROR with type msg := msg and type 'a error := 'a error = struct
       include Make.MonadFromBind(struct
         type 'a t = 'a error
-        type 'a result = 'a t let run xx = xx
+        type 'a result = 'a t
+        (* note that M.run doesn't raise *)
+        let run xx = xx
         let map = `Generate let map2 = `Generate let mapply = `Generate
         let mid x = OK x
         let (>>=) xx k = match xx with OK x -> k x | Error e -> Error e
@@ -1076,14 +1129,12 @@ module Monad = struct
       let throw e = Error e
       let catch xx handler = match xx with OK _ -> xx | Error e -> handler e
     end (* Error.M *)
-    module T(U : MONAD) : sig
-      include MONADT with type 'a result = 'a U.result and type 'a ut := 'a U.t
-      include EXTRA with type 'a t := 'a t
-    end = struct
+    module T(U : MONAD) : ERRORT with type msg := msg and type 'a error := 'a error and type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
       include Make.MonadFromT(struct
         module U = U
         type 'a t = 'a error U.t
         type 'a result = 'a U.result
+        (* note that T.run does raise *)
         let run xx = let uu = U.(xx >>= function OK x -> mid x | Error e -> raise (E.Exc e)) in U.run uu
         let hoist uu = U.(uu >>= fun u -> mid (OK u)) 
         let (>>=) xx k = U.(xx >>= function OK x -> k x | Error e -> mid (Error e))
@@ -1092,8 +1143,8 @@ module Monad = struct
       let catch xx handler = U.(xx >>= function OK _ as x -> mid x | Error e -> handler e)
     end (* Error.T *)
     module Z(U : MONADZERO) : sig
-      include MONADZEROT with type 'a result = 'a U.result and type 'a ut := 'a U.t
-      include EXTRA with type 'a t := 'a t
+      include ERRORT with type msg := msg and type 'a error := 'a error and type 'a uresult := 'a U.result and type 'a ut := 'a U.t
+      include ZERO with type 'a t := 'a t
     end = struct
       include Make.MonadFromTUZ(struct
         module U = U
@@ -1109,9 +1160,10 @@ module Monad = struct
     end (* Error.Z *)
   end (* Error *)
 
+
   (* predefine some common instances *)
 
-  module Writer1 = Writer(struct type log = string let empty = "" let append s1 s2 = s1 ^ "\n" ^ s2 end)
+  module Writer1 = Writer(struct type log = string let empty = "" let append s1 s2 = if s2 = "" then s1 else if s1 = "" then s2 else s1 ^ "\n" ^ s2 end)
 
   module Writer2 = struct
     include Writer(struct
@@ -1125,7 +1177,7 @@ module Monad = struct
     let run xx = let (x,w) = M.run xx in (x, List.rev w)
   end
 
-  module Failure = Error(struct type err = string exception Exc = Failure end)
+  module Failure = Error(struct type msg = string exception Exc = Failure end)
 
 end (* Monad *)
 
diff --git a/code/reader1.hs b/code/reader1.hs
new file mode 100644
index 00000000..74cb5197
--- /dev/null
+++ b/code/reader1.hs
@@ -0,0 +1,31 @@
+import Control.Monad.Reader
+type Bound = Int
+type Env = Char -> Bound
+
+
+env0 = \var -> error "Not found"
+insert var value e = \sought -> if sought == var then value else e sought
+
+getint :: Char -> Reader Env Int
+getint var = asks (\e -> let x = e var in x)
+
+-- monadic versions of `x` and `y`
+getx = getint 'x'
+gety = getint 'y'
+
+-- monadic version of `y + x`
+expr1 :: Reader Env Int
+expr1 = liftM2 (+) gety getx
+
+-- monadic version of `3 + x`
+expr2 :: Reader Env Int
+expr2 = liftM2 (+) (return 3) getx
+
+letx xx body = xx >>= \x -> local (insert 'x' x) body
+
+-- monadic version of `let x = 2 in 3 + x`
+expr3 :: Reader Env Int
+expr3 = letx (return 2) expr2
+
+res = runReader expr3 env0 -- will be 5
+
diff --git a/code/reader1.ml b/code/reader1.ml
new file mode 100644
index 00000000..f9da961a
--- /dev/null
+++ b/code/reader1.ml
@@ -0,0 +1,32 @@
+module E = struct
+  type bound = int
+  type env = char -> bound
+end
+module R_E = Monad.Reader(E)
+module R = R_E.M
+
+
+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) : int R.t = R.asks (fun e -> let x = e var in x)
+
+(* monadic versions of `x` and `y` *)
+let getx = getint 'x'
+let gety = getint 'y'
+
+(* monadic version of `y + x` *)
+let (expr1 : int R.t) = R.(gety >>= fun y -> getx >>= fun x -> mid (y + x))
+(* or *)
+let (expr1 : int R.t) = R.(map2 (+) gety getx)
+
+(* monadic version of `3 + x` *)
+let (expr2 : int R.t) = R.(map2 (+) (mid 3) getx)
+
+let letx xx body = R.(xx >>= fun x -> shift (insert 'x' x) body)
+
+(* monadic version of `let x = 2 in 3 + x` *)
+let (expr3 : int R.t) = R.(letx (mid 2) expr2)
+
+let res = R.run expr3 env0 (* will be 5 *)
+
diff --git a/code/reader2.hs b/code/reader2.hs
new file mode 100644
index 00000000..bfc99e2b
--- /dev/null
+++ b/code/reader2.hs
@@ -0,0 +1,36 @@
+import Control.Monad.Reader
+data Bound = Int Int | Fun (Reader Env Int -> Reader Env Int)
+type Env = Char -> Bound
+
+
+env0 = \var -> error "Not found"
+insert var value e = \sought -> if sought == var then value else e sought
+
+getint :: Char -> Reader Env Int
+getint var = asks (\e -> let (Int x) = e var in x)
+
+getfun :: Char -> Reader Env (Reader Env Int -> Reader Env Int)
+getfun var = asks (\e -> let (Fun f) = e var in f)
+
+-- monadic versions of `x` and `y` and `f`
+getx = getint 'x'
+gety = getint 'y'
+getf = getfun 'f'
+
+-- monadic version of `y + x`
+expr1 :: Reader Env Int
+expr1 = liftM2 (+) gety getx
+
+-- monadic version of `\y -> y + x`
+lambda1 :: Reader Env (Reader Env Int -> Reader Env Int)
+lambda1 = return (\yy -> yy >>= \y -> local (insert 'y' (Int y)) expr1)
+
+letx xx body = xx >>= \x -> local (insert 'x' (Int x)) body
+letf ff body = ff >>= \f -> local (insert 'f' (Fun f)) body
+
+-- monadic version of `let x = 2 in let f = \y -> y + x in f 3`
+expr4 :: Reader Env Int
+expr4 = letx (return 2) (letf lambda1 (getf >>= \f -> f (return 3)))
+
+res = runReader expr4 env0 -- will be 5
+
diff --git a/code/reader2.ml b/code/reader2.ml
new file mode 100644
index 00000000..10d61e3e
--- /dev/null
+++ b/code/reader2.ml
@@ -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
+