-;;; Find any variables in FUN with references outside of the home
-;;; environment and close over them. If a closed over variable is set,
-;;; then we set the INDIRECT flag so that we will know the closed over
-;;; value is really a pointer to the value cell. We also warn about
-;;; unreferenced variables here, just because it's a convenient place
-;;; to do it. We return true if we close over anything.
-(defun compute-closure (fun)
- (declare (type clambda fun))
- (let ((env (get-lambda-physenv fun))
- (did-something nil))
- (note-unreferenced-vars fun)
- (dolist (var (lambda-vars fun))
- (dolist (ref (leaf-refs var))
- (let ((ref-env (get-node-physenv ref)))
- (unless (eq ref-env env)
- (when (lambda-var-sets var)
- (setf (lambda-var-indirect var) t))
- (setq did-something t)
- (close-over var ref-env env))))
- (dolist (set (basic-var-sets var))
- (let ((set-env (get-node-physenv set)))
- (unless (eq set-env env)
- (setq did-something t)
- (setf (lambda-var-indirect var) t)
- (close-over var set-env env)))))
- did-something))
+;;; Find any variables in CLAMBDA -- either directly in LAMBDA-VARS or
+;;; in the LAMBDA-VARS of elements of LAMBDA-LETS -- with references
+;;; outside of the home environment and close over them. If a
+;;; closed-over variable is set, then we set the INDIRECT flag so that
+;;; we will know the closed over value is really a pointer to the
+;;; value cell. We also warn about unreferenced variables here, just
+;;; because it's a convenient place to do it. We return true if we
+;;; close over anything.
+(defun compute-closure (clambda)
+ (declare (type clambda clambda))
+ (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)))