From: Jim Pryor <profjim@jimpryor.net>
Date: Mon, 13 Dec 2010 03:29:59 +0000 (-0500)
Subject: clean up tree_monadizer.ml
X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=commitdiff_plain;h=0c48836d5dbaa454898800a73183d6775cc3664c

clean up tree_monadizer.ml

Signed-off-by: Jim Pryor <profjim@jimpryor.net>
---

diff --git a/code/tree_monadize.ml b/code/tree_monadize.ml
index b8b314a6..d9c5a590 100644
--- a/code/tree_monadize.ml
+++ b/code/tree_monadize.ml
@@ -120,7 +120,7 @@ module Tree_monadizer(M : sig
   val unit : 'a -> 'a m
   val bind : 'a m -> ('a -> 'b m) -> 'b m
 end) = struct
-  let rec monadize (t: 'a tree) (f: 'a -> 'b M.monad) : 'b tree M.monad =
+  let rec monadize (f: 'a -> 'b M.m) (t: 'a tree) : 'b tree M.m =
     match t with
     | Leaf a -> M.bind (f a) (fun b -> M.unit (Leaf b))
     | Node(l, r) ->
@@ -146,9 +146,9 @@ module TreeList =  Tree_monadizer(List_monad);;
 
 (* The Continuation monad is a bit more complicated *)
 module Continuation_monad = struct
-    type ('r,'a) monad = ('a -> 'r) -> 'r;;
-    let unit a : ('r,'a) monad = fun k -> k a;;
-    let bind (u: ('r,'a) monad) (f: 'a -> ('r,'b) monad) : ('r,'b) monad =
+    type ('r,'a) m = ('a -> 'r) -> 'r;;
+    let unit a : ('r,'a) m = fun k -> k a;;
+    let bind (u: ('r,'a) m) (f: 'a -> ('r,'b) m) : ('r,'b) m =
       fun k -> u (fun a -> f a k);;
 end
 
@@ -158,13 +158,13 @@ end
  * Tree_monadizer2 that takes a ('r,'a) monad type constructor in its
  * parameter instead *)
 module Tree_monadizer2(M : sig
-  type ('r,'a) monad
-  val unit : 'a -> ('r,'a) monad
-  val bind : ('r,'a) monad -> ('a -> ('r,'b) monad) -> ('r,'b) monad
+  type ('r,'a) m
+  val unit : 'a -> ('r,'a) m
+  val bind : ('r,'a) m -> ('a -> ('r,'b) m) -> ('r,'b) m
 end) = struct
   (* the body of the monadize function is the same; the only difference is in
    * the types *)
-  let rec monadize (t: 'a tree) (f: 'a -> ('r,'b) M.monad) : ('r,'b tree) M.monad =
+  let rec monadize (f: 'a -> ('r,'b) M.m) (t: 'a tree) : ('r,'b tree) M.m =
     match t with
     | Leaf a -> M.bind (f a) (fun b -> M.unit (Leaf b))
     | Node(l, r) ->
@@ -184,7 +184,7 @@ module TreeCont =  Tree_monadizer2(Continuation_monad);;
  *)
 
 
-let asker : int -> int Reader_monad.monad =
+let asker : int -> int Reader_monad.m =
   fun (a : int) -> fun (env : int -> int) -> env a;;
 
 (* asker takes an int and returns a Reader monad that
@@ -194,13 +194,13 @@ let asker : int -> int Reader_monad.monad =
 
 (* double each leaf *)
 let env = fun i -> i + i in
-TreeReader.monadize t1 asker env;;
+TreeReader.monadize asker t1 env;;
 
 (* You can also avoid declaring a separate toplevel TreeReader module
  * (or even a separate Reader_monad module) by using one of these forms:
  *     ...
  *     let module T = Tree_monadizer(Reader_monad) in
- *     T.monadize t1 asker env;;
+ *     T.monadize asker t1 env;;
  * or:
  *     ...
  *     let env = fun i -> i + i in
@@ -212,7 +212,7 @@ TreeReader.monadize t1 asker env;;
  *         fun e -> f (u e) e;;
  *     end in
  *     let module T = Tree_monadizer(Monad) in
- *     T.monadize t1 asker env;;
+ *     T.monadize asker t1 env;;
  * or:
  *     ...
  *     let module T = Tree_monadizer(struct
@@ -222,17 +222,17 @@ TreeReader.monadize t1 asker env;;
  *       let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
  *         fun e -> f (u e) e;;
  *     end) in
- *     T.monadize t1 asker env;;
+ *     T.monadize asker t1 env;;
  *)
 
 
 (* square each leaf *)
 let env = fun i -> i * i in
-TreeReader.monadize t1 asker env;;
+TreeReader.monadize asker t1 env;;
 
 
 
-let incrementer : int -> int State_monad.monad =
+let incrementer : int -> int State_monad.m =
   fun (a : int) -> fun s -> (a, s+1);;
 
 (* incrementer takes an 'a and returns it wrapped in a
@@ -240,56 +240,32 @@ let incrementer : int -> int State_monad.monad =
 
 (* count leaves *)
 let initial_store = 0 in
-TreeState.monadize t1 incrementer initial_store;;
+TreeState.monadize incrementer t1 initial_store;;
 
 
 
 (* replace leaves with list *)
-TreeList.monadize t1 (fun i -> [ [i;i*i] ]);;
+TreeList.monadize (fun i -> [ [i;i*i] ]) t1;;
 
 
 
 (* do nothing *)
 let initial_continuation = fun t -> t in
-TreeCont.monadize t1 Continuation_monad.unit initial_continuation;;
+TreeCont.monadize Continuation_monad.unit t1 initial_continuation;;
 
 (* convert tree to list of leaves *)
 let initial_continuation = fun t -> [] in
-TreeCont.monadize t1 (fun a k -> a :: k a) initial_continuation;;
+TreeCont.monadize (fun a k -> a :: k a) t1 initial_continuation;;
 
 (* square each leaf using continuation *)
 let initial_continuation = fun t -> t in
-TreeCont.monadize t1 (fun a k -> k (a*a)) initial_continuation;;
+TreeCont.monadize (fun a k -> k (a*a)) t1 initial_continuation;;
 
 (* 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;;
+TreeCont.monadize (fun a k -> k [a; a*a]) t1 initial_continuation;;
 
 (* count leaves, using continuation *)
 let initial_continuation = fun t -> 0 in
-TreeCont.monadize t1 (fun a k -> 1 + k a) initial_continuation;;
+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) treeT_reader =
-    'a tree reader;;
-
-let unit (a: 'a) : 'a tree reader =
-    reader_unit (Leaf a);;
-
-let rec bind (u : 'a tree_reader) (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'));;
-
- *)