X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Ftree_monadize.ml;h=d9c5a5900e520c3fb78c918dd0abbd08f41ea8ae;hp=43d0d981a66161e2f93b8868a040a4ffabac8bac;hb=0c48836d5dbaa454898800a73183d6775cc3664c;hpb=434fc9bef584f51ac5338a39dc4ff5da44b5b435 diff --git a/code/tree_monadize.ml b/code/tree_monadize.ml index 43d0d981..d9c5a590 100644 --- a/code/tree_monadize.ml +++ b/code/tree_monadize.ml @@ -120,7 +120,7 @@ module Tree_monadizer(M : sig val unit : 'a -> 'a m val bind : 'a m -> ('a -> 'b m) -> 'b m end) = struct - let rec monadize (t: 'a tree) (f: 'a -> 'b M.monad) : 'b tree M.monad = + let rec monadize (f: 'a -> 'b M.m) (t: 'a tree) : 'b tree M.m = match t with | Leaf a -> M.bind (f a) (fun b -> M.unit (Leaf b)) | Node(l, r) -> @@ -130,7 +130,7 @@ end) = struct 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,9 +146,9 @@ module TreeList = Tree_monadizer(List_monad);; (* The Continuation monad is a bit more complicated *) module Continuation_monad = struct - type ('r,'a) monad = ('a -> 'r) -> 'r;; - let unit a : ('r,'a) monad = fun k -> k a;; - let bind (u: ('r,'a) monad) (f: 'a -> ('r,'b) monad) : ('r,'b) 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 @@ -158,13 +158,13 @@ end * Tree_monadizer2 that takes a ('r,'a) monad type constructor in its * parameter instead *) module Tree_monadizer2(M : sig - type ('r,'a) monad - val unit : 'a -> ('r,'a) monad - val bind : ('r,'a) monad -> ('a -> ('r,'b) monad) -> ('r,'b) monad + 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 (t: 'a tree) (f: 'a -> ('r,'b) M.monad) : ('r,'b tree) M.monad = + let rec monadize (f: 'a -> ('r,'b) M.m) (t: 'a tree) : ('r,'b tree) M.m = match t with | Leaf a -> M.bind (f a) (fun b -> M.unit (Leaf b)) | Node(l, r) -> @@ -184,23 +184,23 @@ module TreeCont = Tree_monadizer2(Continuation_monad);; *) -let get_int : int -> int Reader_monad.monad = +let asker : int -> int Reader_monad.m = fun (a : int) -> fun (env : int -> int) -> env a;; -(* get_int 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 t1 get_int env;; +TreeReader.monadize asker t1 env;; (* You can also avoid declaring a separate toplevel TreeReader module * (or even a separate Reader_monad module) by using one of these forms: * ... * let module T = Tree_monadizer(Reader_monad) in - * T.monadize t1 get_int env;; + * T.monadize asker t1 env;; * or: * ... * let env = fun i -> i + i in @@ -212,7 +212,7 @@ TreeReader.monadize t1 get_int env;; * fun e -> f (u e) e;; * end in * let module T = Tree_monadizer(Monad) in - * T.monadize t1 get_int env;; + * T.monadize asker t1 env;; * or: * ... * let module T = Tree_monadizer(struct @@ -222,17 +222,17 @@ TreeReader.monadize t1 get_int env;; * let bind (u : 'a m) (f : 'a -> 'b m) : 'b m = * fun e -> f (u e) e;; * end) in - * T.monadize t1 get_int env;; + * T.monadize asker t1 env;; *) (* square each leaf *) let env = fun i -> i * i in -TreeReader.monadize t1 get_int 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 @@ -240,56 +240,32 @@ let incrementer : int -> int State_monad.monad = (* count leaves *) let initial_store = 0 in -TreeState.monadize t1 incrementer initial_store;; +TreeState.monadize incrementer t1 initial_store;; (* replace leaves with list *) -TreeList.monadize t1 (fun i -> [ [i;i*i] ]);; +TreeList.monadize (fun i -> [ [i;i*i] ]) t1;; (* do nothing *) let initial_continuation = fun t -> t in -TreeCont.monadize t1 Continuation_monad.unit initial_continuation;; +TreeCont.monadize Continuation_monad.unit t1 initial_continuation;; (* convert tree to list of leaves *) let initial_continuation = fun t -> [] in -TreeCont.monadize t1 (fun a k -> a :: k a) initial_continuation;; +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 t1 (fun a k -> k (a*a)) initial_continuation;; +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 t1 (fun a k -> k [a; a*a]) initial_continuation;; +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 t1 (fun a k -> 1 + k a) initial_continuation;; +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) treeT_reader = - 'a tree reader;; - -let unit (a: 'a) : 'a tree reader = - reader_unit (Leaf a);; - -let rec bind (u : 'a tree_reader) (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'));; - - *)