From cedec1e680b154afc68d7fabf219f3074362bf9d Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Sun, 21 Jul 2013 01:23:22 +0200
Subject: Assorted cleanups and improvements.

---
 sb-eval2.lisp | 31 ++++++++++++++++---------------
 1 file changed, 16 insertions(+), 15 deletions(-)

diff --git a/sb-eval2.lisp b/sb-eval2.lisp
index e79a174..b5fcf0c 100644
--- a/sb-eval2.lisp
+++ b/sb-eval2.lisp
@@ -278,9 +278,11 @@
           (env-lexical
            (lambda (env)
              (environment-value env nesting offset)))))
-      (lambda (env)
-        (declare (ignore env))
-        (symbol-value var))))
+      (progn
+        (assume-special context var)
+        (lambda (env)
+          (declare (ignore env))
+          (symbol-value var)))))
 
 
 (defun body-decls&forms (exprs)
@@ -540,7 +542,7 @@
           (setq varspecs (nreverse varspecs))
           (flet
               ((handle-arguments (new-env &rest args)
-                 ;;(declare (dynamic-extent args))
+                 (declare (dynamic-extent args))
                  ;; All this ELT and LENGTH stuff is not as
                  ;; inefficient as it looks.  SBCL transforms
                  ;; &rest into &more here.
@@ -787,17 +789,16 @@
                   (loop for (var info val*) on bindings by #'cdddr
                         for value = (funcall (the eval-closure val*) env)
                         for result =
-                           (progn
-                             (etypecase info
-                               (function ;symbol macro setter
-                                (funcall info env))
-                               (lexical
-                                (setf (environment-value env
-                                                         (lexical-nesting info)
-                                                         (lexical-offset info))
-                                      value))
-                               (keyword
-                                (setf (symbol-value var) value))))
+                           (etypecase info
+                             (function ;symbol macro setter
+                              (funcall info env))
+                             (lexical
+                              (setf (environment-value env
+                                                       (lexical-nesting info)
+                                                       (lexical-offset info))
+                                    value))
+                             (keyword
+                              (setf (symbol-value var) value)))
                         finally (return result))))))
            ((catch)
             (destructuring-bind (tag &body body) (rest form)
-- 
cgit v1.2.3