1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.INDEFINITE_DOUBLY_LINKED_LISTS --
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
;
31 with Ada
.Unchecked_Deallocation
;
33 package body Ada
.Containers
.Indefinite_Doubly_Linked_Lists
is
36 new Ada
.Unchecked_Deallocation
(Element_Type
, Element_Access
);
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
60 if Left
'Address = Right
'Address then
64 if Left
.Length
/= Right
.Length
then
70 for J
in 1 .. Left
.Length
loop
71 if L
.Element
.all /= R
.Element
.all then
86 procedure Adjust
(Container
: in out List
) is
87 Src
: Node_Access
:= Container
.First
;
92 pragma Assert
(Container
.Last
= null);
93 pragma Assert
(Container
.Length
= 0);
94 pragma Assert
(Container
.Busy
= 0);
95 pragma Assert
(Container
.Lock
= 0);
99 pragma Assert
(Container
.First
.Prev
= null);
100 pragma Assert
(Container
.Last
.Next
= null);
101 pragma Assert
(Container
.Length
> 0);
103 Container
.First
:= null;
104 Container
.Last
:= null;
105 Container
.Length
:= 0;
110 Element
: Element_Access
:= new Element_Type
'(Src.Element.all);
112 Dst := new Node_Type'(Element
, null, null);
119 Container
.First
:= Dst
;
120 Container
.Last
:= Dst
;
121 Container
.Length
:= 1;
124 while Src
/= null loop
126 Element
: Element_Access
:= new Element_Type
'(Src.Element.all);
128 Dst := new Node_Type'(Element
, null, Prev
=> Container
.Last
);
135 Container
.Last
.Next
:= Dst
;
136 Container
.Last
:= Dst
;
137 Container
.Length
:= Container
.Length
+ 1;
148 (Container
: in out List
;
149 New_Item
: Element_Type
;
150 Count
: Count_Type
:= 1)
153 Insert
(Container
, No_Element
, New_Item
, Count
);
160 procedure Clear
(Container
: in out List
) is
162 pragma Warnings
(Off
, X
);
165 if Container
.Length
= 0 then
166 pragma Assert
(Container
.First
= null);
167 pragma Assert
(Container
.Last
= null);
168 pragma Assert
(Container
.Busy
= 0);
169 pragma Assert
(Container
.Lock
= 0);
173 pragma Assert
(Container
.First
.Prev
= null);
174 pragma Assert
(Container
.Last
.Next
= null);
176 if Container
.Busy
> 0 then
177 raise Program_Error
with
178 "attempt to tamper with elements (list is busy)";
181 while Container
.Length
> 1 loop
182 X
:= Container
.First
;
183 pragma Assert
(X
.Next
.Prev
= Container
.First
);
185 Container
.First
:= X
.Next
;
186 Container
.First
.Prev
:= null;
188 Container
.Length
:= Container
.Length
- 1;
193 X
:= Container
.First
;
194 pragma Assert
(X
= Container
.Last
);
196 Container
.First
:= null;
197 Container
.Last
:= null;
198 Container
.Length
:= 0;
209 Item
: Element_Type
) return Boolean
212 return Find
(Container
, Item
) /= No_Element
;
220 (Container
: in out List
;
221 Position
: in out Cursor
;
222 Count
: Count_Type
:= 1)
227 if Position
.Node
= null then
228 raise Constraint_Error
with
229 "Position cursor has no element";
232 if Position
.Node
.Element
= null then
233 raise Program_Error
with
234 "Position cursor has no element";
237 if Position
.Container
/= Container
'Unrestricted_Access then
238 raise Program_Error
with
239 "Position cursor designates wrong container";
242 pragma Assert
(Vet
(Position
), "bad cursor in Delete");
244 if Position
.Node
= Container
.First
then
245 Delete_First
(Container
, Count
);
246 Position
:= No_Element
; -- Post-York behavior
251 Position
:= No_Element
; -- Post-York behavior
255 if Container
.Busy
> 0 then
256 raise Program_Error
with
257 "attempt to tamper with elements (list is busy)";
260 for Index
in 1 .. Count
loop
262 Container
.Length
:= Container
.Length
- 1;
264 if X
= Container
.Last
then
265 Position
:= No_Element
;
267 Container
.Last
:= X
.Prev
;
268 Container
.Last
.Next
:= null;
274 Position
.Node
:= X
.Next
;
276 X
.Next
.Prev
:= X
.Prev
;
277 X
.Prev
.Next
:= X
.Next
;
282 Position
:= No_Element
; -- Post-York behavior
289 procedure Delete_First
290 (Container
: in out List
;
291 Count
: Count_Type
:= 1)
296 if Count
>= Container
.Length
then
305 if Container
.Busy
> 0 then
306 raise Program_Error
with
307 "attempt to tamper with elements (list is busy)";
310 for I
in 1 .. Count
loop
311 X
:= Container
.First
;
312 pragma Assert
(X
.Next
.Prev
= Container
.First
);
314 Container
.First
:= X
.Next
;
315 Container
.First
.Prev
:= null;
317 Container
.Length
:= Container
.Length
- 1;
327 procedure Delete_Last
328 (Container
: in out List
;
329 Count
: Count_Type
:= 1)
334 if Count
>= Container
.Length
then
343 if Container
.Busy
> 0 then
344 raise Program_Error
with
345 "attempt to tamper with elements (list is busy)";
348 for I
in 1 .. Count
loop
350 pragma Assert
(X
.Prev
.Next
= Container
.Last
);
352 Container
.Last
:= X
.Prev
;
353 Container
.Last
.Next
:= null;
355 Container
.Length
:= Container
.Length
- 1;
365 function Element
(Position
: Cursor
) return Element_Type
is
367 if Position
.Node
= null then
368 raise Constraint_Error
with
369 "Position cursor has no element";
372 if Position
.Node
.Element
= null then
373 raise Program_Error
with
374 "Position cursor has no element";
377 pragma Assert
(Vet
(Position
), "bad cursor in Element");
379 return Position
.Node
.Element
.all;
389 Position
: Cursor
:= No_Element
) return Cursor
391 Node
: Node_Access
:= Position
.Node
;
395 Node
:= Container
.First
;
398 if Node
.Element
= null then
402 if Position
.Container
/= Container
'Unrestricted_Access then
403 raise Program_Error
with
404 "Position cursor designates wrong container";
407 pragma Assert
(Vet
(Position
), "bad cursor in Find");
410 while Node
/= null loop
411 if Node
.Element
.all = Item
then
412 return Cursor
'(Container'Unchecked_Access, Node);
425 function First (Container : List) return Cursor is
427 if Container.First = null then
431 return Cursor'(Container
'Unchecked_Access, Container
.First
);
438 function First_Element
(Container
: List
) return Element_Type
is
440 if Container
.First
= null then
441 raise Constraint_Error
with "list is empty";
444 return Container
.First
.Element
.all;
451 procedure Free
(X
: in out Node_Access
) is
452 procedure Deallocate
is
453 new Ada
.Unchecked_Deallocation
(Node_Type
, Node_Access
);
471 ---------------------
472 -- Generic_Sorting --
473 ---------------------
475 package body Generic_Sorting
is
481 function Is_Sorted
(Container
: List
) return Boolean is
482 Node
: Node_Access
:= Container
.First
;
485 for I
in 2 .. Container
.Length
loop
486 if Node
.Next
.Element
.all < Node
.Element
.all then
501 (Target
: in out List
;
502 Source
: in out List
)
507 if Target
'Address = Source
'Address then
511 if Target
.Busy
> 0 then
512 raise Program_Error
with
513 "attempt to tamper with elements of Target (list is busy)";
516 if Source
.Busy
> 0 then
517 raise Program_Error
with
518 "attempt to tamper with elements of Source (list is busy)";
521 LI
:= First
(Target
);
522 RI
:= First
(Source
);
523 while RI
.Node
/= null loop
524 pragma Assert
(RI
.Node
.Next
= null
525 or else not (RI
.Node
.Next
.Element
.all <
526 RI
.Node
.Element
.all));
528 if LI
.Node
= null then
529 Splice
(Target
, No_Element
, Source
);
533 pragma Assert
(LI
.Node
.Next
= null
534 or else not (LI
.Node
.Next
.Element
.all <
535 LI
.Node
.Element
.all));
537 if RI
.Node
.Element
.all < LI
.Node
.Element
.all then
540 pragma Warnings
(Off
, RJ
);
542 RI
.Node
:= RI
.Node
.Next
;
543 Splice
(Target
, LI
, Source
, RJ
);
547 LI
.Node
:= LI
.Node
.Next
;
556 procedure Sort
(Container
: in out List
) is
557 procedure Partition
(Pivot
: Node_Access
; Back
: Node_Access
);
559 procedure Sort
(Front
, Back
: Node_Access
);
565 procedure Partition
(Pivot
: Node_Access
; Back
: Node_Access
) is
566 Node
: Node_Access
:= Pivot
.Next
;
569 while Node
/= Back
loop
570 if Node
.Element
.all < Pivot
.Element
.all then
572 Prev
: constant Node_Access
:= Node
.Prev
;
573 Next
: constant Node_Access
:= Node
.Next
;
578 Container
.Last
:= Prev
;
584 Node
.Prev
:= Pivot
.Prev
;
588 if Node
.Prev
= null then
589 Container
.First
:= Node
;
591 Node
.Prev
.Next
:= Node
;
607 procedure Sort
(Front
, Back
: Node_Access
) is
608 Pivot
: constant Node_Access
:=
609 (if Front
= null then Container
.First
else Front
.Next
);
611 if Pivot
/= Back
then
612 Partition
(Pivot
, Back
);
618 -- Start of processing for Sort
621 if Container
.Length
<= 1 then
625 pragma Assert
(Container
.First
.Prev
= null);
626 pragma Assert
(Container
.Last
.Next
= null);
628 if Container
.Busy
> 0 then
629 raise Program_Error
with
630 "attempt to tamper with elements (list is busy)";
633 Sort
(Front
=> null, Back
=> null);
635 pragma Assert
(Container
.First
.Prev
= null);
636 pragma Assert
(Container
.Last
.Next
= null);
645 function Has_Element
(Position
: Cursor
) return Boolean is
647 pragma Assert
(Vet
(Position
), "bad cursor in Has_Element");
648 return Position
.Node
/= null;
656 (Container
: in out List
;
658 New_Item
: Element_Type
;
659 Position
: out Cursor
;
660 Count
: Count_Type
:= 1)
662 New_Node
: Node_Access
;
665 if Before
.Container
/= null then
666 if Before
.Container
/= Container
'Unrestricted_Access then
667 raise Program_Error
with
668 "attempt to tamper with elements (list is busy)";
671 if Before
.Node
= null
672 or else Before
.Node
.Element
= null
674 raise Program_Error
with
675 "Before cursor has no element";
678 pragma Assert
(Vet
(Before
), "bad cursor in Insert");
686 if Container
.Length
> Count_Type
'Last - Count
then
687 raise Constraint_Error
with "new length exceeds maximum";
690 if Container
.Busy
> 0 then
691 raise Program_Error
with
692 "attempt to tamper with elements (list is busy)";
696 Element
: Element_Access
:= new Element_Type
'(New_Item);
698 New_Node := new Node_Type'(Element
, null, null);
705 Insert_Internal
(Container
, Before
.Node
, New_Node
);
706 Position
:= Cursor
'(Container'Unchecked_Access, New_Node);
708 for J in Count_Type'(2) .. Count
loop
711 Element
: Element_Access
:= new Element_Type
'(New_Item);
713 New_Node := new Node_Type'(Element
, null, null);
720 Insert_Internal
(Container
, Before
.Node
, New_Node
);
725 (Container
: in out List
;
727 New_Item
: Element_Type
;
728 Count
: Count_Type
:= 1)
731 pragma Unreferenced
(Position
);
733 Insert
(Container
, Before
, New_Item
, Position
, Count
);
736 ---------------------
737 -- Insert_Internal --
738 ---------------------
740 procedure Insert_Internal
741 (Container
: in out List
;
742 Before
: Node_Access
;
743 New_Node
: Node_Access
)
746 if Container
.Length
= 0 then
747 pragma Assert
(Before
= null);
748 pragma Assert
(Container
.First
= null);
749 pragma Assert
(Container
.Last
= null);
751 Container
.First
:= New_Node
;
752 Container
.Last
:= New_Node
;
754 elsif Before
= null then
755 pragma Assert
(Container
.Last
.Next
= null);
757 Container
.Last
.Next
:= New_Node
;
758 New_Node
.Prev
:= Container
.Last
;
760 Container
.Last
:= New_Node
;
762 elsif Before
= Container
.First
then
763 pragma Assert
(Container
.First
.Prev
= null);
765 Container
.First
.Prev
:= New_Node
;
766 New_Node
.Next
:= Container
.First
;
768 Container
.First
:= New_Node
;
771 pragma Assert
(Container
.First
.Prev
= null);
772 pragma Assert
(Container
.Last
.Next
= null);
774 New_Node
.Next
:= Before
;
775 New_Node
.Prev
:= Before
.Prev
;
777 Before
.Prev
.Next
:= New_Node
;
778 Before
.Prev
:= New_Node
;
781 Container
.Length
:= Container
.Length
+ 1;
788 function Is_Empty
(Container
: List
) return Boolean is
790 return Container
.Length
= 0;
799 Process
: not null access procedure (Position
: Cursor
))
801 C
: List
renames Container
'Unrestricted_Access.all;
802 B
: Natural renames C
.Busy
;
804 Node
: Node_Access
:= Container
.First
;
810 while Node
/= null loop
811 Process
(Cursor
'(Container'Unchecked_Access, Node));
827 function Last (Container : List) return Cursor is
829 if Container.Last = null then
833 return Cursor'(Container
'Unchecked_Access, Container
.Last
);
840 function Last_Element
(Container
: List
) return Element_Type
is
842 if Container
.Last
= null then
843 raise Constraint_Error
with "list is empty";
846 return Container
.Last
.Element
.all;
853 function Length
(Container
: List
) return Count_Type
is
855 return Container
.Length
;
862 procedure Move
(Target
: in out List
; Source
: in out List
) is
864 if Target
'Address = Source
'Address then
868 if Source
.Busy
> 0 then
869 raise Program_Error
with
870 "attempt to tamper with elements of Source (list is busy)";
875 Target
.First
:= Source
.First
;
876 Source
.First
:= null;
878 Target
.Last
:= Source
.Last
;
881 Target
.Length
:= Source
.Length
;
889 procedure Next
(Position
: in out Cursor
) is
891 Position
:= Next
(Position
);
894 function Next
(Position
: Cursor
) return Cursor
is
896 if Position
.Node
= null then
900 pragma Assert
(Vet
(Position
), "bad cursor in Next");
903 Next_Node
: constant Node_Access
:= Position
.Node
.Next
;
905 if Next_Node
= null then
909 return Cursor
'(Position.Container, Next_Node);
918 (Container : in out List;
919 New_Item : Element_Type;
920 Count : Count_Type := 1)
923 Insert (Container, First (Container), New_Item, Count);
930 procedure Previous (Position : in out Cursor) is
932 Position := Previous (Position);
935 function Previous (Position : Cursor) return Cursor is
937 if Position.Node = null then
941 pragma Assert (Vet (Position), "bad cursor in Previous");
944 Prev_Node : constant Node_Access := Position.Node.Prev;
946 if Prev_Node = null then
950 return Cursor'(Position
.Container
, Prev_Node
);
958 procedure Query_Element
960 Process
: not null access procedure (Element
: Element_Type
))
963 if Position
.Node
= null then
964 raise Constraint_Error
with
965 "Position cursor has no element";
968 if Position
.Node
.Element
= null then
969 raise Program_Error
with
970 "Position cursor has no element";
973 pragma Assert
(Vet
(Position
), "bad cursor in Query_Element");
976 C
: List
renames Position
.Container
.all'Unrestricted_Access.all;
977 B
: Natural renames C
.Busy
;
978 L
: Natural renames C
.Lock
;
985 Process
(Position
.Node
.Element
.all);
1003 (Stream
: not null access Root_Stream_Type
'Class;
1006 N
: Count_Type
'Base;
1012 Count_Type
'Base'Read (Stream, N);
1019 Element : Element_Access :=
1020 new Element_Type'(Element_Type
'Input (Stream
));
1022 Dst
:= new Node_Type
'(Element, null, null);
1033 while Item.Length < N loop
1035 Element : Element_Access :=
1036 new Element_Type'(Element_Type
'Input (Stream
));
1038 Dst
:= new Node_Type
'(Element, Next => null, Prev => Item.Last);
1045 Item.Last.Next := Dst;
1047 Item.Length := Item.Length + 1;
1052 (Stream : not null access Root_Stream_Type'Class;
1056 raise Program_Error with "attempt to stream list cursor";
1059 ---------------------
1060 -- Replace_Element --
1061 ---------------------
1063 procedure Replace_Element
1064 (Container : in out List;
1066 New_Item : Element_Type)
1069 if Position.Container = null then
1070 raise Constraint_Error with "Position cursor has no element";
1073 if Position.Container /= Container'Unchecked_Access then
1074 raise Program_Error with
1075 "Position cursor designates wrong container";
1078 if Container.Lock > 0 then
1079 raise Program_Error with
1080 "attempt to tamper with cursors (list is locked)";
1083 if Position.Node.Element = null then
1084 raise Program_Error with
1085 "Position cursor has no element";
1088 pragma Assert (Vet (Position), "bad cursor in Replace_Element");
1091 X : Element_Access := Position.Node.Element;
1094 Position.Node.Element := new Element_Type'(New_Item
);
1097 end Replace_Element
;
1099 ----------------------
1100 -- Reverse_Elements --
1101 ----------------------
1103 procedure Reverse_Elements
(Container
: in out List
) is
1104 I
: Node_Access
:= Container
.First
;
1105 J
: Node_Access
:= Container
.Last
;
1107 procedure Swap
(L
, R
: Node_Access
);
1113 procedure Swap
(L
, R
: Node_Access
) is
1114 LN
: constant Node_Access
:= L
.Next
;
1115 LP
: constant Node_Access
:= L
.Prev
;
1117 RN
: constant Node_Access
:= R
.Next
;
1118 RP
: constant Node_Access
:= R
.Prev
;
1133 pragma Assert
(RP
= L
);
1147 -- Start of processing for Reverse_Elements
1150 if Container
.Length
<= 1 then
1154 pragma Assert
(Container
.First
.Prev
= null);
1155 pragma Assert
(Container
.Last
.Next
= null);
1157 if Container
.Busy
> 0 then
1158 raise Program_Error
with
1159 "attempt to tamper with elements (list is busy)";
1162 Container
.First
:= J
;
1163 Container
.Last
:= I
;
1165 Swap
(L
=> I
, R
=> J
);
1173 Swap
(L
=> J
, R
=> I
);
1182 pragma Assert
(Container
.First
.Prev
= null);
1183 pragma Assert
(Container
.Last
.Next
= null);
1184 end Reverse_Elements
;
1190 function Reverse_Find
1192 Item
: Element_Type
;
1193 Position
: Cursor
:= No_Element
) return Cursor
1195 Node
: Node_Access
:= Position
.Node
;
1199 Node
:= Container
.Last
;
1202 if Node
.Element
= null then
1203 raise Program_Error
with "Position cursor has no element";
1206 if Position
.Container
/= Container
'Unrestricted_Access then
1207 raise Program_Error
with
1208 "Position cursor designates wrong container";
1211 pragma Assert
(Vet
(Position
), "bad cursor in Reverse_Find");
1214 while Node
/= null loop
1215 if Node
.Element
.all = Item
then
1216 return Cursor
'(Container'Unchecked_Access, Node);
1225 ---------------------
1226 -- Reverse_Iterate --
1227 ---------------------
1229 procedure Reverse_Iterate
1231 Process : not null access procedure (Position : Cursor))
1233 C : List renames Container'Unrestricted_Access.all;
1234 B : Natural renames C.Busy;
1236 Node : Node_Access := Container.Last;
1242 while Node /= null loop
1243 Process (Cursor'(Container
'Unchecked_Access, Node
));
1253 end Reverse_Iterate
;
1260 (Target
: in out List
;
1262 Source
: in out List
)
1265 if Before
.Container
/= null then
1266 if Before
.Container
/= Target
'Unrestricted_Access then
1267 raise Program_Error
with
1268 "Before cursor designates wrong container";
1271 if Before
.Node
= null
1272 or else Before
.Node
.Element
= null
1274 raise Program_Error
with
1275 "Before cursor has no element";
1278 pragma Assert
(Vet
(Before
), "bad cursor in Splice");
1281 if Target
'Address = Source
'Address
1282 or else Source
.Length
= 0
1287 pragma Assert
(Source
.First
.Prev
= null);
1288 pragma Assert
(Source
.Last
.Next
= null);
1290 if Target
.Length
> Count_Type
'Last - Source
.Length
then
1291 raise Constraint_Error
with "new length exceeds maximum";
1294 if Target
.Busy
> 0 then
1295 raise Program_Error
with
1296 "attempt to tamper with elements of Target (list is busy)";
1299 if Source
.Busy
> 0 then
1300 raise Program_Error
with
1301 "attempt to tamper with elements of Source (list is busy)";
1304 if Target
.Length
= 0 then
1305 pragma Assert
(Before
= No_Element
);
1306 pragma Assert
(Target
.First
= null);
1307 pragma Assert
(Target
.Last
= null);
1309 Target
.First
:= Source
.First
;
1310 Target
.Last
:= Source
.Last
;
1312 elsif Before
.Node
= null then
1313 pragma Assert
(Target
.Last
.Next
= null);
1315 Target
.Last
.Next
:= Source
.First
;
1316 Source
.First
.Prev
:= Target
.Last
;
1318 Target
.Last
:= Source
.Last
;
1320 elsif Before
.Node
= Target
.First
then
1321 pragma Assert
(Target
.First
.Prev
= null);
1323 Source
.Last
.Next
:= Target
.First
;
1324 Target
.First
.Prev
:= Source
.Last
;
1326 Target
.First
:= Source
.First
;
1329 pragma Assert
(Target
.Length
>= 2);
1330 Before
.Node
.Prev
.Next
:= Source
.First
;
1331 Source
.First
.Prev
:= Before
.Node
.Prev
;
1333 Before
.Node
.Prev
:= Source
.Last
;
1334 Source
.Last
.Next
:= Before
.Node
;
1337 Source
.First
:= null;
1338 Source
.Last
:= null;
1340 Target
.Length
:= Target
.Length
+ Source
.Length
;
1345 (Container
: in out List
;
1350 if Before
.Container
/= null then
1351 if Before
.Container
/= Container
'Unchecked_Access then
1352 raise Program_Error
with
1353 "Before cursor designates wrong container";
1356 if Before
.Node
= null
1357 or else Before
.Node
.Element
= null
1359 raise Program_Error
with
1360 "Before cursor has no element";
1363 pragma Assert
(Vet
(Before
), "bad Before cursor in Splice");
1366 if Position
.Node
= null then
1367 raise Constraint_Error
with "Position cursor has no element";
1370 if Position
.Node
.Element
= null then
1371 raise Program_Error
with "Position cursor has no element";
1374 if Position
.Container
/= Container
'Unrestricted_Access then
1375 raise Program_Error
with
1376 "Position cursor designates wrong container";
1379 pragma Assert
(Vet
(Position
), "bad Position cursor in Splice");
1381 if Position
.Node
= Before
.Node
1382 or else Position
.Node
.Next
= Before
.Node
1387 pragma Assert
(Container
.Length
>= 2);
1389 if Container
.Busy
> 0 then
1390 raise Program_Error
with
1391 "attempt to tamper with elements (list is busy)";
1394 if Before
.Node
= null then
1395 pragma Assert
(Position
.Node
/= Container
.Last
);
1397 if Position
.Node
= Container
.First
then
1398 Container
.First
:= Position
.Node
.Next
;
1399 Container
.First
.Prev
:= null;
1401 Position
.Node
.Prev
.Next
:= Position
.Node
.Next
;
1402 Position
.Node
.Next
.Prev
:= Position
.Node
.Prev
;
1405 Container
.Last
.Next
:= Position
.Node
;
1406 Position
.Node
.Prev
:= Container
.Last
;
1408 Container
.Last
:= Position
.Node
;
1409 Container
.Last
.Next
:= null;
1414 if Before
.Node
= Container
.First
then
1415 pragma Assert
(Position
.Node
/= Container
.First
);
1417 if Position
.Node
= Container
.Last
then
1418 Container
.Last
:= Position
.Node
.Prev
;
1419 Container
.Last
.Next
:= null;
1421 Position
.Node
.Prev
.Next
:= Position
.Node
.Next
;
1422 Position
.Node
.Next
.Prev
:= Position
.Node
.Prev
;
1425 Container
.First
.Prev
:= Position
.Node
;
1426 Position
.Node
.Next
:= Container
.First
;
1428 Container
.First
:= Position
.Node
;
1429 Container
.First
.Prev
:= null;
1434 if Position
.Node
= Container
.First
then
1435 Container
.First
:= Position
.Node
.Next
;
1436 Container
.First
.Prev
:= null;
1438 elsif Position
.Node
= Container
.Last
then
1439 Container
.Last
:= Position
.Node
.Prev
;
1440 Container
.Last
.Next
:= null;
1443 Position
.Node
.Prev
.Next
:= Position
.Node
.Next
;
1444 Position
.Node
.Next
.Prev
:= Position
.Node
.Prev
;
1447 Before
.Node
.Prev
.Next
:= Position
.Node
;
1448 Position
.Node
.Prev
:= Before
.Node
.Prev
;
1450 Before
.Node
.Prev
:= Position
.Node
;
1451 Position
.Node
.Next
:= Before
.Node
;
1453 pragma Assert
(Container
.First
.Prev
= null);
1454 pragma Assert
(Container
.Last
.Next
= null);
1458 (Target
: in out List
;
1460 Source
: in out List
;
1461 Position
: in out Cursor
)
1464 if Target
'Address = Source
'Address then
1465 Splice
(Target
, Before
, Position
);
1469 if Before
.Container
/= null then
1470 if Before
.Container
/= Target
'Unrestricted_Access then
1471 raise Program_Error
with
1472 "Before cursor designates wrong container";
1475 if Before
.Node
= null
1476 or else Before
.Node
.Element
= null
1478 raise Program_Error
with
1479 "Before cursor has no element";
1482 pragma Assert
(Vet
(Before
), "bad Before cursor in Splice");
1485 if Position
.Node
= null then
1486 raise Constraint_Error
with "Position cursor has no element";
1489 if Position
.Node
.Element
= null then
1490 raise Program_Error
with
1491 "Position cursor has no element";
1494 if Position
.Container
/= Source
'Unrestricted_Access then
1495 raise Program_Error
with
1496 "Position cursor designates wrong container";
1499 pragma Assert
(Vet
(Position
), "bad Position cursor in Splice");
1501 if Target
.Length
= Count_Type
'Last then
1502 raise Constraint_Error
with "Target is full";
1505 if Target
.Busy
> 0 then
1506 raise Program_Error
with
1507 "attempt to tamper with elements of Target (list is busy)";
1510 if Source
.Busy
> 0 then
1511 raise Program_Error
with
1512 "attempt to tamper with elements of Source (list is busy)";
1515 if Position
.Node
= Source
.First
then
1516 Source
.First
:= Position
.Node
.Next
;
1518 if Position
.Node
= Source
.Last
then
1519 pragma Assert
(Source
.First
= null);
1520 pragma Assert
(Source
.Length
= 1);
1521 Source
.Last
:= null;
1524 Source
.First
.Prev
:= null;
1527 elsif Position
.Node
= Source
.Last
then
1528 pragma Assert
(Source
.Length
>= 2);
1529 Source
.Last
:= Position
.Node
.Prev
;
1530 Source
.Last
.Next
:= null;
1533 pragma Assert
(Source
.Length
>= 3);
1534 Position
.Node
.Prev
.Next
:= Position
.Node
.Next
;
1535 Position
.Node
.Next
.Prev
:= Position
.Node
.Prev
;
1538 if Target
.Length
= 0 then
1539 pragma Assert
(Before
= No_Element
);
1540 pragma Assert
(Target
.First
= null);
1541 pragma Assert
(Target
.Last
= null);
1543 Target
.First
:= Position
.Node
;
1544 Target
.Last
:= Position
.Node
;
1546 Target
.First
.Prev
:= null;
1547 Target
.Last
.Next
:= null;
1549 elsif Before
.Node
= null then
1550 pragma Assert
(Target
.Last
.Next
= null);
1551 Target
.Last
.Next
:= Position
.Node
;
1552 Position
.Node
.Prev
:= Target
.Last
;
1554 Target
.Last
:= Position
.Node
;
1555 Target
.Last
.Next
:= null;
1557 elsif Before
.Node
= Target
.First
then
1558 pragma Assert
(Target
.First
.Prev
= null);
1559 Target
.First
.Prev
:= Position
.Node
;
1560 Position
.Node
.Next
:= Target
.First
;
1562 Target
.First
:= Position
.Node
;
1563 Target
.First
.Prev
:= null;
1566 pragma Assert
(Target
.Length
>= 2);
1567 Before
.Node
.Prev
.Next
:= Position
.Node
;
1568 Position
.Node
.Prev
:= Before
.Node
.Prev
;
1570 Before
.Node
.Prev
:= Position
.Node
;
1571 Position
.Node
.Next
:= Before
.Node
;
1574 Target
.Length
:= Target
.Length
+ 1;
1575 Source
.Length
:= Source
.Length
- 1;
1577 Position
.Container
:= Target
'Unchecked_Access;
1585 (Container
: in out List
;
1589 if I
.Node
= null then
1590 raise Constraint_Error
with "I cursor has no element";
1593 if J
.Node
= null then
1594 raise Constraint_Error
with "J cursor has no element";
1597 if I
.Container
/= Container
'Unchecked_Access then
1598 raise Program_Error
with "I cursor designates wrong container";
1601 if J
.Container
/= Container
'Unchecked_Access then
1602 raise Program_Error
with "J cursor designates wrong container";
1605 if I
.Node
= J
.Node
then
1609 if Container
.Lock
> 0 then
1610 raise Program_Error
with
1611 "attempt to tamper with cursors (list is locked)";
1614 pragma Assert
(Vet
(I
), "bad I cursor in Swap");
1615 pragma Assert
(Vet
(J
), "bad J cursor in Swap");
1618 EI_Copy
: constant Element_Access
:= I
.Node
.Element
;
1621 I
.Node
.Element
:= J
.Node
.Element
;
1622 J
.Node
.Element
:= EI_Copy
;
1630 procedure Swap_Links
1631 (Container
: in out List
;
1635 if I
.Node
= null then
1636 raise Constraint_Error
with "I cursor has no element";
1639 if J
.Node
= null then
1640 raise Constraint_Error
with "J cursor has no element";
1643 if I
.Container
/= Container
'Unrestricted_Access then
1644 raise Program_Error
with "I cursor designates wrong container";
1647 if J
.Container
/= Container
'Unrestricted_Access then
1648 raise Program_Error
with "J cursor designates wrong container";
1651 if I
.Node
= J
.Node
then
1655 if Container
.Busy
> 0 then
1656 raise Program_Error
with
1657 "attempt to tamper with elements (list is busy)";
1660 pragma Assert
(Vet
(I
), "bad I cursor in Swap_Links");
1661 pragma Assert
(Vet
(J
), "bad J cursor in Swap_Links");
1664 I_Next
: constant Cursor
:= Next
(I
);
1668 Splice
(Container
, Before
=> I
, Position
=> J
);
1672 J_Next
: constant Cursor
:= Next
(J
);
1676 Splice
(Container
, Before
=> J
, Position
=> I
);
1679 pragma Assert
(Container
.Length
>= 3);
1681 Splice
(Container
, Before
=> I_Next
, Position
=> J
);
1682 Splice
(Container
, Before
=> J_Next
, Position
=> I
);
1688 pragma Assert
(Container
.First
.Prev
= null);
1689 pragma Assert
(Container
.Last
.Next
= null);
1692 --------------------
1693 -- Update_Element --
1694 --------------------
1696 procedure Update_Element
1697 (Container
: in out List
;
1699 Process
: not null access procedure (Element
: in out Element_Type
))
1702 if Position
.Node
= null then
1703 raise Constraint_Error
with "Position cursor has no element";
1706 if Position
.Node
.Element
= null then
1707 raise Program_Error
with
1708 "Position cursor has no element";
1711 if Position
.Container
/= Container
'Unchecked_Access then
1712 raise Program_Error
with
1713 "Position cursor designates wrong container";
1716 pragma Assert
(Vet
(Position
), "bad cursor in Update_Element");
1719 B
: Natural renames Container
.Busy
;
1720 L
: Natural renames Container
.Lock
;
1727 Process
(Position
.Node
.Element
.all);
1744 function Vet
(Position
: Cursor
) return Boolean is
1746 if Position
.Node
= null then
1747 return Position
.Container
= null;
1750 if Position
.Container
= null then
1754 if Position
.Node
.Next
= Position
.Node
then
1758 if Position
.Node
.Prev
= Position
.Node
then
1762 if Position
.Node
.Element
= null then
1767 L
: List
renames Position
.Container
.all;
1769 if L
.Length
= 0 then
1773 if L
.First
= null then
1777 if L
.Last
= null then
1781 if L
.First
.Prev
/= null then
1785 if L
.Last
.Next
/= null then
1789 if Position
.Node
.Prev
= null
1790 and then Position
.Node
/= L
.First
1795 if Position
.Node
.Next
= null
1796 and then Position
.Node
/= L
.Last
1801 if L
.Length
= 1 then
1802 return L
.First
= L
.Last
;
1805 if L
.First
= L
.Last
then
1809 if L
.First
.Next
= null then
1813 if L
.Last
.Prev
= null then
1817 if L
.First
.Next
.Prev
/= L
.First
then
1821 if L
.Last
.Prev
.Next
/= L
.Last
then
1825 if L
.Length
= 2 then
1826 if L
.First
.Next
/= L
.Last
then
1830 if L
.Last
.Prev
/= L
.First
then
1837 if L
.First
.Next
= L
.Last
then
1841 if L
.Last
.Prev
= L
.First
then
1845 if Position
.Node
= L
.First
then
1849 if Position
.Node
= L
.Last
then
1853 if Position
.Node
.Next
= null then
1857 if Position
.Node
.Prev
= null then
1861 if Position
.Node
.Next
.Prev
/= Position
.Node
then
1865 if Position
.Node
.Prev
.Next
/= Position
.Node
then
1869 if L
.Length
= 3 then
1870 if L
.First
.Next
/= Position
.Node
then
1874 if L
.Last
.Prev
/= Position
.Node
then
1888 (Stream
: not null access Root_Stream_Type
'Class;
1891 Node
: Node_Access
:= Item
.First
;
1894 Count_Type
'Base'Write (Stream, Item.Length);
1896 while Node /= null loop
1897 Element_Type'Output (Stream, Node.Element.all);
1903 (Stream : not null access Root_Stream_Type'Class;
1907 raise Program_Error with "attempt to stream list cursor";
1910 end Ada.Containers.Indefinite_Doubly_Linked_Lists;