X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdeftypes-for-target.lisp;h=aa62b9916386c34bdffffeb67b684f91ce358a5f;hb=82cd148d729c241e79c8df04b700beec1b7c55de;hp=9efcd3677ecb7edfb9c29d6ee5417d290aa194c7;hpb=397b000303e15df61661d9726126ee99ee10d9c6;p=sbcl.git diff --git a/src/code/deftypes-for-target.lisp b/src/code/deftypes-for-target.lisp index 9efcd36..aa62b99 100644 --- a/src/code/deftypes-for-target.lisp +++ b/src/code/deftypes-for-target.lisp @@ -33,37 +33,46 @@ (sb!xc:deftype signed-byte (&optional s) (cond ((eq s '*) 'integer) - ((and (integerp s) (> s 1)) - (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... +(sb!xc:deftype unsigned-byte* (&optional s) + (cond + ((eq s '*) '(integer 0)) + ((zerop s) '(integer 0 0)) + (t `(unsigned-byte ,s)))) (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-char's. None in CMU CL." + "Type of CHARACTERs that aren't BASE-CHARs." '(and character (not base-char))) (sb!xc:deftype standard-char () #!+sb-doc "Type corresponding to the characters required by the standard." '(member - #\NEWLINE #\SPACE #\! #\" #\# #\$ #\% #\& #\' #\( #\) #\* #\+ #\, + #\Newline #\Space #\! #\" #\# #\$ #\% #\& #\' #\( #\) #\* #\+ #\, #\- #\. #\/ #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\: #\; #\< #\= - #\> #\? #\@ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M + #\> #\? #\@ #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z #\[ #\\ #\] #\^ #\_ #\` #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z #\{ @@ -87,10 +96,12 @@ `(simple-array base-char (,size))) (sb!xc:deftype string (&optional size) `(or (array character (,size)) - (base-string ,size))) + (array nil (,size)) + (base-string ,size))) (sb!xc:deftype simple-string (&optional size) `(or (simple-array character (,size)) - (simple-base-string ,size))) + (simple-array nil (,size)) + (simple-base-string ,size))) (sb!xc:deftype bit-vector (&optional size) `(array bit (,size))) @@ -101,8 +112,14 @@ ;;;; some private types that we use in defining the standard functions, ;;;; or implementing declarations in standard compiler transforms -;;; a type specifier -(sb!xc:deftype type-specifier () '(or list symbol sb!xc:class)) +;;; semistandard types +(sb!xc:deftype generalized-boolean () t) + +(sb!xc:deftype format-control () + '(or string function)) + +(sb!xc:deftype restart-designator () + '(or (and symbol (not null)) restart)) ;;; array rank, total size... (sb!xc:deftype array-rank () `(integer 0 (,sb!xc:array-rank-limit))) @@ -113,24 +130,20 @@ ;;; FIXME: could probably go away (sb!xc:deftype form () t) -;;; Maclisp compatibility... -;;; FIXME: should be STRING-DESIGNATOR (the term used in the ANSI spec) -(sb!xc:deftype stringable () '(or string symbol character)) +(sb!xc:deftype string-designator () '(or string symbol character)) ;;; a thing legal in places where we want the name of a file (sb!xc:deftype filename () '(or string pathname)) ;;; legal args to pathname functions (sb!xc:deftype pathname-designator () - '(or string pathname stream)) + '(or string pathname #+sb-xc-host stream #-sb-xc-host file-stream)) (sb!xc:deftype logical-host-designator () '(or host string)) -;;; like INDEX, but augmented with -1 (useful when using the index -;;; to count downwards to 0, e.g. LOOP FOR I FROM N DOWNTO 0, with -;;; an implementation which terminates the loop by testing for the -;;; index leaving the loop range) -(sb!xc:deftype index-or-minus-1 () `(integer -1 ,(1- most-positive-fixnum))) +(sb!xc:deftype package-designator () '(or string-designator sb!xc:package)) +;;; a designator for a list of symbols +(sb!xc:deftype symbols-designator () '(or list symbol)) ;;; a thing returned by the irrational functions. We assume that they ;;; never compute a rational result. @@ -141,16 +154,27 @@ (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)) +;;; the :COUNT arg to a sequence +(sb!xc:deftype sequence-count () + `(or null integer)) + ;;; a valid argument to a stream function -;;; -;;; FIXME: should probably be STREAM-DESIGNATOR, after the term -;;; used in the ANSI spec (if this is in fact exactly the same thing) -(sb!xc:deftype streamlike () '(or stream (member nil t))) +(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)) ;;; a thing that can be passed to FUNCALL & friends ;;; @@ -160,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 ()