1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- A D A . C O N T A I N E R S . --
6 -- I N D E F I N I T E _ D O U B L Y _ L I N K E D _ L I S T S --
10 -- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
21 -- Boston, MA 02110-1301, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- This unit was originally developed by Matthew J Heaney. --
31 ------------------------------------------------------------------------------
33 with System; use type System.Address;
34 with Ada.Unchecked_Deallocation;
36 package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
39 new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
41 -----------------------
42 -- Local Subprograms --
43 -----------------------
45 procedure Free (X : in out Node_Access);
47 procedure Insert_Internal
48 (Container : in out List;
50 New_Node : Node_Access);
52 function Vet (Position : Cursor) return Boolean;
58 function "=" (Left, Right : List) return Boolean is
63 if Left'Address = Right'Address then
67 if Left.Length /= Right.Length then
73 for J in 1 .. Left.Length loop
74 if L.Element.all /= R.Element.all then
89 procedure Adjust (Container : in out List) is
90 Src : Node_Access := Container.First;
95 pragma Assert (Container.Last = null);
96 pragma Assert (Container.Length = 0);
97 pragma Assert (Container.Busy = 0);
98 pragma Assert (Container.Lock = 0);
102 pragma Assert (Container.First.Prev = null);
103 pragma Assert (Container.Last.Next = null);
104 pragma Assert (Container.Length > 0);
106 Container.First := null;
107 Container.Last := null;
108 Container.Length := 0;
113 Element : Element_Access := new Element_Type'(Src.Element.all);
115 Dst := new Node_Type'(Element, null, null);
122 Container.First := Dst;
123 Container.Last := Dst;
124 Container.Length := 1;
127 while Src /= null loop
129 Element : Element_Access := new Element_Type'(Src.Element.all);
131 Dst := new Node_Type'(Element, null, Prev => Container.Last);
138 Container.Last.Next := Dst;
139 Container.Last := Dst;
140 Container.Length := Container.Length + 1;
151 (Container : in out List;
152 New_Item : Element_Type;
153 Count : Count_Type := 1)
156 Insert (Container, No_Element, New_Item, Count);
163 procedure Clear (Container : in out List) is
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
543 RI.Node := RI.Node.Next;
544 Splice (Target, LI, Source, RJ);
548 LI.Node := LI.Node.Next;
557 procedure Sort (Container : in out List) is
558 procedure Partition (Pivot : Node_Access; Back : Node_Access);
560 procedure Sort (Front, Back : Node_Access);
566 procedure Partition (Pivot : Node_Access; Back : Node_Access) is
567 Node : Node_Access := Pivot.Next;
570 while Node /= Back loop
571 if Node.Element.all < Pivot.Element.all then
573 Prev : constant Node_Access := Node.Prev;
574 Next : constant Node_Access := Node.Next;
579 Container.Last := Prev;
585 Node.Prev := Pivot.Prev;
589 if Node.Prev = null then
590 Container.First := Node;
592 Node.Prev.Next := Node;
608 procedure Sort (Front, Back : Node_Access) is
613 Pivot := Container.First;
618 if Pivot /= Back then
619 Partition (Pivot, Back);
625 -- Start of processing for Sort
628 if Container.Length <= 1 then
632 pragma Assert (Container.First.Prev = null);
633 pragma Assert (Container.Last.Next = null);
635 if Container.Busy > 0 then
636 raise Program_Error with
637 "attempt to tamper with elements (list is busy)";
640 Sort (Front => null, Back => null);
642 pragma Assert (Container.First.Prev = null);
643 pragma Assert (Container.Last.Next = null);
652 function Has_Element (Position : Cursor) return Boolean is
654 pragma Assert (Vet (Position), "bad cursor in Has_Element");
655 return Position.Node /= null;
663 (Container : in out List;
665 New_Item : Element_Type;
666 Position : out Cursor;
667 Count : Count_Type := 1)
669 New_Node : Node_Access;
672 if Before.Container /= null then
673 if Before.Container /= Container'Unrestricted_Access then
674 raise Program_Error with
675 "attempt to tamper with elements (list is busy)";
678 if Before.Node = null
679 or else Before.Node.Element = null
681 raise Program_Error with
682 "Before cursor has no element";
685 pragma Assert (Vet (Before), "bad cursor in Insert");
693 if Container.Length > Count_Type'Last - Count then
694 raise Constraint_Error with "new length exceeds maximum";
697 if Container.Busy > 0 then
698 raise Program_Error with
699 "attempt to tamper with elements (list is busy)";
703 Element : Element_Access := new Element_Type'(New_Item);
705 New_Node := new Node_Type'(Element, null, null);
712 Insert_Internal (Container, Before.Node, New_Node);
713 Position := Cursor'(Container'Unchecked_Access, New_Node);
715 for J in Count_Type'(2) .. Count loop
718 Element : Element_Access := new Element_Type'(New_Item);
720 New_Node := new Node_Type'(Element, null, null);
727 Insert_Internal (Container, Before.Node, New_Node);
732 (Container : in out List;
734 New_Item : Element_Type;
735 Count : Count_Type := 1)
739 Insert (Container, Before, New_Item, Position, Count);
742 ---------------------
743 -- Insert_Internal --
744 ---------------------
746 procedure Insert_Internal
747 (Container : in out List;
748 Before : Node_Access;
749 New_Node : Node_Access)
752 if Container.Length = 0 then
753 pragma Assert (Before = null);
754 pragma Assert (Container.First = null);
755 pragma Assert (Container.Last = null);
757 Container.First := New_Node;
758 Container.Last := New_Node;
760 elsif Before = null then
761 pragma Assert (Container.Last.Next = null);
763 Container.Last.Next := New_Node;
764 New_Node.Prev := Container.Last;
766 Container.Last := New_Node;
768 elsif Before = Container.First then
769 pragma Assert (Container.First.Prev = null);
771 Container.First.Prev := New_Node;
772 New_Node.Next := Container.First;
774 Container.First := New_Node;
777 pragma Assert (Container.First.Prev = null);
778 pragma Assert (Container.Last.Next = null);
780 New_Node.Next := Before;
781 New_Node.Prev := Before.Prev;
783 Before.Prev.Next := New_Node;
784 Before.Prev := New_Node;
787 Container.Length := Container.Length + 1;
794 function Is_Empty (Container : List) return Boolean is
796 return Container.Length = 0;
805 Process : not null access procedure (Position : Cursor))
807 C : List renames Container'Unrestricted_Access.all;
808 B : Natural renames C.Busy;
810 Node : Node_Access := Container.First;
816 while Node /= null loop
817 Process (Cursor'(Container'Unchecked_Access, Node));
833 function Last (Container : List) return Cursor is
835 if Container.Last = null then
839 return Cursor'(Container'Unchecked_Access, Container.Last);
846 function Last_Element (Container : List) return Element_Type is
848 if Container.Last = null then
849 raise Constraint_Error with "list is empty";
852 return Container.Last.Element.all;
859 function Length (Container : List) return Count_Type is
861 return Container.Length;
868 procedure Move (Target : in out List; Source : in out List) is
870 if Target'Address = Source'Address then
874 if Source.Busy > 0 then
875 raise Program_Error with
876 "attempt to tamper with elements of Source (list is busy)";
881 Target.First := Source.First;
882 Source.First := null;
884 Target.Last := Source.Last;
887 Target.Length := Source.Length;
895 procedure Next (Position : in out Cursor) is
897 Position := Next (Position);
900 function Next (Position : Cursor) return Cursor is
902 if Position.Node = null then
906 pragma Assert (Vet (Position), "bad cursor in Next");
909 Next_Node : constant Node_Access := Position.Node.Next;
911 if Next_Node = null then
915 return Cursor'(Position.Container, Next_Node);
924 (Container : in out List;
925 New_Item : Element_Type;
926 Count : Count_Type := 1)
929 Insert (Container, First (Container), New_Item, Count);
936 procedure Previous (Position : in out Cursor) is
938 Position := Previous (Position);
941 function Previous (Position : Cursor) return Cursor is
943 if Position.Node = null then
947 pragma Assert (Vet (Position), "bad cursor in Previous");
950 Prev_Node : constant Node_Access := Position.Node.Prev;
952 if Prev_Node = null then
956 return Cursor'(Position.Container, Prev_Node);
964 procedure Query_Element
966 Process : not null access procedure (Element : Element_Type))
969 if Position.Node = null then
970 raise Constraint_Error with
971 "Position cursor has no element";
974 if Position.Node.Element = null then
975 raise Program_Error with
976 "Position cursor has no element";
979 pragma Assert (Vet (Position), "bad cursor in Query_Element");
982 C : List renames Position.Container.all'Unrestricted_Access.all;
983 B : Natural renames C.Busy;
984 L : Natural renames C.Lock;
991 Process (Position.Node.Element.all);
1009 (Stream : not null access Root_Stream_Type'Class;
1012 N : Count_Type'Base;
1018 Count_Type'Base'Read (Stream, N);
1025 Element : Element_Access :=
1026 new Element_Type'(Element_Type'Input (Stream));
1028 Dst := new Node_Type'(Element, null, null);
1039 while Item.Length < N loop
1041 Element : Element_Access :=
1042 new Element_Type'(Element_Type'Input (Stream));
1044 Dst := new Node_Type'(Element, Next => null, Prev => Item.Last);
1051 Item.Last.Next := Dst;
1053 Item.Length := Item.Length + 1;
1058 (Stream : not null access Root_Stream_Type'Class;
1062 raise Program_Error with "attempt to stream list cursor";
1065 ---------------------
1066 -- Replace_Element --
1067 ---------------------
1069 procedure Replace_Element
1070 (Container : in out List;
1072 New_Item : Element_Type)
1075 if Position.Container = null then
1076 raise Constraint_Error with "Position cursor has no element";
1079 if Position.Container /= Container'Unchecked_Access then
1080 raise Program_Error with
1081 "Position cursor designates wrong container";
1084 if Container.Lock > 0 then
1085 raise Program_Error with
1086 "attempt to tamper with cursors (list is locked)";
1089 if Position.Node.Element = null then
1090 raise Program_Error with
1091 "Position cursor has no element";
1094 pragma Assert (Vet (Position), "bad cursor in Replace_Element");
1097 X : Element_Access := Position.Node.Element;
1100 Position.Node.Element := new Element_Type'(New_Item);
1103 end Replace_Element;
1105 ----------------------
1106 -- Reverse_Elements --
1107 ----------------------
1109 procedure Reverse_Elements (Container : in out List) is
1110 I : Node_Access := Container.First;
1111 J : Node_Access := Container.Last;
1113 procedure Swap (L, R : Node_Access);
1119 procedure Swap (L, R : Node_Access) is
1120 LN : constant Node_Access := L.Next;
1121 LP : constant Node_Access := L.Prev;
1123 RN : constant Node_Access := R.Next;
1124 RP : constant Node_Access := R.Prev;
1139 pragma Assert (RP = L);
1153 -- Start of processing for Reverse_Elements
1156 if Container.Length <= 1 then
1160 pragma Assert (Container.First.Prev = null);
1161 pragma Assert (Container.Last.Next = null);
1163 if Container.Busy > 0 then
1164 raise Program_Error with
1165 "attempt to tamper with elements (list is busy)";
1168 Container.First := J;
1169 Container.Last := I;
1171 Swap (L => I, R => J);
1179 Swap (L => J, R => I);
1188 pragma Assert (Container.First.Prev = null);
1189 pragma Assert (Container.Last.Next = null);
1190 end Reverse_Elements;
1196 function Reverse_Find
1198 Item : Element_Type;
1199 Position : Cursor := No_Element) return Cursor
1201 Node : Node_Access := Position.Node;
1205 Node := Container.Last;
1208 if Node.Element = null then
1209 raise Program_Error with "Position cursor has no element";
1212 if Position.Container /= Container'Unrestricted_Access then
1213 raise Program_Error with
1214 "Position cursor designates wrong container";
1217 pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
1220 while Node /= null loop
1221 if Node.Element.all = Item then
1222 return Cursor'(Container'Unchecked_Access, Node);
1231 ---------------------
1232 -- Reverse_Iterate --
1233 ---------------------
1235 procedure Reverse_Iterate
1237 Process : not null access procedure (Position : Cursor))
1239 C : List renames Container'Unrestricted_Access.all;
1240 B : Natural renames C.Busy;
1242 Node : Node_Access := Container.Last;
1248 while Node /= null loop
1249 Process (Cursor'(Container'Unchecked_Access, Node));
1259 end Reverse_Iterate;
1266 (Target : in out List;
1268 Source : in out List)
1271 if Before.Container /= null then
1272 if Before.Container /= Target'Unrestricted_Access then
1273 raise Program_Error with
1274 "Before cursor designates wrong container";
1277 if Before.Node = null
1278 or else Before.Node.Element = null
1280 raise Program_Error with
1281 "Before cursor has no element";
1284 pragma Assert (Vet (Before), "bad cursor in Splice");
1287 if Target'Address = Source'Address
1288 or else Source.Length = 0
1293 pragma Assert (Source.First.Prev = null);
1294 pragma Assert (Source.Last.Next = null);
1296 if Target.Length > Count_Type'Last - Source.Length then
1297 raise Constraint_Error with "new length exceeds maximum";
1300 if Target.Busy > 0 then
1301 raise Program_Error with
1302 "attempt to tamper with elements of Target (list is busy)";
1305 if Source.Busy > 0 then
1306 raise Program_Error with
1307 "attempt to tamper with elements of Source (list is busy)";
1310 if Target.Length = 0 then
1311 pragma Assert (Before = No_Element);
1312 pragma Assert (Target.First = null);
1313 pragma Assert (Target.Last = null);
1315 Target.First := Source.First;
1316 Target.Last := Source.Last;
1318 elsif Before.Node = null then
1319 pragma Assert (Target.Last.Next = null);
1321 Target.Last.Next := Source.First;
1322 Source.First.Prev := Target.Last;
1324 Target.Last := Source.Last;
1326 elsif Before.Node = Target.First then
1327 pragma Assert (Target.First.Prev = null);
1329 Source.Last.Next := Target.First;
1330 Target.First.Prev := Source.Last;
1332 Target.First := Source.First;
1335 pragma Assert (Target.Length >= 2);
1336 Before.Node.Prev.Next := Source.First;
1337 Source.First.Prev := Before.Node.Prev;
1339 Before.Node.Prev := Source.Last;
1340 Source.Last.Next := Before.Node;
1343 Source.First := null;
1344 Source.Last := null;
1346 Target.Length := Target.Length + Source.Length;
1351 (Container : in out List;
1356 if Before.Container /= null then
1357 if Before.Container /= Container'Unchecked_Access then
1358 raise Program_Error with
1359 "Before cursor designates wrong container";
1362 if Before.Node = null
1363 or else Before.Node.Element = null
1365 raise Program_Error with
1366 "Before cursor has no element";
1369 pragma Assert (Vet (Before), "bad Before cursor in Splice");
1372 if Position.Node = null then
1373 raise Constraint_Error with "Position cursor has no element";
1376 if Position.Node.Element = null then
1377 raise Program_Error with "Position cursor has no element";
1380 if Position.Container /= Container'Unrestricted_Access then
1381 raise Program_Error with
1382 "Position cursor designates wrong container";
1385 pragma Assert (Vet (Position), "bad Position cursor in Splice");
1387 if Position.Node = Before.Node
1388 or else Position.Node.Next = Before.Node
1393 pragma Assert (Container.Length >= 2);
1395 if Container.Busy > 0 then
1396 raise Program_Error with
1397 "attempt to tamper with elements (list is busy)";
1400 if Before.Node = null then
1401 pragma Assert (Position.Node /= Container.Last);
1403 if Position.Node = Container.First then
1404 Container.First := Position.Node.Next;
1405 Container.First.Prev := null;
1407 Position.Node.Prev.Next := Position.Node.Next;
1408 Position.Node.Next.Prev := Position.Node.Prev;
1411 Container.Last.Next := Position.Node;
1412 Position.Node.Prev := Container.Last;
1414 Container.Last := Position.Node;
1415 Container.Last.Next := null;
1420 if Before.Node = Container.First then
1421 pragma Assert (Position.Node /= Container.First);
1423 if Position.Node = Container.Last then
1424 Container.Last := Position.Node.Prev;
1425 Container.Last.Next := null;
1427 Position.Node.Prev.Next := Position.Node.Next;
1428 Position.Node.Next.Prev := Position.Node.Prev;
1431 Container.First.Prev := Position.Node;
1432 Position.Node.Next := Container.First;
1434 Container.First := Position.Node;
1435 Container.First.Prev := null;
1440 if Position.Node = Container.First then
1441 Container.First := Position.Node.Next;
1442 Container.First.Prev := null;
1444 elsif Position.Node = Container.Last then
1445 Container.Last := Position.Node.Prev;
1446 Container.Last.Next := null;
1449 Position.Node.Prev.Next := Position.Node.Next;
1450 Position.Node.Next.Prev := Position.Node.Prev;
1453 Before.Node.Prev.Next := Position.Node;
1454 Position.Node.Prev := Before.Node.Prev;
1456 Before.Node.Prev := Position.Node;
1457 Position.Node.Next := Before.Node;
1459 pragma Assert (Container.First.Prev = null);
1460 pragma Assert (Container.Last.Next = null);
1464 (Target : in out List;
1466 Source : in out List;
1467 Position : in out Cursor)
1470 if Target'Address = Source'Address then
1471 Splice (Target, Before, Position);
1475 if Before.Container /= null then
1476 if Before.Container /= Target'Unrestricted_Access then
1477 raise Program_Error with
1478 "Before cursor designates wrong container";
1481 if Before.Node = null
1482 or else Before.Node.Element = null
1484 raise Program_Error with
1485 "Before cursor has no element";
1488 pragma Assert (Vet (Before), "bad Before cursor in Splice");
1491 if Position.Node = null then
1492 raise Constraint_Error with "Position cursor has no element";
1495 if Position.Node.Element = null then
1496 raise Program_Error with
1497 "Position cursor has no element";
1500 if Position.Container /= Source'Unrestricted_Access then
1501 raise Program_Error with
1502 "Position cursor designates wrong container";
1505 pragma Assert (Vet (Position), "bad Position cursor in Splice");
1507 if Target.Length = Count_Type'Last then
1508 raise Constraint_Error with "Target is full";
1511 if Target.Busy > 0 then
1512 raise Program_Error with
1513 "attempt to tamper with elements of Target (list is busy)";
1516 if Source.Busy > 0 then
1517 raise Program_Error with
1518 "attempt to tamper with elements of Source (list is busy)";
1521 if Position.Node = Source.First then
1522 Source.First := Position.Node.Next;
1524 if Position.Node = Source.Last then
1525 pragma Assert (Source.First = null);
1526 pragma Assert (Source.Length = 1);
1527 Source.Last := null;
1530 Source.First.Prev := null;
1533 elsif Position.Node = Source.Last then
1534 pragma Assert (Source.Length >= 2);
1535 Source.Last := Position.Node.Prev;
1536 Source.Last.Next := null;
1539 pragma Assert (Source.Length >= 3);
1540 Position.Node.Prev.Next := Position.Node.Next;
1541 Position.Node.Next.Prev := Position.Node.Prev;
1544 if Target.Length = 0 then
1545 pragma Assert (Before = No_Element);
1546 pragma Assert (Target.First = null);
1547 pragma Assert (Target.Last = null);
1549 Target.First := Position.Node;
1550 Target.Last := Position.Node;
1552 Target.First.Prev := null;
1553 Target.Last.Next := null;
1555 elsif Before.Node = null then
1556 pragma Assert (Target.Last.Next = null);
1557 Target.Last.Next := Position.Node;
1558 Position.Node.Prev := Target.Last;
1560 Target.Last := Position.Node;
1561 Target.Last.Next := null;
1563 elsif Before.Node = Target.First then
1564 pragma Assert (Target.First.Prev = null);
1565 Target.First.Prev := Position.Node;
1566 Position.Node.Next := Target.First;
1568 Target.First := Position.Node;
1569 Target.First.Prev := null;
1572 pragma Assert (Target.Length >= 2);
1573 Before.Node.Prev.Next := Position.Node;
1574 Position.Node.Prev := Before.Node.Prev;
1576 Before.Node.Prev := Position.Node;
1577 Position.Node.Next := Before.Node;
1580 Target.Length := Target.Length + 1;
1581 Source.Length := Source.Length - 1;
1583 Position.Container := Target'Unchecked_Access;
1591 (Container : in out List;
1595 if I.Node = null then
1596 raise Constraint_Error with "I cursor has no element";
1599 if J.Node = null then
1600 raise Constraint_Error with "J cursor has no element";
1603 if I.Container /= Container'Unchecked_Access then
1604 raise Program_Error with "I cursor designates wrong container";
1607 if J.Container /= Container'Unchecked_Access then
1608 raise Program_Error with "J cursor designates wrong container";
1611 if I.Node = J.Node then
1615 if Container.Lock > 0 then
1616 raise Program_Error with
1617 "attempt to tamper with cursors (list is locked)";
1620 pragma Assert (Vet (I), "bad I cursor in Swap");
1621 pragma Assert (Vet (J), "bad J cursor in Swap");
1624 EI_Copy : constant Element_Access := I.Node.Element;
1627 I.Node.Element := J.Node.Element;
1628 J.Node.Element := EI_Copy;
1636 procedure Swap_Links
1637 (Container : in out List;
1641 if I.Node = null then
1642 raise Constraint_Error with "I cursor has no element";
1645 if J.Node = null then
1646 raise Constraint_Error with "J cursor has no element";
1649 if I.Container /= Container'Unrestricted_Access then
1650 raise Program_Error with "I cursor designates wrong container";
1653 if J.Container /= Container'Unrestricted_Access then
1654 raise Program_Error with "J cursor designates wrong container";
1657 if I.Node = J.Node then
1661 if Container.Busy > 0 then
1662 raise Program_Error with
1663 "attempt to tamper with elements (list is busy)";
1666 pragma Assert (Vet (I), "bad I cursor in Swap_Links");
1667 pragma Assert (Vet (J), "bad J cursor in Swap_Links");
1670 I_Next : constant Cursor := Next (I);
1674 Splice (Container, Before => I, Position => J);
1678 J_Next : constant Cursor := Next (J);
1682 Splice (Container, Before => J, Position => I);
1685 pragma Assert (Container.Length >= 3);
1687 Splice (Container, Before => I_Next, Position => J);
1688 Splice (Container, Before => J_Next, Position => I);
1694 pragma Assert (Container.First.Prev = null);
1695 pragma Assert (Container.Last.Next = null);
1698 --------------------
1699 -- Update_Element --
1700 --------------------
1702 procedure Update_Element
1703 (Container : in out List;
1705 Process : not null access procedure (Element : in out Element_Type))
1708 if Position.Node = null then
1709 raise Constraint_Error with "Position cursor has no element";
1712 if Position.Node.Element = null then
1713 raise Program_Error with
1714 "Position cursor has no element";
1717 if Position.Container /= Container'Unchecked_Access then
1718 raise Program_Error with
1719 "Position cursor designates wrong container";
1722 pragma Assert (Vet (Position), "bad cursor in Update_Element");
1725 B : Natural renames Container.Busy;
1726 L : Natural renames Container.Lock;
1733 Process (Position.Node.Element.all);
1750 function Vet (Position : Cursor) return Boolean is
1752 if Position.Node = null then
1753 return Position.Container = null;
1756 if Position.Container = null then
1760 if Position.Node.Next = Position.Node then
1764 if Position.Node.Prev = Position.Node then
1768 if Position.Node.Element = null then
1773 L : List renames Position.Container.all;
1775 if L.Length = 0 then
1779 if L.First = null then
1783 if L.Last = null then
1787 if L.First.Prev /= null then
1791 if L.Last.Next /= null then
1795 if Position.Node.Prev = null
1796 and then Position.Node /= L.First
1801 if Position.Node.Next = null
1802 and then Position.Node /= L.Last
1807 if L.Length = 1 then
1808 return L.First = L.Last;
1811 if L.First = L.Last then
1815 if L.First.Next = null then
1819 if L.Last.Prev = null then
1823 if L.First.Next.Prev /= L.First then
1827 if L.Last.Prev.Next /= L.Last then
1831 if L.Length = 2 then
1832 if L.First.Next /= L.Last then
1836 if L.Last.Prev /= L.First then
1843 if L.First.Next = L.Last then
1847 if L.Last.Prev = L.First then
1851 if Position.Node = L.First then
1855 if Position.Node = L.Last then
1859 if Position.Node.Next = null then
1863 if Position.Node.Prev = null then
1867 if Position.Node.Next.Prev /= Position.Node then
1871 if Position.Node.Prev.Next /= Position.Node then
1875 if L.Length = 3 then
1876 if L.First.Next /= Position.Node then
1880 if L.Last.Prev /= Position.Node then
1894 (Stream : not null access Root_Stream_Type'Class;
1897 Node : Node_Access := Item.First;
1900 Count_Type'Base'Write (Stream, Item.Length);
1902 while Node /= null loop
1903 Element_Type'Output (Stream, Node.Element.all);
1909 (Stream : not null access Root_Stream_Type'Class;
1913 raise Program_Error with "attempt to stream list cursor";
1916 end Ada.Containers.Indefinite_Doubly_Linked_Lists;