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)