Ada: How to get Access to Vector element? - pointers

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.

Related

Ada constraint error: Discriminant check failed. What does this mean?

I've tried searching the docs and the code, but I'm unable to find what this is and therefore how to correct it.
Scenario:
I'm using the Ada SPARK vectors library and I have the following code:
package MyPackage
with SPARK_Mode => On
is
package New_Vectors is new Formal_Vectors (Index_Type => test, Element_Type => My_Element.Object);
type Object is private;
private
type Object is
record
Data : New_Vectors.Vector (Block_Vectors.Last_Count);
Identifier : Identifier_Range;
end record;
I get the error when the code calls:
function Make (Identifier : Identifier_Range) return Object is
begin
return (
Data => New_Vectors.Empty_Vector,
Identifier => Identifier);
end Make;
Pointing to Empty_Vector. The difficulty is that Empty_Vector defines the Capacity as 0 which appears to be leading to the problem. Now I'm not sure then how to deal with that as Capacity seems to be in the type definition (having looked in a-cofove.ads).
So basically I'm stuck as to how to resolve this; or quite how to spot this happening in future.
Your analysis is correct. The error occurs because you attempt to assign an empty vector (i.e. a vector with capacity 0) to a vector with capacity Block_Vectors.Last_Count (which appears to be non-zero).
You actually do not need to initialize the vector explicitly in order to use it. A default initialization (using <>, see, for example, here) suffices as shown in de example below.
However, in order to prove the absence of runtime errors, you do need to explicitly clear the vector using Clear. The Empty_Vector function can then be used to in assertions that check if a vector is empty or not as shown in the example below. The example can be shown to be free of runtime errors using gnatprove. For example by opening the prove settings via menu SPARK > Prove in GNAT Studio, selecting "Report checks moved" in the "General" section (top left) and then running the analysis by selecting "Execute" (bottom right).
main.adb
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Formal_Vectors;
procedure Main with SPARK_Mode is
package My_Vectors is new Ada.Containers.Formal_Vectors
(Index_Type => Natural,
Element_Type => Integer);
use My_Vectors;
type Object is record
Data : Vector (Capacity => 10); -- Max. # of elements: 10
Value : Integer;
end record;
-- Initialize with default value (i.e. <>), no explicit initialization needed.
Obj : Object :=
(Data => <>,
Value => 42);
begin
-- Clear the vector, required for the assertions to be proven.
Clear (Obj.Data);
-- Assert that the vector is not empty.
pragma Assert (Obj.Data = Empty_Vector);
-- Populate the vector with some elements.
Append (Obj.Data, 4);
Append (Obj.Data, 5);
Append (Obj.Data, 6);
-- Assert that the vector is populated.
pragma Assert (Obj.Data /= Empty_Vector);
-- Show the contents of Obj.Data.
Put_Line ("Contents of Obj.Data:");
for I in Natural range 0 .. Natural (Length (Obj.Data)) - 1 loop
Put_Line ("[" & I'Image & "]" & Element (Obj.Data, I)'Image);
end loop;
New_Line;
-- or, alternatively using an iterator ...
declare
I : Extended_Index := Iter_First (Obj.Data);
begin
while Iter_Has_Element (Obj.Data, I) loop
Put_Line ("[" & I'Image & "]" & Element (Obj.Data, I)'Image);
I := Iter_Next (Obj.Data, I);
end loop;
end;
New_Line;
-- Show the contents of Obj.Value.
Put_Line ("Contents of Obj.Value:");
Put_Line (Obj.Value'Image);
New_Line;
end Main;
output
Contents of Obj.Data:
[ 0] 4
[ 1] 5
[ 2] 6
[ 0] 4
[ 1] 5
[ 2] 6
Contents of Obj.Value:
42

Cartesian Product of Lists Using Ada

I am currently working on programming this (https://rosettacode.org/wiki/Cartesian_product_of_two_or_more_lists) in Ada, I am trying to do a Cartesian product between different sets. I need help figuring it out, the main issue is how would I be able to declare empty Pairs and calculate that if it's empty, then the result should be empty. Thank you!
Numbers I am trying to use:
{1, 2} × {3, 4}
{3, 4} × {1, 2}
{1, 2} × {}
{} × {1, 2}
My code:
with Ada.Text_IO; use Ada.Text_IO; -- Basically importing the functions that will be used to print out the results.
procedure Hello is -- Procedure is where variables & functions are declared!
type T_Pair is array(1..2) of Integer; -- Declare a type of array that contains a set of 2 numbers (Used for final result!).
type T_Result is array(1..4) of T_Pair; -- Declare a type of array that contains a set of T_Pair(s), used to hold the result.
Demo1 : T_Result;
Demo1A : T_Pair := (1, 2);
Demo1B : T_Pair := (3, 4);
function Fun_CartProd(p1: T_Pair; p2: T_Pair) return T_Result is
results: T_Result;
i: integer := 1;
begin
for j in 1..2 loop
for h in 1..2 loop
results(i) := (p1(j), p2(h));
i := i + 1;
end loop;
end loop;
return results;
end Fun_CartProd;
begin -- This is where the statements go
Demo1 := Fun_CartProd(Demo1A, Demo1B);
for K in 1 .. Demo1'length loop
Put(" [");
for B in 1 .. Demo1(K)'length loop
Put(Integer'Image(Demo1(K)(B)));
if Demo1(K)'length /= B then
Put(",");
end if;
end loop;
Put("]");
if Demo1'length /= K then
Put(",");
end if;
end loop;
Put_Line(""); -- Create a new line.
end Hello;
Since each set of integers can be any length, including empty, I would start with a type that can handle all those situations:
type Integer_Set is array(Positive range <>) of Integer; -- Input type
type Integer_Tuple is array(Positive range <>_ of Integer; -- Output type
and you can represent the empty sets and tuples this way:
Empty_Set : constant Integer_Set(1..0) := (others => <>);
Empty_Tuple : constant Integer_Tuple(1..0) := (others => <>);
The other problem isn't just how many elements are in each set, but how many sets you will be finding the product of. For this I would recommend some kind of container. An array won't work here because each of the individual sets can have different sizes (including empty), but Ada has a variety of "indefinite" containers that can handle that. Here is an example using vectors:
package Set_Vectors is new Ada.Containers.Indefinite_Vectors
(Index_Type => Positive,
Element_Type => Integer_Set);
package Tuple_Vectors is new Ada.Containers.Indefinite_Vectors
(Index_Type => Positive,
Element_Type => Integer_Tuple);
and you can then represent an empty result as:
Empty_Tuple_Vector : constant Tuple_Vectors.Vector := Tupler_Vectors.Empty_Vector;
Now you can create a function that takes in a vector of sets and returns a Cartesian product which will also be a vector of sets:
function Cartesian_Product(Inputs : Set_Vectors.Vector) return Tuple_Vectors.Vector;
If one of the input sets is empty, you return an Empty_Tuple_Vector. You can check if one of the input sets are empty by checking their Length attribute result. It will be 0 if they are empty. Additionally if the input vector is completely empty, you can decide to either return Empty_Tuple_Vector or raise an exception. For example:
if Inputs'Length = 0 then
return Empty_Tuple_Vector; -- or raise an exception, etc.
end if;
for Set of Inputs loop
if Set'Length = 0 then
return Empty_Tuple_Vector;
end if;
-- Maybe do other stuff here if you need
end loop;
Note that the logic you presented assumes only pairs of inputs. I don't have enough experience to convert your logic to account for variable inputs, but perhaps someone can comment on that if you need it.
Also note as Flyx commented, this does not semantically check if a set is a set or not on the inputs (I.E. no duplicate values).

Ada - getting string from text file and store in array

Hi im just wondering how to put data in an array if i loop txt and store it in A_Composite Name.
procedure Main is
type An_Array is array (Natural range <>) of A_Composite;
type A_Composite is
record
Name : Unbounded_String;
end record;
File : Ada.Text_IO.File_Type;
Line_Count : Integer := 0;
begin
Ada.Text_IO.Open (File => File,
Mode => Ada.Text_IO.In_File,
Name => "highscore.txt");
while not Ada.Text_IO.End_Of_File (File) loop
declare
Line :String := Ada.Text_IO.Get_Line (File);
begin
--I want to store Line String to array. but i don't know how to do it
end;
end loop;
Ada.Text_IO.Close (File);
end Main;
Ok, you have an unconstrained array here. This has implications; you see an unconstrained array gains its definite length when the object (general sense, not OOP) is declared or initialized.
As an example, let's look at strings (which are unconstrained arrays of characters) for an example to see how this works:
-- Create a string of 10 asterisks; the initialization takes those bounds.
A : constant string(1..10):= (others => '*');
-- Create a string of 10 asterisks; but determined by the initialization value.
B : constant string := (1..10 => '*');
-- Another way of declaring a string of 10 asterisks.
C : constant string := ('*','*','*','*','*','*','*','*','*','*');
Now, you can get these bounds from a function call; this means that we can use function-calls to return these values recursively.
Function Get_Text return An_Array is
Package Unbounded renames Ada.Strings.Unbounded;
-- You'll actually want the Get_Line that takes a file.
Function Get_Line return Unbounded.Unbounded_String
renames Unbounded.Text_IO.Get_Line;
begin
return (1 => (Name => Get_Line)) & Get_Text;
exception
when End_Error => return ( 1..0 => (Name => Unbounded.Null_Unbounded_String) );
end Get_Text;
So, that's how you'd do it using an unconstrained array.

How to change the range of the range type?

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.

Return a fat/thick pointer as an out parameter

I am having trouble creating a thick pointer. My current set of declarations look like this:
type Index_Typ is mod 20; -- will be larger in real life
type Data_Buffer_Typ is array (Index_Typ range <>) of Integer; --unconstrained array type
type Data_Buffer_Ptr is access all Data_Buffer_Typ; -- a thick pointer, contains the bounds of array subtype pointed to and address..
Data_Buffer : aliased Data_Buffer_Typ (Index_Typ) := (others => 0); -- this is private
type Result_Typ is (Ok, Overflow, Null_Pointer);
procedure Retrieve (Index : in Index_Typ;
Len : in Index_Typ;
Data_Ptr : out Data_Buffer_Ptr;
Result : out Result_Typ) is
begin
-- assuming range checks are ok, what goes here ?
end Retrieve;
so if i declare:
Ptr : Data_Buffer_Ptr := null;
and given a call of Retreive (2,3, Ptr,Result); how do i end up with a pointer that points at elements 2,3 & 4 of Data_Buffer ?
Notes:
Yes i know passing out an array slice will probably be done as a
pointer anyway, but we want to explicitly use pointers, not
implicitly (and not my choice!).
Yes i have experimented, i usually get : (object subtype must statically match designated subtype) error message..
Where possible use of new to be avoided.
This works for me, though I have to say it's repulsive! Note the order of the components in Fat_Pointer, which is the opposite to what I started with, and the size of the record on this 64-bit machine (I put the rep clause in to have make the order explicit, it works fine without). Also, I think you're stuck with the new.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Conversion;
with System;
procedure Fat is
type Index_Typ is mod 20;
type Data_Buffer_Typ is array (Index_Typ range <>) of Integer;
type Data_Buffer_Ptr is access all Data_Buffer_Typ;
Data_Buffer : aliased Data_Buffer_Typ (Index_Typ) := (others => 0);
type Result_Typ is (Ok, Overflow, Null_Pointer);
procedure Retrieve (Index : in Index_Typ;
Len : in Index_Typ;
Data_Ptr : out Data_Buffer_Ptr;
Result : out Result_Typ)
is
type Bound is (Lower, Upper);
type Bounds is array (Bound) of Index_Typ;
type Bounds_P is access Bounds;
type Fat_Pointer is record
The_Data : System.Address;
The_Bounds : Bounds_P;
end record;
for Fat_Pointer use record
The_Data at 0 range 0 .. 63;
The_Bounds at 8 range 0 .. 63;
end record;
function To_Data_Buffer_Ptr
is new Ada.Unchecked_Conversion (Fat_Pointer, Data_Buffer_Ptr);
Answer : constant Fat_Pointer
:= (The_Bounds => new Bounds'(Lower => Index,
Upper => Index + Len - 1),
The_Data => Data_Buffer (Index)'Address);
begin
Result := Ok;
Data_Ptr := To_Data_Buffer_Ptr (Answer);
end Retrieve;
Ptr : Data_Buffer_Ptr := null;
Result : Result_Typ;
begin
for J in Data_Buffer'Range loop
Data_Buffer (J) := Integer (J);
end loop;
Retrieve (2, 3, Ptr, Result);
for J in Ptr'Range loop
Put_Line (J'Img & " => " & Ptr (J)'Img);
end loop;
end Fat;

Resources