From: Jim Pryor Date: Sun, 5 Dec 2010 14:25:15 +0000 (-0500) Subject: expand tree_monadize explanation X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=commitdiff_plain;h=6bdd5bdd6e49ead61951cecff822c161f28098ca;hp=45b9ccec15be46dd784aa1ca4dab0f89b454c1b1 expand tree_monadize explanation Signed-off-by: Jim Pryor --- diff --git a/code/tree_monadize.ml b/code/tree_monadize.ml index 16d06106..c751b36e 100644 --- a/code/tree_monadize.ml +++ b/code/tree_monadize.ml @@ -1,6 +1,65 @@ (* * tree_monadize.ml * + * If you've got some block of code that uses `unit`s and `bind`s, and you + * want to interpret it alternately using this monad, that monad, or another + * monad, you can use OCaml's module system. You'd write your code like this: + *) + +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 = + fun e -> f (u e) e;; +end + +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 = + 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 = + List.concat(List.map f u);; +end + +(* + * Then you can replace code that looks like this: + * ... reader_bind ... + * with code that looks like this: + * ... Reader_monad.bind ... + * and the latter can be reformulated like this: + * let open Reader_monad in ... bind ... + * or equivalently, like this: + * Reader_monad.(... bind ...) + * Then you can use literally the same `... bind ...` code when writing instead: + * State_monad.(... bind ...) + *) + +(* That's great, however it still requires us to repeat the + * `... bind ...` code every time we want to change which monad we're working + * with. Shouldn't there be a way to _parameterize_ the `... bind ...` code + * on a monad, so that we only have to write the `... bind ...` code once, + * but can invoke it alternately with the Reader_monad supplied as an + * 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 + * 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 + * do this in a moment. + * + * As preparation, a general observation: * '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: @@ -18,18 +77,18 @@ * 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 + * * 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 * 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 *) + * * What we're doing here is building a new module that makes + * * use of the module that was supplied as X *) * struct - * type ('a) t = 'a -> ('a) Parm.b + * type ('a) t = 'a -> ('a) X.b * end * And here's how you'd use it: * module T_list = T_maker(struct type 'a b = 'a list end);; @@ -38,7 +97,9 @@ * type 'a t2 = 'a T_option.t;; * (* and so on *) * - * I know, it seems unnecessarily complicated. + * 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. *) type 'a tree = Leaf of 'a | Node of ('a tree) * ('a tree);; @@ -52,99 +113,68 @@ let t1 = Node (Leaf 7, Leaf 11)));; -module Tree_monadizer(Parm : sig +module Tree_monadizer(X : 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 + type 'a monad + val unit : 'a -> 'a monad + val bind : 'a monad -> ('a -> 'b monad) -> 'b monad end) = struct - let rec monadize (f: 'a -> 'b Parm.m) (t: 'a tree) : 'b tree Parm.m = + let rec monadize (f: 'a -> 'b X.monad) (t: 'a tree) : 'b tree X.monad = match t with - | Leaf a -> Parm.bind (f a) (fun b -> Parm.unit (Leaf b)) + | Leaf a -> X.bind (f a) (fun b -> X.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')))) + X.bind (monadize f l) (fun l' -> + X.bind (monadize f r) (fun r' -> + X.unit (Node (l', r')))) end;; -type env = int -> int;; - -type 'a reader = env -> 'a;; -let reader_unit a : 'a reader = fun e -> a;; -let reader_bind (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 = reader_unit - let bind = reader_bind -end);; - - -type store = int;; +module TreeReader = Tree_monadizer(Reader_monad);; -type 'a state = store -> 'a * store;; -let state_unit a : 'a state = fun s -> (a, s);; -let state_bind (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 = state_unit - let bind = state_bind -end);; +module TreeState = Tree_monadizer(State_monad);; -let list_unit a = [a];; -let list_bind (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 = list_unit - let bind = list_bind -end);; +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 = + 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) m that +(* 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 * 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 + * Tree_monadizer2 that takes a ('a,'z) monad 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 +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 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 = + let rec monadize (f: 'a -> ('b,'x) X.monad) (t: 'a tree) : ('b tree,'x) X.monad = match t with - | Leaf a -> Parm.bind (f a) (fun b -> Parm.unit (Leaf b)) + | Leaf a -> X.bind (f a) (fun b -> X.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')))) + X.bind (monadize f l) (fun l' -> + X.bind (monadize f r) (fun r' -> + X.unit (Node (l', r')))) end;; -type ('a,'r) cont = ('a -> 'r) -> 'r;; -let cont_unit a : ('a,'r) cont = fun k -> k a;; -let cont_bind (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 = cont_unit - let bind = cont_bind -end);; +module TreeCont = Tree_monadizer2(Continuation_monad);; @@ -210,26 +240,3 @@ 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, treeTC_reader = - 'a tree reader;; - - let unit (a: 'a) : 'a tree reader = - M.unit (Leaf a);; - - let rec bind (u : ('a, M) tree) (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'));;