1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.FORMAL_INDEFINITE_VECTORS --
9 -- Copyright (C) 2014-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 -- Similar to Ada.Containers.Formal_Vectors. The main difference is that
33 -- Element_Type may be indefinite (but not an unconstrained array).
35 with Ada
.Containers
.Bounded_Holders
;
36 with Ada
.Containers
.Functional_Vectors
;
39 type Index_Type
is range <>;
40 type Element_Type
(<>) is private;
41 Max_Size_In_Storage_Elements
: Natural :=
42 Element_Type
'Max_Size_In_Storage_Elements;
43 -- Maximum size of Vector elements in bytes. This has the same meaning as
44 -- in Ada.Containers.Bounded_Holders, with the same restrictions. Note that
45 -- setting this too small can lead to erroneous execution; see comments in
46 -- Ada.Containers.Bounded_Holders. If Element_Type is class-wide, it is the
47 -- responsibility of clients to calculate the maximum size of all types in
50 Bounded
: Boolean := True;
51 -- If True, the containers are bounded; the initial capacity is the maximum
52 -- size, and heap allocation will be avoided. If False, the containers can
53 -- grow via heap allocation.
55 package Ada
.Containers
.Formal_Indefinite_Vectors
with
58 pragma Annotate
(CodePeer
, Skip_Analysis
);
60 subtype Extended_Index
is Index_Type
'Base
61 range Index_Type
'First - 1 ..
62 Index_Type
'Min (Index_Type
'Base'Last - 1, Index_Type'Last) + 1;
64 No_Index : constant Extended_Index := Extended_Index'First;
66 Last_Count : constant Count_Type :=
67 (if Index_Type'Last < Index_Type'First then
69 elsif Index_Type'Last < -1
70 or else Index_Type'Pos (Index_Type'First) >
71 Index_Type'Pos (Index_Type'Last) - Count_Type'Last
73 Index_Type'Pos (Index_Type'Last) -
74 Index_Type'Pos (Index_Type'First) + 1
77 -- Maximal capacity of any vector. It is the minimum of the size of the
78 -- index range and the last possible Count_Type.
80 subtype Capacity_Range is Count_Type range 0 .. Last_Count;
82 type Vector (Capacity : Capacity_Range) is limited private with
83 Default_Initial_Condition => Is_Empty (Vector);
84 -- In the bounded case, Capacity is the capacity of the container, which
85 -- never changes. In the unbounded case, Capacity is the initial capacity
86 -- of the container, and operations such as Reserve_Capacity and Append can
87 -- increase the capacity. The capacity never shrinks, except in the case of
90 -- Note that all objects of type Vector are constrained, including in the
91 -- unbounded case; you can't assign from one object to another if the
92 -- Capacity is different.
94 function Length (Container : Vector) return Capacity_Range with
96 Post => Length'Result <= Capacity (Container);
98 pragma Unevaluated_Use_Of_Old (Allow);
100 package Formal_Model with Ghost is
102 package M is new Ada.Containers.Functional_Vectors
103 (Index_Type => Index_Type,
104 Element_Type => Element_Type);
108 Right : M.Sequence) return Boolean renames M."=";
112 Right : M.Sequence) return Boolean renames M."<";
116 Right : M.Sequence) return Boolean renames M."<=";
118 function M_Elements_In_Union
119 (Container : M.Sequence;
121 Right : M.Sequence) return Boolean
122 -- The elements of Container are contained in either Left or Right
126 M_Elements_In_Union'Result =
127 (for all I in Index_Type'First .. M.Last (Container) =>
128 (for some J in Index_Type'First .. M.Last (Left) =>
129 Element (Container, I) = Element (Left, J))
130 or (for some J in Index_Type'First .. M.Last (Right) =>
131 Element (Container, I) = Element (Right, J)));
132 pragma Annotate (GNATprove, Inline_For_Proof, M_Elements_In_Union);
134 function M_Elements_Included
136 L_Fst : Index_Type := Index_Type'First;
137 L_Lst : Extended_Index;
139 R_Fst : Index_Type := Index_Type'First;
140 R_Lst : Extended_Index) return Boolean
141 -- The elements of the slice from L_Fst to L_Lst in Left are contained
142 -- in the slide from R_Fst to R_Lst in Right.
145 Pre => L_Lst <= M.Last (Left) and R_Lst <= M.Last (Right),
147 M_Elements_Included'Result =
148 (for all I in L_Fst .. L_Lst =>
149 (for some J in R_Fst .. R_Lst =>
150 Element (Left, I) = Element (Right, J)));
151 pragma Annotate (GNATprove, Inline_For_Proof, M_Elements_Included);
153 function M_Elements_Reversed
155 Right : M.Sequence) return Boolean
156 -- Right is Left in reverse order
160 M_Elements_Reversed'Result =
161 (M.Length (Left) = M.Length (Right)
162 and (for all I in Index_Type'First .. M.Last (Left) =>
164 Element (Right, M.Last (Left) - I + 1))
165 and (for all I in Index_Type'First .. M.Last (Right) =>
167 Element (Left, M.Last (Left) - I + 1)));
168 pragma Annotate (GNATprove, Inline_For_Proof, M_Elements_Reversed);
170 function M_Elements_Swapped
174 Y : Index_Type) return Boolean
175 -- Elements stored at X and Y are reversed in Left and Right
178 Pre => X <= M.Last (Left) and Y <= M.Last (Left),
180 M_Elements_Swapped'Result =
181 (M.Length (Left) = M.Length (Right)
182 and Element (Left, X) = Element (Right, Y)
183 and Element (Left, Y) = Element (Right, X)
184 and M.Equal_Except (Left, Right, X, Y));
185 pragma Annotate (GNATprove, Inline_For_Proof, M_Elements_Swapped);
187 function Model (Container : Vector) return M.Sequence with
188 -- The high-level model of a vector is a sequence of elements. The
189 -- sequence really is similar to the vector itself. However, it is not
190 -- limited which allows usage of 'Old
and 'Loop_Entry attributes.
194 Post => M.Length (Model'Result) = Length (Container);
198 I : Index_Type) return Element_Type renames M.Get;
199 -- To improve readability of contracts, we rename the function used to
200 -- access an element in the model to Element.
205 function Empty_Vector return Vector with
207 Post => Length (Empty_Vector'Result) = 0;
209 function "=" (Left, Right : Vector) return Boolean with
211 Post => "="'Result
= (Model
(Left
) = Model
(Right
));
214 (New_Item
: Element_Type
;
215 Length
: Capacity_Range
) return Vector
219 Formal_Indefinite_Vectors
.Length
(To_Vector
'Result) = Length
221 (Container
=> Model
(To_Vector
'Result),
222 Fst
=> Index_Type
'First,
223 Lst
=> Last_Index
(To_Vector
'Result),
226 function Capacity
(Container
: Vector
) return Capacity_Range
with
233 Capacity_Range
'Last);
234 pragma Annotate
(GNATprove
, Inline_For_Proof
, Capacity
);
236 procedure Reserve_Capacity
237 (Container
: in out Vector
;
238 Capacity
: Capacity_Range
)
241 Pre
=> (if Bounded
then Capacity
<= Container
.Capacity
),
242 Post
=> Model
(Container
) = Model
(Container
)'Old;
244 function Is_Empty
(Container
: Vector
) return Boolean with
246 Post
=> Is_Empty
'Result = (Length
(Container
) = 0);
248 procedure Clear
(Container
: in out Vector
) with
250 Post
=> Length
(Container
) = 0;
251 -- Note that this reclaims storage in the unbounded case. You need to call
252 -- this before a container goes out of scope in order to avoid storage
253 -- leaks. In addition, "X := ..." can leak unless you Clear(X) first.
255 procedure Assign
(Target
: in out Vector
; Source
: Vector
) with
257 Pre
=> (if Bounded
then Length
(Source
) <= Target
.Capacity
),
258 Post
=> Model
(Target
) = Model
(Source
);
262 Capacity
: Capacity_Range
:= 0) return Vector
265 Pre
=> (if Bounded
then (Capacity
= 0 or Length
(Source
) <= Capacity
)),
267 Model
(Copy
'Result) = Model
(Source
)
268 and (if Capacity
= 0 then
269 Copy
'Result.Capacity
= Length
(Source
)
271 Copy
'Result.Capacity
= Capacity
);
273 procedure Move
(Target
: in out Vector
; Source
: in out Vector
)
276 Pre
=> (if Bounded
then Length
(Source
) <= Capacity
(Target
)),
277 Post
=> Model
(Target
) = Model
(Source
)'Old and Length
(Source
) = 0;
281 Index
: Index_Type
) return Element_Type
284 Pre
=> Index
in First_Index
(Container
) .. Last_Index
(Container
),
285 Post
=> Element
'Result = Element
(Model
(Container
), Index
);
286 pragma Annotate
(GNATprove
, Inline_For_Proof
, Element
);
288 procedure Replace_Element
289 (Container
: in out Vector
;
291 New_Item
: Element_Type
)
294 Pre
=> Index
in First_Index
(Container
) .. Last_Index
(Container
),
296 Length
(Container
) = Length
(Container
)'Old
298 -- Container now has New_Item at index Index
300 and Element
(Model
(Container
), Index
) = New_Item
302 -- All other elements are preserved
305 (Left
=> Model
(Container
)'Old,
306 Right
=> Model
(Container
),
310 (Container
: in out Vector
;
311 Before
: Extended_Index
;
316 Length
(Container
) <= Capacity
(Container
) - Length
(New_Item
)
317 and (Before
in Index_Type
'First .. Last_Index
(Container
)
318 or (Before
/= No_Index
319 and then Before
- 1 = Last_Index
(Container
))),
321 Length
(Container
) = Length
(Container
)'Old + Length
(New_Item
)
323 -- Elements located before Before in Container are preserved
326 (Left
=> Model
(Container
)'Old,
327 Right
=> Model
(Container
),
328 Fst
=> Index_Type
'First,
331 -- Elements of New_Item are inserted at position Before
333 and (if Length
(New_Item
) > 0 then
335 (Left
=> Model
(New_Item
),
336 Right
=> Model
(Container
),
337 Fst
=> Index_Type
'First,
338 Lst
=> Last_Index
(New_Item
),
339 Offset
=> Count_Type
(Before
- Index_Type
'First)))
341 -- Elements located after Before in Container are shifted
344 (Left
=> Model
(Container
)'Old,
345 Right
=> Model
(Container
),
347 Lst
=> Last_Index
(Container
)'Old,
348 Offset
=> Length
(New_Item
));
351 (Container
: in out Vector
;
352 Before
: Extended_Index
;
353 New_Item
: Element_Type
)
357 Length
(Container
) < Capacity
(Container
)
358 and then (Before
in Index_Type
'First .. Last_Index
(Container
) + 1),
360 Length
(Container
) = Length
(Container
)'Old + 1
362 -- Elements located before Before in Container are preserved
365 (Left
=> Model
(Container
)'Old,
366 Right
=> Model
(Container
),
367 Fst
=> Index_Type
'First,
370 -- Container now has New_Item at index Before
372 and Element
(Model
(Container
), Before
) = New_Item
374 -- Elements located after Before in Container are shifted by 1
377 (Left
=> Model
(Container
)'Old,
378 Right
=> Model
(Container
),
380 Lst
=> Last_Index
(Container
)'Old,
384 (Container
: in out Vector
;
385 Before
: Extended_Index
;
386 New_Item
: Element_Type
;
391 Length
(Container
) <= Capacity
(Container
) - Count
392 and (Before
in Index_Type
'First .. Last_Index
(Container
)
393 or (Before
/= No_Index
394 and then Before
- 1 = Last_Index
(Container
))),
396 Length
(Container
) = Length
(Container
)'Old + Count
398 -- Elements located before Before in Container are preserved
401 (Left
=> Model
(Container
)'Old,
402 Right
=> Model
(Container
),
403 Fst
=> Index_Type
'First,
406 -- New_Item is inserted Count times at position Before
408 and (if Count
> 0 then
410 (Container
=> Model
(Container
),
412 Lst
=> Before
+ Index_Type
'Base (Count
- 1),
415 -- Elements located after Before in Container are shifted
418 (Left
=> Model
(Container
)'Old,
419 Right
=> Model
(Container
),
421 Lst
=> Last_Index
(Container
)'Old,
424 procedure Prepend
(Container
: in out Vector
; New_Item
: Vector
) with
426 Pre
=> Length
(Container
) <= Capacity
(Container
) - Length
(New_Item
),
428 Length
(Container
) = Length
(Container
)'Old + Length
(New_Item
)
430 -- Elements of New_Item are inserted at the beginning of Container
433 (Left
=> Model
(New_Item
),
434 Right
=> Model
(Container
),
435 Fst
=> Index_Type
'First,
436 Lst
=> Last_Index
(New_Item
))
438 -- Elements of Container are shifted
441 (Left
=> Model
(Container
)'Old,
442 Right
=> Model
(Container
),
443 Fst
=> Index_Type
'First,
444 Lst
=> Last_Index
(Container
)'Old,
445 Offset
=> Length
(New_Item
));
447 procedure Prepend
(Container
: in out Vector
; New_Item
: Element_Type
) with
449 Pre
=> Length
(Container
) < Capacity
(Container
),
451 Length
(Container
) = Length
(Container
)'Old + 1
453 -- Container now has New_Item at Index_Type'First
455 and Element
(Model
(Container
), Index_Type
'First) = New_Item
457 -- Elements of Container are shifted by 1
460 (Left
=> Model
(Container
)'Old,
461 Right
=> Model
(Container
),
462 Fst
=> Index_Type
'First,
463 Lst
=> Last_Index
(Container
)'Old,
467 (Container
: in out Vector
;
468 New_Item
: Element_Type
;
472 Pre
=> Length
(Container
) <= Capacity
(Container
) - Count
,
474 Length
(Container
) = Length
(Container
)'Old + Count
476 -- New_Item is inserted Count times at the beginning of Container
479 (Container
=> Model
(Container
),
480 Fst
=> Index_Type
'First,
481 Lst
=> Index_Type
'First + Index_Type
'Base (Count
- 1),
484 -- Elements of Container are shifted
487 (Left
=> Model
(Container
)'Old,
488 Right
=> Model
(Container
),
489 Fst
=> Index_Type
'First,
490 Lst
=> Last_Index
(Container
)'Old,
493 procedure Append
(Container
: in out Vector
; New_Item
: Vector
) with
496 Length
(Container
) <= Capacity
(Container
) - Length
(New_Item
),
498 Length
(Container
) = Length
(Container
)'Old + Length
(New_Item
)
500 -- The elements of Container are preserved
502 and Model
(Container
)'Old <= Model
(Container
)
504 -- Elements of New_Item are inserted at the end of Container
506 and (if Length
(New_Item
) > 0 then
508 (Left
=> Model
(New_Item
),
509 Right
=> Model
(Container
),
510 Fst
=> Index_Type
'First,
511 Lst
=> Last_Index
(New_Item
),
514 (Last_Index
(Container
)'Old - Index_Type
'First + 1)));
516 procedure Append
(Container
: in out Vector
; New_Item
: Element_Type
) with
518 Pre
=> Length
(Container
) < Capacity
(Container
),
520 Length
(Container
) = Length
(Container
)'Old + 1
522 -- Elements of Container are preserved
524 and Model
(Container
)'Old < Model
(Container
)
526 -- Container now has New_Item at the end of Container
529 (Model
(Container
), Last_Index
(Container
)'Old + 1) = New_Item
;
532 (Container
: in out Vector
;
533 New_Item
: Element_Type
;
537 Pre
=> Length
(Container
) <= Capacity
(Container
) - Count
,
539 Length
(Container
) = Length
(Container
)'Old + Count
541 -- Elements of Container are preserved
543 and Model
(Container
)'Old <= Model
(Container
)
545 -- New_Item is inserted Count times at the end of Container
547 and (if Count
> 0 then
549 (Container
=> Model
(Container
),
550 Fst
=> Last_Index
(Container
)'Old + 1,
552 Last_Index
(Container
)'Old + Index_Type
'Base (Count
),
555 procedure Delete
(Container
: in out Vector
; Index
: Extended_Index
) with
557 Pre
=> Index
in First_Index
(Container
) .. Last_Index
(Container
),
559 Length
(Container
) = Length
(Container
)'Old - 1
561 -- Elements located before Index in Container are preserved
564 (Left
=> Model
(Container
)'Old,
565 Right
=> Model
(Container
),
566 Fst
=> Index_Type
'First,
569 -- Elements located after Index in Container are shifted by 1
572 (Left
=> Model
(Container
),
573 Right
=> Model
(Container
)'Old,
575 Lst
=> Last_Index
(Container
),
579 (Container
: in out Vector
;
580 Index
: Extended_Index
;
585 Index
in First_Index
(Container
) .. Last_Index
(Container
),
587 Length
(Container
) in
588 Length
(Container
)'Old - Count
.. Length
(Container
)'Old
590 -- The elements of Container located before Index are preserved.
593 (Left
=> Model
(Container
)'Old,
594 Right
=> Model
(Container
),
595 Fst
=> Index_Type
'First,
600 -- All the elements after Position have been erased
602 (Length
(Container
) - Count
<= Count_Type
(Index
- Index_Type
'First) =>
603 Length
(Container
) = Count_Type
(Index
- Index_Type
'First),
606 Length
(Container
) = Length
(Container
)'Old - Count
608 -- Other elements are shifted by Count
611 (Left
=> Model
(Container
),
612 Right
=> Model
(Container
)'Old,
614 Lst
=> Last_Index
(Container
),
617 procedure Delete_First
(Container
: in out Vector
) with
619 Pre
=> Length
(Container
) > 0,
621 Length
(Container
) = Length
(Container
)'Old - 1
623 -- Elements of Container are shifted by 1
626 (Left
=> Model
(Container
),
627 Right
=> Model
(Container
)'Old,
628 Fst
=> Index_Type
'First,
629 Lst
=> Last_Index
(Container
),
632 procedure Delete_First
(Container
: in out Vector
; Count
: Count_Type
) with
636 -- All the elements of Container have been erased
638 (Length
(Container
) <= Count
=> Length
(Container
) = 0,
641 Length
(Container
) = Length
(Container
)'Old - Count
643 -- Elements of Container are shifted by Count
646 (Left
=> Model
(Container
),
647 Right
=> Model
(Container
)'Old,
648 Fst
=> Index_Type
'First,
649 Lst
=> Last_Index
(Container
),
652 procedure Delete_Last
(Container
: in out Vector
) with
654 Pre
=> Length
(Container
) > 0,
656 Length
(Container
) = Length
(Container
)'Old - 1
658 -- Elements of Container are preserved
660 and Model
(Container
) < Model
(Container
)'Old;
662 procedure Delete_Last
(Container
: in out Vector
; Count
: Count_Type
) with
666 -- All the elements after Position have been erased
668 (Length
(Container
) <= Count
=> Length
(Container
) = 0,
671 Length
(Container
) = Length
(Container
)'Old - Count
673 -- The elements of Container are preserved
675 and Model
(Container
) <= Model
(Container
)'Old);
677 procedure Reverse_Elements
(Container
: in out Vector
) with
679 Post
=> M_Elements_Reversed
(Model
(Container
)'Old, Model
(Container
));
682 (Container
: in out Vector
;
688 I
in First_Index
(Container
) .. Last_Index
(Container
)
689 and then J
in First_Index
(Container
) .. Last_Index
(Container
),
691 M_Elements_Swapped
(Model
(Container
)'Old, Model
(Container
), I
, J
);
693 function First_Index
(Container
: Vector
) return Index_Type
with
695 Post
=> First_Index
'Result = Index_Type
'First;
696 pragma Annotate
(GNATprove
, Inline_For_Proof
, First_Index
);
698 function First_Element
(Container
: Vector
) return Element_Type
with
700 Pre
=> not Is_Empty
(Container
),
702 First_Element
'Result = Element
(Model
(Container
), Index_Type
'First);
703 pragma Annotate
(GNATprove
, Inline_For_Proof
, First_Element
);
705 function Last_Index
(Container
: Vector
) return Extended_Index
with
707 Post
=> Last_Index
'Result = M
.Last
(Model
(Container
));
708 pragma Annotate
(GNATprove
, Inline_For_Proof
, Last_Index
);
710 function Last_Element
(Container
: Vector
) return Element_Type
with
712 Pre
=> not Is_Empty
(Container
),
714 Last_Element
'Result =
715 Element
(Model
(Container
), Last_Index
(Container
));
716 pragma Annotate
(GNATprove
, Inline_For_Proof
, Last_Element
);
721 Index
: Index_Type
:= Index_Type
'First) return Extended_Index
726 -- If Item is not contained in Container after Index, Find_Index
729 (Index
> Last_Index
(Container
)
730 or else not M
.Contains
731 (Container
=> Model
(Container
),
733 Lst
=> Last_Index
(Container
),
736 Find_Index
'Result = No_Index
,
738 -- Otherwise, Find_Index returns a valid index greater than Index
741 Find_Index
'Result in Index
.. Last_Index
(Container
)
743 -- The element at this index in Container is Item
745 and Element
(Model
(Container
), Find_Index
'Result) = Item
747 -- It is the first occurrence of Item after Index in Container
750 (Container
=> Model
(Container
),
752 Lst
=> Find_Index
'Result - 1,
755 function Reverse_Find_Index
758 Index
: Index_Type
:= Index_Type
'Last) return Extended_Index
763 -- If Item is not contained in Container before Index,
764 -- Reverse_Find_Index returns No_Index.
767 (Container
=> Model
(Container
),
768 Fst
=> Index_Type
'First,
769 Lst
=> (if Index
<= Last_Index
(Container
) then Index
770 else Last_Index
(Container
)),
773 Reverse_Find_Index
'Result = No_Index
,
775 -- Otherwise, Reverse_Find_Index returns a valid index smaller than
779 Reverse_Find_Index
'Result in Index_Type
'First .. Index
780 and Reverse_Find_Index
'Result <= Last_Index
(Container
)
782 -- The element at this index in Container is Item
784 and Element
(Model
(Container
), Reverse_Find_Index
'Result) = Item
786 -- It is the last occurrence of Item before Index in Container
789 (Container
=> Model
(Container
),
790 Fst
=> Reverse_Find_Index
'Result + 1,
792 (if Index
<= Last_Index
(Container
) then
795 Last_Index
(Container
)),
800 Item
: Element_Type
) return Boolean
806 (Container
=> Model
(Container
),
807 Fst
=> Index_Type
'First,
808 Lst
=> Last_Index
(Container
),
813 Position
: Extended_Index
) return Boolean
818 (Position
in Index_Type
'First .. Last_Index
(Container
));
819 pragma Annotate
(GNATprove
, Inline_For_Proof
, Has_Element
);
822 with function "<" (Left
, Right
: Element_Type
) return Boolean is <>;
823 package Generic_Sorting
with SPARK_Mode
is
825 package Formal_Model
with Ghost
is
827 function M_Elements_Sorted
(Container
: M
.Sequence
) return Boolean
831 M_Elements_Sorted
'Result =
832 (for all I
in Index_Type
'First .. M
.Last
(Container
) =>
833 (for all J
in I
.. M
.Last
(Container
) =>
834 Element
(Container
, I
) = Element
(Container
, J
)
835 or Element
(Container
, I
) < Element
(Container
, J
)));
836 pragma Annotate
(GNATprove
, Inline_For_Proof
, M_Elements_Sorted
);
841 function Is_Sorted
(Container
: Vector
) return Boolean with
843 Post
=> Is_Sorted
'Result = M_Elements_Sorted
(Model
(Container
));
845 procedure Sort
(Container
: in out Vector
) with
848 Length
(Container
) = Length
(Container
)'Old
849 and M_Elements_Sorted
(Model
(Container
))
850 and M_Elements_Included
851 (Left
=> Model
(Container
)'Old,
852 L_Lst
=> Last_Index
(Container
),
853 Right
=> Model
(Container
),
854 R_Lst
=> Last_Index
(Container
))
855 and M_Elements_Included
856 (Left
=> Model
(Container
),
857 L_Lst
=> Last_Index
(Container
),
858 Right
=> Model
(Container
)'Old,
859 R_Lst
=> Last_Index
(Container
));
861 procedure Merge
(Target
: in out Vector
; Source
: in out Vector
) with
862 -- Target and Source should not be aliased
864 Pre
=> Length
(Source
) <= Capacity
(Target
) - Length
(Target
),
866 Length
(Target
) = Length
(Target
)'Old + Length
(Source
)'Old
867 and Length
(Source
) = 0
868 and (if M_Elements_Sorted
(Model
(Target
)'Old)
869 and M_Elements_Sorted
(Model
(Source
)'Old)
871 M_Elements_Sorted
(Model
(Target
)))
872 and M_Elements_Included
873 (Left
=> Model
(Target
)'Old,
874 L_Lst
=> Last_Index
(Target
)'Old,
875 Right
=> Model
(Target
),
876 R_Lst
=> Last_Index
(Target
))
877 and M_Elements_Included
878 (Left
=> Model
(Source
)'Old,
879 L_Lst
=> Last_Index
(Source
)'Old,
880 Right
=> Model
(Target
),
881 R_Lst
=> Last_Index
(Target
))
882 and M_Elements_In_Union
889 pragma SPARK_Mode
(Off
);
891 pragma Inline
(First_Index
);
892 pragma Inline
(Last_Index
);
893 pragma Inline
(Element
);
894 pragma Inline
(First_Element
);
895 pragma Inline
(Last_Element
);
896 pragma Inline
(Replace_Element
);
897 pragma Inline
(Contains
);
899 -- The implementation method is to instantiate Bounded_Holders to get a
900 -- definite type for Element_Type.
902 package Holders
is new Bounded_Holders
903 (Element_Type
, Max_Size_In_Storage_Elements
, "=");
906 subtype Array_Index
is Capacity_Range
range 1 .. Capacity_Range
'Last;
907 type Elements_Array
is array (Array_Index
range <>) of Holder
;
908 function "=" (L
, R
: Elements_Array
) return Boolean is abstract;
910 type Elements_Array_Ptr
is access all Elements_Array
;
912 type Vector
(Capacity
: Capacity_Range
) is limited record
914 -- In the bounded case, the elements are stored in Elements. In the
915 -- unbounded case, the elements are initially stored in Elements, until
916 -- we run out of room, then we switch to Elements_Ptr.
918 Last
: Extended_Index
:= No_Index
;
919 Elements_Ptr
: Elements_Array_Ptr
:= null;
920 Elements
: aliased Elements_Array
(1 .. Capacity
);
923 -- The primary reason Vector is limited is that in the unbounded case, once
924 -- Elements_Ptr is in use, assignment statements won't work. "X := Y;" will
925 -- cause X and Y to share state; that is, X.Elements_Ptr = Y.Elements_Ptr,
926 -- so for example "Append (X, ...);" will modify BOTH X and Y. That would
927 -- allow SPARK to "prove" things that are false. We could fix that by
928 -- making Vector a controlled type, and override Adjust to make a deep
929 -- copy, but finalization is not allowed in SPARK.
931 -- Note that (unfortunately) this means that 'Old and 'Loop_Entry are not
932 -- allowed on Vectors.
934 function Empty_Vector
return Vector
is
935 ((Capacity
=> 0, others => <>));
937 end Ada
.Containers
.Formal_Indefinite_Vectors
;