1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT LIBRARY COMPONENTS                          --
4--                                                                          --
5--                   ADA.CONTAINERS.BOUNDED_MULTIWAY_TREES                  --
6--                                                                          --
7--                                 S p e c                                  --
8--                                                                          --
9--           Copyright (C) 2014-2019, 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-- 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.               --
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
34with Ada.Iterator_Interfaces;
35
36with Ada.Containers.Helpers;
37private with Ada.Streams;
38
39generic
40   type Element_Type is private;
41
42   with function "=" (Left, Right : Element_Type) return Boolean is <>;
43
44package Ada.Containers.Bounded_Multiway_Trees is
45   pragma Annotate (CodePeer, Skip_Analysis);
46   pragma Pure;
47   pragma Remote_Types;
48
49   type Tree (Capacity : Count_Type) is tagged private
50     with Constant_Indexing => Constant_Reference,
51          Variable_Indexing => Reference,
52          Default_Iterator  => Iterate,
53          Iterator_Element  => Element_Type;
54   pragma Preelaborable_Initialization (Tree);
55
56   type Cursor is private;
57   pragma Preelaborable_Initialization (Cursor);
58
59   Empty_Tree : constant Tree;
60
61   No_Element : constant Cursor;
62   function Has_Element (Position : Cursor) return Boolean;
63
64   package Tree_Iterator_Interfaces is new
65     Ada.Iterator_Interfaces (Cursor, Has_Element);
66
67   function Equal_Subtree
68     (Left_Position  : Cursor;
69      Right_Position : Cursor) return Boolean;
70
71   function "=" (Left, Right : Tree) return Boolean;
72
73   function Is_Empty (Container : Tree) return Boolean;
74
75   function Node_Count (Container : Tree) return Count_Type;
76
77   function Subtree_Node_Count (Position : Cursor) return Count_Type;
78
79   function Depth (Position : Cursor) return Count_Type;
80
81   function Is_Root (Position : Cursor) return Boolean;
82
83   function Is_Leaf (Position : Cursor) return Boolean;
84
85   function Root (Container : Tree) return Cursor;
86
87   procedure Clear (Container : in out Tree);
88
89   function Element (Position : Cursor) return Element_Type;
90
91   procedure Replace_Element
92     (Container : in out Tree;
93      Position  : Cursor;
94      New_Item  : Element_Type);
95
96   procedure Query_Element
97     (Position : Cursor;
98      Process  : not null access procedure (Element : Element_Type));
99
100   procedure Update_Element
101     (Container : in out Tree;
102      Position  : Cursor;
103      Process   : not null access procedure (Element : in out Element_Type));
104
105   type Constant_Reference_Type
106     (Element : not null access constant Element_Type) is private
107        with Implicit_Dereference => Element;
108
109   type Reference_Type
110     (Element : not null access Element_Type) is private
111        with Implicit_Dereference => Element;
112
113   function Constant_Reference
114     (Container : aliased Tree;
115      Position  : Cursor) return Constant_Reference_Type;
116
117   function Reference
118     (Container : aliased in out Tree;
119      Position  : Cursor) return Reference_Type;
120
121   procedure Assign (Target : in out Tree; Source : Tree);
122
123   function Copy (Source : Tree; Capacity : Count_Type := 0) return Tree;
124
125   procedure Move (Target : in out Tree; Source : in out Tree);
126
127   procedure Delete_Leaf
128     (Container : in out Tree;
129      Position  : in out Cursor);
130
131   procedure Delete_Subtree
132     (Container : in out Tree;
133      Position  : in out Cursor);
134
135   procedure Swap
136     (Container : in out Tree;
137      I, J      : Cursor);
138
139   function Find
140     (Container : Tree;
141      Item      : Element_Type) return Cursor;
142
143   function Find_In_Subtree
144     (Position : Cursor;
145      Item     : Element_Type) return Cursor;
146
147   function Ancestor_Find
148     (Position : Cursor;
149      Item     : Element_Type) return Cursor;
150
151   function Contains
152     (Container : Tree;
153      Item      : Element_Type) return Boolean;
154
155   procedure Iterate
156     (Container : Tree;
157      Process   : not null access procedure (Position : Cursor));
158
159   procedure Iterate_Subtree
160     (Position  : Cursor;
161      Process   : not null access procedure (Position : Cursor));
162
163   function Iterate (Container : Tree)
164     return Tree_Iterator_Interfaces.Forward_Iterator'Class;
165
166   function Iterate_Subtree (Position : Cursor)
167     return Tree_Iterator_Interfaces.Forward_Iterator'Class;
168
169   function Iterate_Children
170     (Container : Tree;
171      Parent    : Cursor)
172      return Tree_Iterator_Interfaces.Reversible_Iterator'Class;
173
174   function Child_Count (Parent : Cursor) return Count_Type;
175
176   function Child_Depth (Parent, Child : Cursor) return Count_Type;
177
178   procedure Insert_Child
179     (Container : in out Tree;
180      Parent    : Cursor;
181      Before    : Cursor;
182      New_Item  : Element_Type;
183      Count     : Count_Type := 1);
184
185   procedure Insert_Child
186     (Container : in out Tree;
187      Parent    : Cursor;
188      Before    : Cursor;
189      New_Item  : Element_Type;
190      Position  : out Cursor;
191      Count     : Count_Type := 1);
192
193   procedure Insert_Child
194     (Container : in out Tree;
195      Parent    : Cursor;
196      Before    : Cursor;
197      Position  : out Cursor;
198      Count     : Count_Type := 1);
199
200   procedure Prepend_Child
201     (Container : in out Tree;
202      Parent    : Cursor;
203      New_Item  : Element_Type;
204      Count     : Count_Type := 1);
205
206   procedure Append_Child
207     (Container : in out Tree;
208      Parent    : Cursor;
209      New_Item  : Element_Type;
210      Count     : Count_Type := 1);
211
212   procedure Delete_Children
213     (Container : in out Tree;
214      Parent    : Cursor);
215
216   procedure Copy_Subtree
217     (Target   : in out Tree;
218      Parent   : Cursor;
219      Before   : Cursor;
220      Source   : Cursor);
221
222   procedure Splice_Subtree
223     (Target   : in out Tree;
224      Parent   : Cursor;
225      Before   : Cursor;
226      Source   : in out Tree;
227      Position : in out Cursor);
228
229   procedure Splice_Subtree
230     (Container : in out Tree;
231      Parent    : Cursor;
232      Before    : Cursor;
233      Position  : Cursor);
234
235   procedure Splice_Children
236     (Target        : in out Tree;
237      Target_Parent : Cursor;
238      Before        : Cursor;
239      Source        : in out Tree;
240      Source_Parent : Cursor);
241
242   procedure Splice_Children
243     (Container       : in out Tree;
244      Target_Parent   : Cursor;
245      Before          : Cursor;
246      Source_Parent   : Cursor);
247
248   function Parent (Position : Cursor) return Cursor;
249
250   function First_Child (Parent : Cursor) return Cursor;
251
252   function First_Child_Element (Parent : Cursor) return Element_Type;
253
254   function Last_Child (Parent : Cursor) return Cursor;
255
256   function Last_Child_Element (Parent : Cursor) return Element_Type;
257
258   function Next_Sibling (Position : Cursor) return Cursor;
259
260   function Previous_Sibling (Position : Cursor) return Cursor;
261
262   procedure Next_Sibling (Position : in out Cursor);
263
264   procedure Previous_Sibling (Position : in out Cursor);
265
266   procedure Iterate_Children
267     (Parent  : Cursor;
268      Process : not null access procedure (Position : Cursor));
269
270   procedure Reverse_Iterate_Children
271     (Parent  : Cursor;
272      Process : not null access procedure (Position : Cursor));
273
274private
275
276   use Ada.Containers.Helpers;
277   package Implementation is new Generic_Implementation;
278   use Implementation;
279
280   use Ada.Streams;
281
282   No_Node : constant Count_Type'Base := -1;
283   --  Need to document all global declarations such as this ???
284
285   --  Following decls also need much more documentation ???
286
287   type Children_Type is record
288      First : Count_Type'Base;
289      Last  : Count_Type'Base;
290   end record;
291
292   type Tree_Node_Type is record
293      Parent   : Count_Type'Base;
294      Prev     : Count_Type'Base;
295      Next     : Count_Type'Base;
296      Children : Children_Type;
297   end record;
298
299   type Tree_Node_Array is array (Count_Type range <>) of Tree_Node_Type;
300   type Element_Array is array (Count_Type range <>) of aliased Element_Type;
301
302   type Tree (Capacity : Count_Type) is tagged record
303      Nodes    : Tree_Node_Array (0 .. Capacity) := (others => <>);
304      Elements : Element_Array (1 .. Capacity) := (others => <>);
305      Free     : Count_Type'Base := No_Node;
306      TC       : aliased Tamper_Counts;
307      Count    : Count_Type := 0;
308   end record;
309
310   procedure Write
311     (Stream    : not null access Root_Stream_Type'Class;
312      Container : Tree);
313
314   for Tree'Write use Write;
315
316   procedure Read
317     (Stream    : not null access Root_Stream_Type'Class;
318      Container : out Tree);
319
320   for Tree'Read use Read;
321
322   type Tree_Access is access all Tree;
323   for Tree_Access'Storage_Size use 0;
324
325   type Cursor is record
326      Container : Tree_Access;
327      Node      : Count_Type'Base := No_Node;
328   end record;
329
330   procedure  Read
331     (Stream   : not null access Root_Stream_Type'Class;
332      Position : out Cursor);
333   for Cursor'Read use Read;
334
335   procedure Write
336     (Stream   : not null access Root_Stream_Type'Class;
337      Position : Cursor);
338   for Cursor'Write use Write;
339
340   subtype Reference_Control_Type is Implementation.Reference_Control_Type;
341   --  It is necessary to rename this here, so that the compiler can find it
342
343   type Constant_Reference_Type
344     (Element : not null access constant Element_Type) is
345      record
346         Control : Reference_Control_Type :=
347           raise Program_Error with "uninitialized reference";
348         --  The RM says, "The default initialization of an object of
349         --  type Constant_Reference_Type or Reference_Type propagates
350         --  Program_Error."
351      end record;
352
353   procedure Write
354     (Stream : not null access Root_Stream_Type'Class;
355      Item   : Constant_Reference_Type);
356   for Constant_Reference_Type'Write use Write;
357
358   procedure Read
359     (Stream : not null access Root_Stream_Type'Class;
360      Item   : out Constant_Reference_Type);
361   for Constant_Reference_Type'Read use Read;
362
363   type Reference_Type
364     (Element : not null access Element_Type) is
365      record
366         Control : Reference_Control_Type :=
367           raise Program_Error with "uninitialized reference";
368         --  The RM says, "The default initialization of an object of
369         --  type Constant_Reference_Type or Reference_Type propagates
370         --  Program_Error."
371      end record;
372
373   procedure Write
374     (Stream : not null access Root_Stream_Type'Class;
375      Item   : Reference_Type);
376   for Reference_Type'Write use Write;
377
378   procedure Read
379     (Stream : not null access Root_Stream_Type'Class;
380      Item   : out Reference_Type);
381   for Reference_Type'Read use Read;
382
383   --  Three operations are used to optimize in the expansion of "for ... of"
384   --  loops: the Next(Cursor) procedure in the visible part, and the following
385   --  Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for
386   --  details.
387
388   function Pseudo_Reference
389     (Container : aliased Tree'Class) return Reference_Control_Type;
390   pragma Inline (Pseudo_Reference);
391   --  Creates an object of type Reference_Control_Type pointing to the
392   --  container, and increments the Lock. Finalization of this object will
393   --  decrement the Lock.
394
395   type Element_Access is access all Element_Type with
396     Storage_Size => 0;
397
398   function Get_Element_Access
399     (Position : Cursor) return not null Element_Access;
400   --  Returns a pointer to the element designated by Position.
401
402   Empty_Tree : constant Tree := (Capacity => 0, others => <>);
403
404   No_Element : constant Cursor := Cursor'(others => <>);
405
406end Ada.Containers.Bounded_Multiway_Trees;
407