Function: cconv--analyze-function

cconv--analyze-function is a byte-compiled function defined in cconv.el.gz.

Signature

(cconv--analyze-function ARGS BODY ENV PARENTFORM)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/cconv.el.gz
(defun cconv--analyze-function (args body env parentform)
  (let* ((newvars nil)
         (freevars (list body))
         ;; We analyze the body within a new environment where all uses are
         ;; nil, so we can distinguish uses within that function from uses
         ;; outside of it.
         (envcopy
          (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env))
         (cconv--dynbound-variables cconv--dynbound-variables)
         (newenv envcopy))
    ;; Push it before recursing, so cconv-freevars-alist contains entries in
    ;; the order they'll be used by closure-convert-rec.
    (push freevars cconv-freevars-alist)
    (when lexical-binding
      (dolist (arg args)
        (cond
         ((cconv--not-lexical-var-p arg cconv--dynbound-variables)
          (byte-compile-warn-x
           arg
           "Lexical argument shadows the dynamic variable %S"
           arg))
         ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
         (t (let ((varstruct (list arg nil nil nil nil)))
              (cl-pushnew arg byte-compile-lexical-variables)
              (push (cons (list arg) (cdr varstruct)) newvars)
              (push varstruct newenv))))))
    (dolist (form body)                   ;Analyze body forms.
      (cconv-analyze-form form newenv))
    ;; Summarize resulting data about arguments.
    (dolist (vardata newvars)
      (cconv--analyze-use vardata parentform "argument"))
    ;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
    ;; and compute free variables.
    (while env
      (cl-assert (and envcopy (eq (caar env) (caar envcopy))))
      (let ((free nil)
            (x (cdr (car env)))
            (y (cdr (car envcopy))))
        (while x
          (when (car y) (setcar x t) (setq free t))
          (setq x (cdr x) y (cdr y)))
        (when free
          (push (caar env) (cdr freevars))
          (setf (nth 3 (car env)) t))
        (setq env (cdr env) envcopy (cdr envcopy))))))