From fcd504b656a47ef0b92d916c2503214ed0220002 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Mon, 4 Mar 2013 18:42:27 -0500 Subject: [PATCH 07/10] 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. --- libguile/numbers.c | 41 +++++++++++++++++++++++++++-------------- 1 file changed, 27 insertions(+), 14 deletions(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index e9059a3..5feed70 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -9085,22 +9085,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; } } } -- 1.7.10.4