[Sbcl-commits] CVS: sbcl/src/compiler/generic vm-tran.lisp, 1.86, 1.87

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/generic
In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv18370/src/compiler/generic

Modified Files:
	vm-tran.lisp 
Log Message:
1.0.36.15: upgraded array element-type of unions and intersections

 * Rename EXTRACT-UPGRADED-ELEMENT-TYPE and
   EXTRACT-DECLARED-ELEMENT-TYPE ARRAY-TYPE-UPGRADED-ELEMENT-TYPE and
   ARRAY-TYPE-DECLARED-ELEMENT-TYPE, and make them work on array types
   instead of LVARs.

 * Make ARRAY-TYPE-UPGRADED-ELEMENT-TYPE able to handle general
   intersection and union types. Code by "Gustavo"
   <gug...@gm...>.

 * Make ARRAY-TYPE-DIMENSIONS-OR-GIVE-UP able to handle general
   intersection and union types.

 Fixes Launchpad bug #316078.


Index: vm-tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-tran.lisp,v
retrieving revision 1.86
retrieving revision 1.87
diff -u -d -r1.86 -r1.87
--- vm-tran.lisp	28 Feb 2010 19:37:10 -0000	1.86
+++ vm-tran.lisp	8 Mar 2010 17:05:41 -0000	1.87
@@ -112,8 +112,9 @@
 ;;; only made for bigger and up 1o 100% slower code.
 (deftransform hairy-data-vector-ref ((array index) (simple-array t) *)
   "avoid runtime dispatch on array element type"
-  (let ((element-ctype (extract-upgraded-element-type array))
-        (declared-element-ctype (extract-declared-element-type array)))
+  (let* ((type (lvar-type array))
+         (element-ctype (array-type-upgraded-element-type type))
+         (declared-element-ctype (array-type-declared-element-type type)))
     (declare (type ctype element-ctype))
     (when (eq *wild-type* element-ctype)
       (give-up-ir1-transform
@@ -200,8 +201,9 @@
                                      (simple-array t t)
                                      *)
   "avoid runtime dispatch on array element type"
-  (let ((element-ctype (extract-upgraded-element-type array))
-        (declared-element-ctype (extract-declared-element-type array)))
+  (let* ((type (lvar-type array))
+         (element-ctype (array-type-upgraded-element-type type))
+         (declared-element-ctype (array-type-declared-element-type type)))
     (declare (type ctype element-ctype))
     (when (eq *wild-type* element-ctype)
       (give-up-ir1-transform