]>
Commit | Line | Data |
---|---|---|
b5ace3b7 AC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT LIBRARY COMPONENTS -- | |
4 | -- -- | |
15f6d6e7 | 5 | -- ADA.CONTAINERS.RESTRICTED_DOUBLY_LINKED_LISTS -- |
b5ace3b7 AC |
6 | -- -- |
7 | -- B o d y -- | |
8 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 2004-2020, Free Software Foundation, Inc. -- |
b5ace3b7 AC |
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- -- | |
748086b7 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
b5ace3b7 AC |
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 -- | |
748086b7 JJ |
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/>. -- | |
b5ace3b7 AC |
26 | -- -- |
27 | -- This unit was originally developed by Matthew J Heaney. -- | |
28 | ------------------------------------------------------------------------------ | |
29 | ||
6616e390 | 30 | with System; use type System.Address; |
b5ace3b7 AC |
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 | |
5f2d216d | 564 | Pivot : constant Count_Type := |
15f0f591 | 565 | (if Front = 0 then Container.First else N (Front).Next); |
b5ace3b7 | 566 | begin |
b5ace3b7 AC |
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 | |
f8c59c05 AC |
617 | First_Node : Count_Type; |
618 | New_Node : Count_Type; | |
b5ace3b7 AC |
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 | ||
f8c59c05 AC |
642 | Allocate (Container, New_Item, New_Node); |
643 | First_Node := New_Node; | |
644 | Insert_Internal (Container, Before.Node, New_Node); | |
b5ace3b7 AC |
645 | |
646 | for Index in 2 .. Count loop | |
f8c59c05 AC |
647 | Allocate (Container, New_Item, New_Node); |
648 | Insert_Internal (Container, Before.Node, New_Node); | |
b5ace3b7 | 649 | end loop; |
f8c59c05 AC |
650 | |
651 | Position := Cursor'(Container'Unrestricted_Access, First_Node); | |
b5ace3b7 AC |
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; | |
67ce0d7e | 661 | pragma Unreferenced (Position); |
b5ace3b7 AC |
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); | |
67ce0d7e | 1297 | |
b5ace3b7 | 1298 | J_Copy : Cursor := J; |
67ce0d7e | 1299 | pragma Warnings (Off, J_Copy); |
b5ace3b7 AC |
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); | |
67ce0d7e | 1308 | |
b5ace3b7 | 1309 | I_Copy : Cursor := I; |
67ce0d7e | 1310 | pragma Warnings (Off, I_Copy); |
b5ace3b7 AC |
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; |