X-Git-Url: http://lambda.jimpryor.net/git/gitweb.cgi?p=lambda.git;a=blobdiff_plain;f=code%2Fmonads.ml;h=be3753296e8cb599738cb5e73a5f53026cdfcfee;hp=b678a92c28a75c78e257e55a9979268477b09e3e;hb=10906eaaea38d130ae301688749a94e6450447c2;hpb=18ab1e2a09a6c59fd4385c7f83ba2acf11b90daa 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 ============";;