changeset 5376:4b529b940e2e

Eliminate unused blocks named nil, too, cl-macs.el, bytecomp.el 2011-03-17 Aidan Kehoe <kehoea@parhasard.net> * 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.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 17 Mar 2011 21:07:16 +0000
parents 2fba45e5b48d
children eac2e6bd5b2c
files lisp/ChangeLog lisp/bytecomp.el lisp/cl-macs.el
diffstat 3 files changed, 37 insertions(+), 19 deletions(-) [+]
line wrap: on
line diff
--- 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@parhasard.net>
+
+	* 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@parhasard.net>
 
 	* 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
--- 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.