Reading view

There are new articles available, click to refresh the page.

Ada: Convert float to decimal

This post is linked to this one Ada 2005 access type. The goal is to use Ada decimal type to get similar results as to hand (and calculator) computations in which 6 decimal places have been used in each intermediate step.

As can be seen from the table below, the values obtained with the Ada code starts to differ from the hand calculation in the last digit when further iterations with the Euler method are taken.

One of the issues with the Ada code was with the line in the main code diff.adb: return 2 * Real(XY)*; It doesn't matter if I leave it as return 2 * X * Y as well.

The differential equation (O.D.E.) is being solved using the basic Euler method (which is an approximate method which is not that accurate). The D.E. is dy/dx = 2xy. The initial condition is at y0(x=x0=1) = 1. The analytical solution is y = e^((x^2)-1). The objective is to obtain y(x=1.5).

We start with the point (x0,y0) = (1,1). We use a step size h = 0.1 i.e. x is increased with each iteration in the Euler method to 1.1, 1.2, 1.3,..etc. and the corresponding value of y (the variable whose solution is being sought) is determined from the Euler algorithm which is:

y(n) = y(n-1) + h * f(x(n-1), y(n-1))

Here y(n-1) when we start the algorithm is y(0) = 1. Also x(n-1) is our starting x(0) = 1. The function f is the derivative function dy/dx given above as dy/dx = 2xy.

Briefly, h * f(x(n-1), y(n-1)) is the "horizontal distance between two successive x values" multiplied by the gradient. The gradient formula is dy/dx = delta y /delta x which gives delta y or (the change in y) as

delta y = delta x * dy/dx.

In the Euler formula h is the delta x and dy/dx is the gradient. So h * f(x(n-1), y(n-1)) gives delta y which is the change in the value of y i.e. delta y. This change in y is then added to the previous value of y. The Euler method is basically a first order Taylor approximation with a small change in x. A gradient line is drawn to the curve and the next value of the solution variable y is on this tangent line at the successive value of x i.e. xnew = xold + h where h is the step.

The table next shows the solution values for the variable y by the Euler method when calculated by hand (and calculator), by my Ada code and finally in the last column the exact solution.

x y (hand) Ada code y (exact)
1.1 1.200000 1.200000 1.233678
1.2 1.464000 1.464000 1.552707
1.3 1.815360 1.815360 1.993716
1.4 2.287354 2.287353 2.611696
1.5 2.927813 2.927811 3.490343

By hand and calculator for instance, y(x=1.1) i.e y(1) at x = x(1) is calculated as y(x=1.1) = y(0) + h * f(x=1,y=1) = 1 + 0.1 * (2 * 1* 1) = 1.200000 to 6 d.p.

y(2) is calculated at x = x(2) as y(x=1.2) = y(1) + h * f(x=1.1,y=1.200000) = 1.200000 + 0.1 * (2 * 1.1* 1.200000) = 1.464000 to 6 d.p.

y(3) is calculated at x = x(3) as y(x=1.3) = y(2) + h * f(x=1.2,y=1.464000) = 1.464000 + 0.1 * (2 * 1.2* 1.464000) = 1.815360 to 6 d.p.

y(4) is calculated at x = x(4) as y(x=1.4) = y(3) + h * f(x=1.3,y=1.815360) = 1.815360 + 0.1 * (2 * 1.3* 1.815360) = 2.287354 to 6 d.p.

y(5) is calculated at x = x(5) as y(x=1.5) = y(4) + h * f(x=1.4,y=2.287354) = 2.287354 + 0.1 * (2 * 1.4* 2.287354) = 2.927813 to 6 d.p.

Now I want to modify the codes so that they work with a fixed number of decimal places which is 6 here after the decimal place.

The main code is diff.adb:

with Ada.Text_IO;
with Euler;
procedure Diff is

  type Real is delta 0.000001 digits 9;
  type Vector is array(Integer range <>) of Real;
  type Ptr is access function (X: Real; Y: Real) return Real;
   
  package Real_IO is new Ada.Text_IO.Decimal_IO(Num => Real); 
  use Real_IO; 

  procedure Solve is new Euler(Decimal_Type => Real, Vector_Type => Vector, Function_Ptr => Ptr);

  function Maths_Func(X: Real; Y: Real) return Real is
  begin
    return 2 * Real(X*Y);
  end Maths_Func;

  
  Answer: Vector(1..6);

begin
  Solve(F => Maths_Func'Access, Initial_Value => 1.0, Increment => 0.1, Result => Answer);
  for N in Answer'Range loop
    Put(1.0 + 0.1 * Real(N-1), Exp => 0);
    Put( Answer(N), Exp => 0);
    Ada.Text_IO.New_Line;
  end loop;
end Diff;

Then comes euler.ads:

generic
  type Decimal_Type is delta <> digits <>;
  type Vector_Type is array(Integer range <>) of Decimal_Type;
  type Function_Ptr is access function (X: Decimal_Type; Y: Decimal_Type) return Decimal_Type;
procedure Euler(
  F: in Function_Ptr; Initial_Value, Increment: in Decimal_Type; Result: out Vector_Type);

and the package body euler.adb

procedure Euler
  (F : in Function_Ptr; Initial_Value, Increment : in Decimal_Type; Result : out Vector_Type)
is
   Step : constant Decimal_Type := Increment;
   Current_X : Decimal_Type := 1.0;

begin
   Result (Result'First) := Initial_Value;
   for N in Result'First + 1 .. Result'Last loop
      Result (N) := Result (N - 1) + Step * F(Current_X, Result (N - 1));
      Current_X := Current_X + Step;
   end loop;
end Euler;

On compilation, I get the messages pointing to diff.adb:

type cannot be determined from context

explicit conversion to result type required

for the line return 2.0 times X times Y;

Perhaps the 2.0 is causing the trouble here. How to convert this Float number to Decimal?

I believe that further down in diff.adb, I will get the same issue with the line:

Solve(F => Maths_Func'Access, Initial_Value => 1.0, Increment => 0.1, Result => Answer);

for it contains Floating point numbers as well.

The compilation was done on Windows with the 32-bit GNAT community edition of year 2011. Why 2011? This is because I like the IDE better for that year rather than the pale ones which come in the recent years.

The revised codes based on trashgod codes which work are given next:

The main file diff.adb

with Ada.Numerics.Generic_Elementary_Functions; use Ada.Numerics;
with Ada.Text_IO;                               use Ada.Text_IO;
with Euler;

procedure Diff is

   type Real is digits 7;
   type Vector is array (Positive range <>) of Real;
   type Ptr is access function (X : Real; Y : Real) return Real;
   type Round_Ptr is access function (V : Real) return Real;

   procedure Solve is new Euler (Float_Type => Real, Vector => Vector, Function_Ptr => Ptr, Function_Round_Ptr => Round_Ptr);
   package Real_Functions is new Generic_Elementary_Functions (Real);
   use Real_Functions;
   package Real_IO is new Ada.Text_IO.Float_IO (Real);
   use Real_IO;

   function DFDX (X, Y : Real) return Real is (2.0 * X * Y);
   function F (X : Real) return Real is (Exp (X**2.0 - 1.0));
   function Round (V : in Real) return Real is (Real'Rounding (1.0E6 * V) / 1.0E6);

   XI      : constant Real := 1.0;
   YI      : constant Real := 1.0;
   Step    : constant Real := 0.1;
   Result  : Vector (Positive'First .. 6); --11 if step = 0.05
   X_Value : Real;

begin
   Solve (DFDX'Access, Round'Access, XI, YI, Step, Result);
   Put_line("        x      calc     exact     delta");
   for N in Result'Range loop
      X_Value := 1.0 + Step * Real (N - 1);
      Put (X_Value, Exp => 0);
      Put (" ");
      Put (Result (N), Exp => 0);
      Put (" ");
      Put (F (X_Value), Exp => 0);
      Put (" ");
      Put (Result (N) - F (X_Value), Exp => 0);
      Ada.Text_IO.New_Line;
   end loop;
end Diff;

The file euler.ads

generic
   type Float_Type is digits <>;
   type Vector is array (Positive range <>) of Float_Type;
   type Function_Ptr is access function (X, Y : Float_Type) return Float_Type;
   type Function_Round_Ptr is access function (V : Float_Type) return Float_Type;
procedure Euler
  (DFDX : in Function_Ptr; Round : Function_Round_Ptr; XI, YI, Step : in Float_Type; Result : out Vector);

The file euler.adb

procedure Euler
  (DFDX : in Function_Ptr; Round : Function_Round_Ptr; XI, YI, Step : in Float_Type; Result : out Vector)
is
   H : constant Float_Type := Step;
   X : Float_Type          := XI;
begin
   Result (Result'First) := YI;
   for N in Result'First + 1 .. Result'Last loop
       Result (N) :=  Round(Result (N - 1)) + Round(H * DFDX (X, Result (N - 1)));
       X          := X + Step;
   end loop;
end Euler;

giving the output with **step h = 0.1 **

x calc (Ada) exact delta
1.1 1.200000 1.233678 1.233678
1.2 1.464000 1.552707 -0.033678
1.3 1.815360 1.993716 -0.088707
1.4 2.287354 2.611696 -0.178356
1.5 2.927813 3.490343 -0.562530

The calc (Ada) results agree with hand (and calculator) computations.

New to GNAT Studio and Ada, looking for any big open source codebases I can study that demonstrate aggregate projects, mixed C/C++ and Ada linked together?

I'm an experienced C++ developer, Ada newbie, trying to port a mixed C and Ada legacy codebase to GNAT Studio. I want to compile the C and Ada sources to multiple static libraries and use them from a GtkAda executable. Actually it's a pretty complicated situation as I'll detail below.

Initially I was going to ask what is the GNAT Studio equivalent of a workspace or solution file, because I wasn't finding it. But just before posting that question, I stumbled upon the documentation section for "aggregate project" in .gpr file. Yahtzee. ("Aggregate" was the one synonym I hadn't thought to google for!)

But, I still want to see this in use before I'm comfortable using it from scratch. My learning style is I learn best from examples. First I mimic, then I understand. The syntax seems simple enough, but the documentation on aggregate projects doesn't (for instance) devote any words to common conventions like whether the .gpr file is usually mixed in with the sources or at a directory level above, etc.

And the same applies to linking and calling the C code from the Ada code (or even calling the Ada lib from the exe, for that matter). As a C++ programmer (and also C#) I'm familiar with the issues (e.g. name mangling and ABI/calling conventions) with cross-language marshaling. I still want to look at a big (real) Ada project that does it.

Finally, I read that the aggregate project feature in GNAT Studio supports the same source file being included - perhaps with different interpretations - in multiple different projects. That's good news because this legacy codebase uses that model heavily to actually build EPROM (firmware) images for multiple similar-but-different circuit boards. I actually want to run all of them within the one Gtk executable (it will be a simulator or emulator, depending how you term it), so I'll have multiple different Ada libs, that used to build independent .hex or .bin files, now being combined into one executable.

Actually it's even more complicated than that. There's two legacy codebases, the second for a still-old but newer generation of the equipment, and I'm hoping to put both of those together too. (You'd select which version of the equipment you want to simulate with a radio button.) The codebases for those have different versions of the same files. If I had to I can just make that two different GtkAda programs.

Because of both combining what were multiple different EPROM images into one executable, and the possibility of combining two similar-but-different sets of EPROM images, I'm wondering if and how namespace collisions are manageable in an aggregate project. I solved a similar problem combining C++ codebases associated with these two equipment generations into one application by segregating the codebases by DLL. Since a DLL only exports the names you tell it to, it doesn't matter if the same name is used for different things internally; they can still be linked into the same program.

submitted by /u/valdocs_user
[link] [comments]

Ada visitor design pattern and generics

I'm implementing a visitor pattern and I have some elements that I could implement using generics, but the GNAT compiler complains with the generic type. I have a solution using generic mix-ins but its less intuitive.

How can I solve it?

I provide the following minimal reproducibable example:

  1. visitors.ads
with ConcreteElements;
with Instantiation;

package Visitors is

  type Visitor_t is interface;

  procedure pVisit (this : in Visitor_t;
                    element : ConcreteElements.ConcreteElement_t) is abstract;

  procedure pVisit (this : in Visitor_t;
                    element : Instantiation.GenericElement_t) is abstract;

end Visitors;
  1. elements.ads
limited with Visitors;

package Elements is

  type Element_t is abstract tagged null record;

  procedure pAccept
    (this : in Element_t;
     visitor : in Visitors.Visitor_t'Class) is abstract;

end Elements;
  1. concreteelements.ads/adb
limited with Visitors;
with Elements;

package ConcreteElements is

  type ConcreteElement_t is new Elements.Element_t with null record;

  overriding
  procedure pAccept
    (this : in ConcreteElement_t;
     visitor : in Visitors.Visitor_t'Class);

end ConcreteElements;
with Visitors;

package body ConcreteElements is

  procedure pAccept
    (this : in ConcreteElement_t;
     visitor : in Visitors.Visitor_t'Class) is
  begin
    visitor.pVisit(this);
  end pAccept;

end ConcreteElements;
  1. genericelements.ads/adb
with Elements;
limited with Visitors;

generic
  type Parent_t (<>) is abstract new Elements.Element_t with private;
package GenericElements is

  type GenericElement_t is new Parent_t with null record;

  overriding
  procedure pAccept (this : in GenericElement_t;
                     visitor : in Visitors.Visitor_t'Class);

end GenericElements;
with Visitors;

package body GenericElements is

  procedure pAccept (this : in GenericElement_t;
                     visitor : in Visitors.Visitor_t'Class) is
  begin
    visitor.pVisit(this);
  end pAccept;

end GenericElements;
  1. instantiation.ads
with GenericElements;
with Elements;

package instantiation is new GenericElements
  (Parent_t => Elements.Element_t);

The compiler complains in the body of 4), at line 9:

expected type "instantiation.GenericELement_t" defined at genericelements.ads:8

found type "GenericElements.GenericElement_t" defined at genericelements.ads:8

My solution is to perform a mix-in, making GenericElement_t abstract, thus this would be 1), 4) and 5):

1)

with ConcreteElements;
with Instantiation;

package Visitors is

  type Visitor_t is interface;

  procedure pVisit (this : in Visitor_t;
                    element : ConcreteElements.ConcreteElement_t) is abstract;

  procedure pVisit (this : in Visitor_t;
                    element : Instantiation.Instantiation_t) is abstract;

end Visitors;
with Elements;

generic
  type Parent_t (<>) is abstract new Elements.Element_t with private;
package GenericElements is

  type GenericElement_t is abstract new Parent_t with null record;

end GenericElements;
private with GenericElements;
limited with Visitors;
with Elements;

package instantiation is 

  type Instantiation_t is new Elements.Element_t with private;

  overriding
  procedure pAccept (this : in Instantiation_t;
                     visitor : Visitors.Visitor_t'Class);

private

  package instantiation_pck is new GenericElements 
    (Parent_t => Elements.Element_t);

  type Instantiation_t is new instantiation_pck.GenericElement_t with null record;

end instantiation;
with Visitors;

package body instantiation is

  procedure pAccept (this : in Instantiation_t;
                     visitor : Visitors.Visitor_t'Class) is
  begin
    visitor.pVisit(this);
  end pAccept;


end instantiation;

Can I implement correctly the first option or I shall implement it using mix-ins?

Thank you in advance and sorry for the ammount of code.

Ada: fixed decimal place

I am doing some numerical calculations dealing with iterations and I would like to know how to force Ada work only to a certain number of decimal places say 6. If I write

type Real is digits 6;

my understanding tells me that this forces the precision to be 6 Significant figures. But I am more interested in the number of decimal places after the decimal point as in 238.345891 and 0.297568 in which both numbers contain 6 decimal places.

The point of working with a fixed number of decimal places is that with numerical computations, I normally do the checking by hand and a calculator and I keep all calculations to a fixed number of decimal places, here 6. I would like to get the same results which I get by hand calculations and those from the Ada program.

I agree that working with significant figures makes more sense since a number such as 4 x 10^-7 will amount to just zeros if I work with 6 d.p. but I want to know if Ada offers the possibility to work with a fixed number of decimal places.

Is there a way to disable arithmetic operators on a specific type in Ada?

I would like to define HTML response status code numbers as a type but disallow arithmetic operators because it wouldn't make sense for them.

type Status_Code is range 100 .. 599;

function "+" (Left, Right : Status_Code) return Status_Code is
begin
      pragma Assert (1 = -1);
      return Left + Right;
end;

The code snippet above on GNAT will give an error saying assertion will fail on runtime, but that is false when I add two of the numbers together. Is there a way to force a compiler error or at least a warning when arithmetic attempted on a type like this?

Alire - inability to install some packages from the repository

I am currently learning to program in Ada and I use Alire to set up my projects. As part of my testing, I occasionally install a crate and investigate it, I found a bug with Honki_tonks_zivilisationen:

https://alire.ada.dev/crates/honki_tonks_zivilisationen.html

Create exists, if I try to find it using the web interface I am successful:

https://alire.ada.dev/search/?q=Honki_tonks_zivilisationen

or

https://alire.ada.dev/search/?q=stefan

However, I don't see the game in the Linux command line:

$ alr search --crates Honki_tonks_zivilisationen

No hits

$ alr search --crates Honki

No hits

$ alr search --crates honki

No hits

$ alr search --crates stefan

No hits

Another crate, e.g. Eagle lander, is OK:

$ alr search --crates eagle

eagle_lander Apollo 11 lunar lander simulator

Using the command to display all available Alire packages I also don't see it.

alr search --list --full

I am using Arch Linux with Alire 1.2.2 version.

Can I ask to check if I am making a mistake somewhere? Alire is a great tool like Cargo and I would like to use it in my teaching and in the future for all projects.

submitted by /u/Krouzici_orel
[link] [comments]

Ada developer looking for a job as software developer

Hi everyone my name is Joseph . I write this post because i want to be involve in a carrier as Ada developer. I love working with Ada. It first start as hobby writing scripts and gui. Bc i was already involve with Arduino i start embedded project now i am capable to work with stm32 boards.

Recently i start an open source projet ( write ada drivers for common used arduino components ).

I also make an 3DOF robotic arm with Ada.

I am currently located in Senegal and there are no Company using Ada. I Feel useless over here. That's why i want a position in Canada, France or any place where i can work with very talents developers and improve my knowledge.

If you have informations that can help me it will help me out a lot bc i am bout to be a father and my family deserve a good life.

Thank you.

submitted by /u/Yossep237
[link] [comments]

Access type and procedures

I am writing with reference to my earlier post here:

Ada 2005 access type

In the first code diff.adb, there is the line:

procedure Solve is new Euler(Real, Vector, Ptr);

I don't understand how come the arguments of Euler area Real, Vector and Ptr because further down in the same code we have

Solve(Ident'Access, 1.0, 0.1, Answer);

with 4 arguments.

The original codes at the previous link are OK and are working.

matrix function not able to compile ada "declarations must come before "begin"

Hi so I'm very new to ada but it doesn't seem to like this code that I wrote, I keep having this error even though it looks fine.

Compile
   [Ada]          main.adb
main.adb:17:09: error: declarations must come before "begin"
gprbuild: *** compilation phase failed

here is the code:

with Ada.Text_IO;  use Ada.Text_IO;
with Ada.Numerics.Linear_Algebra;

procedure main is

  type Square_Matrix is array(Integer range <>, Integer range <>) of Float;
  
  function Determinant(matrix : in Square_Matrix) return Float is
    (Ada.Numerics.Linear_Algebra.Determinant(matrix));

  function Adjoint(matrix : in Square_Matrix) return Square_Matrix is
    result : Square_Matrix := matrix;
    dimension : Integer := matrix'Length;
  begin
    for i in 1 .. dimension loop
      for j in 1 .. dimension loop
        temp : Square_Matrix(dimension - 1, dimension - 1);
        for m in 1 .. dimension - 1 loop
          for n in 1 .. dimension - 1 loop
            if m < i and n < j then
              temp(m, n) := matrix(m, n);
            elsif m < i and n >= j then
              temp(m, n) := matrix(m, n + 1);
            elsif m >= i and n < j then
              temp(m, n) := matrix(m + 1, n);
            else
              temp(m, n) := matrix(m + 1, n + 1);
            end if;
          end loop;
        end loop;
        sign : Integer := (if (i + j) mod 2 = 0 then 1 else -1);
        result(j, i) := sign * Determinant(temp);
      end loop;
    end loop;
    return result;
  end Adjoint;

  matrix : Square_Matrix(1 .. 6, 1 .. 6) := ((2.0, -2.0, 4.0, -2.0, 0.0, 2.0),
                                             (1.0, 0.0, 4.0, -3.0, 0.0, 0.0),
                                             (1.0, 1.0, 1.0, 1.0, 1.0, 1.0),
                                             (1.0, 0.0, 0.0, -1.0, 0.0, 0.0),
                                             (3.0, 0.0, 0.0, -3.0, 0.0, 2.0),
                                             (1.0, 0.0, 0.0, -2.0, 0.0, 4.0));
  adjoint_matrix : Square_Matrix(1 .. 6, 1 .. 6);

begin
  adjoint_matrix := Adjoint(matrix);
  
  Put_Line("Original Matrix:");
  for i in matrix'Range(1) loop
    for j in matrix'Range(2) loop
      Put(Float'Image(matrix(i, j)), 4, 2);
    end loop;
    New_Line;
  end loop;
  
  Put_Line("Adjoint Matrix:");
  for i in adjoint_matrix'Range(1) loop
    for j in adjoint_matrix'Range(2) loop
      Put(Float'Image(adjoint_matrix(i, j)), 6, 2);
    end loop;
    New_Line;
  end loop;
  
end main;

Penultimate array index retrieval

Suppose the following generic procedure to print the elements of an array indexed by a discreet type (note the slight logic added to prevent the printing of an extra , past the end of the last element):

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;

procedure Array_Printer is
   
   generic
      type Index is (<>);
      type Int_Array is array (Index range <>) of Integer;
   procedure Print(IA: Int_Array); 
   
   procedure Print(IA: Int_Array) is
      -- Penultimate: Index := Index'Pred(IA'Last); -- raises CONSTRAINT_ERROR for IA'Length = 1
   begin
      Put("[");
      for I in IA'First .. Index'Pred(IA'Last) loop
         Put(IA(I), 0);Put(",");
      end loop;
      Put(IA(IA'Last), 0);
      Put("]");      
   end Print;
   
   type Int_Array is array(Positive range <>) of Integer;
   
   IA: Int_Array := (-3, -2, -1, 0, 1, 2, 3);
   IA2: Int_Array := (1 => 0);
   
   procedure Print_Int_Array is new Print(Index => Positive,
                                          Int_Array => Int_Array);
   
   begin
      Print_Int_Array(IA);   
end Array_Printer;

When this procedure runs with an array of length > 1 (e.g. IA) it correctly prints the array ([-3,-2,-1,0,1,2,3]). However, when it is given an array of length = 1 (e.g. IA2) then, perhaps surprisingly, the penultimate index calculation in the for-loop doesn't raise a CONSTRAINT_ERROR (due to a predecessor not existing) and the expected result ([0]) gets printed.

When that calculation is done elsewhere however (e.g. in the declarative section of the procedure) then that exception is raised, indeed.

Is the compiler smart enough to figure-out there's only one element in the array and hence generates a null range for the for loop?

Gnatstudio seems to be invoking gprbuild with -cargs -g -O0

Any thoughts? - Thanks

Libadalang

Has anyone here shareable experience with Libadalang for more than the examples that come with it?

What I'm looking for is to extract - for each subprogram in a spec - the name, the parameters (name & type), and the return type if any. I'm finding it really hard to understand the API reference.

At the moment I'm looking at the Ada API, having had grief with the Python version (to do with shared libraries on macOS) and with the Python API.

Seriously missing ASIS.

submitted by /u/simonjwright
[link] [comments]

Ada 2005 access type

I am trying to solve a differential equation with Euler's method using the technique employed with the access type shown in Ben Ari second editions of Ada for Software Engineers, Section 13.6.1 starting on Page 263.

I have modified the differential equation given in the book to dy/dx = 2xy with Initial Condition y(x=1) = 1. The increment is h = 0.1 and I have to find output the values of y(1), y(1.1), y(1.2), y(1.3), y(1.4) and y(1.5).

There are 3 Ada files: diff.adb which is the main file, euler.ads and euler.adb.

The file diff.adb is

with Ada.Text_IO;
with Euler;
procedure Diff is

  type Real is digits 6;
  type Vector is array(Integer range <>) of Real;
  type Ptr is access function (X: Real; Y: Real) return Real;

  procedure Solve is new Euler(Real, Vector, Ptr);

  function Ident(X: Real; Y: Real) return Real is
  begin
    return 2.0*X*Y;
  end Ident;

  package Real_IO is new Ada.Text_IO.Float_IO(Real);
  use Real_IO;

  Answer: Vector(1..10);

begin
  Solve(Ident'Access, 1.0, 0.1, Answer);
  for N in Answer'Range loop
    Put(1.0 + 0.1 * Real(N-1), Exp => 0);
    Put( Answer(N), Exp => 0);
    Ada.Text_IO.New_Line;
  end loop;
end Diff;


The file euler.ads is

--
-- Solving a differential equation.
-- Demonstrates generic floating point type.
--
generic
  type Float_Type is digits <>;
  type Vector is array(Integer range <>) of Float_Type;
  type Function_Ptr is access function (X: Float_Type; Y: Float_Type) return Float_Type;
procedure Euler(
  F: in Function_Ptr; Init, H: in Float_Type; Result: out Vector);

And the file euler.adb is

procedure Euler(
  F: in Function_Ptr; Init, H: in Float_Type; Result: out Vector) is
begin
  Result(Result'First) := Init;
  for N in Result'First+1..Result'Last loop
    Result(N) := Result(N-1) + H * F(Result(N-1));
  end loop;
end Euler;

When I compile diff.adb, I get the error message:

euler.adb: Builder results euler.adb:6:36 missing argument for parameter Y

As I don't understand access types well, I would be very grateful if I can get help making the above codes work.

PS: The results to be outputtted should be as follows when worked out by hand and a calculator:

x y
1 1
1.1 1.2
1.2 1.464
1.3 1.815360
1.4 2.287354
1.5 2.927813

The first column gives the x values (with an increment of 0.1) and the second column gives the ouput of the Euler method (y values).

After Simon's help:

I used Simon's code for euler.adb:

This was changed to Simon's code:

procedure Euler
  (F : in Function_Ptr; Init, H : in Float_Type; Result : out Vector)
is
      Step : constant Float_Type := H;
   
     Current_X : Float_Type := 1.0;
begin
   Result (Result'First) := Init;
   for N in Result'First + 1 .. Result'Last loop
      Current_X := Current_X + Step;
      Result (N) := Result (N - 1) + Step * F (Current_X, Result (N - 1));
   end loop;
end Euler;

The initial value of X is 1.0 and it is 1.0 as well for Y. In diff.adb, the output line Put(0.1 * Real(N-1), Exp => 0) has been changed to Put(1.0 + 0.1 * Real(N-1), Exp => 0) so as to get the sequence 1.0 to 1.5 (with also the line Answer: Vector(1..6) accordingly modified from 10 to 6).

When I run the corrected code I now get:

x y
1 1.00000
1.1 1.22000
1.2 1.51280
1.3 1.90613
1.4 2.43984
1.5 3.17180

The Y values from the above table are not OK as compared with the values from the table given up earlier. For instance by hand calculation, Y(1.1)= 1 + 0.1 * 2.0 * 1 * 1 = 1.2 where I am using the equation Y1 = Y0 + h*f(X0, Y0) with Y0 and X0 as the initial values of 1 both and h is the X increment of 0.1. Then Y(1.2) = 1.2 + 0.1 * 2 * 1.1 * 1.2 = 1.464000 where I used the equation Y2 = Y1 + h * f(X1, Y1) with X1 = X0 + h = 1 + 0.1 = 1.1 and Y1 has been calculated in the previous iteration as Y(X=1.1)=1.2. Then we can continue calculating for Y(X=1.3), Y(X=1.4) and Y(X=1.5) in a similar manner.

Porting old firmware written in Ada to modern program

I work on an MFC application (C++, Windows) that communicates over serial port to an embedded system. This piece of equipment has firmware written in a combination of assembly, C, and Ada code. Although it is an x86 processor (80196 to be exact, with about 32Kb memory), it's custom hardware and not PC based. Also the underlying OS is a unique RTOS developed by the equipment vendor, not based on any other OS or RTOS.

I'd like to run the actual firmware in a Windows program, either in an emulator or port the code to run as a Windows program so I can debug it and see where data goes as my MFC application communicates with it. Emulating the system so it runs the binary firmware is one possible avenue, but I'm writing this post to ask about the second - porting the source code so I can make a Windows program out of it.

I am experienced porting C to other operating systems, and the assembly language and RTOS functions I believe I could implement or stub out myself. (This would considerably easier than the original development of the RTOS, as I could use a higher level language and as much resources as I want.)

What I'm less strong on is the Ada code. I'm more of a C++ developer. So I'm not sure the best approach here. Is Ada more like Java (write once run anywhere) so that Ada code written in the late 80s through the 90s can also be compiled on a modern Ada compiler for different OS? Or is it like VB6 to VB.NET transition where the old style of the language is hopelessly out of date? Or kind of in-between like C where there's a lot of backward compatible support, but porting it I might have to fix places where it makes assumptions about the word size of the hardware, etc.?

What tools or compilers would you use if you were me? I'm evaluating a long-abandoned open source Ada to C++ translator (if I just transpired all the Ada code to C++ once and compiled that, it would meet my needs), but I don't know whether it was fully functioning or barely implemented before the project was abandoned.

I also thought about writing an Ada interpreter as then I could handle details of emulating virtual hardware within the interpreter. (Lest that sound crazily ambitious, or a non sequitur since Ada is typically compiled, allow me to point out writing a compiler or an interpreter that only needs to work for ONE given program is a significantly less general task than writing a full one. And C interpreters exist.)

As I write this, I'm realizing building a mixed Ada and C++ program is probably the less masochistic way to approach this (if only because finishing an abandoned translator or writing an interpreter are even more so). I think I was mostly scared of finding gcc not supporting this dialect or vintage of Ada (they used an old version of the DDCi compiler), or difficulty stubbing out the hardware support.

submitted by /u/valdocs_user
[link] [comments]

Logo on Wikipedia article

I looked at the Wikipedia article about Ada) and noticed that the community logo previously used in the article has been swapped with the one unilaterally proposed by AdaCore, which erroneously has the description "as defined by the Ada Community" in the article. Many people will read about the language from that article. I think it's a shame that the logo designed by Leah Goodreau in 2015 is no longer visible, especially considering that it was decided in a community competition and considering that not everyone agrees with the simplified logo trend.

I would make an edit on the article so that both logos are shown, along with subtexts such as "Community logo designed by Leah Goodreau" and "Logo designed by AdaCore" but my IP is banned, even though I have never edited anything on Wikipedia. If someone reading this agrees that both logos should be visible (and is not banned on Wikipedia), then please make this edit on the article. Thank you.

submitted by /u/SororitasEU
[link] [comments]

How to retrieve colors with GtkAda?

I use Glade with GtkAda.

-I can't retrieve the color data in the associate callback (window1_callbacks.adb).

-The Gtk.Color_Chooser.Get_RGBA procedure needs Gtk_Color_Chooser type. And Gtk_Color_Chooser function returns returns GObjet, so we need to convert data from GObject type to Gtk_Color_Chooser type.

And I don' see any function doing this. Thanks Mark

    -- Glade_8.adb
    
    -- units from Gtk
    with Gtk.Main;
    with Glib.Error;     use Glib.Error;
    with Gtk.Widget;     use Gtk.Widget;
    with Gtk.Builder;    use Gtk.Builder;
    with Gtkada.Builder; use Gtkada.Builder;
    
    -- Ada predefined units
    with Ada.Text_IO;    use Ada.Text_IO;
    with Ada.Exceptions;
    
    -- Application specific units
    with Window1_Callbacks; use Window1_Callbacks;
    
    procedure Glade_8 is
    
      Builder       : Gtkada_Builder;
      Error         : aliased Glib.Error.GError;
      FileName      : constant String := "glade_8";
      GladeFileName : constant String := FileName & ".glade";
      use type Glib.Guint;
         
      begin
        -- Appelé dans toutes les applications GtkAda.
        -- Arguments ligne de commande sont analysés & retournés à l'application.
        Gtk.Main.Init;
    
        -- Etape 1 : créer un Builder 
        --         & lui donner accès à la fenetre maitre du fichier XML.
        Gtk_New (Builder);
        if Add_From_File (Gtk_Builder(Builder), GladeFileName, Error'Access) = 0 then
          Put_Line ("Error : " & Get_Message (Error));
          Error_Free (Error);
          return;
        end if;
        Put_Line (FileName & " : loading of builder OK ");
       
        -- Etape 2 : créer les handlers ("poignées") des events
        --             (de façon à préparer les callback).
        Register_Handler (Builder, "on_color1_color_set",    On_Color1_Color_Set'Access);  --Ajout
        
        -- Etape 3 : Do_Connect connecte tous les handlers enregistrés en une fois.
        Do_Connect (Builder);
      --Put_Line ("Booleen du Switch : " & boolean'Image (On_Switch1_State_Set (Builder)));
    
        -- Etape 4 : Afficher la fenetre avec ses dépendances
        Show_All (Gtk_Widget (Get_Object (GTK_Builder (Builder), "window")));
    
        -- Etape 5 : Lancer la boucle infinie.
        Gtk.Main.Main;
    
        -- Etape 6 : appeler Unref quand l'application se termine
        --             pour libérer la memoire associée au Builder.
        Unref (Builder);
        Put_Line ("Program " & FileName & " is finished !");
    
      exception
        when Error : others =>
          Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (Error));
      end Glade_8;
    
    
    -- Glade_8
    
    with Gtkada.Builder; use Gtkada.Builder;
    
    package Window1_Callbacks is
          
      Procedure On_Color1_Color_Set (Builder : access Gtkada_Builder_Record'Class);  -- Ajout
    
    end Window1_Callbacks;
    
     
    
    -- Glade_8
    
    -- units from Gtk
    with Gtk.Label;          use Gtk.Label;
    with Gtk.Check_Button;   use Gtk.Check_Button;
    with Gtk.Toggle_Button;  use Gtk.Toggle_Button;
    with Gtk.Spin_Button;    use Gtk.Spin_Button;
    with Gtk.Switch;         use Gtk.Switch;
    with Gtk.Combo_Box;      use Gtk.Combo_Box;
    with Gtk.GEntry;         use Gtk.GEntry;
    
    with Gtk.Color_Button;            use Gtk.Color_Button;           --Ajout
    with Gtk.Color_Chooser;           use Gtk.Color_Chooser;          --Ajout
    with Gtk.Color_Chooser_Dialog;    use Gtk.Color_Chooser_Dialog;   --Ajout
    with Gtk.Color_Chooser_Widget;    use Gtk.Color_Chooser_Widget;   --Ajout
    with Gtk.Color_Selection;         use Gtk.Color_Selection;        --Ajout
    with Gtk.Color_Selection_Dialog;  use Gtk.Color_Selection_Dialog; --Ajout
    
    with Gdk.RGBA;                    use Gdk.RGBA;                   --Ajout
    
    with Glib;              use Glib;
    
    with Ada.Text_IO;       use Ada.Text_IO;
    
    
    package body Window1_Callbacks  is
        
      ---------------------------------
      -- On_Color1_Color_Set  -- AJOUT
      ---------------------------------
      procedure On_Color1_Color_Set (Builder : access Gtkada_Builder_Record'Class) is
        pragma Unreferenced (Builder);
        Color : Gdk_RGBA;
        begin
    --      void on_color1_color_set(GtkColorButton *c)   // To translate from C to Ada.
    --           {
    --           GdkRGBA color;
    --           gtk_color_chooser_get_rgba (GTK_COLOR_CHOOSER(c), &color); // Récupérer la couleur
    --           printf("red %f\n", color, red);
    --           printf("green %f\n", color, green);     
    --           printf("blue %f\n", color, blue);    
    --           printf("alpha %f\n", color, alpha);    
    --           }
    
    --  window1_callbacks.adb:189:35: error: "GObject_To_Gtk_Color_Chooser" is undefined
          Gtk.Color_Chooser.Get_RGBA (
                                      To_Gtk_Color_Chooser
                                                          (Gtk_Color_Chooser (Get_Object (Builder, "color1"))),
                                                                                                                Color);
      
    --      put_line ("Red : ",   Float'Image (Color.Red));
    --      put_line ("Green : ", Float'Image (Color.Green));     
    --      put_line ("Blue : ",  Float'Image (Color.Blue));    
    --      put_line ("Alpha : ", Float'Image (Color.Alpha));   
          
        end On_Color1_Color_Set;
    
    end Window1_Callbacks;


    <?xml version="1.0" encoding="UTF-8"?>
    <!-- Generated with glade 3.40.0 -->
    <interface>
      <requires lib="gtk+" version="3.24"/>
      <object class="GtkAdjustment" id="adjustment1">
        <property name="upper">100</property>
        <property name="step-increment">1</property>
        <property name="page-increment">10</property>
      </object>
      <object class="GtkListStore" id="liststore1">
        <columns>
          <!-- column-name Col_1 -->
          <column type="gchararray"/>
        </columns>
        <data>
          <row>
            <col id="0">Ligne-1</col>
          </row>
          <row>
            <col id="0">bbb</col>
          </row>
          <row>
            <col id="0">dddd</col>
          </row>
          <row>
            <col id="0">eeeeeeee</col>
          </row>
          <row>
            <col id="0">ligne-5</col>
          </row>
          <row>
            <col id="0">ligne-6</col>
          </row>
        </data>
      </object>
      <object class="GtkWindow" id="window">
        <property name="name">window</property>
        <property name="width-request">89</property>
        <property name="height-request">3</property>
        <property name="can-focus">False</property>
        <property name="hexpand">True</property>
        <property name="vexpand">True</property>
        <property name="border-width">0</property>
        <property name="window-position">center</property>
        <property name="gravity">center</property>
        <child>
          <object class="GtkFixed" id="fixed1">
            <property name="name">fixed1</property>
            <property name="visible">True</property>
            <property name="can-focus">False</property>
            <child>
              <object class="GtkButton" id="button1">
                <property name="name">button1</property>
                <property name="width-request">100</property>
                <property name="height-request">80</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="receives-default">True</property>
                <property name="tooltip-text" translatable="yes"> Click Me!</property>
                <property name="always-show-image">True</property>
                <signal name="clicked" handler="on_button1_clicked" swapped="no"/>
                <child>
                  <object class="GtkImage" id="harddisk">
                    <property name="visible">True</property>
                    <property name="can-focus">False</property>
                    <property name="stock">gtk-harddisk</property>
                    <property name="icon_size">6</property>
                  </object>
                </child>
              </object>
              <packing>
                <property name="x">36</property>
                <property name="y">40</property>
              </packing>
            </child>
            <child>
              <object class="GtkLabel" id="label1">
                <property name="width-request">200</property>
                <property name="height-request">40</property>
                <property name="visible">True</property>
                <property name="can-focus">False</property>
                <property name="tooltip-text" translatable="yes">I am a label hiding here.</property>
                <property name="label" translatable="yes">label</property>
                <attributes>
                  <attribute name="font-desc" value="Sans Bold Italic 15"/>
                  <attribute name="foreground" value="#efef29292929"/>
                </attributes>
              </object>
              <packing>
                <property name="x">150</property>
                <property name="y">170</property>
              </packing>
            </child>
            <child>
              <object class="GtkLabel" id="label2">
                <property name="width-request">200</property>
                <property name="height-request">40</property>
                <property name="visible">True</property>
                <property name="can-focus">False</property>
                <property name="xpad">0</property>
                <property name="ypad">17</property>
                <property name="label" translatable="yes">label2</property>
                <property name="xalign">0.5</property>
                <property name="yalign">0.5</property>
              </object>
              <packing>
                <property name="x">150</property>
                <property name="y">220</property>
              </packing>
            </child>
            <child>
              <object class="GtkRadioButton" id="radio1">
                <property name="label" translatable="yes">radio button 1</property>
                <property name="width-request">100</property>
                <property name="height-request">22</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="receives-default">False</property>
                <property name="halign">start</property>
                <property name="active">True</property>
                <property name="draw-indicator">True</property>
                <signal name="toggled" handler="on_radio1_toggled" swapped="no"/>
              </object>
              <packing>
                <property name="x">190</property>
                <property name="y">30</property>
              </packing>
            </child>
            <child>
              <object class="GtkRadioButton" id="radio2">
                <property name="label" translatable="yes">radio button 2</property>
                <property name="width-request">100</property>
                <property name="height-request">22</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="receives-default">False</property>
                <property name="active">True</property>
                <property name="draw-indicator">True</property>
                <property name="group">radio1</property>
                <signal name="toggled" handler="on_radio2_toggled" swapped="no"/>
              </object>
              <packing>
                <property name="x">190</property>
                <property name="y">60</property>
              </packing>
            </child>
            <child>
              <object class="GtkRadioButton" id="radio3">
                <property name="label" translatable="yes">radio button3</property>
                <property name="width-request">100</property>
                <property name="height-request">22</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="receives-default">False</property>
                <property name="active">True</property>
                <property name="draw-indicator">True</property>
                <property name="group">radio1</property>
                <signal name="toggled" handler="on_radio3_toggled" swapped="no"/>
              </object>
              <packing>
                <property name="x">190</property>
                <property name="y">90</property>
              </packing>
            </child>
            <child>
              <object class="GtkCheckButton" id="check1">
                <property name="label" translatable="yes">check button1</property>
                <property name="width-request">100</property>
                <property name="height-request">30</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="receives-default">False</property>
                <property name="draw-indicator">True</property>
                <signal name="toggled" handler="on_check1_toggled" swapped="no"/>
              </object>
              <packing>
                <property name="x">190</property>
                <property name="y">120</property>
              </packing>
            </child>
            <child>
              <object class="GtkToggleButton" id="toggle1">
                <property name="label" translatable="yes">toggle button</property>
                <property name="width-request">123</property>
                <property name="height-request">36</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="receives-default">True</property>
                <signal name="toggled" handler="on_toggle1_toggled" swapped="no"/>
              </object>
              <packing>
                <property name="x">25</property>
                <property name="y">174</property>
              </packing>
            </child>
            <child>
              <object class="GtkSpinButton" id="spin1">
                <property name="width-request">118</property>
                <property name="height-request">34</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="max-width-chars">2</property>
                <property name="adjustment">adjustment1</property>
                <property name="wrap">True</property>
                <signal name="value-changed" handler="on_spin1_value_changed" swapped="no"/>
              </object>
              <packing>
                <property name="x">25</property>
                <property name="y">218</property>
              </packing>
            </child>
            <child>
              <object class="GtkSwitch" id="switch1">
                <property name="use-action-appearance">True</property>
                <property name="name">switch</property>
                <property name="width-request">100</property>
                <property name="height-request">35</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="active">True</property>
                <signal name="state-set" handler="on_switch1_state_set" swapped="no"/>
              </object>
              <packing>
                <property name="x">27</property>
                <property name="y">284</property>
              </packing>
            </child>
            <child>
              <object class="GtkComboBox" id="combo1">
                <property name="width-request">176</property>
                <property name="visible">True</property>
                <property name="can-focus">False</property>
                <property name="model">liststore1</property>
                <property name="active">0</property>
                <property name="has-entry">True</property>
                <property name="entry-text-column">0</property>
                <property name="id-column">0</property>
                <property name="active-id">0</property>
                <signal name="changed" handler="on_combo1_changed" swapped="no"/>
                <child internal-child="entry">
                  <object class="GtkEntry" id="entry1">
                    <property name="can-focus">False</property>
                    <signal name="changed" handler="on_gentry1_changed" swapped="no"/>
                  </object>
                </child>
              </object>
              <packing>
                <property name="x">38</property>
                <property name="y">357</property>
              </packing>
            </child>
            <child>
              <object class="GtkColorButton" id="color1">
                <property name="width-request">100</property>
                <property name="height-request">33</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="receives-default">True</property>
                <signal name="color-set" handler="on_color1_color_set" swapped="no"/>
              </object>
              <packing>
                <property name="x">298</property>
                <property name="y">303</property>
              </packing>
            </child>
          </object>
        </child>

  </object>
</interface>

Recursion – Compound Interest (in Ada)

It might seem odd to think of a compound interest as a problem which could be solved by recursion, but it does make sense. The algorithm for calculating compound interest is of course very simple:

interest = current_balance × interest_rate
new_balance = current_balance + interest
current_balance = new_balance

Of course this calculation is done numerous times depending on how many times the interest is to be compounded. If we were to write a simple function in Ada it would look like this:

with text_io; use text_io;
with ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with ada.Float_Text_IO; use Ada.Float_Text_IO;

procedure compound is
   newBal, currBal, intRate, monRate : float;
   numMon : natural;

   function compound_interest(bal: float; intr: float; n: natural) return float is
      interest: float;
      newbal: float := bal;
   begin
      for i in 1..n loop
         interest := newbal * intr;
         newbal := newbal + interest;
      end loop;
      return newbal;
   end compound_interest;

begin
   put("Balance ($)? "); new_line;
   get(currBal); skip_line;
   put("Interest rate (e.g. 5.3)? "); new_line;
   get(intRate); skip_line;
   put("Number of months (1-12)? "); new_line;
   get(numMon); skip_line;

   monRate := intRate / 100.0 / 12.0;
   newBal := compound_interest(currBal,monrate,numMon);
   put("The new balance is $");
   put(newBal, 1, 2, 0);
end compound;

Here is the program running:

Balance ($)?
1000
Interest rate (e.g. 5.3)?
5
Number of months (1-12)?
12
The new balance is $1051.16

This nonrecursive procedure is fine, but we can also solve it recursively. If we say that the balance, b, after 0 months is the amount of the original deposit, d, and the interest rate is r, then we can write:

At month 0: b(0) = d
At month 1 : b(1) = b(0) + b(0) * r
At month 2 : b(2) = b(1) + b(1) * r
...

Then we can form a recursive definition of the form:

b(m) = b(m-1) + b(m-1) * r

Therefore we can use this to create a recursive function:

b(0) = d
b(m) = b(m-1) + b(m-1) * r

Here is a recursive version of the function compound_interest().

function compound_interestR(bal: float; intr: float; n: natural) return float is
   newbal: float;
begin
   if n = 0 then
      return bal;
   elsif n = 1 then      
      return bal + bal * intr;
   else
      newbal := compound_interestR(bal,intr,n-1);
      return newbal + newbal * intr;
   end if;
end compound_interestR;

❌