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
|
(* Unison file synchronizer: src/tree.ml *)
(* Copyright 1999-2018, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
type ('a, 'b) t =
Node of ('a * ('a, 'b) t) list * 'b option
| Leaf of 'b
type ('a, 'b) u =
{ anc: (('a, 'b) u * 'a) option;
node: 'b option;
children: ('a * ('a, 'b) t) list}
let start =
{anc = None; node = None; children = []}
let add t v =
{t with node = Some v}
let enter t n = {anc = Some (t, n); node = None; children = []}
let leave t =
match t with
{anc = Some (t, n); node = None; children = []} ->
t
| {anc = Some (t, n); node = Some v; children = []} ->
{t with children = (n, Leaf v) :: t.children}
| {anc = Some (t, n); node = v; children = l} ->
{t with children = (n, (Node (Safelist.rev l, v))) :: t.children}
| {anc = None} ->
invalid_arg "Tree.leave"
let finish t =
match t with
{anc = Some _} ->
invalid_arg "Tree.finish"
| {anc = None; node = Some v; children = []} ->
Leaf v
| {anc = None; node = v; children = l} ->
Node (Safelist.rev l, v)
let rec leave_all t =
if t.anc = None then t else leave_all (leave t)
let rec empty t =
{anc =
begin match t.anc with
Some (t', n) -> Some (empty t', n)
| None -> None
end;
node = None;
children = []}
let slice t =
(finish (leave_all t), empty t)
(****)
let is_empty t =
match t with
Node ([], None) -> true
| _ -> false
let rec map f g t =
match t with
Node (l, v) ->
Node (Safelist.map (fun (n, t') -> (f n, map f g t')) l,
match v with None -> None | Some v -> Some (g v))
| Leaf v ->
Leaf (g v)
let rec iteri t path pcons f =
match t with
Node (l, v) ->
begin match v with
Some v -> f path v
| None -> ()
end;
Safelist.iter (fun (n, t') -> iteri t' (pcons path n) pcons f) l
| Leaf v ->
f path v
let rec size_rec s t =
match t with
Node (l, v) ->
let s' = if v = None then s else s + 1 in
Safelist.fold_left (fun s (_, t') -> size_rec s t') s' l
| Leaf v ->
s + 1
let size t = size_rec 0 t
let rec flatten t path pcons result =
match t with
Leaf v ->
(path, v) :: result
| Node (l, v) ->
let rem =
Safelist.fold_right
(fun (name, t') rem ->
flatten t' (pcons path name) pcons rem)
l result
in
match v with
None -> rem
| Some v -> (path, v) :: rem
|
