Mercurial > hg > xemacs-beta
diff lisp/cl-macs.el @ 5356:5dd1ba5e0113
Be better about eliminating `block's that are not `return-from'd, bytecomp.el
2011-02-12 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
* bytecomp.el (unwind-protect):
* bytecomp.el (byte-compile-active-blocks):
* bytecomp.el (byte-compile-catch):
* bytecomp.el ('return-from-1): Removed.
* bytecomp.el ('block-1): Removed.
* bytecomp.el (byte-compile-block-1): Removed.
* bytecomp.el (byte-compile-return-from-1): Removed.
* bytecomp.el (byte-compile-throw):
* cl-macs.el (block):
* cl-macs.el (return-from):
In my last change, the elimination of `block's that were never
`return-from'd didn't work if `cl-macroexpand-all' was called
explicitly, something much code in cl-macs.el does. Change the
implementation to something that doesn't require shadowing of the
macros in `byte-compile-initial-macro-environment', putting a
`cl-block-name' property on the gensym'd symbol argument to
`catch' instead.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 12 Feb 2011 14:07:38 +0000 |
| parents | 38e24b8be4ea |
| children | f00192e1cd49 00e79bbbe48f |
line wrap: on
line diff
--- a/lisp/cl-macs.el Thu Feb 10 08:46:10 2011 +0000 +++ b/lisp/cl-macs.el Sat Feb 12 14:07:38 2011 +0000 @@ -747,6 +747,9 @@ (let ((cl-active-block-names (acons name (copy-symbol name) cl-active-block-names)) (body (cons 'progn body))) + ;; Tell the byte-compiler this is a block, not a normal catch call, and + ;; as such it can eliminate it if that's appropriate: + (put (cdar cl-active-block-names) 'cl-block-name name) `(catch ',(cdar cl-active-block-names) ,(cl-macroexpand-all body cl-macro-environment)))) @@ -763,8 +766,13 @@ returning RESULT from that form (or nil if RESULT is omitted). This is compatible with Common Lisp, but note that `defun' and `defmacro' do not create implicit blocks as they do in Common Lisp." - `(throw ',(or (cdr (assq name cl-active-block-names)) (copy-symbol name)) - ,result)) + `(throw ',(or (cdr (assq name cl-active-block-names)) + (prog1 (copy-symbol name) + (and-fboundp 'byte-compile-warn (cl-compiling-file) + (byte-compile-warn + "return-from: no enclosing block named `%s'" + name)))) + ,result)) ;;; The "loop" macro.