Mercurial > hg > xemacs-beta

diff lisp/cl-extra.el @ 5656:e9c3fe82127d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
line wrap: on
line diff
--- a/lisp/cl-extra.el	Sat May 05 18:42:00 2012 +0100
+++ b/lisp/cl-extra.el	Sat May 05 20:48:24 2012 +0100
@@ -569,19 +569,26 @@
            ;; This is a bit of a hack; special-case symbols with bindings as
            ;; labels.
 	   (let ((found (cdr (assq (cadr form) env))))
-	     (if (and (consp found) (eq (nth 1 (nth 1 found)) 'cl-labels-args))
-                 (if (consp (nth 2 (nth 2 found)))
-                     ;; It's a cons; this is the implementation of
-                     ;; labels in cl-macs.el.
-                     (cl-macroexpand-all (nth 1 (nth 2 (nth 2 found))) env)
-                   ;; It's an atom, almost certainly a compiled function;
-                   ;; we're using the implementation of labels in
-                   ;; bytecomp.el. Quote it with FUNCTION so that code can
-                   ;; tell uses as data apart from the uses with funcall,
-                   ;; where it's unquoted. #### We should warn if (car form)
-                   ;; above is quote, rather than function.
-                   (list 'function (nth 2 (nth 2 found))))
-	       form))))
+	     (cond
+              ((and (consp found) (eq (nth 1 (nth 1 found)) 'cl-labels-args))
+               ;; This is the implementation of labels in cl-macs.el.
+               (cl-macroexpand-all (nth 1 (nth 2 (nth 2 found))) env))
+              ((and (consp found) (eq (nth 1 (nth 1 found))
+                                      'byte-compile-labels-args))
+               ;; We're using the implementation of labels in
+               ;; bytecomp.el. Quote its data-placeholder with FUNCTION so
+               ;; that code can tell uses as data apart from the uses with
+               ;; funcall.
+               (unless (eq 'function (car form))
+                 (byte-compile-warn
+                  "deprecated: '%s, use #'%s instead to quote it as a function"
+                  (cadr form) (cadr form)))
+               (setq found (get (nth 1 (nth 1 (nth 3 found)))
+                                'byte-compile-data-placeholder))
+               (put found 'byte-compile-label-calls
+                    (1+ (get found 'byte-compile-label-calls 0)))
+               (list 'function found))
+              (t form)))))
 	((memq (car form) '(defun defmacro))
 	 (list* (car form) (nth 1 form) (cl-macroexpand-body (cddr form) env)))
 	((and (eq (car form) 'progn) (not (cddr form)))