I have a compile-error that states: "expected private type "Pekare" defined at line 3. found an access type".
this is the .ads code:
package Image_Handling is
type Data_Access is private;
type Image_Type is record
X_Dim, Y_Dim : Integer;
Data : Data_Access := null;
end record;
type RGB_Type is private;
functions...
private
type RGB_Type is record
R, G ,B : Natural;
T : Boolean := False;
end record;
type Undim_Array is array(Positive range <>, Positive range <>) of RGB_Type;
type Data_Access is access Undim_Array;
end Image_Handling;
The problem is that the Data_Access type is private and not known to be an access type in the visible ("public") part of the spec. Therefore, you cannot assign null to the Data field as this would presume the Data field to be of an access type. The typical solution is to use a deferred constant. Such a constant can be declared and used in the public part of the spec, but it's full definition (i.e. it's actual value) is deferred to the private part. Below an example:
image_handling.ads
package Image_Handling is
type Data_Access is private;
None : constant Data_Access; -- Deferred constant.
type Image_Type is record
X_Dim, Y_Dim : Integer;
Data : Data_Access := None;
end record;
type RGB_Type is private;
private
type RGB_Type is record
R, G ,B : Natural;
T : Boolean := False;
end record;
type Undim_Array is array(Positive range <>, Positive range <>) of RGB_Type;
type Data_Access is access Undim_Array;
None : constant Data_Access := null;
-- ^^^ At this point we know that Data_Access is an access type and
-- provide a full definition of the constant that states it's value.
end Image_Handling;
Related
I am trying to update an element in a vector. I have quite a few issues that I don't know how to solve. When I use Replace_Element, everything works, but I want to use the proper procedure.
This is my code:
with Ada.Containers.Vectors;
procedure Test_Update is
type Node is record
Parent : Integer := -1;
Size : Integer := -1;
end record;
function TestUpdate(n : Node; val : Integer) return Node is
begin
n.Size := n.Size + val;
return n;
end TestUpdate;
package NodeVector is new
Ada.Containers.Vectors
(
Index_Type => Natural,
Element_Type => Node
);
Nodes : NodeVector.vector;
Current_Node : Node;
begin
Current_Node.Size := 10;
Nodes.Append(Current_Node);
NodeVector.Update_Element(Nodes, 0, TestUpdate'Access(5));
--NodeVector.Update_Element(Nodes, 0, TestUpdate'Access);
end Test_Update;
These are the errors that I am getting, and I know what is causing them, but no idea how to fix them:
test_update.adb:11:09: error: assignment to "in" mode parameter not allowed
test_update.adb:28:59: error: unexpected argument for "Access" attribute
When I use the code in the comments, and remove the second parameter for the function, it still doesn't work.
You have a lot of things mixed up here. First if you look at Zerte's answer more carefully than before, you'll notice that your TestUpdate operation doesn't match that Process argument at all. It expects a procedure (you have a function) and the procedure's parameter is "in out" while you are using "in" and you have an additional parameter. You need to fix this first
If you want to use Update_Element (I don't recommend it for your specific case) then you need to look into "Nested Subprograms". Here is an example of how to change your TestUpdate operation to work with Update_Element:
procedure TestUpdate(V : in out NodeVector.Vector; val : Integer) is
procedure Actual_Update(N : in out Node) is
begin
n.Size := n.Size + val;
end Actual_Update;
begin
V.Update_Element(V.Last,Actual_Update'Access);
end TestUpdate;
Notice how the Actual_Update procedure actually matches the process argument of the Update_Element operation contract. Additionally, since Actual_Update is nested, it has access to the Val argument from TestUpdate.
Full example:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Vectors;
procedure Test_Update is
type Node is record
Parent : Integer := -1;
Size : Integer := -1;
end record;
package NodeVector is new
Ada.Containers.Vectors
(
Index_Type => Natural,
Element_Type => Node
);
Nodes : NodeVector.vector;
Current_Node : Node;
procedure TestUpdate(V : in out NodeVector.Vector; val : Integer) is
procedure Actual_Update(N : in out Node) is
begin
n.Size := n.Size + val;
end Actual_Update;
begin
V.Update_Element(V.Last,Actual_Update'Access);
end TestUpdate;
begin
Current_Node.Size := 10;
Nodes.Append(Current_Node);
TestUpdate(Nodes, 5);
end Test_Update;
With Vectors, you can also just index things directly. After you append an item, you can use <vector_name>.Last to get the cursor (index) for the last element...the one you just added. Example:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Vectors;
procedure Test_Update is
type Node is record
Parent : Integer := -1;
Size : Integer := -1;
end record;
package NodeVector is new
Ada.Containers.Vectors
(
Index_Type => Natural,
Element_Type => Node
);
Nodes : NodeVector.vector;
Current_Node : Node;
procedure Using_Cursors
(V : in out NodeVector.Vector;
N : Node;
Value : Integer)
is begin
Nodes.Append(N);
Nodes(Nodes.Last).Size := Nodes(Nodes.Last).Size + Value;
end Using_Cursors;
begin
Current_Node.Size := 10;
Using_Cursors(Nodes,Current_Node,5);
end Test_Update;
A quick Web search will lead you to...
A.18.2 The Package Containers.Vectors
(or, if you use GNAT Studio: right-click on "Vectors" in "Ada.Containers.Vectors", then choose Go To Declaration).
Then you will find this:
procedure Update_Element
(Container : in out Vector;
Index : in Index_Type;
Process : not null access procedure
(Element : in out Element_Type));
I would like to make a procedure to accept generic constrained arrays i.e. both ecgReadings and eegReadings:
Types declarations:
subtype ecgReadingsSize is Natural range 1..3;
subtype eegReadingsSize is Natural range 1..10;
subtype eegReading is Natural range 0..1; -- eegRReading is 0 or 1
subtype ecgReading is Natural range 2..600; -- Max heart rate 220
type ecgReadings is array (ecgReadingsSize) of ecgReading;
type eegReadings is array (eegReadingsSize) of eegReading;
type eegPartialSums is array (eegReadingsSize) of Natural;
Trying to make generic procedure:
package iocontroller is
generic
type ItemType is private;
type Index_Type is (<>); -- Any discrete type
type Array_Type is array (Index_Type range <>) of ItemType;
procedure startIO(inFileName : String; outFileName : String; List:
Array_Type);
Testing generic prodcure
procedure Main is --change name
type MyArray is array (Natural range <>) of Natural;
procedure ecgIO is new startIO(
ItemType => Natural,
Index_Type => Natural,
Array_Type => MyArray
);
I think you just need to constrain the generic type parameter Array_Type of Start_IO (see example below).
Note: Although it's not mandatory, you might, in this case, want to declare types instead of subtypes to prevent accidental (implicit) conversions from e.g. ECG_Reading to EEG_Reading, i.e. declare
type ECG_Reading_Index is range 1 .. 3;
type ECG_Reading is range 2 .. 600;
instead of
subtype ECG_Reading_Index is Natural range 1 .. 3;
subtype ECG_Reading is Natural range 2 .. 600;
and similar for EEG_Reading_Index and EEG_Reading.
But apart from that:
main.adb
with IO_Controller;
procedure Main is
subtype ECG_Reading_Index is Natural range 1 .. 3;
subtype ECG_Reading is Natural range 2 .. 600;
type ECG_Readings is array (ECG_Reading_Index) of ECG_Reading;
procedure Start_ECG_IO is new IO_Controller.Start_IO
(Item_Type => ECG_Reading,
Index_Type => ECG_Reading_Index,
Array_Type => ECG_Readings);
subtype EEG_Reading_Index is Natural range 1 .. 10;
subtype EEG_Reading is Natural range 0 .. 1;
type EEG_Readings is array (EEG_Reading_Index) of EEG_Reading;
procedure Start_EEG_IO is new IO_Controller.Start_IO
(Item_Type => EEG_Reading,
Index_Type => EEG_Reading_Index,
Array_Type => EEG_Readings);
ECG : ECG_Readings := (others => <>);
EEG : EEG_Readings := (others => <>);
begin
Start_ECG_IO ("ecg_in", "ecg_out", ECG);
Start_EEG_IO ("eeg_in", "eeg_out", EEG);
end Main;
io_controller.ads
package IO_Controller is
generic
type Item_Type is private;
type Index_Type is (<>);
type Array_Type is array (Index_Type) of Item_Type; -- remove "range <>"
procedure Start_IO
(FileName_In : String;
Filename_Out : String;
List : Array_Type);
end IO_Controller;
In Ada, the context can determine that "+" is not a String but an integer operator, as in the expression: "+"(5,2). The question is, how do I store that operator in a variable? I want to pass that integer operator, or some other one, as a binary function taking two Integers and returning an Integer. In the code below, I made an explicit function that just calls the operator, which I can use as a workaround. Is there some way to avoid having this wrapper, and pass around (an access to) Integer's "+" operator directly?
with Ada.Text_IO; use Ada.Text_IO;
procedure operator is
type binary_int_operator is access function(lhs : Integer; rhs : Integer) return Integer;
--plus : binary_int_operator := Integer."+"'Access;
--plus : binary_int_operator := Integer'Access("+");
--plus : binary_int_operator := Integer'"+";
--plus : binary_int_operator := "+";
function plus(lhs : Integer; rhs : Integer) return Integer is
begin
return lhs + rhs;
end plus;
begin
Put_Line(Integer'Image("+"(5, 12)));
end operator;
The commented declarations show some attempts I made, which do not compile.
I'm afraid you can't do that. The "+" subprogram for Integer is defined in the package Standard [ARM A.1 (17)] and therefore intrinsic [AARM A.1 (2.a)]. It's not allowed to reference an intrinsic subprogram [ARM 3.10.2 (32.3)]. Hence, compiling the program
procedure Main is
type Binary_Int_Operator is
access function (lhs : Integer; rhs : Integer) return Integer;
Plus : Binary_Int_Operator := Standard."+"'Access;
begin
null;
end Main;
yields
6:34 prefix of "Access" attribute cannot be intrinsic
The only workaround is using an indirection. This program compiles
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Main_Alt is
type Operation is
access function (Lhs, Rhs : Integer) return Integer;
-- Sticking to "+" and "-" instead of names like Add or Subtract
-- to demonstrate that you can reference operator subprograms
-- (using the Access attribute) as long as they're not intrinsic.
function "+" (Lhs, Rhs : Integer) return Integer is
(Standard."+" (Lhs, Rhs));
function "-" (Lhs, Rhs : Integer) return Integer is
(Standard."-" (Lhs, Rhs));
procedure Calc_And_Show (Lhs, Rhs : Integer; Op : Operation) is
begin
Put (Op (lhs, rhs));
New_Line;
end Calc_And_Show;
begin
Calc_And_Show (5, 3, "+"'Access);
Calc_And_Show (5, 3, "-"'Access);
end Main_Alt;
and yields (as expected)
$ ./main_alt
8
2
I would suggest considering a different approach using generics.
Generally, I think you end up with a simpler interface for the call then you
get trying to pass in access to subprogram parameters.
(i.e. no need to pass the operation for each call).
Using generics, you don't need to use 'Access at all, and you can pass intrinsic functions such as integer "+", as formal generic parameters.
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Main is
generic
with function Op (L, R : Integer) return Integer;
procedure Calc_And_Show (Lhs, Rhs : Integer);
procedure Calc_And_Show (Lhs, Rhs : Integer) is
begin
Put (Op (lhs, rhs));
New_Line;
end Calc_And_Show;
procedure Calc_And_Show_Plus is new Calc_And_Show (Op => "+");
procedure Calc_And_Show_Minus is new Calc_And_Show (Op => "-");
begin
Calc_And_Show_Plus (5, 3);
Calc_And_Show_Minus (5, 3);
end Main;
There might be reasons why you'd want to use access parameters instead, such as if you wanted Calc_And_Show to be callable from other languages such as C, or if you are in a nested level of code and all you have passed to your nested level is an access to subprogram value. But I think it's generally a good idea to otherwise use generics or at least consider that option as a first preference, unless you have good reason not to.
I have a reasonable amount of experience with Ada, but I have never used objects before. I found I had to use them to avoid the complications of not null access discriminate record types with task safe data structures. I need to make a function that takes in a base class and based on an if statement do dynamic dispatching, but I get an "incompatible types" error if the type I am testing is not in the class in the conditional. Is what I want to do impossible in Ada?
with Ada.Text_IO; use Ada.Text_IO;
procedure Dispatch is
type foo is tagged record
bar : boolean;
end record;
type foo2 is new foo with record
bar2 : boolean;
end record;
type foo3 is new foo with record
bar3 : boolean;
end record;
f3 : foo3;
procedure Do_Something(fubar : in out foo'class) is
begin
if fubar in foo2'class then
fubar.bar2 := True;
end if;
end Do_Something;
begin
Do_Something(f3);
end Dispatch;
Here, your code fails to compile with dispatch.adb:16:15: no selector “bar2" for type “foo'class" defined at line 3; nothing about incompatible types.
Anyway, the problem with the code as posted is that there is no component bar2 in foo; the only components visible in an object through a view of type foo’class are those in an object of type foo.
To get round this, you can change the view of fubar to foo2:
if fubar in foo2'class then
foo2 (fubar).bar2 := true;
end if;
However, this is not dispatching! To get a dispatching call you need
a primitive operation in the base type (none here)
a class-wide object or pointer (OK)
and you need a more complicated example, because you can only declare primitive operations in a package spec. Something like
package Dispatch is
type Foo is tagged record
Bar : Boolean;
end record;
procedure Update (F : in out Foo; B : Boolean) is null; -- primitive
type Foo2 is new Foo with record
Bar2 : Boolean;
end record;
overriding procedure Update (F : in out Foo2; B : Boolean);
type Foo3 is new Foo with record
Bar3 : Boolean;
end record; -- inherits default Update
end Dispatch;
package body Dispatch is
procedure Update (F : in out Foo2; B : Boolean) is
begin
F.Bar2 := B;
end Update;
end Dispatch;
procedure Dispatch.Main is
F3 : Foo3;
procedure Do_Something(Fubar : in out Foo'Class) is
begin
Fubar.Update (True); -- dispatches
end Do_Something;
begin
Do_Something(F3);
end Dispatch.Main;
I am having trouble getting dynamic dispatching to work, even with this simple example. I believe the problem is in how i have set up the types and methods, but cannot see where!
with Ada.Text_Io;
procedure Simple is
type Animal_T is abstract tagged null record;
type Cow_T is new Animal_T with record
Dairy : Boolean;
end record;
procedure Go_To_Vet (A : in out Cow_T) is
begin
Ada.Text_Io.Put_Line ("Cow");
end Go_To_Vet;
type Cat_T is new Animal_T with record
Fur : Boolean;
end record;
procedure Go_To_Vet (A : in out Cat_T)
is
begin
Ada.Text_Io.Put_Line ("Cat");
end Go_To_Vet;
A_Cat : Cat_T := (Animal_T with Fur => True);
A_Cow : Cow_T := (Animal_T with Dairy => False);
Aa : Animal_T'Class := A_Cat;
begin
Go_To_Vet (Aa); -- ERROR This doesn't dynamically dispatch!
end Simple;
Two things:
The first is that you have to have an abstract specification of Go_To_Vet, so that delegation can take place (this has caught me a couple times as well :-):
procedure Go_To_Vet (A : in out Animal_T) is abstract;
And the second is that Ada requires the parent definition be in its own package:
package Animal is
type Animal_T is abstract tagged null record;
procedure Go_To_Vet (A : in out Animal_T) is abstract;
end Animal;
The type definitions in your Simple procedure then need to be adjusted accordingly (here I just withed and used the Animal package to keep it simple):
with Ada.Text_Io;
with Animal; use Animal;
procedure Simple is
type Cow_T is new Animal_T with record
Dairy : Boolean;
end record;
procedure Go_To_Vet (A : in out Cow_T) is
begin
Ada.Text_Io.Put_Line ("Cow");
end Go_To_Vet;
type Cat_T is new Animal_T with record
Fur : Boolean;
end record;
procedure Go_To_Vet (A : in out Cat_T)
is
begin
Ada.Text_Io.Put_Line ("Cat");
end Go_To_Vet;
A_Cat : Cat_T := (Animal_T with Fur => True);
A_Cow : Cow_T := (Animal_T with Dairy => False);
Aa : Animal_T'Class := A_Cat;
begin
Go_To_Vet (Aa); -- ERROR This doesn't dynamically dispatch! DOES NOW!! :-)
end Simple;
Compiling:
[17] Marc say: gnatmake -gnat05 simple
gcc -c -gnat05 simple.adb
gcc -c -gnat05 animal.ads
gnatbind -x simple.ali
gnatlink simple.ali
And finally:
[18] Marc say: ./simple
Cat
how to assign A_Cow to Aa ? (Aa := A_Cow; complains!)
You can't and shouldn't. Although they share a common base class, they are two different types. By comparison to Java, an attempt to convert a cat to a cow would cause a ClassCastException at run time. Ada precludes the problem at compile time, much as a Java generic declaration does.
I've expanded #Marc C's example to show how you can invoke base class subprograms. Note the use of prefixed notation in procedure Simple.
Addendum: As you mention class wide programming, I should add a few points related to the example below. In particular, class wide operations, such as Get_Weight and Set_Weight, are not inherited, but the prefixed notation makes them available. Also, these subprograms are rather contrived, as the tagged record components are accessible directly, e.g. Tabby.Weight.
package Animal is
type Animal_T is abstract tagged record
Weight : Integer := 0;
end record;
procedure Go_To_Vet (A : in out Animal_T) is abstract;
function Get_Weight (A : in Animal_T'Class) return Natural;
procedure Set_Weight (A : in out Animal_T'Class; W : in Natural);
end Animal;
package body Animal is
function Get_Weight (A : in Animal_T'Class) return Natural is
begin
return A.Weight;
end Get_Weight;
procedure Set_Weight (A : in out Animal_T'Class; W : in Natural) is
begin
A.Weight := W;
end Set_Weight;
end Animal;
with Ada.Text_IO; use Ada.Text_IO;
with Animal; use Animal;
procedure Simple is
type Cat_T is new Animal_T with record
Fur : Boolean;
end record;
procedure Go_To_Vet (A : in out Cat_T)
is
begin
Ada.Text_Io.Put_Line ("Cat");
end Go_To_Vet;
type Cow_T is new Animal_T with record
Dairy : Boolean;
end record;
procedure Go_To_Vet (A : in out Cow_T) is
begin
Ada.Text_Io.Put_Line ("Cow");
end Go_To_Vet;
A_Cat : Cat_T := (Weight => 5, Fur => True);
A_Cow : Cow_T := (Weight => 200, Dairy => False);
Tabby : Animal_T'Class := A_Cat;
Bossy : Animal_T'Class := A_Cow;
begin
Go_To_Vet (Tabby);
Put_Line (Tabby.Get_Weight'Img);
Go_To_Vet (Bossy);
Put_Line (Bossy.Get_Weight'Img);
-- feed Bossy
Bossy.Set_Weight (210);
Put_Line (Bossy.Get_Weight'Img);
end Simple;