From 5085164d19b72c6b7760bc156a73cbded02dad2c Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Thu, 22 Sep 2011 23:11:46 +0900 Subject: [PATCH] fixing some #e/#i cases with ratio support --- opt/bignum.c | 25 +++++++++++++++++++++++++ sexp.c | 14 +++++++++++--- 2 files changed, 36 insertions(+), 3 deletions(-) diff --git a/opt/bignum.c b/opt/bignum.c index b7e0fdf8..158477e3 100644 --- a/opt/bignum.c +++ b/opt/bignum.c @@ -471,6 +471,31 @@ double sexp_ratio_to_double (sexp rat) { : sexp_fixnum_to_double(den)); } +sexp sexp_double_to_ratio (sexp ctx, double f) { + int sign, i; + sexp_gc_var4(res, whole, scale, tmp); + if (f == trunc(f)) + return sexp_double_to_bignum(ctx, f); + sexp_gc_preserve4(ctx, res, whole, scale, tmp); + whole = sexp_double_to_bignum(ctx, trunc(f)); + res = sexp_fixnum_to_bignum(ctx, SEXP_ZERO); + scale = SEXP_ONE; + sign = (f < 0 ? -1 : 1); + for (i=0, f=fabs(f-trunc(f)); f != trunc(f) && i < 15; i++) { + res = sexp_bignum_fxmul(ctx, NULL, res, 10, 0); + f = f * 10; + res = sexp_bignum_fxadd(ctx, res, double_10s_digit(f)); + f = f - trunc(f); + scale = sexp_mul(ctx, scale, SEXP_TEN); + } + sexp_bignum_sign(res) = sign; + res = sexp_make_ratio(ctx, res, scale); + res = sexp_ratio_normalize(ctx, res, SEXP_FALSE); + res = sexp_add(ctx, res, whole); + sexp_gc_release4(ctx); + return res; +} + sexp sexp_ratio_add (sexp ctx, sexp a, sexp b) { sexp_gc_var3(res, num, den); sexp_gc_preserve3(ctx, res, num, den); diff --git a/sexp.c b/sexp.c index a52703c3..d7aee6f1 100644 --- a/sexp.c +++ b/sexp.c @@ -1322,7 +1322,7 @@ sexp sexp_make_output_port (sexp ctx, FILE* out, sexp name) { sexp sexp_set_port_fold_case (sexp ctx sexp_api_params(self, n), sexp in, sexp x) { sexp_assert_type(ctx, sexp_iportp, SEXP_IPORT, in); sexp_assert_type(ctx, sexp_booleanp, SEXP_BOOLEAN, x); - sexp_port_fold_casep(in) = x; + sexp_port_fold_casep(in) = sexp_truep(x); return SEXP_VOID; } #endif @@ -2125,12 +2125,20 @@ sexp sexp_read_raw (sexp ctx, sexp in) { case 'e': case 'E': res = sexp_read(ctx, in); if (sexp_flonump(res)) - res = sexp_make_fixnum((sexp_sint_t)sexp_flonum_value(res)); +#if SEXP_USE_RATIOS + res = sexp_double_to_ratio(ctx, sexp_flonum_value(res)); +#else + res = sexp_bignum_normalize(sexp_double_to_bignum(ctx, sexp_flonum_value(res))); +#endif break; case 'i': case 'I': res = sexp_read(ctx, in); - if (sexp_fixnump(res)) + if (sexp_exact_integerp(res)) res = sexp_make_flonum(ctx, sexp_unbox_fixnum(res)); +#if SEXP_USE_RATIOS + else if (sexp_ratiop(res)) + res = sexp_make_flonum(ctx, sexp_ratio_to_double(res)); +#endif break; case 'f': case 'F': case 't': case 'T':