From 838ad3bbecb1feb8d611ad7c29bff9160a274a1a Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Tue, 16 Jul 2013 18:56:21 +0200
Subject: PREPARE-LAMBDA: Simplify.

---
 sb-eval2.lisp | 26 +++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

(limited to 'sb-eval2.lisp')

diff --git a/sb-eval2.lisp b/sb-eval2.lisp
index ccb0d14..8d05ba9 100644
--- a/sb-eval2.lisp
+++ b/sb-eval2.lisp
@@ -366,7 +366,7 @@
                (mapcar (lambda (x) (prepare-form x new-context)) default-values))
              (body* (prepare-progn body new-context))
              (unbound (gensym)))
-        (macrolet ((handle-arguments (args env-ref env)
+        (macrolet ((handle-arguments (args env)
                      ;; All this ELT and LENGTH stuff is not as
                      ;; inefficient as it looks.  SBCL transforms
                      ;; &rest into &more here.
@@ -384,11 +384,11 @@
                              (go missing-optionals))
                            (when (>= argi (the fixnum (+ required-num optional-num)))
                              (go keys))
-                           (setf (,@env-ref 0 vari) (elt ,args argi))
+                           (setf (environment-value ,env 0 vari) (elt ,args argi))
                            (when (>= argi required-num)
                              (pop default-values*)
                              (incf vari)
-                             (setf (,@env-ref 0 vari) t))
+                             (setf (environment-value ,env 0 vari) t))
                            (incf vari)
                            (incf argi)
                            (go positional)
@@ -397,9 +397,9 @@
                            (when (>= vari (the fixnum (+ required-num (the fixnum (* 2 optional-num)))))
                              (go keys))
                            (let ((val* (pop default-values*)))
-                             (setf (,@env-ref 0 vari)
+                             (setf (environment-value ,env 0 vari)
                                    (funcall (the eval-closure val*) ,env)
-                                   (,@env-ref 0 (1+ vari))
+                                   (environment-value ,env 0 (1+ vari))
                                    nil))
                            (incf vari 2)
                            (go missing-optionals)
@@ -412,13 +412,13 @@
                                   (val* (pop default-values*))
                                   (x    (getf rest key unbound)))
                              (if (eq unbound x)
-                                 (setf (,@env-ref 0 vari)
+                                 (setf (environment-value ,env 0 vari)
                                        (funcall (the eval-closure val*) ,env)
-                                       (,@env-ref 0 (1+ vari))
+                                       (environment-value ,env 0 (1+ vari))
                                        nil)
-                                 (setf (,@env-ref 0 vari)
+                                 (setf (environment-value ,env 0 vari)
                                        x
-                                       (,@env-ref 0 (1+ vari))
+                                       (environment-value ,env 0 (1+ vari))
                                        t)))
                            (incf vari 2)
                            (go keys)
@@ -430,27 +430,27 @@
                                              aux-num)))
                              (go rest))
                            (let ((val* (pop default-values*)))
-                             (setf (,@env-ref 0 vari)
+                             (setf (environment-value ,env 0 vari)
                                    (funcall (the eval-closure val*) ,env)))
                            (incf vari)
                            (go aux)
                          rest
                            (assert (null default-values*))
                            (when restp
-                             (setf (,@env-ref 0 (1- varnum))
+                             (setf (environment-value ,env 0 (1- varnum))
                                    rest))))))
           (if envp
               (lambda (env)
                 (lambda (&rest args)
                   (declare (dynamic-extent args))
                   (let ((new-env (make-environment env varnum)))
-                    (handle-arguments args (environment-value new-env) new-env)
+                    (handle-arguments args new-env)
                     (funcall body* new-env))))
               (lambda (env)
                 (lambda (&rest args)
                   (declare (dynamic-extent args))
                   (with-dynamic-extent-environment (new-env env varnum)
-                    (handle-arguments args (environment-value new-env) new-env)
+                    (handle-arguments args new-env)
                     (funcall body* new-env))))))))))
 
 
-- 
cgit v1.2.3