OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-comutr.ads] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
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-2012, 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
with Ada.Iterator_Interfaces;
35
private with Ada.Finalization;
36
private with Ada.Streams;
37
 
38
generic
39
   type Element_Type is private;
40
 
41
   with function "=" (Left, Right : Element_Type) return Boolean is <>;
42
 
43
package Ada.Containers.Multiway_Trees is
44
   pragma Preelaborate;
45
   pragma Remote_Types;
46
 
47
   type Tree is tagged private
48
     with Constant_Indexing => Constant_Reference,
49
          Variable_Indexing => Reference,
50
          Default_Iterator  => Iterate,
51
          Iterator_Element  => Element_Type;
52
   pragma Preelaborable_Initialization (Tree);
53
 
54
   type Cursor is private;
55
   pragma Preelaborable_Initialization (Cursor);
56
 
57
   Empty_Tree : constant Tree;
58
 
59
   No_Element : constant Cursor;
60
   function Has_Element (Position : Cursor) return Boolean;
61
 
62
   package Tree_Iterator_Interfaces is new
63
     Ada.Iterator_Interfaces (Cursor, Has_Element);
64
 
65
   function Equal_Subtree
66
     (Left_Position  : Cursor;
67
      Right_Position : Cursor) return Boolean;
68
 
69
   function "=" (Left, Right : Tree) return Boolean;
70
 
71
   function Is_Empty (Container : Tree) return Boolean;
72
 
73
   function Node_Count (Container : Tree) return Count_Type;
74
 
75
   function Subtree_Node_Count (Position : Cursor) return Count_Type;
76
 
77
   function Depth (Position : Cursor) return Count_Type;
78
 
79
   function Is_Root (Position : Cursor) return Boolean;
80
 
81
   function Is_Leaf (Position : Cursor) return Boolean;
82
 
83
   function Root (Container : Tree) return Cursor;
84
 
85
   procedure Clear (Container : in out Tree);
86
 
87
   function Element (Position : Cursor) return Element_Type;
88
 
89
   procedure Replace_Element
90
     (Container : in out Tree;
91
      Position  : Cursor;
92
      New_Item  : Element_Type);
93
 
94
   procedure Query_Element
95
     (Position : Cursor;
96
      Process  : not null access procedure (Element : Element_Type));
97
 
98
   procedure Update_Element
99
     (Container : in out Tree;
100
      Position  : Cursor;
101
      Process   : not null access procedure (Element : in out Element_Type));
102
 
103
   type Constant_Reference_Type
104
     (Element : not null access constant Element_Type) is private
105
        with Implicit_Dereference => Element;
106
 
107
   type Reference_Type
108
     (Element : not null access Element_Type) is private
109
        with Implicit_Dereference => Element;
110
 
111
   function Constant_Reference
112
     (Container : aliased Tree;
113
      Position  : Cursor) return Constant_Reference_Type;
114
   pragma Inline (Constant_Reference);
115
 
116
   function Reference
117
     (Container : aliased in out Tree;
118
      Position  : Cursor) return Reference_Type;
119
   pragma Inline (Reference);
120
 
121
   procedure Assign (Target : in out Tree; Source : Tree);
122
 
123
   function Copy (Source : Tree) 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
   --  This version of the AI:
144
   --   10-06-02  AI05-0136-1/07
145
   --  declares Find_In_Subtree this way:
146
   --
147
   --  function Find_In_Subtree
148
   --    (Container : Tree;
149
   --     Item      : Element_Type;
150
   --     Position  : Cursor) return Cursor;
151
   --
152
   --  It seems that the Container parameter is there by mistake, but we need
153
   --  an official ruling from the ARG. ???
154
 
155
   function Find_In_Subtree
156
     (Position : Cursor;
157
      Item     : Element_Type) return Cursor;
158
 
159
   --  This version of the AI:
160
   --   10-06-02  AI05-0136-1/07
161
   --  declares Ancestor_Find this way:
162
   --
163
   --  function Ancestor_Find
164
   --    (Container : Tree;
165
   --     Item      : Element_Type;
166
   --     Position  : Cursor) return Cursor;
167
   --
168
   --  It seems that the Container parameter is there by mistake, but we need
169
   --  an official ruling from the ARG. ???
170
 
171
   function Ancestor_Find
172
     (Position : Cursor;
173
      Item     : Element_Type) return Cursor;
174
 
175
   function Contains
176
     (Container : Tree;
177
      Item      : Element_Type) return Boolean;
178
 
179
   procedure Iterate
180
     (Container : Tree;
181
      Process   : not null access procedure (Position : Cursor));
182
 
183
   procedure Iterate_Subtree
184
     (Position : Cursor;
185
      Process  : not null access procedure (Position : Cursor));
186
 
187
   function Iterate (Container : Tree)
188
     return Tree_Iterator_Interfaces.Forward_Iterator'Class;
189
 
190
   function Iterate_Subtree (Position : Cursor)
191
     return Tree_Iterator_Interfaces.Forward_Iterator'Class;
192
 
193
   function Iterate_Children
194
     (Container : Tree;
195
      Parent    : Cursor)
196
      return Tree_Iterator_Interfaces.Reversible_Iterator'Class;
197
 
198
   function Child_Count (Parent : Cursor) return Count_Type;
199
 
200
   function Child_Depth (Parent, Child : Cursor) return Count_Type;
201
 
202
   procedure Insert_Child
203
     (Container : in out Tree;
204
      Parent    : Cursor;
205
      Before    : Cursor;
206
      New_Item  : Element_Type;
207
      Count     : Count_Type := 1);
208
 
209
   procedure Insert_Child
210
     (Container : in out Tree;
211
      Parent    : Cursor;
212
      Before    : Cursor;
213
      New_Item  : Element_Type;
214
      Position  : out Cursor;
215
      Count     : Count_Type := 1);
216
 
217
   procedure Insert_Child
218
     (Container : in out Tree;
219
      Parent    : Cursor;
220
      Before    : Cursor;
221
      Position  : out Cursor;
222
      Count     : Count_Type := 1);
223
 
224
   procedure Prepend_Child
225
     (Container : in out Tree;
226
      Parent    : Cursor;
227
      New_Item  : Element_Type;
228
      Count     : Count_Type := 1);
229
 
230
   procedure Append_Child
231
     (Container : in out Tree;
232
      Parent    : Cursor;
233
      New_Item  : Element_Type;
234
      Count     : Count_Type := 1);
235
 
236
   procedure Delete_Children
237
     (Container : in out Tree;
238
      Parent    : Cursor);
239
 
240
   procedure Copy_Subtree
241
     (Target   : in out Tree;
242
      Parent   : Cursor;
243
      Before   : Cursor;
244
      Source   : Cursor);
245
 
246
   procedure Splice_Subtree
247
     (Target   : in out Tree;
248
      Parent   : Cursor;
249
      Before   : Cursor;
250
      Source   : in out Tree;
251
      Position : in out Cursor);
252
 
253
   procedure Splice_Subtree
254
     (Container : in out Tree;
255
      Parent    : Cursor;
256
      Before    : Cursor;
257
      Position  : Cursor);
258
 
259
   procedure Splice_Children
260
     (Target          : in out Tree;
261
      Target_Parent   : Cursor;
262
      Before          : Cursor;
263
      Source          : in out Tree;
264
      Source_Parent   : Cursor);
265
 
266
   procedure Splice_Children
267
     (Container       : in out Tree;
268
      Target_Parent   : Cursor;
269
      Before          : Cursor;
270
      Source_Parent   : Cursor);
271
 
272
   function Parent (Position : Cursor) return Cursor;
273
 
274
   function First_Child (Parent : Cursor) return Cursor;
275
 
276
   function First_Child_Element (Parent : Cursor) return Element_Type;
277
 
278
   function Last_Child (Parent : Cursor) return Cursor;
279
 
280
   function Last_Child_Element (Parent : Cursor) return Element_Type;
281
 
282
   function Next_Sibling (Position : Cursor) return Cursor;
283
 
284
   function Previous_Sibling (Position : Cursor) return Cursor;
285
 
286
   procedure Next_Sibling (Position : in out Cursor);
287
 
288
   procedure Previous_Sibling (Position : in out Cursor);
289
 
290
   --  This version of the AI:
291
   --   10-06-02  AI05-0136-1/07
292
   --  declares Iterate_Children this way:
293
   --
294
   --  procedure Iterate_Children
295
   --    (Container : Tree;
296
   --     Parent    : Cursor;
297
   --     Process   : not null access procedure (Position : Cursor));
298
   --
299
   --  It seems that the Container parameter is there by mistake, but we need
300
   --  an official ruling from the ARG. ???
301
 
302
   procedure Iterate_Children
303
     (Parent  : Cursor;
304
      Process : not null access procedure (Position : Cursor));
305
 
306
   procedure Reverse_Iterate_Children
307
     (Parent  : Cursor;
308
      Process : not null access procedure (Position : Cursor));
309
 
310
private
311
 
312
   --  A node of this multiway tree comprises an element and a list of children
313
   --  (that are themselves trees). The root node is distinguished because it
314
   --  contains only children: it does not have an element itself.
315
   --
316
   --  This design feature puts two design goals in tension:
317
   --   (1) treat the root node the same as any other node
318
   --   (2) not declare any objects of type Element_Type unnecessarily
319
   --
320
   --  To satisfy (1), we could simply declare the Root node of the tree using
321
   --  the normal Tree_Node_Type, but that would mean that (2) is not
322
   --  satisfied. To resolve the tension (in favor of (2)), we declare the
323
   --  component Root as having a different node type, without an Element
324
   --  component (thus satisfying goal (2)) but otherwise identical to a normal
325
   --  node, and then use Unchecked_Conversion to convert an access object
326
   --  designating the Root node component to the access type designating a
327
   --  normal, non-root node (thus satisfying goal (1)). We make an explicit
328
   --  check for Root when there is any attempt to manipulate the Element
329
   --  component of the node (a check required by the RM anyway).
330
   --
331
   --  In order to be explicit about node (and pointer) representation, we
332
   --  specify that the respective node types have convention C, to ensure that
333
   --  the layout of the components of the node records is the same, thus
334
   --  guaranteeing that (unchecked) conversions between access types
335
   --  designating each kind of node type is a meaningful conversion.
336
 
337
   type Tree_Node_Type;
338
   type Tree_Node_Access is access all Tree_Node_Type;
339
   pragma Convention (C, Tree_Node_Access);
340
 
341
   type Children_Type is record
342
      First : Tree_Node_Access;
343
      Last  : Tree_Node_Access;
344
   end record;
345
 
346
   --  See the comment above. This declaration must exactly match the
347
   --  declaration of Root_Node_Type (except for the Element component).
348
 
349
   type Tree_Node_Type is record
350
      Parent   : Tree_Node_Access;
351
      Prev     : Tree_Node_Access;
352
      Next     : Tree_Node_Access;
353
      Children : Children_Type;
354
      Element  : aliased Element_Type;
355
   end record;
356
   pragma Convention (C, Tree_Node_Type);
357
 
358
   --  See the comment above. This declaration must match the declaration of
359
   --  Tree_Node_Type (except for the Element component).
360
 
361
   type Root_Node_Type is record
362
      Parent   : Tree_Node_Access;
363
      Prev     : Tree_Node_Access;
364
      Next     : Tree_Node_Access;
365
      Children : Children_Type;
366
   end record;
367
   pragma Convention (C, Root_Node_Type);
368
 
369
   use Ada.Finalization;
370
 
371
   --  The Count component of type Tree represents the number of nodes that
372
   --  have been (dynamically) allocated. It does not include the root node
373
   --  itself. As implementors, we decide to cache this value, so that the
374
   --  selector function Node_Count can execute in O(1) time, in order to be
375
   --  consistent with the behavior of the Length selector function for other
376
   --  standard container library units. This does mean, however, that the
377
   --  two-container forms for Splice_XXX (that move subtrees across tree
378
   --  containers) will execute in O(n) time, because we must count the number
379
   --  of nodes in the subtree(s) that get moved. (We resolve the tension
380
   --  between Node_Count and Splice_XXX in favor of Node_Count, under the
381
   --  assumption that Node_Count is the more common operation).
382
 
383
   type Tree is new Controlled with record
384
      Root  : aliased Root_Node_Type;
385
      Busy  : Natural := 0;
386
      Lock  : Natural := 0;
387
      Count : Count_Type := 0;
388
   end record;
389
 
390
   overriding procedure Adjust (Container : in out Tree);
391
 
392
   overriding procedure Finalize (Container : in out Tree) renames Clear;
393
 
394
   use Ada.Streams;
395
 
396
   procedure Write
397
     (Stream    : not null access Root_Stream_Type'Class;
398
      Container : Tree);
399
 
400
   for Tree'Write use Write;
401
 
402
   procedure Read
403
     (Stream    : not null access Root_Stream_Type'Class;
404
      Container : out Tree);
405
 
406
   for Tree'Read use Read;
407
 
408
   type Tree_Access is access all Tree;
409
   for Tree_Access'Storage_Size use 0;
410
 
411
   type Cursor is record
412
      Container : Tree_Access;
413
      Node      : Tree_Node_Access;
414
   end record;
415
 
416
   procedure Write
417
     (Stream   : not null access Root_Stream_Type'Class;
418
      Position : Cursor);
419
 
420
   for Cursor'Write use Write;
421
 
422
   procedure Read
423
     (Stream   : not null access Root_Stream_Type'Class;
424
      Position : out Cursor);
425
 
426
   for Cursor'Read use Read;
427
 
428
   type Reference_Control_Type is
429
      new Controlled with record
430
         Container : Tree_Access;
431
      end record;
432
 
433
   overriding procedure Adjust (Control : in out Reference_Control_Type);
434
   pragma Inline (Adjust);
435
 
436
   overriding procedure Finalize (Control : in out Reference_Control_Type);
437
   pragma Inline (Finalize);
438
 
439
   type Constant_Reference_Type
440
     (Element : not null access constant Element_Type) is
441
      record
442
         Control : Reference_Control_Type;
443
      end record;
444
 
445
   procedure Read
446
     (Stream : not null access Root_Stream_Type'Class;
447
      Item   : out Constant_Reference_Type);
448
 
449
   for Constant_Reference_Type'Read use Read;
450
 
451
   procedure Write
452
     (Stream : not null access Root_Stream_Type'Class;
453
      Item   : Constant_Reference_Type);
454
 
455
   for Constant_Reference_Type'Write use Write;
456
 
457
   type Reference_Type
458
     (Element : not null access Element_Type) is
459
      record
460
         Control : Reference_Control_Type;
461
      end record;
462
 
463
   procedure Read
464
     (Stream : not null access Root_Stream_Type'Class;
465
      Item   : out Reference_Type);
466
 
467
   for Reference_Type'Read use Read;
468
 
469
   procedure Write
470
     (Stream : not null access Root_Stream_Type'Class;
471
      Item   : Reference_Type);
472
 
473
   for Reference_Type'Write use Write;
474
 
475
   Empty_Tree : constant Tree := (Controlled with others => <>);
476
 
477
   No_Element : constant Cursor := (others => <>);
478
 
479
end Ada.Containers.Multiway_Trees;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.