From 90c915c23bb7f80b7f3336a5051a27c0fd3f333f Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Mon, 3 Jul 2017 16:06:15 +1000
Subject: Fixed Rationals Rounding function

---
 src/rationals.adb | 87 +++++++++++++++++++++++++++++++++++++------------------
 src/rationals.ads | 18 ++++++++++++
 2 files changed, 77 insertions(+), 28 deletions(-)

(limited to 'src')

diff --git a/src/rationals.adb b/src/rationals.adb
index 80e070a..c50c479 100644
--- a/src/rationals.adb
+++ b/src/rationals.adb
@@ -109,6 +109,12 @@ package body Rationals is
         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
@@ -124,6 +130,16 @@ package body Rationals is
 
 
 
+    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)
@@ -179,6 +195,31 @@ package body Rationals is
 
 
 
+    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
@@ -533,14 +574,10 @@ package body Rationals is
            (Item : in Fraction)
         return Long_Integer
     is
-        Temp   : mpz_t;
-        Result : Long_Integer;
+        Temp : Bignum;
     begin
-        mpz_init (Temp);
-        mpz_fdiv_q (Temp, Item.Data.mp_num, Item.Data.mp_den);
-        Result := Long_Integer (mpz_get_si (Temp));
-        mpz_clear (Temp);
-        return Result;
+        mpz_fdiv_q (Temp.Data, Item.Data.mp_num, Item.Data.mp_den);
+        return Long_Integer (mpz_get_si (Temp.Data));
     end Floor;
 
 
@@ -548,14 +585,10 @@ package body Rationals is
            (Item : in Fraction)
         return Long_Integer
     is
-        Temp   : mpz_t;
-        Result : Long_Integer;
+        Temp : Bignum;
     begin
-        mpz_init (Temp);
-        mpz_cdiv_q (Temp, Item.Data.mp_num, Item.Data.mp_den);
-        Result := Long_Integer (mpz_get_si (Temp));
-        mpz_clear (Temp);
-        return Result;
+        mpz_cdiv_q (Temp.Data, Item.Data.mp_num, Item.Data.mp_den);
+        return Long_Integer (mpz_get_si (Temp.Data));
     end Ceiling;
 
 
@@ -563,22 +596,20 @@ package body Rationals is
            (Item : in Fraction)
         return Long_Integer
     is
-        Temp1, Temp2, Temp3 : mpz_t;
-        Result : Long_Integer;
-    begin
-        mpz_init (Temp1); mpz_init (Temp2); mpz_init (Temp3);
-        --  This method of calculating whether Num mod Den >= Den / 2 is messy
-        mpz_mod (Temp1, Item.Data.mp_num, Item.Data.mp_den);
-        mpz_set_si (Temp3, 2);
-        mpz_fdiv_q (Temp2, Item.Data.mp_den, Temp3);
+        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 (Temp3, Item.Data.mp_num, Item.Data.mp_den);
-        Result := Long_Integer (mpz_get_si (Temp3));
-        if mpz_cmp (Temp1, Temp2) >= 0 then
-            Result := Result + 1;
+        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;
-        mpz_clear (Temp1); mpz_clear (Temp2); mpz_clear (Temp3);
-        return Result;
+        return Long_Integer (mpz_get_si (Result.Data));
     end Round;
 
 
diff --git a/src/rationals.ads b/src/rationals.ads
index f907633..fb7c5b5 100644
--- a/src/rationals.ads
+++ b/src/rationals.ads
@@ -244,6 +244,24 @@ private
 
 
 
+    --  Internal type for temporary data to make some Fraction
+    --  functions easier to show as correct
+    type Bignum is new Ada.Finalization.Controlled with record
+        Data : mpz_t;
+    end record;
+
+    overriding procedure Initialize
+           (This : in out Bignum);
+
+    overriding procedure Adjust
+           (This : in out Bignum);
+
+    overriding procedure Finalize
+           (This : in out Bignum);
+
+
+
+
     pragma Linker_Options ("-lgmp");
 
 
-- 
cgit