changeset 4743:776bbf454f3a

Be much more comprehensive in our use of byte-compile-funarg. lisp/ChangeLog addition: 2009-11-14 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-funarg-n): New macro, used to create the various byte-compile-funarg functions, which check for quoted lambdas in given positions. (byte-compile-funarg, byte-compile-funarg-2) (byte-compile-funarg-4, byte-compile-funarg-1-2): Use byte-compile-funarg-n in implementing these functions. (byte-compile-maybe-mapc): Add some commentary on GNU's approach to this problem. Be much more comprehensive in the functions that we use byte-compile-funarg and related function to compile, especially including functions from cl-seq.el.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 14 Nov 2009 13:33:52 +0000
parents 4cf435fcebbc
children 17f7e9191c0b
files lisp/ChangeLog lisp/bytecomp.el
diffstat 2 files changed, 95 insertions(+), 25 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sat Nov 14 11:43:09 2009 +0000
+++ b/lisp/ChangeLog	Sat Nov 14 13:33:52 2009 +0000
@@ -1,3 +1,17 @@
+2009-11-14  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* bytecomp.el (byte-compile-funarg-n): 
+	New macro, used to create the various byte-compile-funarg
+	functions, which check for quoted lambdas in given positions.
+	(byte-compile-funarg, byte-compile-funarg-2)
+	(byte-compile-funarg-4, byte-compile-funarg-1-2): Use
+	byte-compile-funarg-n in implementing these functions.
+	(byte-compile-maybe-mapc): Add some commentary on GNU's approach
+	to this problem.
+	Be much more comprehensive in the functions that we use
+	byte-compile-funarg and related function to compile, especially
+	including functions from cl-seq.el. 
+
 2009-11-14  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl-macs.el (letf): 
--- a/lisp/bytecomp.el	Sat Nov 14 11:43:09 2009 +0000
+++ b/lisp/bytecomp.el	Sat Nov 14 13:33:52 2009 +0000
@@ -3524,25 +3524,39 @@
      the syntax (function (lambda (...) ...)) instead."))))
   (byte-compile-two-args form))
 
-(defun byte-compile-funarg (form)
-  ;; (mapcar '(lambda (x) ..) ..) ==> (mapcar (function (lambda (x) ..)) ..)
-  ;; for cases where it's guaranteed that first arg will be used as a lambda.
-  (byte-compile-normal-call
-   (let ((fn (nth 1 form)))
-     (if (and (eq (car-safe fn) 'quote)
-	      (eq (car-safe (nth 1 fn)) 'lambda)
-	      (or 
-	       (null (memq 'quoted-lambda byte-compile-warnings))
-	       (byte-compile-warn
-		"Passing a quoted lambda to #'%s, forcing function quoting"
-		(car form))))
-	 (cons (car form)
-	       (cons (cons 'function (cdr fn))
-		     (cdr (cdr form))))
-       form))))
+(defmacro byte-compile-funarg-n (&rest n)
+  `#'(lambda (form)
+       ,@(loop
+          for en in n
+          collect `(let ((fn (nth ,en form)))
+                    (when (and (eq (car-safe fn) 'quote)
+                               (eq (car-safe (nth 1 fn)) 'lambda)
+                               (or
+                                (null (memq 'quoted-lambda
+                                            byte-compile-warnings))
+                                (byte-compile-warn
+                                 "Passing a quoted lambda to #'%s, forcing \
+function quoting" (car form))))
+                      (setcar fn 'function))))
+          (byte-compile-normal-call form)))
+
+;; (mapcar '(lambda (x) ..) ..) ==> (mapcar (function (lambda (x) ..)) ..)
+;; for cases where it's guaranteed that first arg will be used as a lambda.
+(defalias 'byte-compile-funarg (byte-compile-funarg-n 1))
+
+;; (sort ... '(lambda (x) ..)) ==> (sort ... (function (lambda (x) ..)))
+;; for cases where it's guaranteed that second arg will be used as a lambda.
+(defalias 'byte-compile-funarg-2 (byte-compile-funarg-n 2))
+
+;; For #'merge, basically.
+(defalias 'byte-compile-funarg-4 (byte-compile-funarg-n 4))
+
+;; For #'call-with-condition-handler, basically.
+(defalias 'byte-compile-funarg-1-2 (byte-compile-funarg-n 1 2))
 
 ;; XEmacs change; don't cons up the list if it's going to be immediately
-;; discarded.
+;; discarded. GNU give a warning in `byte-compile-normal-call' instead, and
+;; only for #'mapcar.
 (defun byte-compile-maybe-mapc (form)
   (and for-effect
        (or (null (memq 'discarded-consing byte-compile-warnings))
@@ -3667,7 +3681,6 @@
 	 (if args t for-effect)))))
   (setq for-effect nil))
 
-
 (defun byte-compile-set-default (form)
   (let* ((args (cdr form))
 	 (nargs (length args))
@@ -3738,26 +3751,69 @@
 (byte-defop-compiler-1 funcall)
 (byte-defop-compiler-1 apply byte-compile-funarg)
 (byte-defop-compiler-1 mapcar byte-compile-maybe-mapc)
-(byte-defop-compiler-1 mapvector byte-compile-maybe-mapc)
-(byte-defop-compiler-1 mapc byte-compile-funarg)
-(byte-defop-compiler-1 mapc-internal byte-compile-funarg)
 (byte-defop-compiler-1 mapatoms byte-compile-funarg)
 (byte-defop-compiler-1 mapconcat byte-compile-funarg)
-(byte-defop-compiler-1 map byte-compile-funarg)
+(byte-defop-compiler-1 mapc byte-compile-funarg)
+(byte-defop-compiler-1 maphash byte-compile-funarg)
+(byte-defop-compiler-1 map-char-table byte-compile-funarg)
+(byte-defop-compiler-1 mapvector byte-compile-maybe-mapc)
+(byte-defop-compiler-1 mapc-internal byte-compile-funarg)
 (byte-defop-compiler-1 maplist byte-compile-maplist)
 (byte-defop-compiler-1 mapl byte-compile-funarg)
 (byte-defop-compiler-1 mapcan byte-compile-funarg)
 (byte-defop-compiler-1 mapcon byte-compile-funarg)
-(byte-defop-compiler-1 map-char-table byte-compile-funarg)
 (byte-defop-compiler-1 map-database byte-compile-funarg)
 (byte-defop-compiler-1 map-extent-children byte-compile-funarg)
 (byte-defop-compiler-1 map-extents byte-compile-funarg)
 (byte-defop-compiler-1 map-plist byte-compile-funarg)
 (byte-defop-compiler-1 map-range-table byte-compile-funarg)
 (byte-defop-compiler-1 map-syntax-table byte-compile-funarg)
-(byte-defop-compiler-1 mapcar-extents byte-compile-funarg)
 (byte-defop-compiler-1 mapcar* byte-compile-funarg)
-(byte-defop-compiler-1 maphash byte-compile-funarg)
+
+(byte-defop-compiler-1 remove-if byte-compile-funarg)
+(byte-defop-compiler-1 remove-if-not byte-compile-funarg)
+(byte-defop-compiler-1 delete-if byte-compile-funarg)
+(byte-defop-compiler-1 delete-if-not byte-compile-funarg)
+(byte-defop-compiler-1 find-if byte-compile-funarg)
+(byte-defop-compiler-1 find-if-not byte-compile-funarg)
+(byte-defop-compiler-1 position-if byte-compile-funarg)
+(byte-defop-compiler-1 position-if-not byte-compile-funarg)
+(byte-defop-compiler-1 count-if byte-compile-funarg)
+(byte-defop-compiler-1 count-if-not byte-compile-funarg)
+(byte-defop-compiler-1 member-if byte-compile-funarg)
+(byte-defop-compiler-1 member-if-not byte-compile-funarg)
+(byte-defop-compiler-1 assoc-if byte-compile-funarg)
+(byte-defop-compiler-1 assoc-if-not byte-compile-funarg)
+(byte-defop-compiler-1 rassoc-if byte-compile-funarg)
+(byte-defop-compiler-1 rassoc-if-not byte-compile-funarg)
+(byte-defop-compiler-1 reduce byte-compile-funarg)
+(byte-defop-compiler-1 some byte-compile-funarg)
+(byte-defop-compiler-1 every byte-compile-funarg)
+(byte-defop-compiler-1 notany byte-compile-funarg)
+(byte-defop-compiler-1 notevery byte-compile-funarg)
+
+(byte-defop-compiler-1 walk-windows byte-compile-funarg)
+(byte-defop-compiler-1 get-window-with-predicate byte-compile-funarg)
+
+(byte-defop-compiler-1 map byte-compile-funarg-2)
+(byte-defop-compiler-1 apropos-internal byte-compile-funarg-2)
+(byte-defop-compiler-1 sort byte-compile-funarg-2)
+(byte-defop-compiler-1 sort* byte-compile-funarg-2)
+(byte-defop-compiler-1 stable-sort byte-compile-funarg-2)
+(byte-defop-compiler-1 substitute-if byte-compile-funarg-2)
+(byte-defop-compiler-1 substitute-if-not byte-compile-funarg-2)
+(byte-defop-compiler-1 nsubstitute-if byte-compile-funarg-2)
+(byte-defop-compiler-1 nsubstitute-if-not byte-compile-funarg-2)
+(byte-defop-compiler-1 subst-if byte-compile-funarg-2)
+(byte-defop-compiler-1 subst-if-not byte-compile-funarg-2)
+(byte-defop-compiler-1 nsubst-if byte-compile-funarg-2)
+(byte-defop-compiler-1 nsubst-if-not byte-compile-funarg-2)
+
+(byte-defop-compiler-1 merge byte-compile-funarg-4)
+
+(byte-defop-compiler-1 call-with-condition-handler byte-compile-funarg-1-2)
+(byte-defop-compiler-1 mapcar-extents byte-compile-funarg-1-2)
+
 (byte-defop-compiler-1 let)
 (byte-defop-compiler-1 let*)