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-2006, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- This unit was originally developed by Matthew J Heaney. --
30 ------------------------------------------------------------------------------
32 with System
; use type System
.Address
;
34 with Ada
.Unchecked_Deallocation
;
36 package body Ada
.Containers
.Doubly_Linked_Lists
is
38 -----------------------
39 -- Local Subprograms --
40 -----------------------
42 procedure Free
(X
: in out Node_Access
);
44 procedure Insert_Internal
45 (Container
: in out List
;
47 New_Node
: Node_Access
);
49 function Vet
(Position
: Cursor
) return Boolean;
55 function "=" (Left
, Right
: List
) return Boolean is
56 L
: Node_Access
:= Left
.First
;
57 R
: Node_Access
:= Right
.First
;
60 if Left
'Address = Right
'Address then
64 if Left
.Length
/= Right
.Length
then
68 for J
in 1 .. Left
.Length
loop
69 if L
.Element
/= R
.Element
then
84 procedure Adjust
(Container
: in out List
) is
85 Src
: Node_Access
:= Container
.First
;
89 pragma Assert
(Container
.Last
= null);
90 pragma Assert
(Container
.Length
= 0);
91 pragma Assert
(Container
.Busy
= 0);
92 pragma Assert
(Container
.Lock
= 0);
96 pragma Assert
(Container
.First
.Prev
= null);
97 pragma Assert
(Container
.Last
.Next
= null);
98 pragma Assert
(Container
.Length
> 0);
100 Container
.First
:= null;
101 Container
.Last
:= null;
102 Container
.Length
:= 0;
106 Container
.First
:= new Node_Type
'(Src.Element, null, null);
107 Container.Last := Container.First;
108 Container.Length := 1;
111 while Src /= null loop
112 Container.Last.Next := new Node_Type'(Element
=> Src
.Element
,
113 Prev
=> Container
.Last
,
115 Container
.Last
:= Container
.Last
.Next
;
116 Container
.Length
:= Container
.Length
+ 1;
127 (Container
: in out List
;
128 New_Item
: Element_Type
;
129 Count
: Count_Type
:= 1)
132 Insert
(Container
, No_Element
, New_Item
, Count
);
139 procedure Clear
(Container
: in out List
) is
143 if Container
.Length
= 0 then
144 pragma Assert
(Container
.First
= null);
145 pragma Assert
(Container
.Last
= null);
146 pragma Assert
(Container
.Busy
= 0);
147 pragma Assert
(Container
.Lock
= 0);
151 pragma Assert
(Container
.First
.Prev
= null);
152 pragma Assert
(Container
.Last
.Next
= null);
154 if Container
.Busy
> 0 then
155 raise Program_Error
with
156 "attempt to tamper with elements (list is busy)";
159 while Container
.Length
> 1 loop
160 X
:= Container
.First
;
161 pragma Assert
(X
.Next
.Prev
= Container
.First
);
163 Container
.First
:= X
.Next
;
164 Container
.First
.Prev
:= null;
166 Container
.Length
:= Container
.Length
- 1;
171 X
:= Container
.First
;
172 pragma Assert
(X
= Container
.Last
);
174 Container
.First
:= null;
175 Container
.Last
:= null;
176 Container
.Length
:= 0;
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
495 RI
.Node
:= RI
.Node
.Next
;
496 Splice
(Target
, LI
, Source
, RJ
);
500 LI
.Node
:= LI
.Node
.Next
;
509 procedure Sort
(Container
: in out List
) is
511 procedure Partition
(Pivot
: Node_Access
; Back
: Node_Access
);
513 procedure Sort
(Front
, Back
: Node_Access
);
519 procedure Partition
(Pivot
: Node_Access
; Back
: Node_Access
) is
520 Node
: Node_Access
:= Pivot
.Next
;
523 while Node
/= Back
loop
524 if Node
.Element
< Pivot
.Element
then
526 Prev
: constant Node_Access
:= Node
.Prev
;
527 Next
: constant Node_Access
:= Node
.Next
;
533 Container
.Last
:= Prev
;
539 Node
.Prev
:= Pivot
.Prev
;
543 if Node
.Prev
= null then
544 Container
.First
:= Node
;
546 Node
.Prev
.Next
:= Node
;
562 procedure Sort
(Front
, Back
: Node_Access
) is
567 Pivot
:= Container
.First
;
572 if Pivot
/= Back
then
573 Partition
(Pivot
, Back
);
579 -- Start of processing for Sort
582 if Container
.Length
<= 1 then
586 pragma Assert
(Container
.First
.Prev
= null);
587 pragma Assert
(Container
.Last
.Next
= null);
589 if Container
.Busy
> 0 then
590 raise Program_Error
with
591 "attempt to tamper with elements (list is busy)";
594 Sort
(Front
=> null, Back
=> null);
596 pragma Assert
(Container
.First
.Prev
= null);
597 pragma Assert
(Container
.Last
.Next
= null);
606 function Has_Element
(Position
: Cursor
) return Boolean is
608 pragma Assert
(Vet
(Position
), "bad cursor in Has_Element");
609 return Position
.Node
/= null;
617 (Container
: in out List
;
619 New_Item
: Element_Type
;
620 Position
: out Cursor
;
621 Count
: Count_Type
:= 1)
623 New_Node
: Node_Access
;
626 if Before
.Container
/= null then
627 if Before
.Container
/= Container
'Unrestricted_Access then
628 raise Program_Error
with
629 "attempt to tamper with elements (list is busy)";
632 pragma Assert
(Vet
(Before
), "bad cursor in Insert");
640 if Container
.Length
> Count_Type
'Last - Count
then
641 raise Constraint_Error
with "new length exceeds maximum";
644 if Container
.Busy
> 0 then
645 raise Program_Error
with
646 "attempt to tamper with elements (list is busy)";
649 New_Node
:= new Node_Type
'(New_Item, null, null);
650 Insert_Internal (Container, Before.Node, New_Node);
652 Position := Cursor'(Container
'Unchecked_Access, New_Node
);
654 for J
in Count_Type
'(2) .. Count loop
655 New_Node := new Node_Type'(New_Item
, null, null);
656 Insert_Internal
(Container
, Before
.Node
, New_Node
);
661 (Container
: in out List
;
663 New_Item
: Element_Type
;
664 Count
: Count_Type
:= 1)
668 Insert
(Container
, Before
, New_Item
, Position
, Count
);
672 (Container
: in out List
;
674 Position
: out Cursor
;
675 Count
: Count_Type
:= 1)
677 New_Node
: Node_Access
;
680 if Before
.Container
/= null then
681 if Before
.Container
/= Container
'Unrestricted_Access then
682 raise Program_Error
with
683 "Before cursor designates wrong list";
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)";
703 New_Node
:= new Node_Type
;
704 Insert_Internal
(Container
, Before
.Node
, New_Node
);
706 Position
:= Cursor
'(Container'Unchecked_Access, New_Node);
708 for J in Count_Type'(2) .. Count
loop
709 New_Node
:= new Node_Type
;
710 Insert_Internal
(Container
, Before
.Node
, New_Node
);
714 ---------------------
715 -- Insert_Internal --
716 ---------------------
718 procedure Insert_Internal
719 (Container
: in out List
;
720 Before
: Node_Access
;
721 New_Node
: Node_Access
)
724 if Container
.Length
= 0 then
725 pragma Assert
(Before
= null);
726 pragma Assert
(Container
.First
= null);
727 pragma Assert
(Container
.Last
= null);
729 Container
.First
:= New_Node
;
730 Container
.Last
:= New_Node
;
732 elsif Before
= null then
733 pragma Assert
(Container
.Last
.Next
= null);
735 Container
.Last
.Next
:= New_Node
;
736 New_Node
.Prev
:= Container
.Last
;
738 Container
.Last
:= New_Node
;
740 elsif Before
= Container
.First
then
741 pragma Assert
(Container
.First
.Prev
= null);
743 Container
.First
.Prev
:= New_Node
;
744 New_Node
.Next
:= Container
.First
;
746 Container
.First
:= New_Node
;
749 pragma Assert
(Container
.First
.Prev
= null);
750 pragma Assert
(Container
.Last
.Next
= null);
752 New_Node
.Next
:= Before
;
753 New_Node
.Prev
:= Before
.Prev
;
755 Before
.Prev
.Next
:= New_Node
;
756 Before
.Prev
:= New_Node
;
759 Container
.Length
:= Container
.Length
+ 1;
766 function Is_Empty
(Container
: List
) return Boolean is
768 return Container
.Length
= 0;
777 Process
: not null access procedure (Position
: Cursor
))
779 C
: List
renames Container
'Unrestricted_Access.all;
780 B
: Natural renames C
.Busy
;
782 Node
: Node_Access
:= Container
.First
;
788 while Node
/= null loop
789 Process
(Cursor
'(Container'Unchecked_Access, Node));
805 function Last (Container : List) return Cursor is
807 if Container.Last = null then
811 return Cursor'(Container
'Unchecked_Access, Container
.Last
);
818 function Last_Element
(Container
: List
) return Element_Type
is
820 if Container
.Last
= null then
821 raise Constraint_Error
with "list is empty";
824 return Container
.Last
.Element
;
831 function Length
(Container
: List
) return Count_Type
is
833 return Container
.Length
;
841 (Target
: in out List
;
842 Source
: in out List
)
845 if Target
'Address = Source
'Address then
849 if Source
.Busy
> 0 then
850 raise Program_Error
with
851 "attempt to tamper with elements of Source (list is busy)";
856 Target
.First
:= Source
.First
;
857 Source
.First
:= null;
859 Target
.Last
:= Source
.Last
;
862 Target
.Length
:= Source
.Length
;
870 procedure Next
(Position
: in out Cursor
) is
872 Position
:= Next
(Position
);
875 function Next
(Position
: Cursor
) return Cursor
is
877 if Position
.Node
= null then
881 pragma Assert
(Vet
(Position
), "bad cursor in Next");
884 Next_Node
: constant Node_Access
:= Position
.Node
.Next
;
886 if Next_Node
= null then
890 return Cursor
'(Position.Container, Next_Node);
899 (Container : in out List;
900 New_Item : Element_Type;
901 Count : Count_Type := 1)
904 Insert (Container, First (Container), New_Item, Count);
911 procedure Previous (Position : in out Cursor) is
913 Position := Previous (Position);
916 function Previous (Position : Cursor) return Cursor is
918 if Position.Node = null then
922 pragma Assert (Vet (Position), "bad cursor in Previous");
925 Prev_Node : constant Node_Access := Position.Node.Prev;
927 if Prev_Node = null then
931 return Cursor'(Position
.Container
, Prev_Node
);
939 procedure Query_Element
941 Process
: not null access procedure (Element
: Element_Type
))
944 if Position
.Node
= null then
945 raise Constraint_Error
with
946 "Position cursor has no element";
949 pragma Assert
(Vet
(Position
), "bad cursor in Query_Element");
952 C
: List
renames Position
.Container
.all'Unrestricted_Access.all;
953 B
: Natural renames C
.Busy
;
954 L
: Natural renames C
.Lock
;
961 Process
(Position
.Node
.Element
);
979 (Stream
: not null access Root_Stream_Type
'Class;
987 Count_Type
'Base'Read (Stream, N);
996 Element_Type'Read (Stream, X.Element);
1007 Item.Length := Item.Length + 1;
1008 exit when Item.Length = N;
1013 Element_Type'Read (Stream, X.Element);
1020 X.Prev := Item.Last;
1021 Item.Last.Next := X;
1027 (Stream : not null access Root_Stream_Type'Class;
1031 raise Program_Error with "attempt to stream list cursor";
1034 ---------------------
1035 -- Replace_Element --
1036 ---------------------
1038 procedure Replace_Element
1039 (Container : in out List;
1041 New_Item : Element_Type)
1044 if Position.Container = null then
1045 raise Constraint_Error with "Position cursor has no element";
1048 if Position.Container /= Container'Unchecked_Access then
1049 raise Program_Error with
1050 "Position cursor designates wrong container";
1053 if Container.Lock > 0 then
1054 raise Program_Error with
1055 "attempt to tamper with cursors (list is locked)";
1058 pragma Assert (Vet (Position), "bad cursor in Replace_Element");
1060 Position.Node.Element := New_Item;
1061 end Replace_Element;
1063 ----------------------
1064 -- Reverse_Elements --
1065 ----------------------
1067 procedure Reverse_Elements (Container : in out List) is
1068 I : Node_Access := Container.First;
1069 J : Node_Access := Container.Last;
1071 procedure Swap (L, R : Node_Access);
1077 procedure Swap (L, R : Node_Access) is
1078 LN : constant Node_Access := L.Next;
1079 LP : constant Node_Access := L.Prev;
1081 RN : constant Node_Access := R.Next;
1082 RP : constant Node_Access := R.Prev;
1097 pragma Assert (RP = L);
1111 -- Start of processing for Reverse_Elements
1114 if Container.Length <= 1 then
1118 pragma Assert (Container.First.Prev = null);
1119 pragma Assert (Container.Last.Next = null);
1121 if Container.Busy > 0 then
1122 raise Program_Error with
1123 "attempt to tamper with elements (list is busy)";
1126 Container.First := J;
1127 Container.Last := I;
1129 Swap (L => I, R => J);
1137 Swap (L => J, R => I);
1146 pragma Assert (Container.First.Prev = null);
1147 pragma Assert (Container.Last.Next = null);
1148 end Reverse_Elements;
1154 function Reverse_Find
1156 Item : Element_Type;
1157 Position : Cursor := No_Element) return Cursor
1159 Node : Node_Access := Position.Node;
1163 Node := Container.Last;
1166 if Position.Container /= Container'Unrestricted_Access then
1167 raise Program_Error with
1168 "Position cursor designates wrong container";
1171 pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
1174 while Node /= null loop
1175 if Node.Element = Item then
1176 return Cursor'(Container
'Unchecked_Access, Node
);
1185 ---------------------
1186 -- Reverse_Iterate --
1187 ---------------------
1189 procedure Reverse_Iterate
1191 Process
: not null access procedure (Position
: Cursor
))
1193 C
: List
renames Container
'Unrestricted_Access.all;
1194 B
: Natural renames C
.Busy
;
1196 Node
: Node_Access
:= Container
.Last
;
1202 while Node
/= null loop
1203 Process
(Cursor
'(Container'Unchecked_Access, Node));
1214 end Reverse_Iterate;
1221 (Target : in out List;
1223 Source : in out List)
1226 if Before.Container /= null then
1227 if Before.Container /= Target'Unrestricted_Access then
1228 raise Program_Error with
1229 "Before cursor designates wrong container";
1232 pragma Assert (Vet (Before), "bad cursor in Splice");
1235 if Target'Address = Source'Address
1236 or else Source.Length = 0
1241 pragma Assert (Source.First.Prev = null);
1242 pragma Assert (Source.Last.Next = null);
1244 if Target.Length > Count_Type'Last - Source.Length then
1245 raise Constraint_Error with "new length exceeds maximum";
1248 if Target.Busy > 0 then
1249 raise Program_Error with
1250 "attempt to tamper with elements of Target (list is busy)";
1253 if Source.Busy > 0 then
1254 raise Program_Error with
1255 "attempt to tamper with elements of Source (list is busy)";
1258 if Target.Length = 0 then
1259 pragma Assert (Target.First = null);
1260 pragma Assert (Target.Last = null);
1261 pragma Assert (Before = No_Element);
1263 Target.First := Source.First;
1264 Target.Last := Source.Last;
1266 elsif Before.Node = null then
1267 pragma Assert (Target.Last.Next = null);
1269 Target.Last.Next := Source.First;
1270 Source.First.Prev := Target.Last;
1272 Target.Last := Source.Last;
1274 elsif Before.Node = Target.First then
1275 pragma Assert (Target.First.Prev = null);
1277 Source.Last.Next := Target.First;
1278 Target.First.Prev := Source.Last;
1280 Target.First := Source.First;
1283 pragma Assert (Target.Length >= 2);
1285 Before.Node.Prev.Next := Source.First;
1286 Source.First.Prev := Before.Node.Prev;
1288 Before.Node.Prev := Source.Last;
1289 Source.Last.Next := Before.Node;
1292 Source.First := null;
1293 Source.Last := null;
1295 Target.Length := Target.Length + Source.Length;
1300 (Container : in out List;
1305 if Before.Container /= null then
1306 if Before.Container /= Container'Unchecked_Access then
1307 raise Program_Error with
1308 "Before cursor designates wrong container";
1311 pragma Assert (Vet (Before), "bad Before cursor in Splice");
1314 if Position.Node = null then
1315 raise Constraint_Error with "Position cursor has no element";
1318 if Position.Container /= Container'Unrestricted_Access then
1319 raise Program_Error with
1320 "Position cursor designates wrong container";
1323 pragma Assert (Vet (Position), "bad Position cursor in Splice");
1325 if Position.Node = Before.Node
1326 or else Position.Node.Next = Before.Node
1331 pragma Assert (Container.Length >= 2);
1333 if Container.Busy > 0 then
1334 raise Program_Error with
1335 "attempt to tamper with elements (list is busy)";
1338 if Before.Node = null then
1339 pragma Assert (Position.Node /= Container.Last);
1341 if Position.Node = Container.First then
1342 Container.First := Position.Node.Next;
1343 Container.First.Prev := null;
1345 Position.Node.Prev.Next := Position.Node.Next;
1346 Position.Node.Next.Prev := Position.Node.Prev;
1349 Container.Last.Next := Position.Node;
1350 Position.Node.Prev := Container.Last;
1352 Container.Last := Position.Node;
1353 Container.Last.Next := null;
1358 if Before.Node = Container.First then
1359 pragma Assert (Position.Node /= Container.First);
1361 if Position.Node = Container.Last then
1362 Container.Last := Position.Node.Prev;
1363 Container.Last.Next := null;
1365 Position.Node.Prev.Next := Position.Node.Next;
1366 Position.Node.Next.Prev := Position.Node.Prev;
1369 Container.First.Prev := Position.Node;
1370 Position.Node.Next := Container.First;
1372 Container.First := Position.Node;
1373 Container.First.Prev := null;
1378 if Position.Node = Container.First then
1379 Container.First := Position.Node.Next;
1380 Container.First.Prev := null;
1382 elsif Position.Node = Container.Last then
1383 Container.Last := Position.Node.Prev;
1384 Container.Last.Next := null;
1387 Position.Node.Prev.Next := Position.Node.Next;
1388 Position.Node.Next.Prev := Position.Node.Prev;
1391 Before.Node.Prev.Next := Position.Node;
1392 Position.Node.Prev := Before.Node.Prev;
1394 Before.Node.Prev := Position.Node;
1395 Position.Node.Next := Before.Node;
1397 pragma Assert (Container.First.Prev = null);
1398 pragma Assert (Container.Last.Next = null);
1402 (Target : in out List;
1404 Source : in out List;
1405 Position : in out Cursor)
1408 if Target'Address = Source'Address then
1409 Splice (Target, Before, Position);
1413 if Before.Container /= null then
1414 if Before.Container /= Target'Unrestricted_Access then
1415 raise Program_Error with
1416 "Before cursor designates wrong container";
1419 pragma Assert (Vet (Before), "bad Before cursor in Splice");
1422 if Position.Node = null then
1423 raise Constraint_Error with "Position cursor has no element";
1426 if Position.Container /= Source'Unrestricted_Access then
1427 raise Program_Error with
1428 "Position cursor designates wrong container";
1431 pragma Assert (Vet (Position), "bad Position cursor in Splice");
1433 if Target.Length = Count_Type'Last then
1434 raise Constraint_Error with "Target is full";
1437 if Target.Busy > 0 then
1438 raise Program_Error with
1439 "attempt to tamper with elements of Target (list is busy)";
1442 if Source.Busy > 0 then
1443 raise Program_Error with
1444 "attempt to tamper with elements of Source (list is busy)";
1447 if Position.Node = Source.First then
1448 Source.First := Position.Node.Next;
1450 if Position.Node = Source.Last then
1451 pragma Assert (Source.First = null);
1452 pragma Assert (Source.Length = 1);
1453 Source.Last := null;
1456 Source.First.Prev := null;
1459 elsif Position.Node = Source.Last then
1460 pragma Assert (Source.Length >= 2);
1461 Source.Last := Position.Node.Prev;
1462 Source.Last.Next := null;
1465 pragma Assert (Source.Length >= 3);
1466 Position.Node.Prev.Next := Position.Node.Next;
1467 Position.Node.Next.Prev := Position.Node.Prev;
1470 if Target.Length = 0 then
1471 pragma Assert (Target.First = null);
1472 pragma Assert (Target.Last = null);
1473 pragma Assert (Before = No_Element);
1475 Target.First := Position.Node;
1476 Target.Last := Position.Node;
1478 Target.First.Prev := null;
1479 Target.Last.Next := null;
1481 elsif Before.Node = null then
1482 pragma Assert (Target.Last.Next = null);
1483 Target.Last.Next := Position.Node;
1484 Position.Node.Prev := Target.Last;
1486 Target.Last := Position.Node;
1487 Target.Last.Next := null;
1489 elsif Before.Node = Target.First then
1490 pragma Assert (Target.First.Prev = null);
1491 Target.First.Prev := Position.Node;
1492 Position.Node.Next := Target.First;
1494 Target.First := Position.Node;
1495 Target.First.Prev := null;
1498 pragma Assert (Target.Length >= 2);
1499 Before.Node.Prev.Next := Position.Node;
1500 Position.Node.Prev := Before.Node.Prev;
1502 Before.Node.Prev := Position.Node;
1503 Position.Node.Next := Before.Node;
1506 Target.Length := Target.Length + 1;
1507 Source.Length := Source.Length - 1;
1509 Position.Container := Target'Unchecked_Access;
1517 (Container : in out List;
1521 if I.Node = null then
1522 raise Constraint_Error with "I cursor has no element";
1525 if J.Node = null then
1526 raise Constraint_Error with "J cursor has no element";
1529 if I.Container /= Container'Unchecked_Access then
1530 raise Program_Error with "I cursor designates wrong container";
1533 if J.Container /= Container'Unchecked_Access then
1534 raise Program_Error with "J cursor designates wrong container";
1537 if I.Node = J.Node then
1541 if Container.Lock > 0 then
1542 raise Program_Error with
1543 "attempt to tamper with cursors (list is locked)";
1546 pragma Assert (Vet (I), "bad I cursor in Swap");
1547 pragma Assert (Vet (J), "bad J cursor in Swap");
1550 EI : Element_Type renames I.Node.Element;
1551 EJ : Element_Type renames J.Node.Element;
1553 EI_Copy : constant Element_Type := EI;
1565 procedure Swap_Links
1566 (Container : in out List;
1570 if I.Node = null then
1571 raise Constraint_Error with "I cursor has no element";
1574 if J.Node = null then
1575 raise Constraint_Error with "J cursor has no element";
1578 if I.Container /= Container'Unrestricted_Access then
1579 raise Program_Error with "I cursor designates wrong container";
1582 if J.Container /= Container'Unrestricted_Access then
1583 raise Program_Error with "J cursor designates wrong container";
1586 if I.Node = J.Node then
1590 if Container.Busy > 0 then
1591 raise Program_Error with
1592 "attempt to tamper with elements (list is busy)";
1595 pragma Assert (Vet (I), "bad I cursor in Swap_Links");
1596 pragma Assert (Vet (J), "bad J cursor in Swap_Links");
1599 I_Next : constant Cursor := Next (I);
1603 Splice (Container, Before => I, Position => J);
1607 J_Next : constant Cursor := Next (J);
1611 Splice (Container, Before => J, Position => I);
1614 pragma Assert (Container.Length >= 3);
1616 Splice (Container, Before => I_Next, Position => J);
1617 Splice (Container, Before => J_Next, Position => I);
1624 --------------------
1625 -- Update_Element --
1626 --------------------
1628 procedure Update_Element
1629 (Container : in out List;
1631 Process : not null access procedure (Element : in out Element_Type))
1634 if Position.Node = null then
1635 raise Constraint_Error with "Position cursor has no element";
1638 if Position.Container /= Container'Unchecked_Access then
1639 raise Program_Error with
1640 "Position cursor designates wrong container";
1643 pragma Assert (Vet (Position), "bad cursor in Update_Element");
1646 B : Natural renames Container.Busy;
1647 L : Natural renames Container.Lock;
1654 Process (Position.Node.Element);
1671 function Vet (Position : Cursor) return Boolean is
1673 if Position.Node = null then
1674 return Position.Container = null;
1677 if Position.Container = null then
1681 if Position.Node.Next = Position.Node then
1685 if Position.Node.Prev = Position.Node then
1690 L : List renames Position.Container.all;
1692 if L.Length = 0 then
1696 if L.First = null then
1700 if L.Last = null then
1704 if L.First.Prev /= null then
1708 if L.Last.Next /= null then
1712 if Position.Node.Prev = null
1713 and then Position.Node /= L.First
1718 if Position.Node.Next = null
1719 and then Position.Node /= L.Last
1724 if L.Length = 1 then
1725 return L.First = L.Last;
1728 if L.First = L.Last then
1732 if L.First.Next = null then
1736 if L.Last.Prev = null then
1740 if L.First.Next.Prev /= L.First then
1744 if L.Last.Prev.Next /= L.Last then
1748 if L.Length = 2 then
1749 if L.First.Next /= L.Last then
1753 if L.Last.Prev /= L.First then
1760 if L.First.Next = L.Last then
1764 if L.Last.Prev = L.First then
1768 if Position.Node = L.First then
1772 if Position.Node = L.Last then
1776 if Position.Node.Next = null then
1780 if Position.Node.Prev = null then
1784 if Position.Node.Next.Prev /= Position.Node then
1788 if Position.Node.Prev.Next /= Position.Node then
1792 if L.Length = 3 then
1793 if L.First.Next /= Position.Node then
1797 if L.Last.Prev /= Position.Node then
1811 (Stream : not null access Root_Stream_Type'Class;
1814 Node : Node_Access := Item.First;
1817 Count_Type'Base'Write
(Stream
, Item
.Length
);
1819 while Node
/= null loop
1820 Element_Type
'Write (Stream
, Node
.Element
);
1826 (Stream
: not null access Root_Stream_Type
'Class;
1830 raise Program_Error
with "attempt to stream list cursor";
1833 end Ada
.Containers
.Doubly_Linked_Lists
;