From 10906eaaea38d130ae301688749a94e6450447c2 Mon Sep 17 00:00:00 2001 From: Jim Pryor Date: Mon, 13 Dec 2010 01:25:39 -0500 Subject: [PATCH] transformers finish Signed-off-by: Jim Pryor --- code/monads.ml | 126 +----------------------------- monad_transformers.mdwn | 198 ++++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 195 insertions(+), 129 deletions(-) diff --git a/code/monads.ml b/code/monads.ml index b678a92c..be375329 100644 --- a/code/monads.ml +++ b/code/monads.ml @@ -1063,91 +1063,12 @@ end = struct include BaseT let distribute f t = mapT (fun a -> elevate (f a)) t zero plus end -end - - -module L = List_monad;; -module R = Reader_monad(struct type env = int -> int end);; -module S = State_monad(struct type store = int end);; -module T = Tree_monad;; -module LR = L.T(R);; -module LS = L.T(S);; -module TL = T.T(L);; -module TR = T.T(R);; -module TS = T.T(S);; -module C = Continuation_monad -module TC = T.T(C);; - - -print_endline "=== test TreeT(...).distribute ==================";; - -let t1 = Some (T.Node (T.Node (T.Leaf 2, T.Leaf 3), T.Node (T.Leaf 5, T.Node (T.Leaf 7, T.Leaf 11))));; - -let ts = TS.distribute (fun i -> S.(puts succ >> unit i)) t1;; -TS.run ts 0;; -(* -- : int T.tree option * S.store = -(Some - (T.Node - (T.Node (T.Leaf 2, T.Leaf 3), - T.Node (T.Leaf 5, T.Node (T.Leaf 7, T.Leaf 11)))), - 5) -*) - -let ts2 = TS.distribute (fun i -> S.(puts succ >> get >>= fun n -> unit (i,n))) t1;; -TS.run_exn ts2 0;; -(* -- : (int * S.store) T.tree option * S.store = -(Some - (T.Node - (T.Node (T.Leaf (2, 1), T.Leaf (3, 2)), - T.Node (T.Leaf (5, 3), T.Node (T.Leaf (7, 4), T.Leaf (11, 5))))), - 5) -*) - -let tr = TR.distribute (fun i -> R.asks (fun e -> e i)) t1;; -TR.run_exn tr (fun i -> i+i);; -(* -- : int T.tree option = -Some - (T.Node - (T.Node (T.Leaf 4, T.Leaf 6), - T.Node (T.Leaf 10, T.Node (T.Leaf 14, T.Leaf 22)))) -*) +end;; -let tl = TL.distribute (fun i -> L.(unit (i,i+1))) t1;; -TL.run_exn tl;; -(* -- : (int * int) TL.result = -[Some - (T.Node - (T.Node (T.Leaf (2, 3), T.Leaf (3, 4)), - T.Node (T.Leaf (5, 6), T.Node (T.Leaf (7, 8), T.Leaf (11, 12)))))] -*) -let l2 = [1;2;3;4;5];; -let t2 = Some (T.Node (T.Leaf 1, (T.Node (T.Node (T.Node (T.Leaf 2, T.Leaf 3), T.Leaf 4), T.Leaf 5))));; -LR.(run (distribute (fun i -> R.(asks (fun e -> e i))) l2 >>= fun j -> LR.(plus (unit j) (unit (succ j))))) (fun i -> i*10);; -(* int list = [10; 11; 20; 21; 30; 31; 40; 41; 50; 51] *) +module C = Continuation_monad;; -TR.(run_exn (distribute (fun i -> R.(asks (fun e -> e i))) t2 >>= fun j -> TR.(plus (unit j) (unit (succ j))))) (fun i -> i*10);; -(* -int T.tree option = -Some - (T.Node - (T.Node (T.Leaf 10, T.Leaf 11), - T.Node - (T.Node - (T.Node (T.Node (T.Leaf 20, T.Leaf 21), T.Node (T.Leaf 30, T.Leaf 31)), - T.Node (T.Leaf 40, T.Leaf 41)), - T.Node (T.Leaf 50, T.Leaf 51)))) - *) - -LS.run (LS.distribute (fun i -> if i = -1 then S.get else if i < 0 then S.(puts succ >> unit 0) else S.unit i) [10;-1;-2;-1;20]) 0;; -(* -- : S.store list * S.store = ([10; 0; 0; 1; 20], 1) -*) print_endline "=== test TreeT(Continuation).distribute ==================";; @@ -1208,49 +1129,6 @@ print_endline "=== test bare Continuation ============";; ((111,0), (0,0));; (example ~+10, example ~-10);; -let testc df ic = - C.run_exn TC.(run (distribute df t1)) ic;; - - -(* -(* do nothing *) -let initial_continuation = fun t -> t in -TreeCont.monadize t1 Continuation_monad.unit initial_continuation;; -*) -testc (C.unit) id;; - -(* -(* count leaves, using continuation *) -let initial_continuation = fun t -> 0 in -TreeCont.monadize t1 (fun a k -> 1 + k a) initial_continuation;; -*) - -testc C.(fun a -> shift (fun k -> k a >>= fun v -> unit (1 + v))) (fun t -> 0);; - -(* -(* convert tree to list of leaves *) -let initial_continuation = fun t -> [] in -TreeCont.monadize t1 (fun a k -> a :: k a) initial_continuation;; -*) - -testc C.(fun a -> shift (fun k -> k a >>= fun v -> unit (a::v))) (fun t -> ([] : int list));; - -(* -(* square each leaf using continuation *) -let initial_continuation = fun t -> t in -TreeCont.monadize t1 (fun a k -> k (a*a)) initial_continuation;; -*) - -testc C.(fun a -> shift (fun k -> k (a*a))) (fun t -> t);; - - -(* -(* 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;; -*) - -testc C.(fun a -> shift (fun k -> k (a,a+1))) (fun t -> t);; print_endline "=== pa_monad's Continuation Tests ============";; diff --git a/monad_transformers.mdwn b/monad_transformers.mdwn index 3b5312c1..b40661a8 100644 --- a/monad_transformers.mdwn +++ b/monad_transformers.mdwn @@ -287,15 +287,203 @@ You have to instead say something like this: How is all this related to our tree\_monadize function? ------------------------------------------------------- +Our Tree monad has a corresponding TreeT transformer. Simplified, its implementation looks something like this (we apply it to an inner Reader monad): + + + type 'a tree_reader = 'a tree reader;; + (* really it's an 'a tree option reader, but as I said we're simplifying *) + + let tree_reader_unit (a:'a) : 'a tree_reader = reader_unit (Leaf a);; + + let tree_reader_bind (u: 'a tree_reader) (f: 'a -> 'b tree_reader) : 'b tree_reader = + reader_bind u (fun us -> + let rec loop us = match us with + | Leaf a -> + f a + | Node(l,r) -> + reader_bind (loop l) (fun ls -> + reader_bind (loop r) (fun rs -> + reader_unit (Node(ls, rs)))) + in loop us);; + + let tree_reader_elevate (w : 'a reader) : 'a tree_reader = + reader_bind w (fun a -> reader_unit (Leaf a)) + Recall our earlier definition of `tree_monadize`, specialized for the Reader monad: let rec tree_monadize (f : 'a -> 'b reader) (t : 'a tree) : 'b tree reader = match t with - | Leaf a -> reader_bind (f a) (fun b -> reader_unit (Leaf b)) - | Node (l, r) -> reader_bind (tree_monadize f l) (fun l' -> - reader_bind (tree_monadize f r) (fun r' -> - reader_unit (Node (l', r'))));; + | Leaf a -> + (* the next line is equivalent to: tree_reader_elevate (f a) *) + reader_bind (f a) (fun b -> reader_unit (Leaf b)) + | Node (l, r) -> + reader_bind (tree_monadize f l) (fun l' -> + reader_bind (tree_monadize f r) (fun r' -> + reader_unit (Node (l', r'))));; + +We rendered the result type here as `'b tree reader`, as we did in our earlier discussion, but as we can see from the above implementation of TreeT(Reader), that's the type of an `'b tree_reader`, that is, of a layered box consisting of TreeT packaging wrapped around an inner Reader box. + +The definitions of `tree_monadize` and `tree_reader_bind` should look very similar. They're not quite the same. There's the difference in the order of their function-like and tree-like arguments, but that's inconsequential. More important is that the types of their arguments differs. `tree_reader_bind` wants a tree that's already fused with a reader; `tree_monadize` instead just wants a plain tree. `tree_reader_bind` wants a function that takes the elements occupying its leaves into other `tree_reader`s; `tree_monadize` just wants it to take them into plain `reader`s. That's why the application of `f` to `a` has to be `elevate`d in the `tree_monadize` clause for `Leaf a -> ...`. + +But there is an obvious common structure to these two functions, and indeed in the [[monad library]] their more complicated cousins are defined in terms of common pieces. In the monad library, the `tree_monadize` function is called `distribute`; this is an operation living inside the TreeT packaging. There's an analogous `distribute` function living inside the ListT packaging. (Haskell has the second but not the first; it calls it `mapM` and it lives inside the wrapped base monad, instead of the List packaging.) + +We linked to [some code](/code/tree_monadize.ml) earlier that demonstrated all the `tree_monadize` examples in a compact way. + +Here's how to demonstrate the same examples, using the monad library. First, preliminaries: + + # #use "path/to/monads.ml";; + # module T = Tree_monad;; + # module R = Reader_monad(struct type env = int -> int end);; + # module S = State_monad(struct type store = int end);; + # module L = List_monad;; + # module C = Continuation_monad;; + # module TR = T.T(R);; + # module TS = T.T(S);; + # module TL = T.T(L);; + # module TC = T.T(C);; + # let t1 = Some (T.Node (T.Node (T.Leaf 2, T.Leaf 3), T.Node (T.Leaf 5, T.Node (T.Leaf 7, T.Leaf 11))));; + +We can use TreeT(Reader) to modify leaves: + + # let tree_reader = TR.distribute (fun i -> R.asks (fun e -> e i)) t1;; + # TR.run tree_reader (fun i -> i+i);; + (* + - : int T.tree option = + Some + (T.Node + (T.Node (T.Leaf 4, T.Leaf 6), + T.Node (T.Leaf 10, T.Node (T.Leaf 14, T.Leaf 22)))) + *) + +Here's a comparison of how distribute works for trees and how it works for lists: + + # module LR = L.T(R);; + # let l1 = [2; 3; 5; 7; 11];; + # LR.(run (distribute (fun i -> R.(asks (fun e -> e i))) l1)) (fun i -> i+i);; + - : int list = [4; 6; 10; 14; 22] + + + +We can use TreeT(State) to count leaves: + + # let tree_counter = TS.distribute (fun i -> S.(puts succ >> unit i)) t1 in + TS.run tree_counter 0;; + (* + - : int T.tree option * S.store = + (Some + (T.Node + (T.Node (T.Leaf 2, T.Leaf 3), + T.Node (T.Leaf 5, T.Node (T.Leaf 7, T.Leaf 11)))), + 5) + *) + +or to annotate leaves: + + # let tree_annotater = TS.distribute (fun i -> S.(puts succ >> get >>= fun s -> unit (i,s))) t1 in + TS.run tree_annotater 0;; + - : (int * S.store) T.tree option * S.store = + (Some + (T.Node + (T.Node (T.Leaf (2, 1), T.Leaf (3, 2)), + T.Node (T.Leaf (5, 3), T.Node (T.Leaf (7, 4), T.Leaf (11, 5))))), + 5) + +Here's a comparison of how distribute works for trees and how it works for lists: + + # module LS = L.T(S);; + + # let list_counter = LS.distribute (fun i -> S.(puts succ >> unit i)) l1 in + LS.run list_counter 0;; + - : int list * S.store = ([2; 3; 5; 7; 11], 5) + + # let list_annotater = LS.distribute (fun i -> S.(puts succ >> get >>= fun s -> unit (i,s) )) l1 in + LS.run list_annotater 0;; + - : (int * S.store) list * S.store = + ([(2, 1); (3, 2); (5, 3); (7, 4); (11, 5)], 5) + + + + + +We can use TreeT(List) to copy the tree with different choices for some of the leaves: + + # let tree_chooser = TL.distribute (fun i -> L.(if i = 2 then plus (unit 20) (unit 21) else unit i)) t1;; + # TL.run tree_chooser;; + - : ('_a, int) TL.result = + [Some + (T.Node + (T.Node (T.Leaf 20, T.Leaf 3), + T.Node (T.Leaf 5, T.Node (T.Leaf 7, T.Leaf 11)))); + Some + (T.Node + (T.Node (T.Leaf 21, T.Leaf 3), + T.Node (T.Leaf 5, T.Node (T.Leaf 7, T.Leaf 11))))] + + +Finally, we use TreeT(Continuation) to do various things. For reasons I won't explain here, the library currently requires you to run the Tree-plus-Continuation bundle using a different sequence of `run` commands: + +We can do nothing: + + + # C.run_exn TC.(run (distribute C.unit t1)) (fun t -> t);; + - : int T.tree option = + Some + (T.Node + (T.Node (T.Leaf 2, T.Leaf 3), + T.Node (T.Leaf 5, T.Node (T.Leaf 7, T.Leaf 11)))) + +We can square each leaf. The meaning of `shift` will be explained in [[CPS and Continuation Operators]]. + + + # C.run_exn TC.(run (distribute C.(fun a -> shift (fun k -> k (a*a))) t1)) (fun t -> t);; + - : int T.tree option = + Some + (T.Node + (T.Node (T.Leaf 4, T.Leaf 9), + T.Node (T.Leaf 25, T.Node (T.Leaf 49, T.Leaf 121)))) + +We can count the leaves: + + + # C.run_exn TC.(run (distribute C.(fun a -> shift (fun k -> k a >>= fun v -> unit (1+v))) t1)) (fun t -> 0);; + - : int = 5 + + +We can convert the tree to a list of leaves: + + # C.run_exn TC.(run (distribute C.(fun a -> shift (fun k -> k a >>= fun v -> unit (a::v))) t1)) (fun t -> []);; + - : int list = [2; 3; 5; 7; 11] -(MORE...) -- 2.11.0