From 47da3aec921176b189868519273b5bddb8bcc737 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Wed, 11 Jun 2003 05:53:59 +0000 Subject: [PATCH] 0.8.0.61: * bug fix: in macro-like defining macros/special operators the implicit block does not enclose lambda list. --- NEWS | 2 ++ src/code/defmacro.lisp | 3 +-- src/code/destructuring-bind.lisp | 3 ++- src/code/early-setf.lisp | 5 ++--- src/code/macros.lisp | 3 +-- src/code/parse-defmacro.lisp | 8 ++++++-- src/compiler/deftype.lisp | 2 +- src/compiler/ir1-translators.lisp | 2 +- src/compiler/macros.lisp | 6 ++++-- tests/compiler.pure.lisp | 10 ++++++++++ version.lisp-expr | 2 +- 11 files changed, 31 insertions(+), 15 deletions(-) diff --git a/NEWS b/NEWS index 5c54d08..e567d64 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4