adding top-level-value and set-top-level-value!, using them instead of

set and eval where appropriate
adding separate integer? and integer-valued? predicates

femtolisp/builtins.c

@@ -129,6 +129,24 @@ static value_t fl_intern(value_t *args, u_int32_t nargs)
     return symbol(cvalue_data(args[0]));
 }
 
+static value_t fl_top_level_value(value_t *args, u_int32_t nargs)
+{
+    argcount("top-level-value", nargs, 1);
+    symbol_t *sym = tosymbol(args[0], "top-level-value");
+    if (sym->binding == UNBOUND)
+        raise(list2(UnboundError, args[0]));
+    return sym->binding;
+}
+
+static value_t fl_set_top_level_value(value_t *args, u_int32_t nargs)
+{
+    argcount("set-top-level-value!", nargs, 2);
+    symbol_t *sym = tosymbol(args[0], "set-top-level-value!");
+    if (sym->syntax != TAG_CONST)
+        sym->binding = args[1];
+    return args[1];
+}
+
 extern value_t LAMBDA, COMPILEDLAMBDA;
 
 static value_t fl_setsyntax(value_t *args, u_int32_t nargs)
@@ -202,9 +220,9 @@ static value_t fl_constantp(value_t *args, u_int32_t nargs)
     return FL_T;
 }
 
-static value_t fl_integerp(value_t *args, u_int32_t nargs)
+static value_t fl_integer_valuedp(value_t *args, u_int32_t nargs)
 {
-    argcount("integer?", nargs, 1);
+    argcount("integer-valued?", nargs, 1);
     value_t v = args[0];
     if (isfixnum(v)) {
         return FL_T;
@@ -231,6 +249,14 @@ static value_t fl_integerp(value_t *args, u_int32_t nargs)
     return FL_F;
 }
 
+static value_t fl_integerp(value_t *args, u_int32_t nargs)
+{
+    argcount("integer?", nargs, 1);
+    value_t v = args[0];
+    return (isfixnum(v) ||
+            (iscprim(v) && cp_numtype((cprim_t*)ptr(v)) < T_FLOAT));
+}
+
 static value_t fl_fixnum(value_t *args, u_int32_t nargs)
 {
     argcount("fixnum", nargs, 1);
@@ -407,13 +433,16 @@ static builtinspec_t builtin_info[] = {
     { "symbol-syntax", fl_symbolsyntax },
     { "environment", fl_global_env },
     { "constant?", fl_constantp },
+    { "top-level-value", fl_top_level_value },
+    { "set-top-level-value!", fl_set_top_level_value },
     { "raise", fl_raise },
-
     { "exit", fl_exit },
     { "intern", fl_intern },
+
     { "fixnum", fl_fixnum },
     { "truncate", fl_truncate },
     { "integer?", fl_integerp },
+    { "integer-valued?", fl_integer_valuedp },
     { "nconc", fl_nconc },
     { "assq", fl_assq },
     { "memq", fl_memq },

femtolisp/compiler.lsp

@@ -352,8 +352,8 @@
 		    (not (in-env? head env))
 		    (bound? head)
 		    (constant? head)
-		    (builtin? (eval head)))
-	       (eval head)
+		    (builtin? (top-level-value head)))
+	       (top-level-value head)
 	       head)))
       (let ((b (and (builtin? head)
 		    (builtin->instruction head))))

femtolisp/cps.lsp

@@ -76,7 +76,7 @@
         (#t           (rest->cps prim->cps form k argsyms))))
 
 (define *top-k* (gensym))
-(set *top-k* identity)
+(set-top-level-value! *top-k* identity)
 
 (define (cps form)
   (η-reduce

femtolisp/flisp.h

@@ -171,6 +171,7 @@ void raise(value_t e) __attribute__ ((__noreturn__));
 void type_error(char *fname, char *expected, value_t got) __attribute__ ((__noreturn__));
 void bounds_error(char *fname, value_t arr, value_t ind) __attribute__ ((__noreturn__));
 extern value_t ArgError, IOError, KeyError, MemoryError, EnumerationError;
+extern value_t UnboundError;
 static inline void argcount(char *fname, uint32_t nargs, uint32_t c)
 {
     if (__unlikely(nargs != c))

femtolisp/system.lsp

@@ -21,8 +21,6 @@
       (list 'set! form (car body))
       (list 'set! (car form) (list 'lambda (cdr form) (f-body body)))))
 
-(define (set s v) (eval (list 'set! s (list 'quote v))))
-
 (define (map f lst)
   (if (atom? lst) lst
       (cons (f (car lst)) (map f (cdr lst)))))
@@ -298,7 +296,8 @@
   (or (and (atom? x)
            (not (symbol? x)))
       (and (constant? x)
-           (eq x (eval x)))))
+	   (symbol? x)
+           (eq x (top-level-value x)))))
 
 (define-macro (backquote x) (bq-process x))
 
@@ -451,11 +450,11 @@
 (define-macro (assert expr) `(if ,expr #t (raise '(assert-failed ,expr))))
 
 (define (trace sym)
-  (let* ((lam  (eval sym))
+  (let* ((lam  (top-level-value sym))
 	 (args (cadr lam))
 	 (al   (to-proper args)))
     (if (not (eq? (car lam) 'trace-lambda))
-	(set sym
+	(set-top-level-value! sym
 	     `(trace-lambda ,args
 	        (begin
 		  (princ "(")
@@ -469,9 +468,9 @@
   'ok)
 
 (define (untrace sym)
-  (let ((lam  (eval sym)))
+  (let ((lam  (top-level-value sym)))
     (if (eq? (car lam) 'trace-lambda)
-	(set sym
+	(set-top-level-value! sym
 	     (cadr (caar (last-pair (caddr lam))))))))
 
 (define-macro (time expr)
@@ -679,7 +678,7 @@
 		       (lambda (e) (begin (io.discardbuffer *input-stream*)
 					  (raise e))))))
       (and (not (io.eof? *input-stream*))
-	   (let ((V (eval (expand v))))
+	   (let ((V (load-process v)))
 	     (print V)
 	     (set! that V)
 	     #t))))