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.
* 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);;
-(* since the continuation monad is parameterized on two types---it's
+(* 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
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);;
(* do nothing *)
let initial_continuation = fun t -> t in
-TreeCont.monadize unit_cont t1 initial_continuation;;
+TreeCont.monadize cont_unit t1 initial_continuation;;
(* convert tree to list of leaves *)
let initial_continuation = fun t -> [] 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'));;