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;