(FILECREATED "20-Aug-86 12:58:11" ("compiled on " {ERIS}LIBRARY>CMLTYPES.;51) "15-Aug-86 21:01:02" "COMPILE-FILEd" in "" dated "15-Aug-86 21:12:23") (FILECREATED "20-Aug-86 12:57:19" {ERIS}LIBRARY>CMLTYPES.;51 29418 changes to: (FNS \TYPEP.PRED) (VARS CMLTYPESCOMS) previous date: " 6-Aug-86 18:37:24" {ERIS}LIBRARY>CMLTYPES.;49) (RPAQQ CMLTYPESCOMS ((* includes functions for types & most predicates) (FNS EQL CL:EQUAL EQUALP TYPE-OF) (COMS (* optimize by constant fold and coerce to EQ where possible) (PROP BYTEMACRO EQL CL:EQUAL EQUALP)) (FNS FALSE TRUE) (PROP DMACRO COERCE FALSE TRUE TYPEP) (FUNCTIONS TYPEP COERCE) (FNS FALSE TRUE) (FNS \COERCE.FUNCTION \RANGE.TYPE \TYPEP.EXPAND.MACRO \TYPEP.PRED) (P (MOVD (QUOTE TYPENAMEP) (QUOTE STRUCTURE-TYPEP))) (FUNCTIONS DEFTYPE DEFTYPE-PREDICATE) (DEFINE-TYPES TYPES) (TYPES CL:ATOM BIGNUM BIT CL:CHARACTER CONS DOUBLE-FLOAT FIXNUM FLOAT HASH-TABLE INTEGER KEYWORD LIST LONG-FLOAT CL:MEMBER CL:MOD NULL NUMBER SHORT-FLOAT SIGNED-BYTE STANDARD-CHAR SINGLE-FLOAT SYMBOL UNSIGNED-BYTE RATIONAL COMPLEX SEQUENCE) (TYPES ARRAY VECTOR SIMPLE-STRING STRING SIMPLE-ARRAY SIMPLE-VECTOR BIT-VECTOR SIMPLE-BIT-VECTOR) (* for TYPE-OF - Interlisp types that have different COmmon Lisp names) (PROP CMLTYPE CHARACTER FIXP FLOATP GENERAL-ARRAY LISTP LITATOM ONED-ARRAY SMALLP STRINGP HARRAYP TWOD-ARRAY) (PROP CMLSUBTYPEDESCRIMINATOR SYMBOL ARRAY) (FNS SYMBOL-TYPE ARRAY-TYPE) ( PROP TYPE-COERCE CL:CHARACTER COMPLEX FLOAT SIMPLE-STRING) (VARS (\COERCEMACROHASH (HASHARRAY 30))) ( FUNCTIONS TYPECASE) (PROP FILETYPE CMLTYPES) (PROP PROPTYPE DEFTYPE) (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA))))) EQL D1 (P 1 $$TYPE-VALUE P 0 $$TYPE-VALUE I 1 Y I 0 X) ‰@Aðµ‚±@Hd3 ›¿A3 ´q@AÙjðlð²AIlð´Z@A Hd`ð²$¿AI`ð´>@ A :´3@ A :`ð´"AI`ð´@ A :´@ A :(205Q COMPLEX-IMAGPART 201Q COMPLEX-IMAGPART 172Q COMPLEX-REALPART 166Q COMPLEX-REALPART 135Q RATIO-DENOMINATOR 131Q RATIO-DENOMINATOR 122Q RATIO-NUMERATOR 116Q RATIO-NUMERATOR 63Q FEQP) (157Q COMPLEXTYPE# 143Q COMPLEXTYPE# 107Q RATIOTYPE# 72Q RATIOTYPE#) () CL:EQUAL D1 (P 0 $$TYPE-VALUE I 1 Y I 0 X) N@A:µI@Hdlð²¿A´8@A ´/@A A´@A ´iH`ð´ A ´@A (113Q %%PATHNAME-EQUAL 104Q PATHNAMEP 64Q STRING= 51Q CL:STRINGP 45Q CL:EQUAL 34Q CL:EQUAL) (75Q PATHNAMETYPE#) () EQUALP D1 (P 3 I P 2 A2962 P 1 LENGTH P 0 $$TYPE-VALUE I 1 Y I 0 X) ·@A:µh@Hd3›¿A3´Y@A lð²A´I@A ´@@A H ›A ´-@A H ›A ´@A Hd`ðœ¿A ´@A ´üA ´ö@ ”@ ƒ@ IA ”A ƒA :´ÓIjJKó¡i@K¶AK¶ ´½KkÔ»°ë(255Q EQUALP 226Q CL:LENGTH 221Q FILL-POINTER 214Q ARRAY-HAS-FILL-POINTER-P 204Q CL:LENGTH 177Q FILL-POINTER 172Q ARRAY-HAS-FILL-POINTER-P 164Q VECTORP 156Q VECTORP 152Q %%PATHNAME-EQUAL 143Q PATHNAMEP 125Q STRING-EQUAL 116Q CL:STRINGP 111Q CL:STRINGP 104Q CHAR-EQUAL 75Q CHARACTERP 70Q CHARACTERP 63Q EQUALP 52Q EQUALP 30Q %%=) (134Q PATHNAMETYPE#) () TYPE-OF D1 (P 1 D P 0 TYPE I 0 X) )@ Hg µHXdg I´@kIµH(30Q GETPROP 15Q GETPROP 3 TYPENAME) (25Q CMLSUBTYPEDESCRIMINATOR 12Q CMLTYPE) () (PUTPROPS EQL BYTEMACRO COMP.EQ) (PUTPROPS CL:EQUAL BYTEMACRO COMP.EQ) (PUTPROPS EQUALP BYTEMACRO COMP.EQ) FALSE D1 NIL hNIL NIL () TRUE D1 NIL iNIL NIL () (PUTPROPS COERCE DMACRO (DEFMACRO (OBJ TYPESPEC) (LET* ((CE (CONSTANTEXPRESSIONP TYPESPEC)) (CF (AND CE (\COERCE.FUNCTION (CAR CE))))) (if CF then (LIST CF OBJ) else (QUOTE IGNOREMACRO))))) (PUTPROPS FALSE DMACRO (DEFMACRO BODY (BQUOTE (PROG1 NIL (\,@ BODY))))) (PUTPROPS TRUE DMACRO (DEFMACRO BODY (BQUOTE (PROG1 T (\,@ BODY))))) (PUTPROPS TYPEP DMACRO (DEFMACRO (OBJ TYPESPEC) (LET ((CE (CONSTANTEXPRESSIONP TYPESPEC))) (if CE then (BQUOTE (AND (%, (\TYPEP.PRED (CAR CE)) %, OBJ) T)) else (QUOTE IGNOREMACRO))))) TYPEP D1 (L (1 TYPE 0 OBJECT)) @kA ´i(5 \TYPEP.PRED) NIL () COERCE D1 (L (1 RESULT-TYPE 0 OBJECT)) @dA ‘@kA µAg@(27Q CL:MAP 15Q \COERCE.FUNCTION 5 TYPEP) (23Q IDENTITY) () FALSE D1 NIL hNIL NIL () TRUE D1 NIL iNIL NIL () \COERCE.FUNCTION D1 (P 0 PROP I 0 TYPE F 1 \COERCEMACROHASH) ¡@d¢±†Q µ~@ddgð•¿°kdgð²4¿@§@ °Wgog@ @ ohh°2dgð¥dgð“¿h°"¿@g Hgð˜H@ ‚Qið“g@d¤og (236Q GETPROP 210Q PUTHASH 203Q HELP 177Q \COERCE.FUNCTION 174Q \TYPEP.EXPAND.MACRO 155Q GETPROP 106Q \COERCE.FUNCTION 100Q \COERCE.FUNCTION 55Q \COERCE.FUNCTION 31Q SHOULDNT 12Q GETHASH) (233Q TYPE-COERCE 217Q IDENTITY 165Q MACRO 152Q DEFTYPE 136Q NOT 130Q OR 71Q AND 62Q LAMBDA 37Q AND 23Q SATISFIES) ( 227Q (LAMBDA (X) (CL:ERROR (QUOTE TYPE-MISMATCH) :VALUE X :NAME "coerce's argument" :MESSAGE "anything that can coerce to type NIL")) 112Q (X) 66Q (X)) \RANGE.TYPE D1 (P 1 X I 3 RANGELIST I 2 HIGH I 1 LOW I 0 BASETYPE) ¥A¥gb¿B¥gb¿Agð—Bgð‘@CHµ5g@ggogAgð³4AµgAoh°#b¿g°î¹AIôšBIô”IHX°µhBgð³BµggBhh‰b¿g°îh hhh(226Q \APPEND2) (220Q < 201Q X 176Q <= 164Q CL:* 126Q < 104Q <= 72Q CL:* 66Q AND 57Q LAMBDA 54Q SATISFIES 50Q AND 31Q CL:* 23Q CL:* 14Q CL:* 4 CL:*) ( 111Q (X) 63Q (X)) \TYPEP.EXPAND.MACRO D1 (I 1 TYPE I 0 PROP) @Ag(10Q EXPAND-DEFMACRO) (5 CL:*) () \TYPEP.PRED D1 (P 4 PROP P 3 PRED I 0 TYPE) ?@d¢±Ô` µ‚±Ç@ddgð–¿@±±dgð²¿hg ¿o ±—dgð²#¿goggg@hhh°ndgð¬dgð¦dgð²7¿go@@@°d[ gh¸IµHhZH&¹µæJh°&¿@g Lgð˜L@ †o `ið“g@d£gg LgðšL@h oi ¿@i ¿oi ¿i @gghgg@hhh@ (474Q \TYPEP.PRED 470Q /PUTPROP 434Q TERPRI 427Q PRIN1 416Q PRIN1 410Q PRIN1 377Q \TYPEP.PRED 374Q \TYPEP.EXPAND.MACRO 353Q GETPROP 326Q PUTHASH 317Q HELP 307Q \TYPEP.PRED 304Q \TYPEP.EXPAND.MACRO 265Q GETPROP 215Q \TYPEP.PRED 71Q DATATYPE 61Q \INSTANCE-P 14Q GETHASH) (452Q DATATYPE 447Q QUOTE 443Q MACRO 440Q DEFTYPE 363Q MACRO 350Q DEFTYPE 344Q FALSE 335Q TRUE 323Q CLISPARRAY 275Q MACRO 262Q DEFTYPE 220Q X 173Q OPENLAMBDA 164Q NOT 156Q OR 150Q AND 124Q QUOTE 121Q X 116Q TYPENAMEP 107Q OPENLAMBDA 100Q DATATYPE 56Q SYMBOL 46Q * 31Q SATISFIES 11Q CLISPARRAY) ( 423Q " assumed to be datatype" 404Q "Warning: type " 314Q "undefined type used in TYPEP" 177Q (X) 113Q (X) 66Q ((BQUOTE (OPENLAMBDA (X) (\INSTANCE-P X (QUOTE (\, (CADR TYPE)))))))) (MOVD (QUOTE TYPENAMEP) (QUOTE STRUCTURE-TYPEP)) expand-DEFTYPE D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) f@ Q@¹HºH[¼K½gggJggLM hhhgogggJgIhhhgJhh(51Q MKPROGN 4 REMOVE-COMMENTS) (132Q QUOTE 111Q TYPES 105Q PUTPROPS 102Q FILEPKGFLG 77Q AND 70Q EVAL-WHEN 44Q MACRO 41Q DEFTYPE 35Q PUTPROPS 32Q WITHOUT-FILEPKG 27Q PROGN) ( 74Q (CL:EVAL)) (SETF-MACRO-FUNCTION (QUOTE DEFTYPE) (QUOTE expand-DEFTYPE)) (ADDTOVAR PRETTYPRINTMACROS (DEFTYPE . PPRINT-DEFINER)) expand-DEFTYPE-PREDICATE D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) W@ 1@¹HºH»gggJgKhhgogggJgIhhhgJhh(4 REMOVE-COMMENTS) (113Q QUOTE 72Q TYPES 66Q PUTPROPS 63Q FILEPKGFLG 60Q AND 51Q EVAL-WHEN 35Q TYPE-PREDICATE 31Q PUTPROPS 26Q WITHOUT-FILEPKG 23Q PROGN) ( 55Q (CL:EVAL)) (SETF-MACRO-FUNCTION (QUOTE DEFTYPE-PREDICATE) (QUOTE expand-DEFTYPE-PREDICATE)) (ADDTOVAR PRETTYPRINTMACROS (DEFTYPE-PREDICATE . PPRINT-DEFINER)) (ADDTOVAR PRETTYDEFMACROS (TYPES X (P * (MAPCAR (QUOTE X) (FUNCTION (LAMBDA (ITEM) (CL:DO ((DEF (GET ITEM (QUOTE TYPES)))) (DEF DEF) (CERROR "Re-fetch the definition" "No ~S definition for ~S" (QUOTE TYPES) ITEM)))))))) (ADDTOVAR PRETTYTYPELST (CHANGEDTYPESLST TYPES "Common Lisp type definitions")) (ADDTOVAR FILEPKGTYPES TYPES) (PUTPROPS TYPES GETDEF \DEFINE-TYPE-GETDEF) (PUTPROPS TYPES FILEPKGCONTENTS NILL) (PUTPROPS TYPES PROPTYPE TYPES) (PUTPROPS CL:ATOM DEFTYPE (MACRO NIL (QUOTE (SATISFIES CL:ATOM)))) (PUTPROPS BIGNUM DEFTYPE (MACRO NIL (QUOTE (OR (DATATYPE FIXP) (DATATYPE BIGNUM))))) (PUTPROPS BIT DEFTYPE (MACRO NIL (QUOTE (CL:MOD 2)))) (PUTPROPS CL:CHARACTER DEFTYPE (MACRO NIL (QUOTE (SATISFIES CHARACTERP)))) (PUTPROPS CONS DEFTYPE (MACRO NIL (QUOTE (DATATYPE LISTP)))) (PUTPROPS DOUBLE-FLOAT DEFTYPE (MACRO (&REST X) (CONS (QUOTE FLOAT) X))) (PUTPROPS FIXNUM DEFTYPE (MACRO NIL (QUOTE (DATATYPE SMALLP)))) (PUTPROPS FLOAT DEFTYPE (MACRO (&OPTIONAL LOW HIGH) (\RANGE.TYPE (QUOTE (DATATYPE FLOATP)) LOW HIGH))) (PUTPROPS HASH-TABLE DEFTYPE (MACRO NIL (QUOTE (DATATYPE HARRAYP)))) (PUTPROPS INTEGER DEFTYPE (MACRO (&OPTIONAL LOW HIGH) (\RANGE.TYPE (QUOTE (SATISFIES FIXP)) LOW HIGH ( QUOTE ((-65536 65535 FIXNUM) (0 1 (CL:MEMBER 0 1))))))) (PUTPROPS KEYWORD DEFTYPE (MACRO NIL (QUOTE (SATISFIES KEYWORDP)))) (PUTPROPS LIST DEFTYPE (MACRO (&OPTIONAL TYPE) (COND ((EQ TYPE (QUOTE CL:*)) (QUOTE (OR NULL CONS))) ( T (BQUOTE (AND LIST (SATISFIES (LAMBDA (X) (CL:EVERY (CL:FUNCTION (CL:LAMBDA (ELEMENT) (TYPEP ELEMENT (QUOTE (\, TYPE))))) (THE LIST X)))))))))) (PUTPROPS LONG-FLOAT DEFTYPE (MACRO (&REST X) (CONS (QUOTE FLOAT) X))) (PUTPROPS CL:MEMBER DEFTYPE (MACRO (&REST VALUES) (BQUOTE (SATISFIES (LAMBDA (X) (CL:MEMBER X (QUOTE ( \, VALUES)))))))) (PUTPROPS CL:MOD DEFTYPE (MACRO (N) (BQUOTE (INTEGER 0 (\, (SUB1 N)))))) (PUTPROPS NULL DEFTYPE (MACRO NIL (QUOTE (CL:MEMBER NIL)))) (PUTPROPS NUMBER DEFTYPE (MACRO NIL (QUOTE (SATISFIES NUMBERP)))) (PUTPROPS SHORT-FLOAT DEFTYPE (MACRO (&REST REST) (CONS (QUOTE FLOAT) REST))) (PUTPROPS SIGNED-BYTE DEFTYPE (MACRO (&OPTIONAL S) (if (EQ S (QUOTE CL:*)) then (QUOTE INTEGER) else ( BQUOTE (INTEGER (\, (MINUS (SETQ S (EXPT 2 (SUB1 S))))) (\, (SUB1 S))))))) (PUTPROPS STANDARD-CHAR DEFTYPE (MACRO NIL (QUOTE (SATISFIES STANDARD-CHAR-P)))) (PUTPROPS SINGLE-FLOAT DEFTYPE (MACRO (&REST REST) (CONS (QUOTE FLOAT) REST))) (PUTPROPS SYMBOL DEFTYPE (MACRO NIL (QUOTE (DATATYPE LITATOM)))) (PUTPROPS UNSIGNED-BYTE DEFTYPE (MACRO (&OPTIONAL S) (if (EQ S (QUOTE CL:*)) then (QUOTE (INTEGER 0)) else (BQUOTE (INTEGER 0 ((\, (EXPT 2 S)))))))) (PUTPROPS RATIONAL DEFTYPE (MACRO NIL (QUOTE (OR RATIO INTEGER)))) (PUTPROPS COMPLEX DEFTYPE (MACRO (&OPTIONAL TYPE) (CL:IF (EQ TYPE (QUOTE CL:*)) (QUOTE (DATATYPE COMPLEX)) (BQUOTE (AND COMPLEX (SATISFIES (LAMBDA (X) (TYPEP (COMPLEX-REALPART X) (QUOTE (\, TYPE))))) ))))) (PUTPROPS SEQUENCE DEFTYPE (MACRO (&OPTIONAL TYPE) (COND ((EQ TYPE (QUOTE CL:*)) (QUOTE (OR VECTOR LIST))) (T (BQUOTE (AND SEQUENCE (SATISFIES (LAMBDA (X) (CL:EVERY (CL:FUNCTION (CL:LAMBDA (ELEMENT) ( TYPEP ELEMENT (QUOTE (\, TYPE))))) X))))))))) (PUTPROPS ARRAY DEFTYPE (MACRO (&OPTIONAL ELEMENT-TYPE DIMENSIONS) (PROGN (if (FIXP DIMENSIONS) then ( SETQ DIMENSIONS (for I from 1 to DIMENSIONS collect (QUOTE CL:*)))) (if (NEQ ELEMENT-TYPE (QUOTE CL:*) ) then (SETQ ELEMENT-TYPE (\GET-CANONICAL-CML-TYPE ELEMENT-TYPE))) (if (EQ DIMENSIONS (QUOTE CL:*)) then (if (EQ ELEMENT-TYPE (QUOTE CL:*)) then (QUOTE (SATISFIES CL:ARRAYP)) else (BQUOTE (SATISFIES ( LAMBDA (X) (AND (CL:ARRAYP X) (EQUAL (ARRAY-ELEMENT-TYPE X) (QUOTE (\, ELEMENT-TYPE)))))))) elseif ( EQUAL DIMENSIONS (QUOTE (CL:*))) then (if (EQ ELEMENT-TYPE (QUOTE CL:*)) then (QUOTE VECTOR) elseif ( EQ ELEMENT-TYPE (QUOTE STRING-CHAR)) then (QUOTE STRING) elseif (MEMBER ELEMENT-TYPE (QUOTE (BIT ( UNSIGNED-BYTE 1)))) then (QUOTE BIT-VECTOR) else (BQUOTE (SATISFIES (LAMBDA (X) (AND (VECTORP X) ( EQUAL (ARRAY-ELEMENT-TYPE X) (QUOTE (\, ELEMENT-TYPE)))))))) elseif (EVERY DIMENSIONS (FUNCTION ( LAMBDA (X) (EQ X (QUOTE CL:*))))) then (BQUOTE (SATISFIES (LAMBDA (X) (AND (CL:ARRAYP X) (EQL ( ARRAY-RANK X) (\, (LENGTH DIMENSIONS))) (\,@ (if (NEQ ELEMENT-TYPE (QUOTE CL:*)) then (BQUOTE ((EQUAL (ARRAY-ELEMENT-TYPE X) (QUOTE (\, ELEMENT-TYPE))))))))))) elseif (EVERY DIMENSIONS (FUNCTION (LAMBDA ( X) (OR (EQ X (QUOTE CL:*)) (FIXP X))))) then (if (EQLENGTH DIMENSIONS 1) then (BQUOTE (STRING (\, (CAR DIMENSIONS)))) else (BQUOTE (SATISFIES (LAMBDA (X) (AND (CL:ARRAYP X) (EQL (ARRAY-RANK X) (\, (LENGTH DIMENSIONS))) (for DIM in (ARRAY-DIMENSIONS X) as DIMSPEC in (QUOTE (\, DIMENSIONS)) always (OR (EQ DIMSPEC (QUOTE CL:*)) (EQL DIM DIMSPEC))) (\,@ (if (NEQ ELEMENT-TYPE (QUOTE CL:*)) then (BQUOTE (( EQUAL (ARRAY-ELEMENT-TYPE X) (QUOTE (\, ELEMENT-TYPE)))))))))))) else (ERROR "Bad (final) array type designator" (BQUOTE (ARRAY %, ELEMENT-TYPE %, DIMENSIONS))))))) (PUTPROPS VECTOR DEFTYPE (MACRO (&OPTIONAL ELEMENT-TYPE SIZE) (if (EQ ELEMENT-TYPE (QUOTE CL:*)) then (if (EQ SIZE (QUOTE CL:*)) then (BQUOTE (SATISFIES VECTORP)) else (BQUOTE (SATISFIES (LAMBDA (V) (AND (VECTORP X) (EQL (ARRAY-TOTAL-SIZE V) (\, SIZE))))))) elseif (EQ ELEMENT-TYPE (QUOTE STRING-CHAR)) then (BQUOTE (STRING (\, SIZE))) elseif (MEMBER ELEMENT-TYPE (QUOTE (BIT (UNSIGNED-BYTE 1))) NIL) then (BQUOTE (BIT-VECTOR (\, SIZE))) else (BQUOTE (SATISFIES (LAMBDA (V) (AND (VECTORP X) (EQUAL ( ARRAY-ELEMENT-TYPE V) (\, ELEMENT-TYPE)) (\,@ (if (NEQ SIZE (QUOTE CL:*)) then (BQUOTE ((EQL ( ARRAY-TOTAL-SIZE V) (\, SIZE))))))))))))) (PUTPROPS SIMPLE-STRING DEFTYPE (MACRO (&OPTIONAL SIZE) (if (EQ SIZE (QUOTE CL:*)) then (BQUOTE ( SATISFIES SIMPLE-STRING-P)) else (BQUOTE (SATISFIES (LAMBDA (V) (AND (SIMPLE-STRING-P V) (EQL ( ARRAY-TOTAL-SIZE V) (\, SIZE))))))))) (PUTPROPS STRING DEFTYPE (MACRO (&OPTIONAL SIZE) (if (EQ SIZE (QUOTE CL:*)) then (QUOTE (SATISFIES CL:STRINGP)) else (BQUOTE (SATISFIES (LAMBDA (X) (AND (CL:STRINGP X) (EQL (ARRAY-TOTAL-SIZE X) (\, SIZE))))))))) (PUTPROPS SIMPLE-ARRAY DEFTYPE (MACRO (&OPTIONAL ELEMENT-TYPE DIMSPEC) (if (EQ ELEMENT-TYPE (QUOTE CL:*)) then (if (EQ DIMSPEC (QUOTE CL:*)) then (BQUOTE (SATISFIES SIMPLE-ARRAY-P)) else (BQUOTE (AND ( SATISFIES SIMPLE-ARRAY-P) (ARRAY CL:* (\, DIMSPEC))))) else (BQUOTE (AND (SATISFIES SIMPLE-ARRAY-P) ( ARRAY (\, ELEMENT-TYPE) (\, DIMSPEC))))))) (PUTPROPS SIMPLE-VECTOR DEFTYPE (MACRO (&OPTIONAL SIZE) (BQUOTE (AND (SATISFIES SIMPLE-VECTOR-P) ( VECTOR T (\, SIZE)))))) (PUTPROPS BIT-VECTOR DEFTYPE (MACRO (&OPTIONAL SIZE) (if (EQ SIZE (QUOTE CL:*)) then (BQUOTE ( SATISFIES BIT-VECTOR-P)) else (BQUOTE (SATISFIES (LAMBDA (V) (AND (BIT-VECTOR-P V) (EQL ( ARRAY-TOTAL-SIZE V) (\, SIZE))))))))) (PUTPROPS SIMPLE-BIT-VECTOR DEFTYPE (MACRO (&OPTIONAL SIZE) (if (EQ SIZE (QUOTE CL:*)) then (BQUOTE ( SATISFIES SIMPLE-BIT-VECTOR-P)) else (BQUOTE (SATISFIES (LAMBDA (V) (AND (SIMPLE-BIT-VECTOR-P V) (EQL (ARRAY-TOTAL-SIZE V) (\, SIZE))))))))) (PUTPROPS CHARACTER CMLTYPE CL:CHARACTER) (PUTPROPS FIXP CMLTYPE BIGNUM) (PUTPROPS FLOATP CMLTYPE SINGLE-FLOAT) (PUTPROPS GENERAL-ARRAY CMLTYPE ARRAY) (PUTPROPS LISTP CMLTYPE CONS) (PUTPROPS LITATOM CMLTYPE SYMBOL) (PUTPROPS ONED-ARRAY CMLTYPE ARRAY) (PUTPROPS SMALLP CMLTYPE FIXNUM) (PUTPROPS STRINGP CMLTYPE SIMPLE-STRING) (PUTPROPS HARRAYP CMLTYPE HASH-ARRAY) (PUTPROPS TWOD-ARRAY CMLTYPE ARRAY) (PUTPROPS SYMBOL CMLSUBTYPEDESCRIMINATOR SYMBOL-TYPE) (PUTPROPS ARRAY CMLSUBTYPEDESCRIMINATOR ARRAY-TYPE) SYMBOL-TYPE D1 (I 0 X) @ “gg(3 KEYWORDP) (13Q SYMBOL 7 KEYWORD) () ARRAY-TYPE D1 (I 0 ARRAY) B@“g@²@Ê0jð£gg@ h@³ò@™@É k:³äg@ h(74Q ARRAY-ELEMENT-TYPE 61Q CL:LENGTH 36Q ARRAY-ELEMENT-TYPE) (70Q ARRAY 32Q VECTOR 26Q STRING 6 SIMPLE-STRING) () (PUTPROPS CL:CHARACTER TYPE-COERCE CL:CHARACTER) (PUTPROPS COMPLEX TYPE-COERCE COMPLEX) (PUTPROPS FLOAT TYPE-COERCE FLOAT) (PUTPROPS SIMPLE-STRING TYPE-COERCE MKSTRING) (RPAQ \COERCEMACROHASH (HASHARRAY 30)) expand-TYPECASEA0001 D1 (L (0 FORM)) &@dgð’¿i€@gggHhhINIL (31Q QUOTE 26Q $$TYPE-VALUE 23Q TYPEP 5 OTHERWISE) () expand-TYPECASE D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) (@!H¹HºggIhhggJ h(40Q CL:MAPCAR) (34Q expand-TYPECASEA0001 31Q COND 20Q $$TYPE-VALUE 15Q LET) () (SETF-MACRO-FUNCTION (QUOTE TYPECASE) (QUOTE expand-TYPECASE)) (PUTPROPS CMLTYPES FILETYPE COMPILE-FILE) (PUTPROPS DEFTYPE PROPTYPE IGNORE) (PUTPROPS CMLTYPES COPYRIGHT ("Xerox Corporation" 1985 1986)) STOP