X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Ftree_monadize.ml;h=43ef659f0ad5162eabe0d915a8e90dccdab7ebb6;hp=c751b36e73426177958b2bfeccd3920eb703073a;hb=4528f489f93c2f44f573678dff7359d54d9f9672;hpb=6bdd5bdd6e49ead61951cecff822c161f28098ca diff --git a/code/tree_monadize.ml b/code/tree_monadize.ml index c751b36e..43ef659f 100644 --- a/code/tree_monadize.ml +++ b/code/tree_monadize.ml @@ -184,7 +184,7 @@ module TreeCont = Tree_monadizer2(Continuation_monad);; *) -let int_readerize : int -> int reader = +let int_readerize : int -> int Reader_monad.monad = fun (a : int) -> fun (env : int -> int) -> env a;; (* int_readerize takes an int and returns a Reader monad that @@ -196,13 +196,43 @@ let int_readerize : int -> int reader = let env = fun i -> i + i in TreeReader.monadize int_readerize 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: + * ... + * let module T = Tree_monadizer(Reader_monad) in + * T.monadize int_readerize 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 = + * fun e -> f (u e) e;; + * end in + * let module T = Tree_monadizer(Monad) in + * T.monadize int_readerize 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 = + * fun e -> f (u e) e;; + * end) in + * T.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 = +let incrementer : int -> int State_monad.monad = fun (a : int) -> fun s -> (a, s+1);; (* incrementer takes an 'a and returns it wrapped in a @@ -221,7 +251,7 @@ TreeList.monadize (fun i -> [ [i;i*i] ]) t1;; (* do nothing *) let initial_continuation = fun t -> t in -TreeCont.monadize cont_unit t1 initial_continuation;; +TreeCont.monadize Continuation_monad.unit t1 initial_continuation;; (* convert tree to list of leaves *) let initial_continuation = fun t -> [] in @@ -239,4 +269,27 @@ TreeCont.monadize (fun a k -> k [a; a*a]) t1 initial_continuation;; 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) 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'));; + + *)