;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler -*- lexical-binding: t -*-
-;; Copyright (C) 1991, 1994, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994, 2000-2015 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
(defun byte-compile-inline-expand (form)
(let* ((name (car form))
(localfn (cdr (assq name byte-compile-function-environment)))
- (fn (or localfn (and (fboundp name) (symbol-function name)))))
+ (fn (or localfn (symbol-function name))))
(when (autoloadp fn)
(autoload-do-load fn)
- (setq fn (or (and (fboundp name) (symbol-function name))
+ (setq fn (or (symbol-function name)
(cdr (assq name byte-compile-function-environment)))))
(pcase fn
(`nil
(prin1-to-string form))
nil)
- ((memq fn '(function condition-case))
- ;; These forms are compiled as constants or by breaking out
+ ((eq fn 'function)
+ ;; This forms is compiled as constant or by breaking out
;; all the subexpressions and compiling them separately.
form)
+ ((eq fn 'condition-case)
+ (if byte-compile--use-old-handlers
+ ;; Will be optimized later.
+ form
+ `(condition-case ,(nth 1 form) ;Not evaluated.
+ ,(byte-optimize-form (nth 2 form) for-effect)
+ ,@(mapcar (lambda (clause)
+ `(,(car clause)
+ ,@(byte-optimize-body (cdr clause) for-effect)))
+ (nthcdr 3 form)))))
+
((eq fn 'unwind-protect)
;; the "protected" part of an unwind-protect is compiled (and thus
;; optimized) as a top-level form, so don't do it here. But the
(cdr (cdr form)))))
((eq fn 'catch)
- ;; the body of a catch is compiled (and thus optimized) as a
- ;; top-level form, so don't do it here. The tag is never
- ;; for-effect. The body should have the same for-effect status
- ;; as the catch form itself, but that isn't handled properly yet.
(cons fn
(cons (byte-optimize-form (nth 1 form) nil)
- (cdr (cdr form)))))
+ (if byte-compile--use-old-handlers
+ ;; The body of a catch is compiled (and thus
+ ;; optimized) as a top-level form, so don't do it
+ ;; here.
+ (cdr (cdr form))
+ (byte-optimize-body (cdr form) for-effect)))))
((eq fn 'ignore)
;; Don't treat the args to `ignore' as being
((and for-effect (setq tmp (get fn 'side-effect-free))
(or byte-compile-delete-errors
(eq tmp 'error-free)
- ;; Detect the expansion of (pop foo).
- ;; There is no need to compile the call to `car' there.
- (and (eq fn 'car)
- (eq (car-safe (cadr form)) 'prog1)
- (let ((var (cadr (cadr form)))
- (last (nth 2 (cadr form))))
- (and (symbolp var)
- (null (nthcdr 3 (cadr form)))
- (eq (car-safe last) 'setq)
- (eq (cadr last) var)
- (eq (car-safe (nth 2 last)) 'cdr)
- (eq (cadr (nth 2 last)) var))))
(progn
(byte-compile-warn "value returned from %s is unused"
(prin1-to-string form))
(defun byte-optimize-binary-predicate (form)
- (if (macroexp-const-p (nth 1 form))
- (if (macroexp-const-p (nth 2 form))
- (condition-case ()
- (list 'quote (eval form))
- (error form))
- ;; This can enable some lapcode optimizations.
- (list (car form) (nth 2 form) (nth 1 form)))
- form))
+ (cond
+ ((or (not (macroexp-const-p (nth 1 form)))
+ (nthcdr 3 form)) ;; In case there are more than 2 args.
+ form)
+ ((macroexp-const-p (nth 2 form))
+ (condition-case ()
+ (list 'quote (eval form))
+ (error form)))
+ (t ;; This can enable some lapcode optimizations.
+ (list (car form) (nth 2 form) (nth 1 form)))))
(defun byte-optimize-predicate (form)
(let ((ok t)
form
(nth 1 form)))
-(defun byte-optimize-zerop (form)
- (cond ((numberp (nth 1 form))
- (eval form))
- (byte-compile-delete-errors
- (list '= (nth 1 form) 0))
- (form)))
-
-(put 'zerop 'byte-optimizer 'byte-optimize-zerop)
-
(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
"Don't call this!"
;; Fetch and return the offset for the current opcode.
;; Return nil if this opcode has no offset.
- (cond ((< bytedecomp-op byte-nth)
+ (cond ((< bytedecomp-op byte-pophandler)
(let ((tem (logand bytedecomp-op 7)))
(setq bytedecomp-op (logand bytedecomp-op 248))
(cond ((eq tem 6)
(setq bytedecomp-op byte-constant)))
((or (and (>= bytedecomp-op byte-constant2)
(<= bytedecomp-op byte-goto-if-not-nil-else-pop))
- (= bytedecomp-op byte-stack-set2))
+ (memq bytedecomp-op (eval-when-compile
+ (list byte-stack-set2 byte-pushcatch
+ byte-pushconditioncase))))
;; Offset in next 2 bytes.
(setq bytedecomp-ptr (1+ bytedecomp-ptr))
(+ (aref bytes bytedecomp-ptr)