[COMMIT] Be much more comprehensive in our use of byte-compile-funarg.
Aidan Kehoe
kehoea at parhasard.net
Sat Nov 14 09:11:14 EST 2009
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea at parhasard.net>
# Date 1258205632 0
# Node ID 776bbf454f3adec6a430d72c7e9efd67e85e6545
# Parent 4cf435fcebbc2f8d6895061ea423b85f5e138834
Be much more comprehensive in our use of byte-compile-funarg.
lisp/ChangeLog addition:
2009-11-14 Aidan Kehoe <kehoea at 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.
diff -r 4cf435fcebbc -r 776bbf454f3a lisp/ChangeLog
--- 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 at 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 at parhasard.net>
* cl-macs.el (letf):
diff -r 4cf435fcebbc -r 776bbf454f3a lisp/bytecomp.el
--- 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))
@@ -3666,7 +3680,6 @@
`(set-default ',(pop args) ,@(if args (list (pop args)) nil))
(if args t for-effect)))))
(setq for-effect nil))
-
(defun byte-compile-set-default (form)
(let* ((args (cdr form))
@@ -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*)
--
¿Dónde estará ahora mi sobrino Yoghurtu Nghe, que tuvo que huir
precipitadamente de la aldea por culpa de la escasez de rinocerontes?
More information about the XEmacs-Patches
mailing list