shithub: femtolisp

Download patch

ref: b3b2bc3300fb543195a92c1e4ee3f506aca2b3f7
parent: 135492d18ca5251271e0a25e3b70c5c92c6ebd18
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Fri Jul 11 22:58:55 EDT 2008

fix to how defun was using macroexpand



--- a/femtolisp/system.lsp
+++ b/femtolisp/system.lsp
@@ -86,6 +86,9 @@
 
 (define (cadr x) (car (cdr x)))
 
+(setq *special-forms* '(quote cond if and or while lambda label trycatch
+                        %top progn))
+
 (defun macroexpand (e)
   ((label mexpand
           (lambda (e env f)
@@ -94,15 +97,20 @@
                           (not (member (car e) env))
                           (set 'f (macrocallp e)))
                 (set 'e (apply f (cdr e))))
-              (if (and (consp e)
-                       (not (eq (car e) 'quote)))
-                  (let ((newenv
-                         (if (and (eq (car e) 'lambda)
-                                  (consp (cdr e)))
-                             (append.2 (cadr e) env)
-                           env)))
-                    (map (lambda (x) (mexpand x newenv nil)) e))
-                e))))
+              (cond ((and (consp e)
+                          (not (eq (car e) 'quote)))
+                     (let ((newenv
+                            (if (and (or (eq (car e) 'lambda)
+                                         (eq (car e) 'label))
+                                     (consp (cdr e)))
+                                (append.2 (cadr e) env)
+                              env)))
+                       (map (lambda (x) (mexpand x newenv nil)) 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))
 
 ; uncomment this to macroexpand functions at definition time.
@@ -109,13 +117,13 @@
 ; makes typical code ~25% faster, but only works for defun expressions
 ; at the top level.
 (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
 ; defined at the top level.
 (defmacro defmacro (name args . body)
   (list 'set-syntax (list 'quote name)
-        (list 'lambda args (macroexpand (f-body body)))))
+        (macroexpand (list 'lambda args (f-body body)))))
 
 (setq =   equal)
 (setq eql equal)
--- a/femtolisp/todo
+++ b/femtolisp/todo
@@ -112,7 +112,16 @@
 - a special version of apply that takes arguments on the stack, to avoid
   consing when implementing "call-with" style primitives like trycatch,
   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:
 * with the fully recursive (simpler) relocate(), the size of cons chains