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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220 | with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Finalization;
with Agpl.Generic_Handle;
with Agpl.Smart_Access_Limited;
generic
type Node_Data (<>) is private;
type Child_Index (<>) is private;
with function "<" (L, R : Child_Index) return Boolean is <>;
-- Must be non-modular; it is internally used for sets of children
package Agpl.Containers.Unbounded_Trees is
pragma Preelaborate;
Log_Section : constant String := "agpl.containers.unbounded_trees";
type Tree is tagged private;
-- Because I haven't had the time to implement copying, but can be done
type Cursor is tagged private;
-- Used to navigate a tree. Basically a pointer to node.
function "+" (This : Cursor'Class) return Cursor; pragma Inline ("+");
function Equivalent (L, R : Cursor) return Boolean;
function "=" (L, R : Cursor) return Boolean renames Equivalent;
-- Cursors that point to a same element
function Find (From : Cursor; Data : Node_Data) return Cursor;
-- Search which node below From contains Data
generic
with function "=" (L, R : Node_Data) return Boolean is <>;
function Generic_Find (From : Cursor; Data : Node_Data) return Cursor;
function Has_Element (This : Cursor) return Boolean;
-- If this is false, there are two possibilities:
-- One, this is a node yet undefined: root, some null child.
-- In this case, the cursor is usable for insertions at this position.
-- Two, this may be an invalid "next sibling", which makes no sense.
-- Thus inserting using such a cursor will fail.
function Has_Position (This : Cursor) return Boolean;
-- A cursor may not have element, but still point to a valid position in
-- the tree (e.g. a to-be-child). This kind of cursor is useable for
-- insertions, while others without position aren't
function Index (This : Cursor) return Child_Index;
-- What it is in respect to parent.
-- Fails for root
function Is_Leaf (This : Cursor) return Boolean;
function Root (This : Tree) return Cursor'Class;
function First (This : Tree) return Cursor'Class renames Root;
function Last (This : Tree) return Cursor'Class;
function Root (This : Cursor) return not null access Tree'Class;
function Root_Tree (This : Cursor) return not null access Tree'Class renames Root;
function Root (This : Cursor) return Cursor;
function Root_Cursor (This : Cursor) return Cursor renames Root;
-- Gets the tree root of this node.
function Is_Root (This : Cursor) return Boolean;
function Element (This : Cursor) return Node_Data;
function Update (This : Cursor) return not null access Node_Data;
function Query (This : Cursor) return not null access constant Node_Data;
function Parent (This : Cursor) return Cursor;
function Has_Children (This : Cursor) return Boolean;
function Child_Count (This : Cursor) return Natural;
function Child (This : Cursor;
Which : Child_Index) return Cursor;
function First_Child (This : Cursor) return Cursor;
function Last_Child (This : Cursor) return Cursor;
function Previous_Sibling (This : Cursor) return Cursor;
function Next_Sibling (This : Cursor) return Cursor;
-- These two skip over null nodes.
procedure Insert (This : Cursor;
Data : Node_Data);
-- This must not have element
procedure Include (This : Cursor;
Data : Node_Data);
-- This may or not may have element.
procedure Insert (This : Cursor;
Src : Tree'Class);
-- Insert Src at This.
-- Src /= This.tree!
procedure Include (This : Cursor;
Src : Tree'Class);
procedure Copy (Src : Cursor'Class;
Dst : in out Tree);
-- Make a tree from another node.
procedure Clear (This : Cursor);
-- Cleanses from here downwards
procedure Iterate (This : Tree;
Query : not null access procedure (I : Cursor));
-- Preorder traversal
procedure Iterate_Children
(This : Cursor;
Query : not null access procedure (I : Cursor));
-- Only of immediate children!
generic
with function Precedes (L, R : Cursor) return Boolean is <>;
procedure Iterate_Ordered_Children
(This : Cursor;
Query : not null access procedure (I : Cursor));
-- Visits the children in a new given order.
-- The cursors passed to Precedes are of children nodes
-- O (n log n)
generic
with function Merge_Node (X, Y : Node_Data) return Node_Data;
procedure Merge (Dst : in out Tree;
Src : Tree);
generic
with function Image (X : Node_Data) return String is <>;
with function Image (Index : Child_Index) return String is <>;
Depth_Space : Positive := 2;
procedure Print (This : Tree);
-- Debug dump, Depth first.
private
package Data_Handles is new Generic_Handle (Node_Data);
type Data_Handle is new Data_Handles.Object with null record;
package Index_Handles is new Generic_Handle (Child_Index);
type Index_Handle is new Index_Handles.Object with null record;
type Tree_Access is access all Tree;
-- Pool : Gnat.Debug_Pools.Debug_Pool;
type Node (<>);
type Node_Access is access all Node;
-- for Node_Access'Storage_Pool use Pool;
package Node_Maps is
new Ada.Containers.Indefinite_Ordered_Maps (Child_Index, Node_Access);
type Node (Root : Tree_access;
Parent : Node_Access;
Is_Root : Boolean) is limited
record
Data : Data_Handle;
Children : Node_Maps.Map;
case Is_Root is
when False =>
Index : Index_Handle; -- Own position in respect to parent
when True => null;
end case;
end record;
procedure Clone (Pos : Cursor'Class;
Src : Node_Access);
-- Copy Src branch, making Dst its Tree, at Pos
procedure Replace_Data (This : in out Node;
Data : Node_Data);
-- type Dashit is new Ada.con
type Precursor (Is_Root : Boolean) is limited record
Root : Tree_Access;
Parent, Current : Node_Access;
case Is_Root is
when True => null;
when False =>
Index : Index_Handle;
end case;
end record;
type Precursor_Access is access all Precursor;
-- for Precursor_Access'Storage_Pool use Pool;
package Cursors is
new Agpl.Smart_Access_Limited (Precursor,
Precursor_Access,
"PreCursor");
type Cursor is new Cursors.Object with null record;
type Tree is new Ada.Finalization.Controlled with record
This : Tree_Access := Tree'Unrestricted_Access;
Root : Node_Access;
end record;
overriding
procedure Adjust (This : in out Tree);
overriding
procedure Finalize (This : in out Tree);
function Get_Root (This : Tree) return Cursor'Class renames Root;
end Agpl.Containers.Unbounded_Trees;
|