From 8ac14b5f91b705082c1bc3f406d24ac1b823d06d Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 6 Jun 2016 22:18:47 +0900 Subject: [PATCH] Fixing printing of x-0.0i (issue #352). --- bignum.c | 12 ++++++------ include/chibi/sexp.h | 8 ++++++++ lib/srfi/33/bit.c | 2 +- sexp.c | 2 +- 4 files changed, 16 insertions(+), 8 deletions(-) diff --git a/bignum.c b/bignum.c index 6478c5de..a34cea75 100644 --- a/bignum.c +++ b/bignum.c @@ -651,7 +651,7 @@ sexp sexp_bignum_sqrt (sexp ctx, sexp a, sexp* rem_out) { if (! sexp_bignump(a)) return sexp_type_exception(ctx, NULL, SEXP_BIGNUM, a); sexp_gc_preserve4(ctx, res, rem, tmp, tmpa); /* initial estimate via flonum, ignoring signs */ - if (sexp_negativep(a)) { + if (sexp_exact_negativep(a)) { tmpa = sexp_copy_bignum(ctx, NULL, a, 0); a = tmpa; sexp_negate(a); @@ -780,13 +780,13 @@ sexp sexp_ratio_round (sexp ctx, sexp a) { sexp_gc_preserve2(ctx, q, r); q = sexp_quotient(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(a)); if ((sexp_ratio_denominator(a) == SEXP_TWO) && sexp_oddp(q)) { - q = sexp_add(ctx, q, (sexp_positivep(q) ? SEXP_ONE : SEXP_NEG_ONE)); + q = sexp_add(ctx, q, (sexp_exact_positivep(q) ? SEXP_ONE : SEXP_NEG_ONE)); } else { r = sexp_remainder(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(a)); r = sexp_mul(ctx, r, SEXP_TWO); - if (sexp_negativep(r)) {sexp_negate(r);} + if (sexp_exact_negativep(r)) {sexp_negate(r);} if (sexp_unbox_fixnum(sexp_compare(ctx, r, sexp_ratio_denominator(a))) > 0) - q = sexp_add(ctx, q, (sexp_positivep(q) ? SEXP_ONE : SEXP_NEG_ONE)); + q = sexp_add(ctx, q, (sexp_exact_positivep(q) ? SEXP_ONE : SEXP_NEG_ONE)); } sexp_gc_release2(ctx); return q; @@ -800,7 +800,7 @@ sexp sexp_ratio_floor (sexp ctx, sexp a) { sexp_gc_var1(q); sexp_gc_preserve1(ctx, q); q = sexp_quotient(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(a)); - if (sexp_negativep(sexp_ratio_numerator(a))) + if (sexp_exact_negativep(sexp_ratio_numerator(a))) q = sexp_add(ctx, q, SEXP_NEG_ONE); sexp_gc_release1(ctx); return q; @@ -810,7 +810,7 @@ sexp sexp_ratio_ceiling (sexp ctx, sexp a) { sexp_gc_var1(q); sexp_gc_preserve1(ctx, q); q = sexp_quotient(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(a)); - if (sexp_positivep(sexp_ratio_numerator(a))) + if (sexp_exact_positivep(sexp_ratio_numerator(a))) q = sexp_add(ctx, q, SEXP_ONE); sexp_gc_release1(ctx); return q; diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 5d467460..90cbbb53 100755 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -888,9 +888,17 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x); #define sexp_exact_negativep(x) (sexp_fixnump(x) ? (sexp_unbox_fixnum(x) < 0) \ : ((SEXP_USE_BIGNUMS && sexp_bignump(x)) \ && (sexp_bignum_sign(x) < 0))) +#define sexp_exact_positivep(x) (sexp_fixnump(x) ? (sexp_unbox_fixnum(x) > 0) \ + : ((SEXP_USE_BIGNUMS && sexp_bignump(x)) \ + && (sexp_bignum_sign(x) > 0))) #define sexp_negativep(x) (sexp_exact_negativep(x) || \ (sexp_flonump(x) && sexp_flonum_value(x) < 0)) #define sexp_positivep(x) (!(sexp_negativep(x))) +#define sexp_pedantic_negativep(x) (sexp_exact_negativep(x) || \ + (sexp_flonump(x) && \ + ((sexp_flonum_value(x) < 0) || \ + (sexp_flonum_value(x) == 0 && \ + 1.0 / sexp_flonum_value(x) < 0)))) #if SEXP_USE_BIGNUMS #define sexp_oddp(x) (sexp_fixnump(x) ? sexp_unbox_fixnum(x) & 1 : \ diff --git a/lib/srfi/33/bit.c b/lib/srfi/33/bit.c index be4b9fe1..06c63343 100644 --- a/lib/srfi/33/bit.c +++ b/lib/srfi/33/bit.c @@ -59,7 +59,7 @@ sexp sexp_bit_and (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) { sexp_gc_preserve3(ctx, res, x2, y2); x2 = sexp_twos_complement(ctx, x); y2 = sexp_twos_complement(ctx, y); - if (sexp_fixnump(y2) && sexp_negativep(y2)) + if (sexp_fixnump(y2) && sexp_unbox_fixnum(y2) < 0) y2 = sexp_fixnum_to_twos_complement(ctx, y2, sexp_bignum_length(x2)); if (sexp_fixnump(y2)) { res = sexp_make_fixnum(sexp_unbox_fixnum(y2) & sexp_bignum_data(x2)[0]); diff --git a/sexp.c b/sexp.c index 7f2bb666..aba655fb 100644 --- a/sexp.c +++ b/sexp.c @@ -1964,7 +1964,7 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) { #if SEXP_USE_COMPLEX case SEXP_COMPLEX: sexp_write(ctx, sexp_complex_real(obj), out); - if (!sexp_negativep(sexp_complex_imag(obj)) + if (!sexp_pedantic_negativep(sexp_complex_imag(obj)) && !sexp_infp(sexp_complex_imag(obj))) sexp_write_char(ctx, '+', out); if (sexp_complex_imag(obj) == SEXP_NEG_ONE)