X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Ftree_monadize.ml;h=d23606f95e3dd1c31870aa9a770f9be06d4be56e;hp=7c419a342402ce77a965eb1c2810e4b332cdfcde;hb=ebe5f10b42f512f81bfc9e4c19c361b3010c72f9;hpb=ff95f5a38d61a6fa0b9c5e4da4253a6a3266a7dc diff --git a/code/tree_monadize.ml b/code/tree_monadize.ml index 7c419a34..d23606f9 100644 --- a/code/tree_monadize.ml +++ b/code/tree_monadize.ml @@ -115,12 +115,12 @@ let t1 = Node 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 *) + * for unit and bind, as well as a monadic type constructor *) 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 X.monad) (t: 'a tree) : 'b tree X.monad = + let rec monadize (t: 'a tree) (f: 'a -> 'b X.monad) : 'b tree X.monad = match t with | Leaf a -> X.bind (f a) (fun b -> X.unit (Leaf b)) | Node(l, r) -> @@ -164,7 +164,7 @@ module Tree_monadizer2(X : sig 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 (t: 'a tree) (f: 'a -> ('b,'x) X.monad) : ('b tree,'x) X.monad = match t with | Leaf a -> X.bind (f a) (fun b -> X.unit (Leaf b)) | Node(l, r) -> @@ -194,13 +194,13 @@ let int_readerize : int -> int Reader_monad.monad = (* double each leaf *) let env = fun i -> i + i in -TreeReader.monadize int_readerize t1 env;; +TreeReader.monadize t1 int_readerize 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 t1 int_readerize env;; * or: * ... * let env = fun i -> i + i in @@ -212,7 +212,7 @@ TreeReader.monadize int_readerize t1 env;; * fun e -> f (u e) e;; * end in * let module T = Tree_monadizer(Monad) in - * T.monadize int_readerize t1 env;; + * T.monadize t1 int_readerize env;; * or: * ... * let module T = Tree_monadizer(struct @@ -222,13 +222,13 @@ TreeReader.monadize int_readerize t1 env;; * 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;; + * T.monadize t1 int_readerize env;; *) (* square each leaf *) let env = fun i -> i * i in -TreeReader.monadize int_readerize t1 env;; +TreeReader.monadize t1 int_readerize env;; @@ -240,32 +240,56 @@ let incrementer : int -> int State_monad.monad = (* count leaves *) let initial_store = 0 in -TreeState.monadize incrementer t1 initial_store;; +TreeState.monadize t1 incrementer initial_store;; (* replace leaves with list *) -TreeList.monadize (fun i -> [ [i;i*i] ]) t1;; +TreeList.monadize t1 (fun i -> [ [i;i*i] ]);; (* do nothing *) let initial_continuation = fun t -> t in -TreeCont.monadize Continuation_monad.unit t1 initial_continuation;; +TreeCont.monadize t1 Continuation_monad.unit 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;; +TreeCont.monadize t1 (fun a k -> a :: k a) initial_continuation;; (* square each leaf using continuation *) let initial_continuation = fun t -> t in -TreeCont.monadize (fun a k -> k (a*a)) t1 initial_continuation;; +TreeCont.monadize t1 (fun a k -> k (a*a)) initial_continuation;; (* replace leaves with list, using continuation *) let initial_continuation = fun t -> t in -TreeCont.monadize (fun a k -> k [a; a*a]) t1 initial_continuation;; +TreeCont.monadize t1 (fun a k -> k [a; a*a]) initial_continuation;; (* count leaves, using continuation *) let initial_continuation = fun t -> 0 in -TreeCont.monadize (fun a k -> 1 + k a) t1 initial_continuation;; +TreeCont.monadize t1 (fun a k -> 1 + k a) 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'));; + + *)