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

initial exact ratio support

Browse source
This commit is contained in:
Alex Shinn 2011-07-31 17:34:52 +09:00
parent 56e11e6264
commit 6202f9c1ff
9 changed files with 532 additions and 133 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
eval.c
View file

@ -1142,6 +1142,13 @@ sexp sexp_register_optimization (sexp ctx sexp_api_params(self, n), sexp f, sexp
#define maybe_convert_bignum(z)
#endif
#if SEXP_USE_RATIOS
#define maybe_convert_ratio(z) \
else if (sexp_ratiop(z)) d = sexp_ratio_to_double(z);
#else
#define maybe_convert_ratio(z)
#endif
#define define_math_op(name, cname) \
static sexp name (sexp ctx sexp_api_params(self, n), sexp z) { \
double d; \
@ -1149,6 +1156,7 @@ sexp sexp_register_optimization (sexp ctx sexp_api_params(self, n), sexp f, sexp
d = sexp_flonum_value(z); \
else if (sexp_fixnump(z)) \
d = (double)sexp_unbox_fixnum(z); \
maybe_convert_ratio(z) \
maybe_convert_bignum(z) \
else \
return sexp_type_exception(ctx, self, SEXP_NUMBER, z); \
@ -1243,6 +1251,17 @@ static sexp sexp_expt_op (sexp ctx sexp_api_params(self, n), sexp x, sexp e) {
return res;
}
#if SEXP_USE_RATIOS
static sexp sexp_ratio_numerator_op (sexp ctx sexp_api_params(self, n), sexp rat) {
sexp_assert_type(ctx, sexp_ratiop, SEXP_RATIO, rat);
return sexp_ratio_numerator(rat);
}
static sexp sexp_ratio_denominator_op (sexp ctx sexp_api_params(self, n), sexp rat) {
sexp_assert_type(ctx, sexp_ratiop, SEXP_RATIO, rat);
return sexp_ratio_denominator(rat);
}
#endif
static sexp sexp_string_cmp_op (sexp ctx sexp_api_params(self, n), sexp str1, sexp str2, sexp ci) {
sexp_sint_t len1, len2, len, diff;
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, str1);
@ -1785,6 +1804,9 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
#endif
#if SEXP_USE_AUTO_FORCE
sexp_push(ctx, tmp, sym=sexp_intern(ctx, "auto-force", -1));
#endif
#if SEXP_USE_RATIOS
sexp_push(ctx, tmp, sym=sexp_intern(ctx, "ratios", -1));
#endif
sexp_push(ctx, tmp, sym=sexp_intern(ctx, "chibi", -1));
sexp_env_define(ctx, e, sym=sexp_intern(ctx, "*features*", -1), tmp);

7
include/chibi/bignum.h
View file

@ -1,5 +1,5 @@
/* bignum.h -- header for bignum utilities */
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
/* Copyright (c) 2009-2011 Alex Shinn. All rights reserved. */
/* BSD-style license: http://synthcode.com/license.txt */
#ifndef SEXP_BIGNUM_H
@ -38,6 +38,11 @@ sexp sexp_mul (sexp ctx, sexp a, sexp b);
sexp sexp_div (sexp ctx, sexp a, sexp b);
sexp sexp_quotient (sexp ctx, sexp a, sexp b);
sexp sexp_remainder (sexp ctx, sexp a, sexp b);
#if SEXP_USE_RATIOS
double sexp_ratio_to_double (sexp rat);
sexp sexp_make_ratio (sexp ctx, sexp num, sexp den);
sexp sexp_ratio_normalize (sexp ctx, sexp rat, sexp in);
#endif
#endif /* ! SEXP_BIGNUM_H */

24
include/chibi/features.h
View file

@ -117,6 +117,13 @@
/* in opt/bignum.c. */
/* #define SEXP_USE_BIGNUMS 0 */
/* uncomment this if you don't want exact ratio support */
/* Ratios are part of the bignum library and imply bignums. */
/* #define SEXP_USE_RATIOS 0 */
/* uncomment this if you don't want imaginary number support */
/* #define SEXP_USE_COMPLEX 0 */
/* uncomment this if you don't want 1## style approximate digits */
/* #define SEXP_USE_PLACEHOLDER_DIGITS 0 */
@ -354,6 +361,19 @@
#define SEXP_USE_EXTENDED_FCALL ! SEXP_USE_NO_FEATURES
#endif
#ifndef SEXP_USE_RATIOS
#define SEXP_USE_RATIOS ! SEXP_USE_NO_FEATURES
#endif
/* #ifndef SEXP_USE_COMPLEX */
/* #define SEXP_USE_COMPLEX ! SEXP_USE_NO_FEATURES */
/* #endif */
#define SEXP_USE_COMPLEX 0
#ifndef SEXP_USE_BIGNUMS
#define SEXP_USE_BIGNUMS (SEXP_USE_RATIOS || SEXP_USE_COMPLEX)
#endif
#ifndef SEXP_USE_FLONUMS
#define SEXP_USE_FLONUMS ! SEXP_USE_NO_FEATURES
#endif
@ -378,10 +398,6 @@
#define SEXP_PLACEHOLDER_DIGIT '#'
#endif
#ifndef SEXP_USE_BIGNUMS
#define SEXP_USE_BIGNUMS ! SEXP_USE_NO_FEATURES
#endif
#ifndef SEXP_USE_MATH
#define SEXP_USE_MATH SEXP_USE_FLONUMS && ! SEXP_USE_NO_FEATURES
#endif

28
include/chibi/sexp.h
View file

@ -103,6 +103,8 @@ enum sexp_types {
SEXP_VECTOR,
SEXP_FLONUM,
SEXP_BIGNUM,
SEXP_RATIO,
SEXP_COMPLEX,
SEXP_IPORT,
SEXP_OPORT,
SEXP_EXCEPTION,
@ -300,6 +302,12 @@ struct sexp_struct {
sexp_uint_t length;
sexp_uint_t data[];
} bignum;
struct {
sexp numerator, denominator;
} ratio;
struct {
sexp real, imag;
} complex;
struct {
sexp_uint_t length;
void *value;
@ -553,6 +561,8 @@ sexp sexp_make_flonum(sexp ctx, double f);
#define sexp_iportp(x) (sexp_check_tag(x, SEXP_IPORT))
#define sexp_oportp(x) (sexp_check_tag(x, SEXP_OPORT))
#define sexp_bignump(x) (sexp_check_tag(x, SEXP_BIGNUM))
#define sexp_ratiop(x) (sexp_check_tag(x, SEXP_RATIO))
#define sexp_complexp(x) (sexp_check_tag(x, SEXP_COMPLEX))
#define sexp_cpointerp(x) (sexp_check_tag(x, SEXP_CPOINTER))
#define sexp_exceptionp(x) (sexp_check_tag(x, SEXP_EXCEPTION))
#define sexp_procedurep(x) (sexp_check_tag(x, SEXP_PROCEDURE))
@ -646,6 +656,18 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
#define sexp_numberp(x) sexp_exact_integerp(x)
#endif
#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_negativep(x) (sexp_exact_negativep(x) || \
(sexp_flonump(x) && sexp_flonum_value(x) < 0))
#define sexp_negate(x) \
if (sexp_bignump(x)) \
sexp_bignum_sign(x) = -sexp_bignum_sign(x); \
else if (sexp_fixnump(x)) \
x = sexp_fx_neg(x);
#if SEXP_USE_FLONUMS || SEXP_USE_BIGNUMS
#define sexp_uint_value(x) ((sexp_uint_t)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignum_data(x)[0]))
#define sexp_sint_value(x) ((sexp_sint_t)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignum_sign(x)*sexp_bignum_data(x)[0]))
@ -723,6 +745,12 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
#define sexp_port_offset(p) (sexp_pred_field(p, port, sexp_portp, offset))
#define sexp_port_flags(p) (sexp_pred_field(p, port, sexp_portp, flags))
#define sexp_ratio_numerator(q) (sexp_pred_field(q, ratio, sexp_ratiop, numerator))
#define sexp_ratio_denominator(q) (sexp_pred_field(q, ratio, sexp_ratiop, denominator))
#define sexp_complex_real(q) (sexp_pred_field(q, complex, sexp_complexp, real))
#define sexp_complex_imag(q) (sexp_pred_field(q, complex, sexp_complexp, imag))
#define sexp_exception_kind(x) (sexp_field(x, exception, SEXP_EXCEPTION, kind))
#define sexp_exception_message(x) (sexp_field(x, exception, SEXP_EXCEPTION, message))
#define sexp_exception_irritants(x) (sexp_field(x, exception, SEXP_EXCEPTION, irritants))

187
lib/init.scm
View file

@ -350,6 +350,26 @@
;; string utils
(define (digit-char n)
(if (<= n 9)
(integer->char (+ n (char->integer #\0)))
(integer->char (+ (- n 10) (char->integer #\A)))))
(define (digit-value ch)
(if (char-numeric? ch)
(- (char->integer ch) (char->integer #\0))
(and (<= 65 (char->integer (char-upcase ch)) 70)
(- (char->integer (char-upcase ch)) 55))))
(define (number->string num . o)
(if (if (null? o) #t (eq? 10 (car o)))
(call-with-output-string (lambda (out) (write num out)))
(let lp ((n (abs num)) (d (car o)) (res '()))
(if (> n 0)
(lp (quotient n d) d (cons (digit-char (remainder n d)) res))
(if (null? res)
"0"
(list->string (if (negative? num) (cons #\- res) res)))))))
(define (symbol->string sym)
(call-with-output-string (lambda (out) (write sym out))))
@ -413,93 +433,6 @@
(define (find pred ls)
(cond ((find-tail pred ls) => car) (else #f)))
;; math utils
(define (number? x) (if (fixnum? x) #t (if (bignum? x) #t (flonum? x))))
(define complex? number?)
(define rational? number?)
(define real? number?)
(define (exact? x) (if (fixnum? x) #t (bignum? x)))
(define inexact? flonum?)
(define (exact-integer? x) (if (fixnum? x) #t (bignum? x)))
(define (integer? x)
(if (exact-integer? x) #t (and (flonum? x) (= x (truncate x)))))
(define (exact-integer-sqrt x)
(let ((res (sqrt x)))
(if (exact? res)
(values res 0)
(let ((res (inexact->exact (truncate res))))
(values res (- x (* res res)))))))
(define (zero? x) (= x 0))
(define (positive? x) (> x 0))
(define (negative? x) (< x 0))
(define (even? n) (= (remainder n 2) 0))
(define (odd? n) (= (remainder n 2) 1))
(define (abs x) (if (< x 0) (- x) x))
(define (numerator x)
(if (integer? x) x (numerator (* x 10))))
(define (denominator x)
(if (exact? x)
1
(let lp ((x x) (r 1.0)) (if (integer? x) r (lp (* x 10) (* r 10))))))
(define (modulo a b)
(let ((res (remainder a b)))
(if (< b 0)
(if (<= res 0) res (+ res b))
(if (>= res 0) res (+ res b)))))
(define (gcd a b)
(if (= b 0)
(abs a)
(gcd b (remainder a b))))
(define (lcm a b)
(abs (quotient (* a b) (gcd a b))))
(define (max x . rest)
(let lp ((hi x) (ls rest))
(if (null? ls)
hi
(lp (if (> (car ls) hi) (car ls) hi) (cdr ls)))))
(define (min x . rest)
(let lp ((lo x) (ls rest))
(if (null? ls)
lo
(lp (if (< (car ls) lo) (car ls) lo) (cdr ls)))))
(define (real-part z) z)
(define (imag-part z) 0.0)
(define magnitude abs)
(define (angle z) (if (< z 0) 3.141592653589793 0))
(define (atan x . o) (if (null? o) (atan1 x) (atan1 (/ x (car o)))))
(define (digit-char n)
(if (<= n 9)
(integer->char (+ n (char->integer #\0)))
(integer->char (+ (- n 10) (char->integer #\A)))))
(define (digit-value ch)
(if (char-numeric? ch)
(- (char->integer ch) (char->integer #\0))
(and (<= 65 (char->integer (char-upcase ch)) 70)
(- (char->integer (char-upcase ch)) 55))))
(define (number->string num . o)
(if (if (null? o) #t (eq? 10 (car o)))
(call-with-output-string (lambda (out) (write num out)))
(let lp ((n (abs num)) (d (car o)) (res '()))
(if (> n 0)
(lp (quotient n d) d (cons (digit-char (remainder n d)) res))
(if (null? res)
"0"
(list->string (if (negative? num) (cons #\- res) res)))))))
;; vector utils
(define (list->vector ls)
@ -955,6 +888,86 @@
result)))
(define (force x) (if (procedure? x) (x) x))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; math utils
(cond-expand
(ratios
(define (exact? x) (if (fixnum? x) #t (if (bignum? x) #t (ratio? x))))
(define (numerator x)
(if (ratio? x)
(ratio-numerator x)
(if (integer? x) x (numerator (* x 10)))))
(define (denominator x)
(if (exact? x)
(if (ratio? x) (ratio-denominator x) 1)
(let lp ((x x) (r 1.0)) (if (integer? x) r (lp (* x 10) (* r 10)))))))
(else
(define (exact? x) (if (fixnum? x) #t (bignum? x)))
(define (numerator x)
(if (integer? x) x (numerator (* x 10))))
(define (denominator x)
(if (exact? x)
1
(let lp ((x x) (r 1.0)) (if (integer? x) r (lp (* x 10) (* r 10))))))))
(define inexact? flonum?)
(define (exact-integer? x) (if (fixnum? x) #t (bignum? x)))
(define (integer? x)
(if (exact-integer? x) #t (and (flonum? x) (= x (truncate x)))))
(define (number? x) (if (inexact? x) #t (exact? x)))
(define complex? number?)
(define rational? number?)
(define real? number?)
(define (exact-integer-sqrt x)
(let ((res (sqrt x)))
(if (exact? res)
(values res 0)
(let ((res (inexact->exact (truncate res))))
(values res (- x (* res res)))))))
(define (zero? x) (= x 0))
(define (positive? x) (> x 0))
(define (negative? x) (< x 0))
(define (even? n) (= (remainder n 2) 0))
(define (odd? n) (= (remainder n 2) 1))
(define (abs x) (if (< x 0) (- x) x))
(define (modulo a b)
(let ((res (remainder a b)))
(if (< b 0)
(if (<= res 0) res (+ res b))
(if (>= res 0) res (+ res b)))))
(define (gcd a b)
(if (= b 0)
(abs a)
(gcd b (remainder a b))))
(define (lcm a b)
(abs (quotient (* a b) (gcd a b))))
(define (max x . rest)
(let lp ((hi x) (ls rest))
(if (null? ls)
hi
(lp (if (> (car ls) hi) (car ls) hi) (cdr ls)))))
(define (min x . rest)
(let lp ((lo x) (ls rest))
(if (null? ls)
lo
(lp (if (< (car ls) lo) (car ls) lo) (cdr ls)))))
(define (real-part z) z)
(define (imag-part z) 0.0)
(define magnitude abs)
(define (angle z) (if (< z 0) 3.141592653589793 0))
(define (atan x . o) (if (null? o) (atan1 x) (atan1 (/ x (car o)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; string cursors

5
opcodes.c
View file

@ -82,6 +82,11 @@ _FN1(_I(SEXP_BOOLEAN), _I(SEXP_OBJECT), "flonum?", 0, sexp_flonump_op),
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "flonum?", _I(SEXP_FLONUM), 0),
#endif
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "bignum?", _I(SEXP_BIGNUM), 0),
#if SEXP_USE_RATIOS
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "ratio?", _I(SEXP_RATIO), 0),
_FN1(_I(SEXP_FIXNUM), _I(SEXP_RATIO), "ratio-numerator", 0, sexp_ratio_numerator_op),
_FN1(_I(SEXP_FIXNUM), _I(SEXP_RATIO), "ratio-denominator", 0, sexp_ratio_denominator_op),
#endif
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "closure?", _I(SEXP_PROCEDURE), 0),
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "opcode?", _I(SEXP_OPCODE), 0),
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "input-port?", _I(SEXP_IPORT), 0),

281
opt/bignum.c
View file

@ -1,15 +1,9 @@
/* bignum.c -- bignum support */
/* Copyright (c) 2009-2010 Alex Shinn. All rights reserved. */
/* Copyright (c) 2009-2011 Alex Shinn. All rights reserved. */
/* BSD-style license: http://synthcode.com/license.txt */
#define SEXP_INIT_BIGNUM_SIZE 2
#define sexp_negate(x) \
if (sexp_bignump(x)) \
sexp_bignum_sign(x) = -sexp_bignum_sign(x); \
else if (sexp_fixnump(x)) \
x = sexp_fx_neg(x);
sexp sexp_make_bignum (sexp ctx, sexp_uint_t len) {
sexp_uint_t size = sexp_sizeof(bignum) + len*sizeof(sexp_uint_t);
sexp res = sexp_alloc_tagged(ctx, size, SEXP_BIGNUM);
@ -229,6 +223,13 @@ sexp sexp_read_bignum (sexp ctx, sexp in, sexp_uint_t init,
if (c!='.') sexp_push_char(ctx, c, in); /* push the e back */
res = sexp_read_float_tail(ctx, in, sexp_bignum_to_double(res), (sign==-1));
}
#if SEXP_USE_RATIOS
} else if (c=='/') {
res = sexp_bignum_normalize(res);
res = sexp_make_ratio(ctx, res, SEXP_ONE);
sexp_ratio_denominator(res) = sexp_read_number(ctx, in, 10);
res = sexp_ratio_normalize(ctx, res, in);
#endif
} else if ((c!=EOF) && ! is_separator(c)) {
res = sexp_read_error(ctx, "invalid numeric syntax",
sexp_make_character(c), in);
@ -458,13 +459,71 @@ sexp sexp_bignum_expt (sexp ctx, sexp a, sexp b) {
return sexp_bignum_normalize(res);
}
/************************ ratios ******************************/
#if SEXP_USE_RATIOS
double sexp_ratio_to_double (sexp rat) {
sexp num = sexp_ratio_numerator(rat), den = sexp_ratio_denominator(rat);
return (sexp_bignump(num) ? sexp_bignum_to_double(num)
: sexp_fixnum_to_double(num))
/ (sexp_bignump(den) ? sexp_bignum_to_double(den)
: sexp_fixnum_to_double(den));
}
sexp sexp_ratio_add (sexp ctx, sexp a, sexp b) {
sexp_gc_var3(res, num, den);
sexp_gc_preserve3(ctx, res, num, den);
num = sexp_mul(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(b));
den = sexp_mul(ctx, sexp_ratio_numerator(b), sexp_ratio_denominator(a));
num = sexp_add(ctx, num, den);
den = sexp_mul(ctx, sexp_ratio_denominator(a), sexp_ratio_denominator(b));
res = sexp_make_ratio(ctx, num, den);
sexp_gc_release3(ctx);
return sexp_ratio_normalize(ctx, res, SEXP_FALSE);
}
sexp sexp_ratio_mul (sexp ctx, sexp a, sexp b) {
sexp_gc_var3(res, num, den);
sexp_gc_preserve3(ctx, res, num, den);
num = sexp_mul(ctx, sexp_ratio_numerator(a), sexp_ratio_numerator(b));
den = sexp_mul(ctx, sexp_ratio_denominator(a), sexp_ratio_denominator(b));
res = sexp_make_ratio(ctx, num, den);
sexp_gc_release3(ctx);
return sexp_ratio_normalize(ctx, res, SEXP_FALSE);
}
sexp sexp_ratio_div (sexp ctx, sexp a, sexp b) {
sexp_gc_var3(res, num, den);
sexp_gc_preserve3(ctx, res, num, den);
num = sexp_mul(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(b));
den = sexp_mul(ctx, sexp_ratio_denominator(a), sexp_ratio_numerator(b));
res = sexp_make_ratio(ctx, num, den);
sexp_gc_release3(ctx);
return sexp_ratio_normalize(ctx, res, SEXP_FALSE);
}
sexp sexp_ratio_compare (sexp ctx, sexp a, sexp b) {
sexp_gc_var2(a2, b2);
sexp_gc_preserve2(ctx, a2, b2);
a2 = sexp_mul(ctx, sexp_ratio_numerator(a), sexp_ratio_denominator(b));
b2 = sexp_mul(ctx, sexp_ratio_numerator(b), sexp_ratio_denominator(a));
a2 = sexp_compare(ctx, a2, b2);
sexp_gc_release2(ctx);
return a2;
}
#endif
/****************** generic arithmetic ************************/
enum sexp_number_types {
SEXP_NUM_NOT = 0,
SEXP_NUM_FIX,
SEXP_NUM_FLO,
SEXP_NUM_BIG
SEXP_NUM_BIG,
SEXP_NUM_RAT,
SEXP_NUM_CPX,
};
enum sexp_number_combs {
@ -472,22 +531,68 @@ enum sexp_number_combs {
SEXP_NUM_NOT_FIX,
SEXP_NUM_NOT_FLO,
SEXP_NUM_NOT_BIG,
#if SEXP_USE_RATIOS
SEXP_NUM_NOT_RAT,
#endif
#if SEXP_USE_COMPLEX
SEXP_NUM_NOT_CPX,
#endif
SEXP_NUM_FIX_NOT,
SEXP_NUM_FIX_FIX,
SEXP_NUM_FIX_FLO,
SEXP_NUM_FIX_BIG,
#if SEXP_USE_RATIOS
SEXP_NUM_FIX_RAT,
#endif
#if SEXP_USE_COMPLEX
SEXP_NUM_FIX_CPX,
#endif
SEXP_NUM_FLO_NOT,
SEXP_NUM_FLO_FIX,
SEXP_NUM_FLO_FLO,
SEXP_NUM_FLO_BIG,
#if SEXP_USE_RATIOS
SEXP_NUM_FLO_RAT,
#endif
#if SEXP_USE_COMPLEX
SEXP_NUM_FLO_CPX,
#endif
SEXP_NUM_BIG_NOT,
SEXP_NUM_BIG_FIX,
SEXP_NUM_BIG_FLO,
SEXP_NUM_BIG_BIG
SEXP_NUM_BIG_BIG,
#if SEXP_USE_RATIOS
SEXP_NUM_BIG_RAT,
#endif
#if SEXP_USE_COMPLEX
SEXP_NUM_BIG_CPX,
#endif
#if SEXP_USE_RATIOS
SEXP_NUM_RAT_NOT,
SEXP_NUM_RAT_FIX,
SEXP_NUM_RAT_FLO,
SEXP_NUM_RAT_BIG,
SEXP_NUM_RAT_RAT,
#if SEXP_USE_COMPLEX
SEXP_NUM_RAT_CPX,
#endif
#endif
#if SEXP_USE_COMPLEX
SEXP_NUM_CPX_NOT,
SEXP_NUM_CPX_FIX,
SEXP_NUM_CPX_FLO,
SEXP_NUM_CPX_BIG,
#if SEXP_USE_RATIOS
SEXP_NUM_CPX_RAT,
#endif
SEXP_NUM_CPX_CPX,
#endif
};
static int sexp_number_types[] =
{0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 2, 3, 0, 0, 0, 0};
{0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 2, 3, 4, 5, 0, 0};
#define SEXP_NUM_NUMBER_TYPES (4 + SEXP_USE_RATIOS + SEXP_USE_COMPLEX)
static int sexp_number_type (sexp a) {
return sexp_pointerp(a) ? sexp_number_types[sexp_pointer_tag(a)&15]
@ -500,10 +605,15 @@ static int sexp_number_type (sexp a) {
sexp sexp_add (sexp ctx, sexp a, sexp b) {
int at=sexp_number_type(a), bt=sexp_number_type(b), t;
sexp r=SEXP_VOID;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
if (at > bt) {r=a; a=b; b=r; t=at; at=bt; bt=t;}
switch ((at << 2) + bt) {
switch ((at * SEXP_NUM_NUMBER_TYPES) + bt) {
case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX:
case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG:
#if SEXP_USE_RATIOS
case SEXP_NUM_NOT_RAT:
#endif
r = sexp_type_exception(ctx, NULL, SEXP_NUMBER, a);
break;
case SEXP_NUM_FIX_FIX:
@ -524,21 +634,40 @@ sexp sexp_add (sexp ctx, sexp a, sexp b) {
case SEXP_NUM_BIG_BIG:
r = sexp_bignum_normalize(sexp_bignum_add(ctx, NULL, b, a));
break;
#if SEXP_USE_RATIOS
case SEXP_NUM_FLO_RAT:
r = sexp_make_flonum(ctx, sexp_flonum_value(a) + sexp_ratio_to_double(b));
break;
case SEXP_NUM_FIX_RAT:
case SEXP_NUM_BIG_RAT:
a = tmp = sexp_make_ratio(ctx, a, SEXP_ONE);
/* ... FALLTHROUGH ... */
case SEXP_NUM_RAT_RAT:
r = sexp_ratio_add(ctx, a, b);
break;
#endif
}
sexp_gc_release1(ctx);
return r;
}
sexp sexp_sub (sexp ctx, sexp a, sexp b) {
int at=sexp_number_type(a), bt=sexp_number_type(b);
int at=sexp_number_type(a), bt=sexp_number_type(b), negatep=0;
sexp r=SEXP_VOID;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
switch ((at << 2) + bt) {
sexp_gc_var2(tmp1, tmp2);
sexp_gc_preserve2(ctx, tmp1, tmp2);
switch ((at * SEXP_NUM_NUMBER_TYPES) + bt) {
case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX:
case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG:
#if SEXP_USE_RATIOS
case SEXP_NUM_NOT_RAT:
#endif
r = sexp_type_exception(ctx, NULL, SEXP_NUMBER, a);
break;
case SEXP_NUM_FIX_NOT: case SEXP_NUM_FLO_NOT: case SEXP_NUM_BIG_NOT:
#if SEXP_USE_RATIOS
case SEXP_NUM_RAT_NOT:
#endif
r = sexp_type_exception(ctx, NULL, SEXP_NUMBER, b);
break;
case SEXP_NUM_FIX_FIX:
@ -548,8 +677,8 @@ sexp sexp_sub (sexp ctx, sexp a, sexp b) {
r = sexp_make_flonum(ctx, sexp_fixnum_to_double(a)-sexp_flonum_value(b));
break;
case SEXP_NUM_FIX_BIG:
tmp = sexp_fixnum_to_bignum(ctx, a);
r = sexp_bignum_sub(ctx, NULL, b, tmp);
tmp1 = sexp_fixnum_to_bignum(ctx, a);
r = sexp_bignum_sub(ctx, NULL, b, tmp1);
sexp_negate(r);
r = sexp_bignum_normalize(r);
break;
@ -563,8 +692,8 @@ sexp sexp_sub (sexp ctx, sexp a, sexp b) {
r = sexp_make_flonum(ctx, sexp_flonum_value(a) - sexp_bignum_to_double(b));
break;
case SEXP_NUM_BIG_FIX:
tmp = sexp_fixnum_to_bignum(ctx, b);
r = sexp_bignum_normalize(sexp_bignum_sub(ctx, NULL, a, tmp));
tmp1 = sexp_fixnum_to_bignum(ctx, b);
r = sexp_bignum_normalize(sexp_bignum_sub(ctx, NULL, a, tmp1));
break;
case SEXP_NUM_BIG_FLO:
r = sexp_make_flonum(ctx, sexp_bignum_to_double(a) - sexp_flonum_value(b));
@ -572,18 +701,52 @@ sexp sexp_sub (sexp ctx, sexp a, sexp b) {
case SEXP_NUM_BIG_BIG:
r = sexp_bignum_normalize(sexp_bignum_sub(ctx, NULL, a, b));
break;
#if SEXP_USE_RATIOS
case SEXP_NUM_FLO_RAT:
r = sexp_make_flonum(ctx, sexp_flonum_value(a) - sexp_ratio_to_double(b));
break;
case SEXP_NUM_RAT_FLO:
r = sexp_make_flonum(ctx, sexp_ratio_to_double(b) - sexp_flonum_value(a));
break;
case SEXP_NUM_RAT_FIX:
case SEXP_NUM_RAT_BIG:
tmp1 = a; a = b; b = tmp1;
negatep = 1;
/* ... FALLTHROUGH ... */
case SEXP_NUM_FIX_RAT:
case SEXP_NUM_BIG_RAT:
a = tmp1 = sexp_make_ratio(ctx, a, SEXP_ONE);
/* ... FALLTHROUGH ... */
case SEXP_NUM_RAT_RAT:
tmp2 = sexp_make_ratio(ctx, sexp_ratio_numerator(b), sexp_ratio_denominator(b));
sexp_negate(sexp_ratio_numerator(tmp2));
r = sexp_ratio_add(ctx, a, tmp2);
if (negatep) {
if (sexp_ratiop(r)) {
sexp_negate(sexp_ratio_numerator(r));
} else {
sexp_negate(r);
}
sexp_gc_release1(ctx);
}
break;
#endif
}
sexp_gc_release2(ctx);
return r;
}
sexp sexp_mul (sexp ctx, sexp a, sexp b) {
int at=sexp_number_type(a), bt=sexp_number_type(b), t;
sexp r=SEXP_VOID;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
if (at > bt) {r=a; a=b; b=r; t=at; at=bt; bt=t;}
switch ((at << 2) + bt) {
switch ((at * SEXP_NUM_NUMBER_TYPES) + bt) {
case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX:
case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG:
#if SEXP_USE_RATIOS
case SEXP_NUM_NOT_RAT:
#endif
r = sexp_type_exception(ctx, NULL, SEXP_NUMBER, a);
break;
case SEXP_NUM_FIX_FIX:
@ -605,7 +768,20 @@ sexp sexp_mul (sexp ctx, sexp a, sexp b) {
case SEXP_NUM_BIG_BIG:
r = sexp_bignum_mul(ctx, NULL, a, b);
break;
#if SEXP_USE_RATIOS
case SEXP_NUM_FLO_RAT:
r = sexp_make_flonum(ctx, sexp_flonum_value(a) * sexp_ratio_to_double(b));
break;
case SEXP_NUM_FIX_RAT:
case SEXP_NUM_BIG_RAT:
a = tmp = sexp_make_ratio(ctx, a, SEXP_ONE);
/* ... FALLTHROUGH ... */
case SEXP_NUM_RAT_RAT:
r = sexp_ratio_mul(ctx, a, b);
break;
#endif
}
sexp_gc_release1(ctx);
return r;
}
@ -615,12 +791,18 @@ sexp sexp_div (sexp ctx, sexp a, sexp b) {
sexp r=SEXP_VOID;
sexp_gc_var2(tmp, rem);
sexp_gc_preserve2(ctx, tmp, rem);
switch ((at << 2) + bt) {
switch ((at * SEXP_NUM_NUMBER_TYPES) + bt) {
case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX:
case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG:
#if SEXP_USE_RATIOS
case SEXP_NUM_NOT_RAT:
#endif
r = sexp_type_exception(ctx, NULL, SEXP_NUMBER, a);
break;
case SEXP_NUM_FIX_NOT: case SEXP_NUM_FLO_NOT: case SEXP_NUM_BIG_NOT:
#if SEXP_USE_RATIOS
case SEXP_NUM_RAT_NOT:
#endif
r = sexp_type_exception(ctx, NULL, SEXP_NUMBER, b);
break;
case SEXP_NUM_FIX_FIX:
@ -657,6 +839,25 @@ sexp sexp_div (sexp ctx, sexp a, sexp b) {
case SEXP_NUM_BIG_FLO:
r = sexp_make_flonum(ctx, sexp_bignum_to_double(a) / sexp_flonum_value(b));
break;
#if SEXP_USE_RATIOS
case SEXP_NUM_FLO_RAT:
r = sexp_make_flonum(ctx, sexp_flonum_value(a) / sexp_ratio_to_double(b));
break;
case SEXP_NUM_RAT_FLO:
r = sexp_make_flonum(ctx, sexp_ratio_to_double(b) / sexp_flonum_value(a));
break;
case SEXP_NUM_RAT_FIX:
case SEXP_NUM_RAT_BIG:
b = tmp = sexp_make_ratio(ctx, b, SEXP_ONE);
case SEXP_NUM_FIX_RAT:
case SEXP_NUM_BIG_RAT:
if (!sexp_ratiop(a))
a = tmp = sexp_make_ratio(ctx, a, SEXP_ONE);
/* ... FALLTHROUGH ... */
case SEXP_NUM_RAT_RAT:
r = sexp_ratio_div(ctx, a, b);
break;
#endif
}
sexp_gc_release2(ctx);
return r;
@ -667,7 +868,7 @@ sexp sexp_quotient (sexp ctx, sexp a, sexp b) {
sexp r=SEXP_VOID;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
switch ((at << 2) + bt) {
switch ((at * SEXP_NUM_NUMBER_TYPES) + bt) {
case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX:
case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG:
r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, a);
@ -676,9 +877,16 @@ sexp sexp_quotient (sexp ctx, sexp a, sexp b) {
r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, b);
break;
case SEXP_NUM_FLO_FIX: case SEXP_NUM_FLO_FLO: case SEXP_NUM_FLO_BIG:
#if SEXP_USE_RATIOS
case SEXP_NUM_FLO_RAT: case SEXP_NUM_RAT_FIX: case SEXP_NUM_RAT_FLO:
case SEXP_NUM_RAT_BIG: case SEXP_NUM_RAT_RAT:
#endif
r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, a);
break;
case SEXP_NUM_FIX_FLO: case SEXP_NUM_BIG_FLO:
#if SEXP_USE_RATIOS
case SEXP_NUM_FIX_RAT: case SEXP_NUM_BIG_RAT:
#endif
r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, b);
break;
case SEXP_NUM_FIX_FIX:
@ -703,7 +911,7 @@ sexp sexp_remainder (sexp ctx, sexp a, sexp b) {
sexp r=SEXP_VOID;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
switch ((at << 2) + bt) {
switch ((at * SEXP_NUM_NUMBER_TYPES) + bt) {
case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX:
case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG:
r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, a);
@ -712,9 +920,16 @@ sexp sexp_remainder (sexp ctx, sexp a, sexp b) {
r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, b);
break;
case SEXP_NUM_FLO_FIX: case SEXP_NUM_FLO_FLO: case SEXP_NUM_FLO_BIG:
#if SEXP_USE_RATIOS
case SEXP_NUM_FLO_RAT: case SEXP_NUM_RAT_FIX: case SEXP_NUM_RAT_FLO:
case SEXP_NUM_RAT_BIG: case SEXP_NUM_RAT_RAT:
#endif
r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, a);
break;
case SEXP_NUM_FIX_FLO: case SEXP_NUM_BIG_FLO:
#if SEXP_USE_RATIOS
case SEXP_NUM_FIX_RAT: case SEXP_NUM_BIG_RAT:
#endif
r = sexp_type_exception(ctx, NULL, SEXP_FIXNUM, b);
break;
case SEXP_NUM_FIX_FIX:
@ -738,11 +953,13 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) {
int at=sexp_number_type(a), bt=sexp_number_type(b);
sexp r=SEXP_VOID;
double f;
sexp_gc_var1(tmp);
sexp_gc_preserve1(ctx, tmp);
if (at > bt) {
r = sexp_compare(ctx, b, a);
sexp_negate(r);
} else {
switch ((at << 2) + bt) {
switch ((at * SEXP_NUM_NUMBER_TYPES) + bt) {
case SEXP_NUM_NOT_NOT: case SEXP_NUM_NOT_FIX:
case SEXP_NUM_NOT_FLO: case SEXP_NUM_NOT_BIG:
r = sexp_type_exception(ctx, NULL, SEXP_NUMBER, a);
@ -768,8 +985,20 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) {
case SEXP_NUM_BIG_BIG:
r = sexp_make_fixnum(sexp_bignum_compare(a, b));
break;
#if SEXP_USE_RATIOS
case SEXP_NUM_FLO_RAT:
r = sexp_make_fixnum((sexp_sint_t)(sexp_flonum_value(a) - sexp_ratio_to_double(b)));
break;
case SEXP_NUM_FIX_RAT:
case SEXP_NUM_BIG_RAT:
a = tmp = sexp_make_ratio(ctx, a, SEXP_ONE);
/* ... FALLTHROUGH ... */
case SEXP_NUM_RAT_RAT:
r = sexp_ratio_compare(ctx, a, b);
break;
#endif
}
}
sexp_gc_release1(ctx);
return r;
}

101
sexp.c
View file

@ -97,6 +97,8 @@ static struct sexp_type_struct _sexp_type_specs[] = {
{SEXP_VECTOR, sexp_offsetof(vector, data), 0, 0, sexp_offsetof(vector, length), 1, sexp_sizeof(vector), sexp_offsetof(vector, length), sizeof(sexp), 0, 0, 0, 0, 0, 0, "vector", SEXP_FALSE, SEXP_FALSE, NULL},
{SEXP_FLONUM, 0, 0, 0, 0, 0, sexp_sizeof(flonum), 0, 0, 0, 0, 0, 0, 0, 0, "real", SEXP_FALSE, SEXP_FALSE, NULL},
{SEXP_BIGNUM, 0, 0, 0, 0, 0, sexp_sizeof(bignum), sexp_offsetof(bignum, length), sizeof(sexp_uint_t), 0, 0, 0, 0, 0, 0, "bignum", SEXP_FALSE, SEXP_FALSE, NULL},
{SEXP_RATIO, sexp_offsetof(ratio, numerator), 2, 2, 0, 0, sexp_sizeof(ratio), 0, 0, 0, 0, 0, 0, 0, 0, "ratio", SEXP_FALSE, SEXP_FALSE, NULL},
{SEXP_COMPLEX, sexp_offsetof(complex, real), 2, 2, 0, 0, sexp_sizeof(complex), 0, 0, 0, 0, 0, 0, 0, 0, "complex", SEXP_FALSE, SEXP_FALSE, NULL},
{SEXP_IPORT, sexp_offsetof(port, name), 2, 2, 0, 0, sexp_sizeof(port), 0, 0, 0, 0, 0, 0, 0, 0, "input-port", SEXP_FALSE, SEXP_FALSE, SEXP_FINALIZE_PORT},
{SEXP_OPORT, sexp_offsetof(port, name), 2, 2, 0, 0, sexp_sizeof(port), 0, 0, 0, 0, 0, 0, 0, 0, "output-port", SEXP_FALSE, SEXP_FALSE, SEXP_FINALIZE_PORT},
{SEXP_EXCEPTION, sexp_offsetof(exception, kind), 6, 6, 0, 0, sexp_sizeof(exception), 0, 0, 0, 0, 0, 0, 0, 0, "exception", SEXP_FALSE, SEXP_FALSE, NULL},
@ -1371,6 +1373,22 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
case SEXP_BIGNUM:
sexp_write_bignum(ctx, obj, out, 10);
break;
#endif
#if SEXP_USE_RATIOS
case SEXP_RATIO:
sexp_write(ctx, sexp_ratio_numerator(obj), out);
sexp_write_char(ctx, '/', out);
sexp_write(ctx, sexp_ratio_denominator(obj), out);
break;
#endif
#if SEXP_USE_COMPLEX
case SEXP_COMPLEX:
sexp_write(ctx, sexp_complex_real(obj), out);
if (!sexp_negativep(sexp_complex_imag(obj)))
sexp_write_char(ctx, '+', out);
sexp_write(ctx, sexp_complex_imag(obj), out);
sexp_write_char(ctx, 'i', out);
break;
#endif
case SEXP_OPCODE:
sexp_write_string(ctx, "#<opcode ", out);
@ -1460,7 +1478,9 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
case (sexp_uint_t) SEXP_VOID:
sexp_write_string(ctx, "#<undef>", out); break;
default:
sexp_write_string(ctx, "#<invalid immediate>", out);
sexp_write_string(ctx, "#<invalid immediate: ", out);
sexp_write(ctx, sexp_make_fixnum(obj), out);
sexp_write_char(ctx, '>', out);
}
}
return SEXP_VOID;
@ -1603,13 +1623,52 @@ sexp sexp_read_float_tail (sexp ctx, sexp in, double whole, int negp) {
#endif
}
#if SEXP_USE_RATIOS
sexp sexp_make_ratio (sexp ctx, sexp num, sexp den) {
sexp res = sexp_alloc_type(ctx, ratio, SEXP_RATIO);
sexp_ratio_numerator(res) = num;
sexp_ratio_denominator(res) = den;
return res;
}
sexp sexp_ratio_normalize (sexp ctx, sexp rat, sexp in) {
sexp tmp;
sexp_gc_var2(num, den);
sexp_gc_preserve2(ctx, num, den);
num = sexp_ratio_numerator(rat), den = sexp_ratio_denominator(rat);
if (den == SEXP_ZERO)
return sexp_read_error(ctx, "zero denominator in ratio", rat, in);
else if (num == SEXP_ZERO)
return SEXP_ZERO;
while (den != SEXP_ZERO) {
tmp = sexp_remainder(ctx, num, den);
if (sexp_exceptionp(tmp)) {
sexp_gc_release2(ctx);
return tmp;
}
num = den, den = tmp;
}
sexp_ratio_denominator(rat)
= den = sexp_quotient(ctx, sexp_ratio_denominator(rat), num);
sexp_ratio_numerator(rat)
= sexp_quotient(ctx, sexp_ratio_numerator(rat), num);
if (sexp_exact_negativep(sexp_ratio_denominator(rat))) {
sexp_negate(sexp_ratio_numerator(rat));
sexp_negate(sexp_ratio_denominator(rat));
}
sexp_gc_release2(ctx);
return (sexp_ratio_denominator(rat) == SEXP_ONE) ? sexp_ratio_numerator(rat)
: rat;
}
#endif
sexp sexp_read_number (sexp ctx, sexp in, int base) {
sexp den;
sexp_uint_t res = 0, tmp;
sexp_sint_t val = 0, tmp;
int c, digit, negativep = 0;
#if SEXP_USE_PLACEHOLDER_DIGITS
double whole = 0.0, scale = 0.1;
#endif
sexp_gc_var2(res, den);
c = sexp_read_char(ctx, in);
if (c == '-') {
@ -1621,19 +1680,19 @@ sexp sexp_read_number (sexp ctx, sexp in, int base) {
digit = digit_value(c);
if ((digit < 0) || (digit >= base))
break;
tmp = res * base + digit;
tmp = val * base + digit;
#if SEXP_USE_BIGNUMS
if ((tmp < res) || (tmp > SEXP_MAX_FIXNUM)) {
if ((tmp < val) || (tmp > SEXP_MAX_FIXNUM)) {
sexp_push_char(ctx, c, in);
return sexp_read_bignum(ctx, in, res, (negativep ? -1 : 1), base);
return sexp_read_bignum(ctx, in, val, (negativep ? -1 : 1), base);
}
#endif
res = tmp;
val = tmp;
}
#if SEXP_USE_PLACEHOLDER_DIGITS
if (sexp_placeholder_digit_p(c)) {
whole = res;
whole = val;
for ( ; sexp_placeholder_digit_p(c); c=sexp_read_char(ctx, in))
whole = whole*10 + sexp_placeholder_digit_value(base);
if ((c=='.' || c=='e' || c=='E') && (base != 10))
@ -1658,14 +1717,22 @@ sexp sexp_read_number (sexp ctx, sexp in, int base) {
if (base != 10)
return sexp_read_error(ctx, "found non-base 10 float", SEXP_NULL, in);
if (c!='.') sexp_push_char(ctx, c, in);
return sexp_read_float_tail(ctx, in, res, negativep);
return sexp_read_float_tail(ctx, in, val, negativep);
} else if (c=='/') {
sexp_gc_preserve2(ctx, res, den);
den = sexp_read_number(ctx, in, base);
if (! sexp_fixnump(den))
if (! (sexp_fixnump(den) || sexp_bignump(den)))
return (sexp_exceptionp(den)
? den : sexp_read_error(ctx, "invalid rational syntax", den, in));
return sexp_make_flonum(ctx, (double)(negativep ? -res : res)
#if SEXP_USE_RATIOS
res = sexp_make_ratio(ctx, sexp_make_fixnum(negativep ? -val : val), den);
res = sexp_ratio_normalize(ctx, res, in);
#else
res = sexp_make_flonum(ctx, (double)(negativep ? -val : val)
/ (double)sexp_unbox_fixnum(den));
#endif
sexp_gc_release2(ctx);
return res;
} else {
if ((c!=EOF) && ! is_separator(c))
return sexp_read_error(ctx, "invalid numeric syntax",
@ -1673,7 +1740,7 @@ sexp sexp_read_number (sexp ctx, sexp in, int base) {
sexp_push_char(ctx, c, in);
}
return sexp_make_fixnum(negativep ? -res : res);
return sexp_make_fixnum(negativep ? -val : val);
}
#if SEXP_USE_UTF8_STRINGS
@ -1978,6 +2045,16 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
else
sexp_bignum_sign(res) = -sexp_bignum_sign(res);
} else
#endif
#if SEXP_USE_RATIOS
if (sexp_ratiop(res)) {
sexp_negate(sexp_ratio_numerator(res));
} else
#endif
#if SEXP_USE_COMPLEX
if (sexp_complexp(res)) {
sexp_negate(sexp_complex_real(res));
} else
#endif
res = sexp_fx_mul(res, SEXP_NEG_ONE);
}

4
vm.c
View file

@ -1620,6 +1620,10 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
#if SEXP_USE_BIGNUMS
else if (sexp_bignump(_ARG1))
_ARG1 = sexp_make_flonum(ctx, sexp_bignum_to_double(_ARG1));
#endif
#if SEXP_USE_RATIOS
else if (sexp_ratiop(_ARG1))
_ARG1 = sexp_make_flonum(ctx, sexp_ratio_to_double(_ARG1));
#endif
else if (! sexp_flonump(_ARG1))
sexp_raise("exact->inexact: not a number", sexp_list1(ctx, _ARG1));