ref: c1610f0a9f1afa826cc2cbabb0e218fa6437a574
parent: 7883a5de0b22fcb25d78e333d740bad8153004d4
author: JeffBezanson <[email protected]>
date: Thu Feb 26 13:15:38 EST 2009
changing load to expand each expression before evaluating improve performance by reloading system.lsp with this loader other misc. changes
--- 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
--- a/femtolisp/flisp.h
+++ b/femtolisp/flisp.h
@@ -111,7 +111,8 @@
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,
};
--- 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)))