1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.INDEFINITE_MULTIWAY_TREES --
9 -- Copyright (C) 2004-2024, Free Software Foundation, Inc. --
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. --
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. --
22 -- As a special exception under Section 7 of GPL version 3, you are granted --
23 -- additional permissions described in the GCC Runtime Library Exception, --
24 -- version 3.1, as published by the Free Software Foundation. --
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/>. --
31 -- This unit was originally developed by Matthew J Heaney. --
32 ------------------------------------------------------------------------------
34 with Ada
.Iterator_Interfaces
;
36 with Ada
.Containers
.Helpers
;
37 private with Ada
.Finalization
;
38 private with Ada
.Streams
;
39 private with Ada
.Strings
.Text_Buffers
;
42 type Element_Type
(<>) is private;
44 with function "=" (Left
, Right
: Element_Type
) return Boolean is <>;
46 package Ada
.Containers
.Indefinite_Multiway_Trees
with
49 pragma Annotate
(CodePeer
, Skip_Analysis
);
53 type Tree
is tagged private
54 with Constant_Indexing
=> Constant_Reference
,
55 Variable_Indexing
=> Reference
,
56 Default_Iterator
=> Iterate
,
57 Iterator_Element
=> Element_Type
;
59 pragma Preelaborable_Initialization
(Tree
);
61 type Cursor
is private;
62 pragma Preelaborable_Initialization
(Cursor
);
64 Empty_Tree
: constant Tree
;
66 No_Element
: constant Cursor
;
67 function Has_Element
(Position
: Cursor
) return Boolean;
69 package Tree_Iterator_Interfaces
is new
70 Ada
.Iterator_Interfaces
(Cursor
, Has_Element
);
72 function Equal_Subtree
73 (Left_Position
: Cursor
;
74 Right_Position
: Cursor
) return Boolean;
76 function "=" (Left
, Right
: Tree
) return Boolean;
78 function Is_Empty
(Container
: Tree
) return Boolean;
80 function Node_Count
(Container
: Tree
) return Count_Type
;
82 function Subtree_Node_Count
(Position
: Cursor
) return Count_Type
;
84 function Depth
(Position
: Cursor
) return Count_Type
;
86 function Is_Root
(Position
: Cursor
) return Boolean;
88 function Is_Leaf
(Position
: Cursor
) return Boolean;
90 function Root
(Container
: Tree
) return Cursor
;
92 procedure Clear
(Container
: in out Tree
);
94 function Element
(Position
: Cursor
) return Element_Type
;
96 procedure Replace_Element
97 (Container
: in out Tree
;
99 New_Item
: Element_Type
);
101 procedure Query_Element
103 Process
: not null access procedure (Element
: Element_Type
));
105 procedure Update_Element
106 (Container
: in out Tree
;
108 Process
: not null access procedure (Element
: in out Element_Type
));
110 type Constant_Reference_Type
111 (Element
: not null access constant Element_Type
) is private
112 with Implicit_Dereference
=> Element
;
115 (Element
: not null access Element_Type
) is private
116 with Implicit_Dereference
=> Element
;
118 function Constant_Reference
119 (Container
: aliased Tree
;
120 Position
: Cursor
) return Constant_Reference_Type
;
121 pragma Inline
(Constant_Reference
);
124 (Container
: aliased in out Tree
;
125 Position
: Cursor
) return Reference_Type
;
126 pragma Inline
(Reference
);
128 procedure Assign
(Target
: in out Tree
; Source
: Tree
);
130 function Copy
(Source
: Tree
) return Tree
;
132 procedure Move
(Target
: in out Tree
; Source
: in out Tree
);
134 procedure Delete_Leaf
135 (Container
: in out Tree
;
136 Position
: in out Cursor
);
138 procedure Delete_Subtree
139 (Container
: in out Tree
;
140 Position
: in out Cursor
);
143 (Container
: in out Tree
;
148 Item
: Element_Type
) return Cursor
;
150 -- This version of the AI:
151 -- 10-06-02 AI05-0136-1/07
152 -- declares Find_In_Subtree this way:
154 -- function Find_In_Subtree
155 -- (Container : Tree;
156 -- Item : Element_Type;
157 -- Position : Cursor) return Cursor;
159 -- It seems that the Container parameter is there by mistake, but we need
160 -- an official ruling from the ARG. ???
162 function Find_In_Subtree
164 Item
: Element_Type
) return Cursor
;
166 -- This version of the AI:
167 -- 10-06-02 AI05-0136-1/07
168 -- declares Ancestor_Find this way:
170 -- function Ancestor_Find
171 -- (Container : Tree;
172 -- Item : Element_Type;
173 -- Position : Cursor) return Cursor;
175 -- It seems that the Container parameter is there by mistake, but we need
176 -- an official ruling from the ARG. ???
178 function Ancestor_Find
180 Item
: Element_Type
) return Cursor
;
184 Item
: Element_Type
) return Boolean;
188 Process
: not null access procedure (Position
: Cursor
));
190 procedure Iterate_Subtree
192 Process
: not null access procedure (Position
: Cursor
));
194 function Iterate
(Container
: Tree
)
195 return Tree_Iterator_Interfaces
.Forward_Iterator
'Class;
197 function Iterate_Subtree
(Position
: Cursor
)
198 return Tree_Iterator_Interfaces
.Forward_Iterator
'Class;
200 function Iterate_Children
203 return Tree_Iterator_Interfaces
.Reversible_Iterator
'Class;
205 function Child_Count
(Parent
: Cursor
) return Count_Type
;
207 function Child_Depth
(Parent
, Child
: Cursor
) return Count_Type
;
209 procedure Insert_Child
210 (Container
: in out Tree
;
213 New_Item
: Element_Type
;
214 Count
: Count_Type
:= 1);
216 procedure Insert_Child
217 (Container
: in out Tree
;
220 New_Item
: Element_Type
;
221 Position
: out Cursor
;
222 Count
: Count_Type
:= 1);
224 procedure Prepend_Child
225 (Container
: in out Tree
;
227 New_Item
: Element_Type
;
228 Count
: Count_Type
:= 1);
230 procedure Append_Child
231 (Container
: in out Tree
;
233 New_Item
: Element_Type
;
234 Count
: Count_Type
:= 1);
236 procedure Delete_Children
237 (Container
: in out Tree
;
240 procedure Copy_Subtree
241 (Target
: in out Tree
;
246 procedure Splice_Subtree
247 (Target
: in out Tree
;
250 Source
: in out Tree
;
251 Position
: in out Cursor
);
253 procedure Splice_Subtree
254 (Container
: in out Tree
;
259 procedure Splice_Children
260 (Target
: in out Tree
;
261 Target_Parent
: Cursor
;
263 Source
: in out Tree
;
264 Source_Parent
: Cursor
);
266 procedure Splice_Children
267 (Container
: in out Tree
;
268 Target_Parent
: Cursor
;
270 Source_Parent
: Cursor
);
272 function Parent
(Position
: Cursor
) return Cursor
;
274 function First_Child
(Parent
: Cursor
) return Cursor
;
276 function First_Child_Element
(Parent
: Cursor
) return Element_Type
;
278 function Last_Child
(Parent
: Cursor
) return Cursor
;
280 function Last_Child_Element
(Parent
: Cursor
) return Element_Type
;
282 function Next_Sibling
(Position
: Cursor
) return Cursor
;
284 function Previous_Sibling
(Position
: Cursor
) return Cursor
;
286 procedure Next_Sibling
(Position
: in out Cursor
);
288 procedure Previous_Sibling
(Position
: in out Cursor
);
290 -- This version of the AI:
291 -- 10-06-02 AI05-0136-1/07
292 -- declares Iterate_Children this way:
294 -- procedure Iterate_Children
295 -- (Container : Tree;
297 -- Process : not null access procedure (Position : Cursor));
299 -- It seems that the Container parameter is there by mistake, but we need
300 -- an official ruling from the ARG. ???
302 procedure Iterate_Children
304 Process
: not null access procedure (Position
: Cursor
));
306 procedure Reverse_Iterate_Children
308 Process
: not null access procedure (Position
: Cursor
));
312 use Ada
.Containers
.Helpers
;
313 package Implementation
is new Generic_Implementation
;
317 type Tree_Node_Access
is access all Tree_Node_Type
;
319 type Children_Type
is record
320 First
: Tree_Node_Access
;
321 Last
: Tree_Node_Access
;
324 type Element_Access
is access all Element_Type
;
326 type Tree_Node_Type
is record
327 Parent
: Tree_Node_Access
;
328 Prev
: Tree_Node_Access
;
329 Next
: Tree_Node_Access
;
330 Children
: Children_Type
;
331 Element
: Element_Access
;
334 use Ada
.Finalization
;
336 -- The Count component of type Tree represents the number of nodes that
337 -- have been (dynamically) allocated. It does not include the root node
338 -- itself. As implementors, we decide to cache this value, so that the
339 -- selector function Node_Count can execute in O(1) time, in order to be
340 -- consistent with the behavior of the Length selector function for other
341 -- standard container library units. This does mean, however, that the
342 -- two-container forms for Splice_XXX (that move subtrees across tree
343 -- containers) will execute in O(n) time, because we must count the number
344 -- of nodes in the subtree(s) that get moved. (We resolve the tension
345 -- between Node_Count and Splice_XXX in favor of Node_Count, under the
346 -- assumption that Node_Count is the more common operation).
348 type Tree
is new Controlled
with record
349 Root
: aliased Tree_Node_Type
;
350 TC
: aliased Tamper_Counts
;
351 Count
: Count_Type
:= 0;
352 end record with Put_Image
=> Put_Image
;
355 (S
: in out Ada
.Strings
.Text_Buffers
.Root_Buffer_Type
'Class; V
: Tree
);
357 overriding
procedure Adjust
(Container
: in out Tree
);
359 overriding
procedure Finalize
(Container
: in out Tree
) renames Clear
;
364 (Stream
: not null access Root_Stream_Type
'Class;
367 for Tree
'Write use Write
;
370 (Stream
: not null access Root_Stream_Type
'Class;
371 Container
: out Tree
);
373 for Tree
'Read use Read
;
375 type Tree_Access
is access all Tree
;
376 for Tree_Access
'Storage_Size use 0;
378 type Cursor
is record
379 Container
: Tree_Access
;
380 Node
: Tree_Node_Access
;
384 (Stream
: not null access Root_Stream_Type
'Class;
387 for Cursor
'Write use Write
;
390 (Stream
: not null access Root_Stream_Type
'Class;
391 Position
: out Cursor
);
393 for Cursor
'Read use Read
;
395 subtype Reference_Control_Type
is Implementation
.Reference_Control_Type
;
396 -- It is necessary to rename this here, so that the compiler can find it
398 type Constant_Reference_Type
399 (Element
: not null access constant Element_Type
) is
401 Control
: Reference_Control_Type
:=
402 raise Program_Error
with "uninitialized reference";
403 -- The RM says, "The default initialization of an object of
404 -- type Constant_Reference_Type or Reference_Type propagates
409 (Stream
: not null access Root_Stream_Type
'Class;
410 Item
: out Constant_Reference_Type
);
412 for Constant_Reference_Type
'Read use Read
;
415 (Stream
: not null access Root_Stream_Type
'Class;
416 Item
: Constant_Reference_Type
);
418 for Constant_Reference_Type
'Write use Write
;
421 (Element
: not null access Element_Type
) is
423 Control
: Reference_Control_Type
:=
424 raise Program_Error
with "uninitialized reference";
425 -- The RM says, "The default initialization of an object of
426 -- type Constant_Reference_Type or Reference_Type propagates
431 (Stream
: not null access Root_Stream_Type
'Class;
432 Item
: out Reference_Type
);
434 for Reference_Type
'Read use Read
;
437 (Stream
: not null access Root_Stream_Type
'Class;
438 Item
: Reference_Type
);
440 for Reference_Type
'Write use Write
;
442 -- See Ada.Containers.Vectors for documentation on the following
444 function Pseudo_Reference
445 (Container
: aliased Tree
'Class) return Reference_Control_Type
;
446 pragma Inline
(Pseudo_Reference
);
447 -- Creates an object of type Reference_Control_Type pointing to the
448 -- container, and increments the Lock. Finalization of this object will
449 -- decrement the Lock.
451 function Get_Element_Access
452 (Position
: Cursor
) return not null Element_Access
;
453 -- Returns a pointer to the element designated by Position.
455 Empty_Tree
: constant Tree
:= (Controlled
with others => <>);
457 No_Element
: constant Cursor
:= (others => <>);
459 end Ada
.Containers
.Indefinite_Multiway_Trees
;