X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Farray.lisp;h=6296eb4901bb2cfb96c079252df0e88bd941ceb2;hb=7c886a5d39f959ec6e82ea7970c245c92e407d8f;hp=308b762c5b19212f62d2c77c563e580aaa2ffe23;hpb=71e56a3ec29476514c3cdf57a7ac60a3d9733f1d;p=sbcl.git

diff --git a/src/code/array.lisp b/src/code/array.lisp
index 308b762..6296eb4 100644
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -149,6 +149,11 @@
     (declare (fixnum array-rank))
     (when (and displaced-index-offset (null displaced-to))
       (error "can't specify :DISPLACED-INDEX-OFFSET without :DISPLACED-TO"))
+    (when (and displaced-to
+               (arrayp displaced-to)
+               (not (equal (array-element-type displaced-to)
+                           (upgraded-array-element-type element-type))))
+      (error "Array element type of :DISPLACED-TO array does not match specified element type"))
     (if (and simple (= array-rank 1))
         ;; it's a (SIMPLE-ARRAY * (*))
         (multiple-value-bind (type n-bits)
@@ -306,29 +311,6 @@ of specialized arrays is supported."
            (fill-data-vector data dimensions initial-contents)))
     data))
 
-(defun fill-data-vector (vector dimensions initial-contents)
-  (let ((index 0))
-    (labels ((frob (axis dims contents)
-               (cond ((null dims)
-                      (setf (aref vector index) contents)
-                      (incf index))
-                     (t
-                      (unless (typep contents 'sequence)
-                        (error "malformed :INITIAL-CONTENTS: ~S is not a ~
-                                sequence, but ~W more layer~:P needed."
-                               contents
-                               (- (length dimensions) axis)))
-                      (unless (= (length contents) (car dims))
-                        (error "malformed :INITIAL-CONTENTS: Dimension of ~
-                                axis ~W is ~W, but ~S is ~W long."
-                               axis (car dims) contents (length contents)))
-                      (if (listp contents)
-                          (dolist (content contents)
-                            (frob (1+ axis) (cdr dims) content))
-                          (dotimes (i (length contents))
-                            (frob (1+ axis) (cdr dims) (aref contents i))))))))
-      (frob 0 dimensions initial-contents))))
-
 (defun vector (&rest objects)
   #!+sb-doc
   "Construct a SIMPLE-VECTOR from the given objects."