(* change this to suit your needs *)
type env = int -> int;;
- type 'a monad = env -> 'a;;
- let unit a : 'a monad = fun e -> a;;
- let bind (u : 'a monad) (f : 'a -> 'b monad) : 'b monad =
+ type 'a m = env -> 'a;;
+ let unit a : 'a m = fun e -> a;;
+ let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
fun e -> f (u e) e;;
end
(* change this to suit your needs *)
type store = int;;
- type 'a monad = store -> 'a * store;;
- let unit a : 'a monad = fun s -> (a, s);;
- let bind (u : 'a monad) (f : 'a -> 'b monad) : 'b monad =
+ type 'a m = store -> 'a * store;;
+ let unit a : 'a m = fun s -> (a, s);;
+ let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
fun s -> (let (a, s') = u s in (f a) s');;
end
module List_monad = struct
- type 'a monad = 'a list;;
- let unit a : 'a monad = [a];;
- let bind (u: 'a monad) (f : 'a -> 'b monad) : 'b monad =
+ type 'a m = 'a list;;
+ let unit a : 'a m = [a];;
+ let bind (u: 'a m) (f : 'a -> 'b m) : 'b m =
List.concat(List.map f u);;
end
* argument, or the State_monad, or another?
*
* There is a way to do this, but it requires putting the `... bind ...` code in
- * its own module, and making that module parameterized on some X_monad
+ * its own module, and making that module parameterized on some M_monad
* module. Also we have to explicitly declare what commonality we're expecting
- * from X_monad modules we're going to use as parameters. We'll explain how to
+ * from M_monad modules we're going to use as parameters. We'll explain how to
* do this in a moment.
*
* As preparation, a general observation:
* * module parameter that will choose
* * whether b = list or b = option or b = reader...
* * This module parameter may supply values as well as types *)
- * X : sig
+ * M : 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 X *)
+ * * use of the module that was supplied as M *)
* struct
- * type ('a) t = 'a -> ('a) X.b
+ * type ('a) t = 'a -> ('a) M.b
* end
* And here's how you'd use it:
* module T_list = T_maker(struct type 'a b = 'a list end);;
*
* I know, it seems unnecessarily complicated. Nonetheless, that's how it
* works. And that is also the technique we'll use to make our
- * `... bind ...` code parametric on some X_monad module.
+ * `... bind ...` code parametric on some M_monad module.
*)
type 'a tree = Leaf of 'a | Node of ('a tree) * ('a tree);;
(Leaf 7, Leaf 11)));;
-module Tree_monadizer(X : sig
+module Tree_monadizer(M : 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 monad
- val unit : 'a -> 'a monad
- val bind : 'a monad -> ('a -> 'b monad) -> 'b monad
+ * for unit and bind, as well as a monadic type constructor *)
+ 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 X.monad) (t: 'a tree) : 'b tree X.monad =
+ let rec monadize (f: 'a -> 'b M.m) (t: 'a tree) : 'b tree M.m =
match t with
- | Leaf a -> X.bind (f a) (fun b -> X.unit (Leaf b))
+ | Leaf a -> M.bind (f a) (fun b -> M.unit (Leaf b))
| Node(l, r) ->
- X.bind (monadize f l) (fun l' ->
- X.bind (monadize f r) (fun r' ->
- X.unit (Node (l', r'))))
+ M.bind (monadize f l) (fun l' ->
+ M.bind (monadize f r) (fun r' ->
+ M.unit (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 ('a,'r) monad = ('a -> 'r) -> 'r;;
- let unit a : ('a,'r) monad = fun k -> k a;;
- let bind (u: ('a,'r) monad) (f: 'a -> ('b,'r) monad) : ('b,'r) 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
(* Since the Continuation monad is parameterized on two types---it's
- * ('a,'r) cont not ('a) cont---we can't match the type ('a) monad that
+ * ('r,'a) cont not ('a) cont---we can't match the type ('a) monad that
* Tree_monadizer expects in its parameter. So we have to make a different
- * Tree_monadizer2 that takes a ('a,'z) monad type constructor in its
+ * Tree_monadizer2 that takes a ('r,'a) monad type constructor in its
* parameter instead *)
-module Tree_monadizer2(X : sig
- type ('a,'z) monad
- val unit : 'a -> ('a,'z) monad
- val bind : ('a,'z) monad -> ('a -> ('b,'z) monad) -> ('b,'z) monad
+module Tree_monadizer2(M : sig
+ 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 (f: 'a -> ('b,'x) X.monad) (t: 'a tree) : ('b tree,'x) X.monad =
+ let rec monadize (f: 'a -> ('r,'b) M.m) (t: 'a tree) : ('r,'b tree) M.m =
match t with
- | Leaf a -> X.bind (f a) (fun b -> X.unit (Leaf b))
+ | Leaf a -> M.bind (f a) (fun b -> M.unit (Leaf b))
| Node(l, r) ->
- X.bind (monadize f l) (fun l' ->
- X.bind (monadize f r) (fun r' ->
- X.unit (Node (l', r'))))
+ M.bind (monadize f l) (fun l' ->
+ M.bind (monadize f r) (fun r' ->
+ M.unit (Node (l', r'))))
end;;
(* Make a TreeCont module containing monadize specialized to the Cont monad *)
*)
-let int_readerize : int -> int Reader_monad.monad =
+let asker : int -> int Reader_monad.m =
fun (a : int) -> fun (env : int -> int) -> env a;;
-(* int_readerize 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 int_readerize t1 env;;
+TreeReader.monadize asker t1 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 asker t1 env;;
* or:
* ...
* let env = fun i -> i + i in
* let module Monad = struct
* type env = int -> int;;
- * type 'a monad = env -> 'a;;
- * let unit a : 'a monad = fun e -> a;;
- * let bind (u : 'a monad) (f : 'a -> 'b monad) : 'b monad =
+ * type 'a m = env -> 'a;;
+ * let unit a : 'a m = fun e -> a;;
+ * let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
* fun e -> f (u e) e;;
* end in
* let module T = Tree_monadizer(Monad) in
- * T.monadize int_readerize t1 env;;
+ * T.monadize asker t1 env;;
* or:
* ...
* let module T = Tree_monadizer(struct
* type env = int -> int;;
- * type 'a monad = env -> 'a;;
- * let unit a : 'a monad = fun e -> a;;
- * let bind (u : 'a monad) (f : 'a -> 'b monad) : 'b monad =
+ * type 'a m = env -> 'a;;
+ * let unit a : 'a m = fun e -> a;;
+ * let bind (u : 'a m) (f : 'a -> 'b m) : 'b m =
* fun e -> f (u e) e;;
* end) in
- * T.monadize int_readerize t1 env;;
+ * T.monadize asker t1 env;;
*)
(* square each leaf *)
let env = fun i -> i * i in
-TreeReader.monadize int_readerize t1 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 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 *)
-(* replace leaves with list *)
-TreeList.monadize (fun i -> [ [i;i*i] ]) t1;;
+let chooser i = if i = 2 then [20; 21] else [i];;
+
+TreeList.monadize chooser t1;;
let initial_continuation = fun t -> t in
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 (fun a k -> k [a; a*a]) t1 initial_continuation;;
-
(* count leaves, using continuation *)
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) 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'));;
-
- *)