From: Christophe Rhodes Date: Thu, 26 Jun 2003 09:07:11 +0000 (+0000) Subject: 0.8.0.78.vector-nil-string.12: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=d501bef3a93da4f14f1e85b852c2e01ee1df2907;p=sbcl.git 0.8.0.78.vector-nil-string.12: Use *SAETP* to generate the data for internal error definition (net win so far: 13) --- diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index d829f26..e5627f0 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -2010,7 +2010,7 @@ structure representations" "REGISTER-SAVE-PENALTY" "RETURN-PC-HEADER-WIDETAG" "RETURN-PC-RETURN-POINT-OFFSET" "RETURN-PC-SAVE-OFFSET" "SAETP-CTYPE" "SAETP-INITIAL-ELEMENT-DEFAULT" - "SAETP-N-BITS" "SAETP-TYPECODE" "SAETP-PRIMTYPE" + "SAETP-N-BITS" "SAETP-TYPECODE" "SAETP-PRIMITIVE-TYPE-NAME" "SAETP-N-PAD-ELEMENTS" "SAETP-SPECIFIER" "SAETP-COMPLEX-TYPECODE" "SAETP-IMPORTANCE" "*SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*" diff --git a/src/code/interr.lisp b/src/code/interr.lisp index 0f878d9..41247c1 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -103,21 +103,6 @@ :datum object :expected-type 'simple-string)) -(deferr object-not-simple-base-string-error (object) - (error 'type-error - :datum object - :expected-type 'simple-base-string)) - -(deferr object-not-simple-bit-vector-error (object) - (error 'type-error - :datum object - :expected-type 'simple-bit-vector)) - -(deferr object-not-simple-vector-error (object) - (error 'type-error - :datum object - :expected-type 'simple-vector)) - (deferr object-not-fixnum-error (object) (error 'type-error :datum object @@ -286,81 +271,23 @@ :datum object :expected-type '(unsigned-byte 32))) -(deferr object-not-simple-array-nil-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array nil (*)))) - -(deferr object-not-simple-array-unsigned-byte-2-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array (unsigned-byte 2) (*)))) - -(deferr object-not-simple-array-unsigned-byte-4-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array (unsigned-byte 4) (*)))) - -(deferr object-not-simple-array-unsigned-byte-8-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array (unsigned-byte 8) (*)))) - -(deferr object-not-simple-array-unsigned-byte-16-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array (unsigned-byte 16) (*)))) - -(deferr object-not-simple-array-unsigned-byte-32-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array (unsigned-byte 32) (*)))) - -(deferr object-not-simple-array-signed-byte-8-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array (signed-byte 8) (*)))) - -(deferr object-not-simple-array-signed-byte-16-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array (signed-byte 16) (*)))) - -(deferr object-not-simple-array-signed-byte-30-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array (signed-byte 30) (*)))) - -(deferr object-not-simple-array-signed-byte-32-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array (signed-byte 32) (*)))) - -(deferr object-not-simple-array-single-float-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array single-float (*)))) - -(deferr object-not-simple-array-double-float-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array double-float (*)))) - -(deferr object-not-simple-array-complex-single-float-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array (complex single-float) (*)))) - -(deferr object-not-simple-array-complex-double-float-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array (complex double-float) (*)))) - -#!+long-float -(deferr object-not-simple-array-complex-long-float-error (object) - (error 'type-error - :datum object - :expected-type '(simple-array (complex long-float) (*)))) +(macrolet + ((define-simple-array-internal-errors () + `(progn + ,@(map 'list + (lambda (saetp) + `(deferr ,(symbolicate + "OBJECT-NOT-" + (sb!vm:saetp-primitive-type-name saetp) + "-ERROR") + (object) + (error 'type-error + :datum object + :expected-type `(simple-array + ,(sb!vm:saetp-specifier saetp) + (*))))) + sb!vm:*specialized-array-element-type-properties*)))) + (define-simple-array-internal-errors)) (deferr object-not-complex-error (object) (error 'type-error diff --git a/src/compiler/generic/interr.lisp b/src/compiler/generic/interr.lisp index 1a96e19..43feea6 100644 --- a/src/compiler/generic/interr.lisp +++ b/src/compiler/generic/interr.lisp @@ -25,14 +25,8 @@ (eval-when (:compile-toplevel :execute) (def!macro define-internal-errors (&rest errors) (let ((info (mapcar (lambda (x) - ;; FIXME: We shouldn't need placeholder - ;; NIL entries any more now that we - ;; pass our magic numbers cleanly - ;; through sbcl.h. - (if x - (cons (symbolicate (first x) "-ERROR") - (second x)) - '(nil . "unused"))) + (cons (symbolicate (first x) "-ERROR") + (second x))) errors))) `(progn (setf sb!c:*backend-internal-errors* @@ -59,12 +53,6 @@ "Object is not of type LONG-FLOAT.") (object-not-simple-string "Object is not of type SIMPLE-STRING.") - (object-not-simple-base-string - "Object is not of type SIMPLE-BASE-STRING.") - (object-not-simple-bit-vector - "Object is not of type SIMPLE-BIT-VECTOR.") - (object-not-simple-vector - "Object is not of type SIMPLE-VECTOR.") (object-not-fixnum "Object is not of type FIXNUM.") (object-not-vector @@ -125,40 +113,6 @@ "Object is not of type (SIGNED-BYTE 32).") (object-not-unsigned-byte-32 "Object is not of type (UNSIGNED-BYTE 32).") - (object-not-simple-array-nil - "Object is not of type (SIMPLE-ARRAY NIL (*)).") - (object-not-simple-array-unsigned-byte-2 - "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 2) (*)).") - (object-not-simple-array-unsigned-byte-4 - "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 4) (*)).") - (object-not-simple-array-unsigned-byte-8 - "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)).") - (object-not-simple-array-unsigned-byte-16 - "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 16) (*)).") - (object-not-simple-array-unsigned-byte-32 - "Object is not of type (SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*)).") - (object-not-simple-array-signed-byte-8 - "Object is not of type (SIMPLE-ARRAY (SIGNED-BYTE 8) (*)).") - (object-not-simple-array-signed-byte-16 - "Object is not of type (SIMPLE-ARRAY (SIGNED-BYTE 16) (*)).") - (object-not-simple-array-signed-byte-30 - "Object is not of type (SIMPLE-ARRAY FIXNUM (*)).") - (object-not-simple-array-signed-byte-32 - "Object is not of type (SIMPLE-ARRAY (SIGNED-BYTE 32) (*)).") - (object-not-simple-array-single-float - "Object is not of type (SIMPLE-ARRAY SINGLE-FLOAT (*)).") - (object-not-simple-array-double-float - "Object is not of type (SIMPLE-ARRAY DOUBLE-FLOAT (*)).") - #!+long-float - (object-not-simple-array-long-float - "Object is not of type (SIMPLE-ARRAY LONG-FLOAT (*)).") - (object-not-simple-array-complex-single-float - "Object is not of type (SIMPLE-ARRAY (COMPLEX SINGLE-FLOAT) (*)).") - (object-not-simple-array-complex-double-float - "Object is not of type (SIMPLE-ARRAY (COMPLEX DOUBLE-FLOAT) (*)).") - #!+long-float - (object-not-simple-array-complex-long-float - "Object is not of type (SIMPLE-ARRAY (COMPLEX LONG-FLOAT) (*)).") (object-not-complex "Object is not of type COMPLEX.") (object-not-complex-rational @@ -185,4 +139,14 @@ (layout-invalid "Object layout is invalid. (indicates obsolete instance)") (object-not-complex-vector - "Object is not a complex (non-SIMPLE-ARRAY) vector.")) + "Object is not a complex (non-SIMPLE-ARRAY) vector.") + . + #.(map 'list + (lambda (saetp) + (list + (symbolicate "OBJECT-NOT-" (sb!vm:saetp-primitive-type-name saetp)) + (format nil "Object is not of type ~A." + (specifier-type + `(simple-array ,(sb!vm:saetp-specifier saetp) (*)))))) + sb!vm:*specialized-array-element-type-properties*)) + diff --git a/version.lisp-expr b/version.lisp-expr index 98b5e9a..cf19729 100644 --- 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.11" +"0.8.0.78.vector-nil-string.12"