1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.FORMAL_DOUBLY_LINKED_LISTS --
9 -- Copyright (C) 2010-2013, 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/>. --
26 ------------------------------------------------------------------------------
28 with System
; use type System
.Address
;
30 package body Ada
.Containers
.Formal_Doubly_Linked_Lists
is
32 -----------------------
33 -- Local Subprograms --
34 -----------------------
37 (Container
: in out List
;
38 New_Item
: Element_Type
;
39 New_Node
: out Count_Type
);
42 (Container
: in out List
;
43 New_Node
: out Count_Type
);
46 (Container
: in out List
;
49 procedure Insert_Internal
50 (Container
: in out List
;
52 New_Node
: Count_Type
);
54 function Vet
(L
: List
; Position
: Cursor
) return Boolean;
60 function "=" (Left
, Right
: List
) return Boolean is
64 if Left
'Address = Right
'Address then
68 if Left
.Length
/= Right
.Length
then
75 if Left
.Nodes
(LI
).Element
/= Right
.Nodes
(LI
).Element
then
79 LI
:= Left
.Nodes
(LI
).Next
;
80 RI
:= Right
.Nodes
(RI
).Next
;
91 (Container
: in out List
;
92 New_Item
: Element_Type
;
93 New_Node
: out Count_Type
)
95 N
: Node_Array
renames Container
.Nodes
;
98 if Container
.Free
>= 0 then
99 New_Node
:= Container
.Free
;
100 N
(New_Node
).Element
:= New_Item
;
101 Container
.Free
:= N
(New_Node
).Next
;
104 New_Node
:= abs Container
.Free
;
105 N
(New_Node
).Element
:= New_Item
;
106 Container
.Free
:= Container
.Free
- 1;
111 (Container
: in out List
;
112 New_Node
: out Count_Type
)
114 N
: Node_Array
renames Container
.Nodes
;
117 if Container
.Free
>= 0 then
118 New_Node
:= Container
.Free
;
119 Container
.Free
:= N
(New_Node
).Next
;
122 New_Node
:= abs Container
.Free
;
123 Container
.Free
:= Container
.Free
- 1;
132 (Container
: in out List
;
133 New_Item
: Element_Type
;
134 Count
: Count_Type
:= 1)
137 Insert
(Container
, No_Element
, New_Item
, Count
);
144 procedure Assign
(Target
: in out List
; Source
: List
) is
145 N
: Node_Array
renames Source
.Nodes
;
149 if Target
'Address = Source
'Address then
153 if Target
.Capacity
< Source
.Length
then
154 raise Constraint_Error
with -- ???
155 "Source length exceeds Target capacity";
162 Append
(Target
, N
(J
).Element
);
171 procedure Clear
(Container
: in out List
) is
172 N
: Node_Array
renames Container
.Nodes
;
176 if Container
.Length
= 0 then
177 pragma Assert
(Container
.First
= 0);
178 pragma Assert
(Container
.Last
= 0);
182 pragma Assert
(Container
.First
>= 1);
183 pragma Assert
(Container
.Last
>= 1);
184 pragma Assert
(N
(Container
.First
).Prev
= 0);
185 pragma Assert
(N
(Container
.Last
).Next
= 0);
187 while Container
.Length
> 1 loop
188 X
:= Container
.First
;
190 Container
.First
:= N
(X
).Next
;
191 N
(Container
.First
).Prev
:= 0;
193 Container
.Length
:= Container
.Length
- 1;
198 X
:= Container
.First
;
200 Container
.First
:= 0;
202 Container
.Length
:= 0;
213 Item
: Element_Type
) return Boolean
216 return Find
(Container
, Item
) /= No_Element
;
225 Capacity
: Count_Type
:= 0) return List
227 C
: constant Count_Type
:= Count_Type
'Max (Source
.Capacity
, Capacity
);
233 while N
<= Source
.Capacity
loop
234 P
.Nodes
(N
).Prev
:= Source
.Nodes
(N
).Prev
;
235 P
.Nodes
(N
).Next
:= Source
.Nodes
(N
).Next
;
236 P
.Nodes
(N
).Element
:= Source
.Nodes
(N
).Element
;
240 P
.Free
:= Source
.Free
;
241 P
.Length
:= Source
.Length
;
242 P
.First
:= Source
.First
;
243 P
.Last
:= Source
.Last
;
246 N
:= Source
.Capacity
+ 1;
261 (Container
: in out List
;
262 Position
: in out Cursor
;
263 Count
: Count_Type
:= 1)
265 N
: Node_Array
renames Container
.Nodes
;
269 if not Has_Element
(Container
=> Container
,
270 Position
=> Position
)
272 raise Constraint_Error
with
273 "Position cursor has no element";
276 pragma Assert
(Vet
(Container
, Position
), "bad cursor in Delete");
277 pragma Assert
(Container
.First
>= 1);
278 pragma Assert
(Container
.Last
>= 1);
279 pragma Assert
(N
(Container
.First
).Prev
= 0);
280 pragma Assert
(N
(Container
.Last
).Next
= 0);
282 if Position
.Node
= Container
.First
then
283 Delete_First
(Container
, Count
);
284 Position
:= No_Element
;
289 Position
:= No_Element
;
293 for Index
in 1 .. Count
loop
294 pragma Assert
(Container
.Length
>= 2);
297 Container
.Length
:= Container
.Length
- 1;
299 if X
= Container
.Last
then
300 Position
:= No_Element
;
302 Container
.Last
:= N
(X
).Prev
;
303 N
(Container
.Last
).Next
:= 0;
309 Position
.Node
:= N
(X
).Next
;
310 pragma Assert
(N
(Position
.Node
).Prev
>= 0);
312 N
(N
(X
).Next
).Prev
:= N
(X
).Prev
;
313 N
(N
(X
).Prev
).Next
:= N
(X
).Next
;
317 Position
:= No_Element
;
324 procedure Delete_First
325 (Container
: in out List
;
326 Count
: Count_Type
:= 1)
328 N
: Node_Array
renames Container
.Nodes
;
332 if Count
>= Container
.Length
then
341 for J
in 1 .. Count
loop
342 X
:= Container
.First
;
343 pragma Assert
(N
(N
(X
).Next
).Prev
= Container
.First
);
345 Container
.First
:= N
(X
).Next
;
346 N
(Container
.First
).Prev
:= 0;
348 Container
.Length
:= Container
.Length
- 1;
358 procedure Delete_Last
359 (Container
: in out List
;
360 Count
: Count_Type
:= 1)
362 N
: Node_Array
renames Container
.Nodes
;
366 if Count
>= Container
.Length
then
375 for J
in 1 .. Count
loop
377 pragma Assert
(N
(N
(X
).Prev
).Next
= Container
.Last
);
379 Container
.Last
:= N
(X
).Prev
;
380 N
(Container
.Last
).Next
:= 0;
382 Container
.Length
:= Container
.Length
- 1;
394 Position
: Cursor
) return Element_Type
397 if not Has_Element
(Container
=> Container
, Position
=> Position
) then
398 raise Constraint_Error
with
399 "Position cursor has no element";
402 return Container
.Nodes
(Position
.Node
).Element
;
412 Position
: Cursor
:= No_Element
) return Cursor
414 From
: Count_Type
:= Position
.Node
;
417 if From
= 0 and Container
.Length
= 0 then
422 From
:= Container
.First
;
425 if Position
.Node
/= 0 and then
426 not Has_Element
(Container
, Position
)
428 raise Constraint_Error
with
429 "Position cursor has no element";
433 if Container
.Nodes
(From
).Element
= Item
then
434 return (Node
=> From
);
437 From
:= Container
.Nodes
(From
).Next
;
447 function First
(Container
: List
) return Cursor
is
449 if Container
.First
= 0 then
453 return (Node
=> Container
.First
);
460 function First_Element
(Container
: List
) return Element_Type
is
461 F
: constant Count_Type
:= Container
.First
;
464 raise Constraint_Error
with "list is empty";
466 return Container
.Nodes
(F
).Element
;
475 (Container
: in out List
;
478 pragma Assert
(X
> 0);
479 pragma Assert
(X
<= Container
.Capacity
);
481 N
: Node_Array
renames Container
.Nodes
;
484 N
(X
).Prev
:= -1; -- Node is deallocated (not on active list)
486 if Container
.Free
>= 0 then
487 N
(X
).Next
:= Container
.Free
;
490 elsif X
+ 1 = abs Container
.Free
then
491 N
(X
).Next
:= 0; -- Not strictly necessary, but marginally safer
492 Container
.Free
:= Container
.Free
+ 1;
495 Container
.Free
:= abs Container
.Free
;
497 if Container
.Free
> Container
.Capacity
then
501 for J
in Container
.Free
.. Container
.Capacity
- 1 loop
505 N
(Container
.Capacity
).Next
:= 0;
508 N
(X
).Next
:= Container
.Free
;
513 ---------------------
514 -- Generic_Sorting --
515 ---------------------
517 package body Generic_Sorting
is
523 function Is_Sorted
(Container
: List
) return Boolean is
524 Nodes
: Node_Array
renames Container
.Nodes
;
525 Node
: Count_Type
:= Container
.First
;
528 for J
in 2 .. Container
.Length
loop
529 if Nodes
(Nodes
(Node
).Next
).Element
< Nodes
(Node
).Element
then
532 Node
:= Nodes
(Node
).Next
;
544 (Target
: in out List
;
545 Source
: in out List
)
547 LN
: Node_Array
renames Target
.Nodes
;
548 RN
: Node_Array
renames Source
.Nodes
;
553 if Target
'Address = Source
'Address then
557 LI
:= First
(Target
);
558 RI
:= First
(Source
);
559 while RI
.Node
/= 0 loop
560 pragma Assert
(RN
(RI
.Node
).Next
= 0
561 or else not (RN
(RN
(RI
.Node
).Next
).Element
<
562 RN
(RI
.Node
).Element
));
565 Splice
(Target
, No_Element
, Source
);
569 pragma Assert
(LN
(LI
.Node
).Next
= 0
570 or else not (LN
(LN
(LI
.Node
).Next
).Element
<
571 LN
(LI
.Node
).Element
));
573 if RN
(RI
.Node
).Element
< LN
(LI
.Node
).Element
then
576 pragma Warnings
(Off
, RJ
);
578 RI
.Node
:= RN
(RI
.Node
).Next
;
579 Splice
(Target
, LI
, Source
, RJ
);
583 LI
.Node
:= LN
(LI
.Node
).Next
;
592 procedure Sort
(Container
: in out List
) is
593 N
: Node_Array
renames Container
.Nodes
;
595 procedure Partition
(Pivot
, Back
: Count_Type
);
596 procedure Sort
(Front
, Back
: Count_Type
);
602 procedure Partition
(Pivot
, Back
: Count_Type
) is
606 Node
:= N
(Pivot
).Next
;
607 while Node
/= Back
loop
608 if N
(Node
).Element
< N
(Pivot
).Element
then
610 Prev
: constant Count_Type
:= N
(Node
).Prev
;
611 Next
: constant Count_Type
:= N
(Node
).Next
;
614 N
(Prev
).Next
:= Next
;
617 Container
.Last
:= Prev
;
619 N
(Next
).Prev
:= Prev
;
622 N
(Node
).Next
:= Pivot
;
623 N
(Node
).Prev
:= N
(Pivot
).Prev
;
625 N
(Pivot
).Prev
:= Node
;
627 if N
(Node
).Prev
= 0 then
628 Container
.First
:= Node
;
630 N
(N
(Node
).Prev
).Next
:= Node
;
637 Node
:= N
(Node
).Next
;
646 procedure Sort
(Front
, Back
: Count_Type
) is
651 Pivot
:= Container
.First
;
653 Pivot
:= N
(Front
).Next
;
656 if Pivot
/= Back
then
657 Partition
(Pivot
, Back
);
663 -- Start of processing for Sort
666 if Container
.Length
<= 1 then
670 pragma Assert
(N
(Container
.First
).Prev
= 0);
671 pragma Assert
(N
(Container
.Last
).Next
= 0);
673 Sort
(Front
=> 0, Back
=> 0);
675 pragma Assert
(N
(Container
.First
).Prev
= 0);
676 pragma Assert
(N
(Container
.Last
).Next
= 0);
685 function Has_Element
(Container
: List
; Position
: Cursor
) return Boolean is
687 if Position
.Node
= 0 then
691 return Container
.Nodes
(Position
.Node
).Prev
/= -1;
699 (Container
: in out List
;
701 New_Item
: Element_Type
;
702 Position
: out Cursor
;
703 Count
: Count_Type
:= 1)
708 if Before
.Node
/= 0 then
709 pragma Assert
(Vet
(Container
, Before
), "bad cursor in Insert");
717 if Container
.Length
> Container
.Capacity
- Count
then
718 raise Constraint_Error
with "new length exceeds capacity";
721 Allocate
(Container
, New_Item
, New_Node
=> J
);
722 Insert_Internal
(Container
, Before
.Node
, New_Node
=> J
);
723 Position
:= (Node
=> J
);
725 for Index
in 2 .. Count
loop
726 Allocate
(Container
, New_Item
, New_Node
=> J
);
727 Insert_Internal
(Container
, Before
.Node
, New_Node
=> J
);
732 (Container
: in out List
;
734 New_Item
: Element_Type
;
735 Count
: Count_Type
:= 1)
739 Insert
(Container
, Before
, New_Item
, Position
, Count
);
743 (Container
: in out List
;
745 Position
: out Cursor
;
746 Count
: Count_Type
:= 1)
751 if Before
.Node
/= 0 then
752 pragma Assert
(Vet
(Container
, Before
), "bad cursor in Insert");
760 if Container
.Length
> Container
.Capacity
- Count
then
761 raise Constraint_Error
with "new length exceeds capacity";
764 Allocate
(Container
, New_Node
=> J
);
765 Insert_Internal
(Container
, Before
.Node
, New_Node
=> J
);
766 Position
:= (Node
=> J
);
768 for Index
in 2 .. Count
loop
769 Allocate
(Container
, New_Node
=> J
);
770 Insert_Internal
(Container
, Before
.Node
, New_Node
=> J
);
774 ---------------------
775 -- Insert_Internal --
776 ---------------------
778 procedure Insert_Internal
779 (Container
: in out List
;
781 New_Node
: Count_Type
)
783 N
: Node_Array
renames Container
.Nodes
;
786 if Container
.Length
= 0 then
787 pragma Assert
(Before
= 0);
788 pragma Assert
(Container
.First
= 0);
789 pragma Assert
(Container
.Last
= 0);
791 Container
.First
:= New_Node
;
792 Container
.Last
:= New_Node
;
794 N
(Container
.First
).Prev
:= 0;
795 N
(Container
.Last
).Next
:= 0;
797 elsif Before
= 0 then
798 pragma Assert
(N
(Container
.Last
).Next
= 0);
800 N
(Container
.Last
).Next
:= New_Node
;
801 N
(New_Node
).Prev
:= Container
.Last
;
803 Container
.Last
:= New_Node
;
804 N
(Container
.Last
).Next
:= 0;
806 elsif Before
= Container
.First
then
807 pragma Assert
(N
(Container
.First
).Prev
= 0);
809 N
(Container
.First
).Prev
:= New_Node
;
810 N
(New_Node
).Next
:= Container
.First
;
812 Container
.First
:= New_Node
;
813 N
(Container
.First
).Prev
:= 0;
816 pragma Assert
(N
(Container
.First
).Prev
= 0);
817 pragma Assert
(N
(Container
.Last
).Next
= 0);
819 N
(New_Node
).Next
:= Before
;
820 N
(New_Node
).Prev
:= N
(Before
).Prev
;
822 N
(N
(Before
).Prev
).Next
:= New_Node
;
823 N
(Before
).Prev
:= New_Node
;
826 Container
.Length
:= Container
.Length
+ 1;
833 function Is_Empty
(Container
: List
) return Boolean is
835 return Length
(Container
) = 0;
842 function Last
(Container
: List
) return Cursor
is
844 if Container
.Last
= 0 then
847 return (Node
=> Container
.Last
);
854 function Last_Element
(Container
: List
) return Element_Type
is
855 L
: constant Count_Type
:= Container
.Last
;
858 raise Constraint_Error
with "list is empty";
860 return Container
.Nodes
(L
).Element
;
868 function Left
(Container
: List
; Position
: Cursor
) return List
is
869 Curs
: Cursor
:= Position
;
870 C
: List
(Container
.Capacity
) := Copy
(Container
, Container
.Capacity
);
874 if Curs
= No_Element
then
878 if not Has_Element
(Container
, Curs
) then
879 raise Constraint_Error
;
882 while Curs
.Node
/= 0 loop
885 Curs
:= Next
(Container
, (Node
=> Node
));
895 function Length
(Container
: List
) return Count_Type
is
897 return Container
.Length
;
905 (Target
: in out List
;
906 Source
: in out List
)
908 N
: Node_Array
renames Source
.Nodes
;
912 if Target
'Address = Source
'Address then
916 if Target
.Capacity
< Source
.Length
then
917 raise Constraint_Error
with -- ???
918 "Source length exceeds Target capacity";
923 while Source
.Length
> 1 loop
924 pragma Assert
(Source
.First
in 1 .. Source
.Capacity
);
925 pragma Assert
(Source
.Last
/= Source
.First
);
926 pragma Assert
(N
(Source
.First
).Prev
= 0);
927 pragma Assert
(N
(Source
.Last
).Next
= 0);
929 -- Copy first element from Source to Target
932 Append
(Target
, N
(X
).Element
); -- optimize away???
934 -- Unlink first node of Source
936 Source
.First
:= N
(X
).Next
;
937 N
(Source
.First
).Prev
:= 0;
939 Source
.Length
:= Source
.Length
- 1;
941 -- The representation invariants for Source have been restored. It is
942 -- now safe to free the unlinked node, without fear of corrupting the
943 -- active links of Source.
945 -- Note that the algorithm we use here models similar algorithms used
946 -- in the unbounded form of the doubly-linked list container. In that
947 -- case, Free is an instantation of Unchecked_Deallocation, which can
948 -- fail (because PE will be raised if controlled Finalize fails), so
949 -- we must defer the call until the last step. Here in the bounded
950 -- form, Free merely links the node we have just "deallocated" onto a
951 -- list of inactive nodes, so technically Free cannot fail. However,
952 -- for consistency, we handle Free the same way here as we do for the
953 -- unbounded form, with the pessimistic assumption that it can fail.
958 if Source
.Length
= 1 then
959 pragma Assert
(Source
.First
in 1 .. Source
.Capacity
);
960 pragma Assert
(Source
.Last
= Source
.First
);
961 pragma Assert
(N
(Source
.First
).Prev
= 0);
962 pragma Assert
(N
(Source
.Last
).Next
= 0);
964 -- Copy element from Source to Target
967 Append
(Target
, N
(X
).Element
);
969 -- Unlink node of Source
975 -- Return the unlinked node to the free store
985 procedure Next
(Container
: List
; Position
: in out Cursor
) is
987 Position
:= Next
(Container
, Position
);
990 function Next
(Container
: List
; Position
: Cursor
) return Cursor
is
992 if Position
.Node
= 0 then
996 if not Has_Element
(Container
, Position
) then
997 raise Program_Error
with "Position cursor has no element";
1000 return (Node
=> Container
.Nodes
(Position
.Node
).Next
);
1008 (Container
: in out List
;
1009 New_Item
: Element_Type
;
1010 Count
: Count_Type
:= 1)
1013 Insert
(Container
, First
(Container
), New_Item
, Count
);
1020 procedure Previous
(Container
: List
; Position
: in out Cursor
) is
1022 Position
:= Previous
(Container
, Position
);
1025 function Previous
(Container
: List
; Position
: Cursor
) return Cursor
is
1027 if Position
.Node
= 0 then
1031 if not Has_Element
(Container
, Position
) then
1032 raise Program_Error
with "Position cursor has no element";
1035 return (Node
=> Container
.Nodes
(Position
.Node
).Prev
);
1038 ---------------------
1039 -- Replace_Element --
1040 ---------------------
1042 procedure Replace_Element
1043 (Container
: in out List
;
1045 New_Item
: Element_Type
)
1048 if not Has_Element
(Container
, Position
) then
1049 raise Constraint_Error
with "Position cursor has no element";
1053 (Vet
(Container
, Position
), "bad cursor in Replace_Element");
1055 Container
.Nodes
(Position
.Node
).Element
:= New_Item
;
1056 end Replace_Element
;
1058 ----------------------
1059 -- Reverse_Elements --
1060 ----------------------
1062 procedure Reverse_Elements
(Container
: in out List
) is
1063 N
: Node_Array
renames Container
.Nodes
;
1064 I
: Count_Type
:= Container
.First
;
1065 J
: Count_Type
:= Container
.Last
;
1067 procedure Swap
(L
, R
: Count_Type
);
1073 procedure Swap
(L
, R
: Count_Type
) is
1074 LN
: constant Count_Type
:= N
(L
).Next
;
1075 LP
: constant Count_Type
:= N
(L
).Prev
;
1077 RN
: constant Count_Type
:= N
(R
).Next
;
1078 RP
: constant Count_Type
:= N
(R
).Prev
;
1093 pragma Assert
(RP
= L
);
1107 -- Start of processing for Reverse_Elements
1110 if Container
.Length
<= 1 then
1114 pragma Assert
(N
(Container
.First
).Prev
= 0);
1115 pragma Assert
(N
(Container
.Last
).Next
= 0);
1117 Container
.First
:= J
;
1118 Container
.Last
:= I
;
1120 Swap
(L
=> I
, R
=> J
);
1128 Swap
(L
=> J
, R
=> I
);
1137 pragma Assert
(N
(Container
.First
).Prev
= 0);
1138 pragma Assert
(N
(Container
.Last
).Next
= 0);
1139 end Reverse_Elements
;
1145 function Reverse_Find
1147 Item
: Element_Type
;
1148 Position
: Cursor
:= No_Element
) return Cursor
1150 CFirst
: Count_Type
:= Position
.Node
;
1154 CFirst
:= Container
.First
;
1157 if Container
.Length
= 0 then
1161 while CFirst
/= 0 loop
1162 if Container
.Nodes
(CFirst
).Element
= Item
then
1163 return (Node
=> CFirst
);
1165 CFirst
:= Container
.Nodes
(CFirst
).Prev
;
1175 function Right
(Container
: List
; Position
: Cursor
) return List
is
1176 Curs
: Cursor
:= First
(Container
);
1177 C
: List
(Container
.Capacity
) := Copy
(Container
, Container
.Capacity
);
1181 if Curs
= No_Element
then
1186 if Position
/= No_Element
and not Has_Element
(Container
, Position
) then
1187 raise Constraint_Error
;
1190 while Curs
.Node
/= Position
.Node
loop
1193 Curs
:= Next
(Container
, (Node
=> Node
));
1204 (Target
: in out List
;
1206 Source
: in out List
)
1208 SN
: Node_Array
renames Source
.Nodes
;
1211 if Before
.Node
/= 0 then
1212 pragma Assert
(Vet
(Target
, Before
), "bad cursor in Splice");
1215 if Target
'Address = Source
'Address
1216 or else Source
.Length
= 0
1221 pragma Assert
(SN
(Source
.First
).Prev
= 0);
1222 pragma Assert
(SN
(Source
.Last
).Next
= 0);
1224 if Target
.Length
> Count_Type
'Base'Last - Source.Length then
1225 raise Constraint_Error with "new length exceeds maximum";
1228 if Target.Length + Source.Length > Target.Capacity then
1229 raise Constraint_Error;
1233 Insert (Target, Before, SN (Source.Last).Element);
1234 Delete_Last (Source);
1235 exit when Is_Empty (Source);
1240 (Target : in out List;
1242 Source : in out List;
1243 Position : in out Cursor)
1245 Target_Position : Cursor;
1248 if Target'Address = Source'Address then
1249 Splice (Target, Before, Position);
1253 if Position.Node = 0 then
1254 raise Constraint_Error with "Position cursor has no element";
1257 pragma Assert (Vet (Source, Position), "bad Position cursor in Splice");
1259 if Target.Length >= Target.Capacity then
1260 raise Constraint_Error;
1264 (Container => Target,
1266 New_Item => Source.Nodes (Position.Node).Element,
1267 Position => Target_Position);
1269 Delete (Source, Position);
1270 Position := Target_Position;
1274 (Container : in out List;
1278 N : Node_Array renames Container.Nodes;
1281 if Before.Node /= 0 then
1283 (Vet (Container, Before), "bad Before cursor in Splice");
1286 if Position.Node = 0 then
1287 raise Constraint_Error with "Position cursor has no element";
1291 (Vet (Container, Position), "bad Position cursor in Splice");
1293 if Position.Node = Before.Node
1294 or else N (Position.Node).Next = Before.Node
1299 pragma Assert (Container.Length >= 2);
1301 if Before.Node = 0 then
1302 pragma Assert (Position.Node /= Container.Last);
1304 if Position.Node = Container.First then
1305 Container.First := N (Position.Node).Next;
1306 N (Container.First).Prev := 0;
1309 N (N (Position.Node).Prev).Next := N (Position.Node).Next;
1310 N (N (Position.Node).Next).Prev := N (Position.Node).Prev;
1313 N (Container.Last).Next := Position.Node;
1314 N (Position.Node).Prev := Container.Last;
1316 Container.Last := Position.Node;
1317 N (Container.Last).Next := 0;
1322 if Before.Node = Container.First then
1323 pragma Assert (Position.Node /= Container.First);
1325 if Position.Node = Container.Last then
1326 Container.Last := N (Position.Node).Prev;
1327 N (Container.Last).Next := 0;
1330 N (N (Position.Node).Prev).Next := N (Position.Node).Next;
1331 N (N (Position.Node).Next).Prev := N (Position.Node).Prev;
1334 N (Container.First).Prev := Position.Node;
1335 N (Position.Node).Next := Container.First;
1337 Container.First := Position.Node;
1338 N (Container.First).Prev := 0;
1343 if Position.Node = Container.First then
1344 Container.First := N (Position.Node).Next;
1345 N (Container.First).Prev := 0;
1347 elsif Position.Node = Container.Last then
1348 Container.Last := N (Position.Node).Prev;
1349 N (Container.Last).Next := 0;
1352 N (N (Position.Node).Prev).Next := N (Position.Node).Next;
1353 N (N (Position.Node).Next).Prev := N (Position.Node).Prev;
1356 N (N (Before.Node).Prev).Next := Position.Node;
1357 N (Position.Node).Prev := N (Before.Node).Prev;
1359 N (Before.Node).Prev := Position.Node;
1360 N (Position.Node).Next := Before.Node;
1362 pragma Assert (N (Container.First).Prev = 0);
1363 pragma Assert (N (Container.Last).Next = 0);
1370 function Strict_Equal (Left, Right : List) return Boolean is
1371 CL : Count_Type := Left.First;
1372 CR : Count_Type := Right.First;
1375 while CL /= 0 or CR /= 0 loop
1377 Left.Nodes (CL).Element /= Right.Nodes (CL).Element
1382 CL := Left.Nodes (CL).Next;
1383 CR := Right.Nodes (CR).Next;
1394 (Container : in out List;
1399 raise Constraint_Error with "I cursor has no element";
1403 raise Constraint_Error with "J cursor has no element";
1406 if I.Node = J.Node then
1410 pragma Assert (Vet (Container, I), "bad I cursor in Swap");
1411 pragma Assert (Vet (Container, J), "bad J cursor in Swap");
1414 NN : Node_Array renames Container.Nodes;
1415 NI : Node_Type renames NN (I.Node);
1416 NJ : Node_Type renames NN (J.Node);
1418 EI_Copy : constant Element_Type := NI.Element;
1421 NI.Element := NJ.Element;
1422 NJ.Element := EI_Copy;
1430 procedure Swap_Links
1431 (Container : in out List;
1434 I_Next, J_Next : Cursor;
1438 raise Constraint_Error with "I cursor has no element";
1442 raise Constraint_Error with "J cursor has no element";
1445 if I.Node = J.Node then
1449 pragma Assert (Vet (Container, I), "bad I cursor in Swap_Links");
1450 pragma Assert (Vet (Container, J), "bad J cursor in Swap_Links");
1452 I_Next := Next (Container, I);
1455 Splice (Container, Before => I, Position => J);
1458 J_Next := Next (Container, J);
1461 Splice (Container, Before => J, Position => I);
1464 pragma Assert (Container.Length >= 3);
1465 Splice (Container, Before => I_Next, Position => J);
1466 Splice (Container, Before => J_Next, Position => I);
1475 function Vet (L : List; Position : Cursor) return Boolean is
1476 N : Node_Array renames L.Nodes;
1479 if L.Length = 0 then
1491 if Position.Node > L.Capacity then
1495 if N (Position.Node).Prev < 0
1496 or else N (Position.Node).Prev > L.Capacity
1501 if N (Position.Node).Next > L.Capacity then
1505 if N (L.First).Prev /= 0 then
1509 if N (L.Last).Next /= 0 then
1513 if N (Position.Node).Prev = 0
1514 and then Position.Node /= L.First
1519 if N (Position.Node).Next = 0
1520 and then Position.Node /= L.Last
1525 if L.Length = 1 then
1526 return L.First = L.Last;
1529 if L.First = L.Last then
1533 if N (L.First).Next = 0 then
1537 if N (L.Last).Prev = 0 then
1541 if N (N (L.First).Next).Prev /= L.First then
1545 if N (N (L.Last).Prev).Next /= L.Last then
1549 if L.Length = 2 then
1550 if N (L.First).Next /= L.Last then
1554 if N (L.Last).Prev /= L.First then
1561 if N (L.First).Next = L.Last then
1565 if N (L.Last).Prev = L.First then
1569 if Position.Node = L.First then
1573 if Position.Node = L.Last then
1577 if N (Position.Node).Next = 0 then
1581 if N (Position.Node).Prev = 0 then
1585 if N (N (Position.Node).Next).Prev /= Position.Node then
1589 if N (N (Position.Node).Prev).Next /= Position.Node then
1593 if L.Length = 3 then
1594 if N (L.First).Next /= Position.Node then
1598 if N (L.Last).Prev /= Position.Node then
1606 end Ada.Containers.Formal_Doubly_Linked_Lists;