X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Fmonads.ml;h=3fba1f3216414caa0419bc04527f7bb6b2f64cbb;hp=0dab871253c82b72e19a9855eedd7fd6e2a948c6;hb=8f043cd83b65c90928ab884d52be168b93d23a6c;hpb=d3ea4212bbca7a47f8aae537023852fd9a214389

diff --git a/code/monads.ml b/code/monads.ml
index 0dab8712..3fba1f32 100644
--- a/code/monads.ml
+++ b/code/monads.ml
@@ -42,8 +42,20 @@
  * have to use operations like `run` to convert the abstract monadic types
  * to types whose internals you have free access to.
  *
+ * Acknowledgements: This is largely based on the mtl library distributed
+ * with the Glasgow Haskell Compiler. I've also been helped in
+ * various ways by posts and direct feedback from Oleg Kiselyov and
+ * Chung-chieh Shan. The following were also useful:
+ * - <http://pauillac.inria.fr/~xleroy/mpri/progfunc/>
+ * - Ken Shan "Monads for natural language semantics" <http://arxiv.org/abs/cs/0205026v1>
+ * - http://www.grabmueller.de/martin/www/pub/Transformers.pdf
+ * - http://en.wikibooks.org/wiki/Haskell/Monad_transformers
+ *
+ * Licensing: MIT (if that's compatible with the ghc sources this is partly
+ * derived from)
  *)
 
+exception Undefined
 
 (* Some library functions used below. *)
 module Util = struct
@@ -60,6 +72,10 @@ module Util = struct
     let rec loop n accu =
       if n == 0 then accu else loop (pred n) (fill :: accu)
     in loop len []
+  (* Dirty hack to be a default polymorphic zero.
+   * To implement this cleanly, monads without a natural zero
+   * should always wrap themselves in an option layer (see Tree_monad). *)
+  let undef = Obj.magic (fun () -> raise Undefined)
 end
 
 
@@ -73,53 +89,72 @@ module Monad = struct
   (*
    * Signature extenders:
    *   Make :: BASE -> S
-   *     MakeCatch, MakeDistrib :: PLUSBASE -> PLUS
-   *                                           which merges into S
-   *                                           (P is merged sig)
-   *   MakeT :: TRANS (with Wrapped : S or P) -> custom sig
-   *
-   *   Make2 :: BASE2 -> S2
-   *     MakeCatch2, MakeDistrib2 :: PLUSBASE2 -> PLUS2 (P2 is merged sig)
-   *   to wrap double-typed inner monads:
-   *   MakeT2 :: TRANS2 (with Wrapped : S2 or P2) -> custom sig
-   *
+   *   MakeT :: BASET (with Wrapped : S) -> result sig not declared
    *)
 
 
-
   (* type of base definitions *)
   module type BASE = sig
-    (* The only constraints we impose here on how the monadic type
-     * is implemented is that it have a single type parameter 'a. *)
-    type 'a m
-    type 'a result
-    type 'a result_exn
-    val unit : 'a -> 'a m
-    val bind : 'a m -> ('a -> 'b m) -> 'b m
-    val run : 'a m -> 'a result
+    (* We make all monadic types doubly-parameterized so that they
+     * can layer nicely with Continuation, which needs the second
+     * type parameter. *)
+    type ('x,'a) m
+    type ('x,'a) result
+    type ('x,'a) result_exn
+    val unit : 'a -> ('x,'a) m
+    val bind : ('x,'a) m -> ('a -> ('x,'b) m) -> ('x,'b) m
+    val run : ('x,'a) m -> ('x,'a) result
     (* run_exn tries to provide a more ground-level result, but may fail *)
-    val run_exn : 'a m -> 'a result_exn
+    val run_exn : ('x,'a) m -> ('x,'a) result_exn
+    (* To simplify the library, we require every monad to supply a plus and zero. These obey the following laws:
+     *     zero >>= f   ===  zero
+     *     plus zero u  ===  u
+     *     plus u zero  ===  u
+     * Additionally, they will obey one of the following laws:
+     *     (Catch)   plus (unit a) v  ===  unit a
+     *     (Distrib) plus u v >>= f   ===  plus (u >>= f) (v >>= f)
+     * When no natural zero is available, use `let zero () = Util.undef`.
+     * The Make functor automatically detects for zero >>= ..., and 
+     * plus zero _, plus _ zero; it also substitutes zero for pattern-match failures.
+     *)
+    val zero : unit -> ('x,'a) m
+    (* zero has to be thunked to ensure results are always poly enough *)
+    val plus : ('x,'a) m -> ('x,'a) m -> ('x,'a) m
   end
   module type S = sig
     include BASE
-    val (>>=) : 'a m -> ('a -> 'b m) -> 'b m
-    val (>>) : 'a m -> 'b m -> 'b m
-    val join : ('a m) m -> 'a m
-    val apply : ('a -> 'b) m -> 'a m -> 'b m
-    val lift : ('a -> 'b) -> 'a m -> 'b m
-    val lift2 :  ('a -> 'b -> 'c) -> 'a m -> 'b m -> 'c m
-    val (>=>) : ('a -> 'b m) -> ('b -> 'c m) -> 'a -> 'c m
-    val do_when :  bool -> unit m -> unit m
-    val do_unless :  bool -> unit m -> unit m
-    val forever : 'a m -> 'b m
-    val sequence : 'a m list -> 'a list m
-    val sequence_ : 'a m list -> unit m
+    val (>>=) : ('x,'a) m -> ('a -> ('x,'b) m) -> ('x,'b) m
+    val (>>) : ('x,'a) m -> ('x,'b) m -> ('x,'b) m
+    val join : ('x,('x,'a) m) m -> ('x,'a) m
+    val apply : ('x,'a -> 'b) m -> ('x,'a) m -> ('x,'b) m
+    val lift : ('a -> 'b) -> ('x,'a) m -> ('x,'b) m
+    val lift2 :  ('a -> 'b -> 'c) -> ('x,'a) m -> ('x,'b) m -> ('x,'c) m
+    val (>=>) : ('a -> ('x,'b) m) -> ('b -> ('x,'c) m) -> 'a -> ('x,'c) m
+    val do_when :  bool -> ('x,unit) m -> ('x,unit) m
+    val do_unless :  bool -> ('x,unit) m -> ('x,unit) m
+    val forever : (unit -> ('x,'a) m) -> ('x,'b) m
+    val sequence : ('x,'a) m list -> ('x,'a list) m
+    val sequence_ : ('x,'a) m list -> ('x,unit) m
+    val guard : bool -> ('x,unit) m
+    val sum : ('x,'a) m list -> ('x,'a) m
   end
 
-  (* Standard, single-type-parameter monads. *)
-  module Make(B : BASE) : S with type 'a m = 'a B.m and type 'a result = 'a B.result and type 'a result_exn = 'a B.result_exn = struct
+  module Make(B : BASE) : S with type ('x,'a) m = ('x,'a) B.m and type ('x,'a) result = ('x,'a) B.result and type ('x,'a) result_exn = ('x,'a) B.result_exn = struct
     include B
+    let bind (u : ('x,'a) m) (f : 'a -> ('x,'b) m) : ('x,'b) m =
+      if u == Util.undef then Util.undef
+      else B.bind u (fun a -> try f a with Match_failure _ -> zero ())
+    let plus u v =
+      if u == Util.undef then v else if v == Util.undef then u else B.plus u v
+    let run u =
+      if u == Util.undef then raise Undefined else B.run u
+    let run_exn u =
+      if u == Util.undef then raise Undefined else B.run_exn u
     let (>>=) = bind
+    (* expressions after >> will be evaluated before they're passed to
+     * bind, so you can't do `zero () >> assert false`
+     * this works though: `zero () >>= fun _ -> assert false`
+     *)
     let (>>) u v = u >>= fun _ -> v
     let lift f u = u >>= fun a -> unit (f a)
     (* lift is called listM, fmap, and <$> in Haskell *)
@@ -135,7 +170,21 @@ module Monad = struct
     let (>=>) f g = fun a -> f a >>= g
     let do_when test u = if test then u else unit ()
     let do_unless test u = if test then unit () else u
-    let rec forever u = u >> forever u
+    (* A Haskell-like version works:
+         let rec forever uthunk = uthunk () >>= fun _ -> forever uthunk
+     * but the recursive call is not in tail position so this can stack overflow. *)
+    let forever uthunk =
+        let z = zero () in
+        let id result = result in
+        let kcell = ref id in
+        let rec loop _ =
+            let result = uthunk (kcell := id) >>= chained
+            in !kcell result
+        and chained _ =
+            kcell := loop; z (* we use z only for its polymorphism *)
+        in loop z
+    (* Reimplementations of the preceding using a hand-rolled State or StateT
+can also stack overflow. *)
     let sequence ms =
       let op u v = u >>= fun x -> v >>= fun xs -> unit (x :: xs) in
         Util.fold_right op ms (unit [])
@@ -163,155 +212,29 @@ module Monad = struct
     let replicateM n x = sequence (Util.replicate n x)
     let replicateM_ n x = sequence_ (Util.replicate n x)
     *)
-  end
-
-  (* Single-type-parameter monads that also define `plus` and `zero`
-   * operations. These obey the following laws:
-   *     zero >>= f   ===  zero
-   *     plus zero u  ===  u
-   *     plus u zero  ===  u
-   * Additionally, these monads will obey one of the following laws:
-   *     (Catch)   plus (unit a) v  ===  unit a
-   *     (Distrib) plus u v >>= f   ===  plus (u >>= f) (v >>= f)
-   *)
-  module type PLUSBASE = sig
-    include BASE
-    val zero : unit -> 'a m
-    val plus : 'a m -> 'a m -> 'a m
-  end
-  module type PLUS = sig
-    type 'a m
-    val zero : unit -> 'a m
-    val plus : 'a m -> 'a m -> 'a m
-    val guard : bool -> unit m
-    val sum : 'a m list -> 'a m
-  end
-  (* MakeCatch and MakeDistrib have the same implementation; we just declare
-   * them twice to document which laws the client code is promising to honor. *)
-  module MakeCatch(B : PLUSBASE) : PLUS with type 'a m = 'a B.m = struct
-    type 'a m = 'a B.m
-    let zero = B.zero
-    let plus = B.plus
     let guard test = if test then B.unit () else zero ()
     let sum ms = Util.fold_right plus ms (zero ())
   end
-  module MakeDistrib = MakeCatch
 
   (* Signatures for MonadT *)
-  (* sig for Wrapped that include S and PLUS *)
-  module type P = sig
-    include S
-    include PLUS with type 'a m := 'a m
-  end
-  module type TRANS = sig
+  module type BASET = sig
     module Wrapped : S
-    type 'a m
-    type 'a result
-    type 'a result_exn
-    val bind : 'a m -> ('a -> 'b m) -> 'b m
-    val run : 'a m -> 'a result
-    val run_exn : 'a m -> 'a result_exn
-    val elevate : 'a Wrapped.m -> 'a m
-    (* lift/elevate laws:
-     *     elevate (W.unit a) == unit a
-     *     elevate (W.bind w f) == elevate w >>= fun a -> elevate (f a)
-     *)
-  end
-  module MakeT(T : TRANS) = struct
-    include Make(struct
-        include T
-        let unit a = elevate (Wrapped.unit a)
-    end)
-    let elevate = T.elevate
-  end
-
-
-  (* We have to define BASE, S, and Make again for double-type-parameter monads. *)
-  module type BASE2 = sig
     type ('x,'a) m
     type ('x,'a) result
     type ('x,'a) result_exn
-    val unit : 'a -> ('x,'a) m
     val bind : ('x,'a) m -> ('a -> ('x,'b) m) -> ('x,'b) m
     val run : ('x,'a) m -> ('x,'a) result
     val run_exn : ('x,'a) m -> ('x,'a) result_exn
-  end
-  module type S2 = sig
-    include BASE2
-    val (>>=) : ('x,'a) m -> ('a -> ('x,'b) m) -> ('x,'b) m
-    val (>>) : ('x,'a) m -> ('x,'b) m -> ('x,'b) m
-    val join : ('x,('x,'a) m) m -> ('x,'a) m
-    val apply : ('x,'a -> 'b) m -> ('x,'a) m -> ('x,'b) m
-    val lift : ('a -> 'b) -> ('x,'a) m -> ('x,'b) m
-    val lift2 :  ('a -> 'b -> 'c) -> ('x,'a) m -> ('x,'b) m -> ('x,'c) m
-    val (>=>) : ('a -> ('x,'b) m) -> ('b -> ('x,'c) m) -> 'a -> ('x,'c) m
-    val do_when :  bool -> ('x,unit) m -> ('x,unit) m
-    val do_unless :  bool -> ('x,unit) m -> ('x,unit) m
-    val forever : ('x,'a) m -> ('x,'b) m
-    val sequence : ('x,'a) m list -> ('x,'a list) m
-    val sequence_ : ('x,'a) m list -> ('x,unit) m
-  end
-  module Make2(B : BASE2) : S2 with type ('x,'a) m = ('x,'a) B.m and type ('x,'a) result = ('x,'a) B.result and type ('x,'a) result_exn = ('x,'a) B.result_exn = struct
-    (* code repetition, ugh *)
-    include B
-    let (>>=) = bind
-    let (>>) u v = u >>= fun _ -> v
-    let lift f u = u >>= fun a -> unit (f a)
-    let join uu = uu >>= fun u -> u
-    let apply u v = u >>= fun f -> v >>= fun a -> unit (f a)
-    let lift2 f u v = u >>= fun a -> v >>= fun a' -> unit (f a a')
-    let (>=>) f g = fun a -> f a >>= g
-    let do_when test u = if test then u else unit ()
-    let do_unless test u = if test then unit () else u
-    let rec forever u = u >> forever u
-    let sequence ms =
-      let op u v = u >>= fun x -> v >>= fun xs -> unit (x :: xs) in
-        Util.fold_right op ms (unit [])
-    let sequence_ ms =
-      Util.fold_right (>>) ms (unit ())
-  end
-
-  module type PLUSBASE2 = sig
-    include BASE2
-    val zero : unit -> ('x,'a) m
-    val plus : ('x,'a) m -> ('x,'a) m -> ('x,'a) m
-  end
-  module type PLUS2 = sig
-    type ('x,'a) m
+    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
+    (* lift/elevate laws:
+     *     elevate (W.unit a) == unit a
+     *     elevate (W.bind w f) == elevate w >>= fun a -> elevate (f a)
+     *)
     val zero : unit -> ('x,'a) m
     val plus : ('x,'a) m -> ('x,'a) m -> ('x,'a) m
-    val guard : bool -> ('x,unit) m
-    val sum : ('x,'a) m list -> ('x,'a) m
   end
-  module MakeCatch2(B : PLUSBASE2) : PLUS2 with type ('x,'a) m = ('x,'a) B.m = struct
-    type ('x,'a) m = ('x,'a) B.m
-    (* code repetition, ugh *)
-    let zero = B.zero
-    let plus = B.plus
-    let guard test = if test then B.unit () else zero ()
-    let sum ms = Util.fold_right plus ms (zero ())
-  end
-  module MakeDistrib2 = MakeCatch2
-
-  (* Signatures for MonadT *)
-  (* sig for Wrapped that include S and PLUS *)
-  module type P2 = sig
-    include S2
-    include PLUS2 with type ('x,'a) m := ('x,'a) m
-  end
-  module type TRANS2 = sig
-    module Wrapped : S2
-    type ('x,'a) m
-    type ('x,'a) result
-    type ('x,'a) result_exn
-    val bind : ('x,'a) m -> ('a -> ('x,'b) m) -> ('x,'b) m
-    val run : ('x,'a) m -> ('x,'a) result
-    val run_exn : ('x,'a) m -> ('x,'a) result_exn
-    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
-  end
-  module MakeT2(T : TRANS2) = struct
-    (* code repetition, ugh *)
-    include Make2(struct
+  module MakeT(T : BASET) = struct
+    include Make(struct
         include T
         let unit a = elevate (Wrapped.unit a)
     end)
@@ -326,18 +249,20 @@ end
 
 module Identity_monad : sig
   (* expose only the implementation of type `'a result` *)
-  type 'a result = 'a
-  type 'a result_exn = 'a
-  include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
+  type ('x,'a) result = 'a
+  type ('x,'a) result_exn = 'a
+  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
 end = struct
   module Base = struct
-    type 'a m = 'a
+    type ('x,'a) m = 'a
+    type ('x,'a) result = 'a
+    type ('x,'a) result_exn = 'a
     let unit a = a
     let bind a f = f a
-    type 'a result = 'a
     let run a = a
-    type 'a result_exn = 'a
     let run_exn a = a
+    let zero () = Util.undef
+    let plus u v = u
   end
   include Monad.Make(Base)
 end
@@ -345,73 +270,39 @@ end
 
 module Maybe_monad : sig
   (* expose only the implementation of type `'a result` *)
-  type 'a result = 'a option
-  type 'a result_exn = 'a
-  include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-  include Monad.PLUS with type 'a m := 'a m
+  type ('x,'a) result = 'a option
+  type ('x,'a) result_exn = 'a
+  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
   (* MaybeT transformer *)
   module T : functor (Wrapped : Monad.S) -> sig
-    type 'a result = 'a option Wrapped.result
-    type 'a result_exn = 'a Wrapped.result_exn
-    include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-    include Monad.PLUS with type 'a m := 'a m
-    val elevate : 'a Wrapped.m -> 'a m
-  end
-  module T2 : functor (Wrapped : Monad.S2) -> sig
     type ('x,'a) result = ('x,'a option) Wrapped.result
     type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
-    include Monad.S2 with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-    include Monad.PLUS2 with type ('x,'a) m := ('x,'a) m
+    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
     val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
   end
 end = struct
   module Base = struct
-   type 'a m = 'a option
-   let unit a = Some a
-   let bind u f = match u with Some a -> f a | None -> None
-   type 'a result = 'a option
-   let run u = u
-   type 'a result_exn = 'a
-   let run_exn u = match u with
-     | Some a -> a
-     | None -> failwith "no value"
-   let zero () = None
-   let plus u v = match u with None -> v | _ -> u
+    type ('x,'a) m = 'a option
+    type ('x,'a) result = 'a option
+    type ('x,'a) result_exn = 'a
+    let unit a = Some a
+    let bind u f = match u with Some a -> f a | None -> None
+    let run u = u
+    let run_exn u = match u with
+      | Some a -> a
+      | None -> failwith "no value"
+    let zero () = None
+    (* satisfies Catch *)
+    let plus u v = match u with None -> v | _ -> u
   end
   include Monad.Make(Base)
-  include (Monad.MakeCatch(Base) : Monad.PLUS with type 'a m := 'a m)
   module T(Wrapped : Monad.S) = struct
-    module Trans = struct
+    module BaseT = struct
       include Monad.MakeT(struct
         module Wrapped = Wrapped
-        type 'a m = 'a option Wrapped.m
-        type 'a result = 'a option Wrapped.result
-        type 'a result_exn = 'a Wrapped.result_exn
-        let elevate w = Wrapped.bind w (fun a -> Wrapped.unit (Some a))
-        let bind u f = Wrapped.bind u (fun t -> match t with
-          | Some a -> f a
-          | None -> Wrapped.unit None)
-        let run u = Wrapped.run u
-        let run_exn u =
-          let w = Wrapped.bind u (fun t -> match t with
-            | Some a -> Wrapped.unit a
-            | None -> failwith "no value")
-          in Wrapped.run_exn w
-      end)
-      let zero () = Wrapped.unit None
-      let plus u v = Wrapped.bind u (fun t -> match t with | None -> v | _ -> u)
-    end
-    include Trans
-    include (Monad.MakeCatch(Trans) : Monad.PLUS with type 'a m := 'a m)
-  end
-  module T2(Wrapped : Monad.S2) = struct
-    module Trans = struct
-      include Monad.MakeT2(struct
-        module Wrapped = Wrapped
         type ('x,'a) m = ('x,'a option) Wrapped.m
         type ('x,'a) result = ('x,'a option) Wrapped.result
         type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
-        (* code repetition, ugh *)
         let elevate w = Wrapped.bind w (fun a -> Wrapped.unit (Some a))
         let bind u f = Wrapped.bind u (fun t -> match t with
           | Some a -> f a
@@ -420,68 +311,55 @@ end = struct
         let run_exn u =
           let w = Wrapped.bind u (fun t -> match t with
             | Some a -> Wrapped.unit a
-            | None -> failwith "no value")
-          in Wrapped.run_exn w
+            | None -> Wrapped.zero ()
+          ) in Wrapped.run_exn w
+        let zero () = Wrapped.unit None
+        let plus u v = Wrapped.bind u (fun t -> match t with | None -> v | _ -> u)
       end)
-      let zero () = Wrapped.unit None
-      let plus u v = Wrapped.bind u (fun t -> match t with | None -> v | _ -> u)
     end
-    include Trans
-    include (Monad.MakeCatch2(Trans) : Monad.PLUS2 with type ('x,'a) m := ('x,'a) m)
+    include BaseT
   end
 end
 
 
 module List_monad : sig
   (* declare additional operation, while still hiding implementation of type m *)
-  type 'a result = 'a list
-  type 'a result_exn = 'a
-  include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-  include Monad.PLUS with type 'a m := 'a m
-  val permute : 'a m -> 'a m m
-  val select : 'a m -> ('a * 'a m) m
+  type ('x,'a) result = 'a list
+  type ('x,'a) result_exn = 'a
+  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+  val permute : ('x,'a) m -> ('x,('x,'a) m) m
+  val select : ('x,'a) m -> ('x,'a * ('x,'a) m) m
   (* ListT transformer *)
   module T : functor (Wrapped : Monad.S) -> sig
-    type 'a result = 'a list Wrapped.result
-    type 'a result_exn = 'a Wrapped.result_exn
-    include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-    include Monad.PLUS with type 'a m := 'a m
-    val elevate : 'a Wrapped.m -> 'a m
+    type ('x,'a) result = ('x,'a list) Wrapped.result
+    type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
+    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
     (* note that second argument is an 'a list, not the more abstract 'a m *)
     (* type is ('a -> 'b W) -> 'a list -> 'b list W == 'b listT(W) *)
-    val distribute : ('a -> 'b Wrapped.m) -> 'a list -> 'b m
+    val distribute : ('a -> ('x,'b) Wrapped.m) -> 'a list -> ('x,'b) m
 (* TODO
     val permute : 'a m -> 'a m m
     val select : 'a m -> ('a * 'a m) m
 *)
   end
-(*
-  module T2 : functor (Wrapped : Monad.S2) -> sig
-    type ('x,'a) result = ('x,'a list) Wrapped.result
-    type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
-    include Monad.S2 with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
-    include Monad.PLUS2 with type ('x,'a) m := ('x,'a) m
-    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
-    val distribute : ('a -> ('x,'b) Wrapped.m) -> 'a list -> ('x,'b) m
-  end
- *)
 end = struct
   module Base = struct
-   type 'a m = 'a list
+   type ('x,'a) m = 'a list
+   type ('x,'a) result = 'a list
+   type ('x,'a) result_exn = 'a
    let unit a = [a]
    let bind u f = Util.concat_map f u
-   type 'a result = 'a list
    let run u = u
-   type 'a result_exn = 'a
    let run_exn u = match u with
      | [] -> failwith "no values"
      | [a] -> a
      | many -> failwith "multiple values"
    let zero () = []
+   (* satisfies Distrib *)
    let plus = Util.append
   end
   include Monad.Make(Base)
-  include (Monad.MakeDistrib(Base) : Monad.PLUS with type 'a m := 'a m)
   (* let either u v = plus u v *)
   (* insert 3 [1;2] ~~> [[3;1;2]; [1;3;2]; [1;2;3]] *)
   let rec insert a u =
@@ -497,43 +375,39 @@ end = struct
   let rec select u = match u with
     | [] -> zero ()
     | x::xs -> plus (unit (x, xs)) (select xs >>= fun (x', xs') -> unit (x', x :: xs'))
-  let base_plus = plus
   module T(Wrapped : Monad.S) = struct
-    module Trans = struct
+    (* Wrapped.sequence ms  ===  
+         let plus1 u v =
+           Wrapped.bind u (fun x ->
+           Wrapped.bind v (fun xs ->
+           Wrapped.unit (x :: xs)))
+         in Util.fold_right plus1 ms (Wrapped.unit []) *)
+    (* distribute  ===  Wrapped.mapM; copies alist to its image under f *)
+    let distribute f alist = Wrapped.sequence (Util.map f alist)
+
+    include Monad.MakeT(struct
+      module Wrapped = Wrapped
+      type ('x,'a) m = ('x,'a list) Wrapped.m
+      type ('x,'a) result = ('x,'a list) Wrapped.result
+      type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
+      let elevate w = Wrapped.bind w (fun a -> Wrapped.unit [a])
+      let bind u f =
+        Wrapped.bind u (fun ts ->
+        Wrapped.bind (distribute f ts) (fun tts ->
+        Wrapped.unit (Util.concat tts)))
+      let run u = Wrapped.run u
+      let run_exn u =
+        let w = Wrapped.bind u (fun ts -> match ts with
+          | [] -> Wrapped.zero ()
+          | [a] -> Wrapped.unit a
+          | many -> Wrapped.zero ()
+        ) in Wrapped.run_exn w
       let zero () = Wrapped.unit []
       let plus u v =
         Wrapped.bind u (fun us ->
         Wrapped.bind v (fun vs ->
-        Wrapped.unit (base_plus us vs)))
-      (* Wrapped.sequence ms  ===  
-           let plus1 u v =
-             Wrapped.bind u (fun x ->
-             Wrapped.bind v (fun xs ->
-             Wrapped.unit (x :: xs)))
-           in Util.fold_right plus1 ms (Wrapped.unit []) *)
-      (* distribute  ===  Wrapped.mapM; copies alist to its image under f *)
-      let distribute f alist = Wrapped.sequence (Util.map f alist)
-      include Monad.MakeT(struct
-        module Wrapped = Wrapped
-        type 'a m = 'a list Wrapped.m
-        type 'a result = 'a list Wrapped.result
-        type 'a result_exn = 'a Wrapped.result_exn
-        let elevate w = Wrapped.bind w (fun a -> Wrapped.unit [a])
-        let bind u f =
-          Wrapped.bind u (fun ts ->
-          Wrapped.bind (distribute f ts) (fun tts ->
-          Wrapped.unit (Util.concat tts)))
-        let run u = Wrapped.run u
-        let run_exn u =
-          let w = Wrapped.bind u (fun ts -> match ts with
-            | [] -> failwith "no values"
-            | [a] -> Wrapped.unit a
-            | many -> failwith "multiple values"
-          ) in Wrapped.run_exn w
-      end)
-    end
-    include Trans
-    include (Monad.MakeDistrib(Trans) : Monad.PLUS with type 'a m := 'a m)
+        Wrapped.unit (Base.plus us vs)))
+    end)
 (*
     let permute : 'a m -> 'a m m
     let select : 'a m -> ('a * 'a m) m
@@ -554,48 +428,40 @@ end) : sig
   (* declare additional operations, while still hiding implementation of type m *)
   type err = Err.err
   type 'a error = Error of err | Success of 'a
-  type 'a result = 'a
-  type 'a result_exn = 'a
-  include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-  (* include Monad.PLUS with type 'a m := 'a m *)
-  val throw : err -> 'a m
-  val catch : 'a m -> (err -> 'a m) -> 'a m
+  type ('x,'a) result = 'a error
+  type ('x,'a) result_exn = 'a
+  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+  val throw : err -> ('x,'a) m
+  val catch : ('x,'a) m -> (err -> ('x,'a) m) -> ('x,'a) m
   (* ErrorT transformer *)
   module T : functor (Wrapped : Monad.S) -> sig
-    type 'a result = 'a Wrapped.result
-    type 'a result_exn = 'a Wrapped.result_exn
-    include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-    val elevate : 'a Wrapped.m -> 'a m
-    val throw : err -> 'a m
-    val catch : 'a m -> (err -> 'a m) -> 'a m
+    type ('x,'a) result = ('x,'a) Wrapped.result
+    type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
+    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
+    val throw : err -> ('x,'a) m
+    val catch : ('x,'a) m -> (err -> ('x,'a) m) -> ('x,'a) m
   end
 end = struct
   type err = Err.err
   type 'a error = Error of err | Success of 'a
   module Base = struct
-    type 'a m = 'a error
+    type ('x,'a) m = 'a error
+    type ('x,'a) result = 'a error
+    type ('x,'a) result_exn = 'a
     let unit a = Success a
     let bind u f = match u with
       | Success a -> f a
       | Error e -> Error e (* input and output may be of different 'a types *)
-    type 'a result = 'a
-    (* TODO: should run refrain from failing? *)
-    let run u = match u with
+    let run u = u
+    let run_exn u = match u with
       | Success a -> a
       | Error e -> raise (Err.Exc e)
-    type 'a result_exn = 'a
-    let run_exn = run
-    (*
-    let zero () = Error Err.zero
-    let plus u v = match (u, v) with
-      | Success _, _ -> u
-      (* to satisfy (Catch) laws, plus u zero = u, even if u = Error _
-       * otherwise, plus (Error _) v = v *)
-      | Error _, _ when v = zero -> u
-      (* combine errors *)
-      | Error e1, Error e2 when u <> zero -> Error (Err.plus e1 e2)
-      | Error _, _ -> v
-    *)
+    let zero () = Util.undef
+    (* satisfies Catch *)
+    let plus u v = match u with
+      | Success _ -> u
+      | Error _ -> if v == Util.undef then u else v
   end
   include Monad.Make(Base)
   (* include (Monad.MakeCatch(Base) : Monad.PLUS with type 'a m := 'a m) *)
@@ -604,30 +470,28 @@ end = struct
     | Success _ -> u
     | Error e -> handler e
   module T(Wrapped : Monad.S) = struct
-    module Trans = struct
+    include Monad.MakeT(struct
       module Wrapped = Wrapped
-      type 'a m = 'a Base.m Wrapped.m
+      type ('x,'a) m = ('x,'a error) Wrapped.m
+      type ('x,'a) result = ('x,'a) Wrapped.result
+      type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
       let elevate w = Wrapped.bind w (fun a -> Wrapped.unit (Success a))
       let bind u f = Wrapped.bind u (fun t -> match t with
         | Success a -> f a
         | Error e -> Wrapped.unit (Error e))
-      type 'a result = 'a Wrapped.result
-      (* TODO: should run refrain from failing? *)
       let run u =
         let w = Wrapped.bind u (fun t -> match t with
           | Success a -> Wrapped.unit a
-          (* | _ -> Wrapped.fail () *)
-          | Error e -> raise (Err.Exc e))
-        in Wrapped.run w
-      type 'a result_exn = 'a Wrapped.result_exn
+          | Error e -> Wrapped.zero ()
+        ) in Wrapped.run w
       let run_exn u =
         let w = Wrapped.bind u (fun t -> match t with
           | Success a -> Wrapped.unit a
-          (* | _ -> Wrapped.fail () *)
           | Error e -> raise (Err.Exc e))
         in Wrapped.run_exn w
-    end
-    include Monad.MakeT(Trans)
+      let plus u v = Wrapped.plus u v
+      let zero () = Wrapped.zero () (* elevate (Wrapped.zero ()) *)
+    end)
     let throw e = Wrapped.unit (Error e)
     let catch u handler = Wrapped.bind u (fun t -> match t with
       | Success _ -> Wrapped.unit t
@@ -645,73 +509,65 @@ module Failure = Error_monad(struct
   *)
 end)
 
+
 (* must be parameterized on (struct type env = ... end) *)
 module Reader_monad(Env : sig type env end) : sig
   (* declare additional operations, while still hiding implementation of type m *)
   type env = Env.env
-  type 'a result = env -> 'a
-  type 'a result_exn = env -> 'a
-  include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-  val ask : env m
-  val asks : (env -> 'a) -> 'a m
-  val local : (env -> env) -> 'a m -> 'a m
+  type ('x,'a) result = env -> 'a
+  type ('x,'a) result_exn = env -> 'a
+  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+  val ask : ('x,env) m
+  val asks : (env -> 'a) -> ('x,'a) m
+  (* lookup i == `fun e -> e i` would assume env is a functional type *)
+  val local : (env -> env) -> ('x,'a) m -> ('x,'a) m
   (* ReaderT transformer *)
   module T : functor (Wrapped : Monad.S) -> sig
-    type 'a result = env -> 'a Wrapped.result
-    type 'a result_exn = env -> 'a Wrapped.result_exn
-    include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-    val elevate : 'a Wrapped.m -> 'a m
-    val ask : env m
-    val asks : (env -> 'a) -> 'a m
-    val local : (env -> env) -> 'a m -> 'a m
-  end
-  (* ReaderT transformer when wrapped monad has plus, zero *)
-  module TP : functor (Wrapped : Monad.P) -> sig
-    include module type of T(Wrapped)
-    include Monad.PLUS with type 'a m := 'a m
+    type ('x,'a) result = env -> ('x,'a) Wrapped.result
+    type ('x,'a) result_exn = env -> ('x,'a) Wrapped.result_exn
+    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
+    val ask : ('x,env) m
+    val asks : (env -> 'a) -> ('x,'a) m
+    val local : (env -> env) -> ('x,'a) m -> ('x,'a) m
   end
 end = struct
   type env = Env.env
   module Base = struct
-    type 'a m = env -> 'a
+    type ('x,'a) m = env -> 'a
+    type ('x,'a) result = env -> 'a
+    type ('x,'a) result_exn = env -> 'a
     let unit a = fun e -> a
     let bind u f = fun e -> let a = u e in let u' = f a in u' e
-    type 'a result = env -> 'a
     let run u = fun e -> u e
-    type 'a result_exn = env -> 'a
     let run_exn = run
+    let zero () = Util.undef
+    let plus u v = u
   end
   include Monad.Make(Base)
   let ask = fun e -> e
   let asks selector = ask >>= (fun e -> unit (selector e)) (* may fail *)
   let local modifier u = fun e -> u (modifier e)
   module T(Wrapped : Monad.S) = struct
-    module Trans = struct
+    module BaseT = struct
       module Wrapped = Wrapped
-      type 'a m = env -> 'a Wrapped.m
+      type ('x,'a) m = env -> ('x,'a) Wrapped.m
+      type ('x,'a) result = env -> ('x,'a) Wrapped.result
+      type ('x,'a) result_exn = env -> ('x,'a) Wrapped.result_exn
       let elevate w = fun e -> w
-      let bind u f = fun e -> Wrapped.bind (u e) (fun v -> f v e)
-      type 'a result = env -> 'a Wrapped.result
+      let bind u f = fun e -> Wrapped.bind (u e) (fun a -> f a e)
       let run u = fun e -> Wrapped.run (u e)
-      type 'a result_exn = env -> 'a Wrapped.result_exn
       let run_exn u = fun e -> Wrapped.run_exn (u e)
+      (* satisfies Distrib *)
+      let plus u v = fun e -> Wrapped.plus (u e) (v e)
+      let zero () = fun e -> Wrapped.zero () (* elevate (Wrapped.zero ()) *)
     end
-    include Monad.MakeT(Trans)
-    let ask = fun e -> Wrapped.unit e
-    let asks selector = ask >>= (fun e -> unit (selector e)) (* may fail *)
+    include Monad.MakeT(BaseT)
+    let ask = Wrapped.unit
     let local modifier u = fun e -> u (modifier e)
-  end
-  module TP(Wrapped : Monad.P) = struct
-    module TransP = struct
-      include T(Wrapped)
-      let plus u v = fun s -> Wrapped.plus (u s) (v s)
-      let zero () = elevate (Wrapped.zero ())
-      let asks selector = ask >>= (fun e ->
-        try unit (selector e)
-        with Not_found -> fun e -> Wrapped.zero ())
-    end
-    include TransP
-    include (Monad.MakeDistrib(TransP) : Monad.PLUS with type 'a m := 'a m)
+    let asks selector = ask >>= (fun e ->
+      try unit (selector e)
+      with Not_found -> fun e -> Wrapped.zero ())
   end
 end
 
@@ -720,39 +576,36 @@ end
 module State_monad(Store : sig type store end) : sig
   (* declare additional operations, while still hiding implementation of type m *)
   type store = Store.store
-  type 'a result = store -> 'a * store
-  type 'a result_exn = store -> 'a
-  include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-  val get : store m
-  val gets : (store -> 'a) -> 'a m
-  val put : store -> unit m
-  val puts : (store -> store) -> unit m
+  type ('x,'a) result =  store -> 'a * store
+  type ('x,'a) result_exn = store -> 'a
+  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+  val get : ('x,store) m
+  val gets : (store -> 'a) -> ('x,'a) m
+  val put : store -> ('x,unit) m
+  val puts : (store -> store) -> ('x,unit) m
   (* StateT transformer *)
   module T : functor (Wrapped : Monad.S) -> sig
-    type 'a result = store -> ('a * store) Wrapped.result
-    type 'a result_exn = store -> 'a Wrapped.result_exn
-    include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-    val elevate : 'a Wrapped.m -> 'a m
-    val get : store m
-    val gets : (store -> 'a) -> 'a m
-    val put : store -> unit m
-    val puts : (store -> store) -> unit m
-  end
-  (* StateT transformer when wrapped monad has plus, zero *)
-  module TP : functor (Wrapped : Monad.P) -> sig
-    include module type of T(Wrapped)
-    include Monad.PLUS with type 'a m := 'a m
+    type ('x,'a) result = store -> ('x,'a * store) Wrapped.result
+    type ('x,'a) result_exn = store -> ('x,'a) Wrapped.result_exn
+    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
+    val get : ('x,store) m
+    val gets : (store -> 'a) -> ('x,'a) m
+    val put : store -> ('x,unit) m
+    val puts : (store -> store) -> ('x,unit) m
   end
 end = struct
   type store = Store.store
   module Base = struct
-    type 'a m = store -> 'a * store
+    type ('x,'a) m =  store -> 'a * store
+    type ('x,'a) result =  store -> 'a * store
+    type ('x,'a) result_exn = store -> 'a
     let unit a = fun s -> (a, s)
     let bind u f = fun s -> let (a, s') = u s in let u' = f a in u' s'
-    type 'a result = store -> 'a * store
     let run u = fun s -> (u s)
-    type 'a result_exn = store -> 'a
     let run_exn u = fun s -> fst (u s)
+    let zero () = Util.undef
+    let plus u v = u
   end
   include Monad.Make(Base)
   let get = fun s -> (s, s)
@@ -760,66 +613,55 @@ end = struct
   let put s = fun _ -> ((), s)
   let puts modifier = fun s -> ((), modifier s)
   module T(Wrapped : Monad.S) = struct
-    module Trans = struct
+    module BaseT = struct
       module Wrapped = Wrapped
-      type 'a m = store -> ('a * store) Wrapped.m
+      type ('x,'a) m = store -> ('x,'a * store) Wrapped.m
+      type ('x,'a) result = store -> ('x,'a * store) Wrapped.result
+      type ('x,'a) result_exn = store -> ('x,'a) Wrapped.result_exn
       let elevate w = fun s ->
         Wrapped.bind w (fun a -> Wrapped.unit (a, s))
       let bind u f = fun s ->
         Wrapped.bind (u s) (fun (a, s') -> f a s')
-      type 'a result = store -> ('a * store) Wrapped.result
       let run u = fun s -> Wrapped.run (u s)
-      type 'a result_exn = store -> 'a Wrapped.result_exn
       let run_exn u = fun s ->
         let w = Wrapped.bind (u s) (fun (a,s) -> Wrapped.unit a)
         in Wrapped.run_exn w
-    end
-    include Monad.MakeT(Trans)
-    let get = fun s -> Wrapped.unit (s, s)
-    let gets viewer = fun s -> Wrapped.unit (viewer s, s) (* may fail *)
-    let put s = fun _ -> Wrapped.unit ((), s)
-    let puts modifier = fun s -> Wrapped.unit ((), modifier s)
-  end
-  module TP(Wrapped : Monad.P) = struct
-    module TransP = struct
-      include T(Wrapped)
+      (* satisfies Distrib *)
       let plus u v = fun s -> Wrapped.plus (u s) (v s)
-      let zero () = elevate (Wrapped.zero ())
+      let zero () = fun s -> Wrapped.zero () (* elevate (Wrapped.zero ()) *)
     end
+    include Monad.MakeT(BaseT)
+    let get = fun s -> Wrapped.unit (s, s)
     let gets viewer = fun s ->
       try Wrapped.unit (viewer s, s)
       with Not_found -> Wrapped.zero ()
-    include TransP
-    include (Monad.MakeDistrib(TransP) : Monad.PLUS with type 'a m := 'a m)
+    let put s = fun _ -> Wrapped.unit ((), s)
+    let puts modifier = fun s -> Wrapped.unit ((), modifier s)
   end
 end
 
+
 (* State monad with different interface (structured store) *)
 module Ref_monad(V : sig
   type value
 end) : sig
   type ref
   type value = V.value
-  type 'a result = 'a
-  type 'a result_exn = 'a
-  include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-  val newref : value -> ref m
-  val deref : ref -> value m
-  val change : ref -> value -> unit m
+  type ('x,'a) result = 'a
+  type ('x,'a) result_exn = 'a
+  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+  val newref : value -> ('x,ref) m
+  val deref : ref -> ('x,value) m
+  val change : ref -> value -> ('x,unit) m
   (* RefT transformer *)
   module T : functor (Wrapped : Monad.S) -> sig
-    type 'a result = 'a Wrapped.result
-    type 'a result_exn = 'a Wrapped.result_exn
-    include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-    val elevate : 'a Wrapped.m -> 'a m
-    val newref : value -> ref m
-    val deref : ref -> value m
-    val change : ref -> value -> unit m
-  end
-  (* RefT transformer when wrapped monad has plus, zero *)
-  module TP : functor (Wrapped : Monad.P) -> sig
-    include module type of T(Wrapped)
-    include Monad.PLUS with type 'a m := 'a m
+    type ('x,'a) result = ('x,'a) Wrapped.result
+    type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
+    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
+    val newref : value -> ('x,ref) m
+    val deref : ref -> ('x,value) m
+    val change : ref -> value -> ('x,unit) m
   end
 end = struct
   type ref = int
@@ -834,49 +676,45 @@ end = struct
   let write (key : ref) (value : value) (d : dict) =
     { next = d.next; tree = D.add key value d.tree }
   module Base = struct
-    type 'a m = dict -> 'a * dict
+    type ('x,'a) m = dict -> 'a * dict
+    type ('x,'a) result = 'a
+    type ('x,'a) result_exn = 'a
     let unit a = fun s -> (a, s)
     let bind u f = fun s -> let (a, s') = u s in let u' = f a in u' s'
-    type 'a result = 'a
     let run u = fst (u empty)
-    type 'a result_exn = 'a
     let run_exn = run
+    let zero () = Util.undef
+    let plus u v = u
   end
   include Monad.Make(Base)
   let newref value = fun s -> alloc value s
   let deref key = fun s -> (read key s, s) (* shouldn't fail because key will have an abstract type, and we never garbage collect *)
   let change key value = fun s -> ((), write key value s) (* shouldn't allocate because key will have an abstract type *)
   module T(Wrapped : Monad.S) = struct
-    module Trans = struct
+    module BaseT = struct
       module Wrapped = Wrapped
-      type 'a m = dict -> ('a * dict) Wrapped.m
+      type ('x,'a) m = dict -> ('x,'a * dict) Wrapped.m
+      type ('x,'a) result = ('x,'a) Wrapped.result
+      type ('x,'a) result_exn = ('x,'a) Wrapped.result_exn
       let elevate w = fun s ->
         Wrapped.bind w (fun a -> Wrapped.unit (a, s))
       let bind u f = fun s ->
         Wrapped.bind (u s) (fun (a, s') -> f a s')
-      type 'a result = 'a Wrapped.result
       let run u =
         let w = Wrapped.bind (u empty) (fun (a,s) -> Wrapped.unit a)
         in Wrapped.run w
-      type 'a result_exn = 'a Wrapped.result_exn
       let run_exn u =
         let w = Wrapped.bind (u empty) (fun (a,s) -> Wrapped.unit a)
         in Wrapped.run_exn w
+      (* satisfies Distrib *)
+      let plus u v = fun s -> Wrapped.plus (u s) (v s)
+      let zero () = fun s -> Wrapped.zero () (* elevate (Wrapped.zero ()) *)
     end
-    include Monad.MakeT(Trans)
+    include Monad.MakeT(BaseT)
     let newref value = fun s -> Wrapped.unit (alloc value s)
     let deref key = fun s -> Wrapped.unit (read key s, s)
     let change key value = fun s -> Wrapped.unit ((), write key value s)
   end
-  module TP(Wrapped : Monad.P) = struct
-    module TransP = struct
-      include T(Wrapped)
-      let plus u v = fun s -> Wrapped.plus (u s) (v s)
-      let zero () = elevate (Wrapped.zero ())
-    end
-    include TransP
-    include (Monad.MakeDistrib(TransP) : Monad.PLUS with type 'a m := 'a m)
-  end
 end
 
 
@@ -888,24 +726,37 @@ module Writer_monad(Log : sig
 end) : sig
   (* declare additional operations, while still hiding implementation of type m *)
   type log = Log.log
-  type 'a result = 'a * log
-  type 'a result_exn = 'a * log
-  include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-  val tell : log -> unit m
-  val listen : 'a m -> ('a * log) m
-  val listens : (log -> 'b) -> 'a m -> ('a * 'b) m
-  (* val pass : ('a * (log -> log)) m -> 'a m *)
-  val censor : (log -> log) -> 'a m -> 'a m
+  type ('x,'a) result = 'a * log
+  type ('x,'a) result_exn = 'a * log
+  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+  val tell : log -> ('x,unit) m
+  val listen : ('x,'a) m -> ('x,'a * log) m
+  val listens : (log -> 'b) -> ('x,'a) m -> ('x,'a * 'b) m
+  (* val pass : ('x,'a * (log -> log)) m -> ('x,'a) m *)
+  val censor : (log -> log) -> ('x,'a) m -> ('x,'a) m
+  (* WriterT transformer *)
+  module T : functor (Wrapped : Monad.S) -> sig
+    type ('x,'a) result = ('x,'a * log) Wrapped.result
+    type ('x,'a) result_exn = ('x,'a * log) Wrapped.result_exn
+    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
+    val tell : log -> ('x,unit) m
+    val listen : ('x,'a) m -> ('x,'a * log) m
+    val listens : (log -> 'b) -> ('x,'a) m -> ('x,'a * 'b) m
+    val censor : (log -> log) -> ('x,'a) m -> ('x,'a) m
+  end
 end = struct
   type log = Log.log
   module Base = struct
-    type 'a m = 'a * log
+    type ('x,'a) m = 'a * log
+    type ('x,'a) result = 'a * log
+    type ('x,'a) result_exn = 'a * log
     let unit a = (a, Log.zero)
-    let bind (a, w) f = let (a', w') = f a in (a', Log.plus w w')
-    type 'a result = 'a * log
+    let bind (a, w) f = let (b, w') = f a in (b, Log.plus w w')
     let run u = u
-    type 'a result_exn = 'a * log
     let run_exn = run
+    let zero () = Util.undef
+    let plus u v = u
   end
   include Monad.Make(Base)
   let tell entries = ((), entries) (* add entries to log *)
@@ -913,6 +764,31 @@ end = struct
   let listens selector u = listen u >>= fun (a, w) -> unit (a, selector w) (* filter listen through selector *)
   let pass ((a, f), w) = (a, f w) (* usually use censor helper *)
   let censor f u = pass (u >>= fun a -> unit (a, f))
+  module T(Wrapped : Monad.S) = struct
+    module BaseT = struct
+      module Wrapped = Wrapped
+      type ('x,'a) m = ('x,'a * log) Wrapped.m
+      type ('x,'a) result = ('x,'a * log) Wrapped.result
+      type ('x,'a) result_exn = ('x,'a * log) Wrapped.result_exn
+      let elevate w =
+        Wrapped.bind w (fun a -> Wrapped.unit (a, Log.zero))
+      let bind u f =
+        Wrapped.bind u (fun (a, w) ->
+        Wrapped.bind (f a) (fun (b, w') ->
+        Wrapped.unit (b, Log.plus w w')))
+      let zero () = elevate (Wrapped.zero ())
+      let plus u v = Wrapped.plus u v
+      let run u = Wrapped.run u
+      let run_exn u = Wrapped.run_exn u
+    end
+    include Monad.MakeT(BaseT)
+    let tell entries = Wrapped.unit ((), entries)
+    let listen u = Wrapped.bind u (fun (a, w) -> Wrapped.unit ((a, w), w))
+    let pass u = Wrapped.bind u (fun ((a, f), w) -> Wrapped.unit (a, f w))
+    (* rest are derived in same way as before *)
+    let listens selector u = listen u >>= fun (a, w) -> unit (a, selector w)
+    let censor f u = pass (u >>= fun a -> unit (a, f))
+  end
 end
 
 (* pre-define simple Writer *)
@@ -936,27 +812,30 @@ module Writer2 = struct
 end
 
 
+(* TODO needs a T *)
 module IO_monad : sig
   (* declare additional operation, while still hiding implementation of type m *)
-  type 'a result = 'a
-  type 'a result_exn = 'a
-  include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-  val printf : ('a, unit, string, unit m) format4 -> 'a
-  val print_string : string -> unit m
-  val print_int : int -> unit m
-  val print_hex : int -> unit m
-  val print_bool : bool -> unit m
+  type ('x,'a) result = 'a
+  type ('x,'a) result_exn = 'a
+  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+  val printf : ('a, unit, string, ('x,unit) m) format4 -> 'a
+  val print_string : string -> ('x,unit) m
+  val print_int : int -> ('x,unit) m
+  val print_hex : int -> ('x,unit) m
+  val print_bool : bool -> ('x,unit) m
 end = struct
   module Base = struct
-    type 'a m = { run : unit -> unit; value : 'a }
+    type ('x,'a) m = { run : unit -> unit; value : 'a }
+    type ('x,'a) result = 'a
+    type ('x,'a) result_exn = 'a
     let unit a = { run = (fun () -> ()); value = a }
-    let bind (a : 'a m) (f: 'a -> 'b m) : 'b m =
+    let bind (a : ('x,'a) m) (f: 'a -> ('x,'b) m) : ('x,'b) m =
      let fres = f a.value in
        { run = (fun () -> a.run (); fres.run ()); value = fres.value }
-    type 'a result = 'a
     let run a = let () = a.run () in a.value
-    type 'a result_exn = 'a
     let run_exn = run
+    let zero () = Util.undef
+    let plus u v = u
   end
   include Monad.Make(Base)
   let printf fmt =
@@ -967,108 +846,86 @@ end = struct
   let print_bool b = { Base.run = (fun () -> Printf.printf "%B\n" b); value = () }
 end
 
-module Continuation_monad : sig
-  (* expose only the implementation of type `('r,'a) result` *)
-  type 'a m
-  type 'a result = 'a m
-  type 'a result_exn = 'a m
-  include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn and type 'a m := 'a m
-  (* val callcc : (('a -> ('r,'b) m) -> ('r,'a) m) -> ('r,'a) m *)
-  (* misses that the answer types of all the cont's must be the same *)
-  val callcc : (('a -> 'b m) -> 'a m) -> 'a m
-  (* val reset : ('a,'a) m -> ('r,'a) m *)
-  val reset : 'a m -> 'a m
-  (* val shift : (('a -> ('q,'r) m) -> ('r,'r) m) -> ('r,'a) m *)
-  (* misses that the answer types of second and third continuations must be b *)
-  val shift : (('a -> 'b m) -> 'b m) -> 'a m
-  (* overwrite the run declaration in S, because I can't declare 'a result =
-   * this polymorphic type (complains that 'r is unbound *)
-  val runk : 'a m -> ('a -> 'r) -> 'r
-  val run0 : 'a m -> 'a
-end = struct
-  let id = fun i -> i
-  module Base = struct
-    (* 'r is result type of whole computation *)
-    type 'a m = { cont : 'r. ('a -> 'r) -> 'r }
-    let unit a =
-      let cont : 'r. ('a -> 'r) -> 'r =
-        fun k -> k a
-      in { cont }
-    let bind u f =
-      let cont : 'r. ('a -> 'r) -> 'r =
-        fun k -> u.cont (fun a -> (f a).cont k)
-      in { cont }
-    type 'a result = 'a m
-    let run (u : 'a m) : 'a result = u
-    type 'a result_exn = 'a m
-    let run_exn (u : 'a m) : 'a result_exn = u
-    let callcc f =
-      let cont : 'r. ('a -> 'r) -> 'r =
-          (* Can't figure out how to make the type polymorphic enough
-           * to satisfy the OCaml type-checker (it's ('a -> 'r) -> 'r
-           * instead of 'r. ('a -> 'r) -> 'r); so we have to fudge
-           * with Obj.magic... which tells OCaml's type checker to
-           * relax, the supplied value has whatever type the context
-           * needs it to have. *)
-          fun k ->
-          let usek a = { cont = Obj.magic (fun _ -> k a) }
-          in (f usek).cont k
-      in { cont }
-    let reset u = unit (u.cont id)
-    let shift (f : ('a -> 'b m) -> 'b m) : 'a m =
-      let cont = fun k ->
-        (f (fun a -> unit (k a))).cont id
-      in { cont = Obj.magic cont }
-    let runk u k = (u.cont : ('a -> 'r) -> 'r) k
-    let run0 u = runk u id
-  end
-  include Monad.Make(Base)
-  let callcc = Base.callcc
-  let reset = Base.reset
-  let shift = Base.shift
-  let runk = Base.runk
-  let run0 = Base.run0
-end
-
-(*
-(* This two-type parameter version works without Obj.magic *)
 
-module Continuation_monad2 : sig
+module Continuation_monad : sig
   (* expose only the implementation of type `('r,'a) result` *)
-  type ('r,'a) result = ('a -> 'r) -> 'r
+  type ('r,'a) m
+  type ('r,'a) result = ('r,'a) m
   type ('r,'a) result_exn = ('a -> 'r) -> 'r
-  include Monad.S2 with type ('r,'a) result := ('r,'a) result and type ('r,'a) result_exn := ('r,'a) result_exn
+  include Monad.S with type ('r,'a) result := ('r,'a) result and type ('r,'a) result_exn := ('r,'a) result_exn and type ('r,'a) m := ('r,'a) m
   val callcc : (('a -> ('r,'b) m) -> ('r,'a) m) -> ('r,'a) m
   val reset : ('a,'a) m -> ('r,'a) m
   val shift : (('a -> ('q,'r) m) -> ('r,'r) m) -> ('r,'a) m
-
+  (* val abort : ('a,'a) m -> ('a,'b) m *)
+  val abort : 'a -> ('a,'b) m
+  val run0 : ('a,'a) m -> 'a
+  (* ContinuationT transformer *)
+  module T : functor (Wrapped : Monad.S) -> sig
+    type ('r,'a) m
+    type ('r,'a) result = ('a -> ('r,'r) Wrapped.m) -> ('r,'r) Wrapped.result
+    type ('r,'a) result_exn = ('a -> ('r,'r) Wrapped.m) -> ('r,'r) Wrapped.result_exn
+    include Monad.S with type ('r,'a) result := ('r,'a) result and type ('r,'a) result_exn := ('r,'a) result_exn and type ('r,'a) m := ('r,'a) m
+    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
+    val callcc : (('a -> ('r,'b) m) -> ('r,'a) m) -> ('r,'a) m
+    (* TODO: reset,shift,abort,run0 *)
+  end
 end = struct
   let id = fun i -> i
   module Base = struct
     (* 'r is result type of whole computation *)
     type ('r,'a) m = ('a -> 'r) -> 'r
-    let unit a = fun k -> k a
-    let bind u f = fun k -> u (fun a -> (f a) k)
     type ('r,'a) result = ('a -> 'r) -> 'r
-    let run u = u
-    type ('r,'a) result_exn = ('a -> 'r) -> 'r
+    type ('r,'a) result_exn = ('r,'a) result
+    let unit a = (fun k -> k a)
+    let bind u f = (fun k -> (u) (fun a -> (f a) k))
+    let run u k = (u) k
     let run_exn = run
+    let zero () = Util.undef
+    let plus u v = u
   end
-  include Monad.Make2(Base)
-  let callcc f = fun k ->
-    let usek a = fun _ -> k a
-    in f usek k
+  include Monad.Make(Base)
+  let callcc f = (fun k ->
+    let usek a = (fun _ -> k a)
+    in (f usek) k)
   (*
   val callcc : (('a -> 'r) -> ('r,'a) m) -> ('r,'a) m
   val throw : ('a -> 'r) -> 'a -> ('r,'b) m
   let callcc f = fun k -> f k k
   let throw k a = fun _ -> k a
   *)
-  (* from http://www.haskell.org/haskellwiki/MonadCont_done_right *)
-  let reset u = unit (u id)
-  let shift u = fun k -> u (fun a -> unit (k a)) id
+
+  (* from http://www.haskell.org/haskellwiki/MonadCont_done_right
+   *
+   *  reset :: (Monad m) => ContT a m a -> ContT r m a
+   *  reset e = ContT $ \k -> runContT e return >>= k
+   *
+   *  shift :: (Monad m) => ((a -> ContT r m b) -> ContT b m b) -> ContT b m a
+   *  shift e = ContT $ \k ->
+   *              runContT (e $ \v -> ContT $ \c -> k v >>= c) return *)
+  let reset u = unit ((u) id)
+  let shift f = (fun k -> (f (fun a -> unit (k a))) id)
+  (* let abort a = shift (fun _ -> a) *)
+  let abort a = shift (fun _ -> unit a)
+  let run0 (u : ('a,'a) m) = (u) id
+  module T(Wrapped : Monad.S) = struct
+    module BaseT = struct
+      module Wrapped = Wrapped
+      type ('r,'a) m = ('a -> ('r,'r) Wrapped.m) -> ('r,'r) Wrapped.m
+      type ('r,'a) result = ('a -> ('r,'r) Wrapped.m) -> ('r,'r) Wrapped.result
+      type ('r,'a) result_exn = ('a -> ('r,'r) Wrapped.m) -> ('r,'r) Wrapped.result_exn
+      let elevate w = fun k -> Wrapped.bind w k
+      let bind u f = fun k -> u (fun a -> f a k)
+      let run u k = Wrapped.run (u k)
+      let run_exn u k = Wrapped.run_exn (u k)
+      let zero () = Util.undef
+      let plus u v = u
+    end
+    include Monad.MakeT(BaseT)
+    let callcc f = (fun k ->
+      let usek a = (fun _ -> k a)
+      in (f usek) k)
+  end
 end
- *)
 
 
 (*
@@ -1092,63 +949,25 @@ end
  *   >>= fun x -> unit (x, 0)
  *   in run u)
  *
- *
- * (* (+ 1000 (prompt (+ 100 (shift k (+ 10 1))))) ~~> 1011 *)
- * let example1 () : int =
- *   Continuation_monad.(let v = reset (
- *       let u = shift (fun k -> unit (10 + 1))
- *       in u >>= fun x -> unit (100 + x)
- *     ) in let w = v >>= fun x -> unit (1000 + x)
- *     in run w)
- *
- * (* (+ 1000 (prompt (+ 100 (shift k (k (+ 10 1)))))) ~~> 1111 *)
- * let example2 () =
- *   Continuation_monad.(let v = reset (
- *       let u = shift (fun k -> k (10 :: [1]))
- *       in u >>= fun x -> unit (100 :: x)
- *     ) in let w = v >>= fun x -> unit (1000 :: x)
- *     in run w)
- *
- * (* (+ 1000 (prompt (+ 100 (shift k (+ 10 (k 1)))))) ~~> 1111 but added differently *)
- * let example3 () =
- *   Continuation_monad.(let v = reset (
- *       let u = shift (fun k -> k [1] >>= fun x -> unit (10 :: x))
- *       in u >>= fun x -> unit (100 :: x)
- *     ) in let w = v >>= fun x -> unit (1000 :: x)
- *     in run w)
- *
- * (* (+ 100 ((prompt (+ 10 (shift k k))) 1)) ~~> 111 *)
- * (* not sure if this example can be typed without a sum-type *)
- *
- * (* (+ 100 (prompt (+ 10 (shift k (k (k 1)))))) ~~> 121 *)
- * let example5 () : int =
- *   Continuation_monad.(let v = reset (
- *       let u = shift (fun k -> k 1 >>= fun x -> k x)
- *       in u >>= fun x -> unit (10 + x)
- *     ) in let w = v >>= fun x -> unit (100 + x)
- *     in run w)
- *
  *)
 
 
-module Leaf_monad : sig
+module Tree_monad : sig
   (* We implement the type as `'a tree option` because it has a natural`plus`,
    * and the rest of the library expects that `plus` and `zero` will come together. *)
   type 'a tree = Leaf of 'a | Node of ('a tree * 'a tree)
-  type 'a result = 'a tree option
-  type 'a result_exn = 'a tree
-  include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-  include Monad.PLUS with type 'a m := 'a m
-  (* LeafT transformer *)
+  type ('x,'a) result = 'a tree option
+  type ('x,'a) result_exn = 'a tree
+  include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+  (* TreeT transformer *)
   module T : functor (Wrapped : Monad.S) -> sig
-    type 'a result = 'a tree option Wrapped.result
-    type 'a result_exn = 'a tree Wrapped.result_exn
-    include Monad.S with type 'a result := 'a result and type 'a result_exn := 'a result_exn
-    include Monad.PLUS with type 'a m := 'a m
-    val elevate : 'a Wrapped.m -> 'a m
+    type ('x,'a) result = ('x,'a tree option) Wrapped.result
+    type ('x,'a) result_exn = ('x,'a tree) Wrapped.result_exn
+    include Monad.S with type ('x,'a) result := ('x,'a) result and type ('x,'a) result_exn := ('x,'a) result_exn
+    val elevate : ('x,'a) Wrapped.m -> ('x,'a) m
     (* note that second argument is an 'a tree?, not the more abstract 'a m *)
     (* type is ('a -> 'b W) -> 'a tree? -> 'b tree? W == 'b treeT(W) *)
-    val distribute : ('a -> 'b Wrapped.m) -> 'a tree option -> 'b m
+    val distribute : ('a -> ('x,'b) Wrapped.m) -> 'a tree option -> ('x,'b) m
   end
 end = struct
   type 'a tree = Leaf of 'a | Node of ('a tree * 'a tree)
@@ -1162,17 +981,18 @@ end = struct
                          plus (loop l) (loop r)
                    ) in loop ts
   module Base = struct
-    type 'a m = 'a tree option
+    type ('x,'a) m = 'a tree option
+    type ('x,'a) result = 'a tree option
+    type ('x,'a) result_exn = 'a tree
     let unit a = Some (Leaf a)
     let zero () = None
+    (* satisfies Distrib *)
     let plus u v = match (u, v) with
       | None, _ -> v
       | _, None -> u
       | Some us, Some vs -> Some (Node (us, vs))
     let bind u f = mapT f u zero plus
-    type 'a result = 'a tree option
     let run u = u
-    type 'a result_exn = 'a tree
     let run_exn u = match u with
       | None -> failwith "no values"
       (*
@@ -1182,220 +1002,31 @@ end = struct
       | Some us -> us
   end
   include Monad.Make(Base)
-  include (Monad.MakeDistrib(Base) : Monad.PLUS with type 'a m := 'a m)
-  let base_plus = plus
-  let base_lift = lift
   module T(Wrapped : Monad.S) = struct
-    module Trans = struct
-      let zero () = Wrapped.unit None
-      let plus u v =
-        Wrapped.bind u (fun us ->
-        Wrapped.bind v (fun vs ->
-        Wrapped.unit (base_plus us vs)))
+    module BaseT = struct
       include Monad.MakeT(struct
         module Wrapped = Wrapped
-        type 'a m = 'a Base.m Wrapped.m
+        type ('x,'a) m = ('x,'a tree option) Wrapped.m
+        type ('x,'a) result = ('x,'a tree option) Wrapped.result
+        type ('x,'a) result_exn = ('x,'a tree) Wrapped.result_exn
+        let zero () = Wrapped.unit None
+        let plus u v =
+          Wrapped.bind u (fun us ->
+          Wrapped.bind v (fun vs ->
+          Wrapped.unit (Base.plus us vs)))
         let elevate w = Wrapped.bind w (fun a -> Wrapped.unit (Some (Leaf a)))
         let bind u f = Wrapped.bind u (fun t -> mapT f t zero plus)
-        type 'a result = 'a tree option Wrapped.result
         let run u = Wrapped.run u
-        type 'a result_exn = 'a tree Wrapped.result_exn
         let run_exn u =
             let w = Wrapped.bind u (fun t -> match t with
-              | None -> failwith "no values"
-              | Some ts -> Wrapped.unit ts)
-            in Wrapped.run_exn w
+              | None -> Wrapped.zero ()
+              | Some ts -> Wrapped.unit ts
+            ) in Wrapped.run_exn w
       end)
     end
-    include Trans
-    include (Monad.MakeDistrib(Trans) : Monad.PLUS with type 'a m := 'a m)
-    (* let distribute f t = mapT (fun a -> a) (base_lift (fun a -> elevate (f a)) t) zero plus *)
+    include BaseT
     let distribute f t = mapT (fun a -> elevate (f a)) t zero plus
   end
-end
-
-
-module L = List_monad;;
-module R = Reader_monad(struct type env = int -> int end);;
-module S = State_monad(struct type store = int end);;
-module T = Leaf_monad;;
-module LR = L.T(R);;
-module LS = L.T(S);;
-module TL = T.T(L);;
-module TR = T.T(R);;
-module TS = T.T(S);;
-
-let t1 = Some (T.Node (T.Node (T.Leaf 2, T.Leaf 3), T.Node (T.Leaf 5, T.Node (T.Leaf 7, T.Leaf 11))));;
-
-(*
-let ts = TS.distribute (fun i -> S.(puts succ >> unit i)) t1;;
-TS.run ts 0;;
-(*
-- : int T.tree option * S.store =
-(Some
-  (T.Node
-    (T.Node (T.Leaf 2, T.Leaf 3),
-     T.Node (T.Leaf 5, T.Node (T.Leaf 7, T.Leaf 11)))),
- 5)
-*)
-
-let ts2 = TS.distribute (fun i -> S.(puts succ >> get >>= fun n -> unit (i,n))) t1;;
-TS.run_exn ts2 0;;
-(*
-- : (int * S.store) T.tree option * S.store =
-(Some
-  (T.Node
-    (T.Node (T.Leaf (2, 1), T.Leaf (3, 2)),
-     T.Node (T.Leaf (5, 3), T.Node (T.Leaf (7, 4), T.Leaf (11, 5))))),
- 5)
-*)
-
-let tr = TR.distribute (fun i -> R.asks (fun e -> e i)) t1;;
-TR.run_exn tr (fun i -> i+i);;
-(*
-- : int T.tree option =
-Some
- (T.Node
-   (T.Node (T.Leaf 4, T.Leaf 6),
-    T.Node (T.Leaf 10, T.Node (T.Leaf 14, T.Leaf 22))))
-*)
-
-let tl = TL.distribute (fun i -> L.(unit (i,i+1))) t1;;
-TL.run_exn tl;;
-(*
-- : (int * int) TL.result =
-[Some
-  (T.Node
-    (T.Node (T.Leaf (2, 3), T.Leaf (3, 4)),
-     T.Node (T.Leaf (5, 6), T.Node (T.Leaf (7, 8), T.Leaf (11, 12)))))]
-*)
-
-let l2 = [1;2;3;4;5];;
-let t2 = Some (T.Node (T.Leaf 1, (T.Node (T.Node (T.Node (T.Leaf 2, T.Leaf 3), T.Leaf 4), T.Leaf 5))));;
-
-LR.(run (distribute (fun i -> R.(asks (fun e -> e i))) l2 >>= fun j -> LR.(plus (unit j) (unit (succ j))))) (fun i -> i*10);;
-(* int list = [10; 11; 20; 21; 30; 31; 40; 41; 50; 51] *)
-
-TR.(run_exn (distribute (fun i -> R.(asks (fun e -> e i))) t2 >>= fun j -> TR.(plus (unit j) (unit (succ j))))) (fun i -> i*10);;
-(*
-int T.tree option =
-Some
- (T.Node
-   (T.Node (T.Leaf 10, T.Leaf 11),
-    T.Node
-     (T.Node
-       (T.Node (T.Node (T.Leaf 20, T.Leaf 21), T.Node (T.Leaf 30, T.Leaf 31)),
-        T.Node (T.Leaf 40, T.Leaf 41)),
-      T.Node (T.Leaf 50, T.Leaf 51))))
- *)
-
-LS.run (LS.distribute (fun i -> if i = -1 then S.get else if i < 0 then S.(puts succ >> unit 0) else S.unit i) [10;-1;-2;-1;20]) 0;;
-(*
-- : S.store list * S.store = ([10; 0; 0; 1; 20], 1)
-*)
-
-*)
-
-let id : 'z. 'z -> 'z = fun x -> x
-
-let example n : (int * int) =
-  Continuation_monad.(let u = callcc (fun k ->
-      (if n < 0 then k 0 else unit [n + 100])
-      (* all of the following is skipped by k 0; the end type int is k's input type *)
-      >>= fun [x] -> unit (x + 1)
-  )
-  (* k 0 starts again here, outside the callcc (...); the end type int * int is k's output type *)
-  >>= fun x -> unit (x, 0)
-  in run0 u)
-
-
-(* (+ 1000 (prompt (+ 100 (shift k (+ 10 1))))) ~~> 1011 *)
-let example1 () : int =
-  Continuation_monad.(let v = reset (
-      let u = shift (fun k -> unit (10 + 1))
-      in u >>= fun x -> unit (100 + x)
-    ) in let w = v >>= fun x -> unit (1000 + x)
-    in run0 w)
-
-(* (+ 1000 (prompt (+ 100 (shift k (k (+ 10 1)))))) ~~> 1111 *)
-let example2 () =
-  Continuation_monad.(let v = reset (
-      let u = shift (fun k -> k (10 :: [1]))
-      in u >>= fun x -> unit (100 :: x)
-    ) in let w = v >>= fun x -> unit (1000 :: x)
-    in run0 w)
-
-(* (+ 1000 (prompt (+ 100 (shift k (+ 10 (k 1)))))) ~~> 1111 but added differently *)
-let example3 () =
-  Continuation_monad.(let v = reset (
-      let u = shift (fun k -> k [1] >>= fun x -> unit (10 :: x))
-      in u >>= fun x -> unit (100 :: x)
-    ) in let w = v >>= fun x -> unit (1000 :: x)
-    in run0 w)
-
-(* (+ 100 ((prompt (+ 10 (shift k k))) 1)) ~~> 111 *)
-(* not sure if this example can be typed without a sum-type *)
-
-(* (+ 100 (prompt (+ 10 (shift k (k (k 1)))))) ~~> 121 *)
-let example5 () : int =
-  Continuation_monad.(let v = reset (
-      let u = shift (fun k -> k 1 >>= fun x -> k x)
-      in u >>= fun x -> unit (10 + x)
-    ) in let w = v >>= fun x -> unit (100 + x)
-    in run0 w)
-
-
-;;
-
-(1011, 1111, 1111, 121);;
-(example1(), example2(), example3(), example5());;
-((111,0), (0,0));;
-(example ~+10, example ~-10);;
-
-module C = Continuation_monad
-module TC = T.T(C)
-
-let testc df ic =
-    C.runk TC.(run_exn (distribute df t1)) ic;;
-
-
-(*
-(* do nothing *)
-let initial_continuation = fun t -> t in
-TreeCont.monadize t1 Continuation_monad.unit initial_continuation;;
-*)
-testc (C.unit) id;;
-
-(*
-(* count leaves, using continuation *)
-let initial_continuation = fun t -> 0 in
-TreeCont.monadize t1 (fun a k -> 1 + k a) initial_continuation;;
-*)
-
-testc C.(fun a -> shift (fun k -> k a >>= fun v -> unit (1 + v))) (fun t -> 0);;
-
-(*
-(* convert tree to list of leaves *)
-let initial_continuation = fun t -> [] in
-TreeCont.monadize t1 (fun a k -> a :: k a) initial_continuation;;
-*)
-
-testc C.(fun a -> shift (fun k -> k a >>= fun v -> unit (a::v))) (fun t -> ([] : int list));;
-
-(*
-(* square each leaf using continuation *)
-let initial_continuation = fun t -> t in
-TreeCont.monadize t1 (fun a k -> k (a*a)) initial_continuation;;
-*)
-
-testc C.(fun a -> shift (fun k -> k (a*a))) (fun t -> t);;
-
-
-(*
-(* replace leaves with list, using continuation *)
-let initial_continuation = fun t -> t in
-TreeCont.monadize t1 (fun a k -> k [a; a*a]) initial_continuation;;
-*)
+end;;
 
-testc C.(fun a -> shift (fun k -> k (a,a+1))) (fun t -> t);;