1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.INDEFINITE_DOUBLY_LINKED_LISTS --
9 -- Copyright (C) 2004-2024, 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
.Indefinite_Doubly_Linked_Lists
with
50 pragma Annotate
(CodePeer
, Skip_Analysis
);
54 type List
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
);
62 pragma Preelaborable_Initialization
(List
);
64 type Cursor
is private;
65 pragma Preelaborable_Initialization
(Cursor
);
67 Empty_List
: constant List
;
69 function Empty
return List
;
70 pragma Ada_2022
(Empty
);
72 No_Element
: constant Cursor
;
74 function Has_Element
(Position
: Cursor
) return Boolean;
76 package List_Iterator_Interfaces
is new
77 Ada
.Iterator_Interfaces
(Cursor
, Has_Element
);
79 function "=" (Left
, Right
: List
) return Boolean;
81 function Length
(Container
: List
) return Count_Type
;
83 function Is_Empty
(Container
: List
) return Boolean;
85 procedure Clear
(Container
: in out List
);
87 function Element
(Position
: Cursor
) return Element_Type
;
89 procedure Replace_Element
90 (Container
: in out List
;
92 New_Item
: Element_Type
);
94 procedure Query_Element
96 Process
: not null access procedure (Element
: Element_Type
));
98 procedure Update_Element
99 (Container
: in out List
;
101 Process
: not null access procedure (Element
: in out Element_Type
));
103 type Constant_Reference_Type
104 (Element
: not null access constant Element_Type
) is private
106 Implicit_Dereference
=> Element
;
109 (Element
: not null access Element_Type
) is private
111 Implicit_Dereference
=> Element
;
113 function Constant_Reference
114 (Container
: aliased List
;
115 Position
: Cursor
) return Constant_Reference_Type
;
116 pragma Inline
(Constant_Reference
);
119 (Container
: aliased in out List
;
120 Position
: Cursor
) return Reference_Type
;
121 pragma Inline
(Reference
);
123 procedure Assign
(Target
: in out List
; Source
: List
);
125 function Copy
(Source
: List
) return List
;
128 (Target
: in out List
;
129 Source
: in out List
);
132 (Container
: in out List
;
134 New_Item
: Element_Type
;
135 Count
: Count_Type
:= 1);
138 (Container
: in out List
;
140 New_Item
: Element_Type
;
141 Position
: out Cursor
;
142 Count
: Count_Type
:= 1);
145 (Container
: in out List
;
146 New_Item
: Element_Type
;
147 Count
: Count_Type
:= 1);
150 (Container
: in out List
;
151 New_Item
: Element_Type
;
155 (Container
: in out List
;
156 New_Item
: Element_Type
);
159 (Container
: in out List
;
160 Position
: in out Cursor
;
161 Count
: Count_Type
:= 1);
163 procedure Delete_First
164 (Container
: in out List
;
165 Count
: Count_Type
:= 1);
167 procedure Delete_Last
168 (Container
: in out List
;
169 Count
: Count_Type
:= 1);
171 procedure Reverse_Elements
(Container
: in out List
);
173 procedure Swap
(Container
: in out List
; I
, J
: Cursor
);
175 procedure Swap_Links
(Container
: in out List
; I
, J
: Cursor
);
178 (Target
: in out List
;
180 Source
: in out List
);
183 (Target
: in out List
;
185 Source
: in out List
;
186 Position
: in out Cursor
);
189 (Container
: in out List
;
193 function First
(Container
: List
) return Cursor
;
195 function First_Element
(Container
: List
) return Element_Type
;
197 function Last
(Container
: List
) return Cursor
;
199 function Last_Element
(Container
: List
) return Element_Type
;
201 function Next
(Position
: Cursor
) return Cursor
;
203 procedure Next
(Position
: in out Cursor
);
205 function Previous
(Position
: Cursor
) return Cursor
;
207 procedure Previous
(Position
: in out Cursor
);
212 Position
: Cursor
:= No_Element
) return Cursor
;
214 function Reverse_Find
217 Position
: Cursor
:= No_Element
) return Cursor
;
221 Item
: Element_Type
) return Boolean;
225 Process
: not null access procedure (Position
: Cursor
));
227 procedure Reverse_Iterate
229 Process
: not null access procedure (Position
: Cursor
));
233 return List_Iterator_Interfaces
.Reversible_Iterator
'class;
238 return List_Iterator_Interfaces
.Reversible_Iterator
'class;
241 with function "<" (Left
, Right
: Element_Type
) return Boolean is <>;
242 package Generic_Sorting
is
244 function Is_Sorted
(Container
: List
) return Boolean;
246 procedure Sort
(Container
: in out List
);
248 procedure Merge
(Target
, Source
: in out List
);
254 pragma Inline
(Next
);
255 pragma Inline
(Previous
);
257 use Ada
.Containers
.Helpers
;
258 package Implementation
is new Generic_Implementation
;
262 type Node_Access
is access Node_Type
;
264 type Element_Access
is access all Element_Type
;
268 Element
: Element_Access
;
273 use Ada
.Finalization
;
277 new Controlled
with record
278 First
: Node_Access
:= null;
279 Last
: Node_Access
:= null;
280 Length
: Count_Type
:= 0;
281 TC
: aliased Tamper_Counts
;
282 end record with Put_Image
=> Put_Image
;
285 (S
: in out Ada
.Strings
.Text_Buffers
.Root_Buffer_Type
'Class; V
: List
);
287 overriding
procedure Adjust
(Container
: in out List
);
289 overriding
procedure Finalize
(Container
: in out List
) renames Clear
;
292 (Stream
: not null access Root_Stream_Type
'Class;
295 for List
'Read use Read
;
298 (Stream
: not null access Root_Stream_Type
'Class;
301 for List
'Write use Write
;
303 type List_Access
is access all List
;
304 for List_Access
'Storage_Size use 0;
308 Container
: List_Access
;
313 (Stream
: not null access Root_Stream_Type
'Class;
316 for Cursor
'Read use Read
;
319 (Stream
: not null access Root_Stream_Type
'Class;
322 for Cursor
'Write use Write
;
324 subtype Reference_Control_Type
is Implementation
.Reference_Control_Type
;
325 -- It is necessary to rename this here, so that the compiler can find it
327 type Constant_Reference_Type
328 (Element
: not null access constant Element_Type
) is
330 Control
: Reference_Control_Type
:=
331 raise Program_Error
with "uninitialized reference";
332 -- The RM says, "The default initialization of an object of
333 -- type Constant_Reference_Type or Reference_Type propagates
338 (Stream
: not null access Root_Stream_Type
'Class;
339 Item
: Constant_Reference_Type
);
341 for Constant_Reference_Type
'Write use Write
;
344 (Stream
: not null access Root_Stream_Type
'Class;
345 Item
: out Constant_Reference_Type
);
347 for Constant_Reference_Type
'Read use Read
;
350 (Element
: not null access Element_Type
) is
352 Control
: Reference_Control_Type
:=
353 raise Program_Error
with "uninitialized reference";
354 -- The RM says, "The default initialization of an object of
355 -- type Constant_Reference_Type or Reference_Type propagates
360 (Stream
: not null access Root_Stream_Type
'Class;
361 Item
: Reference_Type
);
363 for Reference_Type
'Write use Write
;
366 (Stream
: not null access Root_Stream_Type
'Class;
367 Item
: out Reference_Type
);
369 for Reference_Type
'Read use Read
;
371 -- See Ada.Containers.Vectors for documentation on the following
373 procedure _Next
(Position
: in out Cursor
) renames Next
;
374 procedure _Previous
(Position
: in out Cursor
) renames Previous
;
376 function Pseudo_Reference
377 (Container
: aliased List
'Class) return Reference_Control_Type
;
378 pragma Inline
(Pseudo_Reference
);
379 -- Creates an object of type Reference_Control_Type pointing to the
380 -- container, and increments the Lock. Finalization of this object will
381 -- decrement the Lock.
383 function Get_Element_Access
384 (Position
: Cursor
) return not null Element_Access
;
385 -- Returns a pointer to the element designated by Position.
387 Empty_List
: constant List
:= List
'(Controlled with others => <>);
388 function Empty return List is (Empty_List);
390 No_Element : constant Cursor := Cursor'(null, null);
392 type Iterator
is new Limited_Controlled
and
393 List_Iterator_Interfaces
.Reversible_Iterator
with
395 Container
: List_Access
;
398 with Disable_Controlled
=> not T_Check
;
400 overriding
procedure Finalize
(Object
: in out Iterator
);
402 overriding
function First
(Object
: Iterator
) return Cursor
;
403 overriding
function Last
(Object
: Iterator
) return Cursor
;
405 overriding
function Next
407 Position
: Cursor
) return Cursor
;
409 overriding
function Previous
411 Position
: Cursor
) return Cursor
;
413 end Ada
.Containers
.Indefinite_Doubly_Linked_Lists
;