Function: byte-optimize-let-form

byte-optimize-let-form is a byte-compiled function defined in byte-opt.el.gz.

Signature

(byte-optimize-let-form HEAD FORM FOR-EFFECT)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/byte-opt.el.gz
(defun byte-optimize-let-form (head form for-effect)
  ;; Recursively enter the optimizer for the bindings and body
  ;; of a let or let*.  This for depth-firstness: forms that
  ;; are more deeply nested are optimized first.
  (if lexical-binding
      (let* ((byte-optimize--lexvars byte-optimize--lexvars)
             (byte-optimize--aliased-vars byte-optimize--aliased-vars)
             (new-lexvars nil)
             (new-aliased-vars nil)
             (let-vars nil)
             (body (cdr form))
             (bindings (car form)))
        (while bindings
          (let* ((binding (car bindings))
                 (name (car binding))
                 (expr (byte-optimize-form (cadr binding) nil)))
            (setq bindings (cdr bindings))
            (when (and (eq head 'let*)
                       (memq name byte-optimize--aliased-vars))
              ;; New variable shadows an aliased variable -- α-rename
              ;; it in this and all subsequent bindings.
              (let ((new-name (make-symbol (symbol-name name))))
                (setq bindings
                      (mapcar (lambda (b)
                                (list (byte-optimize--rename-var
                                       name new-name (car b))
                                      (byte-optimize--rename-var
                                       name new-name (cadr b))))
                              bindings))
                (setq body (byte-optimize--rename-var-body name new-name body))
                (setq name new-name)))
            (let* ((aliased nil)
                   (value (and
                           (or (byte-optimize--substitutable-p expr)
                               ;; Aliasing another lexvar.
                               (setq aliased
                                     (and (symbolp expr)
                                          (assq expr byte-optimize--lexvars))))
                           (list expr)))
                   (lexical (not (or (special-variable-p name)
                                     (memq name byte-compile-bound-variables)
                                     (memq name byte-optimize--dynamic-vars))))
                   (lexinfo (and lexical (cons name (cons nil value)))))
              (push (cons name (cons expr (cdr lexinfo))) let-vars)
              (when lexinfo
                (push lexinfo (if (eq head 'let*)
                                  byte-optimize--lexvars
                                new-lexvars)))
              (when aliased
                (push expr (if (eq head 'let*)
                               byte-optimize--aliased-vars
                             new-aliased-vars))))))

        (setq byte-optimize--aliased-vars
              (append new-aliased-vars byte-optimize--aliased-vars))
        (when (and (eq head 'let) byte-optimize--aliased-vars)
          ;; Find new variables that shadow aliased variables.
          (let ((shadowing-vars nil))
            (dolist (lexvar new-lexvars)
              (let ((name (car lexvar)))
                (when (and (memq name byte-optimize--aliased-vars)
                           (not (memq name shadowing-vars)))
                  (push name shadowing-vars))))
            ;; α-rename them
            (dolist (name shadowing-vars)
              (let ((new-name (make-symbol (symbol-name name))))
                (setq new-lexvars
                      (mapcar (lambda (lexvar)
                                (if (eq (car lexvar) name)
                                    (cons new-name (cdr lexvar))
                                  lexvar))
                              new-lexvars))
                (setq let-vars
                      (mapcar (lambda (v)
                                (if (eq (car v) name)
                                    (cons new-name (cdr v))
                                  v))
                              let-vars))
                (setq body (byte-optimize--rename-var-body
                            name new-name body))))))
        (setq byte-optimize--lexvars
              (append new-lexvars byte-optimize--lexvars))
        ;; Walk the body expressions, which may mutate some of the records,
        ;; and generate new bindings that exclude unused variables.
        (let* ((byte-optimize--dynamic-vars byte-optimize--dynamic-vars)
               (opt-body (byte-optimize-body body for-effect))
               (bindings nil))
          (dolist (var let-vars)
            ;; VAR is (NAME EXPR [KEEP [VALUE]])
            (when (or (not (nthcdr 3 var)) (nth 2 var)
                      byte-optimize--inhibit-outside-loop-constprop)
              ;; Value not present, or variable marked to be kept,
              ;; or we are in the loop discovery phase: keep the binding.
              (push (list (nth 0 var) (nth 1 var)) bindings)))
          (cons bindings opt-body)))

    ;; With dynamic binding, no substitutions are in effect.
    (let ((byte-optimize--lexvars nil))
      (cons
       (mapcar (lambda (binding)
                 (if (symbolp binding)
		     binding
                   (when (or (atom binding) (cddr binding))
		     (byte-compile-warn "malformed let binding: `%S'" binding))
                   (list (car binding)
                         (byte-optimize-form (nth 1 binding) nil))))
	       (car form))
       (byte-optimize-body (cdr form) for-effect)))))