1.0.45.10: tools-for-build/Makefile path fixes

[sbcl.git] / src / compiler / ir1util.lisp

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index aeb2566..78d92e3 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -1259,11 +1259,32 @@
 
 ;;; Return functional for DEFINED-FUN which has been converted in policy
 ;;; corresponding to the current one, or NIL if no such functional exists.
+;;;
+;;; Also check that the parent of the functional is visible in the current
+;;; environment.
 (defun defined-fun-functional (defined-fun)
-  (let ((policy (lexenv-%policy *lexenv*)))
-    (dolist (functional (defined-fun-functionals defined-fun))
-      (when (equal policy (lexenv-%policy (functional-lexenv functional)))
-        (return functional)))))
+  (let ((functionals (defined-fun-functionals defined-fun)))
+    (when functionals
+      (let* ((sample (car functionals))
+             (there (lambda-parent (if (lambda-p sample)
+                                       sample
+                                       (optional-dispatch-main-entry sample)))))
+        (when there
+          (labels ((lookup (here)
+                     (unless (eq here there)
+                       (if here
+                           (lookup (lambda-parent here))
+                           ;; We looked up all the way up, and didn't find the parent
+                           ;; of the functional -- therefore it is nested in a lambda
+                           ;; we don't see, so return nil.
+                           (return-from defined-fun-functional nil)))))
+            (lookup (lexenv-lambda *lexenv*)))))
+      ;; Now find a functional whose policy matches the current one, if we already
+      ;; have one.
+      (let ((policy (lexenv-%policy *lexenv*)))
+        (dolist (functional functionals)
+          (when (equal policy (lexenv-%policy (functional-lexenv functional)))
+            (return functional)))))))
 
 ;;; Do stuff to delete the semantic attachments of a REF node. When
 ;;; this leaves zero or one reference, we do a type dispatch off of
@@ -1284,7 +1305,8 @@
                  (aver (null (functional-entry-fun leaf)))
                  (delete-lambda leaf))
                 (:external
-                 (delete-lambda leaf))
+                 (unless (functional-has-external-references-p leaf)
+                   (delete-lambda leaf)))
                 ((:deleted :zombie :optional))))
              (optional-dispatch
               (unless (eq (functional-kind leaf) :deleted)