diff options
Diffstat (limited to 'lisp/emacs-lisp/byte-opt.el')
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 555 |
1 files changed, 397 insertions, 158 deletions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index fc49e88f8ee..27b0d33d3ef 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -171,7 +171,7 @@ Earlier variables shadow later ones with the same name.") (if (eq fn localfn) ;; From the same file => same mode. (macroexp--unfold-lambda `(,fn ,@(cdr form))) - ;; Since we are called from inside the optimiser, we need to make + ;; Since we are called from inside the optimizer, we need to make ;; sure not to propagate lexvar values. (let ((byte-optimize--lexvars nil) ;; Silence all compilation warnings: the useful ones should @@ -204,7 +204,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") This indicates the loop discovery phase.") (defvar byte-optimize--dynamic-vars nil - "List of variables declared as dynamic during optimisation.") + "List of variables declared as dynamic during optimization.") (defvar byte-optimize--aliased-vars nil "List of variables which may be aliased by other lexical variables. @@ -315,7 +315,7 @@ for speeding up processing.") (`(cond . ,clauses) ;; FIXME: The condition in the first clause is always executed, and ;; clause bodies are mutually exclusive -- use this for improved - ;; optimisation (see comment about `if' below). + ;; optimization (see comment about `if' below). (cons fn (mapcar (lambda (clause) (if (consp clause) @@ -364,9 +364,9 @@ for speeding up processing.") ;; FIXME: We have to traverse the expressions in left-to-right ;; order (because that is the order of evaluation and variable ;; mutations must be found prior to their use), but doing so we miss - ;; some optimisation opportunities: + ;; some optimization opportunities: ;; consider (and A B) in a for-effect context, where B => nil. - ;; Then A could be optimised in a for-effect context too. + ;; Then A could be optimized in a for-effect context too. (let ((tail exps) (args nil)) (while tail @@ -380,19 +380,19 @@ for speeding up processing.") ;; FIXME: If the loop condition is statically nil after substitution ;; of surrounding variables then we can eliminate the whole loop, ;; even if those variables are mutated inside the loop. - ;; We currently don't perform this important optimisation. + ;; We currently don't perform this important optimization. (let* ((byte-optimize--vars-outside-loop byte-optimize--lexvars) (condition-body (if byte-optimize--inhibit-outside-loop-constprop ;; We are already inside the discovery phase of an outer ;; loop so there is no need for traversing this loop twice. (cons exp exps) - ;; Discovery phase: run optimisation without substitution + ;; Discovery phase: run optimization without substitution ;; of variables bound outside this loop. (let ((byte-optimize--inhibit-outside-loop-constprop t)) (cons (byte-optimize-form exp nil) (byte-optimize-body exps t))))) - ;; Optimise again, this time with constprop enabled (unless + ;; Optimize again, this time with constprop enabled (unless ;; we are in discovery of an outer loop), ;; as mutated variables have been marked as non-substitutable. (condition (byte-optimize-form (car condition-body) nil)) @@ -406,7 +406,7 @@ for speeding up processing.") (`(function . ,_) ;; This forms is compiled as constant or by breaking out ;; all the subexpressions and compiling them separately. - form) + (and (not for-effect) form)) (`(condition-case ,var ,exp . ,clauses) `(,fn ,var ;Not evaluated. @@ -422,15 +422,13 @@ for speeding up processing.") (byte-optimize-body (cdr clause) for-effect)))) clauses))) - (`(unwind-protect ,exp :fun-body ,f) - ;; The unwinding part of an unwind-protect is compiled (and thus - ;; optimized) as a top-level form, but run the optimizer for it here - ;; anyway for lexical variable usage and substitution. But the - ;; protected part has the same for-effect status as the - ;; unwind-protect itself. (The unwinding part is always for effect, - ;; but that isn't handled properly yet.) - (let ((bodyform (byte-optimize-form exp for-effect))) - `(,fn ,bodyform :fun-body ,(byte-optimize-form f nil)))) + ;; `unwind-protect' is a special form which here takes the shape + ;; (unwind-protect EXPR :fun-body UNWIND-FUN). + ;; We can treat it as if it were a plain function at this point, + ;; although there are specific optimizations possible. + ;; In particular, the return value of UNWIND-FUN is never used + ;; so its body should really be compiled for-effect, but we + ;; don't do that right now. (`(catch ,tag . ,exps) `(,fn ,(byte-optimize-form tag nil) @@ -438,13 +436,15 @@ for speeding up processing.") ;; Needed as long as we run byte-optimize-form after cconv. (`(internal-make-closure . ,_) + (and (not for-effect) + (progn ;; Look up free vars and mark them to be kept, so that they - ;; won't be optimised away. + ;; won't be optimized away. (dolist (var (caddr form)) (let ((lexvar (assq var byte-optimize--lexvars))) (when lexvar (setcar (cdr lexvar) t)))) - form) + form))) (`((lambda . ,_) . ,_) (let ((newform (macroexp--unfold-lambda form))) @@ -513,7 +513,7 @@ for speeding up processing.") (defun byte-optimize-one-form (form &optional for-effect) "The source-level pass of the optimizer." - ;; Make optimiser aware of lexical arguments. + ;; Make optimizer aware of lexical arguments. (let ((byte-optimize--lexvars (mapcar (lambda (v) (list (car v) t)) byte-compile--lexical-environment))) @@ -525,7 +525,7 @@ for speeding up processing.") ;; First, optimize all sub-forms of this one. (setq form (byte-optimize-form-code-walker form for-effect)) - ;; If a form-specific optimiser is available, run it and start over + ;; If a form-specific optimizer is available, run it and start over ;; until a fixpoint has been reached. (and (consp form) (symbolp (car form)) @@ -722,35 +722,108 @@ for speeding up processing.") ;; something not EQ to its argument if and ONLY if it has made a change. ;; This implies that you cannot simply destructively modify the list; ;; you must return something not EQ to it if you make an optimization. -;; -;; It is now safe to optimize code such that it introduces new bindings. -(defsubst byte-compile-trueconstp (form) +(defsubst byte-opt--bool-value-form (form) + "The form in FORM that yields its boolean value, possibly FORM itself." + (while (let ((head (car-safe form))) + (cond ((memq head '( progn inline save-excursion save-restriction + save-current-buffer)) + (setq form (car (last (cdr form)))) + t) + ((memq head '(let let*)) + (setq form (car (last (cddr form)))) + t) + ((memq head '( prog1 unwind-protect copy-sequence identity + reverse nreverse sort)) + (setq form (nth 1 form)) + t) + ((memq head '(mapc setq setcar setcdr puthash)) + (setq form (nth 2 form)) + t) + ((memq head '(aset put function-put)) + (setq form (nth 3 form)) + t)))) + form) + +(defun byte-compile-trueconstp (form) "Return non-nil if FORM always evaluates to a non-nil value." - (while (eq (car-safe form) 'progn) - (setq form (car (last (cdr form))))) + (setq form (byte-opt--bool-value-form form)) (cond ((consp form) - (pcase (car form) - ('quote (cadr form)) - ;; Can't use recursion in a defsubst. - ;; (`progn (byte-compile-trueconstp (car (last (cdr form))))) - )) + (let ((head (car form))) + ;; FIXME: Lots of other expressions are statically non-nil. + (cond ((memq head '(quote function)) (cadr form)) + ((eq head 'list) (cdr form)) + ((memq head + ;; FIXME: Replace this list with a function property? + '( length safe-length cons lambda + string unibyte-string make-string concat + format format-message + substring substring-no-properties string-replace + replace-regexp-in-string symbol-name make-symbol + compare-strings string-distance + mapconcat + vector make-vector vconcat make-record record + regexp-quote regexp-opt + buffer-string buffer-substring + buffer-substring-no-properties + current-buffer buffer-size get-buffer-create + point point-min point-max buffer-end count-lines + following-char preceding-char get-byte max-char + region-beginning region-end + line-beginning-position line-end-position + pos-bol pos-eol + + - * / % 1+ 1- min max abs mod expt logb + logand logior logxor lognot ash logcount + floor ceiling round truncate + sqrt sin cos tan asin acos atan exp log copysign + ffloor fceiling fround ftruncate float + ldexp frexp + number-to-string string-to-number + int-to-string char-to-string + prin1-to-string read-from-string + byte-to-string string-to-vector string-to-char + capitalize upcase downcase + propertize + string-as-multibyte string-as-unibyte + string-to-multibyte string-to-unibyte + string-make-multibyte string-make-unibyte + string-width char-width + make-hash-table hash-table-count + unibyte-char-to-multibyte multibyte-char-to-unibyte + sxhash sxhash-equal sxhash-eq sxhash-eql + sxhash-equal-including-properties + make-marker copy-marker point-marker mark-marker + kbd key-description + always)) + t) + ((eq head 'if) + (and (byte-compile-trueconstp (nth 2 form)) + (byte-compile-trueconstp (car (last (cdddr form)))))) + ((memq head '(not null)) + (byte-compile-nilconstp (cadr form))) + ((eq head 'or) + (and (cdr form) + (byte-compile-trueconstp (car (last (cdr form))))))))) ((not (symbolp form))) ((eq form t)) ((keywordp form)))) -(defsubst byte-compile-nilconstp (form) +(defun byte-compile-nilconstp (form) "Return non-nil if FORM always evaluates to a nil value." - (while (eq (car-safe form) 'progn) - (setq form (car (last (cdr form))))) - (cond ((consp form) - (pcase (car form) - ('quote (null (cadr form))) - ;; Can't use recursion in a defsubst. - ;; (`progn (byte-compile-nilconstp (car (last (cdr form))))) - )) - ((not (symbolp form)) nil) - ((null form)))) + (setq form (byte-opt--bool-value-form form)) + (or (not form) ; assume (quote nil) always being normalised to nil + (and (consp form) + (let ((head (car form))) + ;; FIXME: There are many other expressions that are statically nil. + (cond ((memq head '(while ignore)) t) + ((eq head 'if) + (and (byte-compile-nilconstp (nth 2 form)) + (byte-compile-nilconstp (car (last (cdddr form)))))) + ((memq head '(not null)) + (byte-compile-trueconstp (cadr form))) + ((eq head 'and) + (and (cdr form) + (byte-compile-nilconstp (car (last (cdr form))))))))))) ;; If the function is being called with constant integer args, ;; evaluate as much as possible at compile-time. This optimizer @@ -921,7 +994,7 @@ for speeding up processing.") (defun byte-optimize--fixnump (o) "Return whether O is guaranteed to be a fixnum in all Emacsen. See Info node `(elisp) Integer Basics'." - (and (fixnump o) (<= -536870912 o 536870911))) + (and (integerp o) (<= -536870912 o 536870911))) (defun byte-optimize-equal (form) ;; Replace `equal' or `eql' with `eq' if at least one arg is a @@ -1077,35 +1150,91 @@ See Info node `(elisp) Integer Basics'." (nth 1 form))) (defun byte-optimize-and (form) - ;; Simplify if less than 2 args. - ;; if there is a literal nil in the args to `and', throw it and following - ;; forms away, and surround the `and' with (progn ... nil). - (cond ((null (cdr form))) - ((memq nil form) - (list 'progn - (byte-optimize-and - (prog1 (setq form (copy-sequence form)) - (while (nth 1 form) - (setq form (cdr form))) - (setcdr form nil))) - nil)) - ((null (cdr (cdr form))) - (nth 1 form)) - ((byte-optimize-constant-args form)))) + (let ((seq nil) + (new-args nil) + (nil-result nil) + (args (cdr form))) + (while + (and args + (let ((arg (car args))) + (cond + (seq ; previous arg was always-true + (push arg seq) + (unless (and (cdr args) (byte-compile-trueconstp arg)) + (push `(progn . ,(nreverse seq)) new-args) + (setq seq nil)) + t) + ((and (cdr args) (byte-compile-trueconstp arg)) + ;; Always-true arg: evaluate unconditionally. + (push arg seq) + t) + ((and arg (not (byte-compile-nilconstp arg))) + (push arg new-args) + t) + (t + ;; Throw away the remaining args; this one is always false. + (setq nil-result t) + (when arg + (push arg new-args)) ; keep possible side-effects + nil)))) + (setq args (cdr args))) + + (setq new-args (nreverse new-args)) + (if (equal new-args (cdr form)) + ;; Input is unchanged: keep original form, and don't represent + ;; a nil result explicitly because that would lead to infinite + ;; growth when the optimiser is iterated. + (setq nil-result nil) + (setq form (cons (car form) new-args))) + + (let ((new-form + (pcase form + ;; (and (progn ... X) ...) -> (progn ... (and X ...)) + (`(,head (progn . ,forms) . ,rest) + `(progn ,@(butlast forms) (,head ,(car (last forms)) . ,rest))) + (`(,_) t) ; (and) -> t + (`(,_ ,arg) arg) ; (and X) -> X + (_ (byte-optimize-constant-args form))))) + (if nil-result + `(progn ,new-form nil) + new-form)))) (defun byte-optimize-or (form) - ;; Throw away nil's, and simplify if less than 2 args. - ;; If there is a literal non-nil constant in the args to `or', throw away all - ;; following forms. - (setq form (remq nil form)) - (let ((rest form)) - (while (cdr (setq rest (cdr rest))) - (if (byte-compile-trueconstp (car rest)) - (setq form (copy-sequence form) - rest (setcdr (memq (car rest) form) nil)))) - (if (cdr (cdr form)) - (byte-optimize-constant-args form) - (nth 1 form)))) + (let ((seq nil) + (new-args nil) + (args (remq nil (cdr form)))) ; Discard nil arguments. + (while + (and args + (let ((arg (car args))) + (cond + (seq ; previous arg was always-false + (push arg seq) + (unless (and (cdr args) (byte-compile-nilconstp arg)) + (push `(progn . ,(nreverse seq)) new-args) + (setq seq nil)) + t) + ((and (cdr args) (byte-compile-nilconstp arg)) + ;; Always-false arg: evaluate unconditionally. + (push arg seq) + t) + (t + (push arg new-args) + ;; If this arg is always true, throw away the remaining args. + (not (byte-compile-trueconstp arg)))))) + (setq args (cdr args))) + + (setq new-args (nreverse new-args)) + ;; Keep original form unless the arguments changed. + (unless (equal new-args (cdr form)) + (setq form (cons (car form) new-args))) + + (pcase form + ;; (or (progn ... X) ...) -> (progn ... (or X ...)) + (`(,head (progn . ,forms) . ,rest) + `(progn ,@(butlast forms) (,head ,(car (last forms)) . ,rest))) + (`(,_) nil) ; (or) -> nil + (`(,_ ,arg) arg) ; (or X) -> X + (_ (byte-optimize-constant-args form))))) (defun byte-optimize-cond (form) ;; if any clauses have a literal nil as their test, throw them away. @@ -1142,55 +1271,79 @@ See Info node `(elisp) Integer Basics'." (and clauses form))) form)) +(defsubst byte-opt--negate (form) + "Negate FORM, avoiding double negation if already negated." + (if (and (consp form) (memq (car form) '(not null))) + (cadr form) + `(not ,form))) + (defun byte-optimize-if (form) - ;; (if (progn <insts> <test>) <rest>) ==> (progn <insts> (if <test> <rest>)) - ;; (if <true-constant> <then> <else...>) ==> <then> - ;; (if <false-constant> <then> <else...>) ==> (progn <else...>) - ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>)) - ;; (if <test> <then> nil) ==> (if <test> <then>) - (let ((clause (nth 1 form))) - (cond ((and (eq (car-safe clause) 'progn) - (proper-list-p clause)) - (if (null (cddr clause)) - ;; A trivial `progn'. - (byte-optimize-if `(,(car form) ,(cadr clause) ,@(nthcdr 2 form))) - (nconc (butlast clause) - (list - (byte-optimize-if - `(,(car form) ,(car (last clause)) ,@(nthcdr 2 form))))))) - ((byte-compile-trueconstp clause) - `(progn ,clause ,(nth 2 form))) - ((byte-compile-nilconstp clause) - `(progn ,clause ,@(nthcdr 3 form))) - ((nth 2 form) - (if (equal '(nil) (nthcdr 3 form)) - (list (car form) clause (nth 2 form)) - form)) - ((or (nth 3 form) (nthcdr 4 form)) - (list (car form) - ;; Don't make a double negative; - ;; instead, take away the one that is there. - (if (and (consp clause) (memq (car clause) '(not null)) - (= (length clause) 2)) ; (not xxxx) or (not (xxxx)) - (nth 1 clause) - (list 'not clause)) - (if (nthcdr 4 form) - (cons 'progn (nthcdr 3 form)) - (nth 3 form)))) - (t - (list 'progn clause nil))))) + (let ((condition (nth 1 form)) + (then (nth 2 form)) + (else (nthcdr 3 form))) + (cond + ;; (if (progn ... X) ...) -> (progn ... (if X ...)) + ((eq (car-safe condition) 'progn) + (nconc (butlast condition) + (list + (byte-optimize-if + `(,(car form) ,(car (last condition)) ,@(nthcdr 2 form)))))) + ;; (if TRUE THEN ...) -> (progn TRUE THEN) + ((byte-compile-trueconstp condition) + `(progn ,condition ,then)) + ;; (if FALSE THEN ELSE...) -> (progn FALSE ELSE...) + ((byte-compile-nilconstp condition) + (if else + `(progn ,condition ,@else) + condition)) + ;; (if X nil t) -> (not X) + ((and (eq then nil) (eq else '(t))) + `(not ,condition)) + ;; (if X t [nil]) -> (not (not X)) + ((and (eq then t) (or (null else) (eq else '(nil)))) + `(not ,(byte-opt--negate condition))) + ;; (if VAR VAR X...) -> (or VAR (progn X...)) + ((and (symbolp condition) (eq condition then)) + `(or ,then ,(if (cdr else) + `(progn . ,else) + (car else)))) + ;; (if X THEN nil) -> (if X THEN) + (then + (if (equal else '(nil)) + (list (car form) condition then) + form)) + ;; (if X nil ELSE...) -> (if (not X) (progn ELSE...)) + ((or (car else) (cdr else)) + (list (car form) (byte-opt--negate condition) + (if (cdr else) + `(progn . ,else) + (car else)))) + ;; (if X nil nil) -> (progn X nil) + (t + (list 'progn condition nil))))) (defun byte-optimize-while (form) - (when (< (length form) 2) - (byte-compile-warn-x form "too few arguments for `while'")) - (if (nth 1 form) - form)) + (let ((condition (nth 1 form))) + (if (byte-compile-nilconstp condition) + condition + form))) + +(defun byte-optimize-not (form) + (and (= (length form) 2) + (let ((arg (nth 1 form))) + (cond ((null arg) t) + ((macroexp-const-p arg) nil) + ((byte-compile-nilconstp arg) `(progn ,arg t)) + ((byte-compile-trueconstp arg) `(progn ,arg nil)) + (t form))))) (put 'and 'byte-optimizer #'byte-optimize-and) (put 'or 'byte-optimizer #'byte-optimize-or) (put 'cond 'byte-optimizer #'byte-optimize-cond) (put 'if 'byte-optimizer #'byte-optimize-if) (put 'while 'byte-optimizer #'byte-optimize-while) +(put 'not 'byte-optimizer #'byte-optimize-not) +(put 'null 'byte-optimizer #'byte-optimize-not) ;; byte-compile-negation-optimizer lives in bytecomp.el (put '/= 'byte-optimizer #'byte-compile-negation-optimizer) @@ -1207,25 +1360,26 @@ See Info node `(elisp) Integer Basics'." form))) (defun byte-optimize-apply (form) - ;; If the last arg is a literal constant, turn this into a funcall. - ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...). - (if (= (length form) 2) - ;; single-argument `apply' is not worth optimizing (bug#40968) - form - (let ((fn (nth 1 form)) - (last (nth (1- (length form)) form))) ; I think this really is fastest - (or (if (or (null last) - (eq (car-safe last) 'quote)) - (if (listp (nth 1 last)) - (let ((butlast (nreverse (cdr (reverse (cdr (cdr form))))))) - (nconc (list 'funcall fn) butlast - (mapcar (lambda (x) (list 'quote x)) (nth 1 last)))) + (let ((len (length form))) + (if (>= len 2) + (let ((fn (nth 1 form)) + (last (nth (1- len) form))) + (cond + ;; (apply F ... '(X Y ...)) -> (funcall F ... 'X 'Y ...) + ((or (null last) + (eq (car-safe last) 'quote)) + (let ((last-value (nth 1 last))) + (if (listp last-value) + `(funcall ,fn ,@(butlast (cddr form)) + ,@(mapcar (lambda (x) (list 'quote x)) last-value)) (byte-compile-warn-x - last - "last arg to apply can't be a literal atom: `%s'" - last) - nil)) - form)))) + last "last arg to apply can't be a literal atom: `%s'" last) + nil))) + ;; (apply F ... (list X Y ...)) -> (funcall F ... X Y ...) + ((eq (car-safe last) 'list) + `(funcall ,fn ,@(butlast (cddr form)) ,@(cdr last))) + (t form))) + form))) (put 'funcall 'byte-optimizer #'byte-optimize-funcall) (put 'apply 'byte-optimizer #'byte-optimize-apply) @@ -1281,15 +1435,99 @@ See Info node `(elisp) Integer Basics'." (put 'cons 'byte-optimizer #'byte-optimize-cons) (defun byte-optimize-cons (form) - ;; (cons X nil) => (list X) - (if (and (= (safe-length form) 3) - (null (nth 2 form))) - `(list ,(nth 1 form)) - form)) + (let ((tail (nth 2 form))) + (cond + ;; (cons X nil) => (list X) + ((null tail) `(list ,(nth 1 form))) + ;; (cons X (list YS...)) -> (list X YS...) + ((and (consp tail) (eq (car tail) 'list)) + `(,(car tail) ,(nth 1 form) . ,(cdr tail))) + (t form)))) + +(put 'list 'byte-optimizer #'byte-optimize-list) +(defun byte-optimize-list (form) + ;; (list) -> nil + (and (cdr form) form)) + +(put 'append 'byte-optimizer #'byte-optimize-append) +(defun byte-optimize-append (form) + ;; There is (probably) too much code relying on `append' to return a + ;; new list for us to do full constant-folding; these transformations + ;; preserve the allocation semantics. + (and (cdr form) ; (append) -> nil + (named-let loop ((args (cdr form)) (newargs nil)) + (let ((arg (car args)) + (prev (car newargs))) + (cond + ;; Flatten nested `append' forms. + ((and (consp arg) (eq (car arg) 'append)) + (loop (append (cdr arg) (cdr args)) newargs)) + + ;; Merge consecutive `list' forms. + ((and (consp arg) (eq (car arg) 'list) + newargs (consp prev) (eq (car prev) 'list)) + (loop (cons (cons (car prev) (append (cdr prev) (cdr arg))) + (cdr args)) + (cdr newargs))) + + ;; non-terminal arg + ((cdr args) + (cond + ((macroexp-const-p arg) + ;; constant arg + (let ((val (eval arg))) + (cond + ;; Elide empty arguments (nil, empty string, etc). + ((zerop (length val)) + (loop (cdr args) newargs)) + ;; Merge consecutive constants. + ((and newargs (macroexp-const-p prev)) + (loop (cdr args) + (cons + (list 'quote + (append (eval prev) val nil)) + (cdr newargs)))) + (t (loop (cdr args) (cons arg newargs)))))) + + ;; (list CONSTANTS...) -> '(CONSTANTS...) + ((and (consp arg) (eq (car arg) 'list) + (not (memq nil (mapcar #'macroexp-const-p (cdr arg))))) + (loop (cons (list 'quote (eval arg)) (cdr args)) newargs)) + + (t (loop (cdr args) (cons arg newargs))))) + + ;; At this point, `arg' is the last (tail) argument. + + ;; (append X) -> X + ((null newargs) arg) + + ;; (append (list Xs...) nil) -> (list Xs...) + ((and (null arg) + newargs (null (cdr newargs)) + (consp prev) (eq (car prev) 'list)) + prev) + + ;; (append '(X) Y) -> (cons 'X Y) + ;; (append (list X) Y) -> (cons X Y) + ((and newargs (null (cdr newargs)) + (consp prev) + (cond ((eq (car prev) 'quote) + (and (consp (cadr prev)) + (= (length (cadr prev)) 1))) + ((eq (car prev) 'list) + (= (length (cdr prev)) 1)))) + (list 'cons (if (eq (car prev) 'quote) + (macroexp-quote (caadr prev)) + (cadr prev)) + arg)) + + (t + (let ((new-form (cons 'append (nreverse (cons arg newargs))))) + (if (equal new-form form) + form + new-form)))))))) ;; Fixme: delete-char -> delete-region (byte-coded) -;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte, -;; string-make-multibyte for constant args. (put 'set 'byte-optimizer #'byte-optimize-set) (defun byte-optimize-set (form) @@ -1354,28 +1592,27 @@ See Info node `(elisp) Integer Basics'." keymap-parent lax-plist-get ldexp length length< length> length= - line-beginning-position line-end-position + line-beginning-position line-end-position pos-bol pos-eol local-variable-if-set-p local-variable-p locale-info log log10 logand logb logcount logior lognot logxor lsh make-byte-code make-list make-string make-symbol mark marker-buffer max match-beginning match-end member memq memql min minibuffer-selected-window minibuffer-window mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string - parse-colon-path plist-get plist-member + parse-colon-path prefix-numeric-value previous-window prin1-to-string propertize degrees-to-radians radians-to-degrees rassq rassoc read-from-string regexp-opt regexp-quote region-beginning region-end reverse round sin sqrt string string< string= string-equal string-lessp - string> string-greaterp string-empty-p - string-prefix-p string-suffix-p string-blank-p + string> string-greaterp string-empty-p string-blank-p string-search string-to-char string-to-number string-to-syntax substring sxhash sxhash-equal sxhash-eq sxhash-eql symbol-function symbol-name symbol-plist symbol-value string-make-unibyte string-make-multibyte string-as-multibyte string-as-unibyte string-to-multibyte - tan time-convert truncate + take tan time-convert truncate unibyte-char-to-multibyte upcase user-full-name user-login-name user-original-login-name custom-variable-p vconcat @@ -1388,7 +1625,7 @@ See Info node `(elisp) Integer Basics'." window-next-buffers window-next-sibling window-new-normal window-new-total window-normal-size window-parameter window-parameters window-parent window-pixel-edges window-point window-prev-buffers - window-prev-sibling window-redisplay-end-trigger window-scroll-bars + window-prev-sibling window-scroll-bars window-start window-text-height window-top-child window-top-line window-total-height window-total-width window-use-time window-vscroll window-width zerop)) @@ -1416,7 +1653,7 @@ See Info node `(elisp) Integer Basics'." natnump nlistp not null number-or-marker-p numberp one-window-p overlayp point point-marker point-min point-max preceding-char primary-charset - processp + processp proper-list-p recent-keys recursion-depth safe-length selected-frame selected-window sequencep standard-case-table standard-syntax-table stringp subrp symbolp @@ -1461,7 +1698,7 @@ See Info node `(elisp) Integer Basics'." floor ceiling round truncate ffloor fceiling fround ftruncate string= string-equal string< string-lessp string> string-greaterp - string-empty-p string-blank-p string-prefix-p string-suffix-p + string-empty-p string-blank-p string-search consp atom listp nlistp proper-list-p sequencep arrayp vectorp stringp bool-vector-p hash-table-p @@ -1476,14 +1713,14 @@ See Info node `(elisp) Integer Basics'." ;; arguments. This is pure enough for the purposes of ;; constant folding, but not necessarily for all kinds of ;; code motion. - car cdr car-safe cdr-safe nth nthcdr last + car cdr car-safe cdr-safe nth nthcdr last take equal length safe-length memq memql member ;; `assoc' and `assoc-default' are excluded since they are ;; impure if the test function is (consider `string-match'). assq rassq rassoc - plist-get lax-plist-get plist-member + lax-plist-get aref elt base64-decode-string base64-encode-string base64url-encode-string bool-vector-subsetp @@ -1664,10 +1901,10 @@ See Info node `(elisp) Integer Basics'." byte-goto-if-not-nil-else-pop)) (defconst byte-after-unbind-ops - '(byte-constant byte-dup + '(byte-constant byte-dup byte-stack-ref byte-stack-set byte-discard byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp byte-eq byte-not - byte-cons byte-list1 byte-list2 ; byte-list3 byte-list4 + byte-cons byte-list1 byte-list2 byte-list3 byte-list4 byte-listN byte-interactive-p) ;; How about other side-effect-free-ops? Is it safe to move an ;; error invocation (such as from nth) out of an unwind-protect? @@ -1679,7 +1916,8 @@ See Info node `(elisp) Integer Basics'." (defconst byte-compile-side-effect-and-error-free-ops '(byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe - byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max + byte-cdr-safe byte-cons byte-list1 byte-list2 byte-list3 byte-list4 + byte-listN byte-point byte-point-max byte-point-min byte-following-char byte-preceding-char byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp byte-current-buffer byte-stack-ref)) @@ -2030,13 +2268,15 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (setcar (cdr rest) lap0) (setq keep-going t)) ;; - ;; varbind-X unbind-N --> discard unbind-(N-1) - ;; save-excursion unbind-N --> unbind-(N-1) - ;; save-restriction unbind-N --> unbind-(N-1) + ;; varbind-X unbind-N --> discard unbind-(N-1) + ;; save-excursion unbind-N --> unbind-(N-1) + ;; save-restriction unbind-N --> unbind-(N-1) + ;; save-current-buffer unbind-N --> unbind-(N-1) ;; ((and (eq 'byte-unbind (car lap1)) (memq (car lap0) '(byte-varbind byte-save-excursion - byte-save-restriction)) + byte-save-restriction + byte-save-current-buffer)) (< 0 (cdr lap1))) (if (zerop (setcdr lap1 (1- (cdr lap1)))) (delq lap1 rest)) @@ -2060,9 +2300,9 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ((and (memq (car lap0) byte-goto-ops) (memq (car (setq tmp (nth 1 (memq (cdr lap0) lap)))) '(byte-goto byte-return))) - (cond ((and (not (eq tmp lap0)) - (or (eq (car lap0) 'byte-goto) - (eq (car tmp) 'byte-goto))) + (cond ((and (or (eq (car lap0) 'byte-goto) + (eq (car tmp) 'byte-goto)) + (not (eq (cdr tmp) (cdr lap0)))) (byte-compile-log-lap " %s [%s]\t-->\t%s" (car lap0) tmp tmp) (if (eq (car tmp) 'byte-return) @@ -2392,8 +2632,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; itself, compile some of its most used recursive functions (at load time). ;; (eval-when-compile - (or (byte-code-function-p (symbol-function 'byte-optimize-form)) - (subr-native-elisp-p (symbol-function 'byte-optimize-form)) + (or (compiled-function-p (symbol-function 'byte-optimize-form)) (assq 'byte-code (symbol-function 'byte-optimize-form)) (let ((byte-optimize nil) (byte-compile-warnings nil)) |