path: root/src/rationals.adb

with

    Interfaces.C;

use type

    Interfaces.C.int;


package body Rationals is


    procedure mpq_canonicalize
           (Op : in out mpq_t)
        with Inline => True;
    pragma Import (C, mpq_canonicalize, "__gmpq_canonicalize");

    procedure mpq_init
           (X : out mpq_t)
        with Inline => True;
    pragma Import (C, mpq_init, "__gmpq_init");

    procedure mpq_clear
           (X : in out mpq_t)
        with Inline => True;
    pragma Import (C, mpq_clear, "__gmpq_clear");

    procedure mpq_set
           (Rop : in out mpq_t;
            Op  : in     mpq_t)
        with Inline => True;
    pragma Import (C, mpq_set, "__gmpq_set");

    procedure mpq_set_si
           (Rop : in out mpq_t;
            Op1 : in     Interfaces.C.long;
            Op2 : in     Interfaces.C.unsigned_long)
        with Inline => True;
    pragma Import (C, mpq_set_si, "__gmpq_set_si");




    procedure mpq_add
           (Sum              : in out mpq_t;
            Addend1, Addend2 : in     mpq_t)
        with Inline => True;
    pragma Import (C, mpq_add, "__gmpq_add");

    procedure mpq_sub
           (Difference          : in out mpq_t;
            Minuend, Subtrahend : in     mpq_t)
        with Inline => True;
    pragma Import (C, mpq_sub, "__gmpq_sub");

    procedure mpq_mul
           (Product                  : in out mpq_t;
            Multiplier, Multiplicand : in     mpq_t)
        with Inline => True;
    pragma Import (C, mpq_mul, "__gmpq_mul");

    procedure mpq_div
           (Quotient          : in out mpq_t;
            Dividend, Divisor : in     mpq_t)
        with Inline => True;
    pragma Import (C, mpq_div, "__gmpq_div");

    procedure mpq_neg
           (Negated : in out mpq_t;
            Operand : in     mpq_t)
        with Inline => True;
    pragma Import (C, mpq_neg, "__gmpq_neg");




    function mpq_cmp
           (Op1, Op2 : in mpq_t)
        return Interfaces.C.int
        with Inline => True;
    pragma Import (C, mpq_cmp, "__gmpq_cmp");

    function mpq_equal
           (Op1, Op2 : in mpq_t)
        return Interfaces.C.int
        with Inline => True;
    pragma Import (C, mpq_equal, "__gmpq_equal");




    procedure mpz_init
           (X : out mpz_t)
        with Inline => True;
    pragma Import (C, mpz_init, "__gmpz_init");

    procedure mpz_clear
           (X : in out mpz_t)
        with Inline => True;
    pragma Import (C, mpz_clear, "__gmpz_clear");

    procedure mpz_set
           (Rop : in out mpz_t;
            Op  : in     mpz_t)
        with Inline => True;
    pragma Import (C, mpz_set, "__gmpz_set");

    function mpz_get_si
           (Op : in mpz_t)
        return Interfaces.C.long
        with Inline => True;
    pragma Import (C, mpz_get_si, "__gmpz_get_si");

    procedure mpz_set_si
           (Rop : in out mpz_t;
            Op  : in     Interfaces.C.long)
        with Inline => True;
    pragma Import (C, mpz_set_si, "__gmpz_set_si");




    procedure mpz_add_ui
           (Rop : in out mpz_t;
            Op1 : in     mpz_t;
            Op2 : in     Interfaces.C.unsigned_long)
        with Inline => True;
    pragma Import (C, mpz_add_ui, "__gmpz_add_ui");




    procedure mpz_cdiv_q
           (Q    : in out mpz_t;
            N, R : in     mpz_t)
        with Inline => True;
    pragma Import (C, mpz_cdiv_q, "__gmpz_cdiv_q");

    procedure mpz_fdiv_q
           (Q    : in out mpz_t;
            N, R : in     mpz_t)
        with Inline => True;
    pragma Import (C, mpz_fdiv_q, "__gmpz_fdiv_q");

    procedure mpz_mod
           (R    : in out mpz_t;
            N, D : in     mpz_t)
        with Inline => True;
    pragma Import (C, mpz_mod, "__gmpz_mod");




    function mpz_cmp
           (Op1, Op2 : in mpz_t)
        return Interfaces.C.int
        with Inline => True;
    pragma Import (C, mpz_cmp, "__gmpz_cmp");




    procedure Initialize
           (This : in out Fraction) is
    begin
        mpq_init (This.Data);
    end Initialize;

    procedure Adjust
           (This : in out Fraction)
    is
        Temp : mpq_t;
    begin
        mpq_init (Temp);
        mpq_set (Temp, This.Data);
        This.Data := Temp;
    end Adjust;

    procedure Finalize
           (This : in out Fraction) is
    begin
        mpq_clear (This.Data);
    end Finalize;




    procedure Initialize
           (This : in out Bignum) is
    begin
        mpz_init (This.Data);
    end Initialize;

    procedure Adjust
           (This : in out Bignum)
    is
        Temp : mpz_t;
    begin
        mpz_init (Temp);
        mpz_set (Temp, This.Data);
        This.Data := Temp;
    end Adjust;

    procedure Finalize
           (This : in out Bignum) is
    begin
        mpz_clear (This.Data);
    end Finalize;




    function "+"
           (Left, Right : in Fraction)
        return Fraction is
    begin
        return Result : Fraction do
            mpq_add (Result.Data, Left.Data, Right.Data);
        end return;
    end "+";

    function "+"
           (Left  : in Fraction;
            Right : in Integer)
        return Fraction
    is
        Temp : Fraction;
    begin
        return Result : Fraction do
            mpq_set_si (Temp.Data, Interfaces.C.long (Right), 1);
            mpq_add (Result.Data, Left.Data, Temp.Data);
        end return;
    end "+";

    function "+"
           (Left  : in Integer;
            Right : in Fraction)
        return Fraction
    is
        Temp : Fraction;
    begin
        return Result : Fraction do
            mpq_set_si (Temp.Data, Interfaces.C.long (Left), 1);
            mpq_add (Result.Data, Temp.Data, Right.Data);
        end return;
    end "+";




    function "-"
           (Left, Right : in Fraction)
        return Fraction is
    begin
        return Result : Fraction do
            mpq_sub (Result.Data, Left.Data, Right.Data);
        end return;
    end "-";

    function "-"
           (Left  : in Fraction;
            Right : in Integer)
        return Fraction
    is
        Temp : Fraction;
    begin
        return Result : Fraction do
            mpq_set_si (Temp.Data, Interfaces.C.long (Right), 1);
            mpq_sub (Result.Data, Left.Data, Temp.Data);
        end return;
    end "-";

    function "-"
           (Left  : in Integer;
            Right : in Fraction)
        return Fraction
    is
        Temp : Fraction;
    begin
        return Result : Fraction do
            mpq_set_si (Temp.Data, Interfaces.C.long (Left), 1);
            mpq_sub (Result.Data, Temp.Data, Right.Data);
        end return;
    end "-";

    function "-"
           (Right : in Fraction)
        return Fraction is
    begin
        return Result : Fraction do
            mpq_neg (Result.Data, Right.Data);
        end return;
    end "-";




    function "*"
           (Left, Right : in Fraction)
        return Fraction is
    begin
        return Result : Fraction do
            mpq_mul (Result.Data, Left.Data, Right.Data);
        end return;
    end "*";

    function "*"
           (Left  : in Fraction;
            Right : in Integer)
        return Fraction
    is
        Temp : Fraction;
    begin
        return Result : Fraction do
            mpq_set_si (Temp.Data, Interfaces.C.long (Right), 1);
            mpq_mul (Result.Data, Left.Data, Temp.Data);
        end return;
    end "*";

    function "*"
           (Left  : in Integer;
            Right : in Fraction)
        return Fraction
    is
        Temp : Fraction;
    begin
        return Result : Fraction do
            mpq_set_si (Temp.Data, Interfaces.C.long (Left), 1);
            mpq_mul (Result.Data, Temp.Data, Right.Data);
        end return;
    end "*";




    function "/"
           (Left, Right : in Fraction)
        return Fraction is
    begin
        return Result : Fraction do
            mpq_div (Result.Data, Left.Data, Right.Data);
        end return;
    end "/";

    function "/"
           (Left  : in Fraction;
            Right : in Integer)
        return Fraction
    is
        Temp : Fraction;
    begin
        return Result : Fraction do
            mpq_set_si (Temp.Data, Interfaces.C.long (Right), 1);
            mpq_div (Result.Data, Left.Data, Temp.Data);
        end return;
    end "/";

    function "/"
           (Left  : in Integer;
            Right : in Fraction)
        return Fraction
    is
        Temp : Fraction;
    begin
        return Result : Fraction do
            mpq_set_si (Temp.Data, Interfaces.C.long (Left), 1);
            mpq_div (Result.Data, Temp.Data, Right.Data);
        end return;
    end "/";

    function "/"
           (Left, Right : in Integer)
        return Fraction is
    begin
        return Result : Fraction do
            mpq_set_si
                   (Result.Data,
                    Interfaces.C.long (Left),
                    Interfaces.C.unsigned_long (Right));
            mpq_canonicalize (Result.Data);
        end return;
    end "/";




    function "="
           (Left, Right : in Fraction)
        return Boolean is
    begin
        return mpq_equal (Left.Data, Right.Data) /= 0;
    end "=";

    function "="
           (Left  : in Fraction;
            Right : in Integer)
        return Boolean
    is
        Temp : Fraction;
    begin
        mpq_set_si (Temp.Data, Interfaces.C.long (Right), 1);
        return mpq_equal (Left.Data, Temp.Data) /= 0;
    end "=";

    function "="
           (Left  : in Integer;
            Right : in Fraction)
        return Boolean
    is
        Temp : Fraction;
    begin
        mpq_set_si (Temp.Data, Interfaces.C.long (Left), 1);
        return mpq_equal (Temp.Data, Right.Data) /= 0;
    end "=";




    function "<="
           (Left, Right : in Fraction)
        return Boolean is
    begin
        return mpq_cmp (Left.Data, Right.Data) <= 0;
    end "<=";

    function "<="
           (Left  : in Fraction;
            Right : in Integer)
        return Boolean
    is
        Temp : Fraction;
    begin
        mpq_set_si (Temp.Data, Interfaces.C.long (Right), 1);
        return mpq_cmp (Left.Data, Temp.Data) <= 0;
    end "<=";

    function "<="
           (Left  : in Integer;
            Right : in Fraction)
        return Boolean
    is
        Temp : Fraction;
    begin
        mpq_set_si (Temp.Data, Interfaces.C.long (Left), 1);
        return mpq_cmp (Temp.Data, Right.Data) <= 0;
    end "<=";




    function "<"
           (Left, Right : in Fraction)
        return Boolean is
    begin
        return mpq_cmp (Left.Data, Right.Data) < 0;
    end "<";

    function "<"
           (Left  : in Fraction;
            Right : in Integer)
        return Boolean
    is
        Temp : Fraction;
    begin
        mpq_set_si (Temp.Data, Interfaces.C.long (Right), 1);
        return mpq_cmp (Left.Data, Temp.Data) < 0;
    end "<";

    function "<"
           (Left  : in Integer;
            Right : in Fraction)
        return Boolean
    is
        Temp : Fraction;
    begin
        mpq_set_si (Temp.Data, Interfaces.C.long (Left), 1);
        return mpq_cmp (Temp.Data, Right.Data) < 0;
    end "<";




    function ">="
           (Left, Right : in Fraction)
        return Boolean is
    begin
        return mpq_cmp (Left.Data, Right.Data) >= 0;
    end ">=";

    function ">="
           (Left  : in Fraction;
            Right : in Integer)
        return Boolean
    is
        Temp : Fraction;
    begin
        mpq_set_si (Temp.Data, Interfaces.C.long (Right), 1);
        return mpq_cmp (Left.Data, Temp.Data) >= 0;
    end ">=";

    function ">="
           (Left  : in Integer;
            Right : in Fraction)
        return Boolean
    is
        Temp : Fraction;
    begin
        mpq_set_si (Temp.Data, Interfaces.C.long (Left), 1);
        return mpq_cmp (Temp.Data, Right.Data) >= 0;
    end ">=";




    function ">"
           (Left, Right : in Fraction)
        return Boolean is
    begin
        return mpq_cmp (Left.Data, Right.Data) > 0;
    end ">";

    function ">"
           (Left  : in Fraction;
            Right : in Integer)
        return Boolean
    is
        Temp : Fraction;
    begin
        mpq_set_si (Temp.Data, Interfaces.C.long (Right), 1);
        return mpq_cmp (Left.Data, Temp.Data) > 0;
    end ">";

    function ">"
           (Left  : in Integer;
            Right : in Fraction)
        return Boolean
    is
        Temp : Fraction;
    begin
        mpq_set_si (Temp.Data, Interfaces.C.long (Left), 1);
        return mpq_cmp (Temp.Data, Right.Data) > 0;
    end ">";




    function Numerator
           (Item : in Fraction)
        return Long_Integer is
    begin
        return Long_Integer (mpz_get_si (Item.Data.mp_num));
    end Numerator;


    function Denominator
           (Item : in Fraction)
        return Long_Integer is
    begin
        return Long_Integer (mpz_get_si (Item.Data.mp_den));
    end Denominator;


    function Floor
           (Item : in Fraction)
        return Long_Integer
    is
        Temp : Bignum;
    begin
        mpz_fdiv_q (Temp.Data, Item.Data.mp_num, Item.Data.mp_den);
        return Long_Integer (mpz_get_si (Temp.Data));
    end Floor;


    function Ceiling
           (Item : in Fraction)
        return Long_Integer
    is
        Temp : Bignum;
    begin
        mpz_cdiv_q (Temp.Data, Item.Data.mp_num, Item.Data.mp_den);
        return Long_Integer (mpz_get_si (Temp.Data));
    end Ceiling;


    function Round
           (Item : in Fraction)
        return Long_Integer
    is
        Num_Mod_Den, Den_Div_2, Temp, Result : Bignum;
    begin
        --  Precalculate Num mod Den and Den / 2
        mpz_mod (Num_Mod_Den.Data, Item.Data.mp_num, Item.Data.mp_den);
        mpz_set_si (Temp.Data, 2);
        mpz_cdiv_q (Den_Div_2.Data, Item.Data.mp_den, Temp.Data);
        --  Here the actual Num / Den division takes place
        mpz_fdiv_q (Temp.Data, Item.Data.mp_num, Item.Data.mp_den);
        if mpz_cmp (Num_Mod_Den.Data, Den_Div_2.Data) >= 0 then
            mpz_add_ui (Result.Data, Temp.Data, 1);
        else
            mpz_set (Result.Data, Temp.Data);
        end if;
        return Long_Integer (mpz_get_si (Result.Data));
    end Round;


end Rationals;