Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-18 21:29:19 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fixing printing of x-0.0i (issue #352).

Browse source
This commit is contained in:
Alex Shinn 2016-06-06 22:18:47 +09:00
parent be3c76b43f
commit 8ac14b5f91
4 changed files with 16 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
bignum.c
View file

@ -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); if (! sexp_bignump(a)) return sexp_type_exception(ctx, NULL, SEXP_BIGNUM, a);
sexp_gc_preserve4(ctx, res, rem, tmp, tmpa); sexp_gc_preserve4(ctx, res, rem, tmp, tmpa);
/* initial estimate via flonum, ignoring signs */ /* initial estimate via flonum, ignoring signs */
if (sexp_negativep(a)) { if (sexp_exact_negativep(a)) {
tmpa = sexp_copy_bignum(ctx, NULL, a, 0); tmpa = sexp_copy_bignum(ctx, NULL, a, 0);
a = tmpa; a = tmpa;
sexp_negate(a); sexp_negate(a);
@ -780,13 +780,13 @@ sexp sexp_ratio_round (sexp ctx, sexp a) {
sexp_gc_preserve2(ctx, q, r); sexp_gc_preserve2(ctx, q, r);
q = sexp_quotient(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(a)); q = sexp_quotient(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(a));
if ((sexp_ratio_denominator(a) == SEXP_TWO) && sexp_oddp(q)) { 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 { } else {
r = sexp_remainder(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(a)); r = sexp_remainder(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(a));
r = sexp_mul(ctx, r, SEXP_TWO); 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) 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); sexp_gc_release2(ctx);
return q; return q;
@ -800,7 +800,7 @@ sexp sexp_ratio_floor (sexp ctx, sexp a) {
sexp_gc_var1(q); sexp_gc_var1(q);
sexp_gc_preserve1(ctx, q); sexp_gc_preserve1(ctx, q);
q = sexp_quotient(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(a)); 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); q = sexp_add(ctx, q, SEXP_NEG_ONE);
sexp_gc_release1(ctx); sexp_gc_release1(ctx);
return q; return q;
@ -810,7 +810,7 @@ sexp sexp_ratio_ceiling (sexp ctx, sexp a) {
sexp_gc_var1(q); sexp_gc_var1(q);
sexp_gc_preserve1(ctx, q); sexp_gc_preserve1(ctx, q);
q = sexp_quotient(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(a)); 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); q = sexp_add(ctx, q, SEXP_ONE);
sexp_gc_release1(ctx); sexp_gc_release1(ctx);
return q; return q;

8
include/chibi/sexp.h
View file

@ -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) \ #define sexp_exact_negativep(x) (sexp_fixnump(x) ? (sexp_unbox_fixnum(x) < 0) \
: ((SEXP_USE_BIGNUMS && sexp_bignump(x)) \ : ((SEXP_USE_BIGNUMS && sexp_bignump(x)) \
&& (sexp_bignum_sign(x) < 0))) && (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) || \ #define sexp_negativep(x) (sexp_exact_negativep(x) || \
(sexp_flonump(x) && sexp_flonum_value(x) < 0)) (sexp_flonump(x) && sexp_flonum_value(x) < 0))
#define sexp_positivep(x) (!(sexp_negativep(x))) #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 #if SEXP_USE_BIGNUMS
#define sexp_oddp(x) (sexp_fixnump(x) ? sexp_unbox_fixnum(x) & 1 : \ #define sexp_oddp(x) (sexp_fixnump(x) ? sexp_unbox_fixnum(x) & 1 : \

2
lib/srfi/33/bit.c
View file

@ -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); sexp_gc_preserve3(ctx, res, x2, y2);
x2 = sexp_twos_complement(ctx, x); x2 = sexp_twos_complement(ctx, x);
y2 = sexp_twos_complement(ctx, y); 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)); y2 = sexp_fixnum_to_twos_complement(ctx, y2, sexp_bignum_length(x2));
if (sexp_fixnump(y2)) { if (sexp_fixnump(y2)) {
res = sexp_make_fixnum(sexp_unbox_fixnum(y2) & sexp_bignum_data(x2)[0]); res = sexp_make_fixnum(sexp_unbox_fixnum(y2) & sexp_bignum_data(x2)[0]);

2
sexp.c
View file

@ -1964,7 +1964,7 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
#if SEXP_USE_COMPLEX #if SEXP_USE_COMPLEX
case SEXP_COMPLEX: case SEXP_COMPLEX:
sexp_write(ctx, sexp_complex_real(obj), out); 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_infp(sexp_complex_imag(obj)))
sexp_write_char(ctx, '+', out); sexp_write_char(ctx, '+', out);
if (sexp_complex_imag(obj) == SEXP_NEG_ONE) if (sexp_complex_imag(obj) == SEXP_NEG_ONE)