1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.BOUNDED_MULTIWAY_TREES --
9 -- Copyright (C) 2011, 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
;
35 private with Ada
.Streams
;
38 type Element_Type
is private;
40 with function "=" (Left
, Right
: Element_Type
) return Boolean is <>;
42 package Ada
.Containers
.Bounded_Multiway_Trees
is
46 type Tree
(Capacity
: Count_Type
) is tagged private
47 with Constant_Indexing
=> Constant_Reference
,
48 Variable_Indexing
=> Reference
,
49 Default_Iterator
=> Iterate
,
50 Iterator_Element
=> Element_Type
;
51 pragma Preelaborable_Initialization
(Tree
);
53 type Cursor
is private;
54 pragma Preelaborable_Initialization
(Cursor
);
56 Empty_Tree
: constant Tree
;
58 No_Element
: constant Cursor
;
59 function Has_Element
(Position
: Cursor
) return Boolean;
61 package Tree_Iterator_Interfaces
is new
62 Ada
.Iterator_Interfaces
(Cursor
, Has_Element
);
64 function Equal_Subtree
65 (Left_Position
: Cursor
;
66 Right_Position
: Cursor
) return Boolean;
68 function "=" (Left
, Right
: Tree
) return Boolean;
70 function Is_Empty
(Container
: Tree
) return Boolean;
72 function Node_Count
(Container
: Tree
) return Count_Type
;
74 function Subtree_Node_Count
(Position
: Cursor
) return Count_Type
;
76 function Depth
(Position
: Cursor
) return Count_Type
;
78 function Is_Root
(Position
: Cursor
) return Boolean;
80 function Is_Leaf
(Position
: Cursor
) return Boolean;
82 function Root
(Container
: Tree
) return Cursor
;
84 procedure Clear
(Container
: in out Tree
);
86 function Element
(Position
: Cursor
) return Element_Type
;
88 procedure Replace_Element
89 (Container
: in out Tree
;
91 New_Item
: Element_Type
);
93 procedure Query_Element
95 Process
: not null access procedure (Element
: Element_Type
));
97 procedure Update_Element
98 (Container
: in out Tree
;
100 Process
: not null access procedure (Element
: in out Element_Type
));
102 type Constant_Reference_Type
103 (Element
: not null access constant Element_Type
) is private
104 with Implicit_Dereference
=> Element
;
107 (Element
: not null access Element_Type
) is private
108 with Implicit_Dereference
=> Element
;
110 procedure Assign
(Target
: in out Tree
; Source
: Tree
);
112 function Copy
(Source
: Tree
; Capacity
: Count_Type
:= 0) return Tree
;
114 procedure Move
(Target
: in out Tree
; Source
: in out Tree
);
116 procedure Delete_Leaf
117 (Container
: in out Tree
;
118 Position
: in out Cursor
);
120 procedure Delete_Subtree
121 (Container
: in out Tree
;
122 Position
: in out Cursor
);
125 (Container
: in out Tree
;
130 Item
: Element_Type
) return Cursor
;
132 -- This version of the AI:
133 -- 10-06-02 AI05-0136-1/07
134 -- declares Find_In_Subtree this way:
136 -- function Find_In_Subtree
137 -- (Container : Tree;
138 -- Item : Element_Type;
139 -- Position : Cursor) return Cursor;
141 -- It seems that the Container parameter is there by mistake, but we need
142 -- an official ruling from the ARG. ???
144 function Find_In_Subtree
146 Item
: Element_Type
) return Cursor
;
148 -- This version of the AI:
149 -- 10-06-02 AI05-0136-1/07
150 -- declares Ancestor_Find this way:
152 -- function Ancestor_Find
153 -- (Container : Tree;
154 -- Item : Element_Type;
155 -- Position : Cursor) return Cursor;
157 -- It seems that the Container parameter is there by mistake, but we need
158 -- an official ruling from the ARG. ???
160 function Ancestor_Find
162 Item
: Element_Type
) return Cursor
;
166 Item
: Element_Type
) return Boolean;
170 Process
: not null access procedure (Position
: Cursor
));
172 procedure Iterate_Subtree
174 Process
: not null access procedure (Position
: Cursor
));
176 function Iterate
(Container
: Tree
)
177 return Tree_Iterator_Interfaces
.Forward_Iterator
'Class;
179 function Iterate_Subtree
(Position
: Cursor
)
180 return Tree_Iterator_Interfaces
.Forward_Iterator
'Class;
182 function Iterate_Children
185 return Tree_Iterator_Interfaces
.Reversible_Iterator
'Class;
187 function Child_Count
(Parent
: Cursor
) return Count_Type
;
189 function Child_Depth
(Parent
, Child
: Cursor
) return Count_Type
;
191 procedure Insert_Child
192 (Container
: in out Tree
;
195 New_Item
: Element_Type
;
196 Count
: Count_Type
:= 1);
198 procedure Insert_Child
199 (Container
: in out Tree
;
202 New_Item
: Element_Type
;
203 Position
: out Cursor
;
204 Count
: Count_Type
:= 1);
206 procedure Insert_Child
207 (Container
: in out Tree
;
210 Position
: out Cursor
;
211 Count
: Count_Type
:= 1);
213 procedure Prepend_Child
214 (Container
: in out Tree
;
216 New_Item
: Element_Type
;
217 Count
: Count_Type
:= 1);
219 procedure Append_Child
220 (Container
: in out Tree
;
222 New_Item
: Element_Type
;
223 Count
: Count_Type
:= 1);
225 procedure Delete_Children
226 (Container
: in out Tree
;
229 procedure Copy_Subtree
230 (Target
: in out Tree
;
235 procedure Splice_Subtree
236 (Target
: in out Tree
;
239 Source
: in out Tree
;
240 Position
: in out Cursor
);
242 procedure Splice_Subtree
243 (Container
: in out Tree
;
248 procedure Splice_Children
249 (Target
: in out Tree
;
250 Target_Parent
: Cursor
;
252 Source
: in out Tree
;
253 Source_Parent
: Cursor
);
255 procedure Splice_Children
256 (Container
: in out Tree
;
257 Target_Parent
: Cursor
;
259 Source_Parent
: Cursor
);
261 function Parent
(Position
: Cursor
) return Cursor
;
263 function First_Child
(Parent
: Cursor
) return Cursor
;
265 function First_Child_Element
(Parent
: Cursor
) return Element_Type
;
267 function Last_Child
(Parent
: Cursor
) return Cursor
;
269 function Last_Child_Element
(Parent
: Cursor
) return Element_Type
;
271 function Next_Sibling
(Position
: Cursor
) return Cursor
;
273 function Previous_Sibling
(Position
: Cursor
) return Cursor
;
275 procedure Next_Sibling
(Position
: in out Cursor
);
277 procedure Previous_Sibling
(Position
: in out Cursor
);
279 -- This version of the AI:
281 -- 10-06-02 AI05-0136-1/07
283 -- declares Iterate_Children this way:
285 -- procedure Iterate_Children
286 -- (Container : Tree;
288 -- Process : not null access procedure (Position : Cursor));
290 -- It seems that the Container parameter is there by mistake, but we need
291 -- an official ruling from the ARG. ???
293 procedure Iterate_Children
295 Process
: not null access procedure (Position
: Cursor
));
297 procedure Reverse_Iterate_Children
299 Process
: not null access procedure (Position
: Cursor
));
304 type Children_Type
is record
305 First
: Count_Type
'Base;
306 Last
: Count_Type
'Base;
309 type Tree_Node_Type
is record
310 Parent
: Count_Type
'Base;
311 Prev
: Count_Type
'Base;
312 Next
: Count_Type
'Base;
313 Children
: Children_Type
;
316 type Tree_Node_Array
is array (Count_Type
range <>) of Tree_Node_Type
;
317 type Element_Array
is array (Count_Type
range <>) of aliased Element_Type
;
319 type Tree
(Capacity
: Count_Type
) is tagged record
320 Nodes
: Tree_Node_Array
(0 .. Capacity
) := (others => <>);
321 Elements
: Element_Array
(1 .. Capacity
) := (others => <>);
322 Free
: Count_Type
'Base := -1;
325 Count
: Count_Type
:= 0;
329 (Stream
: not null access Root_Stream_Type
'Class;
332 for Tree
'Write use Write
;
335 (Stream
: not null access Root_Stream_Type
'Class;
336 Container
: out Tree
);
338 for Tree
'Read use Read
;
340 type Tree_Access
is access all Tree
;
341 for Tree_Access
'Storage_Size use 0;
343 type Cursor
is record
344 Container
: Tree_Access
;
345 Node
: Count_Type
'Base := -1;
349 (Stream
: not null access Root_Stream_Type
'Class;
350 Position
: out Cursor
);
351 for Cursor
'Read use Read
;
354 (Stream
: not null access Root_Stream_Type
'Class;
356 for Cursor
'Write use Write
;
358 type Constant_Reference_Type
359 (Element
: not null access constant Element_Type
) is null record;
362 (Stream
: not null access Root_Stream_Type
'Class;
363 Item
: Constant_Reference_Type
);
364 for Constant_Reference_Type
'Write use Write
;
367 (Stream
: not null access Root_Stream_Type
'Class;
368 Item
: out Constant_Reference_Type
);
369 for Constant_Reference_Type
'Read use Read
;
372 (Element
: not null access Element_Type
) is null record;
374 (Stream
: not null access Root_Stream_Type
'Class;
375 Item
: Reference_Type
);
376 for Reference_Type
'Write use Write
;
379 (Stream
: not null access Root_Stream_Type
'Class;
380 Item
: out Reference_Type
);
381 for Reference_Type
'Read use Read
;
383 function Constant_Reference
384 (Container
: aliased Tree
;
385 Position
: Cursor
) return Constant_Reference_Type
;
388 (Container
: aliased Tree
;
389 Position
: Cursor
) return Reference_Type
;
391 Empty_Tree
: constant Tree
:= (Capacity
=> 0, others => <>);
393 No_Element
: constant Cursor
:= Cursor
'(others => <>);
395 end Ada.Containers.Bounded_Multiway_Trees;