-- $Id: ackermann.gnat,v 1.0 2003/06/11 12:01:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

with Ada.Command_Line, Text_IO, Ada.Strings.Fixed, Interfaces;

procedure Ackermann is
   function L_Trim (Source : String; Side : Ada.Strings.Trim_End :=
               Ada.Strings.Left) return String renames Ada.Strings.Fixed.Trim;

   subtype Nat is Interfaces.Integer_32 range 0 .. Interfaces.Integer_32'Last;
   subtype Pos is Nat range 1 .. Nat'Last;         --  Largest is 2_147_483_647
   use type Nat;

   function Ack (M, N : Nat) return Pos is
      pragma Suppress (Overflow_Check);
      pragma Suppress (Range_Check);
   begin
      if M = 0 then
         return N + 1;
      elsif N = 0 then
         return Ack (M - 1, 1);
      else
         return Ack (M - 1, Ack (M, N - 1));
      end if;
   end Ack;

   N        : Pos := 1;
begin
   if Ada.Command_Line.Argument_Count > 0 then
      N := Pos'Value (Ada.Command_Line.Argument (1));
   end if;
   Text_IO.Put_Line ("Ack(3," & L_Trim (Pos'Image (N)) & "):" &
            Pos'Image (Ack (3, N)));
end Ackermann;

-- $Id: ary3.gnat,v 1.0 2003/06/11 12:08:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

with Text_IO, Ada.Command_Line, Ada.Strings.Fixed;

procedure Ary3 is
   function L_Trim (Source : String; Side : Ada.Strings.Trim_End :=
               Ada.Strings.Left) return String renames Ada.Strings.Fixed.Trim;
   N        : Positive := 1;
begin
   begin
      N := Positive'Value (Ada.Command_Line.Argument (1));
   exception
      when Constraint_Error => null;
   end;
   declare
      type Vect is array (1 .. N) of Integer;
      X, Y     : Vect;
   begin
      for K in Vect'Range loop
         X (K) := K;
         Y (K) := 0;
      end loop;

      for Iter in 1 .. 1000 loop
         for K in reverse Vect'Range loop
            declare
               Y_K      : Integer renames Y (K);
            begin
               Y_K := Y_K + X (K);
            end;
         end loop;
      end loop;
      Text_IO.Put_Line (L_Trim (Integer'Image (Y (1))) &
               Integer'Image (Y (N)));
   end;
end Ary3;

-- $Id: wc.gnat,v 1.0 2003/06/11 12:11:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

-- Annotated Ada Reference Manual ISO/IEC 8652:1995: http://www.ada-auth.org/

with Interfaces.C, System, Ada.Strings.Fixed, Ada.Text_IO;

procedure Wc is
   package IC renames Interfaces.C;
   function L_Trim (Source : String; Side : Ada.Strings.Trim_End :=
               Ada.Strings.Left) return String renames Ada.Strings.Fixed.Trim;

   package Io is
      type File_Descriptor is new IC.int;       --  STDIN=0, STDOUT=1, STDERR=2
      type Setmode_Flag is new IC.int;
      STDIN       : constant File_Descriptor := 0;
      O_BINARY    : constant Setmode_Flag := 16#8000#;

      function C_Setmode (
               FD       : File_Descriptor;
               Mode     : Setmode_Flag)
            return IC.int;

      function C_Sysread (
               FD       : File_Descriptor;
               Buf      : System.Address;
               NByte    : IC.int)
            return IC.int;
   private
      pragma Import (C, C_Setmode, "_setmode");          --  Microsoft Windows
      pragma Import (C, C_Sysread, "_read");
   end Io;

   Buffer      : String (1 .. 4 * 1024);
   NL, NW, NC  : Natural := 0;
   Inside_Word : Boolean := False;
   C           : Character;
   Last, R     : Integer;
begin
   R := Integer (Io.C_Setmode (Io.STDIN, Io.O_BINARY));  --  Read CR,LF right
   loop
      Last := Integer (Io.C_Sysread (FD => Io.STDIN,
                  Buf => Buffer (1)'Address, NByte => Buffer'Length));
      exit when Last <= 0;
      NC := NC + Last;
      for K in Buffer'First .. Last loop
         C := Buffer (K);
         if C = ASCII.LF then
            NL := NL + 1;
         end if;
         if C = ' ' or C = ASCII.CR or C = ASCII.LF or C = ASCII.HT then
            Inside_Word := False;
         elsif not Inside_Word then
            Inside_Word := True;
            NW := NW + 1;
         end if;
      end loop;
   end loop;
   Ada.Text_IO.Put_Line (L_Trim (Natural'Image (NL)) & Natural'Image (NW) &
            Natural'Image (NC));
end Wc;
   --  The "Ada.Streams.Stream_IO.Read (File, Item, Last)" procedure can't
   --  read from STDIN: can't associate Standard Input with File parameter.
   --  GNAT's Interfaces.C_Streams.fread function isn't from ISO/IEC 8652:1995.

-- $Id: except.gnat,v 1.0 2003/06/11 12:06:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

with Text_IO, Ada.Strings.Fixed, Ada.Command_Line;

procedure Except is
   High_Exception : exception;
   Low_Exception  : exception;
   Low            : Integer := 0;
   High           : Integer := 0;

   procedure Blowup (K : Integer) is
      pragma Inline (Blowup);
   begin
      case 1 = (K mod 2) is
         when False => raise High_Exception;
         when True  => raise Low_Exception;
      end case;
   end Blowup;

   procedure Low_Function (K : Integer) is
      pragma Inline (Low_Function);
   begin
      Blowup (K);
   exception
      when Low_Exception => Low := Low + 1;
   end Low_Function;

   procedure High_Function (K : Integer) is
      pragma Inline (High_Function);
   begin
      Low_Function (K);
   exception
      when High_Exception => High := High + 1;
   end High_Function;

   procedure Some_Function (K : Integer) is
      pragma Inline (Some_Function);
   begin
      High_Function (K);
   exception
      when others => Text_IO.Put_Line ("We shouldn't get here");
   end Some_Function;

   function L_Trim (Source : String; Side : Ada.Strings.Trim_End :=
               Ada.Strings.Left) return String renames Ada.Strings.Fixed.Trim;
   N        : Natural := 0;
begin
   begin
      N := Natural'Value (Ada.Command_Line.Argument (1));
   exception
      when Constraint_Error => null;
   end;
   for K in reverse 0 .. N - 1 loop
      Some_Function (K);
   end loop;
   Text_IO.Put_Line ("Exceptions: HI=" & L_Trim (Natural'Image (High)) &
            " / LO=" & L_Trim (Natural'Image (Low)));
end Except;

-- $Id: fibo.gnat,v 1.0 2003/06/11 12:02:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

with Ada.Command_Line, Ada.Text_IO, Ada.Integer_Text_IO;

procedure Fibo is
   function Fib (N : Natural) return Integer is
      L        : Integer := N - 1;
      pragma Suppress (Range_Check, On => L);
   begin
      if L <= 0 then
         return 1;
      else
         return Fib (N - 2) + Fib (L);
      end if;
   end Fib;
   N        : Natural := 0;
begin
   begin
      N := Natural'Value (Ada.Command_Line.Argument (1));
   exception
      when Constraint_Error => null;
   end;
   Ada.Integer_Text_IO.Put (Item => Fib (N), Width => 0);
   Ada.Text_IO.New_Line;
end Fibo;

-- $Id: heapsort.gnat,v 1.0 2003/06/11 12:10:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

-- Annotated Ada Reference Manual ISO/IEC 8652:1995: http://www.ada-auth.org/

with System, Ada.Command_Line, Text_IO;

procedure Heapsort is
   type Real is digits Positive'Max (15, System.Max_Digits);
   package Rio is new Text_IO.Float_IO (Num => Real);

   package Random_Real is
      function Gen_Random (Supr : Real) return Real;
      pragma Inline (Gen_Random);
   end Random_Real;

   package body Random_Real is
      IM          : constant Positive := 139968;
      IA          : constant Integer := 3877;
      IC          : constant Integer := 29573;
      Last        : Integer := 42;

      function Gen_Random (Supr : Real) return Real is
         pragma Suppress (Overflow_Check);
         pragma Suppress (Range_Check);
      begin
         Last := (Last * IA + IC) mod IM;
         return Supr * Real (Last) / Real (IM);
      end Gen_Random;
   end Random_Real;

   type Range_Int is new Integer;
   subtype Offset_Int is Range_Int;

   type Real_Array is array (Range_Int range <>) of Real;
   type Real_Array_Ptr is access Real_Array;

   procedure Heapsort (A : in out Real_Array) is
      pragma Suppress (Overflow_Check);
      pragma Suppress (Index_Check);
      pragma Suppress (Range_Check);
      subtype Range_Positive is Range_Int;
      First          : constant Range_Int := A'First;    --  might be <= -1
      IR             : Range_Positive;
      One            : constant Offset_Int := 1;
      Minus_One      : constant Offset_Int := -1;
      First_Minus_1  : constant Range_Int := First + Minus_One;
      First_Plus_1   : constant Range_Int := First + One;
      RRA            : Real;
      L              : Offset_Int := One + (A'Length / 2);
   begin
      if A'Length <= 0 then
         return;
      end if;
      IR := A'Last;
      loop
         if L > One then
            L := L - One;
            RRA := A (First_Minus_1 + L);
         else
            RRA := A (IR);
            A (IR) := A (First);
            if IR <= First_Plus_1 then
               A (First) := RRA;
               exit;
            else
               IR := IR + Minus_One;
            end if;
         end if;
         declare
            K1    : Range_Positive := First_Minus_1 + L;
            K2    : Range_Positive := K1 + L;
         begin
            while K2 <= IR loop
               if K2 < IR then
                  if A (K2) < A (K2 + One) then
                     K2 := K2 + One;
                  end if;
               end if;
               if RRA < A (K2) then
                  A (K1) := A (K2);
                  K1 := K2;
                  K2 := K1 + (K1 - First_Minus_1);
               else
                  K2 := IR + One;
               end if;
            end loop;
            A (K1) := RRA;
         end;
      end loop;
   end Heapsort;

   N           : Range_Int;
   No_Verify   : constant Boolean := True;
   Chk         : Real := 0.0;
   X           : Real_Array_Ptr;
begin
   begin
      N := Range_Int'Max (1, Range_Int'Value (Ada.Command_Line.Argument (1)));
   exception
      when Constraint_Error => N := 1;
   end;
   X := new Real_Array (0 .. N - 1);   --  3% slower than 'declare' (stack)
   for Iter in X'Range loop
      X (Iter) := Random_Real.Gen_Random (Supr => 1.0);
   end loop;
   if No_Verify then
      Heapsort (A => X.all);
      Rio.Put (X (X'Last), Fore => 0, Aft => 10, Exp => 0);
      Text_IO.New_Line;
   else
      for Iter in X'Range loop Chk := Chk + X (Iter); end loop;
      Heapsort (A => X.all);
      for K in X'Range loop
         pragma Assert (K + 1 = X'Last or else X (K) <= X (K + 1));
         Chk := Chk - X (K);
      end loop;
      pragma Assert (abs Chk < 50.0 * Real (N) * Real'Model_Epsilon);
   end if;
end Heapsort;

-- $Id: hello.gnat,v 1.0 2003/06/11 12:04:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

with Ada.Text_IO;
procedure Hello is
begin
   Ada.Text_IO.Put_Line ("hello world");
end Hello;

-- $Id: matrix.gnat,v 1.0 2003/06/11 12:09:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

with Text_IO, Ada.Strings.Fixed, Ada.Command_Line;

procedure Matrix is
   function L_Trim (Source : String; Side : Ada.Strings.Trim_End :=
               Ada.Strings.Left) return String renames Ada.Strings.Fixed.Trim;

   type Int is new Integer;
   type Int_Matrix is array (Positive range <>, Positive range <>) of Int;

   function Mk_Matrix (NRows, NCols : Natural) return Int_Matrix is
      Count    : Int := 1;
      M        : Int_Matrix (1 .. NRows, 1 .. NCols);
   begin
      for I in M'Range (1) loop
         for J in M'Range (2) loop
            M (I, J) := Count;
            Count := Count + 1;
         end loop;
      end loop;
      return M;
   end Mk_Matrix;

   procedure M_Mult (M1, M2 : Int_Matrix; MM : in out Int_Matrix) is
      pragma Inline (M_Mult);
      pragma Suppress (Index_Check);
      Sum      : Int;
   begin
      if not (M1'First (2) = M2'First (1) and M1'Last (2) = M2'Last (1) and
               M1'First (1) = MM'First (1) and M1'Last (1) = MM'Last (1) and
               M2'First (2) = MM'First (2) and M2'Last (2) = MM'Last (2)) then
         raise Constraint_Error;
      end if;
      for I in M1'Range (1) loop
         for J in M2'Range (2) loop
            Sum := 0;
            for KK in M1'Range (2) loop
               Sum := Sum + M1 (I, KK) * M2 (KK, J);
            end loop;
            MM (I, J) := Sum;
         end loop;
      end loop;
   end M_Mult;

   Size     : constant Natural := 30;
   M1, M2, MM : Int_Matrix (1 .. Size, 1 .. Size);
   N        : Positive := 1;
begin
   begin
      N := Positive'Value (Ada.Command_Line.Argument (1));
   exception
      when Constraint_Error => null;
   end;
   M1 := Mk_Matrix (Size, Size);
   M2 := Mk_Matrix (Size, Size);
   for Iter in 1 .. N loop
      M_Mult (M1, M2, MM);
   end loop;
   Text_IO.Put_Line (L_Trim (Int'Image (MM (1, 1))) & Int'Image (MM (3, 4)) &
            Int'Image (MM (4, 3)) & Int'Image (MM (5, 5)));
end Matrix;

-- $Id: methcall.gnat,v 1.0 2003/06/11 12:10:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

with Text_IO, Ada.Command_Line, Ada.Characters.Handling;

procedure MethCall is
   package Toggles is
      type A_Rec is                          --  'tagged' implies hidden field,
         tagged record                       --   and can append new fields
            Value       : Boolean := True;
         end record;

      procedure Activate (A : in out A_Rec);

      type B_Rec is new A_Rec with                 --  Add more fields to A_Rec
         record
            Flip_Period : Positive := 1;
            Count       : Natural := 0;
         end record;

      procedure Activate (B : in out B_Rec);
      pragma Inline (Activate);
   end Toggles;

   package body Toggles is
      procedure Activate (A : in out A_Rec) is
      begin
         A.Value := not A.Value;
      end Activate;

      procedure Activate (B : in out B_Rec) is
      begin
         B.Count := B.Count + 1;
         if B.Count = B.Flip_Period then
            B.Count := 0;
            B.Value := not B.Value;
         end if;
      end Activate;
   end Toggles;

   X        : Toggles.A_Rec := (Value => True);
   Y        : Toggles.B_Rec := (Value => True, Count => 0, Flip_Period => 3);
   Val      : Boolean;
   N        : Positive := 1;
begin
   begin
      N := Positive'Value (Ada.Command_Line.Argument (1));
   exception
      when Constraint_Error => null;
   end;
   for Iter in 1 .. N loop
      Toggles.Activate (X);
      Val := X.Value;
   end loop;
   Text_IO.Put_Line (Ada.Characters.Handling.To_Lower (Boolean'Image (Val)));
   for Iter in 1 .. N loop
      Toggles.Activate (Y);
      Val := Y.Value;
   end loop;
   Text_IO.Put_Line (Ada.Characters.Handling.To_Lower (Boolean'Image (Val)));
end MethCall;

-- $Id: nestedloop.gnat,v 1.0 2003/06/11 12:04:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Command_Line;

procedure NestedLoop is
   Count, M : Natural := 0;
   N        : Positive := 1;
begin
   begin
      N := Positive'Value (Ada.Command_Line.Argument (1));
   exception
      when Constraint_Error => null;
   end;
   M := N - 1;
   for A in 0 .. M loop
      for B in 0 .. M loop
         for C in 0 .. M loop
            for D in 0 .. M loop
               for E in 0 .. M loop
                  for F in 0 .. M loop
                     Count := Count + 1;
                  end loop;
               end loop;
            end loop;
         end loop;
      end loop;
   end loop;
   Ada.Integer_Text_IO.Put (Item => Count, Width => 0);
   Ada.Text_IO.New_Line;
end NestedLoop;

-- $Id: objinst.gnat,v 1.0 2003/06/11 12:07:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

-- Annotated Ada Reference Manual ISO/IEC 8652:1995: http://www.ada-auth.org/

with Ada.Command_Line, Ada.Characters.Handling, Text_IO, Ada.Tags;

procedure ObjInst is    --  3.451
   pragma Suppress (Discriminant_Check);
   pragma Suppress (Access_Check);
   package CH renames Ada.Characters.Handling;
   use type Ada.Tags.Tag;

   package Toggles is
      type A_Rec is
         tagged record                 --  'tagged' allows fields to be added
            Value       : Boolean := True;
         end record;

      type B_Rec is new A_Rec with
         record
            Flip_Period : Positive := 1;
            Count       : Natural := 0;
         end record;

      type A_Recs_Family_Ptr is access all A_Rec'Class;

      function Activate (X : A_Recs_Family_Ptr) return A_Recs_Family_Ptr;
      pragma Inline (Activate);
   end Toggles;

   package body Toggles is
      function Activate (X : A_Recs_Family_Ptr) return A_Recs_Family_Ptr is
         pragma Suppress (Range_Check);
         pragma Suppress (Tag_Check);
      begin                   --  X is a ptr: no "in out" parms in a function
         if X.all'Tag = A_Rec'Tag then                         --  A_Rec case
            X.all.Value := not X.all.Value;
         else
            declare                       --  Make visible the 2 B_Rec fields
               pragma Suppress (Tag_Check);
               B        : B_Rec renames B_Rec (X.all);
            begin
               B.Count := B.Count + 1;
               if B.Count = B.Flip_Period then
                  B.Count := 0;
                  B.Value := not B.Value;
               end if;
            end;
         end if;
         return X;
      end Activate;
   end Toggles;

   A        : aliased Toggles.A_Rec;      --  "aliased", since X'Access is used
   B        : aliased Toggles.B_Rec;      --  "access all" above for aliased
   N        : Positive := 1;
   Res      : Boolean;
begin
   begin
      N := Positive'Value (Ada.Command_Line.Argument (1));
   exception
      when Constraint_Error => null;
   end;
   A := Toggles.A_Rec'(Value => True);
   for K in 1 .. 5 loop
      Res := Toggles.Activate (A'Access).Value;
      Text_IO.Put_Line (CH.To_Lower (Boolean'Image (Res)));
   end loop;
   for Iter in 1 .. N loop
      A := Toggles.A_Rec'(Value => True);
   end loop;
   Text_IO.New_Line;
   B := Toggles.B_Rec'(Value => True, Flip_Period => 3, Count => 0);
   for K in 1 .. 8 loop
      Res := Toggles.Activate (B'Access).Value;
      Text_IO.Put_Line (CH.To_Lower (Boolean'Image (Res)));
   end loop;
   for Iter in 1 .. N loop
      B := Toggles.B_Rec'(Value => True, Flip_Period => 3, Count => 0);
   end loop;
end ObjInst;

-- $Id: prodcons.gnat,v 1.0 2003/06/11 12:10:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

with Ada.Strings.Fixed, Ada.Command_Line, Text_IO;

procedure ProdCons is

   type Data_Type is new Integer;
   End_Of_Data    : constant Data_Type := Data_Type'First;

   protected Queue is
      entry Put (Data : Data_Type);
      entry Get (Data_Out : out Data_Type);
   private
      Count          : Natural := 0;
      Buffer         : Data_Type;
   end Queue;

   protected body Queue is
      entry Put (Data : Data_Type)
         when Count = 0 is
      begin
         Buffer := Data;
         Count := Count + 1;
      end Put;

      entry Get (Data_Out : out Data_Type)
         when Count /= 0 is
      begin
         Data_Out := Buffer;
         Count := Count - 1;
      end Get;
   end Queue;

   Produced, Consumed : Natural := 0;

   task type Producer_Task (N : Natural);
   task type Consumer_Task (N : Natural);

   task body Producer_Task is
   begin
      for Data_K in 1 .. Data_Type (N) loop
         Queue.Put (Data => Data_K);
         Produced := Produced + 1;
      end loop;
      Queue.Put (Data => End_Of_Data);
   end Producer_Task;

   task body Consumer_Task is
      Data        : Data_Type;
   begin
      loop
         Queue.Get (Data_Out => Data);
         exit when Data = End_Of_Data;
         Consumed := Consumed + 1;
      end loop;
   end Consumer_Task;

   function L_Trim (Source : String; Side : Ada.Strings.Trim_End :=
               Ada.Strings.Left) return String renames Ada.Strings.Fixed.Trim;
   N        : Natural := 0;
begin
   begin
      N := Natural'Value (Ada.Command_Line.Argument (1));
   exception
      when Constraint_Error => null;
   end;
   declare
      Producer    : Producer_Task (N => N);
      Consumer    : Consumer_Task (N => N);
   begin
      null;
   end;
   Text_IO.Put_Line (L_Trim (Natural'Image (Produced)) &
            Natural'Image (Consumed));
end ProdCons;

-- $Id: random.gnat,v 1.0 2003/06/11 12:05:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

with System, Ada.Command_Line, Ada.Text_IO;

procedure Random is
   type Real is digits Positive'Max (15, System.Max_Digits);
   package Rio is new Ada.Text_IO.Float_IO (Num => Real);

   package Random_Real is
      function Gen_Random (Supr : Real) return Real;
      pragma Inline (Gen_Random);
   end Random_Real;

   package body Random_Real is
      IM          : constant Positive := 139968;
      IA          : constant Integer := 3877;
      IC          : constant Integer := 29573;
      Last        : Integer := 42;

      function Gen_Random (Supr : Real) return Real is
         pragma Suppress (Overflow_Check);
         pragma Suppress (Range_Check);
      begin
         Last := (Last * IA + IC) mod IM;
         return Supr * Real (Last) / Real (IM);
      end Gen_Random;
         --  Assume no overflow for "Natural ((IM - 1) * IA + IC)"
   end Random_Real;

   Result   : Real;
   N        : Natural := 0;
begin
   begin
      N := Natural'Value (Ada.Command_Line.Argument (1));
   exception
      when Constraint_Error => null;
   end;
   for Iter in 1 .. N loop
      Result := Random_Real.Gen_Random (Supr => 100.0);
   end loop;
   Rio.Put (Result, Fore => 0, Aft => 9, Exp => 0);
   Ada.Text_IO.New_Line;
end Random;

-- $Id: sieve.gnat,v 1.0 2003/06/11 12:03:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

with Text_IO, Ada.Command_Line;

procedure Sieve is
   High        : constant := 8192;
   Is_Prime    : array (2 .. High) of Boolean;
   Count, K, N : Natural := 0;
begin
   begin
      N := Natural'Value (Ada.Command_Line.Argument (1));
   exception
      when Constraint_Error => null;
   end;
   for Iter in 1 .. N loop
      declare
         pragma Suppress (Overflow_Check);
         pragma Suppress (Index_Check);
         pragma Suppress (Range_Check);
      begin
         Count := 0;
         Is_Prime := (others => True);
         for J in Is_Prime'Range loop
            if Is_Prime (J) then
               K := J + J;
               while K <= Is_Prime'Last loop
                  Is_Prime (K) := False;        --  K is not a prime since a
                  K := K + J;                   --  multiple of prime J
               end loop;
               Count := Count + 1;
            end if;
         end loop;
      end;
   end loop;
   Text_IO.Put_Line ("Count:" & Natural'Image (Count));
end Sieve;

-- $Id: moments.gnat,v 1.0 2003/06/11 12:08:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

-- Annotated Ada Reference Manual ISO/IEC 8652:1995: http://www.ada-auth.org/

with System, Ada.Numerics.Generic_Elementary_Functions;
with Ada.Unchecked_Deallocation, Ada.Text_IO;

procedure Moments is
   type Real is digits Positive'Max (15, System.Max_Digits);
   package AF is new
         Ada.Numerics.Generic_Elementary_Functions (Float_Type => Real);
   package Io renames Ada.Text_IO;
   package Rio is new Ada.Text_IO.Float_IO (Num => Real);
   procedure Put (Item : Real; Fore : Io.Field := 0; Aft : Io.Field := 6;
                  Exp : Io.Field := 0) renames Rio.Put;

   generic
       type Item_Type is private;      --  Component type of array to be sorted
       with function "<=" (X, Y : Item_Type) return Boolean;
       type Sequence is array (Integer range <>) of Item_Type;
   package Sort_Pkg is
      procedure Quick_Sort (S : in out Sequence);
   end Sort_Pkg;  --  Copied from Southampton Ada MPICH supercomputer bindings

   package body Sort_Pkg is
      procedure Quick_Sort (S : in out Sequence) is
         procedure Sort_Recursive (Lwb, Upb : Integer) is
            Pivot    : Item_Type := S (Upb);
            Front    : Integer := Lwb;
            Back     : Integer := Upb;
            Temp     : Item_Type;
         begin
            if Lwb < Upb then
               while  (Front <= Back)  loop
                  while not  (Pivot <= S (Front)) loop
                     Front := Front + 1;
                  end loop;
                  while not  (S (Back) <= Pivot) loop
                     Back := Back - 1;
                  end loop;
                  if Front <= Back then
                     Temp := S (Front);
                     S (Front) := S (Back);
                     S (Back) := Temp;
                     Front := Front + 1;
                     Back  := Back - 1;
                  end if;
               end loop;
               Sort_Recursive (Lwb, Back);
               Sort_Recursive (Front, Upb);
            end if;
         end Sort_Recursive;
      begin
         Sort_Recursive (S'First, S'Last);
      end Quick_Sort;
   end Sort_Pkg;

   type Real_Array is array (Integer range <>) of Real;
   type Real_Array_Ptr is access Real_Array;
   procedure Deallocate_Real_Array is new Ada.Unchecked_Deallocation (
                  Object => Real_Array, Name => Real_Array_Ptr);
   package Sort is new Sort_Pkg (Real, "<=" => "<=", Sequence => Real_Array);

   Data           : Real_Array_Ptr := new Real_Array (1 .. 0);
   Temp_Array     : Real_Array_Ptr;
   Dev, D_2, Mean, Median     : Real;
   Standard_Deviation         : Real;
   Sum, Avg_Abs_Deviation     : Real := 0.0;
   Variance, Skew, Kurtosis   : Real := 0.0;
   M              : Natural := 0;
begin
   while not Io.End_Of_File loop
      M := M + 1;
      if M > Data'Last then                  --  Lengthen array of strings
         Temp_Array := new Real_Array (
                        1 .. 4 + Positive (Real'Ceiling (1.70 * Real (M))));
         Temp_Array (Data'Range) := Data.all;
         Deallocate_Real_Array (Data);
         Data := Temp_Array;     --  Replace the old array with the new one
      end if;
      Rio.Get (Item => Data (M));      -- Read  numbers between whitespace
      Sum := Sum + Data (M);
   end loop;
   Mean := Sum / Real (M);
   for K in 1 .. M loop
      Dev := Data (K) - Mean;
      Avg_Abs_Deviation := Avg_Abs_Deviation + abs Dev;
      D_2 := Dev * Dev;
      Variance := Variance + D_2;
      Skew := Skew + (D_2 * Dev);
      Kurtosis := Kurtosis + (D_2 * D_2);
   end loop;
   Avg_Abs_Deviation := Avg_Abs_Deviation / Real (M);
   Variance := Variance / Real (M - 1);
   Standard_Deviation := AF.Sqrt (Variance);
   if Variance < 10.0 * Real'Model_Epsilon then
      Io.Put_Line ("> Reduced accuracy results: 0 = ((Variance/10 + 1) - 1)");
   else
      Skew := Skew / (Real (M) * Variance * Standard_Deviation);
      Kurtosis := -3.0 + Kurtosis / (Real (M) * Variance * Variance);
   end if;
   Sort.Quick_Sort (S => Data (1 .. M));
   if 1 = (M mod 2) then
      Median := Data ((M + 1) / 2);
   else
      Median := (Data (M / 2) + Data (1 + M / 2)) / 2.0;
   end if;
   Io.Put_Line ("n:                 " & Integer'Image (M));
   Io.Put ("median:             "); Put (Median);              Io.New_Line;
   Io.Put ("mean:               "); Put (Mean);                Io.New_Line;
   Io.Put ("average_deviation:  "); Put (Avg_Abs_Deviation);   Io.New_Line;
   Io.Put ("standard_deviation: "); Put (Standard_Deviation);  Io.New_Line;
   Io.Put ("variance:           "); Put (Variance);            Io.New_Line;
   Io.Put ("skew:               "); Put (Skew);                Io.New_Line;
   Io.Put ("kurtosis:           "); Put (Kurtosis);            Io.New_Line;
end Moments;

-- $Id: strcat.gnat,v 1.0 2003/11/18 12:15:00 dada Exp $
-- http://dada.perl.it/shootout
-- contributed by James S. Rogers

with Ada.Command_Line; use Ada.Command_Line;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_Io; use Ada.Text_Io;
with Ada.Integer_text_Io; use Ada.Integer_Text_Io;

procedure Strcat is
   N: Integer;
   Hello : String := "hello" & Ascii.Lf;
   Buffer : Unbounded_String := Null_Unbounded_String;
begin
   N := Integer'Value(Argument(1));
   for Num in 1..N loop
      Append(Source => Buffer, New_Item => Hello);
   end loop;
   Put(Length(Buffer));
   New_Line;
end Strcat;

-- $Id: sumcol.gnat,v 1.0 2003/06/11 12:06:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.

with Text_IO, Ada.Strings.Fixed, Ada.IO_Exceptions;

procedure SumCol is
   package IE renames Ada.IO_Exceptions;
   package AS renames Ada.Strings;

   function Read_Line return String is
      Buf      : String (1 .. 4096);
      Last     : Natural;
   begin    --  (End_Error here (in ObjectAda) on unusual missing final "\n")
      Text_IO.Get_Line (Text_IO.Standard_Input, Item => Buf, Last => Last);
      if Last < Buf'Last or else
                     Text_IO.End_Of_File (Text_IO.Standard_Input) then
         return Buf (1 .. Last);
      else
         return Buf & Read_Line;
      end if;
   end Read_Line;

   Sum         : Integer := 0;
begin
   while not Text_IO.End_Of_File loop
      declare
         Line     : String := AS.Fixed.Trim (Read_Line, Side => AS.Right);
      begin
         Sum := Sum + Integer'Value (Line);  --  Fail 0 or 2 numbers per line
      end;
   end loop;
   Text_IO.Put_Line (AS.Fixed.Trim (Natural'Image (Sum), Side => AS.Left));
exception                        --  Catch error from Get_Line Integer'Value
   when Constraint_Error | IE.Device_Error | IE.End_Error =>
      Text_IO.Put_Line ("> Error near line" &
               Text_IO.Count'Image (Text_IO.Line));
end SumCol;