diff lisp/cl-macs.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 cc6f0266bc36
children 289cf21be887
line wrap: on
line diff
--- a/lisp/cl-macs.el	Sat May 05 18:42:00 2012 +0100
+++ b/lisp/cl-macs.el	Sat May 05 20:48:24 2012 +0100
@@ -1863,39 +1863,40 @@
 		    byte-compile-bound-variables))))
 
 	((eq (car-safe spec) 'inline)
-	 (while (setq spec (cdr spec))
-	   (let ((assq (cdr (assq (car spec) byte-compile-macro-environment))))
-	     (if (and (consp assq) (eq (nth 1 (nth 1 assq)) 'cl-labels-args)
-		      (atom (setq assq (nth 2 (nth 2 assq)))))
-		 ;; It's a label, and we're using the labels
-		 ;; implementation in bytecomp.el. Tell the compiler
-		 ;; to inline it, don't mark the symbol to be inlined
-		 ;; globally.
-		 (setf (getf (aref (compiled-function-constants assq) 0)
-                             'byte-optimizer)
-                       'byte-compile-inline-expand)
-	       (or (memq (get (car spec) 'byte-optimizer)
-			 '(nil byte-compile-inline-expand))
-		   (error
-		    "%s already has a byte-optimizer, can't make it inline"
-		    (car spec)))
-	       (put (car spec) 'byte-optimizer 'byte-compile-inline-expand)))))
+         (while (setq spec (cdr spec))
+           (let* ((assq (cdr (assq (car spec)
+                                   byte-compile-macro-environment)))
+                  (symbol (if (and (consp assq)
+                                   (eq (nth 1 (nth 1 assq))
+                                       'byte-compile-labels-args))
+                              ;; It's a label, and we're using the labels
+                              ;; implementation in bytecomp.el. Tell the
+                              ;; compiler to inline it, don't mark the
+                              ;; symbol to be inlined globally.
+                              (nth 1 (nth 1 (nth 3 assq)))
+                            (car spec))))
+             (or (memq (get symbol 'byte-optimizer)
+                       '(nil byte-compile-inline-expand))
+                 (error
+                  "%s already has a byte-optimizer, can't make it inline"
+                  symbol))
+             (put symbol 'byte-optimizer 'byte-compile-inline-expand))))
 	((eq (car-safe spec) 'notinline)
 	 (while (setq spec (cdr spec))
-	   (let ((assq (cdr (assq (car spec) byte-compile-macro-environment))))
-	     (if (and (consp assq) (eq (nth 1 (nth 1 assq)) 'cl-labels-args)
-		      (atom (setq assq (nth 2 (nth 2 assq)))))
-		 ;; It's a label, and we're using the labels
-		 ;; implementation in bytecomp.el. Tell the compiler
-		 ;; not to inline it.
-                 (if (eq 'byte-compile-inline-expand
-                         (getf (aref (compiled-function-constants assq) 0)
-                               'byte-optimizer))
-                     (remf (aref (compiled-function-constants assq) 0)
-                           'byte-optimizer))
-	       (if (eq (get (car spec) 'byte-optimizer)
-		       'byte-compile-inline-expand)
-		   (put (car spec) 'byte-optimizer nil))))))
+           (let* ((assq (cdr (assq (car spec)
+                                   byte-compile-macro-environment)))
+                  (symbol (if (and (consp assq)
+                                   (eq (nth 1 (nth 1 assq))
+                                       'byte-compile-labels-args))
+                              ;; It's a label, and we're using the labels
+                              ;; implementation in bytecomp.el. Tell the
+                              ;; compiler not to inline it, don't mark the
+                              ;; symbol to be notinline globally.
+                              (nth 1 (nth 1 (nth 3 assq)))
+                            (car spec))))
+             (if (eq (get symbol 'byte-optimizer)
+                     'byte-compile-inline-expand)
+                 (put symbol 'byte-optimizer nil)))))
 	((eq (car-safe spec) 'optimize)
 	 (let ((speed (assq (nth 1 (assq 'speed (cdr spec)))
 			    '((0 . nil) (1 . t) (2 . t) (3 . t))))