[COMMIT] Be better about eliminating `block's that are not `return-from'd, bytecomp.el

APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1297519658 0 # Node ID 5dd1ba5e01137d935224d5156fe55ac773844eaf # Parent 70b15ac66ee5f431c1e663ea985f825bfd09ea63 Be better about eliminating `block's that are not `return-from'd, bytecomp.el 2011-02-12 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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. diff -r 70b15ac66ee5 -r 5dd1ba5e0113 lisp/ChangeLog --- a/lisp/ChangeLog Thu Feb 10 08:46:10 2011 +0000 +++ b/lisp/ChangeLog Sat Feb 12 14:07:38 2011 +0000 ＠＠ -1,3 +1,25 ＠＠ +2011-02-12 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * 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. + 2011-02-09 Aidan Kehoe <kehoea(a)parhasard.net&gt; * cl.el (acons): Removed, make the implementation in alloc.c diff -r 70b15ac66ee5 -r 5dd1ba5e0113 lisp/bytecomp.el --- a/lisp/bytecomp.el Thu Feb 10 08:46:10 2011 +0000 +++ b/lisp/bytecomp.el Sat Feb 12 14:07:38 2011 +0000 ＠＠ -511,11 +511,7 ＠＠ "%s is not of type %s" form type))) (if byte-compile-delete-errors form - (funcall (cdr (symbol-function 'the)) type form)))) - (return-from . - ,#'(lambda (name &optional result) `(return-from-1 ',name ,result))) - (block . - ,#'(lambda (name &rest body) `(block-1 ',name ,＠body)))) + (funcall (cdr (symbol-function 'the)) type form))))) "The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter.") ＠＠ -4186,8 +4182,6 ＠＠ ;;; other tricky macro-like special-operators (byte-defop-compiler-1 catch) -(byte-defop-compiler-1 block-1) -(byte-defop-compiler-1 return-from-1) (byte-defop-compiler-1 unwind-protect) (byte-defop-compiler-1 condition-case) (byte-defop-compiler-1 save-excursion) ＠＠ -4196,44 +4190,33 ＠＠ (byte-defop-compiler-1 with-output-to-temp-buffer) ;; no track-mouse. +(defvar byte-compile-active-blocks nil) + (defun byte-compile-catch (form) - (byte-compile-form (car (cdr form))) - (byte-compile-push-constant - (byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect)) - (byte-compile-out 'byte-catch 0)) - -;; `return-from' and `block' are different from `throw' and `catch' when it -;; comes to scope and extent. These differences are implemented for -;; interpreted code in cl-macs.el, in compiled code in bytecomp.el. There's -;; a certain amount of bootstrapping needed for the latter, and until this -;; is done return-from and block behave as throw and catch in their scope -;; and extent. This is only relevant to people working on bytecomp.el. - -(defalias 'return-from-1 'throw) -(defalias 'block-1 'catch) - -(defvar byte-compile-active-blocks nil) - -(defun byte-compile-block-1 (form) - (let* ((name (nth 1 (nth 1 form))) - (elt (list name (copy-symbol name) nil)) - (byte-compile-active-blocks (cons elt byte-compile-active-blocks)) - (body (byte-compile-top-level (cons 'progn (cddr form))))) - (if (nth 2 elt) - (byte-compile-catch `(catch ',(nth 1 elt) ,body)) - (byte-compile-form body)))) - -(defun byte-compile-return-from-1 (form) - (let* ((name (nth 1 (nth 1 form))) - (assq (assq name byte-compile-active-blocks))) - (if assq - (setf (nth 2 assq) t) - (byte-compile-warn - "return-from: %S: no current lexical block with this name" - name)) - (byte-compile-throw - `(throw ',(or (nth 1 assq) (copy-symbol name)) - ,＠(nthcdr 2 form))))) + "Byte-compile and return a `catch' from. + +If FORM is the result of macroexpanding a `block' form (the TAG argument is +a quoted symbol with a non-nil `cl-block-name' property) and there is no +corresponding `return-from' within the block--or equivalently, it was +optimized away--just byte compile and return the BODY." + (let* ((symbol (car-safe (cdr-safe (nth 1 form)))) + (block (and symbol (symbolp symbol) (get symbol 'cl-block-name))) + (elt (and block (cons block nil))) + (byte-compile-active-blocks + (if block + (cons elt byte-compile-active-blocks) + byte-compile-active-blocks)) + (body + (byte-compile-top-level (cons 'progn (cddr form)) + (if block nil for-effect)))) + (if (and block (not (cdr elt))) + ;; A lexical block without any contained return-from clauses: + (byte-compile-form body) + ;; A normal catch call, or a lexical block with a contained + ;; return-from clause. + (byte-compile-form (car (cdr form))) + (byte-compile-push-constant body) + (byte-compile-out 'byte-catch 0)))) (defun byte-compile-unwind-protect (form) (byte-compile-push-constant ＠＠ -4383,6 +4366,12 ＠＠ (byte-compile-normal-call `(signal 'wrong-number-of-arguments '(,(car form) ,(length (cdr form)))))) + ;; If this form was macroexpanded from `return-from', mark the + ;; corresponding block as having been referenced. + (let* ((symbol (car-safe (cdr-safe (nth 1 form)))) + (block (and symbol (symbolp symbol) (get symbol 'cl-block-name))) + (assq (and block (assq block byte-compile-active-blocks)))) + (and assq (setcdr assq t))) (byte-compile-form (nth 1 form)) ;; Push the arguments (byte-compile-form (nth 2 form)) (byte-compile-out (get (car form) 'byte-opcode) 0) diff -r 70b15ac66ee5 -r 5dd1ba5e0113 lisp/cl-macs.el --- 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. -- “Apart from the nine-banded armadillo, man is the only natural host of Mycobacterium leprae, although it can be grown in the footpads of mice.” -- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches