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