[Sbcl-commits] CVS: sbcl/src/compiler typetran.lisp,1.65,1.66

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv10783/src/compiler

Modified Files:
	typetran.lisp 
Log Message:
1.0.32.31: type system now understands (and <array-type> (not simple-array))
    
Taken to mean the <array-type> with COMPLEXP T (rather than :MAYBE). 
Adjust the type test transform to use the old technique for testing for 
complex arrays (using an explicit (NOT SIMPLE-ARRAY) test rather than a 
full call to %TYPEP, as you would otherwise get; this is a KLUDGE, but 
no worse than before).
    
Include a test case for bug #309129, which this fixes.


Index: typetran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/typetran.lisp,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -d -r1.65 -r1.66
--- typetran.lisp	7 Oct 2009 18:06:36 -0000	1.65
+++ typetran.lisp	19 Nov 2009 11:50:43 -0000	1.66
@@ -406,14 +406,24 @@
              ;; not safe to assume here that it will eventually
              ;; have (UPGRADED-ARRAY-ELEMENT-TYPE type)=T, so punt.)
              (not (unknown-type-p (array-type-element-type type)))
-             (eq (array-type-complexp stype) (array-type-complexp type)))
-          (once-only ((n-obj obj))
-            (multiple-value-bind (tests headerp)
-                (test-array-dimensions n-obj type stype)
-              `(and (,pred ,n-obj)
-                    ,@tests
-                    ,@(test-array-element-type n-obj type stype headerp))))
-          `(%typep ,obj ',(type-specifier type)))))
+             (or (eq (array-type-complexp stype) (array-type-complexp type))
+                 (and (eql (array-type-complexp stype) :maybe)
+                      (eql (array-type-complexp type) t))))
+        (once-only ((n-obj obj))
+          (multiple-value-bind (tests headerp)
+              (test-array-dimensions n-obj type stype)
+            `(and (,pred ,n-obj)
+                  ,@(when (and (eql (array-type-complexp stype) :maybe)
+                               (eql (array-type-complexp type) t))
+                      ;; KLUDGE: this is a bit lame; if we get here,
+                      ;; we already know that N-OBJ is an array, but
+                      ;; (NOT SIMPLE-ARRAY) doesn't know that.  On the
+                      ;; other hand, this should get compiled down to
+                      ;; two widetag tests, so it's only a bit lame.
+                      `((typep ,n-obj '(not simple-array))))
+                  ,@tests
+                  ,@(test-array-element-type n-obj type stype headerp))))
+        `(%typep ,obj ',(type-specifier type)))))
 
 ;;; Transform a type test against some instance type. The type test is
 ;;; flushed if the result is known at compile time. If not properly