0.7.3.8:

[sbcl.git] / src / compiler / array-tran.lisp

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 0fe241e..1cb1a64 100644 (file)
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -25,14 +25,6 @@
        element-type-specifier)))
 
 ;;; Array access functions return an object from the array, hence its
-;;; type will be asserted to be array element type.
-(defun extract-element-type (array)
-  (let ((type (continuation-type array)))
-    (if (array-type-p type)
-       (array-type-element-type type)
-       *universal-type*)))
-
-;;; Array access functions return an object from the array, hence its
 ;;; type is going to be the array upgraded element type.
 (defun extract-upgraded-element-type (array)
   (let ((type (continuation-type array)))
@@ -46,7 +38,7 @@
 (defun assert-new-value-type (new-value array)
   (let ((type (continuation-type array)))
     (when (array-type-p type)
-      (assert-continuation-type new-value (array-type-element-type type))))
+      (assert-continuation-type new-value (array-type-specialized-element-type type))))
   (continuation-type new-value))
 
 ;;; Return true if Arg is NIL, or is a constant-continuation whose
@@ -75,7 +67,7 @@
   ;; If the node continuation has a single use then assert its type.
   (let ((cont (node-cont node)))
     (when (= (length (find-uses cont)) 1)
-      (assert-continuation-type cont (extract-element-type array))))
+      (assert-continuation-type cont (extract-upgraded-element-type array))))
   (extract-upgraded-element-type array))
 
 (defoptimizer (%aset derive-type) ((array &rest stuff))
@@ -99,7 +91,7 @@
     (when (array-type-p atype)
       (values-specifier-type
        `(values (simple-array ,(type-specifier
-                               (array-type-element-type atype))
+                               (array-type-specialized-element-type atype))
                              (*))
                index index index)))))
 
@@ -199,7 +191,7 @@
                    ;; (SIMPLE-STRINGs are stored with an extra trailing
                    ;; #\NULL for convenience in calling out to C.)
                    :n-pad-elements 1)
-        (single-float 0.0s0 32 ,sb!vm:simple-array-single-float-widetag)
+        (single-float 0.0f0 32 ,sb!vm:simple-array-single-float-widetag)
         (double-float 0.0d0 64 ,sb!vm:simple-array-double-float-widetag)
         #!+long-float (long-float 0.0L0 #!+x86 96 #!+sparc 128
                                   ,sb!vm:simple-array-long-float-widetag)
@@ -213,7 +205,7 @@
         ((signed-byte 16) 0 16 ,sb!vm:simple-array-signed-byte-16-widetag)
         ((signed-byte 30) 0 32 ,sb!vm:simple-array-signed-byte-30-widetag)
         ((signed-byte 32) 0 32 ,sb!vm:simple-array-signed-byte-32-widetag)
-        ((complex single-float) #C(0.0s0 0.0s0) 64
+        ((complex single-float) #C(0.0f0 0.0f0) 64
          ,sb!vm:simple-array-complex-single-float-widetag)
         ((complex double-float) #C(0.0d0 0.0d0) 128
          ,sb!vm:simple-array-complex-double-float-widetag)