Ada Programming Language


My languages of choice are Common Lisp, C, and Haskell. However, I would now like to replace Haskell because the compile time is quite slow. So I’m trying Ada. I know that Ada has a very good type system and strong safety features. When I tried it, I really liked it.

I’m currently trying to port some code from other languages to Ada, and I also created a Forth interpreter in this language. You can check out my Forth interpreter on my Codeberg.

jovial sample program

Program Listing

with Ada.Text_Io;
with Ada.Numerics.Elementary_Functions;

procedure Main is
   function Is_Prime (N : Integer) return Boolean is
   begin
      if N <= 1 then
         return False;
      end if;
      for I in 2 .. N - 1 loop
         if N mod I = 0 then
            return False;
         end if;
      end loop;
      return True;
   end Is_Prime;

   procedure Spec (A, B : Integer) is
      use Ada.Text_Io;
      use Ada.Numerics.Elementary_Functions;

      subtype AB_Integer is Integer range A .. B;
      subtype Prime_Integer is Integer
        with Dynamic_Predicate => Is_Prime (Prime_Integer);
      subtype Odd_AB_Integer is AB_Integer
        with Dynamic_Predicate => Odd_AB_Integer mod 2 /= 0;

      procedure Computef (K : Odd_AB_Integer) is
         Kf     : constant Float := Float (K);
         Result : Float;
      begin
         if K in Prime_Integer then
            Result := Sqrt (3.0 * Kf + Sin (Kf));
            Put ("K:" & K'Image & " F(K)" & Float'Image (Result));
            Put_Line (" PRIME");
         else
            Result := Sqrt (4.0 * Kf + Cos (Kf));
            Put ("K:" & K'Image & " F(K)" & Float'Image (Result));
            Put_Line (" NONPRIME");
         end if;
      end Computef;

   begin
      for K in AB_Integer loop
         if K in Odd_AB_Integer then
            Computef (K);
         end if;
      end loop;
   end Spec;

begin
   Spec (3, 15);
end Main;

program output

$ gnatmake -gnata -gnatwa -gnatw.e -gnatva main
gcc -c main.adb
gnatbind -x main.ali
gnatlink main.ali
$ time ./main
K: 3 F(K) 3.02343E+00 PRIME
K: 5 F(K) 3.74714E+00 PRIME
K: 7 F(K) 4.65371E+00 PRIME
K: 9 F(K) 5.92359E+00 NONPRIME
K: 11 F(K) 5.65686E+00 PRIME
K: 13 F(K) 6.27855E+00 PRIME
K: 15 F(K) 7.69677E+00 NONPRIME

real    0m0.001s
user    0m0.000s
sys     0m0.001s

Distance Vectors

Program Listing

with Ada.Text_IO;
with Ada.Float_Text_IO;
with Ada.Numerics.Elementary_Functions;

procedure Dv is
   package TIO renames Ada.Text_IO;
   package FTIO renames Ada.Float_Text_IO;
   package NEF renames Ada.Numerics.Elementary_Functions;

   subtype Point is Float range 0.0 .. 100.0;
   type Vector is record
      X : Point;
      Y : Point;
   end record;

   function Scale (X, Min, Max : Float) return Float is
      ((X - Min) / (Max - Min));

   function Scale_Vector (V : Vector; Min, Max : Float) return Vector is
      Result : Vector;
   begin
      Result.X := Scale (V.X, Min, Max);
      Result.Y := Scale (V.Y, Min, Max);
      return Result;
   end Scale_Vector;

   function Distance_Vector (V1, V2 : Vector) return Float is
     X : Float := (V2.X - V1.X) ** 2;
     Y : Float := (V2.Y - V1.Y) ** 2;
   begin
      return NEF.Sqrt(X + Y);
   end Distance_Vector;

   procedure Print_Vector (V : Vector) is
   begin
      TIO.Put ("(x => ");
      FTIO.Put (Item => V.X, Fore => 1, Aft => 2, Exp => 0);
      TIO.Put (", Y => ");
      FTIO.Put (Item => V.Y, Fore => 1, Aft => 2, Exp => 0);
      TIO.Put_Line (")");
   end Print_Vector;

   B1        : Vector := (X => 45.0, Y => 20.0);
   B1_Scaled : Vector := Scale_Vector (B1, 0.0, 100.0);
   B2        : Vector := (X => 10.0, Y => 20.0);
   B2_Scaled : Vector := Scale_Vector (B2, 0.0, 100.0);
   Distance  : Float  := Distance_Vector (B1_Scaled, B2_Scaled);
begin
   TIO.Put ("V1=");
   Print_Vector (B1_Scaled);

   TIO.Put ("V2=");
   Print_Vector (B2_Scaled);
   
   TIO.Put ("Distance(V1, V2)=");
   FTIO.Put (Item => Distance, Fore => 1, Aft => 2, Exp => 0);
   TIO.New_Line;
end Dv;

program output

$ gnatmake -gnata -gnatwa -gnatw.e -gnatv dv
gcc -c dv.adb
gnatbind -x dv.ali
gnatlink dv.ali
$ time ./dv
V1=(x => 0.45, Y => 0.20)
V2=(x => 0.10, Y => 0.20)
Distance(V1, V2)=0.35

real    0m0.001s
user    0m0.000s
sys     0m0.001s

Operator Overload

Program Listing

with Ada.Text_IO;

procedure Main is
   type Vector2 is record
      X : Integer;
      Y : Integer;
   end record;

   function "+" (Lhs, Rhs : Vector2) return Vector2 is
      (X => Lhs.X + Rhs.X, Y => Lhs.Y + Rhs.Y);

   procedure Put_Vector2 (V : Vector2) is
      use Ada.Text_IO;
   begin
      Put_Line ("X:" & V.X'Image & " Y:" & V.Y'Image);
   end Put_Vector2;

   Ball_Sum : Vector2;
begin
   Ball_Sum := (X => 10, Y => 10) + (X => 10, Y => 10);
   Put_Vector2 (Ball_Sum);
end Main;

program output

$ gnatmake -gnata -gnatwa -gnatw.e -gnatv main
gcc -c main.adb
gnatbind -x main.ali
gnatlink main.ali
$ time ./main
X: 20 Y: 20

real    0m0.002s
user    0m0.001s
sys     0m0.001s