d2291df0ce419074ff57a668fb0de307fb870cfb
[gcc.git] / gcc / ada / a-comutr.ads
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT LIBRARY COMPONENTS --
4 -- --
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 --
6 -- --
7 -- S p e c --
8 -- --
9 -- Copyright (C) 2004-2011, 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
34 private with Ada.Finalization;
35 private with Ada.Streams;
36
37 generic
38 type Element_Type is private;
39
40 with function "=" (Left, Right : Element_Type) return Boolean is <>;
41
42 package Ada.Containers.Multiway_Trees is
43 pragma Preelaborate;
44 pragma Remote_Types;
45
46 type Tree is tagged private;
47 pragma Preelaborable_Initialization (Tree);
48
49 type Cursor is private;
50 pragma Preelaborable_Initialization (Cursor);
51
52 Empty_Tree : constant Tree;
53
54 No_Element : constant Cursor;
55
56 function Equal_Subtree
57 (Left_Position : Cursor;
58 Right_Position : Cursor) return Boolean;
59
60 function "=" (Left, Right : Tree) return Boolean;
61
62 function Is_Empty (Container : Tree) return Boolean;
63
64 function Node_Count (Container : Tree) return Count_Type;
65
66 function Subtree_Node_Count (Position : Cursor) return Count_Type;
67
68 function Depth (Position : Cursor) return Count_Type;
69
70 function Is_Root (Position : Cursor) return Boolean;
71
72 function Is_Leaf (Position : Cursor) return Boolean;
73
74 function Root (Container : Tree) return Cursor;
75
76 procedure Clear (Container : in out Tree);
77
78 function Element (Position : Cursor) return Element_Type;
79
80 procedure Replace_Element
81 (Container : in out Tree;
82 Position : Cursor;
83 New_Item : Element_Type);
84
85 procedure Query_Element
86 (Position : Cursor;
87 Process : not null access procedure (Element : Element_Type));
88
89 procedure Update_Element
90 (Container : in out Tree;
91 Position : Cursor;
92 Process : not null access procedure (Element : in out Element_Type));
93
94 procedure Assign (Target : in out Tree; Source : Tree);
95
96 function Copy (Source : Tree) return Tree;
97
98 procedure Move (Target : in out Tree; Source : in out Tree);
99
100 procedure Delete_Leaf
101 (Container : in out Tree;
102 Position : in out Cursor);
103
104 procedure Delete_Subtree
105 (Container : in out Tree;
106 Position : in out Cursor);
107
108 procedure Swap
109 (Container : in out Tree;
110 I, J : Cursor);
111
112 function Find
113 (Container : Tree;
114 Item : Element_Type) return Cursor;
115
116 -- This version of the AI:
117 -- 10-06-02 AI05-0136-1/07
118 -- declares Find_In_Subtree this way:
119 --
120 -- function Find_In_Subtree
121 -- (Container : Tree;
122 -- Item : Element_Type;
123 -- Position : Cursor) return Cursor;
124 --
125 -- It seems that the Container parameter is there by mistake, but we need
126 -- an official ruling from the ARG. ???
127
128 function Find_In_Subtree
129 (Position : Cursor;
130 Item : Element_Type) return Cursor;
131
132 -- This version of the AI:
133 -- 10-06-02 AI05-0136-1/07
134 -- declares Ancestor_Find this way:
135 --
136 -- function Ancestor_Find
137 -- (Container : Tree;
138 -- Item : Element_Type;
139 -- Position : Cursor) return Cursor;
140 --
141 -- It seems that the Container parameter is there by mistake, but we need
142 -- an official ruling from the ARG. ???
143
144 function Ancestor_Find
145 (Position : Cursor;
146 Item : Element_Type) return Cursor;
147
148 function Contains
149 (Container : Tree;
150 Item : Element_Type) return Boolean;
151
152 function Has_Element (Position : Cursor) return Boolean;
153
154 procedure Iterate
155 (Container : Tree;
156 Process : not null access procedure (Position : Cursor));
157
158 procedure Iterate_Subtree
159 (Position : Cursor;
160 Process : not null access procedure (Position : Cursor));
161
162 function Child_Count (Parent : Cursor) return Count_Type;
163
164 function Child_Depth (Parent, Child : Cursor) return Count_Type;
165
166 procedure Insert_Child
167 (Container : in out Tree;
168 Parent : Cursor;
169 Before : Cursor;
170 New_Item : Element_Type;
171 Count : Count_Type := 1);
172
173 procedure Insert_Child
174 (Container : in out Tree;
175 Parent : Cursor;
176 Before : Cursor;
177 New_Item : Element_Type;
178 Position : out Cursor;
179 Count : Count_Type := 1);
180
181 procedure Insert_Child
182 (Container : in out Tree;
183 Parent : Cursor;
184 Before : Cursor;
185 Position : out Cursor;
186 Count : Count_Type := 1);
187
188 procedure Prepend_Child
189 (Container : in out Tree;
190 Parent : Cursor;
191 New_Item : Element_Type;
192 Count : Count_Type := 1);
193
194 procedure Append_Child
195 (Container : in out Tree;
196 Parent : Cursor;
197 New_Item : Element_Type;
198 Count : Count_Type := 1);
199
200 procedure Delete_Children
201 (Container : in out Tree;
202 Parent : Cursor);
203
204 procedure Copy_Subtree
205 (Target : in out Tree;
206 Parent : Cursor;
207 Before : Cursor;
208 Source : Cursor);
209
210 procedure Splice_Subtree
211 (Target : in out Tree;
212 Parent : Cursor;
213 Before : Cursor;
214 Source : in out Tree;
215 Position : in out Cursor);
216
217 procedure Splice_Subtree
218 (Container : in out Tree;
219 Parent : Cursor;
220 Before : Cursor;
221 Position : Cursor);
222
223 procedure Splice_Children
224 (Target : in out Tree;
225 Target_Parent : Cursor;
226 Before : Cursor;
227 Source : in out Tree;
228 Source_Parent : Cursor);
229
230 procedure Splice_Children
231 (Container : in out Tree;
232 Target_Parent : Cursor;
233 Before : Cursor;
234 Source_Parent : Cursor);
235
236 function Parent (Position : Cursor) return Cursor;
237
238 function First_Child (Parent : Cursor) return Cursor;
239
240 function First_Child_Element (Parent : Cursor) return Element_Type;
241
242 function Last_Child (Parent : Cursor) return Cursor;
243
244 function Last_Child_Element (Parent : Cursor) return Element_Type;
245
246 function Next_Sibling (Position : Cursor) return Cursor;
247
248 function Previous_Sibling (Position : Cursor) return Cursor;
249
250 procedure Next_Sibling (Position : in out Cursor);
251
252 procedure Previous_Sibling (Position : in out Cursor);
253
254 -- This version of the AI:
255 -- 10-06-02 AI05-0136-1/07
256 -- declares Iterate_Children this way:
257 --
258 -- procedure Iterate_Children
259 -- (Container : Tree;
260 -- Parent : Cursor;
261 -- Process : not null access procedure (Position : Cursor));
262 --
263 -- It seems that the Container parameter is there by mistake, but we need
264 -- an official ruling from the ARG. ???
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
274 private
275
276 -- A node of this multiway tree comprises an element and a list of children
277 -- (that are themselves trees). The root node is distinguished because it
278 -- contains only children: it does not have an element itself.
279 --
280 -- This design feature puts two design goals in tension:
281 -- (1) treat the root node the same as any other node
282 -- (2) not declare any objects of type Element_Type unnecessarily
283 --
284 -- To satisfy (1), we could simply declare the Root node of the tree using
285 -- the normal Tree_Node_Type, but that would mean that (2) is not
286 -- satisfied. To resolve the tension (in favor of (2)), we declare the
287 -- component Root as having a different node type, without an Element
288 -- component (thus satisfying goal (2)) but otherwise identical to a normal
289 -- node, and then use Unchecked_Conversion to convert an access object
290 -- designating the Root node component to the access type designating a
291 -- normal, non-root node (thus satisfying goal (1)). We make an explicit
292 -- check for Root when there is any attempt to manipulate the Element
293 -- component of the node (a check required by the RM anyway).
294 --
295 -- In order to be explicit about node (and pointer) representation, we
296 -- specify that the respective node types have convention C, to ensure that
297 -- the layout of the components of the node records is the same, thus
298 -- guaranteeing that (unchecked) conversions between access types
299 -- designating each kind of node type is a meaningful conversion.
300
301 type Tree_Node_Type;
302 type Tree_Node_Access is access all Tree_Node_Type;
303 pragma Convention (C, Tree_Node_Access);
304
305 type Children_Type is record
306 First : Tree_Node_Access;
307 Last : Tree_Node_Access;
308 end record;
309
310 -- See the comment above. This declaration must exactly match the
311 -- declaration of Root_Node_Type (except for the Element component).
312
313 type Tree_Node_Type is record
314 Parent : Tree_Node_Access;
315 Prev : Tree_Node_Access;
316 Next : Tree_Node_Access;
317 Children : Children_Type;
318 Element : Element_Type;
319 end record;
320 pragma Convention (C, Tree_Node_Type);
321
322 -- See the comment above. This declaration must match the declaration of
323 -- Tree_Node_Type (except for the Element component).
324
325 type Root_Node_Type is record
326 Parent : Tree_Node_Access;
327 Prev : Tree_Node_Access;
328 Next : Tree_Node_Access;
329 Children : Children_Type;
330 end record;
331 pragma Convention (C, Root_Node_Type);
332
333 use Ada.Finalization;
334
335 -- The Count component of type Tree represents the number of nodes that
336 -- have been (dynamically) allocated. It does not include the root node
337 -- itself. As implementors, we decide to cache this value, so that the
338 -- selector function Node_Count can execute in O(1) time, in order to be
339 -- consistent with the behavior of the Length selector function for other
340 -- standard container library units. This does mean, however, that the
341 -- two-container forms for Splice_XXX (that move subtrees across tree
342 -- containers) will execute in O(n) time, because we must count the number
343 -- of nodes in the subtree(s) that get moved. (We resolve the tension
344 -- between Node_Count and Splice_XXX in favor of Node_Count, under the
345 -- assumption that Node_Count is the more common operation).
346
347 type Tree is new Controlled with record
348 Root : aliased Root_Node_Type;
349 Busy : Integer := 0;
350 Lock : Integer := 0;
351 Count : Count_Type := 0;
352 end record;
353
354 overriding procedure Adjust (Container : in out Tree);
355
356 overriding procedure Finalize (Container : in out Tree) renames Clear;
357
358 use Ada.Streams;
359
360 procedure Write
361 (Stream : not null access Root_Stream_Type'Class;
362 Container : Tree);
363
364 for Tree'Write use Write;
365
366 procedure Read
367 (Stream : not null access Root_Stream_Type'Class;
368 Container : out Tree);
369
370 for Tree'Read use Read;
371
372 type Tree_Access is access all Tree;
373 for Tree_Access'Storage_Size use 0;
374
375 type Cursor is record
376 Container : Tree_Access;
377 Node : Tree_Node_Access;
378 end record;
379
380 procedure Write
381 (Stream : not null access Root_Stream_Type'Class;
382 Position : Cursor);
383
384 for Cursor'Write use Write;
385
386 procedure Read
387 (Stream : not null access Root_Stream_Type'Class;
388 Position : out Cursor);
389
390 for Cursor'Read use Read;
391
392 Empty_Tree : constant Tree := (Controlled with others => <>);
393
394 No_Element : constant Cursor := (others => <>);
395
396 end Ada.Containers.Multiway_Trees;