X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdeftypes-for-target.lisp;h=aa62b9916386c34bdffffeb67b684f91ce358a5f;hb=HEAD;hp=ed97565ebee64ad2565883fe1728b7996e33cbe3;hpb=771b864c8f32af7734bc0550aeaf1539fc4df194;p=sbcl.git diff --git a/src/code/deftypes-for-target.lisp b/src/code/deftypes-for-target.lisp index ed97565..aa62b99 100644 --- a/src/code/deftypes-for-target.lisp +++ b/src/code/deftypes-for-target.lisp @@ -33,18 +33,18 @@ (sb!xc:deftype signed-byte (&optional s) (cond ((eq s '*) 'integer) - ((and (integerp s) (> s 0)) - (let ((bound (ash 1 (1- s)))) - `(integer ,(- bound) ,(1- bound)))) - (t - (error "bad size specified for SIGNED-BYTE type specifier: ~S" s)))) + ((and (integerp s) (> s 0)) + (let ((bound (ash 1 (1- s)))) + `(integer ,(- bound) ,(1- bound)))) + (t + (error "bad size specified for SIGNED-BYTE type specifier: ~S" s)))) (sb!xc:deftype unsigned-byte (&optional s) (cond ((eq s '*) '(integer 0)) - ((and (integerp s) (> s 0)) - `(integer 0 ,(1- (ash 1 s)))) - (t - (error "bad size specified for UNSIGNED-BYTE type specifier: ~S" s)))) + ((and (integerp s) (> s 0)) + `(integer 0 ,(1- (ash 1 s)))) + (t + (error "bad size specified for UNSIGNED-BYTE type specifier: ~S" s)))) ;;; ANSI got UNSIGNED-BYTE wrong, prohibiting (UNSIGNED-BYTE 0). ;;; Since this is actually a substantial impediment to clarity... @@ -56,10 +56,11 @@ (sb!xc:deftype bit () '(integer 0 1)) -(sb!xc:deftype compiled-function () 'function) - (sb!xc:deftype atom () '(not cons)) +(sb!xc:deftype base-char () + '(character-set ((0 . #.(1- base-char-code-limit))))) + (sb!xc:deftype extended-char () #!+sb-doc "Type of CHARACTERs that aren't BASE-CHARs." @@ -153,7 +154,8 @@ (sb!xc:deftype char-code () `(integer 0 (,sb!xc:char-code-limit))) ;;; a consed sequence result. If a vector, is a simple array. -(sb!xc:deftype consed-sequence () '(or list (simple-array * (*)))) +(sb!xc:deftype consed-sequence () + '(or (simple-array * (*)) list extended-sequence)) ;;; the :END arg to a sequence (sb!xc:deftype sequence-end () '(or null index)) @@ -165,6 +167,11 @@ ;;; a valid argument to a stream function (sb!xc:deftype stream-designator () '(or stream (member nil t))) +;;; something valid as the :EXTERNAL-FORMAT argument to OPEN, LOAD, +;;; COMPILE-FILE and friends. +(sb!xc:deftype external-format-designator () + '(or keyword (cons keyword))) + ;;; an object suitable for input to standard functions that accept ;;; "environment objects" (of the ANSI glossary) (sb!xc:deftype lexenv-designator () '(or lexenv null)) @@ -177,28 +184,28 @@ ;;; decomposing floats into integers (sb!xc:deftype single-float-exponent () `(integer ,(- sb!vm:single-float-normal-exponent-min - sb!vm:single-float-bias - sb!vm:single-float-digits) - ,(- sb!vm:single-float-normal-exponent-max - sb!vm:single-float-bias))) + sb!vm:single-float-bias + sb!vm:single-float-digits) + ,(- sb!vm:single-float-normal-exponent-max + sb!vm:single-float-bias))) (sb!xc:deftype double-float-exponent () `(integer ,(- sb!vm:double-float-normal-exponent-min - sb!vm:double-float-bias - sb!vm:double-float-digits) - ,(- sb!vm:double-float-normal-exponent-max - sb!vm:double-float-bias))) + sb!vm:double-float-bias + sb!vm:double-float-digits) + ,(- sb!vm:double-float-normal-exponent-max + sb!vm:double-float-bias))) (sb!xc:deftype single-float-int-exponent () `(integer ,(- sb!vm:single-float-normal-exponent-min - sb!vm:single-float-bias - (* sb!vm:single-float-digits 2)) - ,(- sb!vm:single-float-normal-exponent-max - sb!vm:single-float-bias - sb!vm:single-float-digits))) + sb!vm:single-float-bias + (* sb!vm:single-float-digits 2)) + ,(- sb!vm:single-float-normal-exponent-max + sb!vm:single-float-bias + sb!vm:single-float-digits))) (sb!xc:deftype double-float-int-exponent () `(integer ,(- sb!vm:double-float-normal-exponent-min sb!vm:double-float-bias - (* sb!vm:double-float-digits 2)) - ,(- sb!vm:double-float-normal-exponent-max sb!vm:double-float-bias - sb!vm:double-float-digits))) + (* sb!vm:double-float-digits 2)) + ,(- sb!vm:double-float-normal-exponent-max sb!vm:double-float-bias + sb!vm:double-float-digits))) (sb!xc:deftype single-float-significand () `(integer 0 (,(ash 1 sb!vm:single-float-digits)))) (sb!xc:deftype double-float-significand ()