1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.FORMAL_DOUBLY_LINKED_LISTS --
9 -- Copyright (C) 2004-2017, Free Software Foundation, Inc. --
11 -- This specification is derived from the Ada Reference Manual for use with --
12 -- GNAT. The copyright notice above, and the license provisions that follow --
13 -- apply solely to the contents of the part following the private keyword. --
15 -- GNAT is free software; you can redistribute it and/or modify it under --
16 -- terms of the GNU General Public License as published by the Free Soft- --
17 -- ware Foundation; either version 3, or (at your option) any later ver- --
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
20 -- or FITNESS FOR A PARTICULAR PURPOSE. --
22 -- As a special exception under Section 7 of GPL version 3, you are granted --
23 -- additional permissions described in the GCC Runtime Library Exception, --
24 -- version 3.1, as published by the Free Software Foundation. --
26 -- You should have received a copy of the GNU General Public License and --
27 -- a copy of the GCC Runtime Library Exception along with this program; --
28 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
29 -- <http://www.gnu.org/licenses/>. --
30 ------------------------------------------------------------------------------
32 with Ada
.Containers
.Functional_Vectors
;
33 with Ada
.Containers
.Functional_Maps
;
36 type Element_Type
is private;
38 package Ada
.Containers
.Formal_Doubly_Linked_Lists
with
41 pragma Annotate
(CodePeer
, Skip_Analysis
);
43 type List
(Capacity
: Count_Type
) is private with
44 Iterable
=> (First
=> First
,
46 Has_Element
=> Has_Element
,
48 Default_Initial_Condition
=> Is_Empty
(List
);
49 pragma Preelaborable_Initialization
(List
);
52 Node
: Count_Type
:= 0;
55 No_Element
: constant Cursor
:= Cursor
'(Node => 0);
57 Empty_List : constant List;
59 function Length (Container : List) return Count_Type with
61 Post => Length'Result <= Container.Capacity;
63 pragma Unevaluated_Use_Of_Old (Allow);
65 package Formal_Model with Ghost is
66 subtype Positive_Count_Type is Count_Type range 1 .. Count_Type'Last;
68 package M is new Ada.Containers.Functional_Vectors
69 (Index_Type => Positive_Count_Type,
70 Element_Type => Element_Type);
74 Right : M.Sequence) return Boolean renames M."=";
78 Right : M.Sequence) return Boolean renames M."<";
82 Right : M.Sequence) return Boolean renames M."<=";
84 function M_Elements_In_Union
85 (Container : M.Sequence;
87 Right : M.Sequence) return Boolean
88 -- The elements of Container are contained in either Left or Right
92 M_Elements_In_Union'Result =
93 (for all I in 1 .. M.Length (Container) =>
94 (for some J in 1 .. M.Length (Left) =>
95 Element (Container, I) = Element (Left, J))
96 or (for some J in 1 .. M.Length (Right) =>
97 Element (Container, I) = Element (Right, J)));
98 pragma Annotate (GNATprove, Inline_For_Proof, M_Elements_In_Union);
100 function M_Elements_Included
102 L_Fst : Positive_Count_Type := 1;
105 R_Fst : Positive_Count_Type := 1;
106 R_Lst : Count_Type) return Boolean
107 -- The elements of the slice from L_Fst to L_Lst in Left are contained
108 -- in the slide from R_Fst to R_Lst in Right.
111 Pre => L_Lst <= M.Length (Left) and R_Lst <= M.Length (Right),
113 M_Elements_Included'Result =
114 (for all I in L_Fst .. L_Lst =>
115 (for some J in R_Fst .. R_Lst =>
116 Element (Left, I) = Element (Right, J)));
117 pragma Annotate (GNATprove, Inline_For_Proof, M_Elements_Included);
119 function M_Elements_Reversed
121 Right : M.Sequence) return Boolean
122 -- Right is Left in reverse order
126 M_Elements_Reversed'Result =
127 (M.Length (Left) = M.Length (Right)
128 and (for all I in 1 .. M.Length (Left) =>
130 Element (Right, M.Length (Left) - I + 1))
131 and (for all I in 1 .. M.Length (Left) =>
133 Element (Left, M.Length (Left) - I + 1)));
134 pragma Annotate (GNATprove, Inline_For_Proof, M_Elements_Reversed);
136 function M_Elements_Swapped
139 X : Positive_Count_Type;
140 Y : Positive_Count_Type) return Boolean
141 -- Elements stored at X and Y are reversed in Left and Right
144 Pre => X <= M.Length (Left) and Y <= M.Length (Left),
146 M_Elements_Swapped'Result =
147 (M.Length (Left) = M.Length (Right)
148 and Element (Left, X) = Element (Right, Y)
149 and Element (Left, Y) = Element (Right, X)
150 and M.Equal_Except (Left, Right, X, Y));
151 pragma Annotate (GNATprove, Inline_For_Proof, M_Elements_Swapped);
153 package P is new Ada.Containers.Functional_Maps
155 Element_Type => Positive_Count_Type,
156 Equivalent_Keys => "=",
157 Enable_Handling_Of_Equivalence => False);
161 Right : P.Map) return Boolean renames P."=";
165 Right : P.Map) return Boolean renames P."<=";
167 function P_Positions_Shifted
170 Cut : Positive_Count_Type;
171 Count : Count_Type := 1) return Boolean
175 P_Positions_Shifted'Result =
177 -- Big contains all cursors of Small
179 (P.Keys_Included (Small, Big)
181 -- Cursors located before Cut are not moved, cursors located
182 -- after are shifted by Count.
184 and (for all I of Small =>
185 (if P.Get (Small, I) < Cut then
186 P.Get (Big, I) = P.Get (Small, I)
188 P.Get (Big, I) - Count = P.Get (Small, I)))
190 -- New cursors of Big (if any) are between Cut and Cut - 1 +
193 and (for all I of Big =>
195 or P.Get (Big, I) - Count in Cut - Count .. Cut - 1));
197 function P_Positions_Swapped
201 Y : Cursor) return Boolean
202 -- Left and Right contain the same cursors, but the positions of X and Y
208 P_Positions_Swapped'Result =
209 (P.Same_Keys (Left, Right)
210 and P.Elements_Equal_Except (Left, Right, X, Y)
211 and P.Has_Key (Left, X)
212 and P.Has_Key (Left, Y)
213 and P.Get (Left, X) = P.Get (Right, Y)
214 and P.Get (Left, Y) = P.Get (Right, X));
216 function P_Positions_Truncated
219 Cut : Positive_Count_Type;
220 Count : Count_Type := 1) return Boolean
225 P_Positions_Truncated'Result =
227 -- Big contains all cursors of Small at the same position
231 -- New cursors of Big (if any) are between Cut and Cut - 1 +
234 and (for all I of Big =>
236 or P.Get (Big, I) - Count in Cut - Count .. Cut - 1));
238 function Mapping_Preserved
239 (M_Left : M.Sequence;
240 M_Right : M.Sequence;
242 P_Right : P.Map) return Boolean
247 (if Mapping_Preserved'Result then
249 -- Left and Right contain the same cursors
251 P.Same_Keys (P_Left, P_Right)
253 -- Mappings from cursors to elements induced by M_Left, P_Left
254 -- and M_Right, P_Right are the same.
256 and (for all C of P_Left =>
257 M.Get (M_Left, P.Get (P_Left, C)) =
258 M.Get (M_Right, P.Get (P_Right, C))));
260 function Model (Container : List) return M.Sequence with
261 -- The high-level model of a list is a sequence of elements. Cursors are
262 -- not represented in this model.
266 Post => M.Length (Model'Result) = Length (Container);
267 pragma Annotate (GNATprove, Iterable_For_Proof, "Model", Model);
269 function Positions (Container : List) return P.Map with
270 -- The Positions map is used to model cursors. It only contains valid
271 -- cursors and map them to their position in the container.
276 not P.Has_Key (Positions'Result, No_Element)
278 -- Positions of cursors are smaller than the container's length.
281 (for all I of Positions'Result =>
282 P.Get (Positions'Result, I) in 1 .. Length (Container)
284 -- No two cursors have the same position. Note that we do not
285 -- state that there is a cursor in the map for each position, as
286 -- it is rarely needed.
289 (for all J of Positions'Result =>
290 (if P.Get (Positions'Result, I) = P.Get (Positions'Result, J)
293 procedure Lift_Abstraction_Level (Container : List) with
294 -- Lift_Abstraction_Level is a ghost procedure that does nothing but
295 -- assume that we can access to the same elements by iterating over
296 -- positions or cursors.
297 -- This information is not generally useful except when switching from
298 -- a low-level cursor-aware view of a container to a high-level
299 -- position-based view.
304 (for all Elt of Model (Container) =>
305 (for some I of Positions (Container) =>
306 M.Get (Model (Container), P.Get (Positions (Container), I)) =
311 I : Count_Type) return Element_Type renames M.Get;
312 -- To improve readability of contracts, we rename the function used to
313 -- access an element in the model to Element.
318 function "=" (Left, Right : List) return Boolean with
320 Post => "="'Result
= (Model
(Left
) = Model
(Right
));
322 function Is_Empty
(Container
: List
) return Boolean with
324 Post
=> Is_Empty
'Result = (Length
(Container
) = 0);
326 procedure Clear
(Container
: in out List
) with
328 Post
=> Length
(Container
) = 0;
330 procedure Assign
(Target
: in out List
; Source
: List
) with
332 Pre
=> Target
.Capacity
>= Length
(Source
),
333 Post
=> Model
(Target
) = Model
(Source
);
335 function Copy
(Source
: List
; Capacity
: Count_Type
:= 0) return List
with
337 Pre
=> Capacity
= 0 or else Capacity
>= Source
.Capacity
,
339 Model
(Copy
'Result) = Model
(Source
)
340 and Positions
(Copy
'Result) = Positions
(Source
)
341 and (if Capacity
= 0 then
342 Copy
'Result.Capacity
= Source
.Capacity
344 Copy
'Result.Capacity
= Capacity
);
348 Position
: Cursor
) return Element_Type
351 Pre
=> Has_Element
(Container
, Position
),
354 Element
(Model
(Container
), P
.Get
(Positions
(Container
), Position
));
355 pragma Annotate
(GNATprove
, Inline_For_Proof
, Element
);
357 procedure Replace_Element
358 (Container
: in out List
;
360 New_Item
: Element_Type
)
363 Pre
=> Has_Element
(Container
, Position
),
365 Length
(Container
) = Length
(Container
)'Old
367 -- Cursors are preserved
369 and Positions
(Container
)'Old = Positions
(Container
)
371 -- The element at the position of Position in Container is New_Item
375 P
.Get
(Positions
(Container
), Position
)) = New_Item
377 -- Other elements are preserved
380 (Model
(Container
)'Old,
382 P
.Get
(Positions
(Container
), Position
));
384 procedure Move
(Target
: in out List
; Source
: in out List
) with
386 Pre
=> Target
.Capacity
>= Length
(Source
),
387 Post
=> Model
(Target
) = Model
(Source
'Old) and Length
(Source
) = 0;
390 (Container
: in out List
;
392 New_Item
: Element_Type
)
396 Length
(Container
) < Container
.Capacity
397 and then (Has_Element
(Container
, Before
)
398 or else Before
= No_Element
),
399 Post
=> Length
(Container
) = Length
(Container
)'Old + 1,
401 (Before
= No_Element
=>
403 -- Positions contains a new mapping from the last cursor of
404 -- Container to its length.
406 P
.Get
(Positions
(Container
), Last
(Container
)) = Length
(Container
)
408 -- Other cursors come from Container'Old
410 and P
.Keys_Included_Except
411 (Left
=> Positions
(Container
),
412 Right
=> Positions
(Container
)'Old,
413 New_Key
=> Last
(Container
))
415 -- Cursors of Container'Old keep the same position
417 and Positions
(Container
)'Old <= Positions
(Container
)
419 -- Model contains a new element New_Item at the end
421 and Element
(Model
(Container
), Length
(Container
)) = New_Item
423 -- Elements of Container'Old are preserved
425 and Model
(Container
)'Old <= Model
(Container
),
429 -- The elements of Container located before Before are preserved
432 (Left
=> Model
(Container
)'Old,
433 Right
=> Model
(Container
),
435 Lst
=> P
.Get
(Positions
(Container
)'Old, Before
) - 1)
437 -- Other elements are shifted by 1
440 (Left
=> Model
(Container
)'Old,
441 Right
=> Model
(Container
),
442 Fst
=> P
.Get
(Positions
(Container
)'Old, Before
),
443 Lst
=> Length
(Container
)'Old,
446 -- New_Item is stored at the previous position of Before in
451 P
.Get
(Positions
(Container
)'Old, Before
)) = New_Item
453 -- A new cursor has been inserted at position Before in Container
455 and P_Positions_Shifted
456 (Positions
(Container
)'Old,
457 Positions
(Container
),
458 Cut
=> P
.Get
(Positions
(Container
)'Old, Before
)));
461 (Container
: in out List
;
463 New_Item
: Element_Type
;
468 Length
(Container
) <= Container
.Capacity
- Count
469 and then (Has_Element
(Container
, Before
)
470 or else Before
= No_Element
),
471 Post
=> Length
(Container
) = Length
(Container
)'Old + Count
,
473 (Before
= No_Element
=>
475 -- The elements of Container are preserved
478 (Left
=> Model
(Container
)'Old,
479 Right
=> Model
(Container
),
481 Lst
=> Length
(Container
)'Old)
483 -- Container contains Count times New_Item at the end
485 and (if Count
> 0 then
487 (Container
=> Model
(Container
),
488 Fst
=> Length
(Container
)'Old + 1,
489 Lst
=> Length
(Container
),
492 -- Container contains Count times New_Item at the end
495 (Container
=> Model
(Container
),
496 Fst
=> Length
(Container
)'Old + 1,
497 Lst
=> Length
(Container
),
500 -- A Count cursors have been inserted at the end of Container
502 and P_Positions_Truncated
503 (Positions
(Container
)'Old,
504 Positions
(Container
),
505 Cut
=> Length
(Container
)'Old + 1,
510 -- The elements of Container located before Before are preserved
513 (Left
=> Model
(Container
)'Old,
514 Right
=> Model
(Container
),
516 Lst
=> P
.Get
(Positions
(Container
)'Old, Before
) - 1)
518 -- Other elements are shifted by Count
521 (Left
=> Model
(Container
)'Old,
522 Right
=> Model
(Container
),
523 Fst
=> P
.Get
(Positions
(Container
)'Old, Before
),
524 Lst
=> Length
(Container
)'Old,
527 -- Container contains Count times New_Item after position Before
530 (Container
=> Model
(Container
),
531 Fst
=> P
.Get
(Positions
(Container
)'Old, Before
),
533 P
.Get
(Positions
(Container
)'Old, Before
) - 1 + Count
,
536 -- Count cursors have been inserted at position Before in
539 and P_Positions_Shifted
540 (Positions
(Container
)'Old,
541 Positions
(Container
),
542 Cut
=> P
.Get
(Positions
(Container
)'Old, Before
),
546 (Container
: in out List
;
548 New_Item
: Element_Type
;
549 Position
: out Cursor
)
553 Length
(Container
) < Container
.Capacity
554 and then (Has_Element
(Container
, Before
)
555 or else Before
= No_Element
),
557 Length
(Container
) = Length
(Container
)'Old + 1
559 -- Positions is valid in Container and it is located either before
560 -- Before if it is valid in Container or at the end if it is
563 and P
.Has_Key
(Positions
(Container
), Position
)
564 and (if Before
= No_Element
then
565 P
.Get
(Positions
(Container
), Position
) = Length
(Container
)
567 P
.Get
(Positions
(Container
), Position
) =
568 P
.Get
(Positions
(Container
)'Old, Before
))
570 -- The elements of Container located before Position are preserved
573 (Left
=> Model
(Container
)'Old,
574 Right
=> Model
(Container
),
576 Lst
=> P
.Get
(Positions
(Container
), Position
) - 1)
578 -- Other elements are shifted by 1
581 (Left
=> Model
(Container
)'Old,
582 Right
=> Model
(Container
),
583 Fst
=> P
.Get
(Positions
(Container
), Position
),
584 Lst
=> Length
(Container
)'Old,
587 -- New_Item is stored at Position in Container
591 P
.Get
(Positions
(Container
), Position
)) = New_Item
593 -- A new cursor has been inserted at position Position in Container
595 and P_Positions_Shifted
596 (Positions
(Container
)'Old,
597 Positions
(Container
),
598 Cut
=> P
.Get
(Positions
(Container
), Position
));
601 (Container
: in out List
;
603 New_Item
: Element_Type
;
604 Position
: out Cursor
;
609 Length
(Container
) <= Container
.Capacity
- Count
610 and then (Has_Element
(Container
, Before
)
611 or else Before
= No_Element
),
612 Post
=> Length
(Container
) = Length
(Container
)'Old + Count
,
616 and Model
(Container
) = Model
(Container
)'Old
617 and Positions
(Container
) = Positions
(Container
)'Old,
621 -- Positions is valid in Container and it is located either before
622 -- Before if it is valid in Container or at the end if it is
625 P
.Has_Key
(Positions
(Container
), Position
)
626 and (if Before
= No_Element
then
627 P
.Get
(Positions
(Container
), Position
) =
628 Length
(Container
)'Old + 1
630 P
.Get
(Positions
(Container
), Position
) =
631 P
.Get
(Positions
(Container
)'Old, Before
))
633 -- The elements of Container located before Position are preserved
636 (Left
=> Model
(Container
)'Old,
637 Right
=> Model
(Container
),
639 Lst
=> P
.Get
(Positions
(Container
), Position
) - 1)
641 -- Other elements are shifted by Count
644 (Left
=> Model
(Container
)'Old,
645 Right
=> Model
(Container
),
646 Fst
=> P
.Get
(Positions
(Container
), Position
),
647 Lst
=> Length
(Container
)'Old,
650 -- Container contains Count times New_Item after position Position
653 (Container
=> Model
(Container
),
654 Fst
=> P
.Get
(Positions
(Container
), Position
),
656 P
.Get
(Positions
(Container
), Position
) - 1 + Count
,
659 -- Count cursor have been inserted at Position in Container
661 and P_Positions_Shifted
662 (Positions
(Container
)'Old,
663 Positions
(Container
),
664 Cut
=> P
.Get
(Positions
(Container
), Position
),
667 procedure Prepend
(Container
: in out List
; New_Item
: Element_Type
) with
669 Pre
=> Length
(Container
) < Container
.Capacity
,
671 Length
(Container
) = Length
(Container
)'Old + 1
673 -- Elements are shifted by 1
676 (Left
=> Model
(Container
)'Old,
677 Right
=> Model
(Container
),
679 Lst
=> Length
(Container
)'Old,
682 -- New_Item is the first element of Container
684 and Element
(Model
(Container
), 1) = New_Item
686 -- A new cursor has been inserted at the beginning of Container
688 and P_Positions_Shifted
689 (Positions
(Container
)'Old,
690 Positions
(Container
),
694 (Container
: in out List
;
695 New_Item
: Element_Type
;
699 Pre
=> Length
(Container
) <= Container
.Capacity
- Count
,
701 Length
(Container
) = Length
(Container
)'Old + Count
703 -- Elements are shifted by Count
706 (Left
=> Model
(Container
)'Old,
707 Right
=> Model
(Container
),
709 Lst
=> Length
(Container
)'Old,
712 -- Container starts with Count times New_Item
715 (Container
=> Model
(Container
),
720 -- Count cursors have been inserted at the beginning of Container
722 and P_Positions_Shifted
723 (Positions
(Container
)'Old,
724 Positions
(Container
),
728 procedure Append
(Container
: in out List
; New_Item
: Element_Type
) with
730 Pre
=> Length
(Container
) < Container
.Capacity
,
732 Length
(Container
) = Length
(Container
)'Old + 1
734 -- Positions contains a new mapping from the last cursor of Container
737 and P
.Get
(Positions
(Container
), Last
(Container
)) =
740 -- Other cursors come from Container'Old
742 and P
.Keys_Included_Except
743 (Left
=> Positions
(Container
),
744 Right
=> Positions
(Container
)'Old,
745 New_Key
=> Last
(Container
))
747 -- Cursors of Container'Old keep the same position
749 and Positions
(Container
)'Old <= Positions
(Container
)
751 -- Model contains a new element New_Item at the end
753 and Element
(Model
(Container
), Length
(Container
)) = New_Item
755 -- Elements of Container'Old are preserved
757 and Model
(Container
)'Old <= Model
(Container
);
760 (Container
: in out List
;
761 New_Item
: Element_Type
;
765 Pre
=> Length
(Container
) <= Container
.Capacity
- Count
,
767 Length
(Container
) = Length
(Container
)'Old + Count
769 -- The elements of Container are preserved
771 and Model
(Container
)'Old <= Model
(Container
)
773 -- Container contains Count times New_Item at the end
775 and (if Count
> 0 then
777 (Container
=> Model
(Container
),
778 Fst
=> Length
(Container
)'Old + 1,
779 Lst
=> Length
(Container
),
782 -- Count cursors have been inserted at the end of Container
784 and P_Positions_Truncated
785 (Positions
(Container
)'Old,
786 Positions
(Container
),
787 Cut
=> Length
(Container
)'Old + 1,
790 procedure Delete
(Container
: in out List
; Position
: in out Cursor
) with
792 Pre
=> Has_Element
(Container
, Position
),
794 Length
(Container
) = Length
(Container
)'Old - 1
796 -- Position is set to No_Element
798 and Position
= No_Element
800 -- The elements of Container located before Position are preserved.
803 (Left
=> Model
(Container
)'Old,
804 Right
=> Model
(Container
),
806 Lst
=> P
.Get
(Positions
(Container
)'Old, Position
'Old) - 1)
808 -- The elements located after Position are shifted by 1
811 (Left
=> Model
(Container
),
812 Right
=> Model
(Container
)'Old,
813 Fst
=> P
.Get
(Positions
(Container
)'Old, Position
'Old),
814 Lst
=> Length
(Container
),
817 -- Position has been removed from Container
819 and P_Positions_Shifted
820 (Positions
(Container
),
821 Positions
(Container
)'Old,
822 Cut
=> P
.Get
(Positions
(Container
)'Old, Position
'Old));
825 (Container
: in out List
;
826 Position
: in out Cursor
;
830 Pre
=> Has_Element
(Container
, Position
),
832 Length
(Container
) in
833 Length
(Container
)'Old - Count
.. Length
(Container
)'Old
835 -- Position is set to No_Element
837 and Position
= No_Element
839 -- The elements of Container located before Position are preserved.
842 (Left
=> Model
(Container
)'Old,
843 Right
=> Model
(Container
),
845 Lst
=> P
.Get
(Positions
(Container
)'Old, Position
'Old) - 1),
849 -- All the elements after Position have been erased
851 (Length
(Container
) - Count
< P
.Get
(Positions
(Container
), Position
) =>
853 P
.Get
(Positions
(Container
)'Old, Position
'Old) - 1
855 -- At most Count cursors have been removed at the end of Container
857 and P_Positions_Truncated
858 (Positions
(Container
),
859 Positions
(Container
)'Old,
860 Cut
=> P
.Get
(Positions
(Container
)'Old, Position
'Old),
864 Length
(Container
) = Length
(Container
)'Old - Count
866 -- Other elements are shifted by Count
869 (Left
=> Model
(Container
),
870 Right
=> Model
(Container
)'Old,
871 Fst
=> P
.Get
(Positions
(Container
)'Old, Position
'Old),
872 Lst
=> Length
(Container
),
875 -- Count cursors have been removed from Container at Position
877 and P_Positions_Shifted
878 (Positions
(Container
),
879 Positions
(Container
)'Old,
880 Cut
=> P
.Get
(Positions
(Container
)'Old, Position
'Old),
883 procedure Delete_First
(Container
: in out List
) with
885 Pre
=> not Is_Empty
(Container
),
887 Length
(Container
) = Length
(Container
)'Old - 1
889 -- The elements of Container are shifted by 1
892 (Left
=> Model
(Container
),
893 Right
=> Model
(Container
)'Old,
895 Lst
=> Length
(Container
),
898 -- The first cursor of Container has been removed
900 and P_Positions_Shifted
901 (Positions
(Container
),
902 Positions
(Container
)'Old,
905 procedure Delete_First
(Container
: in out List
; Count
: Count_Type
) with
909 -- All the elements of Container have been erased
911 (Length
(Container
) <= Count
=>
912 Length
(Container
) = 0,
915 Length
(Container
) = Length
(Container
)'Old - Count
917 -- Elements of Container are shifted by Count
920 (Left
=> Model
(Container
),
921 Right
=> Model
(Container
)'Old,
923 Lst
=> Length
(Container
),
926 -- The first Count cursors have been removed from Container
928 and P_Positions_Shifted
929 (Positions
(Container
),
930 Positions
(Container
)'Old,
934 procedure Delete_Last
(Container
: in out List
) with
936 Pre
=> not Is_Empty
(Container
),
938 Length
(Container
) = Length
(Container
)'Old - 1
940 -- The elements of Container are preserved
942 and Model
(Container
) <= Model
(Container
)'Old
944 -- The last cursor of Container has been removed
946 and not P
.Has_Key
(Positions
(Container
), Last
(Container
)'Old)
948 -- Other cursors are still valid
950 and P
.Keys_Included_Except
951 (Left
=> Positions
(Container
)'Old,
952 Right
=> Positions
(Container
)'Old,
953 New_Key
=> Last
(Container
)'Old)
955 -- The positions of other cursors are preserved
957 and Positions
(Container
) <= Positions
(Container
)'Old;
959 procedure Delete_Last
(Container
: in out List
; Count
: Count_Type
) with
963 -- All the elements of Container have been erased
965 (Length
(Container
) <= Count
=>
966 Length
(Container
) = 0,
969 Length
(Container
) = Length
(Container
)'Old - Count
971 -- The elements of Container are preserved
973 and Model
(Container
) <= Model
(Container
)'Old
975 -- At most Count cursors have been removed at the end of Container
977 and P_Positions_Truncated
978 (Positions
(Container
),
979 Positions
(Container
)'Old,
980 Cut
=> Length
(Container
) + 1,
983 procedure Reverse_Elements
(Container
: in out List
) with
985 Post
=> M_Elements_Reversed
(Model
(Container
)'Old, Model
(Container
));
988 (Container
: in out List
;
993 Pre
=> Has_Element
(Container
, I
) and then Has_Element
(Container
, J
),
996 (Model
(Container
)'Old,
998 X
=> P
.Get
(Positions
(Container
)'Old, I
),
999 Y
=> P
.Get
(Positions
(Container
)'Old, J
))
1001 and Positions
(Container
) = Positions
(Container
)'Old;
1003 procedure Swap_Links
1004 (Container
: in out List
;
1009 Pre
=> Has_Element
(Container
, I
) and then Has_Element
(Container
, J
),
1012 (Model
(Container
'Old),
1014 X
=> P
.Get
(Positions
(Container
)'Old, I
),
1015 Y
=> P
.Get
(Positions
(Container
)'Old, J
))
1016 and P_Positions_Swapped
1017 (Positions
(Container
)'Old, Positions
(Container
), I
, J
);
1020 (Target
: in out List
;
1022 Source
: in out List
)
1023 -- Target and Source should not be aliased
1027 Length
(Source
) <= Target
.Capacity
- Length
(Target
)
1028 and then (Has_Element
(Target
, Before
)
1029 or else Before
= No_Element
),
1032 and Length
(Target
) = Length
(Target
)'Old + Length
(Source
)'Old,
1034 (Before
= No_Element
=>
1036 -- The elements of Target are preserved
1039 (Left
=> Model
(Target
)'Old,
1040 Right
=> Model
(Target
),
1042 Lst
=> Length
(Target
)'Old)
1044 -- The elements of Source are appended to target, the order is not
1047 and M_Elements_Included
1048 (Left
=> Model
(Source
)'Old,
1049 L_Lst
=> Length
(Source
)'Old,
1050 Right
=> Model
(Target
),
1051 R_Fst
=> Length
(Target
)'Old + 1,
1052 R_Lst
=> Length
(Target
))
1054 and M_Elements_Included
1055 (Left
=> Model
(Target
),
1056 L_Fst
=> Length
(Target
)'Old + 1,
1057 L_Lst
=> Length
(Target
),
1058 Right
=> Model
(Source
)'Old,
1059 R_Lst
=> Length
(Source
)'Old)
1061 -- Cursors have been inserted at the end of Target
1063 and P_Positions_Truncated
1064 (Positions
(Target
)'Old,
1066 Cut
=> Length
(Target
)'Old + 1,
1067 Count
=> Length
(Source
)'Old),
1071 -- The elements of Target located before Before are preserved
1074 (Left
=> Model
(Target
)'Old,
1075 Right
=> Model
(Target
),
1077 Lst
=> P
.Get
(Positions
(Target
)'Old, Before
) - 1)
1079 -- The elements of Source are inserted before Before, the order is
1082 and M_Elements_Included
1083 (Left
=> Model
(Source
)'Old,
1084 L_Lst
=> Length
(Source
)'Old,
1085 Right
=> Model
(Target
),
1086 R_Fst
=> P
.Get
(Positions
(Target
)'Old, Before
),
1088 P
.Get
(Positions
(Target
)'Old, Before
) - 1 +
1089 Length
(Source
)'Old)
1091 and M_Elements_Included
1092 (Left
=> Model
(Target
),
1093 L_Fst
=> P
.Get
(Positions
(Target
)'Old, Before
),
1095 P
.Get
(Positions
(Target
)'Old, Before
) - 1 +
1096 Length
(Source
)'Old,
1097 Right
=> Model
(Source
)'Old,
1098 R_Lst
=> Length
(Source
)'Old)
1100 -- Other elements are shifted by the length of Source
1103 (Left
=> Model
(Target
)'Old,
1104 Right
=> Model
(Target
),
1105 Fst
=> P
.Get
(Positions
(Target
)'Old, Before
),
1106 Lst
=> Length
(Target
)'Old,
1107 Offset
=> Length
(Source
)'Old)
1109 -- Cursors have been inserted at position Before in Target
1111 and P_Positions_Shifted
1112 (Positions
(Target
)'Old,
1114 Cut
=> P
.Get
(Positions
(Target
)'Old, Before
),
1115 Count
=> Length
(Source
)'Old));
1118 (Target
: in out List
;
1120 Source
: in out List
;
1121 Position
: in out Cursor
)
1122 -- Target and Source should not be aliased
1126 (Has_Element
(Target
, Before
) or else Before
= No_Element
)
1127 and then Has_Element
(Source
, Position
)
1128 and then Length
(Target
) < Target
.Capacity
,
1130 Length
(Target
) = Length
(Target
)'Old + 1
1131 and Length
(Source
) = Length
(Source
)'Old - 1
1133 -- The elements of Source located before Position are preserved
1136 (Left
=> Model
(Source
)'Old,
1137 Right
=> Model
(Source
),
1139 Lst
=> P
.Get
(Positions
(Source
)'Old, Position
'Old) - 1)
1141 -- The elements located after Position are shifted by 1
1144 (Left
=> Model
(Source
)'Old,
1145 Right
=> Model
(Source
),
1146 Fst
=> P
.Get
(Positions
(Source
)'Old, Position
'Old) + 1,
1147 Lst
=> Length
(Source
)'Old,
1150 -- Position has been removed from Source
1152 and P_Positions_Shifted
1153 (Positions
(Source
),
1154 Positions
(Source
)'Old,
1155 Cut
=> P
.Get
(Positions
(Source
)'Old, Position
'Old))
1157 -- Positions is valid in Target and it is located either before
1158 -- Before if it is valid in Target or at the end if it is No_Element.
1160 and P
.Has_Key
(Positions
(Target
), Position
)
1161 and (if Before
= No_Element
then
1162 P
.Get
(Positions
(Target
), Position
) = Length
(Target
)
1164 P
.Get
(Positions
(Target
), Position
) =
1165 P
.Get
(Positions
(Target
)'Old, Before
))
1167 -- The elements of Target located before Position are preserved
1170 (Left
=> Model
(Target
)'Old,
1171 Right
=> Model
(Target
),
1173 Lst
=> P
.Get
(Positions
(Target
), Position
) - 1)
1175 -- Other elements are shifted by 1
1178 (Left
=> Model
(Target
)'Old,
1179 Right
=> Model
(Target
),
1180 Fst
=> P
.Get
(Positions
(Target
), Position
),
1181 Lst
=> Length
(Target
)'Old,
1184 -- The element located at Position in Source is moved to Target
1186 and Element
(Model
(Target
),
1187 P
.Get
(Positions
(Target
), Position
)) =
1188 Element
(Model
(Source
)'Old,
1189 P
.Get
(Positions
(Source
)'Old, Position
'Old))
1191 -- A new cursor has been inserted at position Position in Target
1193 and P_Positions_Shifted
1194 (Positions
(Target
)'Old,
1196 Cut
=> P
.Get
(Positions
(Target
), Position
));
1199 (Container
: in out List
;
1205 (Has_Element
(Container
, Before
) or else Before
= No_Element
)
1206 and then Has_Element
(Container
, Position
),
1207 Post
=> Length
(Container
) = Length
(Container
)'Old,
1209 (Before
= Position
=>
1210 Model
(Container
) = Model
(Container
)'Old
1211 and Positions
(Container
) = Positions
(Container
)'Old,
1213 Before
= No_Element
=>
1215 -- The elements located before Position are preserved
1218 (Left
=> Model
(Container
)'Old,
1219 Right
=> Model
(Container
),
1221 Lst
=> P
.Get
(Positions
(Container
)'Old, Position
) - 1)
1223 -- The elements located after Position are shifted by 1
1226 (Left
=> Model
(Container
)'Old,
1227 Right
=> Model
(Container
),
1228 Fst
=> P
.Get
(Positions
(Container
)'Old, Position
) + 1,
1229 Lst
=> Length
(Container
)'Old,
1232 -- The last element of Container is the one that was previously at
1235 and Element
(Model
(Container
),
1236 Length
(Container
)) =
1237 Element
(Model
(Container
)'Old,
1238 P
.Get
(Positions
(Container
)'Old, Position
))
1240 -- Cursors from Container continue designating the same elements
1242 and Mapping_Preserved
1243 (M_Left
=> Model
(Container
)'Old,
1244 M_Right
=> Model
(Container
),
1245 P_Left
=> Positions
(Container
)'Old,
1246 P_Right
=> Positions
(Container
)),
1250 -- The elements located before Position and Before are preserved
1253 (Left
=> Model
(Container
)'Old,
1254 Right
=> Model
(Container
),
1258 (P
.Get
(Positions
(Container
)'Old, Position
) - 1,
1259 P
.Get
(Positions
(Container
)'Old, Before
) - 1))
1261 -- The elements located after Position and Before are preserved
1264 (Left
=> Model
(Container
)'Old,
1265 Right
=> Model
(Container
),
1268 (P
.Get
(Positions
(Container
)'Old, Position
) + 1,
1269 P
.Get
(Positions
(Container
)'Old, Before
) + 1),
1270 Lst
=> Length
(Container
))
1272 -- The elements located after Before and before Position are
1273 -- shifted by 1 to the right.
1276 (Left
=> Model
(Container
)'Old,
1277 Right
=> Model
(Container
),
1278 Fst
=> P
.Get
(Positions
(Container
)'Old, Before
) + 1,
1279 Lst
=> P
.Get
(Positions
(Container
)'Old, Position
) - 1,
1282 -- The elements located after Position and before Before are
1283 -- shifted by 1 to the left.
1286 (Left
=> Model
(Container
)'Old,
1287 Right
=> Model
(Container
),
1288 Fst
=> P
.Get
(Positions
(Container
)'Old, Position
) + 1,
1289 Lst
=> P
.Get
(Positions
(Container
)'Old, Before
) - 1,
1292 -- The element previously at Position is now before Before
1296 P
.Get
(Positions
(Container
)'Old, Before
)) =
1298 (Model
(Container
)'Old,
1299 P
.Get
(Positions
(Container
)'Old, Position
))
1301 -- Cursors from Container continue designating the same elements
1303 and Mapping_Preserved
1304 (M_Left
=> Model
(Container
)'Old,
1305 M_Right
=> Model
(Container
),
1306 P_Left
=> Positions
(Container
)'Old,
1307 P_Right
=> Positions
(Container
)));
1309 function First
(Container
: List
) return Cursor
with
1312 (Length
(Container
) = 0 =>
1313 First
'Result = No_Element
,
1316 Has_Element
(Container
, First
'Result)
1317 and P
.Get
(Positions
(Container
), First
'Result) = 1);
1319 function First_Element
(Container
: List
) return Element_Type
with
1321 Pre
=> not Is_Empty
(Container
),
1322 Post
=> First_Element
'Result = M
.Get
(Model
(Container
), 1);
1324 function Last
(Container
: List
) return Cursor
with
1327 (Length
(Container
) = 0 =>
1328 Last
'Result = No_Element
,
1331 Has_Element
(Container
, Last
'Result)
1332 and P
.Get
(Positions
(Container
), Last
'Result) =
1333 Length
(Container
));
1335 function Last_Element
(Container
: List
) return Element_Type
with
1337 Pre
=> not Is_Empty
(Container
),
1339 Last_Element
'Result = M
.Get
(Model
(Container
), Length
(Container
));
1341 function Next
(Container
: List
; Position
: Cursor
) return Cursor
with
1344 Has_Element
(Container
, Position
) or else Position
= No_Element
,
1346 (Position
= No_Element
1347 or else P
.Get
(Positions
(Container
), Position
) = Length
(Container
)
1349 Next
'Result = No_Element
,
1352 Has_Element
(Container
, Next
'Result)
1353 and then P
.Get
(Positions
(Container
), Next
'Result) =
1354 P
.Get
(Positions
(Container
), Position
) + 1);
1356 procedure Next
(Container
: List
; Position
: in out Cursor
) with
1359 Has_Element
(Container
, Position
) or else Position
= No_Element
,
1361 (Position
= No_Element
1362 or else P
.Get
(Positions
(Container
), Position
) = Length
(Container
)
1364 Position
= No_Element
,
1367 Has_Element
(Container
, Position
)
1368 and then P
.Get
(Positions
(Container
), Position
) =
1369 P
.Get
(Positions
(Container
), Position
'Old) + 1);
1371 function Previous
(Container
: List
; Position
: Cursor
) return Cursor
with
1374 Has_Element
(Container
, Position
) or else Position
= No_Element
,
1376 (Position
= No_Element
1377 or else P
.Get
(Positions
(Container
), Position
) = 1
1379 Previous
'Result = No_Element
,
1382 Has_Element
(Container
, Previous
'Result)
1383 and then P
.Get
(Positions
(Container
), Previous
'Result) =
1384 P
.Get
(Positions
(Container
), Position
) - 1);
1386 procedure Previous
(Container
: List
; Position
: in out Cursor
) with
1389 Has_Element
(Container
, Position
) or else Position
= No_Element
,
1391 (Position
= No_Element
1392 or else P
.Get
(Positions
(Container
), Position
) = 1
1394 Position
= No_Element
,
1397 Has_Element
(Container
, Position
)
1398 and then P
.Get
(Positions
(Container
), Position
) =
1399 P
.Get
(Positions
(Container
), Position
'Old) - 1);
1403 Item
: Element_Type
;
1404 Position
: Cursor
:= No_Element
) return Cursor
1408 Has_Element
(Container
, Position
) or else Position
= No_Element
,
1411 -- If Item is not contained in Container after Position, Find returns
1415 (Container
=> Model
(Container
),
1417 (if Position
= No_Element
then
1420 P
.Get
(Positions
(Container
), Position
)),
1421 Lst
=> Length
(Container
),
1424 Find
'Result = No_Element
,
1426 -- Otherwise, Find returns a valid cursor in Container
1429 P
.Has_Key
(Positions
(Container
), Find
'Result)
1431 -- The element designated by the result of Find is Item
1435 P
.Get
(Positions
(Container
), Find
'Result)) = Item
1437 -- The result of Find is located after Position
1439 and (if Position
/= No_Element
then
1440 P
.Get
(Positions
(Container
), Find
'Result) >=
1441 P
.Get
(Positions
(Container
), Position
))
1443 -- It is the first occurrence of Item in this slice
1446 (Container
=> Model
(Container
),
1448 (if Position
= No_Element
then
1451 P
.Get
(Positions
(Container
), Position
)),
1453 P
.Get
(Positions
(Container
), Find
'Result) - 1,
1456 function Reverse_Find
1458 Item
: Element_Type
;
1459 Position
: Cursor
:= No_Element
) return Cursor
1463 Has_Element
(Container
, Position
) or else Position
= No_Element
,
1466 -- If Item is not contained in Container before Position, Find returns
1470 (Container
=> Model
(Container
),
1473 (if Position
= No_Element
then
1476 P
.Get
(Positions
(Container
), Position
)),
1479 Reverse_Find
'Result = No_Element
,
1481 -- Otherwise, Find returns a valid cursor in Container
1484 P
.Has_Key
(Positions
(Container
), Reverse_Find
'Result)
1486 -- The element designated by the result of Find is Item
1490 P
.Get
(Positions
(Container
), Reverse_Find
'Result)) = Item
1492 -- The result of Find is located before Position
1494 and (if Position
/= No_Element
then
1495 P
.Get
(Positions
(Container
), Reverse_Find
'Result) <=
1496 P
.Get
(Positions
(Container
), Position
))
1498 -- It is the last occurrence of Item in this slice
1501 (Container
=> Model
(Container
),
1503 P
.Get
(Positions
(Container
),
1504 Reverse_Find
'Result) + 1,
1506 (if Position
= No_Element
then
1509 P
.Get
(Positions
(Container
), Position
)),
1514 Item
: Element_Type
) return Boolean
1518 Contains
'Result = M
.Contains
(Container
=> Model
(Container
),
1520 Lst
=> Length
(Container
),
1523 function Has_Element
1525 Position
: Cursor
) return Boolean
1529 Has_Element
'Result = P
.Has_Key
(Positions
(Container
), Position
);
1530 pragma Annotate
(GNATprove
, Inline_For_Proof
, Has_Element
);
1533 with function "<" (Left
, Right
: Element_Type
) return Boolean is <>;
1535 package Generic_Sorting
with SPARK_Mode
is
1537 package Formal_Model
with Ghost
is
1538 function M_Elements_Sorted
(Container
: M
.Sequence
) return Boolean
1542 M_Elements_Sorted
'Result =
1543 (for all I
in 1 .. M
.Length
(Container
) =>
1544 (for all J
in I
.. M
.Length
(Container
) =>
1545 Element
(Container
, I
) = Element
(Container
, J
)
1546 or Element
(Container
, I
) < Element
(Container
, J
)));
1547 pragma Annotate
(GNATprove
, Inline_For_Proof
, M_Elements_Sorted
);
1552 function Is_Sorted
(Container
: List
) return Boolean with
1554 Post
=> Is_Sorted
'Result = M_Elements_Sorted
(Model
(Container
));
1556 procedure Sort
(Container
: in out List
) with
1559 Length
(Container
) = Length
(Container
)'Old
1560 and M_Elements_Sorted
(Model
(Container
))
1561 and M_Elements_Included
1562 (Left
=> Model
(Container
)'Old,
1563 L_Lst
=> Length
(Container
),
1564 Right
=> Model
(Container
),
1565 R_Lst
=> Length
(Container
))
1566 and M_Elements_Included
1567 (Left
=> Model
(Container
),
1568 L_Lst
=> Length
(Container
),
1569 Right
=> Model
(Container
)'Old,
1570 R_Lst
=> Length
(Container
));
1572 procedure Merge
(Target
: in out List
; Source
: in out List
) with
1573 -- Target and Source should not be aliased
1575 Pre
=> Length
(Source
) <= Target
.Capacity
- Length
(Target
),
1577 Length
(Target
) = Length
(Target
)'Old + Length
(Source
)'Old
1578 and Length
(Source
) = 0
1579 and (if M_Elements_Sorted
(Model
(Target
)'Old)
1580 and M_Elements_Sorted
(Model
(Source
)'Old)
1582 M_Elements_Sorted
(Model
(Target
)))
1583 and M_Elements_Included
1584 (Left
=> Model
(Target
)'Old,
1585 L_Lst
=> Length
(Target
)'Old,
1586 Right
=> Model
(Target
),
1587 R_Lst
=> Length
(Target
))
1588 and M_Elements_Included
1589 (Left
=> Model
(Source
)'Old,
1590 L_Lst
=> Length
(Source
)'Old,
1591 Right
=> Model
(Target
),
1592 R_Lst
=> Length
(Target
))
1593 and M_Elements_In_Union
1596 Model
(Target
)'Old);
1597 end Generic_Sorting
;
1600 pragma SPARK_Mode
(Off
);
1602 type Node_Type
is record
1603 Prev
: Count_Type
'Base := -1;
1605 Element
: Element_Type
;
1608 function "=" (L
, R
: Node_Type
) return Boolean is abstract;
1610 type Node_Array
is array (Count_Type
range <>) of Node_Type
;
1611 function "=" (L
, R
: Node_Array
) return Boolean is abstract;
1613 type List
(Capacity
: Count_Type
) is record
1614 Free
: Count_Type
'Base := -1;
1615 Length
: Count_Type
:= 0;
1616 First
: Count_Type
:= 0;
1617 Last
: Count_Type
:= 0;
1618 Nodes
: Node_Array
(1 .. Capacity
) := (others => <>);
1621 Empty_List
: constant List
:= (0, others => <>);
1623 end Ada
.Containers
.Formal_Doubly_Linked_Lists
;