4 let asker : char -> int Reader_custom.m =
5 fun (a : char) -> fun (env : char -> int) -> env a;;
7 let seed t = TR.monadize asker t;;
9 let v3 = TreeCont.monadize (fun a k ->
10 fun e -> k a (update_env e a)
11 ) tree seed (fun a -> 0);;
14 What's going on here? Our distributed function takes a leaf element `a`,
15 a continuation `k` (which takes leaf elements and environments), and an
16 environment `e`, and returns the result of passing the leaf element and
17 an updated environment to `k`.
19 As always, the seed function operates on trees of leaf elements where
20 the distributed function operated on leaf elements. So the seed function
21 takes a tree and a environment, and returns whatever you want.
23 What we want is a tree-reader, that is, a function from environments to
24 trees. Once this gets distributed over the tree using the
25 `TreeCont.monadize` function, we'll have a tree-reader that operates on
26 the updated environment instead of the initial environment (which we
27 still have to supply---it's the final `fun a -> 0`).
30 How can we build such a tree-reader? The same way we formerly turned a tree
31 of `int`s and an int-to-b-reader function into a b-tree-reader: using the `TR.monadize` function.
34 And `v3` is just what we were looking for:
36 Node (Leaf 2, Node (Leaf 1, Node (Leaf 1, Leaf 2))).
41 Now all of this should be implementable in the "monads.ml" library too. But as
42 I said earlier, the encapsulation enforced by that library may make it somewhat harder to work with.
45 module T = Tree_monad;;
46 module C = Continuation_monad;;
47 module S = State_monad(struct type store = char -> int end);;
48 module R = Reader_monad(struct type env = char -> int end);;
52 let tree = Some (T.Node(T.Leaf '1', T.Node(T.Leaf '2', T.Node(T.Leaf '3', T.Leaf '1'))));;
55 # let v0 = TC.(run_exn (distribute (fun a ->
56 C.(shift (fun k -> k a >>= fun v -> unit (1+v)))
57 ) tree)) (fun a -> 0);;
61 # let v1 = TC.(run_exn (distribute (fun a ->
62 C.(shift (fun k -> k a >>= fun ka ->
63 unit (fun e -> let e_prev = ka e in (update_env e_prev a))))
64 ) tree)) (fun t e -> e) (fun a -> 0);;
65 - : char -> int = <fun>
73 # let annotater : char -> ('x, char) S.m =
74 fun a -> S.(puts (fun s -> (update_env s a)) >> unit a);;
75 # let v2 = TS.(run (distribute annotater tree)) (fun a -> 0);;
76 # let (t, env) = v2 in TR.(run (distribute (fun a -> R.asks (fun e -> e a)) t)) env;;
78 (* returns tree with leafs replaced with their numbers of occurrences *)
81 # let v3 = TC.(run_exn (distribute (fun a ->
82 C.(shift (fun k -> k a >>= fun ka ->
83 unit (fun e -> ka (update_env e a))))
85 TR.(run(distribute (fun a -> R.asks (fun e -> e a)) (Some t)))
88 (* also returns tree with leafs replaced with their numbers of occurrences *)