1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- A D A . C O N T A I N E R S . M U L T I W A Y _ T R E E S --
9 -- Copyright (C) 2004-2015, 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;
41 type Element_Type is private;
43 with function "=" (Left, Right : Element_Type) return Boolean is <>;
45 package Ada.Containers.Multiway_Trees is
46 pragma Annotate (CodePeer, Skip_Analysis);
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 pragma Preelaborable_Initialization (Tree);
57 type Cursor is private;
58 pragma Preelaborable_Initialization (Cursor);
60 Empty_Tree : constant Tree;
62 No_Element : constant Cursor;
63 function Has_Element (Position : Cursor) return Boolean;
65 package Tree_Iterator_Interfaces is new
66 Ada.Iterator_Interfaces (Cursor, Has_Element);
68 function Equal_Subtree
69 (Left_Position : Cursor;
70 Right_Position : Cursor) return Boolean;
72 function "=" (Left, Right : Tree) return Boolean;
74 function Is_Empty (Container : Tree) return Boolean;
76 function Node_Count (Container : Tree) return Count_Type;
78 function Subtree_Node_Count (Position : Cursor) return Count_Type;
80 function Depth (Position : Cursor) return Count_Type;
82 function Is_Root (Position : Cursor) return Boolean;
84 function Is_Leaf (Position : Cursor) return Boolean;
86 function Root (Container : Tree) return Cursor;
88 procedure Clear (Container : in out Tree);
90 function Element (Position : Cursor) return Element_Type;
92 procedure Replace_Element
93 (Container : in out Tree;
95 New_Item : Element_Type);
97 procedure Query_Element
99 Process : not null access procedure (Element : Element_Type));
101 procedure Update_Element
102 (Container : in out Tree;
104 Process : not null access procedure (Element : in out Element_Type));
106 type Constant_Reference_Type
107 (Element : not null access constant Element_Type) is private
108 with Implicit_Dereference => Element;
111 (Element : not null access Element_Type) is private
112 with Implicit_Dereference => Element;
114 function Constant_Reference
115 (Container : aliased Tree;
116 Position : Cursor) return Constant_Reference_Type;
117 pragma Inline (Constant_Reference);
120 (Container : aliased in out Tree;
121 Position : Cursor) return Reference_Type;
122 pragma Inline (Reference);
124 procedure Assign (Target : in out Tree; Source : Tree);
126 function Copy (Source : Tree) return Tree;
128 procedure Move (Target : in out Tree; Source : in out Tree);
130 procedure Delete_Leaf
131 (Container : in out Tree;
132 Position : in out Cursor);
134 procedure Delete_Subtree
135 (Container : in out Tree;
136 Position : in out Cursor);
139 (Container : in out Tree;
144 Item : Element_Type) return Cursor;
146 -- This version of the AI:
147 -- 10-06-02 AI05-0136-1/07
148 -- declares Find_In_Subtree this way:
150 -- function Find_In_Subtree
151 -- (Container : Tree;
152 -- Item : Element_Type;
153 -- Position : Cursor) return Cursor;
155 -- It seems that the Container parameter is there by mistake, but we need
156 -- an official ruling from the ARG. ???
158 function Find_In_Subtree
160 Item : Element_Type) return Cursor;
162 -- This version of the AI:
163 -- 10-06-02 AI05-0136-1/07
164 -- declares Ancestor_Find this way:
166 -- function Ancestor_Find
167 -- (Container : Tree;
168 -- Item : Element_Type;
169 -- Position : Cursor) return Cursor;
171 -- It seems that the Container parameter is there by mistake, but we need
172 -- an official ruling from the ARG. ???
174 function Ancestor_Find
176 Item : Element_Type) return Cursor;
180 Item : Element_Type) return Boolean;
184 Process : not null access procedure (Position : Cursor));
186 procedure Iterate_Subtree
188 Process : not null access procedure (Position : Cursor));
190 function Iterate (Container : Tree)
191 return Tree_Iterator_Interfaces.Forward_Iterator'Class;
193 function Iterate_Subtree (Position : Cursor)
194 return Tree_Iterator_Interfaces.Forward_Iterator'Class;
196 function Iterate_Children
199 return Tree_Iterator_Interfaces.Reversible_Iterator'Class;
201 function Child_Count (Parent : Cursor) return Count_Type;
203 function Child_Depth (Parent, Child : Cursor) return Count_Type;
205 procedure Insert_Child
206 (Container : in out Tree;
209 New_Item : Element_Type;
210 Count : Count_Type := 1);
212 procedure Insert_Child
213 (Container : in out Tree;
216 New_Item : Element_Type;
217 Position : out Cursor;
218 Count : Count_Type := 1);
220 procedure Insert_Child
221 (Container : in out Tree;
224 Position : out Cursor;
225 Count : Count_Type := 1);
227 procedure Prepend_Child
228 (Container : in out Tree;
230 New_Item : Element_Type;
231 Count : Count_Type := 1);
233 procedure Append_Child
234 (Container : in out Tree;
236 New_Item : Element_Type;
237 Count : Count_Type := 1);
239 procedure Delete_Children
240 (Container : in out Tree;
243 procedure Copy_Subtree
244 (Target : in out Tree;
249 procedure Splice_Subtree
250 (Target : in out Tree;
253 Source : in out Tree;
254 Position : in out Cursor);
256 procedure Splice_Subtree
257 (Container : in out Tree;
262 procedure Splice_Children
263 (Target : in out Tree;
264 Target_Parent : Cursor;
266 Source : in out Tree;
267 Source_Parent : Cursor);
269 procedure Splice_Children
270 (Container : in out Tree;
271 Target_Parent : Cursor;
273 Source_Parent : Cursor);
275 function Parent (Position : Cursor) return Cursor;
277 function First_Child (Parent : Cursor) return Cursor;
279 function First_Child_Element (Parent : Cursor) return Element_Type;
281 function Last_Child (Parent : Cursor) return Cursor;
283 function Last_Child_Element (Parent : Cursor) return Element_Type;
285 function Next_Sibling (Position : Cursor) return Cursor;
287 function Previous_Sibling (Position : Cursor) return Cursor;
289 procedure Next_Sibling (Position : in out Cursor);
291 procedure Previous_Sibling (Position : in out Cursor);
293 -- This version of the AI:
294 -- 10-06-02 AI05-0136-1/07
295 -- declares Iterate_Children this way:
297 -- procedure Iterate_Children
298 -- (Container : Tree;
300 -- Process : not null access procedure (Position : Cursor));
302 -- It seems that the Container parameter is there by mistake, but we need
303 -- an official ruling from the ARG. ???
305 procedure Iterate_Children
307 Process : not null access procedure (Position : Cursor));
309 procedure Reverse_Iterate_Children
311 Process : not null access procedure (Position : Cursor));
314 -- A node of this multiway tree comprises an element and a list of children
315 -- (that are themselves trees). The root node is distinguished because it
316 -- contains only children: it does not have an element itself.
318 -- This design feature puts two design goals in tension with one another:
319 -- (1) treat the root node the same as any other node
320 -- (2) not declare any objects of type Element_Type unnecessarily
322 -- To satisfy (1), we could simply declare the Root node of the tree
323 -- using the normal Tree_Node_Type, but that would mean that (2) is not
324 -- satisfied. To resolve the tension (in favor of (2)), we declare the
325 -- component Root as having a different node type, without an Element
326 -- component (thus satisfying goal (2)) but otherwise identical to a normal
327 -- node, and then use Unchecked_Conversion to convert an access object
328 -- designating the Root node component to the access type designating a
329 -- normal, non-root node (thus satisfying goal (1)). We make an explicit
330 -- check for Root when there is any attempt to manipulate the Element
331 -- component of the node (a check required by the RM anyway).
333 -- In order to be explicit about node (and pointer) representation, we
334 -- specify that the respective node types have convention C, to ensure
335 -- that the layout of the components of the node records is the same,
336 -- thus guaranteeing that (unchecked) conversions between access types
337 -- designating each kind of node type is a meaningful conversion.
339 use Ada.Containers.Helpers;
340 package Implementation is new Generic_Implementation;
344 type Tree_Node_Access is access all Tree_Node_Type;
345 pragma Convention (C, Tree_Node_Access);
346 pragma No_Strict_Aliasing (Tree_Node_Access);
347 -- The above-mentioned Unchecked_Conversion is a violation of the normal
350 type Children_Type is record
351 First : Tree_Node_Access;
352 Last : Tree_Node_Access;
355 -- See the comment above. This declaration must exactly match the
356 -- declaration of Root_Node_Type (except for the Element component).
358 type Tree_Node_Type is record
359 Parent : Tree_Node_Access;
360 Prev : Tree_Node_Access;
361 Next : Tree_Node_Access;
362 Children : Children_Type;
363 Element : aliased Element_Type;
365 pragma Convention (C, Tree_Node_Type);
367 -- See the comment above. This declaration must match the declaration of
368 -- Tree_Node_Type (except for the Element component).
370 type Root_Node_Type is record
371 Parent : Tree_Node_Access;
372 Prev : Tree_Node_Access;
373 Next : Tree_Node_Access;
374 Children : Children_Type;
376 pragma Convention (C, Root_Node_Type);
378 for Root_Node_Type'Alignment use Standard'Maximum_Alignment;
379 -- The alignment has to be large enough to allow Root_Node to Tree_Node
380 -- access value conversions, and Tree_Node_Type's alignment may be bumped
381 -- up by the Element component.
383 use Ada.Finalization;
385 -- The Count component of type Tree represents the number of nodes that
386 -- have been (dynamically) allocated. It does not include the root node
387 -- itself. As implementors, we decide to cache this value, so that the
388 -- selector function Node_Count can execute in O(1) time, in order to be
389 -- consistent with the behavior of the Length selector function for other
390 -- standard container library units. This does mean, however, that the
391 -- two-container forms for Splice_XXX (that move subtrees across tree
392 -- containers) will execute in O(n) time, because we must count the number
393 -- of nodes in the subtree(s) that get moved. (We resolve the tension
394 -- between Node_Count and Splice_XXX in favor of Node_Count, under the
395 -- assumption that Node_Count is the more common operation).
397 type Tree is new Controlled with record
398 Root : aliased Root_Node_Type;
399 TC : aliased Tamper_Counts;
400 Count : Count_Type := 0;
403 overriding procedure Adjust (Container : in out Tree);
405 overriding procedure Finalize (Container : in out Tree) renames Clear;
410 (Stream : not null access Root_Stream_Type'Class;
413 for Tree'Write use Write;
416 (Stream : not null access Root_Stream_Type'Class;
417 Container : out Tree);
419 for Tree'Read use Read;
421 type Tree_Access is access all Tree;
422 for Tree_Access'Storage_Size use 0;
424 type Cursor is record
425 Container : Tree_Access;
426 Node : Tree_Node_Access;
430 (Stream : not null access Root_Stream_Type'Class;
433 for Cursor'Write use Write;
436 (Stream : not null access Root_Stream_Type'Class;
437 Position : out Cursor);
439 for Cursor'Read use Read;
441 subtype Reference_Control_Type is Implementation.Reference_Control_Type;
442 -- It is necessary to rename this here, so that the compiler can find it
444 type Constant_Reference_Type
445 (Element : not null access constant Element_Type) is
447 Control : Reference_Control_Type :=
448 raise Program_Error with "uninitialized reference";
449 -- The RM says, "The default initialization of an object of
450 -- type Constant_Reference_Type or Reference_Type propagates
455 (Stream : not null access Root_Stream_Type'Class;
456 Item : out Constant_Reference_Type);
458 for Constant_Reference_Type'Read use Read;
461 (Stream : not null access Root_Stream_Type'Class;
462 Item : Constant_Reference_Type);
464 for Constant_Reference_Type'Write use Write;
467 (Element : not null access Element_Type) is
469 Control : Reference_Control_Type :=
470 raise Program_Error with "uninitialized reference";
471 -- The RM says, "The default initialization of an object of
472 -- type Constant_Reference_Type or Reference_Type propagates
477 (Stream : not null access Root_Stream_Type'Class;
478 Item : out Reference_Type);
480 for Reference_Type'Read use Read;
483 (Stream : not null access Root_Stream_Type'Class;
484 Item : Reference_Type);
486 for Reference_Type'Write use Write;
488 -- Three operations are used to optimize in the expansion of "for ... of"
489 -- loops: the Next(Cursor) procedure in the visible part, and the following
490 -- Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for
493 function Pseudo_Reference
494 (Container : aliased Tree'Class) return Reference_Control_Type;
495 pragma Inline (Pseudo_Reference);
496 -- Creates an object of type Reference_Control_Type pointing to the
497 -- container, and increments the Lock. Finalization of this object will
498 -- decrement the Lock.
500 type Element_Access is access all Element_Type with
503 function Get_Element_Access
504 (Position : Cursor) return not null Element_Access;
505 -- Returns a pointer to the element designated by Position.
507 Empty_Tree : constant Tree := (Controlled with others => <>);
509 No_Element : constant Cursor := (others => <>);
511 end Ada.Containers.Multiway_Trees;