From c1610f0a9f1afa826cc2cbabb0e218fa6437a574 Mon Sep 17 00:00:00 2001
From: JeffBezanson <jeff.bezanson@gmail.com>
Date: Thu, 26 Feb 2009 18:15:38 +0000
Subject: [PATCH] changing load to expand each expression before evaluating
 improve performance by reloading system.lsp with this loader other misc.
 changes

---
 femtolisp/flisp.c    | 14 ++++++++++++--
 femtolisp/flisp.h    |  3 ++-
 femtolisp/system.lsp | 40 +++++++++++++++++++++-------------------
 3 files changed, 35 insertions(+), 22 deletions(-)

diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c
index 05201ef..299311f 100644
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -51,16 +51,26 @@
 #include "flisp.h"
 
 static char *builtin_names[] =
-    { "quote", "cond", "if", "and", "or", "while", "lambda",
+    { // special forms
+      "quote", "cond", "if", "and", "or", "while", "lambda",
       "trycatch", "%apply", "set!", "begin",
 
+      // predicates
       "eq?", "eqv?", "equal?", "atom?", "not", "null?", "boolean?", "symbol?",
       "number?", "bound?", "pair?", "builtin?", "vector?", "fixnum?",
 
+      // lists
       "cons", "list", "car", "cdr", "set-car!", "set-cdr!",
+
+      // execution
       "eval", "eval*", "apply", "prog1", "raise",
+
+      // arithmetic
       "+", "-", "*", "/", "<", "lognot", "logand", "logior", "logxor",
-      "vector", "aref", "aset!", "length", "assq", "compare", "for",
+      "compare",
+
+      // sequences
+      "vector", "aref", "aset!", "length", "assq", "for",
       "", "", "" };
 
 #define N_STACK 98304
diff --git a/femtolisp/flisp.h b/femtolisp/flisp.h
index 3ae3f27..c2901d0 100644
--- a/femtolisp/flisp.h
+++ b/femtolisp/flisp.h
@@ -111,7 +111,8 @@ enum {
     F_CONS, F_LIST, F_CAR, F_CDR, F_SETCAR, F_SETCDR,
     F_EVAL, F_EVALSTAR, F_APPLY, F_PROG1, F_RAISE,
     F_ADD, F_SUB, F_MUL, F_DIV, F_LT, F_BNOT, F_BAND, F_BOR, F_BXOR,
-    F_VECTOR, F_AREF, F_ASET, F_LENGTH, F_ASSQ, F_COMPARE, F_FOR,
+    F_COMPARE,
+    F_VECTOR, F_AREF, F_ASET, F_LENGTH, F_ASSQ, F_FOR,
     F_TRUE, F_FALSE, F_NIL,
     N_BUILTINS,
 };
diff --git a/femtolisp/system.lsp b/femtolisp/system.lsp
index 0399213..6f90d03 100644
--- a/femtolisp/system.lsp
+++ b/femtolisp/system.lsp
@@ -3,12 +3,14 @@
 ; by Jeff Bezanson (C) 2009
 ; Distributed under the BSD License
 
-(set-constant! 'eq       eq?)
-(set-constant! 'eqv      eqv?)
-(set-constant! 'equal    equal?)
-(set-constant! 'rplaca   set-car!)
-(set-constant! 'rplacd   set-cdr!)
-(set-constant! 'char?    (lambda (x) (eq? (typeof x) 'wchar)))
+(if (not (bound? 'eq))
+    (begin
+      (set-constant! 'eq       eq?)
+      (set-constant! 'eqv      eqv?)
+      (set-constant! 'equal    equal?)
+      (set-constant! 'rplaca   set-car!)
+      (set-constant! 'rplacd   set-cdr!)
+      (set-constant! 'char?    (lambda (x) (eq? (typeof x) 'wchar)))))
 
 ; convert a sequence of body statements to a single expression.
 ; this allows define, defun, defmacro, let, etc. to contain multiple
@@ -149,16 +151,6 @@
                     (#t e)))))
    e () ()))
 
-(define-macro (define form . body)
-  (if (symbol? form)
-      (list 'set! form (car body))
-      (list 'set! (car form)
-	    (macroexpand (list 'lambda (cdr form) (f-body body))))))
-(define-macro (define-macro form . body)
-  (list 'set-syntax! (list 'quote (car form))
-	(macroexpand (list 'lambda (cdr form) (f-body body)))))
-(define macroexpand (macroexpand macroexpand))
-
 (define (delete-duplicates lst)
   (if (atom? lst)
       lst
@@ -198,9 +190,11 @@
 
 (define-macro (body . forms) (f-body forms))
 
+(define (expand x) (macroexpand x))
+
 (define =   eqv)
 (define eql eqv)
-(define (/= a b) (not (equal a b)))
+(define (/= a b) (not (eqv a b)))
 (define != /=)
 (define (>  a b) (< b a))
 (define (<= a b) (not (< b a)))
@@ -533,9 +527,9 @@
        (if (not (io.eof? F))
 	   (next (read F)
                  prev
-		 (eval E))
+		 (eval (expand E)))
 	   (begin (io.close F)
-		  (eval E)))) ; evaluate last form in almost-tail position
+		  (eval (expand E))))) ; evaluate last form in almost-tail position
      (lambda (e)
        (begin
 	 (io.close F)
@@ -614,7 +608,15 @@
 	    (lambda (e) (begin (print-exception e)
 			       (exit 1)))))
 
+(if (or (eq? *os-name* 'win32)
+	(eq? *os-name* 'win64)
+	(eq? *os-name* 'windows))
+    (define *directory-separator* "\\")
+    (define *directory-separator* "/"))
+
 (define (__start . argv)
+  ; reload this file with our new definition of load
+  (load (string *install-dir* *directory-separator* "system.lsp"))
   (if (pair? (cdr argv))
       (begin (set! *argv* (cdr argv))
 	     (__script (cadr argv)))