X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Ftree_monadize.ml;h=d9c5a5900e520c3fb78c918dd0abbd08f41ea8ae;hp=7c419a342402ce77a965eb1c2810e4b332cdfcde;hb=0c48836d5dbaa454898800a73183d6775cc3664c;hpb=ff95f5a38d61a6fa0b9c5e4da4253a6a3266a7dc diff --git a/code/tree_monadize.ml b/code/tree_monadize.ml index 7c419a34..d9c5a590 100644 --- a/code/tree_monadize.ml +++ b/code/tree_monadize.ml @@ -10,9 +10,9 @@ module Reader_monad = struct (* 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 @@ -20,16 +20,16 @@ module State_monad = struct (* 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 @@ -54,9 +54,9 @@ 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: @@ -80,15 +80,15 @@ end * * 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);; @@ -99,7 +99,7 @@ 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);; @@ -113,24 +113,24 @@ let t1 = Node (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);; @@ -146,31 +146,31 @@ module TreeList = Tree_monadizer(List_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 *) @@ -184,55 +184,55 @@ module TreeCont = Tree_monadizer2(Continuation_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 = +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