Mercurial > hg > xemacs-beta

comparison lisp/bytecomp.el @ 5356:5dd1ba5e0113

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 31475de17064 00e79bbbe48f
comparison
equal deleted inserted replaced
5355:70b15ac66ee5 5356:5dd1ba5e0113
509 (or (eval (cl-make-type-test form type)) 509 (or (eval (cl-make-type-test form type))
510 (byte-compile-warn 510 (byte-compile-warn
511 "%s is not of type %s" form type))) 511 "%s is not of type %s" form type)))
512 (if byte-compile-delete-errors 512 (if byte-compile-delete-errors
513 form 513 form
514 (funcall (cdr (symbol-function 'the)) type form)))) 514 (funcall (cdr (symbol-function 'the)) type form)))))
515 (return-from .
516 ,#'(lambda (name &optional result) `(return-from-1 ',name ,result)))
517 (block .
518 ,#'(lambda (name &rest body) `(block-1 ',name ,@body))))
519 "The default macro-environment passed to macroexpand by the compiler. 515 "The default macro-environment passed to macroexpand by the compiler.
520 Placing a macro here will cause a macro to have different semantics when 516 Placing a macro here will cause a macro to have different semantics when
521 expanded by the compiler as when expanded by the interpreter.") 517 expanded by the compiler as when expanded by the interpreter.")
522 518
523 (defvar byte-compile-macro-environment byte-compile-initial-macro-environment 519 (defvar byte-compile-macro-environment byte-compile-initial-macro-environment
4184 (cdr form)))) 4180 (cdr form))))
4185 4181
4186 ;;; other tricky macro-like special-operators 4182 ;;; other tricky macro-like special-operators
4187 4183
4188 (byte-defop-compiler-1 catch) 4184 (byte-defop-compiler-1 catch)
4189 (byte-defop-compiler-1 block-1)
4190 (byte-defop-compiler-1 return-from-1)
4191 (byte-defop-compiler-1 unwind-protect) 4185 (byte-defop-compiler-1 unwind-protect)
4192 (byte-defop-compiler-1 condition-case) 4186 (byte-defop-compiler-1 condition-case)
4193 (byte-defop-compiler-1 save-excursion) 4187 (byte-defop-compiler-1 save-excursion)
4194 (byte-defop-compiler-1 save-current-buffer) 4188 (byte-defop-compiler-1 save-current-buffer)
4195 (byte-defop-compiler-1 save-restriction) 4189 (byte-defop-compiler-1 save-restriction)
4196 (byte-defop-compiler-1 with-output-to-temp-buffer) 4190 (byte-defop-compiler-1 with-output-to-temp-buffer)
4197 ;; no track-mouse. 4191 ;; no track-mouse.
4198 4192
4193 (defvar byte-compile-active-blocks nil)
4194
4199 (defun byte-compile-catch (form) 4195 (defun byte-compile-catch (form)
4200 (byte-compile-form (car (cdr form))) 4196 "Byte-compile and return a `catch' from.
4201 (byte-compile-push-constant 4197
4202 (byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect)) 4198 If FORM is the result of macroexpanding a `block' form (the TAG argument is
4203 (byte-compile-out 'byte-catch 0)) 4199 a quoted symbol with a non-nil `cl-block-name' property) and there is no
4204 4200 corresponding `return-from' within the block--or equivalently, it was
4205 ;; `return-from' and `block' are different from `throw' and `catch' when it 4201 optimized away--just byte compile and return the BODY."
4206 ;; comes to scope and extent. These differences are implemented for 4202 (let* ((symbol (car-safe (cdr-safe (nth 1 form))))
4207 ;; interpreted code in cl-macs.el, in compiled code in bytecomp.el. There's 4203 (block (and symbol (symbolp symbol) (get symbol 'cl-block-name)))
4208 ;; a certain amount of bootstrapping needed for the latter, and until this 4204 (elt (and block (cons block nil)))
4209 ;; is done return-from and block behave as throw and catch in their scope 4205 (byte-compile-active-blocks
4210 ;; and extent. This is only relevant to people working on bytecomp.el. 4206 (if block
4211 4207 (cons elt byte-compile-active-blocks)
4212 (defalias 'return-from-1 'throw) 4208 byte-compile-active-blocks))
4213 (defalias 'block-1 'catch) 4209 (body
4214 4210 (byte-compile-top-level (cons 'progn (cddr form))
4215 (defvar byte-compile-active-blocks nil) 4211 (if block nil for-effect))))
4216 4212 (if (and block (not (cdr elt)))
4217 (defun byte-compile-block-1 (form) 4213 ;; A lexical block without any contained return-from clauses:
4218 (let* ((name (nth 1 (nth 1 form))) 4214 (byte-compile-form body)
4219 (elt (list name (copy-symbol name) nil)) 4215 ;; A normal catch call, or a lexical block with a contained
4220 (byte-compile-active-blocks (cons elt byte-compile-active-blocks)) 4216 ;; return-from clause.
4221 (body (byte-compile-top-level (cons 'progn (cddr form))))) 4217 (byte-compile-form (car (cdr form)))
4222 (if (nth 2 elt) 4218 (byte-compile-push-constant body)
4223 (byte-compile-catch `(catch ',(nth 1 elt) ,body)) 4219 (byte-compile-out 'byte-catch 0))))
4224 (byte-compile-form body))))
4225
4226 (defun byte-compile-return-from-1 (form)
4227 (let* ((name (nth 1 (nth 1 form)))
4228 (assq (assq name byte-compile-active-blocks)))
4229 (if assq
4230 (setf (nth 2 assq) t)
4231 (byte-compile-warn
4232 "return-from: %S: no current lexical block with this name"
4233 name))
4234 (byte-compile-throw
4235 `(throw ',(or (nth 1 assq) (copy-symbol name))
4236 ,@(nthcdr 2 form)))))
4237 4220
4238 (defun byte-compile-unwind-protect (form) 4221 (defun byte-compile-unwind-protect (form)
4239 (byte-compile-push-constant 4222 (byte-compile-push-constant
4240 (byte-compile-top-level-body (cdr (cdr form)) t)) 4223 (byte-compile-top-level-body (cdr (cdr form)) t))
4241 (byte-compile-out 'byte-unwind-protect 0) 4224 (byte-compile-out 'byte-unwind-protect 0)
4381 (progn 4364 (progn
4382 (byte-compile-warn-wrong-args form 2) 4365 (byte-compile-warn-wrong-args form 2)
4383 (byte-compile-normal-call 4366 (byte-compile-normal-call
4384 `(signal 'wrong-number-of-arguments '(,(car form) 4367 `(signal 'wrong-number-of-arguments '(,(car form)
4385 ,(length (cdr form)))))) 4368 ,(length (cdr form))))))
4369 ;; If this form was macroexpanded from `return-from', mark the
4370 ;; corresponding block as having been referenced.
4371 (let* ((symbol (car-safe (cdr-safe (nth 1 form))))
4372 (block (and symbol (symbolp symbol) (get symbol 'cl-block-name)))
4373 (assq (and block (assq block byte-compile-active-blocks))))
4374 (and assq (setcdr assq t)))
4386 (byte-compile-form (nth 1 form)) ;; Push the arguments 4375 (byte-compile-form (nth 1 form)) ;; Push the arguments
4387 (byte-compile-form (nth 2 form)) 4376 (byte-compile-form (nth 2 form))
4388 (byte-compile-out (get (car form) 'byte-opcode) 0) 4377 (byte-compile-out (get (car form) 'byte-opcode) 0)
4389 (pushnew '(null (function-max-args 'throw)) 4378 (pushnew '(null (function-max-args 'throw))
4390 byte-compile-checks-on-load 4379 byte-compile-checks-on-load