4 * 'a and so on are type variables in OCaml; they stand for arbitrary types.
5 * What if you want a variable for a type constructor? For example, you want to
6 * generalize this pattern:
7 * type ('a) t1 = 'a -> ('a) list
8 * type ('a) t2 = 'a -> ('a) option
9 * type ('a) t3 = 'a -> ('a) reader
10 * and so on? OCaml won't let you do this:
11 * type ('a, 'b) t = 'a -> ('a) 'b
12 * To generalize on the 'b position, we instead have to use OCaml's modules,
13 * and in particular its ability to make modules parameterized on other modules
14 * (OCaml calls these parameterized modules Functors, but that name is also
15 * used in other ways in this literature, so I won't give in to it.)
17 * Here's how you'd have to define the t type from above:
19 * (* A sig...end block specifies the type of a module
20 * * What we're doing here is specifying the type of the
21 * module parameter that will choose
22 * whether b = list or b = option or b = reader...
23 * This module parameter may supply values as well as types *)
28 * (* A struct...end block gives a module value
29 * What we're doing here is building a new module that makes
30 * use of the module that was supplied as Parm *)
32 * type ('a) t = 'a -> ('a) Parm.b
34 * And here's how you'd use it:
35 * module T_list = T_maker(struct type 'a b = 'a list end);;
36 * type 'a t1 = 'a T_list.t;;
37 * module T_option = T_maker(struct type 'a b = 'a option end);;
38 * type 'a t2 = 'a T_option.t;;
41 * I know, it seems unnecessarily complicated.
44 type 'a tree = Leaf of 'a | Node of ('a tree) * ('a tree);;
55 module Tree_monadizer(Parm : sig
56 (* the module we're using as a parameter has to supply function values
57 * for unit and bind, as well as a monadic type constructor m *)
60 val bind : 'a m -> ('a -> 'b m) -> 'b m
62 let rec monadize (f: 'a -> 'b Parm.m) (t: 'a tree) : 'b tree Parm.m =
64 | Leaf a -> Parm.bind (f a) (fun b -> Parm.unit (Leaf b))
66 Parm.bind (monadize f l) (fun l' ->
67 Parm.bind (monadize f r) (fun r' ->
68 Parm.unit (Node (l', r'))))
72 type env = int -> int;;
74 type 'a reader = env -> 'a;;
75 let reader_unit a : 'a reader = fun e -> a;;
76 let reader_bind (u : 'a reader) (f : 'a -> 'b reader) : 'b reader =
79 (* Now we supply the Reader monad as a parameter to Tree_monadizer.
80 * We'll get back a module TreeReader that contains a single value,
81 * the monadize function specialized to the Reader monad *)
82 module TreeReader = Tree_monadizer(struct
84 let unit = reader_unit
85 let bind = reader_bind
91 type 'a state = store -> 'a * store;;
92 let state_unit a : 'a state = fun s -> (a, s);;
93 let state_bind (u : 'a state) (f : 'a -> 'b state) : 'b state =
94 fun s -> (let (a, s') = u s in (f a) s');;
96 (* Make a TreeState module containing monadize specialized to the State monad *)
97 module TreeState = Tree_monadizer(struct
100 let bind = state_bind
104 let list_unit a = [a];;
105 let list_bind (u: 'a list) (f : 'a -> 'b list) : 'b list =
106 List.concat(List.map f u);;
108 (* Make a TreeList module containing monadize specialized to the List monad *)
109 module TreeList = Tree_monadizer(struct
116 (* since the Continuation monad is parameterized on two types---it's
117 * ('a,'r) cont not ('a) cont---we can't match the type ('a) m that
118 * Tree_monadizer expects in its parameter. So we have to make a different
119 * Tree_monadizer2 that takes a ('a,'x) m type constructor in its
120 * parameter instead *)
121 module Tree_monadizer2(Parm : sig
123 val unit : 'a -> ('a,'x) m
124 val bind : ('a,'x) m -> ('a -> ('b,'x) m) -> ('b,'x) m
126 (* the body of the monadize function is the same; the only difference is in
128 let rec monadize (f: 'a -> ('b,'x) Parm.m) (t: 'a tree) : ('b tree,'x) Parm.m =
130 | Leaf a -> Parm.bind (f a) (fun b -> Parm.unit (Leaf b))
132 Parm.bind (monadize f l) (fun l' ->
133 Parm.bind (monadize f r) (fun r' ->
134 Parm.unit (Node (l', r'))))
137 type ('a,'r) cont = ('a -> 'r) -> 'r;;
138 let cont_unit a : ('a,'r) cont = fun k -> k a;;
139 let cont_bind (u: ('a,'r) cont) (f: 'a -> ('b,'r) cont) : ('b,'r) cont =
140 fun k -> u (fun a -> f a k);;
142 (* Make a TreeCont module containing monadize specialized to the Cont monad *)
143 module TreeCont = Tree_monadizer2(struct
144 type ('a,'r) m = ('a,'r) cont
152 * Here are all the examples from
153 * http://lambda.jimpryor.net/manipulating_trees_with_monads/
157 let int_readerize : int -> int reader =
158 fun (a : int) -> fun (env : int -> int) -> env a;;
160 (* int_readerize takes an int and returns a Reader monad that
161 * "looks up" that int in the environment (i.e. modifies it)
162 * this is structurally parallel to the function `lookup` we used
163 * before to "look up" variables in the environment *)
165 (* double each leaf *)
166 let env = fun i -> i + i in
167 TreeReader.monadize int_readerize t1 env;;
169 (* square each leaf *)
170 let env = fun i -> i * i in
171 TreeReader.monadize int_readerize t1 env;;
175 let incrementer : int -> int state =
176 fun (a : int) -> fun s -> (a, s+1);;
178 (* incrementer takes an 'a and returns it wrapped in a
179 * State monad that increments the store *)
182 let initial_store = 0 in
183 TreeState.monadize incrementer t1 initial_store;;
187 (* replace leaves with list *)
188 TreeList.monadize (fun i -> [ [i;i*i] ]) t1;;
193 let initial_continuation = fun t -> t in
194 TreeCont.monadize cont_unit t1 initial_continuation;;
196 (* convert tree to list of leaves *)
197 let initial_continuation = fun t -> [] in
198 TreeCont.monadize (fun a k -> a :: k a) t1 initial_continuation;;
200 (* square each leaf using continuation *)
201 let initial_continuation = fun t -> t in
202 TreeCont.monadize (fun a k -> k (a*a)) t1 initial_continuation;;
204 (* replace leaves with list, using continuation *)
205 let initial_continuation = fun t -> t in
206 TreeCont.monadize (fun a k -> k [a; a*a]) t1 initial_continuation;;
208 (* count leaves, using continuation *)
209 let initial_continuation = fun t -> 0 in
210 TreeCont.monadize (fun a k -> 1 + k a) t1 initial_continuation;;
217 (* type 'a tree defined above *)
218 let tree_unit (a: 'a) : 'a tree = Leaf a;;
219 let rec tree_bind (u : 'a tree) (f : 'a -> 'b tree) : 'b tree =
222 | Node (l, r) -> Node (tree_bind l f, tree_bind r f);;
224 type 'a, treeTC_reader =
227 let unit (a: 'a) : 'a tree reader =
230 let rec bind (u : ('a, M) tree) (f : 'a -> ('b, M) tree) : ('b, M) tree =
232 | Leaf a -> M.bind (f a) (fun b -> M.unit (Leaf b))
233 | Node (l, r) -> M.bind (bind l f) (fun l' ->
234 M.bind (bind r f) (fun r' ->
235 M.unit (Node (l', r'));;