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-2009, 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 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
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. --
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/>. --
27 -- This unit was originally developed by Matthew J Heaney. --
28 ------------------------------------------------------------------------------
30 with System; use type System.Address;
32 with Ada.Unchecked_Deallocation;
34 package body Ada.Containers.Doubly_Linked_Lists is
36 -----------------------
37 -- Local Subprograms --
38 -----------------------
40 procedure Free (X : in out Node_Access);
42 procedure Insert_Internal
43 (Container : in out List;
45 New_Node : Node_Access);
47 function Vet (Position : Cursor) return Boolean;
53 function "=" (Left, Right : List) return Boolean is
54 L : Node_Access := Left.First;
55 R : Node_Access := Right.First;
58 if Left'Address = Right'Address then
62 if Left.Length /= Right.Length then
66 for J in 1 .. Left.Length loop
67 if L.Element /= R.Element then
82 procedure Adjust (Container : in out List) is
83 Src : Node_Access := Container.First;
87 pragma Assert (Container.Last = null);
88 pragma Assert (Container.Length = 0);
89 pragma Assert (Container.Busy = 0);
90 pragma Assert (Container.Lock = 0);
94 pragma Assert (Container.First.Prev = null);
95 pragma Assert (Container.Last.Next = null);
96 pragma Assert (Container.Length > 0);
98 Container.First := null;
99 Container.Last := null;
100 Container.Length := 0;
104 Container.First := new Node_Type'(Src.Element, null, null);
105 Container.Last := Container.First;
106 Container.Length := 1;
109 while Src /= null loop
110 Container.Last.Next := new Node_Type'(Element => Src.Element,
111 Prev => Container.Last,
113 Container.Last := Container.Last.Next;
114 Container.Length := Container.Length + 1;
125 (Container : in out List;
126 New_Item : Element_Type;
127 Count : Count_Type := 1)
130 Insert (Container, No_Element, New_Item, Count);
137 procedure Clear (Container : in out List) is
141 if Container.Length = 0 then
142 pragma Assert (Container.First = null);
143 pragma Assert (Container.Last = null);
144 pragma Assert (Container.Busy = 0);
145 pragma Assert (Container.Lock = 0);
149 pragma Assert (Container.First.Prev = null);
150 pragma Assert (Container.Last.Next = null);
152 if Container.Busy > 0 then
153 raise Program_Error with
154 "attempt to tamper with elements (list is busy)";
157 while Container.Length > 1 loop
158 X := Container.First;
159 pragma Assert (X.Next.Prev = Container.First);
161 Container.First := X.Next;
162 Container.First.Prev := null;
164 Container.Length := Container.Length - 1;
169 X := Container.First;
170 pragma Assert (X = Container.Last);
172 Container.First := null;
173 Container.Last := null;
174 Container.Length := 0;
176 pragma Warnings (Off);
178 pragma Warnings (On);
187 Item : Element_Type) return Boolean
190 return Find (Container, Item) /= No_Element;
198 (Container : in out List;
199 Position : in out Cursor;
200 Count : Count_Type := 1)
205 if Position.Node = null then
206 raise Constraint_Error with
207 "Position cursor has no element";
210 if Position.Container /= Container'Unrestricted_Access then
211 raise Program_Error with
212 "Position cursor designates wrong container";
215 pragma Assert (Vet (Position), "bad cursor in Delete");
217 if Position.Node = Container.First then
218 Delete_First (Container, Count);
219 Position := No_Element; -- Post-York behavior
224 Position := No_Element; -- Post-York behavior
228 if Container.Busy > 0 then
229 raise Program_Error with
230 "attempt to tamper with elements (list is busy)";
233 for Index in 1 .. Count loop
235 Container.Length := Container.Length - 1;
237 if X = Container.Last then
238 Position := No_Element;
240 Container.Last := X.Prev;
241 Container.Last.Next := null;
247 Position.Node := X.Next;
249 X.Next.Prev := X.Prev;
250 X.Prev.Next := X.Next;
255 Position := No_Element; -- Post-York behavior
262 procedure Delete_First
263 (Container : in out List;
264 Count : Count_Type := 1)
269 if Count >= Container.Length then
278 if Container.Busy > 0 then
279 raise Program_Error with
280 "attempt to tamper with elements (list is busy)";
283 for I in 1 .. Count loop
284 X := Container.First;
285 pragma Assert (X.Next.Prev = Container.First);
287 Container.First := X.Next;
288 Container.First.Prev := null;
290 Container.Length := Container.Length - 1;
300 procedure Delete_Last
301 (Container : in out List;
302 Count : Count_Type := 1)
307 if Count >= Container.Length then
316 if Container.Busy > 0 then
317 raise Program_Error with
318 "attempt to tamper with elements (list is busy)";
321 for I in 1 .. Count loop
323 pragma Assert (X.Prev.Next = Container.Last);
325 Container.Last := X.Prev;
326 Container.Last.Next := null;
328 Container.Length := Container.Length - 1;
338 function Element (Position : Cursor) return Element_Type is
340 if Position.Node = null then
341 raise Constraint_Error with
342 "Position cursor has no element";
345 pragma Assert (Vet (Position), "bad cursor in Element");
347 return Position.Node.Element;
357 Position : Cursor := No_Element) return Cursor
359 Node : Node_Access := Position.Node;
363 Node := Container.First;
366 if Position.Container /= Container'Unrestricted_Access then
367 raise Program_Error with
368 "Position cursor designates wrong container";
371 pragma Assert (Vet (Position), "bad cursor in Find");
374 while Node /= null loop
375 if Node.Element = Item then
376 return Cursor'(Container'Unchecked_Access, Node);
389 function First (Container : List) return Cursor is
391 if Container.First = null then
395 return Cursor'(Container'Unchecked_Access, Container.First);
402 function First_Element (Container : List) return Element_Type is
404 if Container.First = null then
405 raise Constraint_Error with "list is empty";
408 return Container.First.Element;
415 procedure Free (X : in out Node_Access) is
416 procedure Deallocate is
417 new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
425 ---------------------
426 -- Generic_Sorting --
427 ---------------------
429 package body Generic_Sorting is
435 function Is_Sorted (Container : List) return Boolean is
436 Node : Node_Access := Container.First;
439 for I in 2 .. Container.Length loop
440 if Node.Next.Element < Node.Element then
455 (Target : in out List;
456 Source : in out List)
461 if Target'Address = Source'Address then
465 if Target.Busy > 0 then
466 raise Program_Error with
467 "attempt to tamper with elements of Target (list is busy)";
470 if Source.Busy > 0 then
471 raise Program_Error with
472 "attempt to tamper with elements of Source (list is busy)";
475 LI := First (Target);
476 RI := First (Source);
477 while RI.Node /= null loop
478 pragma Assert (RI.Node.Next = null
479 or else not (RI.Node.Next.Element <
482 if LI.Node = null then
483 Splice (Target, No_Element, Source);
487 pragma Assert (LI.Node.Next = null
488 or else not (LI.Node.Next.Element <
491 if RI.Node.Element < LI.Node.Element then
494 pragma Warnings (Off, RJ);
496 RI.Node := RI.Node.Next;
497 Splice (Target, LI, Source, RJ);
501 LI.Node := LI.Node.Next;
510 procedure Sort (Container : in out List) is
512 procedure Partition (Pivot : Node_Access; Back : Node_Access);
514 procedure Sort (Front, Back : Node_Access);
520 procedure Partition (Pivot : Node_Access; Back : Node_Access) is
521 Node : Node_Access := Pivot.Next;
524 while Node /= Back loop
525 if Node.Element < Pivot.Element then
527 Prev : constant Node_Access := Node.Prev;
528 Next : constant Node_Access := Node.Next;
534 Container.Last := Prev;
540 Node.Prev := Pivot.Prev;
544 if Node.Prev = null then
545 Container.First := Node;
547 Node.Prev.Next := Node;
563 procedure Sort (Front, Back : Node_Access) is
564 Pivot : constant Node_Access :=
565 (if Front = null then Container.First else Front.Next);
567 if Pivot /= Back then
568 Partition (Pivot, Back);
574 -- Start of processing for Sort
577 if Container.Length <= 1 then
581 pragma Assert (Container.First.Prev = null);
582 pragma Assert (Container.Last.Next = null);
584 if Container.Busy > 0 then
585 raise Program_Error with
586 "attempt to tamper with elements (list is busy)";
589 Sort (Front => null, Back => null);
591 pragma Assert (Container.First.Prev = null);
592 pragma Assert (Container.Last.Next = null);
601 function Has_Element (Position : Cursor) return Boolean is
603 pragma Assert (Vet (Position), "bad cursor in Has_Element");
604 return Position.Node /= null;
612 (Container : in out List;
614 New_Item : Element_Type;
615 Position : out Cursor;
616 Count : Count_Type := 1)
618 New_Node : Node_Access;
621 if Before.Container /= null then
622 if Before.Container /= Container'Unrestricted_Access then
623 raise Program_Error with
624 "Before cursor designates wrong list";
627 pragma Assert (Vet (Before), "bad cursor in Insert");
635 if Container.Length > Count_Type'Last - Count then
636 raise Constraint_Error with "new length exceeds maximum";
639 if Container.Busy > 0 then
640 raise Program_Error with
641 "attempt to tamper with elements (list is busy)";
644 New_Node := new Node_Type'(New_Item, null, null);
645 Insert_Internal (Container, Before.Node, New_Node);
647 Position := Cursor'(Container'Unchecked_Access, New_Node);
649 for J in Count_Type'(2) .. Count loop
650 New_Node := new Node_Type'(New_Item, null, null);
651 Insert_Internal (Container, Before.Node, New_Node);
656 (Container : in out List;
658 New_Item : Element_Type;
659 Count : Count_Type := 1)
662 pragma Unreferenced (Position);
664 Insert (Container, Before, New_Item, Position, Count);
668 (Container : in out List;
670 Position : out Cursor;
671 Count : Count_Type := 1)
673 New_Node : Node_Access;
676 if Before.Container /= null then
677 if Before.Container /= Container'Unrestricted_Access then
678 raise Program_Error with
679 "Before cursor designates wrong list";
682 pragma Assert (Vet (Before), "bad cursor in Insert");
690 if Container.Length > Count_Type'Last - Count then
691 raise Constraint_Error with "new length exceeds maximum";
694 if Container.Busy > 0 then
695 raise Program_Error with
696 "attempt to tamper with elements (list is busy)";
699 New_Node := new Node_Type;
700 Insert_Internal (Container, Before.Node, New_Node);
702 Position := Cursor'(Container'Unchecked_Access, New_Node);
704 for J in Count_Type'(2) .. Count loop
705 New_Node := new Node_Type;
706 Insert_Internal (Container, Before.Node, New_Node);
710 ---------------------
711 -- Insert_Internal --
712 ---------------------
714 procedure Insert_Internal
715 (Container : in out List;
716 Before : Node_Access;
717 New_Node : Node_Access)
720 if Container.Length = 0 then
721 pragma Assert (Before = null);
722 pragma Assert (Container.First = null);
723 pragma Assert (Container.Last = null);
725 Container.First := New_Node;
726 Container.Last := New_Node;
728 elsif Before = null then
729 pragma Assert (Container.Last.Next = null);
731 Container.Last.Next := New_Node;
732 New_Node.Prev := Container.Last;
734 Container.Last := New_Node;
736 elsif Before = Container.First then
737 pragma Assert (Container.First.Prev = null);
739 Container.First.Prev := New_Node;
740 New_Node.Next := Container.First;
742 Container.First := New_Node;
745 pragma Assert (Container.First.Prev = null);
746 pragma Assert (Container.Last.Next = null);
748 New_Node.Next := Before;
749 New_Node.Prev := Before.Prev;
751 Before.Prev.Next := New_Node;
752 Before.Prev := New_Node;
755 Container.Length := Container.Length + 1;
762 function Is_Empty (Container : List) return Boolean is
764 return Container.Length = 0;
773 Process : not null access procedure (Position : Cursor))
775 C : List renames Container'Unrestricted_Access.all;
776 B : Natural renames C.Busy;
778 Node : Node_Access := Container.First;
784 while Node /= null loop
785 Process (Cursor'(Container'Unchecked_Access, Node));
801 function Last (Container : List) return Cursor is
803 if Container.Last = null then
807 return Cursor'(Container'Unchecked_Access, Container.Last);
814 function Last_Element (Container : List) return Element_Type is
816 if Container.Last = null then
817 raise Constraint_Error with "list is empty";
820 return Container.Last.Element;
827 function Length (Container : List) return Count_Type is
829 return Container.Length;
837 (Target : in out List;
838 Source : in out List)
841 if Target'Address = Source'Address then
845 if Source.Busy > 0 then
846 raise Program_Error with
847 "attempt to tamper with elements of Source (list is busy)";
852 Target.First := Source.First;
853 Source.First := null;
855 Target.Last := Source.Last;
858 Target.Length := Source.Length;
866 procedure Next (Position : in out Cursor) is
868 Position := Next (Position);
871 function Next (Position : Cursor) return Cursor is
873 if Position.Node = null then
877 pragma Assert (Vet (Position), "bad cursor in Next");
880 Next_Node : constant Node_Access := Position.Node.Next;
882 if Next_Node = null then
886 return Cursor'(Position.Container, Next_Node);
895 (Container : in out List;
896 New_Item : Element_Type;
897 Count : Count_Type := 1)
900 Insert (Container, First (Container), New_Item, Count);
907 procedure Previous (Position : in out Cursor) is
909 Position := Previous (Position);
912 function Previous (Position : Cursor) return Cursor is
914 if Position.Node = null then
918 pragma Assert (Vet (Position), "bad cursor in Previous");
921 Prev_Node : constant Node_Access := Position.Node.Prev;
923 if Prev_Node = null then
927 return Cursor'(Position.Container, Prev_Node);
935 procedure Query_Element
937 Process : not null access procedure (Element : Element_Type))
940 if Position.Node = null then
941 raise Constraint_Error with
942 "Position cursor has no element";
945 pragma Assert (Vet (Position), "bad cursor in Query_Element");
948 C : List renames Position.Container.all'Unrestricted_Access.all;
949 B : Natural renames C.Busy;
950 L : Natural renames C.Lock;
957 Process (Position.Node.Element);
975 (Stream : not null access Root_Stream_Type'Class;
983 Count_Type'Base'Read (Stream, N);
992 Element_Type'Read (Stream, X.Element);
1003 Item.Length := Item.Length + 1;
1004 exit when Item.Length = N;
1009 Element_Type'Read (Stream, X.Element);
1016 X.Prev := Item.Last;
1017 Item.Last.Next := X;
1023 (Stream : not null access Root_Stream_Type'Class;
1027 raise Program_Error with "attempt to stream list cursor";
1030 ---------------------
1031 -- Replace_Element --
1032 ---------------------
1034 procedure Replace_Element
1035 (Container : in out List;
1037 New_Item : Element_Type)
1040 if Position.Container = null then
1041 raise Constraint_Error with "Position cursor has no element";
1044 if Position.Container /= Container'Unchecked_Access then
1045 raise Program_Error with
1046 "Position cursor designates wrong container";
1049 if Container.Lock > 0 then
1050 raise Program_Error with
1051 "attempt to tamper with cursors (list is locked)";
1054 pragma Assert (Vet (Position), "bad cursor in Replace_Element");
1056 Position.Node.Element := New_Item;
1057 end Replace_Element;
1059 ----------------------
1060 -- Reverse_Elements --
1061 ----------------------
1063 procedure Reverse_Elements (Container : in out List) is
1064 I : Node_Access := Container.First;
1065 J : Node_Access := Container.Last;
1067 procedure Swap (L, R : Node_Access);
1073 procedure Swap (L, R : Node_Access) is
1074 LN : constant Node_Access := L.Next;
1075 LP : constant Node_Access := L.Prev;
1077 RN : constant Node_Access := R.Next;
1078 RP : constant Node_Access := R.Prev;
1093 pragma Assert (RP = L);
1107 -- Start of processing for Reverse_Elements
1110 if Container.Length <= 1 then
1114 pragma Assert (Container.First.Prev = null);
1115 pragma Assert (Container.Last.Next = null);
1117 if Container.Busy > 0 then
1118 raise Program_Error with
1119 "attempt to tamper with elements (list is busy)";
1122 Container.First := J;
1123 Container.Last := I;
1125 Swap (L => I, R => J);
1133 Swap (L => J, R => I);
1142 pragma Assert (Container.First.Prev = null);
1143 pragma Assert (Container.Last.Next = null);
1144 end Reverse_Elements;
1150 function Reverse_Find
1152 Item : Element_Type;
1153 Position : Cursor := No_Element) return Cursor
1155 Node : Node_Access := Position.Node;
1159 Node := Container.Last;
1162 if Position.Container /= Container'Unrestricted_Access then
1163 raise Program_Error with
1164 "Position cursor designates wrong container";
1167 pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
1170 while Node /= null loop
1171 if Node.Element = Item then
1172 return Cursor'(Container'Unchecked_Access, Node);
1181 ---------------------
1182 -- Reverse_Iterate --
1183 ---------------------
1185 procedure Reverse_Iterate
1187 Process : not null access procedure (Position : Cursor))
1189 C : List renames Container'Unrestricted_Access.all;
1190 B : Natural renames C.Busy;
1192 Node : Node_Access := Container.Last;
1198 while Node /= null loop
1199 Process (Cursor'(Container'Unchecked_Access, Node));
1210 end Reverse_Iterate;
1217 (Target : in out List;
1219 Source : in out List)
1222 if Before.Container /= null then
1223 if Before.Container /= Target'Unrestricted_Access then
1224 raise Program_Error with
1225 "Before cursor designates wrong container";
1228 pragma Assert (Vet (Before), "bad cursor in Splice");
1231 if Target'Address = Source'Address
1232 or else Source.Length = 0
1237 pragma Assert (Source.First.Prev = null);
1238 pragma Assert (Source.Last.Next = null);
1240 if Target.Length > Count_Type'Last - Source.Length then
1241 raise Constraint_Error with "new length exceeds maximum";
1244 if Target.Busy > 0 then
1245 raise Program_Error with
1246 "attempt to tamper with elements of Target (list is busy)";
1249 if Source.Busy > 0 then
1250 raise Program_Error with
1251 "attempt to tamper with elements of Source (list is busy)";
1254 if Target.Length = 0 then
1255 pragma Assert (Target.First = null);
1256 pragma Assert (Target.Last = null);
1257 pragma Assert (Before = No_Element);
1259 Target.First := Source.First;
1260 Target.Last := Source.Last;
1262 elsif Before.Node = null then
1263 pragma Assert (Target.Last.Next = null);
1265 Target.Last.Next := Source.First;
1266 Source.First.Prev := Target.Last;
1268 Target.Last := Source.Last;
1270 elsif Before.Node = Target.First then
1271 pragma Assert (Target.First.Prev = null);
1273 Source.Last.Next := Target.First;
1274 Target.First.Prev := Source.Last;
1276 Target.First := Source.First;
1279 pragma Assert (Target.Length >= 2);
1281 Before.Node.Prev.Next := Source.First;
1282 Source.First.Prev := Before.Node.Prev;
1284 Before.Node.Prev := Source.Last;
1285 Source.Last.Next := Before.Node;
1288 Source.First := null;
1289 Source.Last := null;
1291 Target.Length := Target.Length + Source.Length;
1296 (Container : in out List;
1301 if Before.Container /= null then
1302 if Before.Container /= Container'Unchecked_Access then
1303 raise Program_Error with
1304 "Before cursor designates wrong container";
1307 pragma Assert (Vet (Before), "bad Before cursor in Splice");
1310 if Position.Node = null then
1311 raise Constraint_Error with "Position cursor has no element";
1314 if Position.Container /= Container'Unrestricted_Access then
1315 raise Program_Error with
1316 "Position cursor designates wrong container";
1319 pragma Assert (Vet (Position), "bad Position cursor in Splice");
1321 if Position.Node = Before.Node
1322 or else Position.Node.Next = Before.Node
1327 pragma Assert (Container.Length >= 2);
1329 if Container.Busy > 0 then
1330 raise Program_Error with
1331 "attempt to tamper with elements (list is busy)";
1334 if Before.Node = null then
1335 pragma Assert (Position.Node /= Container.Last);
1337 if Position.Node = Container.First then
1338 Container.First := Position.Node.Next;
1339 Container.First.Prev := null;
1341 Position.Node.Prev.Next := Position.Node.Next;
1342 Position.Node.Next.Prev := Position.Node.Prev;
1345 Container.Last.Next := Position.Node;
1346 Position.Node.Prev := Container.Last;
1348 Container.Last := Position.Node;
1349 Container.Last.Next := null;
1354 if Before.Node = Container.First then
1355 pragma Assert (Position.Node /= Container.First);
1357 if Position.Node = Container.Last then
1358 Container.Last := Position.Node.Prev;
1359 Container.Last.Next := null;
1361 Position.Node.Prev.Next := Position.Node.Next;
1362 Position.Node.Next.Prev := Position.Node.Prev;
1365 Container.First.Prev := Position.Node;
1366 Position.Node.Next := Container.First;
1368 Container.First := Position.Node;
1369 Container.First.Prev := null;
1374 if Position.Node = Container.First then
1375 Container.First := Position.Node.Next;
1376 Container.First.Prev := null;
1378 elsif Position.Node = Container.Last then
1379 Container.Last := Position.Node.Prev;
1380 Container.Last.Next := null;
1383 Position.Node.Prev.Next := Position.Node.Next;
1384 Position.Node.Next.Prev := Position.Node.Prev;
1387 Before.Node.Prev.Next := Position.Node;
1388 Position.Node.Prev := Before.Node.Prev;
1390 Before.Node.Prev := Position.Node;
1391 Position.Node.Next := Before.Node;
1393 pragma Assert (Container.First.Prev = null);
1394 pragma Assert (Container.Last.Next = null);
1398 (Target : in out List;
1400 Source : in out List;
1401 Position : in out Cursor)
1404 if Target'Address = Source'Address then
1405 Splice (Target, Before, Position);
1409 if Before.Container /= null then
1410 if Before.Container /= Target'Unrestricted_Access then
1411 raise Program_Error with
1412 "Before cursor designates wrong container";
1415 pragma Assert (Vet (Before), "bad Before cursor in Splice");
1418 if Position.Node = null then
1419 raise Constraint_Error with "Position cursor has no element";
1422 if Position.Container /= Source'Unrestricted_Access then
1423 raise Program_Error with
1424 "Position cursor designates wrong container";
1427 pragma Assert (Vet (Position), "bad Position cursor in Splice");
1429 if Target.Length = Count_Type'Last then
1430 raise Constraint_Error with "Target is full";
1433 if Target.Busy > 0 then
1434 raise Program_Error with
1435 "attempt to tamper with elements of Target (list is busy)";
1438 if Source.Busy > 0 then
1439 raise Program_Error with
1440 "attempt to tamper with elements of Source (list is busy)";
1443 if Position.Node = Source.First then
1444 Source.First := Position.Node.Next;
1446 if Position.Node = Source.Last then
1447 pragma Assert (Source.First = null);
1448 pragma Assert (Source.Length = 1);
1449 Source.Last := null;
1452 Source.First.Prev := null;
1455 elsif Position.Node = Source.Last then
1456 pragma Assert (Source.Length >= 2);
1457 Source.Last := Position.Node.Prev;
1458 Source.Last.Next := null;
1461 pragma Assert (Source.Length >= 3);
1462 Position.Node.Prev.Next := Position.Node.Next;
1463 Position.Node.Next.Prev := Position.Node.Prev;
1466 if Target.Length = 0 then
1467 pragma Assert (Target.First = null);
1468 pragma Assert (Target.Last = null);
1469 pragma Assert (Before = No_Element);
1471 Target.First := Position.Node;
1472 Target.Last := Position.Node;
1474 Target.First.Prev := null;
1475 Target.Last.Next := null;
1477 elsif Before.Node = null then
1478 pragma Assert (Target.Last.Next = null);
1479 Target.Last.Next := Position.Node;
1480 Position.Node.Prev := Target.Last;
1482 Target.Last := Position.Node;
1483 Target.Last.Next := null;
1485 elsif Before.Node = Target.First then
1486 pragma Assert (Target.First.Prev = null);
1487 Target.First.Prev := Position.Node;
1488 Position.Node.Next := Target.First;
1490 Target.First := Position.Node;
1491 Target.First.Prev := null;
1494 pragma Assert (Target.Length >= 2);
1495 Before.Node.Prev.Next := Position.Node;
1496 Position.Node.Prev := Before.Node.Prev;
1498 Before.Node.Prev := Position.Node;
1499 Position.Node.Next := Before.Node;
1502 Target.Length := Target.Length + 1;
1503 Source.Length := Source.Length - 1;
1505 Position.Container := Target'Unchecked_Access;
1513 (Container : in out List;
1517 if I.Node = null then
1518 raise Constraint_Error with "I cursor has no element";
1521 if J.Node = null then
1522 raise Constraint_Error with "J cursor has no element";
1525 if I.Container /= Container'Unchecked_Access then
1526 raise Program_Error with "I cursor designates wrong container";
1529 if J.Container /= Container'Unchecked_Access then
1530 raise Program_Error with "J cursor designates wrong container";
1533 if I.Node = J.Node then
1537 if Container.Lock > 0 then
1538 raise Program_Error with
1539 "attempt to tamper with cursors (list is locked)";
1542 pragma Assert (Vet (I), "bad I cursor in Swap");
1543 pragma Assert (Vet (J), "bad J cursor in Swap");
1546 EI : Element_Type renames I.Node.Element;
1547 EJ : Element_Type renames J.Node.Element;
1549 EI_Copy : constant Element_Type := EI;
1561 procedure Swap_Links
1562 (Container : in out List;
1566 if I.Node = null then
1567 raise Constraint_Error with "I cursor has no element";
1570 if J.Node = null then
1571 raise Constraint_Error with "J cursor has no element";
1574 if I.Container /= Container'Unrestricted_Access then
1575 raise Program_Error with "I cursor designates wrong container";
1578 if J.Container /= Container'Unrestricted_Access then
1579 raise Program_Error with "J cursor designates wrong container";
1582 if I.Node = J.Node then
1586 if Container.Busy > 0 then
1587 raise Program_Error with
1588 "attempt to tamper with elements (list is busy)";
1591 pragma Assert (Vet (I), "bad I cursor in Swap_Links");
1592 pragma Assert (Vet (J), "bad J cursor in Swap_Links");
1595 I_Next : constant Cursor := Next (I);
1599 Splice (Container, Before => I, Position => J);
1603 J_Next : constant Cursor := Next (J);
1607 Splice (Container, Before => J, Position => I);
1610 pragma Assert (Container.Length >= 3);
1612 Splice (Container, Before => I_Next, Position => J);
1613 Splice (Container, Before => J_Next, Position => I);
1620 --------------------
1621 -- Update_Element --
1622 --------------------
1624 procedure Update_Element
1625 (Container : in out List;
1627 Process : not null access procedure (Element : in out Element_Type))
1630 if Position.Node = null then
1631 raise Constraint_Error with "Position cursor has no element";
1634 if Position.Container /= Container'Unchecked_Access then
1635 raise Program_Error with
1636 "Position cursor designates wrong container";
1639 pragma Assert (Vet (Position), "bad cursor in Update_Element");
1642 B : Natural renames Container.Busy;
1643 L : Natural renames Container.Lock;
1650 Process (Position.Node.Element);
1667 function Vet (Position : Cursor) return Boolean is
1669 if Position.Node = null then
1670 return Position.Container = null;
1673 if Position.Container = null then
1677 if Position.Node.Next = Position.Node then
1681 if Position.Node.Prev = Position.Node then
1686 L : List renames Position.Container.all;
1688 if L.Length = 0 then
1692 if L.First = null then
1696 if L.Last = null then
1700 if L.First.Prev /= null then
1704 if L.Last.Next /= null then
1708 if Position.Node.Prev = null
1709 and then Position.Node /= L.First
1714 -- If we get here, we know that this disjunction is true:
1715 -- Position.Node.Prev /= null or else Position.Node = L.First
1717 if Position.Node.Next = null
1718 and then Position.Node /= L.Last
1723 -- If we get here, we know that this disjunction is true:
1724 -- Position.Node.Next /= null or else Position.Node = L.Last
1726 if L.Length = 1 then
1727 return L.First = L.Last;
1730 if L.First = L.Last then
1734 if L.First.Next = null then
1738 if L.Last.Prev = null then
1742 if L.First.Next.Prev /= L.First then
1746 if L.Last.Prev.Next /= L.Last then
1750 if L.Length = 2 then
1751 if L.First.Next /= L.Last then
1755 if L.Last.Prev /= L.First then
1762 if L.First.Next = L.Last then
1766 if L.Last.Prev = L.First then
1770 if Position.Node = L.First then -- eliminates ealier disjunct
1774 -- If we get here, we know, per disjunctive syllogism (modus
1775 -- tollendo ponens), that this predicate is true:
1776 -- Position.Node.Prev /= null
1778 if Position.Node = L.Last then -- eliminates earlier disjunct
1782 -- If we get here, we know, per disjunctive syllogism (modus
1783 -- tollendo ponens), that this predicate is true:
1784 -- Position.Node.Next /= null
1786 if Position.Node.Next.Prev /= Position.Node then
1790 if Position.Node.Prev.Next /= Position.Node then
1794 if L.Length = 3 then
1795 if L.First.Next /= Position.Node then
1799 if L.Last.Prev /= Position.Node then
1813 (Stream : not null access Root_Stream_Type'Class;
1816 Node : Node_Access := Item.First;
1819 Count_Type'Base'Write (Stream, Item.Length);
1821 while Node /= null loop
1822 Element_Type'Write (Stream, Node.Element);
1828 (Stream : not null access Root_Stream_Type'Class;
1832 raise Program_Error with "attempt to stream list cursor";
1835 end Ada.Containers.Doubly_Linked_Lists;