I am implementing a simple tool using ASIS(Ada Semantics interface Specifications).
I am having problem with listing child elements in a given Elements.for example i am having assignment statement as
C := A + B;
i am able to get the element(expression) which represents "A + B", from the above assignment statement but need to extract A, B elements individually from the above expression.
what is the query in ASIS for doing the same. i have tried "Traverse_element" but not able to succeed.
A + B is a function call, so you have to extract the actual parameters of the function call using:
declare
use ASIS.Expressions;
begin
for Parameter_Association of Function_Call_Parameters (Expression => Element,
Normalized => True) loop
declare
Formal : constant Asis.Element := Formal_Parameter (Parameter_Association);
Actual : constant Asis.Element := Actual_Parameter (Parameter_Association);
begin
...
end;
end loop;
end;
Related
I am writing program: sum of real numbers using recursive function.
What is wrong with it? It shows me just last entered numebr.
type
Indexy = 1..100;
TPoleReal = array [Indexy] of Real;
var
j: word;
r, realRes: real;
tpr: TPoleReal;
function SoucetCisel(n: TPoleReal; j: word): real;
begin
if j>0 then begin
SoucetCisel:=SoucetCisel + n[j];
j:=j-1;
end
end;
begin i:=0; j:=0;
while not seekeof do begin
read(r); Inc(j);
tpr[j]:=r;
writeln(j, ' ', tpr[j]);
end;
realRes:= SoucetCisel(tpr, j);
writeln(realRes);
end.
For debugging purposes I suggest you simplify the main part of your code to
begin
i:=0;
j:=0;
tpr[j] := 1;
Inc(j);
tpr[2] := 2;
realRes:= SoucetCisel(tpr, j);
writeln(realRes);
end.
That should make it make it much easier to appreciate what the problem is.
The first problem with your SoucetCisel function is that it isn't actually recursive.
A recursive function is one which calls itself with altered arguments, as in the
archetypical Factorial function
function Factorial(N : Integer)
begin
if N = 1 then
Factorial := 1
else
Factorial := N * Factorial(N - 1);
end;
The recursive call in this is the line
Factorial := Factorial(N - 1);
Your SoucetCisel doesn't do that, it simply adds the initial value of the function result
to the value of n[j], so it is not recursive at all.
The other problem is that, as written, it has no defined return value. In all the
Pascal implementations I've come across, the return value is undefined on entry to the
function and stays undefined until some value is explicitly assigned to it. The
function result is usually some space on the stack which the compiler-generated
code of the function reserves but which initially (on entry to the function) holds some random value, resulting from previous usage of the stack.
So, what the result of your SoucetCisel function is evaluated from is effectively
SoucetCisel := ARandomNumber + n[j]
which of course is just another random number. Obviously, you fix this aspect
of your function by ensuring that an explicit assignment to the function result is made
immediately on entry to the function. As a general rule, all execution paths through a function should lead through a statement which explicitly assigns a
value to the function result.
Then, you need to rewrite the remainder of it so that it actually is recursive
in the way your task requires.
While you're doing those two things, I would suggest that you use a more
helpful parameter name than the anonymous 'n'. 'n' is usually used to refer to an uninteresting integer.
update I'm not sure from your comment whether it was supposed to be serious. In case it was, consider these two functions
function SumOfReals(Reals : TPoleReal; j : word): real;
var
i : Integer;
begin
SumOfReals := 0;
for i := 1 to j do
SumOfReals := SumOfReals + Reals[i];
end;
function SumOfRealsRecursive(Reals : TPoleReal; j : word): real;
var
i : Integer;
begin
SumOfRealsRecursive := Reals[j];
if j > 1 then
SumOfRealsRecursive := SumOfRealsRecursive + SumOfRealsRecursive(Reals, j -1);
end;
These functions both do the same thing, namely evaluate the sum of the contents
of the Reals array up to and including the index j. The first one does so iteratively,
simply traversing the Reals array, which the second does it recursively. However,
it should be obvious that the recursive version is absolutely pointless in this case because
the iterative version does the same thing but far more efficiently, because
it does not involve copying the entire Reals array for each recursive call, which the recursive version does.
As I told you in a comment before. Try this code for your pascal program:
type
Indexy = 1..100;
TPoleReal = array [Indexy] of Real;
var
j: word;
r, realRes: real;
tpr: TPoleReal;
function SoucetCisel(n: TPoleReal; j: word): real;
begin
if j>0 then begin
SoucetCisel:=SoucetCisel(n, j-1) + n[j];
end
end;
begin i:=0; j:=0;
while not seekeof do begin
read(r); Inc(j);
tpr[j]:=r;
writeln(j, ' ', tpr[j]);
end;
realRes:= SoucetCisel(tpr, j);
writeln(realRes);
end.
Can I have a vector filled with both, type A and B? I will fill it only with one type, so I am always sure, what I will get out of it. But it would make many things very easy for me, if I can define the vector once.
type T is tagged null record;
type A is new T with
record
x : Integer;
end record;
type B is new T with
record
y : Integer;
end record;
package Some_Vector is new Ada.Containers.Indefinite_Vectors (
Index_Type => Positive,
Element_Type => T <- ???
);
You can say:
package Some_Vector is new Ada.Containers.Indefinite_Vectors (
Index_Type => Positive,
Element_Type => T'Class
);
Some_Vector is now able to hold elements of type T or any type derived from it, including A or B. There's no requirement that all the elements have to be of the same type, as long as they're all derived from T; so if you don't really care whether this property is enforced, the above should work. If you really want the compiler to enforce that all elements are the same type, then you should simply declare two packages, A_Vector and B_Vector, for vectors of the two types; but then there's no way to write a "class-wide" type name that could refer to either an A_Vector or a B_Vector.
If you really want to combine both--have a vector type that could refer either to a vector of A or a vector of B, but still enforce that all elements of the vector have the same type, then I think this could be done if you define your own vector type and perform the needed check at run time, but it could get complicated. This compiles, but I haven't tested it:
generic
type Elem is new T with private;
package Sub_Vectors is
type Sub_Vector is new Some_Vector.Vector with null record;
overriding
procedure Insert (Container : in out Sub_Vector;
Before : in Some_Vector.Extended_Index;
New_Item : in T'Class;
Count : in Ada.Containers.Count_Type := 1)
with Pre => New_Item in Elem;
end Sub_Vectors;
package body Sub_Vectors is
procedure Insert (Container : in out Sub_Vector;
Before : in Some_Vector.Extended_Index;
New_Item : in T'Class;
Count : in Ada.Containers.Count_Type := 1) is
begin
Some_Vector.Insert
(Some_Vector.Vector(Container), Before, New_Item, Count);
end Insert;
end Sub_Vectors;
Unfortunately, you'd have to override every Insert and Replace_Element operation that could put an element into the vector. After you do all this, though, you can instantiate Sub_Vectors with Elem => A and with Elem => B, and the class Some_Vector.Vector'Class would be a class-wide type that would include both Sub_Vector types in the instance packages.
If you really want the compiler to enforce that all elements are the
same type, then you should simply declare two packages, A_Vector and
B_Vector, for vectors of the two types; but then there's no way to
write a "class-wide" type name that could refer to either an A_Vector
or a B_Vector.
You can, however, have a vector that points only to the A or B subtrees of the hierarchy:
type T is tagged null record;
type A is new T with null record;
type B is new T with null record;
type C is new T with null record;
type TAB is access all T'Class
with Dynamic_Predicate =>
TAB = null or else
(TAB.all in A'Class or TAB.all in B'Class);
Above yields the TAB Type which must be a [pointer to] an A'Class or B'Class, which you should be able to use in your vector. -- The only problem I've run into is you have to use GNAT's 'Unchecked_Access to get the access values of objects (due, I think, to my quick and dirty testing).
I am attempting to understand how to fix this circular dependency. All the examples I can find online suggest using a limited with, but then they demonstrate the use with two basic types, whereas this is a bit more advanced. The circular dependency is between the two files below. I thought it was between package Chessboard ... and the Piece type, but now I am not so sure. Attempting to put the package Chessboard ... line within chess_types.ads after the Piece type is declared and removing the use and with of Chessboard results in an error: this primitive operation is declared too late for the Move procedure. I am stuck on how to get out of this dependency. Any help would be much appreciated!
Thank you
chessboard.ads:
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
with Chess_Types;
use Chess_Types;
package Chessboard is new Indefinite_Vectors(Board_Index, Piece'Class);
chess_types.ads:
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
with Chessboard;
use Chessboard;
package Chess_Types is
subtype Board_Index is Integer range 1 .. 64;
type Color is (Black, White);
type Piece is tagged
record
Name : String (1 .. 3) := " ";
Alive : Boolean := False;
Team : Color;
Coordinate : Integer;
end record;
procedure Move_Piece(Board: in Vector; P: in Piece; Move_To: in Integer);
end Chess_Types;
More Code for question in comments:
Chess_Types.Piece_Types.ads:
package Chess_Types.Piece_Types is
type Pawn is new Piece with
record
First_Move : Boolean := True;
end record;
overriding
procedure Move_Piece(Board: in CB_Vector'Class; Po: in Pawn; Move_To: in Board_Index);
-- Other piece types declared here
end Chess_Types.Piece_Types;
Chess_Types.Piece_Types.adb:
with Ada.Text_IO;
use Ada.Text_IO;
package body Chess_Types.Piece_Types is
procedure Move_Piece(Board: in CB_Vector'Class; Po: in Pawn; Move_To: in Board_Index) is
Index_From, Index_To : Board_Index;
Move_From : Board_Index := Po.Coordinate;
begin
-- Obtain locations of Pawn to move from (Index_From) and to (Index_To)
-- in terms of the single dimension vector
for I in Board.First_Index .. Board.Last_Index loop
if Board.Element(I).Coordinate = Move_From then
Index_From := I;
end if;
if Board.Element(I).Coordinate = Move_To then
Index_To := I;
end if;
end loop;
-- Determine if the requested move is legal, and if so, do the move.
-- More possibilties to be entered, very primitive for simple checking.
if Move_To - Move_From = 2 and then Po.First_Move = True then
Board.Swap(I => Index_From, J => Index_To); -- "actual for "Container" must be a variable"
Board.Element(Index_From).First_Move := False; -- "no selector for "First_Move" for type "Piece'Class"
elsif Move_To - Po.Coordinate = 1 then
Board.Swap(Index_From, Index_To); -- "actual for "Container" must be a variable"
end if;
-- Test to make sure we are in the right Move_Piece procedure
Put_Line("1");
end Move_Piece;
-- Other piece type move_piece procedures defined here
end Chess_types.Piece_Types;
As a note to understand further, the Coordinate component of each piece correspond to ICCF numeric notation, which is two digits, so there needs to be some type of conversion between the vector and the ICCF notation, hence the reason for the whole for loop at the start.
This is a tough one. It looks like limited with and generics don't play nice together. The only way to make it work is to go back to using your own access type:
with Ada.Containers.Vectors;
use Ada.Containers;
limited with Chess_Types;
use Chess_Types;
package Chessboard_Package is
subtype Board_Index is Integer range 1 .. 64;
type Piece_Acc is access all Piece'Class;
package Chessboard is new Vectors(Board_Index, Piece_Acc);
end Chessboard_Package;
I had to put the instantiation into a new package, and move the Board_Index there too. Also, I changed it to Vectors since Piece_Acc is a definite type and there's no point in using Indefinite_Vectors. But in any event, this defeats the purpose. I'm just not sure Ada gives you a way to do what you want with two packages like this.
Even doing it in one package is not easy:
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
package Chess_Types is
subtype Board_Index is Integer range 1 .. 64;
type Color is (Black, White);
type Piece is tagged record ... end record;
type CB_Vector is tagged;
procedure Move_Piece (Board : in CB_Vector'Class;
P : in Piece;
Move_To : in Board_Index);
package Chessboard is new Indefinite_Vectors(Board_Index, Piece'Class);
type CB_Vector is new Chessboard.Vector with null record;
end Chess_Types;
This compiles, but I had to add extra stuff to get around some of the language rules (in particular, when you instantiate a generic, that "freezes" all prior tagged types so that you can no longer declare a new primitive operation of the type); also, I had to make the Board parameter a classwide type to avoid running into the rule about primitive operations of multiple tagged types.
As I understand it, this will do what you want.
with Ada.Containers.Indefinite_Vectors;
use Ada.Containers;
package Chess_Types is
subtype Board_Index is Integer range 1 .. 64;
type Color is (Black, White);
type Piece is abstract tagged
record
Name : String (1 .. 3) := " ";
Alive : Boolean := False;
Team : Color;
Coordinate : Board_Index;
end record;
type Piece_Ptr is access all Piece'Class;
package Chessboard is new Indefinite_Vectors(Board_Index, Piece_Ptr);
procedure Move_Piece (Board : in Chessboard.Vector;
P : in Piece'Class;
Move_To : in Board_Index) is abstract;
end Chess_Types;
NOTES:
Piece is now abstract, as is the Move_Piece method. This will mean you now need to derive your other piece types (package piece_type-rook.ads, with a move_piece method for rook) etc...
Chessboard now contains pointers (Class wide pointers), beware allocating, deallocating, deep copy, shallow copy issues when using it.
You should now be able to call Move_Piece on any dereference of a piece_ptr and have it dispatch to the correct method.
The Move_To parameter is now the same type as the Board_Index. (Coordinate also brought in line) -- this seems a bit clunky, perhaps rethink this. (Row & Column Indices defining a 2D array perhaps? --No need for Indefinite_Vectors)
To answer the second question in the comment:
To use First_Move, the procedure has to know that it's a Pawn. If the object is declared with type Piece'Class, you can't access components that are defined only for one of the derived types. (That's true in most OO languages.) This may indicate a flaw in your design; if you have a procedure that takes a Piece'Class as a parameter, but you want to do something that makes sense only for a Pawn, then maybe you should add another operation to your Piece that does a default action for most pieces (perhaps it does nothing) and then override it for Pawn. Other possibilities are to use a type conversion:
procedure Something (P : Piece'Class) is ...
if Pawn(P).First_Move then ...
which will raise an exception if P isn't a Pawn. If you want to test first, you can say "if P in Pawn". I sometimes write code like:
if P in Pawn then
declare
P_Pawn : Pawn renames Pawn(P);
begin
if P_Pawn.First_Move then ...
end;
end if;
But defining a new polymorphic operation is preferable. (Note: I haven't tested the above code, hope I didn't make a syntax error somewhere.)
I'm an absolute beginner in Ada and I'm trying to calculate sin(x) [sin(3) now] by using Taylor-series, but I just can't get it to work.
So here is my procedure:
with Ada.Float_Text_IO;
with Mat;
procedure SinKoz is
X:Float:=3.0;
Szamlalo:Float:=0.0;
begin
for I in 1..100 loop
Szamlalo := Szamlalo + ((-1.0)**I)*(X**(2.0*I+1.0))/Mat.Faktorialis(2*I+1);
end loop;
Ada.Float_Text_IO.Put( Szamlalo );
end SinKoz;
And inside Mat, here is my Faktorialis, which calculates the factorial of 2*I+1:
function Faktorialis( N: Float ) return Float is
Fakt : Float := 1.0;
begin
for I in 1..N loop
Fakt := Fakt * I;
end loop;
return Fakt;
end Faktorialis;
When i'm trying to compile my code, this error comes up:
exponent must be of type Natural, found type "Standard.Float"
I hope you can help me trying to figure out what went wrong with my types!
The first question is : do you need to raise X to a non-integer power?
It looks to me as if you don't : in which case replace X**(2.0*I+1.0) with X**(2*I+1) and all will be well.
But if you really do (perhaps not here, but in another application) you just need to make such an operator visible : there's one for Float in the package Ada.Numerics.Elementary_Functions so precede your function with
with Ada.Numerics.Elementary_Functions;
use Ada.Numerics.Elementary_Functions;
and it should work as written.
Finally, if you have created your own float type, you can instantiate the generic package Ada.Numerics.Generic_Elementary_Functions with your type as its parameter, to create a set of these functions specifically for your type.
Gotta love Ada's strong typing.
Off the top of my head, I suspect your problem may be this line:
Szamlalo := Szamlalo + ((-1.0)**I)*(X**(2.0*I+1.0))/Mat.Faktorialis(2*I+1);
2.0*I+1.0 is going to return a Float. Not a Natural. You could try wrapping that in Integer() or Natural() (Natural is a subtype of Integer) and see if that helps.
I have a function that returns a string for a particular item, and I need to call that function numerous times and combine those strings into one. The combined string is bounded. I've made sure to fill it when space characters when it initializes but I keep getting "length check failed" errors. Is there something basic I'm doing wrong here?
FOR I IN 1..Collection.Size LOOP
Combined_String := combined_string & Tostring(Collection.Book(I));
END LOOP;
Unbounded_String is probably the easiest way to go:
with Ada.Strings.Unbounded;
use Ada.Strings.unbounded;
...
Temp_Unbounded_String : Unbounded_String; -- Is empty by default.
...
for I in 1 .. Collection.Size loop
Append(Temp_Unbounded_String, ToString(Collection.Book(I));
end loop;
If you then need to have the result placed in your fixed length standard string:
declare
Temp_String : constant String := To_String(Temp_Unbounded_String);
begin
-- Beware! If the length of the Temp_String is greater than that of the
-- fixed-length string, a Constraint_Error will be raised. Some verification
-- of source and target string lengths must be performed!
Combined_String(Temp_String'Range) := Temp_String;
end;
Alternatively, you can use the Ada.Strings.Fixed Move() procedure to bring the Unbounded_String into the target fixed-length string:
Ada.Strings.Fixed.Move(To_String(Temp_Unbounded_String), Combined_String);
In this case, if the source string is "too long", by default a Length_Error exception is raised. There are other parameters to Move() that can modify the behavior in that situation, see the provided link on Move for more detail.
In order to assign Combined_String, you must assign the full correct length at once. You can't "build up" a string and assign it that way in Ada.
Without seeing the rest of your code, I think Ada.Strings.Unbounded is probably what you should be using.
I know this is an ancient question, but now that Ada 2012 is out I thought I'd share an idiom I've been finding myself using...
declare
function Concatenate(i: Collection'index)
is
(tostring(Collection(i) &
if (i = Collection'last) then
("")
else
(Concatenate(i+1))
);
s: string := Concatenate(Collection'first);
begin
Put_Line(s);
end;
Typed off the top of my head, so it'll be full of typos; and if you want it to work on empty collections you'll need to tweak the logic (should be obvious).
Ada 2012's expression functions are awesome!
Ada works best when you can use perfectly-sized arrays and strings. This works wonderfully for 99% of string uses, but causes problems any time you need to progressively build a string from something else.
Given that, I'd really like to know why you need that combined string.
If you really need it like that, there are two good ways I know of to do it. The first is to use "unbounded" (dynamically-sized) strings from Ada.Strings.Unbounded, as Dave and Marc C suggested.
The other is to use a bit of functional programming (in this case, recursion) to create your fixed string. Eg:
function Combined_String (String_Collection : in String_Collection_Type) return String is
begin
if String_Collection'length = 1 then
return String_Collection(String_Collection'first);
end if;
return String_Collection(String_Collection'first) &
Combined_String (String_Collection'first + 1 .. String_Collection'last);
end Combined_String;
I don't know what type you used for Collection, so I'm making some guesses. In particular, I'm assuming its an unconstrained array of fixed strings. If it's not, you will need to replace some of the above code with whatever your container uses to return its bounds, access elements, and perform slicing.
From AdaPower.com:
function Next_Line(File : in Ada.Text_IO.File_Type :=
Ada.Text_Io.Standard_Input) return String is
Answer : String(1..256);
Last : Natural;
begin
Ada.Text_IO.Get_Line(File => File,
Item => Answer,
Last => Last);
if Last = Answer'Last then
return Answer & Next_Line(File);
else
return Answer(1..Last);
end if;
end Next_Line;
As you can see, this method builds a string (using Get_Line) of unlimited* length from the file it's reading from. So what you'll need to do, in order to keep what you have is something on the order of:
function Combined_String (String_Collection : in String_Collection_Type)
Return String is
begin
if String_Collection'length = 1 then
Return String_Collection(String_Collection'First).All;
end if;
Recursion:
Declare
Data : String:= String_Collection(String_Collection'First).All;
SubType Constraint is Positive Range
Positive'Succ(String_Collection'First)..String_Collection'Last;
Begin
Return Data & Combined_String( String_Collection(Constraint'Range) );
End Recursion;
end Combined_String;
Assuming that String_Collection is defined as:
Type String_Collection is Array (Positive Range <>) of Access String;
*Actually limited by Integer'Range, IIRC