diff options
| author | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-15 14:53:17 +0200 | 
|---|---|---|
| committer | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-15 14:53:17 +0200 | 
| commit | ba4403aa5be2a280ee67842d71753933ed8e1be0 (patch) | |
| tree | 6880f996b557dc4ab85af3ebaf1810b72aa47e13 | |
| parent | 8419cf4459872884161f1a6834e27e77ab1ad662 (diff) | |
Specialize LAMBDA.
| -rw-r--r-- | sb-eval2.lisp | 30 | 
1 files changed, 21 insertions, 9 deletions
diff --git a/sb-eval2.lisp b/sb-eval2.lisp index 3ae5fb0..3d075f7 100644 --- a/sb-eval2.lisp +++ b/sb-eval2.lisp @@ -249,15 +249,27 @@        (multiple-value-bind (required optional restp rest keyp keys allowp auxp aux                              morep more-context more-count)            (sb-int:parse-lambda-list lambda-list) -       (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)))))))) +       (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))))) +               `(lambda (env) +                  (lambda ,args +                    ;; FIXME: non-simple lambda-lists +                    (let ((new-env (make-environment env n))) +                      ,@(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 (&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)))))))))  (defun context->native-environment (context)    ;;FIXME  | 
