changeset: 5356:5dd1ba5e0113
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat Feb 12 14:07:38 2011 +0000
files: lisp/ChangeLog lisp/bytecomp.el lisp/cl-macs.el
description:
Be better about eliminating `block's that are not `return-from'd, bytecomp.el
2011-02-12 Aidan Kehoe <kehoea(a)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.
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>
+
+ * 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>
* 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.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches