X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1util.lisp;h=33a8d3d872505427b8abcb7e10b9cf9f65f5f020;hb=f7faed97898dd0e94a18b0d1fca03aaa0fe24ab0;hp=55df1594e3b5bfb3662e8aad3ff503b1ec1d037a;hpb=c02501b9bbd01f1c0c0e896dc5cdb7657a77e4a7;p=sbcl.git

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 55df159..33a8d3d 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -149,6 +149,16 @@
            (t (eq (block-start (first (block-succ (node-block node))))
                   (node-prev dest))))))
 
+;;; Returns the defined (usually untrusted) type of the combination,
+;;; or NIL if we couldn't figure it out.
+(defun combination-defined-type (combination)
+  (let ((use (principal-lvar-use (basic-combination-fun combination))))
+    (or (when (ref-p use)
+          (let ((type (leaf-defined-type (ref-leaf use))))
+            (when (fun-type-p type)
+              (fun-type-returns type))))
+        *wild-type*)))
+
 ;;; Return true if LVAR destination is executed after node with only
 ;;; uninteresting nodes intervening.
 ;;;
@@ -457,10 +467,6 @@
         (compiler-notify "could not stack allocate the result of ~S"
                          (find-original-source (node-source-path use)))))))
 
-(declaim (ftype (sfunction (node (member nil t :truly) &optional (or null component))
-                           boolean) use-good-for-dx-p))
-(declaim (ftype (sfunction (lvar (member nil t :truly) &optional (or null component))
-                           boolean) lvar-good-for-dx-p))
 (defun use-good-for-dx-p (use dx &optional component)
   ;; FIXME: Can casts point to LVARs in other components?
   ;; RECHECK-DYNAMIC-EXTENT-LVARS assumes that they can't -- that is, that the
@@ -539,8 +545,9 @@
 (defun trivial-lambda-var-ref-p (use)
   (and (ref-p use)
        (let ((var (ref-leaf use)))
-         ;; lambda-var, no SETS
-         (when (and (lambda-var-p var) (not (lambda-var-sets var)))
+         ;; lambda-var, no SETS, not explicitly indefinite-extent.
+         (when (and (lambda-var-p var) (not (lambda-var-sets var))
+                    (neq :indefinite (lambda-var-extent var)))
            (let ((home (lambda-var-home var))
                  (refs (lambda-var-refs var)))
              ;; bound by a system lambda, no other REFS