annotate gcc/ada/libgnat/a-crdlli.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT LIBRARY COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
5 -- ADA.CONTAINERS.RESTRICTED_DOUBLY_LINKED_LISTS --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
9 -- Copyright (C) 2004-2018, Free Software Foundation, Inc. --
111
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- GNAT is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
12 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
kono
parents:
diff changeset
17 -- --
kono
parents:
diff changeset
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
kono
parents:
diff changeset
19 -- additional permissions described in the GCC Runtime Library Exception, --
kono
parents:
diff changeset
20 -- version 3.1, as published by the Free Software Foundation. --
kono
parents:
diff changeset
21 -- --
kono
parents:
diff changeset
22 -- You should have received a copy of the GNU General Public License and --
kono
parents:
diff changeset
23 -- a copy of the GCC Runtime Library Exception along with this program; --
kono
parents:
diff changeset
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
kono
parents:
diff changeset
25 -- <http://www.gnu.org/licenses/>. --
kono
parents:
diff changeset
26 -- --
kono
parents:
diff changeset
27 -- This unit was originally developed by Matthew J Heaney. --
kono
parents:
diff changeset
28 ------------------------------------------------------------------------------
kono
parents:
diff changeset
29
kono
parents:
diff changeset
30 with System; use type System.Address;
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 package body Ada.Containers.Restricted_Doubly_Linked_Lists is
kono
parents:
diff changeset
33
kono
parents:
diff changeset
34 -----------------------
kono
parents:
diff changeset
35 -- Local Subprograms --
kono
parents:
diff changeset
36 -----------------------
kono
parents:
diff changeset
37
kono
parents:
diff changeset
38 procedure Allocate
kono
parents:
diff changeset
39 (Container : in out List'Class;
kono
parents:
diff changeset
40 New_Item : Element_Type;
kono
parents:
diff changeset
41 New_Node : out Count_Type);
kono
parents:
diff changeset
42
kono
parents:
diff changeset
43 procedure Free
kono
parents:
diff changeset
44 (Container : in out List'Class;
kono
parents:
diff changeset
45 X : Count_Type);
kono
parents:
diff changeset
46
kono
parents:
diff changeset
47 procedure Insert_Internal
kono
parents:
diff changeset
48 (Container : in out List'Class;
kono
parents:
diff changeset
49 Before : Count_Type;
kono
parents:
diff changeset
50 New_Node : Count_Type);
kono
parents:
diff changeset
51
kono
parents:
diff changeset
52 function Vet (Position : Cursor) return Boolean;
kono
parents:
diff changeset
53
kono
parents:
diff changeset
54 ---------
kono
parents:
diff changeset
55 -- "=" --
kono
parents:
diff changeset
56 ---------
kono
parents:
diff changeset
57
kono
parents:
diff changeset
58 function "=" (Left, Right : List) return Boolean is
kono
parents:
diff changeset
59 LN : Node_Array renames Left.Nodes;
kono
parents:
diff changeset
60 RN : Node_Array renames Right.Nodes;
kono
parents:
diff changeset
61
kono
parents:
diff changeset
62 LI : Count_Type := Left.First;
kono
parents:
diff changeset
63 RI : Count_Type := Right.First;
kono
parents:
diff changeset
64
kono
parents:
diff changeset
65 begin
kono
parents:
diff changeset
66 if Left'Address = Right'Address then
kono
parents:
diff changeset
67 return True;
kono
parents:
diff changeset
68 end if;
kono
parents:
diff changeset
69
kono
parents:
diff changeset
70 if Left.Length /= Right.Length then
kono
parents:
diff changeset
71 return False;
kono
parents:
diff changeset
72 end if;
kono
parents:
diff changeset
73
kono
parents:
diff changeset
74 for J in 1 .. Left.Length loop
kono
parents:
diff changeset
75 if LN (LI).Element /= RN (RI).Element then
kono
parents:
diff changeset
76 return False;
kono
parents:
diff changeset
77 end if;
kono
parents:
diff changeset
78
kono
parents:
diff changeset
79 LI := LN (LI).Next;
kono
parents:
diff changeset
80 RI := RN (RI).Next;
kono
parents:
diff changeset
81 end loop;
kono
parents:
diff changeset
82
kono
parents:
diff changeset
83 return True;
kono
parents:
diff changeset
84 end "=";
kono
parents:
diff changeset
85
kono
parents:
diff changeset
86 --------------
kono
parents:
diff changeset
87 -- Allocate --
kono
parents:
diff changeset
88 --------------
kono
parents:
diff changeset
89
kono
parents:
diff changeset
90 procedure Allocate
kono
parents:
diff changeset
91 (Container : in out List'Class;
kono
parents:
diff changeset
92 New_Item : Element_Type;
kono
parents:
diff changeset
93 New_Node : out Count_Type)
kono
parents:
diff changeset
94 is
kono
parents:
diff changeset
95 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
96
kono
parents:
diff changeset
97 begin
kono
parents:
diff changeset
98 if Container.Free >= 0 then
kono
parents:
diff changeset
99 New_Node := Container.Free;
kono
parents:
diff changeset
100 N (New_Node).Element := New_Item;
kono
parents:
diff changeset
101 Container.Free := N (New_Node).Next;
kono
parents:
diff changeset
102
kono
parents:
diff changeset
103 else
kono
parents:
diff changeset
104 New_Node := abs Container.Free;
kono
parents:
diff changeset
105 N (New_Node).Element := New_Item;
kono
parents:
diff changeset
106 Container.Free := Container.Free - 1;
kono
parents:
diff changeset
107 end if;
kono
parents:
diff changeset
108 end Allocate;
kono
parents:
diff changeset
109
kono
parents:
diff changeset
110 ------------
kono
parents:
diff changeset
111 -- Append --
kono
parents:
diff changeset
112 ------------
kono
parents:
diff changeset
113
kono
parents:
diff changeset
114 procedure Append
kono
parents:
diff changeset
115 (Container : in out List;
kono
parents:
diff changeset
116 New_Item : Element_Type;
kono
parents:
diff changeset
117 Count : Count_Type := 1)
kono
parents:
diff changeset
118 is
kono
parents:
diff changeset
119 begin
kono
parents:
diff changeset
120 Insert (Container, No_Element, New_Item, Count);
kono
parents:
diff changeset
121 end Append;
kono
parents:
diff changeset
122
kono
parents:
diff changeset
123 ------------
kono
parents:
diff changeset
124 -- Assign --
kono
parents:
diff changeset
125 ------------
kono
parents:
diff changeset
126
kono
parents:
diff changeset
127 procedure Assign (Target : in out List; Source : List) is
kono
parents:
diff changeset
128 begin
kono
parents:
diff changeset
129 if Target'Address = Source'Address then
kono
parents:
diff changeset
130 return;
kono
parents:
diff changeset
131 end if;
kono
parents:
diff changeset
132
kono
parents:
diff changeset
133 if Target.Capacity < Source.Length then
kono
parents:
diff changeset
134 raise Constraint_Error; -- ???
kono
parents:
diff changeset
135 end if;
kono
parents:
diff changeset
136
kono
parents:
diff changeset
137 Clear (Target);
kono
parents:
diff changeset
138
kono
parents:
diff changeset
139 declare
kono
parents:
diff changeset
140 N : Node_Array renames Source.Nodes;
kono
parents:
diff changeset
141 J : Count_Type := Source.First;
kono
parents:
diff changeset
142
kono
parents:
diff changeset
143 begin
kono
parents:
diff changeset
144 while J /= 0 loop
kono
parents:
diff changeset
145 Append (Target, N (J).Element);
kono
parents:
diff changeset
146 J := N (J).Next;
kono
parents:
diff changeset
147 end loop;
kono
parents:
diff changeset
148 end;
kono
parents:
diff changeset
149 end Assign;
kono
parents:
diff changeset
150
kono
parents:
diff changeset
151 -----------
kono
parents:
diff changeset
152 -- Clear --
kono
parents:
diff changeset
153 -----------
kono
parents:
diff changeset
154
kono
parents:
diff changeset
155 procedure Clear (Container : in out List) is
kono
parents:
diff changeset
156 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
157 X : Count_Type;
kono
parents:
diff changeset
158
kono
parents:
diff changeset
159 begin
kono
parents:
diff changeset
160 if Container.Length = 0 then
kono
parents:
diff changeset
161 pragma Assert (Container.First = 0);
kono
parents:
diff changeset
162 pragma Assert (Container.Last = 0);
kono
parents:
diff changeset
163 -- pragma Assert (Container.Busy = 0);
kono
parents:
diff changeset
164 -- pragma Assert (Container.Lock = 0);
kono
parents:
diff changeset
165 return;
kono
parents:
diff changeset
166 end if;
kono
parents:
diff changeset
167
kono
parents:
diff changeset
168 pragma Assert (Container.First >= 1);
kono
parents:
diff changeset
169 pragma Assert (Container.Last >= 1);
kono
parents:
diff changeset
170 pragma Assert (N (Container.First).Prev = 0);
kono
parents:
diff changeset
171 pragma Assert (N (Container.Last).Next = 0);
kono
parents:
diff changeset
172
kono
parents:
diff changeset
173 -- if Container.Busy > 0 then
kono
parents:
diff changeset
174 -- raise Program_Error;
kono
parents:
diff changeset
175 -- end if;
kono
parents:
diff changeset
176
kono
parents:
diff changeset
177 while Container.Length > 1 loop
kono
parents:
diff changeset
178 X := Container.First;
kono
parents:
diff changeset
179
kono
parents:
diff changeset
180 Container.First := N (X).Next;
kono
parents:
diff changeset
181 N (Container.First).Prev := 0;
kono
parents:
diff changeset
182
kono
parents:
diff changeset
183 Container.Length := Container.Length - 1;
kono
parents:
diff changeset
184
kono
parents:
diff changeset
185 Free (Container, X);
kono
parents:
diff changeset
186 end loop;
kono
parents:
diff changeset
187
kono
parents:
diff changeset
188 X := Container.First;
kono
parents:
diff changeset
189
kono
parents:
diff changeset
190 Container.First := 0;
kono
parents:
diff changeset
191 Container.Last := 0;
kono
parents:
diff changeset
192 Container.Length := 0;
kono
parents:
diff changeset
193
kono
parents:
diff changeset
194 Free (Container, X);
kono
parents:
diff changeset
195 end Clear;
kono
parents:
diff changeset
196
kono
parents:
diff changeset
197 --------------
kono
parents:
diff changeset
198 -- Contains --
kono
parents:
diff changeset
199 --------------
kono
parents:
diff changeset
200
kono
parents:
diff changeset
201 function Contains
kono
parents:
diff changeset
202 (Container : List;
kono
parents:
diff changeset
203 Item : Element_Type) return Boolean
kono
parents:
diff changeset
204 is
kono
parents:
diff changeset
205 begin
kono
parents:
diff changeset
206 return Find (Container, Item) /= No_Element;
kono
parents:
diff changeset
207 end Contains;
kono
parents:
diff changeset
208
kono
parents:
diff changeset
209 ------------
kono
parents:
diff changeset
210 -- Delete --
kono
parents:
diff changeset
211 ------------
kono
parents:
diff changeset
212
kono
parents:
diff changeset
213 procedure Delete
kono
parents:
diff changeset
214 (Container : in out List;
kono
parents:
diff changeset
215 Position : in out Cursor;
kono
parents:
diff changeset
216 Count : Count_Type := 1)
kono
parents:
diff changeset
217 is
kono
parents:
diff changeset
218 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
219 X : Count_Type;
kono
parents:
diff changeset
220
kono
parents:
diff changeset
221 begin
kono
parents:
diff changeset
222 if Position.Node = 0 then
kono
parents:
diff changeset
223 raise Constraint_Error;
kono
parents:
diff changeset
224 end if;
kono
parents:
diff changeset
225
kono
parents:
diff changeset
226 if Position.Container /= Container'Unrestricted_Access then
kono
parents:
diff changeset
227 raise Program_Error;
kono
parents:
diff changeset
228 end if;
kono
parents:
diff changeset
229
kono
parents:
diff changeset
230 pragma Assert (Vet (Position), "bad cursor in Delete");
kono
parents:
diff changeset
231
kono
parents:
diff changeset
232 if Position.Node = Container.First then
kono
parents:
diff changeset
233 Delete_First (Container, Count);
kono
parents:
diff changeset
234 Position := No_Element;
kono
parents:
diff changeset
235 return;
kono
parents:
diff changeset
236 end if;
kono
parents:
diff changeset
237
kono
parents:
diff changeset
238 if Count = 0 then
kono
parents:
diff changeset
239 Position := No_Element;
kono
parents:
diff changeset
240 return;
kono
parents:
diff changeset
241 end if;
kono
parents:
diff changeset
242
kono
parents:
diff changeset
243 -- if Container.Busy > 0 then
kono
parents:
diff changeset
244 -- raise Program_Error;
kono
parents:
diff changeset
245 -- end if;
kono
parents:
diff changeset
246
kono
parents:
diff changeset
247 pragma Assert (Container.First >= 1);
kono
parents:
diff changeset
248 pragma Assert (Container.Last >= 1);
kono
parents:
diff changeset
249 pragma Assert (N (Container.First).Prev = 0);
kono
parents:
diff changeset
250 pragma Assert (N (Container.Last).Next = 0);
kono
parents:
diff changeset
251
kono
parents:
diff changeset
252 for Index in 1 .. Count loop
kono
parents:
diff changeset
253 pragma Assert (Container.Length >= 2);
kono
parents:
diff changeset
254
kono
parents:
diff changeset
255 X := Position.Node;
kono
parents:
diff changeset
256 Container.Length := Container.Length - 1;
kono
parents:
diff changeset
257
kono
parents:
diff changeset
258 if X = Container.Last then
kono
parents:
diff changeset
259 Position := No_Element;
kono
parents:
diff changeset
260
kono
parents:
diff changeset
261 Container.Last := N (X).Prev;
kono
parents:
diff changeset
262 N (Container.Last).Next := 0;
kono
parents:
diff changeset
263
kono
parents:
diff changeset
264 Free (Container, X);
kono
parents:
diff changeset
265 return;
kono
parents:
diff changeset
266 end if;
kono
parents:
diff changeset
267
kono
parents:
diff changeset
268 Position.Node := N (X).Next;
kono
parents:
diff changeset
269
kono
parents:
diff changeset
270 N (N (X).Next).Prev := N (X).Prev;
kono
parents:
diff changeset
271 N (N (X).Prev).Next := N (X).Next;
kono
parents:
diff changeset
272
kono
parents:
diff changeset
273 Free (Container, X);
kono
parents:
diff changeset
274 end loop;
kono
parents:
diff changeset
275
kono
parents:
diff changeset
276 Position := No_Element;
kono
parents:
diff changeset
277 end Delete;
kono
parents:
diff changeset
278
kono
parents:
diff changeset
279 ------------------
kono
parents:
diff changeset
280 -- Delete_First --
kono
parents:
diff changeset
281 ------------------
kono
parents:
diff changeset
282
kono
parents:
diff changeset
283 procedure Delete_First
kono
parents:
diff changeset
284 (Container : in out List;
kono
parents:
diff changeset
285 Count : Count_Type := 1)
kono
parents:
diff changeset
286 is
kono
parents:
diff changeset
287 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
288 X : Count_Type;
kono
parents:
diff changeset
289
kono
parents:
diff changeset
290 begin
kono
parents:
diff changeset
291 if Count >= Container.Length then
kono
parents:
diff changeset
292 Clear (Container);
kono
parents:
diff changeset
293 return;
kono
parents:
diff changeset
294 end if;
kono
parents:
diff changeset
295
kono
parents:
diff changeset
296 if Count = 0 then
kono
parents:
diff changeset
297 return;
kono
parents:
diff changeset
298 end if;
kono
parents:
diff changeset
299
kono
parents:
diff changeset
300 -- if Container.Busy > 0 then
kono
parents:
diff changeset
301 -- raise Program_Error;
kono
parents:
diff changeset
302 -- end if;
kono
parents:
diff changeset
303
kono
parents:
diff changeset
304 for I in 1 .. Count loop
kono
parents:
diff changeset
305 X := Container.First;
kono
parents:
diff changeset
306 pragma Assert (N (N (X).Next).Prev = Container.First);
kono
parents:
diff changeset
307
kono
parents:
diff changeset
308 Container.First := N (X).Next;
kono
parents:
diff changeset
309 N (Container.First).Prev := 0;
kono
parents:
diff changeset
310
kono
parents:
diff changeset
311 Container.Length := Container.Length - 1;
kono
parents:
diff changeset
312
kono
parents:
diff changeset
313 Free (Container, X);
kono
parents:
diff changeset
314 end loop;
kono
parents:
diff changeset
315 end Delete_First;
kono
parents:
diff changeset
316
kono
parents:
diff changeset
317 -----------------
kono
parents:
diff changeset
318 -- Delete_Last --
kono
parents:
diff changeset
319 -----------------
kono
parents:
diff changeset
320
kono
parents:
diff changeset
321 procedure Delete_Last
kono
parents:
diff changeset
322 (Container : in out List;
kono
parents:
diff changeset
323 Count : Count_Type := 1)
kono
parents:
diff changeset
324 is
kono
parents:
diff changeset
325 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
326 X : Count_Type;
kono
parents:
diff changeset
327
kono
parents:
diff changeset
328 begin
kono
parents:
diff changeset
329 if Count >= Container.Length then
kono
parents:
diff changeset
330 Clear (Container);
kono
parents:
diff changeset
331 return;
kono
parents:
diff changeset
332 end if;
kono
parents:
diff changeset
333
kono
parents:
diff changeset
334 if Count = 0 then
kono
parents:
diff changeset
335 return;
kono
parents:
diff changeset
336 end if;
kono
parents:
diff changeset
337
kono
parents:
diff changeset
338 -- if Container.Busy > 0 then
kono
parents:
diff changeset
339 -- raise Program_Error;
kono
parents:
diff changeset
340 -- end if;
kono
parents:
diff changeset
341
kono
parents:
diff changeset
342 for I in 1 .. Count loop
kono
parents:
diff changeset
343 X := Container.Last;
kono
parents:
diff changeset
344 pragma Assert (N (N (X).Prev).Next = Container.Last);
kono
parents:
diff changeset
345
kono
parents:
diff changeset
346 Container.Last := N (X).Prev;
kono
parents:
diff changeset
347 N (Container.Last).Next := 0;
kono
parents:
diff changeset
348
kono
parents:
diff changeset
349 Container.Length := Container.Length - 1;
kono
parents:
diff changeset
350
kono
parents:
diff changeset
351 Free (Container, X);
kono
parents:
diff changeset
352 end loop;
kono
parents:
diff changeset
353 end Delete_Last;
kono
parents:
diff changeset
354
kono
parents:
diff changeset
355 -------------
kono
parents:
diff changeset
356 -- Element --
kono
parents:
diff changeset
357 -------------
kono
parents:
diff changeset
358
kono
parents:
diff changeset
359 function Element (Position : Cursor) return Element_Type is
kono
parents:
diff changeset
360 begin
kono
parents:
diff changeset
361 if Position.Node = 0 then
kono
parents:
diff changeset
362 raise Constraint_Error;
kono
parents:
diff changeset
363 end if;
kono
parents:
diff changeset
364
kono
parents:
diff changeset
365 pragma Assert (Vet (Position), "bad cursor in Element");
kono
parents:
diff changeset
366
kono
parents:
diff changeset
367 declare
kono
parents:
diff changeset
368 N : Node_Array renames Position.Container.Nodes;
kono
parents:
diff changeset
369 begin
kono
parents:
diff changeset
370 return N (Position.Node).Element;
kono
parents:
diff changeset
371 end;
kono
parents:
diff changeset
372 end Element;
kono
parents:
diff changeset
373
kono
parents:
diff changeset
374 ----------
kono
parents:
diff changeset
375 -- Find --
kono
parents:
diff changeset
376 ----------
kono
parents:
diff changeset
377
kono
parents:
diff changeset
378 function Find
kono
parents:
diff changeset
379 (Container : List;
kono
parents:
diff changeset
380 Item : Element_Type;
kono
parents:
diff changeset
381 Position : Cursor := No_Element) return Cursor
kono
parents:
diff changeset
382 is
kono
parents:
diff changeset
383 Nodes : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
384 Node : Count_Type := Position.Node;
kono
parents:
diff changeset
385
kono
parents:
diff changeset
386 begin
kono
parents:
diff changeset
387 if Node = 0 then
kono
parents:
diff changeset
388 Node := Container.First;
kono
parents:
diff changeset
389
kono
parents:
diff changeset
390 else
kono
parents:
diff changeset
391 if Position.Container /= Container'Unrestricted_Access then
kono
parents:
diff changeset
392 raise Program_Error;
kono
parents:
diff changeset
393 end if;
kono
parents:
diff changeset
394
kono
parents:
diff changeset
395 pragma Assert (Vet (Position), "bad cursor in Find");
kono
parents:
diff changeset
396 end if;
kono
parents:
diff changeset
397
kono
parents:
diff changeset
398 while Node /= 0 loop
kono
parents:
diff changeset
399 if Nodes (Node).Element = Item then
kono
parents:
diff changeset
400 return Cursor'(Container'Unrestricted_Access, Node);
kono
parents:
diff changeset
401 end if;
kono
parents:
diff changeset
402
kono
parents:
diff changeset
403 Node := Nodes (Node).Next;
kono
parents:
diff changeset
404 end loop;
kono
parents:
diff changeset
405
kono
parents:
diff changeset
406 return No_Element;
kono
parents:
diff changeset
407 end Find;
kono
parents:
diff changeset
408
kono
parents:
diff changeset
409 -----------
kono
parents:
diff changeset
410 -- First --
kono
parents:
diff changeset
411 -----------
kono
parents:
diff changeset
412
kono
parents:
diff changeset
413 function First (Container : List) return Cursor is
kono
parents:
diff changeset
414 begin
kono
parents:
diff changeset
415 if Container.First = 0 then
kono
parents:
diff changeset
416 return No_Element;
kono
parents:
diff changeset
417 end if;
kono
parents:
diff changeset
418
kono
parents:
diff changeset
419 return Cursor'(Container'Unrestricted_Access, Container.First);
kono
parents:
diff changeset
420 end First;
kono
parents:
diff changeset
421
kono
parents:
diff changeset
422 -------------------
kono
parents:
diff changeset
423 -- First_Element --
kono
parents:
diff changeset
424 -------------------
kono
parents:
diff changeset
425
kono
parents:
diff changeset
426 function First_Element (Container : List) return Element_Type is
kono
parents:
diff changeset
427 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
428
kono
parents:
diff changeset
429 begin
kono
parents:
diff changeset
430 if Container.First = 0 then
kono
parents:
diff changeset
431 raise Constraint_Error;
kono
parents:
diff changeset
432 end if;
kono
parents:
diff changeset
433
kono
parents:
diff changeset
434 return N (Container.First).Element;
kono
parents:
diff changeset
435 end First_Element;
kono
parents:
diff changeset
436
kono
parents:
diff changeset
437 ----------
kono
parents:
diff changeset
438 -- Free --
kono
parents:
diff changeset
439 ----------
kono
parents:
diff changeset
440
kono
parents:
diff changeset
441 procedure Free
kono
parents:
diff changeset
442 (Container : in out List'Class;
kono
parents:
diff changeset
443 X : Count_Type)
kono
parents:
diff changeset
444 is
kono
parents:
diff changeset
445 pragma Assert (X > 0);
kono
parents:
diff changeset
446 pragma Assert (X <= Container.Capacity);
kono
parents:
diff changeset
447
kono
parents:
diff changeset
448 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
449
kono
parents:
diff changeset
450 begin
kono
parents:
diff changeset
451 N (X).Prev := -1; -- Node is deallocated (not on active list)
kono
parents:
diff changeset
452
kono
parents:
diff changeset
453 if Container.Free >= 0 then
kono
parents:
diff changeset
454 N (X).Next := Container.Free;
kono
parents:
diff changeset
455 Container.Free := X;
kono
parents:
diff changeset
456
kono
parents:
diff changeset
457 elsif X + 1 = abs Container.Free then
kono
parents:
diff changeset
458 N (X).Next := 0; -- Not strictly necessary, but marginally safer
kono
parents:
diff changeset
459 Container.Free := Container.Free + 1;
kono
parents:
diff changeset
460
kono
parents:
diff changeset
461 else
kono
parents:
diff changeset
462 Container.Free := abs Container.Free;
kono
parents:
diff changeset
463
kono
parents:
diff changeset
464 if Container.Free > Container.Capacity then
kono
parents:
diff changeset
465 Container.Free := 0;
kono
parents:
diff changeset
466
kono
parents:
diff changeset
467 else
kono
parents:
diff changeset
468 for I in Container.Free .. Container.Capacity - 1 loop
kono
parents:
diff changeset
469 N (I).Next := I + 1;
kono
parents:
diff changeset
470 end loop;
kono
parents:
diff changeset
471
kono
parents:
diff changeset
472 N (Container.Capacity).Next := 0;
kono
parents:
diff changeset
473 end if;
kono
parents:
diff changeset
474
kono
parents:
diff changeset
475 N (X).Next := Container.Free;
kono
parents:
diff changeset
476 Container.Free := X;
kono
parents:
diff changeset
477 end if;
kono
parents:
diff changeset
478 end Free;
kono
parents:
diff changeset
479
kono
parents:
diff changeset
480 ---------------------
kono
parents:
diff changeset
481 -- Generic_Sorting --
kono
parents:
diff changeset
482 ---------------------
kono
parents:
diff changeset
483
kono
parents:
diff changeset
484 package body Generic_Sorting is
kono
parents:
diff changeset
485
kono
parents:
diff changeset
486 ---------------
kono
parents:
diff changeset
487 -- Is_Sorted --
kono
parents:
diff changeset
488 ---------------
kono
parents:
diff changeset
489
kono
parents:
diff changeset
490 function Is_Sorted (Container : List) return Boolean is
kono
parents:
diff changeset
491 Nodes : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
492 Node : Count_Type := Container.First;
kono
parents:
diff changeset
493
kono
parents:
diff changeset
494 begin
kono
parents:
diff changeset
495 for I in 2 .. Container.Length loop
kono
parents:
diff changeset
496 if Nodes (Nodes (Node).Next).Element < Nodes (Node).Element then
kono
parents:
diff changeset
497 return False;
kono
parents:
diff changeset
498 end if;
kono
parents:
diff changeset
499
kono
parents:
diff changeset
500 Node := Nodes (Node).Next;
kono
parents:
diff changeset
501 end loop;
kono
parents:
diff changeset
502
kono
parents:
diff changeset
503 return True;
kono
parents:
diff changeset
504 end Is_Sorted;
kono
parents:
diff changeset
505
kono
parents:
diff changeset
506 ----------
kono
parents:
diff changeset
507 -- Sort --
kono
parents:
diff changeset
508 ----------
kono
parents:
diff changeset
509
kono
parents:
diff changeset
510 procedure Sort (Container : in out List) is
kono
parents:
diff changeset
511 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
512
kono
parents:
diff changeset
513 procedure Partition (Pivot, Back : Count_Type);
kono
parents:
diff changeset
514 procedure Sort (Front, Back : Count_Type);
kono
parents:
diff changeset
515
kono
parents:
diff changeset
516 ---------------
kono
parents:
diff changeset
517 -- Partition --
kono
parents:
diff changeset
518 ---------------
kono
parents:
diff changeset
519
kono
parents:
diff changeset
520 procedure Partition (Pivot, Back : Count_Type) is
kono
parents:
diff changeset
521 Node : Count_Type := N (Pivot).Next;
kono
parents:
diff changeset
522
kono
parents:
diff changeset
523 begin
kono
parents:
diff changeset
524 while Node /= Back loop
kono
parents:
diff changeset
525 if N (Node).Element < N (Pivot).Element then
kono
parents:
diff changeset
526 declare
kono
parents:
diff changeset
527 Prev : constant Count_Type := N (Node).Prev;
kono
parents:
diff changeset
528 Next : constant Count_Type := N (Node).Next;
kono
parents:
diff changeset
529
kono
parents:
diff changeset
530 begin
kono
parents:
diff changeset
531 N (Prev).Next := Next;
kono
parents:
diff changeset
532
kono
parents:
diff changeset
533 if Next = 0 then
kono
parents:
diff changeset
534 Container.Last := Prev;
kono
parents:
diff changeset
535 else
kono
parents:
diff changeset
536 N (Next).Prev := Prev;
kono
parents:
diff changeset
537 end if;
kono
parents:
diff changeset
538
kono
parents:
diff changeset
539 N (Node).Next := Pivot;
kono
parents:
diff changeset
540 N (Node).Prev := N (Pivot).Prev;
kono
parents:
diff changeset
541
kono
parents:
diff changeset
542 N (Pivot).Prev := Node;
kono
parents:
diff changeset
543
kono
parents:
diff changeset
544 if N (Node).Prev = 0 then
kono
parents:
diff changeset
545 Container.First := Node;
kono
parents:
diff changeset
546 else
kono
parents:
diff changeset
547 N (N (Node).Prev).Next := Node;
kono
parents:
diff changeset
548 end if;
kono
parents:
diff changeset
549
kono
parents:
diff changeset
550 Node := Next;
kono
parents:
diff changeset
551 end;
kono
parents:
diff changeset
552
kono
parents:
diff changeset
553 else
kono
parents:
diff changeset
554 Node := N (Node).Next;
kono
parents:
diff changeset
555 end if;
kono
parents:
diff changeset
556 end loop;
kono
parents:
diff changeset
557 end Partition;
kono
parents:
diff changeset
558
kono
parents:
diff changeset
559 ----------
kono
parents:
diff changeset
560 -- Sort --
kono
parents:
diff changeset
561 ----------
kono
parents:
diff changeset
562
kono
parents:
diff changeset
563 procedure Sort (Front, Back : Count_Type) is
kono
parents:
diff changeset
564 Pivot : constant Count_Type :=
kono
parents:
diff changeset
565 (if Front = 0 then Container.First else N (Front).Next);
kono
parents:
diff changeset
566 begin
kono
parents:
diff changeset
567 if Pivot /= Back then
kono
parents:
diff changeset
568 Partition (Pivot, Back);
kono
parents:
diff changeset
569 Sort (Front, Pivot);
kono
parents:
diff changeset
570 Sort (Pivot, Back);
kono
parents:
diff changeset
571 end if;
kono
parents:
diff changeset
572 end Sort;
kono
parents:
diff changeset
573
kono
parents:
diff changeset
574 -- Start of processing for Sort
kono
parents:
diff changeset
575
kono
parents:
diff changeset
576 begin
kono
parents:
diff changeset
577 if Container.Length <= 1 then
kono
parents:
diff changeset
578 return;
kono
parents:
diff changeset
579 end if;
kono
parents:
diff changeset
580
kono
parents:
diff changeset
581 pragma Assert (N (Container.First).Prev = 0);
kono
parents:
diff changeset
582 pragma Assert (N (Container.Last).Next = 0);
kono
parents:
diff changeset
583
kono
parents:
diff changeset
584 -- if Container.Busy > 0 then
kono
parents:
diff changeset
585 -- raise Program_Error;
kono
parents:
diff changeset
586 -- end if;
kono
parents:
diff changeset
587
kono
parents:
diff changeset
588 Sort (Front => 0, Back => 0);
kono
parents:
diff changeset
589
kono
parents:
diff changeset
590 pragma Assert (N (Container.First).Prev = 0);
kono
parents:
diff changeset
591 pragma Assert (N (Container.Last).Next = 0);
kono
parents:
diff changeset
592 end Sort;
kono
parents:
diff changeset
593
kono
parents:
diff changeset
594 end Generic_Sorting;
kono
parents:
diff changeset
595
kono
parents:
diff changeset
596 -----------------
kono
parents:
diff changeset
597 -- Has_Element --
kono
parents:
diff changeset
598 -----------------
kono
parents:
diff changeset
599
kono
parents:
diff changeset
600 function Has_Element (Position : Cursor) return Boolean is
kono
parents:
diff changeset
601 begin
kono
parents:
diff changeset
602 pragma Assert (Vet (Position), "bad cursor in Has_Element");
kono
parents:
diff changeset
603 return Position.Node /= 0;
kono
parents:
diff changeset
604 end Has_Element;
kono
parents:
diff changeset
605
kono
parents:
diff changeset
606 ------------
kono
parents:
diff changeset
607 -- Insert --
kono
parents:
diff changeset
608 ------------
kono
parents:
diff changeset
609
kono
parents:
diff changeset
610 procedure Insert
kono
parents:
diff changeset
611 (Container : in out List;
kono
parents:
diff changeset
612 Before : Cursor;
kono
parents:
diff changeset
613 New_Item : Element_Type;
kono
parents:
diff changeset
614 Position : out Cursor;
kono
parents:
diff changeset
615 Count : Count_Type := 1)
kono
parents:
diff changeset
616 is
kono
parents:
diff changeset
617 First_Node : Count_Type;
kono
parents:
diff changeset
618 New_Node : Count_Type;
kono
parents:
diff changeset
619
kono
parents:
diff changeset
620 begin
kono
parents:
diff changeset
621 if Before.Container /= null then
kono
parents:
diff changeset
622 if Before.Container /= Container'Unrestricted_Access then
kono
parents:
diff changeset
623 raise Program_Error;
kono
parents:
diff changeset
624 end if;
kono
parents:
diff changeset
625
kono
parents:
diff changeset
626 pragma Assert (Vet (Before), "bad cursor in Insert");
kono
parents:
diff changeset
627 end if;
kono
parents:
diff changeset
628
kono
parents:
diff changeset
629 if Count = 0 then
kono
parents:
diff changeset
630 Position := Before;
kono
parents:
diff changeset
631 return;
kono
parents:
diff changeset
632 end if;
kono
parents:
diff changeset
633
kono
parents:
diff changeset
634 if Container.Length > Container.Capacity - Count then
kono
parents:
diff changeset
635 raise Constraint_Error;
kono
parents:
diff changeset
636 end if;
kono
parents:
diff changeset
637
kono
parents:
diff changeset
638 -- if Container.Busy > 0 then
kono
parents:
diff changeset
639 -- raise Program_Error;
kono
parents:
diff changeset
640 -- end if;
kono
parents:
diff changeset
641
kono
parents:
diff changeset
642 Allocate (Container, New_Item, New_Node);
kono
parents:
diff changeset
643 First_Node := New_Node;
kono
parents:
diff changeset
644 Insert_Internal (Container, Before.Node, New_Node);
kono
parents:
diff changeset
645
kono
parents:
diff changeset
646 for Index in 2 .. Count loop
kono
parents:
diff changeset
647 Allocate (Container, New_Item, New_Node);
kono
parents:
diff changeset
648 Insert_Internal (Container, Before.Node, New_Node);
kono
parents:
diff changeset
649 end loop;
kono
parents:
diff changeset
650
kono
parents:
diff changeset
651 Position := Cursor'(Container'Unrestricted_Access, First_Node);
kono
parents:
diff changeset
652 end Insert;
kono
parents:
diff changeset
653
kono
parents:
diff changeset
654 procedure Insert
kono
parents:
diff changeset
655 (Container : in out List;
kono
parents:
diff changeset
656 Before : Cursor;
kono
parents:
diff changeset
657 New_Item : Element_Type;
kono
parents:
diff changeset
658 Count : Count_Type := 1)
kono
parents:
diff changeset
659 is
kono
parents:
diff changeset
660 Position : Cursor;
kono
parents:
diff changeset
661 pragma Unreferenced (Position);
kono
parents:
diff changeset
662 begin
kono
parents:
diff changeset
663 Insert (Container, Before, New_Item, Position, Count);
kono
parents:
diff changeset
664 end Insert;
kono
parents:
diff changeset
665
kono
parents:
diff changeset
666 procedure Insert
kono
parents:
diff changeset
667 (Container : in out List;
kono
parents:
diff changeset
668 Before : Cursor;
kono
parents:
diff changeset
669 Position : out Cursor;
kono
parents:
diff changeset
670 Count : Count_Type := 1)
kono
parents:
diff changeset
671 is
kono
parents:
diff changeset
672 New_Item : Element_Type; -- Do we need to reinit node ???
kono
parents:
diff changeset
673 pragma Warnings (Off, New_Item);
kono
parents:
diff changeset
674
kono
parents:
diff changeset
675 begin
kono
parents:
diff changeset
676 Insert (Container, Before, New_Item, Position, Count);
kono
parents:
diff changeset
677 end Insert;
kono
parents:
diff changeset
678
kono
parents:
diff changeset
679 ---------------------
kono
parents:
diff changeset
680 -- Insert_Internal --
kono
parents:
diff changeset
681 ---------------------
kono
parents:
diff changeset
682
kono
parents:
diff changeset
683 procedure Insert_Internal
kono
parents:
diff changeset
684 (Container : in out List'Class;
kono
parents:
diff changeset
685 Before : Count_Type;
kono
parents:
diff changeset
686 New_Node : Count_Type)
kono
parents:
diff changeset
687 is
kono
parents:
diff changeset
688 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
689
kono
parents:
diff changeset
690 begin
kono
parents:
diff changeset
691 if Container.Length = 0 then
kono
parents:
diff changeset
692 pragma Assert (Before = 0);
kono
parents:
diff changeset
693 pragma Assert (Container.First = 0);
kono
parents:
diff changeset
694 pragma Assert (Container.Last = 0);
kono
parents:
diff changeset
695
kono
parents:
diff changeset
696 Container.First := New_Node;
kono
parents:
diff changeset
697 Container.Last := New_Node;
kono
parents:
diff changeset
698
kono
parents:
diff changeset
699 N (Container.First).Prev := 0;
kono
parents:
diff changeset
700 N (Container.Last).Next := 0;
kono
parents:
diff changeset
701
kono
parents:
diff changeset
702 elsif Before = 0 then
kono
parents:
diff changeset
703 pragma Assert (N (Container.Last).Next = 0);
kono
parents:
diff changeset
704
kono
parents:
diff changeset
705 N (Container.Last).Next := New_Node;
kono
parents:
diff changeset
706 N (New_Node).Prev := Container.Last;
kono
parents:
diff changeset
707
kono
parents:
diff changeset
708 Container.Last := New_Node;
kono
parents:
diff changeset
709 N (Container.Last).Next := 0;
kono
parents:
diff changeset
710
kono
parents:
diff changeset
711 elsif Before = Container.First then
kono
parents:
diff changeset
712 pragma Assert (N (Container.First).Prev = 0);
kono
parents:
diff changeset
713
kono
parents:
diff changeset
714 N (Container.First).Prev := New_Node;
kono
parents:
diff changeset
715 N (New_Node).Next := Container.First;
kono
parents:
diff changeset
716
kono
parents:
diff changeset
717 Container.First := New_Node;
kono
parents:
diff changeset
718 N (Container.First).Prev := 0;
kono
parents:
diff changeset
719
kono
parents:
diff changeset
720 else
kono
parents:
diff changeset
721 pragma Assert (N (Container.First).Prev = 0);
kono
parents:
diff changeset
722 pragma Assert (N (Container.Last).Next = 0);
kono
parents:
diff changeset
723
kono
parents:
diff changeset
724 N (New_Node).Next := Before;
kono
parents:
diff changeset
725 N (New_Node).Prev := N (Before).Prev;
kono
parents:
diff changeset
726
kono
parents:
diff changeset
727 N (N (Before).Prev).Next := New_Node;
kono
parents:
diff changeset
728 N (Before).Prev := New_Node;
kono
parents:
diff changeset
729 end if;
kono
parents:
diff changeset
730
kono
parents:
diff changeset
731 Container.Length := Container.Length + 1;
kono
parents:
diff changeset
732 end Insert_Internal;
kono
parents:
diff changeset
733
kono
parents:
diff changeset
734 --------------
kono
parents:
diff changeset
735 -- Is_Empty --
kono
parents:
diff changeset
736 --------------
kono
parents:
diff changeset
737
kono
parents:
diff changeset
738 function Is_Empty (Container : List) return Boolean is
kono
parents:
diff changeset
739 begin
kono
parents:
diff changeset
740 return Container.Length = 0;
kono
parents:
diff changeset
741 end Is_Empty;
kono
parents:
diff changeset
742
kono
parents:
diff changeset
743 -------------
kono
parents:
diff changeset
744 -- Iterate --
kono
parents:
diff changeset
745 -------------
kono
parents:
diff changeset
746
kono
parents:
diff changeset
747 procedure Iterate
kono
parents:
diff changeset
748 (Container : List;
kono
parents:
diff changeset
749 Process : not null access procedure (Position : Cursor))
kono
parents:
diff changeset
750 is
kono
parents:
diff changeset
751 C : List renames Container'Unrestricted_Access.all;
kono
parents:
diff changeset
752 N : Node_Array renames C.Nodes;
kono
parents:
diff changeset
753 -- B : Natural renames C.Busy;
kono
parents:
diff changeset
754
kono
parents:
diff changeset
755 Node : Count_Type := Container.First;
kono
parents:
diff changeset
756
kono
parents:
diff changeset
757 Index : Count_Type := 0;
kono
parents:
diff changeset
758 Index_Max : constant Count_Type := Container.Length;
kono
parents:
diff changeset
759
kono
parents:
diff changeset
760 begin
kono
parents:
diff changeset
761 if Index_Max = 0 then
kono
parents:
diff changeset
762 pragma Assert (Node = 0);
kono
parents:
diff changeset
763 return;
kono
parents:
diff changeset
764 end if;
kono
parents:
diff changeset
765
kono
parents:
diff changeset
766 loop
kono
parents:
diff changeset
767 pragma Assert (Node /= 0);
kono
parents:
diff changeset
768
kono
parents:
diff changeset
769 Process (Cursor'(C'Unchecked_Access, Node));
kono
parents:
diff changeset
770 pragma Assert (Container.Length = Index_Max);
kono
parents:
diff changeset
771 pragma Assert (N (Node).Prev /= -1);
kono
parents:
diff changeset
772
kono
parents:
diff changeset
773 Node := N (Node).Next;
kono
parents:
diff changeset
774 Index := Index + 1;
kono
parents:
diff changeset
775
kono
parents:
diff changeset
776 if Index = Index_Max then
kono
parents:
diff changeset
777 pragma Assert (Node = 0);
kono
parents:
diff changeset
778 return;
kono
parents:
diff changeset
779 end if;
kono
parents:
diff changeset
780 end loop;
kono
parents:
diff changeset
781 end Iterate;
kono
parents:
diff changeset
782
kono
parents:
diff changeset
783 ----------
kono
parents:
diff changeset
784 -- Last --
kono
parents:
diff changeset
785 ----------
kono
parents:
diff changeset
786
kono
parents:
diff changeset
787 function Last (Container : List) return Cursor is
kono
parents:
diff changeset
788 begin
kono
parents:
diff changeset
789 if Container.Last = 0 then
kono
parents:
diff changeset
790 return No_Element;
kono
parents:
diff changeset
791 end if;
kono
parents:
diff changeset
792
kono
parents:
diff changeset
793 return Cursor'(Container'Unrestricted_Access, Container.Last);
kono
parents:
diff changeset
794 end Last;
kono
parents:
diff changeset
795
kono
parents:
diff changeset
796 ------------------
kono
parents:
diff changeset
797 -- Last_Element --
kono
parents:
diff changeset
798 ------------------
kono
parents:
diff changeset
799
kono
parents:
diff changeset
800 function Last_Element (Container : List) return Element_Type is
kono
parents:
diff changeset
801 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
802
kono
parents:
diff changeset
803 begin
kono
parents:
diff changeset
804 if Container.Last = 0 then
kono
parents:
diff changeset
805 raise Constraint_Error;
kono
parents:
diff changeset
806 end if;
kono
parents:
diff changeset
807
kono
parents:
diff changeset
808 return N (Container.Last).Element;
kono
parents:
diff changeset
809 end Last_Element;
kono
parents:
diff changeset
810
kono
parents:
diff changeset
811 ------------
kono
parents:
diff changeset
812 -- Length --
kono
parents:
diff changeset
813 ------------
kono
parents:
diff changeset
814
kono
parents:
diff changeset
815 function Length (Container : List) return Count_Type is
kono
parents:
diff changeset
816 begin
kono
parents:
diff changeset
817 return Container.Length;
kono
parents:
diff changeset
818 end Length;
kono
parents:
diff changeset
819
kono
parents:
diff changeset
820 ----------
kono
parents:
diff changeset
821 -- Next --
kono
parents:
diff changeset
822 ----------
kono
parents:
diff changeset
823
kono
parents:
diff changeset
824 procedure Next (Position : in out Cursor) is
kono
parents:
diff changeset
825 begin
kono
parents:
diff changeset
826 Position := Next (Position);
kono
parents:
diff changeset
827 end Next;
kono
parents:
diff changeset
828
kono
parents:
diff changeset
829 function Next (Position : Cursor) return Cursor is
kono
parents:
diff changeset
830 begin
kono
parents:
diff changeset
831 if Position.Node = 0 then
kono
parents:
diff changeset
832 return No_Element;
kono
parents:
diff changeset
833 end if;
kono
parents:
diff changeset
834
kono
parents:
diff changeset
835 pragma Assert (Vet (Position), "bad cursor in Next");
kono
parents:
diff changeset
836
kono
parents:
diff changeset
837 declare
kono
parents:
diff changeset
838 Nodes : Node_Array renames Position.Container.Nodes;
kono
parents:
diff changeset
839 Node : constant Count_Type := Nodes (Position.Node).Next;
kono
parents:
diff changeset
840
kono
parents:
diff changeset
841 begin
kono
parents:
diff changeset
842 if Node = 0 then
kono
parents:
diff changeset
843 return No_Element;
kono
parents:
diff changeset
844 end if;
kono
parents:
diff changeset
845
kono
parents:
diff changeset
846 return Cursor'(Position.Container, Node);
kono
parents:
diff changeset
847 end;
kono
parents:
diff changeset
848 end Next;
kono
parents:
diff changeset
849
kono
parents:
diff changeset
850 -------------
kono
parents:
diff changeset
851 -- Prepend --
kono
parents:
diff changeset
852 -------------
kono
parents:
diff changeset
853
kono
parents:
diff changeset
854 procedure Prepend
kono
parents:
diff changeset
855 (Container : in out List;
kono
parents:
diff changeset
856 New_Item : Element_Type;
kono
parents:
diff changeset
857 Count : Count_Type := 1)
kono
parents:
diff changeset
858 is
kono
parents:
diff changeset
859 begin
kono
parents:
diff changeset
860 Insert (Container, First (Container), New_Item, Count);
kono
parents:
diff changeset
861 end Prepend;
kono
parents:
diff changeset
862
kono
parents:
diff changeset
863 --------------
kono
parents:
diff changeset
864 -- Previous --
kono
parents:
diff changeset
865 --------------
kono
parents:
diff changeset
866
kono
parents:
diff changeset
867 procedure Previous (Position : in out Cursor) is
kono
parents:
diff changeset
868 begin
kono
parents:
diff changeset
869 Position := Previous (Position);
kono
parents:
diff changeset
870 end Previous;
kono
parents:
diff changeset
871
kono
parents:
diff changeset
872 function Previous (Position : Cursor) return Cursor is
kono
parents:
diff changeset
873 begin
kono
parents:
diff changeset
874 if Position.Node = 0 then
kono
parents:
diff changeset
875 return No_Element;
kono
parents:
diff changeset
876 end if;
kono
parents:
diff changeset
877
kono
parents:
diff changeset
878 pragma Assert (Vet (Position), "bad cursor in Previous");
kono
parents:
diff changeset
879
kono
parents:
diff changeset
880 declare
kono
parents:
diff changeset
881 Nodes : Node_Array renames Position.Container.Nodes;
kono
parents:
diff changeset
882 Node : constant Count_Type := Nodes (Position.Node).Prev;
kono
parents:
diff changeset
883 begin
kono
parents:
diff changeset
884 if Node = 0 then
kono
parents:
diff changeset
885 return No_Element;
kono
parents:
diff changeset
886 end if;
kono
parents:
diff changeset
887
kono
parents:
diff changeset
888 return Cursor'(Position.Container, Node);
kono
parents:
diff changeset
889 end;
kono
parents:
diff changeset
890 end Previous;
kono
parents:
diff changeset
891
kono
parents:
diff changeset
892 -------------------
kono
parents:
diff changeset
893 -- Query_Element --
kono
parents:
diff changeset
894 -------------------
kono
parents:
diff changeset
895
kono
parents:
diff changeset
896 procedure Query_Element
kono
parents:
diff changeset
897 (Position : Cursor;
kono
parents:
diff changeset
898 Process : not null access procedure (Element : Element_Type))
kono
parents:
diff changeset
899 is
kono
parents:
diff changeset
900 begin
kono
parents:
diff changeset
901 if Position.Node = 0 then
kono
parents:
diff changeset
902 raise Constraint_Error;
kono
parents:
diff changeset
903 end if;
kono
parents:
diff changeset
904
kono
parents:
diff changeset
905 pragma Assert (Vet (Position), "bad cursor in Query_Element");
kono
parents:
diff changeset
906
kono
parents:
diff changeset
907 declare
kono
parents:
diff changeset
908 C : List renames Position.Container.all'Unrestricted_Access.all;
kono
parents:
diff changeset
909 N : Node_Type renames C.Nodes (Position.Node);
kono
parents:
diff changeset
910
kono
parents:
diff changeset
911 begin
kono
parents:
diff changeset
912 Process (N.Element);
kono
parents:
diff changeset
913 pragma Assert (N.Prev >= 0);
kono
parents:
diff changeset
914 end;
kono
parents:
diff changeset
915 end Query_Element;
kono
parents:
diff changeset
916
kono
parents:
diff changeset
917 ---------------------
kono
parents:
diff changeset
918 -- Replace_Element --
kono
parents:
diff changeset
919 ---------------------
kono
parents:
diff changeset
920
kono
parents:
diff changeset
921 procedure Replace_Element
kono
parents:
diff changeset
922 (Container : in out List;
kono
parents:
diff changeset
923 Position : Cursor;
kono
parents:
diff changeset
924 New_Item : Element_Type)
kono
parents:
diff changeset
925 is
kono
parents:
diff changeset
926 begin
kono
parents:
diff changeset
927 if Position.Container = null then
kono
parents:
diff changeset
928 raise Constraint_Error;
kono
parents:
diff changeset
929 end if;
kono
parents:
diff changeset
930
kono
parents:
diff changeset
931 if Position.Container /= Container'Unrestricted_Access then
kono
parents:
diff changeset
932 raise Program_Error;
kono
parents:
diff changeset
933 end if;
kono
parents:
diff changeset
934
kono
parents:
diff changeset
935 -- if Container.Lock > 0 then
kono
parents:
diff changeset
936 -- raise Program_Error;
kono
parents:
diff changeset
937 -- end if;
kono
parents:
diff changeset
938
kono
parents:
diff changeset
939 pragma Assert (Vet (Position), "bad cursor in Replace_Element");
kono
parents:
diff changeset
940
kono
parents:
diff changeset
941 declare
kono
parents:
diff changeset
942 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
943 begin
kono
parents:
diff changeset
944 N (Position.Node).Element := New_Item;
kono
parents:
diff changeset
945 end;
kono
parents:
diff changeset
946 end Replace_Element;
kono
parents:
diff changeset
947
kono
parents:
diff changeset
948 ----------------------
kono
parents:
diff changeset
949 -- Reverse_Elements --
kono
parents:
diff changeset
950 ----------------------
kono
parents:
diff changeset
951
kono
parents:
diff changeset
952 procedure Reverse_Elements (Container : in out List) is
kono
parents:
diff changeset
953 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
954 I : Count_Type := Container.First;
kono
parents:
diff changeset
955 J : Count_Type := Container.Last;
kono
parents:
diff changeset
956
kono
parents:
diff changeset
957 procedure Swap (L, R : Count_Type);
kono
parents:
diff changeset
958
kono
parents:
diff changeset
959 ----------
kono
parents:
diff changeset
960 -- Swap --
kono
parents:
diff changeset
961 ----------
kono
parents:
diff changeset
962
kono
parents:
diff changeset
963 procedure Swap (L, R : Count_Type) is
kono
parents:
diff changeset
964 LN : constant Count_Type := N (L).Next;
kono
parents:
diff changeset
965 LP : constant Count_Type := N (L).Prev;
kono
parents:
diff changeset
966
kono
parents:
diff changeset
967 RN : constant Count_Type := N (R).Next;
kono
parents:
diff changeset
968 RP : constant Count_Type := N (R).Prev;
kono
parents:
diff changeset
969
kono
parents:
diff changeset
970 begin
kono
parents:
diff changeset
971 if LP /= 0 then
kono
parents:
diff changeset
972 N (LP).Next := R;
kono
parents:
diff changeset
973 end if;
kono
parents:
diff changeset
974
kono
parents:
diff changeset
975 if RN /= 0 then
kono
parents:
diff changeset
976 N (RN).Prev := L;
kono
parents:
diff changeset
977 end if;
kono
parents:
diff changeset
978
kono
parents:
diff changeset
979 N (L).Next := RN;
kono
parents:
diff changeset
980 N (R).Prev := LP;
kono
parents:
diff changeset
981
kono
parents:
diff changeset
982 if LN = R then
kono
parents:
diff changeset
983 pragma Assert (RP = L);
kono
parents:
diff changeset
984
kono
parents:
diff changeset
985 N (L).Prev := R;
kono
parents:
diff changeset
986 N (R).Next := L;
kono
parents:
diff changeset
987
kono
parents:
diff changeset
988 else
kono
parents:
diff changeset
989 N (L).Prev := RP;
kono
parents:
diff changeset
990 N (RP).Next := L;
kono
parents:
diff changeset
991
kono
parents:
diff changeset
992 N (R).Next := LN;
kono
parents:
diff changeset
993 N (LN).Prev := R;
kono
parents:
diff changeset
994 end if;
kono
parents:
diff changeset
995 end Swap;
kono
parents:
diff changeset
996
kono
parents:
diff changeset
997 -- Start of processing for Reverse_Elements
kono
parents:
diff changeset
998
kono
parents:
diff changeset
999 begin
kono
parents:
diff changeset
1000 if Container.Length <= 1 then
kono
parents:
diff changeset
1001 return;
kono
parents:
diff changeset
1002 end if;
kono
parents:
diff changeset
1003
kono
parents:
diff changeset
1004 pragma Assert (N (Container.First).Prev = 0);
kono
parents:
diff changeset
1005 pragma Assert (N (Container.Last).Next = 0);
kono
parents:
diff changeset
1006
kono
parents:
diff changeset
1007 -- if Container.Busy > 0 then
kono
parents:
diff changeset
1008 -- raise Program_Error;
kono
parents:
diff changeset
1009 -- end if;
kono
parents:
diff changeset
1010
kono
parents:
diff changeset
1011 Container.First := J;
kono
parents:
diff changeset
1012 Container.Last := I;
kono
parents:
diff changeset
1013 loop
kono
parents:
diff changeset
1014 Swap (L => I, R => J);
kono
parents:
diff changeset
1015
kono
parents:
diff changeset
1016 J := N (J).Next;
kono
parents:
diff changeset
1017 exit when I = J;
kono
parents:
diff changeset
1018
kono
parents:
diff changeset
1019 I := N (I).Prev;
kono
parents:
diff changeset
1020 exit when I = J;
kono
parents:
diff changeset
1021
kono
parents:
diff changeset
1022 Swap (L => J, R => I);
kono
parents:
diff changeset
1023
kono
parents:
diff changeset
1024 I := N (I).Next;
kono
parents:
diff changeset
1025 exit when I = J;
kono
parents:
diff changeset
1026
kono
parents:
diff changeset
1027 J := N (J).Prev;
kono
parents:
diff changeset
1028 exit when I = J;
kono
parents:
diff changeset
1029 end loop;
kono
parents:
diff changeset
1030
kono
parents:
diff changeset
1031 pragma Assert (N (Container.First).Prev = 0);
kono
parents:
diff changeset
1032 pragma Assert (N (Container.Last).Next = 0);
kono
parents:
diff changeset
1033 end Reverse_Elements;
kono
parents:
diff changeset
1034
kono
parents:
diff changeset
1035 ------------------
kono
parents:
diff changeset
1036 -- Reverse_Find --
kono
parents:
diff changeset
1037 ------------------
kono
parents:
diff changeset
1038
kono
parents:
diff changeset
1039 function Reverse_Find
kono
parents:
diff changeset
1040 (Container : List;
kono
parents:
diff changeset
1041 Item : Element_Type;
kono
parents:
diff changeset
1042 Position : Cursor := No_Element) return Cursor
kono
parents:
diff changeset
1043 is
kono
parents:
diff changeset
1044 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
1045 Node : Count_Type := Position.Node;
kono
parents:
diff changeset
1046
kono
parents:
diff changeset
1047 begin
kono
parents:
diff changeset
1048 if Node = 0 then
kono
parents:
diff changeset
1049 Node := Container.Last;
kono
parents:
diff changeset
1050
kono
parents:
diff changeset
1051 else
kono
parents:
diff changeset
1052 if Position.Container /= Container'Unrestricted_Access then
kono
parents:
diff changeset
1053 raise Program_Error;
kono
parents:
diff changeset
1054 end if;
kono
parents:
diff changeset
1055
kono
parents:
diff changeset
1056 pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
kono
parents:
diff changeset
1057 end if;
kono
parents:
diff changeset
1058
kono
parents:
diff changeset
1059 while Node /= 0 loop
kono
parents:
diff changeset
1060 if N (Node).Element = Item then
kono
parents:
diff changeset
1061 return Cursor'(Container'Unrestricted_Access, Node);
kono
parents:
diff changeset
1062 end if;
kono
parents:
diff changeset
1063
kono
parents:
diff changeset
1064 Node := N (Node).Prev;
kono
parents:
diff changeset
1065 end loop;
kono
parents:
diff changeset
1066
kono
parents:
diff changeset
1067 return No_Element;
kono
parents:
diff changeset
1068 end Reverse_Find;
kono
parents:
diff changeset
1069
kono
parents:
diff changeset
1070 ---------------------
kono
parents:
diff changeset
1071 -- Reverse_Iterate --
kono
parents:
diff changeset
1072 ---------------------
kono
parents:
diff changeset
1073
kono
parents:
diff changeset
1074 procedure Reverse_Iterate
kono
parents:
diff changeset
1075 (Container : List;
kono
parents:
diff changeset
1076 Process : not null access procedure (Position : Cursor))
kono
parents:
diff changeset
1077 is
kono
parents:
diff changeset
1078 C : List renames Container'Unrestricted_Access.all;
kono
parents:
diff changeset
1079 N : Node_Array renames C.Nodes;
kono
parents:
diff changeset
1080 -- B : Natural renames C.Busy;
kono
parents:
diff changeset
1081
kono
parents:
diff changeset
1082 Node : Count_Type := Container.Last;
kono
parents:
diff changeset
1083
kono
parents:
diff changeset
1084 Index : Count_Type := 0;
kono
parents:
diff changeset
1085 Index_Max : constant Count_Type := Container.Length;
kono
parents:
diff changeset
1086
kono
parents:
diff changeset
1087 begin
kono
parents:
diff changeset
1088 if Index_Max = 0 then
kono
parents:
diff changeset
1089 pragma Assert (Node = 0);
kono
parents:
diff changeset
1090 return;
kono
parents:
diff changeset
1091 end if;
kono
parents:
diff changeset
1092
kono
parents:
diff changeset
1093 loop
kono
parents:
diff changeset
1094 pragma Assert (Node > 0);
kono
parents:
diff changeset
1095
kono
parents:
diff changeset
1096 Process (Cursor'(C'Unchecked_Access, Node));
kono
parents:
diff changeset
1097 pragma Assert (Container.Length = Index_Max);
kono
parents:
diff changeset
1098 pragma Assert (N (Node).Prev /= -1);
kono
parents:
diff changeset
1099
kono
parents:
diff changeset
1100 Node := N (Node).Prev;
kono
parents:
diff changeset
1101 Index := Index + 1;
kono
parents:
diff changeset
1102
kono
parents:
diff changeset
1103 if Index = Index_Max then
kono
parents:
diff changeset
1104 pragma Assert (Node = 0);
kono
parents:
diff changeset
1105 return;
kono
parents:
diff changeset
1106 end if;
kono
parents:
diff changeset
1107 end loop;
kono
parents:
diff changeset
1108 end Reverse_Iterate;
kono
parents:
diff changeset
1109
kono
parents:
diff changeset
1110 ------------
kono
parents:
diff changeset
1111 -- Splice --
kono
parents:
diff changeset
1112 ------------
kono
parents:
diff changeset
1113
kono
parents:
diff changeset
1114 procedure Splice
kono
parents:
diff changeset
1115 (Container : in out List;
kono
parents:
diff changeset
1116 Before : Cursor;
kono
parents:
diff changeset
1117 Position : in out Cursor)
kono
parents:
diff changeset
1118 is
kono
parents:
diff changeset
1119 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
1120
kono
parents:
diff changeset
1121 begin
kono
parents:
diff changeset
1122 if Before.Container /= null then
kono
parents:
diff changeset
1123 if Before.Container /= Container'Unrestricted_Access then
kono
parents:
diff changeset
1124 raise Program_Error;
kono
parents:
diff changeset
1125 end if;
kono
parents:
diff changeset
1126
kono
parents:
diff changeset
1127 pragma Assert (Vet (Before), "bad Before cursor in Splice");
kono
parents:
diff changeset
1128 end if;
kono
parents:
diff changeset
1129
kono
parents:
diff changeset
1130 if Position.Node = 0 then
kono
parents:
diff changeset
1131 raise Constraint_Error;
kono
parents:
diff changeset
1132 end if;
kono
parents:
diff changeset
1133
kono
parents:
diff changeset
1134 if Position.Container /= Container'Unrestricted_Access then
kono
parents:
diff changeset
1135 raise Program_Error;
kono
parents:
diff changeset
1136 end if;
kono
parents:
diff changeset
1137
kono
parents:
diff changeset
1138 pragma Assert (Vet (Position), "bad Position cursor in Splice");
kono
parents:
diff changeset
1139
kono
parents:
diff changeset
1140 if Position.Node = Before.Node
kono
parents:
diff changeset
1141 or else N (Position.Node).Next = Before.Node
kono
parents:
diff changeset
1142 then
kono
parents:
diff changeset
1143 return;
kono
parents:
diff changeset
1144 end if;
kono
parents:
diff changeset
1145
kono
parents:
diff changeset
1146 pragma Assert (Container.Length >= 2);
kono
parents:
diff changeset
1147
kono
parents:
diff changeset
1148 -- if Container.Busy > 0 then
kono
parents:
diff changeset
1149 -- raise Program_Error;
kono
parents:
diff changeset
1150 -- end if;
kono
parents:
diff changeset
1151
kono
parents:
diff changeset
1152 if Before.Node = 0 then
kono
parents:
diff changeset
1153 pragma Assert (Position.Node /= Container.Last);
kono
parents:
diff changeset
1154
kono
parents:
diff changeset
1155 if Position.Node = Container.First then
kono
parents:
diff changeset
1156 Container.First := N (Position.Node).Next;
kono
parents:
diff changeset
1157 N (Container.First).Prev := 0;
kono
parents:
diff changeset
1158
kono
parents:
diff changeset
1159 else
kono
parents:
diff changeset
1160 N (N (Position.Node).Prev).Next := N (Position.Node).Next;
kono
parents:
diff changeset
1161 N (N (Position.Node).Next).Prev := N (Position.Node).Prev;
kono
parents:
diff changeset
1162 end if;
kono
parents:
diff changeset
1163
kono
parents:
diff changeset
1164 N (Container.Last).Next := Position.Node;
kono
parents:
diff changeset
1165 N (Position.Node).Prev := Container.Last;
kono
parents:
diff changeset
1166
kono
parents:
diff changeset
1167 Container.Last := Position.Node;
kono
parents:
diff changeset
1168 N (Container.Last).Next := 0;
kono
parents:
diff changeset
1169
kono
parents:
diff changeset
1170 return;
kono
parents:
diff changeset
1171 end if;
kono
parents:
diff changeset
1172
kono
parents:
diff changeset
1173 if Before.Node = Container.First then
kono
parents:
diff changeset
1174 pragma Assert (Position.Node /= Container.First);
kono
parents:
diff changeset
1175
kono
parents:
diff changeset
1176 if Position.Node = Container.Last then
kono
parents:
diff changeset
1177 Container.Last := N (Position.Node).Prev;
kono
parents:
diff changeset
1178 N (Container.Last).Next := 0;
kono
parents:
diff changeset
1179
kono
parents:
diff changeset
1180 else
kono
parents:
diff changeset
1181 N (N (Position.Node).Prev).Next := N (Position.Node).Next;
kono
parents:
diff changeset
1182 N (N (Position.Node).Next).Prev := N (Position.Node).Prev;
kono
parents:
diff changeset
1183 end if;
kono
parents:
diff changeset
1184
kono
parents:
diff changeset
1185 N (Container.First).Prev := Position.Node;
kono
parents:
diff changeset
1186 N (Position.Node).Next := Container.First;
kono
parents:
diff changeset
1187
kono
parents:
diff changeset
1188 Container.First := Position.Node;
kono
parents:
diff changeset
1189 N (Container.First).Prev := 0;
kono
parents:
diff changeset
1190
kono
parents:
diff changeset
1191 return;
kono
parents:
diff changeset
1192 end if;
kono
parents:
diff changeset
1193
kono
parents:
diff changeset
1194 if Position.Node = Container.First then
kono
parents:
diff changeset
1195 Container.First := N (Position.Node).Next;
kono
parents:
diff changeset
1196 N (Container.First).Prev := 0;
kono
parents:
diff changeset
1197
kono
parents:
diff changeset
1198 elsif Position.Node = Container.Last then
kono
parents:
diff changeset
1199 Container.Last := N (Position.Node).Prev;
kono
parents:
diff changeset
1200 N (Container.Last).Next := 0;
kono
parents:
diff changeset
1201
kono
parents:
diff changeset
1202 else
kono
parents:
diff changeset
1203 N (N (Position.Node).Prev).Next := N (Position.Node).Next;
kono
parents:
diff changeset
1204 N (N (Position.Node).Next).Prev := N (Position.Node).Prev;
kono
parents:
diff changeset
1205 end if;
kono
parents:
diff changeset
1206
kono
parents:
diff changeset
1207 N (N (Before.Node).Prev).Next := Position.Node;
kono
parents:
diff changeset
1208 N (Position.Node).Prev := N (Before.Node).Prev;
kono
parents:
diff changeset
1209
kono
parents:
diff changeset
1210 N (Before.Node).Prev := Position.Node;
kono
parents:
diff changeset
1211 N (Position.Node).Next := Before.Node;
kono
parents:
diff changeset
1212
kono
parents:
diff changeset
1213 pragma Assert (N (Container.First).Prev = 0);
kono
parents:
diff changeset
1214 pragma Assert (N (Container.Last).Next = 0);
kono
parents:
diff changeset
1215 end Splice;
kono
parents:
diff changeset
1216
kono
parents:
diff changeset
1217 ----------
kono
parents:
diff changeset
1218 -- Swap --
kono
parents:
diff changeset
1219 ----------
kono
parents:
diff changeset
1220
kono
parents:
diff changeset
1221 procedure Swap
kono
parents:
diff changeset
1222 (Container : in out List;
kono
parents:
diff changeset
1223 I, J : Cursor)
kono
parents:
diff changeset
1224 is
kono
parents:
diff changeset
1225 begin
kono
parents:
diff changeset
1226 if I.Node = 0
kono
parents:
diff changeset
1227 or else J.Node = 0
kono
parents:
diff changeset
1228 then
kono
parents:
diff changeset
1229 raise Constraint_Error;
kono
parents:
diff changeset
1230 end if;
kono
parents:
diff changeset
1231
kono
parents:
diff changeset
1232 if I.Container /= Container'Unrestricted_Access
kono
parents:
diff changeset
1233 or else J.Container /= Container'Unrestricted_Access
kono
parents:
diff changeset
1234 then
kono
parents:
diff changeset
1235 raise Program_Error;
kono
parents:
diff changeset
1236 end if;
kono
parents:
diff changeset
1237
kono
parents:
diff changeset
1238 if I.Node = J.Node then
kono
parents:
diff changeset
1239 return;
kono
parents:
diff changeset
1240 end if;
kono
parents:
diff changeset
1241
kono
parents:
diff changeset
1242 -- if Container.Lock > 0 then
kono
parents:
diff changeset
1243 -- raise Program_Error;
kono
parents:
diff changeset
1244 -- end if;
kono
parents:
diff changeset
1245
kono
parents:
diff changeset
1246 pragma Assert (Vet (I), "bad I cursor in Swap");
kono
parents:
diff changeset
1247 pragma Assert (Vet (J), "bad J cursor in Swap");
kono
parents:
diff changeset
1248
kono
parents:
diff changeset
1249 declare
kono
parents:
diff changeset
1250 N : Node_Array renames Container.Nodes;
kono
parents:
diff changeset
1251
kono
parents:
diff changeset
1252 EI : Element_Type renames N (I.Node).Element;
kono
parents:
diff changeset
1253 EJ : Element_Type renames N (J.Node).Element;
kono
parents:
diff changeset
1254
kono
parents:
diff changeset
1255 EI_Copy : constant Element_Type := EI;
kono
parents:
diff changeset
1256
kono
parents:
diff changeset
1257 begin
kono
parents:
diff changeset
1258 EI := EJ;
kono
parents:
diff changeset
1259 EJ := EI_Copy;
kono
parents:
diff changeset
1260 end;
kono
parents:
diff changeset
1261 end Swap;
kono
parents:
diff changeset
1262
kono
parents:
diff changeset
1263 ----------------
kono
parents:
diff changeset
1264 -- Swap_Links --
kono
parents:
diff changeset
1265 ----------------
kono
parents:
diff changeset
1266
kono
parents:
diff changeset
1267 procedure Swap_Links
kono
parents:
diff changeset
1268 (Container : in out List;
kono
parents:
diff changeset
1269 I, J : Cursor)
kono
parents:
diff changeset
1270 is
kono
parents:
diff changeset
1271 begin
kono
parents:
diff changeset
1272 if I.Node = 0
kono
parents:
diff changeset
1273 or else J.Node = 0
kono
parents:
diff changeset
1274 then
kono
parents:
diff changeset
1275 raise Constraint_Error;
kono
parents:
diff changeset
1276 end if;
kono
parents:
diff changeset
1277
kono
parents:
diff changeset
1278 if I.Container /= Container'Unrestricted_Access
kono
parents:
diff changeset
1279 or else I.Container /= J.Container
kono
parents:
diff changeset
1280 then
kono
parents:
diff changeset
1281 raise Program_Error;
kono
parents:
diff changeset
1282 end if;
kono
parents:
diff changeset
1283
kono
parents:
diff changeset
1284 if I.Node = J.Node then
kono
parents:
diff changeset
1285 return;
kono
parents:
diff changeset
1286 end if;
kono
parents:
diff changeset
1287
kono
parents:
diff changeset
1288 -- if Container.Busy > 0 then
kono
parents:
diff changeset
1289 -- raise Program_Error;
kono
parents:
diff changeset
1290 -- end if;
kono
parents:
diff changeset
1291
kono
parents:
diff changeset
1292 pragma Assert (Vet (I), "bad I cursor in Swap_Links");
kono
parents:
diff changeset
1293 pragma Assert (Vet (J), "bad J cursor in Swap_Links");
kono
parents:
diff changeset
1294
kono
parents:
diff changeset
1295 declare
kono
parents:
diff changeset
1296 I_Next : constant Cursor := Next (I);
kono
parents:
diff changeset
1297
kono
parents:
diff changeset
1298 J_Copy : Cursor := J;
kono
parents:
diff changeset
1299 pragma Warnings (Off, J_Copy);
kono
parents:
diff changeset
1300
kono
parents:
diff changeset
1301 begin
kono
parents:
diff changeset
1302 if I_Next = J then
kono
parents:
diff changeset
1303 Splice (Container, Before => I, Position => J_Copy);
kono
parents:
diff changeset
1304
kono
parents:
diff changeset
1305 else
kono
parents:
diff changeset
1306 declare
kono
parents:
diff changeset
1307 J_Next : constant Cursor := Next (J);
kono
parents:
diff changeset
1308
kono
parents:
diff changeset
1309 I_Copy : Cursor := I;
kono
parents:
diff changeset
1310 pragma Warnings (Off, I_Copy);
kono
parents:
diff changeset
1311
kono
parents:
diff changeset
1312 begin
kono
parents:
diff changeset
1313 if J_Next = I then
kono
parents:
diff changeset
1314 Splice (Container, Before => J, Position => I_Copy);
kono
parents:
diff changeset
1315
kono
parents:
diff changeset
1316 else
kono
parents:
diff changeset
1317 pragma Assert (Container.Length >= 3);
kono
parents:
diff changeset
1318
kono
parents:
diff changeset
1319 Splice (Container, Before => I_Next, Position => J_Copy);
kono
parents:
diff changeset
1320 Splice (Container, Before => J_Next, Position => I_Copy);
kono
parents:
diff changeset
1321 end if;
kono
parents:
diff changeset
1322 end;
kono
parents:
diff changeset
1323 end if;
kono
parents:
diff changeset
1324 end;
kono
parents:
diff changeset
1325 end Swap_Links;
kono
parents:
diff changeset
1326
kono
parents:
diff changeset
1327 --------------------
kono
parents:
diff changeset
1328 -- Update_Element --
kono
parents:
diff changeset
1329 --------------------
kono
parents:
diff changeset
1330
kono
parents:
diff changeset
1331 procedure Update_Element
kono
parents:
diff changeset
1332 (Container : in out List;
kono
parents:
diff changeset
1333 Position : Cursor;
kono
parents:
diff changeset
1334 Process : not null access procedure (Element : in out Element_Type))
kono
parents:
diff changeset
1335 is
kono
parents:
diff changeset
1336 begin
kono
parents:
diff changeset
1337 if Position.Node = 0 then
kono
parents:
diff changeset
1338 raise Constraint_Error;
kono
parents:
diff changeset
1339 end if;
kono
parents:
diff changeset
1340
kono
parents:
diff changeset
1341 if Position.Container /= Container'Unrestricted_Access then
kono
parents:
diff changeset
1342 raise Program_Error;
kono
parents:
diff changeset
1343 end if;
kono
parents:
diff changeset
1344
kono
parents:
diff changeset
1345 pragma Assert (Vet (Position), "bad cursor in Update_Element");
kono
parents:
diff changeset
1346
kono
parents:
diff changeset
1347 declare
kono
parents:
diff changeset
1348 N : Node_Type renames Container.Nodes (Position.Node);
kono
parents:
diff changeset
1349
kono
parents:
diff changeset
1350 begin
kono
parents:
diff changeset
1351 Process (N.Element);
kono
parents:
diff changeset
1352 pragma Assert (N.Prev >= 0);
kono
parents:
diff changeset
1353 end;
kono
parents:
diff changeset
1354 end Update_Element;
kono
parents:
diff changeset
1355
kono
parents:
diff changeset
1356 ---------
kono
parents:
diff changeset
1357 -- Vet --
kono
parents:
diff changeset
1358 ---------
kono
parents:
diff changeset
1359
kono
parents:
diff changeset
1360 function Vet (Position : Cursor) return Boolean is
kono
parents:
diff changeset
1361 begin
kono
parents:
diff changeset
1362 if Position.Node = 0 then
kono
parents:
diff changeset
1363 return Position.Container = null;
kono
parents:
diff changeset
1364 end if;
kono
parents:
diff changeset
1365
kono
parents:
diff changeset
1366 if Position.Container = null then
kono
parents:
diff changeset
1367 return False;
kono
parents:
diff changeset
1368 end if;
kono
parents:
diff changeset
1369
kono
parents:
diff changeset
1370 declare
kono
parents:
diff changeset
1371 L : List renames Position.Container.all;
kono
parents:
diff changeset
1372 N : Node_Array renames L.Nodes;
kono
parents:
diff changeset
1373
kono
parents:
diff changeset
1374 begin
kono
parents:
diff changeset
1375 if L.Length = 0 then
kono
parents:
diff changeset
1376 return False;
kono
parents:
diff changeset
1377 end if;
kono
parents:
diff changeset
1378
kono
parents:
diff changeset
1379 if L.First = 0 then
kono
parents:
diff changeset
1380 return False;
kono
parents:
diff changeset
1381 end if;
kono
parents:
diff changeset
1382
kono
parents:
diff changeset
1383 if L.Last = 0 then
kono
parents:
diff changeset
1384 return False;
kono
parents:
diff changeset
1385 end if;
kono
parents:
diff changeset
1386
kono
parents:
diff changeset
1387 if Position.Node > L.Capacity then
kono
parents:
diff changeset
1388 return False;
kono
parents:
diff changeset
1389 end if;
kono
parents:
diff changeset
1390
kono
parents:
diff changeset
1391 if N (Position.Node).Prev < 0
kono
parents:
diff changeset
1392 or else N (Position.Node).Prev > L.Capacity
kono
parents:
diff changeset
1393 then
kono
parents:
diff changeset
1394 return False;
kono
parents:
diff changeset
1395 end if;
kono
parents:
diff changeset
1396
kono
parents:
diff changeset
1397 if N (Position.Node).Next > L.Capacity then
kono
parents:
diff changeset
1398 return False;
kono
parents:
diff changeset
1399 end if;
kono
parents:
diff changeset
1400
kono
parents:
diff changeset
1401 if N (L.First).Prev /= 0 then
kono
parents:
diff changeset
1402 return False;
kono
parents:
diff changeset
1403 end if;
kono
parents:
diff changeset
1404
kono
parents:
diff changeset
1405 if N (L.Last).Next /= 0 then
kono
parents:
diff changeset
1406 return False;
kono
parents:
diff changeset
1407 end if;
kono
parents:
diff changeset
1408
kono
parents:
diff changeset
1409 if N (Position.Node).Prev = 0
kono
parents:
diff changeset
1410 and then Position.Node /= L.First
kono
parents:
diff changeset
1411 then
kono
parents:
diff changeset
1412 return False;
kono
parents:
diff changeset
1413 end if;
kono
parents:
diff changeset
1414
kono
parents:
diff changeset
1415 if N (Position.Node).Next = 0
kono
parents:
diff changeset
1416 and then Position.Node /= L.Last
kono
parents:
diff changeset
1417 then
kono
parents:
diff changeset
1418 return False;
kono
parents:
diff changeset
1419 end if;
kono
parents:
diff changeset
1420
kono
parents:
diff changeset
1421 if L.Length = 1 then
kono
parents:
diff changeset
1422 return L.First = L.Last;
kono
parents:
diff changeset
1423 end if;
kono
parents:
diff changeset
1424
kono
parents:
diff changeset
1425 if L.First = L.Last then
kono
parents:
diff changeset
1426 return False;
kono
parents:
diff changeset
1427 end if;
kono
parents:
diff changeset
1428
kono
parents:
diff changeset
1429 if N (L.First).Next = 0 then
kono
parents:
diff changeset
1430 return False;
kono
parents:
diff changeset
1431 end if;
kono
parents:
diff changeset
1432
kono
parents:
diff changeset
1433 if N (L.Last).Prev = 0 then
kono
parents:
diff changeset
1434 return False;
kono
parents:
diff changeset
1435 end if;
kono
parents:
diff changeset
1436
kono
parents:
diff changeset
1437 if N (N (L.First).Next).Prev /= L.First then
kono
parents:
diff changeset
1438 return False;
kono
parents:
diff changeset
1439 end if;
kono
parents:
diff changeset
1440
kono
parents:
diff changeset
1441 if N (N (L.Last).Prev).Next /= L.Last then
kono
parents:
diff changeset
1442 return False;
kono
parents:
diff changeset
1443 end if;
kono
parents:
diff changeset
1444
kono
parents:
diff changeset
1445 if L.Length = 2 then
kono
parents:
diff changeset
1446 if N (L.First).Next /= L.Last then
kono
parents:
diff changeset
1447 return False;
kono
parents:
diff changeset
1448 end if;
kono
parents:
diff changeset
1449
kono
parents:
diff changeset
1450 if N (L.Last).Prev /= L.First then
kono
parents:
diff changeset
1451 return False;
kono
parents:
diff changeset
1452 end if;
kono
parents:
diff changeset
1453
kono
parents:
diff changeset
1454 return True;
kono
parents:
diff changeset
1455 end if;
kono
parents:
diff changeset
1456
kono
parents:
diff changeset
1457 if N (L.First).Next = L.Last then
kono
parents:
diff changeset
1458 return False;
kono
parents:
diff changeset
1459 end if;
kono
parents:
diff changeset
1460
kono
parents:
diff changeset
1461 if N (L.Last).Prev = L.First then
kono
parents:
diff changeset
1462 return False;
kono
parents:
diff changeset
1463 end if;
kono
parents:
diff changeset
1464
kono
parents:
diff changeset
1465 if Position.Node = L.First then
kono
parents:
diff changeset
1466 return True;
kono
parents:
diff changeset
1467 end if;
kono
parents:
diff changeset
1468
kono
parents:
diff changeset
1469 if Position.Node = L.Last then
kono
parents:
diff changeset
1470 return True;
kono
parents:
diff changeset
1471 end if;
kono
parents:
diff changeset
1472
kono
parents:
diff changeset
1473 if N (Position.Node).Next = 0 then
kono
parents:
diff changeset
1474 return False;
kono
parents:
diff changeset
1475 end if;
kono
parents:
diff changeset
1476
kono
parents:
diff changeset
1477 if N (Position.Node).Prev = 0 then
kono
parents:
diff changeset
1478 return False;
kono
parents:
diff changeset
1479 end if;
kono
parents:
diff changeset
1480
kono
parents:
diff changeset
1481 if N (N (Position.Node).Next).Prev /= Position.Node then
kono
parents:
diff changeset
1482 return False;
kono
parents:
diff changeset
1483 end if;
kono
parents:
diff changeset
1484
kono
parents:
diff changeset
1485 if N (N (Position.Node).Prev).Next /= Position.Node then
kono
parents:
diff changeset
1486 return False;
kono
parents:
diff changeset
1487 end if;
kono
parents:
diff changeset
1488
kono
parents:
diff changeset
1489 if L.Length = 3 then
kono
parents:
diff changeset
1490 if N (L.First).Next /= Position.Node then
kono
parents:
diff changeset
1491 return False;
kono
parents:
diff changeset
1492 end if;
kono
parents:
diff changeset
1493
kono
parents:
diff changeset
1494 if N (L.Last).Prev /= Position.Node then
kono
parents:
diff changeset
1495 return False;
kono
parents:
diff changeset
1496 end if;
kono
parents:
diff changeset
1497 end if;
kono
parents:
diff changeset
1498
kono
parents:
diff changeset
1499 return True;
kono
parents:
diff changeset
1500 end;
kono
parents:
diff changeset
1501 end Vet;
kono
parents:
diff changeset
1502
kono
parents:
diff changeset
1503 end Ada.Containers.Restricted_Doubly_Linked_Lists;