(FILECREATED " 9-Jul-86 15:46:24" {ERIS}<LISPCORE>LIBRARY>CMLCHARACTER.;27 24963  

      changes to:  (VARS CMLCHARACTERCOMS)
                   (RECORDS CHARACTER)

      previous date: " 2-Jun-86 10:42:31" {ERIS}<LISPCORE>LIBRARY>CMLCHARACTER.;25)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT CMLCHARACTERCOMS)

(RPAQQ CMLCHARACTERCOMS 
       [(COMS (* "Interlisp CHARCODE")
              (FNS CHARCODE CHARCODE.DECODE)
              (VARS CHARACTERNAMES CHARACTERSETNAMES)
              (PROP MACRO CHARCODE SELCHARQ ALPHACHARP DIGITCHARP UCASECODE)
              (ALISTS (DWIMEQUIVLST SELCHARQ)
                     (PRETTYEQUIVLST SELCHARQ)))
        (COMS (* "Common Lisp CHARACTER type")
              (DECLARE: EVAL@COMPILE DONTCOPY (RECORDS CHARACTER))
              (INITVARS (\CODE-CHAR-HASH (HASHARRAY 512)))
              (ADDVARS (\ALPHACHARSETS 38 39 36 37))
              (CONSTANTS (CHAR-CODE-LIMIT 65536)
                     (CHAR-FONT-LIMIT 1)
                     (CHAR-BITS-LIMIT 1)
                     (CHAR-CONTROL-BIT 0)
                     (CHAR-META-BIT 0)
                     (CHAR-SUPER-BIT 0)
                     (CHAR-HYPER-BIT 0)))
        (FNS CL:CHARACTER CHAR-DOWNCASE CHAR-UPCASE DIGIT-CHAR MAKE-CHAR)
        (FNS CHARACTERP STANDARD-CHAR-P GRAPHIC-CHAR-P STRING-CHAR-P ALPHA-CHAR-P DIGIT-CHAR-P 
             ALPHANUMERICP UPPER-CASE-P LOWER-CASE-P BOTH-CASE-P)
        (FNS CHAR-INT INT-CHAR CHAR-BITS CHAR-FONT CHAR-CODE CODE-CHAR NAME-CHAR CHAR-NAME)
        (FNS CHAR-BIT SET-CHAR-BIT)
        (FNS CHAR-EQUAL CHAR-GREATERP CHAR-LESSP CHAR= CHAR/= CHAR< CHAR> CHAR>= CHAR<= 
             CHAR-NOT-EQUAL CHAR-NOT-GREATERP CHAR-NOT-LESSP)
        (FNS CHARACTER.READ CHARACTER.PRINT CHARCODE.UNDECODE)
        [DECLARE: DONTEVAL@LOAD DOCOPY (P (SETTOPVAL (\TYPEGLOBALVARIABLE (QUOTE CHARACTER)
                                                            T)
                                                 (NTYPX (CODE-CHAR 0 0 0)))
                                          (DEFPRINT (QUOTE CHARACTER)
                                                 (QUOTE CHARACTER.PRINT]
        (PROP FILETYPE CMLCHARACTER)
        (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
               (ADDVARS (NLAMA)
                      (NLAML CHARCODE)
                      (LAMA CHAR-NOT-LESSP CHAR-NOT-GREATERP CHAR-NOT-EQUAL CHAR<= CHAR>= CHAR> CHAR< 
                            CHAR/= CHAR= CHAR-LESSP CHAR-GREATERP CHAR-EQUAL DIGIT-CHAR])



(* "Interlisp CHARCODE")

(DEFINEQ

(CHARCODE
  [NLAMBDA (CHAR)
    (CHARCODE.DECODE CHAR])

(CHARCODE.DECODE
  [LAMBDA (C NOERROR)                                        (* bvm: "30-May-86 13:51")
    (DECLARE (GLOBALVARS CHARACTERNAMES CHARACTERSETNAMES))
    (COND
       ((NOT C)
        NIL)
       ((LISTP C)
        (CONS (CHARCODE.DECODE (CAR C)
                     NOERROR)
              (CHARCODE.DECODE (CDR C)
                     NOERROR)))
       ((NOT (OR (ATOM C)
                 (STRINGP C)))
        (AND (NOT NOERROR)
             (ERROR "BAD CHARACTER SPECIFICATION" C)))
       ((EQ (NCHARS C)
            1)
        (CHCON1 C))
       (T
        (SELECTQ (NTHCHAR C 1)
            (↑ (AND (SETQ C (CHARCODE.DECODE (SUBSTRING C 2 -1)
                                   NOERROR))
                    (LOGAND C (LOGNOT 96))))
            (#                                               (* "We use IPLUS instead of LOGOR here because some people want ##char to read as Xerox Meta, i.e., 1,char")
               (AND (SETQ C (CHARCODE.DECODE (SUBSTRING C 2 -1)
                                   NOERROR))
                    (IPLUS C 128)))
            (LET
             ((STR (MKSTRING C)))
             (for X in CHARACTERNAMES when (STRING.EQUAL (CAR X)
                                                  STR) do (RETURN (OR (NUMBERP (CADR X))
                                                                      (CHARCODE.DECODE (CADR X)
                                                                             NOERROR)))
                finally
                (RETURN
                 (LET ((POS (STRPOSL (QUOTE (%, - "." "|"))
                                   STR)))                    (* In the form charset,char)
                      (COND
                         ([AND POS (PROGN (PSETQ POS (SUBATOM STR 1 (SUB1 POS))
                                                 STR
                                                 (SUBATOM STR (ADD1 POS)
                                                        -1))
                                          (SETQ STR (COND
                                                       ((FIXP STR)
                                                        (PACK* STR (QUOTE Q)))
                                                       (T (CHARCODE.DECODE STR NOERROR]
                          (LOGOR STR (LLSH [COND
                                              ((FIXP POS)
                                               (PACK* POS (QUOTE Q)))
                                              (T (OR (CADR (find PAIR in CHARACTERSETNAMES
                                                              suchthat (STRING-EQUAL (CAR PAIR)
                                                                              POS)))
                                                     (ERROR "BAD CHARACTERSET SPECIFICATION" C]
                                           8)))
                         ((NOT NOERROR)
                          (ERROR "BAD CHARACTER SPECIFICATION" C])
)

(RPAQQ CHARACTERNAMES (("Page" 12)
                       ("Form" 12)
                       ("FF" 12)
                       ("Rubout" 127)
                       ("Del" 127)
                       ("Null" 0)
                       ("Escape" 27)
                       ("Esc" 27)
                       ("Bell" 7)
                       ("Tab" 9)
                       ("Backspace" 8)
                       ("Bs" 8)
                       ("Newline" 13)
                       ("CR" 13)
                       ("EOL" 13)
                       ("Tenexeol" 31)
                       ("Space" 32)
                       ("Sp" 32)
                       ("Linefeed" 10)
                       ("LF" 10)
                       ("Return" 13)))

(RPAQQ CHARACTERSETNAMES (("Greek" 38)
                          ("Cyrillic" 39)
                          ("Hira" 36)
                          ("Hiragana" 36)
                          ("Kata" 37)
                          ("Katakana" 37)
                          ("Kanji" 48)))

(PUTPROPS CHARCODE MACRO (DEFMACRO (C ) (KWOTE (CHARCODE.DECODE C T)) )
)

(PUTPROPS SELCHARQ MACRO [F (CONS (QUOTE SELECTQ)
                                  (CONS (CAR F)
                                        (MAPLIST (CDR F)
                                               (FUNCTION (LAMBDA (I)
                                                           (COND
                                                              ((CDR I)
                                                               (CONS (CHARCODE.DECODE (CAAR I))
                                                                     (CDAR I)))
                                                              (T (CAR I])

(PUTPROPS ALPHACHARP MACRO ((CHAR)
                            ([LAMBDA (UCHAR)
                               (DECLARE (LOCALVARS UCHAR))
                               (AND (IGEQ UCHAR (CHARCODE A))
                                    (ILEQ UCHAR (CHARCODE Z]
                             (LOGAND CHAR 95))))

(PUTPROPS DIGITCHARP MACRO [LAMBDA (CHAR)
                             (AND (IGEQ CHAR (CHARCODE 0))
                                  (ILEQ CHAR (CHARCODE 9])

(PUTPROPS UCASECODE MACRO (OPENLAMBDA (CHAR)
                                 (COND
                                    ((AND (IGEQ CHAR (CHARCODE a))
                                          (ILEQ CHAR (CHARCODE z)))
                                     (LOGAND CHAR 95))
                                    (T CHAR))))

(ADDTOVAR DWIMEQUIVLST (SELCHARQ . SELECTQ))

(ADDTOVAR PRETTYEQUIVLST (SELCHARQ . SELECTQ))



(* "Common Lisp CHARACTER type")

(DECLARE: EVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(ACCESSFNS CHARACTER [(CODE (\LOLOC (\DTEST DATUM (QUOTE CHARACTER]
                     (CREATE (\VAG2 \CHARHI CODE)))
]
)

(RPAQ? \CODE-CHAR-HASH (HASHARRAY 512))

(ADDTOVAR \ALPHACHARSETS 38 39 36 37)
(DECLARE: EVAL@COMPILE 

(RPAQQ CHAR-CODE-LIMIT 65536)

(RPAQQ CHAR-FONT-LIMIT 1)

(RPAQQ CHAR-BITS-LIMIT 1)

(RPAQQ CHAR-CONTROL-BIT 0)

(RPAQQ CHAR-META-BIT 0)

(RPAQQ CHAR-SUPER-BIT 0)

(RPAQQ CHAR-HYPER-BIT 0)

(CONSTANTS (CHAR-CODE-LIMIT 65536)
       (CHAR-FONT-LIMIT 1)
       (CHAR-BITS-LIMIT 1)
       (CHAR-CONTROL-BIT 0)
       (CHAR-META-BIT 0)
       (CHAR-SUPER-BIT 0)
       (CHAR-HYPER-BIT 0))
)
(DEFINEQ

(CL:CHARACTER
  [LAMBDA (OBJECT)                                           (* lmm "18-Jul-85 21:33")
    (OR [COND
           ((TYPEP OBJECT (QUOTE CHARACTER))
            OBJECT)
           ((FIXP OBJECT)
            (INT-CHAR OBJECT))
           ((OR (STRINGP OBJECT)
                (LITATOM OBJECT))
            (INT-CHAR (CHARCODE.DECODE OBJECT]
        (ERROR OBJECT "Illegal Common Lisp Character specification"])

(CHAR-DOWNCASE
  [LAMBDA (CHAR)                                             (* lmm " 1-Aug-85 12:47")
    (COND
       [(UPPER-CASE-P CHAR)
        (CODE-CHAR (PLUS (CHAR-CODE CHAR)
                         (DIFFERENCE (CHARCODE a)
                                (CHARCODE A]
       (T CHAR])

(CHAR-UPCASE
  [LAMBDA (CHAR)                                             (* lmm " 1-Aug-85 12:47")
    (COND
       [(LOWER-CASE-P CHAR)
        (CODE-CHAR (PLUS (CHAR-CODE CHAR)
                         (DIFFERENCE (CHARCODE A)
                                (CHARCODE a]
       (T CHAR])

(DIGIT-CHAR
  [CL:LAMBDA (WEIGHT &OPTIONAL (RADIX 10)
                    (FONT 0))                                (* lmm "28-Oct-85 20:44")
         (AND (EQ FONT 0)
              (INTEGERP RADIX)
              (LESSP WEIGHT RADIX)
              (COND
                 ((OR (LESSP WEIGHT 10)
                      (LEQ RADIX 10))
                  (CODE-CHAR (PLUS (CHARCODE 0)
                                   WEIGHT)))
                 (T (CODE-CHAR (PLUS (CHARCODE A)
                                     (DIFFERENCE WEIGHT 10])

(MAKE-CHAR
  [LAMBDA (CHAR BITS FONT)                                   (* lmm " 7-Jul-85 16:35")
    (COND
       ((AND (OR (NULL BITS)
                 (EQ BITS 0))
             (OR (NULL FONT)
                 (EQ FONT 0)))
        CHAR])
)
(DEFINEQ

(CHARACTERP
  [LAMBDA (X)                                                (* lmm " 1-Aug-85 22:45")
    (TYPENAMEP X (QUOTE CHARACTER])

(STANDARD-CHAR-P
  [LAMBDA (CHAR)                                             (* lmm "28-Oct-85 20:42")
    (NOT (NULL (FMEMB (fetch (CHARACTER CODE) of CHAR)
                      (CONSTANT (CHCON 
   "!%"#%%'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]↑←`abcdefghijklmnopqrstuvwxyz{|}~ 
"])

(GRAPHIC-CHAR-P
  [LAMBDA (CHAR)                                             (* bvm: "14-May-86 16:19")
          
          (* * True if CHAR represents a graphic (printing) character.
          Definition follows NS character standard)

    (LET* ((CODE (fetch (CHARACTER CODE) of CHAR))
           (CSET (LRSH CODE 8)))
          (AND [PROGN                                        (* 
                                               "Graphic charsets are zero, 41 thru 176, 241 thru 276")
                      (OR (EQ CSET 0)
                          (AND (IGREATERP (SETQ CSET (LOGAND CSET 127))
                                      32)
                               (NEQ CSET 127]
               (PROGN                                        (* 
                          "Printing chars within a character set are SPACE thru 176 and 241 thru 276")
                      (OR (EQ (SETQ CODE (LOGAND CODE 255))
                              (CHARCODE SPACE))
                          (AND (IGREATERP (SETQ CODE (LOGAND CODE 127))
                                      32)
                               (NEQ CODE 127])

(STRING-CHAR-P
  [LAMBDA (CHAR)
    T])

(ALPHA-CHAR-P
  [LAMBDA (CHAR)                                             (* raf "23-Oct-85 15:03")
    (LET ((CODE (fetch (CHARACTER CODE) of CHAR)))           (* should also be true for greek 
                                                             alphabetics, etc.)
         (OR (AND (IGEQ CODE (CHARCODE A))
                  (ILEQ CODE (CHARCODE Z)))
             (AND (IGEQ CODE (CHARCODE a))
                  (ILEQ CODE (CHARCODE z)))
             (AND (IGREATERP CODE 255)
                  (FMEMB (RSH CODE 8)
                         \ALPHACHARSETS)
                  (GRAPHIC-CHAR-P CODE])

(DIGIT-CHAR-P
  [LAMBDA (CHAR RADIX)                                       (* lmm " 7-Jul-85 17:03")
    (LET ((R (OR RADIX 10))
          (CODE (fetch (CHARACTER CODE)
                       CHAR))
          VAL)
         (AND (GEQ CODE (CHARCODE "0"))
              (COND
                 ((OR (LEQ R 10)
                      (LEQ CODE (CHARCODE "9")))
                  (AND (LESSP (SETQ VAL (DIFFERENCE CODE (CHARCODE 0)))
                              R)
                       VAL))
                 (T [COND
                       ((GEQ CODE (CHARCODE "a"))
                        (add CODE (DIFFERENCE (CHARCODE "A")
                                         (CHARCODE "a"]
                    (AND (GEQ CODE (CHARCODE "A"))
                         (LESSP [SETQ VAL (PLUS 10 (DIFFERENCE CODE (CHARCODE "A"]
                                RADIX)
                         VAL])

(ALPHANUMERICP
  [LAMBDA (CHAR)                                             (* lmm "28-Oct-85 20:40")
    (OR (ALPHA-CHAR-P CHAR)
        (NOT (NULL (DIGIT-CHAR-P CHAR])

(UPPER-CASE-P
  [LAMBDA (CHAR)
    (LET ((CODE (fetch (CHARACTER CODE) of CHAR)))
         (OR (AND (GEQ CODE (CHARCODE A))
                  (LEQ CODE (CHARCODE Z)))
             (AND (GREATERP CODE 255)
                  (PROGN                                     (* should know about upper-case greek)
                         NIL])

(LOWER-CASE-P
  [LAMBDA (CHAR)                                             (* lmm " 7-Jul-85 17:10")
    (LET ((CODE (fetch (CHARACTER CODE) of CHAR)))
         (OR (AND (GEQ CODE (CHARCODE a))
                  (LEQ CODE (CHARCODE z)))
             (AND (GREATERP CODE 255)
                  (PROGN                                     (* should know about upper-case greek)
                         NIL])

(BOTH-CASE-P
  [LAMBDA (CHAR)
    (OR (UPPER-CASE-P CHAR)
        (LOWER-CASE-P CHAR])
)
(DEFINEQ

(CHAR-INT
  [LAMBDA (CHAR)
    (CHAR-CODE CHAR])

(INT-CHAR
  [LAMBDA (INTEGER)                                          (* lmm " 7-Jul-85 16:50")
    (CODE-CHAR INTEGER])

(CHAR-BITS
  [LAMBDA (CHAR)
    0])

(CHAR-FONT
  [LAMBDA (CHAR)
    0])

(CHAR-CODE
  [LAMBDA (CHAR)                                             (* raf "23-Oct-85 15:04")
    (fetch (CHARACTER CODE)
           CHAR])

(CODE-CHAR
  [LAMBDA (CODE BITS FONT)                                   (* lmm "12-Jul-85 20:47")
    (COND
       ((AND (OR (NULL BITS)
                 (EQ BITS 0))
             (OR (NULL FONT)
                 (EQ FONT 0))
             (AND (FIXP CODE)
                  (GEQ CODE 0)
                  (LESSP CODE CHAR-CODE-LIMIT)))             (* Unique pointers for character codes)
        (create CHARACTER
               CODE ← CODE])

(NAME-CHAR
  [LAMBDA (NAME)                                             (* lmm "28-Oct-85 20:51")
    (CAR (NLSETQ (INT-CHAR (CHARCODE.DECODE NAME])

(CHAR-NAME
  [LAMBDA (CHAR)                                             (* bvm: "14-May-86 16:19")
    (LET ((CODE (fetch (CHARACTER CODE)
                       CHAR)))
         (COND
            [(for X in CHARACTERNAMES when (EQ (CADR X)
                                               CODE) do (RETURN (CAR X]
            ((NOT (GRAPHIC-CHAR-P CHAR))                     (* All non-graphics must have a name, 
                                                             so invent one)
             (LET ((CSET (LRSH CODE 8)))
                  (SETQ CODE (LOGAND CODE 255))
                  (COND
                     [(EQ CSET 0)
                      (COND
                         [(ILEQ CODE (CHARCODE ↑Z))          (* Control chars)
                          (CONCAT "↑" (ALLOCSTRING 1 (LOGOR CODE (CHARCODE @]
                         (T (CONCAT "0," (OCTALSTRING CODE]
                     (T                                      (* Build extended cset name.
                                                             Separate components with hyphen, 
                                                             rather than comma, so that it can be 
                                                             read back in properly)
                        (CONCAT (for X in CHARACTERSETNAMES when (EQ (CADR X)
                                                                     CSET)
                                   do (RETURN (CAR X)) finally 
                                                             (* No name, use octal)
                                                             (RETURN (OCTALSTRING CSET)))
                               "-"
                               (OCTALSTRING CODE])
)
(DEFINEQ

(CHAR-BIT
  [LAMBDA (CHAR NAME)                                        (* lmm " 7-Jul-85 17:41")
    (ERROR (LIST "Bit " NAME " not supported."])

(SET-CHAR-BIT
  [LAMBDA (CHAR NAME NEWVALUE)                               (* lmm " 7-Jul-85 17:41")
    (ERROR (LIST "Bit " NAME " not supported."])
)
(DEFINEQ

(CHAR-EQUAL
  [CL:LAMBDA (CHAR &REST CHARS)
         (CL:APPLY (FUNCTION CHAR=)
                (CL:MAPCAR (FUNCTION CHAR-UPCASE)
                       (CONS CHAR CHARS])

(CHAR-GREATERP
  [CL:LAMBDA (CHAR &REST CHARS)
         (CL:APPLY (FUNCTION CHAR>)
                (CL:MAPCAR (FUNCTION CHAR-UPCASE)
                       (CONS CHAR CHARS])

(CHAR-LESSP
  [CL:LAMBDA (CHAR &REST CHARS)
         (CL:APPLY (FUNCTION CHAR<)
                (CL:MAPCAR (FUNCTION CHAR-UPCASE)
                       (CONS CHAR CHARS])

(CHAR=
  [LAMBDA N                                                  (* raf "23-Oct-85 15:04")
    (for I from 2 to N always (EQ (fetch (CHARACTER CODE)
                                         (ARG N 1))
                                  (fetch (CHARACTER CODE)
                                         (ARG N I])

(CHAR/=
  [LAMBDA N                                                  (* raf "23-Oct-85 15:05")
    (for I from 1 to N always (for J from (ADD1 I) to N always (NEQ (fetch (CHARACTER CODE)
                                                                           (ARG N I))
                                                                    (fetch (CHARACTER CODE)
                                                                           (ARG N J])

(CHAR<
  [LAMBDA N                                                  (* raf "23-Oct-85 15:05")
    (for J from 2 to N always (LESSP (fetch (CHARACTER CODE)
                                            (ARG N (SUB1 J)))
                                     (fetch (CHARACTER CODE)
                                            (ARG N J])

(CHAR>
  [LAMBDA N                                                  (* raf "23-Oct-85 15:05")
    (for J from 2 to N always (GREATERP (fetch (CHARACTER CODE)
                                               (ARG N (SUB1 J)))
                                     (fetch (CHARACTER CODE)
                                            (ARG N J])

(CHAR>=
  [LAMBDA N                                                  (* raf "23-Oct-85 15:05")
    (for J from 2 to N always (GEQ (fetch (CHARACTER CODE)
                                          (ARG N (SUB1 J)))
                                   (fetch (CHARACTER CODE)
                                          (ARG N J])

(CHAR<=
  [LAMBDA N                                                  (* raf "23-Oct-85 15:06")
    (for J from 2 to N always (LEQ (fetch (CHARACTER CODE)
                                          (ARG N (SUB1 J)))
                                   (fetch (CHARACTER CODE)
                                          (ARG N J])

(CHAR-NOT-EQUAL
  [CL:LAMBDA (CHAR &REST CHARS)
         (CL:APPLY (FUNCTION CHAR/=)
                (CL:MAPCAR (FUNCTION CHAR-UPCASE)
                       (CONS CHAR CHARS])

(CHAR-NOT-GREATERP
  [CL:LAMBDA (CHAR &REST CHARS)
         (CL:APPLY (FUNCTION CHAR<=)
                (CL:MAPCAR (FUNCTION CHAR-UPCASE)
                       (CONS CHAR CHARS])

(CHAR-NOT-LESSP
  [CL:LAMBDA (CHAR &REST CHARS)
         (CL:APPLY (FUNCTION CHAR>=)
                (CL:MAPCAR (FUNCTION CHAR-UPCASE)
                       (CONS CHAR CHARS])
)
(DEFINEQ

(CHARACTER.READ
  [LAMBDA (STREAM)                                           (* bvm: "14-May-86 15:28")
          
          (* * Called by the #\ macro -- reads a character object consisting of the thing 
          next named)

    (INT-CHAR (LET ((NEXTCHAR (READCCODE STREAM)))
                   (COND
                      ((fetch STOPATOM of (\SYNCODE (fetch READSA of (\GTREADTABLE))
                                                 (PEEKCCODE STREAM)))
                                                             (* Terminates next, so it's just this 
                                                             char)
                       NEXTCHAR)
                      (T                                     (* Read a whole name, up to the next 
                                                             break/sepr)
                         (CHARCODE.DECODE (CONCAT (ALLOCSTRING 1 NEXTCHAR)
                                                 (RSTRING STREAM])

(CHARACTER.PRINT
  [LAMBDA (CHAR STREAM)                                      (* bvm: "14-May-86 14:05")
    (LET* ((N (fetch (CHARACTER CODE) of CHAR))
           (PNAME (CHAR-NAME CHAR)))
          [.SPACECHECK. STREAM (IPLUS 2 (COND
                                           (PNAME (NCHARS PNAME))
                                           (T 1]             (* Print as "#\" followed by character 
                                                             name)
          (\OUTCHAR STREAM (fetch (READTABLEP HASHMACROCHAR) of *READTABLE*))
          (\OUTCHAR STREAM (CHARCODE \))
          (COND
             [PNAME (COND
                       ((STRINGP PNAME)
                        (\SOUT PNAME STREAM))
                       (T (LET (*PRINT-ESCAPE*)
                               (\PRINDATUM PNAME STREAM]
             (T (\OUTCHAR STREAM N)))                        (* Return T to say we printed it 
                                                             ourselves)
          T])

(CHARCODE.UNDECODE
  [LAMBDA (CODE)                                             (* bvm: "14-May-86 14:06")
    (CHAR-NAME (INT-CHAR CODE])
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(SETTOPVAL (\TYPEGLOBALVARIABLE (QUOTE CHARACTER)
                  T)
       (NTYPX (CODE-CHAR 0 0 0)))
(DEFPRINT (QUOTE CHARACTER)
       (QUOTE CHARACTER.PRINT))
)

(PUTPROPS CMLCHARACTER FILETYPE COMPILE-FILE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML CHARCODE)

(ADDTOVAR LAMA CHAR-NOT-LESSP CHAR-NOT-GREATERP CHAR-NOT-EQUAL CHAR<= CHAR>= CHAR> CHAR< CHAR/= CHAR= 
                     CHAR-LESSP CHAR-GREATERP CHAR-EQUAL DIGIT-CHAR)
)
(PUTPROPS CMLCHARACTER COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2581 5680 (CHARCODE 2591 . 2654) (CHARCODE.DECODE 2656 . 5678)) (9087 11014 (
CL:CHARACTER 9097 . 9541) (CHAR-DOWNCASE 9543 . 9868) (CHAR-UPCASE 9870 . 10193) (DIGIT-CHAR 10195 . 
10757) (MAKE-CHAR 10759 . 11012)) (11015 15406 (CHARACTERP 11025 . 11171) (STANDARD-CHAR-P 11173 . 
11495) (GRAPHIC-CHAR-P 11497 . 12670) (STRING-CHAR-P 12672 . 12715) (ALPHA-CHAR-P 12717 . 13373) (
DIGIT-CHAR-P 13375 . 14313) (ALPHANUMERICP 14315 . 14504) (UPPER-CASE-P 14506 . 14865) (LOWER-CASE-P 
14867 . 15304) (BOTH-CASE-P 15306 . 15404)) (15407 18314 (CHAR-INT 15417 . 15473) (INT-CHAR 15475 . 
15612) (CHAR-BITS 15614 . 15653) (CHAR-FONT 15655 . 15694) (CHAR-CODE 15696 . 15855) (CODE-CHAR 15857
 . 16319) (NAME-CHAR 16321 . 16489) (CHAR-NAME 16491 . 18312)) (18315 18647 (CHAR-BIT 18325 . 18482) (
SET-CHAR-BIT 18484 . 18645)) (18648 22068 (CHAR-EQUAL 18658 . 18833) (CHAR-GREATERP 18835 . 19013) (
CHAR-LESSP 19015 . 19190) (CHAR= 19192 . 19541) (CHAR/= 19543 . 20045) (CHAR< 20047 . 20415) (CHAR> 
20417 . 20791) (CHAR>= 20793 . 21154) (CHAR<= 21156 . 21517) (CHAR-NOT-EQUAL 21519 . 21699) (
CHAR-NOT-GREATERP 21701 . 21884) (CHAR-NOT-LESSP 21886 . 22066)) (22069 24330 (CHARACTER.READ 22079 . 
23112) (CHARACTER.PRINT 23114 . 24168) (CHARCODE.UNDECODE 24170 . 24328)))))
STOP