X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/938d65136b6d8c4ea91313216c873d2084be4240..dd92b5f5047931f6020045ce47360b62d1c2cb72:/lisp/emacs-lisp/byte-opt.el diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index ee0a5a11c7..dbaf2bc6f6 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1,6 +1,6 @@ ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler -*- lexical-binding: t -*- -;; Copyright (C) 1991, 1994, 2000-2014 Free Software Foundation, Inc. +;; Copyright (C) 1991, 1994, 2000-2016 Free Software Foundation, Inc. ;; Author: Jamie Zawinski ;; Hallvard Furuseth @@ -192,7 +192,7 @@ ;; (if (aref byte-code-vector 0) ;; (error "The old version of the disassembler is loaded. Reload new-bytecomp as well")) (byte-compile-log-1 - (apply 'format format + (apply #'format-message format (let (c a) (mapcar (lambda (arg) (if (not (consp arg)) @@ -292,7 +292,7 @@ (format "Inlining closure %S failed" name)) form)))) - (t ;; Give up on inlining. + (_ ;; Give up on inlining. form)))) ;; ((lambda ...) ...) @@ -302,65 +302,65 @@ ;; doesn't matter here, because function's behavior is underspecified so it ;; can safely be turned into a `let', even though the reverse is not true. (or name (setq name "anonymous lambda")) - (let ((lambda (car form)) - (values (cdr form))) - (let ((arglist (nth 1 lambda)) - (body (cdr (cdr lambda))) - optionalp restp - bindings) - (if (and (stringp (car body)) (cdr body)) - (setq body (cdr body))) - (if (and (consp (car body)) (eq 'interactive (car (car body)))) - (setq body (cdr body))) - ;; FIXME: The checks below do not belong in an optimization phase. - (while arglist - (cond ((eq (car arglist) '&optional) - ;; ok, I'll let this slide because funcall_lambda() does... - ;; (if optionalp (error "multiple &optional keywords in %s" name)) - (if restp (error "&optional found after &rest in %s" name)) - (if (null (cdr arglist)) - (error "nothing after &optional in %s" name)) - (setq optionalp t)) - ((eq (car arglist) '&rest) - ;; ...but it is by no stretch of the imagination a reasonable - ;; thing that funcall_lambda() allows (&rest x y) and - ;; (&rest x &optional y) in arglists. - (if (null (cdr arglist)) - (error "nothing after &rest in %s" name)) - (if (cdr (cdr arglist)) - (error "multiple vars after &rest in %s" name)) - (setq restp t)) - (restp - (setq bindings (cons (list (car arglist) - (and values (cons 'list values))) - bindings) - values nil)) - ((and (not optionalp) (null values)) - (byte-compile-warn "attempt to open-code `%s' with too few arguments" name) - (setq arglist nil values 'too-few)) - (t - (setq bindings (cons (list (car arglist) (car values)) - bindings) - values (cdr values)))) - (setq arglist (cdr arglist))) - (if values - (progn - (or (eq values 'too-few) - (byte-compile-warn - "attempt to open-code `%s' with too many arguments" name)) - form) - - ;; The following leads to infinite recursion when loading a - ;; file containing `(defsubst f () (f))', and then trying to - ;; byte-compile that file. - ;(setq body (mapcar 'byte-optimize-form body))) - - (let ((newform - (if bindings - (cons 'let (cons (nreverse bindings) body)) - (cons 'progn body)))) - (byte-compile-log " %s\t==>\t%s" form newform) - newform))))) + (let* ((lambda (car form)) + (values (cdr form)) + (arglist (nth 1 lambda)) + (body (cdr (cdr lambda))) + optionalp restp + bindings) + (if (and (stringp (car body)) (cdr body)) + (setq body (cdr body))) + (if (and (consp (car body)) (eq 'interactive (car (car body)))) + (setq body (cdr body))) + ;; FIXME: The checks below do not belong in an optimization phase. + (while arglist + (cond ((eq (car arglist) '&optional) + ;; ok, I'll let this slide because funcall_lambda() does... + ;; (if optionalp (error "multiple &optional keywords in %s" name)) + (if restp (error "&optional found after &rest in %s" name)) + (if (null (cdr arglist)) + (error "nothing after &optional in %s" name)) + (setq optionalp t)) + ((eq (car arglist) '&rest) + ;; ...but it is by no stretch of the imagination a reasonable + ;; thing that funcall_lambda() allows (&rest x y) and + ;; (&rest x &optional y) in arglists. + (if (null (cdr arglist)) + (error "nothing after &rest in %s" name)) + (if (cdr (cdr arglist)) + (error "multiple vars after &rest in %s" name)) + (setq restp t)) + (restp + (setq bindings (cons (list (car arglist) + (and values (cons 'list values))) + bindings) + values nil)) + ((and (not optionalp) (null values)) + (byte-compile-warn "attempt to open-code `%s' with too few arguments" name) + (setq arglist nil values 'too-few)) + (t + (setq bindings (cons (list (car arglist) (car values)) + bindings) + values (cdr values)))) + (setq arglist (cdr arglist))) + (if values + (progn + (or (eq values 'too-few) + (byte-compile-warn + "attempt to open-code `%s' with too many arguments" name)) + form) + + ;; The following leads to infinite recursion when loading a + ;; file containing `(defsubst f () (f))', and then trying to + ;; byte-compile that file. + ;(setq body (mapcar 'byte-optimize-form body))) + + (let ((newform + (if bindings + (cons 'let (cons (nreverse bindings) body)) + (cons 'progn body)))) + (byte-compile-log " %s\t==>\t%s" form newform) + newform)))) ;;; implementing source-level optimizers @@ -390,12 +390,13 @@ (and (nth 1 form) (not for-effect) form)) - ((eq 'lambda (car-safe fn)) + ((eq (car-safe fn) 'lambda) (let ((newform (byte-compile-unfold-lambda form))) (if (eq newform form) ;; Some error occurred, avoid infinite recursion form (byte-optimize-form-code-walker newform for-effect)))) + ((eq (car-safe fn) 'closure) form) ((memq fn '(let let*)) ;; recursively enter the optimizer for the bindings and body ;; of a let or let*. This for depth-firstness: forms that @@ -565,7 +566,7 @@ (cons fn args))))))) (defun byte-optimize-all-constp (list) - "Non-nil if all elements of LIST satisfy `macroexp-const-p" + "Non-nil if all elements of LIST satisfy `macroexp-const-p'." (let ((constant t)) (while (and list constant) (unless (macroexp-const-p (car list)) @@ -1208,8 +1209,9 @@ radians-to-degrees rassq rassoc read-from-string regexp-quote region-beginning region-end reverse round sin sqrt string string< string= string-equal string-lessp string-to-char - string-to-int string-to-number substring sxhash symbol-function - symbol-name symbol-plist symbol-value string-make-unibyte + string-to-int string-to-number 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 truncate @@ -1224,7 +1226,7 @@ window-left-child window-left-column window-margins window-minibuffer-p 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-parent window-pixel-edges window-point window-prev-buffers window-prev-sibling window-redisplay-end-trigger 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