X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Farray.lisp;h=0435fd3c5be9eb94cf3dd83ed612aa85af22a979;hb=667ec9d494530079bef28e8589dd0d3274b935ec;hp=90891e12c4265848b5b5ef5554676b2dfabc4227;hpb=2f453e77acd12b73a09c3b50601a420d3454b732;p=sbcl.git

diff --git a/src/code/array.lisp b/src/code/array.lisp
index 90891e1..0435fd3 100644
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -60,7 +60,7 @@
 ;;;; MAKE-ARRAY
 
 (eval-when (:compile-toplevel :execute)
-  (sb!xc:defmacro pick-type (type &rest specs)
+  (sb!xc:defmacro pick-vector-type (type &rest specs)
     `(cond ,@(mapcar #'(lambda (spec)
 			 `(,(if (eq (car spec) t)
 			      t
@@ -85,13 +85,15 @@
     ;; and for all in any reasonable user programs.)
     ((t)
      (values #.sb!vm:simple-vector-type #.sb!vm:word-bits))
-    ((character base-char)
+    ((character base-char standard-char)
      (values #.sb!vm:simple-string-type #.sb!vm:byte-bits))
     ((bit)
      (values #.sb!vm:simple-bit-vector-type 1))
     ;; OK, we have to wade into SUBTYPEPing after all.
     (t
-     (pick-type type
+     ;; FIXME: The data here are redundant with
+     ;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
+     (pick-vector-type type
        (base-char (values #.sb!vm:simple-string-type #.sb!vm:byte-bits))
        (bit (values #.sb!vm:simple-bit-vector-type 1))
        ((unsigned-byte 2)
@@ -138,7 +140,7 @@
      #.sb!vm:complex-bit-vector-type)
     ;; OK, we have to wade into SUBTYPEPing after all.
     (t
-     (pick-type type
+     (pick-vector-type type
        (base-char #.sb!vm:complex-string-type)
        (bit #.sb!vm:complex-bit-vector-type)
        (t #.sb!vm:complex-vector-type)))))
@@ -370,7 +372,7 @@
 
 (defun array-in-bounds-p (array &rest subscripts)
   #!+sb-doc
-  "Returns T if the Subscipts are in bounds for the Array, Nil otherwise."
+  "Return T if the Subscipts are in bounds for the Array, Nil otherwise."
   (if (%array-row-major-index array subscripts nil)
       t))
 
@@ -379,7 +381,7 @@
 
 (defun aref (array &rest subscripts)
   #!+sb-doc
-  "Returns the element of the Array specified by the Subscripts."
+  "Return the element of the Array specified by the Subscripts."
   (row-major-aref array (%array-row-major-index array subscripts)))
 
 (defun %aset (array &rest stuff)
@@ -414,7 +416,7 @@
 
 (defun row-major-aref (array index)
   #!+sb-doc
-  "Returns the element of array corressponding to the row-major index. This is
+  "Return the element of array corressponding to the row-major index. This is
    SETF'able."
   (declare (optimize (safety 1)))
   (row-major-aref array index))
@@ -425,7 +427,7 @@
 
 (defun svref (simple-vector index)
   #!+sb-doc
-  "Returns the Index'th element of the given Simple-Vector."
+  "Return the INDEX'th element of the given Simple-Vector."
   (declare (optimize (safety 1)))
   (aref simple-vector index))
 
@@ -435,7 +437,7 @@
 
 (defun bit (bit-array &rest subscripts)
   #!+sb-doc
-  "Returns the bit from the Bit-Array at the specified Subscripts."
+  "Return the bit from the BIT-ARRAY at the specified SUBSCRIPTS."
   (declare (type (array bit) bit-array) (optimize (safety 1)))
   (row-major-aref bit-array (%array-row-major-index bit-array subscripts)))
 
@@ -456,7 +458,7 @@
 
 (defun sbit (simple-bit-array &rest subscripts)
   #!+sb-doc
-  "Returns the bit from the Simple-Bit-Array at the specified Subscripts."
+  "Return the bit from SIMPLE-BIT-ARRAY at the specified SUBSCRIPTS."
   (declare (type (simple-array bit) simple-bit-array) (optimize (safety 1)))
   (row-major-aref simple-bit-array
 		  (%array-row-major-index simple-bit-array subscripts)))
@@ -484,7 +486,7 @@
 
 (defun array-element-type (array)
   #!+sb-doc
-  "Returns the type of the elements of the array"
+  "Return the type of the elements of the array"
   (let ((type (get-type array)))
     (macrolet ((pick-element-type (&rest stuff)
 		 `(cond ,@(mapcar #'(lambda (stuff)
@@ -501,6 +503,8 @@
 						`(= type ,item))))
 				       (cdr stuff)))
 						   stuff))))
+      ;; FIXME: The data here are redundant with
+      ;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
       (pick-element-type
        ((sb!vm:simple-string-type sb!vm:complex-string-type) 'base-char)
        ((sb!vm:simple-bit-vector-type sb!vm:complex-bit-vector-type) 'bit)
@@ -539,7 +543,7 @@
 
 (defun array-dimension (array axis-number)
   #!+sb-doc
-  "Returns the length of dimension AXIS-NUMBER of ARRAY."
+  "Return the length of dimension AXIS-NUMBER of ARRAY."
   (declare (array array) (type index axis-number))
   (cond ((not (array-header-p array))
 	 (unless (= axis-number 0)
@@ -620,6 +624,11 @@
 	     :format-control "~S is not an array with a fill pointer."
 	     :format-arguments (list vector))))
 
+;;; FIXME: It'd probably make sense to use a MACROLET to share the
+;;; guts of VECTOR-PUSH between VECTOR-PUSH-EXTEND. Such a macro
+;;; should probably be based on the VECTOR-PUSH-EXTEND code (which is
+;;; new ca. sbcl-0.7.0) rather than the VECTOR-PUSH code (which dates
+;;; back to CMU CL).
 (defun vector-push (new-el array)
   #!+sb-doc
   "Attempt to set the element of ARRAY designated by its fill pointer
@@ -640,9 +649,6 @@
 			   vector
 			   &optional
 			   (extension (1+ (length vector))))
-  #!+sb-doc
-  "This is like Vector-Push except that if the fill pointer gets too
-   large, the Vector is extended rather than Nil being returned."
   (declare (vector vector) (fixnum extension))
   (let ((fill-pointer (fill-pointer vector)))
     (declare (fixnum fill-pointer))
@@ -654,9 +660,8 @@
 
 (defun vector-pop (array)
   #!+sb-doc
-  "Attempts to decrease the fill pointer by 1 and return the element
-   pointer to by the new fill pointer. If the original value of the fill
-   pointer is 0, an error occurs."
+  "Decrease the fill pointer by 1 and return the element pointed to by the
+  new fill pointer."
   (declare (vector array))
   (let ((fill-pointer (fill-pointer array)))
     (declare (fixnum fill-pointer))
@@ -674,7 +679,7 @@
 			   initial-contents fill-pointer
 			   displaced-to displaced-index-offset)
   #!+sb-doc
-  "Adjusts the Array's dimensions to the given Dimensions and stuff."
+  "Adjust ARRAY's dimensions to the given DIMENSIONS and stuff."
   (let ((dimensions (if (listp dimensions) dimensions (list dimensions))))
     (cond ((/= (the fixnum (length (the list dimensions)))
 	       (the fixnum (array-rank array)))
@@ -815,15 +820,20 @@
   (unless (array-header-p vector)
     (macrolet ((frob (name &rest things)
 		 `(etypecase ,name
-		    ,@(mapcar #'(lambda (thing)
-				  `(,(car thing)
-				    (fill (truly-the ,(car thing) ,name)
-					  ,(cadr thing)
-					  :start new-length)))
+		    ,@(mapcar (lambda (thing)
+				(destructuring-bind (type-spec fill-value)
+				    thing
+				  `(,type-spec
+				    (fill (truly-the ,type-spec ,name)
+					  ,fill-value
+					  :start new-length))))
 			      things))))
+      ;; FIXME: The associations between vector types and initial
+      ;; values here are redundant with
+      ;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
       (frob vector
 	(simple-vector 0)
-	(simple-base-string #.default-init-char)
+	(simple-base-string #.*default-init-char-form*)
 	(simple-bit-vector 0)
 	((simple-array (unsigned-byte 2) (*)) 0)
 	((simple-array (unsigned-byte 4) (*)) 0)