with Ada.Command_Line, Globals, Strings;

pragma Elaborate_All (Ada.Command_Line,Strings,Globals);

package body Rationals is

  function GCD(N,D: LInt) return LInt is
    AN: LInt := abs(N);
    AD: LInt := abs(D);
    Tmp: LInt;
  begin
    while (AN /= 0) loop
      Tmp  := AN;
      AN := AD mod Tmp;
      AD := Tmp;
    end loop;
    if AD=0 then raise Constraint_Error; end if;
    return AD;
  end GCD;

  function Width(I: LInt; Base: Positive := 10) return Positive is
    B: constant LInt := LInt(Base);
    L: Integer;
    K: LInt;
  begin
    K := abs(I);
    if I<0 then L := 2; else L := 1; end if;
    while K >= B loop
      K := K/B;
      L := L+1;
    end loop;
    return L;
  end Width;

  function Value(S: String) return LInt is
    pragma Unsuppress (Overflow_Check);
    use Strings;
    Neg: Boolean := False;
    I: LInt := 0;
  begin
    for K in S'Range loop
      if S(K)='-' then
        Neg := True;
      elsif S(K) /= ' ' and then S(K) /= '+' then
        I := 10*I+LInt(Val(S(K),9));
      end if;
    end loop;
    if Neg then I := -I; end if;
    return I;
  end Value;

  procedure Show1(N: in String; I: in LInt; NewLine: in Boolean := True) is
    use Strings, Globals;
    P: constant File_Access := Default_Output.all;
  begin
    Put(P,N);
    LInt_IO.Put(P.all,I,Width(I));
    if NewLine then New_Line(P); end if;
  end Show1;

  function Prompt(N: String) return LInt is
    use Strings;
    S: constant String := Prompt(N);
  begin
    return Value(S);
  end Prompt;

  --------------------------

  function LRat(N: Lint; D: LInt := 1) return Rational is
    G: constant LInt := GCD(N,D);
  begin
    if D>0 then
      return (N/G,D/G);
    end if;
    if D=0 then raise Constraint_Error; end if;
    return ((-N)/G,(-D)/G);
  end LRat;

  function IRat(N: Integer; D: Integer := 1) return Rational is
  begin
    return (Lint(N)/Lint(D));
  end IRat;

  function LNum(Q: Rational) return Lint is
  begin
    return Q.Num;
  end LNum;

  function INum(Q: Rational) return Integer is
    use LInt_IO;
  begin
    return Integer(Q.Num);
  exception
    when CONSTRAINT_ERROR =>
      LInt_IO.Put(Q.Num,Width(Q.Num));
      New_Line;
      raise;
  end INum;

  function LDen(Q: Rational) return Lint is
  begin
    return Q.Den;
  end LDen;

  function IDen(Q: Rational) return Integer is
    use LInt_IO;
  begin
    return Integer(Q.Den);
  exception
    when CONSTRAINT_ERROR =>
      LInt_IO.Put(Q.Den,Width(Q.Den));
      New_Line;
      raise;
  end IDen;

  ------------------------------

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

  function "+"(P,Q: Rational) return Rational is
    pragma Unsuppress (Overflow_Check);
    G: constant LInt := GCD(P.Den,Q.Den);
    PD: constant Lint := P.Den/G;
    QD: constant Lint := Q.Den/G;
  begin
    return (P.Num*QD+PD*Q.Num)/(PD*Q.Den);
  end "+";

  function "-"(P,Q: Rational) return Rational is
    pragma Unsuppress (Overflow_Check);
    G: constant LInt := GCD(P.Den,Q.Den);
    PD: constant Lint := P.Den/G;
    QD: constant Lint := Q.Den/G;
  begin
    return (P.Num*QD-PD*Q.Num)/(PD*Q.Den);
  end "-";

  function "*"(P,Q: Rational) return Rational is
    pragma Unsuppress (Overflow_Check);
    A: constant Rational := P.Num/Q.Den;
    B: constant Rational := Q.Num/P.Den;
  begin
    return (A.Num*B.Num,A.Den*B.Den);
  end "*";

  function "/" (P,Q: Rational) return Rational is
    pragma Unsuppress (Overflow_Check);
    A: constant Rational := P.Num/Q.Num;
    B: constant Rational := Q.Den/P.Den;
  begin
    return (A.Num*B.Num,A.Den*B.Den);
  end "/";

  function "mod"(P,Q: Rational) return Rational is
    G: constant LInt := GCD(P.Den,Q.Den);
  begin
    return (P.Num*(Q.Den/G) mod Q.Num*(P.Den/G))/(P.Den*(Q.Den/G));
  end "mod";

  function Inv(Q: Rational) return Rational is
  begin
    if Q.Num>0 then return (Q.Den,Q.Num); end if;
    return (-Q.Den,-Q.Num);
  end Inv;

  function Sqr(Q: Rational) return Rational is
    pragma Unsuppress (Overflow_Check);
  begin
    return (Q.Num*Q.Num,Q.Den*Q.Den);
  end Sqr;

  function "abs"(Q: Rational) return Rational is
  begin
    return (abs(Q.Num),Q.Den);
  end "abs";

  function "<"(P,Q: Rational) return Boolean is
    pragma Unsuppress (Overflow_Check);
    G: constant LInt := GCD(P.Den,Q.Den);
    PD: constant Lint := P.Den/G;
    QD: constant Lint := Q.Den/G;
  begin
    return (P.Num*QD)<(Q.Num*PD);
  end "<";

  ---------------------

  function "+"(I: Integer; Q: Rational) return Rational is
    pragma Unsuppress (Overflow_Check);
  begin
    return (LInt(I)*Q.Den+Q.Num,Q.Den);
  end "+";

  function "+"(Q: Rational; I: Integer) return Rational is
    pragma Unsuppress (Overflow_Check);
  begin
    return (Q.Num+LInt(I)*Q.Den,Q.Den);
  end "+";

  function "-"(I: Integer; Q: Rational) return Rational is
    pragma Unsuppress (Overflow_Check);
  begin
    return (LInt(I)*Q.Den-Q.Num,Q.Den);
  end "-";

  function "-"(Q: Rational; I: Integer) return Rational is
    pragma Unsuppress (Overflow_Check);
  begin
    return (Q.Num-LInt(I)*Q.Den,Q.Den);
  end "-";

  function "*"(I: Integer; Q: Rational) return Rational is
    pragma Unsuppress (Overflow_Check);
  begin
    return (LInt(I)*Q.Num)/Q.Den;
  end "*";

  function "*"(Q: Rational; I: Integer) return Rational is
    pragma Unsuppress (Overflow_Check);
  begin
    return (Q.Num*LInt(I))/Q.Den;
  end "*";

  function "/"(I: Integer; Q: Rational) return Rational is
    pragma Unsuppress (Overflow_Check);
  begin
    return (LInt(I)*Q.Den)/Q.Num;
  end "/";

  function "/"(Q: Rational; I: Integer) return Rational is
    pragma Unsuppress (Overflow_Check);
  begin
    return Q.Num/(Q.Den*LInt(I));
  end "/";

  function "mod"(P: Rational; I: Integer) return Rational is
  begin
    return (P.Num mod (Lint(I)*P.Den),P.Den);
  end "mod";

  function LFloor(Q: Rational) return LInt is
    I: constant LInt := Q.Num/Q.Den; -- rounds toward 0
  begin
    if Q.Num >= 0 then return I; end if;
    if I*Q.Den=Q.Num then return I; end if;
    return I-1;
  end LFloor;

  function IFloor(Q: Rational) return Integer is
    pragma Unsuppress (Overflow_Check);
  begin
    return Integer(LFloor(Q));
  end IFloor;

  function LCeiling(Q: Rational) return LInt is
    I: constant LInt := Q.Num/Q.Den; -- rounds toward 0
  begin
    if Q.Num <= 0 then return I; end if;
    if I*Q.Den=Q.Num then return I; end if;
    return I+1;
  end LCeiling;

  function ICeiling(Q: Rational) return Integer is
    pragma Unsuppress (Overflow_Check);
  begin
    return Integer(LCeiling(Q));
  end ICeiling;

  -----------------------------

  function Value(S: String) return Rational is
    Num: LInt;
    Den: Nonnegative_LInt;
  begin
    for K in S'First+1 .. S'Last-1 loop
      if S(K)='/' then
        Num := Value(S(S'First .. K-1));
        Den := Value(S(K+1 .. S'Last));
        return LRat(Num,Den);
      end if;
    end loop;
    Num := Value(S);
    return (Num,1);
  end Value;

  function Normalize(Q: Rational) return Rational is
    G: constant LInt := GCD(Q.Num,Q.Den);
  begin
    if G /= 1 then
      Show1("Warning: found un-normalized rational ",Q);
    end if;
    return (Q.Num/G,Q.Den/G);
  end Normalize;

  procedure Show1(N: in String; Q: in Rational; NewLine: in Boolean := True) is
    use LInt_IO;
    P: constant Rational := Normalize(Q);
  begin
    Put(N);
    LInt_IO.Put(P.Num,Width(P.Num));
    Put("/");
    LInt_IO.Put(P.Den,Width(P.Den));
    if NewLine then New_Line; end if;
  end Show1;

  function Prompt(N: String) return Rational is
    use Strings;
    S: constant String := Prompt(N);
  begin
    return Value(S);
  end Prompt;

  function GetArg return Rational is
    use Globals;
    S: constant String := Ada.Command_Line.Argument(ArgIndex);
  begin
    ArgIndex := ArgIndex+1;
    return Value(S);
  end GetArg;

  ----------------------

  function EvenOverOdd(Q: Rational) return Boolean is
    P: constant Rational := Normalize(Q);
  begin
    return ((P.Num mod 2)=0) and then ((P.Den mod 2)=1);
  end EvenOverOdd;

  function OddOverEven(Q: Rational) return Boolean is
    P: constant Rational := Normalize(Q);
  begin
    return ((P.Num mod 2)=1) and then ((P.Den mod 2)=0);
  end OddOverEven;

  function OddOverOdd(Q: Rational) return Boolean is
    P: constant Rational := Normalize(Q);
  begin
    return ((P.Num mod 2)=1) and then ((P.Den mod 2)=1);
  end OddOverOdd;

end Rationals;
