diff --git a/Makefile b/Makefile index db9cf208..c18fd434 100644 --- a/Makefile +++ b/Makefile @@ -67,7 +67,7 @@ test: test-contribs test-nostdlib test-contribs: bin/picrin $(CONTRIB_TESTS) test-nostdlib: - $(CC) -I extlib/benz/include -D'PIC_ENABLE_LIBC=0' -D'PIC_ENABLE_FLOAT=0' -D'PIC_ENABLE_STDIO=0' -nostdlib -fPIC -shared -std=c89 -pedantic -Wall -Wextra -Werror -o lib/libbenz.so $(BENZ_SRCS) etc/libc_polyfill.c -fno-stack-protector + $(CC) -I extlib/benz/include -D'PIC_ENABLE_LIBC=0' -D'PIC_ENABLE_FLOAT=0' -D'PIC_ENABLE_STDIO=0' -ffreestanding -nostdlib -fPIC -shared -std=c89 -pedantic -Wall -Wextra -Werror -o lib/libbenz.so $(BENZ_SRCS) etc/libc_polyfill.c -fno-stack-protector rm -f lib/libbenz.so install: all diff --git a/contrib/10.math/math.c b/contrib/10.math/math.c new file mode 100644 index 00000000..f2b9d7f5 --- /dev/null +++ b/contrib/10.math/math.c @@ -0,0 +1,310 @@ +#include "picrin.h" + +#include + +static pic_value +pic_number_floor2(pic_state *pic) +{ + int i, j; + bool e1, e2; + + pic_get_args(pic, "II", &i, &e1, &j, &e2); + + if (e1 && e2) { + int k; + + k = (i < 0 && j < 0) || (0 <= i && 0 <= j) + ? i / j + : (i / j) - 1; + + return pic_values2(pic, pic_int_value(k), pic_int_value(i - k * j)); + } else { + double q, r; + + q = floor((double)i/j); + r = i - j * q; + return pic_values2(pic, pic_float_value(q), pic_float_value(r)); + } +} + +static pic_value +pic_number_trunc2(pic_state *pic) +{ + int i, j; + bool e1, e2; + + pic_get_args(pic, "II", &i, &e1, &j, &e2); + + if (e1 && e2) { + return pic_values2(pic, pic_int_value(i/j), pic_int_value(i - (i/j) * j)); + } else { + double q, r; + + q = trunc((double)i/j); + r = i - j * q; + + return pic_values2(pic, pic_float_value(q), pic_float_value(r)); + } +} + +static pic_value +pic_number_floor(pic_state *pic) +{ + double f; + bool e; + + pic_get_args(pic, "F", &f, &e); + + if (e) { + return pic_int_value((int)f); + } else { + return pic_float_value(floor(f)); + } +} + +static pic_value +pic_number_ceil(pic_state *pic) +{ + double f; + bool e; + + pic_get_args(pic, "F", &f, &e); + + if (e) { + return pic_int_value((int)f); + } else { + return pic_float_value(ceil(f)); + } +} + +static pic_value +pic_number_trunc(pic_state *pic) +{ + double f; + bool e; + + pic_get_args(pic, "F", &f, &e); + + if (e) { + return pic_int_value((int)f); + } else { + return pic_float_value(trunc(f)); + } +} + +static pic_value +pic_number_round(pic_state *pic) +{ + double f; + bool e; + + pic_get_args(pic, "F", &f, &e); + + if (e) { + return pic_int_value((int)f); + } else { + return pic_float_value(round(f)); + } +} + +static pic_value +pic_number_finite_p(pic_state *pic) +{ + pic_value v; + + pic_get_args(pic, "o", &v); + + if (pic_int_p(v)) + return pic_true_value(); + if (pic_float_p(v) && ! (isinf(pic_float(v)) || isnan(pic_float(v)))) + return pic_true_value(); + else + return pic_false_value(); +} + +static pic_value +pic_number_infinite_p(pic_state *pic) +{ + pic_value v; + + pic_get_args(pic, "o", &v); + + if (pic_float_p(v) && isinf(pic_float(v))) + return pic_true_value(); + else + return pic_false_value(); +} + +static pic_value +pic_number_nan_p(pic_state *pic) +{ + pic_value v; + + pic_get_args(pic, "o", &v); + + if (pic_float_p(v) && isnan(pic_float(v))) + return pic_true_value(); + else + return pic_false_value(); +} + +static pic_value +pic_number_exp(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + return pic_float_value(exp(f)); +} + +static pic_value +pic_number_log(pic_state *pic) +{ + double f,g; + int argc; + + argc = pic_get_args(pic, "f|f", &f, &g); + if (argc == 1) { + return pic_float_value(log(f)); + } + else { + return pic_float_value(log(f) / log(g)); + } +} + +static pic_value +pic_number_sin(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + f = sin(f); + return pic_float_value(f); +} + +static pic_value +pic_number_cos(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + f = cos(f); + return pic_float_value(f); +} + +static pic_value +pic_number_tan(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + f = tan(f); + return pic_float_value(f); +} + +static pic_value +pic_number_acos(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + f = acos(f); + return pic_float_value(f); +} + +static pic_value +pic_number_asin(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + f = asin(f); + return pic_float_value(f); +} + +static pic_value +pic_number_atan(pic_state *pic) +{ + double f,g; + int argc; + + argc = pic_get_args(pic, "f|f", &f, &g); + if (argc == 1) { + f = atan(f); + return pic_float_value(f); + } + else { + return pic_float_value(atan2(f,g)); + } +} + +static pic_value +pic_number_sqrt(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + + return pic_float_value(sqrt(f)); +} + +static pic_value +pic_number_abs(pic_state *pic) +{ + double f; + bool e; + + pic_get_args(pic, "F", &f, &e); + + if (e) { + return pic_int_value(f < 0 ? -f : f); + } + else { + return pic_float_value(fabs(f)); + } +} + +static pic_value +pic_number_expt(pic_state *pic) +{ + double f, g, h; + bool e1, e2; + + pic_get_args(pic, "FF", &f, &e1, &g, &e2); + + h = pow(f, g); + if (e1 && e2) { + if (h <= INT_MAX) { + return pic_int_value((int)h); + } + } + return pic_float_value(h); +} + +void +pic_init_math(pic_state *pic) +{ + pic_deflibrary (pic, "(picrin math)") { + pic_defun(pic, "floor/", pic_number_floor2); + pic_defun(pic, "truncate/", pic_number_trunc2); + pic_defun(pic, "floor", pic_number_floor); + pic_defun(pic, "ceiling", pic_number_ceil); + pic_defun(pic, "truncate", pic_number_trunc); + pic_defun(pic, "round", pic_number_round); + + pic_defun(pic, "finite?", pic_number_finite_p); + pic_defun(pic, "infinite?", pic_number_infinite_p); + pic_defun(pic, "nan?", pic_number_nan_p); + pic_defun(pic, "sqrt", pic_number_sqrt); + pic_defun(pic, "exp", pic_number_exp); + pic_defun(pic, "log", pic_number_log); + pic_defun(pic, "sin", pic_number_sin); + pic_defun(pic, "cos", pic_number_cos); + pic_defun(pic, "tan", pic_number_tan); + pic_defun(pic, "acos", pic_number_acos); + pic_defun(pic, "asin", pic_number_asin); + pic_defun(pic, "atan", pic_number_atan); + pic_defun(pic, "abs", pic_number_abs); + pic_defun(pic, "expt", pic_number_expt); + } +} diff --git a/contrib/10.math/nitro.mk b/contrib/10.math/nitro.mk new file mode 100644 index 00000000..452ce371 --- /dev/null +++ b/contrib/10.math/nitro.mk @@ -0,0 +1,3 @@ +CONTRIB_INITS += math + +CONTRIB_SRCS += contrib/10.math/math.c diff --git a/contrib/20.r7rs/scheme/base.scm b/contrib/20.r7rs/scheme/base.scm index fe476435..7976fddc 100644 --- a/contrib/20.r7rs/scheme/base.scm +++ b/contrib/20.r7rs/scheme/base.scm @@ -1,5 +1,17 @@ (define-library (scheme base) (import (picrin base) + (only (picrin math) + abs + expt + floor/ + truncate/ + floor + ceiling + truncate + round + sqrt + nan? + infinite?) (picrin macro) (picrin string) (scheme file)) @@ -460,6 +472,16 @@ ;; 6.2. Numbers + (define complex? number?) + (define real? number?) + (define rational? number?) + (define (integer? o) + (or (exact? o) + (and (inexact? o) + (not (nan? o)) + (not (infinite? o)) + (= o (floor o))))) + (define (exact-integer? x) (and (exact? x) (integer? x))) diff --git a/contrib/20.r7rs/scheme/inexact.scm b/contrib/20.r7rs/scheme/inexact.scm index 28c162dc..578af54c 100644 --- a/contrib/20.r7rs/scheme/inexact.scm +++ b/contrib/20.r7rs/scheme/inexact.scm @@ -1,5 +1,6 @@ (define-library (scheme inexact) - (import (picrin base)) + (import (picrin base) + (picrin math)) (export acos asin diff --git a/extlib/benz/error.c b/extlib/benz/error.c index c50fc85d..b75223d8 100644 --- a/extlib/benz/error.c +++ b/extlib/benz/error.c @@ -7,7 +7,7 @@ void pic_panic(pic_state PIC_UNUSED(*pic), const char *msg) { - extern void abort(); + extern PIC_NORETURN void abort(); #if DEBUG fprintf(stderr, "abort: %s\n", msg); diff --git a/extlib/benz/file.c b/extlib/benz/file.c index 96f25c74..888dbff0 100644 --- a/extlib/benz/file.c +++ b/extlib/benz/file.c @@ -345,38 +345,38 @@ int xvfprintf(pic_state *pic, xFILE *stream, const char *fmt, va_list ap) { ival = va_arg(ap, int); cnt += print_int(pic, stream, ival, 10); break; -#if PIC_ENABLE_FLOAT -# if PIC_ENABLE_LIBC +#if PIC_ENABLE_LIBC case 'f': { char buf[100]; sprintf(buf, "%g", va_arg(ap, double)); xfputs(pic, buf, stream); break; } -# else +#else +# define fabs(x) ((x) >= 0 ? (x) : -(x)) case 'f': { - double dval, dint; - dval = modf(va_arg(ap, double), &dint); - if (dint < 0 || dval < 0) { /* either may be zero */ + double dval = va_arg(ap, double); + long lval; + if (dval < 0) { + dval = -dval; xputc(pic, '-', stream); cnt++; } - cnt += print_int(pic, stream, (long)fabs(dint), 10); + lval = (long)dval; + cnt += print_int(pic, stream, lval, 10); xputc(pic, '.', stream); cnt++; - if ((ival = fabs(fabs(dval) * 1e4) + 0.5) == 0) { + dval -= lval; + if ((ival = fabs(dval) * 1e4 + 0.5) == 0) { cnt += xfputs(pic, "0000", stream); } else { - int i; - for (i = 0; i < 3 - (int)log10(ival); ++i) { - xputc(pic, '0', stream); - cnt++; - } + if (ival < 1000) xputc(pic, '0', stream); cnt++; + if (ival < 100) xputc(pic, '0', stream); cnt++; + if (ival < 10) xputc(pic, '0', stream); cnt++; cnt += print_int(pic, stream, ival, 10); } break; } -# endif #endif case 's': sval = va_arg(ap, char*); diff --git a/extlib/benz/gc.c b/extlib/benz/gc.c index 5285f7ab..9ac40c27 100644 --- a/extlib/benz/gc.c +++ b/extlib/benz/gc.c @@ -439,9 +439,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj) } case PIC_TT_NIL: case PIC_TT_BOOL: -#if PIC_ENABLE_FLOAT case PIC_TT_FLOAT: -#endif case PIC_TT_INT: case PIC_TT_CHAR: case PIC_TT_EOF: @@ -679,9 +677,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj) } case PIC_TT_NIL: case PIC_TT_BOOL: -#if PIC_ENABLE_FLOAT case PIC_TT_FLOAT: -#endif case PIC_TT_INT: case PIC_TT_CHAR: case PIC_TT_EOF: diff --git a/extlib/benz/include/picrin/compat.h b/extlib/benz/include/picrin/compat.h index e6abc5dd..36c9981a 100644 --- a/extlib/benz/include/picrin/compat.h +++ b/extlib/benz/include/picrin/compat.h @@ -205,10 +205,6 @@ strcpy(char *dst, const char *src) #endif -#if PIC_ENABLE_FLOAT -# include -#endif - #if PIC_ENABLE_STDIO # include #endif diff --git a/extlib/benz/include/picrin/config.h b/extlib/benz/include/picrin/config.h index 16d872c2..e90684d0 100644 --- a/extlib/benz/include/picrin/config.h +++ b/extlib/benz/include/picrin/config.h @@ -11,9 +11,6 @@ /** enable word boxing */ /* #define PIC_WORD_BOXING 0 */ -/** enable floating point number support */ -/* #define PIC_ENABLE_FLOAT 1 */ - /** no dependency on libc */ /* #define PIC_ENABLE_LIBC 1 */ @@ -68,10 +65,6 @@ # error cannot enable both PIC_NAN_BOXING and PIC_WORD_BOXING simultaneously #endif -#if PIC_WORD_BOXING && PIC_ENABLE_FLOAT -# error cannot enable both PIC_WORD_BOXING and PIC_ENABLE_FLOAT simultaneously -#endif - #ifndef PIC_WORD_BOXING # define PIC_WORD_BOXING 0 #endif @@ -84,20 +77,10 @@ # endif #endif -#ifndef PIC_ENABLE_FLOAT -# if ! PIC_WORD_BOXING -# define PIC_ENABLE_FLOAT 1 -# endif -#endif - #ifndef PIC_ENABLE_LIBC # define PIC_ENABLE_LIBC 1 #endif -#if PIC_NAN_BOXING && defined(PIC_ENABLE_FLOAT) && ! PIC_ENABLE_FLOAT -# error cannot disable float support when nan boxing is on -#endif - #ifndef PIC_ENABLE_STDIO # define PIC_ENABLE_STDIO 1 #endif diff --git a/extlib/benz/include/picrin/type.h b/extlib/benz/include/picrin/type.h index e6626960..535421f5 100644 --- a/extlib/benz/include/picrin/type.h +++ b/extlib/benz/include/picrin/type.h @@ -20,9 +20,7 @@ enum pic_vtype { PIC_VTYPE_FALSE, PIC_VTYPE_UNDEF, PIC_VTYPE_INVALID, -#if PIC_ENABLE_FLOAT PIC_VTYPE_FLOAT, -#endif PIC_VTYPE_INT, PIC_VTYPE_CHAR, PIC_VTYPE_EOF, @@ -116,9 +114,7 @@ typedef struct { enum pic_vtype type; union { void *data; -#if PIC_ENABLE_FLOAT double f; -#endif int i; char c; } u; @@ -128,9 +124,7 @@ typedef struct { #define pic_vtype(v) ((v).type) #define pic_init_value(v,vtype) ((v).type = (vtype), (v).u.data = NULL) -#if PIC_ENABLE_FLOAT -# define pic_float(v) ((v).u.f) -#endif +#define pic_float(v) ((v).u.f) #define pic_int(v) ((v).u.i) #define pic_char(v) ((v).u.c) @@ -140,9 +134,7 @@ enum pic_tt { /* immediate */ PIC_TT_NIL, PIC_TT_BOOL, -#if PIC_ENABLE_FLOAT PIC_TT_FLOAT, -#endif PIC_TT_INT, PIC_TT_CHAR, PIC_TT_EOF, @@ -218,21 +210,12 @@ PIC_INLINE const char *pic_type_repr(enum pic_tt); pic_errorf(pic, "expected " #type ", but got ~s", v); \ } -#if PIC_ENABLE_FLOAT PIC_INLINE bool pic_valid_int(double v) { return INT_MIN <= v && v <= INT_MAX; } -#else -PIC_INLINE bool -pic_valid_int(int PIC_UNUSED(v)) -{ - return true; -} -#endif - PIC_INLINE pic_value pic_nil_value(); PIC_INLINE pic_value pic_true_value(); PIC_INLINE pic_value pic_false_value(); @@ -240,9 +223,7 @@ PIC_INLINE pic_value pic_bool_value(bool); PIC_INLINE pic_value pic_undef_value(); PIC_INLINE pic_value pic_invalid_value(); PIC_INLINE pic_value pic_obj_value(void *); -#if PIC_ENABLE_FLOAT PIC_INLINE pic_value pic_float_value(double); -#endif PIC_INLINE pic_value pic_int_value(int); PIC_INLINE pic_value pic_size_value(size_t); PIC_INLINE pic_value pic_char_value(char c); @@ -264,10 +245,8 @@ pic_type(pic_value v) return PIC_TT_UNDEF; case PIC_VTYPE_INVALID: return PIC_TT_INVALID; -#if PIC_ENABLE_FLOAT case PIC_VTYPE_FLOAT: return PIC_TT_FLOAT; -#endif case PIC_VTYPE_INT: return PIC_TT_INT; case PIC_VTYPE_CHAR: @@ -289,10 +268,8 @@ pic_type_repr(enum pic_tt tt) return "nil"; case PIC_TT_BOOL: return "boolean"; -#if PIC_ENABLE_FLOAT case PIC_TT_FLOAT: return "float"; -#endif case PIC_TT_INT: return "int"; case PIC_TT_SYMBOL: @@ -382,13 +359,11 @@ pic_bool_value(bool b) PIC_INLINE pic_value pic_size_value(size_t s) { -#if PIC_ENABLE_FLOAT if (sizeof(unsigned) < sizeof(size_t)) { if (s > (size_t)INT_MAX) { return pic_float_value(s); } } -#endif return pic_int_value((int)s); } @@ -472,8 +447,6 @@ pic_obj_value(void *ptr) return v; } -#if PIC_ENABLE_FLOAT - PIC_INLINE pic_value pic_float_value(double f) { @@ -484,8 +457,6 @@ pic_float_value(double f) return v; } -#endif - PIC_INLINE pic_value pic_int_value(int i) { @@ -569,10 +540,8 @@ pic_eqv_p(pic_value x, pic_value y) return true; case PIC_TT_BOOL: return pic_vtype(x) == pic_vtype(y); -#if PIC_ENABLE_FLOAT case PIC_TT_FLOAT: return pic_float(x) == pic_float(y); -#endif case PIC_TT_INT: return pic_int(x) == pic_int(y); default: @@ -582,82 +551,52 @@ pic_eqv_p(pic_value x, pic_value y) #endif -#if PIC_ENABLE_FLOAT -# define pic_define_aop(name, op, guard) \ - PIC_INLINE pic_value \ - name(pic_state *pic, pic_value a, pic_value b) \ - { \ - extern PIC_NORETURN void pic_errorf(pic_state *, const char *, ...); \ - double f; \ - if (pic_int_p(a) && pic_int_p(b)) { \ - f = (double)pic_int(a) op (double)pic_int(b); \ - return (INT_MIN <= f && f <= INT_MAX && guard) \ - ? pic_int_value((int)f) \ - : pic_float_value(f); \ - } else if (pic_float_p(a) && pic_float_p(b)) { \ - return pic_float_value(pic_float(a) op pic_float(b)); \ - } else if (pic_int_p(a) && pic_float_p(b)) { \ - return pic_float_value(pic_int(a) op pic_float(b)); \ - } else if (pic_float_p(a) && pic_int_p(b)) { \ - return pic_float_value(pic_float(a) op pic_int(b)); \ - } else { \ - pic_errorf(pic, #name ": non-number operand given"); \ - } \ - PIC_UNREACHABLE(); \ +#define pic_define_aop(name, op, guard) \ + PIC_INLINE pic_value \ + name(pic_state *pic, pic_value a, pic_value b) \ + { \ + PIC_NORETURN void pic_errorf(pic_state *, const char *, ...); \ + double f; \ + if (pic_int_p(a) && pic_int_p(b)) { \ + f = (double)pic_int(a) op (double)pic_int(b); \ + return (INT_MIN <= f && f <= INT_MAX && guard) \ + ? pic_int_value((int)f) \ + : pic_float_value(f); \ + } else if (pic_float_p(a) && pic_float_p(b)) { \ + return pic_float_value(pic_float(a) op pic_float(b)); \ + } else if (pic_int_p(a) && pic_float_p(b)) { \ + return pic_float_value(pic_int(a) op pic_float(b)); \ + } else if (pic_float_p(a) && pic_int_p(b)) { \ + return pic_float_value(pic_float(a) op pic_int(b)); \ + } else { \ + pic_errorf(pic, #name ": non-number operand given"); \ + } \ + PIC_UNREACHABLE(); \ } -#else -# define pic_define_aop(name, op, guard) \ - PIC_INLINE pic_value \ - name(pic_state *pic, pic_value a, pic_value b) \ - { \ - extern PIC_NORETURN void pic_errorf(pic_state *, const char *, ...); \ - if (pic_int_p(a) && pic_int_p(b)) { \ - return pic_int_value(pic_int(a) op pic_int(b)); \ - } else { \ - pic_errorf(pic, #name ": non-number operand given"); \ - } \ - PIC_UNREACHABLE(); \ - } -#endif pic_define_aop(pic_add, +, true) pic_define_aop(pic_sub, -, true) pic_define_aop(pic_mul, *, true) -pic_define_aop(pic_div, /, f == round(f)) +pic_define_aop(pic_div, /, f == (int)f) -#if PIC_ENABLE_FLOAT -# define pic_define_cmp(name, op) \ - PIC_INLINE bool \ - name(pic_state *pic, pic_value a, pic_value b) \ - { \ - extern PIC_NORETURN void pic_errorf(pic_state *, const char *, ...); \ - if (pic_int_p(a) && pic_int_p(b)) { \ - return pic_int(a) op pic_int(b); \ - } else if (pic_float_p(a) && pic_float_p(b)) { \ - return pic_float(a) op pic_float(b); \ - } else if (pic_int_p(a) && pic_float_p(b)) { \ - return pic_int(a) op pic_float(b); \ - } else if (pic_float_p(a) && pic_int_p(b)) { \ - return pic_float(a) op pic_int(b); \ - } else { \ - pic_errorf(pic, #name ": non-number operand given"); \ - } \ - PIC_UNREACHABLE(); \ +#define pic_define_cmp(name, op) \ + PIC_INLINE bool \ + name(pic_state *pic, pic_value a, pic_value b) \ + { \ + PIC_NORETURN void pic_errorf(pic_state *, const char *, ...); \ + if (pic_int_p(a) && pic_int_p(b)) { \ + return pic_int(a) op pic_int(b); \ + } else if (pic_float_p(a) && pic_float_p(b)) { \ + return pic_float(a) op pic_float(b); \ + } else if (pic_int_p(a) && pic_float_p(b)) { \ + return pic_int(a) op pic_float(b); \ + } else if (pic_float_p(a) && pic_int_p(b)) { \ + return pic_float(a) op pic_int(b); \ + } else { \ + pic_errorf(pic, #name ": non-number operand given"); \ + } \ + PIC_UNREACHABLE(); \ } -#else -# define pic_define_cmp(name, op) \ - PIC_INLINE bool \ - name(pic_state *pic, pic_value a, pic_value b) \ - { \ - extern PIC_NORETURN void pic_errorf(pic_state *, const char *, ...); \ - if (pic_int_p(a) && pic_int_p(b)) { \ - return pic_int(a) op pic_int(b); \ - } else { \ - pic_errorf(pic, #name ": non-number operand given"); \ - } \ - PIC_UNREACHABLE(); \ - } -#endif pic_define_cmp(pic_eq, ==) pic_define_cmp(pic_lt, <) diff --git a/extlib/benz/number.c b/extlib/benz/number.c index e0cd1181..42f20640 100644 --- a/extlib/benz/number.c +++ b/extlib/benz/number.c @@ -4,23 +4,119 @@ #include "picrin.h" -#if ! PIC_ENABLE_FLOAT static pic_value -pic_number_id(pic_state *pic) +pic_number_number_p(pic_state *pic) { - int i; + pic_value v; - pic_get_args(pic, "i", &i); + pic_get_args(pic, "o", &v); - return pic_int_value(i); + return pic_bool_value(pic_float_p(v) || pic_int_p(v)); } -#endif -/** - * Returns the length of string representing val. - * radix is between 2 and 36 (inclusive). - * No error checks are performed in this function. - */ +static pic_value +pic_number_exact_p(pic_state *pic) +{ + pic_value v; + + pic_get_args(pic, "o", &v); + + return pic_bool_value(pic_int_p(v)); +} + +static pic_value +pic_number_inexact_p(pic_state *pic) +{ + pic_value v; + + pic_get_args(pic, "o", &v); + + return pic_bool_value(pic_float_p(v)); +} + +static pic_value +pic_number_inexact(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + + return pic_float_value(f); +} + +static pic_value +pic_number_exact(pic_state *pic) +{ + double f; + + pic_get_args(pic, "f", &f); + + return pic_int_value((int)f); +} + +#define DEFINE_CMP(op) \ + static pic_value \ + pic_number_##op(pic_state *pic) \ + { \ + size_t argc, i; \ + pic_value *argv; \ + \ + pic_get_args(pic, "*", &argc, &argv); \ + \ + if (argc < 2) { \ + return pic_true_value(); \ + } \ + \ + for (i = 1; i < argc; ++i) { \ + if (! pic_##op(pic, argv[i - 1], argv[i])) { \ + return pic_false_value(); \ + } \ + } \ + return pic_true_value(); \ + } + +DEFINE_CMP(eq) +DEFINE_CMP(lt) +DEFINE_CMP(le) +DEFINE_CMP(gt) +DEFINE_CMP(ge) + +#define DEFINE_AOP(op, v1, c0) \ + static pic_value \ + pic_number_##op(pic_state *pic) \ + { \ + size_t argc, i; \ + pic_value *argv, tmp; \ + \ + pic_get_args(pic, "*", &argc, &argv); \ + \ + if (argc == 0) { \ + c0; \ + } \ + else if (argc == 1) { \ + return v1; \ + } \ + \ + tmp = argv[0]; \ + for (i = 1; i < argc; ++i) { \ + tmp = pic_##op(pic, tmp, argv[i]); \ + } \ + return tmp; \ + } + +DEFINE_AOP(add, argv[0], do { + return pic_int_value(0); + } while (0)) +DEFINE_AOP(mul, argv[0], do { + return pic_int_value(1); + } while (0)) +DEFINE_AOP(sub, pic_sub(pic, pic_int_value(0), argv[0]), do { + pic_errorf(pic, "-: at least one argument required"); + } while (0)) +DEFINE_AOP(div, pic_div(pic, pic_int_value(1), argv[0]), do { + pic_errorf(pic, "/: at least one argument required"); + } while (0)) + static int number_string_length(int val, int radix) { @@ -40,12 +136,6 @@ number_string_length(int val, int radix) return count; } -/** - * Returns the string representing val. - * radix is between 2 and 36 (inclusive). - * This function overwrites buffer and stores the result. - * No error checks are performed in this function. It is caller's responsibility to avoid buffer-overrun. - */ static void number_string(int val, int radix, int length, char *buffer) { const char digits[37] = "0123456789abcdefghijklmnopqrstuvwxyz"; @@ -69,485 +159,9 @@ number_string(int val, int radix, int length, char *buffer) { return; } -static pic_value -pic_number_real_p(pic_state *pic) -{ - pic_value v; - - pic_get_args(pic, "o", &v); - -#if PIC_ENABLE_FLOAT - return pic_bool_value(pic_float_p(v) || pic_int_p(v)); -#else - return pic_bool_value(pic_int_p(v)); -#endif -} - -static pic_value -pic_number_integer_p(pic_state *pic) -{ - pic_value v; - - pic_get_args(pic, "o", &v); - - if (pic_int_p(v)) { - return pic_true_value(); - } -#if PIC_ENABLE_FLOAT - if (pic_float_p(v)) { - double f = pic_float(v); - - if (isinf(f)) { - return pic_false_value(); - } - - if (f == round(f)) { - return pic_true_value(); - } - } -#endif - return pic_false_value(); -} - -static pic_value -pic_number_exact_p(pic_state *pic) -{ - pic_value v; - - pic_get_args(pic, "o", &v); - - return pic_bool_value(pic_int_p(v)); -} - -static pic_value -pic_number_inexact_p(pic_state *pic) -{ - pic_value v; - - pic_get_args(pic, "o", &v); - -#if PIC_ENABLE_FLOAT - return pic_bool_value(pic_float_p(v)); -#else - return pic_false_value(); -#endif -} - -#define DEFINE_ARITH_CMP(op, name) \ - static pic_value \ - pic_number_##name(pic_state *pic) \ - { \ - size_t argc, i; \ - pic_value *argv; \ - double f,g; \ - \ - pic_get_args(pic, "ff*", &f, &g, &argc, &argv); \ - \ - if (! (f op g)) \ - return pic_false_value(); \ - \ - for (i = 0; i < argc; ++i) { \ - f = g; \ - if (pic_float_p(argv[i])) \ - g = pic_float(argv[i]); \ - else if (pic_int_p(argv[i])) \ - g = pic_int(argv[i]); \ - else \ - pic_errorf(pic, #op ": number required"); \ - \ - if (! (f op g)) \ - return pic_false_value(); \ - } \ - \ - return pic_true_value(); \ - } - -#define DEFINE_ARITH_CMP2(op, name) \ - static pic_value \ - pic_number_##name(pic_state *pic) \ - { \ - size_t argc, i; \ - pic_value *argv; \ - int f,g; \ - \ - pic_get_args(pic, "ii*", &f, &g, &argc, &argv); \ - \ - if (! (f op g)) \ - return pic_false_value(); \ - \ - for (i = 0; i < argc; ++i) { \ - f = g; \ - if (pic_int_p(argv[i])) \ - g = pic_int(argv[i]); \ - else \ - pic_errorf(pic, #op ": number required"); \ - \ - if (! (f op g)) \ - return pic_false_value(); \ - } \ - \ - return pic_true_value(); \ - } - -#if PIC_ENABLE_FLOAT -DEFINE_ARITH_CMP(==, eq) -DEFINE_ARITH_CMP(<, lt) -DEFINE_ARITH_CMP(>, gt) -DEFINE_ARITH_CMP(<=, le) -DEFINE_ARITH_CMP(>=, ge) -#else -DEFINE_ARITH_CMP2(==, eq) -DEFINE_ARITH_CMP2(<, lt) -DEFINE_ARITH_CMP2(>, gt) -DEFINE_ARITH_CMP2(<=, le) -DEFINE_ARITH_CMP2(>=, ge) -#endif - -#define DEFINE_ARITH_OP(op, name, unit) \ - static pic_value \ - pic_number_##name(pic_state *pic) \ - { \ - size_t argc, i; \ - pic_value *argv; \ - double f; \ - bool e = true; \ - \ - pic_get_args(pic, "*", &argc, &argv); \ - \ - f = unit; \ - for (i = 0; i < argc; ++i) { \ - if (pic_int_p(argv[i])) { \ - f op##= pic_int(argv[i]); \ - } \ - else if (pic_float_p(argv[i])) { \ - e = false; \ - f op##= pic_float(argv[i]); \ - } \ - else { \ - pic_errorf(pic, #op ": number required"); \ - } \ - } \ - \ - return e ? pic_int_value((int)f) : pic_float_value(f); \ - } - -#define DEFINE_ARITH_OP2(op, name, unit) \ - static pic_value \ - pic_number_##name(pic_state *pic) \ - { \ - size_t argc, i; \ - pic_value *argv; \ - int f; \ - \ - pic_get_args(pic, "*", &argc, &argv); \ - \ - f = unit; \ - for (i = 0; i < argc; ++i) { \ - if (pic_int_p(argv[i])) { \ - f op##= pic_int(argv[i]); \ - } \ - else { \ - pic_errorf(pic, #op ": number required"); \ - } \ - } \ - \ - return pic_int_value(f); \ - } - -#if PIC_ENABLE_FLOAT -DEFINE_ARITH_OP(+, add, 0) -DEFINE_ARITH_OP(*, mul, 1) -#else -DEFINE_ARITH_OP2(+, add, 0) -DEFINE_ARITH_OP2(*, mul, 1) -#endif - -#define DEFINE_ARITH_INV_OP(op, name, unit, exact) \ - static pic_value \ - pic_number_##name(pic_state *pic) \ - { \ - size_t argc, i; \ - pic_value *argv; \ - double f; \ - bool e = true; \ - \ - pic_get_args(pic, "F*", &f, &e, &argc, &argv); \ - \ - e = e && exact; \ - \ - if (argc == 0) { \ - f = unit op f; \ - } \ - for (i = 0; i < argc; ++i) { \ - if (pic_int_p(argv[i])) { \ - f op##= pic_int(argv[i]); \ - } \ - else if (pic_float_p(argv[i])) { \ - e = false; \ - f op##= pic_float(argv[i]); \ - } \ - else { \ - pic_errorf(pic, #op ": number required"); \ - } \ - } \ - \ - return e ? pic_int_value((int)f) : pic_float_value(f); \ - } - -#define DEFINE_ARITH_INV_OP2(op, name, unit) \ - static pic_value \ - pic_number_##name(pic_state *pic) \ - { \ - size_t argc, i; \ - pic_value *argv; \ - int f; \ - \ - pic_get_args(pic, "i*", &f, &argc, &argv); \ - \ - if (argc == 0) { \ - f = unit op f; \ - } \ - for (i = 0; i < argc; ++i) { \ - if (pic_int_p(argv[i])) { \ - f op##= pic_int(argv[i]); \ - } \ - else { \ - pic_errorf(pic, #op ": number required"); \ - } \ - } \ - \ - return pic_int_value(f); \ - } - -#if PIC_ENABLE_FLOAT -DEFINE_ARITH_INV_OP(-, sub, 0, true) -DEFINE_ARITH_INV_OP(/, div, 1, false) -#else -DEFINE_ARITH_INV_OP2(-, sub, 0) -DEFINE_ARITH_INV_OP2(/, div, 1) -#endif - -static pic_value -pic_number_abs(pic_state *pic) -{ -#if PIC_ENABLE_FLOAT - double f; - bool e; - - pic_get_args(pic, "F", &f, &e); - - if (e) { - return pic_int_value(f < 0 ? -f : f); - } - else { - return pic_float_value(fabs(f)); - } -#else - int i; - - pic_get_args(pic, "i", &i); - - return pic_int_value(i < 0 ? -i : i); -#endif -} - -static pic_value -pic_number_expt(pic_state *pic) -{ -#if PIC_ENABLE_FLOAT - double f, g, h; - bool e1, e2; - - pic_get_args(pic, "FF", &f, &e1, &g, &e2); - - h = pow(f, g); - if (e1 && e2) { - if (h <= INT_MAX) { - return pic_int_value((int)h); - } - } - return pic_float_value(h); -#else - int x, y, i, e = 1, r = 1, s = 0; - - pic_get_args(pic, "ii", &x, &y); - - if (y < 0) { - s = 1; - y = -y; - } - e = x; - for (i = 0; y; ++i) { - if ((y & 1) != 0) { - r *= e; - } - e *= e; - y >>= 1; - } - if (s != 0) { - r = 1 / r; - } - return pic_int_value(r); -#endif -} - -static pic_value -pic_number_floor2(pic_state *pic) -{ -#if PIC_ENABLE_FLOAT - int i, j; - bool e1, e2; - - pic_get_args(pic, "II", &i, &e1, &j, &e2); - - if (e1 && e2) { - int k; - - k = (i < 0 && j < 0) || (0 <= i && 0 <= j) - ? i / j - : (i / j) - 1; - - return pic_values2(pic, pic_int_value(k), pic_int_value(i - k * j)); - } - else { - double q, r; - - q = floor((double)i/j); - r = i - j * q; - return pic_values2(pic, pic_float_value(q), pic_float_value(r)); - } -#else - int i, j, k; - - pic_get_args(pic, "ii", &i, &j); - - k = (i < 0 && j < 0) || (0 <= i && 0 <= j) - ? i / j - : (i / j) - 1; - - return pic_values2(pic, pic_int_value(k), pic_int_value(i - k * j)); -#endif -} - -static pic_value -pic_number_trunc2(pic_state *pic) -{ -#if PIC_ENABLE_FLOAT - int i, j; - bool e1, e2; - - pic_get_args(pic, "II", &i, &e1, &j, &e2); - - if (e1 && e2) { - return pic_values2(pic, pic_int_value(i/j), pic_int_value(i - (i/j) * j)); - } - else { - double q, r; - - q = trunc((double)i/j); - r = i - j * q; - - return pic_values2(pic, pic_float_value(q), pic_float_value(r)); - } -#else - int i, j; - - pic_get_args(pic, "ii", &i, &j); - - return pic_values2(pic, pic_int_value(i/j), pic_int_value(i - (i/j) * j)); -#endif -} - -#if PIC_ENABLE_FLOAT -static pic_value -pic_number_floor(pic_state *pic) -{ - double f; - bool e; - - pic_get_args(pic, "F", &f, &e); - - if (e) { - return pic_int_value((int)f); - } - else { - return pic_float_value(floor(f)); - } -} - -static pic_value -pic_number_ceil(pic_state *pic) -{ - double f; - bool e; - - pic_get_args(pic, "F", &f, &e); - - if (e) { - return pic_int_value((int)f); - } - else { - return pic_float_value(ceil(f)); - } -} - -static pic_value -pic_number_trunc(pic_state *pic) -{ - double f; - bool e; - - pic_get_args(pic, "F", &f, &e); - - if (e) { - return pic_int_value((int)f); - } - else { - return pic_float_value(trunc(f)); - } -} - -static pic_value -pic_number_round(pic_state *pic) -{ - double f; - bool e; - - pic_get_args(pic, "F", &f, &e); - - if (e) { - return pic_int_value((int)f); - } - else { - return pic_float_value(round(f)); - } -} - -static pic_value -pic_number_inexact(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - - return pic_float_value(f); -} - -static pic_value -pic_number_exact(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - - return pic_int_value((int)(round(f))); -} -#endif - static pic_value pic_number_number_to_string(pic_state *pic) { -#if PIC_ENABLE_FLOAT double f; bool e; int radix = 10; @@ -582,46 +196,16 @@ pic_number_number_to_string(pic_state *pic) } return pic_obj_value(str); -#else - int f; - bool e; - int radix = 10; - pic_str *str; - size_t s; - char *buf; - int ival, ilen; - - pic_get_args(pic, "i|i", &f, &e, &radix); - - if (radix < 2 || radix > 36) { - pic_errorf(pic, "number->string: invalid radix %d (between 2 and 36, inclusive)", radix); - } - - ival = f; - ilen = number_string_length(ival, radix); - s = ilen + 1; - - buf = pic_malloc(pic, s); - - number_string(ival, radix, ilen, buf); - - str = pic_make_str(pic, buf, s - 1); - - pic_free(pic, buf); - - return pic_obj_value(str); -#endif } static pic_value pic_number_string_to_number(pic_state *pic) { -#if PIC_ENABLE_FLOAT const char *str; int radix = 10; long num; char *eptr; - double flo; + pic_value flo; pic_get_args(pic, "z|i", &str, &radix); @@ -632,188 +216,30 @@ pic_number_string_to_number(pic_state *pic) : pic_float_value(num); } - flo = strtod(str, &eptr); - if (*eptr == '\0') { - return pic_float_value(flo); + flo = pic_read_cstr(pic, str); + if (pic_int_p(flo) || pic_float_p(flo)) { + return flo; } pic_errorf(pic, "invalid string given: %s", str); -#else - const char *str; - int radix = 10; - long num; - char *eptr; - - pic_get_args(pic, "z|i", &str, &radix); - - num = strtol(str, &eptr, radix); - if (*eptr == '\0') { - return pic_int_value(num); - } - - pic_errorf(pic, "invalid string given: %s", str); -#endif } -#if PIC_ENABLE_FLOAT -static pic_value -pic_number_finite_p(pic_state *pic) -{ - pic_value v; - - pic_get_args(pic, "o", &v); - - if (pic_int_p(v)) - return pic_true_value(); - if (pic_float_p(v) && ! (isinf(pic_float(v)) || isnan(pic_float(v)))) - return pic_true_value(); - else - return pic_false_value(); -} - -static pic_value -pic_number_infinite_p(pic_state *pic) -{ - pic_value v; - - pic_get_args(pic, "o", &v); - - if (pic_float_p(v) && isinf(pic_float(v))) - return pic_true_value(); - else - return pic_false_value(); -} - -static pic_value -pic_number_nan_p(pic_state *pic) -{ - pic_value v; - - pic_get_args(pic, "o", &v); - - if (pic_float_p(v) && isnan(pic_float(v))) - return pic_true_value(); - else - return pic_false_value(); -} - -static pic_value -pic_number_exp(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - return pic_float_value(exp(f)); -} - -static pic_value -pic_number_log(pic_state *pic) -{ - double f,g; - int argc; - - argc = pic_get_args(pic, "f|f", &f, &g); - if (argc == 1) { - return pic_float_value(log(f)); - } - else { - return pic_float_value(log(f) / log(g)); - } -} - -static pic_value -pic_number_sin(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - f = sin(f); - return pic_float_value(f); -} - -static pic_value -pic_number_cos(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - f = cos(f); - return pic_float_value(f); -} - -static pic_value -pic_number_tan(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - f = tan(f); - return pic_float_value(f); -} - -static pic_value -pic_number_acos(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - f = acos(f); - return pic_float_value(f); -} - -static pic_value -pic_number_asin(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - f = asin(f); - return pic_float_value(f); -} - -static pic_value -pic_number_atan(pic_state *pic) -{ - double f,g; - int argc; - - argc = pic_get_args(pic, "f|f", &f, &g); - if (argc == 1) { - f = atan(f); - return pic_float_value(f); - } - else { - return pic_float_value(atan2(f,g)); - } -} - -static pic_value -pic_number_sqrt(pic_state *pic) -{ - double f; - - pic_get_args(pic, "f", &f); - - return pic_float_value(sqrt(f)); -} -#endif - void pic_init_number(pic_state *pic) { size_t ai = pic_gc_arena_preserve(pic); - pic_defun(pic, "number?", pic_number_real_p); - pic_defun(pic, "complex?", pic_number_real_p); - pic_defun(pic, "real?", pic_number_real_p); - pic_defun(pic, "rational?", pic_number_real_p); - pic_defun(pic, "integer?", pic_number_integer_p); + pic_defun(pic, "number?", pic_number_number_p); pic_gc_arena_restore(pic, ai); pic_defun(pic, "exact?", pic_number_exact_p); pic_defun(pic, "inexact?", pic_number_inexact_p); pic_gc_arena_restore(pic, ai); + pic_defun(pic, "inexact", pic_number_inexact); + pic_defun(pic, "exact", pic_number_exact); + pic_gc_arena_restore(pic, ai); + pic_defun(pic, "=", pic_number_eq); pic_defun(pic, "<", pic_number_lt); pic_defun(pic, ">", pic_number_gt); @@ -827,49 +253,7 @@ pic_init_number(pic_state *pic) pic_defun(pic, "/", pic_number_div); pic_gc_arena_restore(pic, ai); - pic_defun(pic, "abs", pic_number_abs); - pic_defun(pic, "expt", pic_number_expt); - pic_gc_arena_restore(pic, ai); - - pic_defun(pic, "floor/", pic_number_floor2); - pic_defun(pic, "truncate/", pic_number_trunc2); - pic_gc_arena_restore(pic, ai); - -#if PIC_ENABLE_FLOAT - pic_defun(pic, "floor", pic_number_floor); - pic_defun(pic, "ceiling", pic_number_ceil); - pic_defun(pic, "truncate", pic_number_trunc); - pic_defun(pic, "round", pic_number_round); - pic_defun(pic, "inexact", pic_number_inexact); - pic_defun(pic, "exact", pic_number_exact); - pic_gc_arena_restore(pic, ai); -#else - pic_defun(pic, "floor", pic_number_id); - pic_defun(pic, "ceiling", pic_number_id); - pic_defun(pic, "truncate", pic_number_id); - pic_defun(pic, "round", pic_number_id); - pic_defun(pic, "inexact", pic_number_id); - pic_defun(pic, "exact", pic_number_id); - pic_gc_arena_restore(pic, ai); -#endif - pic_defun(pic, "number->string", pic_number_number_to_string); pic_defun(pic, "string->number", pic_number_string_to_number); pic_gc_arena_restore(pic, ai); - -#if PIC_ENABLE_FLOAT - pic_defun(pic, "finite?", pic_number_finite_p); - pic_defun(pic, "infinite?", pic_number_infinite_p); - pic_defun(pic, "nan?", pic_number_nan_p); - pic_defun(pic, "sqrt", pic_number_sqrt); - pic_defun(pic, "exp", pic_number_exp); - pic_defun(pic, "log", pic_number_log); - pic_defun(pic, "sin", pic_number_sin); - pic_defun(pic, "cos", pic_number_cos); - pic_defun(pic, "tan", pic_number_tan); - pic_defun(pic, "acos", pic_number_acos); - pic_defun(pic, "asin", pic_number_asin); - pic_defun(pic, "atan", pic_number_atan); - pic_gc_arena_restore(pic, ai); -#endif } diff --git a/extlib/benz/read.c b/extlib/benz/read.c index 3c13fd03..6051ecf7 100644 --- a/extlib/benz/read.c +++ b/extlib/benz/read.c @@ -64,7 +64,6 @@ isdelim(int c) return c == EOF || strchr("();,|\" \t\n\r", c) != NULL; /* ignores "#", "'" */ } -#if PIC_ENABLE_FLOAT static bool strcaseeq(const char *s1, const char *s2) { @@ -76,7 +75,6 @@ strcaseeq(const char *s1, const char *s2) } return a == b; } -#endif static int case_fold(pic_state *pic, int c) @@ -271,8 +269,7 @@ read_unsigned(pic_state *pic, struct pic_port *port, int c) u = read_uinteger(pic, port, c); switch (peek(pic, port)) { -#if PIC_ENABLE_FLOAT -# if PIC_ENABLE_LIBC +#if PIC_ENABLE_LIBC case '.': { char buf[256]; i = sprintf(buf, "%d", u); @@ -283,16 +280,20 @@ read_unsigned(pic_state *pic, struct pic_port *port, int c) sprintf(buf + i, "e%d", read_suffix(pic, port)); return pic_float_value(atof(buf)); } -# else +#else case '.': { - double f, g; + double f, g, h; next(pic, port); g = 0, e = 0; while (isdigit(c = peek(pic, port))) { g = g * 10 + (next(pic, port) - '0'); e++; } - f = u + g * pow(10, -e); + h = 1.0; + while (e-- > 0) { + h /= 10; + } + f = u + g * h; exp = read_suffix(pic, port); if (exp >= 0) { @@ -312,7 +313,6 @@ read_unsigned(pic_state *pic, struct pic_port *port, int c) } return pic_float_value(f); } -# endif #endif default: @@ -346,15 +346,11 @@ read_number(pic_state *pic, struct pic_port *port, int c) static pic_value negate(pic_value n) { -#if PIC_ENABLE_FLOAT if (pic_int_p(n)) { return pic_int_value(-pic_int(n)); } else { return pic_float_value(-pic_float(n)); } -#else - return pic_int_value(-pic_int(n)); -#endif } static pic_value @@ -367,14 +363,12 @@ read_minus(pic_state *pic, struct pic_port *port, int c) } else { sym = read_symbol(pic, port, c); -#if PIC_ENABLE_FLOAT if (strcaseeq(pic_symbol_name(pic, pic_sym_ptr(sym)), "-inf.0")) { - return pic_float_value(-INFINITY); + return pic_float_value(-(1.0 / 0.0)); } if (strcaseeq(pic_symbol_name(pic, pic_sym_ptr(sym)), "-nan.0")) { - return pic_float_value(-NAN); + return pic_float_value(-(0.0 / 0.0)); } -#endif return sym; } } @@ -389,14 +383,12 @@ read_plus(pic_state *pic, struct pic_port *port, int c) } else { sym = read_symbol(pic, port, c); -#if PIC_ENABLE_FLOAT if (strcaseeq(pic_symbol_name(pic, pic_sym_ptr(sym)), "+inf.0")) { - return pic_float_value(INFINITY); + return pic_float_value(1.0 / 0.0); } if (strcaseeq(pic_symbol_name(pic, pic_sym_ptr(sym)), "+nan.0")) { - return pic_float_value(NAN); + return pic_float_value(0.0 / 0.0); } -#endif return sym; } } diff --git a/extlib/benz/state.c b/extlib/benz/state.c index bb587966..7fcb51bf 100644 --- a/extlib/benz/state.c +++ b/extlib/benz/state.c @@ -48,7 +48,7 @@ pic_init_features(pic_state *pic) { pic_add_feature(pic, "picrin"); -#if PIC_ENABLE_FLOAT +#if __STDC_IEC_559__ pic_add_feature(pic, "ieee-float"); #endif diff --git a/extlib/benz/string.c b/extlib/benz/string.c index f94dfd50..ac1b2449 100644 --- a/extlib/benz/string.c +++ b/extlib/benz/string.c @@ -316,11 +316,9 @@ pic_xvfformat(pic_state *pic, xFILE *file, const char *fmt, va_list ap) case 'p': xfprintf(pic, file, "%p", va_arg(ap, void *)); break; -#if PIC_ENABLE_FLOAT case 'f': xfprintf(pic, file, "%f", va_arg(ap, double)); break; -#endif } break; case '~': diff --git a/extlib/benz/vm.c b/extlib/benz/vm.c index 4ab5a644..8068f933 100644 --- a/extlib/benz/vm.c +++ b/extlib/benz/vm.c @@ -103,7 +103,6 @@ pic_get_args(pic_state *pic, const char *format, ...) *p = GET_OPERAND(pic,i); break; } -#if PIC_ENABLE_FLOAT case 'f': { double *f; pic_value v; @@ -169,7 +168,6 @@ pic_get_args(pic_state *pic, const char *format, ...) } break; } -#endif case 'i': { int *k; pic_value v; @@ -178,11 +176,9 @@ pic_get_args(pic_state *pic, const char *format, ...) v = GET_OPERAND(pic, i); switch (pic_type(v)) { -#if PIC_ENABLE_FLOAT case PIC_TT_FLOAT: *k = (int)pic_float(v); break; -#endif case PIC_TT_INT: *k = pic_int(v); break; diff --git a/extlib/benz/write.c b/extlib/benz/write.c index 124ae7b4..88f63804 100644 --- a/extlib/benz/write.c +++ b/extlib/benz/write.c @@ -101,19 +101,19 @@ write_str(pic_state *pic, pic_str *str, xFILE *file, int mode) xfprintf(pic, file, "\""); } -#if PIC_ENABLE_FLOAT static void write_float(pic_state *pic, double f, xFILE *file) { - if (isnan(f)) { - xfprintf(pic, file, signbit(f) ? "-nan.0" : "+nan.0"); - } else if (isinf(f)) { - xfprintf(pic, file, signbit(f) ? "-inf.0" : "+inf.0"); + if (f != f) { + xfprintf(pic, file, "+nan.0"); + } else if (f == 1.0 / 0.0) { + xfprintf(pic, file, "+inf.0"); + } else if (f == -1.0 / 0.0) { + xfprintf(pic, file, "-inf.0"); } else { xfprintf(pic, file, "%f", f); } } -#endif static void write_core(struct writer_control *p, pic_value); @@ -291,11 +291,9 @@ write_core(struct writer_control *p, pic_value obj) case PIC_TT_INT: xfprintf(pic, file, "%d", pic_int(obj)); break; -#if PIC_ENABLE_FLOAT case PIC_TT_FLOAT: write_float(pic, pic_float(obj), file); break; -#endif case PIC_TT_SYMBOL: xfprintf(pic, file, "%s", pic_symbol_name(pic, pic_sym_ptr(obj))); break;