Mercurial > hg > xemacs-beta
comparison lisp/cl-extra.el @ 5656:e9c3fe82127d
Co-operate with the byte-optimizer in the bytecomp.el labels implementation.
lisp/ChangeLog addition:
2012-05-05 Aidan Kehoe <kehoea@parhasard.net>
Co-operate with the byte-optimizer in the bytecomp.el labels
implementation, don't work against it.
* byte-optimize.el:
* byte-optimize.el (byte-compile-inline-expand):
Call #'byte-compile-unfold-lambda explicitly here, don't assume
that the byte-optimizer will do it.
* byte-optimize.el (byte-compile-unfold-lambda):
Call #'byte-optimize-body on the body, don't just mapcar
#'byte-optimize-form along it.
* byte-optimize.el (byte-optimize-lambda): New. Optimize a lambda
form.
* byte-optimize.el (byte-optimize-form-code-walker):
Descend lambda expressions, defun, and defmacro, relevant for
lexically-oriented operators like #'labels.
* byte-optimize.el (byte-optimize-body): Only return a non-eq
object if we've actually optimized something
* bytecomp.el (byte-compile-initial-macro-environment):
In the labels implementation, work with the byte optimizer, not
against it; warn when labels are defined but not used,
automatically inline labels that are used only once.
* bytecomp.el (byte-recompile-directory):
No need to wrap #'byte-compile-report-error in a lambda with
#'call-with-condition-handler here.
* bytecomp.el (byte-compile-form):
Don't inline compiled-function objects, they're probably labels.
* bytecomp.el (byte-compile-funcall):
No longer inline lambdas, trust the byte optimizer to have done it
properly, even for labels.
* cl-extra.el (cl-macroexpand-all):
Treat labels established by the byte compiler distinctly from
those established by cl-macs.el.
* cl-macs.el (cl-do-proclaim):
Treat labels established by the byte compiler distinctly from
those established by cl-macs.el.
* gui.el (make-gui-button):
When referring to the #'gui-button-action label, quote it using
function, otherwise there's a warning from the byte compiler.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sat, 05 May 2012 20:48:24 +0100 |
parents | bd80d9103fc8 |
children | cd4f5f1f1f4c |
comparison
equal
deleted
inserted
replaced
5655:b7ae5f44b950 | 5656:e9c3fe82127d |
---|---|
567 '((quote --cl-rest--))))))) | 567 '((quote --cl-rest--))))))) |
568 (list (car form) (list* 'lambda (cadadr form) body)))) | 568 (list (car form) (list* 'lambda (cadadr form) body)))) |
569 ;; This is a bit of a hack; special-case symbols with bindings as | 569 ;; This is a bit of a hack; special-case symbols with bindings as |
570 ;; labels. | 570 ;; labels. |
571 (let ((found (cdr (assq (cadr form) env)))) | 571 (let ((found (cdr (assq (cadr form) env)))) |
572 (if (and (consp found) (eq (nth 1 (nth 1 found)) 'cl-labels-args)) | 572 (cond |
573 (if (consp (nth 2 (nth 2 found))) | 573 ((and (consp found) (eq (nth 1 (nth 1 found)) 'cl-labels-args)) |
574 ;; It's a cons; this is the implementation of | 574 ;; This is the implementation of labels in cl-macs.el. |
575 ;; labels in cl-macs.el. | 575 (cl-macroexpand-all (nth 1 (nth 2 (nth 2 found))) env)) |
576 (cl-macroexpand-all (nth 1 (nth 2 (nth 2 found))) env) | 576 ((and (consp found) (eq (nth 1 (nth 1 found)) |
577 ;; It's an atom, almost certainly a compiled function; | 577 'byte-compile-labels-args)) |
578 ;; we're using the implementation of labels in | 578 ;; We're using the implementation of labels in |
579 ;; bytecomp.el. Quote it with FUNCTION so that code can | 579 ;; bytecomp.el. Quote its data-placeholder with FUNCTION so |
580 ;; tell uses as data apart from the uses with funcall, | 580 ;; that code can tell uses as data apart from the uses with |
581 ;; where it's unquoted. #### We should warn if (car form) | 581 ;; funcall. |
582 ;; above is quote, rather than function. | 582 (unless (eq 'function (car form)) |
583 (list 'function (nth 2 (nth 2 found)))) | 583 (byte-compile-warn |
584 form)))) | 584 "deprecated: '%s, use #'%s instead to quote it as a function" |
585 (cadr form) (cadr form))) | |
586 (setq found (get (nth 1 (nth 1 (nth 3 found))) | |
587 'byte-compile-data-placeholder)) | |
588 (put found 'byte-compile-label-calls | |
589 (1+ (get found 'byte-compile-label-calls 0))) | |
590 (list 'function found)) | |
591 (t form))))) | |
585 ((memq (car form) '(defun defmacro)) | 592 ((memq (car form) '(defun defmacro)) |
586 (list* (car form) (nth 1 form) (cl-macroexpand-body (cddr form) env))) | 593 (list* (car form) (nth 1 form) (cl-macroexpand-body (cddr form) env))) |
587 ((and (eq (car form) 'progn) (not (cddr form))) | 594 ((and (eq (car form) 'progn) (not (cddr form))) |
588 (cl-macroexpand-all (nth 1 form) env)) | 595 (cl-macroexpand-all (nth 1 form) env)) |
589 ((eq (car form) 'setq) | 596 ((eq (car form) 'setq) |