Mercurial > hg > xemacs-beta

comparison lisp/bytecomp.el @ 4743:776bbf454f3a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 bd51ab22afa8
children 1d61580e0cf7
comparison
equal deleted inserted replaced
4742:4cf435fcebbc 4743:776bbf454f3a
3522 "A quoted lambda form is the second argument of fset. This is probably 3522 "A quoted lambda form is the second argument of fset. This is probably
3523 not what you want, as that lambda cannot be compiled. Consider using 3523 not what you want, as that lambda cannot be compiled. Consider using
3524 the syntax (function (lambda (...) ...)) instead.")))) 3524 the syntax (function (lambda (...) ...)) instead."))))
3525 (byte-compile-two-args form)) 3525 (byte-compile-two-args form))
3526 3526
3527 (defun byte-compile-funarg (form) 3527 (defmacro byte-compile-funarg-n (&rest n)
3528 ;; (mapcar '(lambda (x) ..) ..) ==> (mapcar (function (lambda (x) ..)) ..) 3528 `#'(lambda (form)
3529 ;; for cases where it's guaranteed that first arg will be used as a lambda. 3529 ,@(loop
3530 (byte-compile-normal-call 3530 for en in n
3531 (let ((fn (nth 1 form))) 3531 collect `(let ((fn (nth ,en form)))
3532 (if (and (eq (car-safe fn) 'quote) 3532 (when (and (eq (car-safe fn) 'quote)
3533 (eq (car-safe (nth 1 fn)) 'lambda) 3533 (eq (car-safe (nth 1 fn)) 'lambda)
3534 (or 3534 (or
3535 (null (memq 'quoted-lambda byte-compile-warnings)) 3535 (null (memq 'quoted-lambda
3536 (byte-compile-warn 3536 byte-compile-warnings))
3537 "Passing a quoted lambda to #'%s, forcing function quoting" 3537 (byte-compile-warn
3538 (car form)))) 3538 "Passing a quoted lambda to #'%s, forcing \
3539 (cons (car form) 3539 function quoting" (car form))))
3540 (cons (cons 'function (cdr fn)) 3540 (setcar fn 'function))))
3541 (cdr (cdr form)))) 3541 (byte-compile-normal-call form)))
3542 form)))) 3542
3543 ;; (mapcar '(lambda (x) ..) ..) ==> (mapcar (function (lambda (x) ..)) ..)
3544 ;; for cases where it's guaranteed that first arg will be used as a lambda.
3545 (defalias 'byte-compile-funarg (byte-compile-funarg-n 1))
3546
3547 ;; (sort ... '(lambda (x) ..)) ==> (sort ... (function (lambda (x) ..)))
3548 ;; for cases where it's guaranteed that second arg will be used as a lambda.
3549 (defalias 'byte-compile-funarg-2 (byte-compile-funarg-n 2))
3550
3551 ;; For #'merge, basically.
3552 (defalias 'byte-compile-funarg-4 (byte-compile-funarg-n 4))
3553
3554 ;; For #'call-with-condition-handler, basically.
3555 (defalias 'byte-compile-funarg-1-2 (byte-compile-funarg-n 1 2))
3543 3556
3544 ;; XEmacs change; don't cons up the list if it's going to be immediately 3557 ;; XEmacs change; don't cons up the list if it's going to be immediately
3545 ;; discarded. 3558 ;; discarded. GNU give a warning in `byte-compile-normal-call' instead, and
3559 ;; only for #'mapcar.
3546 (defun byte-compile-maybe-mapc (form) 3560 (defun byte-compile-maybe-mapc (form)
3547 (and for-effect 3561 (and for-effect
3548 (or (null (memq 'discarded-consing byte-compile-warnings)) 3562 (or (null (memq 'discarded-consing byte-compile-warnings))
3549 (byte-compile-warn 3563 (byte-compile-warn
3550 "Discarding the result of #'%s; maybe you meant #'mapc?" 3564 "Discarding the result of #'%s; maybe you meant #'mapc?"
3664 (byte-compile-form 3678 (byte-compile-form
3665 ;; Odd number of args? Let `set-default' get the error. 3679 ;; Odd number of args? Let `set-default' get the error.
3666 `(set-default ',(pop args) ,@(if args (list (pop args)) nil)) 3680 `(set-default ',(pop args) ,@(if args (list (pop args)) nil))
3667 (if args t for-effect))))) 3681 (if args t for-effect)))))
3668 (setq for-effect nil)) 3682 (setq for-effect nil))
3669
3670 3683
3671 (defun byte-compile-set-default (form) 3684 (defun byte-compile-set-default (form)
3672 (let* ((args (cdr form)) 3685 (let* ((args (cdr form))
3673 (nargs (length args)) 3686 (nargs (length args))
3674 (var (car args))) 3687 (var (car args)))
3736 (byte-defop-compiler-1 or) 3749 (byte-defop-compiler-1 or)
3737 (byte-defop-compiler-1 while) 3750 (byte-defop-compiler-1 while)
3738 (byte-defop-compiler-1 funcall) 3751 (byte-defop-compiler-1 funcall)
3739 (byte-defop-compiler-1 apply byte-compile-funarg) 3752 (byte-defop-compiler-1 apply byte-compile-funarg)
3740 (byte-defop-compiler-1 mapcar byte-compile-maybe-mapc) 3753 (byte-defop-compiler-1 mapcar byte-compile-maybe-mapc)
3741 (byte-defop-compiler-1 mapvector byte-compile-maybe-mapc)
3742 (byte-defop-compiler-1 mapc byte-compile-funarg)
3743 (byte-defop-compiler-1 mapc-internal byte-compile-funarg)
3744 (byte-defop-compiler-1 mapatoms byte-compile-funarg) 3754 (byte-defop-compiler-1 mapatoms byte-compile-funarg)
3745 (byte-defop-compiler-1 mapconcat byte-compile-funarg) 3755 (byte-defop-compiler-1 mapconcat byte-compile-funarg)
3746 (byte-defop-compiler-1 map byte-compile-funarg) 3756 (byte-defop-compiler-1 mapc byte-compile-funarg)
3757 (byte-defop-compiler-1 maphash byte-compile-funarg)
3758 (byte-defop-compiler-1 map-char-table byte-compile-funarg)
3759 (byte-defop-compiler-1 mapvector byte-compile-maybe-mapc)
3760 (byte-defop-compiler-1 mapc-internal byte-compile-funarg)
3747 (byte-defop-compiler-1 maplist byte-compile-maplist) 3761 (byte-defop-compiler-1 maplist byte-compile-maplist)
3748 (byte-defop-compiler-1 mapl byte-compile-funarg) 3762 (byte-defop-compiler-1 mapl byte-compile-funarg)
3749 (byte-defop-compiler-1 mapcan byte-compile-funarg) 3763 (byte-defop-compiler-1 mapcan byte-compile-funarg)
3750 (byte-defop-compiler-1 mapcon byte-compile-funarg) 3764 (byte-defop-compiler-1 mapcon byte-compile-funarg)
3751 (byte-defop-compiler-1 map-char-table byte-compile-funarg)
3752 (byte-defop-compiler-1 map-database byte-compile-funarg) 3765 (byte-defop-compiler-1 map-database byte-compile-funarg)
3753 (byte-defop-compiler-1 map-extent-children byte-compile-funarg) 3766 (byte-defop-compiler-1 map-extent-children byte-compile-funarg)
3754 (byte-defop-compiler-1 map-extents byte-compile-funarg) 3767 (byte-defop-compiler-1 map-extents byte-compile-funarg)
3755 (byte-defop-compiler-1 map-plist byte-compile-funarg) 3768 (byte-defop-compiler-1 map-plist byte-compile-funarg)
3756 (byte-defop-compiler-1 map-range-table byte-compile-funarg) 3769 (byte-defop-compiler-1 map-range-table byte-compile-funarg)
3757 (byte-defop-compiler-1 map-syntax-table byte-compile-funarg) 3770 (byte-defop-compiler-1 map-syntax-table byte-compile-funarg)
3758 (byte-defop-compiler-1 mapcar-extents byte-compile-funarg)
3759 (byte-defop-compiler-1 mapcar* byte-compile-funarg) 3771 (byte-defop-compiler-1 mapcar* byte-compile-funarg)
3760 (byte-defop-compiler-1 maphash byte-compile-funarg) 3772
3773 (byte-defop-compiler-1 remove-if byte-compile-funarg)
3774 (byte-defop-compiler-1 remove-if-not byte-compile-funarg)
3775 (byte-defop-compiler-1 delete-if byte-compile-funarg)
3776 (byte-defop-compiler-1 delete-if-not byte-compile-funarg)
3777 (byte-defop-compiler-1 find-if byte-compile-funarg)
3778 (byte-defop-compiler-1 find-if-not byte-compile-funarg)
3779 (byte-defop-compiler-1 position-if byte-compile-funarg)
3780 (byte-defop-compiler-1 position-if-not byte-compile-funarg)
3781 (byte-defop-compiler-1 count-if byte-compile-funarg)
3782 (byte-defop-compiler-1 count-if-not byte-compile-funarg)
3783 (byte-defop-compiler-1 member-if byte-compile-funarg)
3784 (byte-defop-compiler-1 member-if-not byte-compile-funarg)
3785 (byte-defop-compiler-1 assoc-if byte-compile-funarg)
3786 (byte-defop-compiler-1 assoc-if-not byte-compile-funarg)
3787 (byte-defop-compiler-1 rassoc-if byte-compile-funarg)
3788 (byte-defop-compiler-1 rassoc-if-not byte-compile-funarg)
3789 (byte-defop-compiler-1 reduce byte-compile-funarg)
3790 (byte-defop-compiler-1 some byte-compile-funarg)
3791 (byte-defop-compiler-1 every byte-compile-funarg)
3792 (byte-defop-compiler-1 notany byte-compile-funarg)
3793 (byte-defop-compiler-1 notevery byte-compile-funarg)
3794
3795 (byte-defop-compiler-1 walk-windows byte-compile-funarg)
3796 (byte-defop-compiler-1 get-window-with-predicate byte-compile-funarg)
3797
3798 (byte-defop-compiler-1 map byte-compile-funarg-2)
3799 (byte-defop-compiler-1 apropos-internal byte-compile-funarg-2)
3800 (byte-defop-compiler-1 sort byte-compile-funarg-2)
3801 (byte-defop-compiler-1 sort* byte-compile-funarg-2)
3802 (byte-defop-compiler-1 stable-sort byte-compile-funarg-2)
3803 (byte-defop-compiler-1 substitute-if byte-compile-funarg-2)
3804 (byte-defop-compiler-1 substitute-if-not byte-compile-funarg-2)
3805 (byte-defop-compiler-1 nsubstitute-if byte-compile-funarg-2)
3806 (byte-defop-compiler-1 nsubstitute-if-not byte-compile-funarg-2)
3807 (byte-defop-compiler-1 subst-if byte-compile-funarg-2)
3808 (byte-defop-compiler-1 subst-if-not byte-compile-funarg-2)
3809 (byte-defop-compiler-1 nsubst-if byte-compile-funarg-2)
3810 (byte-defop-compiler-1 nsubst-if-not byte-compile-funarg-2)
3811
3812 (byte-defop-compiler-1 merge byte-compile-funarg-4)
3813
3814 (byte-defop-compiler-1 call-with-condition-handler byte-compile-funarg-1-2)
3815 (byte-defop-compiler-1 mapcar-extents byte-compile-funarg-1-2)
3816
3761 (byte-defop-compiler-1 let) 3817 (byte-defop-compiler-1 let)
3762 (byte-defop-compiler-1 let*) 3818 (byte-defop-compiler-1 let*)
3763 3819
3764 (defun byte-compile-progn (form) 3820 (defun byte-compile-progn (form)
3765 (byte-compile-body-do-effect (cdr form))) 3821 (byte-compile-body-do-effect (cdr form)))