[COMMIT] Eliminate unused blocks named nil, too, cl-macs.el, bytecomp.el

APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1300396036 0 # Node ID 4b529b940e2e8bcc623fed865ac1796132b99eaa # Parent 2fba45e5b48d45e4df97aba9f07f4c00e368bb6a Eliminate unused blocks named nil, too, cl-macs.el, bytecomp.el 2011-03-17 Aidan Kehoe <kehoea(a)parhasard.net&gt; * bytecomp.el (byte-compile-catch): * bytecomp.el (byte-compile-throw): * cl-macs.el (return-from): With `block' and `return-from', a nil NAME is perfectly legitimate, and the corresponding `catch' statements need be removed by the byte-compiler. 5dd1ba5e0113 , my change of 2011-02-12, didn't do this; correct that now. diff -r 2fba45e5b48d -r 4b529b940e2e lisp/ChangeLog --- a/lisp/ChangeLog Thu Mar 17 20:17:19 2011 +0000 +++ b/lisp/ChangeLog Thu Mar 17 21:07:16 2011 +0000 ＠＠ -1,3 +1,13 ＠＠ +2011-03-17 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * bytecomp.el (byte-compile-catch): + * bytecomp.el (byte-compile-throw): + * cl-macs.el (return-from): + With `block' and `return-from', a nil NAME is perfectly + legitimate, and the corresponding `catch' statements need be + removed by the byte-compiler. 5dd1ba5e0113 , my change of + 2011-02-12, didn't do this; correct that now. + 2011-03-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; * bytecomp.el: diff -r 2fba45e5b48d -r 4b529b940e2e lisp/bytecomp.el --- a/lisp/bytecomp.el Thu Mar 17 20:17:19 2011 +0000 +++ b/lisp/bytecomp.el Thu Mar 17 21:07:16 2011 +0000 ＠＠ -4195,20 +4195,22 ＠＠ "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 +a quoted symbol with a `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))) + (not-present '#:not-present) + (block (and symbol (symbolp symbol) + (get symbol 'cl-block-name not-present))) + (elt (and (not (eq block not-present)) (list block))) (byte-compile-active-blocks - (if block + (if elt (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))) + (and elt for-effect)))) + (if (and elt (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 ＠＠ -4368,14 +4370,20 ＠＠ ;; 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)) + (not-present '#:not-present) + (block (and symbol (symbolp symbol) + (get symbol 'cl-block-name not-present))) + (assq (and (not (eq block not-present)) + (assq block byte-compile-active-blocks)))) + (when assq + (setcdr assq t)) + (when (not (eq block not-present)) + ;; No corresponding enclosing block. + (byte-compile-warn "return-from: no enclosing block named `%s'" + block))) + (mapc 'byte-compile-form (cdr form)) ;; Push the arguments (byte-compile-out (get (car form) 'byte-opcode) 0) - (pushnew '(null (function-max-args 'throw)) - byte-compile-checks-on-load + (pushnew '(null (function-max-args 'throw)) byte-compile-checks-on-load :test #'equal)))  ;;; top-level forms elsewhere diff -r 2fba45e5b48d -r 4b529b940e2e lisp/cl-macs.el --- a/lisp/cl-macs.el Thu Mar 17 20:17:19 2011 +0000 +++ b/lisp/cl-macs.el Thu Mar 17 21:07:16 2011 +0000 ＠＠ -767,12 +767,12 ＠＠ 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)) - (prog1 (copy-symbol name) - (and-fboundp 'byte-compile-warn (cl-compiling-file) - (byte-compile-warn - "return-from: no enclosing block named `%s'" - name)))) - ,result)) + ;; Tell the byte-compiler the original name of the block, + ;; leave any warning to it. + (let ((copy-symbol (copy-symbol name))) + (put copy-symbol 'cl-block-name name) + copy-symbol)) + ,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