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 "malformed quote form: `%s'"
(prin1-to-string 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 "malformed cond form: `%s'"
(prin1-to-string 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)
`(prog1 ,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))))
`(if ,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)))
`(while ,condition . ,body)))
(`(interactive . ,_)
(byte-compile-warn "misplaced interactive spec: `%s'"
(prin1-to-string form))
nil)
(`(function . ,_)
;; This forms is compiled as constant or by breaking out
;; all the subexpressions and compiling them separately.
form)
(`(condition-case ,var ,exp . ,clauses)
`(condition-case ,var ;Not evaluated.
,(byte-optimize-form exp 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 ,exp . ,exps)
;; 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)))
(pcase exps
(`(:fun-body ,f)
`(unwind-protect ,bodyform
:fun-body ,(byte-optimize-form f nil)))
(_
`(unwind-protect ,bodyform
. ,(byte-optimize-body exps t))))))
(`(catch ,tag . ,exps)
`(catch ,(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 . ,_)
;; Look up free vars and mark them to be kept, so that they
;; won't be optimized away.
(dolist (var (caddr form))
(let ((lexvar (assq var byte-optimize--lexvars)))
(when lexvar
(setcar (cdr lexvar) t))))
form)
(`((lambda . ,_) . ,_)
(let ((newform (macroexp--unfold-lambda form)))
(if (eq newform form)
;; Some error occurred, avoid infinite recursion.
form
(byte-optimize-form newform for-effect))))
;; FIXME: Strictly speaking, I think this is a bug: (closure...)
;; is a *value* and shouldn't appear in the car.
(`((closure . ,_) . ,_) form)
(`(setq . ,args)
(let ((var-expr-list nil))
(while args
(unless (and (consp args)
(symbolp (car args)) (consp (cdr args)))
(byte-compile-warn "malformed setq form: %S" form))
(let* ((var (car args))
(expr (cadr args))
(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.
(when (memq var byte-optimize--aliased-vars)
;; Cancel aliasing of variables aliased to this one.
(dolist (v byte-optimize--lexvars)
(when (eq (nth 2 v) var)
;; V is bound to VAR but VAR is now mutated:
;; cancel aliasing.
(setcdr (cdr v) nil)))))
(push var var-expr-list)
(push value var-expr-list))
(setq args (cddr args)))
(cons fn (nreverse var-expr-list))))
(`(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)
`(defvar ,name . ,optimized-rest)))
(`(,(pred byte-code-function-p) . ,exps)
(cons fn (mapcar #'byte-optimize-form exps)))
(`(,(pred (not symbolp)) . ,_)
(byte-compile-warn "`%s' is a malformed function"
(prin1-to-string fn))
form)
((guard (when for-effect
(if-let ((tmp (get fn 'side-effect-free)))
(or byte-compile-delete-errors
(eq tmp 'error-free)
(progn
(byte-compile-warn "value returned from %s is unused"
(prin1-to-string form))
nil)))))
(byte-compile-log " %s called for effect; deleted" fn)
;; appending a nil here might not be necessary, but it can't hurt.
(byte-optimize-form
(cons 'progn (append (cdr form) '(nil))) 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 (get fn 'pure)
(byte-optimize-constant-args form)
form))))))