0.8.0.78.vector-nil-string.8:

	Some more OAOOification from *SAETP*
	... add a COMPLEX-TYPECODE field to *SAETP* to allow us to carry
		the information that SIMPLE-BIT-VECTOR and
		COMPLEX-BIT-VECTOR are both bit vectors.
	... use *SAETP* in %VECTOR-WIDETAG-AND-N-BITS,
		ARRAY-ELEMENT-TYPE and SHRINK-VECTOR (net win so far: 6)
	... we might need a FIXNUM type earlier than CLASS.  I've got
		one in, but then I found a refactor that might mean we
		don't need it.  The problem is in SPECIALIZE-ARRAY-TYPE,
		where obviously we need to have complete knowledge about
		all the possible upgraded-array-element-types so that
		we can ask whether a given type is SUBTYPEP.  FIXNUM
		is defined as a type fairly late, but maybe defining it
		before (simple-array (signed-byte 30) (*)) is enough,
		when combined with...
	Refactor PRIMITIVE-TYPEs
	... we only ever use the specifier, not the ctype, of
		PRIMITIVE-TYPE-TYPE, so...
	... delete the TYPE field and add a SPECIFIER field.
	... add AVERrance in SPECIALIZE-ARRAY-TYPE.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 96d96ef..53aece2 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -2012,6 +2012,7 @@ structure representations"
             "SAETP-CTYPE" "SAETP-INITIAL-ELEMENT-DEFAULT"
             "SAETP-N-BITS" "SAETP-TYPECODE" "SAETP-PRIMTYPE"
             "SAETP-N-PAD-ELEMENTS" "SAETP-SPECIFIER"
+            "SAETP-COMPLEX-TYPECODE"
             "*SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*"
             "SANCTIFY-FOR-EXECUTION"
              "SAP-POINTER-SLOT" "SAP-REG-SC-NUMBER" "SAP-SIZE"

diff --git a/src/code/array.lisp b/src/code/array.lisp
index e951999..4f0052b 100644 (file)
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -106,46 +106,14 @@
      (values #.sb!vm:simple-bit-vector-widetag 1))
     ;; OK, we have to wade into SUBTYPEPing after all.
     (t
-     ;; FIXME: The data here are redundant with
-     ;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
-     (pick-vector-type type
-       (nil (values #.sb!vm:simple-array-nil-widetag 0))
-       (base-char (values #.sb!vm:simple-base-string-widetag #.sb!vm:n-byte-bits))
-       (bit (values #.sb!vm:simple-bit-vector-widetag 1))
-       ((unsigned-byte 2)
-       (values #.sb!vm:simple-array-unsigned-byte-2-widetag 2))
-       ((unsigned-byte 4)
-       (values #.sb!vm:simple-array-unsigned-byte-4-widetag 4))
-       ((unsigned-byte 8)
-       (values #.sb!vm:simple-array-unsigned-byte-8-widetag 8))
-       ((unsigned-byte 16)
-       (values #.sb!vm:simple-array-unsigned-byte-16-widetag 16))
-       ((unsigned-byte 32)
-       (values #.sb!vm:simple-array-unsigned-byte-32-widetag 32))
-       ((signed-byte 8)
-       (values #.sb!vm:simple-array-signed-byte-8-widetag 8))
-       ((signed-byte 16)
-       (values #.sb!vm:simple-array-signed-byte-16-widetag 16))
-       ((signed-byte 30)
-       (values #.sb!vm:simple-array-signed-byte-30-widetag 32))
-       ((signed-byte 32)
-       (values #.sb!vm:simple-array-signed-byte-32-widetag 32))
-       (single-float (values #.sb!vm:simple-array-single-float-widetag 32))
-       (double-float (values #.sb!vm:simple-array-double-float-widetag 64))
-       #!+long-float
-       (long-float
-       (values #.sb!vm:simple-array-long-float-widetag
-               #!+x86 96 #!+sparc 128))
-       ((complex single-float)
-       (values #.sb!vm:simple-array-complex-single-float-widetag 64))
-       ((complex double-float)
-       (values #.sb!vm:simple-array-complex-double-float-widetag 128))
-       #!+long-float
-       ((complex long-float)
-       (values #.sb!vm:simple-array-complex-long-float-widetag
-               #!+x86 192
-               #!+sparc 256))
-       (t (values #.sb!vm:simple-vector-widetag #.sb!vm:n-word-bits))))))
+     #.`(pick-vector-type type
+        ,@(map 'list
+               (lambda (saetp)
+                 `(,(sb!vm:saetp-specifier saetp)
+                   (values ,(sb!vm:saetp-typecode saetp)
+                           ,(sb!vm:saetp-n-bits saetp))))
+               sb!vm:*specialized-array-element-type-properties*)))))
+
 (defun %complex-vector-widetag (type)
   (case type
     ;; Pick off some easy common cases.
@@ -559,41 +527,23 @@
                                              `(= widetag ,item))))
                                     (cdr stuff)))
                                  stuff))))
-      ;; FIXME: The data here are redundant with
-      ;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
-      (pick-element-type
-       ((sb!vm:simple-array-nil-widetag sb!vm:complex-vector-nil-widetag) nil)
-       ((sb!vm:simple-base-string-widetag sb!vm:complex-base-string-widetag) 'base-char)
-       ((sb!vm:simple-bit-vector-widetag
-        sb!vm:complex-bit-vector-widetag) 'bit)
-       (sb!vm:simple-vector-widetag t)
-       (sb!vm:simple-array-unsigned-byte-2-widetag '(unsigned-byte 2))
-       (sb!vm:simple-array-unsigned-byte-4-widetag '(unsigned-byte 4))
-       (sb!vm:simple-array-unsigned-byte-8-widetag '(unsigned-byte 8))
-       (sb!vm:simple-array-unsigned-byte-16-widetag '(unsigned-byte 16))
-       (sb!vm:simple-array-unsigned-byte-32-widetag '(unsigned-byte 32))
-       (sb!vm:simple-array-signed-byte-8-widetag '(signed-byte 8))
-       (sb!vm:simple-array-signed-byte-16-widetag '(signed-byte 16))
-       (sb!vm:simple-array-signed-byte-30-widetag '(signed-byte 30))
-       (sb!vm:simple-array-signed-byte-32-widetag '(signed-byte 32))
-       (sb!vm:simple-array-single-float-widetag 'single-float)
-       (sb!vm:simple-array-double-float-widetag 'double-float)
-       #!+long-float
-       (sb!vm:simple-array-long-float-widetag 'long-float)
-       (sb!vm:simple-array-complex-single-float-widetag
-       '(complex single-float))
-       (sb!vm:simple-array-complex-double-float-widetag
-       '(complex double-float))
-       #!+long-float
-       (sb!vm:simple-array-complex-long-float-widetag '(complex long-float))
-       ((sb!vm:simple-array-widetag
-        sb!vm:complex-vector-widetag
-        sb!vm:complex-array-widetag)
-       (with-array-data ((array array) (start) (end))
-         (declare (ignore start end))
-         (array-element-type array)))
-       (t
-       (error 'type-error :datum array :expected-type 'array))))))
+      #.`(pick-element-type
+         ,@(map 'list
+                (lambda (saetp)
+                  `(,(if (sb!vm:saetp-complex-typecode saetp)
+                         (list (sb!vm:saetp-typecode saetp)
+                               (sb!vm:saetp-complex-typecode saetp))
+                         (sb!vm:saetp-typecode saetp))
+                    ',(sb!vm:saetp-specifier saetp)))
+                sb!vm:*specialized-array-element-type-properties*)
+         ((sb!vm:simple-array-widetag
+           sb!vm:complex-vector-widetag
+           sb!vm:complex-array-widetag)
+          (with-array-data ((array array) (start) (end))
+            (declare (ignore start end))
+            (array-element-type array)))
+         (t
+          (error 'type-error :datum array :expected-type 'array))))))
 
 (defun array-rank (array)
   #!+sb-doc
@@ -890,33 +840,16 @@
                                          ,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-form*)
-       (simple-bit-vector 0)
-       ((simple-array (unsigned-byte 2) (*)) 0)
-       ((simple-array (unsigned-byte 4) (*)) 0)
-       ((simple-array (unsigned-byte 8) (*)) 0)
-       ((simple-array (unsigned-byte 16) (*)) 0)
-       ((simple-array (unsigned-byte 32) (*)) 0)
-       ((simple-array (signed-byte 8) (*)) 0)
-       ((simple-array (signed-byte 16) (*)) 0)
-       ((simple-array (signed-byte 30) (*)) 0)
-       ((simple-array (signed-byte 32) (*)) 0)
-       ((simple-array single-float (*)) (coerce 0 'single-float))
-       ((simple-array double-float (*)) (coerce 0 'double-float))
-       #!+long-float
-       ((simple-array long-float (*)) (coerce 0 'long-float))
-       ((simple-array (complex single-float) (*))
-        (coerce 0 '(complex single-float)))
-       ((simple-array (complex double-float) (*))
-        (coerce 0 '(complex double-float)))
-       #!+long-float
-       ((simple-array (complex long-float) (*))
-        (coerce 0 '(complex long-float))))))
+      #.`(frob vector
+         ,@(map 'list
+                (lambda (saetp)
+                  `((simple-array ,(sb!vm:saetp-specifier saetp) (*))
+                    ,(if (eq (sb!vm:saetp-specifier saetp) 'base-char)
+                         *default-init-char-form*
+                         (sb!vm:saetp-initial-element-default saetp))))
+                (remove-if-not
+                 #'sb!vm:saetp-specifier
+                 sb!vm:*specialized-array-element-type-properties*)))))
   ;; Only arrays have fill-pointers, but vectors have their length
   ;; parameter in the same place.
   (setf (%array-fill-pointer vector) new-length)

diff --git a/src/code/class.lisp b/src/code/class.lisp
index bea6e90..4b2f936 100644 (file)
--- a/src/code/class.lisp
+++ b/src/code/class.lisp
@@ -956,6 +956,61 @@
       :inherits (function)
       :state :read-only)
 
+     (number :translation number)
+     (complex
+      :translation complex
+      :inherits (number)
+      :codes (#.sb!vm:complex-widetag))
+     (complex-single-float
+      :translation (complex single-float)
+      :inherits (complex number)
+      :codes (#.sb!vm:complex-single-float-widetag))
+     (complex-double-float
+      :translation (complex double-float)
+      :inherits (complex number)
+      :codes (#.sb!vm:complex-double-float-widetag))
+     #!+long-float
+     (complex-long-float
+      :translation (complex long-float)
+      :inherits (complex number)
+      :codes (#.sb!vm:complex-long-float-widetag))
+     (real :translation real :inherits (number))
+     (float
+      :translation float
+      :inherits (real number))
+     (single-float
+      :translation single-float
+      :inherits (float real number)
+      :codes (#.sb!vm:single-float-widetag))
+     (double-float
+      :translation double-float
+      :inherits (float real number)
+      :codes (#.sb!vm:double-float-widetag))
+     #!+long-float
+     (long-float
+      :translation long-float
+      :inherits (float real number)
+      :codes (#.sb!vm:long-float-widetag))
+     (rational
+      :translation rational
+      :inherits (real number))
+     (ratio
+      :translation (and rational (not integer))
+      :inherits (rational real number)
+      :codes (#.sb!vm:ratio-widetag))
+     (integer
+      :translation integer
+      :inherits (rational real number))
+     (fixnum
+      :translation (integer #.sb!xc:most-negative-fixnum
+                   #.sb!xc:most-positive-fixnum)
+      :inherits (integer rational real number)
+      :codes (#.sb!vm:even-fixnum-lowtag #.sb!vm:odd-fixnum-lowtag))
+     (bignum
+      :translation (and integer (not fixnum))
+      :inherits (integer rational real number)
+      :codes (#.sb!vm:bignum-widetag))
+
      (array :translation array :codes (#.sb!vm:complex-array-widetag)
             :hierarchical-p nil)
      (simple-array
@@ -995,166 +1050,113 @@
       :direct-superclasses (vector simple-array)
       :inherits (vector simple-array array sequence))
      (simple-array-unsigned-byte-16
-     :translation (simple-array (unsigned-byte 16) (*))
-     :codes (#.sb!vm:simple-array-unsigned-byte-16-widetag)
-     :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence))
+      :translation (simple-array (unsigned-byte 16) (*))
+      :codes (#.sb!vm:simple-array-unsigned-byte-16-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence))
      (simple-array-unsigned-byte-32
-     :translation (simple-array (unsigned-byte 32) (*))
-     :codes (#.sb!vm:simple-array-unsigned-byte-32-widetag)
-     :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence))
+      :translation (simple-array (unsigned-byte 32) (*))
+      :codes (#.sb!vm:simple-array-unsigned-byte-32-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence))
      (simple-array-signed-byte-8
-     :translation (simple-array (signed-byte 8) (*))
-     :codes (#.sb!vm:simple-array-signed-byte-8-widetag)
-     :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence))
+      :translation (simple-array (signed-byte 8) (*))
+      :codes (#.sb!vm:simple-array-signed-byte-8-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence))
      (simple-array-signed-byte-16
-     :translation (simple-array (signed-byte 16) (*))
-     :codes (#.sb!vm:simple-array-signed-byte-16-widetag)
-     :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence))
+      :translation (simple-array (signed-byte 16) (*))
+      :codes (#.sb!vm:simple-array-signed-byte-16-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence))
      (simple-array-signed-byte-30
-     :translation (simple-array (signed-byte 30) (*))
-     :codes (#.sb!vm:simple-array-signed-byte-30-widetag)
-     :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence))
+      :translation (simple-array (signed-byte 30) (*))
+      :codes (#.sb!vm:simple-array-signed-byte-30-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence))
      (simple-array-signed-byte-32
-     :translation (simple-array (signed-byte 32) (*))
-     :codes (#.sb!vm:simple-array-signed-byte-32-widetag)
-     :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence))
+      :translation (simple-array (signed-byte 32) (*))
+      :codes (#.sb!vm:simple-array-signed-byte-32-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence))
      (simple-array-single-float
-     :translation (simple-array single-float (*))
-     :codes (#.sb!vm:simple-array-single-float-widetag)
-     :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence))
+      :translation (simple-array single-float (*))
+      :codes (#.sb!vm:simple-array-single-float-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence))
      (simple-array-double-float
-     :translation (simple-array double-float (*))
-     :codes (#.sb!vm:simple-array-double-float-widetag)
-     :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence))
-    #!+long-float
-    (simple-array-long-float
-     :translation (simple-array long-float (*))
-     :codes (#.sb!vm:simple-array-long-float-widetag)
-     :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence))
-    (simple-array-complex-single-float
-     :translation (simple-array (complex single-float) (*))
-     :codes (#.sb!vm:simple-array-complex-single-float-widetag)
-     :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence))
-    (simple-array-complex-double-float
-     :translation (simple-array (complex double-float) (*))
-     :codes (#.sb!vm:simple-array-complex-double-float-widetag)
-     :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence))
-    #!+long-float
-    (simple-array-complex-long-float
-     :translation (simple-array (complex long-float) (*))
-     :codes (#.sb!vm:simple-array-complex-long-float-widetag)
-     :direct-superclasses (vector simple-array)
-     :inherits (vector simple-array array sequence))
-    (string
-     :translation string
-     :direct-superclasses (vector)
-     :inherits (vector array sequence))
-    (simple-string
-     :translation simple-string
-     :direct-superclasses (string simple-array)
-     :inherits (string vector simple-array array sequence))
-    (vector-nil
-     ;; FIXME: Should this be (AND (VECTOR NIL) (NOT (SIMPLE-ARRAY NIL (*))))?
-     :translation (vector nil)
-     :codes (#.sb!vm:complex-vector-nil-widetag)
-     :direct-superclasses (string)
-     :inherits (string vector array sequence))
-    (simple-array-nil
-     :translation (simple-array nil (*))
-     :codes (#.sb!vm:simple-array-nil-widetag)
-     :direct-superclasses (vector-nil simple-string)
-     :inherits (vector-nil simple-string string vector simple-array array sequence))
-    (base-string
-     :translation base-string
-     :codes (#.sb!vm:complex-base-string-widetag)
-     :direct-superclasses (string)
-     :inherits (string vector array sequence))
-    (simple-base-string
-     :translation simple-base-string
-     :codes (#.sb!vm:simple-base-string-widetag)
-     :direct-superclasses (base-string simple-string)
-     :inherits (base-string simple-string string vector simple-array
-               array sequence))
-    (list
-     :translation (or cons (member nil))
-     :inherits (sequence))
-    (cons
-     :codes (#.sb!vm:list-pointer-lowtag)
-     :translation cons
-     :inherits (list sequence))
-    (null
-     :translation (member nil)
-     :inherits (symbol list sequence)
-     :direct-superclasses (symbol list))
-    (number :translation number)
-    (complex
-     :translation complex
-     :inherits (number)
-     :codes (#.sb!vm:complex-widetag))
-    (complex-single-float
-     :translation (complex single-float)
-     :inherits (complex number)
-     :codes (#.sb!vm:complex-single-float-widetag))
-    (complex-double-float
-     :translation (complex double-float)
-     :inherits (complex number)
-     :codes (#.sb!vm:complex-double-float-widetag))
-    #!+long-float
-    (complex-long-float
-     :translation (complex long-float)
-     :inherits (complex number)
-     :codes (#.sb!vm:complex-long-float-widetag))
-    (real :translation real :inherits (number))
-    (float
-     :translation float
-     :inherits (real number))
-    (single-float
-     :translation single-float
-     :inherits (float real number)
-     :codes (#.sb!vm:single-float-widetag))
-    (double-float
-     :translation double-float
-     :inherits (float real number)
-     :codes (#.sb!vm:double-float-widetag))
-    #!+long-float
-    (long-float
-     :translation long-float
-     :inherits (float real number)
-     :codes (#.sb!vm:long-float-widetag))
-    (rational
-     :translation rational
-     :inherits (real number))
-    (ratio
-     :translation (and rational (not integer))
-     :inherits (rational real number)
-     :codes (#.sb!vm:ratio-widetag))
-    (integer
-     :translation integer
-     :inherits (rational real number))
-    (fixnum
-     :translation (integer #.sb!xc:most-negative-fixnum
-                          #.sb!xc:most-positive-fixnum)
-     :inherits (integer rational real number)
-     :codes (#.sb!vm:even-fixnum-lowtag #.sb!vm:odd-fixnum-lowtag))
-    (bignum
-     :translation (and integer (not fixnum))
-     :inherits (integer rational real number)
-     :codes (#.sb!vm:bignum-widetag))
-    (stream
-     :state :read-only
-     :depth 3
-     :inherits (instance)))))
+      :translation (simple-array double-float (*))
+      :codes (#.sb!vm:simple-array-double-float-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence))
+     #!+long-float
+     (simple-array-long-float
+      :translation (simple-array long-float (*))
+      :codes (#.sb!vm:simple-array-long-float-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence))
+     (simple-array-complex-single-float
+      :translation (simple-array (complex single-float) (*))
+      :codes (#.sb!vm:simple-array-complex-single-float-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence))
+     (simple-array-complex-double-float
+      :translation (simple-array (complex double-float) (*))
+      :codes (#.sb!vm:simple-array-complex-double-float-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence))
+     #!+long-float
+     (simple-array-complex-long-float
+      :translation (simple-array (complex long-float) (*))
+      :codes (#.sb!vm:simple-array-complex-long-float-widetag)
+      :direct-superclasses (vector simple-array)
+      :inherits (vector simple-array array sequence))
+     (string
+      :translation string
+      :direct-superclasses (vector)
+      :inherits (vector array sequence))
+     (simple-string
+      :translation simple-string
+      :direct-superclasses (string simple-array)
+      :inherits (string vector simple-array array sequence))
+     (vector-nil
+      ;; FIXME: Should this be (AND (VECTOR NIL) (NOT (SIMPLE-ARRAY NIL (*))))?
+      :translation (vector nil)
+      :codes (#.sb!vm:complex-vector-nil-widetag)
+      :direct-superclasses (string)
+      :inherits (string vector array sequence))
+     (simple-array-nil
+      :translation (simple-array nil (*))
+      :codes (#.sb!vm:simple-array-nil-widetag)
+      :direct-superclasses (vector-nil simple-string)
+      :inherits (vector-nil simple-string string vector simple-array array sequence))
+     (base-string
+      :translation base-string
+      :codes (#.sb!vm:complex-base-string-widetag)
+      :direct-superclasses (string)
+      :inherits (string vector array sequence))
+     (simple-base-string
+      :translation simple-base-string
+      :codes (#.sb!vm:simple-base-string-widetag)
+      :direct-superclasses (base-string simple-string)
+      :inherits (base-string simple-string string vector simple-array
+                array sequence))
+     (list
+      :translation (or cons (member nil))
+      :inherits (sequence))
+     (cons
+      :codes (#.sb!vm:list-pointer-lowtag)
+      :translation cons
+      :inherits (list sequence))
+     (null
+      :translation (member nil)
+      :inherits (symbol list sequence)
+      :direct-superclasses (symbol list))
+     
+     (stream
+      :state :read-only
+      :depth 3
+      :inherits (instance)))))
 
 ;;; comment from CMU CL:
 ;;;   See also type-init.lisp where we finish setting up the

diff --git a/src/code/deftypes-for-target.lisp b/src/code/deftypes-for-target.lisp
index cea2e9b..ab58e4e 100644 (file)
--- a/src/code/deftypes-for-target.lisp
+++ b/src/code/deftypes-for-target.lisp
@@ -24,6 +24,11 @@
 \f
 ;;;; standard types
 
+;;; also has a definition in src/code/class.lisp, but we need it
+;;; earlier for array specialization.
+(sb!xc:deftype fixnum ()
+  '(integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum))
+
 (sb!xc:deftype boolean () '(member t nil))
 
 (sb!xc:deftype mod (n)

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index 58084a7..bab805f 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -711,8 +711,6 @@
   "Return a new sequence of all the argument sequences concatenated together
   which shares no structure with the original argument sequences of the
   specified OUTPUT-TYPE-SPEC."
-  (/show0 "full call to CONCATENATE, OUTPUT-TYPE-SPEC=..")
-  (/hexstr output-type-spec)
   (let ((type (specifier-type output-type-spec)))
   (cond
     ((csubtypep type (specifier-type 'list))

diff --git a/src/compiler/fixup-type.lisp b/src/compiler/fixup-type.lisp
index 0c101f4..ca3406c 100644 (file)
--- a/src/compiler/fixup-type.lisp
+++ b/src/compiler/fixup-type.lisp
@@ -9,20 +9,4 @@
              (specifier-type (sb!vm:saetp-specifier saetp))))
       sb!vm:*specialized-array-element-type-properties*))
 
-(!cold-init-forms
- (maphash
-  (lambda (key value)
-    (declare (ignore key))
-    (setf (primitive-type-type value)
-         (specifier-type (type-specifier (primitive-type-type value)))))
-  *backend-meta-primitive-type-names*))
-
-(!cold-init-forms
- (maphash
-  (lambda (key value)
-    (declare (ignore key))
-    (setf (primitive-type-type value)
-         (specifier-type (type-specifier (primitive-type-type value)))))
-  *backend-primitive-type-names*))
-
 (!defun-from-collected-cold-init-forms !fixup-type-cold-init)
\ No newline at end of file

diff --git a/src/compiler/generic/vm-array.lisp b/src/compiler/generic/vm-array.lisp
index 75e016f..728a337 100644 (file)
--- a/src/compiler/generic/vm-array.lisp
+++ b/src/compiler/generic/vm-array.lisp
@@ -21,7 +21,7 @@
              initial-element-default
              n-bits
              primitive-type-name
-             &key (n-pad-elements 0)
+             &key (n-pad-elements 0) complex-typecode
              &aux (typecode
                    (eval (symbolicate primitive-type-name "-WIDETAG")))))
            (:copier nil))
@@ -38,6 +38,9 @@
   (n-bits (missing-arg) :type index :read-only t)
   ;; the low-level type code (aka "widetag")
   (typecode (missing-arg) :type index :read-only t)
+  ;; if an integer, a typecode corresponding to a complex vector
+  ;; specialized on this element type.
+  (complex-typecode nil :type (or index null) :read-only t)
   ;; the name of the primitive type of data vectors specialized on
   ;; this type
   (primitive-type-name (missing-arg) :type symbol :read-only t)
@@ -53,17 +56,20 @@
         (apply #'!make-saetp args))
        `(;; 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 simple-array-nil)
+        (nil #:mu 0 simple-array-nil
+             :complex-typecode #.sb!vm:complex-vector-nil-widetag)
         (base-char ,(code-char 0) 8 simple-base-string
                    ;; (SIMPLE-BASE-STRINGs are stored with an extra
                    ;; trailing #\NULL for convenience in calling out
                    ;; to C.)
-                   :n-pad-elements 1)
+                   :n-pad-elements 1
+                   :complex-typecode #.sb!vm:complex-base-string-widetag)
         (single-float 0.0f0 32 simple-array-single-float)
         (double-float 0.0d0 64 simple-array-double-float)
         #!+long-float
         (long-float 0.0l0 #!+x86 96 #!+sparc 128 simple-array-long-float)
-        (bit 0 1 simple-bit-vector)
+        (bit 0 1 simple-bit-vector
+             :complex-typecode #.sb!vm:complex-bit-vector-widetag)
         ;; KLUDGE: The fact that these UNSIGNED-BYTE entries come
         ;; before their SIGNED-BYTE partners is significant in the
         ;; implementation of the compiler; some of the cross-compiler

diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp
index 3bec6e1..cde035f 100644 (file)
--- a/src/compiler/generic/vm-type.lisp
+++ b/src/compiler/generic/vm-type.lisp
@@ -119,6 +119,7 @@
                ;; them on the fly this way? (Call the new array
                ;; *SPECIALIZED-ARRAY-ELEMENT-SPECIFIER-TYPES* or something..)
                (let ((stype (specifier-type stype-name)))
+                 (aver (not (unknown-type-p stype)))
                  (when (csubtypep eltype stype)
                    (return stype))))))
     type))

diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp
index b44b9ab..a3fcba1 100644 (file)
--- a/src/compiler/meta-vmdef.lisp
+++ b/src/compiler/meta-vmdef.lisp
@@ -275,8 +275,7 @@
 ;;; type descriptor for the Lisp type that is equivalent to this type.
 (defmacro !def-primitive-type (name scs &key (type name))
   (declare (type symbol name) (type list scs))
-  (let ((scns (mapcar #'meta-sc-number-or-lose scs))
-       (ctype-form `(specifier-type ',type)))
+  (let ((scns (mapcar #'meta-sc-number-or-lose scs)))
     `(progn
        (/show0 "doing !DEF-PRIMITIVE-TYPE, NAME=..")
        (/primitive-print ,(symbol-name name))
@@ -284,9 +283,8 @@
         (setf (gethash ',name *backend-meta-primitive-type-names*)
               (make-primitive-type :name ',name
                                    :scs ',scns
-                                   :type ,ctype-form)))
-       ,(once-only ((n-old `(gethash ',name *backend-primitive-type-names*))
-                   (n-type ctype-form))
+                                   :specifier ',type)))
+       ,(once-only ((n-old `(gethash ',name *backend-primitive-type-names*)))
          `(progn
             ;; If the PRIMITIVE-TYPE structure already exists, we
             ;; destructively modify it so that existing references in
@@ -300,13 +298,13 @@
             (cond (,n-old
                    (/show0 "in ,N-OLD clause of COND")
                    (setf (primitive-type-scs ,n-old) ',scns)
-                   (setf (primitive-type-type ,n-old) ,n-type))
+                   (setf (primitive-type-specifier ,n-old) ',type))
                   (t
                    (/show0 "in T clause of COND")
                    (setf (gethash ',name *backend-primitive-type-names*)
                          (make-primitive-type :name ',name
                                               :scs ',scns
-                                              :type ,n-type))))
+                                              :specifier ',type))))
             (/show0 "done with !DEF-PRIMITIVE-TYPE")
             ',name)))))
 

diff --git a/src/compiler/vmdef.lisp b/src/compiler/vmdef.lisp
index 0c4fd38..3b6fb42 100644 (file)
--- a/src/compiler/vmdef.lisp
+++ b/src/compiler/vmdef.lisp
@@ -208,10 +208,7 @@
                    (if (eq x '*)
                        t
                        (ecase (first x)
-                         (:or `(or ,@(mapcar (lambda (type)
-                                               (type-specifier
-                                                (primitive-type-type
-                                                 type)))
+                         (:or `(or ,@(mapcar #'primitive-type-specifier
                                              (rest x))))
                          (:constant `(constant-arg ,(third x)))))))
             `(,@(mapcar #'frob types)

diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp
index 874c362..159900f 100644 (file)
--- a/src/compiler/vop.lisp
+++ b/src/compiler/vop.lisp
@@ -47,7 +47,7 @@
   (scs nil :type list)
   ;; the Lisp type equivalent to this type. If this type could never be
   ;; returned by PRIMITIVE-TYPE, then this is the NIL (or empty) type
-  (type (missing-arg) :type ctype)
+  (specifier (missing-arg) :type type-specifier)
   ;; the template used to check that an object is of this type. This is a
   ;; template of one argument and one result, both of primitive-type T. If
   ;; the argument is of the correct type, then it is delivered into the

diff --git a/version.lisp-expr b/version.lisp-expr
index 7823fa0..96b3b50 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.0.78.vector-nil-string.7"
+"0.8.0.78.vector-nil-string.8"