(FILECREATED " 6-Aug-86 18:38:00" ("compiled on " {ERIS}LIBRARY>CMLTYPES.;49) "30-Jul-86 09:02:49" "COMPILE-FILEd" in "Xerox Lisp 30-Jul-86 ..." dated "30-Jul-86 09:16:17") (FILECREATED " 6-Aug-86 18:37:24" {ERIS}LIBRARY>CMLTYPES.;49 29284 changes to: (VARS CMLTYPESCOMS) (FNS \TYPEP.PRED) previous date: "29-Jul-86 01:52:36" {ERIS}LIBRARY>CMLTYPES.;47) (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) (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 x@Ajg AIg ]@A Hg $AIg A@ A :6@ A :Hg #AIg @ A : @ A :(214Q COMPLEX-IMAGPART 210Q COMPLEX-IMAGPART 201Q COMPLEX-REALPART 175Q COMPLEX-REALPART 167Q \INSTANCE-P 152Q \INSTANCE-P 141Q RATIO-DENOMINATOR 135Q RATIO-DENOMINATOR 126Q RATIO-NUMERATOR 122Q RATIO-NUMERATOR 114Q \INSTANCE-P 77Q \INSTANCE-P 67Q FEQP 60Q \INSTANCE-P 43Q \INSTANCE-P) (164Q COMPLEX 147Q COMPLEX 111Q RATIO 74Q RATIO 55Q FLOATP 40Q FLOATP) () CL:EQUAL D1 (P 0 $$TYPE-VALUE I 1 Y I 0 X) P@A:K@Hg A:@A 1@A H A@A iHg A @A (115Q %%PATHNAME-EQUAL 106Q PATHNAMEP 100Q \INSTANCE-P 65Q STRING= 52Q CL:STRINGP 45Q CL:EQUAL 34Q CL:EQUAL 17Q \INSTANCE-P) (75Q PATHNAME 14Q LISTP) () EQUALP D1 (P 3 I P 2 A0693 P 1 LENGTH P 0 $$TYPE-VALUE I 1 Y I 0 X) @A:i@Hd3A3Z@A g AH@A ?@A H A ,@A H A @A Hg A @A H A @ @ @ IA A A :IjJKi@KAK KkԻ(257Q EQUALP 230Q CL:LENGTH 223Q FILL-POINTER 216Q ARRAY-HAS-FILL-POINTER-P 206Q CL:LENGTH 201Q FILL-POINTER 174Q ARRAY-HAS-FILL-POINTER-P 166Q VECTORP 160Q VECTORP 153Q %%PATHNAME-EQUAL 144Q PATHNAMEP 137Q \INSTANCE-P 127Q STRING-EQUAL 120Q CL:STRINGP 113Q CL:STRINGP 106Q CHAR-EQUAL 77Q CHARACTERP 72Q CHARACTERP 65Q EQUALP 54Q EQUALP 37Q \INSTANCE-P 30Q %%=) (134Q PATHNAME 34Q LISTP) () TYPE-OF D1 (P 1 D P 0 TYPE I 0 X) )@ Hg HXdg I@kIH(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) @dQ ~@ddgkdg4@@ Wgog@ @ ohh2dgdgh"@g HgH@ Q ig@dog (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) AgbBgbAgBg@CH5g@ggogAg4AgAoh#bgAIBIIHXhBgBggBhhbgh 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 F 5 CLISPARRAY) !@dU @ddg@dg#goggg@hhhndgdgdg7go@@@d[ ghIHhZH&Jh&@g LgL@ o U ig@dgg LgL@h oi @i oi i @gghgg@hhh @ (436Q \TYPEP.PRED 432Q /PUTPROP 376Q TERPRI 371Q PRIN1 360Q PRIN1 352Q PRIN1 341Q \TYPEP.PRED 336Q \TYPEP.EXPAND.MACRO 315Q GETPROP 270Q PUTHASH 263Q HELP 253Q \TYPEP.PRED 250Q \TYPEP.EXPAND.MACRO 231Q GETPROP 161Q \TYPEP.PRED 12Q GETHASH) (414Q DATATYPE 411Q QUOTE 405Q MACRO 402Q DEFTYPE 325Q MACRO 312Q DEFTYPE 306Q FALSE 277Q TRUE 241Q MACRO 226Q DEFTYPE 164Q X 137Q OPENLAMBDA 130Q NOT 122Q OR 114Q AND 70Q QUOTE 65Q X 62Q \INSTANCE-P 53Q OPENLAMBDA 44Q DATATYPE 27Q SATISFIES) ( 365Q " assumed to be datatype" 346Q "Warning: type " 260Q "undefined type used in TYPEP" 143Q (X) 57Q (X)) (MOVD (QUOTE TYPENAMEP) (QUOTE STRUCTURE-TYPEP)) expand-DEFTYPE D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) c@Q@HH[KgggJggLM 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@HHgggJgKhhgogggJgIhhhgJhhNIL (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@@pjgg@ 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)) &@dgi@gggHhhINIL (31Q QUOTE 26Q $$TYPE-VALUE 23Q TYPEP 5 OTHERWISE) () expand-TYPECASE D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) (@!HHggIhhggJ 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