- (flet (;; This is the old CMU CL COMPUTE-CLOSURE, which only works
- ;; on LAMBDA-VARS directly, not on the LAMBDA-VARS of
- ;; LAMBDA-LETS. It seems never to be valid to use this
- ;; operation alone, so in SBCL, it's private, and the public
- ;; interface always runs over all the variables, both the
- ;; LAMBDA-VARS of CLAMBDA itself and the LAMBDA-VARS of
- ;; CLAMBDA's LAMBDA-LETS.
- ;;
- ;; Note that we don't need to make a distinction between the
- ;; outer CLAMBDA argument and the inner one, or refer to the
- ;; outer CLAMBDA argument at all, because the LET-conversion
- ;; process carefully modifies all the necessary CLAMBDA slots
- ;; (e.g. LAMBDA-PHYSENV) of a LET-converted CLAMBDA to refer
- ;; to the new home.
- (%compute-closure (clambda)
- (let ((physenv (get-lambda-physenv clambda))
- (did-something nil))
- (note-unreferenced-vars clambda)
- (dolist (var (lambda-vars clambda))
- (dolist (ref (leaf-refs var))
- (let ((ref-physenv (get-node-physenv ref)))
- (unless (eq ref-physenv physenv)
- (when (lambda-var-sets var)
- (setf (lambda-var-indirect var) t))
- (setq did-something t)
- (close-over var ref-physenv physenv))))
- (dolist (set (basic-var-sets var))
- (let ((set-physenv (get-node-physenv set)))
- (unless (eq set-physenv physenv)
- (setq did-something t)
- (setf (lambda-var-indirect var) t)
- (close-over var set-physenv physenv)))))
- did-something)))
- (let ((did-something nil))
- (when (%compute-closure clambda)
- (setf did-something t))
- (dolist (lambda-let (lambda-lets clambda))
- ;; There's no need to recurse through full COMPUTE-CLOSURE
- ;; here, since LETS only go one layer deep.
- (aver (null (lambda-lets lambda-let)))
- (when (%compute-closure lambda-let)
- (setf did-something t)))
- did-something)))
+ (let ((did-something nil))
+ (when (%add-lambda-vars-to-closures clambda)
+ (setf did-something t))
+ (dolist (lambda-let (lambda-lets clambda))
+ ;; There's no need to recurse through full COMPUTE-CLOSURE
+ ;; here, since LETS only go one layer deep.
+ (aver (null (lambda-lets lambda-let)))
+ (when (%add-lambda-vars-to-closures lambda-let)
+ (setf did-something t)))
+ did-something))