How to incorporate proof aspects into the specification so that every function and procedure has a Post aspect and, if required, a Pre aspect that outlines the proper behaviour of the code below:
package Stack with SPARK_Mode is
pragma Elaborate_Body;
Stack_Size : constant := 100;
type Pointer_Range is range 0 .. Stack_Size;
subtype Index_Range is Pointer_Range range 1 .. Stack_Size;
type Vector is array(Index_Range) of Integer;
S: Vector;
Pointer: Pointer_Range;
function isEmpty return Boolean;
procedure Push(X : in Integer)
with
Global => (In_out => (S, Pointer)),
Depends => (S => (S, Pointer, X),
Pointer => Pointer);
procedure Pop(X : out Integer)
with
Global => (input => S, in_out => Pointer),
Depends => (Pointer => Pointer,
X => (S, Pointer));
end Stack;
Following is a possible set of post conditions and pre conditions for your example. The actual set must depend upon actual requirements for your stack behavior. This example is simply a typical set of conditions for the stack.
package Stack with SPARK_MODE is
pragma Elaborate_Body;
Stack_Size : constant := 100;
type Pointer_Range is range 0 .. Stack_Size;
subtype Index_Range is Pointer_Range range 1..Stack_Size;
type Vector is array (Index_Range) of Integer;
S : Vector;
Pointer : Pointer_Range := 0;
function isEmpty return Boolean with
Post => IsEmpty'Result = (if Pointer = 0 then True else False);
procedure Push(X : in Integer) with
Global => (In_Out => (S, Pointer)),
Depends => (S => (S, Pointer, X), Pointer => Pointer),
Pre => Pointer < Stack_Size,
Post => Pointer = Pointer'Old + 1 and S(Pointer) = X;
procedure Pop(X : out Integer) with
Global => (In_Out => (S, Pointer)),
Depends => (Pointer => Pointer,
X => (S, Pointer),
S => S),
Pre => not isEmpty,
Post => Pointer = Pointer'Old - 1 and X = S(Pointer'Old);
end Stack;
In brief, you should add a Post-condition aspect to every subprogram in the package, and a Pre-condition aspect to those subprograms that need it.
Preconditions and postconditions in Ada are explained at http://www.ada-auth.org/standards/22rm/html/RM-6-1-1.html.
What is your problem, really? Is it about the syntax of the pre/post-condition aspects, or about their content and meaning? Or is it about the meaning of "proper behaviour" in the problem statement? In the last case, try to imagine what might be improper behaviour, or incorrect use, of a Push or Pop operation on a stack with a fixed maximum size.
Related
I am learning Ada and I've hit a design problem. Excuse me as I'm not up with basic Ada mechanisms and idioms.
Let's say I want to represent an operation. Operators can be either plus or minus and operands can be either integers or strings.
Disclaimer: some things may not make much sense on a semantic level (minus on strings, operators without operands, ...) but it's all about representation.
For now I have the following incorrect code:
operand.ads:
package Operand is
-- I want a None for unary operands or operators without operands
type Operand_Type is (Int, Str, None);
-- This needs to be tagged
type Instance (Op_Type : Operand_Type := None) is tagged record
case Op_Type is
when Int =>
Int_Value : Integer;
when Str =>
Str_Value : String (1 .. 10);
when None =>
null;
end case;
end record;
-- Some methods on operands...
end Operand;
operation.ads:
with Operand;
package Operation is
type Operation_Type is (Plus, Minus);
-- This also needs to be tagged
type Instance is tagged record
Left, Right : Operand.Instance;
end record;
-- Some methods on operations...
end Operation;
main.adb:
with Operand;
with Operation;
procedure Main is
Op : Operation.Instance;
begin
Op.Left := (Op_Type => Operand.Int, Int_Value => 1);
Op.Right := (Op_Type => Operand.Int, Int_Value => 3);
end Main;
When I try to compile I get the following errors:
$ gnatmake main.adb
gcc -c main.adb
operand.ads:7:45: discriminants of nonlimited tagged type cannot have defaults
operation.ads:9:28: unconstrained subtype in component declaration
gnatmake: "main.adb" compilation error
I get why I can't use defaults on tagged type's discriminant but I don't really know how to get around this limitation.
Proposal 1:
Stop using variant records and use a record with one field for each operand. But I feel like this is just throwing away code elegance.
Proposal 2:
Remove defaults from Operand.Instance record and constrain Left and Right from Operation.Instance record. But I get a runtime error :
raised CONSTRAINT_ERROR : main.adb:7 discriminant check failed
As I cannot dynamically change discriminant value of a record's field.
Any help would be much appreciated !
Jim Rogers already discussed using inheritance. You can also use composition if you like by creating an internal non tagged type (which allows defaults), make the Operand.Instance type tagged private, have the private implementation use the internal non tagged version, and just add what operations you need to set and get the operands:
with Ada.Text_IO; use Ada.Text_IO;
procedure Hello is
package Operand is
-- I want a None for unary operands or operators without operands
type Operand_Type is (Int, Str, None);
Invalid_Operand : exception;
-- This needs to be tagged
type Instance is tagged private;
function Int_Value(Value : Integer) return Instance;
function Str_Value(Value : String) return Instance;
function Null_Instance return Instance;
function Int_Value(Self : Instance) return Integer;
function Str_Value(Self : Instance) return String;
function Op_Type(Self : Instance) return Operand_Type;
-- Some methods on operands...
private
type Instance_Internal (Op_Type : Operand_Type := None) is record
case Op_Type is
when Int =>
Int_Value : Integer;
when Str =>
Str_Value : String (1 .. 10);
when None =>
null;
end case;
end record;
type Instance is tagged record
Impl : Instance_Internal;
end record;
function Int_Value(Value : Integer) return Instance is (Impl => (Int, Value));
function Str_Value(Value : String) return Instance is (Impl => (Str, Value));
function Null_Instance return Instance is (Impl => (Op_Type => None));
function Int_Value(Self : Instance) return Integer
is (if Self.Impl.Op_Type = Int then Self.Impl.Int_Value else raise Invalid_Operand);
function Str_Value(Self : Instance) return String
is (if Self.Impl.Op_Type = Str then Self.Impl.Str_Value else raise Invalid_Operand);
function Op_Type(Self : Instance) return Operand_Type
is (Self.Impl.Op_Type);
end Operand;
package Operation is
type Operation_Type is (Plus, Minus);
-- This also needs to be tagged
type Instance is tagged record
Left, Right : Operand.Instance;
end record;
-- Some methods on operations...
end Operation;
Op : Operation.Instance;
begin
Put_Line("Hello, world!");
Op.Left := Operand.Int_Value(1);
Op.Right := Operand.Int_Value(3);
Put_Line(Integer'Image(Op.Left.Int_Value));
Put_Line(Integer'Image(Op.Right.Int_Value));
end Hello;
You can break the Operand package into spec and body for better readability, this was just for example.
I have a collection of things, which I deliberately want to allocate on the heap and access them 'by reference':
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Containers; use Ada.Containers;
procedure Main is
type Thing_Key is new Integer;
type Thing is record
Key : Thing_Key;
Data : Integer;
end record;
type Thing_Access is access all Thing;
function Image (T : Thing) return String is
(T.Key'Image & '(' & T.Data'Image & ')');
function "=" (A, B : Thing) return Boolean is
(A.Key = B.Key);
function Thing_Hash (K : Thing_Key) return Hash_Type is
(Hash_Type (K));
package Thing_Map is new
Ada.Containers.Indefinite_Hashed_Maps
(Key_Type => Thing_Key,
Element_Type => Thing,
Hash => Thing_Hash,
Equivalent_Keys => "=");
use Thing_Map;
Map : Thing_Map.Map;
C : Cursor;
P : Thing_Access;
begin
P := new Thing '(Key => 1, Data => 2); -- on the heap
Map.Insert (P.Key, P.all);
Put_Line (Image (P.all)); -- '1( 2)', as expected
P.Data := 99;
Put_Line (Image (P.all)); -- '1( 99)', as expected
C := Map.Find (1); -- Get cursor to thing
-- Set P to point at the thing at the cursor?
-- Following lines don't compile
P := Map (C)'Access; -- access-to-variable designates constant
P := Map (C).Reference; -- undefined selector "Reference" for overloaded prefix
P := Map (C).Get_Element_Access; -- undefined selector "Get_Element_Access" for overloaded prefix
P := Map.Reference (C); -- no visible interpretation of "Reference" matches expected type "Thing_Access"
end Main;
What is the syntax to get a pointer from a cursor?
I assume that you only want to store elements on the heap in order to access them by reference for manipulation. However, you don't need to do that when using Ada containers. All containers have some way of accessing the elements by reference readily available (via some Constant_Reference or Reference function that can typically be omitted because of the Variable_Indexing aspect defined on the container type; see, for example, section 6.3 in the Ada 2012 rationale, and/or the answer of #Timur Samkharadze).
If you want to store the key as part of the element, then I think it might be more appropriate to use a hashed set (see RM A.18.7, RM A.18.8 and on learn.adacore.com). An element in a hashed set can be accessed by reference via the function Reference_Preserving_Key (see also RM 96.10 (3)).
Below are two examples: the first example shows how to update an element in a Hashed_Map and the second example shows how to update an element in a Hashed_Set, both using a key:
main.adb (Hashed_Map)
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers; use Ada.Containers;
with Ada.Containers.Hashed_Maps;
procedure Main is
type Thing_Key is new Integer;
type Thing is record
Key : Thing_Key;
Data : Integer;
end record;
function Image (T : Thing) return String is
("Key = " & T.Key'Image & ", Value = " & T.Data'Image);
function Hash (K : Thing_Key) return Hash_Type is (Hash_Type (K));
package Things is new Ada.Containers.Hashed_Maps
(Key_Type => Thing_Key,
Element_Type => Thing,
Hash => Hash,
Equivalent_Keys => "=");
Map : Things.Map;
begin
-- Inserting 4 elements. Note that the key is now stored twice: once in
-- the map's key index (its hash, to be more precise), and once in the item
-- itself (unhashed). You must now ensure that the key value in the
-- element does not accidentally get out-of-sync with the hashed key in the
-- map's key index (e.g. when you update the stored element). Of course,
-- you could also you just omit the key in the element itself if possible
-- given your use-case.
Map.Insert (Key => 1, New_Item => (Key => 1, Data => 10));
Map.Insert (Key => 2, New_Item => (Key => 2, Data => 20));
Map.Insert (Key => 3, New_Item => (Key => 3, Data => 30));
Map.Insert (Key => 4, New_Item => (Key => 4, Data => 40));
for T of Map loop
Put_Line (Image (T));
end loop;
New_Line;
-- Update element with key 3.
--
-- Note that the following expressions are all equivalent:
--
-- Map.Reference (3).Element.all.Data := 300; -- Original expression
-- Map.Reference (3).Element.Data := 300; -- Omit "all" due to implicit dereferencing of access types in Ada.
-- Map.Reference (3).Data := 300; -- Omit "Element" due to the "Implicit_Dereferencing" aspect on the "Hashed_Maps.Reference_Type".
-- Map (3).Data := 300; -- Omit "Reference" due to the "Variable_Indexing" aspect on the "Hashed_Maps.Map" type.
--
Map (3).Data := 300;
-- Example if you really need a pointer to element with key 3.
declare
type Thing_Access is not null access all Thing;
type Thing_Constant_Access is not null access constant Thing;
-- Element is mutable via P , i.e. P.Data := 301 (OK)
-- Element is not mutable via CP, i.e. CP.Data := 302 (Error)
P : Thing_Access := Map.Reference (3).Element;
CP : Thing_Constant_Access := Map.Constant_Reference (3).Element;
begin
null;
end;
for T of Map loop
Put_Line (Image (T));
end loop;
New_Line;
end Main;
main.adb (Hashed_Set)
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers; use Ada.Containers;
with Ada.Containers.Hashed_Sets;
procedure Main is
type Thing_Key is new Integer;
type Thing is record
Key : Thing_Key;
Data : Integer;
end record;
function Image (T : Thing) return String is
("Key = " & T.Key'Image & ", Value = " & T.Data'Image);
function Key (T : Thing) return Thing_Key is (T.Key);
function Hash (T : Thing) return Hash_Type is (Hash_Type (T.Key));
function Hash (K : Thing_Key) return Hash_Type is (Hash_Type (K));
package Things is new Ada.Containers.Hashed_Sets
(Element_Type => Thing,
Hash => Hash,
Equivalent_Elements => "=");
package Things_Keys is new Things.Generic_Keys
(Key_Type => Thing_Key,
Key => Key,
Hash => Hash,
Equivalent_Keys => "=");
Set : Things.Set;
begin
-- Inserting 4 elements. Note that the key is stored only in the element.
Set.Insert ((Key => 1, Data => 10));
Set.Insert ((Key => 2, Data => 20));
Set.Insert ((Key => 3, Data => 30));
Set.Insert ((Key => 4, Data => 40));
for T of Set loop
Put_Line (Image (T));
end loop;
New_Line;
-- Update the element. See also RM 96.10 (3). Opposed to most other
-- containers, you cannot omit "Reference_Preserving_Key" as the "Set" type
-- does not have a "Variable_Indexing" aspect specifying "Reference_Preserving_Key".
-- Hence, you need write it out explicitly.
Things_Keys.Reference_Preserving_Key (Set, 3).Data := 300;
-- Example if you really need a pointer to element with key 3.
declare
type Thing_Access is not null access all Thing;
type Thing_Constant_Access is not null access constant Thing;
-- Element is mutable via P , i.e. P.Data := 301 (OK)
-- Element is not mutable via CP, i.e. CP.Data := 302 (Error)
P : Thing_Access := Things_Keys.Reference_Preserving_Key (Set, 3).Element;
CP : Thing_Constant_Access := Things_Keys.Constant_Reference (Set, 3).Element;
begin
null;
end;
for T of Set loop
Put_Line (Image (T));
end loop;
New_Line;
end Main;
output (same for both)
Key = 1, Value = 10
Key = 2, Value = 20
Key = 3, Value = 30
Key = 4, Value = 40
Key = 1, Value = 10
Key = 2, Value = 20
Key = 3, Value = 300
Key = 4, Value = 40
You might want to use P := Map.Reference(C).Element;
Function Reference returns a value of Reference_Type that has aspect Implicit_Dereference whose value is Element and whose type is not null access Element_Type.
In C, the use of bits in some form of unsigned char or int to represent non-exclusive conditions is very common and, by use of the & | and ~ operators, is extremely efficient. From my limited Ada experience, the equivalent in Ada would be as illustrated in the following code.
with Ada.Text_IO; use Ada.Text_IO;
procedure Main is
type Colours is (Red, Green, Blue, Orange, Yellow, Purple);
type BitFieldType is array (Colours) of Boolean;
pragma Pack (BitFieldType);
RedBitField : constant BitFieldType := (Red => True, others => False);
GreenBitField : constant BitFieldType := (Green => True, others => False);
BlueBitField : constant BitFieldType := (Blue => True, others => False);
OrangeBitField : constant BitFieldType := (Orange => True, others => False);
YellowBitField : constant BitFieldType := (Yellow => True, others => False);
PurpleBitField : constant BitFieldType := (Purple => True, others => False);
NoColourBitField : constant BitFieldType := (others => False);
AllColoursBitField : constant BitFieldType := (others => True);
MyBitField : BitFieldType;
MyOtherBitField : BitFieldType;
Counter : Integer := 0;
begin
MyBitField := not RedBitField;
MyOtherBitField := RedBitField;
if (MyOtherBitField or MyBitField) = AllColoursBitField then
Counter := Counter + 1;
end if;
if (MyBitField and MyOtherBitField) = NoColourBitField then
Counter := Counter + 1;
end if;
Put_Line ("Counter is " & Integer'image (Counter));
end Main;
This appears somewhat clunky. Is there a better and more Lovelacey way to use bit maps like this?
What are you actually trying to achieve with your bitfields? You seem to want to write C using Ada. If that is true then consider using a modular type in Ada where you would use an unsigned type in C.
Section 4.5.1 of the Ada 2012 Reference Manual states:
For modular types, the predefined logical operators are defined on a
bit-by-bit basis, using the binary representation of the value of the
operands to yield a binary representation for the result, where zero
represents False and one represents True. If this result is outside
the base range of the type, a final subtraction by the modulus is
performed to bring the result into the base range of the type.
The logical operators on arrays are performed on a
component-by-component basis on matching components (as for equality —
see 4.5.2), using the predefined logical operator for the component
type. The bounds of the resulting array are those of the left operand.
For example, an unsigned type for your example could be defined as
type Color_Matrix is mod 2**6;
Red : constant Color_Matrix := 2#100000#;
Green : constant Color_Matrix := 2#010000#;
Blue : constant Color_Matrix := 2#001000#;
Orange : constant Color_Matrix := 2#000100#;
Yellow : constant Color_Matrix := 2#000010#;
Purple : constant Color_Matrix := 2#000001#;
No_Color : constant Color_Matrix := 0;
All_Colors : constant Color_Matrix := 2#111111#;
You can now perform all your familiar operations on instances of Color_Matrix.
Edit:
Additional information comparing Ada represenation clauses and C/C++ bitfields can be found at https://sworthodoxy.blogspot.com/2014/03/ada-vs-c-bit-fields.html
It does depend what you are trying to do.
Often you'll see convoluted use of the & | ~ << >> operators (or sometimes even && ||) and easy-to-get-wrong mask values in C to set, clear or test a single bit (e.g. turn RED on or off in a BitFieldType) instead of accessing the bit directly:
MyBitField(Red) := TRUE;
If MyBitField(Orange) then ...
Funnily enough, for microcontrollers with bit set, clear and test instructions, it's quite a difficult job for the compiler to translate the C code into the obvious simple instruction.
I really should not be spending my Saturday doing pupils homework! ;-)
Try to move as much as possible to the declaration part. You may do something like this:
-- Warning: Not tested
with Ada.Text_IO;
procedure Bit_Fields is
type Typ_Counter is range 0 .. 1_000_000; -- Fix this!
package Counter_Io is new Ada.Text_Io.Integer_Io (Typ_Counter);
procedure Increment (Counter : in out Typ_Counter; On_Condition : Boolean) is
begin
if On_Condition then
Counter := Counter + 1; -- May overflow!
end if;
end Increment;
type Typ_Colour is mod 2**8 with Size => 8; -- Look into this!
Colour_Max : constant Typ_Colour := Typ_Colour'Last;
Colour_None : constant Typ_Colour := Typ_Colour'First;
type Knd_Colour is (Red, Green, Blue, Orange, Yellow, Purple);
type Arr_Colour is array (Knd_Colour) of Typ_Colour;
None : constant Arr_Colour := (others => Colour_None);
Max : constant Arr_Colour := (others => Colour_Max);
generic
with function Operation (Left, Right : Typ_Colour) return Typ_Colour;
function Generic_Operation (Left, Right : Arr_Colour) return Arr_Colour;
function Generic_Operation (Left, Right : Arr_Colour) return Arr_Colour
is
Result : Arr_Colour;
begin
for Gun in Result'Range loop
Result (Gun) := Operation (Left => Left (Gun),
Right => Right (Gun));
end loop;
return Result;
end Generic_Operation;
function "or" is new Generic_Operation (Operation => "or");
function "and" is new Generic_Operation (Operation => "and");
My_Colours : Arr_Colour;
My_Other_Colours : Arr_Colour;
Counter : Typ_Counter := 0;
begin
My_Colours := (Red => not Colour_Max, others => Colour_None);
My_Other_Colours := (Red => Colour_Max, others => Colour_None);
Increment (Counter, On => (My_Other_Colours or My_Colours) = Max);
Increment (Counter, On => (My_Colours and My_Other_Colours) = None);
declare
use Ada.Text_Io, Counter_IO;
begin
Put ("Counter is ");
Put (Counter, Width => 0);
New_Line;
end;
end Bit_Fields;
I wrote a very simple program but I failed to prove it's functional correctness. It uses a list of items, with each item having a field indicating if it's free or used :
type t_item is record
used : boolean := false;
value : integer := 0;
end record;
type t_item_list is array (1 .. MAX_ITEM) of t_item;
items : t_item_list;
There is also a counter indicating the number of used elements :
used_items : integer := 0;
The append_item procedure checks the used_items counter to see if the list is full. If it's not, the first free entry is marked as used and the used_items counter is incremented :
procedure append_item (value : in integer; success : out boolean)
is
begin
if used_items = MAX_ITEM then
success := false;
return;
end if;
for i in items'range loop
if not items(i).used then
items(i).value := value;
items(i).used := true;
used_items := used_items + 1;
success := true;
return;
end if;
end loop;
-- Should be unreachable
raise program_error;
end append_item;
I don't know how to prove that used_items equals the number of used elements in the list.
Note also that gnatprove messages sometimes are puzzling and I don't know where to look for some more informations in the many gnatprove/* files. In fact, the main difficulty for me is to figure out what the prover needs. I would be very glad if you have some indications about all that.
Counting elements which have a given property in a data-structure is tricky to express indeed. To help with this problem, we provide with SPARK pro of generic counting function in the library of lemmas. This library of higher level functions is described in the user guide:
http://docs.adacore.com/spark2014-docs/html/ug/en/source/spark_libraries.html#higher-order-function-library
To use it, you should modify your project file to use the project file of the lemma library and set SPARK_BODY_MODE to Off.
You should also set the environment variable SPARK_LEMMAS_OBJECT_DIR to the absolute path of the object directory where you want compilation and verification artefacts for the lemma library to be created.
Then, you can instantiate SPARK.Higher_Order.Fold.Count for your purpose. It expects an unconstrained array type and a function to choose which elements should be counted. So I have rewritten your code to supply this information and instantiated the generic as follows:
type t_item_list_b is array (positive range <>) of t_item;
subtype t_item_list is t_item_list_b (1 .. MAX_ITEM);
function Is_Used (X : t_item) return Boolean is
(X.used);
package Count_Used is new SPARK.Higher_Order.Fold.Count
(Index_Type => Positive,
Element => t_item,
Array_Type => t_item_list_b,
Choose => Is_Used);
Count_Used now contains:
a Count function that you can use in your invariant:
function invariant return boolean is
(used_items = Count_Used.Count (items));
lemmas to prove usual things for counting: Count_Zero to prove that the result of count is 0 is no elements have the property in the array, and Update_Count to know how Count is modified when the array is updated. These properties are obvious for a person, but in fact they need induction to prove, so they are generally out of reach of automatic solvers. To prove append_item, I now simply need to call Update_Count after the update of item as follows:
procedure append_item
(value : in integer;
success : out boolean)
with ...
is
Old_Items : t_item_list := items with Ghost;
begin
if used_items = MAX_ITEM then
success := false;
return;
end if;
for i in items'range loop
if not items(i).used then
items(i).value := value;
items(i).used := true;
used_items := used_items + 1;
success := true;
Count_Used.Update_Count (items, Old_Items, I);
return;
end if;
end loop;
-- Should be unreachable
raise program_error;
end append_item;
I hope this helps,
Best Regards,
Using this spec for Append_Item doesn’t prove that Used_Items is equal to the number of used elements in the list, but (with the removal of the raise Program_Error) it does at least prove.
procedure Append_Item (Value : in Integer; Success : out Boolean)
with Pre =>
Used_Items <= Max_Item -- avoid overflow check
and
(Used_Items = Max_Item
or (for some Item of Items => not Item.Used)),
Post =>
(Used_Items'Old < Max_Item
and Used_Items = Used_Items'Old + 1
and Success = True)
or (Used_Items'Old = Max_Item and Success = False);
I liked Simons approach, it was close to working I think.
I used that as a starting point, and applied some changes which I was able to prove using SPARK community edition, without needing additional support packages.
One of the first things I did was to take advantage of Ada's stronger typing to constrain the types as much as possible. In particular, rather than defining Used_Items as an Integer, I defined an Element_Count subtype whose range cannot exceed Max_Items. The more you can apply such constraints, the less work you need to pass on to the prover.
I then created an Integer_List type as a higher level abstraction type,
and moved the array types and element types into the private part of the package.
Doing this, I found simplified the interface, I think. As it then made sense to create helper functions (Length and Is_Full) which are used in the preconditions
to more simply express the properties to the client, which helps because they are repeated several times in the pre and post conditions, but which are expanded in the private part of the package to more specifically provide the detail.
I used conditional expressions in the pre and post conditions, as I think that
more clearly expresses the contract to the reader.
The only other thing I found I needed to add was a loop invariant in the body
of the Append_Item. The prover told me that I was missing a loop invariant,
which I added. You basically need to prove that you cannot exit the loop without
falling into the if statement finding a slot to add the new value.
package Array_Item_Lists with SPARK_Mode is
Max_Item : constant := 3;
subtype Element_Count is Natural range 0 .. Max_Item;
type Integer_List is private;
function Length (List : Integer_List) return Element_Count;
function Is_Full (List : Integer_List) return Boolean;
procedure Append_Item (List : in out Integer_List;
Value : Integer;
Success : out Boolean)
with
Pre => (if Length (List) < Max_Item
then not Is_Full (List)
else Is_Full (List)),
Post =>
(if Length (List'Old) < Max_Item
then Length (List) = Length (List'Old) + 1
and then Success
else (Length (List'Old) = Max_Item and then Success = False));
private
type t_item is record
used : Boolean := False;
value : Integer := 0;
end record;
type t_item_list is
array (Element_Count range 1 .. Element_Count'Last) of t_item;
type Integer_List is
record
Items : t_item_list;
used_items : Element_Count := 0;
end record;
function Length (List : Integer_List) return Element_Count is
(List.used_items);
function Is_Full (List : Integer_List) return Boolean is
(for all Item of List.Items => Item.used);
end Array_Item_Lists;
pragma Ada_2012;
package body Array_Item_Lists with SPARK_Mode is
procedure Append_Item (List : in out Integer_List;
Value : Integer;
Success : out Boolean) is
begin
Success := False;
if List.used_items = Max_Item then
return;
end if;
for i in List.Items'Range loop
pragma Loop_Invariant
(for some j in i .. Max_Item => not List.Items (j).used);
if not List.Items (i).used then
List.Items (i).value := Value;
List.Items (i).used := True;
List.used_items := List.used_items + 1;
Success := True;
return;
end if;
end loop;
end Append_Item;
end Array_Item_Lists;
This version was quite a bit more work , and probably can be improved upon, but it attempts to prove more functional properties one might want to apply to this problem. For example, it ensures that adding an element to the list only modifies one storage element, without modifying others, and that the number of elements in the list matches the number of used slots in the array. This version also provides a main program which is written in SPARK that uses the package.
I did have an intermediate version which I arrived at fairly easily that proved
the extra functional requirements, but when I tried to use it with a client
program written in SPARK, it led me to add to and revise what I had.
package Array_Item_Lists with SPARK_Mode is
Max_Item : constant := 3; -- Set to whatever limit is desired
subtype Element_Count is Natural range 0 .. Max_Item;
subtype Element_Index is Natural range 1 .. Max_Item;
type Integer_List is private;
function Create return Integer_List
with Post => Length (Create'Result) = 0
and then Used_Count (Create'Result) = 0
and then not Is_Full (Create'Result)
and then Not_Full (Create'Result)
and then (for all I in 1 .. Max_Item =>
not Has_Element (Create'Result, I));
function Length (List : Integer_List) return Element_Count;
function Used_Count (List : Integer_List) return Element_Count;
-- Is_Full is based on Length being = Max_Item
function Is_Full (List : Integer_List) return Boolean;
-- Not_Full is based on there being empty slots in the list available
-- Since the length is kept in sync with number of used slots, the
-- negation of one result should be equivalent to the result of the other
function Not_Full (List : Integer_List) return Boolean;
function Next_Index (List : Integer_List) return Element_Index
with Pre => Used_Count (List) = Length (List)
and then Length (List) < Max_Item and then Not_Full (List),
Post => not Has_Element (List, Next_Index'Result);
function Element (List : Integer_List;
Index : Element_Index) return Integer;
function Has_Element (List : Integer_List;
Index : Element_Index) return Boolean;
procedure Append_Item (List : in out Integer_List;
Value : Integer;
Success : out Boolean)
with
Pre => Used_Count (List) = Length (List)
and then (if Length (List) < Max_Item
then Not_Full (List) and then
not Has_Element (List, Next_Index (List))
else Is_Full (List)),
Post =>
(if not Is_Full (List) then Not_Full (List)) and then
(if Length (List'Old) < Max_Item
then Success
and then Length (List) = Length (List'Old) + 1
and then Element (List, Next_Index (List'Old)) = Value
and then Has_Element (List, Next_Index (List'Old))
and then (for all I in 1 .. Max_Item =>
(if I /= Next_Index (List'Old) then
Element (List'Old, I) = Element (List, I)
and then
Has_Element (List'Old, I) = Has_Element (List, I)))
and then Used_Count (List) = Used_Count (List'Old) + 1
else not Success and then
Length (List) = Max_Item and then List'Old = List
and then Used_Count (List) = Max_Item);
private
type t_item is record
Used : Boolean := False;
Value : Integer := 0;
end record;
type t_item_list is
array (Element_Count range 1 .. Element_Count'Last) of t_item;
type Integer_List is
record
Items : t_item_list := (others => (Used => False, Value => 0));
Used_Items : Element_Count := 0;
end record;
function Element (List : Integer_List;
Index : Element_Index) return Integer is
(List.Items (Index).Value);
function Has_Element (List : Integer_List;
Index : Element_Index) return Boolean is
(List.Items (Index).Used);
function Length (List : Integer_List) return Element_Count is
(List.Used_Items);
function Is_Full (List : Integer_List) return Boolean is
(for all Item of List.Items => Item.Used
and then Length (List) = Max_Item);
function Not_Full (List : Integer_List) return Boolean is
(for some Item of List.Items => not Item.Used
-- Used_Count (List) < Max_Item
);
end Array_Item_Lists;
I'm not quite happy about having both an Is_Full function and a Not_Full function,
and that may be something that can be simplified. But I did manage to get this to prove, once I added some reasonable assumptions in the body below.
pragma Ada_2012;
package body Array_Item_Lists with SPARK_Mode is
procedure Append_Item (List : in out Integer_List;
Value : Integer;
Success : out Boolean)
is
Old_Used_Count : constant Element_Count := Used_Count (List);
begin
if List.Used_Items = Max_Item then
Success := False;
return;
end if;
declare
Update_Index : constant Element_Index := Next_Index (List);
begin
pragma Assert (List.Items (Update_Index).Used = False);
List.Items (Update_Index) := (Value => Value, Used => True);
List.Used_Items := List.Used_Items + 1;
Success := True;
pragma Assert (List.Items (Update_Index).Used = True);
-- We have proven that one the one element of the array
-- has been modified, and that it was previous not used,
-- and that not it is used. From this, we can now assume that
-- the use count was incremented by one
pragma Assume (Used_Count (List) = Old_Used_Count + 1);
-- If the length isn't full (Is_Full) we can assume the
-- number of used items has room also. We incremented both
-- of these above, and the two numbers are always in sync.
pragma Assume (if not Is_Full (List) then Not_Full (List));
end;
end Append_Item;
-----------------------------------------------------------------
function Create return Integer_List is
Result : Integer_List := (Items => <>,
Used_Items => 0);
begin
for I in Result.Items'Range loop
Result.Items (I) := (Used => False, Value => 0);
pragma Loop_Invariant
(for all J in 1 .. I => Result.Items (J).Used = False);
end loop;
pragma Assert (for all Item of Result.Items => Item.Used = False);
-- Since we have just proven that all items are not used, we know
-- the Used_Count has to be zero, and hence we are not full
-- so we can make the following assumptions
pragma Assume (Used_Count (Result) = 0);
pragma Assume (Not_Full (Result));
return Result;
end Create;
-----------------------------------------------------------------
function Next_Index (List : Integer_List) return Element_Index
is
Result : Element_Index := 1;
begin
Search_Loop :
for I in List.Items'Range loop
pragma Loop_Invariant
(for some J in I .. Max_Item => not List.Items (J).Used);
if not List.Items (I).Used then
Result := I;
exit Search_Loop;
end if;
end loop Search_Loop;
return Result;
end Next_Index;
function Used_Count (List : Integer_List) return Element_Count is
Count : Element_Count := 0;
begin
for Item of List.Items loop
if Item.Used then
Count := Count + 1;
end if;
end loop;
return Count;
end Used_Count;
end Array_Item_Lists;
And finally, here is a SPARK main program that makes calls to the above package
with Ada.Text_IO; use Ada.Text_IO;
with Array_Item_Lists;
procedure Main with SPARK_Mode
is
List : Array_Item_Lists.Integer_List := Array_Item_Lists.Create;
Success : Boolean;
begin
Array_Item_Lists.Append_Item (List => List,
Value => 3,
Success => Success);
pragma Assert (Success);
Array_Item_Lists.Append_Item (List => List,
Value => 4,
Success => Success);
pragma Assert (Success);
Array_Item_Lists.Append_Item (List => List,
Value => 5,
Success => Success);
pragma Assert (Success);
Array_Item_Lists.Append_Item (List => List,
Value => 6,
Success => Success);
pragma Assert (not Success);
Put_Line ("List " &
(if Array_Item_Lists.Is_Full (List)
then "is Full!" else "has room!"));
end Main;
Lets say I have
function x return boolean is
type range0 is range 1..1;
begin
canse x is
when 4=> range0:=firstArray'range;
when 5=> range0:=secondArray'range;
when 6=> range0:=1..100;
end case;
end x;
Basically I would like to change the range of range0 on the go? How may I accomplish this without using the declare block?
Basically I would like to change the range of range0 on the go? How may I accomplish this without using the declare block?
Hm...
In Ada 2012 you can use if- and case-expressions, so you could have something like this:
Type Array_Type is Array(Positive Range <>) of Integer;
Array_1 : Array_Type(1..128);
Array_2 : Array_Type(33..63);
-- your variant-selector
Use_1 : constant Boolean:= True;
-- Your variant-range here:
Subtype Variant_Range is Positive Range
(if Use_1 then Array_1'First else Array_2'First)
..(if Use_1 then Array_1'Last else Array_2'Last);
Array_3 : Array_Type( Variant_Range );
All that said, this probably isn't the best way to go about it and using a declare-block is very likely going to be more easily maintained.
You could technically satisfy the stated requirements by converting the obvious way (declare block) into a local procedure :
function x return boolean is
procedure use_dynamic_range(first,last : in integer) is
type range0 is new integer range first .. last;
begin
null;
end use_dynamic_range;
begin
case z is
when 4=> use_dynamic_range(firstArray'first, firstArray'last);
when 5=> use_dynamic_range(secondArray'first, secondArray'last);
when 6=> use_dynamic_range(1,100);
end case;
end x;
Because it's a local procedure it executes in the same scope as the equivalent declare block, therefore it can access everything visible within X, so you don't need to pass it a huge parameter list.
What about something like :
function x return Boolean is
type Range_Info_Type is
record
First : Integer;
Last : Integer;
end record;
function Get_Range_Info_Type return Range_Info_Type is
begin
case z is
when 4=> return Range_Info_Type'(First => firstArray'First,
Last => FirstArray'Last);
when 5=> return Range_Info_Type'(First => secondArray'First,
Last => secondArray'Last);
when 6=> return Range_Info_Type'(First => 1,
Last => 100);
when others => return Range_Info_Type'(First => 1,
Last => 1);
end case;
end;
MyTypeInfo : constant Range_Info_Type := Get_Range_Info_Type;
-- Now declare the actual type I want to use.
type range0 is new Integer range MyTypeInfo.First .. MyTypeInfo.Last;
begin
return true;
end x;
A declare block might be easier to understand by this should do the trick.
Note that you cannot write type range0 is range <expr>..<expr> in your case since expr should be a static expression (see RM 3.5.4)
Another non declare-block answer from Ada 2012:
Minimum : Integer := Integer'First; --' SO highlight correction
Maximum : Integer := Integer'Last; --' *same*
Function In_Range(X : Integer) return Boolean is
( X in range Minimum..Maximum );
Subtype Variant_Range is Integer Range Integer
with Dynamic_Predicate => In_Range(Variant_Range);
WARNING: Though this should work, I have not tested it.