From 7e3d6cc411a3fb891cb6de18b19ce707e7160b92 Mon Sep 17 00:00:00 2001 From: Jim Pryor Date: Thu, 2 Dec 2010 07:07:06 -0500 Subject: [PATCH] code/tree_monadize.ml Signed-off-by: Jim Pryor --- code/tree_monadize.ml | 124 +++++++++++++++++++++++++++++++++++--------------- 1 file changed, 88 insertions(+), 36 deletions(-) diff --git a/code/tree_monadize.ml b/code/tree_monadize.ml index 310b797e..d38800a7 100644 --- a/code/tree_monadize.ml +++ b/code/tree_monadize.ml @@ -1,28 +1,42 @@ (* * tree_monadize.ml * - * 'a and so on are type variables in OCaml; they stand for arbitrary types + * '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 + * 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, + * 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(S: sig - * type 'a b - * end) = struct - * type 'a t = 'a -> 'a S.b + * 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. *) @@ -38,18 +52,20 @@ let t1 = Node (Leaf 7, Leaf 11)));; -module Tree_monadizer(S: sig +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 S.m) (t: 'a tree) : 'b tree S.m = + let rec monadize (f: 'a -> 'b Parm.m) (t: 'a tree) : 'b tree Parm.m = match t with - | Leaf a -> S.bind (f a) (fun b -> S.unit (Leaf b)) + | Leaf a -> Parm.bind (f a) (fun b -> Parm.unit (Leaf b)) | Node(l, r) -> - S.bind (monadize f l) (fun l' -> - S.bind (monadize f r) (fun r' -> - S.unit (Node (l', r')))) + Parm.bind (monadize f l) (fun l' -> + Parm.bind (monadize f r) (fun r' -> + Parm.unit (Node (l', r')))) end;; @@ -60,6 +76,9 @@ 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 @@ -74,6 +93,7 @@ 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 @@ -85,6 +105,7 @@ 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 @@ -92,21 +113,25 @@ module TreeList = Tree_monadizer(struct end);; - -(* we need to a new module when the monad is parameterized on two types *) -module Tree_monadizer2(S: sig +(* 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 - let rec monadize (f: 'a -> ('b,'x) S.m) (t: 'a tree) : ('b tree,'x) S.m = - (* the definition is the same, the difference is only in the types *) + (* 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 -> S.bind (f a) (fun b -> S.unit (Leaf b)) + | Leaf a -> Parm.bind (f a) (fun b -> Parm.unit (Leaf b)) | Node(l, r) -> - S.bind (monadize f l) (fun l' -> - S.bind (monadize f r) (fun r' -> - S.unit (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;; @@ -114,6 +139,7 @@ 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 @@ -127,34 +153,60 @@ end);; * http://lambda.jimpryor.net/manipulating_trees_with_monads/ *) + let int_readerize : int -> int reader = - fun (a : int) (modifier : int -> int) -> modifier a;; + 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 *) -TreeReader.monadize int_readerize t1 (fun i -> i + i);; +let env = fun i -> i + i in +TreeReader.monadize int_readerize t1 env;; (* square each leaf *) -TreeReader.monadize int_readerize t1 (fun i -> i * i);; +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 *) -TreeState.monadize (fun a s -> (a, s+1)) t1 0;; +let initial_store = 0 in +TreeState.monadize incrementer t1 initial_store;; + + (* replace leaves with list *) -TreeList.monadize (fun i -> [[i;i*i]]) t1;; +TreeList.monadize (fun i -> [ [i;i*i] ]) t1;; + -(* convert tree to list of leaves *) -TreeCont.monadize (fun a k -> a :: k a) t1 (fun t -> []);; (* do nothing *) -TreeCont.monadize unit_cont t1 (fun t-> t);; +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 *) -TreeCont.monadize (fun a k -> k (a*a)) t1 (fun t -> t);; +let initial_continuation = fun t -> t in +TreeCont.monadize (fun a k -> k (a*a)) t1 initial_continuation;; (* replace leaves with list, using continuation *) -TreeCont.monadize (fun a k -> k [a; a*a]) t1 (fun t -> t);; +let initial_continuation = fun t -> t in +TreeCont.monadize (fun a k -> k [a; a*a]) t1 initial_continuation;; (* count leaves, using continuation *) -TreeCont.monadize (fun a k -> 1 + k a) t1 (fun t -> 0);; +let initial_continuation = fun t -> 0 in +TreeCont.monadize (fun a k -> 1 + k a) t1 initial_continuation;; -- 2.11.0