Reimplement 'inexact->exact' to avoid mpq functions.

* libguile/numbers.c (scm_inexact_to_exact): Implement conversion of a
  double to an exact rational without using the mpq functions.

* test-suite/tests/numbers.test (dbl-mant-dig): Simplify initializer.
  (dbl-epsilon, dbl-min-exp): New variables.
  ("inexact->exact"): Add tests.  Fix broken "2.0**i to exact and back"
  test, and change it to "2.0**i to exact", to avoid use of
  'exact->inexact'.

1 files changed, 27 insertions, 14 deletions

diff --git a/libguile/numbers.c b/libguile/numbers.c
index fa55b4f9e..f0f7236dd 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -9109,22 +9109,35 @@ SCM_PRIMITIVE_GENERIC (scm_inexact_to_exact, "inexact->exact", 1, 0, 0,
 
       if (!SCM_LIKELY (DOUBLE_IS_FINITE (val)))
 	SCM_OUT_OF_RANGE (1, z);
+      else if (val == 0.0)
+        return SCM_INUM0;
       else
 	{
-	  mpq_t frac;
-	  SCM q;
-	  
-	  mpq_init (frac);
-	  mpq_set_d (frac, val);
-	  q = scm_i_make_ratio_already_reduced
-	    (scm_i_mpz2num (mpq_numref (frac)),
-	     scm_i_mpz2num (mpq_denref (frac)));
-
-	  /* When scm_i_make_ratio throws, we leak the memory allocated
-	     for frac...
-	   */
-	  mpq_clear (frac);
-	  return q;
+          int expon;
+          SCM numerator;
+
+          numerator = scm_i_dbl2big (ldexp (frexp (val, &expon),
+                                            DBL_MANT_DIG));
+          expon -= DBL_MANT_DIG;
+          if (expon < 0)
+            {
+              int shift = mpz_scan1 (SCM_I_BIG_MPZ (numerator), 0);
+
+              if (shift > -expon)
+                shift = -expon;
+              mpz_fdiv_q_2exp (SCM_I_BIG_MPZ (numerator),
+                               SCM_I_BIG_MPZ (numerator),
+                               shift);
+              expon += shift;
+            }
+          numerator = scm_i_normbig (numerator);
+          if (expon < 0)
+            return scm_i_make_ratio_already_reduced
+              (numerator, left_shift_exact_integer (SCM_INUM1, -expon));
+          else if (expon > 0)
+            return left_shift_exact_integer (numerator, expon);
+          else
+            return numerator;
 	}
     }
 }