From a070a6a472f050b4ca1346f047b7577fc407217d Mon Sep 17 00:00:00 2001
From: Alexey Dejneka <adejneka@comail.ru>
Date: Sat, 14 Jun 2003 17:15:29 +0000
Subject: [PATCH] 0.8.0.71:         * Merged in Robert E. Brown's patch for
 the bug 235b;         * MAKE-ARRAY: in complex case infer a
 dimension.

---
 BUGS                         |   26 +++++++++++++-------------
 NEWS                         |    2 ++
 src/compiler/array-tran.lisp |    4 ++--
 src/compiler/seqtran.lisp    |    5 +++--
 tests/compiler.pure.lisp     |    6 ++++++
 version.lisp-expr            |    2 +-
 6 files changed, 27 insertions(+), 18 deletions(-)

diff --git a/BUGS b/BUGS
index 2227e4c..e4dd346 100644
--- a/BUGS
+++ b/BUGS
@@ -721,8 +721,8 @@ WORKAROUND:
      lists and &KEY arguments) do not signal errors when they should.
 
 
-201: "Incautious type inference from compound CONS types"
-  (reported by APD sbcl-devel 2002-09-17)
+201: "Incautious type inference from compound types"
+  a. (reported by APD sbcl-devel 2002-09-17)
     (DEFUN FOO (X)
       (LET ((Y (CAR (THE (CONS INTEGER *) X))))
         (SETF (CAR X) NIL)
@@ -735,6 +735,17 @@ WORKAROUND:
 
     (FOO ' (1 . 2)) => "NIL IS INTEGER, Y = 1"
 
+  b.
+    * (defun foo (x)
+        (declare (type (array * (4 4)) x))
+        (let ((y x))
+          (setq x (make-array '(4 4)))
+          (adjust-array y '(3 5))
+          (= (array-dimension y 0) (eval `(array-dimension ,y 0)))))
+    FOO
+    * (foo (make-array '(4 4) :adjustable t))
+    NIL
+
 205: "environment issues in cross compiler"
   (These bugs have no impact on user code, but should be fixed or
   documented.)
@@ -930,17 +941,6 @@ WORKAROUND:
 
   (foo '(nil) '(t)) => NIL, T.
 
-  b. (reported by brown on #lisp 2003-01-21)
-
-    (defun find-it (x)
-      (declare (optimize (speed 3) (safety 0)))
-      (declare (notinline mapcar))
-      (let ((z (mapcar #'car x)))
-        (find 'foobar z)))
-
-  Without (DECLARE (NOTINLINE MAPCAR)), Python cannot derive that Z is
-  LIST.
-
 237: "Environment arguments to type functions"
   a. Functions SUBTYPEP, TYPEP, UPGRADED-ARRAY-ELEMENT-TYPE, and 
      UPGRADED-COMPLEX-PART-TYPE now have an optional environment
diff --git a/NEWS b/NEWS
index cda9759..f25cda5 100644
--- a/NEWS
+++ b/NEWS
@@ -1833,6 +1833,8 @@ changes in sbcl-0.8.1 relative to sbcl-0.8.0:
     strings which use variants of the ~* directive inside.
   * bug fix: SEARCH now applies its TEST predicate to the elements of
     the arguments in the correct order.  (thanks to Wolfhard Buss)
+  * fixed bug 235b: compiler uses return types of MAPCAR and friends
+    in type inference.  (thanks to Robert E. Brown)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** NIL is now allowed as a structure slot name.
     ** arbitrary numbers, not just reals, are allowed in certain
diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 9d0df27..07ab5d3 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -142,9 +142,9 @@
             ,(cond ((constant-continuation-p dims)
                     (let* ((val (continuation-value dims))
 			   (cdims (if (listp val) val (list val))))
-		      (if (or simple (/= (length cdims) 1))
+		      (if simple
 			  cdims
-			  '(*))))
+			  (length cdims))))
                    ((csubtypep (continuation-type dims)
                                (specifier-type 'integer))
                     '(*))
diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index df274b1..82a5fa7 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -44,13 +44,14 @@
 	     `(let ((,fn-sym ,fn)
 		    (,map-result (list nil)))
 		(do-anonymous ((,temp ,map-result) . ,(do-clauses))
-			      (,endtest (cdr ,map-result))
+			      (,endtest (truly-the list (cdr ,map-result)))
 		  (rplacd ,temp (setq ,temp (list ,call)))))))
 	  ((nil)
 	   `(let ((,fn-sym ,fn)
 		  (,n-first ,(first arglists)))
 	      (do-anonymous ,(do-clauses)
-			    (,endtest ,n-first) ,call))))))))
+			    (,endtest (truly-the list ,n-first))
+                            ,call))))))))
 
 (define-source-transform mapc (function list &rest more-lists)
   (mapfoo-transform function (cons list more-lists) nil t))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index ae6a645..1178ab8 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -434,3 +434,9 @@
                                    (char/= x y z)))
                         nil #\a #\a)
                type-error)
+
+;;; Compiler lost return type of MAPCAR and friends
+(dolist (fun '(mapcar mapc maplist mapl))
+  (assert (nth-value 2 (compile nil
+                                `(lambda (x)
+                                   (1+ (,fun #'print x)))))))
diff --git a/version.lisp-expr b/version.lisp-expr
index 6d3862c..9668685 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".)
-"0.8.0.70"
+"0.8.0.71"
-- 
1.7.10.4