1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.BOUNDED_DOUBLY_LINKED_LISTS --
9 -- Copyright (C) 2004-2023, 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
;
36 with Ada
.Containers
.Helpers
;
37 private with Ada
.Streams
;
38 private with Ada
.Finalization
;
39 private with Ada
.Strings
.Text_Buffers
;
42 type Element_Type
is private;
44 with function "=" (Left
, Right
: Element_Type
)
47 package Ada
.Containers
.Bounded_Doubly_Linked_Lists
with
50 pragma Annotate
(CodePeer
, Skip_Analysis
);
54 type List
(Capacity
: Count_Type
) is tagged private with
55 Constant_Indexing
=> Constant_Reference
,
56 Variable_Indexing
=> Reference
,
57 Default_Iterator
=> Iterate
,
58 Iterator_Element
=> Element_Type
,
59 Aggregate
=> (Empty
=> Empty
,
60 Add_Unnamed
=> Append
),
61 Preelaborable_Initialization
62 => Element_Type
'Preelaborable_Initialization;
64 type Cursor
is private with Preelaborable_Initialization
;
66 Empty_List
: constant List
;
68 No_Element
: constant Cursor
;
70 function Empty
(Capacity
: Count_Type
:= 10) return List
;
72 function Has_Element
(Position
: Cursor
) return Boolean;
74 package List_Iterator_Interfaces
is new
75 Ada
.Iterator_Interfaces
(Cursor
, Has_Element
);
77 function "=" (Left
, Right
: List
) return Boolean;
79 function Length
(Container
: List
) return Count_Type
;
81 function Is_Empty
(Container
: List
) return Boolean;
83 procedure Clear
(Container
: in out List
);
85 function Element
(Position
: Cursor
) return Element_Type
;
87 procedure Replace_Element
88 (Container
: in out List
;
90 New_Item
: Element_Type
);
92 procedure Query_Element
94 Process
: not null access procedure (Element
: Element_Type
));
96 procedure Update_Element
97 (Container
: in out List
;
99 Process
: not null access procedure (Element
: in out Element_Type
));
101 type Constant_Reference_Type
102 (Element
: not null access constant Element_Type
) is private
104 Implicit_Dereference
=> Element
;
107 (Element
: not null access Element_Type
) is private
109 Implicit_Dereference
=> Element
;
111 function Constant_Reference
112 (Container
: aliased List
;
113 Position
: Cursor
) return Constant_Reference_Type
;
116 (Container
: aliased in out List
;
117 Position
: Cursor
) return Reference_Type
;
119 procedure Assign
(Target
: in out List
; Source
: List
);
121 function Copy
(Source
: List
; Capacity
: Count_Type
:= 0) return List
;
124 (Target
: in out List
;
125 Source
: in out List
);
128 (Container
: in out List
;
130 New_Item
: Element_Type
;
131 Count
: Count_Type
:= 1);
134 (Container
: in out List
;
136 New_Item
: Element_Type
;
137 Position
: out Cursor
;
138 Count
: Count_Type
:= 1);
141 (Container
: in out List
;
143 Position
: out Cursor
;
144 Count
: Count_Type
:= 1);
147 (Container
: in out List
;
148 New_Item
: Element_Type
;
149 Count
: Count_Type
:= 1);
152 (Container
: in out List
;
153 New_Item
: Element_Type
;
157 (Container
: in out List
;
158 New_Item
: Element_Type
);
161 (Container
: in out List
;
162 Position
: in out Cursor
;
163 Count
: Count_Type
:= 1);
165 procedure Delete_First
166 (Container
: in out List
;
167 Count
: Count_Type
:= 1);
169 procedure Delete_Last
170 (Container
: in out List
;
171 Count
: Count_Type
:= 1);
173 procedure Reverse_Elements
(Container
: in out List
);
177 return List_Iterator_Interfaces
.Reversible_Iterator
'class;
182 return List_Iterator_Interfaces
.Reversible_Iterator
'class;
185 (Container
: in out List
;
189 (Container
: in out List
;
193 (Target
: in out List
;
195 Source
: in out List
);
198 (Target
: in out List
;
200 Source
: in out List
;
201 Position
: in out Cursor
);
204 (Container
: in out List
;
208 function First
(Container
: List
) return Cursor
;
210 function First_Element
(Container
: List
) return Element_Type
;
212 function Last
(Container
: List
) return Cursor
;
214 function Last_Element
(Container
: List
) return Element_Type
;
216 function Next
(Position
: Cursor
) return Cursor
;
218 procedure Next
(Position
: in out Cursor
);
220 function Previous
(Position
: Cursor
) return Cursor
;
222 procedure Previous
(Position
: in out Cursor
);
227 Position
: Cursor
:= No_Element
) return Cursor
;
229 function Reverse_Find
232 Position
: Cursor
:= No_Element
) return Cursor
;
236 Item
: Element_Type
) return Boolean;
240 Process
: not null access procedure (Position
: Cursor
));
242 procedure Reverse_Iterate
244 Process
: not null access procedure (Position
: Cursor
));
247 with function "<" (Left
, Right
: Element_Type
) return Boolean is <>;
248 package Generic_Sorting
is
250 function Is_Sorted
(Container
: List
) return Boolean;
252 procedure Sort
(Container
: in out List
);
254 procedure Merge
(Target
, Source
: in out List
);
260 pragma Inline
(Next
);
261 pragma Inline
(Previous
);
263 use Ada
.Containers
.Helpers
;
264 package Implementation
is new Generic_Implementation
;
268 use Ada
.Finalization
;
270 type Node_Type
is record
271 Prev
: Count_Type
'Base;
273 Element
: aliased Element_Type
;
276 type Node_Array
is array (Count_Type
range <>) of Node_Type
;
278 type List
(Capacity
: Count_Type
) is tagged record
279 Free
: Count_Type
'Base := -1;
280 First
: Count_Type
:= 0;
281 Last
: Count_Type
:= 0;
282 Length
: Count_Type
:= 0;
283 TC
: aliased Tamper_Counts
;
284 Nodes
: Node_Array
(1 .. Capacity
);
285 end record with Put_Image
=> Put_Image
;
288 (S
: in out Ada
.Strings
.Text_Buffers
.Root_Buffer_Type
'Class; V
: List
);
291 (Stream
: not null access Root_Stream_Type
'Class;
294 for List
'Read use Read
;
297 (Stream
: not null access Root_Stream_Type
'Class;
300 for List
'Write use Write
;
302 type List_Access
is access all List
;
303 for List_Access
'Storage_Size use 0;
305 type Cursor
is record
306 Container
: List_Access
;
307 Node
: Count_Type
:= 0;
311 (Stream
: not null access Root_Stream_Type
'Class;
314 for Cursor
'Read use Read
;
317 (Stream
: not null access Root_Stream_Type
'Class;
320 for Cursor
'Write use Write
;
322 subtype Reference_Control_Type
is Implementation
.Reference_Control_Type
;
323 -- It is necessary to rename this here, so that the compiler can find it
325 type Constant_Reference_Type
326 (Element
: not null access constant Element_Type
) is
328 Control
: Reference_Control_Type
:=
329 raise Program_Error
with "uninitialized reference";
330 -- The RM says, "The default initialization of an object of
331 -- type Constant_Reference_Type or Reference_Type propagates
336 (Stream
: not null access Root_Stream_Type
'Class;
337 Item
: out Constant_Reference_Type
);
339 for Constant_Reference_Type
'Read use Read
;
342 (Stream
: not null access Root_Stream_Type
'Class;
343 Item
: Constant_Reference_Type
);
345 for Constant_Reference_Type
'Write use Write
;
347 type Reference_Type
(Element
: not null access Element_Type
) is record
348 Control
: Reference_Control_Type
:=
349 raise Program_Error
with "uninitialized reference";
350 -- The RM says, "The default initialization of an object of
351 -- type Constant_Reference_Type or Reference_Type propagates
356 (Stream
: not null access Root_Stream_Type
'Class;
357 Item
: Reference_Type
);
359 for Reference_Type
'Write use Write
;
362 (Stream
: not null access Root_Stream_Type
'Class;
363 Item
: out Reference_Type
);
365 for Reference_Type
'Read use Read
;
367 -- See Ada.Containers.Vectors for documentation on the following
369 procedure _Next
(Position
: in out Cursor
) renames Next
;
370 procedure _Previous
(Position
: in out Cursor
) renames Previous
;
372 function Pseudo_Reference
373 (Container
: aliased List
'Class) return Reference_Control_Type
;
374 pragma Inline
(Pseudo_Reference
);
375 -- Creates an object of type Reference_Control_Type pointing to the
376 -- container, and increments the Lock. Finalization of this object will
377 -- decrement the Lock.
379 type Element_Access
is access all Element_Type
with
382 function Get_Element_Access
383 (Position
: Cursor
) return not null Element_Access
;
384 -- Returns a pointer to the element designated by Position.
386 Empty_List
: constant List
:= (Capacity
=> 0, others => <>);
388 No_Element
: constant Cursor
:= Cursor
'(null, 0);
390 type Iterator is new Limited_Controlled and
391 List_Iterator_Interfaces.Reversible_Iterator with
393 Container : List_Access;
396 with Disable_Controlled => not T_Check;
398 overriding procedure Finalize (Object : in out Iterator);
400 overriding function First (Object : Iterator) return Cursor;
401 overriding function Last (Object : Iterator) return Cursor;
403 overriding function Next
405 Position : Cursor) return Cursor;
407 overriding function Previous
409 Position : Cursor) return Cursor;
411 end Ada.Containers.Bounded_Doubly_Linked_Lists;