1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.INDEFINITE_DOUBLY_LINKED_LISTS --
9 -- Copyright (C) 2004-2017, 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
;
41 type Element_Type
(<>) is private;
43 with function "=" (Left
, Right
: Element_Type
)
46 package Ada
.Containers
.Indefinite_Doubly_Linked_Lists
is
47 pragma Annotate
(CodePeer
, Skip_Analysis
);
51 type List
is tagged private with
52 Constant_Indexing
=> Constant_Reference
,
53 Variable_Indexing
=> Reference
,
54 Default_Iterator
=> Iterate
,
55 Iterator_Element
=> Element_Type
;
57 pragma Preelaborable_Initialization
(List
);
59 type Cursor
is private;
60 pragma Preelaborable_Initialization
(Cursor
);
62 Empty_List
: constant List
;
64 No_Element
: constant Cursor
;
66 function Has_Element
(Position
: Cursor
) return Boolean;
68 package List_Iterator_Interfaces
is new
69 Ada
.Iterator_Interfaces
(Cursor
, Has_Element
);
71 function "=" (Left
, Right
: List
) return Boolean;
73 function Length
(Container
: List
) return Count_Type
;
75 function Is_Empty
(Container
: List
) return Boolean;
77 procedure Clear
(Container
: in out List
);
79 function Element
(Position
: Cursor
) return Element_Type
;
81 procedure Replace_Element
82 (Container
: in out List
;
84 New_Item
: Element_Type
);
86 procedure Query_Element
88 Process
: not null access procedure (Element
: Element_Type
));
90 procedure Update_Element
91 (Container
: in out List
;
93 Process
: not null access procedure (Element
: in out Element_Type
));
95 type Constant_Reference_Type
96 (Element
: not null access constant Element_Type
) is private
98 Implicit_Dereference
=> Element
;
101 (Element
: not null access Element_Type
) is private
103 Implicit_Dereference
=> Element
;
105 function Constant_Reference
106 (Container
: aliased List
;
107 Position
: Cursor
) return Constant_Reference_Type
;
108 pragma Inline
(Constant_Reference
);
111 (Container
: aliased in out List
;
112 Position
: Cursor
) return Reference_Type
;
113 pragma Inline
(Reference
);
115 procedure Assign
(Target
: in out List
; Source
: List
);
117 function Copy
(Source
: List
) return List
;
120 (Target
: in out List
;
121 Source
: in out List
);
124 (Container
: in out List
;
126 New_Item
: Element_Type
;
127 Count
: Count_Type
:= 1);
130 (Container
: in out List
;
132 New_Item
: Element_Type
;
133 Position
: out Cursor
;
134 Count
: Count_Type
:= 1);
137 (Container
: in out List
;
138 New_Item
: Element_Type
;
139 Count
: Count_Type
:= 1);
142 (Container
: in out List
;
143 New_Item
: Element_Type
;
144 Count
: Count_Type
:= 1);
147 (Container
: in out List
;
148 Position
: in out Cursor
;
149 Count
: Count_Type
:= 1);
151 procedure Delete_First
152 (Container
: in out List
;
153 Count
: Count_Type
:= 1);
155 procedure Delete_Last
156 (Container
: in out List
;
157 Count
: Count_Type
:= 1);
159 procedure Reverse_Elements
(Container
: in out List
);
161 procedure Swap
(Container
: in out List
; I
, J
: Cursor
);
163 procedure Swap_Links
(Container
: in out List
; I
, J
: Cursor
);
166 (Target
: in out List
;
168 Source
: in out List
);
171 (Target
: in out List
;
173 Source
: in out List
;
174 Position
: in out Cursor
);
177 (Container
: in out List
;
181 function First
(Container
: List
) return Cursor
;
183 function First_Element
(Container
: List
) return Element_Type
;
185 function Last
(Container
: List
) return Cursor
;
187 function Last_Element
(Container
: List
) return Element_Type
;
189 function Next
(Position
: Cursor
) return Cursor
;
191 procedure Next
(Position
: in out Cursor
);
193 function Previous
(Position
: Cursor
) return Cursor
;
195 procedure Previous
(Position
: in out Cursor
);
200 Position
: Cursor
:= No_Element
) return Cursor
;
202 function Reverse_Find
205 Position
: Cursor
:= No_Element
) return Cursor
;
209 Item
: Element_Type
) return Boolean;
213 Process
: not null access procedure (Position
: Cursor
));
215 procedure Reverse_Iterate
217 Process
: not null access procedure (Position
: Cursor
));
221 return List_Iterator_Interfaces
.Reversible_Iterator
'class;
226 return List_Iterator_Interfaces
.Reversible_Iterator
'class;
229 with function "<" (Left
, Right
: Element_Type
) return Boolean is <>;
230 package Generic_Sorting
is
232 function Is_Sorted
(Container
: List
) return Boolean;
234 procedure Sort
(Container
: in out List
);
236 procedure Merge
(Target
, Source
: in out List
);
242 pragma Inline
(Next
);
243 pragma Inline
(Previous
);
245 use Ada
.Containers
.Helpers
;
246 package Implementation
is new Generic_Implementation
;
250 type Node_Access
is access Node_Type
;
252 type Element_Access
is access all Element_Type
;
256 Element
: Element_Access
;
261 use Ada
.Finalization
;
265 new Controlled
with record
266 First
: Node_Access
:= null;
267 Last
: Node_Access
:= null;
268 Length
: Count_Type
:= 0;
269 TC
: aliased Tamper_Counts
;
272 overriding
procedure Adjust
(Container
: in out List
);
274 overriding
procedure Finalize
(Container
: in out List
) renames Clear
;
277 (Stream
: not null access Root_Stream_Type
'Class;
280 for List
'Read use Read
;
283 (Stream
: not null access Root_Stream_Type
'Class;
286 for List
'Write use Write
;
288 type List_Access
is access all List
;
289 for List_Access
'Storage_Size use 0;
293 Container
: List_Access
;
298 (Stream
: not null access Root_Stream_Type
'Class;
301 for Cursor
'Read use Read
;
304 (Stream
: not null access Root_Stream_Type
'Class;
307 for Cursor
'Write use Write
;
309 subtype Reference_Control_Type
is Implementation
.Reference_Control_Type
;
310 -- It is necessary to rename this here, so that the compiler can find it
312 type Constant_Reference_Type
313 (Element
: not null access constant Element_Type
) is
315 Control
: Reference_Control_Type
:=
316 raise Program_Error
with "uninitialized reference";
317 -- The RM says, "The default initialization of an object of
318 -- type Constant_Reference_Type or Reference_Type propagates
323 (Stream
: not null access Root_Stream_Type
'Class;
324 Item
: Constant_Reference_Type
);
326 for Constant_Reference_Type
'Write use Write
;
329 (Stream
: not null access Root_Stream_Type
'Class;
330 Item
: out Constant_Reference_Type
);
332 for Constant_Reference_Type
'Read use Read
;
335 (Element
: not null access Element_Type
) is
337 Control
: Reference_Control_Type
:=
338 raise Program_Error
with "uninitialized reference";
339 -- The RM says, "The default initialization of an object of
340 -- type Constant_Reference_Type or Reference_Type propagates
345 (Stream
: not null access Root_Stream_Type
'Class;
346 Item
: Reference_Type
);
348 for Reference_Type
'Write use Write
;
351 (Stream
: not null access Root_Stream_Type
'Class;
352 Item
: out Reference_Type
);
354 for Reference_Type
'Read use Read
;
356 -- Three operations are used to optimize in the expansion of "for ... of"
357 -- loops: the Next(Cursor) procedure in the visible part, and the following
358 -- Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for
361 function Pseudo_Reference
362 (Container
: aliased List
'Class) return Reference_Control_Type
;
363 pragma Inline
(Pseudo_Reference
);
364 -- Creates an object of type Reference_Control_Type pointing to the
365 -- container, and increments the Lock. Finalization of this object will
366 -- decrement the Lock.
368 function Get_Element_Access
369 (Position
: Cursor
) return not null Element_Access
;
370 -- Returns a pointer to the element designated by Position.
372 Empty_List
: constant List
:= List
'(Controlled with others => <>);
374 No_Element : constant Cursor := Cursor'(null, null);
376 type Iterator
is new Limited_Controlled
and
377 List_Iterator_Interfaces
.Reversible_Iterator
with
379 Container
: List_Access
;
382 with Disable_Controlled
=> not T_Check
;
384 overriding
procedure Finalize
(Object
: in out Iterator
);
386 overriding
function First
(Object
: Iterator
) return Cursor
;
387 overriding
function Last
(Object
: Iterator
) return Cursor
;
389 overriding
function Next
391 Position
: Cursor
) return Cursor
;
393 overriding
function Previous
395 Position
: Cursor
) return Cursor
;
397 end Ada
.Containers
.Indefinite_Doubly_Linked_Lists
;