1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.INDEFINITE_DOUBLY_LINKED_LISTS --
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;
33 with Ada.Unchecked_Deallocation;
35 package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
38 new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
40 -----------------------
41 -- Local Subprograms --
42 -----------------------
44 procedure Free (X : in out Node_Access);
46 procedure Insert_Internal
47 (Container : in out List;
49 New_Node : Node_Access);
51 function Vet (Position : Cursor) return Boolean;
57 function "=" (Left, Right : List) return Boolean is
62 if Left'Address = Right'Address then
66 if Left.Length /= Right.Length then
72 for J in 1 .. Left.Length loop
73 if L.Element.all /= R.Element.all then
88 procedure Adjust (Container : in out List) is
89 Src : Node_Access := Container.First;
94 pragma Assert (Container.Last = null);
95 pragma Assert (Container.Length = 0);
96 pragma Assert (Container.Busy = 0);
97 pragma Assert (Container.Lock = 0);
101 pragma Assert (Container.First.Prev = null);
102 pragma Assert (Container.Last.Next = null);
103 pragma Assert (Container.Length > 0);
105 Container.First := null;
106 Container.Last := null;
107 Container.Length := 0;
112 Element : Element_Access := new Element_Type'(Src.Element.all);
114 Dst := new Node_Type'(Element, null, null);
121 Container.First := Dst;
122 Container.Last := Dst;
123 Container.Length := 1;
126 while Src /= null loop
128 Element : Element_Access := new Element_Type'(Src.Element.all);
130 Dst := new Node_Type'(Element, null, Prev => Container.Last);
137 Container.Last.Next := Dst;
138 Container.Last := Dst;
139 Container.Length := Container.Length + 1;
150 (Container : in out List;
151 New_Item : Element_Type;
152 Count : Count_Type := 1)
155 Insert (Container, No_Element, New_Item, Count);
162 procedure Clear (Container : in out List) is
164 pragma Warnings (Off, X);
167 if Container.Length = 0 then
168 pragma Assert (Container.First = null);
169 pragma Assert (Container.Last = null);
170 pragma Assert (Container.Busy = 0);
171 pragma Assert (Container.Lock = 0);
175 pragma Assert (Container.First.Prev = null);
176 pragma Assert (Container.Last.Next = null);
178 if Container.Busy > 0 then
179 raise Program_Error with
180 "attempt to tamper with elements (list is busy)";
183 while Container.Length > 1 loop
184 X := Container.First;
185 pragma Assert (X.Next.Prev = Container.First);
187 Container.First := X.Next;
188 Container.First.Prev := null;
190 Container.Length := Container.Length - 1;
195 X := Container.First;
196 pragma Assert (X = Container.Last);
198 Container.First := null;
199 Container.Last := null;
200 Container.Length := 0;
211 Item : Element_Type) return Boolean
214 return Find (Container, Item) /= No_Element;
222 (Container : in out List;
223 Position : in out Cursor;
224 Count : Count_Type := 1)
229 if Position.Node = null then
230 raise Constraint_Error with
231 "Position cursor has no element";
234 if Position.Node.Element = null then
235 raise Program_Error with
236 "Position cursor has no element";
239 if Position.Container /= Container'Unrestricted_Access then
240 raise Program_Error with
241 "Position cursor designates wrong container";
244 pragma Assert (Vet (Position), "bad cursor in Delete");
246 if Position.Node = Container.First then
247 Delete_First (Container, Count);
248 Position := No_Element; -- Post-York behavior
253 Position := No_Element; -- Post-York behavior
257 if Container.Busy > 0 then
258 raise Program_Error with
259 "attempt to tamper with elements (list is busy)";
262 for Index in 1 .. Count loop
264 Container.Length := Container.Length - 1;
266 if X = Container.Last then
267 Position := No_Element;
269 Container.Last := X.Prev;
270 Container.Last.Next := null;
276 Position.Node := X.Next;
278 X.Next.Prev := X.Prev;
279 X.Prev.Next := X.Next;
284 Position := No_Element; -- Post-York behavior
291 procedure Delete_First
292 (Container : in out List;
293 Count : Count_Type := 1)
298 if Count >= Container.Length then
307 if Container.Busy > 0 then
308 raise Program_Error with
309 "attempt to tamper with elements (list is busy)";
312 for I in 1 .. Count loop
313 X := Container.First;
314 pragma Assert (X.Next.Prev = Container.First);
316 Container.First := X.Next;
317 Container.First.Prev := null;
319 Container.Length := Container.Length - 1;
329 procedure Delete_Last
330 (Container : in out List;
331 Count : Count_Type := 1)
336 if Count >= Container.Length then
345 if Container.Busy > 0 then
346 raise Program_Error with
347 "attempt to tamper with elements (list is busy)";
350 for I in 1 .. Count loop
352 pragma Assert (X.Prev.Next = Container.Last);
354 Container.Last := X.Prev;
355 Container.Last.Next := null;
357 Container.Length := Container.Length - 1;
367 function Element (Position : Cursor) return Element_Type is
369 if Position.Node = null then
370 raise Constraint_Error with
371 "Position cursor has no element";
374 if Position.Node.Element = null then
375 raise Program_Error with
376 "Position cursor has no element";
379 pragma Assert (Vet (Position), "bad cursor in Element");
381 return Position.Node.Element.all;
391 Position : Cursor := No_Element) return Cursor
393 Node : Node_Access := Position.Node;
397 Node := Container.First;
400 if Node.Element = null then
404 if Position.Container /= Container'Unrestricted_Access then
405 raise Program_Error with
406 "Position cursor designates wrong container";
409 pragma Assert (Vet (Position), "bad cursor in Find");
412 while Node /= null loop
413 if Node.Element.all = Item then
414 return Cursor'(Container'Unchecked_Access, Node);
427 function First (Container : List) return Cursor is
429 if Container.First = null then
433 return Cursor'(Container'Unchecked_Access, Container.First);
440 function First_Element (Container : List) return Element_Type is
442 if Container.First = null then
443 raise Constraint_Error with "list is empty";
446 return Container.First.Element.all;
453 procedure Free (X : in out Node_Access) is
454 procedure Deallocate is
455 new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
473 ---------------------
474 -- Generic_Sorting --
475 ---------------------
477 package body Generic_Sorting is
483 function Is_Sorted (Container : List) return Boolean is
484 Node : Node_Access := Container.First;
487 for I in 2 .. Container.Length loop
488 if Node.Next.Element.all < Node.Element.all then
503 (Target : in out List;
504 Source : in out List)
509 if Target'Address = Source'Address then
513 if Target.Busy > 0 then
514 raise Program_Error with
515 "attempt to tamper with elements of Target (list is busy)";
518 if Source.Busy > 0 then
519 raise Program_Error with
520 "attempt to tamper with elements of Source (list is busy)";
523 LI := First (Target);
524 RI := First (Source);
525 while RI.Node /= null loop
526 pragma Assert (RI.Node.Next = null
527 or else not (RI.Node.Next.Element.all <
528 RI.Node.Element.all));
530 if LI.Node = null then
531 Splice (Target, No_Element, Source);
535 pragma Assert (LI.Node.Next = null
536 or else not (LI.Node.Next.Element.all <
537 LI.Node.Element.all));
539 if RI.Node.Element.all < LI.Node.Element.all then
542 pragma Warnings (Off, RJ);
544 RI.Node := RI.Node.Next;
545 Splice (Target, LI, Source, RJ);
549 LI.Node := LI.Node.Next;
558 procedure Sort (Container : in out List) is
559 procedure Partition (Pivot : Node_Access; Back : Node_Access);
561 procedure Sort (Front, Back : Node_Access);
567 procedure Partition (Pivot : Node_Access; Back : Node_Access) is
568 Node : Node_Access := Pivot.Next;
571 while Node /= Back loop
572 if Node.Element.all < Pivot.Element.all then
574 Prev : constant Node_Access := Node.Prev;
575 Next : constant Node_Access := Node.Next;
580 Container.Last := Prev;
586 Node.Prev := Pivot.Prev;
590 if Node.Prev = null then
591 Container.First := Node;
593 Node.Prev.Next := Node;
609 procedure Sort (Front, Back : Node_Access) is
614 Pivot := Container.First;
619 if Pivot /= Back then
620 Partition (Pivot, Back);
626 -- Start of processing for Sort
629 if Container.Length <= 1 then
633 pragma Assert (Container.First.Prev = null);
634 pragma Assert (Container.Last.Next = null);
636 if Container.Busy > 0 then
637 raise Program_Error with
638 "attempt to tamper with elements (list is busy)";
641 Sort (Front => null, Back => null);
643 pragma Assert (Container.First.Prev = null);
644 pragma Assert (Container.Last.Next = null);
653 function Has_Element (Position : Cursor) return Boolean is
655 pragma Assert (Vet (Position), "bad cursor in Has_Element");
656 return Position.Node /= null;
664 (Container : in out List;
666 New_Item : Element_Type;
667 Position : out Cursor;
668 Count : Count_Type := 1)
670 New_Node : Node_Access;
673 if Before.Container /= null then
674 if Before.Container /= Container'Unrestricted_Access then
675 raise Program_Error with
676 "attempt to tamper with elements (list is busy)";
679 if Before.Node = null
680 or else Before.Node.Element = null
682 raise Program_Error with
683 "Before cursor has no element";
686 pragma Assert (Vet (Before), "bad cursor in Insert");
694 if Container.Length > Count_Type'Last - Count then
695 raise Constraint_Error with "new length exceeds maximum";
698 if Container.Busy > 0 then
699 raise Program_Error with
700 "attempt to tamper with elements (list is busy)";
704 Element : Element_Access := new Element_Type'(New_Item);
706 New_Node := new Node_Type'(Element, null, null);
713 Insert_Internal (Container, Before.Node, New_Node);
714 Position := Cursor'(Container'Unchecked_Access, New_Node);
716 for J in Count_Type'(2) .. Count loop
719 Element : Element_Access := new Element_Type'(New_Item);
721 New_Node := new Node_Type'(Element, null, null);
728 Insert_Internal (Container, Before.Node, New_Node);
733 (Container : in out List;
735 New_Item : Element_Type;
736 Count : Count_Type := 1)
739 pragma Unreferenced (Position);
741 Insert (Container, Before, New_Item, Position, Count);
744 ---------------------
745 -- Insert_Internal --
746 ---------------------
748 procedure Insert_Internal
749 (Container : in out List;
750 Before : Node_Access;
751 New_Node : Node_Access)
754 if Container.Length = 0 then
755 pragma Assert (Before = null);
756 pragma Assert (Container.First = null);
757 pragma Assert (Container.Last = null);
759 Container.First := New_Node;
760 Container.Last := New_Node;
762 elsif Before = null then
763 pragma Assert (Container.Last.Next = null);
765 Container.Last.Next := New_Node;
766 New_Node.Prev := Container.Last;
768 Container.Last := New_Node;
770 elsif Before = Container.First then
771 pragma Assert (Container.First.Prev = null);
773 Container.First.Prev := New_Node;
774 New_Node.Next := Container.First;
776 Container.First := New_Node;
779 pragma Assert (Container.First.Prev = null);
780 pragma Assert (Container.Last.Next = null);
782 New_Node.Next := Before;
783 New_Node.Prev := Before.Prev;
785 Before.Prev.Next := New_Node;
786 Before.Prev := New_Node;
789 Container.Length := Container.Length + 1;
796 function Is_Empty (Container : List) return Boolean is
798 return Container.Length = 0;
807 Process : not null access procedure (Position : Cursor))
809 C : List renames Container'Unrestricted_Access.all;
810 B : Natural renames C.Busy;
812 Node : Node_Access := Container.First;
818 while Node /= null loop
819 Process (Cursor'(Container'Unchecked_Access, Node));
835 function Last (Container : List) return Cursor is
837 if Container.Last = null then
841 return Cursor'(Container'Unchecked_Access, Container.Last);
848 function Last_Element (Container : List) return Element_Type is
850 if Container.Last = null then
851 raise Constraint_Error with "list is empty";
854 return Container.Last.Element.all;
861 function Length (Container : List) return Count_Type is
863 return Container.Length;
870 procedure Move (Target : in out List; Source : in out List) is
872 if Target'Address = Source'Address then
876 if Source.Busy > 0 then
877 raise Program_Error with
878 "attempt to tamper with elements of Source (list is busy)";
883 Target.First := Source.First;
884 Source.First := null;
886 Target.Last := Source.Last;
889 Target.Length := Source.Length;
897 procedure Next (Position : in out Cursor) is
899 Position := Next (Position);
902 function Next (Position : Cursor) return Cursor is
904 if Position.Node = null then
908 pragma Assert (Vet (Position), "bad cursor in Next");
911 Next_Node : constant Node_Access := Position.Node.Next;
913 if Next_Node = null then
917 return Cursor'(Position.Container, Next_Node);
926 (Container : in out List;
927 New_Item : Element_Type;
928 Count : Count_Type := 1)
931 Insert (Container, First (Container), New_Item, Count);
938 procedure Previous (Position : in out Cursor) is
940 Position := Previous (Position);
943 function Previous (Position : Cursor) return Cursor is
945 if Position.Node = null then
949 pragma Assert (Vet (Position), "bad cursor in Previous");
952 Prev_Node : constant Node_Access := Position.Node.Prev;
954 if Prev_Node = null then
958 return Cursor'(Position.Container, Prev_Node);
966 procedure Query_Element
968 Process : not null access procedure (Element : Element_Type))
971 if Position.Node = null then
972 raise Constraint_Error with
973 "Position cursor has no element";
976 if Position.Node.Element = null then
977 raise Program_Error with
978 "Position cursor has no element";
981 pragma Assert (Vet (Position), "bad cursor in Query_Element");
984 C : List renames Position.Container.all'Unrestricted_Access.all;
985 B : Natural renames C.Busy;
986 L : Natural renames C.Lock;
993 Process (Position.Node.Element.all);
1011 (Stream : not null access Root_Stream_Type'Class;
1014 N : Count_Type'Base;
1020 Count_Type'Base'Read (Stream, N);
1027 Element : Element_Access :=
1028 new Element_Type'(Element_Type'Input (Stream));
1030 Dst := new Node_Type'(Element, null, null);
1041 while Item.Length < N loop
1043 Element : Element_Access :=
1044 new Element_Type'(Element_Type'Input (Stream));
1046 Dst := new Node_Type'(Element, Next => null, Prev => Item.Last);
1053 Item.Last.Next := Dst;
1055 Item.Length := Item.Length + 1;
1060 (Stream : not null access Root_Stream_Type'Class;
1064 raise Program_Error with "attempt to stream list cursor";
1067 ---------------------
1068 -- Replace_Element --
1069 ---------------------
1071 procedure Replace_Element
1072 (Container : in out List;
1074 New_Item : Element_Type)
1077 if Position.Container = null then
1078 raise Constraint_Error with "Position cursor has no element";
1081 if Position.Container /= Container'Unchecked_Access then
1082 raise Program_Error with
1083 "Position cursor designates wrong container";
1086 if Container.Lock > 0 then
1087 raise Program_Error with
1088 "attempt to tamper with cursors (list is locked)";
1091 if Position.Node.Element = null then
1092 raise Program_Error with
1093 "Position cursor has no element";
1096 pragma Assert (Vet (Position), "bad cursor in Replace_Element");
1099 X : Element_Access := Position.Node.Element;
1102 Position.Node.Element := new Element_Type'(New_Item);
1105 end Replace_Element;
1107 ----------------------
1108 -- Reverse_Elements --
1109 ----------------------
1111 procedure Reverse_Elements (Container : in out List) is
1112 I : Node_Access := Container.First;
1113 J : Node_Access := Container.Last;
1115 procedure Swap (L, R : Node_Access);
1121 procedure Swap (L, R : Node_Access) is
1122 LN : constant Node_Access := L.Next;
1123 LP : constant Node_Access := L.Prev;
1125 RN : constant Node_Access := R.Next;
1126 RP : constant Node_Access := R.Prev;
1141 pragma Assert (RP = L);
1155 -- Start of processing for Reverse_Elements
1158 if Container.Length <= 1 then
1162 pragma Assert (Container.First.Prev = null);
1163 pragma Assert (Container.Last.Next = null);
1165 if Container.Busy > 0 then
1166 raise Program_Error with
1167 "attempt to tamper with elements (list is busy)";
1170 Container.First := J;
1171 Container.Last := I;
1173 Swap (L => I, R => J);
1181 Swap (L => J, R => I);
1190 pragma Assert (Container.First.Prev = null);
1191 pragma Assert (Container.Last.Next = null);
1192 end Reverse_Elements;
1198 function Reverse_Find
1200 Item : Element_Type;
1201 Position : Cursor := No_Element) return Cursor
1203 Node : Node_Access := Position.Node;
1207 Node := Container.Last;
1210 if Node.Element = null then
1211 raise Program_Error with "Position cursor has no element";
1214 if Position.Container /= Container'Unrestricted_Access then
1215 raise Program_Error with
1216 "Position cursor designates wrong container";
1219 pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
1222 while Node /= null loop
1223 if Node.Element.all = Item then
1224 return Cursor'(Container'Unchecked_Access, Node);
1233 ---------------------
1234 -- Reverse_Iterate --
1235 ---------------------
1237 procedure Reverse_Iterate
1239 Process : not null access procedure (Position : Cursor))
1241 C : List renames Container'Unrestricted_Access.all;
1242 B : Natural renames C.Busy;
1244 Node : Node_Access := Container.Last;
1250 while Node /= null loop
1251 Process (Cursor'(Container'Unchecked_Access, Node));
1261 end Reverse_Iterate;
1268 (Target : in out List;
1270 Source : in out List)
1273 if Before.Container /= null then
1274 if Before.Container /= Target'Unrestricted_Access then
1275 raise Program_Error with
1276 "Before cursor designates wrong container";
1279 if Before.Node = null
1280 or else Before.Node.Element = null
1282 raise Program_Error with
1283 "Before cursor has no element";
1286 pragma Assert (Vet (Before), "bad cursor in Splice");
1289 if Target'Address = Source'Address
1290 or else Source.Length = 0
1295 pragma Assert (Source.First.Prev = null);
1296 pragma Assert (Source.Last.Next = null);
1298 if Target.Length > Count_Type'Last - Source.Length then
1299 raise Constraint_Error with "new length exceeds maximum";
1302 if Target.Busy > 0 then
1303 raise Program_Error with
1304 "attempt to tamper with elements of Target (list is busy)";
1307 if Source.Busy > 0 then
1308 raise Program_Error with
1309 "attempt to tamper with elements of Source (list is busy)";
1312 if Target.Length = 0 then
1313 pragma Assert (Before = No_Element);
1314 pragma Assert (Target.First = null);
1315 pragma Assert (Target.Last = null);
1317 Target.First := Source.First;
1318 Target.Last := Source.Last;
1320 elsif Before.Node = null then
1321 pragma Assert (Target.Last.Next = null);
1323 Target.Last.Next := Source.First;
1324 Source.First.Prev := Target.Last;
1326 Target.Last := Source.Last;
1328 elsif Before.Node = Target.First then
1329 pragma Assert (Target.First.Prev = null);
1331 Source.Last.Next := Target.First;
1332 Target.First.Prev := Source.Last;
1334 Target.First := Source.First;
1337 pragma Assert (Target.Length >= 2);
1338 Before.Node.Prev.Next := Source.First;
1339 Source.First.Prev := Before.Node.Prev;
1341 Before.Node.Prev := Source.Last;
1342 Source.Last.Next := Before.Node;
1345 Source.First := null;
1346 Source.Last := null;
1348 Target.Length := Target.Length + Source.Length;
1353 (Container : in out List;
1358 if Before.Container /= null then
1359 if Before.Container /= Container'Unchecked_Access then
1360 raise Program_Error with
1361 "Before cursor designates wrong container";
1364 if Before.Node = null
1365 or else Before.Node.Element = null
1367 raise Program_Error with
1368 "Before cursor has no element";
1371 pragma Assert (Vet (Before), "bad Before cursor in Splice");
1374 if Position.Node = null then
1375 raise Constraint_Error with "Position cursor has no element";
1378 if Position.Node.Element = null then
1379 raise Program_Error with "Position cursor has no element";
1382 if Position.Container /= Container'Unrestricted_Access then
1383 raise Program_Error with
1384 "Position cursor designates wrong container";
1387 pragma Assert (Vet (Position), "bad Position cursor in Splice");
1389 if Position.Node = Before.Node
1390 or else Position.Node.Next = Before.Node
1395 pragma Assert (Container.Length >= 2);
1397 if Container.Busy > 0 then
1398 raise Program_Error with
1399 "attempt to tamper with elements (list is busy)";
1402 if Before.Node = null then
1403 pragma Assert (Position.Node /= Container.Last);
1405 if Position.Node = Container.First then
1406 Container.First := Position.Node.Next;
1407 Container.First.Prev := null;
1409 Position.Node.Prev.Next := Position.Node.Next;
1410 Position.Node.Next.Prev := Position.Node.Prev;
1413 Container.Last.Next := Position.Node;
1414 Position.Node.Prev := Container.Last;
1416 Container.Last := Position.Node;
1417 Container.Last.Next := null;
1422 if Before.Node = Container.First then
1423 pragma Assert (Position.Node /= Container.First);
1425 if Position.Node = Container.Last then
1426 Container.Last := Position.Node.Prev;
1427 Container.Last.Next := null;
1429 Position.Node.Prev.Next := Position.Node.Next;
1430 Position.Node.Next.Prev := Position.Node.Prev;
1433 Container.First.Prev := Position.Node;
1434 Position.Node.Next := Container.First;
1436 Container.First := Position.Node;
1437 Container.First.Prev := null;
1442 if Position.Node = Container.First then
1443 Container.First := Position.Node.Next;
1444 Container.First.Prev := null;
1446 elsif Position.Node = Container.Last then
1447 Container.Last := Position.Node.Prev;
1448 Container.Last.Next := null;
1451 Position.Node.Prev.Next := Position.Node.Next;
1452 Position.Node.Next.Prev := Position.Node.Prev;
1455 Before.Node.Prev.Next := Position.Node;
1456 Position.Node.Prev := Before.Node.Prev;
1458 Before.Node.Prev := Position.Node;
1459 Position.Node.Next := Before.Node;
1461 pragma Assert (Container.First.Prev = null);
1462 pragma Assert (Container.Last.Next = null);
1466 (Target : in out List;
1468 Source : in out List;
1469 Position : in out Cursor)
1472 if Target'Address = Source'Address then
1473 Splice (Target, Before, Position);
1477 if Before.Container /= null then
1478 if Before.Container /= Target'Unrestricted_Access then
1479 raise Program_Error with
1480 "Before cursor designates wrong container";
1483 if Before.Node = null
1484 or else Before.Node.Element = null
1486 raise Program_Error with
1487 "Before cursor has no element";
1490 pragma Assert (Vet (Before), "bad Before cursor in Splice");
1493 if Position.Node = null then
1494 raise Constraint_Error with "Position cursor has no element";
1497 if Position.Node.Element = null then
1498 raise Program_Error with
1499 "Position cursor has no element";
1502 if Position.Container /= Source'Unrestricted_Access then
1503 raise Program_Error with
1504 "Position cursor designates wrong container";
1507 pragma Assert (Vet (Position), "bad Position cursor in Splice");
1509 if Target.Length = Count_Type'Last then
1510 raise Constraint_Error with "Target is full";
1513 if Target.Busy > 0 then
1514 raise Program_Error with
1515 "attempt to tamper with elements of Target (list is busy)";
1518 if Source.Busy > 0 then
1519 raise Program_Error with
1520 "attempt to tamper with elements of Source (list is busy)";
1523 if Position.Node = Source.First then
1524 Source.First := Position.Node.Next;
1526 if Position.Node = Source.Last then
1527 pragma Assert (Source.First = null);
1528 pragma Assert (Source.Length = 1);
1529 Source.Last := null;
1532 Source.First.Prev := null;
1535 elsif Position.Node = Source.Last then
1536 pragma Assert (Source.Length >= 2);
1537 Source.Last := Position.Node.Prev;
1538 Source.Last.Next := null;
1541 pragma Assert (Source.Length >= 3);
1542 Position.Node.Prev.Next := Position.Node.Next;
1543 Position.Node.Next.Prev := Position.Node.Prev;
1546 if Target.Length = 0 then
1547 pragma Assert (Before = No_Element);
1548 pragma Assert (Target.First = null);
1549 pragma Assert (Target.Last = null);
1551 Target.First := Position.Node;
1552 Target.Last := Position.Node;
1554 Target.First.Prev := null;
1555 Target.Last.Next := null;
1557 elsif Before.Node = null then
1558 pragma Assert (Target.Last.Next = null);
1559 Target.Last.Next := Position.Node;
1560 Position.Node.Prev := Target.Last;
1562 Target.Last := Position.Node;
1563 Target.Last.Next := null;
1565 elsif Before.Node = Target.First then
1566 pragma Assert (Target.First.Prev = null);
1567 Target.First.Prev := Position.Node;
1568 Position.Node.Next := Target.First;
1570 Target.First := Position.Node;
1571 Target.First.Prev := null;
1574 pragma Assert (Target.Length >= 2);
1575 Before.Node.Prev.Next := Position.Node;
1576 Position.Node.Prev := Before.Node.Prev;
1578 Before.Node.Prev := Position.Node;
1579 Position.Node.Next := Before.Node;
1582 Target.Length := Target.Length + 1;
1583 Source.Length := Source.Length - 1;
1585 Position.Container := Target'Unchecked_Access;
1593 (Container : in out List;
1597 if I.Node = null then
1598 raise Constraint_Error with "I cursor has no element";
1601 if J.Node = null then
1602 raise Constraint_Error with "J cursor has no element";
1605 if I.Container /= Container'Unchecked_Access then
1606 raise Program_Error with "I cursor designates wrong container";
1609 if J.Container /= Container'Unchecked_Access then
1610 raise Program_Error with "J cursor designates wrong container";
1613 if I.Node = J.Node then
1617 if Container.Lock > 0 then
1618 raise Program_Error with
1619 "attempt to tamper with cursors (list is locked)";
1622 pragma Assert (Vet (I), "bad I cursor in Swap");
1623 pragma Assert (Vet (J), "bad J cursor in Swap");
1626 EI_Copy : constant Element_Access := I.Node.Element;
1629 I.Node.Element := J.Node.Element;
1630 J.Node.Element := EI_Copy;
1638 procedure Swap_Links
1639 (Container : in out List;
1643 if I.Node = null then
1644 raise Constraint_Error with "I cursor has no element";
1647 if J.Node = null then
1648 raise Constraint_Error with "J cursor has no element";
1651 if I.Container /= Container'Unrestricted_Access then
1652 raise Program_Error with "I cursor designates wrong container";
1655 if J.Container /= Container'Unrestricted_Access then
1656 raise Program_Error with "J cursor designates wrong container";
1659 if I.Node = J.Node then
1663 if Container.Busy > 0 then
1664 raise Program_Error with
1665 "attempt to tamper with elements (list is busy)";
1668 pragma Assert (Vet (I), "bad I cursor in Swap_Links");
1669 pragma Assert (Vet (J), "bad J cursor in Swap_Links");
1672 I_Next : constant Cursor := Next (I);
1676 Splice (Container, Before => I, Position => J);
1680 J_Next : constant Cursor := Next (J);
1684 Splice (Container, Before => J, Position => I);
1687 pragma Assert (Container.Length >= 3);
1689 Splice (Container, Before => I_Next, Position => J);
1690 Splice (Container, Before => J_Next, Position => I);
1696 pragma Assert (Container.First.Prev = null);
1697 pragma Assert (Container.Last.Next = null);
1700 --------------------
1701 -- Update_Element --
1702 --------------------
1704 procedure Update_Element
1705 (Container : in out List;
1707 Process : not null access procedure (Element : in out Element_Type))
1710 if Position.Node = null then
1711 raise Constraint_Error with "Position cursor has no element";
1714 if Position.Node.Element = null then
1715 raise Program_Error with
1716 "Position cursor has no element";
1719 if Position.Container /= Container'Unchecked_Access then
1720 raise Program_Error with
1721 "Position cursor designates wrong container";
1724 pragma Assert (Vet (Position), "bad cursor in Update_Element");
1727 B : Natural renames Container.Busy;
1728 L : Natural renames Container.Lock;
1735 Process (Position.Node.Element.all);
1752 function Vet (Position : Cursor) return Boolean is
1754 if Position.Node = null then
1755 return Position.Container = null;
1758 if Position.Container = null then
1762 if Position.Node.Next = Position.Node then
1766 if Position.Node.Prev = Position.Node then
1770 if Position.Node.Element = null then
1775 L : List renames Position.Container.all;
1777 if L.Length = 0 then
1781 if L.First = null then
1785 if L.Last = null then
1789 if L.First.Prev /= null then
1793 if L.Last.Next /= null then
1797 if Position.Node.Prev = null
1798 and then Position.Node /= L.First
1803 if Position.Node.Next = null
1804 and then Position.Node /= L.Last
1809 if L.Length = 1 then
1810 return L.First = L.Last;
1813 if L.First = L.Last then
1817 if L.First.Next = null then
1821 if L.Last.Prev = null then
1825 if L.First.Next.Prev /= L.First then
1829 if L.Last.Prev.Next /= L.Last then
1833 if L.Length = 2 then
1834 if L.First.Next /= L.Last then
1838 if L.Last.Prev /= L.First then
1845 if L.First.Next = L.Last then
1849 if L.Last.Prev = L.First then
1853 if Position.Node = L.First then
1857 if Position.Node = L.Last then
1861 if Position.Node.Next = null then
1865 if Position.Node.Prev = null then
1869 if Position.Node.Next.Prev /= Position.Node then
1873 if Position.Node.Prev.Next /= Position.Node then
1877 if L.Length = 3 then
1878 if L.First.Next /= Position.Node then
1882 if L.Last.Prev /= Position.Node then
1896 (Stream : not null access Root_Stream_Type'Class;
1899 Node : Node_Access := Item.First;
1902 Count_Type'Base'Write (Stream, Item.Length);
1904 while Node /= null loop
1905 Element_Type'Output (Stream, Node.Element.all);
1911 (Stream : not null access Root_Stream_Type'Class;
1915 raise Program_Error with "attempt to stream list cursor";
1918 end Ada.Containers.Indefinite_Doubly_Linked_Lists;