File : a-cimutr.ads
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT LIBRARY COMPONENTS --
4 -- --
5 -- ADA.CONTAINERS.INDEFINITE_MULTIWAY_TREES --
6 -- --
7 -- S p e c --
8 -- --
9 -- Copyright (C) 2004-2015, Free Software Foundation, Inc. --
10 -- --
11 -- This specification is derived from the Ada Reference Manual for use with --
12 -- GNAT. The copyright notice above, and the license provisions that follow --
13 -- apply solely to the contents of the part following the private keyword. --
14 -- --
15 -- GNAT is free software; you can redistribute it and/or modify it under --
16 -- terms of the GNU General Public License as published by the Free Soft- --
17 -- ware Foundation; either version 3, or (at your option) any later ver- --
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
20 -- or FITNESS FOR A PARTICULAR PURPOSE. --
21 -- --
22 -- --
23 -- --
24 -- --
25 -- --
26 -- You should have received a copy of the GNU General Public License and --
27 -- a copy of the GCC Runtime Library Exception along with this program; --
28 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
29 -- <http://www.gnu.org/licenses/>. --
30 -- --
31 -- This unit was originally developed by Matthew J Heaney. --
32 ------------------------------------------------------------------------------
33
34 with Ada.Iterator_Interfaces;
35
36 with Ada.Containers.Helpers;
37 private with Ada.Finalization;
38 private with Ada.Streams;
39
40 generic
41 type Element_Type (<>) is private;
42
43 with function "=" (Left, Right : Element_Type) return Boolean is <>;
44
45 package Ada.Containers.Indefinite_Multiway_Trees is
46 pragma Annotate (CodePeer, Skip_Analysis);
47 pragma Preelaborate;
48 pragma Remote_Types;
49
50 type Tree is tagged private
51 with Constant_Indexing => Constant_Reference,
52 Variable_Indexing => Reference,
53 Default_Iterator => Iterate,
54 Iterator_Element => Element_Type;
55
56 pragma Preelaborable_Initialization (Tree);
57
58 type Cursor is private;
59 pragma Preelaborable_Initialization (Cursor);
60
61 Empty_Tree : constant Tree;
62
63 No_Element : constant Cursor;
64 function Has_Element (Position : Cursor) return Boolean;
65
66 package Tree_Iterator_Interfaces is new
67 Ada.Iterator_Interfaces (Cursor, Has_Element);
68
69 function Equal_Subtree
70 (Left_Position : Cursor;
71 Right_Position : Cursor) return Boolean;
72
73 function "=" (Left, Right : Tree) return Boolean;
74
75 function Is_Empty (Container : Tree) return Boolean;
76
77 function Node_Count (Container : Tree) return Count_Type;
78
79 function Subtree_Node_Count (Position : Cursor) return Count_Type;
80
81 function Depth (Position : Cursor) return Count_Type;
82
83 function Is_Root (Position : Cursor) return Boolean;
84
85 function Is_Leaf (Position : Cursor) return Boolean;
86
87 function Root (Container : Tree) return Cursor;
88
89 procedure Clear (Container : in out Tree);
90
91 function Element (Position : Cursor) return Element_Type;
92
93 procedure Replace_Element
94 (Container : in out Tree;
95 Position : Cursor;
96 New_Item : Element_Type);
97
98 procedure Query_Element
99 (Position : Cursor;
100 Process : not null access procedure (Element : Element_Type));
101
102 procedure Update_Element
103 (Container : in out Tree;
104 Position : Cursor;
105 Process : not null access procedure (Element : in out Element_Type));
106
107 type Constant_Reference_Type
108 (Element : not null access constant Element_Type) is private
109 with Implicit_Dereference => Element;
110
111 type Reference_Type
112 (Element : not null access Element_Type) is private
113 with Implicit_Dereference => Element;
114
115 function Constant_Reference
116 (Container : aliased Tree;
117 Position : Cursor) return Constant_Reference_Type;
118 pragma Inline (Constant_Reference);
119
120 function Reference
121 (Container : aliased in out Tree;
122 Position : Cursor) return Reference_Type;
123 pragma Inline (Reference);
124
125 procedure Assign (Target : in out Tree; Source : Tree);
126
127 function Copy (Source : Tree) return Tree;
128
129 procedure Move (Target : in out Tree; Source : in out Tree);
130
131 procedure Delete_Leaf
132 (Container : in out Tree;
133 Position : in out Cursor);
134
135 procedure Delete_Subtree
136 (Container : in out Tree;
137 Position : in out Cursor);
138
139 procedure Swap
140 (Container : in out Tree;
141 I, J : Cursor);
142
143 function Find
144 (Container : Tree;
145 Item : Element_Type) return Cursor;
146
147 -- This version of the AI:
148 -- 10-06-02 AI05-0136-1/07
149 -- declares Find_In_Subtree this way:
150 --
151 -- function Find_In_Subtree
152 -- (Container : Tree;
153 -- Item : Element_Type;
154 -- Position : Cursor) return Cursor;
155 --
156 -- It seems that the Container parameter is there by mistake, but we need
157 -- an official ruling from the ARG. ???
158
159 function Find_In_Subtree
160 (Position : Cursor;
161 Item : Element_Type) return Cursor;
162
163 -- This version of the AI:
164 -- 10-06-02 AI05-0136-1/07
165 -- declares Ancestor_Find this way:
166 --
167 -- function Ancestor_Find
168 -- (Container : Tree;
169 -- Item : Element_Type;
170 -- Position : Cursor) return Cursor;
171 --
172 -- It seems that the Container parameter is there by mistake, but we need
173 -- an official ruling from the ARG. ???
174
175 function Ancestor_Find
176 (Position : Cursor;
177 Item : Element_Type) return Cursor;
178
179 function Contains
180 (Container : Tree;
181 Item : Element_Type) return Boolean;
182
183 procedure Iterate
184 (Container : Tree;
185 Process : not null access procedure (Position : Cursor));
186
187 procedure Iterate_Subtree
188 (Position : Cursor;
189 Process : not null access procedure (Position : Cursor));
190
191 function Iterate (Container : Tree)
192 return Tree_Iterator_Interfaces.Forward_Iterator'Class;
193
194 function Iterate_Subtree (Position : Cursor)
195 return Tree_Iterator_Interfaces.Forward_Iterator'Class;
196
197 function Iterate_Children
198 (Container : Tree;
199 Parent : Cursor)
200 return Tree_Iterator_Interfaces.Reversible_Iterator'Class;
201
202 function Child_Count (Parent : Cursor) return Count_Type;
203
204 function Child_Depth (Parent, Child : Cursor) return Count_Type;
205
206 procedure Insert_Child
207 (Container : in out Tree;
208 Parent : Cursor;
209 Before : Cursor;
210 New_Item : Element_Type;
211 Count : Count_Type := 1);
212
213 procedure Insert_Child
214 (Container : in out Tree;
215 Parent : Cursor;
216 Before : Cursor;
217 New_Item : Element_Type;
218 Position : out Cursor;
219 Count : Count_Type := 1);
220
221 procedure Prepend_Child
222 (Container : in out Tree;
223 Parent : Cursor;
224 New_Item : Element_Type;
225 Count : Count_Type := 1);
226
227 procedure Append_Child
228 (Container : in out Tree;
229 Parent : Cursor;
230 New_Item : Element_Type;
231 Count : Count_Type := 1);
232
233 procedure Delete_Children
234 (Container : in out Tree;
235 Parent : Cursor);
236
237 procedure Copy_Subtree
238 (Target : in out Tree;
239 Parent : Cursor;
240 Before : Cursor;
241 Source : Cursor);
242
243 procedure Splice_Subtree
244 (Target : in out Tree;
245 Parent : Cursor;
246 Before : Cursor;
247 Source : in out Tree;
248 Position : in out Cursor);
249
250 procedure Splice_Subtree
251 (Container : in out Tree;
252 Parent : Cursor;
253 Before : Cursor;
254 Position : Cursor);
255
256 procedure Splice_Children
257 (Target : in out Tree;
258 Target_Parent : Cursor;
259 Before : Cursor;
260 Source : in out Tree;
261 Source_Parent : Cursor);
262
263 procedure Splice_Children
264 (Container : in out Tree;
265 Target_Parent : Cursor;
266 Before : Cursor;
267 Source_Parent : Cursor);
268
269 function Parent (Position : Cursor) return Cursor;
270
271 function First_Child (Parent : Cursor) return Cursor;
272
273 function First_Child_Element (Parent : Cursor) return Element_Type;
274
275 function Last_Child (Parent : Cursor) return Cursor;
276
277 function Last_Child_Element (Parent : Cursor) return Element_Type;
278
279 function Next_Sibling (Position : Cursor) return Cursor;
280
281 function Previous_Sibling (Position : Cursor) return Cursor;
282
283 procedure Next_Sibling (Position : in out Cursor);
284
285 procedure Previous_Sibling (Position : in out Cursor);
286
287 -- This version of the AI:
288 -- 10-06-02 AI05-0136-1/07
289 -- declares Iterate_Children this way:
290 --
291 -- procedure Iterate_Children
292 -- (Container : Tree;
293 -- Parent : Cursor;
294 -- Process : not null access procedure (Position : Cursor));
295 --
296 -- It seems that the Container parameter is there by mistake, but we need
297 -- an official ruling from the ARG. ???
298
299 procedure Iterate_Children
300 (Parent : Cursor;
301 Process : not null access procedure (Position : Cursor));
302
303 procedure Reverse_Iterate_Children
304 (Parent : Cursor;
305 Process : not null access procedure (Position : Cursor));
306
307 private
308
309 use Ada.Containers.Helpers;
310 package Implementation is new Generic_Implementation;
311 use Implementation;
312
313 type Tree_Node_Type;
314 type Tree_Node_Access is access all Tree_Node_Type;
315
316 type Children_Type is record
317 First : Tree_Node_Access;
318 Last : Tree_Node_Access;
319 end record;
320
321 type Element_Access is access all Element_Type;
322
323 type Tree_Node_Type is record
324 Parent : Tree_Node_Access;
325 Prev : Tree_Node_Access;
326 Next : Tree_Node_Access;
327 Children : Children_Type;
328 Element : Element_Access;
329 end record;
330
331 use Ada.Finalization;
332
333 -- The Count component of type Tree represents the number of nodes that
334 -- have been (dynamically) allocated. It does not include the root node
335 -- itself. As implementors, we decide to cache this value, so that the
336 -- selector function Node_Count can execute in O(1) time, in order to be
337 -- consistent with the behavior of the Length selector function for other
338 -- standard container library units. This does mean, however, that the
339 -- two-container forms for Splice_XXX (that move subtrees across tree
340 -- containers) will execute in O(n) time, because we must count the number
341 -- of nodes in the subtree(s) that get moved. (We resolve the tension
342 -- between Node_Count and Splice_XXX in favor of Node_Count, under the
343 -- assumption that Node_Count is the more common operation).
344
345 type Tree is new Controlled with record
346 Root : aliased Tree_Node_Type;
347 TC : aliased Tamper_Counts;
348 Count : Count_Type := 0;
349 end record;
350
351 overriding procedure Adjust (Container : in out Tree);
352
353 overriding procedure Finalize (Container : in out Tree) renames Clear;
354
355 use Ada.Streams;
356
357 procedure Write
358 (Stream : not null access Root_Stream_Type'Class;
359 Container : Tree);
360
361 for Tree'Write use Write;
362
363 procedure Read
364 (Stream : not null access Root_Stream_Type'Class;
365 Container : out Tree);
366
367 for Tree'Read use Read;
368
369 type Tree_Access is access all Tree;
370 for Tree_Access'Storage_Size use 0;
371
372 type Cursor is record
373 Container : Tree_Access;
374 Node : Tree_Node_Access;
375 end record;
376
377 procedure Write
378 (Stream : not null access Root_Stream_Type'Class;
379 Position : Cursor);
380
381 for Cursor'Write use Write;
382
383 procedure Read
384 (Stream : not null access Root_Stream_Type'Class;
385 Position : out Cursor);
386
387 for Cursor'Read use Read;
388
389 subtype Reference_Control_Type is Implementation.Reference_Control_Type;
390 -- It is necessary to rename this here, so that the compiler can find it
391
392 type Constant_Reference_Type
393 (Element : not null access constant Element_Type) is
394 record
395 Control : Reference_Control_Type :=
396 raise Program_Error with "uninitialized reference";
397 -- The RM says, "The default initialization of an object of
398 -- type Constant_Reference_Type or Reference_Type propagates
399 -- Program_Error."
400 end record;
401
402 procedure Read
403 (Stream : not null access Root_Stream_Type'Class;
404 Item : out Constant_Reference_Type);
405
406 for Constant_Reference_Type'Read use Read;
407
408 procedure Write
409 (Stream : not null access Root_Stream_Type'Class;
410 Item : Constant_Reference_Type);
411
412 for Constant_Reference_Type'Write use Write;
413
414 type Reference_Type
415 (Element : not null access Element_Type) is
416 record
417 Control : Reference_Control_Type :=
418 raise Program_Error with "uninitialized reference";
419 -- The RM says, "The default initialization of an object of
420 -- type Constant_Reference_Type or Reference_Type propagates
421 -- Program_Error."
422 end record;
423
424 procedure Read
425 (Stream : not null access Root_Stream_Type'Class;
426 Item : out Reference_Type);
427
428 for Reference_Type'Read use Read;
429
430 procedure Write
431 (Stream : not null access Root_Stream_Type'Class;
432 Item : Reference_Type);
433
434 for Reference_Type'Write use Write;
435
436 -- Three operations are used to optimize in the expansion of "for ... of"
437 -- loops: the Next(Cursor) procedure in the visible part, and the following
438 -- Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for
439 -- details.
440
441 function Pseudo_Reference
442 (Container : aliased Tree'Class) return Reference_Control_Type;
443 pragma Inline (Pseudo_Reference);
444 -- Creates an object of type Reference_Control_Type pointing to the
445 -- container, and increments the Lock. Finalization of this object will
446 -- decrement the Lock.
447
448 function Get_Element_Access
449 (Position : Cursor) return not null Element_Access;
450 -- Returns a pointer to the element designated by Position.
451
452 Empty_Tree : constant Tree := (Controlled with others => <>);
453
454 No_Element : constant Cursor := (others => <>);
455
456 end Ada.Containers.Indefinite_Multiway_Trees;