From dcf0b8c0de428bef460212899de6bf0ea4f7f5fe Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Fri, 19 Jul 2013 15:17:22 +0200
Subject: Simplify.

---
 sb-eval2.lisp | 21 ++++++++++++---------
 1 file changed, 12 insertions(+), 9 deletions(-)

(limited to 'sb-eval2.lisp')

diff --git a/sb-eval2.lisp b/sb-eval2.lisp
index 62f0486..403af17 100644
--- a/sb-eval2.lisp
+++ b/sb-eval2.lisp
@@ -481,7 +481,7 @@
                (body* (prepare-progn body new-context))
                (unbound (gensym)))
           (setq varspecs (nreverse varspecs))
-          (macrolet ((handle-arguments (args env body*)
+          (macrolet ((handle-arguments (args env)
                        ;; All this ELT and LENGTH stuff is not as
                        ;; inefficient as it looks.  SBCL transforms
                        ;; &rest into &more here.
@@ -533,7 +533,8 @@
                                     positional
                                       (when (>= argi (length ,args))
                                         (go missing-optionals))
-                                      (when (>= argi (the fixnum (+ required-num optional-num)))
+                                      (when (>= argi (the fixnum
+                                                          (+ required-num optional-num)))
                                         (go keys))
                                       (if (>= argi required-num)
                                         (progn
@@ -550,10 +551,11 @@
                                                                  optional-num)))
                                         (go keys))
                                       (let ((val* (pop my-default-values*)))
-                                        (push-args (funcall (the eval-closure val*) ,env) nil))
+                                        (push-args (funcall (the eval-closure val*)
+                                                            ,env)
+                                                   nil))
                                       (go missing-optionals)
                                     keys
-                                      (print "; missing-optionals")
                                       (unless keyp
                                         (unless (or restp (= argi (length args)))
                                           (error 'sb-int:simple-program-error
@@ -601,7 +603,8 @@
                                                         aux-num)))
                                         (go rest))
                                       (let ((val* (pop my-default-values*)))
-                                        (push-args (funcall (the eval-closure val*) ,env)))
+                                        (push-args (funcall (the eval-closure val*)
+                                                            ,env)))
                                       (go aux)
                                     rest
                                       (assert (null my-default-values*))
@@ -609,20 +612,20 @@
                                         (push-args rest))
                                     final-call
                                       (return-from iter
-                                        (funcall ,body* ,env))))))
+                                        (funcall body* ,env))))))
                             (iter)))))
             (if envp
                 (lambda (env)
                   (lambda (&rest args)
                     (declare (dynamic-extent args))
                     (let ((new-env (make-environment env varnum)))
-                      (handle-arguments args new-env body*))))
+                      (handle-arguments args new-env))))
                 (lambda (env)
                   (lambda (&rest args)
                     (declare (dynamic-extent args))
                     ;;XXX VARNUM is too big--- need only lexicals
                     (with-dynamic-extent-environment (new-env env varnum)
-                      (handle-arguments args new-env body*)))))))))))
+                      (handle-arguments args new-env)))))))))))
 
 (defun context->native-environment (context)
   ;;FIXME
@@ -849,7 +852,7 @@
                                  (some (lambda (x) (maybe-closes-over-p context x vars))
                                        (mapcar #'cdr real-bindings))))
                        (new-context
-                         (context-add-env-lexicals context (list)))
+                         (make-lexical-context context))
                        lexical-values*
                        special-bindings*)
                   (loop for (var . value-form) in real-bindings
-- 
cgit v1.2.3