1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
open Node_type
module Iter : sig
(** Iteration. Parent nodes are iterated before their subnodes.
*)
type state
val iter :
(t -> [`Continue of view | `Return of unit ]) ->
t -> unit
val iter_interleaved :
(t -> [`Continue of view | `Return of unit ]) ->
t ->
(state -> [`Left of state | `Right of unit ]) * state
end = struct
type job = t
type state = job list
let step enter js =
match js with
| [] -> `Right ()
| n::js ->
match enter n with
| `Return () -> `Left js
| `Continue v ->
match v with
| Leaf _ -> `Left js
| Bud (None, _, _) -> `Left js
| Bud (Some n, _, _) ->
`Left (n :: js)
| Extender (_, n, _, _) ->
`Left (n :: js)
| Internal (nl, nr, _, _) ->
`Left (nl :: nr :: js)
let iter_interleaved enter n =
let js = [n] in
let stepper x = step enter x in
stepper, js
let iter enter n =
let rec loop js = match step enter js with
| `Right res -> res
| `Left js -> loop js
in
loop [n]
end
module Map : sig
type state
val map :
enter:(t -> [`Continue of view | `Return of t ]) ->
leave:(org:view -> view -> t) ->
t -> t
val map_interleaved :
enter:(t -> [`Continue of view | `Return of t ]) ->
leave:(org:view -> view -> t) ->
t ->
(state -> [`Left of state | `Right of t ]) * state
end = struct
type job =
| Do of t
| BudSome of view
| Extender of view * Segment.t
| Internal of view
type state = job list * t list
let step ~enter ~leave (js, ns) =
match js, ns with
| [], [n] -> `Right n
| [], _ -> assert false
| BudSome v::js, n::ns ->
let v' = _Bud (Some n, Not_Indexed, Not_Hashed) in
let n = leave ~org:v v' in
`Left (js, (n::ns))
| Extender (v, seg)::js, n::ns ->
let v' = _Extender (seg, n, Not_Indexed, Not_Hashed) in
let n = leave ~org:v v' in
`Left (js, (n::ns))
| Internal v::js, nr::nl::ns ->
let v' = _Internal (nl, nr, Not_Indexed, Not_Hashed) in
let n = leave ~org:v v' in
`Left (js, (n::ns))
| (BudSome _ | Extender _ | Internal _)::_, _ -> assert false
| Do n::js, ns ->
match enter n with
| `Return n -> `Left (js, (n::ns))
| `Continue v ->
match v with
| Leaf _ ->
let n = leave ~org:v v in
`Left (js, n::ns)
| Bud (None, _, _) ->
let n = leave ~org:v v in
`Left (js, n::ns)
| Bud (Some n, _, _) ->
`Left ((Do n :: BudSome v :: js), ns)
| Extender (seg, n, _, _) ->
`Left ((Do n :: Extender (v, seg) :: js), ns)
| Internal (nl, nr, _, _) ->
`Left ((Do nl :: Do nr :: Internal v :: js), ns)
let map_interleaved ~enter ~leave n =
let js_ss = [Do n], [] in
let stepper x = step ~enter ~leave x in
stepper, js_ss
let map ~enter ~leave n =
let rec loop js_ss = match step ~enter ~leave js_ss with
| `Right res -> res
| `Left js_ss -> loop js_ss
in
loop ([Do n], [])
end