(* * tree_monadize.ml * * 'a and so on are type variables in OCaml; they stand for arbitrary types. * What if you want a variable for a type constructor? For example, you want to * generalize this pattern: * type ('a) t1 = 'a -> ('a) list * type ('a) t2 = 'a -> ('a) option * type ('a) t3 = 'a -> ('a) reader * and so on? OCaml won't let you do this: * type ('a, 'b) t = 'a -> ('a) 'b * To generalize on the 'b position, we instead have to use OCaml's modules, * and in particular its ability to make modules parameterized on other modules * (OCaml calls these parameterized modules Functors, but that name is also * used in other ways in this literature, so I won't give in to it.) * * Here's how you'd have to define the t type from above: * module T_maker( * (* A sig...end block specifies the type of a module * * What we're doing here is specifying the type of the * module parameter that will choose * whether b = list or b = option or b = reader... * This module parameter may supply values as well as types *) * Parm: 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 Parm *) * struct * type ('a) t = 'a -> ('a) Parm.b * end * And here's how you'd use it: * module T_list = T_maker(struct type 'a b = 'a list end);; * type 'a t1 = 'a T_list.t;; * module T_option = T_maker(struct type 'a b = 'a option end);; * type 'a t2 = 'a T_option.t;; * (* and so on *) * * I know, it seems unnecessarily complicated. *) type 'a tree = Leaf of 'a | Node of ('a tree) * ('a tree);; let t1 = Node (Node (Leaf 2, Leaf 3), Node (Leaf 5, Node (Leaf 7, Leaf 11)));; module Tree_monadizer(Parm : 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 m val unit : 'a -> 'a m val bind : 'a m -> ('a -> 'b m) -> 'b m end) = struct let rec monadize (f: 'a -> 'b Parm.m) (t: 'a tree) : 'b tree Parm.m = match t with | Leaf a -> Parm.bind (f a) (fun b -> Parm.unit (Leaf b)) | Node(l, r) -> Parm.bind (monadize f l) (fun l' -> Parm.bind (monadize f r) (fun r' -> Parm.unit (Node (l', r')))) end;; 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 = fun e -> f (u e) e;; (* Now we supply the 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(struct type 'a m = 'a reader let unit = unit_reader let bind = bind_reader 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 = 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 end);; let unit_list a = [a];; let bind_list (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 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) 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 * parameter instead *) module Tree_monadizer2(Parm : sig type ('a,'x) m val unit : 'a -> ('a,'x) m val bind : ('a,'x) m -> ('a -> ('b,'x) m) -> ('b,'x) 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) Parm.m) (t: 'a tree) : ('b tree,'x) Parm.m = match t with | Leaf a -> Parm.bind (f a) (fun b -> Parm.unit (Leaf b)) | Node(l, r) -> Parm.bind (monadize f l) (fun l' -> Parm.bind (monadize f r) (fun r' -> Parm.unit (Node (l', r')))) 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 = 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 end);; (* * Here are all the examples from * http://lambda.jimpryor.net/manipulating_trees_with_monads/ *) let int_readerize : int -> int reader = fun (a : int) -> fun (env : int -> int) -> env a;; (* int_readerize 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;; (* square each leaf *) let env = fun i -> i * i in TreeReader.monadize int_readerize t1 env;; let incrementer : int -> int state = 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;; (* replace leaves with list *) TreeList.monadize (fun i -> [ [i;i*i] ]) t1;; (* do nothing *) let initial_continuation = fun t -> t in TreeCont.monadize unit_cont t1 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;; (* square each leaf using continuation *) 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;;