anchor.diff:  (CL:PROGN (CL:DEFUN STRING== (A B) (CL:STRING= A B)) (CL:SETF (CL:GETHASH 'STRING== *BUILTIN-ATOMS*) #'STRING==))
   (CL:PROGN (CL:DEFUN LIST-STRING (X) (CL:APPLY #'CL:CONCATENATE 'CL:STRING (CL:MAPCAR (CL:LAMBDA (X) (CL:STRING (CL:COND ((CL:NUMBERP X) (CL:CODE-CHAR X)) (T X)))) X))) (CL:SETF (CL:GETHASH 'LIST-STRING *BUILTIN-ATOMS*) #'LIST-STRING))
   (CL:DEFVAR *SPECIAL-FORMS*)
  -(CL:DEFUN SPECIAL-%%MACROCALL (X) (CL:LABELS ((~G1529 (!) (CL:APPLY (CL:CDR !) (ARGUMENT-EXPAND-VALUES (CL:CAR X) (CL:CAR !) (CL:CDR X))))) (~G1529 (CL:CDR (ASSOC (CL:CAR X) *SPECIAL-FORMS* :TEST #'EQ)))))
  +(CL:DEFUN SPECIAL-%%MACROCALL (X) (CL:LABELS ((~G1531 (!) (CL:APPLY (CL:CDR !) (ARGUMENT-EXPAND-VALUES (CL:CAR X) (CL:CAR !) (CL:CDR X))))) (~G1531 (CL:CDR (ASSOC (CL:CAR X) *SPECIAL-FORMS* :TEST #'EQ)))))
   (CL:DEFUN SPECIAL-%%MACRO? (X) (CL:COND ((CONS? X) (CL:COND ((SYMBOL? (CL:CAR X)) (ASSOC (CL:CAR X) *SPECIAL-FORMS* :TEST #'EQ))))))
  -(CL:DEFUN SPECIALEXPAND (X) (CL:LABELS ((~G1530 (~G1473) (CL:PROGN (CL:SETQ *MACRO?* #'SPECIAL-%%MACRO?)) (CL:LABELS ((~G1531 (~G1475) (CL:PROGN (CL:SETQ *MACRO?* ~G1473)) ~G1475)) (~G1531 (CL:PROGN (CL:LABELS ((~G1532 (~G1474) (CL:PROGN (CL:SETQ *MACROCALL* #'SPECIAL-%%MACROCALL)) (CL:LABELS ((~G1533 (~G1476) (CL:PROGN (CL:SETQ *MACROCALL* ~G1474)) ~G1476)) (~G1533 (CL:PROGN (CL:LABELS ((F (OLD X) (CL:COND ((EQUAL OLD X) X) (T (F X (%MACROEXPAND X)))))) (F X (%MACROEXPAND X)))))))) (~G1532 *MACROCALL*))))))) (~G1530 *MACRO?*)))
  +(CL:DEFUN SPECIALEXPAND (X) (CL:LABELS ((~G1532 (~G1474) (CL:PROGN (CL:SETQ *MACRO?* #'SPECIAL-%%MACRO?)) (CL:LABELS ((~G1533 (~G1476) (CL:PROGN (CL:SETQ *MACRO?* ~G1474)) ~G1476)) (~G1533 (CL:PROGN (CL:LABELS ((~G1534 (~G1475) (CL:PROGN (CL:SETQ *MACROCALL* #'SPECIAL-%%MACROCALL)) (CL:LABELS ((~G1535 (~G1477) (CL:PROGN (CL:SETQ *MACROCALL* ~G1475)) ~G1477)) (~G1535 (CL:PROGN (CL:LABELS ((F (OLD X) (CL:COND ((EQUAL OLD X) X) (T (F X (%MACROEXPAND X)))))) (F X (%MACROEXPAND X)))))))) (~G1534 *MACROCALL*))))))) (~G1532 *MACRO?*)))
   (CL:DEFUN MAKE-%DEFUN-QUIET (NAME ARGS BODY) `(CL:PROGN (CL:PUSH (CL:CONS ',NAME ',(CL:CONS ARGS BODY)) *FUNCTIONS*) (CL:DEFUN ,NAME ,ARGS ,@BODY)))
   (CL:DEFVAR *KEYWORD-PACKAGE*)
   (CL:PROGN (CL:DEFUN MAKE-SYMBOL (X CL:&OPTIONAL (PACKAGE NIL)) (CL:INTERN X (CL:COND ((CL:NOT PACKAGE) "TRE") ((CL:PACKAGEP PACKAGE) (CL:PACKAGE-NAME PACKAGE)) ((CL:SYMBOLP PACKAGE) (CL:SYMBOL-NAME PACKAGE)) (T PACKAGE)))) (CL:SETF (CL:GETHASH 'MAKE-SYMBOL *BUILTIN-ATOMS*) #'MAKE-SYMBOL))
  
positive.code: (CL:DEFUN STREAM-LOCATION-ID (ARR) (CL:BLOCK STREAM-LOCATION-ID (CL:BLOCK NIL (CL:AREF ARR 3))))
  (CL:DEFUN STREAM-LOCATION-TRACK? (ARR) (CL:BLOCK STREAM-LOCATION-TRACK? (CL:BLOCK NIL (CL:AREF ARR 2))))
  (CL:DEFUN =-STREAM-LAST-CHAR (VAL ARR) (CL:BLOCK =-STREAM-LAST-CHAR (CL:BLOCK NIL (CL:PROGN (=-AREF VAL ARR 6)))))
  (CL:DEFUN %FORMAT-DIRECTIVE (INF TXT ARGS) (CL:BLOCK %FORMAT-DIRECTIVE (CL:BLOCK NIL (CL:PROGN (=-FORMAT-INFO-PROCESSED-ARGS (NUMBER+ (FORMAT-INFO-PROCESSED-ARGS INF) 1) INF)) (CL:LABELS ((~G1571 (~G318) (CL:COND ((CHARACTER== ~G318 #\%) (%FORMAT-DIRECTIVE-EOL INF (CL:CDR TXT) ARGS)) ((CHARACTER== ~G318 #\A) (%FORMAT-DIRECTIVE-PLACEHOLDER INF (CL:CDR TXT) ARGS)) ((CHARACTER== ~G318 #\F) (%FORMAT-DIRECTIVE-FORCE-OUTPUT INF (CL:CDR TXT) ARGS)) (T (%FORMAT-DIRECTIVE-TILDE INF TXT ARGS))))) (~G1571 (CHAR-UPCASE (CL:CAR TXT)))))))
  (CL:DEFUN %FORMAT-DIRECTIVE-TILDE (INF TXT ARGS) (CL:BLOCK %FORMAT-DIRECTIVE-TILDE (CL:BLOCK NIL (PRINC #\~ (FORMAT-INFO-STREAM INF)) (%FORMAT INF TXT ARGS))))
  (CL:DEFUN %FORMAT-DIRECTIVE-FORCE-OUTPUT (INF TXT ARGS) (CL:BLOCK %FORMAT-DIRECTIVE-FORCE-OUTPUT (CL:BLOCK NIL (FORCE-OUTPUT (FORMAT-INFO-STREAM INF)) (%FORMAT INF TXT ARGS))))
  (CL:DEFUN FORCE-OUTPUT (CL:&OPTIONAL (STR *STANDARD-OUTPUT*)) (CL:BLOCK FORCE-OUTPUT (CL:BLOCK NIL (%FORCE-OUTPUT (STREAM-HANDLE STR)))))
  (CL:DEFUN STREAM-HANDLE (ARR) (CL:BLOCK STREAM-HANDLE (CL:BLOCK NIL (CL:AREF ARR 2))))
  (CL:DEFUN %FORMAT-DIRECTIVE-PLACEHOLDER (INF TXT ARGS) (CL:BLOCK %FORMAT-DIRECTIVE-PLACEHOLDER (CL:BLOCK NIL (CL:COND (ARGS (CL:COND ((CONS? (CL:CAR ARGS)) (LATE-PRINT (CL:CAR ARGS) (FORMAT-INFO-STREAM INF))) (T (PRINC (CL:CAR ARGS) (FORMAT-INFO-STREAM INF))))) (T (ERROR "Argument ~A specified in format \"~A\" is missing." (FORMAT-INFO-PROCESSED-ARGS INF) (FORMAT-INFO-TEXT INF)))) (%FORMAT INF TXT (CL:CDR ARGS)))))
  (CL:DEFUN FORMAT-INFO-TEXT (ARR) (CL:BLOCK FORMAT-INFO-TEXT (CL:BLOCK NIL (CL:AREF ARR 3))))
  (CL:DEFUN LATE-PRINT (X CL:&OPTIONAL (STR *STANDARD-OUTPUT*) (PRINT-INFO NIL)) (CL:BLOCK LATE-PRINT (CL:BLOCK NIL (CL:LABELS ((~G1572 (~G220) (CL:LABELS ((~G1573 (S) (CL:LABELS ((~G1574 (~G221) (CL:COND (~G220 ~G221) (T (GET-STREAM-STRING S))))) (~G1574 (CL:PROGN (%LATE-PRINT X S (CL:LABELS ((~G1575 (~G219) (CL:COND (~G219 ~G219) (T (MAKE-PRINT-INFO))))) (~G1575 PRINT-INFO))) (CL:COND (*PRINT-AUTOMATIC-NEWLINE?* (CL:PROGN (TERPRI S))))))))) (~G1573 (DEFAULT-STREAM ~G220))))) (~G1572 STR)) X)))
  (CL:DEFUN TERPRI (CL:&OPTIONAL (STR *STANDARD-OUTPUT*)) (CL:BLOCK TERPRI (CL:BLOCK NIL (CL:LABELS ((~G1576 (~G175) (CL:LABELS ((~G1577 (S) (CL:LABELS ((~G1578 (~G176) (CL:COND (~G175 ~G176) (T (GET-STREAM-STRING S))))) (~G1578 (CL:PROGN (STREAM-PRINC (CODE-CHAR 10) S) (FORCE-OUTPUT S) NIL))))) (~G1577 (DEFAULT-STREAM ~G175))))) (~G1576 STR)))))
  (CL:DEFUN MAKE-PRINT-INFO (CL:&KEY (PRETTY-PRINT? 'PRETTY-PRINT?) (DOWNCASE? 'DOWNCASE?) (INDENTATION 'INDENTATION) (NO-PADDING? 'NO-PADDING?)) (CL:BLOCK MAKE-PRINT-INFO (CL:BLOCK NIL (CL:LABELS ((~G1579 (~G190) (CL:PROGN (=-AREF 'STRUCT ~G190 0) (=-AREF 'PRINT-INFO ~G190 1)) (CL:PROGN (=-AREF (CL:COND ((EQ PRETTY-PRINT? 'PRETTY-PRINT?) NIL) (T PRETTY-PRINT?)) ~G190 2)) (CL:PROGN (=-AREF (CL:COND ((EQ DOWNCASE? 'DOWNCASE?) NIL) (T DOWNCASE?)) ~G190 3)) (CL:PROGN (=-AREF (CL:COND ((EQ INDENTATION 'INDENTATION) 0) (T INDENTATION)) ~G190 4)) (CL:PROGN (=-AREF (CL:COND ((EQ NO-PADDING? 'NO-PADDING?) T) (T NO-PADDING?)) ~G190 5)) ~G190)) (~G1579 (MAKE-ARRAY 6))))))
  (CL:DEFUN %LATE-PRINT (X STR INFO) (CL:BLOCK %LATE-PRINT (CL:BLOCK NIL (CL:COND ((CONS? X) (%PRINT-CONS X STR INFO)) (T (%PRINT-ATOM X STR INFO))))))
  (CL:DEFUN %PRINT-ATOM (X STR INFO) (CL:BLOCK %PRINT-ATOM (CL:BLOCK NIL (CL:PROGN (CL:COND ((PRINT-INFO-NO-PADDING? INFO) (CL:PROGN (=-PRINT-INFO-NO-PADDING? NIL INFO))) (T (PRINC " " STR))) (CL:LABELS ((~G1580 (~G218) (CL:COND ((SYMBOL? ~G218) (%PRINT-SYMBOL X STR INFO)) ((CHARACTER? ~G218) (%PRINT-CHARACTER X STR)) ((NUMBER? ~G218) (PRINC X STR)) ((STRING? ~G218) (%PRINT-STRING X STR)) ((ARRAY? ~G218) (%PRINT-ARRAY X STR INFO)) ((FUNCTION? ~G218) (%PRINT-FUNCTION X STR INFO)) ((OBJECT? ~G218) (%PRINT-OBJECT X STR INFO)) (T "UNKNOWN OBJECT")))) (~G1580 X))))))
  (CL:DEFUN %PRINT-OBJECT (X STR INFO) (CL:BLOCK %PRINT-OBJECT (CL:BLOCK NIL)))
  (CL:DEFUN OBJECT? (X) (CL:BLOCK OBJECT? (CL:BLOCK NIL X NIL)))
  (CL:DEFUN %PRINT-FUNCTION (X STR INFO) (CL:BLOCK %PRINT-FUNCTION (CL:BLOCK NIL (PRINC "#'" STR) (%LATE-PRINT (CL:CONS (FUNCTION-ARGUMENTS X) (FUNCTION-BODY X)) STR INFO))))
  (CL:DEFUN FUNCTION-BODY (FUN) (CL:BLOCK FUNCTION-BODY (CL:BLOCK NIL (CL:COND ((FUNCTION-BYTECODE FUN) (CL:AREF (FUNCTION-BYTECODE FUN) 1)) (T (CL:CDR (FUNCTION-SOURCE FUN)))))))
  (CL:DEFUN FUNCTION-ARGUMENTS (FUN) (CL:BLOCK FUNCTION-ARGUMENTS (CL:BLOCK NIL (CL:COND ((BUILTIN? FUN) (CL:CONS 'CL:&REST (CL:CONS 'ARGS-TO-BUILTIN NIL))) ((FUNCTION-BYTECODE FUN) (CL:AREF (FUNCTION-BYTECODE FUN) 0)) (T (CL:CAR (FUNCTION-SOURCE FUN)))))))
  (CL:DEFUN %PRINT-ARRAY (X STR INFO) (CL:BLOCK %PRINT-ARRAY (CL:BLOCK NIL (PRINC "#" STR) (CL:PROGN (CL:COND ((PRINT-INFO-NO-PADDING? INFO) (CL:PROGN (=-PRINT-INFO-NO-PADDING? NIL INFO))) (T (PRINC " " STR))) (PRINC "(" STR) (CL:PROGN (=-PRINT-INFO-NO-PADDING? T INFO)) (CL:LABELS ((~G1581 (~G214) (CL:COND (~G214 (CL:PROGN (CL:LABELS ((~G1582 (~G216) (CL:BLOCK NIL (CL:LABELS ((~G1583 (~G215) (CL:TAGBODY ~G217 (CL:COND ((INTEGER== ~G215 ~G216) (CL:RETURN-FROM NIL (CL:PROGN)))) (CL:LABELS ((~G1584 (I) (%LATE-PRINT I STR INFO))) (~G1584 (CL:AREF ~G214 ~G215))) (CL:SETQ ~G215 (INTEGER+ 1 ~G215)) (CL:GO ~G217)))) (~G1583 0))))) (~G1582 (INTEGER (CL:LENGTH ~G214))))))))) (~G1581 X)) (PRINC ")" STR)))))
  (CL:DEFUN %PRINT-STRING (X STR) (CL:BLOCK %PRINT-STRING (CL:BLOCK NIL (PRINC #\" STR) (CL:BLOCK NIL (CL:LABELS ((~G1585 (~G206) (CL:LABELS ((~G1586 (I) (CL:TAGBODY ~G204 (CL:COND ((NOT ~G206) (CL:GO ~G205))) (CL:SETQ I (CL:CAR ~G206)) (CL:COND ((== I #\") (PRINC "\\\"" STR)) ((== I #\\) (PRINC "\\\\" STR)) (T (PRINC I STR))) (CL:SETQ ~G206 (CL:CDR ~G206)) (CL:GO ~G204) ~G205 (CL:RETURN-FROM NIL (CL:PROGN))))) (~G1586 NIL)))) (~G1585 (STRING-LIST X)))) (PRINC #\" STR))))
  (CL:DEFUN %PRINT-CHARACTER (X STR) (CL:BLOCK %PRINT-CHARACTER (CL:BLOCK NIL (PRINC "#\\" STR) (PRINC X STR))))
  (CL:DEFUN %PRINT-SYMBOL (X STR INFO) (CL:BLOCK %PRINT-SYMBOL (CL:BLOCK NIL (CL:COND ((NOT (CL:LABELS ((~G1587 (~G211) (CL:COND (~G211 ~G211) (T (EQ T X))))) (~G1587 (NOT X)))) (CL:PROGN (CL:LABELS ((~G1588 (!) (CL:COND (! (CL:PROGN (CL:LABELS ((~G1589 (!) (CL:COND ((NOT (CL:COND ((NOT *ALWAYS-PRINT-PACKAGE-NAMES?*) (CL:LABELS ((~G1590 (~G212) (CL:COND (~G212 ~G212) (T (STRING== ! "TRE-CORE"))))) (~G1590 (STRING== ! "TRE")))))) (CL:PROGN (CL:LABELS ((~G1591 (~G213) (CL:COND (~G213 ~G213) (T (%PRINT-SYMBOL-PACKAGE ! STR))))) (~G1591 (KEYWORD? X))) (PRINC #\: STR)))))) (~G1589 (CL:PACKAGE-NAME !)))))))) (~G1588 (SYMBOL-PACKAGE X)))))) (%PRINT-SYMBOL-COMPONENT (SYMBOL-NAME X) STR))))
  (CL:DEFUN %PRINT-SYMBOL-COMPONENT (X STR) (CL:BLOCK %PRINT-SYMBOL-COMPONENT (CL:BLOCK NIL (CL:COND ((SOME #'SYMBOL-CHAR-NEEDS-ESCAPING? (STRING-LIST X)) (%PRINT-ESCAPED-SYMBOL X STR)) (T (PRINC X STR))))))
  (CL:DEFUN %PRINT-ESCAPED-SYMBOL (X STR) (CL:BLOCK %PRINT-ESCAPED-SYMBOL (CL:BLOCK NIL (PRINC #\| STR) (CL:BLOCK NIL (CL:LABELS ((~G1592 (~G209) (CL:LABELS ((~G1593 (I) (CL:TAGBODY ~G207 (CL:COND ((NOT ~G209) (CL:GO ~G208))) (CL:SETQ I (CL:CAR ~G209)) (CL:COND ((== I #\|) (PRINC "\\|" STR)) (T (PRINC I STR))) (CL:SETQ ~G209 (CL:CDR ~G209)) (CL:GO ~G207) ~G208 (CL:RETURN-FROM NIL (CL:PROGN))))) (~G1593 NIL)))) (~G1592 (STRING-LIST X)))) (PRINC #\| STR))))
  (CL:DEFUN SYMBOL-CHAR-NEEDS-ESCAPING? (X) (CL:BLOCK SYMBOL-CHAR-NEEDS-ESCAPING? (CL:BLOCK NIL (CL:LABELS ((~G1594 (~G210) (CL:COND (~G210 ~G210) (T (LOWER-CASE? X))))) (~G1594 (== #\| X))))))
  (CL:DEFUN LOWER-CASE? (CL:&REST ~G64) (CL:BLOCK LOWER-CASE? (CL:BLOCK NIL (CL:BLOCK NIL (CL:LABELS ((~G1595 (~G68) (CL:LABELS ((~G1596 (C) (CL:TAGBODY ~G66 (CL:COND ((NOT ~G68) (CL:GO ~G67))) (CL:SETQ C (CL:CAR ~G68)) (CL:LABELS ((~G1597 (~G65) (CL:COND (~G65 ~G65) (T (CL:RETURN-FROM NIL NIL))))) (~G1597 (RANGE? C #\a #\z))) (CL:SETQ ~G68 (CL:CDR ~G68)) (CL:GO ~G66) ~G67 (CL:RETURN-FROM NIL (CL:PROGN T))))) (~G1596 NIL)))) (~G1595 ~G64))))))
  (CL:DEFUN RANGE? (X BOTTOM TOP) (CL:BLOCK RANGE? (CL:BLOCK NIL (CL:COND ((>= X BOTTOM) (<= X TOP))))))
  (CL:DEFUN >= (N CL:&REST X) (CL:BLOCK >= (CL:BLOCK NIL (CL:BLOCK NIL (CL:LABELS ((~G1598 (~G13) (CL:LABELS ((~G1599 (I) (CL:TAGBODY ~G11 (CL:COND ((NOT ~G13) (CL:GO ~G12))) (CL:SETQ I (CL:CAR ~G13)) (CL:LABELS ((~G1600 (~G9) (CL:COND (~G9 ~G9) (T (CL:LABELS ((~G1601 (~G10) (CL:COND (~G10 ~G10) (T (CL:RETURN-FROM NIL NIL))))) (~G1601 (> N I))))))) (~G1600 (== N I))) (CL:SETQ N I) (CL:SETQ ~G13 (CL:CDR ~G13)) (CL:GO ~G11) ~G12 (CL:RETURN-FROM NIL (CL:PROGN T))))) (~G1599 NIL)))) (~G1598 X))))))
  (CL:DEFUN SOME (PRED CL:&REST SEQS) (CL:BLOCK SOME (CL:BLOCK NIL (FIND-IF PRED (CL:APPLY #'APPEND SEQS)))))
  (CL:DEFUN FIND-IF (PRED SEQ CL:&KEY (START NIL) (END NIL) (FROM-END NIL) (WITH-INDEX NIL)) (CL:BLOCK FIND-IF (CL:BLOCK NIL (CL:COND ((NOT (CL:ATOM SEQ) START END) (%FIND-IF-LIST PRED SEQ FROM-END WITH-INDEX)) (T (%FIND-IF-SEQUENCE PRED SEQ START END FROM-END WITH-INDEX))))))
  (CL:DEFUN %FIND-IF-SEQUENCE (PRED SEQ START END FROM-END WITH-INDEX) (CL:BLOCK %FIND-IF-SEQUENCE (CL:BLOCK NIL (CL:COND (SEQ (CL:COND ((< 0 (CL:LENGTH SEQ)) (CL:LABELS ((~G1602 (E) (CL:LABELS ((~G1603 (S) (CL:COND ((CL:LABELS ((~G1604 (~G101) (CL:COND (~G101 ~G101) (T (CL:COND ((< S E) FROM-END)))))) (~G1604 (CL:COND ((> S E) (NOT FROM-END))))) (CL:LABELS ((~G1605 (~G102) (CL:PROGN (CL:SETQ S E) (CL:SETQ E ~G102)))) (~G1605 S)))) (CL:BLOCK NIL (CL:LABELS ((~G1606 (I) (CL:TAGBODY ~G103 (CL:COND ((CL:COND (FROM-END (< I E)) (T (> I E))) (CL:RETURN-FROM NIL (CL:PROGN)))) (CL:LABELS ((~G1607 (!) (CL:COND ((CL:APPLY PRED (CL:CONS ! (CL:COND (WITH-INDEX (CL:LIST I))))) (CL:RETURN-FROM NIL !))))) (~G1607 (ELT SEQ I))) (CL:SETQ I (CL:COND (FROM-END (-- I)) (T (++ I)))) (CL:GO ~G103)))) (~G1606 S))))) (~G1603 (CL:LABELS ((~G1608 (~G100) (CL:COND (~G100 ~G100) (T 0)))) (~G1608 START)))))) (~G1602 (CL:LABELS ((~G1609 (~G99) (CL:COND (~G99 ~G99) (T (-- (CL:LENGTH SEQ)))))) (~G1609 END)))))))))))
  (CL:DEFUN %FIND-IF-LIST (PRED SEQ FROM-END WITH-INDEX) (CL:BLOCK %FIND-IF-LIST (CL:BLOCK NIL (CL:LABELS ((~G1610 (!) (CL:COND (WITH-INDEX (CL:LABELS ((~G1611 (IDX) (CL:BLOCK NIL (CL:LABELS ((~G1612 (~G95) (CL:LABELS ((~G1613 (!) (CL:TAGBODY ~G93 (CL:COND ((NOT ~G95) (CL:GO ~G94))) (CL:SETQ ! (CL:CAR ~G95)) (CL:COND ((FUNCALL PRED ! IDX) (CL:RETURN-FROM NIL !))) (CL:PROGN (CL:SETQ IDX (NUMBER+ IDX 1))) (CL:SETQ ~G95 (CL:CDR ~G95)) (CL:GO ~G93) ~G94 (CL:RETURN-FROM NIL (CL:PROGN NIL))))) (~G1613 NIL)))) (~G1612 !))))) (~G1611 0))) (T (CL:BLOCK NIL (CL:LABELS ((~G1614 (~G98) (CL:LABELS ((~G1615 (!) (CL:TAGBODY ~G96 (CL:COND ((NOT ~G98) (CL:GO ~G97))) (CL:SETQ ! (CL:CAR ~G98)) (CL:COND ((FUNCALL PRED !) (CL:RETURN-FROM NIL !))) (CL:SETQ ~G98 (CL:CDR ~G98)) (CL:GO ~G96) ~G97 (CL:RETURN-FROM NIL (CL:PROGN NIL))))) (~G1615 NIL)))) (~G1614 !))))))) (~G1610 (CL:COND (FROM-END (REVERSE SEQ)) (T SEQ)))))))
  (CL:DEFUN %PRINT-SYMBOL-PACKAGE (NAME STR) (CL:BLOCK %PRINT-SYMBOL-PACKAGE (CL:BLOCK NIL (%PRINT-SYMBOL-COMPONENT (CL:COND ((STRING== "COMMON-LISP" NAME) "CL") (T NAME)) STR))))
  (CL:DEFUN KEYWORD? (X) (CL:BLOCK KEYWORD? (CL:BLOCK NIL (CL:COND ((SYMBOL? X) (EQ *KEYWORD-PACKAGE* (SYMBOL-PACKAGE X)))))))
  (CL:DEFUN =-PRINT-INFO-NO-PADDING? (VAL ARR) (CL:BLOCK =-PRINT-INFO-NO-PADDING? (CL:BLOCK NIL (CL:PROGN (=-AREF VAL ARR 5)))))
  (CL:DEFUN PRINT-INFO-NO-PADDING? (ARR) (CL:BLOCK PRINT-INFO-NO-PADDING? (CL:BLOCK NIL (CL:AREF ARR 5))))
  (CL:DEFUN %PRINT-CONS (X STR INFO) (CL:BLOCK %PRINT-CONS (CL:BLOCK NIL (CL:LABELS ((~G1616 (!) (CL:COND (! (%PRINT-ABBREVIATION ! X STR INFO)) (T (%PRINT-LIST X STR INFO))))) (~G1616 (ASSOC (CL:CAR X) *PRINTER-ABBREVIATIONS* :TEST #'EQ))))))
  (CL:DEFUN %PRINT-LIST (X STR INFO) (CL:BLOCK %PRINT-LIST (CL:BLOCK NIL (CL:PROGN (CL:COND ((PRINT-INFO-NO-PADDING? INFO) (CL:PROGN (=-PRINT-INFO-NO-PADDING? NIL INFO))) (T (PRINC " " STR))) (PRINC "(" STR) (CL:PROGN (=-PRINT-INFO-NO-PADDING? T INFO)) (%LATE-PRINT (CL:CAR X) STR INFO) (CL:LABELS ((~G1617 (!) (CL:COND (! (%PRINT-CALL (CL:CDR X) ! STR INFO)) (T (%PRINT-REST (CL:CDR X) STR INFO))))) (~G1617 (%PRINT-CALL? X INFO))) (PRINC ")" STR)))))
  (CL:DEFUN %PRINT-REST (X STR INFO) (CL:BLOCK %PRINT-REST (CL:BLOCK NIL (CL:COND (X (CL:PROGN (CL:COND ((CONS? X) (CL:PROGN (%LATE-PRINT (CL:CAR X) STR INFO) (%PRINT-REST (CL:CDR X) STR INFO))) (T (CL:PROGN (PRINC " . " STR) (%PRINT-ATOM X STR INFO))))))))))
  (CL:DEFUN %PRINT-CALL (X ARGDEF STR INFO) (CL:BLOCK %PRINT-CALL (CL:BLOCK NIL (%PRINT-ARGS (%PRINT-GET-ARGS X ARGDEF) STR INFO))))
  (CL:DEFUN %PRINT-GET-ARGS (ARGS DEF) (CL:BLOCK %PRINT-GET-ARGS (CL:BLOCK NIL (ARGUMENT-EXPAND 'CL:PRINT DEF ARGS :CONCATENATE-SUBLISTS? NIL))))
  (CL:DEFUN ARGUMENT-EXPAND (FUN DEF VALS CL:&KEY (APPLY-VALUES? T) (CONCATENATE-SUBLISTS? T)) (CL:BLOCK ARGUMENT-EXPAND (CL:BLOCK NIL (CL:COND (APPLY-VALUES? (ARGUMENT-EXPAND-0 FUN DEF VALS APPLY-VALUES? CONCATENATE-SUBLISTS?)) (T (CARLIST (ARGUMENT-EXPAND-0 FUN DEF VALS APPLY-VALUES? CONCATENATE-SUBLISTS?)))))))
  (CL:DEFUN CARLIST (~G126) (CL:BLOCK CARLIST (CL:BLOCK NIL (FILTER #'CL:CAR ~G126))))
  (CL:DEFUN ARGUMENT-EXPAND-0 (FUN ADEF ALST APPLY-VALUES? CONCATENATE-SUBLISTS?) (CL:BLOCK ARGUMENT-EXPAND-0 (CL:BLOCK NIL (CL:LABELS ((~G1618 (~G185) (CL:LABELS ((~G1619 (~G186) (CL:COND ((NOT (EQ (CL:CAR ~G185) 'VALUES)) (CL:PROGN (ERROR "VALUES expected instead of ~A." ~G185)))) (CL:LABELS ((~G1620 (A) (CL:LABELS ((~G1621 (~G187) (CL:LABELS ((~G1622 (K) (CL:LABELS ((~G1623 (ARGDEFS) (CL:LABELS ((~G1624 (KEY-ARGS) (CL:LABELS ((~G1625 (NUM) (CL:LABELS ((~G1626 (NO-STATIC) (CL:LABELS ((~G1627 (REST-ARG) (CL:LABELS ((ERR (MSG ARGS) (ERROR "; Call of function ~A: ~A~%; Argument definition: ~A~%; Given arguments: ~A~%" (SYMBOL-NAME FUN) (CL:APPLY #'FORMAT NIL MSG ARGS) ADEF ALST)) (EXP-STATIC (DEF VALS) (CL:COND (NO-STATIC (ERR "static argument definition after ~A" (CL:LIST NO-STATIC)))) (CL:COND (APPLY-VALUES? (CL:COND ((NOT VALS) (ERR "argument ~A missing" (CL:LIST NUM)))))) (CL:CONS (CL:CONS (ARGDEF-GET-NAME (CL:CAR DEF)) (CL:CAR VALS)) (EXP-MAIN (CL:CDR DEF) (CL:CDR VALS)))) (EXP-OPTIONAL (DEF VALS) (CL:COND ((ARGUMENT-KEYWORD? (CL:CAR DEF)) (ERR "Keyword ~A after &OPTIONAL" (CL:LIST (CL:CAR DEF))))) (CL:PROGN (CL:SETQ NO-STATIC 'CL:&OPTIONAL)) (CL:CONS (CL:CONS (ARGDEF-GET-NAME (CL:CAR DEF)) (ARGDEF-GET-VALUE DEF VALS)) (CL:COND ((ARGUMENT-KEYWORD? (CL:CAR (CL:CDR DEF))) (EXP-MAIN (CL:CDR DEF) (CL:CDR VALS))) ((CL:CDR DEF) (EXP-OPTIONAL (CL:CDR DEF) (CL:CDR VALS))) (T (EXP-MAIN (CL:CDR DEF) (CL:CDR VALS)))))) (EXP-KEY (DEF VALS) (CL:LABELS ((~G1628 (K) (CL:COND (K (CL:LABELS ((~G1629 (!) (CL:RPLACD K (CL:CAR (CL:CDR !))) (EXP-MAIN DEF (CL:CDR (CL:CDR !))))) (~G1629 VALS))) (T (EXP-MAIN-NON-KEY DEF VALS))))) (~G1628 (ASSOC ($ (CL:CAR VALS)) KEY-ARGS :TEST #'EQ)))) (EXP-REST (DEF VALS) (CL:PROGN (CL:SETQ NO-STATIC 'CL:&REST)) (CL:PROGN (CL:SETQ REST-ARG (CL:LIST (CL:CONS (ARGDEF-GET-NAME (CL:CAR (CL:CDR DEF))) (CL:CONS '%REST VALS))))) NIL) (EXP-OPTIONAL-REST (DEF VALS) (CL:LABELS ((~G1630 (~G183) (CL:COND ((EQ ~G183 'CL:&REST) (EXP-REST DEF VALS)) ((EQ ~G183 'CL:&BODY) (EXP-REST DEF VALS)) ((EQ ~G183 'CL:&OPTIONAL) (EXP-OPTIONAL (CL:CDR DEF) VALS))))) (~G1630 (CL:CAR DEF)))) (EXP-SUB (DEF VALS) (CL:COND (NO-STATIC (ERR "static sublevel argument definition after ~A" (CL:LIST NO-STATIC)))) (CL:COND (APPLY-VALUES? (CL:COND ((CL:ATOM (CL:CAR VALS)) (ERR "sublist expected for argument ~A" (CL:LIST NUM)))))) (CL:COND (CONCATENATE-SUBLISTS? (%NCONC (ARGUMENT-EXPAND-0 FUN (CL:CAR DEF) (CL:CAR VALS) APPLY-VALUES? CONCATENATE-SUBLISTS?) (EXP-MAIN (CL:CDR DEF) (CL:CDR VALS)))) (T (CL:CONS (CL:CONS NIL (ARGUMENT-EXPAND-0 FUN (CL:CAR DEF) (CL:CAR VALS) APPLY-VALUES? CONCATENATE-SUBLISTS?)) (EXP-MAIN (CL:CDR DEF) (CL:CDR VALS)))))) (EXP-CHECK-TOO-MANY (DEF VALS) (CL:COND ((NOT DEF) (CL:COND (VALS (ERR "too many arguments. ~A max, but ~A more given" (CL:LIST (CL:LENGTH ARGDEFS) (CL:LENGTH VALS)))))))) (EXP-MAIN-NON-KEY (DEF VALS) (EXP-CHECK-TOO-MANY DEF VALS) (CL:COND ((ARGUMENT-KEYWORD? (CL:CAR DEF)) (EXP-OPTIONAL-REST DEF VALS)) ((NOT (ARGUMENT-NAME? (CL:CAR DEF))) (EXP-SUB DEF VALS)) (T (EXP-STATIC DEF VALS)))) (EXP-MAIN (DEF VALS) (CL:PROGN (CL:SETQ NUM (NUMBER+ NUM 1))) (CL:COND ((KEYWORD? (CL:CAR VALS)) (EXP-KEY DEF VALS)) (T (CL:LABELS ((~G1631 (~G184) (CL:COND (~G184 ~G184) (T (CL:COND (DEF (EXP-MAIN-NON-KEY DEF VALS))))))) (~G1631 (EXP-CHECK-TOO-MANY DEF VALS))))))) (%NCONC (EXP-MAIN ARGDEFS ALST) (%NCONC KEY-ARGS REST-ARG))))) (~G1627 NIL)))) (~G1626 NIL)))) (~G1625 0)))) (~G1624 K)))) (~G1623 A)))) (~G1622 (CL:CAR ~G187))))) (~G1621 (CL:LABELS ((~G1632 (~G189) (CL:COND (~G189 ~G189) (T (%ERROR "Not enough VALUES."))))) (~G1632 (CL:CDR ~G186))))))) (~G1620 (CL:CAR ~G186))))) (~G1619 (CL:CDR ~G185))))) (~G1618 (MAKE-&KEY-ALIST ADEF))))))
  (CL:DEFUN ARGUMENT-NAME? (X) (CL:BLOCK ARGUMENT-NAME? (CL:BLOCK NIL (CL:ATOM X))))
  (CL:DEFUN $ (CL:&REST ARGS) (CL:BLOCK $ (CL:BLOCK NIL (MAKE-SYMBOL (CL:APPLY #'+ (CL:MAPCAR #'STRING ARGS))))))
  (CL:DEFUN ARGDEF-GET-VALUE (DEFS VALS) (CL:BLOCK ARGDEF-GET-VALUE (CL:BLOCK NIL (CL:COND ((CONS? VALS) (CL:CAR VALS)) ((CONS? (CL:CAR DEFS)) (CADR (CL:CAR DEFS))) (T (CL:CAR DEFS))))))
  (CL:DEFUN ARGUMENT-KEYWORD? (X) (CL:BLOCK ARGUMENT-KEYWORD? (CL:BLOCK NIL (CL:LABELS ((~G1633 (~G180) (CL:COND (~G180 ~G180) (T (CL:LABELS ((~G1634 (~G181) (CL:COND (~G181 ~G181) (T (CL:LABELS ((~G1635 (~G182) (CL:COND (~G182 ~G182) (T (EQ X 'CL:&KEY))))) (~G1635 (EQ X 'CL:&OPTIONAL))))))) (~G1634 (EQ X 'CL:&BODY))))))) (~G1633 (EQ X 'CL:&REST))))))
  (CL:DEFUN ARGDEF-GET-NAME (X) (CL:BLOCK ARGDEF-GET-NAME (CL:BLOCK NIL (CL:COND ((CONS? X) (CL:CAR X)) (T X)))))
  (CL:DEFUN MAKE-&KEY-ALIST (DEF) (CL:BLOCK MAKE-&KEY-ALIST (CL:BLOCK NIL (CL:LABELS ((~G1636 (KEYS) (CL:LABELS ((MAKE-&KEY-DESCR (_) (CL:BLOCK NIL (CL:COND (_ (CL:PROGN (CL:COND ((ARGUMENT-KEYWORD? (CL:CAR _)) (COPY-DEF-UNTIL-&KEY _)) (T (CL:LABELS ((~G1637 (!) (CL:PROGN (CL:SETQ KEYS (CL:CONS (CL:COND ((CONS? !) (CL:CONS (CL:CAR !) (CL:CAR (CL:CDR !)))) (T (CL:CONS ! !))) KEYS))) (MAKE-&KEY-DESCR (CL:CDR _)))) (~G1637 (CL:CAR _)))))))))) (COPY-DEF-UNTIL-&KEY (_) (CL:BLOCK NIL (CL:COND (_ (CL:PROGN (CL:COND ((EQ 'CL:&KEY (CL:CAR _)) (MAKE-&KEY-DESCR (CL:CDR _))) (T (CL:CONS (CL:CAR _) (COPY-DEF-UNTIL-&KEY (CL:CDR _))))))))))) (VALUES (COPY-DEF-UNTIL-&KEY DEF) (REVERSE KEYS))))) (~G1636 NIL)))))
  (CL:DEFUN VALUES (CL:&REST VALS) (CL:BLOCK VALUES (CL:BLOCK NIL (CL:CONS 'VALUES VALS))))
  (CL:DEFUN %PRINT-ARGS (X STR INFO) (CL:BLOCK %PRINT-ARGS (CL:BLOCK NIL (CL:BLOCK NIL (CL:LABELS ((~G1638 (~G203) (CL:LABELS ((~G1639 (!) (CL:TAGBODY ~G201 (CL:COND ((NOT ~G203) (CL:GO ~G202))) (CL:SETQ ! (CL:CAR ~G203)) (CL:COND ((NOT (CL:CAR !)) (CL:PROGN (CL:COND ((PRINT-INFO-NO-PADDING? INFO) (CL:PROGN (=-PRINT-INFO-NO-PADDING? NIL INFO))) (T (PRINC " " STR))) (PRINC "(" STR) (CL:PROGN (=-PRINT-INFO-NO-PADDING? T INFO)) (%PRINT-ARGS (CL:CDR !) STR INFO) (PRINC ")" STR))) ((CONS? (CL:CDR !)) (CL:LABELS ((~G1640 (~G198) (CL:COND ((EQ ~G198 'CL:&BODY) (%PRINT-BODY (CL:CDR (CL:CDR !)) STR INFO)) ((EQ ~G198 'CL:&REST) (%PRINT-REST (CL:CDR (CL:CDR !)) STR INFO)) (T (%PRINT-CONS (CL:CDR !) STR INFO))))) (~G1640 (CL:CAR (CL:CDR !))))) (T (CL:LABELS ((~G1641 (~G199) (CL:PROGN (CL:SETQ *PRINT-AUTOMATIC-NEWLINE?* NIL)) (CL:LABELS ((~G1642 (~G200) (CL:PROGN (CL:SETQ *PRINT-AUTOMATIC-NEWLINE?* ~G199)) ~G200)) (~G1642 (CL:PROGN (%LATE-PRINT (CL:CDR !) STR INFO)))))) (~G1641 *PRINT-AUTOMATIC-NEWLINE?*)))) (CL:SETQ ~G203 (CL:CDR ~G203)) (CL:GO ~G201) ~G202 (CL:RETURN-FROM NIL (CL:PROGN NIL))))) (~G1639 NIL)))) (~G1638 X))))))
  (CL:DEFUN %PRINT-BODY (X STR INFO) (CL:BLOCK %PRINT-BODY (CL:BLOCK NIL (TERPRI STR) (CL:LABELS ((~G1643 (~G193) (CL:PROGN (=-PRINT-INFO-INDENTATION (++ (PRINT-INFO-INDENTATION INFO)) INFO)) (CL:LABELS ((~G1644 (~G197) (CL:PROGN (=-PRINT-INFO-INDENTATION ~G193 INFO)) ~G197)) (~G1644 (CL:PROGN (CL:BLOCK NIL (CL:LABELS ((~G1645 (~G196) (CL:LABELS ((~G1646 (!) (CL:TAGBODY ~G194 (CL:COND ((NOT ~G196) (CL:GO ~G195))) (CL:SETQ ! (CL:CAR ~G196)) (%PRINT-INDENTATION STR INFO) (%LATE-PRINT ! STR INFO) (CL:COND ((NOT (EQ ! (CL:CAR (CL:LAST X)))) (CL:PROGN (TERPRI STR)))) (CL:SETQ ~G196 (CL:CDR ~G196)) (CL:GO ~G194) ~G195 (CL:RETURN-FROM NIL (CL:PROGN NIL))))) (~G1646 NIL)))) (~G1645 X)))))))) (~G1643 (PRINT-INFO-INDENTATION INFO))))))
  (CL:DEFUN %PRINT-INDENTATION (STR INFO) (CL:BLOCK %PRINT-INDENTATION (CL:BLOCK NIL (CL:LABELS ((~G1647 (~G191) (CL:BLOCK NIL (CL:LABELS ((~G1648 (!) (CL:TAGBODY ~G192 (CL:COND ((INTEGER== ! ~G191) (CL:RETURN-FROM NIL (CL:PROGN NIL)))) (PRINC " " STR) (CL:SETQ ! (INTEGER+ 1 !)) (CL:GO ~G192)))) (~G1648 0))))) (~G1647 (INTEGER (PRINT-INFO-INDENTATION INFO)))) (CL:PROGN (=-PRINT-INFO-NO-PADDING? T INFO)))))
  (CL:DEFUN =-PRINT-INFO-INDENTATION (VAL ARR) (CL:BLOCK =-PRINT-INFO-INDENTATION (CL:BLOCK NIL (CL:PROGN (=-AREF VAL ARR 4)))))
  (CL:DEFUN PRINT-INFO-INDENTATION (ARR) (CL:BLOCK PRINT-INFO-INDENTATION (CL:BLOCK NIL (CL:AREF ARR 4))))
  (CL:DEFUN %PRINT-CALL? (X INFO) (CL:BLOCK %PRINT-CALL? (CL:BLOCK NIL (CL:COND ((PRINT-INFO-PRETTY-PRINT? INFO) (CL:COND ((SYMBOL? (CL:CAR X)) (CL:LABELS ((~G1649 (!) (CL:COND (! (CL:COND ((FUNCTION? !) (FUNCTION-ARGUMENTS !))))))) (~G1649 (SYMBOL-FUNCTION (CL:CAR X)))))))))))
  (CL:DEFUN PRINT-INFO-PRETTY-PRINT? (ARR) (CL:BLOCK PRINT-INFO-PRETTY-PRINT? (CL:BLOCK NIL (CL:AREF ARR 2))))
  (CL:DEFUN %PRINT-ABBREVIATION (ABBREVIATION X STR INFO) (CL:BLOCK %PRINT-ABBREVIATION (CL:BLOCK NIL (CL:PROGN (CL:COND ((PRINT-INFO-NO-PADDING? INFO) (CL:PROGN (=-PRINT-INFO-NO-PADDING? NIL INFO))) (T (PRINC " " STR))) (PRINC (CL:CAR (CL:CDR ABBREVIATION)) STR) (CL:PROGN (=-PRINT-INFO-NO-PADDING? T INFO)) (%LATE-PRINT (CL:CAR (CL:CDR X)) STR INFO)))))
  (CL:DEFUN %FORMAT-DIRECTIVE-EOL (INF TXT ARGS) (CL:BLOCK %FORMAT-DIRECTIVE-EOL (CL:BLOCK NIL (TERPRI (FORMAT-INFO-STREAM INF)) (%FORMAT INF TXT ARGS))))
  (CL:DEFUN CHAR-UPCASE (C) (CL:BLOCK CHAR-UPCASE (CL:BLOCK NIL (CL:COND ((LOWER-CASE? C) (CHARACTER+ C (CHARACTER- #\A #\a))) (T C)))))
  (CL:DEFUN FORMAT-INFO-PROCESSED-ARGS (ARR) (CL:BLOCK FORMAT-INFO-PROCESSED-ARGS (CL:BLOCK NIL (CL:AREF ARR 5))))
  (CL:DEFUN =-FORMAT-INFO-PROCESSED-ARGS (VAL ARR) (CL:BLOCK =-FORMAT-INFO-PROCESSED-ARGS (CL:BLOCK NIL (CL:PROGN (=-AREF VAL ARR 5)))))
  (CL:DEFUN DEFAULT-STREAM (X) (CL:BLOCK DEFAULT-STREAM (CL:BLOCK NIL (CL:LABELS ((~G1650 (~G163) (CL:COND ((EQ ~G163 NIL) (MAKE-STRING-STREAM)) ((EQ ~G163 T) *STANDARD-OUTPUT*) (T X)))) (~G1650 X)))))
  (CL:DEFUN MAKE-STRING-STREAM NIL (CL:BLOCK MAKE-STRING-STREAM (CL:BLOCK NIL (MAKE-STREAM :USER-DETAIL (MAKE-QUEUE) :FUN-IN (CL:LAMBDA (STR) (CL:LABELS ((~G1651 (!) (CL:COND ((STRING? (CL:CAR !)) (CL:PROGN (CL:PROGN (=-STREAM-USER-DETAIL (MAKE-QUEUE) STR)) (ENQUEUE-LIST (STREAM-USER-DETAIL STR) (APPEND (STRING-LIST (CL:CAR !)) (CL:CDR !)))))))) (~G1651 (QUEUE-LIST (STREAM-USER-DETAIL STR)))) (QUEUE-POP (STREAM-USER-DETAIL STR))) :FUN-OUT (CL:LAMBDA (X STR) (ENQUEUE (STREAM-USER-DETAIL STR) X)) :FUN-EOF (CL:LAMBDA (STR) (NOT (QUEUE-LIST (STREAM-USER-DETAIL STR))))))))
  (CL:DEFUN ENQUEUE (X CL:&REST VALS) (CL:BLOCK ENQUEUE (CL:BLOCK NIL (CL:RPLACA X (CL:CDR (CL:RPLACD (CL:LABELS ((~G1652 (~G7) (CL:COND (~G7 ~G7) (T X)))) (~G1652 (CL:CAR X))) VALS))) VALS)))
  (CL:DEFUN QUEUE-POP (X) (CL:BLOCK QUEUE-POP (CL:BLOCK NIL (CL:LABELS ((~G1653 (~G8) (CL:COND ((NOT (CL:CDR (CL:CDR X))) (CL:RPLACA X NIL))) (CL:COND ((CL:CDR X) (CL:RPLACD X (CL:CDR (CL:CDR X))))) ~G8)) (~G1653 (CL:CAR (CL:CDR X)))))))
  (CL:DEFUN ENQUEUE-LIST (X VALS) (CL:BLOCK ENQUEUE-LIST (CL:BLOCK NIL (CL:RPLACD X (NCONC (CL:CDR X) VALS)) (CL:RPLACA X (CL:LAST VALS)))))
  (CL:DEFUN NCONC (CL:&REST LSTS) (CL:BLOCK NCONC (CL:BLOCK NIL (%NCONC-0 LSTS))))
  (CL:DEFUN %NCONC-0 (LSTS) (CL:BLOCK %NCONC-0 (CL:BLOCK NIL (CL:COND (LSTS (CL:PROGN (CL:LABELS ((~G1654 (!) (CL:COND (! (CL:PROGN (CL:RPLACD (CL:LAST !) (%NCONC-0 (CL:CDR LSTS))) !)) (T (%NCONC-0 (CL:CDR LSTS)))))) (~G1654 (CL:CAR LSTS)))))))))
  (CL:DEFUN MAKE-STREAM (CL:&KEY (HANDLE 'HANDLE) (FUN-IN 'FUN-IN) (FUN-OUT 'FUN-OUT) (FUN-EOF 'FUN-EOF) (LAST-CHAR 'LAST-CHAR) (PEEKED-CHAR 'PEEKED-CHAR) (INPUT-LOCATION 'INPUT-LOCATION) (OUTPUT-LOCATION 'OUTPUT-LOCATION) (USER-DETAIL 'USER-DETAIL)) (CL:BLOCK MAKE-STREAM (CL:BLOCK NIL (CL:LABELS ((~G1655 (~G156) (CL:PROGN (=-AREF 'STRUCT ~G156 0) (=-AREF 'STREAM ~G156 1)) (CL:PROGN (=-AREF (CL:COND ((EQ HANDLE 'HANDLE) NIL) (T HANDLE)) ~G156 2)) (CL:PROGN (=-AREF (CL:COND ((EQ FUN-IN 'FUN-IN) NIL) (T FUN-IN)) ~G156 3)) (CL:PROGN (=-AREF (CL:COND ((EQ FUN-OUT 'FUN-OUT) NIL) (T FUN-OUT)) ~G156 4)) (CL:PROGN (=-AREF (CL:COND ((EQ FUN-EOF 'FUN-EOF) NIL) (T FUN-EOF)) ~G156 5)) (CL:PROGN (=-AREF (CL:COND ((EQ LAST-CHAR 'LAST-CHAR) NIL) (T LAST-CHAR)) ~G156 6)) (CL:PROGN (=-AREF (CL:COND ((EQ PEEKED-CHAR 'PEEKED-CHAR) NIL) (T PEEKED-CHAR)) ~G156 7)) (CL:PROGN (=-AREF (CL:COND ((EQ INPUT-LOCATION 'INPUT-LOCATION) (MAKE-STREAM-LOCATION)) (T INPUT-LOCATION)) ~G156 8)) (CL:PROGN (=-AREF (CL:COND ((EQ OUTPUT-LOCATION 'OUTPUT-LOCATION) (MAKE-STREAM-LOCATION :TRACK? NIL)) (T OUTPUT-LOCATION)) ~G156 9)) (CL:PROGN (=-AREF (CL:COND ((EQ USER-DETAIL 'USER-DETAIL) NIL) (T USER-DETAIL)) ~G156 10)) ~G156)) (~G1655 (MAKE-ARRAY 11))))))
  (CL:DEFUN MAKE-STREAM-LOCATION (CL:&KEY (TRACK? 'TRACK?) (ID 'ID) (LINE 'LINE) (COLUMN 'COLUMN) (TABSIZE 'TABSIZE)) (CL:BLOCK MAKE-STREAM-LOCATION (CL:BLOCK NIL (CL:LABELS ((~G1656 (~G155) (CL:PROGN (=-AREF 'STRUCT ~G155 0) (=-AREF 'STREAM-LOCATION ~G155 1)) (CL:PROGN (=-AREF (CL:COND ((EQ TRACK? 'TRACK?) T) (T TRACK?)) ~G155 2)) (CL:PROGN (=-AREF (CL:COND ((EQ ID 'ID) NIL) (T ID)) ~G155 3)) (CL:PROGN (=-AREF (CL:COND ((EQ LINE 'LINE) 1) (T LINE)) ~G155 4)) (CL:PROGN (=-AREF (CL:COND ((EQ COLUMN 'COLUMN) 1) (T COLUMN)) ~G155 5)) (CL:PROGN (=-AREF (CL:COND ((EQ TABSIZE 'TABSIZE) *DEFAULT-STREAM-TABSIZE*) (T TABSIZE)) ~G155 6)) ~G155)) (~G1656 (MAKE-ARRAY 7))))))
  (CL:DEFUN FRESH-LINE (CL:&OPTIONAL (STR *STANDARD-OUTPUT*)) (CL:BLOCK FRESH-LINE (CL:BLOCK NIL (CL:LABELS ((~G1657 (~G177) (CL:LABELS ((~G1658 (S) (CL:LABELS ((~G1659 (~G178) (CL:COND (~G177 ~G178) (T (GET-STREAM-STRING S))))) (~G1659 (CL:PROGN (CL:COND ((NOT (FRESH-LINE? S)) (CL:PROGN (TERPRI S) T)))))))) (~G1658 (DEFAULT-STREAM ~G177))))) (~G1657 STR)))))
  (CL:DEFUN FRESH-LINE? (CL:&OPTIONAL (STR *STANDARD-OUTPUT*)) (CL:BLOCK FRESH-LINE? (CL:BLOCK NIL (== (STREAM-LAST-CHAR STR) (CODE-CHAR 10)))))
  (CL:DEFUN STREAM-LAST-CHAR (ARR) (CL:BLOCK STREAM-LAST-CHAR (CL:BLOCK NIL (CL:AREF ARR 6))))
  (CL:DEFUN GROUP (X SIZE) (CL:BLOCK GROUP (CL:BLOCK NIL (CL:COND (X (CL:CONS (COPY-HEAD X SIZE) (GROUP (CL:NTHCDR SIZE X) SIZE)))))))
  
negative.code: (CL:DEFUN %MACROEXPAND (X) (CL:COND ((CL:ATOM X) X) ((EQ (CL:CAR X) 'CL:QUOTE) X) ((EQ (CL:CAR X) 'BACKQUOTE) (CL:CONS 'BACKQUOTE (CL:APPLY *MACROEXPAND-BACKQUOTE* (CL:LIST (CL:CDR X))))) ((EQ (CL:CAR X) 'QUASIQUOTE) (CL:CONS 'QUASIQUOTE (%MACROEXPAND (CL:CDR X)))) ((EQ (CL:CAR X) 'QUASIQUOTE-SPLICE) (CL:CONS 'QUASIQUOTE-SPLICE (%MACROEXPAND (CL:CDR X)))) (T (%MACROEXPAND-CALL (%MACROEXPAND-REST X)))))
  (CL:DEFUN %MACROEXPAND-REST (X) (CL:COND ((CL:ATOM X) X) (T (CL:CONS (%MACROEXPAND (CL:CAR X)) (%MACROEXPAND-REST (CL:CDR X))))))
  (CL:DEFUN %MACROEXPAND-CALL (X) (CL:COND ((CL:APPLY *MACRO?* (CL:LIST X)) (%MACROEXPAND-XLAT X)) (T X)))
  (CL:DEFUN %MACROEXPAND-XLAT (X) (CL:COND (*MACROEXPAND-PRINT?* (CL:PROGN (CL:PRINT '*MACROEXPAND-PRINT?*) (CL:PRINT X)))) (CL:SETQ *CURRENT-MACRO* (CL:CAR X)) (CL:LABELS ((~G1662 (X) (CL:COND (*MACROEXPAND-PRINT?* (CL:PRINT X))) (CL:SETQ *CURRENT-MACRO* NIL) X)) (~G1662 (CL:APPLY *MACROCALL* (CL:LIST X)))))
  (CL:DEFUN FUNCALL (FUN CL:&REST ARGS) (CL:BLOCK FUNCALL (CL:BLOCK NIL (CL:APPLY FUN ARGS))))
  (CL:DEFUN ARGUMENT-EXPAND-VALUES (FUN DEF VALS) (CL:BLOCK ARGUMENT-EXPAND-VALUES (CL:BLOCK NIL (CL:MAPCAR (CL:LAMBDA (_) (CL:BLOCK NIL (CL:COND ((CL:COND ((CONS? _) (EQ (CL:CAR _) '%REST))) (CL:CDR _)) (T _)))) (CDRLIST (ARGUMENT-EXPAND FUN DEF VALS))))))
  (CL:DEFUN CDRLIST (~G127) (CL:BLOCK CDRLIST (CL:BLOCK NIL (FILTER #'CL:CDR ~G127))))
  (CL:DEFUN ASSOC (KEY LST CL:&KEY (TEST #'EQL)) (CL:BLOCK ASSOC (CL:BLOCK NIL (CL:COND (LST (CL:BLOCK NIL (CL:LABELS ((~G1663 (~G130) (CL:LABELS ((~G1664 (I) (CL:TAGBODY ~G128 (CL:COND ((NOT ~G130) (CL:GO ~G129))) (CL:SETQ I (CL:CAR ~G130)) (CL:COND ((CONS? I) (CL:COND ((FUNCALL TEST KEY (CL:CAR I)) (CL:RETURN-FROM NIL I)))) (T (ERROR "Pair expected instead of ~A." I))) (CL:SETQ ~G130 (CL:CDR ~G130)) (CL:GO ~G128) ~G129 (CL:RETURN-FROM NIL (CL:PROGN))))) (~G1664 NIL)))) (~G1663 LST))))))))
  (CL:DEFUN TRE-SYMBOL (X) (CL:BLOCK TRE-SYMBOL (CL:BLOCK NIL (CL:INTERN (SYMBOL-NAME X) "TRE"))))
  (CL:DEFUN CLOSE (STR) (CL:BLOCK CLOSE (CL:BLOCK NIL (%FCLOSE (STREAM-HANDLE STR)))))
  (CL:DEFUN OPEN (PATH CL:&KEY DIRECTION) (CL:BLOCK OPEN (CL:BLOCK NIL (CL:LABELS ((~G1665 (!) (CL:COND (! (MAKE-STREAM-STREAM :STREAM ! :INPUT-LOCATION (MAKE-STREAM-LOCATION :ID PATH))) (T (ERROR "Couldn't open file `~A'." PATH))))) (~G1665 (%FOPEN PATH (%FOPEN-DIRECTION DIRECTION)))))))
  (CL:DEFUN MAKE-STREAM-STREAM (CL:&KEY STREAM (INPUT-LOCATION (MAKE-STREAM-LOCATION)) (OUTPUT-LOCATION (MAKE-STREAM-LOCATION :TRACK? NIL))) (CL:BLOCK MAKE-STREAM-STREAM (CL:BLOCK NIL (MAKE-STREAM :HANDLE STREAM :INPUT-LOCATION INPUT-LOCATION :OUTPUT-LOCATION OUTPUT-LOCATION :FUN-IN (CL:LAMBDA (_) (CL:BLOCK NIL (%READ-CHAR (STREAM-HANDLE _)))) :FUN-OUT (CL:LAMBDA (C STR) (%PRINC C (STREAM-HANDLE STR))) :FUN-EOF (CL:LAMBDA (_) (CL:BLOCK NIL (%FEOF (STREAM-HANDLE _))))))))
  (CL:DEFUN %FOPEN-DIRECTION (DIRECTION) (CL:BLOCK %FOPEN-DIRECTION (CL:BLOCK NIL (CL:LABELS ((~G1666 (~G164) (CL:COND ((EQUAL ~G164 'INPUT) "r") ((EQUAL ~G164 'OUTPUT) "w") ((EQUAL ~G164 'APPEND) "a") (T (ERROR ":DIRECTION isn't specified."))))) (~G1666 DIRECTION)))))
  (CL:DEFUN PRINT-DEFINITION (X) (CL:COND (*PRINT-DEFINITIONS?* (CL:APPLY *DEFINITION-PRINTER* (CL:LIST X)))))
  (CL:DEFUN DOT-EXPAND (X) (CL:BLOCK DOT-EXPAND (CL:BLOCK NIL (CL:LABELS ((LABEL? (_) (CL:BLOCK NIL (NOT (CL:LABELS ((~G1667 (~G122) (CL:COND (~G122 ~G122) (T (CL:LABELS ((~G1668 (~G123) (CL:COND (~G123 ~G123) (T (STRING? _))))) (~G1668 (NUMBER? _))))))) (~G1667 (CONS? _))))))) (CL:COND (X (CL:PROGN (CL:COND ((LABEL? X) (DOT-EXPAND-CONV X)) ((CONS? X) (CL:PROGN (CL:LABELS ((~G1669 (~G125) (CL:LABELS ((~G1670 (!) (CL:COND (! (CL:PROGN (CL:PROGN (CL:SETQ *DEFAULT-LISTPROP* !))))))) (~G1670 (CL:COND ((CONS? ~G125) (CPR ~G125))))))) (~G1669 X)) (CL:LABELS ((~G1671 (~G124) (RPLACP (CL:CONS (DOT-EXPAND (CL:CAR X)) (DOT-EXPAND (CL:CDR X))) ~G124))) (~G1671 *DEFAULT-LISTPROP*)))) (T X)))))))))
  (CL:DEFUN DOT-EXPAND-CONV (X) (CL:BLOCK DOT-EXPAND-CONV (CL:BLOCK NIL (CL:LABELS ((~G1672 (SL) (CL:LABELS ((~G1673 (P) (CL:COND ((NO-DOT-NOTATION? X) X) ((HAS-DOT-NOTATION? X) (DOT-EXPAND-LIST SL)) (T (CL:CONS '%SLOT-VALUE (CL:CONS (LIST-SYMBOL (SUBSEQ SL 0 P)) (CL:CONS (DOT-EXPAND-CONV (LIST-SYMBOL (SUBSEQ SL (++ P)))) NIL))))))) (~G1673 (DOT-POSITION SL))))) (~G1672 (STRING-LIST (SYMBOL-NAME X)))))))
  (CL:DEFUN SUBSEQ (SEQ START CL:&OPTIONAL (END 99999)) (CL:BLOCK SUBSEQ (CL:BLOCK NIL (CL:COND (SEQ (CL:PROGN (CL:COND ((> START END) (CL:LABELS ((~G1674 (~G62) (CL:PROGN (CL:SETQ START END) (CL:SETQ END ~G62)))) (~G1674 START)))) (CL:LABELS ((~G1675 (~G63) (CL:COND ((CONS? ~G63) (LIST-SUBSEQ SEQ START END)) ((STRING? ~G63) (STRING-SUBSEQ SEQ START END)) ((ARRAY? ~G63) (%SUBSEQ-SEQUENCE #'MAKE-ARRAY SEQ START END)) (T (ERROR "Type of ~A not supported." SEQ))))) (~G1675 SEQ))))))))
  (CL:DEFUN %SUBSEQ-SEQUENCE (MAKER SEQ START END) (CL:BLOCK %SUBSEQ-SEQUENCE (CL:BLOCK NIL (CL:COND ((NOT (== START END)) (CL:PROGN (CL:LABELS ((~G1676 (!) (CL:COND ((< START !) (CL:PROGN (CL:COND ((>= END !) (CL:PROGN (CL:SETQ END !)))) (CL:LABELS ((~G1677 (L) (CL:LABELS ((~G1678 (S) (CL:LABELS ((~G1679 (~G60) (CL:BLOCK NIL (CL:LABELS ((~G1680 (X) (CL:TAGBODY ~G61 (CL:COND ((INTEGER== X ~G60) (CL:RETURN-FROM NIL (CL:PROGN S)))) (CL:PROGN (=-ELT (ELT SEQ (+ START X)) S X)) (CL:SETQ X (INTEGER+ 1 X)) (CL:GO ~G61)))) (~G1680 0))))) (~G1679 (INTEGER L))))) (~G1678 (FUNCALL MAKER L))))) (~G1677 (- END START)))))))) (~G1676 (CL:LENGTH SEQ)))))))))
  (CL:DEFUN =-ELT (VAL SEQ IDX) (CL:BLOCK =-ELT (CL:BLOCK NIL (%SET-ELT VAL SEQ IDX))))
  (CL:DEFUN STRING-SUBSEQ (SEQ START CL:&OPTIONAL (END 99999)) (CL:BLOCK STRING-SUBSEQ (CL:BLOCK NIL (CL:COND ((== START END) "") (T (CL:LABELS ((~G1681 (SEQLEN) (CL:COND ((< START SEQLEN) (CL:PROGN (CL:COND ((>= END SEQLEN) (CL:PROGN (CL:PROGN (CL:SETQ END SEQLEN))))) (CL:LABELS ((~G1682 (L) (CL:LABELS ((~G1683 (S) (CL:LABELS ((~G1684 (~G57) (CL:BLOCK NIL (CL:LABELS ((~G1685 (X) (CL:TAGBODY ~G58 (CL:COND ((INTEGER== X ~G57) (CL:RETURN-FROM NIL (CL:PROGN S)))) (CL:PROGN (CL:SETQ S (+ S (STRING (ELT SEQ (+ START X)))))) (CL:SETQ X (INTEGER+ 1 X)) (CL:GO ~G58)))) (~G1685 0))))) (~G1684 (INTEGER L))))) (~G1683 (CL:MAKE-STRING 0))))) (~G1682 (- END START)))))))) (~G1681 (CL:LENGTH SEQ))))))))
  (CL:DEFUN LIST-SUBSEQ (SEQ START CL:&OPTIONAL (END 999999)) (CL:BLOCK LIST-SUBSEQ (CL:BLOCK NIL (CL:COND ((CL:COND (SEQ (NOT (== START END)))) (CL:PROGN (CL:COND ((> START END) (CL:LABELS ((~G1686 (~G59) (CL:PROGN (CL:SETQ START END) (CL:SETQ END ~G59)))) (~G1686 START)))) (CL:LABELS ((COPY-NUM (LST LEN) (CL:COND (LST (CL:COND ((< 0 LEN) (CL:CONS (CL:CAR LST) (COPY-NUM (CL:CDR LST) (-- LEN))))))))) (COPY-NUM (CL:NTHCDR START SEQ) (- END START)))))))))
  (CL:DEFUN LIST-SYMBOL (X) (CL:BLOCK LIST-SYMBOL (CL:BLOCK NIL (MAKE-SYMBOL (LIST-STRING X)))))
  (CL:DEFUN DOT-EXPAND-LIST (X) (CL:BLOCK DOT-EXPAND-LIST (CL:BLOCK NIL (CL:LABELS ((~G1687 (~G110) (CL:LABELS ((~G1688 (~G111) (CL:COND ((NOT (EQ (CL:CAR ~G110) 'VALUES)) (CL:PROGN (ERROR "VALUES expected instead of ~A." ~G110)))) (CL:LABELS ((~G1689 (NUM-CDRS) (CL:LABELS ((~G1690 (~G112) (CL:LABELS ((~G1691 (WITHOUT-START) (CL:LABELS ((~G1692 (~G115) (CL:LABELS ((~G1693 (~G116) (CL:COND ((NOT (EQ (CL:CAR ~G115) 'VALUES)) (CL:PROGN (ERROR "VALUES expected instead of ~A." ~G115)))) (CL:LABELS ((~G1694 (NUM-CARS) (CL:LABELS ((~G1695 (~G117) (CL:LABELS ((~G1696 (WITHOUT-END) (DOT-EXPAND-MAKE-EXPR 'CL:CAR NUM-CARS (DOT-EXPAND-MAKE-EXPR 'CL:CDR NUM-CDRS (DOT-EXPAND (LIST-SYMBOL WITHOUT-END)))))) (~G1696 (CL:CAR ~G117))))) (~G1695 (CL:LABELS ((~G1697 (~G119) (CL:COND (~G119 ~G119) (T (%ERROR "Not enough VALUES."))))) (~G1697 (CL:CDR ~G116))))))) (~G1694 (CL:CAR ~G116))))) (~G1693 (CL:CDR ~G115))))) (~G1692 (DOT-EXPAND-TAIL-LENGTH WITHOUT-START))))) (~G1691 (CL:CAR ~G112))))) (~G1690 (CL:LABELS ((~G1698 (~G114) (CL:COND (~G114 ~G114) (T (%ERROR "Not enough VALUES."))))) (~G1698 (CL:CDR ~G111))))))) (~G1689 (CL:CAR ~G111))))) (~G1688 (CL:CDR ~G110))))) (~G1687 (DOT-EXPAND-HEAD-LENGTH X))))))
  (CL:DEFUN DOT-EXPAND-MAKE-EXPR (WHICH NUM X) (CL:BLOCK DOT-EXPAND-MAKE-EXPR (CL:BLOCK NIL (CL:COND ((< 0 NUM) (CL:CONS WHICH (CL:CONS (DOT-EXPAND-MAKE-EXPR WHICH (-- NUM) X) NIL))) (T X)))))
  (CL:DEFUN DOT-EXPAND-TAIL-LENGTH (X CL:&OPTIONAL (NUM 0)) (CL:BLOCK DOT-EXPAND-TAIL-LENGTH (CL:BLOCK NIL (CL:COND ((== #\. (CL:CAR (CL:LAST X))) (DOT-EXPAND-TAIL-LENGTH (BUTLAST X) (++ NUM))) (T (VALUES NUM X))))))
  (CL:DEFUN DOT-EXPAND-HEAD-LENGTH (X CL:&OPTIONAL (NUM 0)) (CL:BLOCK DOT-EXPAND-HEAD-LENGTH (CL:BLOCK NIL (CL:COND ((== #\. (CL:CAR X)) (DOT-EXPAND-HEAD-LENGTH (CL:CDR X) (++ NUM))) (T (VALUES NUM X))))))
  (CL:DEFUN HAS-DOT-NOTATION? (X) (CL:BLOCK HAS-DOT-NOTATION? (CL:BLOCK NIL (CL:LABELS ((~G1699 (SL) (CL:LABELS ((~G1700 (~G121) (CL:COND (~G121 ~G121) (T (== #\. (CL:CAR (CL:LAST SL))))))) (~G1700 (== #\. (CL:CAR SL)))))) (~G1699 (STRING-LIST (SYMBOL-NAME X)))))))
  (CL:DEFUN NO-DOT-NOTATION? (X) (CL:BLOCK NO-DOT-NOTATION? (CL:BLOCK NIL (CL:LABELS ((~G1701 (SL) (CL:LABELS ((~G1702 (L) (CL:LABELS ((~G1703 (P) (CL:LABELS ((~G1704 (~G120) (CL:COND (~G120 ~G120) (T (NOT P))))) (~G1704 (== 1 L))))) (~G1703 (DOT-POSITION SL))))) (~G1702 (CL:LENGTH SL))))) (~G1701 (STRING-LIST (SYMBOL-NAME X)))))))
  (CL:DEFUN DOT-POSITION (X) (CL:BLOCK DOT-POSITION (CL:BLOCK NIL (POSITION #\. X :TEST #'==))))
  (CL:DEFUN POSITION (OBJ SEQ CL:&KEY (START NIL) (END NIL) (FROM-END NIL) (TEST #'EQL)) (CL:BLOCK POSITION (CL:BLOCK NIL (CL:LABELS ((~G1705 (!) (FIND-IF (CL:LAMBDA (X I) (CL:COND ((FUNCALL TEST X OBJ) (CL:PROGN (CL:SETQ ! I))))) SEQ :START START :END END :FROM-END FROM-END :WITH-INDEX T) !)) (~G1705 NIL)))))
  (CL:DEFUN QUASIQUOTE-EXPAND (X) (CL:CAR (%QUASIQUOTE-EXPAND (CL:LIST X))))
  (CL:DEFUN %QUASIQUOTE-EXPAND (X) (CL:COND ((CL:ATOM X) X) ((CL:ATOM (CL:CAR X)) (CL:CONS (CL:CAR X) (%QUASIQUOTE-EXPAND (CL:CDR X)))) ((EQ (CL:CAR (CL:CAR X)) 'CL:QUOTE) (CL:CONS (CL:CAR X) (%QUASIQUOTE-EXPAND (CL:CDR X)))) ((EQ (CL:CAR (CL:CAR X)) 'BACKQUOTE) (CL:CONS (CL:CAR X) (%QUASIQUOTE-EXPAND (CL:CDR X)))) ((EQ (CL:CAR (CL:CAR X)) 'QUASIQUOTE) (CL:CONS (EVAL (MACROEXPAND (CL:CAR (CL:CDR (CL:CAR X))))) (%QUASIQUOTE-EXPAND (CL:CDR X)))) ((EQ (CL:CAR (CL:CAR X)) 'QUASIQUOTE-SPLICE) (APPEND (EVAL (MACROEXPAND (CL:CAR (CL:CDR (CL:CAR X))))) (%QUASIQUOTE-EXPAND (CL:CDR X)))) (T (CL:CONS (%QUASIQUOTE-EXPAND (CL:CAR X)) (%QUASIQUOTE-EXPAND (CL:CDR X))))))
  (CL:DEFUN READ (CL:&OPTIONAL (STR *STANDARD-INPUT*)) (CL:BLOCK READ (CL:BLOCK NIL (SKIP-SPACES STR) (CL:COND ((PEEK-CHAR STR) (READ-EXPR STR))))))
  (CL:DEFUN READ-EXPR (STR) (CL:BLOCK READ-EXPR (CL:BLOCK NIL (CL:LABELS ((~G1706 (~G304) (CL:LABELS ((~G1707 (~G305) (CL:COND ((NOT (EQ (CL:CAR ~G304) 'VALUES)) (CL:PROGN (ERROR "VALUES expected instead of ~A." ~G304)))) (CL:LABELS ((~G1708 (TOKEN) (CL:LABELS ((~G1709 (~G306) (CL:LABELS ((~G1710 (PKG) (CL:LABELS ((~G1711 (~G307) (CL:LABELS ((~G1712 (SYM) (CL:LABELS ((~G1713 (~G303) (CL:COND ((EQ ~G303 NIL) NIL) ((EQ ~G303 'EOF) NIL) ((EQ ~G303 'BRACKET-OPEN) (READ-CONS-SLOT STR)) ((EQ ~G303 'SQUARE-BRACKET-OPEN) (CL:CONS 'SQUARE (READ-CONS-SLOT STR))) ((EQ ~G303 'CURLY-BRACKET-OPEN) (CL:CONS 'CURLY (READ-CONS-SLOT STR))) (T (CL:COND ((TOKEN-IS-QUOTE? TOKEN) (READ-QUOTE STR TOKEN)) (T (READ-ATOM STR TOKEN PKG SYM))))))) (~G1713 TOKEN)))) (~G1712 (CL:CAR ~G307))))) (~G1711 (CL:LABELS ((~G1714 (~G310) (CL:COND (~G310 ~G310) (T (%ERROR "Not enough VALUES."))))) (~G1714 (CL:CDR ~G306))))))) (~G1710 (CL:CAR ~G306))))) (~G1709 (CL:LABELS ((~G1715 (~G309) (CL:COND (~G309 ~G309) (T (%ERROR "Not enough VALUES."))))) (~G1715 (CL:CDR ~G305))))))) (~G1708 (CL:CAR ~G305))))) (~G1707 (CL:CDR ~G304))))) (~G1706 (READ-TOKEN STR))))))
  (CL:DEFUN READ-ATOM (STR TOKEN PKG SYM) (CL:BLOCK READ-ATOM (CL:BLOCK NIL (CL:LABELS ((~G1716 (~G266) (CL:COND ((EQ ~G266 'DBLQUOTE) (READ-STRING STR)) ((EQ ~G266 'CHAR) (READ-CHAR STR)) ((EQ ~G266 'NUMBER) (CL:LABELS ((~G1717 (S) (PRINC (LIST-STRING SYM) S) (CL:PROGN (READ-NUMBER S)))) (~G1717 (MAKE-STRING-STREAM)))) ((EQ ~G266 'HEXNUM) (READ-HEX STR)) ((EQ ~G266 'CL:FUNCTION) (CL:CONS 'CL:FUNCTION (CL:CONS (READ-EXPR STR) NIL))) ((EQ ~G266 'SYMBOL) (READ-SYMBOL-OR-SLOT-VALUE SYM PKG)) (T (ERROR "Syntax error: token ~A, sym ~A." TOKEN SYM))))) (~G1716 TOKEN)))))
  (CL:DEFUN READ-SYMBOL-OR-SLOT-VALUE (SYM PKG) (CL:BLOCK READ-SYMBOL-OR-SLOT-VALUE (CL:BLOCK NIL (CL:LABELS ((~G1718 (!) (CL:COND ((CL:COND ((CL:CDR !) (CL:COND ((CL:CAR !) (CL:CAR (CL:LAST !)))))) (READ-SLOT-VALUE !)) (T (CL:COND (*READER-FINDS-SYMBOLS?* (CL:FIND-SYMBOL (LIST-STRING SYM) (CL:COND ((NOT PKG) CL:*PACKAGE*) (T (CL:FIND-PACKAGE (CL:COND ((EQ T PKG) *KEYWORD-PACKAGE*) (T (LIST-STRING PKG)))))))) (T (MAKE-SYMBOL (LIST-STRING SYM) (CL:COND ((NOT PKG) NIL) ((EQ T PKG) *KEYWORD-PACKAGE*) (T (LIST-STRING PKG)))))))))) (~G1718 (CL:MAPCAR (CL:LAMBDA (_) (CL:BLOCK NIL (CL:COND (_ (LIST-STRING _))))) (SPLIT #\. SYM)))))))
  (CL:DEFUN READ-SLOT-VALUE (X) (CL:BLOCK READ-SLOT-VALUE (CL:BLOCK NIL (CL:COND (X (CL:COND ((CL:CDR X) (CL:CONS 'SLOT-VALUE (CL:CONS (READ-SLOT-VALUE (BUTLAST X)) (CL:CONS (CL:CONS 'CL:QUOTE (CL:CONS (MAKE-SYMBOL (CL:CAR (CL:LAST X))) NIL)) NIL)))) (T (CL:COND ((STRING? (CL:CAR X)) (MAKE-SYMBOL (CL:CAR X))) (T (CL:CAR X))))))))))
  (CL:DEFUN SPLIT (OBJ SEQ CL:&KEY (TEST #'EQL) (INCLUDE? NIL)) (CL:BLOCK SPLIT (CL:BLOCK NIL (GENERIC-SPLIT OBJ SEQ :TEST TEST :INCLUDE? INCLUDE?))))
  (CL:DEFUN GENERIC-SPLIT (OBJ SEQ CL:&KEY (TEST #'EQL) (INCLUDE? NIL)) (CL:BLOCK GENERIC-SPLIT (CL:BLOCK NIL (CL:COND (SEQ (CL:LABELS ((~G1719 (!) (CL:COND (! (CL:CONS (SUBSEQ SEQ 0 (CL:COND (INCLUDE? (++ !)) (T !))) (GENERIC-SPLIT OBJ (SUBSEQ SEQ (++ !)) :TEST TEST :INCLUDE? INCLUDE?))) (T (CL:LIST SEQ))))) (~G1719 (POSITION OBJ SEQ :TEST TEST))))))))
  (CL:DEFUN READ-HEX (STR) (CL:BLOCK READ-HEX (CL:BLOCK NIL (CL:LABELS ((REC (V) (CL:LABELS ((~G1720 (!) (CL:COND ((HEX-DIGIT-CHAR? !) (CL:PROGN (READ-CHAR STR) (REC (+ (* V 16) (- ! (CL:COND ((DIGIT-CHAR? !) #\0) (T (- #\A 10)))))))) (T V)))) (~G1720 (CHAR-UPCASE (PEEK-CHAR STR)))))) (CL:LABELS ((~G1721 (~G225) (CL:COND (~G225 ~G225) (T (ERROR "Illegal character '~A' at begin of hexadecimal number." (PEEK-CHAR STR)))))) (~G1721 (HEX-DIGIT-CHAR? (PEEK-CHAR STR)))) (CL:LABELS ((~G1722 (~G226) (CL:COND ((SYMBOL-CHAR? (PEEK-CHAR STR)) (ERROR "Illegal character '~A' in hexadecimal number." (PEEK-CHAR STR)))) ~G226)) (~G1722 (REC 0)))))))
  (CL:DEFUN SYMBOL-CHAR? (X) (CL:BLOCK SYMBOL-CHAR? (CL:BLOCK NIL (CL:COND ((> X 32) (NOT (SPECIAL-CHAR? X)))))))
  (CL:DEFUN SPECIAL-CHAR? (X) (CL:BLOCK SPECIAL-CHAR? (CL:BLOCK NIL (CL:LABELS ((~G1723 (~G241) (CL:COND (~G241 ~G241) (T (CL:LABELS ((~G1724 (~G242) (CL:COND (~G242 ~G242) (T (CL:LABELS ((~G1725 (~G243) (CL:COND (~G243 ~G243) (T (CL:LABELS ((~G1726 (~G244) (CL:COND (~G244 ~G244) (T (CL:LABELS ((~G1727 (~G245) (CL:COND (~G245 ~G245) (T (CL:LABELS ((~G1728 (~G246) (CL:COND (~G246 ~G246) (T (CL:LABELS ((~G1729 (~G247) (CL:COND (~G247 ~G247) (T (CL:LABELS ((~G1730 (~G248) (CL:COND (~G248 ~G248) (T (CL:LABELS ((~G1731 (~G249) (CL:COND (~G249 ~G249) (T (CL:LABELS ((~G1732 (~G250) (CL:COND (~G250 ~G250) (T (CL:LABELS ((~G1733 (~G251) (CL:COND (~G251 ~G251) (T (CL:LABELS ((~G1734 (~G252) (CL:COND (~G252 ~G252) (T (CL:LABELS ((~G1735 (~G253) (CL:COND (~G253 ~G253) (T (== X #\^))))) (~G1735 (== X #\#))))))) (~G1734 (== X #\"))))))) (~G1733 (== X #\;))))))) (~G1732 (== X #\:))))))) (~G1731 (== X #\,))))))) (~G1730 (== X #\`))))))) (~G1729 (== X #\'))))))) (~G1728 (== X #\}))))))) (~G1727 (== X #\{))))))) (~G1726 (== X #\]))))))) (~G1725 (== X #\[))))))) (~G1724 (== X #\)))))))) (~G1723 (== X #\())))))
  (CL:DEFUN DIGIT-CHAR? (C CL:&KEY (BASE 10)) (CL:BLOCK DIGIT-CHAR? (CL:BLOCK NIL (CL:COND ((CHARACTER? C) (CL:LABELS ((~G1736 (~G81) (CL:COND (~G81 ~G81) (T (NONDECIMAL-DIGIT? C :BASE BASE))))) (~G1736 (DECIMAL-DIGIT? C))))))))
  (CL:DEFUN NONDECIMAL-DIGIT? (X CL:&KEY (BASE 10)) (CL:BLOCK NONDECIMAL-DIGIT? (CL:BLOCK NIL (CL:COND ((< 10 BASE) (CL:LABELS ((~G1737 (~G80) (CL:COND (~G80 ~G80) (T (%NONDECIMAL-DIGIT? X #\A BASE))))) (~G1737 (%NONDECIMAL-DIGIT? X #\a BASE))))))))
  (CL:DEFUN %NONDECIMAL-DIGIT? (X START BASE) (CL:BLOCK %NONDECIMAL-DIGIT? (CL:BLOCK NIL (RANGE? X START (CHARACTER+ START (CHARACTER- BASE 10))))))
  (CL:DEFUN DECIMAL-DIGIT? (X) (CL:BLOCK DECIMAL-DIGIT? (CL:BLOCK NIL (RANGE? X #\0 #\9))))
  (CL:DEFUN HEX-DIGIT-CHAR? (X) (CL:BLOCK HEX-DIGIT-CHAR? (CL:BLOCK NIL (CL:LABELS ((~G1738 (~G82) (CL:COND (~G82 ~G82) (T (CL:LABELS ((~G1739 (~G83) (CL:COND (~G83 ~G83) (T (CL:COND ((>= X #\a) (<= X #\f))))))) (~G1739 (CL:COND ((>= X #\A) (<= X #\F))))))))) (~G1738 (DIGIT-CHAR? X))))))
  (CL:DEFUN READ-NUMBER (CL:&OPTIONAL (STR *STANDARD-INPUT*)) (CL:BLOCK READ-NUMBER (CL:BLOCK NIL (* (CL:COND ((== #\- (PEEK-CHAR STR)) (CL:PROGN (READ-CHAR STR) -1)) (T 1)) (+ (READ-INTEGER STR) (CL:LABELS ((~G1740 (~G227) (CL:COND (~G227 ~G227) (T 0)))) (~G1740 (CL:COND ((PEEK-DOT STR) (CL:COND ((READ-CHAR STR) (READ-DECIMAL-PLACES STR))))))))))))
  (CL:DEFUN READ-DECIMAL-PLACES (CL:&OPTIONAL (STR *STANDARD-INPUT*)) (CL:BLOCK READ-DECIMAL-PLACES (CL:BLOCK NIL (CL:COND ((CL:LABELS ((~G1741 (!) (CL:COND (! (DIGIT-CHAR? !))))) (~G1741 (PEEK-CHAR STR))) (READ-DECIMAL-PLACES-0 STR 0 0.1))))))
  (CL:DEFUN READ-DECIMAL-PLACES-0 (STR V S) (CL:BLOCK READ-DECIMAL-PLACES-0 (CL:BLOCK NIL (CL:COND ((PEEK-DIGIT STR) (READ-DECIMAL-PLACES-0 STR (+ V (* S (DIGIT-NUMBER (READ-CHAR STR)))) (/ S 10))) (T V)))))
  (CL:DEFUN DIGIT-NUMBER (X) (CL:BLOCK DIGIT-NUMBER (CL:BLOCK NIL (- X #\0))))
  (CL:DEFUN PEEK-DIGIT (STR) (CL:BLOCK PEEK-DIGIT (CL:BLOCK NIL (CL:LABELS ((~G1742 (!) (CL:COND (! (CL:PROGN (CL:COND ((DIGIT-CHAR? !) !))))))) (~G1742 (PEEK-CHAR STR))))))
  (CL:DEFUN PEEK-DOT (STR) (CL:BLOCK PEEK-DOT (CL:BLOCK NIL (CL:LABELS ((~G1743 (!) (CL:COND (! (CL:PROGN (== #\. !)))))) (~G1743 (PEEK-CHAR STR))))))
  (CL:DEFUN READ-INTEGER (CL:&OPTIONAL (STR *STANDARD-INPUT*)) (CL:BLOCK READ-INTEGER (CL:BLOCK NIL (CL:COND ((PEEK-DIGIT STR) (INTEGER (READ-INTEGER-0 STR 0)))))))
  (CL:DEFUN READ-INTEGER-0 (STR V) (CL:BLOCK READ-INTEGER-0 (CL:BLOCK NIL (CL:COND ((PEEK-DIGIT STR) (READ-INTEGER-0 STR (+ (* V 10) (DIGIT-NUMBER (READ-CHAR STR))))) (T V)))))
  (CL:DEFUN READ-CHAR (CL:&OPTIONAL (STR *STANDARD-INPUT*)) (CL:BLOCK READ-CHAR (CL:BLOCK NIL (%TRACK-LOCATION (STREAM-INPUT-LOCATION STR) (READ-CHAR-0 STR)))))
  (CL:DEFUN READ-CHAR-0 (STR) (CL:BLOCK READ-CHAR-0 (CL:BLOCK NIL (CL:LABELS ((~G1744 (~G223) (CL:COND (~G223 ~G223) (T (CL:PROGN (=-STREAM-LAST-CHAR (FUNCALL (STREAM-FUN-IN STR) STR) STR)))))) (~G1744 (READ-PEEKED-CHAR STR))))))
  (CL:DEFUN STREAM-FUN-IN (ARR) (CL:BLOCK STREAM-FUN-IN (CL:BLOCK NIL (CL:AREF ARR 3))))
  (CL:DEFUN READ-PEEKED-CHAR (STR) (CL:BLOCK READ-PEEKED-CHAR (CL:BLOCK NIL (CL:LABELS ((~G1745 (!) (CL:COND (! (CL:PROGN (CL:PROGN (=-STREAM-PEEKED-CHAR NIL STR)) !))))) (~G1745 (STREAM-PEEKED-CHAR STR))))))
  (CL:DEFUN =-STREAM-PEEKED-CHAR (VAL ARR) (CL:BLOCK =-STREAM-PEEKED-CHAR (CL:BLOCK NIL (CL:PROGN (=-AREF VAL ARR 7)))))
  (CL:DEFUN STREAM-PEEKED-CHAR (ARR) (CL:BLOCK STREAM-PEEKED-CHAR (CL:BLOCK NIL (CL:AREF ARR 7))))
  (CL:DEFUN STREAM-INPUT-LOCATION (ARR) (CL:BLOCK STREAM-INPUT-LOCATION (CL:BLOCK NIL (CL:AREF ARR 8))))
  (CL:DEFUN READ-STRING (STR) (CL:BLOCK READ-STRING (CL:BLOCK NIL (LIST-STRING (READ-STRING-0 STR)))))
  (CL:DEFUN READ-STRING-0 (STR) (CL:BLOCK READ-STRING-0 (CL:BLOCK NIL (CL:LABELS ((~G1746 (C) (CL:COND ((NOT (== C #\")) (CL:PROGN (CL:CONS (CL:COND ((== C #\\) (READ-CHAR STR)) (T C)) (READ-STRING-0 STR))))))) (~G1746 (READ-CHAR STR))))))
  (CL:DEFUN READ-QUOTE (STR TOKEN) (CL:BLOCK READ-QUOTE (CL:BLOCK NIL (CL:LIST TOKEN (READ-EXPR STR)))))
  (CL:DEFUN TOKEN-IS-QUOTE? (X) (CL:BLOCK TOKEN-IS-QUOTE? (CL:BLOCK NIL (CL:LABELS ((~G1747 (~G235) (CL:COND (~G235 ~G235) (T (CL:LABELS ((~G1748 (~G236) (CL:COND (~G236 ~G236) (T (CL:LABELS ((~G1749 (~G237) (CL:COND (~G237 ~G237) (T (CL:LABELS ((~G1750 (~G238) (CL:COND (~G238 ~G238) (T (EQ X 'ACCENT-CIRCONFLEX))))) (~G1750 (EQ X 'QUASIQUOTE-SPLICE))))))) (~G1749 (EQ X 'QUASIQUOTE))))))) (~G1748 (EQ X 'BACKQUOTE))))))) (~G1747 (EQ X 'CL:QUOTE))))))
  (CL:DEFUN READ-CONS-SLOT (STR) (CL:BLOCK READ-CONS-SLOT (CL:BLOCK NIL (READ-SET-LISTPROP STR) (CL:LABELS ((~G1751 (~G294) (CL:PROGN (CL:SETQ *DEFAULT-LISTPROP* *DEFAULT-LISTPROP*)) (CL:LABELS ((~G1752 (~G300) (CL:PROGN (CL:SETQ *DEFAULT-LISTPROP* ~G294)) ~G300)) (~G1752 (CL:PROGN (CL:LABELS ((~G1753 (!) (CL:COND ((== #\. (PEEK-CHAR STR)) (CL:PROGN (READ-CHAR STR) (CL:LABELS ((~G1754 (~G295) (CL:LABELS ((~G1755 (~G296) (CL:COND ((NOT (EQ (CL:CAR ~G295) 'VALUES)) (CL:PROGN (ERROR "VALUES expected instead of ~A." ~G295)))) (CL:LABELS ((~G1756 (TOKEN) (CL:LABELS ((~G1757 (~G297) (CL:LABELS ((~G1758 (PKG) (CL:LABELS ((~G1759 (~G298) (CL:LABELS ((~G1760 (SYM) (READ-SLOT-VALUE (CL:LIST ! (LIST-STRING SYM))))) (~G1760 (CL:CAR ~G298))))) (~G1759 (CL:LABELS ((~G1761 (~G302) (CL:COND (~G302 ~G302) (T (%ERROR "Not enough VALUES."))))) (~G1761 (CL:CDR ~G297))))))) (~G1758 (CL:CAR ~G297))))) (~G1757 (CL:LABELS ((~G1762 (~G301) (CL:COND (~G301 ~G301) (T (%ERROR "Not enough VALUES."))))) (~G1762 (CL:CDR ~G296))))))) (~G1756 (CL:CAR ~G296))))) (~G1755 (CL:CDR ~G295))))) (~G1754 (READ-TOKEN STR))))) (T !)))) (~G1753 (READ-CONS STR)))))))) (~G1751 *DEFAULT-LISTPROP*)))))
  (CL:DEFUN READ-CONS (STR) (CL:BLOCK READ-CONS (CL:BLOCK NIL (CL:LABELS ((~G1763 (LOC) (CL:LABELS ((~G1764 (LINE) (CL:LABELS ((~G1765 (COLUMN) (CL:LABELS ((~G1766 (FILE) (CL:LABELS ((ERR (_) (CL:BLOCK NIL (ERROR "~A in form starting at line ~A, column ~A in file ~A." _ LINE COLUMN FILE))) (F (TOKEN PKG SYM) (CL:COND ((NOT (%READ-CLOSING-BRACKET? TOKEN)) (CL:PROGN (CL:CONS (CL:LABELS ((~G1767 (~G268) (CL:PROGN (CL:SETQ *DEFAULT-LISTPROP* *DEFAULT-LISTPROP*)) (CL:LABELS ((~G1768 (~G271) (CL:PROGN (CL:SETQ *DEFAULT-LISTPROP* ~G268)) ~G271)) (~G1768 (CL:PROGN (CL:LABELS ((~G1769 (~G267) (CL:COND ((EQ ~G267 'BRACKET-OPEN) (READ-CONS-SLOT STR)) ((EQ ~G267 'SQUARE-BRACKET-OPEN) (CL:CONS 'SQUARE (READ-CONS-SLOT STR))) ((EQ ~G267 'CURLY-BRACKET-OPEN) (CL:CONS 'CURLY (READ-CONS-SLOT STR))) (T (CL:COND ((TOKEN-IS-QUOTE? TOKEN) (READ-QUOTE STR TOKEN)) (T (READ-ATOM STR TOKEN PKG SYM))))))) (~G1769 TOKEN))))))) (~G1767 *DEFAULT-LISTPROP*)) (CL:LABELS ((~G1770 (~G270) (CL:PROGN (CL:SETQ *DEFAULT-LISTPROP* *DEFAULT-LISTPROP*)) (CL:LABELS ((~G1771 (~G277) (CL:PROGN (CL:SETQ *DEFAULT-LISTPROP* ~G270)) ~G277)) (~G1771 (CL:PROGN (CL:LABELS ((~G1772 (!) (CL:COND (! (CL:LABELS ((~G1773 (~G272) (CL:LABELS ((~G1774 (~G273) (CL:COND ((NOT (EQ (CL:CAR ~G272) 'VALUES)) (CL:PROGN (ERROR "VALUES expected instead of ~A." ~G272)))) (CL:LABELS ((~G1775 (TOKEN) (CL:LABELS ((~G1776 (~G274) (CL:LABELS ((~G1777 (PKG) (CL:LABELS ((~G1778 (~G275) (CL:LABELS ((~G1779 (SYM) (CL:COND ((EQ 'DOT TOKEN) (CL:LABELS ((~G1780 (X) (CL:LABELS ((~G1781 (~G280) (CL:LABELS ((~G1782 (~G281) (CL:COND ((NOT (EQ (CL:CAR ~G280) 'VALUES)) (CL:PROGN (ERROR "VALUES expected instead of ~A." ~G280)))) (CL:LABELS ((~G1783 (TOKEN) (CL:LABELS ((~G1784 (~G282) (CL:LABELS ((~G1785 (PKG) (CL:LABELS ((~G1786 (~G283) (CL:LABELS ((~G1787 (SYM) (CL:LABELS ((~G1788 (~G269) (CL:COND (~G269 ~G269) (T (ERR "Only one value allowed after dotted cons"))))) (~G1788 (%READ-CLOSING-BRACKET? TOKEN))) X)) (~G1787 (CL:CAR ~G283))))) (~G1786 (CL:LABELS ((~G1789 (~G286) (CL:COND (~G286 ~G286) (T (%ERROR "Not enough VALUES."))))) (~G1789 (CL:CDR ~G282))))))) (~G1785 (CL:CAR ~G282))))) (~G1784 (CL:LABELS ((~G1790 (~G285) (CL:COND (~G285 ~G285) (T (%ERROR "Not enough VALUES."))))) (~G1790 (CL:CDR ~G281))))))) (~G1783 (CL:CAR ~G281))))) (~G1782 (CL:CDR ~G280))))) (~G1781 (READ-TOKEN STR))))) (~G1780 (READ-EXPR STR)))) (T (F TOKEN PKG SYM))))) (~G1779 (CL:CAR ~G275))))) (~G1778 (CL:LABELS ((~G1791 (~G279) (CL:COND (~G279 ~G279) (T (%ERROR "Not enough VALUES."))))) (~G1791 (CL:CDR ~G274))))))) (~G1777 (CL:CAR ~G274))))) (~G1776 (CL:LABELS ((~G1792 (~G278) (CL:COND (~G278 ~G278) (T (%ERROR "Not enough VALUES."))))) (~G1792 (CL:CDR ~G273))))))) (~G1775 (CL:CAR ~G273))))) (~G1774 (CL:CDR ~G272))))) (~G1773 !))) (T (ERR "Missing closing bracket"))))) (~G1772 (READ-TOKEN STR)))))))) (~G1770 *DEFAULT-LISTPROP*)))))))) (CL:LABELS ((~G1793 (~G287) (CL:LABELS ((~G1794 (~G288) (CL:COND ((NOT (EQ (CL:CAR ~G287) 'VALUES)) (CL:PROGN (ERROR "VALUES expected instead of ~A." ~G287)))) (CL:LABELS ((~G1795 (TOKEN) (CL:LABELS ((~G1796 (~G289) (CL:LABELS ((~G1797 (PKG) (CL:LABELS ((~G1798 (~G290) (CL:LABELS ((~G1799 (SYM) (CL:COND ((EQ TOKEN 'DOT) (CL:CONS 'CL:CONS (READ-CONS STR))) (T (F TOKEN PKG SYM))))) (~G1799 (CL:CAR ~G290))))) (~G1798 (CL:LABELS ((~G1800 (~G293) (CL:COND (~G293 ~G293) (T (%ERROR "Not enough VALUES."))))) (~G1800 (CL:CDR ~G289))))))) (~G1797 (CL:CAR ~G289))))) (~G1796 (CL:LABELS ((~G1801 (~G292) (CL:COND (~G292 ~G292) (T (%ERROR "Not enough VALUES."))))) (~G1801 (CL:CDR ~G288))))))) (~G1795 (CL:CAR ~G288))))) (~G1794 (CL:CDR ~G287))))) (~G1793 (READ-TOKEN STR)))))) (~G1766 (STREAM-LOCATION-ID LOC))))) (~G1765 (STREAM-LOCATION-COLUMN LOC))))) (~G1764 (STREAM-LOCATION-LINE LOC))))) (~G1763 (STREAM-INPUT-LOCATION STR))))))
  (CL:DEFUN %READ-CLOSING-BRACKET? (X) (CL:BLOCK %READ-CLOSING-BRACKET? (CL:BLOCK NIL (CL:LABELS ((~G1802 (~G239) (CL:COND (~G239 ~G239) (T (CL:LABELS ((~G1803 (~G240) (CL:COND (~G240 ~G240) (T (EQ X 'CURLY-BRACKET-CLOSE))))) (~G1803 (EQ X 'SQUARE-BRACKET-CLOSE))))))) (~G1802 (EQ X 'BRACKET-CLOSE))))))
  (CL:DEFUN READ-SET-LISTPROP (STR) (CL:BLOCK READ-SET-LISTPROP (CL:BLOCK NIL (CL:LABELS ((~G1804 (!) (CL:PROGN (CL:SETQ *DEFAULT-LISTPROP* (CL:CONS (STREAM-LOCATION-ID !) (CL:CONS (MEMORIZED-NUMBER (STREAM-LOCATION-COLUMN !)) (MEMORIZED-NUMBER (STREAM-LOCATION-LINE !)))))))) (~G1804 (STREAM-INPUT-LOCATION STR))))))
  (CL:DEFUN MEMORIZED-NUMBER (X) (CL:BLOCK MEMORIZED-NUMBER (CL:BLOCK NIL (CL:LABELS ((~G1805 (~G222) (CL:COND (~G222 ~G222) (T (CL:PROGN (=-HREF X *MEMORIZED-NUMBERS* X)))))) (~G1805 (HREF *MEMORIZED-NUMBERS* X))))))
  (CL:DEFUN READ-TOKEN (STR) (CL:BLOCK READ-TOKEN (CL:BLOCK NIL (CL:LABELS ((~G1806 (~G261) (CL:LABELS ((~G1807 (~G262) (CL:COND ((NOT (EQ (CL:CAR ~G261) 'VALUES)) (CL:PROGN (ERROR "VALUES expected instead of ~A." ~G261)))) (CL:LABELS ((~G1808 (PKG) (CL:LABELS ((~G1809 (~G263) (CL:LABELS ((~G1810 (SYM) (VALUES (CL:COND ((CL:COND (SYM (CL:COND ((NOT (CL:CDR SYM)) (== #\. (CL:CAR SYM)))))) 'DOT) (T (CL:COND (SYM (CL:COND ((LIST-NUMBER? SYM) 'NUMBER) (T 'SYMBOL))) (T (CL:LABELS ((~G1811 (~G260) (CL:COND ((CHARACTER== ~G260 #\() 'BRACKET-OPEN) ((CHARACTER== ~G260 #\)) 'BRACKET-CLOSE) ((CHARACTER== ~G260 #\[) 'SQUARE-BRACKET-OPEN) ((CHARACTER== ~G260 #\]) 'SQUARE-BRACKET-CLOSE) ((CHARACTER== ~G260 #\{) 'CURLY-BRACKET-OPEN) ((CHARACTER== ~G260 #\}) 'CURLY-BRACKET-CLOSE) ((CHARACTER== ~G260 #\') 'CL:QUOTE) ((CHARACTER== ~G260 #\`) 'BACKQUOTE) ((CHARACTER== ~G260 #\^) 'ACCENT-CIRCONFLEX) ((CHARACTER== ~G260 #\") 'DBLQUOTE) ((CHARACTER== ~G260 #\,) (CL:COND ((== #\@ (PEEK-CHAR STR)) (CL:COND ((READ-CHAR STR) 'QUASIQUOTE-SPLICE))) (T 'QUASIQUOTE))) ((CHARACTER== ~G260 #\#) (CL:LABELS ((~G1812 (~G259) (CL:COND ((CHARACTER== ~G259 #\\) 'CHAR) ((CHARACTER== ~G259 #\x) 'HEXNUM) ((CHARACTER== ~G259 #\') 'CL:FUNCTION) ((CHARACTER== ~G259 #\|) (READ-COMMENT-BLOCK STR)) (T (ERROR "Invalid character after '#'."))))) (~G1812 (READ-CHAR STR)))) ((CHARACTER== ~G260 -1) 'EOF)))) (~G1811 (READ-CHAR STR))))))) PKG SYM))) (~G1810 (CL:CAR ~G263))))) (~G1809 (CL:LABELS ((~G1813 (~G265) (CL:COND (~G265 ~G265) (T (%ERROR "Not enough VALUES."))))) (~G1813 (CL:CDR ~G262))))))) (~G1808 (CL:CAR ~G262))))) (~G1807 (CL:CDR ~G261))))) (~G1806 (GET-SYMBOL-AND-PACKAGE STR))))))
  (CL:DEFUN READ-COMMENT-BLOCK (STR) (CL:BLOCK READ-COMMENT-BLOCK (CL:BLOCK NIL (CL:BLOCK NIL (CL:PROGN (CL:TAGBODY ~G255 (CL:COND ((NOT (NOT (CL:COND ((== #\| (READ-CHAR STR)) (== #\# (PEEK-CHAR STR)))))) (CL:RETURN-FROM NIL (CL:PROGN (READ-CHAR STR))))) NIL (CL:GO ~G255)))))))
  (CL:DEFUN LIST-NUMBER? (X) (CL:BLOCK LIST-NUMBER? (CL:BLOCK NIL (CL:COND ((CL:LABELS ((~G1814 (~G257) (CL:COND (~G257 ~G257) (T (DIGIT-CHAR? (CL:CAR X)))))) (~G1814 (CL:COND ((CL:CDR X) (CL:LABELS ((~G1815 (~G256) (CL:COND (~G256 ~G256) (T (== #\. (CL:CAR X)))))) (~G1815 (== #\- (CL:CAR X)))))))) (CL:COND ((CL:CDR X) (EVERY (CL:LAMBDA (_) (CL:BLOCK NIL (CL:LABELS ((~G1816 (~G258) (CL:COND (~G258 ~G258) (T (== #\. _))))) (~G1816 (DIGIT-CHAR? _))))) (CL:CDR X))) (T T)))))))
  (CL:DEFUN EVERY (PRED CL:&REST SEQS) (CL:BLOCK EVERY (CL:BLOCK NIL (CL:BLOCK NIL (CL:LABELS ((~G1817 (~G108) (CL:LABELS ((~G1818 (SEQ) (CL:TAGBODY ~G106 (CL:COND ((NOT ~G108) (CL:GO ~G107))) (CL:SETQ SEQ (CL:CAR ~G108)) (CL:LABELS ((~G1819 (~G105) (CL:BLOCK NIL (CL:LABELS ((~G1820 (!) (CL:TAGBODY ~G109 (CL:COND ((INTEGER== ! ~G105) (CL:RETURN-FROM NIL (CL:PROGN NIL)))) (CL:LABELS ((~G1821 (~G104) (CL:COND (~G104 ~G104) (T (CL:RETURN-FROM EVERY NIL))))) (~G1821 (FUNCALL PRED (ELT SEQ !)))) (CL:SETQ ! (INTEGER+ 1 !)) (CL:GO ~G109)))) (~G1820 0))))) (~G1819 (INTEGER (CL:LENGTH SEQ)))) (CL:SETQ ~G108 (CL:CDR ~G108)) (CL:GO ~G106) ~G107 (CL:RETURN-FROM NIL (CL:PROGN T))))) (~G1818 NIL)))) (~G1817 SEQS))))))
  (CL:DEFUN GET-SYMBOL-AND-PACKAGE (STR) (CL:BLOCK GET-SYMBOL-AND-PACKAGE (CL:BLOCK NIL (SKIP-SPACES STR) (CL:LABELS ((~G1822 (SYM) (CL:LABELS ((~G1823 (!) (CL:COND (! (CL:PROGN (CL:COND ((== ! #\:) (VALUES (CL:LABELS ((~G1824 (~G254) (CL:COND (~G254 ~G254) (T T)))) (~G1824 SYM)) (CL:COND ((READ-CHAR STR) (GET-SYMBOL STR))))) (T (VALUES NIL SYM)))))))) (~G1823 (PEEK-CHAR STR))))) (~G1822 (GET-SYMBOL STR))))))
  (CL:DEFUN GET-SYMBOL (STR) (CL:BLOCK GET-SYMBOL (CL:BLOCK NIL (CL:LABELS ((~G1825 (C) (CL:COND (C (CL:PROGN (CL:COND ((NOT (SPECIAL-CHAR? C)) (CL:PROGN (GET-SYMBOL-0 STR))))))))) (~G1825 (PEEK-CHAR STR))))))
  (CL:DEFUN GET-SYMBOL-0 (STR) (CL:BLOCK GET-SYMBOL-0 (CL:BLOCK NIL (CL:LABELS ((~G1826 (C) (CL:COND ((== #\; C) (CL:PROGN (SKIP-COMMENT STR) (GET-SYMBOL-0 STR))) (T (CL:COND ((SYMBOL-CHAR? C) (CL:CONS (CHAR-UPCASE (READ-CHAR STR)) (GET-SYMBOL-0 STR)))))))) (~G1826 (CHAR-UPCASE (PEEK-CHAR STR)))))))
  (CL:DEFUN SKIP-COMMENT (STR) (CL:BLOCK SKIP-COMMENT (CL:BLOCK NIL (CL:LABELS ((~G1827 (C) (CL:COND (C (CL:PROGN (CL:COND ((== C 10) (SKIP-SPACES STR)) (T (SKIP-COMMENT STR)))))))) (~G1827 (READ-CHAR STR))))))
  (CL:DEFUN SKIP-SPACES (STR) (CL:BLOCK SKIP-SPACES (CL:BLOCK NIL (CL:LABELS ((~G1828 (C) (CL:COND (C (CL:PROGN (CL:COND ((== #\; C) (CL:PROGN (SKIP-COMMENT STR)))) (CL:COND ((WHITESPACE? C) (CL:PROGN (READ-CHAR STR) (SKIP-SPACES STR))))))))) (~G1828 (PEEK-CHAR STR))))))
  (CL:DEFUN WHITESPACE? (X) (CL:BLOCK WHITESPACE? (CL:BLOCK NIL (CL:COND ((< X 33) (>= X 0))))))
  (CL:DEFUN PEEK-CHAR (CL:&OPTIONAL (STR *STANDARD-INPUT*)) (CL:BLOCK PEEK-CHAR (CL:BLOCK NIL (CL:LABELS ((~G1829 (~G224) (CL:COND (~G224 ~G224) (T (CL:PROGN (=-STREAM-PEEKED-CHAR (READ-CHAR-0 STR) STR)))))) (~G1829 (STREAM-PEEKED-CHAR STR))))))
  (CL:DEFUN CADR (LST) (CL:CAR (CL:CDR LST)))
  (CL:DEFUN QUOTE-EXPAND (X) (CL:BLOCK QUOTE-EXPAND (CL:BLOCK NIL (CL:LABELS ((~G885 (X) (CL:LABELS ((ATOMIC (_) (CL:BLOCK NIL (CL:COND ((CONSTANT-LITERAL? _) _) (T (CL:CONS 'CL:QUOTE (CL:CONS _ NIL)))))) (STATIC (_) (CL:BLOCK NIL (CL:COND ((CL:ATOM _) (ATOMIC _)) (T (CL:CONS 'CL:CONS (CL:CONS (STATIC (CL:CAR _)) (CL:CONS (STATIC (CL:CDR _)) NIL))))))) (QQ (_) (CL:BLOCK NIL (CL:COND ((ANY-QUASIQUOTE? (CADR (CL:CAR _))) (CL:CONS 'CL:CONS (CL:CONS (BACKQ (CADR (CL:CAR _))) (CL:CONS (BACKQ (CL:CDR _)) NIL)))) (T (CL:CONS 'CL:CONS (CL:CONS (CADR (CL:CAR _)) (CL:CONS (BACKQ (CL:CDR _)) NIL))))))) (QQS (_) (CL:BLOCK NIL (CL:COND ((ANY-QUASIQUOTE? (CADR (CL:CAR _))) (ERROR "Illegal ~A as argument to ,@ (QUASIQUOTE-SPLICE)." (CADR (CL:CAR _)))) (T (CL:CONS 'APPEND (CL:CONS (CADR (CL:CAR _)) (CL:CONS (BACKQ (CL:CDR _)) NIL))))))) (BACKQ (_) (CL:BLOCK NIL (CL:COND ((CL:ATOM _) (ATOMIC _)) (T (CL:LABELS ((~G1830 (~G883) (CL:COND ((CL:ATOM ~G883) (CL:CONS 'CL:CONS (CL:CONS (ATOMIC (CL:CAR _)) (CL:CONS (BACKQ (CL:CDR _)) NIL)))) ((QUASIQUOTE? ~G883) (QQ _)) ((QUASIQUOTE-SPLICE? ~G883) (QQS _)) (T (CL:CONS 'CL:CONS (CL:CONS (BACKQ (CL:CAR _)) (CL:CONS (BACKQ (CL:CDR _)) NIL))))))) (~G1830 (CL:CAR _))))))) (DISP (_) (CL:BLOCK NIL (CL:LABELS ((~G1831 (~G884) (CL:COND ((QUOTE? ~G884) (STATIC (CL:CAR (CL:CDR _)))) ((BACKQUOTE? ~G884) (BACKQ (CL:CAR (CL:CDR _)))) (T _)))) (~G1831 _))))) (CL:CAR (TREE-WALK (CL:LIST X) :ASCENDING #'DISP))))) (CL:COND ((NOT (DUMP-PASS? 'QUOTE-EXPAND)) (CL:PROGN (CL:RETURN-FROM NIL (~G885 X))))) (FRESH-LINE) (FORMAT T "; **** QUOTE-EXPAND~%") (CL:LABELS ((~G1832 (~G886) (FRESH-LINE) (FORMAT T "; **** end of QUOTE-EXPAND~%") ~G886)) (~G1832 (CL:LABELS ((~G1833 (~G887) (CL:PROGN (CL:SETQ *CURRENT-PASS-INPUT* X)) (CL:LABELS ((~G1834 (~G889) (CL:PROGN (CL:SETQ *CURRENT-PASS-INPUT* ~G887)) ~G889)) (~G1834 (CL:PROGN (CL:LABELS ((~G1835 (~G888) (CL:PROGN (CL:SETQ *ALWAYS-PRINT-PACKAGE-NAMES?* T)) (CL:LABELS ((~G1836 (~G890) (CL:PROGN (CL:SETQ *ALWAYS-PRINT-PACKAGE-NAMES?* ~G888)) ~G890)) (~G1836 (CL:PROGN (LATE-PRINT (~G885 X))))))) (~G1835 *ALWAYS-PRINT-PACKAGE-NAMES?*))))))) (~G1833 *CURRENT-PASS-INPUT*))))))))
  (CL:DEFUN DUMP-PASS? (NAME) (CL:BLOCK DUMP-PASS? (CL:BLOCK NIL (CL:COND (*TRANSPILER* (CL:LABELS ((~G1837 (!) (CL:COND (! (CL:LABELS ((~G1838 (~G418) (CL:COND (~G418 ~G418) (T (MEMBER NAME (ENSURE-LIST !)))))) (~G1838 (EQ T !))))))) (~G1837 (DUMP-PASSES?))))))))
  (CL:DEFUN ENSURE-LIST (X) (CL:BLOCK ENSURE-LIST (CL:BLOCK NIL (CL:COND ((CONS? X) X) (T (CL:LIST X))))))
  (CL:DEFUN MEMBER (ELM LST CL:&KEY (TEST #'EQL)) (CL:BLOCK MEMBER (CL:BLOCK NIL (CL:BLOCK NIL (CL:LABELS ((~G1839 (I) (CL:TAGBODY ~G23 (CL:COND ((NOT I) (CL:RETURN-FROM NIL (CL:PROGN)))) (CL:COND ((FUNCALL TEST ELM (CL:CAR I)) (CL:RETURN-FROM MEMBER I))) (CL:SETQ I (CL:CDR I)) (CL:GO ~G23)))) (~G1839 LST))))))
  (CL:DEFUN DUMP-PASSES? NIL (CL:BLOCK DUMP-PASSES? (CL:BLOCK NIL (CL:AREF *TRANSPILER* 61))))
  (CL:DEFUN TREE-WALK (I CL:&KEY (ASCENDING NIL) (DONT-ASCEND-IF NIL) (DONT-ASCEND-AFTER-IF NIL)) (CL:BLOCK TREE-WALK (CL:BLOCK NIL (CL:COND ((CL:ATOM I) (FUNCALL ASCENDING I)) (T (CL:PROGN (CL:LABELS ((~G1840 (Y) (CL:LABELS ((~G1841 (A) (CL:PROGN (CL:LABELS ((~G1842 (~G362) (CL:LABELS ((~G1843 (!) (CL:COND (! (CL:PROGN (CL:PROGN (CL:SETQ *DEFAULT-LISTPROP* !))))))) (~G1843 (CL:COND ((CONS? ~G362) (CPR ~G362))))))) (~G1842 I)) (CL:LABELS ((~G1844 (~G361) (RPLACP (CL:CONS A (TREE-WALK (CL:CDR I) :ASCENDING ASCENDING :DONT-ASCEND-IF DONT-ASCEND-IF :DONT-ASCEND-AFTER-IF DONT-ASCEND-AFTER-IF)) ~G361))) (~G1844 *DEFAULT-LISTPROP*))))) (~G1841 (CL:LABELS ((~G1845 (~G360) (CL:COND (~G360 ~G360) (T (CL:COND ((CL:COND (DONT-ASCEND-AFTER-IF (FUNCALL DONT-ASCEND-AFTER-IF Y))) (FUNCALL ASCENDING Y)) (T (TREE-WALK (CL:COND (ASCENDING (FUNCALL ASCENDING Y)) (T Y)) :ASCENDING ASCENDING :DONT-ASCEND-IF DONT-ASCEND-IF :DONT-ASCEND-AFTER-IF DONT-ASCEND-AFTER-IF))))))) (~G1845 (CL:COND (DONT-ASCEND-IF (CL:COND ((FUNCALL DONT-ASCEND-IF Y) Y)))))))))) (~G1840 (CL:CAR I)))))))))
  (CL:DEFUN BACKQUOTE? (X) (CL:BLOCK BACKQUOTE? (CL:BLOCK NIL (CL:COND ((CONS? X) (CL:COND ((EQ 'BACKQUOTE (CL:CAR X)) X)))))))
  (CL:DEFUN QUOTE? (X) (CL:BLOCK QUOTE? (CL:BLOCK NIL (CL:COND ((CONS? X) (CL:COND ((EQ 'CL:QUOTE (CL:CAR X)) X)))))))
  (CL:DEFUN QUASIQUOTE-SPLICE? (X) (CL:BLOCK QUASIQUOTE-SPLICE? (CL:BLOCK NIL (CL:COND ((CONS? X) (CL:COND ((EQ 'QUASIQUOTE-SPLICE (CL:CAR X)) X)))))))
  (CL:DEFUN QUASIQUOTE? (X) (CL:BLOCK QUASIQUOTE? (CL:BLOCK NIL (CL:COND ((CONS? X) (CL:COND ((EQ 'QUASIQUOTE (CL:CAR X)) X)))))))
  (CL:DEFUN ANY-QUASIQUOTE? (X) (CL:COND ((CONS? X) (CL:COND ((EQ (CL:CAR X) 'QUASIQUOTE) T) ((EQ (CL:CAR X) 'QUASIQUOTE-SPLICE) T)))))
  (CL:DEFUN CONSTANT-LITERAL? (X) (CL:BLOCK CONSTANT-LITERAL? (CL:BLOCK NIL (CL:LABELS ((~G1846 (~G409) (CL:COND (~G409 ~G409) (T (CL:LABELS ((~G1847 (~G410) (CL:COND (~G410 ~G410) (T (CL:LABELS ((~G1848 (~G411) (CL:COND (~G411 ~G411) (T (CL:LABELS ((~G1849 (~G412) (CL:COND (~G412 ~G412) (T (CL:LABELS ((~G1850 (~G413) (CL:COND (~G413 ~G413) (T (HASH-TABLE? X))))) (~G1850 (ARRAY? X))))))) (~G1849 (STRING? X))))))) (~G1848 (NUMBER? X))))))) (~G1847 (EQ T X))))))) (~G1846 (NOT X))))))
  (CL:DEFUN EQUAL (X Y) (CL:BLOCK EQUAL (CL:BLOCK NIL (CL:COND ((CL:LABELS ((~G1851 (~G6) (CL:COND (~G6 ~G6) (T (CL:ATOM Y))))) (~G1851 (CL:ATOM X))) (EQL X Y)) ((EQUAL (CL:CAR X) (CL:CAR Y)) (EQUAL (CL:CDR X) (CL:CDR Y)))))))
  (CL:DEFUN CADAR (LST) (CADR (CL:CAR LST)))
  (CL:DEFUN GENSYM NIL (CL:LABELS ((~G1852 (X) (CL:COND ((EQ (SYMBOL-VALUE X) X) (CL:COND ((SYMBOL-FUNCTION X) (GENSYM)) (T X))) (T (GENSYM))))) (~G1852 (MAKE-SYMBOL (STRING-CONCAT *GENSYM-PREFIX* (STRING (GENSYM-NUMBER)))))))
  (CL:DEFUN GENSYM-NUMBER NIL (CL:SETQ *GENSYM-COUNTER* (+ 1 *GENSYM-COUNTER*)))
  (CL:DEFUN + (CL:&REST X) (CL:LABELS ((~G1853 (A) (CL:COND (A (CL:APPLY (CL:COND ((CONS? A) #'APPEND) ((STRING? A) #'STRING-CONCAT) (T #'NUMBER+)) X)) (T (CL:COND ((CL:CDR X) (CL:APPLY #'+ (CL:CDR X)))))))) (~G1853 (CL:CAR X))))
  (CL:DEFUN IDENTITY (X) X)
  (CL:DEFVAR *GENSYM-COUNTER*)
  (CL:DEFVAR *GENSYM-PREFIX*)
  