Supporting # approximate digit values.

This commit is contained in:
Alex Shinn 2011-03-20 19:43:14 +09:00
parent f92f423297
commit 1edfa35ad8
3 changed files with 49 additions and 0 deletions

View file

@ -123,6 +123,9 @@
/* in opt/bignum.c. */ /* in opt/bignum.c. */
/* #define SEXP_USE_BIGNUMS 0 */ /* #define SEXP_USE_BIGNUMS 0 */
/* uncomment this if you don't want 1## style approximate digits */
/* #define SEXP_USE_PLACEHOLDER_DIGITS 0 */
/* uncomment this if you don't need extended math operations */ /* uncomment this if you don't need extended math operations */
/* This includes the trigonometric and expt functions. */ /* This includes the trigonometric and expt functions. */
/* Automatically disabled if you've disabled flonums. */ /* Automatically disabled if you've disabled flonums. */
@ -369,6 +372,14 @@
#define SEXP_USE_IMMEDIATE_FLONUMS 0 #define SEXP_USE_IMMEDIATE_FLONUMS 0
#endif #endif
#ifndef SEXP_USE_PLACEHOLDER_DIGITS
#define SEXP_USE_PLACEHOLDER_DIGITS SEXP_USE_FLONUMS
#endif
#ifndef SEXP_PLACEHOLDER_DIGIT
#define SEXP_PLACEHOLDER_DIGIT '#'
#endif
#ifndef SEXP_USE_BIGNUMS #ifndef SEXP_USE_BIGNUMS
#define SEXP_USE_BIGNUMS ! SEXP_USE_NO_FEATURES #define SEXP_USE_BIGNUMS ! SEXP_USE_NO_FEATURES
#endif #endif

View file

@ -598,6 +598,14 @@ sexp sexp_make_flonum(sexp ctx, double f);
#define sexp_fixnum_to_double(x) ((double)sexp_unbox_fixnum(x)) #define sexp_fixnum_to_double(x) ((double)sexp_unbox_fixnum(x))
#if SEXP_USE_PLACEHOLDER_DIGITS
#define sexp_placeholder_digit_p(c) ((c) == SEXP_PLACEHOLDER_DIGIT)
#else
#define sexp_placeholder_digit_p(c) 0
#endif
#define sexp_placeholder_digit_value(base) ((base)/2)
#if SEXP_USE_FLONUMS #if SEXP_USE_FLONUMS
#define sexp_fp_integerp(x) (sexp_flonum_value(x) == trunc(sexp_flonum_value(x))) #define sexp_fp_integerp(x) (sexp_flonum_value(x) == trunc(sexp_flonum_value(x)))
#define _or_integer_flonump(x) || (sexp_flonump(x) && sexp_fp_integerp(x)) #define _or_integer_flonump(x) || (sexp_flonump(x) && sexp_fp_integerp(x))

30
sexp.c
View file

@ -1589,6 +1589,10 @@ sexp sexp_read_float_tail (sexp ctx, sexp in, double whole, int negp) {
isdigit(c); isdigit(c);
c=sexp_read_char(ctx, in), scale*=0.1) c=sexp_read_char(ctx, in), scale*=0.1)
res += digit_value(c)*scale; res += digit_value(c)*scale;
#if SEXP_USE_PLACEHOLDER_DIGITS
for (; c==SEXP_PLACEHOLDER_DIGIT; c=sexp_read_char(ctx, in), scale*=0.1)
res += sexp_placeholder_digit_value(10)*scale;
#endif
if (c=='e' || c=='E') { if (c=='e' || c=='E') {
exponent = sexp_read_number(ctx, in, 10); exponent = sexp_read_number(ctx, in, 10);
if (sexp_exceptionp(exponent)) return exponent; if (sexp_exceptionp(exponent)) return exponent;
@ -1613,6 +1617,9 @@ sexp sexp_read_number (sexp ctx, sexp in, int base) {
sexp den; sexp den;
sexp_uint_t res = 0, tmp; sexp_uint_t res = 0, tmp;
int c, digit, negativep = 0; int c, digit, negativep = 0;
#if SEXP_USE_PLACEHOLDER_DIGITS
double whole = 0.0, scale = 0.1;
#endif
c = sexp_read_char(ctx, in); c = sexp_read_char(ctx, in);
if (c == '-') { if (c == '-') {
@ -1634,6 +1641,29 @@ sexp sexp_read_number (sexp ctx, sexp in, int base) {
res = tmp; res = tmp;
} }
#if SEXP_USE_PLACEHOLDER_DIGITS
if (sexp_placeholder_digit_p(c)) {
whole = res;
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))
return sexp_read_error(ctx, "found non-base 10 float", SEXP_NULL, in);
if (c=='.')
for (c=sexp_read_char(ctx, in); sexp_placeholder_digit_p(c);
c=sexp_read_char(ctx, in), scale*=0.1)
whole += sexp_placeholder_digit_value(10)*scale;
if (c=='e' || c=='E') {
sexp_push_char(ctx, c, in);
return sexp_read_float_tail(ctx, in, whole, negativep);
} else if ((c!=EOF) && !is_separator(c)) {
return sexp_read_error(ctx, "invalid numeric syntax after placeholders",
sexp_make_character(c), in);
}
sexp_push_char(ctx, c, in);
return sexp_make_flonum(ctx, (negativep ? -whole : whole));
}
#endif
if (c=='.' || c=='e' || c=='E') { if (c=='.' || c=='e' || c=='E') {
if (base != 10) if (base != 10)
return sexp_read_error(ctx, "found non-base 10 float", SEXP_NULL, in); return sexp_read_error(ctx, "found non-base 10 float", SEXP_NULL, in);