Function: byte-optimize-form-code-walker
byte-optimize-form-code-walker is a byte-compiled function defined in
byte-opt.el.gz.
Signature
(byte-optimize-form-code-walker FORM FOR-EFFECT)
Source Code
;; Defined in /usr/src/emacs/lisp/emacs-lisp/byte-opt.el.gz
(defun byte-optimize-form-code-walker (form for-effect)
;;
;; For normal function calls, We can just mapcar the optimizer the cdr. But
;; we need to have special knowledge of the syntax of the special forms
;; like let and defun (that's why they're special forms :-). (Actually,
;; the important aspect is that they are subrs that don't evaluate all of
;; their args.)
;;
;; FIXME: There are a bunch of `byte-compile-warn' here which arguably
;; have no place in an optimizer: the corresponding tests should be
;; performed in `macroexpand-all', or in `cconv', or in `bytecomp'.
(let ((fn (car-safe form)))
(byte-optimize--pcase form
((pred (not consp))
(cond
((and for-effect
(or byte-compile-delete-errors
(not (symbolp form))
(eq form t)
(keywordp form)))
nil)
((symbolp form)
(let ((lexvar (assq form byte-optimize--lexvars)))
(cond
((not lexvar) form)
(for-effect nil)
((and (cddr lexvar) ; substitution available
;; Perform substitution, except during the loop mutation
;; discovery phase if the variable was bound outside the
;; innermost loop.
(not (and byte-optimize--inhibit-outside-loop-constprop
(assq form byte-optimize--vars-outside-loop))))
(caddr lexvar))
(t form))))
(t form)))
(`(quote . ,v)
(if (or (not v) (cdr v))
(byte-compile-warn-x form "malformed quote form: `%s'"
form))
;; Map (quote nil) to nil to simplify optimizer logic.
;; Map quoted constants to nil if for-effect (just because).
(and (car v)
(not for-effect)
form))
(`(,(or 'let 'let*) . ,rest)
(cons fn (byte-optimize-let-form fn rest for-effect)))
(`(cond . ,clauses)
;; FIXME: The condition in the first clause is always executed, and
;; clause bodies are mutually exclusive -- use this for improved
;; optimization (see comment about `if' below).
(cons fn
(mapcar (lambda (clause)
(if (consp clause)
(cons
(byte-optimize-form (car clause) nil)
(byte-optimize-body (cdr clause) for-effect))
(byte-compile-warn-x
clause "malformed cond form: `%s'"
clause)
clause))
clauses)))
(`(progn . ,exps)
;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
(if (cdr exps)
(macroexp-progn (byte-optimize-body exps for-effect))
(byte-optimize-form (car exps) for-effect)))
(`(prog1 ,exp . ,exps)
(let ((exp-opt (byte-optimize-form exp for-effect)))
(if exps
(let ((exps-opt (byte-optimize-body exps t)))
(if (macroexp-const-p exp-opt)
`(progn ,@exps-opt ,exp-opt)
`(,fn ,exp-opt ,@exps-opt)))
exp-opt)))
(`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps)
;; 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
;; will be optimized away in the lap-optimize pass.
(cons fn (byte-optimize-body exps for-effect)))
(`(if ,test ,then . ,else)
;; FIXME: We are conservative here: any variable changed in the
;; THEN branch will be barred from substitution in the ELSE
;; branch, despite the branches being mutually exclusive.
(let* ((test-opt (byte-optimize-form test nil))
(const (macroexp-const-p test-opt))
;; Avoid traversing dead branches.
(then-opt (and test-opt (byte-optimize-form then for-effect)))
(else-opt (and (not (and test-opt const))
(byte-optimize-body else for-effect))))
`(,fn ,test-opt ,then-opt . ,else-opt)))
(`(,(or 'and 'or) . ,exps)
;; 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 optimization opportunities:
;; consider (and A B) in a for-effect context, where B => nil.
;; Then A could be optimized in a for-effect context too.
(let ((tail exps)
(args nil))
(while tail
(push (byte-optimize-form
(car tail) (and for-effect (null (cdr tail))))
args)
(setq tail (cdr tail)))
(cons fn (nreverse args))))
(`(while ,exp . ,exps)
;; 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 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 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)))))
;; 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))
(body (byte-optimize-body (cdr condition-body) t)))
`(,fn ,condition . ,body)))
(`(interactive . ,_)
(byte-compile-warn-x form "misplaced interactive spec: `%s'" form)
nil)
(`(function . ,_)
;; This forms is compiled as constant or by breaking out
;; all the subexpressions and compiling them separately.
(and (not for-effect) form))
(`(condition-case ,var ,exp . ,clauses)
`(,fn ,var ;Not evaluated.
,(byte-optimize-form exp
(if (assq :success clauses)
(null var)
for-effect))
,@(mapcar (lambda (clause)
(let ((byte-optimize--lexvars
(and lexical-binding
(if var
(cons (list var t)
byte-optimize--lexvars)
byte-optimize--lexvars))))
(cons (car clause)
(byte-optimize-body (cdr clause) for-effect))))
clauses)))
(`(unwind-protect ,protected-expr :fun-body ,unwind-fun)
;; FIXME: The return value of UNWIND-FUN is never used so we
;; could potentially optimize it for-effect, but we don't do
;; that right no.
`(,fn ,(byte-optimize-form protected-expr for-effect)
:fun-body ,(byte-optimize-form unwind-fun)))
(`(catch ,tag . ,exps)
`(,fn ,(byte-optimize-form tag nil)
. ,(byte-optimize-body exps for-effect)))
;; Needed as long as we run byte-optimize-form after cconv.
(`(internal-make-closure ,vars ,env . ,rest)
(if for-effect
`(progn ,@(byte-optimize-body env t))
`(,fn ,vars ,(mapcar #'byte-optimize-form env) . ,rest)))
(`(setq ,var ,expr)
(let ((lexvar (assq var byte-optimize--lexvars))
(value (byte-optimize-form expr nil)))
(when lexvar
(setcar (cdr lexvar) t) ; Mark variable to be kept.
(setcdr (cdr lexvar) nil) ; Inhibit further substitution.
;; Cancel substitution of variables aliasing this one.
(let ((aliased-vars byte-optimize--aliased-vars))
(while
(let ((alias (assq var aliased-vars)))
(and alias
(progn
;; Found a variable bound to VAR but VAR is
;; now mutated; cancel aliasing.
(setcdr (cddr alias) nil)
(setq aliased-vars (cdr (memq alias aliased-vars)))
t))))))
`(,fn ,var ,value)))
(`(defvar ,(and (pred symbolp) name) . ,rest)
(let ((optimized-rest (and rest
(cons (byte-optimize-form (car rest) nil)
(cdr rest)))))
(push name byte-optimize--dynamic-vars)
`(,fn ,name . ,optimized-rest)))
((guard (when for-effect
(if-let* ((tmp (byte-opt--fget fn 'side-effect-free)))
(or byte-compile-delete-errors
(eq tmp 'error-free)))))
(byte-compile-log " %s called for effect; deleted" fn)
(byte-optimize-form (cons 'progn (cdr form)) t))
(_
;; Otherwise, no args can be considered to be for-effect,
;; even if the called function is for-effect, because we
;; don't know anything about that function.
(let ((form (cons fn (mapcar #'byte-optimize-form (cdr form)))))
(if (byte-opt--fget fn 'pure)
(byte-optimize-constant-args form)
form))))))