diff options
Diffstat (limited to 'src/boot/strap/scanner.clisp')
-rw-r--r-- | src/boot/strap/scanner.clisp | 626 |
1 files changed, 626 insertions, 0 deletions
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp new file mode 100644 index 00000000..50078c3d --- /dev/null +++ b/src/boot/strap/scanner.clisp @@ -0,0 +1,626 @@ +(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-lexer")) + +(IMPORT-MODULE "tokens") + +(IMPORT-MODULE "includer") + +(IN-PACKAGE "BOOTTRAN") + +(DEFUN |double| (|x|) (PROG () (RETURN (FLOAT |x| 1.0)))) + +(DEFUN |dqUnit| (|s|) + (PROG (|a|) (RETURN (PROGN (SETQ |a| (LIST |s|)) (CONS |a| |a|))))) + +(DEFUN |dqAppend| (|x| |y|) + (PROG () + (RETURN + (COND + ((NULL |x|) |y|) + ((NULL |y|) |x|) + ('T (RPLACD (CDR |x|) (CAR |y|)) (RPLACD |x| (CDR |y|)) |x|))))) + +(DEFUN |dqConcat| (|ld|) + (PROG () + (RETURN + (COND + ((NULL |ld|) NIL) + ((NULL (CDR |ld|)) (CAR |ld|)) + ('T (|dqAppend| (CAR |ld|) (|dqConcat| (CDR |ld|)))))))) + +(DEFUN |dqToList| (|s|) + (PROG () (RETURN (COND ((NULL |s|) NIL) ('T (CAR |s|)))))) + +(DEFUN |shoeConstructToken| (|ln| |lp| |b| |n|) + (PROG () + (RETURN (CONS (ELT |b| 0) (CONS (ELT |b| 1) (CONS |lp| |n|)))))) + +(DEFUN |shoeTokType| (|x|) (PROG () (RETURN (CAR |x|)))) + +(DEFUN |shoeTokPart| (|x|) (PROG () (RETURN (CADR |x|)))) + +(DEFUN |shoeTokPosn| (|x|) (PROG () (RETURN (CDDR |x|)))) + +(DEFUN |shoeTokConstruct| (|x| |y| |z|) + (PROG () (RETURN (CONS |x| (CONS |y| |z|))))) + +(DEFUN |shoeNextLine| (|s|) + (PROG (|s1| |a|) + (DECLARE (SPECIAL |$sz| |$n| |$ln| |$r| |$f| |$linepos|)) + (RETURN + (COND + ((|bStreamNull| |s|) NIL) + ('T (SETQ |$linepos| |s|) (SETQ |$f| (CAR |s|)) + (SETQ |$r| (CDR |s|)) (SETQ |$ln| (CAR |$f|)) + (SETQ |$n| (STRPOSL " " |$ln| 0 T)) + (SETQ |$sz| (LENGTH |$ln|)) + (COND + ((NULL |$n|) T) + ((EQUAL (QENUM |$ln| |$n|) |shoeTAB|) + (PROGN + (SETQ |a| (MAKE-FULL-CVEC (- 7 (REM |$n| 8)) " ")) + (SETF (ELT |$ln| |$n|) (ELT " " 0)) + (SETQ |$ln| (CONCAT |a| |$ln|)) + (SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|)) + (|shoeNextLine| |s1|))) + ('T T))))))) + +(DEFUN |shoeLineToks| (|s|) + (PROG (|$linepos| |$floatok| |$sz| |$n| |$ln| |$r| |$f| |toks| |a| + |dq| |command| |fst|) + (DECLARE (SPECIAL |$floatok| |$f| |$sz| |$linepos| |$ln| |$r| |$n|)) + (RETURN + (PROGN + (SETQ |$f| NIL) + (SETQ |$r| NIL) + (SETQ |$ln| NIL) + (SETQ |$n| NIL) + (SETQ |$sz| NIL) + (SETQ |$floatok| T) + (SETQ |$linepos| |s|) + (COND + ((NULL (|shoeNextLine| |s|)) (CONS NIL NIL)) + ((NULL |$n|) (|shoeLineToks| |$r|)) + (#0='T + (PROGN + (SETQ |fst| (QENUM |$ln| 0)) + (COND + ((EQL |fst| |shoeCLOSEPAREN|) + (COND + ((SETQ |command| (|shoeLine?| |$ln|)) + (PROGN + (SETQ |dq| + (|dqUnit| + (|shoeConstructToken| |$ln| |$linepos| + (|shoeLeafLine| |command|) 0))) + (CONS (LIST |dq|) |$r|))) + ((SETQ |command| (|shoeLisp?| |$ln|)) + (|shoeLispToken| |$r| |command|)) + ((SETQ |command| (|shoePackage?| |$ln|)) + (PROGN + (SETQ |a| (CONCAT "(IN-PACKAGE " |command| ")")) + (SETQ |dq| + (|dqUnit| + (|shoeConstructToken| |$ln| |$linepos| + (|shoeLeafLisp| |a|) 0))) + (CONS (LIST |dq|) |$r|))) + (#0# (|shoeLineToks| |$r|)))) + (#0# + (PROGN + (SETQ |toks| NIL) + (LOOP + (COND + ((NOT (< |$n| |$sz|)) (RETURN NIL)) + ('T + (SETQ |toks| (|dqAppend| |toks| (|shoeToken|)))))) + (COND + ((NULL |toks|) (|shoeLineToks| |$r|)) + (#0# (CONS (LIST |toks|) |$r|))))))))))))) + +(DEFUN |shoeLispToken| (|s| |string|) + (PROG (|dq| |st| |r| |LETTMP#1| |linepos| |ln|) + (DECLARE (SPECIAL |$linepos| |$ln|)) + (RETURN + (PROGN + (SETQ |string| + (COND + ((OR (EQL (LENGTH |string|) 0) + (EQL (QENUM |string| 0) (QENUM ";" 0))) + "") + ('T |string|))) + (SETQ |ln| |$ln|) + (SETQ |linepos| |$linepos|) + (SETQ |LETTMP#1| (|shoeAccumulateLines| |s| |string|)) + (SETQ |r| (CAR |LETTMP#1|)) + (SETQ |st| (CDR |LETTMP#1|)) + (SETQ |dq| + (|dqUnit| + (|shoeConstructToken| |ln| |linepos| + (|shoeLeafLisp| |st|) 0))) + (CONS (LIST |dq|) |r|))))) + +(DEFUN |shoeAccumulateLines| (|s| |string|) + (PROG (|a| |command| |fst|) + (DECLARE (SPECIAL |$ln| |$r| |$n|)) + (RETURN + (COND + ((NULL (|shoeNextLine| |s|)) (CONS |s| |string|)) + ((NULL |$n|) (|shoeAccumulateLines| |$r| |string|)) + ((EQL (LENGTH |$ln|) 0) (|shoeAccumulateLines| |$r| |string|)) + (#0='T + (PROGN + (SETQ |fst| (QENUM |$ln| 0)) + (COND + ((EQL |fst| |shoeCLOSEPAREN|) + (PROGN + (SETQ |command| (|shoeLisp?| |$ln|)) + (COND + ((AND |command| (< 0 (LENGTH |command|))) + (COND + ((EQL (QENUM |command| 0) (QENUM ";" 0)) + (|shoeAccumulateLines| |$r| |string|)) + (#0# + (PROGN + (SETQ |a| (STRPOS ";" |command| 0 NIL)) + (COND + (|a| (|shoeAccumulateLines| |$r| + (CONCAT |string| + (SUBSTRING |command| 0 (- |a| 1))))) + (#0# + (|shoeAccumulateLines| |$r| + (CONCAT |string| |command|)))))))) + (#0# (|shoeAccumulateLines| |$r| |string|))))) + (#0# (CONS |s| |string|))))))))) + +(DEFUN |shoeCloser| (|t|) + (PROG () (RETURN (MEMQ (|shoeKeyWord| |t|) '(CPAREN CBRACK))))) + +(DEFUN |shoeToken| () + (PROG (|b| |ch| |n| |linepos| |c| |ln|) + (DECLARE (SPECIAL |$linepos| |$n| |$ln|)) + (RETURN + (PROGN + (SETQ |ln| |$ln|) + (SETQ |c| (QENUM |$ln| |$n|)) + (SETQ |linepos| |$linepos|) + (SETQ |n| |$n|) + (SETQ |ch| (ELT |$ln| |$n|)) + (SETQ |b| + (COND + ((|shoeStartsComment|) (PROGN (|shoeComment|) NIL)) + ((|shoeStartsNegComment|) + (PROGN (|shoeNegComment|) NIL)) + ((EQUAL |c| |shoeLispESCAPE|) (|shoeLispEscape|)) + ((|shoePunctuation| |c|) (|shoePunct|)) + ((|shoeStartsId| |ch|) (|shoeWord| NIL)) + ((EQUAL |c| |shoeSPACE|) (PROGN (|shoeSpace|) NIL)) + ((EQUAL |c| |shoeSTRINGCHAR|) (|shoeString|)) + ((|shoeDigit| |ch|) (|shoeNumber|)) + ((EQUAL |c| |shoeESCAPE|) (|shoeEscape|)) + ((EQUAL |c| |shoeTAB|) + (PROGN (SETQ |$n| (+ |$n| 1)) NIL)) + (#0='T (|shoeError|)))) + (COND + ((NULL |b|) NIL) + (#0# + (|dqUnit| (|shoeConstructToken| |ln| |linepos| |b| |n|)))))))) + +(DEFUN |shoeLeafId| (|x|) (PROG () (RETURN (LIST 'ID (INTERN |x|))))) + +(DEFUN |shoeLeafKey| (|x|) + (PROG () (RETURN (LIST 'KEY (|shoeKeyWord| |x|))))) + +(DEFUN |shoeLeafInteger| (|x|) + (PROG () (RETURN (LIST 'INTEGER (|shoeIntValue| |x|))))) + +(DEFUN |shoeLeafFloat| (|a| |w| |e|) + (PROG (|c| |b|) + (RETURN + (PROGN + (SETQ |b| (|shoeIntValue| (CONCAT |a| |w|))) + (SETQ |c| + (* (|double| |b|) + (EXPT (|double| 10) (- |e| (LENGTH |w|))))) + (LIST 'FLOAT |c|))))) + +(DEFUN |shoeLeafString| (|x|) (PROG () (RETURN (LIST 'STRING |x|)))) + +(DEFUN |shoeLeafLisp| (|x|) (PROG () (RETURN (LIST 'LISP |x|)))) + +(DEFUN |shoeLeafLispExp| (|x|) (PROG () (RETURN (LIST 'LISPEXP |x|)))) + +(DEFUN |shoeLeafLine| (|x|) (PROG () (RETURN (LIST 'LINE |x|)))) + +(DEFUN |shoeLeafComment| (|x|) (PROG () (RETURN (LIST 'COMMENT |x|)))) + +(DEFUN |shoeLeafNegComment| (|x|) + (PROG () (RETURN (LIST 'NEGCOMMENT |x|)))) + +(DEFUN |shoeLeafError| (|x|) (PROG () (RETURN (LIST 'ERROR |x|)))) + +(DEFUN |shoeLeafSpaces| (|x|) (PROG () (RETURN (LIST 'SPACES |x|)))) + +(DEFUN |shoeLispEscape| () + (PROG (|n| |exp| |a|) + (DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |$n| (+ |$n| 1)) + (COND + ((NOT (< |$n| |$sz|)) + (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error") + (|shoeLeafError| (ELT |$ln| |$n|))) + ('T (SETQ |a| (|shoeReadLispString| |$ln| |$n|)) + (COND + ((NULL |a|) + (PROGN + (|SoftShoeError| (CONS |$linepos| |$n|) + "lisp escape error") + (|shoeLeafError| (ELT |$ln| |$n|)))) + (#0='T + (PROGN + (SETQ |exp| (CAR |a|)) + (SETQ |n| (CADR |a|)) + (COND + ((NULL |n|) + (PROGN (SETQ |$n| |$sz|) (|shoeLeafLispExp| |exp|))) + (#0# + (PROGN (SETQ |$n| |n|) (|shoeLeafLispExp| |exp|))))))))))))) + +(DEFUN |shoeEscape| () + (PROG (|a|) + (DECLARE (SPECIAL |$n|)) + (RETURN + (PROGN + (SETQ |$n| (+ |$n| 1)) + (SETQ |a| (|shoeEsc|)) + (COND (|a| (|shoeWord| T)) ('T NIL)))))) + +(DEFUN |shoeEsc| () + (PROG (|n1|) + (DECLARE (SPECIAL |$ln| |$r| |$sz| |$n|)) + (RETURN + (COND + ((NOT (< |$n| |$sz|)) + (COND + ((|shoeNextLine| |$r|) + (LOOP + (COND (|$n| (RETURN NIL)) (#0='T (|shoeNextLine| |$r|)))) + (|shoeEsc|) NIL) + (#1='T NIL))) + (#1# (SETQ |n1| (STRPOSL " " |$ln| |$n| T)) + (COND + ((NULL |n1|) (|shoeNextLine| |$r|) + (LOOP + (COND (|$n| (RETURN NIL)) (#0# (|shoeNextLine| |$r|)))) + (|shoeEsc|) NIL) + (#1# T))))))) + +(DEFUN |shoeStartsComment| () + (PROG (|www|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (COND + ((< |$n| |$sz|) + (COND + ((EQUAL (QENUM |$ln| |$n|) |shoePLUSCOMMENT|) + (SETQ |www| (+ |$n| 1)) + (COND + ((NOT (< |www| |$sz|)) NIL) + (#0='T (EQUAL (QENUM |$ln| |www|) |shoePLUSCOMMENT|)))) + (#0# NIL))) + (#0# NIL))))) + +(DEFUN |shoeStartsNegComment| () + (PROG (|www|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (COND + ((< |$n| |$sz|) + (COND + ((EQUAL (QENUM |$ln| |$n|) |shoeMINUSCOMMENT|) + (SETQ |www| (+ |$n| 1)) + (COND + ((NOT (< |www| |$sz|)) NIL) + (#0='T (EQUAL (QENUM |$ln| |www|) |shoeMINUSCOMMENT|)))) + (#0# NIL))) + (#0# NIL))))) + +(DEFUN |shoeNegComment| () + (PROG (|n|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |n| |$n|) + (SETQ |$n| |$sz|) + (|shoeLeafNegComment| (SUBSTRING |$ln| |n| NIL)))))) + +(DEFUN |shoeComment| () + (PROG (|n|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |n| |$n|) + (SETQ |$n| |$sz|) + (|shoeLeafComment| (SUBSTRING |$ln| |n| NIL)))))) + +(DEFUN |shoePunct| () + (PROG (|sss|) + (DECLARE (SPECIAL |$n| |$ln|)) + (RETURN + (PROGN + (SETQ |sss| (|shoeMatch| |$ln| |$n|)) + (SETQ |$n| (+ |$n| (LENGTH |sss|))) + (|shoeKeyTr| |sss|))))) + +(DEFUN |shoeKeyTr| (|w|) + (PROG () + (DECLARE (SPECIAL |$floatok|)) + (RETURN + (COND + ((EQ (|shoeKeyWord| |w|) 'DOT) + (COND + (|$floatok| (|shoePossFloat| |w|)) + (#0='T (|shoeLeafKey| |w|)))) + (#0# (SETQ |$floatok| (NULL (|shoeCloser| |w|))) + (|shoeLeafKey| |w|)))))) + +(DEFUN |shoePossFloat| (|w|) + (PROG () + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (COND + ((OR (NOT (< |$n| |$sz|)) + (NULL (|shoeDigit| (ELT |$ln| |$n|)))) + (|shoeLeafKey| |w|)) + ('T (SETQ |w| (|shoeInteger|)) (|shoeExponent| "0" |w|)))))) + +(DEFUN |shoeSpace| () + (PROG (|n|) + (DECLARE (SPECIAL |$floatok| |$ln| |$n|)) + (RETURN + (PROGN + (SETQ |n| |$n|) + (SETQ |$n| (STRPOSL " " |$ln| |$n| T)) + (SETQ |$floatok| T) + (COND + ((NULL |$n|) (|shoeLeafSpaces| 0) (SETQ |$n| (LENGTH |$ln|))) + ('T (|shoeLeafSpaces| (- |$n| |n|)))))))) + +(DEFUN |shoeString| () + (PROG () + (DECLARE (SPECIAL |$floatok| |$n|)) + (RETURN + (PROGN + (SETQ |$n| (+ |$n| 1)) + (SETQ |$floatok| NIL) + (|shoeLeafString| (|shoeS|)))))) + +(DEFUN |shoeS| () + (PROG (|b| |a| |str| |mn| |escsym| |strsym| |n|) + (DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|)) + (RETURN + (COND + ((NOT (< |$n| |$sz|)) + (|SoftShoeError| (CONS |$linepos| |$n|) "quote added") "") + (#0='T (SETQ |n| |$n|) + (SETQ |strsym| (OR (STRPOS "\"" |$ln| |$n| NIL) |$sz|)) + (SETQ |escsym| (OR (STRPOS "_" |$ln| |$n| NIL) |$sz|)) + (SETQ |mn| (MIN |strsym| |escsym|)) + (COND + ((EQUAL |mn| |$sz|) (SETQ |$n| |$sz|) + (|SoftShoeError| (CONS |$linepos| |$n|) "quote added") + (SUBSTRING |$ln| |n| NIL)) + ((EQUAL |mn| |strsym|) (SETQ |$n| (+ |mn| 1)) + (SUBSTRING |$ln| |n| (- |mn| |n|))) + (#0# (SETQ |str| (SUBSTRING |$ln| |n| (- |mn| |n|))) + (SETQ |$n| (+ |mn| 1)) (SETQ |a| (|shoeEsc|)) + (SETQ |b| + (COND + (|a| (SETQ |str| (CONCAT |str| (ELT |$ln| |$n|))) + (SETQ |$n| (+ |$n| 1)) (|shoeS|)) + (#0# (|shoeS|)))) + (CONCAT |str| |b|)))))))) + +(DEFUN |shoeIdEnd| (|line| |n|) + (PROG () + (RETURN + (PROGN + (LOOP + (COND + ((NOT (AND (< |n| (LENGTH |line|)) + (|shoeIdChar| (ELT |line| |n|)))) + (RETURN NIL)) + ('T (SETQ |n| (+ |n| 1))))) + |n|)))) + +(DEFUN |shoeDigit| (|x|) (PROG () (RETURN (DIGIT-CHAR-P |x|)))) + +(DEFUN |shoeW| (|b|) + (PROG (|bb| |a| |str| |endid| |l| |n1|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |n1| |$n|) + (SETQ |$n| (+ |$n| 1)) + (SETQ |l| |$sz|) + (SETQ |endid| (|shoeIdEnd| |$ln| |$n|)) + (COND + ((OR (EQUAL |endid| |l|) + (NOT (EQUAL (QENUM |$ln| |endid|) |shoeESCAPE|))) + (SETQ |$n| |endid|) + (LIST |b| (SUBSTRING |$ln| |n1| (- |endid| |n1|)))) + (#0='T (SETQ |str| (SUBSTRING |$ln| |n1| (- |endid| |n1|))) + (SETQ |$n| (+ |endid| 1)) (SETQ |a| (|shoeEsc|)) + (SETQ |bb| (COND (|a| (|shoeW| T)) (#0# (LIST |b| "")))) + (LIST (OR (ELT |bb| 0) |b|) (CONCAT |str| (ELT |bb| 1))))))))) + +(DEFUN |shoeWord| (|esp|) + (PROG (|w| |aaa|) + (DECLARE (SPECIAL |$floatok|)) + (RETURN + (PROGN + (SETQ |aaa| (|shoeW| NIL)) + (SETQ |w| (ELT |aaa| 1)) + (SETQ |$floatok| NIL) + (COND + ((OR |esp| (ELT |aaa| 0)) (|shoeLeafId| |w|)) + ((|shoeKeyWordP| |w|) (SETQ |$floatok| T) + (|shoeLeafKey| |w|)) + ('T (|shoeLeafId| |w|))))))) + +(DEFUN |shoeInteger| () (PROG () (RETURN (|shoeInteger1| NIL)))) + +(DEFUN |shoeInteger1| (|zro|) + (PROG (|bb| |a| |str| |l| |n|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |n| |$n|) + (SETQ |l| |$sz|) + (LOOP + (COND + ((NOT (AND (< |$n| |l|) (|shoeDigit| (ELT |$ln| |$n|)))) + (RETURN NIL)) + ('T (SETQ |$n| (+ |$n| 1))))) + (COND + ((OR (EQUAL |$n| |l|) + (NOT (EQUAL (QENUM |$ln| |$n|) |shoeESCAPE|))) + (COND + ((AND (EQUAL |n| |$n|) |zro|) "0") + (#0='T (SUBSTRING |$ln| |n| (- |$n| |n|))))) + (#0# (SETQ |str| (SUBSTRING |$ln| |n| (- |$n| |n|))) + (SETQ |$n| (+ |$n| 1)) (SETQ |a| (|shoeEsc|)) + (SETQ |bb| (|shoeInteger1| |zro|)) (CONCAT |str| |bb|))))))) + +(DEFUN |shoeIntValue| (|s|) + (PROG (|d| |ival| |ns|) + (RETURN + (PROGN + (SETQ |ns| (LENGTH |s|)) + (SETQ |ival| 0) + (LET ((|bfVar#1| (- |ns| 1)) (|i| 0)) + (LOOP + (COND + ((> |i| |bfVar#1|) (RETURN NIL)) + ('T + (PROGN + (SETQ |d| (|shoeOrdToNum| (ELT |s| |i|))) + (SETQ |ival| (+ (* 10 |ival|) |d|))))) + (SETQ |i| (+ |i| 1)))) + |ival|)))) + +(DEFUN |shoeNumber| () + (PROG (|w| |n| |a|) + (DECLARE (SPECIAL |$ln| |$floatok| |$sz| |$n|)) + (RETURN + (PROGN + (SETQ |a| (|shoeInteger|)) + (COND + ((NOT (< |$n| |$sz|)) (|shoeLeafInteger| |a|)) + ((AND |$floatok| (EQUAL (QENUM |$ln| |$n|) |shoeDOT|)) + (SETQ |n| |$n|) (SETQ |$n| (+ |$n| 1)) + (COND + ((AND (< |$n| |$sz|) (EQUAL (QENUM |$ln| |$n|) |shoeDOT|)) + (SETQ |$n| |n|) (|shoeLeafInteger| |a|)) + (#0='T (SETQ |w| (|shoeInteger1| T)) + (|shoeExponent| |a| |w|)))) + (#0# (|shoeLeafInteger| |a|))))))) + +(DEFUN |shoeExponent| (|a| |w|) + (PROG (|c1| |e| |c| |n|) + (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (RETURN + (COND + ((NOT (< |$n| |$sz|)) (|shoeLeafFloat| |a| |w| 0)) + (#0='T (SETQ |n| |$n|) (SETQ |c| (QENUM |$ln| |$n|)) + (COND + ((OR (EQUAL |c| |shoeEXPONENT1|) + (EQUAL |c| |shoeEXPONENT2|)) + (SETQ |$n| (+ |$n| 1)) + (COND + ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|) + (|shoeLeafFloat| |a| |w| 0)) + ((|shoeDigit| (ELT |$ln| |$n|)) + (SETQ |e| (|shoeInteger|)) + (SETQ |e| (|shoeIntValue| |e|)) + (|shoeLeafFloat| |a| |w| |e|)) + (#0# (SETQ |c1| (QENUM |$ln| |$n|)) + (COND + ((OR (EQUAL |c1| |shoePLUSCOMMENT|) + (EQUAL |c1| |shoeMINUSCOMMENT|)) + (SETQ |$n| (+ |$n| 1)) + (COND + ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|) + (|shoeLeafFloat| |a| |w| 0)) + ((|shoeDigit| (ELT |$ln| |$n|)) + (SETQ |e| (|shoeInteger|)) + (SETQ |e| (|shoeIntValue| |e|)) + (|shoeLeafFloat| |a| |w| + (COND + ((EQUAL |c1| |shoeMINUSCOMMENT|) (- |e|)) + (#0# |e|)))) + (#0# (SETQ |$n| |n|) (|shoeLeafFloat| |a| |w| 0)))))))) + (#0# (|shoeLeafFloat| |a| |w| 0)))))))) + +(DEFUN |shoeError| () + (PROG (|n|) + (DECLARE (SPECIAL |$ln| |$linepos| |$n|)) + (RETURN + (PROGN + (SETQ |n| |$n|) + (SETQ |$n| (+ |$n| 1)) + (|SoftShoeError| (CONS |$linepos| |n|) + (CONCAT "The character whose number is " + (STRINGIMAGE (QENUM |$ln| |n|)) + " is not a Boot character")) + (|shoeLeafError| (ELT |$ln| |n|)))))) + +(DEFUN |shoeOrdToNum| (|x|) (PROG () (RETURN (DIGIT-CHAR-P |x|)))) + +(DEFUN |shoeKeyWord| (|st|) + (PROG () (RETURN (GETHASH |st| |shoeKeyTable|)))) + +(DEFUN |shoeKeyWordP| (|st|) + (PROG () (RETURN (NULL (NULL (GETHASH |st| |shoeKeyTable|)))))) + +(DEFUN |shoeMatch| (|l| |i|) + (PROG () (RETURN (|shoeSubStringMatch| |l| |shoeDict| |i|)))) + +(DEFUN |shoeSubStringMatch| (|l| |d| |i|) + (PROG (|eql| |ls| |s| |s1| |done| |ll| |u| |h|) + (RETURN + (PROGN + (SETQ |h| (QENUM |l| |i|)) + (SETQ |u| (ELT |d| |h|)) + (SETQ |ll| (SIZE |l|)) + (SETQ |done| NIL) + (SETQ |s1| "") + (LET ((|bfVar#2| (- (SIZE |u|) 1)) (|j| 0)) + (LOOP + (COND + ((OR (> |j| |bfVar#2|) |done|) (RETURN NIL)) + (#0='T + (PROGN + (SETQ |s| (ELT |u| |j|)) + (SETQ |ls| (SIZE |s|)) + (SETQ |done| + (COND + ((< |ll| (+ |ls| |i|)) NIL) + (#1='T (SETQ |eql| T) + (LET ((|bfVar#3| (- |ls| 1)) (|k| 1)) + (LOOP + (COND + ((OR (> |k| |bfVar#3|) (NOT |eql|)) + (RETURN NIL)) + (#0# + (SETQ |eql| + (EQL (QENUM |s| |k|) + (QENUM |l| (+ |k| |i|)))))) + (SETQ |k| (+ |k| 1)))) + (COND (|eql| (SETQ |s1| |s|) T) (#1# NIL)))))))) + (SETQ |j| (+ |j| 1)))) + |s1|)))) + +(DEFUN |shoePunctuation| (|c|) + (PROG () (RETURN (EQL (ELT |shoePun| |c|) 1)))) + |