1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.RESTRICTED_DOUBLY_LINKED_LISTS --
9 -- Copyright (C) 2004-2017, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- This unit was originally developed by Matthew J Heaney. --
28 ------------------------------------------------------------------------------
30 -- The doubly-linked list container provides constant-time insertion and
31 -- deletion at all positions, and allows iteration in both the forward and
32 -- reverse directions. This list form allocates storage for all nodes
33 -- statically (there is no dynamic allocation), and a discriminant is used to
34 -- specify the capacity. This container is also "restricted", meaning that
35 -- even though it does raise exceptions (as described below), it does not use
36 -- internal exception handlers. No state changes are made that would need to
37 -- be reverted (in the event of an exception), and so as a consequence, this
38 -- container cannot detect tampering (of cursors or elements).
41 type Element_Type
is private;
43 with function "=" (Left
, Right
: Element_Type
)
46 package Ada
.Containers
.Restricted_Doubly_Linked_Lists
is
49 type List
(Capacity
: Count_Type
) is tagged limited private;
50 pragma Preelaborable_Initialization
(List
);
52 type Cursor
is private;
53 pragma Preelaborable_Initialization
(Cursor
);
55 Empty_List
: constant List
;
56 -- The default value for list objects declared without an explicit
57 -- initialization expression.
59 No_Element
: constant Cursor
;
60 -- The default value for cursor objects declared without an explicit
61 -- initialization expression.
63 function "=" (Left
, Right
: List
) return Boolean;
64 -- If Left denotes the same list object as Right, then equality returns
65 -- True. If the length of Left is different from the length of Right, then
66 -- it returns False. Otherwise, list equality iterates over Left and Right,
67 -- comparing the element of Left to the corresponding element of Right
68 -- using the generic actual equality operator for elements. If the elements
69 -- compare False, then the iteration terminates and list equality returns
70 -- False. Otherwise, if all elements return True, then list equality
73 procedure Assign
(Target
: in out List
; Source
: List
);
74 -- If Target denotes the same list object as Source, the operation does
75 -- nothing. If Target.Capacity is less than Source.Length, then it raises
76 -- Constraint_Error. Otherwise, it clears Target, and then inserts each
77 -- element of Source into Target.
79 function Length
(Container
: List
) return Count_Type
;
80 -- Returns the total number of (active) elements in Container
82 function Is_Empty
(Container
: List
) return Boolean;
83 -- Returns True if Container.Length is 0
85 procedure Clear
(Container
: in out List
);
86 -- Deletes all elements from Container. Note that this is a bounded
87 -- container and so the element is not "deallocated" in the same sense that
88 -- an unbounded form would deallocate the element. Rather, the node is
89 -- relinked off of the active part of the list and onto the inactive part
90 -- of the list (the storage from which new elements are "allocated").
92 function Element
(Position
: Cursor
) return Element_Type
;
93 -- If Position equals No_Element, then Constraint_Error is raised.
94 -- Otherwise, function Element returns the element designed by Position.
96 procedure Replace_Element
97 (Container
: in out List
;
99 New_Item
: Element_Type
);
100 -- If Position equals No_Element, then Constraint_Error is raised. If
101 -- Position is associated with a list object different from Container,
102 -- Program_Error is raised. Otherwise, the element designated by Position
103 -- is assigned the value New_Item.
105 procedure Query_Element
107 Process
: not null access procedure (Element
: Element_Type
));
108 -- If Position equals No_Element, then Constraint_Error is raised.
109 -- Otherwise, it calls Process with (a constant view of) the element
110 -- designated by Position as the parameter.
112 procedure Update_Element
113 (Container
: in out List
;
115 Process
: not null access procedure (Element
: in out Element_Type
));
116 -- If Position equals No_Element, then Constraint_Error is raised.
117 -- Otherwise, it calls Process with (a variable view of) the element
118 -- designated by Position as the parameter.
121 (Container
: in out List
;
123 New_Item
: Element_Type
;
124 Count
: Count_Type
:= 1);
125 -- Inserts Count new elements, all with the value New_Item, into Container,
126 -- immediately prior to the position specified by Before. If Before has the
127 -- value No_Element, this is interpreted to mean that the elements are
128 -- appended to the list. If Before is associated with a list object
129 -- different from Container, then Program_Error is raised. If there are
130 -- fewer than Count nodes available, then Constraint_Error is raised.
133 (Container
: in out List
;
135 New_Item
: Element_Type
;
136 Position
: out Cursor
;
137 Count
: Count_Type
:= 1);
138 -- Inserts elements into Container as described above, but with the
139 -- difference that cursor Position is returned, which designates the first
140 -- of the new elements inserted. If Count is 0, Position returns the value
144 (Container
: in out List
;
146 Position
: out Cursor
;
147 Count
: Count_Type
:= 1);
148 -- Inserts elements in Container as described above, but with the
149 -- difference that the new elements are initialized to the default value
150 -- for objects of type Element_Type.
153 (Container
: in out List
;
154 New_Item
: Element_Type
;
155 Count
: Count_Type
:= 1);
156 -- Inserts Count elements, all having the value New_Item, prior to the
157 -- first element of Container.
160 (Container
: in out List
;
161 New_Item
: Element_Type
;
162 Count
: Count_Type
:= 1);
163 -- Inserts Count elements, all having the value New_Item, following the
164 -- last element of Container.
167 (Container
: in out List
;
168 Position
: in out Cursor
;
169 Count
: Count_Type
:= 1);
170 -- If Position equals No_Element, Constraint_Error is raised. If Position
171 -- is associated with a list object different from Container, then
172 -- Program_Error is raised. Otherwise, the Count nodes starting from
173 -- Position are removed from Container ("removed" meaning that the nodes
174 -- are unlinked from the active nodes of the list and relinked to inactive
175 -- storage). On return, Position is set to No_Element.
177 procedure Delete_First
178 (Container
: in out List
;
179 Count
: Count_Type
:= 1);
180 -- Removes the first Count nodes from Container
182 procedure Delete_Last
183 (Container
: in out List
;
184 Count
: Count_Type
:= 1);
185 -- Removes the last Count nodes from Container
187 procedure Reverse_Elements
(Container
: in out List
);
188 -- Relinks the nodes in reverse order
191 (Container
: in out List
;
193 -- If I or J equals No_Element, then Constraint_Error is raised. If I or J
194 -- is associated with a list object different from Container, then
195 -- Program_Error is raised. Otherwise, Swap exchanges (copies) the values
196 -- of the elements (on the nodes) designated by I and J.
199 (Container
: in out List
;
201 -- If I or J equals No_Element, then Constraint_Error is raised. If I or J
202 -- is associated with a list object different from Container, then
203 -- Program_Error is raised. Otherwise, Swap exchanges (relinks) the nodes
204 -- designated by I and J.
207 (Container
: in out List
;
209 Position
: in out Cursor
);
210 -- If Before is associated with a list object different from Container,
211 -- then Program_Error is raised. If Position equals No_Element, then
212 -- Constraint_Error is raised; if it associated with a list object
213 -- different from Container, then Program_Error is raised. Otherwise, the
214 -- node designated by Position is relinked immediately prior to Before. If
215 -- Before equals No_Element, this is interpreted to mean to move the node
216 -- designed by Position to the last end of the list.
218 function First
(Container
: List
) return Cursor
;
219 -- If Container is empty, the function returns No_Element. Otherwise, it
220 -- returns a cursor designating the first element.
222 function First_Element
(Container
: List
) return Element_Type
;
223 -- Equivalent to Element (First (Container))
225 function Last
(Container
: List
) return Cursor
;
226 -- If Container is empty, the function returns No_Element. Otherwise, it
227 -- returns a cursor designating the last element.
229 function Last_Element
(Container
: List
) return Element_Type
;
230 -- Equivalent to Element (Last (Container))
232 function Next
(Position
: Cursor
) return Cursor
;
233 -- If Position equals No_Element or Last (Container), the function returns
234 -- No_Element. Otherwise, it returns a cursor designating the node that
235 -- immediately follows the node designated by Position.
237 procedure Next
(Position
: in out Cursor
);
238 -- Equivalent to Position := Next (Position)
240 function Previous
(Position
: Cursor
) return Cursor
;
241 -- If Position equals No_Element or First (Container), the function returns
242 -- No_Element. Otherwise, it returns a cursor designating the node that
243 -- immediately precedes the node designated by Position.
245 procedure Previous
(Position
: in out Cursor
);
246 -- Equivalent to Position := Previous (Position)
251 Position
: Cursor
:= No_Element
) return Cursor
;
252 -- Searches for the node whose element is equal to Item, starting from
253 -- Position and continuing to the last end of the list. If Position equals
254 -- No_Element, the search starts from the first node. If Position is
255 -- associated with a list object different from Container, then
256 -- Program_Error is raised. If no node is found having an element equal to
257 -- Item, then Find returns No_Element.
259 function Reverse_Find
262 Position
: Cursor
:= No_Element
) return Cursor
;
263 -- Searches in reverse for the node whose element is equal to Item,
264 -- starting from Position and continuing to the first end of the list. If
265 -- Position equals No_Element, the search starts from the last node. If
266 -- Position is associated with a list object different from Container, then
267 -- Program_Error is raised. If no node is found having an element equal to
268 -- Item, then Reverse_Find returns No_Element.
272 Item
: Element_Type
) return Boolean;
273 -- Equivalent to Container.Find (Item) /= No_Element
275 function Has_Element
(Position
: Cursor
) return Boolean;
276 -- Equivalent to Position /= No_Element
280 Process
: not null access procedure (Position
: Cursor
));
281 -- Calls Process with a cursor designating each element of Container, in
282 -- order from Container.First to Container.Last.
284 procedure Reverse_Iterate
286 Process
: not null access procedure (Position
: Cursor
));
287 -- Calls Process with a cursor designating each element of Container, in
288 -- order from Container.Last to Container.First.
291 with function "<" (Left
, Right
: Element_Type
) return Boolean is <>;
292 package Generic_Sorting
is
294 function Is_Sorted
(Container
: List
) return Boolean;
295 -- Returns False if there exists an element which is less than its
298 procedure Sort
(Container
: in out List
);
299 -- Sorts the elements of Container (by relinking nodes), according to
300 -- the order specified by the generic formal less-than operator, such
301 -- that smaller elements are first in the list. The sort is stable,
302 -- meaning that the relative order of elements is preserved.
308 type Node_Type
is limited record
309 Prev
: Count_Type
'Base;
311 Element
: Element_Type
;
314 type Node_Array
is array (Count_Type
range <>) of Node_Type
;
316 type List
(Capacity
: Count_Type
) is tagged limited record
317 Nodes
: Node_Array
(1 .. Capacity
) := (others => <>);
318 Free
: Count_Type
'Base := -1;
319 First
: Count_Type
:= 0;
320 Last
: Count_Type
:= 0;
321 Length
: Count_Type
:= 0;
324 type List_Access
is access all List
;
325 for List_Access
'Storage_Size use 0;
329 Container
: List_Access
;
330 Node
: Count_Type
:= 0;
333 Empty_List
: constant List
:= (0, others => <>);
335 No_Element
: constant Cursor
:= (null, 0);
337 end Ada
.Containers
.Restricted_Doubly_Linked_Lists
;