Gnat (ada95) comfused by error "... is not visible" using my package - ada

Using Gnat 7.4.0.
I'm an Ada noob, and confused by the error message:
$ gnat make list_test.adb
x86_64-linux-gnu-gcc-7 -c list_test.adb
list_test.adb:9:18: "List" is not visible (more references follow)
list_test.adb:9:18: non-visible declaration at linked_list.ads:19
x86_64-linux-gnu-gnatmake-7: "list_test.adb" compilation error
I don't understand why my List is not visible.
I'm trying to write a linked list with a generic payload to teach myself Ada. I wrote a binary tree with a similar layout (except the generic) which did not exhibit this error.
The .ads:
with Ada.Unchecked_Deallocation;
generic
type Payload_Type is private;
package Linked_List is
type List_Node;
type List_Node_Pointer is access all List_Node;
type List_Node is
record
payload : Payload_Type;
next : List_Node_Pointer := null;
prev : List_Node_Pointer := null;
end record;
type List is
record
head : List_Node_Pointer := null;
tail : List_Node_Pointer := null;
count : Natural := 0;
end record;
type List_Pointer is access all List;
procedure pushTail( base : in List;
payload : in Payload_Type );
procedure pushHead( base : in List;
payload : in Payload_Type );
function popTail( base : List ) return Payload_Type;
function contains( base : List;
payload : Payload_Type ) return Boolean;
private
procedure free is new Ada.Unchecked_Deallocation( List_Node, List_Node_Pointer );
end Linked_List;
And the .adb: (for the sake of completeness)
with Ada.Assertions;
package body Linked_List is
procedure pushTail( base : in out List;
payload : in Payload_Type ) is
begin
if ( base.head = null ) then
-- list is empy
base.head := new List_Node;
base.tail := base.head;
base.head.payload := payload;
else
-- list is not empty, add to the tail
base.tail.next := new List_Node;
base.tail.next.prev := base.tail;
base.tail := base.tail.next;
base.tail.payload := payload;
end if;
base.count := base.count + 1;
end push;
... -- More definitions for pushHead(), popTail(), contains()
private
end Linked_List;
The list_test.adb is something like:
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Linked_List;
procedure List_Test is
my_list : List;
found : Boolean;
begin
List.pushTail( my_list, Ada.Strings.Unbounded.To_Unbounded_String( "First" ) );
List.pushTail( my_list, Ada.Strings.Unbounded.To_Unbounded_String( "2nd" ) );
... etc.
Originally I had the syntax:
my_list : Linked_List.List;
But Gnat didn't like it - I don't understand why that wasn't accepted either.
EDIT: I've also tried
procedure List_Test is
package List_String is new List( Ada.Strings.Unbounded.Unbounded_String );
my_list : List_String;
But I get the same "List" is not visible error.
EDIT2:
with Linked_List;
procedure List_Test is
package String_List is new List( Ada.Strings.Unbounded.Unbounded_String ); use String_List;
my_list : String_List;
Still generates the error:
list_test.adb:10:32: "List" is not visible
list_test.adb:10:32: non-visible declaration at linked_list.ads:10
list_test.adb:10:89: "String_List" is undefined (more references follow)

As the Linked_List package is generic, you cannot reference the type Linked_List.List directly. You can only reference the List type in the instantiated package. Hence, try insert use List_String; directly after the instantiation of the generic package Linked_List, or use List_String.List to reference the List type in the List_String package:
procedure List_Test is
package List_String is
new Linked_List (Ada.Strings.Unbounded.Unbounded_String);
use List_String;
my_list : List
or
procedure List_Test is
package List_String is
new Linked_List (Ada.Strings.Unbounded.Unbounded_String);
my_list : List_String.List

Related

How to get around forbidden discriminants defaults for tagged records in Ada?

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.

Ada elaboration not occurring at all

I have an unusual situation in which elaboration code is simply not being executed at all. This is not an elaboration order issue, but rather an elaboration at all issue.
The problem is that I don't "with" the unit in question whatsoever, yet in theory it should still be accessible, as long as its elaboration occurs.
Of course I could just add a useless "with" for the unit in question, but in my real use case there are a large number of units that I would have to do that with.
My question is if there is any way either in the code, through pragmas, in the gpr project file, or through command-line switches that I could force the compiler to include a file even though it thinks the file isn't referenced?
Here is a minimal working example:
as.ads:
package As is
type A is tagged null record;
type Nothing is null record;
function Create (Ignored : not null access Nothing) return A;
function Image (From : A) return String;
end As;
as.adb:
package body As is
function Create (Ignored : not null access Nothing) return A is
(null record);
function Image (From : A) return String is ("A");
end As;
finder.ads:
with Ada.Tags;
package Finder is
procedure Register (Name : String; Tag : Ada.Tags.Tag);
function Find (Name : String; Default : Ada.Tags.Tag) return Ada.Tags.Tag;
end Finder;
finder.adb:
with Ada.Containers.Indefinite_Vectors;
package body Finder is
type Name_Tag (Size : Natural) is
record
Name : String (1 .. Size);
To : Ada.Tags.Tag;
end record;
package Name_Tag_Vectors is new Ada.Containers.Indefinite_Vectors (Positive, Name_Tag);
Name_Tags : Name_Tag_Vectors.Vector := Name_Tag_Vectors.Empty_Vector;
procedure Register (Name : String; Tag : Ada.Tags.Tag) is begin
Name_Tags.Append ((Name'Length, Name, Tag));
end Register;
function Find (Name : String; Default : Ada.Tags.Tag) return Ada.Tags.Tag is begin
for Tag of Name_Tags loop
if Tag.Name = Name then
return Tag.To;
end if;
end loop;
return Default;
end Find;
end Finder;
bs.ads:
with As;
package Bs is
type B is new As.A with null record;
function Create (Ignored : not null access As.Nothing) return B;
function Image (From : B) return String;
end Bs;
bs.adb:
with Finder;
package body Bs is
function Create (Ignored : not null access As.Nothing) return B is
(As.Create (Ignored) with null record);
function Image (From : B) return String is ("B");
begin
Finder.Register ("B", B'Tag);
end Bs;
test.adb:
with As; use As;
-- with Bs; -- (uncommenting this line solves my problem, but what if I had the rest of the alphabet?)
with Finder;
with Ada.Tags.Generic_Dispatching_Constructor;
with Ada.Text_IO;
procedure Test is
function Constructor is new Ada.Tags.Generic_Dispatching_Constructor (
T => A,
Parameters => Nothing,
Constructor => Create);
Nada : aliased Nothing := (null record);
What : A'Class := Constructor (Finder.Find ("B", A'Tag), Nada'Access);
begin
Ada.Text_IO.Put_Line (What.Image);
end Test;
The compiler thinks your package Bs isn't referenced because it isn't. You don't have a with clause for it, so it's not part of your program.
A simple example:
a.ads
package A is
procedure Blah;
end A;
a.adb
with Ada.Text_IO;
package body A is
procedure Blah is begin null; end Blah;
begin
Ada.Text_IO.Put_Line("Elaborate A");
end A;
b.ads
package B is
procedure Blah;
end B;
b.adb
with Ada.Text_IO;
package body B is
procedure Blah is begin null; end Blah;
begin
Ada.Text_IO.Put_Line("Elaborate B");
end B;
main.adb
with Ada.Text_IO;
with A;
procedure Main is
begin
Ada.Text_IO.Put_Line("Main");
end Main;
When I run main, it prints
Elaborate A
Main
It doesn't print Elaborate B because that package isn't part of the program; it's just a couple of source files in the same directory.
The obvious solution is to add the with clauses.
I don't know whether there's a less obvious solution. If there is, it's probably compiler-specific. But I'm not sure why a compiler would have a feature that lets you incorporate an otherwise unused package into a program.
What I’ve done (e.g. here ff) is to actually reference the units in the main program (with pragma Unreferenced to prevent warnings).
Alternatively, you could have a package e.g. Required_Units with all the necessary withs included, and then with that from the main program.
Even if there was some alternative process, you’d have to tell it what units you need to have included; might as well go with the flow and do it in Ada!
Since the package Bs is invisible to your program, so is the type B.
So the next question is: why do you need to register type B if it is not used anywhere?
If an Ada compiler did elaborate all units (packages or standalone subprograms) that are irrelevant to a main program, but are visible through source path, it would become really messy!...

Ada interface casting?

I am trying to model a set of Parsers in Ada based on interface below:
package Parsers is
type Parser is interface;
type DataArray is array(Integer range <>) of String(1..100);
function Parse(Object : access Parser; FilePath : String) return DataArray is abstract;
end Parsers;
The first Parser interface member is a text parser show below:
with Parsers;
package TextParsers is
type Parser is new Parsers.Parser with null record;
overriding function Parse(Object : access Parser; FilePath : String) return Parsers.DataArray;
end TextParsers;
with Parsers;
use Parsers;
package body TextParsers is
overriding function Parse(Object : access Parser; FilePath : String) return Parsers.DataArray is
Data : Parsers.DataArray (0..144);
begin
-- just stubbed out
return Data;
end Parse;
end TextParsers;
And finally, I would like to have a factory method create these Parsers based on the path provided, like detecting if it was a txt file or maybe a csv, etc. Here is the factory code:
with Parsers;
use Parsers;
package ParserFactories is
function GetParser(Path : String) return Parsers.Parser;
end ParserFactories;
with Parsers, TextParsers;
package body ParserFactories is
function GetParser(Path : String) return Parsers.Parser is
Text : TextParsers.Parser;
Parse : Parsers.Parser'Class := Text;
begin
return Parse;
end GetParser;
end ParserFactories;
I keep getting a "dynamically tagged expression not allowed" compilier error, and I cannot figure out how I can create these objects that implement the Parser interface and return it out of this function. Is there a way to do this in Ada?
You are trying to return a Parsers.Parser type. This is not allowed (and not what you intend to do). Change it to Parsers.Parser'Class instead.
The answer is that you don't return the interface's type, but the type that the object is... or else you can return the interface'class to indicate that you're going to assign it to that abstract-typed variable.
Procedure Testing is
package Interface_Test is
Type IBob is interface;
Function Make Return IBob is abstract;
Function Image( Object : In IBob ) Return String is abstract;
Generic
Type Data is (<>);
Default_Data : In Data;
Package Container is
Type Data_Container is NEW IBob with private;
private
Type Data_Container is new IBob with record
Info : Data:= Default_Data;
end record;
Overriding Function Make Return Data_Container;
Overriding Function Image(Object : In Data_Container) Return String;
end Container;
end Interface_Test;
package Body Interface_Test is
Package Body Container is
Function Make Return Data_Container is
begin
Return Result : Data_Container;
end Make;
Function Image( Object : Data_Container ) Return String is
begin
return Data'Image( Object.Info );
end image;
end Container;
end Interface_Test;
package J is new Interface_Test.Container( Integer, 1 );
use type J.Data_Container;
Test : J.Data_Container:= J.Make;
Use Ada.Text_IO;
Begin
put_line( Test.Image );
End;

Creating objects and calling their methods based on keywords in Ada

This is a followup to my question here.
I got to a point in the program where I felt like I couldn't proceed any further with the current structure, so I did a lot of rewriting. The Statement type is no longer abstract, and each subtype of Statement creates its own instance of Statement's variables. I also removed the abstract execute function from the Statements package because the compiler didn't like that (each subtype will still have its own execute method regardless). The execute function has been changed to a procedure because the incoming Statement type must be modified. I moved statementFactory (formerly createStatement) to the Statement package.
Here is the error I'm getting:
statements-compoundstatements.adb:15:29: expected type "CompoundStatement" defined at statements-compoundstatements.ads:11
statements-compoundstatements.adb:15:29: found type "Statement'Class" defined at statements.ads:6
I'm a beginner at Ada, but my hunch is that because the execute procedure is in CompoundStatements (which is a "subclass" of Statements) it would never be able to see the execute method of another "subclass" of Statements. The only solution I can think of would be to dump all the execute procedures that call an execute procedure into the Statement package, but that seems undesirable. But that still doesn't explain why stmt.all is being used as a type Statement'Class instead of the type created in statementFactory.
Here is the new code:
package Statements is
type Statement is tagged private;
type Statement_Access is access all Statement'Class;
ParserException : Exception;
procedure createStatement(tokens : Vector; S : out Statement);
procedure statementFactory(S: in out Statement; stmt: out Statement_Access);
--.....A bunch of other procedures and functions.....
private
type Statement is tagged
record
tokens : Vector;
executedtokens : Vector;
end record;
end Statements;
procedure createStatement(tokens : Vector; S : out Statement) is
begin
S.tokens := tokens;
end createStatement;
procedure statementFactory(S: in out Statement; stmt: out Statement_Access) is
currenttoken : Unbounded_String;
C : CompoundStatement;
A : AssignmentStatement;
P : PrintStatement;
begin
currenttoken := getCurrentToken(S);
if currenttoken = "begin" then
createStatement(S.tokens, C);
stmt := new CompoundStatement;
stmt.all := Statement'Class(C);
elsif isVariable(To_String(currenttoken)) then
createStatement(S.tokens, A);
stmt := new AssignmentStatement;
stmt.all := Statement'Class(A);
elsif currenttoken = "print" then
createStatement(S.tokens, P);
stmt := new PrintStatement;
stmt.all := Statement'Class(P);
end statementFactory;
package body Statements.CompoundStatements is
procedure execute(skip: in Boolean; C: in out CompoundStatement; reset: out Integer) is
stmt: Statement_Access;
tokensexecuted: Integer;
currenttoken : Unbounded_String;
begin
match(C, "begin");
currenttoken := getCurrentToken(C);
while(currenttoken /= "end") loop
statementFactory(C, stmt);
execute(skip, stmt.all, tokensexecuted); //ERROR OCCURS HERE
You say “I also removed the abstract execute function from the Statements package because the compiler didn't like that”; but you really need it, because otherwise how is the compiler to know that when you call execute (skip, stmt.all, tokensexecuted) that any stmt.all will provide an execute for it to dispatch to?
Not only does the extended type inherit the attributes of its parent type (so each CompoundStatement etc already has tokens and executedtokens), it inherits the primitive operations of the parent; if the parent operation is abstract, the child must provide its own implementation, if not, the child can provide its own (overriding) implementation.
See the Ada 95 Rationale and Wikibooks for good discussions on this.

Implementing an abstract function with access types in Ada

I have a package called Statements with an abstract type called Statement and an abstract function called execute(). In another package I have a type CompoundStatement which is a type Statement and it implements the execute() function.
I have a function called createStatement(). It's purpose is to evaluate a token of type Unbounded_String and determine what keyword it contains. Then based on this keyword it will generate an access type based on this keyword.
So far so good.
But what I can't figure out how to do is call the correct execute method. I only have one keyword coded in right now because it's not working yet.
Sorry if my description sounds convoluted.
package Statements is
type Statement is abstract tagged private;
type Statement_Access is access all Statement'Class;
function execute(skip: in Boolean; T: in TokenHandler; S: in Statement) return Integer is abstract;
private
type Statement is abstract tagged
record
tokens: Vector;
end record;
end Statements;
procedure createStatement(T : in TokenHandler; stmt: out Statement_Access) is
currenttoken : Unbounded_String;
C : CompoundStatement;
begin
currenttoken := To_Unbounded_String(TokenHandlers.getCurrentToken(T));
if currenttoken = "begin" then
createCompoundStatement(T, C);
stmt := new CompoundStatement;
stmt.all := Statement'Class(C);
end if;
end createStatement;
procedure createCompoundStatement(T : in TokenHandler; C: out CompoundStatement) is
begin
C.tokens := T.tokens;
end createCompoundStatement;
function execute(skip: in Boolean; T: in TokenHandler; C: in CompoundStatement) return Integer is
TK: TokenHandler := T;
stmt: Statement_Access;
tokensexecuted: Integer;
currenttoken : Unbounded_String;
begin
TokenHandlers.match("begin", TK);
currenttoken := To_Unbounded_String(TokenHandlers.getCurrentToken(TK));
while(currenttoken /= "end") loop
Put(To_String(currenttoken));
createStatement(T, stmt);
tokensexecuted := execute(skip, TK, stmt); //ERROR OCCURS HERE
TokenHandlers.moveAhead(tokensexecuted, TK);
currenttoken := To_Unbounded_String(TokenHandlers.getCurrentToken(TK));
end loop;
TokenHandlers.match("end", TK);
return TokenHandlers.resetTokens(TK);
end execute;
I get this error when I compile:
statements-statementhandlers.adb:35:28: no candidate interpretations match the actuals:
statements-statementhandlers.adb:35:46: expected type "CompoundStatement" defined at statements-statementhandlers.ads:14
statements-statementhandlers.adb:35:46: found type "Statement_Access" defined at statements.ads:6
statements-statementhandlers.adb:35:46: ==> in call to "execute" at statements-statementhandlers.ads:10
statements-statementhandlers.adb:35:46: ==> in call to "execute" at statements.ads:8
The third parameter to execute is expected to be a (child of) Statement, but what you’ve given it is a pointer to a (child of) Statement. You probably want
tokensexecuted := execute(skip, TK, stmt.all);
As a matter of style, by the way, it’s usually best to make the dispatching parameter the first; you could then (in Ada 2005) say
tokensexecuted := stmt.execute(skip, TK);

Resources