Mercurial > hg > xemacs-beta
comparison lisp/bytecomp.el @ 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 | d967d96ca043 |
| children | eac2e6bd5b2c |
comparison
equal
deleted
inserted
replaced
| 5375:2fba45e5b48d | 5376:4b529b940e2e |
|---|---|
| 4193 | 4193 |
| 4194 (defun byte-compile-catch (form) | 4194 (defun byte-compile-catch (form) |
| 4195 "Byte-compile and return a `catch' from. | 4195 "Byte-compile and return a `catch' from. |
| 4196 | 4196 |
| 4197 If FORM is the result of macroexpanding a `block' form (the TAG argument is | 4197 If FORM is the result of macroexpanding a `block' form (the TAG argument is |
| 4198 a quoted symbol with a non-nil `cl-block-name' property) and there is no | 4198 a quoted symbol with a `cl-block-name' property) and there is no |
| 4199 corresponding `return-from' within the block--or equivalently, it was | 4199 corresponding `return-from' within the block--or equivalently, it was |
| 4200 optimized away--just byte compile and return the BODY." | 4200 optimized away--just byte compile and return the BODY." |
| 4201 (let* ((symbol (car-safe (cdr-safe (nth 1 form)))) | 4201 (let* ((symbol (car-safe (cdr-safe (nth 1 form)))) |
| 4202 (block (and symbol (symbolp symbol) (get symbol 'cl-block-name))) | 4202 (not-present '#:not-present) |
| 4203 (elt (and block (cons block nil))) | 4203 (block (and symbol (symbolp symbol) |
| 4204 (get symbol 'cl-block-name not-present))) | |
| 4205 (elt (and (not (eq block not-present)) (list block))) | |
| 4204 (byte-compile-active-blocks | 4206 (byte-compile-active-blocks |
| 4205 (if block | 4207 (if elt |
| 4206 (cons elt byte-compile-active-blocks) | 4208 (cons elt byte-compile-active-blocks) |
| 4207 byte-compile-active-blocks)) | 4209 byte-compile-active-blocks)) |
| 4208 (body | 4210 (body |
| 4209 (byte-compile-top-level (cons 'progn (cddr form)) | 4211 (byte-compile-top-level (cons 'progn (cddr form)) |
| 4210 (if block nil for-effect)))) | 4212 (and elt for-effect)))) |
| 4211 (if (and block (not (cdr elt))) | 4213 (if (and elt (not (cdr elt))) |
| 4212 ;; A lexical block without any contained return-from clauses: | 4214 ;; A lexical block without any contained return-from clauses: |
| 4213 (byte-compile-form body) | 4215 (byte-compile-form body) |
| 4214 ;; A normal catch call, or a lexical block with a contained | 4216 ;; A normal catch call, or a lexical block with a contained |
| 4215 ;; return-from clause. | 4217 ;; return-from clause. |
| 4216 (byte-compile-form (car (cdr form))) | 4218 (byte-compile-form (car (cdr form))) |
| 4366 `(signal 'wrong-number-of-arguments '(,(car form) | 4368 `(signal 'wrong-number-of-arguments '(,(car form) |
| 4367 ,(length (cdr form)))))) | 4369 ,(length (cdr form)))))) |
| 4368 ;; If this form was macroexpanded from `return-from', mark the | 4370 ;; If this form was macroexpanded from `return-from', mark the |
| 4369 ;; corresponding block as having been referenced. | 4371 ;; corresponding block as having been referenced. |
| 4370 (let* ((symbol (car-safe (cdr-safe (nth 1 form)))) | 4372 (let* ((symbol (car-safe (cdr-safe (nth 1 form)))) |
| 4371 (block (and symbol (symbolp symbol) (get symbol 'cl-block-name))) | 4373 (not-present '#:not-present) |
| 4372 (assq (and block (assq block byte-compile-active-blocks)))) | 4374 (block (and symbol (symbolp symbol) |
| 4373 (and assq (setcdr assq t))) | 4375 (get symbol 'cl-block-name not-present))) |
| 4374 (byte-compile-form (nth 1 form)) ;; Push the arguments | 4376 (assq (and (not (eq block not-present)) |
| 4375 (byte-compile-form (nth 2 form)) | 4377 (assq block byte-compile-active-blocks)))) |
| 4378 (when assq | |
| 4379 (setcdr assq t)) | |
| 4380 (when (not (eq block not-present)) | |
| 4381 ;; No corresponding enclosing block. | |
| 4382 (byte-compile-warn "return-from: no enclosing block named `%s'" | |
| 4383 block))) | |
| 4384 (mapc 'byte-compile-form (cdr form)) ;; Push the arguments | |
| 4376 (byte-compile-out (get (car form) 'byte-opcode) 0) | 4385 (byte-compile-out (get (car form) 'byte-opcode) 0) |
| 4377 (pushnew '(null (function-max-args 'throw)) | 4386 (pushnew '(null (function-max-args 'throw)) byte-compile-checks-on-load |
| 4378 byte-compile-checks-on-load | |
| 4379 :test #'equal))) | 4387 :test #'equal))) |
| 4380 | 4388 |
| 4381 ;;; top-level forms elsewhere | 4389 ;;; top-level forms elsewhere |
| 4382 | 4390 |
| 4383 (byte-defop-compiler-1 defun) | 4391 (byte-defop-compiler-1 defun) |