1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- A D A . C O N T A I N E R S . D O U B L Y _ L I N K E D _ L I S T S --
9 -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- This unit was originally developed by Matthew J Heaney. --
30 ------------------------------------------------------------------------------
32 with System; use type System.Address;
34 with Ada.Unchecked_Deallocation;
36 package body Ada.Containers.Doubly_Linked_Lists is
38 -----------------------
39 -- Local Subprograms --
40 -----------------------
42 procedure Free (X : in out Node_Access);
44 procedure Insert_Internal
45 (Container : in out List;
47 New_Node : Node_Access);
49 function Vet (Position : Cursor) return Boolean;
55 function "=" (Left, Right : List) return Boolean is
56 L : Node_Access := Left.First;
57 R : Node_Access := Right.First;
60 if Left'Address = Right'Address then
64 if Left.Length /= Right.Length then
68 for J in 1 .. Left.Length loop
69 if L.Element /= R.Element then
84 procedure Adjust (Container : in out List) is
85 Src : Node_Access := Container.First;
89 pragma Assert (Container.Last = null);
90 pragma Assert (Container.Length = 0);
91 pragma Assert (Container.Busy = 0);
92 pragma Assert (Container.Lock = 0);
96 pragma Assert (Container.First.Prev = null);
97 pragma Assert (Container.Last.Next = null);
98 pragma Assert (Container.Length > 0);
100 Container.First := null;
101 Container.Last := null;
102 Container.Length := 0;
106 Container.First := new Node_Type'(Src.Element, null, null);
107 Container.Last := Container.First;
108 Container.Length := 1;
111 while Src /= null loop
112 Container.Last.Next := new Node_Type'(Element => Src.Element,
113 Prev => Container.Last,
115 Container.Last := Container.Last.Next;
116 Container.Length := Container.Length + 1;
127 (Container : in out List;
128 New_Item : Element_Type;
129 Count : Count_Type := 1)
132 Insert (Container, No_Element, New_Item, Count);
139 procedure Clear (Container : in out List) is
143 if Container.Length = 0 then
144 pragma Assert (Container.First = null);
145 pragma Assert (Container.Last = null);
146 pragma Assert (Container.Busy = 0);
147 pragma Assert (Container.Lock = 0);
151 pragma Assert (Container.First.Prev = null);
152 pragma Assert (Container.Last.Next = null);
154 if Container.Busy > 0 then
155 raise Program_Error with
156 "attempt to tamper with elements (list is busy)";
159 while Container.Length > 1 loop
160 X := Container.First;
161 pragma Assert (X.Next.Prev = Container.First);
163 Container.First := X.Next;
164 Container.First.Prev := null;
166 Container.Length := Container.Length - 1;
171 X := Container.First;
172 pragma Assert (X = Container.Last);
174 Container.First := null;
175 Container.Last := null;
176 Container.Length := 0;
178 pragma Warnings (Off);
180 pragma Warnings (On);
189 Item : Element_Type) return Boolean
192 return Find (Container, Item) /= No_Element;
200 (Container : in out List;
201 Position : in out Cursor;
202 Count : Count_Type := 1)
207 if Position.Node = null then
208 raise Constraint_Error with
209 "Position cursor has no element";
212 if Position.Container /= Container'Unrestricted_Access then
213 raise Program_Error with
214 "Position cursor designates wrong container";
217 pragma Assert (Vet (Position), "bad cursor in Delete");
219 if Position.Node = Container.First then
220 Delete_First (Container, Count);
221 Position := No_Element; -- Post-York behavior
226 Position := No_Element; -- Post-York behavior
230 if Container.Busy > 0 then
231 raise Program_Error with
232 "attempt to tamper with elements (list is busy)";
235 for Index in 1 .. Count loop
237 Container.Length := Container.Length - 1;
239 if X = Container.Last then
240 Position := No_Element;
242 Container.Last := X.Prev;
243 Container.Last.Next := null;
249 Position.Node := X.Next;
251 X.Next.Prev := X.Prev;
252 X.Prev.Next := X.Next;
257 Position := No_Element; -- Post-York behavior
264 procedure Delete_First
265 (Container : in out List;
266 Count : Count_Type := 1)
271 if Count >= Container.Length then
280 if Container.Busy > 0 then
281 raise Program_Error with
282 "attempt to tamper with elements (list is busy)";
285 for I in 1 .. Count loop
286 X := Container.First;
287 pragma Assert (X.Next.Prev = Container.First);
289 Container.First := X.Next;
290 Container.First.Prev := null;
292 Container.Length := Container.Length - 1;
302 procedure Delete_Last
303 (Container : in out List;
304 Count : Count_Type := 1)
309 if Count >= Container.Length then
318 if Container.Busy > 0 then
319 raise Program_Error with
320 "attempt to tamper with elements (list is busy)";
323 for I in 1 .. Count loop
325 pragma Assert (X.Prev.Next = Container.Last);
327 Container.Last := X.Prev;
328 Container.Last.Next := null;
330 Container.Length := Container.Length - 1;
340 function Element (Position : Cursor) return Element_Type is
342 if Position.Node = null then
343 raise Constraint_Error with
344 "Position cursor has no element";
347 pragma Assert (Vet (Position), "bad cursor in Element");
349 return Position.Node.Element;
359 Position : Cursor := No_Element) return Cursor
361 Node : Node_Access := Position.Node;
365 Node := Container.First;
368 if Position.Container /= Container'Unrestricted_Access then
369 raise Program_Error with
370 "Position cursor designates wrong container";
373 pragma Assert (Vet (Position), "bad cursor in Find");
376 while Node /= null loop
377 if Node.Element = Item then
378 return Cursor'(Container'Unchecked_Access, Node);
391 function First (Container : List) return Cursor is
393 if Container.First = null then
397 return Cursor'(Container'Unchecked_Access, Container.First);
404 function First_Element (Container : List) return Element_Type is
406 if Container.First = null then
407 raise Constraint_Error with "list is empty";
410 return Container.First.Element;
417 procedure Free (X : in out Node_Access) is
418 procedure Deallocate is
419 new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
427 ---------------------
428 -- Generic_Sorting --
429 ---------------------
431 package body Generic_Sorting is
437 function Is_Sorted (Container : List) return Boolean is
438 Node : Node_Access := Container.First;
441 for I in 2 .. Container.Length loop
442 if Node.Next.Element < Node.Element then
457 (Target : in out List;
458 Source : in out List)
463 if Target'Address = Source'Address then
467 if Target.Busy > 0 then
468 raise Program_Error with
469 "attempt to tamper with elements of Target (list is busy)";
472 if Source.Busy > 0 then
473 raise Program_Error with
474 "attempt to tamper with elements of Source (list is busy)";
477 LI := First (Target);
478 RI := First (Source);
479 while RI.Node /= null loop
480 pragma Assert (RI.Node.Next = null
481 or else not (RI.Node.Next.Element <
484 if LI.Node = null then
485 Splice (Target, No_Element, Source);
489 pragma Assert (LI.Node.Next = null
490 or else not (LI.Node.Next.Element <
493 if RI.Node.Element < LI.Node.Element then
496 pragma Warnings (Off, RJ);
498 RI.Node := RI.Node.Next;
499 Splice (Target, LI, Source, RJ);
503 LI.Node := LI.Node.Next;
512 procedure Sort (Container : in out List) is
514 procedure Partition (Pivot : Node_Access; Back : Node_Access);
516 procedure Sort (Front, Back : Node_Access);
522 procedure Partition (Pivot : Node_Access; Back : Node_Access) is
523 Node : Node_Access := Pivot.Next;
526 while Node /= Back loop
527 if Node.Element < Pivot.Element then
529 Prev : constant Node_Access := Node.Prev;
530 Next : constant Node_Access := Node.Next;
536 Container.Last := Prev;
542 Node.Prev := Pivot.Prev;
546 if Node.Prev = null then
547 Container.First := Node;
549 Node.Prev.Next := Node;
565 procedure Sort (Front, Back : Node_Access) is
570 Pivot := Container.First;
575 if Pivot /= Back then
576 Partition (Pivot, Back);
582 -- Start of processing for Sort
585 if Container.Length <= 1 then
589 pragma Assert (Container.First.Prev = null);
590 pragma Assert (Container.Last.Next = null);
592 if Container.Busy > 0 then
593 raise Program_Error with
594 "attempt to tamper with elements (list is busy)";
597 Sort (Front => null, Back => null);
599 pragma Assert (Container.First.Prev = null);
600 pragma Assert (Container.Last.Next = null);
609 function Has_Element (Position : Cursor) return Boolean is
611 pragma Assert (Vet (Position), "bad cursor in Has_Element");
612 return Position.Node /= null;
620 (Container : in out List;
622 New_Item : Element_Type;
623 Position : out Cursor;
624 Count : Count_Type := 1)
626 New_Node : Node_Access;
629 if Before.Container /= null then
630 if Before.Container /= Container'Unrestricted_Access then
631 raise Program_Error with
632 "attempt to tamper with elements (list is busy)";
635 pragma Assert (Vet (Before), "bad cursor in Insert");
643 if Container.Length > Count_Type'Last - Count then
644 raise Constraint_Error with "new length exceeds maximum";
647 if Container.Busy > 0 then
648 raise Program_Error with
649 "attempt to tamper with elements (list is busy)";
652 New_Node := new Node_Type'(New_Item, null, null);
653 Insert_Internal (Container, Before.Node, New_Node);
655 Position := Cursor'(Container'Unchecked_Access, New_Node);
657 for J in Count_Type'(2) .. Count loop
658 New_Node := new Node_Type'(New_Item, null, null);
659 Insert_Internal (Container, Before.Node, New_Node);
664 (Container : in out List;
666 New_Item : Element_Type;
667 Count : Count_Type := 1)
670 pragma Unreferenced (Position);
672 Insert (Container, Before, New_Item, Position, Count);
676 (Container : in out List;
678 Position : out Cursor;
679 Count : Count_Type := 1)
681 New_Node : Node_Access;
684 if Before.Container /= null then
685 if Before.Container /= Container'Unrestricted_Access then
686 raise Program_Error with
687 "Before cursor designates wrong list";
690 pragma Assert (Vet (Before), "bad cursor in Insert");
698 if Container.Length > Count_Type'Last - Count then
699 raise Constraint_Error with "new length exceeds maximum";
702 if Container.Busy > 0 then
703 raise Program_Error with
704 "attempt to tamper with elements (list is busy)";
707 New_Node := new Node_Type;
708 Insert_Internal (Container, Before.Node, New_Node);
710 Position := Cursor'(Container'Unchecked_Access, New_Node);
712 for J in Count_Type'(2) .. Count loop
713 New_Node := new Node_Type;
714 Insert_Internal (Container, Before.Node, New_Node);
718 ---------------------
719 -- Insert_Internal --
720 ---------------------
722 procedure Insert_Internal
723 (Container : in out List;
724 Before : Node_Access;
725 New_Node : Node_Access)
728 if Container.Length = 0 then
729 pragma Assert (Before = null);
730 pragma Assert (Container.First = null);
731 pragma Assert (Container.Last = null);
733 Container.First := New_Node;
734 Container.Last := New_Node;
736 elsif Before = null then
737 pragma Assert (Container.Last.Next = null);
739 Container.Last.Next := New_Node;
740 New_Node.Prev := Container.Last;
742 Container.Last := New_Node;
744 elsif Before = Container.First then
745 pragma Assert (Container.First.Prev = null);
747 Container.First.Prev := New_Node;
748 New_Node.Next := Container.First;
750 Container.First := New_Node;
753 pragma Assert (Container.First.Prev = null);
754 pragma Assert (Container.Last.Next = null);
756 New_Node.Next := Before;
757 New_Node.Prev := Before.Prev;
759 Before.Prev.Next := New_Node;
760 Before.Prev := New_Node;
763 Container.Length := Container.Length + 1;
770 function Is_Empty (Container : List) return Boolean is
772 return Container.Length = 0;
781 Process : not null access procedure (Position : Cursor))
783 C : List renames Container'Unrestricted_Access.all;
784 B : Natural renames C.Busy;
786 Node : Node_Access := Container.First;
792 while Node /= null loop
793 Process (Cursor'(Container'Unchecked_Access, Node));
809 function Last (Container : List) return Cursor is
811 if Container.Last = null then
815 return Cursor'(Container'Unchecked_Access, Container.Last);
822 function Last_Element (Container : List) return Element_Type is
824 if Container.Last = null then
825 raise Constraint_Error with "list is empty";
828 return Container.Last.Element;
835 function Length (Container : List) return Count_Type is
837 return Container.Length;
845 (Target : in out List;
846 Source : in out List)
849 if Target'Address = Source'Address then
853 if Source.Busy > 0 then
854 raise Program_Error with
855 "attempt to tamper with elements of Source (list is busy)";
860 Target.First := Source.First;
861 Source.First := null;
863 Target.Last := Source.Last;
866 Target.Length := Source.Length;
874 procedure Next (Position : in out Cursor) is
876 Position := Next (Position);
879 function Next (Position : Cursor) return Cursor is
881 if Position.Node = null then
885 pragma Assert (Vet (Position), "bad cursor in Next");
888 Next_Node : constant Node_Access := Position.Node.Next;
890 if Next_Node = null then
894 return Cursor'(Position.Container, Next_Node);
903 (Container : in out List;
904 New_Item : Element_Type;
905 Count : Count_Type := 1)
908 Insert (Container, First (Container), New_Item, Count);
915 procedure Previous (Position : in out Cursor) is
917 Position := Previous (Position);
920 function Previous (Position : Cursor) return Cursor is
922 if Position.Node = null then
926 pragma Assert (Vet (Position), "bad cursor in Previous");
929 Prev_Node : constant Node_Access := Position.Node.Prev;
931 if Prev_Node = null then
935 return Cursor'(Position.Container, Prev_Node);
943 procedure Query_Element
945 Process : not null access procedure (Element : Element_Type))
948 if Position.Node = null then
949 raise Constraint_Error with
950 "Position cursor has no element";
953 pragma Assert (Vet (Position), "bad cursor in Query_Element");
956 C : List renames Position.Container.all'Unrestricted_Access.all;
957 B : Natural renames C.Busy;
958 L : Natural renames C.Lock;
965 Process (Position.Node.Element);
983 (Stream : not null access Root_Stream_Type'Class;
991 Count_Type'Base'Read (Stream, N);
1000 Element_Type'Read (Stream, X.Element);
1011 Item.Length := Item.Length + 1;
1012 exit when Item.Length = N;
1017 Element_Type'Read (Stream, X.Element);
1024 X.Prev := Item.Last;
1025 Item.Last.Next := X;
1031 (Stream : not null access Root_Stream_Type'Class;
1035 raise Program_Error with "attempt to stream list cursor";
1038 ---------------------
1039 -- Replace_Element --
1040 ---------------------
1042 procedure Replace_Element
1043 (Container : in out List;
1045 New_Item : Element_Type)
1048 if Position.Container = null then
1049 raise Constraint_Error with "Position cursor has no element";
1052 if Position.Container /= Container'Unchecked_Access then
1053 raise Program_Error with
1054 "Position cursor designates wrong container";
1057 if Container.Lock > 0 then
1058 raise Program_Error with
1059 "attempt to tamper with cursors (list is locked)";
1062 pragma Assert (Vet (Position), "bad cursor in Replace_Element");
1064 Position.Node.Element := New_Item;
1065 end Replace_Element;
1067 ----------------------
1068 -- Reverse_Elements --
1069 ----------------------
1071 procedure Reverse_Elements (Container : in out List) is
1072 I : Node_Access := Container.First;
1073 J : Node_Access := Container.Last;
1075 procedure Swap (L, R : Node_Access);
1081 procedure Swap (L, R : Node_Access) is
1082 LN : constant Node_Access := L.Next;
1083 LP : constant Node_Access := L.Prev;
1085 RN : constant Node_Access := R.Next;
1086 RP : constant Node_Access := R.Prev;
1101 pragma Assert (RP = L);
1115 -- Start of processing for Reverse_Elements
1118 if Container.Length <= 1 then
1122 pragma Assert (Container.First.Prev = null);
1123 pragma Assert (Container.Last.Next = null);
1125 if Container.Busy > 0 then
1126 raise Program_Error with
1127 "attempt to tamper with elements (list is busy)";
1130 Container.First := J;
1131 Container.Last := I;
1133 Swap (L => I, R => J);
1141 Swap (L => J, R => I);
1150 pragma Assert (Container.First.Prev = null);
1151 pragma Assert (Container.Last.Next = null);
1152 end Reverse_Elements;
1158 function Reverse_Find
1160 Item : Element_Type;
1161 Position : Cursor := No_Element) return Cursor
1163 Node : Node_Access := Position.Node;
1167 Node := Container.Last;
1170 if Position.Container /= Container'Unrestricted_Access then
1171 raise Program_Error with
1172 "Position cursor designates wrong container";
1175 pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
1178 while Node /= null loop
1179 if Node.Element = Item then
1180 return Cursor'(Container'Unchecked_Access, Node);
1189 ---------------------
1190 -- Reverse_Iterate --
1191 ---------------------
1193 procedure Reverse_Iterate
1195 Process : not null access procedure (Position : Cursor))
1197 C : List renames Container'Unrestricted_Access.all;
1198 B : Natural renames C.Busy;
1200 Node : Node_Access := Container.Last;
1206 while Node /= null loop
1207 Process (Cursor'(Container'Unchecked_Access, Node));
1218 end Reverse_Iterate;
1225 (Target : in out List;
1227 Source : in out List)
1230 if Before.Container /= null then
1231 if Before.Container /= Target'Unrestricted_Access then
1232 raise Program_Error with
1233 "Before cursor designates wrong container";
1236 pragma Assert (Vet (Before), "bad cursor in Splice");
1239 if Target'Address = Source'Address
1240 or else Source.Length = 0
1245 pragma Assert (Source.First.Prev = null);
1246 pragma Assert (Source.Last.Next = null);
1248 if Target.Length > Count_Type'Last - Source.Length then
1249 raise Constraint_Error with "new length exceeds maximum";
1252 if Target.Busy > 0 then
1253 raise Program_Error with
1254 "attempt to tamper with elements of Target (list is busy)";
1257 if Source.Busy > 0 then
1258 raise Program_Error with
1259 "attempt to tamper with elements of Source (list is busy)";
1262 if Target.Length = 0 then
1263 pragma Assert (Target.First = null);
1264 pragma Assert (Target.Last = null);
1265 pragma Assert (Before = No_Element);
1267 Target.First := Source.First;
1268 Target.Last := Source.Last;
1270 elsif Before.Node = null then
1271 pragma Assert (Target.Last.Next = null);
1273 Target.Last.Next := Source.First;
1274 Source.First.Prev := Target.Last;
1276 Target.Last := Source.Last;
1278 elsif Before.Node = Target.First then
1279 pragma Assert (Target.First.Prev = null);
1281 Source.Last.Next := Target.First;
1282 Target.First.Prev := Source.Last;
1284 Target.First := Source.First;
1287 pragma Assert (Target.Length >= 2);
1289 Before.Node.Prev.Next := Source.First;
1290 Source.First.Prev := Before.Node.Prev;
1292 Before.Node.Prev := Source.Last;
1293 Source.Last.Next := Before.Node;
1296 Source.First := null;
1297 Source.Last := null;
1299 Target.Length := Target.Length + Source.Length;
1304 (Container : in out List;
1309 if Before.Container /= null then
1310 if Before.Container /= Container'Unchecked_Access then
1311 raise Program_Error with
1312 "Before cursor designates wrong container";
1315 pragma Assert (Vet (Before), "bad Before cursor in Splice");
1318 if Position.Node = null then
1319 raise Constraint_Error with "Position cursor has no element";
1322 if Position.Container /= Container'Unrestricted_Access then
1323 raise Program_Error with
1324 "Position cursor designates wrong container";
1327 pragma Assert (Vet (Position), "bad Position cursor in Splice");
1329 if Position.Node = Before.Node
1330 or else Position.Node.Next = Before.Node
1335 pragma Assert (Container.Length >= 2);
1337 if Container.Busy > 0 then
1338 raise Program_Error with
1339 "attempt to tamper with elements (list is busy)";
1342 if Before.Node = null then
1343 pragma Assert (Position.Node /= Container.Last);
1345 if Position.Node = Container.First then
1346 Container.First := Position.Node.Next;
1347 Container.First.Prev := null;
1349 Position.Node.Prev.Next := Position.Node.Next;
1350 Position.Node.Next.Prev := Position.Node.Prev;
1353 Container.Last.Next := Position.Node;
1354 Position.Node.Prev := Container.Last;
1356 Container.Last := Position.Node;
1357 Container.Last.Next := null;
1362 if Before.Node = Container.First then
1363 pragma Assert (Position.Node /= Container.First);
1365 if Position.Node = Container.Last then
1366 Container.Last := Position.Node.Prev;
1367 Container.Last.Next := null;
1369 Position.Node.Prev.Next := Position.Node.Next;
1370 Position.Node.Next.Prev := Position.Node.Prev;
1373 Container.First.Prev := Position.Node;
1374 Position.Node.Next := Container.First;
1376 Container.First := Position.Node;
1377 Container.First.Prev := null;
1382 if Position.Node = Container.First then
1383 Container.First := Position.Node.Next;
1384 Container.First.Prev := null;
1386 elsif Position.Node = Container.Last then
1387 Container.Last := Position.Node.Prev;
1388 Container.Last.Next := null;
1391 Position.Node.Prev.Next := Position.Node.Next;
1392 Position.Node.Next.Prev := Position.Node.Prev;
1395 Before.Node.Prev.Next := Position.Node;
1396 Position.Node.Prev := Before.Node.Prev;
1398 Before.Node.Prev := Position.Node;
1399 Position.Node.Next := Before.Node;
1401 pragma Assert (Container.First.Prev = null);
1402 pragma Assert (Container.Last.Next = null);
1406 (Target : in out List;
1408 Source : in out List;
1409 Position : in out Cursor)
1412 if Target'Address = Source'Address then
1413 Splice (Target, Before, Position);
1417 if Before.Container /= null then
1418 if Before.Container /= Target'Unrestricted_Access then
1419 raise Program_Error with
1420 "Before cursor designates wrong container";
1423 pragma Assert (Vet (Before), "bad Before cursor in Splice");
1426 if Position.Node = null then
1427 raise Constraint_Error with "Position cursor has no element";
1430 if Position.Container /= Source'Unrestricted_Access then
1431 raise Program_Error with
1432 "Position cursor designates wrong container";
1435 pragma Assert (Vet (Position), "bad Position cursor in Splice");
1437 if Target.Length = Count_Type'Last then
1438 raise Constraint_Error with "Target is full";
1441 if Target.Busy > 0 then
1442 raise Program_Error with
1443 "attempt to tamper with elements of Target (list is busy)";
1446 if Source.Busy > 0 then
1447 raise Program_Error with
1448 "attempt to tamper with elements of Source (list is busy)";
1451 if Position.Node = Source.First then
1452 Source.First := Position.Node.Next;
1454 if Position.Node = Source.Last then
1455 pragma Assert (Source.First = null);
1456 pragma Assert (Source.Length = 1);
1457 Source.Last := null;
1460 Source.First.Prev := null;
1463 elsif Position.Node = Source.Last then
1464 pragma Assert (Source.Length >= 2);
1465 Source.Last := Position.Node.Prev;
1466 Source.Last.Next := null;
1469 pragma Assert (Source.Length >= 3);
1470 Position.Node.Prev.Next := Position.Node.Next;
1471 Position.Node.Next.Prev := Position.Node.Prev;
1474 if Target.Length = 0 then
1475 pragma Assert (Target.First = null);
1476 pragma Assert (Target.Last = null);
1477 pragma Assert (Before = No_Element);
1479 Target.First := Position.Node;
1480 Target.Last := Position.Node;
1482 Target.First.Prev := null;
1483 Target.Last.Next := null;
1485 elsif Before.Node = null then
1486 pragma Assert (Target.Last.Next = null);
1487 Target.Last.Next := Position.Node;
1488 Position.Node.Prev := Target.Last;
1490 Target.Last := Position.Node;
1491 Target.Last.Next := null;
1493 elsif Before.Node = Target.First then
1494 pragma Assert (Target.First.Prev = null);
1495 Target.First.Prev := Position.Node;
1496 Position.Node.Next := Target.First;
1498 Target.First := Position.Node;
1499 Target.First.Prev := null;
1502 pragma Assert (Target.Length >= 2);
1503 Before.Node.Prev.Next := Position.Node;
1504 Position.Node.Prev := Before.Node.Prev;
1506 Before.Node.Prev := Position.Node;
1507 Position.Node.Next := Before.Node;
1510 Target.Length := Target.Length + 1;
1511 Source.Length := Source.Length - 1;
1513 Position.Container := Target'Unchecked_Access;
1521 (Container : in out List;
1525 if I.Node = null then
1526 raise Constraint_Error with "I cursor has no element";
1529 if J.Node = null then
1530 raise Constraint_Error with "J cursor has no element";
1533 if I.Container /= Container'Unchecked_Access then
1534 raise Program_Error with "I cursor designates wrong container";
1537 if J.Container /= Container'Unchecked_Access then
1538 raise Program_Error with "J cursor designates wrong container";
1541 if I.Node = J.Node then
1545 if Container.Lock > 0 then
1546 raise Program_Error with
1547 "attempt to tamper with cursors (list is locked)";
1550 pragma Assert (Vet (I), "bad I cursor in Swap");
1551 pragma Assert (Vet (J), "bad J cursor in Swap");
1554 EI : Element_Type renames I.Node.Element;
1555 EJ : Element_Type renames J.Node.Element;
1557 EI_Copy : constant Element_Type := EI;
1569 procedure Swap_Links
1570 (Container : in out List;
1574 if I.Node = null then
1575 raise Constraint_Error with "I cursor has no element";
1578 if J.Node = null then
1579 raise Constraint_Error with "J cursor has no element";
1582 if I.Container /= Container'Unrestricted_Access then
1583 raise Program_Error with "I cursor designates wrong container";
1586 if J.Container /= Container'Unrestricted_Access then
1587 raise Program_Error with "J cursor designates wrong container";
1590 if I.Node = J.Node then
1594 if Container.Busy > 0 then
1595 raise Program_Error with
1596 "attempt to tamper with elements (list is busy)";
1599 pragma Assert (Vet (I), "bad I cursor in Swap_Links");
1600 pragma Assert (Vet (J), "bad J cursor in Swap_Links");
1603 I_Next : constant Cursor := Next (I);
1607 Splice (Container, Before => I, Position => J);
1611 J_Next : constant Cursor := Next (J);
1615 Splice (Container, Before => J, Position => I);
1618 pragma Assert (Container.Length >= 3);
1620 Splice (Container, Before => I_Next, Position => J);
1621 Splice (Container, Before => J_Next, Position => I);
1628 --------------------
1629 -- Update_Element --
1630 --------------------
1632 procedure Update_Element
1633 (Container : in out List;
1635 Process : not null access procedure (Element : in out Element_Type))
1638 if Position.Node = null then
1639 raise Constraint_Error with "Position cursor has no element";
1642 if Position.Container /= Container'Unchecked_Access then
1643 raise Program_Error with
1644 "Position cursor designates wrong container";
1647 pragma Assert (Vet (Position), "bad cursor in Update_Element");
1650 B : Natural renames Container.Busy;
1651 L : Natural renames Container.Lock;
1658 Process (Position.Node.Element);
1675 function Vet (Position : Cursor) return Boolean is
1677 if Position.Node = null then
1678 return Position.Container = null;
1681 if Position.Container = null then
1685 if Position.Node.Next = Position.Node then
1689 if Position.Node.Prev = Position.Node then
1694 L : List renames Position.Container.all;
1696 if L.Length = 0 then
1700 if L.First = null then
1704 if L.Last = null then
1708 if L.First.Prev /= null then
1712 if L.Last.Next /= null then
1716 if Position.Node.Prev = null
1717 and then Position.Node /= L.First
1722 if Position.Node.Next = null
1723 and then Position.Node /= L.Last
1728 if L.Length = 1 then
1729 return L.First = L.Last;
1732 if L.First = L.Last then
1736 if L.First.Next = null then
1740 if L.Last.Prev = null then
1744 if L.First.Next.Prev /= L.First then
1748 if L.Last.Prev.Next /= L.Last then
1752 if L.Length = 2 then
1753 if L.First.Next /= L.Last then
1757 if L.Last.Prev /= L.First then
1764 if L.First.Next = L.Last then
1768 if L.Last.Prev = L.First then
1772 if Position.Node = L.First then
1776 if Position.Node = L.Last then
1780 if Position.Node.Next = null then
1784 if Position.Node.Prev = null then
1788 if Position.Node.Next.Prev /= Position.Node then
1792 if Position.Node.Prev.Next /= Position.Node then
1796 if L.Length = 3 then
1797 if L.First.Next /= Position.Node then
1801 if L.Last.Prev /= Position.Node then
1815 (Stream : not null access Root_Stream_Type'Class;
1818 Node : Node_Access := Item.First;
1821 Count_Type'Base'Write (Stream, Item.Length);
1823 while Node /= null loop
1824 Element_Type'Write (Stream, Node.Element);
1830 (Stream : not null access Root_Stream_Type'Class;
1834 raise Program_Error with "attempt to stream list cursor";
1837 end Ada.Containers.Doubly_Linked_Lists;