0.8.0.61:

        * bug fix: in macro-like defining macros/special operators the
          implicit block does not enclose lambda list.

diff --git a/NEWS b/NEWS
index 5c54d08..e567d64 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1813,6 +1813,8 @@ changes in sbcl-0.8.1 relative to sbcl-0.8.0:
     is better at handling symbol macros.
   * bug fix: there is no longer a type named LENGTH.  (reported by
     Raymond Toy)
+  * bug fix: in macro-like defining macros/special operators the
+    implicit block does not enclose lambda list.
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** NIL is now allowed as a structure slot name.
     ** arbitrary numbers, not just reals, are allowed in certain

diff --git a/src/code/defmacro.lisp b/src/code/defmacro.lisp
index a889710..a68fb37 100644 (file)
--- a/src/code/defmacro.lisp
+++ b/src/code/defmacro.lisp
@@ -37,8 +37,7 @@
                          :environment environment)
        (let ((def `(lambda (,whole ,environment)
                      ,@local-decs
-                     (block ,name 
-                       ,new-body)))
+                      ,new-body))
              ;; If we want to move over to list-style names
              ;; [e.g. (DEFMACRO FOO), maybe to support some XREF-like
              ;; functionality] here might be a good place to start.

diff --git a/src/code/destructuring-bind.lisp b/src/code/destructuring-bind.lisp
index 1a74b38..3e65da7 100644 (file)
--- a/src/code/destructuring-bind.lisp
+++ b/src/code/destructuring-bind.lisp
@@ -16,7 +16,8 @@
     (multiple-value-bind (body local-decls)
        (parse-defmacro lambda-list arg-list-name body nil 'destructuring-bind
                        :anonymousp t
-                       :doc-string-allowed nil)
+                       :doc-string-allowed nil
+                        :wrap-block nil)
       `(let ((,arg-list-name ,arg-list))
         ,@local-decls
         ,body))))

diff --git a/src/code/early-setf.lisp b/src/code/early-setf.lisp
index 76a8c43..6549d41 100644 (file)
--- a/src/code/early-setf.lisp
+++ b/src/code/early-setf.lisp
@@ -372,8 +372,7 @@ GET-SETF-EXPANSION directly."
                     (%defsetf ,access-form-var ,(length store-variables)
                               (lambda (,arglist-var)
                                 ,@local-decs
-                                (block ,access-fn
-                                  ,body))))
+                                 ,body)))
                   nil
                   ',doc))))))
        (t
@@ -423,7 +422,7 @@ GET-SETF-EXPANSION directly."
         (assign-setf-macro ',access-fn
                            (lambda (,whole ,environment)
                              ,@local-decs
-                             (block ,access-fn ,body))
+                             ,body)
                            nil
                            ',doc)))))
 

diff --git a/src/code/macros.lisp b/src/code/macros.lisp
index 7e7783a..9159bfb 100644 (file)
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -133,8 +133,7 @@
                        :environment environment)
       (let ((def `(lambda (,whole ,environment)
                    ,@local-decs
-                   (block ,(fun-name-block-name name)
-                     ,body)))
+                   ,body))
            (debug-name (debug-namify "DEFINE-COMPILER-MACRO ~S" name)))
        `(eval-when (:compile-toplevel :load-toplevel :execute)
          (sb!c::%define-compiler-macro ',name

diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp
index 4cf203f..55121c9 100644 (file)
--- a/src/code/parse-defmacro.lisp
+++ b/src/code/parse-defmacro.lisp
@@ -37,7 +37,8 @@
                                   (doc-string-allowed t)
                                   ((:environment env-arg-name))
                                   ((:default-default *default-default*))
-                                  (error-fun 'error))
+                                  (error-fun 'error)
+                                   (wrap-block t))
   (multiple-value-bind (forms declarations documentation)
       (parse-body body doc-string-allowed)
     (let ((*arg-tests* ())
@@ -57,7 +58,10 @@
                   ,@*arg-tests*
                   (let* ,(nreverse *user-lets*)
                     ,@declarations
-                    ,@forms))
+                     ,@(if wrap-block
+                           `((block ,(fun-name-block-name name)
+                               ,@forms))
+                           forms)))
                `(,@(when (and env-arg-name (not env-arg-used))
                       `((declare (ignore ,env-arg-name)))))
                documentation

diff --git a/src/compiler/deftype.lisp b/src/compiler/deftype.lisp
index 54cc932..752f878 100644 (file)
--- a/src/compiler/deftype.lisp
+++ b/src/compiler/deftype.lisp
@@ -21,5 +21,5 @@
         (%compiler-deftype ',name
                            (lambda (,whole)
                              ,@local-decs
-                             (block ,name ,body))
+                             ,body)
                            ,@(when doc `(,doc)))))))

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index ec67238..23dfa9c 100644 (file)
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -289,7 +289,7 @@
                nil
                `(lambda (,whole ,environment)
                  ,@local-decls
-                 (block ,name ,body))
+                  ,body)
                ,lexenv))))))))
 
 (defun funcall-in-macrolet-lexenv (definitions fun)

diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp
index ecc3d9e..fd533a0 100644 (file)
--- a/src/compiler/macros.lisp
+++ b/src/compiler/macros.lisp
@@ -54,7 +54,8 @@
     (multiple-value-bind (body decls doc)
        (parse-defmacro lambda-list n-form body name "special form"
                        :environment n-env
-                       :error-fun 'convert-condition-into-compiler-error)
+                       :error-fun 'convert-condition-into-compiler-error
+                        :wrap-block nil)
       `(progn
         (declaim (ftype (function (continuation continuation t) (values))
                         ,fn-name))
@@ -110,7 +111,8 @@
                        :error-fun `(lambda (&rest stuff)
                                      (declare (ignore stuff))
                                      (return-from ,name
-                                       (values nil t))))
+                                       (values nil t)))
+                        :wrap-block nil)
       `(lambda (,n-form &aux (,n-env *lexenv*))
          ,@decls
          (block ,name

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index c1ad3e3..19ddd19 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -409,3 +409,13 @@
                     (list (the fixnum (the (real 0) (eval v))))))))
   (assert (raises-error? (funcall f 0.1) type-error))
   (assert (raises-error? (funcall f -1) type-error)))
+
+;;; the implicit block does not enclose lambda list
+(let ((forms '((defmacro #1=#:foo (&optional (x (return-from #1#))))
+               #+nil(macrolet ((#2=#:foo (&optional (x (return-from #2#))))))
+               (define-compiler-macro #3=#:foo (&optional (x (return-from #3#))))
+               (deftype #4=#:foo (&optional (x (return-from #4#))))
+               (define-setf-expander #5=#:foo (&optional (x (return-from #5#))))
+               (defsetf #6=#:foo (&optional (x (return-from #6#))) ()))))
+  (dolist (form forms)
+    (assert (nth-value 2 (compile nil `(lambda () ,form))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 4b18c37..9317d81 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.0.60"
+"0.8.0.61"