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

Subversion Repositories openrisc

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

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT LIBRARY COMPONENTS                          --
4
--                                                                          --
5
--                   ADA.CONTAINERS.INDEFINITE_MULTIWAY_TREES               --
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.Indefinite_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
 
53
   pragma Preelaborable_Initialization (Tree);
54
 
55
   type Cursor is private;
56
   pragma Preelaborable_Initialization (Cursor);
57
 
58
   Empty_Tree : constant Tree;
59
 
60
   No_Element : constant Cursor;
61
   function Has_Element (Position : Cursor) return Boolean;
62
 
63
   package Tree_Iterator_Interfaces is new
64
     Ada.Iterator_Interfaces (Cursor, Has_Element);
65
 
66
   function Equal_Subtree
67
     (Left_Position  : Cursor;
68
      Right_Position : Cursor) return Boolean;
69
 
70
   function "=" (Left, Right : Tree) return Boolean;
71
 
72
   function Is_Empty (Container : Tree) return Boolean;
73
 
74
   function Node_Count (Container : Tree) return Count_Type;
75
 
76
   function Subtree_Node_Count (Position : Cursor) return Count_Type;
77
 
78
   function Depth (Position : Cursor) return Count_Type;
79
 
80
   function Is_Root (Position : Cursor) return Boolean;
81
 
82
   function Is_Leaf (Position : Cursor) return Boolean;
83
 
84
   function Root (Container : Tree) return Cursor;
85
 
86
   procedure Clear (Container : in out Tree);
87
 
88
   function Element (Position : Cursor) return Element_Type;
89
 
90
   procedure Replace_Element
91
     (Container : in out Tree;
92
      Position  : Cursor;
93
      New_Item  : Element_Type);
94
 
95
   procedure Query_Element
96
     (Position : Cursor;
97
      Process  : not null access procedure (Element : Element_Type));
98
 
99
   procedure Update_Element
100
     (Container : in out Tree;
101
      Position  : Cursor;
102
      Process   : not null access procedure (Element : in out Element_Type));
103
 
104
   type Constant_Reference_Type
105
     (Element : not null access constant Element_Type) is private
106
        with Implicit_Dereference => Element;
107
 
108
   type Reference_Type
109
     (Element : not null access Element_Type) is private
110
        with Implicit_Dereference => Element;
111
 
112
   function Constant_Reference
113
     (Container : aliased Tree;
114
      Position  : Cursor) return Constant_Reference_Type;
115
   pragma Inline (Constant_Reference);
116
 
117
   function Reference
118
     (Container : aliased in out Tree;
119
      Position  : Cursor) return Reference_Type;
120
   pragma Inline (Reference);
121
 
122
   procedure Assign (Target : in out Tree; Source : Tree);
123
 
124
   function Copy (Source : Tree) return Tree;
125
 
126
   procedure Move (Target : in out Tree; Source : in out Tree);
127
 
128
   procedure Delete_Leaf
129
     (Container : in out Tree;
130
      Position  : in out Cursor);
131
 
132
   procedure Delete_Subtree
133
     (Container : in out Tree;
134
      Position  : in out Cursor);
135
 
136
   procedure Swap
137
     (Container : in out Tree;
138
      I, J      : Cursor);
139
 
140
   function Find
141
     (Container : Tree;
142
      Item      : Element_Type) return Cursor;
143
 
144
   --  This version of the AI:
145
   --   10-06-02  AI05-0136-1/07
146
   --  declares Find_In_Subtree this way:
147
   --
148
   --  function Find_In_Subtree
149
   --    (Container : Tree;
150
   --     Item      : Element_Type;
151
   --     Position  : Cursor) return Cursor;
152
   --
153
   --  It seems that the Container parameter is there by mistake, but we need
154
   --  an official ruling from the ARG. ???
155
 
156
   function Find_In_Subtree
157
     (Position : Cursor;
158
      Item     : Element_Type) return Cursor;
159
 
160
   --  This version of the AI:
161
   --   10-06-02  AI05-0136-1/07
162
   --  declares Ancestor_Find this way:
163
   --
164
   --  function Ancestor_Find
165
   --    (Container : Tree;
166
   --     Item      : Element_Type;
167
   --     Position  : Cursor) return Cursor;
168
   --
169
   --  It seems that the Container parameter is there by mistake, but we need
170
   --  an official ruling from the ARG. ???
171
 
172
   function Ancestor_Find
173
     (Position : Cursor;
174
      Item     : Element_Type) return Cursor;
175
 
176
   function Contains
177
     (Container : Tree;
178
      Item      : Element_Type) return Boolean;
179
 
180
   procedure Iterate
181
     (Container : Tree;
182
      Process   : not null access procedure (Position : Cursor));
183
 
184
   procedure Iterate_Subtree
185
     (Position  : Cursor;
186
      Process   : not null access procedure (Position : Cursor));
187
 
188
   function Iterate (Container : Tree)
189
     return Tree_Iterator_Interfaces.Forward_Iterator'Class;
190
 
191
   function Iterate_Subtree (Position : Cursor)
192
     return Tree_Iterator_Interfaces.Forward_Iterator'Class;
193
 
194
   function Iterate_Children
195
     (Container : Tree;
196
      Parent    : Cursor)
197
     return Tree_Iterator_Interfaces.Reversible_Iterator'Class;
198
 
199
   function Child_Count (Parent : Cursor) return Count_Type;
200
 
201
   function Child_Depth (Parent, Child : Cursor) return Count_Type;
202
 
203
   procedure Insert_Child
204
     (Container : in out Tree;
205
      Parent    : Cursor;
206
      Before    : Cursor;
207
      New_Item  : Element_Type;
208
      Count     : Count_Type := 1);
209
 
210
   procedure Insert_Child
211
     (Container : in out Tree;
212
      Parent    : Cursor;
213
      Before    : Cursor;
214
      New_Item  : Element_Type;
215
      Position  : out Cursor;
216
      Count     : Count_Type := 1);
217
 
218
   procedure Prepend_Child
219
     (Container : in out Tree;
220
      Parent    : Cursor;
221
      New_Item  : Element_Type;
222
      Count     : Count_Type := 1);
223
 
224
   procedure Append_Child
225
     (Container : in out Tree;
226
      Parent    : Cursor;
227
      New_Item  : Element_Type;
228
      Count     : Count_Type := 1);
229
 
230
   procedure Delete_Children
231
     (Container : in out Tree;
232
      Parent    : Cursor);
233
 
234
   procedure Copy_Subtree
235
     (Target   : in out Tree;
236
      Parent   : Cursor;
237
      Before   : Cursor;
238
      Source   : Cursor);
239
 
240
   procedure Splice_Subtree
241
     (Target   : in out Tree;
242
      Parent   : Cursor;
243
      Before   : Cursor;
244
      Source   : in out Tree;
245
      Position : in out Cursor);
246
 
247
   procedure Splice_Subtree
248
     (Container : in out Tree;
249
      Parent    : Cursor;
250
      Before    : Cursor;
251
      Position  : Cursor);
252
 
253
   procedure Splice_Children
254
     (Target          : in out Tree;
255
      Target_Parent   : Cursor;
256
      Before          : Cursor;
257
      Source          : in out Tree;
258
      Source_Parent   : Cursor);
259
 
260
   procedure Splice_Children
261
     (Container       : in out Tree;
262
      Target_Parent   : Cursor;
263
      Before          : Cursor;
264
      Source_Parent   : Cursor);
265
 
266
   function Parent (Position : Cursor) return Cursor;
267
 
268
   function First_Child (Parent : Cursor) return Cursor;
269
 
270
   function First_Child_Element (Parent : Cursor) return Element_Type;
271
 
272
   function Last_Child (Parent : Cursor) return Cursor;
273
 
274
   function Last_Child_Element (Parent : Cursor) return Element_Type;
275
 
276
   function Next_Sibling (Position : Cursor) return Cursor;
277
 
278
   function Previous_Sibling (Position : Cursor) return Cursor;
279
 
280
   procedure Next_Sibling (Position : in out Cursor);
281
 
282
   procedure Previous_Sibling (Position : in out Cursor);
283
 
284
   --  This version of the AI:
285
   --   10-06-02  AI05-0136-1/07
286
   --  declares Iterate_Children this way:
287
   --
288
   --  procedure Iterate_Children
289
   --    (Container : Tree;
290
   --     Parent    : Cursor;
291
   --     Process   : not null access procedure (Position : Cursor));
292
   --
293
   --  It seems that the Container parameter is there by mistake, but we need
294
   --  an official ruling from the ARG. ???
295
 
296
   procedure Iterate_Children
297
     (Parent  : Cursor;
298
      Process : not null access procedure (Position : Cursor));
299
 
300
   procedure Reverse_Iterate_Children
301
     (Parent  : Cursor;
302
      Process : not null access procedure (Position : Cursor));
303
 
304
private
305
 
306
   type Tree_Node_Type;
307
   type Tree_Node_Access is access all Tree_Node_Type;
308
 
309
   type Children_Type is record
310
      First : Tree_Node_Access;
311
      Last  : Tree_Node_Access;
312
   end record;
313
 
314
   type Element_Access is access Element_Type;
315
 
316
   type Tree_Node_Type is record
317
      Parent   : Tree_Node_Access;
318
      Prev     : Tree_Node_Access;
319
      Next     : Tree_Node_Access;
320
      Children : Children_Type;
321
      Element  : Element_Access;
322
   end record;
323
 
324
   use Ada.Finalization;
325
 
326
   --  The Count component of type Tree represents the number of nodes that
327
   --  have been (dynamically) allocated. It does not include the root node
328
   --  itself. As implementors, we decide to cache this value, so that the
329
   --  selector function Node_Count can execute in O(1) time, in order to be
330
   --  consistent with the behavior of the Length selector function for other
331
   --  standard container library units. This does mean, however, that the
332
   --  two-container forms for Splice_XXX (that move subtrees across tree
333
   --  containers) will execute in O(n) time, because we must count the number
334
   --  of nodes in the subtree(s) that get moved. (We resolve the tension
335
   --  between Node_Count and Splice_XXX in favor of Node_Count, under the
336
   --  assumption that Node_Count is the more common operation).
337
 
338
   type Tree is new Controlled with record
339
      Root  : aliased Tree_Node_Type;
340
      Busy  : Natural := 0;
341
      Lock  : Natural := 0;
342
      Count : Count_Type := 0;
343
   end record;
344
 
345
   overriding procedure Adjust (Container : in out Tree);
346
 
347
   overriding procedure Finalize (Container : in out Tree) renames Clear;
348
 
349
   use Ada.Streams;
350
 
351
   procedure Write
352
     (Stream    : not null access Root_Stream_Type'Class;
353
      Container : Tree);
354
 
355
   for Tree'Write use Write;
356
 
357
   procedure Read
358
     (Stream    : not null access Root_Stream_Type'Class;
359
      Container : out Tree);
360
 
361
   for Tree'Read use Read;
362
 
363
   type Tree_Access is access all Tree;
364
   for Tree_Access'Storage_Size use 0;
365
 
366
   type Cursor is record
367
      Container : Tree_Access;
368
      Node      : Tree_Node_Access;
369
   end record;
370
 
371
   procedure Write
372
     (Stream   : not null access Root_Stream_Type'Class;
373
      Position : Cursor);
374
 
375
   for Cursor'Write use Write;
376
 
377
   procedure Read
378
     (Stream   : not null access Root_Stream_Type'Class;
379
      Position : out Cursor);
380
 
381
   for Cursor'Read use Read;
382
 
383
   type Reference_Control_Type is
384
      new Controlled with record
385
         Container : Tree_Access;
386
      end record;
387
 
388
   overriding procedure Adjust (Control : in out Reference_Control_Type);
389
   pragma Inline (Adjust);
390
 
391
   overriding procedure Finalize (Control : in out Reference_Control_Type);
392
   pragma Inline (Finalize);
393
 
394
   type Constant_Reference_Type
395
     (Element : not null access constant Element_Type) is
396
      record
397
         Control : Reference_Control_Type;
398
      end record;
399
 
400
   procedure Read
401
     (Stream : not null access Root_Stream_Type'Class;
402
      Item   : out Constant_Reference_Type);
403
 
404
   for Constant_Reference_Type'Read use Read;
405
 
406
   procedure Write
407
     (Stream : not null access Root_Stream_Type'Class;
408
      Item   : Constant_Reference_Type);
409
 
410
   for Constant_Reference_Type'Write use Write;
411
 
412
   type Reference_Type
413
     (Element : not null access Element_Type) is
414
      record
415
         Control : Reference_Control_Type;
416
      end record;
417
 
418
   procedure Read
419
     (Stream : not null access Root_Stream_Type'Class;
420
      Item   : out Reference_Type);
421
 
422
   for Reference_Type'Read use Read;
423
 
424
   procedure Write
425
     (Stream : not null access Root_Stream_Type'Class;
426
      Item   : Reference_Type);
427
 
428
   for Reference_Type'Write use Write;
429
 
430
   Empty_Tree : constant Tree := (Controlled with others => <>);
431
 
432
   No_Element : constant Cursor := (others => <>);
433
 
434
end Ada.Containers.Indefinite_Multiway_Trees;

powered by: WebSVN 2.1.0

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