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) ->
end;;
-(* Now we supply the Reader monad as a parameter to Tree_monadizer.
+(* Now we supply 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(Reader_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
* 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) ->
*)
-let get_int : int -> int Reader_monad.monad =
+let asker : int -> int Reader_monad.m =
fun (a : int) -> fun (env : int -> int) -> env a;;
-(* get_int takes an int and returns a Reader monad that
+(* asker 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 *)
let env = fun i -> i + i in
-TreeReader.monadize t1 get_int 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 get_int env;;
+ * T.monadize asker t1 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 t1 get_int env;;
+ * T.monadize asker t1 env;;
* or:
* ...
* let module T = Tree_monadizer(struct
* let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
* fun e -> f (u e) e;;
* end) in
- * T.monadize t1 get_int env;;
+ * T.monadize asker t1 env;;
*)
(* square each leaf *)
let env = fun i -> i * i in
-TreeReader.monadize t1 get_int env;;
+TreeReader.monadize asker t1 env;;
-let incrementer : int -> int State_monad.monad =
- fun (a : int) -> fun s -> (a, s+1);;
+(* count leaves *)
+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
* State monad that increments the store *)
-(* count leaves *)
let initial_store = 0 in
-TreeState.monadize t1 incrementer initial_store;;
+TreeState.monadize incrementer t1 initial_store;;
+
+(* annotate leaves as they're visited *)
+
+let annotater : int -> (int * int) State_monad.m =
+ fun (a : int) -> fun s -> ((a,s+1), s+1);;
+
+let initial_store = 0 in
+TreeState.monadize annotater t1 initial_store;;
+
+(* copy tree with different choices for leaves *)
+let chooser i = if i = 2 then [20; 21] else [i];;
-(* replace leaves with list *)
-TreeList.monadize t1 (fun i -> [ [i;i*i] ]);;
+TreeList.monadize chooser 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;;
-
-(* 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)) 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;;
-
-(*
-(* 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);;
+TreeCont.monadize (fun a k -> 1 + k a) t1 initial_continuation;;
-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'));;
-
- *)