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