lassik
/
upscheme
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

fix to how defun was using macroexpand

This commit is contained in:
JeffBezanson 2008-07-12 02:58:55 +00:00
parent 135492d18c
commit b3b2bc3300
2 changed files with 29 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
femtolisp/system.lsp
View File

@ -86,6 +86,9 @@
(define (cadr x) (car (cdr x))) (define (cadr x) (car (cdr x)))
(setq *special-forms* '(quote cond if and or while lambda label trycatch
%top progn))
(defun macroexpand (e) (defun macroexpand (e)
((label mexpand ((label mexpand
(lambda (e env f) (lambda (e env f)
@ -94,28 +97,33 @@
(not (member (car e) env)) (not (member (car e) env))
(set 'f (macrocallp e))) (set 'f (macrocallp e)))
(set 'e (apply f (cdr e)))) (set 'e (apply f (cdr e))))
(if (and (consp e) (cond ((and (consp e)
(not (eq (car e) 'quote))) (not (eq (car e) 'quote)))
(let ((newenv (let ((newenv
(if (and (eq (car e) 'lambda) (if (and (or (eq (car e) 'lambda)
(eq (car e) 'label))
(consp (cdr e))) (consp (cdr e)))
(append.2 (cadr e) env) (append.2 (cadr e) env)
env))) env)))
(map (lambda (x) (mexpand x newenv nil)) e)) (map (lambda (x) (mexpand x newenv nil)) e)))
e)))) ;((and (symbolp e) (constantp e)) (eval e))
;((and (symbolp e)
; (not (member e *special-forms*))
; (not (member e env))) (cons '%top e))
(T e)))))
e nil nil)) e nil nil))
; uncomment this to macroexpand functions at definition time. ; uncomment this to macroexpand functions at definition time.
; makes typical code ~25% faster, but only works for defun expressions ; makes typical code ~25% faster, but only works for defun expressions
; at the top level. ; at the top level.
(defmacro defun (name args . body) (defmacro defun (name args . body)
(list 'setq name (list 'lambda args (macroexpand (f-body body))))) (list 'setq name (macroexpand (list 'lambda args (f-body body)))))
; same thing for macros. enabled by default because macros are usually ; same thing for macros. enabled by default because macros are usually
; defined at the top level. ; defined at the top level.
(defmacro defmacro (name args . body) (defmacro defmacro (name args . body)
(list 'set-syntax (list 'quote name) (list 'set-syntax (list 'quote name)
(list 'lambda args (macroexpand (f-body body))))) (macroexpand (list 'lambda args (f-body body)))))
(setq = equal) (setq = equal)
(setq eql equal) (setq eql equal)

11
femtolisp/todo
View File

@ -112,7 +112,16 @@ for internal use:
- a special version of apply that takes arguments on the stack, to avoid - a special version of apply that takes arguments on the stack, to avoid
consing when implementing "call-with" style primitives like trycatch, consing when implementing "call-with" style primitives like trycatch,
hashtable-foreach, or the fl_apply API hashtable-foreach, or the fl_apply API
try this environment representation:
for all kinds of functions (except maybe builtin special forms) push
all arguments on the stack, either evaluated or not.
for lambdas, push the lambda list and next-env pointers.
to capture, save the n+2 pointers to a vector
. this uses n+2 heap or stack words per environment instead of 2n+1 words
. argument handling is more uniform which could lead to simplifications,
and a more efficient apply() entry point
. disadvantage is looking through the lambda list on every lookup. maybe
improve by making lambda lists vectors somehow?
bugs: bugs:
* with the fully recursive (simpler) relocate(), the size of cons chains * with the fully recursive (simpler) relocate(), the size of cons chains