Fix math stuff

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)))

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");
 

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);

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")

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;