X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1util.lisp;h=925940542f7a26de554ca3ed045817cf04256ceb;hb=cd12bb346dbbd1e077ed3e14a9db4e1cc227c244;hp=9af93518a74c62df494f1ead645462acb45a5707;hpb=e3113504fca73ebd1b992930315386d9d3ae5d18;p=sbcl.git

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 9af9351..9259405 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -440,11 +440,9 @@
                           (lambda-return clambda)))
                (result-use (when (return-p creturn)
                              (principal-lvar-use (return-result creturn)))))
-          (when result-use
-            (if (known-dx-combination-p result-use dx)
-                (combination-args-flow-cleanly-p use result-use dx)
-                (dx-combination-p result-use dx)))))
-       t))
+          ;; FIXME: We should be able to deal with multiple uses here as well.
+          (and (dx-combination-p result-use dx)
+               (combination-args-flow-cleanly-p use result-use dx))))))
 
 (defun combination-args-flow-cleanly-p (combination1 combination2 dx)
   (labels ((recurse (combination)
@@ -1143,6 +1141,14 @@
                    (eq (defined-fun-functional defined-fun) fun))
           (remhash name *free-funs*))))))
 
+;;; Return functional for DEFINED-FUN which has been converted in policy
+;;; corresponding to the current one, or NIL if no such functional exists.
+(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)))))
+
 ;;; 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
 ;;; the leaf to determine if a special action is appropriate.