X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fprimtype.lisp;h=ea2e4b65535707d2acc9947f0e2d0070d68c3e6c;hb=HEAD;hp=6b8a396ce2c271bb4ce03c300d5ca4ab36995d1a;hpb=b387f6ae447b55e203f47fc40af4a36e756fe345;p=sbcl.git diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp index 6b8a396..ea2e4b6 100644 --- a/src/compiler/generic/primtype.lisp +++ b/src/compiler/generic/primtype.lisp @@ -23,28 +23,28 @@ ;;; primitive integer types that fit in registers (/show0 "primtype.lisp 24") (!def-primitive-type positive-fixnum (any-reg signed-reg unsigned-reg) - :type (unsigned-byte 29)) + :type (unsigned-byte #.sb!vm:n-positive-fixnum-bits)) (/show0 "primtype.lisp 27") -#!-alpha +#!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 32) '(and) '(or)) (!def-primitive-type unsigned-byte-31 (signed-reg unsigned-reg descriptor-reg) :type (unsigned-byte 31)) (/show0 "primtype.lisp 31") -#!-alpha +#!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 32) '(and) '(or)) (!def-primitive-type unsigned-byte-32 (unsigned-reg descriptor-reg) :type (unsigned-byte 32)) (/show0 "primtype.lisp 35") -#!+alpha +#!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or)) (!def-primitive-type unsigned-byte-63 (signed-reg unsigned-reg descriptor-reg) :type (unsigned-byte 63)) -#!+alpha +#!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or)) (!def-primitive-type unsigned-byte-64 (unsigned-reg descriptor-reg) :type (unsigned-byte 64)) (!def-primitive-type fixnum (any-reg signed-reg) - :type (signed-byte 30)) -#!-alpha + :type (signed-byte #.(1+ sb!vm:n-positive-fixnum-bits))) +#!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 32) '(and) '(or)) (!def-primitive-type signed-byte-32 (signed-reg descriptor-reg) :type (signed-byte 32)) -#!+alpha +#!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or)) (!def-primitive-type signed-byte-64 (signed-reg descriptor-reg) :type (signed-byte 64)) @@ -52,21 +52,23 @@ (/show0 "primtype.lisp 53") (!def-primitive-type-alias tagged-num (:or positive-fixnum fixnum)) -(!def-primitive-type-alias unsigned-num (:or #!-alpha unsigned-byte-32 - #!-alpha unsigned-byte-31 - #!+alpha unsigned-byte-64 - #!+alpha unsigned-byte-63 - positive-fixnum)) -(!def-primitive-type-alias signed-num (:or #!-alpha signed-byte-32 - #!+alpha signed-byte-64 - fixnum - #!-alpha unsigned-byte-31 - #!+alpha unsigned-byte-63 - positive-fixnum)) +(progn + (!def-primitive-type-alias unsigned-num #1= + #!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or)) + (:or unsigned-byte-64 unsigned-byte-63 positive-fixnum) + #!-#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or)) + (:or unsigned-byte-32 unsigned-byte-31 positive-fixnum)) + (!def-primitive-type-alias signed-num #2= + #!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or)) + (:or signed-byte-64 fixnum unsigned-byte-63 positive-fixnum) + #!-#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or)) + (:or signed-byte-32 fixnum unsigned-byte-31 positive-fixnum)) + (!def-primitive-type-alias untagged-num + (:or . #.(sort (copy-list (union (cdr '#1#) (cdr '#2#))) #'string<)))) ;;; other primitive immediate types (/show0 "primtype.lisp 68") -(!def-primitive-type base-char (base-char-reg any-reg)) +(!def-primitive-type character (character-reg any-reg)) ;;; primitive pointer types (/show0 "primtype.lisp 73") @@ -86,59 +88,36 @@ (!def-primitive-type single-float (single-reg descriptor-reg)) (/show0 "about to !DEF-PRIMITIVE-TYPE DOUBLE-FLOAT") (!def-primitive-type double-float (double-reg descriptor-reg)) -#!+long-float -(!def-primitive-type long-float (long-reg descriptor-reg)) + (/show0 "about to !DEF-PRIMITIVE-TYPE COMPLEX-SINGLE-FLOAT") (!def-primitive-type complex-single-float (complex-single-reg descriptor-reg) :type (complex single-float)) (/show0 "about to !DEF-PRIMITIVE-TYPE COMPLEX-DOUBLE-FLOAT") (!def-primitive-type complex-double-float (complex-double-reg descriptor-reg) :type (complex double-float)) -#!+long-float -(!def-primitive-type complex-long-float (complex-long-reg descriptor-reg) - :type (complex long-float)) +#!+sb-simd-pack +(progn + (/show0 "about to !DEF-PRIMITIVE-TYPE SIMD-PACK") + (!def-primitive-type simd-pack-single (single-sse-reg descriptor-reg) + :type (simd-pack single-float)) + (!def-primitive-type simd-pack-double (double-sse-reg descriptor-reg) + :type (simd-pack double-float)) + (!def-primitive-type simd-pack-int (int-sse-reg descriptor-reg) + :type (simd-pack integer)) + (!def-primitive-type-alias simd-pack (:or simd-pack-single simd-pack-double simd-pack-int))) ;;; primitive other-pointer array types (/show0 "primtype.lisp 96") -(!def-primitive-type simple-array-nil (descriptor-reg) - :type (simple-array nil (*))) -(!def-primitive-type simple-string (descriptor-reg) - :type simple-base-string) -(!def-primitive-type simple-bit-vector (descriptor-reg)) -(!def-primitive-type simple-vector (descriptor-reg)) -(!def-primitive-type simple-array-unsigned-byte-2 (descriptor-reg) - :type (simple-array (unsigned-byte 2) (*))) -(!def-primitive-type simple-array-unsigned-byte-4 (descriptor-reg) - :type (simple-array (unsigned-byte 4) (*))) -(!def-primitive-type simple-array-unsigned-byte-8 (descriptor-reg) - :type (simple-array (unsigned-byte 8) (*))) -(!def-primitive-type simple-array-unsigned-byte-16 (descriptor-reg) - :type (simple-array (unsigned-byte 16) (*))) -(!def-primitive-type simple-array-unsigned-byte-32 (descriptor-reg) - :type (simple-array (unsigned-byte 32) (*))) -(!def-primitive-type simple-array-signed-byte-8 (descriptor-reg) - :type (simple-array (signed-byte 8) (*))) -(!def-primitive-type simple-array-signed-byte-16 (descriptor-reg) - :type (simple-array (signed-byte 16) (*))) -(!def-primitive-type simple-array-signed-byte-30 (descriptor-reg) - :type (simple-array (signed-byte 30) (*))) -(!def-primitive-type simple-array-signed-byte-32 (descriptor-reg) - :type (simple-array (signed-byte 32) (*))) -(!def-primitive-type simple-array-single-float (descriptor-reg) - :type (simple-array single-float (*))) -(!def-primitive-type simple-array-double-float (descriptor-reg) - :type (simple-array double-float (*))) -#!+long-float -(!def-primitive-type simple-array-long-float (descriptor-reg) - :type (simple-array long-float (*))) -(!def-primitive-type simple-array-complex-single-float (descriptor-reg) - :type (simple-array (complex single-float) (*))) -(!def-primitive-type simple-array-complex-double-float (descriptor-reg) - :type (simple-array (complex double-float) (*))) -#!+long-float -(!def-primitive-type simple-array-complex-long-float (descriptor-reg) - :type (simple-array (complex long-float) (*))) - +(macrolet ((define-simple-array-primitive-types () + `(progn + ,@(map 'list + (lambda (saetp) + `(!def-primitive-type + ,(saetp-primitive-type-name saetp) + (descriptor-reg) + :type (simple-array ,(saetp-specifier saetp) (*)))) + *specialized-array-element-type-properties*)))) + (define-simple-array-primitive-types)) ;;; Note: The complex array types are not included, 'cause it is ;;; pointless to restrict VOPs to them. @@ -153,38 +132,14 @@ ;;; Return the most restrictive primitive type that contains OBJECT. (/show0 "primtype.lisp 147") -(!def-vm-support-routine primitive-type-of (object) +(defun primitive-type-of (object) (let ((type (ctype-of object))) (cond ((not (member-type-p type)) (primitive-type type)) - ((equal (member-type-members type) '(nil)) - (primitive-type-or-lose 'list)) - (t - *backend-t-primitive-type*)))) - -(defvar *simple-array-primitive-types* - '((nil . simple-array-nil) - (base-char . simple-string) - (bit . simple-bit-vector) - ((unsigned-byte 2) . simple-array-unsigned-byte-2) - ((unsigned-byte 4) . simple-array-unsigned-byte-4) - ((unsigned-byte 8) . simple-array-unsigned-byte-8) - ((unsigned-byte 16) . simple-array-unsigned-byte-16) - ((unsigned-byte 32) . simple-array-unsigned-byte-32) - ((signed-byte 8) . simple-array-signed-byte-8) - ((signed-byte 16) . simple-array-signed-byte-16) - (fixnum . simple-array-signed-byte-30) - ((signed-byte 32) . simple-array-signed-byte-32) - (single-float . simple-array-single-float) - (double-float . simple-array-double-float) - #!+long-float (long-float . simple-array-long-float) - ((complex single-float) . simple-array-complex-single-float) - ((complex double-float) . simple-array-complex-double-float) - #!+long-float - ((complex long-float) . simple-array-complex-long-float) - (t . simple-vector)) - #!+sb-doc - "An a-list for mapping simple array element types to their - corresponding primitive types.") + ((and (eql 1 (member-type-size type)) + (equal (member-type-members type) '(nil))) + (primitive-type-or-lose 'list)) + (t + *backend-t-primitive-type*)))) ;;; Return the primitive type corresponding to a type descriptor ;;; structure. The second value is true when the primitive type is @@ -196,198 +151,266 @@ ;;; We need an aux function because we need to use both ;;; !DEF-VM-SUPPORT-ROUTINE and DEFUN-CACHED. (/show0 "primtype.lisp 188") -(!def-vm-support-routine primitive-type (type) +(defun primitive-type (type) + (sb!kernel::maybe-reparse-specifier! type) (primitive-type-aux type)) (/show0 "primtype.lisp 191") (defun-cached (primitive-type-aux - :hash-function (lambda (x) - (logand (type-hash-value x) #x1FF)) - :hash-bits 9 - :values 2 - :default (values nil :empty)) - ((type eq)) + :hash-function (lambda (x) + (logand (type-hash-value x) #x1FF)) + :hash-bits 9 + :values 2 + :default (values nil :empty)) + ((type eq)) (declare (type ctype type)) (macrolet ((any () '(values *backend-t-primitive-type* nil)) - (exactly (type) - `(values (primitive-type-or-lose ',type) t)) - (part-of (type) - `(values (primitive-type-or-lose ',type) nil))) + (exactly (type) + `(values (primitive-type-or-lose ',type) t)) + (part-of (type) + `(values (primitive-type-or-lose ',type) nil))) (flet ((maybe-numeric-type-union (t1 t2) - (let ((t1-name (primitive-type-name t1)) - (t2-name (primitive-type-name t2))) - (case t1-name - (positive-fixnum - (if (or (eq t2-name 'fixnum) - (eq t2-name #!-alpha 'signed-byte-32 - #!+alpha 'signed-byte-64) - (eq t2-name #!-alpha 'unsigned-byte-31 - #!+alpha 'unsigned-byte-63) - (eq t2-name #!-alpha 'unsigned-byte-32 - #!+alpha 'unsigned-byte-64)) - t2)) - (fixnum - (case t2-name - (#!-alpha signed-byte-32 - #!+alpha signed-byte-64 t2) - (#!-alpha unsigned-byte-31 - #!+alpha unsigned-byte-63 - (primitive-type-or-lose - #!-alpha 'signed-byte-32 - #!+alpha 'signed-byte-64)))) - (#!-alpha signed-byte-32 - #!+alpha signed-byte-64 - (if (eq t2-name #!-alpha 'unsigned-byte-31 - #!+alpha 'unsigned-byte-63) - t1)) - (#!-alpha unsigned-byte-31 - #!+alpha unsigned-byte-63 - (if (eq t2-name #!-alpha 'unsigned-byte-32 - #!+alpha 'unsigned-byte-64) - t2)))))) + (let ((t1-name (primitive-type-name t1)) + (t2-name (primitive-type-name t2))) + (case t1-name + (positive-fixnum + (if (or (eq t2-name 'fixnum) + (eq t2-name + (ecase sb!vm::n-machine-word-bits + (32 'signed-byte-32) + (64 'signed-byte-64))) + (eq t2-name + (ecase sb!vm::n-machine-word-bits + (32 'unsigned-byte-31) + (64 'unsigned-byte-63))) + (eq t2-name + (ecase sb!vm::n-machine-word-bits + (32 'unsigned-byte-32) + (64 'unsigned-byte-64)))) + t2)) + (fixnum + (case t2-name + (#.(ecase sb!vm::n-machine-word-bits + (32 'signed-byte-32) + (64 'signed-byte-64)) + t2) + (#.(ecase sb!vm::n-machine-word-bits + (32 'unsigned-byte-31) + (64 'unsigned-byte-63)) + (primitive-type-or-lose + (ecase sb!vm::n-machine-word-bits + (32 'signed-byte-32) + (64 'signed-byte-64)))))) + (#.(ecase sb!vm::n-machine-word-bits + (32 'signed-byte-32) + (64 'signed-byte-64)) + (if (eq t2-name + (ecase sb!vm::n-machine-word-bits + (32 'unsigned-byte-31) + (64 'unsigned-byte-63))) + t1)) + (#.(ecase sb!vm::n-machine-word-bits + (32 'unsigned-byte-31) + (64 'unsigned-byte-63)) + (if (eq t2-name + (ecase sb!vm::n-machine-word-bits + (32 'unsigned-byte-32) + (64 'unsigned-byte-64))) + t2)))))) (etypecase type - (numeric-type - (let ((lo (numeric-type-low type)) - (hi (numeric-type-high type))) - (case (numeric-type-complexp type) - (:real - (case (numeric-type-class type) - (integer - (cond ((and hi lo) - (dolist (spec - `((positive-fixnum 0 ,(1- (ash 1 29))) - #!-alpha - (unsigned-byte-31 0 ,(1- (ash 1 31))) - #!-alpha - (unsigned-byte-32 0 ,(1- (ash 1 32))) - #!+alpha - (unsigned-byte-63 0 ,(1- (ash 1 63))) - #!+alpha - (unsigned-byte-64 0 ,(1- (ash 1 64))) - (fixnum ,(ash -1 29) - ,(1- (ash 1 29))) - #!-alpha - (signed-byte-32 ,(ash -1 31) - ,(1- (ash 1 31))) - #!+alpha - (signed-byte-64 ,(ash -1 63) - ,(1- (ash 1 63)))) - (if (or (< hi (ash -1 29)) - (> lo (1- (ash 1 29)))) - (part-of bignum) - (any))) - (let ((type (car spec)) - (min (cadr spec)) - (max (caddr spec))) - (when (<= min lo hi max) - (return (values - (primitive-type-or-lose type) - (and (= lo min) (= hi max)))))))) - ((or (and hi (< hi most-negative-fixnum)) - (and lo (> lo most-positive-fixnum))) - (part-of bignum)) - (t - (any)))) - (float - (let ((exact (and (null lo) (null hi)))) - (case (numeric-type-format type) - ((short-float single-float) - (values (primitive-type-or-lose 'single-float) - exact)) - ((double-float #!-long-float long-float) - (values (primitive-type-or-lose 'double-float) - exact)) - #!+long-float - (long-float - (values (primitive-type-or-lose 'long-float) - exact)) - (t - (any))))) - (t - (any)))) - (:complex - (if (eq (numeric-type-class type) 'float) - (let ((exact (and (null lo) (null hi)))) - (case (numeric-type-format type) - ((short-float single-float) - (values (primitive-type-or-lose 'complex-single-float) - exact)) - ((double-float #!-long-float long-float) - (values (primitive-type-or-lose 'complex-double-float) - exact)) - #!+long-float - (long-float - (values (primitive-type-or-lose 'complex-long-float) - exact)) - (t - (part-of complex)))) - (part-of complex))) - (t - (any))))) - (array-type - (if (array-type-complexp type) - (any) - (let* ((dims (array-type-dimensions type)) - (etype (array-type-specialized-element-type type)) - (type-spec (type-specifier etype)) - (ptype (cdr (assoc type-spec *simple-array-primitive-types* - :test #'equal)))) - (if (and (consp dims) (null (rest dims)) ptype) - (values (primitive-type-or-lose ptype) - (eq (first dims) '*)) - (any))))) - (union-type - (if (type= type (specifier-type 'list)) - (exactly list) - (let ((types (union-type-types type))) - (multiple-value-bind (res exact) (primitive-type (first types)) - (dolist (type (rest types) (values res exact)) - (multiple-value-bind (ptype ptype-exact) - (primitive-type type) - (unless ptype-exact (setq exact nil)) - (unless (eq ptype res) - (let ((new-ptype - (or (maybe-numeric-type-union res ptype) - (maybe-numeric-type-union ptype res)))) - (if new-ptype - (setq res new-ptype) - (return (any))))))))))) - (member-type - (let* ((members (member-type-members type)) - (res (primitive-type-of (first members)))) - (dolist (mem (rest members) (values res nil)) - (let ((ptype (primitive-type-of mem))) - (unless (eq ptype res) - (let ((new-ptype (or (maybe-numeric-type-union res ptype) - (maybe-numeric-type-union ptype res)))) - (if new-ptype - (setq res new-ptype) - (return (any))))))))) - (named-type - (ecase (named-type-name type) - ((t *) (values *backend-t-primitive-type* t)) - ((nil) (any)))) - (built-in-classoid - (case (classoid-name type) - ((complex function instance - system-area-pointer weak-pointer) - (values (primitive-type-or-lose (classoid-name type)) t)) - (funcallable-instance - (part-of function)) - (base-char - (exactly base-char)) - (cons-type - (part-of list)) - (t - (any)))) - (fun-type - (exactly function)) - (classoid - (if (csubtypep type (specifier-type 'function)) - (part-of function) - (part-of instance))) - (ctype + (numeric-type + (let ((lo (numeric-type-low type)) + (hi (numeric-type-high type))) + (case (numeric-type-complexp type) + (:real + (case (numeric-type-class type) + (integer + (cond ((and hi lo) + (dolist (spec + `((positive-fixnum 0 ,sb!xc:most-positive-fixnum) + ,@(ecase sb!vm::n-machine-word-bits + (32 + `((unsigned-byte-31 + 0 ,(1- (ash 1 31))) + (unsigned-byte-32 + 0 ,(1- (ash 1 32))))) + (64 + `((unsigned-byte-63 + 0 ,(1- (ash 1 63))) + (unsigned-byte-64 + 0 ,(1- (ash 1 64)))))) + (fixnum ,sb!xc:most-negative-fixnum + ,sb!xc:most-positive-fixnum) + ,(ecase sb!vm::n-machine-word-bits + (32 + `(signed-byte-32 ,(ash -1 31) + ,(1- (ash 1 31)))) + (64 + `(signed-byte-64 ,(ash -1 63) + ,(1- (ash 1 63)))))) + (if (or (< hi sb!xc:most-negative-fixnum) + (> lo sb!xc:most-positive-fixnum)) + (part-of bignum) + (any))) + (let ((type (car spec)) + (min (cadr spec)) + (max (caddr spec))) + (when (<= min lo hi max) + (return (values + (primitive-type-or-lose type) + (and (= lo min) (= hi max)))))))) + ((or (and hi (< hi sb!xc:most-negative-fixnum)) + (and lo (> lo sb!xc:most-positive-fixnum))) + (part-of bignum)) + (t + (any)))) + (float + (let ((exact (and (null lo) (null hi)))) + (case (numeric-type-format type) + ((short-float single-float) + (values (primitive-type-or-lose 'single-float) + exact)) + ((double-float) + (values (primitive-type-or-lose 'double-float) + exact)) + (t + (any))))) + (t + (any)))) + (:complex + (if (eq (numeric-type-class type) 'float) + (let ((exact (and (null lo) (null hi)))) + (case (numeric-type-format type) + ((short-float single-float) + (values (primitive-type-or-lose 'complex-single-float) + exact)) + ((double-float long-float) + (values (primitive-type-or-lose 'complex-double-float) + exact)) + (t + (part-of complex)))) + (part-of complex))) + (t + (any))))) + (array-type + (if (array-type-complexp type) + (any) + (let* ((dims (array-type-dimensions type)) + (etype (array-type-specialized-element-type type)) + (type-spec (type-specifier etype)) + ;; FIXME: We're _WHAT_? Testing for type equality + ;; with a specifier and #'EQUAL? *BOGGLE*. -- + ;; CSR, 2003-06-24 + (ptype (cdr (assoc type-spec *simple-array-primitive-types* + :test #'equal)))) + (if (and (consp dims) (null (rest dims)) ptype) + (values (primitive-type-or-lose ptype) + (eq (first dims) '*)) + (any))))) + (union-type + (if (type= type (specifier-type 'list)) + (exactly list) + (let ((types (union-type-types type))) + (multiple-value-bind (res exact) (primitive-type (first types)) + (dolist (type (rest types) (values res exact)) + (multiple-value-bind (ptype ptype-exact) + (primitive-type type) + (unless ptype-exact (setq exact nil)) + (unless (eq ptype res) + (let ((new-ptype + (or (maybe-numeric-type-union res ptype) + (maybe-numeric-type-union ptype res)))) + (if new-ptype + (setq res new-ptype) + (return (any))))))))))) + (intersection-type + (let ((types (intersection-type-types type)) + (res (any))) + ;; why NIL for the exact? Well, we assume that the + ;; intersection type is in fact doing something for us: + ;; that is, that each of the types in the intersection is + ;; in fact cutting off some of the type lattice. Since no + ;; intersection type is represented by a primitive type and + ;; primitive types are mutually exclusive, it follows that + ;; no intersection type can represent the entirety of the + ;; primitive type. (And NIL is the conservative answer, + ;; anyway). -- CSR, 2006-09-14 + (dolist (type types (values res nil)) + (multiple-value-bind (ptype) + (primitive-type type) + (cond + ;; if the result so far is (any), any improvement on + ;; the specificity of the primitive type is valid. + ((eq res (any)) + (setq res ptype)) + ;; if the primitive type returned is (any), the + ;; result so far is valid. Likewise, if the + ;; primitive type is the same as the result so far, + ;; everything is fine. + ((or (eq ptype (any)) (eq ptype res))) + ;; otherwise, we have something hairy and confusing, + ;; such as (and condition funcallable-instance). + ;; Punt. + (t (return (any)))))))) + (member-type + (let (res) + (block nil + (mapc-member-type-members + (lambda (member) + (let ((ptype (primitive-type-of member))) + (if res + (unless (eq ptype res) + (let ((new-ptype (or (maybe-numeric-type-union res ptype) + (maybe-numeric-type-union ptype res)))) + (if new-ptype + (setq res new-ptype) + (return (any))))) + (setf res ptype)))) + type) + res))) + (named-type + (ecase (named-type-name type) + ((t *) (values *backend-t-primitive-type* t)) + ((instance) (exactly instance)) + ((funcallable-instance) (part-of function)) + ((extended-sequence) (any)) + ((nil) (any)))) + (character-set-type + (let ((pairs (character-set-type-pairs type))) + (if (and (= (length pairs) 1) + (= (caar pairs) 0) + (= (cdar pairs) (1- sb!xc:char-code-limit))) + (exactly character) + (part-of character)))) + #!+sb-simd-pack + (simd-pack-type + (let ((eltypes (simd-pack-type-element-type type))) + (cond ((member 'integer eltypes) + (exactly simd-pack-int)) + ((member 'single-float eltypes) + (exactly simd-pack-single)) + ((member 'double-float eltypes) + (exactly simd-pack-double))))) + (built-in-classoid + (case (classoid-name type) + #!+sb-simd-pack + ;; Can't tell what specific type; assume integers. + (simd-pack + (exactly simd-pack-int)) + ((complex function system-area-pointer weak-pointer) + (values (primitive-type-or-lose (classoid-name type)) t)) + (cons-type + (part-of list)) + (t + (any)))) + (fun-type + (exactly function)) + (classoid + (if (csubtypep type (specifier-type 'function)) + (part-of function) + (part-of instance))) + (ctype (if (csubtypep type (specifier-type 'function)) - (part-of function) + (part-of function) (any))))))) (/show0 "primtype.lisp end of file")