form)
;; else
(if (and (consp fn) (eq (car fn) 'autoload))
- (load (nth 1 fn)))
+ (progn
+ (load (nth 1 fn))
+ (setq fn (or (cdr (assq name byte-compile-function-environment))
+ (and (fboundp name) (symbol-function name))))))
(if (and (consp fn) (eq (car fn) 'autoload))
(error "file \"%s\" didn't define \"%s\"" (nth 1 fn) name))
(if (symbolp fn)
(byte-compile-inline-expand (cons fn (cdr form)))
(if (byte-code-function-p fn)
- (progn
+ (let (string)
(fetch-bytecode fn)
+ (setq string (aref fn 1))
+ (if (fboundp 'string-as-unibyte)
+ (setq string (string-as-unibyte string)))
(cons (list 'lambda (aref fn 0)
- (list 'byte-code (aref fn 1) (aref fn 2) (aref fn 3)))
+ (list 'byte-code string (aref fn 2) (aref fn 3)))
(cdr form)))
(if (not (eq (car fn) 'lambda)) (error "%s is not a lambda" name))
(cons fn (cdr form)))))))
(cons (byte-optimize-form (nth 2 form) for-effect)
(byte-optimize-body (cdr (cdr (cdr form))) t)))))
- ((memq fn '(save-excursion save-restriction))
+ ((memq fn '(save-excursion save-restriction save-current-buffer))
;; those subrs which have an implicit progn; it's not quite good
;; enough to treat these like normal function calls.
;; This can turn (save-excursion ...) into (save-excursion) which
(setq form (macroexpand form
byte-compile-macro-environment))))
(byte-optimize-form form for-effect))
+
+ ;; Support compiler macros as in cl.el.
+ ((and (fboundp 'compiler-macroexpand)
+ (symbolp (car-safe form))
+ (get (car-safe form) 'cl-compiler-macro)
+ (not (eq form
+ (setq form (compiler-macroexpand form)))))
+ (byte-optimize-form form for-effect))
((not (symbolp fn))
(or (eq 'mocklisp (car-safe fn)) ; ha!
;; form))
(defun byte-optimize-approx-equal (x y)
- (< (* (abs (- x y)) 100) (abs (+ x y))))
+ (<= (* (abs (- x y)) 100) (abs (+ x y))))
;; Collect all the constants from FORM, after the STARTth arg,
;; and apply FUN to them to make one argument at the end.
;;; (actually, it would be safe if we know the sole arg
;;; is not a marker).
;; ((null (cdr (cdr form))) (nth 1 form))
+ ((and (null (nthcdr 3 form))
+ (or (memq (nth 1 form) '(1 -1))
+ (memq (nth 2 form) '(1 -1))))
+ ;; Optimize (+ x 1) into (1+ x) and (+ x -1) into (1- x).
+ (let ((integer
+ (if (memq (nth 1 form) '(1 -1))
+ (nth 1 form)
+ (nth 2 form)))
+ (other
+ (if (memq (nth 1 form) '(1 -1))
+ (nth 2 form)
+ (nth 1 form))))
+ (list (if (eq integer 1) '1+ '1-)
+ other)))
(t form)))
(defun byte-optimize-minus (form)
;; (- x y ... 0) --> (- x y ...)
(setq form (copy-sequence form))
(setcdr (cdr (cdr form)) (delq 0 (nthcdr 3 form))))
+ ((equal (nthcdr 2 form) '(1))
+ (setq form (list '1- (nth 1 form))))
+ ((equal (nthcdr 2 form) '(-1))
+ (setq form (list '1+ (nth 1 form))))
;; If form is (- CONST foo... CONST), merge first and last.
((and (numberp (nth 1 form))
(numberp last))
(while (>= (setq count (1- count)) 0)
(setq form (list 'cdr form)))
form)))
+
+(put 'concat 'byte-optimizer 'byte-optimize-concat)
+(defun byte-optimize-concat (form)
+ (let ((args (cdr form))
+ (constant t))
+ (while (and args constant)
+ (or (byte-compile-constp (car args))
+ (setq constant nil))
+ (setq args (cdr args)))
+ (if constant
+ (eval form)
+ form)))
\f
;;; enumerating those functions which need not be called if the returned
;;; value is not used. That is, something like
tags)))))))
((cond ((eq op 'byte-constant2) (setq op 'byte-constant) t)
((memq op byte-constref-ops)))
- (setq tmp (aref constvec offset)
+ (setq tmp (if (>= offset (length constvec))
+ (list 'out-of-range offset)
+ (aref constvec offset))
offset (if (eq op 'byte-constant)
(byte-compile-get-constant tmp)
(or (assq tmp byte-compile-variables)
(defconst byte-after-unbind-ops
'(byte-constant byte-dup
byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp
- byte-eq byte-equal byte-not
+ byte-eq byte-not
byte-cons byte-list1 byte-list2 ; byte-list3 byte-list4
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?
+ ;; No, it is not, because the unwind-protect forms can alter
+ ;; the inside of the object to which nth would apply.
+ ;; For the same reason, byte-equal was deleted from this list.
"Byte-codes that can be moved past an unbind.")
(defconst byte-compile-side-effect-and-error-free-ops
byte-member byte-assq byte-quo byte-rem)
byte-compile-side-effect-and-error-free-ops))
-;;; This piece of shit is because of the way DEFVAR_BOOL() variables work.
+;;; This crock is because of the way DEFVAR_BOOL variables work.
;;; Consider the code
;;;
;;; (defun foo (flag)
;;; the BOOL variables are, and not perform this optimization on them.
;;;
(defconst byte-boolean-vars
- '(abbrev-all-caps abbrevs-changed byte-metering-on
- cannot-suspend completion-auto-help completion-ignore-case
- cursor-in-echo-area debug-on-next-call debug-on-quit
- delete-exited-processes enable-recursive-minibuffers
- highlight-nonselected-windows indent-tabs-mode inhibit-local-menu-bar-menus
- insert-default-directory inverse-video load-force-doc-strings
- load-in-progress menu-prompting minibuffer-auto-raise
- mode-line-inverse-video multiple-frames no-redraw-on-reenter noninteractive
- parse-sexp-ignore-comments pop-up-frames pop-up-windows
- print-escape-newlines system-uses-terminfo truncate-partial-width-windows
+ '(abbrev-all-caps abbrevs-changed byte-debug-flag byte-metering-on
+ cannot-suspend check-markers-debug-flag completion-auto-help
+ completion-ignore-case cursor-in-echo-area debug-on-next-call
+ debug-on-quit delete-exited-processes enable-recursive-minibuffers
+ garbage-collection-messages highlight-nonselected-windows
+ indent-tabs-mode inherit-process-coding-system inhibit-eol-conversion
+ inhibit-local-menu-bar-menus insert-default-directory inverse-video
+ keyword-symbols-constant-flag load-convert-to-unibyte
+ load-force-doc-strings load-in-progress menu-prompting
+ minibuffer-allow-text-properties minibuffer-auto-raise
+ mode-line-inverse-video multiple-frames no-redraw-on-reenter
+ noninteractive parse-sexp-ignore-comments parse-sexp-lookup-properties
+ pop-up-frames pop-up-windows print-escape-multibyte
+ print-escape-newlines
+ print-escape-nonascii print-quoted scroll-preserve-screen-position
+ system-uses-terminfo truncate-partial-width-windows use-dialog-box
visible-bell vms-stmlf-recfm words-include-escapes)
"DEFVAR_BOOL variables. Giving these any non-nil value sets them to t.
If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer
(setq lap0 (car rest)
lap1 (nth 1 rest))
(if (memq (car lap0) byte-constref-ops)
- (if (eq (cdr lap0) 'byte-constant)
+ (if (not (eq (car lap0) 'byte-constant))
(or (memq (cdr lap0) byte-compile-variables)
(setq byte-compile-variables (cons (cdr lap0)
byte-compile-variables)))