comparison lisp/bytecomp.el @ 5294:bbff29a01820

Add compiler macros and compilation sanity-checks for functions with keywords. 2010-10-25 Aidan Kehoe <kehoea@parhasard.net> Add compiler macros and compilation sanity-checking for various functions that take keywords. * byte-optimize.el (side-effect-free-fns): #'symbol-value is side-effect free and not error free. * bytecomp.el (byte-compile-normal-call): Check keyword argument lists for sanity; store information about the positions where keyword arguments start using the new byte-compile-keyword-start property. * cl-macs.el (cl-const-expr-val): Take a new optional argument, cl-not-constant, defaulting to nil, in this function; return it if the expression is not constant. (cl-non-fixnum-number-p): Make this into a separate function, we want to pass it to #'every. (eql): Use it. (define-star-compiler-macros): Use the same code to generate the member*, assoc* and rassoc* compiler macros; special-case some code in #'add-to-list in subr.el. (remove, remq): Add compiler macros for these two functions, in preparation for #'remove being in C. (define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to (remove ... :if-not) at compile time, which will be a real win once the latter is in C. (define-substitute-if-compiler-macros) (define-subst-if-compiler-macros): Similarly for these functions. (delete-duplicates): Change this compiler macro to use #'plists-equal; if we don't have information about the type of SEQUENCE at compile time, don't bother attempting to inline the call, the function will be in C soon enough. (equalp): Remove an old commented-out compiler macro for this, if we want to see it it's in version control. (subst-char-in-string): Transform this to a call to nsubstitute or nsubstitute, if that is appropriate. * cl.el (ldiff): Don't call setf here, this makes for a load-time dependency problem in cl-macs.el
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 25 Oct 2010 13:04:04 +0100
parents dcc34e28cd84
children ec05a30f7148 b9167d522a9a
comparison
equal deleted inserted replaced
5293:63f247c5da0a 5294:bbff29a01820
2836 (setq for-effect nil)) 2836 (setq for-effect nil))
2837 ((byte-compile-normal-call form))) 2837 ((byte-compile-normal-call form)))
2838 (when for-effect 2838 (when for-effect
2839 (byte-compile-discard))) 2839 (byte-compile-discard)))
2840 2840
2841 ;; Generate the list of functions with keyword arguments like so:
2842 ;;
2843 ;; (delete-duplicates
2844 ;; (sort*
2845 ;; (loop
2846 ;; for symbol being each symbol in obarray
2847 ;; with arglist = nil
2848 ;; if (and (fboundp symbol)
2849 ;; (ignore-errors (setq symbol (indirect-function symbol)))
2850 ;; (cond
2851 ;; ((and (subrp symbol) (setq symbol (intern (subr-name symbol)))))
2852 ;; ((and (compiled-function-p symbol)
2853 ;; (setq symbol (compiled-function-annotation symbol)))))
2854 ;; (setq arglist (function-arglist symbol))
2855 ;; (setq arglist (ignore-errors (read-from-string arglist)))
2856 ;; (setq arglist (car arglist))
2857 ;; (setq arglist (position '&key arglist)))
2858 ;; collect (cons symbol arglist))
2859 ;; #'string-lessp
2860 ;; :key #'car) :test #'eq :key #'car)
2861 ;;
2862 ;; That won't include those that take advantage of cl-seq.el's
2863 ;; cl-parsing-keywords macro, but the below list does.
2864
2865 (map nil
2866 (function*
2867 (lambda ((function . nargs))
2868 ;; Document that the car of OBJECT, a symbol, describes a function
2869 ;; taking keyword arguments from the argument index described by
2870 ;; the cdr of OBJECT.
2871 (put function 'byte-compile-keyword-start nargs)))
2872 '((adjoin . 3) (assoc* . 3) (assoc-if . 3) (assoc-if-not . 3)
2873 (count . 3) (count-if . 3) (count-if-not . 3) (define-behavior . 3)
2874 (define-behavior-group . 2) (delete* . 3) (delete-duplicates . 2)
2875 (delete-if . 3) (delete-if-not . 3) (fill . 3) (find . 3) (find-if . 3)
2876 (find-if-not . 3) (internal-make-translation-table . 1)
2877 (make-Print-context . 1) (make-hash-table . 1) (make-saved-window . 1)
2878 (make-window-configuration . 1) (member* . 3)
2879 (member-if . 3) (member-if-not . 3) (merge . 5) (nsublis . 3)
2880 (nsubst . 4) (nsubst-if . 4) (nsubst-if-not . 4) (nsubstitute . 4)
2881 (nsubstitute-if . 4) (nsubstitute-if-not . 4) (override-behavior . 2)
2882 (position . 3) (position-if . 3) (position-if-not . 3) (rassoc* . 3)
2883 (rassoc-if . 3) (rassoc-if-not . 3) (reduce . 3) (remove* . 3)
2884 (remove-duplicates . 2) (remove-if . 3) (remove-if-not . 3)
2885 (replace . 3) (sort* . 3) (stable-sort . 3) (sublis . 3)
2886 (subsetp . 3) (subst . 4) (subst-if . 4) (subst-if-not . 4)
2887 (substitute . 4) (substitute-if . 4) (substitute-if-not . 4)
2888 (tree-equal . 3)))
2889
2841 (defun byte-compile-normal-call (form) 2890 (defun byte-compile-normal-call (form)
2891 (and (get (car form) 'byte-compile-keyword-start)
2892 (let ((plist (nthcdr (get (car form) 'byte-compile-keyword-start)
2893 form)))
2894 (symbol-macrolet
2895 ((not-present '#:not-present))
2896 (if (not (valid-plist-p plist))
2897 (byte-compile-warn
2898 "#'%s: ill-formed keyword argument list: %S" (car form) plist)
2899 (and
2900 (memq 'callargs byte-compile-warnings)
2901 (map nil
2902 (function*
2903 (lambda ((function . nargs))
2904 (and (setq function (plist-get plist function
2905 not-present))
2906 (not (eq function not-present))
2907 (byte-compile-constp function)
2908 (byte-compile-callargs-warn
2909 (cons (eval function)
2910 (member*
2911 nargs
2912 ;; Dummy arguments. There's no need for
2913 ;; it to be longer than even 2, now, but
2914 ;; very little harm in it.
2915 '(9 8 7 6 5 4 3 2 1)))))))
2916 '((:key . 1) (:test . 2) (:test-not . 2)
2917 (:if . 1) (:if-not . 1))))))))
2842 (if byte-compile-generate-call-tree 2918 (if byte-compile-generate-call-tree
2843 (byte-compile-annotate-call-tree form)) 2919 (byte-compile-annotate-call-tree form))
2844 (byte-compile-push-constant (car form)) 2920 (byte-compile-push-constant (car form))
2845 (mapc 'byte-compile-form (cdr form)) ; wasteful, but faster. 2921 (mapc 'byte-compile-form (cdr form)) ; wasteful, but faster.
2846 (byte-compile-out 'byte-call (length (cdr form)))) 2922 (byte-compile-out 'byte-call (length (cdr form))))