X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1util.lisp;h=78d92e3511b0b205fe2a064da194c67e6bc6d2f4;hb=2e5263a05f55e2b56a3194ad7853e9ae18ad69af;hp=f27b60d37ae9164be4b89dd55c42b3c8a7373aa4;hpb=8e73cf67d15bf0aeed37ac38d309aa9048b29573;p=sbcl.git

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index f27b60d..78d92e3 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -429,7 +429,7 @@
     (lvar-dynamic-extent it)))
 
 (defun flushable-combination-p (call)
-  (declare (combination call))
+  (declare (type combination call))
   (let ((kind (combination-kind call))
         (info (combination-fun-info call)))
     (when (and (eq kind :known) (fun-info-p info))
@@ -1052,6 +1052,7 @@
 (defun delete-lambda-var (leaf)
   (declare (type lambda-var leaf))
 
+  (setf (lambda-var-deleted leaf) t)
   ;; Iterate over all local calls flushing the corresponding argument,
   ;; allowing the computation of the argument to be deleted. We also
   ;; mark the LET for reoptimization, since it may be that we have
@@ -1258,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
@@ -1283,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)
@@ -2035,6 +2058,15 @@ is :ANY, the function name is not checked."
               (memq (functional-kind functional) '(:deleted :zombie))))
     (throw 'locall-already-let-converted functional)))
 
+(defun assure-leaf-live-p (leaf)
+  (typecase leaf
+    (lambda-var
+     (when (lambda-var-deleted leaf)
+       (throw 'locall-already-let-converted leaf)))
+    (functional
+     (assure-functional-live-p leaf))))
+
+
 (defun call-full-like-p (call)
   (declare (type combination call))
   (let ((kind (basic-combination-kind call)))
@@ -2190,8 +2222,11 @@ is :ANY, the function name is not checked."
                 (not (null (member (leaf-source-name leaf) names
                                    :test #'equal))))))))
 
+;;; Return true if LVAR's only use is a call to one of the named functions
+;;; (or any function if none are specified) with the specified number of
+;;; of arguments (or any number if number is not specified)
 (defun lvar-matches (lvar &key fun-names arg-count)
-  (let ((use (lvar-use lvar)))
+  (let ((use (lvar-uses lvar)))
     (and (combination-p use)
          (or (not fun-names)
              (multiple-value-bind (name ok)