--  Program 3   May 2022



--  Rational Reckoner 

-- This program is identical to that in Programming in Ada 2012
-- except for the added comments.


package Rational_Numbers is
   type Rational is private;

   -- unary operators
   function "+" (X: Rational) return Rational;
   function "-" (X: Rational) return Rational;

   -- binary operators
   function "+" (X, Y: Rational) return Rational;
   function "-" (X, Y: Rational) return Rational;
   function "*" (X, Y: Rational) return Rational;
   function "/" (X, Y: Rational) return Rational;

   -- constructor function
   function "/" (X: Integer; Y: Positive) return Rational;

   -- selector functions
   function Numerator(R: Rational) return Integer;
   function Denominator(R: Rational) return Positive;

private
   type Rational is
      record
         Num: Integer := 0;   -- numerator
         Den: Positive := 1;  -- denominator
      end record;
end;

private package Rational_Numbers.Slave is

   -- The function Normal cancels any common factors in
   -- the numerator and denominator and returns 
   -- the normalized form.
   --    It could be restructured as a child function.

   function Normal(R: Rational) return Rational;
end;

package body Rational_Numbers.Slave is

   -- It would be more efficient to use the iterative
   -- form of GCD as shown in the answer to Exercise 10.1(7).

   function GCD(X, Y: Natural) return Natural is
   begin
      if Y = 0 then
         return X;
      else
         return GCD(Y, X mod Y);
      end if;
   end GCD;

   function Normal(R: Rational) return Rational is
      G: Positive := GCD(abs R.Num, R.Den);
   begin
      return (R.Num/G, R.Den/G);
   end Normal;

end Rational_Numbers.Slave;

with Rational_Numbers.Slave;
package body Rational_Numbers is
   use Slave;

   -- It might be argued that it would be better to use the 
   -- constructor function "/" rather than directly use Normal
   -- in the various operations.

   function "+" (X: Rational) return Rational is
   begin
      return X;
   end "+";

   function "-" (X: Rational) return Rational is
   begin
      return (-X.Num, X.Den);
   end "-";

   function "+" (X, Y: Rational) return Rational is
   begin
      return Normal((X.Num*Y.Den + Y.Num*X.Den, X.Den*Y.Den));
   end "+";

   function "-" (X, Y: Rational) return Rational is
   begin
      return Normal((X.Num*Y.Den - Y.Num*X.Den, X.Den*Y.Den));
   end "-";

   function "*" (X, Y: Rational) return Rational is
   begin
      return Normal((X.Num*Y.Num, X.Den*Y.Den));
   end "*";

   function "/" (X, Y: Rational) return Rational is
      N: Integer := X.Num*Y.Den;
      D: Integer := X.Den*Y.Num;
   begin
   -- we have to change the signs if D is negative because
   -- Den is of subtype Positive. Early versions of this 
   -- program were incorrect.
      if D < 0 then D := -D; N := -N; end if;
      return Normal((Num => N, Den => D));
   end "/";

   function "/" (X: Integer; Y: Positive) return Rational is
   begin
      return Normal((Num => X, Den => Y));
   end "/";

   function Numerator(R: Rational) return Integer is
   begin
      return R.Num;
   end Numerator;

   function Denominator(R: Rational) return Positive is
   begin
      return R.Den;
   end Denominator;

end Rational_Numbers;

package Rational_Numbers.IO is
   procedure Get(X: out Rational);
   procedure Put(X: in Rational);
end;

with Ada.Text_IO, Ada.Integer_Text_IO;  use Ada;
with Rational_Numbers.Slave;
package body Rational_Numbers.IO is

   -- This child package directly accesses the components of the
   -- type Rational and uses the function Normal in the child
   -- package which is not visible to the external client.
   --    An alternative approach would be only to use the public 
   -- view of the type Rational in which case this package need not
   -- be a child.

   procedure Get(X: out Rational) is
      N: Integer;  -- numerator
      D: Integer;  -- denominator
      C: Character;
      EOL: Boolean; -- end of line
   begin
       -- Read the signed numerator with the predefined Get.
       -- This also skips spaces and newlines.
       Integer_Text_IO.Get(N);     -- numerator
       Text_IO.Look_Ahead(C, EOL);
       if EOL or else C /= '/' then
          raise Text_IO.Data_Error;
       end if;
       Text_IO.Get(C);  -- remove the / character
       Text_IO.Look_Ahead(C, EOL);
       if EOL or else C not in '0' .. '9' then
          raise Text_IO.Data_Error;
       end if;
       -- Read the unsigned denominator.
       Integer_Text_IO.Get(D);     -- denominator
       if D = 0 then
          raise Text_IO.Data_Error;
       end if;
       X := Slave.Normal((N, D));
   end Get;

   procedure Put(X: in Rational) is
   begin
      Integer_Text_IO.Put(X.Num, 0);
      Text_IO.Put('/');
      Integer_Text_IO.Put(X.Den, 0);
   end Put;

end Rational_Numbers.IO;

with Rational_Numbers;
use Rational_Numbers;
package Rat_Stack is

   -- This package provides a stack of Rational values.
   -- The subprograms Push and Pop are as usual - they raise
   -- the exception Error if an attempt is made to Push onto a
   -- full stack or Pop from an empty one.  The procedure Clear
   -- sets the stack to empty.

   Error: exception;
   procedure Clear;
   procedure Push(R: in Rational);
   function Pop return Rational;
end;

private package Rat_Stack.Data is
   Max: constant := 4;  -- stack size
   Top: Integer := 0;
   Stack: array (1 .. Max) of Rational;
end Rat_Stack.Data;

with Rat_Stack.Data;
package body Rat_Stack is
   use Data;

   -- The data which represents the stack is in the private child
   -- package Data. 

   procedure Clear is
   begin
      Top := 0;
   end Clear;

   procedure Push(R: in Rational) is
   begin
      if Top = Max then
         raise Error;
      end if;
      Top := Top + 1;
      Stack(Top) := R;
   end Push;

   function Pop return Rational is
   begin
      if Top = 0 then
         raise Error;
      end if;
      Top := Top - 1;
      return Stack(Top + 1);
   end Pop;

end Rat_Stack;

with Rational_Numbers.IO;
with Ada.Text_IO;
private with Rat_Stack.Data;
procedure Rat_Stack.Print_Top is
   use Data;

   -- Prints the top item on the stack without deleting it.
   -- Outputs an appropriate message if the stack is empty.

   -- Note the private with clause for Rat_Stack.Data. This is
   -- necessary because we have chosen not to give a distinct 
   -- specification for Print_Top. In such a case the context 
   -- clause behaves as if it were on a specification and the
   -- specification of a public child can only have a private 
   -- with clause for a private sibling.

begin
   if Top = 0 then
      Ada.Text_IO.Put("Nothing on stack");
   else
      Rational_Numbers.IO.Put(Stack(Top));
   end if;
   Ada.Text_IO.New_Line;
end Rat_Stack.Print_Top;

with Rat_Stack;
with Ada.Text_IO;  use Ada.Text_IO;
procedure Rational_Reckoner is
   C: Character;
   Control_Error, Done: exception;
   procedure Process(C: Character) is separate;
begin
   Put("Welcome to the Rational Reckoner");
   New_Line(2);
   Put_Line("Operations are + - * / ? ! plus eXit");
   Put_Line("Input rational by #[sign]digits/digits");
   Rat_Stack.Clear;
   loop
      begin
         Get(C);
         Process(C);
      exception
         when Rat_Stack.Error =>
            New_Line;
            Put_Line("Stack overflow/underflow, " &
                     "stack reset");
            Rat_Stack.Clear;
         when Control_Error =>
            New_Line;
            Put_Line("Unexpected character, " &
                     "not # + - * / ? ! or X");
         when Done =>
            exit;
      end;
   end loop;
   New_Line;
   Put_Line("Finished");
   Skip_Line(2);
end Rational_Reckoner;

with Rat_Stack.Print_Top;  use Rat_Stack;
with Rational_Numbers;  use Rational_Numbers;
separate(Rational_Reckoner)
procedure Process(C: Character) is

   -- Performs the action represented by the character passed
   -- as parameter.
   --    Raises the exception Control_Error if the character is not
   -- recognized.  Raises Done if the program is to terminate.  It
   -- might also propagate Rat_Stack.Error from the calls of Push
   -- and Pop.

   R: Rational;
   procedure Get_Rational(R: out Rational) is separate;
begin
   case C is
      when '#' =>
         Get_Rational(R);
         Push(R);
      when '+' =>
         Push(Pop + Pop);
      when '-' =>
         R := Pop;  Push(Pop - R);
      when '*' =>
         Push(Pop * Pop);
      when '/' =>
         R := Pop;  Push(Pop / R);
      when '?' =>
         Print_Top;
      when '!' =>
         Print_Top;  R := Pop;
      when ' ' =>
         null;
      when 'X' | 'x' =>
         raise Done;
      when others =>
         raise Control_Error;
   end case;
end Process;

with Rational_Numbers.IO;
separate(Rational_Reckoner.Process)
procedure Get_Rational(R: out Rational) is

   -- Reads a rational value. If an attempt raises Data_Error
   -- then it outputs a message and a prompt and tries again.

begin
   loop
      begin
         IO.Get(R);
         exit;
      exception
         when Data_Error =>
            Skip_Line;  New_Line;
            Put_Line("Not a rational, try again ");
            Put('#');
      end;
   end loop;
end Get_Rational;