0.pre8.105

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

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 56641ac..a384a6c 100644 (file)
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -187,13 +187,13 @@
         ,n-vec))))
 
 ;;; Just convert it into a MAKE-ARRAY.
-(define-source-transform make-string (length &key
-                                            (element-type ''base-char)
-                                            (initial-element
-                                             '#.*default-init-char-form*))
-  `(make-array (the index ,length)
-              :element-type ,element-type
-              :initial-element ,initial-element))
+(deftransform make-string ((length &key
+                                  (element-type 'base-char)
+                                  (initial-element
+                                   #.*default-init-char-form*)))
+  '(make-array (the index length)
+               :element-type element-type
+               :initial-element initial-element))
 
 (defstruct (specialized-array-element-type-properties
            (:conc-name saetp-)
@@ -227,7 +227,10 @@
         (destructuring-bind (type-spec &rest rest) args
           (let ((ctype (specifier-type type-spec)))
             (apply #'!make-saetp ctype rest))))
-       `((base-char ,(code-char 0) 8 ,sb!vm:simple-string-widetag
+       `(;; Erm.  Yeah.  There aren't a lot of things that make sense
+        ;; for an initial element for (ARRAY NIL). -- CSR, 2002-03-07
+        (nil '#:mu 0 ,sb!vm:simple-array-nil-widetag)
+        (base-char ,(code-char 0) 8 ,sb!vm:simple-string-widetag
                    ;; (SIMPLE-STRINGs are stored with an extra trailing
                    ;; #\NULL for convenience in calling out to C.)
                    :n-pad-elements 1)
@@ -366,14 +369,17 @@
                                   'length
                                   `(+ length ,n-pad-elements)))
           (n-words-form
-           (if (>= n-bits-per-element sb!vm:n-word-bits)
-               `(* ,padded-length-form
-                   (the fixnum ; i.e., not RATIO
-                     ,(/ n-bits-per-element sb!vm:n-word-bits)))
-               (let ((n-elements-per-word (/ sb!vm:n-word-bits
-                                             n-bits-per-element)))
-                 (declare (type index n-elements-per-word)) ; i.e., not RATIO
-                 `(ceiling ,padded-length-form ,n-elements-per-word)))))
+           (cond
+             ((= n-bits-per-element 0) 0)
+             ((>= n-bits-per-element sb!vm:n-word-bits)
+              `(* ,padded-length-form
+                (the fixnum ; i.e., not RATIO
+                  ,(/ n-bits-per-element sb!vm:n-word-bits))))
+             (t
+              (let ((n-elements-per-word (/ sb!vm:n-word-bits
+                                            n-bits-per-element)))
+                (declare (type index n-elements-per-word)) ; i.e., not RATIO
+                `(ceiling ,padded-length-form ,n-elements-per-word))))))
       (values
        `(truly-the ,result-type-spec
         (allocate-vector ,typecode length ,n-words-form))
@@ -629,14 +635,21 @@
              (cond (,end
                     (unless (or ,unsafe? (<= ,end ,size))
                       ,(if fail-inline?
-                           `(error "End ~W is greater than total size ~W."
-                                   ,end ,size)
+                           `(error 'bounding-indices-bad-error
+                             :datum (cons ,start ,end)
+                             :expected-type `(cons (integer 0 ,',size)
+                                                   (integer ,',start ,',size))
+                             :object ,array)
                            `(failed-%with-array-data ,array ,start ,end)))
                     ,end)
                    (t ,size))))
        (unless (or ,unsafe? (<= ,start ,defaulted-end))
         ,(if fail-inline?
-             `(error "Start ~W is greater than end ~W." ,start ,defaulted-end)
+             `(error 'bounding-indices-bad-error
+               :datum (cons ,start ,end)
+               :expected-type `(cons (integer 0 ,',size)
+                                     (integer ,',start ,',size))
+               :object ,array)
              `(failed-%with-array-data ,array ,start ,end)))
        (do ((,data ,array (%array-data-vector ,data))
            (,cumulative-offset 0