I created the following example code:
with Ada.Text_IO;
procedure Main is
type My_Type is
(A,
B,
C);
procedure Foo (The_Type : My_Type) is
begin
null;
end Foo;
procedure Bar (B : String) is
begin
-- Error
Foo (The_Type => B);
-- Ok
Foo (The_Type => My_Type'Succ (A));
-- Ok
Foo (The_Type => My_Type'Value ("B"));
end Bar;
begin
Bar ("Hello");
end Main;
The literal B defined in the enum type My_Type is also used as a parameter name in the procedure Bar. Unfortunately the compiler assumes that in the procedure call Foo (The_Type => B); the B is the name of the parameter and not the literal B in the defined enum type. I found two not optimal solutions to solve the problem. Are there any other solutions if I am not interested in renaming the literal or the parameter name?
Your problem is that the parameter B in procedure Bar hides the enumeration identifier B declared in the enclosing scope for procedure Bar. You need only name the scope with the parameter:
with Ada.Text_IO;
procedure Main is
type My_Type is
(A,
B,
C);
procedure Foo (The_Type : My_Type) is
begin
null;
end Foo;
procedure Bar (B : String) is
begin
Foo (The_Type => Main.B);
end Bar;
begin
Bar ("Hello");
end Main;
Related
I would like to have a record with an integer and a variable-length string in it, something like this:
type Entry is
record
Value: Integer;
Label: String;
end record;
I ran into the issue that you can't put an unconstrained String in a record type, so following the advice at that link I tried
type Entry(Label_Length : Natural) is
record
Value: Integer;
Label: String(1..Label_Length);
end record;
But now the problem is, I want an array of these things:
Entries : Array(1..2) of Entry := (
(Label_Length => 0, Value => 1, Label => ""),
(Label_Length => 0, Value => 2, Label => "")
);
and I'm getting told
main.adb:17:28: unconstrained element type in array declaration
I just want to be able to declare a (constant) array of these things and type in the labels and values in an intuitive way (I already wasn't crazy about having to count string lengths and type in Label_Length by hand). How can I do this?
If you have no idea of the maximum size of the label field you can use Ada.Strings.Unbounded.
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO.Unbounded_IO; use Ada.Text_IO.Unbounded_IO;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
procedure Main is
type Ent is record
Value : Integer;
Label : Unbounded_String;
end record;
type ent_array is array (1 .. 4) of Ent;
Foo : ent_array;
begin
for I of Foo loop
Put ("Enter a value: ");
Get (I.Value);
Skip_Line;
Put ("Enter a label: ");
I.Label := Get_Line;
New_Line;
end loop;
Put_Line ("Array Foo contents:");
for I of Foo loop
Put (I.Value'Image & " ");
Put_Line (I.Label);
end loop;
end Main;
[entry is a reserved word.]
If you want an array, all the entries have to be the same size. The size of your second record is Label_Length (4) + Value (4) + Label (Character (1) * Label_Length) i.e. anything between 8 and just over 2**31 bytes.
The trick is to fix the maximum size and give a default value:
subtype Ent_Label_Length is Natural range 0 .. 32;
type Ent (Label_Length : Ent_Label_Length := Ent_Label_Length'Last) is
record
Value : Integer;
Label : String (1 .. Label_Length);
end record;
You can save yourself the trouble of writing this (and working out the length of each string) by using Ada.Strings.Bounded (ARM A.4.4).
If you don't mind slightly different syntax, you can also consider using the Ada.Containers.Indefinite_Vectors package in place of arrays. Then each element can be a different size. And vectors can be used in for loops just like arrays can:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Indefinite_Vectors; use Ada.Containers;
procedure Main is
type Entry_Info(Label_Length : Natural) is
record
Value: Integer;
Label: String(1..Label_Length);
end record;
package Vectors is new Indefinite_Vectors
(Index_Type => Positive,
Element_Type => Entry_Info);
use type Vectors.Vector; -- so you can use the & operator
Entries : Vectors.Vector := Vectors.Empty_Vector
& (Label_Length => 0, Value => 1, Label => "")
& (Label_Length => 1, Value => 2, Label => "A");
begin
for Info of Entries loop
Put_Line(Info.Value'Image & " => " & Info.Label);
end loop;
end Main;
Yet another, but perhaps cruder, method is to put the strings on the heap and use access values:
type String_Ref is access String;
type Entry_T is record
Value: Integer;
Label: String_Ref;
end record;
To allocate the strings, use "new" with an initial value:
Entries : constant array(1..2) of Entry_T := (
(Value => 1, Label => new String'("First entry")),
(Value => 2, Label => new String'("Second entry"))
);
To get the value of a Label, deference with ".all":
for E of Entries loop
Ada.Text_IO.Put_Line (
"Value" & E.Value'Image
& ", label " & E.Label.all);
end loop;
If we're posting odd solutions, you can also use a holder:
package String_Holders is new Ada.Containers.Indefinite_Holders
(Element_Type => String);
type Entry_Is_Reserved is record
Value : Integer;
Label : String_Holders.Holder;
end record;
In this code, I have built a list of three integers (5, 10, 15) and what I need help with is that I need to ask the user which of these elements he/she wants to remove and then only return the element/elements that are left. I need to write a subprogram for this and just by using recursion, I need to remove the elements that the user does not need.
Main program:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Linked_List; use Linked_List;
procedure Main_Remove is
I : Integer;
L : List_Type;
begin
Build_Test_List(L); -- builds a list of 3 integers (5 => 10 => 15)
Put(L);
Put("Which elements do you want to remove/delete ");
Get(I);
Remove(L, I);
Put(L);
end Main_Remove;
Package:
package Linked_List is
type List_Type is private;
procedure Put(Item : in List_Type);
procedure Build_Test_List(Item : out List_Type;
Base : in Integer := 5);
private
type E_Type;
type List_Type is access E_Type;
type E_Type is
record
Data : Integer;
Next : List_Type;
end record;
end Linked_List;
Pakage body:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Unchecked_Deallocation;
package body Linked_List is
procedure Put(Item : in List_Type) is
P : List_Type := Item;
begin
Put("Listan: ");
while P /= null loop
if P /= Item then
Put(" -> ");
end if;
Put(P.Data, Width => 0);
P := P.Next;
end loop;
New_Line;
end Put;
procedure Insert_First(L : in out List_Type;
D : in Integer) is
begin
L := new E_Type'(Data => D, Next => L);
end Insert_First;
procedure Build_Test_List(Item : out List_Type;
Base : in Integer := 5) is
begin
for I in reverse 1..3 loop
Insert_First(Item, Base * I);
end loop;
end Build_Test_List;
end Linked_List;
Something like this will do, with reservations: specifically, there’s a memory leak.
procedure Remove (L : in out List_Type; Item : Integer) is
begin
The recursion has to be stopped when the list is empty.
if L = null then
return;
end if;
The list isn’t empty. What to do next depends on whether the current list element contains the value we’re looking for, or not.
if L.Data = Item then
This item needs to be removed from the list. Do this by altering the original pointer (which came from the list head, or the previous element) to skip over this element, and then process that element.
This is the point at which the memory leak has occurred. Obviously the cell being pointed to by the initial L needs to be freed, but you’re going to have to be careful about the order of operations.
L := L.Next;
Remove (L, Item);
else
The item stays in the list, go on to the next element.
Remove (L.Next, Item);
end if;
end Remove;
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;