module Tree_monadizer(X : 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 *)
+ * for unit and bind, as well as a monadic type constructor *)
type 'a monad
val unit : 'a -> 'a monad
val bind : 'a monad -> ('a -> 'b monad) -> 'b monad
end) = struct
- let rec monadize (f: 'a -> 'b X.monad) (t: 'a tree) : 'b tree X.monad =
+ let rec monadize (t: 'a tree) (f: 'a -> 'b X.monad) : 'b tree X.monad =
match t with
| Leaf a -> X.bind (f a) (fun b -> X.unit (Leaf b))
| Node(l, r) ->
end) = struct
(* the body of the monadize function is the same; the only difference is in
* the types *)
- let rec monadize (f: 'a -> ('b,'x) X.monad) (t: 'a tree) : ('b tree,'x) X.monad =
+ let rec monadize (t: 'a tree) (f: 'a -> ('b,'x) X.monad) : ('b tree,'x) X.monad =
match t with
| Leaf a -> X.bind (f a) (fun b -> X.unit (Leaf b))
| Node(l, r) ->
(* double each leaf *)
let env = fun i -> i + i in
-TreeReader.monadize int_readerize t1 env;;
+TreeReader.monadize t1 int_readerize env;;
(* You can also avoid declaring a separate toplevel TreeReader module
- * (or even a separate Reader_monad module) by ysing one of these forms:
+ * (or even a separate Reader_monad module) by using one of these forms:
* ...
* let module T = Tree_monadizer(Reader_monad) in
- * T.monadize int_readerize t1 env;;
+ * T.monadize t1 int_readerize env;;
* or:
* ...
* let env = fun i -> i + i in
* fun e -> f (u e) e;;
* end in
* let module T = Tree_monadizer(Monad) in
- * T.monadize int_readerize t1 env;;
+ * T.monadize t1 int_readerize env;;
* or:
* ...
* let module T = Tree_monadizer(struct
* let bind (u : 'a monad) (f : 'a -> 'b monad) : 'b monad =
* fun e -> f (u e) e;;
* end) in
- * T.monadize int_readerize t1 env;;
+ * T.monadize t1 int_readerize env;;
*)
(* square each leaf *)
let env = fun i -> i * i in
-TreeReader.monadize int_readerize t1 env;;
+TreeReader.monadize t1 int_readerize env;;
(* count leaves *)
let initial_store = 0 in
-TreeState.monadize incrementer t1 initial_store;;
+TreeState.monadize t1 incrementer initial_store;;
(* replace leaves with list *)
-TreeList.monadize (fun i -> [ [i;i*i] ]) t1;;
+TreeList.monadize t1 (fun i -> [ [i;i*i] ]);;
(* do nothing *)
let initial_continuation = fun t -> t in
-TreeCont.monadize Continuation_monad.unit t1 initial_continuation;;
+TreeCont.monadize t1 Continuation_monad.unit 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;;
+TreeCont.monadize t1 (fun a k -> a :: k a) initial_continuation;;
(* square each leaf using continuation *)
let initial_continuation = fun t -> t in
-TreeCont.monadize (fun a k -> k (a*a)) t1 initial_continuation;;
+TreeCont.monadize t1 (fun a k -> k (a*a)) initial_continuation;;
(* replace leaves with list, using continuation *)
let initial_continuation = fun t -> t in
-TreeCont.monadize (fun a k -> k [a; a*a]) t1 initial_continuation;;
+TreeCont.monadize t1 (fun a k -> k [a; a*a]) initial_continuation;;
(* count leaves, using continuation *)
let initial_continuation = fun t -> 0 in
-TreeCont.monadize (fun a k -> 1 + k a) t1 initial_continuation;;
+TreeCont.monadize t1 (fun a k -> 1 + k a) 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'));;
+
+ *)