1.0.13.4: Removing UNIX-NAMESTRING, part 4

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

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 6da6828..d2008e7 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -57,9 +57,10 @@
                      (values-type-union (node-derived-type (first current))
                                         res))
                 (current (rest uses) (rest current)))
-               ((null current) res)))
+               ((or (null current) (eq res *wild-type*))
+                res)))
           (t
-           (node-derived-type (lvar-uses lvar))))))
+           (node-derived-type uses)))))
 
 ;;; Return the derived type for LVAR's first value. This is guaranteed
 ;;; not to be a VALUES or FUNCTION type.
@@ -181,7 +182,7 @@
                      (lambda-var-p (ref-leaf node)))
             (let ((type (single-value-type int)))
               (when (and (member-type-p type)
-                         (null (rest (member-type-members type))))
+                         (eql 1 (member-type-size type)))
                 (change-ref-leaf node (find-constant
                                        (first (member-type-members type)))))))
           (reoptimize-lvar lvar)))))
@@ -843,12 +844,6 @@
              (:inline t)
              (:no-chance nil)
              ((nil :maybe-inline) (policy call (zerop space))))
-           ;; FIXME & KLUDGE: This LET-CONVERSION check was added as a
-           ;; half-assed workaround for the bug for which the test
-           ;; case :HIGH-DEBUG-KNOWN-FUNCTION-INLINING checks in
-           ;; compiler.pure.lisp. The _real_ culprit seems to be
-           ;; the insertion of BIND/UNBIND-SENTINEL vops.
-           (policy call (plusp let-conversion))
            (defined-fun-p leaf)
            (defined-fun-inline-expansion leaf)
            (let ((fun (defined-fun-functional leaf)))
@@ -1125,9 +1120,24 @@
   (aver (and (legal-fun-name-p source-name)
              (not (eql source-name '.anonymous.))))
   (node-ends-block call)
+  ;; The internal variables of a transform are not going to be
+  ;; interesting to the debugger, so there's no sense in
+  ;; suppressing the substitution of variables with only one use
+  ;; (the extra variables can slow down constraint propagation).
+  ;;
+  ;; This needs to be done before the WITH-IR1-ENVIRONMENT-FROM-NODE,
+  ;; so that it will bind *LEXENV* to the right environment.
+  (setf (combination-lexenv call)
+        (make-lexenv :default (combination-lexenv call)
+                     :policy (process-optimize-decl
+                              '(optimize
+                                (preserve-single-use-debug-variables 0))
+                              (lexenv-policy
+                                   (combination-lexenv call)))))
   (with-ir1-environment-from-node call
     (with-component-last-block (*current-component*
                                 (block-next (node-block call)))
+
       (let ((new-fun (ir1-convert-inline-lambda
                       res
                       :debug-name (debug-name 'lambda-inlined source-name)
@@ -1135,17 +1145,6 @@
             (ref (lvar-use (combination-fun call))))
         (change-ref-leaf ref new-fun)
         (setf (combination-kind call) :full)
-        ;; The internal variables of a transform are not going to be
-        ;; interesting to the debugger, so there's no sense in
-        ;; suppressing the substitution of variables with only one use
-        ;; (the extra variables can slow down constraint propagation).
-        (setf (combination-lexenv call)
-              (make-lexenv :default (combination-lexenv call)
-                           :policy (process-optimize-decl
-                                    '(optimize
-                                      (preserve-single-use-debug-variables 0))
-                                    (lexenv-policy
-                                     (combination-lexenv call)))))
         (locall-analyze-component *current-component*))))
   (values))
 
@@ -1445,8 +1444,8 @@
                                                 *policy*)))
                  (setf (cast-type-to-check cast) *wild-type*)
                  (substitute-lvar-uses value arg
-                                     ;; FIXME
-                                     t)
+                                       ;; FIXME
+                                       t)
                  (%delete-lvar-use ref)
                  (add-lvar-use cast lvar)))))
       (setf (node-derived-type ref) *wild-type*)
@@ -1551,7 +1550,6 @@
 ;;; right here.
 (defun propagate-local-call-args (call fun)
   (declare (type combination call) (type clambda fun))
-
   (unless (or (functional-entry-fun fun)
               (lambda-optional-dispatch fun))
     (let* ((vars (lambda-vars fun))