Mercurial > hg > xemacs-beta
diff 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 |
line wrap: on
line diff
--- a/lisp/bytecomp.el Mon Oct 18 23:43:03 2010 +0900 +++ b/lisp/bytecomp.el Mon Oct 25 13:04:04 2010 +0100 @@ -2838,7 +2838,83 @@ (when for-effect (byte-compile-discard))) +;; Generate the list of functions with keyword arguments like so: +;; +;; (delete-duplicates +;; (sort* +;; (loop +;; for symbol being each symbol in obarray +;; with arglist = nil +;; if (and (fboundp symbol) +;; (ignore-errors (setq symbol (indirect-function symbol))) +;; (cond +;; ((and (subrp symbol) (setq symbol (intern (subr-name symbol))))) +;; ((and (compiled-function-p symbol) +;; (setq symbol (compiled-function-annotation symbol))))) +;; (setq arglist (function-arglist symbol)) +;; (setq arglist (ignore-errors (read-from-string arglist))) +;; (setq arglist (car arglist)) +;; (setq arglist (position '&key arglist))) +;; collect (cons symbol arglist)) +;; #'string-lessp +;; :key #'car) :test #'eq :key #'car) +;; +;; That won't include those that take advantage of cl-seq.el's +;; cl-parsing-keywords macro, but the below list does. + +(map nil + (function* + (lambda ((function . nargs)) + ;; Document that the car of OBJECT, a symbol, describes a function + ;; taking keyword arguments from the argument index described by + ;; the cdr of OBJECT. + (put function 'byte-compile-keyword-start nargs))) + '((adjoin . 3) (assoc* . 3) (assoc-if . 3) (assoc-if-not . 3) + (count . 3) (count-if . 3) (count-if-not . 3) (define-behavior . 3) + (define-behavior-group . 2) (delete* . 3) (delete-duplicates . 2) + (delete-if . 3) (delete-if-not . 3) (fill . 3) (find . 3) (find-if . 3) + (find-if-not . 3) (internal-make-translation-table . 1) + (make-Print-context . 1) (make-hash-table . 1) (make-saved-window . 1) + (make-window-configuration . 1) (member* . 3) + (member-if . 3) (member-if-not . 3) (merge . 5) (nsublis . 3) + (nsubst . 4) (nsubst-if . 4) (nsubst-if-not . 4) (nsubstitute . 4) + (nsubstitute-if . 4) (nsubstitute-if-not . 4) (override-behavior . 2) + (position . 3) (position-if . 3) (position-if-not . 3) (rassoc* . 3) + (rassoc-if . 3) (rassoc-if-not . 3) (reduce . 3) (remove* . 3) + (remove-duplicates . 2) (remove-if . 3) (remove-if-not . 3) + (replace . 3) (sort* . 3) (stable-sort . 3) (sublis . 3) + (subsetp . 3) (subst . 4) (subst-if . 4) (subst-if-not . 4) + (substitute . 4) (substitute-if . 4) (substitute-if-not . 4) + (tree-equal . 3))) + (defun byte-compile-normal-call (form) + (and (get (car form) 'byte-compile-keyword-start) + (let ((plist (nthcdr (get (car form) 'byte-compile-keyword-start) + form))) + (symbol-macrolet + ((not-present '#:not-present)) + (if (not (valid-plist-p plist)) + (byte-compile-warn + "#'%s: ill-formed keyword argument list: %S" (car form) plist) + (and + (memq 'callargs byte-compile-warnings) + (map nil + (function* + (lambda ((function . nargs)) + (and (setq function (plist-get plist function + not-present)) + (not (eq function not-present)) + (byte-compile-constp function) + (byte-compile-callargs-warn + (cons (eval function) + (member* + nargs + ;; Dummy arguments. There's no need for + ;; it to be longer than even 2, now, but + ;; very little harm in it. + '(9 8 7 6 5 4 3 2 1))))))) + '((:key . 1) (:test . 2) (:test-not . 2) + (:if . 1) (:if-not . 1)))))))) (if byte-compile-generate-call-tree (byte-compile-annotate-call-tree form)) (byte-compile-push-constant (car form))