diff --git a/lisp/kernel.gl b/lisp/kernel.gl index bb7ff20..d253427 100644 --- a/lisp/kernel.gl +++ b/lisp/kernel.gl @@ -23,4 +23,4 @@ (princ datum print-char-fun) (funcall (or print-char-fun 'write-byte) ?\n)) -(princln (/ 1 0.0)) +(princln (type-of (+ 1 most-positive-fixnum))) diff --git a/src/base.c b/src/base.c index 44dc5b1..4626e93 100644 --- a/src/base.c +++ b/src/base.c @@ -69,6 +69,11 @@ DEFINE_SYMBOL(unbound, "unbound"); DEFVAR(lexical_environment, "lexical-environment", "", Qnil); DEFINE_SYMBOL(lexical_tags, "lexical-tags"); +DEFCONST(most_positive_fixnum, "most-positive-fixnum", "", + MAKE_FIXNUM(MOST_POSITIVE_FIXNUM)); +DEFCONST(most_negative_fixnum, "most-negative-fixnum", "", + MAKE_FIXNUM(MOST_NEGATIVE_FIXNUM)); + DEFUN(id, "id", (LispVal * obj), "(id)", "") { // TODO not all values are handled here return MAKE_FIXNUM((uintptr_t) obj); @@ -230,6 +235,9 @@ DEFINE_SYMBOL(symbol, "symbol"); DEFINE_SYMBOL(hash_table, "hash-table"); // function defind above DEFINE_SYMBOL(bignum, "bignum"); +DEFINE_SYMBOL(special_form, "special-form"); +DEFINE_SYMBOL(builtin_function, "builtin-function"); +DEFINE_SYMBOL(interp_function, "interp-function"); LispVal *symbol_for_type(LispValType type) { switch (type) { @@ -255,6 +263,20 @@ LispVal *symbol_for_type(LispValType type) { abort(); } } +DEFUN(type_of, "type-of", (LispVal * val), "(val)", "") { + LispValType type = TYPE_OF(val); + if (type == TYPE_FUNCTION) { + LispFunction *fobj = val; + if (fobj->type == FUNCTION_NATIVE) { + return fobj->impl.native.no_eval_args ? Qspecial_form + : Qbuiltin_function; + } else { + return Qinterp_function; + } + } else { + return symbol_for_type(type); + } +} DEFINE_SYMBOL(condition_class, "condition-class"); diff --git a/src/base.h b/src/base.h index dc0edd8..be4296b 100644 --- a/src/base.h +++ b/src/base.h @@ -271,6 +271,8 @@ DEFOBJTYPE(Vector, VECTOR, VECTORP, { return (init_val); \ } \ LispVal *V##cname +#define DEFCONST(cname, lisp_name, doc, init_val) \ + DEFVAR(cname, lisp_name, doc, init_val) #define DEFUN(cname, lisp_name, cargs, lisp_args, doc) \ DEFINE_SYMBOL(cname, lisp_name); \ @@ -304,13 +306,18 @@ DEFOBJTYPE(Vector, VECTOR, VECTORP, { lisp_gc_register_static_object(Q##cname); \ } #define REGISTER_GLOBAL_VARIABLE(cname) \ - REGISTER_GLOBAL_SYMBOL(cname); \ { \ + REGISTER_GLOBAL_SYMBOL(cname); \ V##cname = internal_V##cname##_init(); \ ((LispSymbol *) Q##cname)->value_type = SYMBOL_NATIVE; \ ((LispSymbol *) Q##cname)->value.native = &V##cname; \ ((LispSymbol *) Q##cname)->flags |= SYMBOL_DYNAMIC; \ } +#define REGISTER_GLOBAL_CONSTANT(cname) \ + { \ + REGISTER_GLOBAL_VARIABLE(cname); \ + ((LispSymbol *) Q##cname)->flags |= SYMBOL_CONST_VALUE; \ + } #define REGISTER_GLOBAL_FUNCTION(cname) \ { \ REGISTER_GLOBAL_SYMBOL(cname); \ @@ -345,7 +352,10 @@ DECLARE_SYMBOL(t); // these are uninterned DECLARE_SYMBOL(unbound); DECLARE_VARIABLE(lexical_environment); -DECLARE_VARIABLE(lexical_tags); +DECLARE_SYMBOL(lexical_tags); + +DECLARE_VARIABLE(most_positive_fixnum); +DECLARE_VARIABLE(most_negative_fixnum); extern LispVal *Vlexical_environment; @@ -434,8 +444,12 @@ DECLARE_SYMBOL(symbol); DECLARE_SYMBOL(hash_table); // function defined above DECLARE_SYMBOL(bignum); +DECLARE_SYMBOL(special_form); +DECLARE_SYMBOL(builtin_function); +DECLARE_SYMBOL(interp_function); LispVal *symbol_for_type(LispValType type); +DECLARE_FUNCTION(type_of, (LispVal * val)); // condition stuff DECLARE_SYMBOL(condition_class); diff --git a/src/gen-init-globals.awk b/src/gen-init-globals.awk index f963bd4..0f25ff9 100644 --- a/src/gen-init-globals.awk +++ b/src/gen-init-globals.awk @@ -102,6 +102,11 @@ function maybe_emit_next_symbol(entity) { maybe_emit_next_symbol("VARIABLE") } +/DEFCONST\(/ { + maybe_print_file_header() + maybe_emit_next_symbol("CONSTANT") +} + /DEFINE_CONDITION_CLASS\(/ { maybe_print_file_header() maybe_emit_next_symbol("CONDITION_CLASS") diff --git a/src/lisp_math.c b/src/lisp_math.c index d756300..28a4bcf 100644 --- a/src/lisp_math.c +++ b/src/lisp_math.c @@ -94,7 +94,7 @@ static inline LispVal *type_for_operator(enum Operator op) { LispVal *float_math_driver(enum Operator op, bool first, lisp_float_t acc, LispVal *nums) { - assert(LISP_FLOAT_P(XCAR(nums))); + assert(!first || LISP_FLOAT_P(XCAR(nums))); switch (op) { case OPERATOR_AND: case OPERATOR_IOR: @@ -141,7 +141,7 @@ LispVal *float_math_driver(enum Operator op, bool first, lisp_float_t acc, LispVal *gmp_math_driver(enum Operator op, bool first, fixnum_t fixnum_acc, LispVal *nums) { - assert(LISP_GMP_P(XCAR(nums))); + assert(!first || LISP_GMP_P(XCAR(nums))); LispGmp *acc = make_gmp(fixnum_acc); if (first) { mpz_set(acc->val, ((LispGmp *) XCAR(nums))->val); @@ -233,7 +233,7 @@ LispVal *gmp_math_driver(enum Operator op, bool first, fixnum_t fixnum_acc, } } if (mpz_cmp_si(acc->val, MOST_POSITIVE_FIXNUM) <= 0 - || mpz_cmp_si(acc->val, MOST_NEGATIVE_FIXNUM) >= 0) { + && mpz_cmp_si(acc->val, MOST_NEGATIVE_FIXNUM) >= 0) { return MAKE_FIXNUM(mpz_get_si(acc->val)); } return acc; @@ -285,7 +285,8 @@ LispVal *math_driver(enum Operator op, LispVal *nums) { default: abort(); } - if (did_overflow) { + if (did_overflow || out > MOST_POSITIVE_FIXNUM + || out < MOST_NEGATIVE_FIXNUM) { break; } acc = out;