1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- A D A . C O N T A I N E R S . D O U B L Y _ L I N K E D _ L I S T S --
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
.Finalization
;
38 private with Ada
.Streams
;
39 private with Ada
.Strings
.Text_Buffers
;
42 type Element_Type
is private;
44 with function "=" (Left
, Right
: Element_Type
)
47 package Ada
.Containers
.Doubly_Linked_Lists
with
50 pragma Annotate
(CodePeer
, Skip_Analysis
);
54 type List
is tagged private
56 Constant_Indexing
=> Constant_Reference
,
57 Variable_Indexing
=> Reference
,
58 Default_Iterator
=> Iterate
,
59 Iterator_Element
=> Element_Type
,
60 Aggregate
=> (Empty
=> Empty
,
61 Add_Unnamed
=> Append
);
63 pragma Preelaborable_Initialization
(List
);
65 type Cursor
is private;
66 pragma Preelaborable_Initialization
(Cursor
);
68 Empty_List
: constant List
;
70 function Empty
return List
;
71 pragma Ada_2022
(Empty
);
73 No_Element
: constant Cursor
;
75 function Has_Element
(Position
: Cursor
) return Boolean;
77 package List_Iterator_Interfaces
is new
78 Ada
.Iterator_Interfaces
(Cursor
, Has_Element
);
80 function "=" (Left
, Right
: List
) return Boolean;
82 function Length
(Container
: List
) return Count_Type
;
84 function Is_Empty
(Container
: List
) return Boolean;
86 procedure Clear
(Container
: in out List
);
88 function Element
(Position
: Cursor
) return Element_Type
;
90 procedure Replace_Element
91 (Container
: in out List
;
93 New_Item
: Element_Type
);
95 procedure Query_Element
97 Process
: not null access procedure (Element
: Element_Type
));
99 procedure Update_Element
100 (Container
: in out List
;
102 Process
: not null access procedure (Element
: in out Element_Type
));
104 type Constant_Reference_Type
105 (Element
: not null access constant Element_Type
) is private
107 Implicit_Dereference
=> Element
;
110 (Element
: not null access Element_Type
) is private
112 Implicit_Dereference
=> Element
;
114 function Constant_Reference
115 (Container
: aliased List
;
116 Position
: Cursor
) return Constant_Reference_Type
;
117 pragma Inline
(Constant_Reference
);
120 (Container
: aliased in out List
;
121 Position
: Cursor
) return Reference_Type
;
122 pragma Inline
(Reference
);
124 procedure Assign
(Target
: in out List
; Source
: List
);
126 function Copy
(Source
: List
) return List
;
129 (Target
: in out List
;
130 Source
: in out List
);
133 (Container
: in out List
;
135 New_Item
: Element_Type
;
136 Count
: Count_Type
:= 1);
139 (Container
: in out List
;
141 New_Item
: Element_Type
;
142 Position
: out Cursor
;
143 Count
: Count_Type
:= 1);
146 (Container
: in out List
;
148 Position
: out Cursor
;
149 Count
: Count_Type
:= 1);
152 (Container
: in out List
;
153 New_Item
: Element_Type
;
154 Count
: Count_Type
:= 1);
157 (Container
: in out List
;
158 New_Item
: Element_Type
;
162 (Container
: in out List
;
163 New_Item
: Element_Type
);
166 (Container
: in out List
;
167 Position
: in out Cursor
;
168 Count
: Count_Type
:= 1);
170 procedure Delete_First
171 (Container
: in out List
;
172 Count
: Count_Type
:= 1);
174 procedure Delete_Last
175 (Container
: in out List
;
176 Count
: Count_Type
:= 1);
178 procedure Reverse_Elements
(Container
: in out List
);
180 function Iterate
(Container
: List
)
181 return List_Iterator_Interfaces
.Reversible_Iterator
'Class;
183 function Iterate
(Container
: List
; Start
: Cursor
)
184 return List_Iterator_Interfaces
.Reversible_Iterator
'Class;
187 (Container
: in out List
;
191 (Container
: in out List
;
195 (Target
: in out List
;
197 Source
: in out List
);
200 (Target
: in out List
;
202 Source
: in out List
;
203 Position
: in out Cursor
);
206 (Container
: in out List
;
210 function First
(Container
: List
) return Cursor
;
212 function First_Element
(Container
: List
) return Element_Type
;
214 function Last
(Container
: List
) return Cursor
;
216 function Last_Element
(Container
: List
) return Element_Type
;
218 function Next
(Position
: Cursor
) return Cursor
;
220 procedure Next
(Position
: in out Cursor
);
222 function Previous
(Position
: Cursor
) return Cursor
;
224 procedure Previous
(Position
: in out Cursor
);
229 Position
: Cursor
:= No_Element
) return Cursor
;
231 function Reverse_Find
234 Position
: Cursor
:= No_Element
) return Cursor
;
238 Item
: Element_Type
) return Boolean;
242 Process
: not null access procedure (Position
: Cursor
));
244 procedure Reverse_Iterate
246 Process
: not null access procedure (Position
: Cursor
));
249 with function "<" (Left
, Right
: Element_Type
) return Boolean is <>;
250 package Generic_Sorting
is
252 function Is_Sorted
(Container
: List
) return Boolean;
254 procedure Sort
(Container
: in out List
);
256 procedure Merge
(Target
, Source
: in out List
);
262 pragma Inline
(Next
);
263 pragma Inline
(Previous
);
265 use Ada
.Containers
.Helpers
;
266 package Implementation
is new Generic_Implementation
;
270 type Node_Access
is access Node_Type
;
274 Element
: aliased Element_Type
;
279 use Ada
.Finalization
;
283 new Controlled
with record
284 First
: Node_Access
:= null;
285 Last
: Node_Access
:= null;
286 Length
: Count_Type
:= 0;
287 TC
: aliased Tamper_Counts
;
288 end record with Put_Image
=> Put_Image
;
291 (S
: in out Ada
.Strings
.Text_Buffers
.Root_Buffer_Type
'Class; V
: List
);
293 overriding
procedure Adjust
(Container
: in out List
);
295 overriding
procedure Finalize
(Container
: in out List
) renames Clear
;
298 (Stream
: not null access Root_Stream_Type
'Class;
301 for List
'Read use Read
;
304 (Stream
: not null access Root_Stream_Type
'Class;
307 for List
'Write use Write
;
309 type List_Access
is access all List
;
310 for List_Access
'Storage_Size use 0;
314 Container
: List_Access
;
319 (Stream
: not null access Root_Stream_Type
'Class;
322 for Cursor
'Read use Read
;
325 (Stream
: not null access Root_Stream_Type
'Class;
328 for Cursor
'Write use Write
;
330 subtype Reference_Control_Type
is Implementation
.Reference_Control_Type
;
331 -- It is necessary to rename this here, so that the compiler can find it
333 type Constant_Reference_Type
334 (Element
: not null access constant Element_Type
) is
336 Control
: Reference_Control_Type
:=
337 raise Program_Error
with "uninitialized reference";
338 -- The RM says, "The default initialization of an object of
339 -- type Constant_Reference_Type or Reference_Type propagates
344 (Stream
: not null access Root_Stream_Type
'Class;
345 Item
: Constant_Reference_Type
);
347 for Constant_Reference_Type
'Write use Write
;
350 (Stream
: not null access Root_Stream_Type
'Class;
351 Item
: out Constant_Reference_Type
);
353 for Constant_Reference_Type
'Read use Read
;
356 (Element
: not null access Element_Type
) is
358 Control
: Reference_Control_Type
:=
359 raise Program_Error
with "uninitialized reference";
360 -- The RM says, "The default initialization of an object of
361 -- type Constant_Reference_Type or Reference_Type propagates
366 (Stream
: not null access Root_Stream_Type
'Class;
367 Item
: Reference_Type
);
369 for Reference_Type
'Write use Write
;
372 (Stream
: not null access Root_Stream_Type
'Class;
373 Item
: out Reference_Type
);
375 for Reference_Type
'Read use Read
;
377 -- See Ada.Containers.Vectors for documentation on the following
379 procedure _Next
(Position
: in out Cursor
) renames Next
;
380 procedure _Previous
(Position
: in out Cursor
) renames Previous
;
382 function Pseudo_Reference
383 (Container
: aliased List
'Class) return Reference_Control_Type
;
384 pragma Inline
(Pseudo_Reference
);
385 -- Creates an object of type Reference_Control_Type pointing to the
386 -- container, and increments the Lock. Finalization of this object will
387 -- decrement the Lock.
389 type Element_Access
is access all Element_Type
with
392 function Get_Element_Access
393 (Position
: Cursor
) return not null Element_Access
;
394 -- Returns a pointer to the element designated by Position.
396 Empty_List
: constant List
:= (Controlled
with others => <>);
397 function Empty
return List
is (Empty_List
);
399 No_Element
: constant Cursor
:= Cursor
'(null, null);
401 type Iterator is new Limited_Controlled and
402 List_Iterator_Interfaces.Reversible_Iterator with
404 Container : List_Access;
407 with Disable_Controlled => not T_Check;
409 overriding procedure Finalize (Object : in out Iterator);
411 overriding function First (Object : Iterator) return Cursor;
412 overriding function Last (Object : Iterator) return Cursor;
414 overriding function Next
416 Position : Cursor) return Cursor;
418 overriding function Previous
420 Position : Cursor) return Cursor;
422 end Ada.Containers.Doubly_Linked_Lists;