From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Wed, 6 Oct 2010 08:59:32 +0000 (+0000)
Subject: 1.0.43.26: propagate-local-call-args for lambdas with optional-dispatches too
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=4bc105c259d2f6e0df7bcc6ceb72d5a75bb4e720;p=sbcl.git

1.0.43.26: propagate-local-call-args for lambdas with optional-dispatches too

 Previously we elided the propagation if the lambda had an entry-fun
 or an optional-dispatch. The comment notes that we "If the function
 has an XEP, then we don't do anything".

 There are, however, lambdas with optional-dispatche that don't have
 XEPs. Doing propagation for these is required for proper &REST list
 type derivation.

 Fixes lp#655203.
---

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index d091f38..59b145a 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1706,8 +1706,8 @@
 ;;; variable, we compute the union of the types across all calls and
 ;;; propagate this type information to the var's refs.
 ;;;
-;;; If the function has an XEP, then we don't do anything, since we
-;;; won't discover anything.
+;;; If the function has an entry-fun, then we don't do anything: since
+;;; it has a XEP we would not discover anything.
 ;;;
 ;;; We can clear the LVAR-REOPTIMIZE flags for arguments in all calls
 ;;; corresponding to changed arguments in CALL, since the only use in
@@ -1715,8 +1715,7 @@
 ;;; 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))
+  (unless (functional-entry-fun fun)
     (let* ((vars (lambda-vars fun))
            (union (mapcar (lambda (arg var)
                             (when (and arg
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 439518e..5435c43 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2676,6 +2676,14 @@
     (assert (eq 'list type))
     (assert derivedp)))
 
+(with-test (:name :rest-list-type-derivation2)
+  (multiple-value-bind (type derivedp)
+      (funcall (funcall (compile nil `(lambda ()
+                                        (lambda (&rest args)
+                                          (ctu:compiler-derived-type args))))))
+    (assert (eq 'list type))
+    (assert derivedp)))
+
 (with-test (:name :base-char-typep-elimination)
   (assert (eq (funcall (lambda (ch)
                          (declare (type base-char ch) (optimize (speed 3) (safety 0)))
diff --git a/version.lisp-expr b/version.lisp-expr
index f09282b..dd65459 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.43.25"
+"1.0.43.26"