Merge branch 'master' into stack

Conflicts:
	sb-eval2.lisp

1 files changed, 49 insertions, 30 deletions

diff --git a/sb-eval2.lisp b/sb-eval2.lisp
index 61aafae..f5c3ad8 100644
--- a/sb-eval2.lisp
+++ b/sb-eval2.lisp
@@ -5,8 +5,8 @@
 
 (in-package "SB-EVAL2")
 
-#+(or)
-(setq SB-EXT:*EVALUATOR-MODE* :interpret)
+;;(declaim (optimize (debug 3) (space 0) (speed 0) (safety 3) (compilation-speed 0)))
+(declaim (optimize (debug 0) (space 0) (speed 3) (safety 0) (compilation-speed 0)))
 
 (defvar *stack*)
 (defvar *fp*)
@@ -94,10 +94,6 @@
     (t
      nil)))
 
-(defstruct (box (:constructor make-box (value)))
-  value)
-(defun unbox (box) (box-value box))
-
 (defstruct (context (:constructor make-context (&optional parent)))
   parent
   (env-hop nil :type boolean)
@@ -460,30 +456,53 @@
       (declare (ignorable required optional restp rest keyp keys allowp auxp aux
                           morep more-context more-count))
       (let* ((argvars lambda-list)    ;fixme
-             (n (length (the list lambda-list))))
-        (if (maybe-closes-over-p `(progn ,@body) argvars)
-            (let* ((new-context (context-add-env-lexicals context argvars))
-                   (body* (prepare-progn body new-context)))
-              (lambda (env)
-                (lambda (&rest args)
-                  (declare (dynamic-extent args))
-                  ;; FIXME: non-simple lambda-lists
-                  (let ((new-env (make-environment env n)))
-                    (loop for i from 0 to n
-                          for val in args
-                          do (setf (environment-value new-env 0 i) val))
-                    (funcall body* new-env)))))
-            (let* ((new-context (context-add-stack-lexicals context argvars))
-                   (body* (prepare-progn body new-context)))
-              (lambda (env)
-                (lambda (&rest args)
-                  (declare (dynamic-extent args))
-                  ;; FIXME: non-simple lambda-lists
-                  (with-stack-frame n
-                    (loop for i from 0 below n
-                          for val in args
-                          do (setf (stack-ref 0 i) val))
-                    (funcall body* env))))))))))
+             (n (length (the list lambda-list)))
+             (envp (maybe-closes-over-p `(progn ,@body) argvars))
+             (new-context (if envp
+                              (context-add-env-lexicals context argvars)
+                              (context-add-stack-lexicals context argvars)))
+             (body* (prepare-progn body new-context)))
+        (if (< n 20)
+            (specialize m% n (loop for i from 0 below 20 collect i)
+              (let ((args (loop for i from 0 below m%
+                                collect (gensym (format nil "ARG~D-" i)))))
+                `(if envp
+                     (lambda (env)
+                       (lambda ,args
+                         ;; FIXME: non-simple lambda-lists
+                         (let ((new-env (make-environment env ,m%)))
+                           ,@(loop for i from 0
+                                   for val in args
+                                   collect `(setf (environment-value new-env 0 ,i) ,val))
+                           (funcall body* new-env))))
+                     (lambda (env)
+                       (lambda ,args
+                         ;; FIXME: non-simple lambda-lists
+                         (with-stack-frame ,m%
+                           ,@(loop for i from 0
+                                   for val in args
+                                   collect `(setf (stack-ref 0 ,i) ,val))
+                           (funcall body* env)))))))
+            (if envp
+                (lambda (env)
+                  (lambda (&rest args)
+                    (declare (dynamic-extent args))
+                    ;; FIXME: non-simple lambda-lists
+                    (let ((new-env (make-environment env n)))
+                      (loop for i from 0 to n
+                            for val in args
+                            do (setf (environment-value new-env 0 i) val))
+                      (funcall body* new-env))))
+                (lambda (env)
+                  (lambda (&rest args)
+                    (declare (dynamic-extent args))
+                    ;; FIXME: non-simple lambda-lists
+                    (with-stack-frame n
+                      (loop for i from 0 below n
+                            for val in args
+                            do (setf (stack-ref 0 i) val))
+                      (funcall body* env))))))))))
+
 
 (defun context->native-environment (context)
   ;;FIXME