(FILECREATED "29-Jul-86 01:59:14" ("compiled on " {ERIS}LIBRARY>CMLTYPES.;46) "23-Jul-86 04:26:56" "COMPILE-FILEd" in "Xerox Lisp 23-Jul-86 ..." dated "23-Jul-86 04:52:47") (FILECREATED "29-Jul-86 01:52:36" {ERIS}LIBRARY>CMLTYPES.;46 29392 changes to: (FUNCTIONS COERCE TYPEP) (TYPES COMPLEX) (FNS \COERCE.FUNCTION) (VARS CMLTYPESCOMS) (PROPS (COMPLEX TYPE-COERCE)) previous date: "25-Jul-86 00:40:23" {ERIS}LIBRARY>CMLTYPES.;43) (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 TYPEP) (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) (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA TYPEP))))) 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 A0760 P 1 LENGTH P 0 $$TYPE-VALUE I 1 Y I 0 X) ¼@A:µm@Hd3›¿A3´^@A lð²A´N@A ´E@A Hd`ðž¿A`ð´,@A ›A ´@A Hd`ðœ¿A ´@A ´üA ´ö@ ”@ ƒ@ IA ”A ƒA :´ÓIjJKó¡i@K¶AK¶ ´½KkÔ»°ë(262Q EQUALP 233Q CL:LENGTH 226Q FILL-POINTER 221Q ARRAY-HAS-FILL-POINTER-P 211Q CL:LENGTH 204Q FILL-POINTER 177Q ARRAY-HAS-FILL-POINTER-P 171Q VECTORP 163Q VECTORP 157Q %%PATHNAME-EQUAL 150Q PATHNAMEP 132Q STRING-EQUAL 123Q CL:STRINGP 116Q CL:STRINGP 112Q CHAR-EQUAL 63Q EQUALP 52Q EQUALP 30Q %%=) (141Q PATHNAMETYPE# 102Q CL:CHARACTERTYPE# 72Q CL:CHARACTERTYPE#) () 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 () TYPEP D1 (I 1 TYPE I 0 OBJECT) @kA ´i(5 \TYPEP.PRED) 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ð²#¿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@ (442Q \TYPEP.PRED 436Q /PUTPROP 402Q TERPRI 375Q PRIN1 364Q PRIN1 356Q PRIN1 345Q \TYPEP.PRED 342Q \TYPEP.EXPAND.MACRO 321Q GETPROP 274Q PUTHASH 265Q HELP 255Q \TYPEP.PRED 252Q \TYPEP.EXPAND.MACRO 233Q GETPROP 163Q \TYPEP.PRED 14Q GETHASH) (420Q DATATYPE 415Q QUOTE 411Q MACRO 406Q DEFTYPE 331Q MACRO 316Q DEFTYPE 312Q FALSE 303Q TRUE 271Q CLISPARRAY 243Q MACRO 230Q DEFTYPE 166Q X 141Q OPENLAMBDA 132Q NOT 124Q OR 116Q AND 72Q QUOTE 67Q X 64Q TYPENAMEP 55Q OPENLAMBDA 46Q DATATYPE 31Q SATISFIES 11Q CLISPARRAY) ( 371Q " assumed to be datatype" 352Q "Warning: type " 262Q "undefined type used in TYPEP" 145Q (X) 61Q (X)) (MOVD (QUOTE TYPENAMEP) (QUOTE STRUCTURE-TYPEP)) expand-DEFTYPE D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) c@Q@¹HºH[¼K½gggJggLM hhhgogggJgIhhhgJhh(46Q MKPROGN) (127Q QUOTE 106Q TYPES 102Q PUTPROPS 77Q FILEPKGFLG 74Q AND 65Q EVAL-WHEN 41Q MACRO 36Q DEFTYPE 32Q PUTPROPS 27Q WITHOUT-FILEPKG 24Q PROGN) ( 71Q (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)) T@1@¹HºH»gggJgKhhgogggJgIhhhgJhhNIL (110Q QUOTE 67Q TYPES 63Q PUTPROPS 60Q FILEPKGFLG 55Q AND 46Q EVAL-WHEN 32Q TYPE-PREDICATE 26Q PUTPROPS 23Q WITHOUT-FILEPKG 20Q PROGN) ( 52Q (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) 5@“g@²@Êpjð£gg@ h@ ³ñg@ h(57Q ARRAY-ELEMENT-TYPE 46Q \VECTORP 36Q ARRAY-ELEMENT-TYPE) (53Q 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 CMLTYPES COPYRIGHT ("Xerox Corporation" 1985 1986)) STOP