X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Ftree_monadize.ml;h=16d061060d3cd23d345789a64c9f096d42afd672;hp=310b797e4f08c0bcc631194dfcd1a5f488bbc5dc;hb=0638e3b38097e20ebf645fe7cb1ecec4f17aef7a;hpb=f6950034eb1c228badf3364375595032a56e3afb

diff --git a/code/tree_monadize.ml b/code/tree_monadize.ml
index 310b797e..16d06106 100644
--- a/code/tree_monadize.ml
+++ b/code/tree_monadize.ml
@@ -1,28 +1,42 @@
 (*
  * tree_monadize.ml
  *
- * 'a and so on are type variables in OCaml; they stand for arbitrary types
+ * 'a and so on are type variables in OCaml; they stand for arbitrary types.
  * What if you want a variable for a type constructor? For example, you want to
  * generalize this pattern:
- *      type ('a) t1 = 'a -> 'a list
- *      type ('a) t2 = 'a -> 'a option
- *      type ('a) t3 = 'a -> 'a reader
+ *      type ('a) t1 = 'a -> ('a) list
+ *      type ('a) t2 = 'a -> ('a) option
+ *      type ('a) t3 = 'a -> ('a) reader
  * and so on? OCaml won't let you do this:
- *      type ('a, 'b) t = 'a -> 'a 'b
- * to generalize on the 'b position, we instead have to use OCaml's modules,
+ *      type ('a, 'b) t = 'a -> ('a) 'b
+ * To generalize on the 'b position, we instead have to use OCaml's modules,
  * and in particular its ability to make modules parameterized on other modules
  * (OCaml calls these parameterized modules Functors, but that name is also
  * used in other ways in this literature, so I won't give in to it.)
  *
  * Here's how you'd have to define the t type from above:
- *      module T_maker(S: sig
- *          type 'a b
- *      end) = struct
- *          type 'a t = 'a -> 'a S.b
+ *      module T_maker(
+ *      (* A sig...end block specifies the type of a module
+ *       * What we're doing here is specifying the type of the 
+         * module parameter that will choose
+         * whether b = list or b = option or b = reader...
+         * This module parameter may supply values as well as types *)
+ *      Parm: sig
+ *          type ('a) b
+ *      end
+ *      ) = 
+ *      (* A struct...end block gives a module value
+         * What we're doing here is building a new module that makes
+         * use of the module that was supplied as Parm *)
+ *      struct
+ *          type ('a) t = 'a -> ('a) Parm.b
  *      end
  * And here's how you'd use it:
  *      module T_list = T_maker(struct type 'a b = 'a list end);;
  *      type 'a t1 = 'a T_list.t;;
+ *      module T_option = T_maker(struct type 'a b = 'a option end);;
+ *      type 'a t2 = 'a T_option.t;;
+ *      (* and so on *)
  *
  * I know, it seems unnecessarily complicated.
  *)
@@ -38,86 +52,98 @@ let t1 = Node
                 (Leaf 7, Leaf 11)));;
 
 
-module Tree_monadizer(S: sig
+module Tree_monadizer(Parm : sig
+  (* the module we're using as a parameter has to supply function values
+   * for unit and bind, as well as a monadic type constructor m *)
   type 'a m
   val unit : 'a -> 'a m
   val bind : 'a m -> ('a -> 'b m) -> 'b m
 end) = struct
-  let rec monadize (f: 'a -> 'b S.m) (t: 'a tree) : 'b tree S.m =
+  let rec monadize (f: 'a -> 'b Parm.m) (t: 'a tree) : 'b tree Parm.m =
     match t with
-    | Leaf a -> S.bind (f a) (fun b -> S.unit (Leaf b))
+    | Leaf a -> Parm.bind (f a) (fun b -> Parm.unit (Leaf b))
     | Node(l, r) ->
-        S.bind (monadize f l) (fun l' ->
-          S.bind (monadize f r) (fun r' ->
-            S.unit (Node (l', r'))))
+        Parm.bind (monadize f l) (fun l' ->
+          Parm.bind (monadize f r) (fun r' ->
+            Parm.unit (Node (l', r'))))
 end;;
 
 
 type env = int -> int;;
 
 type 'a reader = env -> 'a;;
-let unit_reader a : 'a reader = fun e -> a;;
-let bind_reader (u : 'a reader) (f : 'a -> 'b reader) : 'b reader =
+let reader_unit a : 'a reader = fun e -> a;;
+let reader_bind (u : 'a reader) (f : 'a -> 'b reader) : 'b reader =
   fun e -> f (u e) e;;
 
+(* Now we supply the Reader monad as a parameter to Tree_monadizer.
+ * We'll get back a module TreeReader that contains a single value,
+ * the monadize function specialized to the Reader monad *)
 module TreeReader = Tree_monadizer(struct
   type 'a m = 'a reader
-  let unit = unit_reader
-  let bind = bind_reader
+  let unit = reader_unit
+  let bind = reader_bind
 end);;
 
 
 type store = int;;
 
 type 'a state = store -> 'a * store;;
-let unit_state a : 'a state  = fun s -> (a, s);;
-let bind_state (u : 'a state) (f : 'a -> 'b state) : 'b state =
+let state_unit a : 'a state  = fun s -> (a, s);;
+let state_bind (u : 'a state) (f : 'a -> 'b state) : 'b state =
   fun s -> (let (a, s') = u s in (f a) s');;
 
+(* Make a TreeState module containing monadize specialized to the State monad *)
 module TreeState =  Tree_monadizer(struct
   type 'a m = 'a state
-  let unit = unit_state
-  let bind = bind_state
+  let unit = state_unit
+  let bind = state_bind
 end);;
 
 
-let unit_list a = [a];;
-let bind_list (u: 'a list) (f : 'a -> 'b list) : 'b list =
+let list_unit a = [a];;
+let list_bind (u: 'a list) (f : 'a -> 'b list) : 'b list =
   List.concat(List.map f u);;
 
+(* Make a TreeList module containing monadize specialized to the List monad *)
 module TreeList =  Tree_monadizer(struct
   type 'a m = 'a list
-  let unit = unit_list
-  let bind = bind_list
+  let unit = list_unit
+  let bind = list_bind
 end);;
 
 
-
-(* we need to a new module when the monad is parameterized on two types *)
-module Tree_monadizer2(S: sig
+(* since the Continuation monad is parameterized on two types---it's
+ * ('a,'r) cont not ('a) cont---we can't match the type ('a) m that
+ * Tree_monadizer expects in its parameter. So we have to make a different
+ * Tree_monadizer2 that takes a ('a,'x) m type constructor in its
+ * parameter instead *)
+module Tree_monadizer2(Parm : sig
   type ('a,'x) m
   val unit : 'a -> ('a,'x) m
   val bind : ('a,'x) m -> ('a -> ('b,'x) m) -> ('b,'x) m
 end) = struct
-  let rec monadize (f: 'a -> ('b,'x) S.m) (t: 'a tree) : ('b tree,'x) S.m =
-    (* the definition is the same, the difference is only in the types *)
+  (* the body of the monadize function is the same; the only difference is in
+   * the types *)
+  let rec monadize (f: 'a -> ('b,'x) Parm.m) (t: 'a tree) : ('b tree,'x) Parm.m =
     match t with
-    | Leaf a -> S.bind (f a) (fun b -> S.unit (Leaf b))
+    | Leaf a -> Parm.bind (f a) (fun b -> Parm.unit (Leaf b))
     | Node(l, r) ->
-        S.bind (monadize f l) (fun l' ->
-          S.bind (monadize f r) (fun r' ->
-            S.unit (Node (l', r'))))
+        Parm.bind (monadize f l) (fun l' ->
+          Parm.bind (monadize f r) (fun r' ->
+            Parm.unit (Node (l', r'))))
 end;;
 
 type ('a,'r) cont = ('a -> 'r) -> 'r;;
-let unit_cont a : ('a,'r) cont = fun k -> k a;;
-let bind_cont (u: ('a,'r) cont) (f: 'a -> ('b,'r) cont) : ('b,'r) cont =
+let cont_unit a : ('a,'r) cont = fun k -> k a;;
+let cont_bind (u: ('a,'r) cont) (f: 'a -> ('b,'r) cont) : ('b,'r) cont =
   fun k -> u (fun a -> f a k);;
 
+(* Make a TreeCont module containing monadize specialized to the Cont monad *)
 module TreeCont =  Tree_monadizer2(struct
   type ('a,'r) m = ('a,'r) cont
-  let unit = unit_cont
-  let bind = bind_cont
+  let unit = cont_unit
+  let bind = cont_bind
 end);;
 
 
@@ -127,34 +153,83 @@ end);;
  * http://lambda.jimpryor.net/manipulating_trees_with_monads/
  *)
 
+
 let int_readerize : int -> int reader =
-  fun (a : int) (modifier : int -> int) -> modifier a;;
+  fun (a : int) -> fun (env : int -> int) -> env a;;
+
+(* int_readerize takes an int and returns a Reader monad that
+ * "looks up" that int in the environment (i.e. modifies it)
+ * this is structurally parallel to the function `lookup` we used
+ * before to "look up" variables in the environment *)
 
 (* double each leaf *)
-TreeReader.monadize int_readerize t1 (fun i -> i + i);;
+let env = fun i -> i + i in
+TreeReader.monadize int_readerize t1 env;;
 
 (* square each leaf *)
-TreeReader.monadize int_readerize t1 (fun i -> i * i);;
+let env = fun i -> i * i in
+TreeReader.monadize int_readerize t1 env;;
+
+
+
+let incrementer : int -> int state =
+  fun (a : int) -> fun s -> (a, s+1);;
+
+(* incrementer takes an 'a and returns it wrapped in a
+ * State monad that increments the store *)
 
 (* count leaves *)
-TreeState.monadize (fun a s -> (a, s+1)) t1 0;;
+let initial_store = 0 in
+TreeState.monadize incrementer t1 initial_store;;
+
+
 
 (* replace leaves with list *)
-TreeList.monadize (fun i -> [[i;i*i]]) t1;;
+TreeList.monadize (fun i -> [ [i;i*i] ]) t1;;
+
 
-(* convert tree to list of leaves *)
-TreeCont.monadize (fun a k -> a :: k a) t1 (fun t -> []);;
 
 (* do nothing *)
-TreeCont.monadize unit_cont t1 (fun t-> t);;
+let initial_continuation = fun t -> t in
+TreeCont.monadize cont_unit t1 initial_continuation;;
+
+(* convert tree to list of leaves *)
+let initial_continuation = fun t -> [] in
+TreeCont.monadize (fun a k -> a :: k a) t1 initial_continuation;;
 
 (* square each leaf using continuation *)
-TreeCont.monadize (fun a k -> k (a*a)) t1 (fun t -> t);;
+let initial_continuation = fun t -> t in
+TreeCont.monadize (fun a k -> k (a*a)) t1 initial_continuation;;
 
 (* replace leaves with list, using continuation *)
-TreeCont.monadize (fun a k -> k [a; a*a]) t1 (fun t -> t);;
+let initial_continuation = fun t -> t in
+TreeCont.monadize (fun a k -> k [a; a*a]) t1 initial_continuation;;
 
 (* count leaves, using continuation *)
-TreeCont.monadize (fun a k -> 1 + k a) t1 (fun t -> 0);;
+let initial_continuation = fun t -> 0 in
+TreeCont.monadize (fun a k -> 1 + k a) t1 initial_continuation;;
+
+
+
+
+(* Tree monad *)
+
+(* type 'a tree defined above *)
+let tree_unit (a: 'a) : 'a tree = Leaf a;;
+let rec tree_bind (u : 'a tree) (f : 'a -> 'b tree) : 'b tree =
+    match u with
+    | Leaf a -> f a
+    | Node (l, r) -> Node (tree_bind l f, tree_bind r f);;
+
+type 'a, treeTC_reader =
+		'a tree reader;;
 
+	let unit (a: 'a) : 'a tree reader =
+		M.unit (Leaf a);;
 
+	let rec bind (u : ('a, M) tree) (f : 'a -> ('b, M) tree) : ('b, M) tree =
+	    match u with
+	    | Leaf a -> M.bind (f a) (fun b -> M.unit (Leaf b))
+	    | Node (l, r) -> M.bind (bind l f) (fun l' ->
+							M.bind (bind r f) (fun r' ->
+								M.unit (Node (l', r'));;