Mercurial > hg > xemacs-beta
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*)