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
568 Pivot
:= Container
.First
;
573 if Pivot
/= Back
then
574 Partition
(Pivot
, Back
);
580 -- Start of processing for Sort
583 if Container
.Length
<= 1 then
587 pragma Assert
(Container
.First
.Prev
= null);
588 pragma Assert
(Container
.Last
.Next
= null);
590 if Container
.Busy
> 0 then
591 raise Program_Error
with
592 "attempt to tamper with elements (list is busy)";
595 Sort
(Front
=> null, Back
=> null);
597 pragma Assert
(Container
.First
.Prev
= null);
598 pragma Assert
(Container
.Last
.Next
= null);
607 function Has_Element
(Position
: Cursor
) return Boolean is
609 pragma Assert
(Vet
(Position
), "bad cursor in Has_Element");
610 return Position
.Node
/= null;
618 (Container
: in out List
;
620 New_Item
: Element_Type
;
621 Position
: out Cursor
;
622 Count
: Count_Type
:= 1)
624 New_Node
: Node_Access
;
627 if Before
.Container
/= null then
628 if Before
.Container
/= Container
'Unrestricted_Access then
629 raise Program_Error
with
630 "attempt to tamper with elements (list is busy)";
633 pragma Assert
(Vet
(Before
), "bad cursor in Insert");
641 if Container
.Length
> Count_Type
'Last - Count
then
642 raise Constraint_Error
with "new length exceeds maximum";
645 if Container
.Busy
> 0 then
646 raise Program_Error
with
647 "attempt to tamper with elements (list is busy)";
650 New_Node
:= new Node_Type
'(New_Item, null, null);
651 Insert_Internal (Container, Before.Node, New_Node);
653 Position := Cursor'(Container
'Unchecked_Access, New_Node
);
655 for J
in Count_Type
'(2) .. Count loop
656 New_Node := new Node_Type'(New_Item
, null, null);
657 Insert_Internal
(Container
, Before
.Node
, New_Node
);
662 (Container
: in out List
;
664 New_Item
: Element_Type
;
665 Count
: Count_Type
:= 1)
668 pragma Unreferenced
(Position
);
670 Insert
(Container
, Before
, New_Item
, Position
, Count
);
674 (Container
: in out List
;
676 Position
: out Cursor
;
677 Count
: Count_Type
:= 1)
679 New_Node
: Node_Access
;
682 if Before
.Container
/= null then
683 if Before
.Container
/= Container
'Unrestricted_Access then
684 raise Program_Error
with
685 "Before cursor designates wrong list";
688 pragma Assert
(Vet
(Before
), "bad cursor in Insert");
696 if Container
.Length
> Count_Type
'Last - Count
then
697 raise Constraint_Error
with "new length exceeds maximum";
700 if Container
.Busy
> 0 then
701 raise Program_Error
with
702 "attempt to tamper with elements (list is busy)";
705 New_Node
:= new Node_Type
;
706 Insert_Internal
(Container
, Before
.Node
, New_Node
);
708 Position
:= Cursor
'(Container'Unchecked_Access, New_Node);
710 for J in Count_Type'(2) .. Count
loop
711 New_Node
:= new Node_Type
;
712 Insert_Internal
(Container
, Before
.Node
, New_Node
);
716 ---------------------
717 -- Insert_Internal --
718 ---------------------
720 procedure Insert_Internal
721 (Container
: in out List
;
722 Before
: Node_Access
;
723 New_Node
: Node_Access
)
726 if Container
.Length
= 0 then
727 pragma Assert
(Before
= null);
728 pragma Assert
(Container
.First
= null);
729 pragma Assert
(Container
.Last
= null);
731 Container
.First
:= New_Node
;
732 Container
.Last
:= New_Node
;
734 elsif Before
= null then
735 pragma Assert
(Container
.Last
.Next
= null);
737 Container
.Last
.Next
:= New_Node
;
738 New_Node
.Prev
:= Container
.Last
;
740 Container
.Last
:= New_Node
;
742 elsif Before
= Container
.First
then
743 pragma Assert
(Container
.First
.Prev
= null);
745 Container
.First
.Prev
:= New_Node
;
746 New_Node
.Next
:= Container
.First
;
748 Container
.First
:= New_Node
;
751 pragma Assert
(Container
.First
.Prev
= null);
752 pragma Assert
(Container
.Last
.Next
= null);
754 New_Node
.Next
:= Before
;
755 New_Node
.Prev
:= Before
.Prev
;
757 Before
.Prev
.Next
:= New_Node
;
758 Before
.Prev
:= New_Node
;
761 Container
.Length
:= Container
.Length
+ 1;
768 function Is_Empty
(Container
: List
) return Boolean is
770 return Container
.Length
= 0;
779 Process
: not null access procedure (Position
: Cursor
))
781 C
: List
renames Container
'Unrestricted_Access.all;
782 B
: Natural renames C
.Busy
;
784 Node
: Node_Access
:= Container
.First
;
790 while Node
/= null loop
791 Process
(Cursor
'(Container'Unchecked_Access, Node));
807 function Last (Container : List) return Cursor is
809 if Container.Last = null then
813 return Cursor'(Container
'Unchecked_Access, Container
.Last
);
820 function Last_Element
(Container
: List
) return Element_Type
is
822 if Container
.Last
= null then
823 raise Constraint_Error
with "list is empty";
826 return Container
.Last
.Element
;
833 function Length
(Container
: List
) return Count_Type
is
835 return Container
.Length
;
843 (Target
: in out List
;
844 Source
: in out List
)
847 if Target
'Address = Source
'Address then
851 if Source
.Busy
> 0 then
852 raise Program_Error
with
853 "attempt to tamper with elements of Source (list is busy)";
858 Target
.First
:= Source
.First
;
859 Source
.First
:= null;
861 Target
.Last
:= Source
.Last
;
864 Target
.Length
:= Source
.Length
;
872 procedure Next
(Position
: in out Cursor
) is
874 Position
:= Next
(Position
);
877 function Next
(Position
: Cursor
) return Cursor
is
879 if Position
.Node
= null then
883 pragma Assert
(Vet
(Position
), "bad cursor in Next");
886 Next_Node
: constant Node_Access
:= Position
.Node
.Next
;
888 if Next_Node
= null then
892 return Cursor
'(Position.Container, Next_Node);
901 (Container : in out List;
902 New_Item : Element_Type;
903 Count : Count_Type := 1)
906 Insert (Container, First (Container), New_Item, Count);
913 procedure Previous (Position : in out Cursor) is
915 Position := Previous (Position);
918 function Previous (Position : Cursor) return Cursor is
920 if Position.Node = null then
924 pragma Assert (Vet (Position), "bad cursor in Previous");
927 Prev_Node : constant Node_Access := Position.Node.Prev;
929 if Prev_Node = null then
933 return Cursor'(Position
.Container
, Prev_Node
);
941 procedure Query_Element
943 Process
: not null access procedure (Element
: Element_Type
))
946 if Position
.Node
= null then
947 raise Constraint_Error
with
948 "Position cursor has no element";
951 pragma Assert
(Vet
(Position
), "bad cursor in Query_Element");
954 C
: List
renames Position
.Container
.all'Unrestricted_Access.all;
955 B
: Natural renames C
.Busy
;
956 L
: Natural renames C
.Lock
;
963 Process
(Position
.Node
.Element
);
981 (Stream
: not null access Root_Stream_Type
'Class;
989 Count_Type
'Base'Read (Stream, N);
998 Element_Type'Read (Stream, X.Element);
1009 Item.Length := Item.Length + 1;
1010 exit when Item.Length = N;
1015 Element_Type'Read (Stream, X.Element);
1022 X.Prev := Item.Last;
1023 Item.Last.Next := X;
1029 (Stream : not null access Root_Stream_Type'Class;
1033 raise Program_Error with "attempt to stream list cursor";
1036 ---------------------
1037 -- Replace_Element --
1038 ---------------------
1040 procedure Replace_Element
1041 (Container : in out List;
1043 New_Item : Element_Type)
1046 if Position.Container = null then
1047 raise Constraint_Error with "Position cursor has no element";
1050 if Position.Container /= Container'Unchecked_Access then
1051 raise Program_Error with
1052 "Position cursor designates wrong container";
1055 if Container.Lock > 0 then
1056 raise Program_Error with
1057 "attempt to tamper with cursors (list is locked)";
1060 pragma Assert (Vet (Position), "bad cursor in Replace_Element");
1062 Position.Node.Element := New_Item;
1063 end Replace_Element;
1065 ----------------------
1066 -- Reverse_Elements --
1067 ----------------------
1069 procedure Reverse_Elements (Container : in out List) is
1070 I : Node_Access := Container.First;
1071 J : Node_Access := Container.Last;
1073 procedure Swap (L, R : Node_Access);
1079 procedure Swap (L, R : Node_Access) is
1080 LN : constant Node_Access := L.Next;
1081 LP : constant Node_Access := L.Prev;
1083 RN : constant Node_Access := R.Next;
1084 RP : constant Node_Access := R.Prev;
1099 pragma Assert (RP = L);
1113 -- Start of processing for Reverse_Elements
1116 if Container.Length <= 1 then
1120 pragma Assert (Container.First.Prev = null);
1121 pragma Assert (Container.Last.Next = null);
1123 if Container.Busy > 0 then
1124 raise Program_Error with
1125 "attempt to tamper with elements (list is busy)";
1128 Container.First := J;
1129 Container.Last := I;
1131 Swap (L => I, R => J);
1139 Swap (L => J, R => I);
1148 pragma Assert (Container.First.Prev = null);
1149 pragma Assert (Container.Last.Next = null);
1150 end Reverse_Elements;
1156 function Reverse_Find
1158 Item : Element_Type;
1159 Position : Cursor := No_Element) return Cursor
1161 Node : Node_Access := Position.Node;
1165 Node := Container.Last;
1168 if Position.Container /= Container'Unrestricted_Access then
1169 raise Program_Error with
1170 "Position cursor designates wrong container";
1173 pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
1176 while Node /= null loop
1177 if Node.Element = Item then
1178 return Cursor'(Container
'Unchecked_Access, Node
);
1187 ---------------------
1188 -- Reverse_Iterate --
1189 ---------------------
1191 procedure Reverse_Iterate
1193 Process
: not null access procedure (Position
: Cursor
))
1195 C
: List
renames Container
'Unrestricted_Access.all;
1196 B
: Natural renames C
.Busy
;
1198 Node
: Node_Access
:= Container
.Last
;
1204 while Node
/= null loop
1205 Process
(Cursor
'(Container'Unchecked_Access, Node));
1216 end Reverse_Iterate;
1223 (Target : in out List;
1225 Source : in out List)
1228 if Before.Container /= null then
1229 if Before.Container /= Target'Unrestricted_Access then
1230 raise Program_Error with
1231 "Before cursor designates wrong container";
1234 pragma Assert (Vet (Before), "bad cursor in Splice");
1237 if Target'Address = Source'Address
1238 or else Source.Length = 0
1243 pragma Assert (Source.First.Prev = null);
1244 pragma Assert (Source.Last.Next = null);
1246 if Target.Length > Count_Type'Last - Source.Length then
1247 raise Constraint_Error with "new length exceeds maximum";
1250 if Target.Busy > 0 then
1251 raise Program_Error with
1252 "attempt to tamper with elements of Target (list is busy)";
1255 if Source.Busy > 0 then
1256 raise Program_Error with
1257 "attempt to tamper with elements of Source (list is busy)";
1260 if Target.Length = 0 then
1261 pragma Assert (Target.First = null);
1262 pragma Assert (Target.Last = null);
1263 pragma Assert (Before = No_Element);
1265 Target.First := Source.First;
1266 Target.Last := Source.Last;
1268 elsif Before.Node = null then
1269 pragma Assert (Target.Last.Next = null);
1271 Target.Last.Next := Source.First;
1272 Source.First.Prev := Target.Last;
1274 Target.Last := Source.Last;
1276 elsif Before.Node = Target.First then
1277 pragma Assert (Target.First.Prev = null);
1279 Source.Last.Next := Target.First;
1280 Target.First.Prev := Source.Last;
1282 Target.First := Source.First;
1285 pragma Assert (Target.Length >= 2);
1287 Before.Node.Prev.Next := Source.First;
1288 Source.First.Prev := Before.Node.Prev;
1290 Before.Node.Prev := Source.Last;
1291 Source.Last.Next := Before.Node;
1294 Source.First := null;
1295 Source.Last := null;
1297 Target.Length := Target.Length + Source.Length;
1302 (Container : in out List;
1307 if Before.Container /= null then
1308 if Before.Container /= Container'Unchecked_Access then
1309 raise Program_Error with
1310 "Before cursor designates wrong container";
1313 pragma Assert (Vet (Before), "bad Before cursor in Splice");
1316 if Position.Node = null then
1317 raise Constraint_Error with "Position cursor has no element";
1320 if Position.Container /= Container'Unrestricted_Access then
1321 raise Program_Error with
1322 "Position cursor designates wrong container";
1325 pragma Assert (Vet (Position), "bad Position cursor in Splice");
1327 if Position.Node = Before.Node
1328 or else Position.Node.Next = Before.Node
1333 pragma Assert (Container.Length >= 2);
1335 if Container.Busy > 0 then
1336 raise Program_Error with
1337 "attempt to tamper with elements (list is busy)";
1340 if Before.Node = null then
1341 pragma Assert (Position.Node /= Container.Last);
1343 if Position.Node = Container.First then
1344 Container.First := Position.Node.Next;
1345 Container.First.Prev := null;
1347 Position.Node.Prev.Next := Position.Node.Next;
1348 Position.Node.Next.Prev := Position.Node.Prev;
1351 Container.Last.Next := Position.Node;
1352 Position.Node.Prev := Container.Last;
1354 Container.Last := Position.Node;
1355 Container.Last.Next := null;
1360 if Before.Node = Container.First then
1361 pragma Assert (Position.Node /= Container.First);
1363 if Position.Node = Container.Last then
1364 Container.Last := Position.Node.Prev;
1365 Container.Last.Next := null;
1367 Position.Node.Prev.Next := Position.Node.Next;
1368 Position.Node.Next.Prev := Position.Node.Prev;
1371 Container.First.Prev := Position.Node;
1372 Position.Node.Next := Container.First;
1374 Container.First := Position.Node;
1375 Container.First.Prev := null;
1380 if Position.Node = Container.First then
1381 Container.First := Position.Node.Next;
1382 Container.First.Prev := null;
1384 elsif Position.Node = Container.Last then
1385 Container.Last := Position.Node.Prev;
1386 Container.Last.Next := null;
1389 Position.Node.Prev.Next := Position.Node.Next;
1390 Position.Node.Next.Prev := Position.Node.Prev;
1393 Before.Node.Prev.Next := Position.Node;
1394 Position.Node.Prev := Before.Node.Prev;
1396 Before.Node.Prev := Position.Node;
1397 Position.Node.Next := Before.Node;
1399 pragma Assert (Container.First.Prev = null);
1400 pragma Assert (Container.Last.Next = null);
1404 (Target : in out List;
1406 Source : in out List;
1407 Position : in out Cursor)
1410 if Target'Address = Source'Address then
1411 Splice (Target, Before, Position);
1415 if Before.Container /= null then
1416 if Before.Container /= Target'Unrestricted_Access then
1417 raise Program_Error with
1418 "Before cursor designates wrong container";
1421 pragma Assert (Vet (Before), "bad Before cursor in Splice");
1424 if Position.Node = null then
1425 raise Constraint_Error with "Position cursor has no element";
1428 if Position.Container /= Source'Unrestricted_Access then
1429 raise Program_Error with
1430 "Position cursor designates wrong container";
1433 pragma Assert (Vet (Position), "bad Position cursor in Splice");
1435 if Target.Length = Count_Type'Last then
1436 raise Constraint_Error with "Target is full";
1439 if Target.Busy > 0 then
1440 raise Program_Error with
1441 "attempt to tamper with elements of Target (list is busy)";
1444 if Source.Busy > 0 then
1445 raise Program_Error with
1446 "attempt to tamper with elements of Source (list is busy)";
1449 if Position.Node = Source.First then
1450 Source.First := Position.Node.Next;
1452 if Position.Node = Source.Last then
1453 pragma Assert (Source.First = null);
1454 pragma Assert (Source.Length = 1);
1455 Source.Last := null;
1458 Source.First.Prev := null;
1461 elsif Position.Node = Source.Last then
1462 pragma Assert (Source.Length >= 2);
1463 Source.Last := Position.Node.Prev;
1464 Source.Last.Next := null;
1467 pragma Assert (Source.Length >= 3);
1468 Position.Node.Prev.Next := Position.Node.Next;
1469 Position.Node.Next.Prev := Position.Node.Prev;
1472 if Target.Length = 0 then
1473 pragma Assert (Target.First = null);
1474 pragma Assert (Target.Last = null);
1475 pragma Assert (Before = No_Element);
1477 Target.First := Position.Node;
1478 Target.Last := Position.Node;
1480 Target.First.Prev := null;
1481 Target.Last.Next := null;
1483 elsif Before.Node = null then
1484 pragma Assert (Target.Last.Next = null);
1485 Target.Last.Next := Position.Node;
1486 Position.Node.Prev := Target.Last;
1488 Target.Last := Position.Node;
1489 Target.Last.Next := null;
1491 elsif Before.Node = Target.First then
1492 pragma Assert (Target.First.Prev = null);
1493 Target.First.Prev := Position.Node;
1494 Position.Node.Next := Target.First;
1496 Target.First := Position.Node;
1497 Target.First.Prev := null;
1500 pragma Assert (Target.Length >= 2);
1501 Before.Node.Prev.Next := Position.Node;
1502 Position.Node.Prev := Before.Node.Prev;
1504 Before.Node.Prev := Position.Node;
1505 Position.Node.Next := Before.Node;
1508 Target.Length := Target.Length + 1;
1509 Source.Length := Source.Length - 1;
1511 Position.Container := Target'Unchecked_Access;
1519 (Container : in out List;
1523 if I.Node = null then
1524 raise Constraint_Error with "I cursor has no element";
1527 if J.Node = null then
1528 raise Constraint_Error with "J cursor has no element";
1531 if I.Container /= Container'Unchecked_Access then
1532 raise Program_Error with "I cursor designates wrong container";
1535 if J.Container /= Container'Unchecked_Access then
1536 raise Program_Error with "J cursor designates wrong container";
1539 if I.Node = J.Node then
1543 if Container.Lock > 0 then
1544 raise Program_Error with
1545 "attempt to tamper with cursors (list is locked)";
1548 pragma Assert (Vet (I), "bad I cursor in Swap");
1549 pragma Assert (Vet (J), "bad J cursor in Swap");
1552 EI : Element_Type renames I.Node.Element;
1553 EJ : Element_Type renames J.Node.Element;
1555 EI_Copy : constant Element_Type := EI;
1567 procedure Swap_Links
1568 (Container : in out List;
1572 if I.Node = null then
1573 raise Constraint_Error with "I cursor has no element";
1576 if J.Node = null then
1577 raise Constraint_Error with "J cursor has no element";
1580 if I.Container /= Container'Unrestricted_Access then
1581 raise Program_Error with "I cursor designates wrong container";
1584 if J.Container /= Container'Unrestricted_Access then
1585 raise Program_Error with "J cursor designates wrong container";
1588 if I.Node = J.Node then
1592 if Container.Busy > 0 then
1593 raise Program_Error with
1594 "attempt to tamper with elements (list is busy)";
1597 pragma Assert (Vet (I), "bad I cursor in Swap_Links");
1598 pragma Assert (Vet (J), "bad J cursor in Swap_Links");
1601 I_Next : constant Cursor := Next (I);
1605 Splice (Container, Before => I, Position => J);
1609 J_Next : constant Cursor := Next (J);
1613 Splice (Container, Before => J, Position => I);
1616 pragma Assert (Container.Length >= 3);
1618 Splice (Container, Before => I_Next, Position => J);
1619 Splice (Container, Before => J_Next, Position => I);
1626 --------------------
1627 -- Update_Element --
1628 --------------------
1630 procedure Update_Element
1631 (Container : in out List;
1633 Process : not null access procedure (Element : in out Element_Type))
1636 if Position.Node = null then
1637 raise Constraint_Error with "Position cursor has no element";
1640 if Position.Container /= Container'Unchecked_Access then
1641 raise Program_Error with
1642 "Position cursor designates wrong container";
1645 pragma Assert (Vet (Position), "bad cursor in Update_Element");
1648 B : Natural renames Container.Busy;
1649 L : Natural renames Container.Lock;
1656 Process (Position.Node.Element);
1673 function Vet (Position : Cursor) return Boolean is
1675 if Position.Node = null then
1676 return Position.Container = null;
1679 if Position.Container = null then
1683 if Position.Node.Next = Position.Node then
1687 if Position.Node.Prev = Position.Node then
1692 L : List renames Position.Container.all;
1694 if L.Length = 0 then
1698 if L.First = null then
1702 if L.Last = null then
1706 if L.First.Prev /= null then
1710 if L.Last.Next /= null then
1714 if Position.Node.Prev = null
1715 and then Position.Node /= L.First
1720 if Position.Node.Next = null
1721 and then 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
1774 if Position.Node = L.Last then
1778 if Position.Node.Next = null then
1782 if Position.Node.Prev = null then
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
;