diff options
Diffstat (limited to 'src/boot/strap/scanner.clisp')
| -rw-r--r-- | src/boot/strap/scanner.clisp | 355 |
1 files changed, 201 insertions, 154 deletions
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index 070235e3..ba33e189 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -23,116 +23,135 @@ (DEFUN |dqToList| (|s|) (COND ((NULL |s|) NIL) (T (CAR |s|)))) -(DEFUN |shoeNextLine| (|s|) +(DEFSTRUCT (|%Lexer| (:COPIER |copy%Lexer|)) |line| |pos|) + +(DEFMACRO |mk%Lexer| (|line| |pos|) + (LIST '|MAKE-%Lexer| :|line| |line| :|pos| |pos|)) + +(DEFMACRO |lexerInputLine| (|bfVar#1|) (LIST '|%Lexer-line| |bfVar#1|)) + +(DEFMACRO |lexerCurrentPosition| (|bfVar#1|) (LIST '|%Lexer-pos| |bfVar#1|)) + +(DEFUN |makeLexer| () (|mk%Lexer| NIL NIL)) + +(DEFUN |shoeNextLine| (|lex| |s|) (LET* (|s1| |a|) - (DECLARE (SPECIAL |$sz| |$n| |$ln| |$r| |$f| |$linepos|)) + (DECLARE (SPECIAL |$sz| |$n| |$r| |$f| |$linepos|)) (COND ((|bStreamNull| |s|) NIL) (T (SETQ |$linepos| |s|) (SETQ |$f| (CAR |s|)) (SETQ |$r| (CDR |s|)) - (SETQ |$ln| (|sourceLineString| |$f|)) - (SETQ |$n| (|firstNonblankPosition| |$ln| 0)) - (SETQ |$sz| (LENGTH |$ln|)) + (SETF (|lexerInputLine| |lex|) (|sourceLineString| |$f|)) + (SETQ |$n| (|firstNonblankPosition| (|lexerInputLine| |lex|) 0)) + (SETQ |$sz| (LENGTH (|lexerInputLine| |lex|))) (COND ((NULL |$n|) T) - ((CHAR= (SCHAR |$ln| |$n|) |shoeTAB|) + ((CHAR= (SCHAR (|lexerInputLine| |lex|) |$n|) |shoeTAB|) (SETQ |a| (|makeString| (- 7 (REM |$n| 8)) (|char| '| |))) - (SETF (SCHAR |$ln| |$n|) (|char| '| |)) - (SETQ |$ln| (CONCAT |a| |$ln|)) + (SETF (SCHAR (|lexerInputLine| |lex|) |$n|) (|char| '| |)) + (SETF (|lexerInputLine| |lex|) + (CONCAT |a| (|lexerInputLine| |lex|))) (SETQ |s1| (CONS - (|makeSourceLine| |$ln| (|sourceLineNumber| |$f|)) + (|makeSourceLine| (|lexerInputLine| |lex|) + (|sourceLineNumber| |$f|)) |$r|)) - (|shoeNextLine| |s1|)) + (|shoeNextLine| |lex| |s1|)) (T T)))))) (DEFUN |shoeLineToks| (|s|) (LET* ((|$f| NIL) (|$r| NIL) - (|$ln| NIL) (|$n| NIL) (|$sz| NIL) (|$floatok| T) (|$linepos| |s|) |toks| |dq| - |command|) - (DECLARE (SPECIAL |$f| |$r| |$ln| |$n| |$sz| |$floatok| |$linepos|)) - (COND ((NOT (|shoeNextLine| |s|)) (CONS NIL NIL)) - ((NULL |$n|) (|shoeLineToks| |$r|)) - ((CHAR= (SCHAR |$ln| 0) (|char| '|)|)) - (COND - ((SETQ |command| (|shoeLine?| |$ln|)) - (SETQ |dq| - (|dqUnit| - (|makeToken| |$linepos| (|shoeLeafLine| |command|) 0))) - (CONS (LIST |dq|) |$r|)) - ((SETQ |command| (|shoeLisp?| |$ln|)) - (|shoeLispToken| |$r| |command|)) - (T (|shoeLineToks| |$r|)))) - (T (SETQ |toks| NIL) - (LOOP - (COND ((NOT (< |$n| |$sz|)) (RETURN NIL)) - (T (SETQ |toks| (|dqAppend| |toks| (|shoeToken|)))))) - (COND ((NULL |toks|) (|shoeLineToks| |$r|)) - (T (CONS (LIST |toks|) |$r|))))))) - -(DEFUN |shoeLispToken| (|s| |string|) + |command| + |lex|) + (DECLARE (SPECIAL |$f| |$r| |$n| |$sz| |$floatok| |$linepos|)) + (PROGN + (SETQ |lex| (|makeLexer|)) + (COND ((NOT (|shoeNextLine| |lex| |s|)) (CONS NIL NIL)) + ((NULL |$n|) (|shoeLineToks| |$r|)) + ((CHAR= (SCHAR (|lexerInputLine| |lex|) 0) (|char| '|)|)) + (COND + ((SETQ |command| (|shoeLine?| (|lexerInputLine| |lex|))) + (SETQ |dq| + (|dqUnit| + (|makeToken| |$linepos| (|shoeLeafLine| |command|) 0))) + (CONS (LIST |dq|) |$r|)) + ((SETQ |command| (|shoeLisp?| (|lexerInputLine| |lex|))) + (|shoeLispToken| |lex| |$r| |command|)) + (T (|shoeLineToks| |$r|)))) + (T (SETQ |toks| NIL) + (LOOP + (COND ((NOT (< |$n| |$sz|)) (RETURN NIL)) + (T (SETQ |toks| (|dqAppend| |toks| (|shoeToken| |lex|)))))) + (COND ((NULL |toks|) (|shoeLineToks| |$r|)) + (T (CONS (LIST |toks|) |$r|)))))))) + +(DEFUN |shoeLispToken| (|lex| |s| |string|) (LET* (|dq| |st| |r| |LETTMP#1| |linepos| |ln|) - (DECLARE (SPECIAL |$linepos| |$ln|)) + (DECLARE (SPECIAL |$linepos|)) (PROGN (COND ((OR (EQL (LENGTH |string|) 0) (CHAR= (SCHAR |string| 0) (|char| '|;|))) (SETQ |string| ""))) - (SETQ |ln| |$ln|) + (SETQ |ln| (|lexerInputLine| |lex|)) (SETQ |linepos| |$linepos|) - (SETQ |LETTMP#1| (|shoeAccumulateLines| |s| |string|)) + (SETQ |LETTMP#1| (|shoeAccumulateLines| |lex| |s| |string|)) (SETQ |r| (CAR |LETTMP#1|)) (SETQ |st| (CDR |LETTMP#1|)) (SETQ |dq| (|dqUnit| (|makeToken| |linepos| (|shoeLeafLisp| |st|) 0))) (CONS (LIST |dq|) |r|)))) -(DEFUN |shoeAccumulateLines| (|s| |string|) +(DEFUN |shoeAccumulateLines| (|lex| |s| |string|) (LET* (|a| |command|) - (DECLARE (SPECIAL |$ln| |$r| |$n|)) - (COND ((NOT (|shoeNextLine| |s|)) (CONS |s| |string|)) - ((NULL |$n|) (|shoeAccumulateLines| |$r| |string|)) - ((EQL (LENGTH |$ln|) 0) (|shoeAccumulateLines| |$r| |string|)) - ((CHAR= (SCHAR |$ln| 0) (|char| '|)|)) - (SETQ |command| (|shoeLisp?| |$ln|)) + (DECLARE (SPECIAL |$r| |$n|)) + (COND ((NOT (|shoeNextLine| |lex| |s|)) (CONS |s| |string|)) + ((NULL |$n|) (|shoeAccumulateLines| |lex| |$r| |string|)) + ((EQL (LENGTH (|lexerInputLine| |lex|)) 0) + (|shoeAccumulateLines| |lex| |$r| |string|)) + ((CHAR= (SCHAR (|lexerInputLine| |lex|) 0) (|char| '|)|)) + (SETQ |command| (|shoeLisp?| (|lexerInputLine| |lex|))) (COND ((AND |command| (PLUSP (LENGTH |command|))) (COND ((CHAR= (SCHAR |command| 0) (|char| '|;|)) - (|shoeAccumulateLines| |$r| |string|)) + (|shoeAccumulateLines| |lex| |$r| |string|)) ((SETQ |a| (|charPosition| (|char| '|;|) |command| 0)) - (|shoeAccumulateLines| |$r| + (|shoeAccumulateLines| |lex| |$r| (CONCAT |string| (|subString| |command| 0 (- |a| 1))))) - (T (|shoeAccumulateLines| |$r| (CONCAT |string| |command|))))) - (T (|shoeAccumulateLines| |$r| |string|)))) + (T + (|shoeAccumulateLines| |lex| |$r| + (CONCAT |string| |command|))))) + (T (|shoeAccumulateLines| |lex| |$r| |string|)))) (T (CONS |s| |string|))))) (DEFUN |shoeCloser| (|t|) (|symbolMember?| (|shoeKeyWord| |t|) '(CPAREN CBRACK))) -(DEFUN |shoeToken| () +(DEFUN |shoeToken| (|lex|) (LET* (|b| |ch| |n| |linepos|) - (DECLARE (SPECIAL |$ln| |$n| |$linepos|)) + (DECLARE (SPECIAL |$n| |$linepos|)) (PROGN (SETQ |linepos| |$linepos|) (SETQ |n| |$n|) - (SETQ |ch| (SCHAR |$ln| |$n|)) + (SETQ |ch| (SCHAR (|lexerInputLine| |lex|) |$n|)) (SETQ |b| - (COND ((|shoeStartsComment|) (|shoeComment|) NIL) - ((|shoeStartsNegComment|) (|shoeNegComment|) NIL) - ((CHAR= |ch| (|char| '!)) (|shoeLispEscape|)) - ((|shoePunctuation| (CHAR-CODE |ch|)) (|shoePunct|)) - ((|shoeStartsId| |ch|) (|shoeWord| NIL)) - ((CHAR= |ch| (|char| '| |)) (|shoeSpace|) NIL) - ((CHAR= |ch| (|char| '|"|)) (|shoeString|)) - ((DIGIT-CHAR-P |ch|) (|shoeNumber|)) - ((CHAR= |ch| (|char| '_)) (|shoeEscape|)) + (COND ((|shoeStartsComment| |lex|) (|shoeComment| |lex|) NIL) + ((|shoeStartsNegComment| |lex|) (|shoeNegComment| |lex|) + NIL) + ((CHAR= |ch| (|char| '!)) (|shoeLispEscape| |lex|)) + ((|shoePunctuation| (CHAR-CODE |ch|)) (|shoePunct| |lex|)) + ((|shoeStartsId| |ch|) (|shoeWord| |lex| NIL)) + ((CHAR= |ch| (|char| '| |)) (|shoeSpace| |lex|) NIL) + ((CHAR= |ch| (|char| '|"|)) (|shoeString| |lex|)) + ((DIGIT-CHAR-P |ch|) (|shoeNumber| |lex|)) + ((CHAR= |ch| (|char| '_)) (|shoeEscape| |lex|)) ((EQUAL |ch| |shoeTAB|) (SETQ |$n| (+ |$n| 1)) NIL) - (T (|shoeError|)))) + (T (|shoeError| |lex|)))) (COND ((NULL |b|) NIL) (T (|dqUnit| (|makeToken| |linepos| |b| |n|))))))) (DEFUN |shoeLeafId| (|x|) (LIST 'ID (INTERN |x|))) @@ -164,147 +183,162 @@ (DEFUN |shoeLeafSpaces| (|x|) (LIST 'SPACES |x|)) -(DEFUN |shoeLispEscape| () +(DEFUN |shoeLispEscape| (|lex|) (LET* (|n| |exp| |a|) - (DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|)) + (DECLARE (SPECIAL |$linepos| |$sz| |$n|)) (PROGN (SETQ |$n| (+ |$n| 1)) (COND ((NOT (< |$n| |$sz|)) (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error") - (|shoeLeafError| (SCHAR |$ln| |$n|))) - (T (SETQ |a| (|shoeReadLispString| |$ln| |$n|)) + (|shoeLeafError| (SCHAR (|lexerInputLine| |lex|) |$n|))) + (T (SETQ |a| (|shoeReadLispString| (|lexerInputLine| |lex|) |$n|)) (COND ((NULL |a|) (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error") - (|shoeLeafError| (SCHAR |$ln| |$n|))) + (|shoeLeafError| (SCHAR (|lexerInputLine| |lex|) |$n|))) (T (SETQ |exp| (CAR |a|)) (SETQ |n| (CADR |a|)) (COND ((NULL |n|) (SETQ |$n| |$sz|) (|shoeLeafLispExp| |exp|)) (T (SETQ |$n| |n|) (|shoeLeafLispExp| |exp|)))))))))) -(DEFUN |shoeEscape| () +(DEFUN |shoeEscape| (|lex|) (DECLARE (SPECIAL |$n|)) - (PROGN (SETQ |$n| (+ |$n| 1)) (COND ((|shoeEsc|) (|shoeWord| T)) (T NIL)))) + (PROGN + (SETQ |$n| (+ |$n| 1)) + (COND ((|shoeEsc| |lex|) (|shoeWord| |lex| T)) (T NIL)))) -(DEFUN |shoeEsc| () +(DEFUN |shoeEsc| (|lex|) (LET* (|n1|) - (DECLARE (SPECIAL |$ln| |$r| |$sz| |$n|)) + (DECLARE (SPECIAL |$r| |$sz| |$n|)) (COND ((NOT (< |$n| |$sz|)) (COND - ((|shoeNextLine| |$r|) - (LOOP (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |$r|)))) (|shoeEsc|) - NIL) + ((|shoeNextLine| |lex| |$r|) + (LOOP (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |lex| |$r|)))) + (|shoeEsc| |lex|) NIL) (T NIL))) - (T (SETQ |n1| (|firstNonblankPosition| |$ln| |$n|)) + (T (SETQ |n1| (|firstNonblankPosition| (|lexerInputLine| |lex|) |$n|)) (COND - ((NULL |n1|) (|shoeNextLine| |$r|) - (LOOP (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |$r|)))) (|shoeEsc|) - NIL) + ((NULL |n1|) (|shoeNextLine| |lex| |$r|) + (LOOP (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |lex| |$r|)))) + (|shoeEsc| |lex|) NIL) (T T)))))) -(DEFUN |shoeStartsComment| () +(DEFUN |shoeStartsComment| (|lex|) (LET* (|www|) - (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (DECLARE (SPECIAL |$sz| |$n|)) (COND ((< |$n| |$sz|) (COND - ((CHAR= (SCHAR |$ln| |$n|) (|char| '+)) (SETQ |www| (+ |$n| 1)) + ((CHAR= (SCHAR (|lexerInputLine| |lex|) |$n|) (|char| '+)) + (SETQ |www| (+ |$n| 1)) (COND ((NOT (< |www| |$sz|)) NIL) - (T (CHAR= (SCHAR |$ln| |www|) (|char| '+))))) + (T (CHAR= (SCHAR (|lexerInputLine| |lex|) |www|) (|char| '+))))) (T NIL))) (T NIL)))) -(DEFUN |shoeStartsNegComment| () +(DEFUN |shoeStartsNegComment| (|lex|) (LET* (|www|) - (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (DECLARE (SPECIAL |$sz| |$n|)) (COND ((< |$n| |$sz|) (COND - ((CHAR= (SCHAR |$ln| |$n|) (|char| '-)) (SETQ |www| (+ |$n| 1)) + ((CHAR= (SCHAR (|lexerInputLine| |lex|) |$n|) (|char| '-)) + (SETQ |www| (+ |$n| 1)) (COND ((NOT (< |www| |$sz|)) NIL) - (T (CHAR= (SCHAR |$ln| |www|) (|char| '-))))) + (T (CHAR= (SCHAR (|lexerInputLine| |lex|) |www|) (|char| '-))))) (T NIL))) (T NIL)))) -(DEFUN |shoeNegComment| () +(DEFUN |shoeNegComment| (|lex|) (LET* (|n|) - (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (DECLARE (SPECIAL |$sz| |$n|)) (PROGN (SETQ |n| |$n|) (SETQ |$n| |$sz|) - (|shoeLeafNegComment| (|subString| |$ln| |n|))))) + (|shoeLeafNegComment| (|subString| (|lexerInputLine| |lex|) |n|))))) -(DEFUN |shoeComment| () +(DEFUN |shoeComment| (|lex|) (LET* (|n|) - (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (DECLARE (SPECIAL |$sz| |$n|)) (PROGN (SETQ |n| |$n|) (SETQ |$n| |$sz|) - (|shoeLeafComment| (|subString| |$ln| |n|))))) + (|shoeLeafComment| (|subString| (|lexerInputLine| |lex|) |n|))))) -(DEFUN |shoePunct| () +(DEFUN |shoePunct| (|lex|) (LET* (|sss|) - (DECLARE (SPECIAL |$n| |$ln|)) + (DECLARE (SPECIAL |$n|)) (PROGN - (SETQ |sss| (|shoeMatch| |$ln| |$n|)) + (SETQ |sss| (|shoeMatch| (|lexerInputLine| |lex|) |$n|)) (SETQ |$n| (+ |$n| (LENGTH |sss|))) - (|shoeKeyTr| |sss|)))) + (|shoeKeyTr| |lex| |sss|)))) -(DEFUN |shoeKeyTr| (|w|) +(DEFUN |shoeKeyTr| (|lex| |w|) (DECLARE (SPECIAL |$floatok|)) (COND ((EQ (|shoeKeyWord| |w|) 'DOT) - (COND (|$floatok| (|shoePossFloat| |w|)) (T (|shoeLeafKey| |w|)))) + (COND (|$floatok| (|shoePossFloat| |lex| |w|)) (T (|shoeLeafKey| |w|)))) (T (SETQ |$floatok| (NOT (|shoeCloser| |w|))) (|shoeLeafKey| |w|)))) -(DEFUN |shoePossFloat| (|w|) - (DECLARE (SPECIAL |$ln| |$sz| |$n|)) +(DEFUN |shoePossFloat| (|lex| |w|) + (DECLARE (SPECIAL |$sz| |$n|)) (COND - ((OR (NOT (< |$n| |$sz|)) (NOT (DIGIT-CHAR-P (SCHAR |$ln| |$n|)))) + ((OR (NOT (< |$n| |$sz|)) + (NOT (DIGIT-CHAR-P (SCHAR (|lexerInputLine| |lex|) |$n|)))) (|shoeLeafKey| |w|)) - (T (SETQ |w| (|shoeInteger|)) (|shoeExponent| "0" |w|)))) + (T (SETQ |w| (|shoeInteger| |lex|)) (|shoeExponent| |lex| "0" |w|)))) -(DEFUN |shoeSpace| () +(DEFUN |shoeSpace| (|lex|) (LET* (|n|) - (DECLARE (SPECIAL |$floatok| |$ln| |$n|)) + (DECLARE (SPECIAL |$floatok| |$n|)) (PROGN (SETQ |n| |$n|) - (SETQ |$n| (|firstNonblankPosition| |$ln| |$n|)) + (SETQ |$n| (|firstNonblankPosition| (|lexerInputLine| |lex|) |$n|)) (SETQ |$floatok| T) - (COND ((NULL |$n|) (|shoeLeafSpaces| 0) (SETQ |$n| (LENGTH |$ln|))) - (T (|shoeLeafSpaces| (- |$n| |n|))))))) + (COND + ((NULL |$n|) (|shoeLeafSpaces| 0) + (SETQ |$n| (LENGTH (|lexerInputLine| |lex|)))) + (T (|shoeLeafSpaces| (- |$n| |n|))))))) -(DEFUN |shoeString| () +(DEFUN |shoeString| (|lex|) (DECLARE (SPECIAL |$floatok| |$n|)) (PROGN (SETQ |$n| (+ |$n| 1)) (SETQ |$floatok| NIL) - (|shoeLeafString| (|shoeS|)))) + (|shoeLeafString| (|shoeS| |lex|)))) -(DEFUN |shoeS| () +(DEFUN |shoeS| (|lex|) (LET* (|b| |a| |str| |mn| |escsym| |strsym| |n|) - (DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|)) + (DECLARE (SPECIAL |$linepos| |$sz| |$n|)) (COND ((NOT (< |$n| |$sz|)) (|SoftShoeError| (CONS |$linepos| |$n|) "quote added") "") (T (SETQ |n| |$n|) - (SETQ |strsym| (OR (|charPosition| (|char| '|"|) |$ln| |$n|) |$sz|)) - (SETQ |escsym| (OR (|charPosition| (|char| '_) |$ln| |$n|) |$sz|)) + (SETQ |strsym| + (OR (|charPosition| (|char| '|"|) (|lexerInputLine| |lex|) |$n|) + |$sz|)) + (SETQ |escsym| + (OR (|charPosition| (|char| '_) (|lexerInputLine| |lex|) |$n|) + |$sz|)) (SETQ |mn| (MIN |strsym| |escsym|)) (COND ((EQUAL |mn| |$sz|) (SETQ |$n| |$sz|) (|SoftShoeError| (CONS |$linepos| |$n|) "quote added") - (|subString| |$ln| |n|)) + (|subString| (|lexerInputLine| |lex|) |n|)) ((EQUAL |mn| |strsym|) (SETQ |$n| (+ |mn| 1)) - (|subString| |$ln| |n| (- |mn| |n|))) - (T (SETQ |str| (|subString| |$ln| |n| (- |mn| |n|))) - (SETQ |$n| (+ |mn| 1)) (SETQ |a| (|shoeEsc|)) + (|subString| (|lexerInputLine| |lex|) |n| (- |mn| |n|))) + (T (SETQ |str| (|subString| (|lexerInputLine| |lex|) |n| (- |mn| |n|))) + (SETQ |$n| (+ |mn| 1)) (SETQ |a| (|shoeEsc| |lex|)) (SETQ |b| (COND - (|a| (SETQ |str| (CONCAT |str| (STRING (SCHAR |$ln| |$n|)))) - (SETQ |$n| (+ |$n| 1)) (|shoeS|)) - (T (|shoeS|)))) + (|a| + (SETQ |str| + (CONCAT |str| + (STRING + (SCHAR (|lexerInputLine| |lex|) |$n|)))) + (SETQ |$n| (+ |$n| 1)) (|shoeS| |lex|)) + (T (|shoeS| |lex|)))) (CONCAT |str| |b|))))))) (DEFUN |shoeIdEnd| (|line| |n|) @@ -316,54 +350,60 @@ (T (SETQ |n| (+ |n| 1))))) |n|)) -(DEFUN |shoeW| (|b|) +(DEFUN |shoeW| (|lex| |b|) (LET* (|bb| |a| |str| |endid| |l| |n1|) - (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (DECLARE (SPECIAL |$sz| |$n|)) (PROGN (SETQ |n1| |$n|) (SETQ |$n| (+ |$n| 1)) (SETQ |l| |$sz|) - (SETQ |endid| (|shoeIdEnd| |$ln| |$n|)) + (SETQ |endid| (|shoeIdEnd| (|lexerInputLine| |lex|) |$n|)) (COND - ((OR (EQUAL |endid| |l|) (NOT (CHAR= (SCHAR |$ln| |endid|) (|char| '_)))) + ((OR (EQUAL |endid| |l|) + (NOT (CHAR= (SCHAR (|lexerInputLine| |lex|) |endid|) (|char| '_)))) (SETQ |$n| |endid|) - (LIST |b| (|subString| |$ln| |n1| (- |endid| |n1|)))) - (T (SETQ |str| (|subString| |$ln| |n1| (- |endid| |n1|))) - (SETQ |$n| (+ |endid| 1)) (SETQ |a| (|shoeEsc|)) - (SETQ |bb| (COND (|a| (|shoeW| T)) (T (LIST |b| "")))) + (LIST |b| (|subString| (|lexerInputLine| |lex|) |n1| (- |endid| |n1|)))) + (T + (SETQ |str| + (|subString| (|lexerInputLine| |lex|) |n1| (- |endid| |n1|))) + (SETQ |$n| (+ |endid| 1)) (SETQ |a| (|shoeEsc| |lex|)) + (SETQ |bb| (COND (|a| (|shoeW| |lex| T)) (T (LIST |b| "")))) (LIST (OR (ELT |bb| 0) |b|) (CONCAT |str| (ELT |bb| 1)))))))) -(DEFUN |shoeWord| (|esp|) +(DEFUN |shoeWord| (|lex| |esp|) (LET* (|w| |aaa|) (DECLARE (SPECIAL |$floatok|)) (PROGN - (SETQ |aaa| (|shoeW| NIL)) + (SETQ |aaa| (|shoeW| |lex| 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| () (|shoeInteger1| NIL)) +(DEFUN |shoeInteger| (|lex|) (|shoeInteger1| |lex| NIL)) -(DEFUN |shoeInteger1| (|zro|) +(DEFUN |shoeInteger1| (|lex| |zro|) (LET* (|bb| |a| |str| |l| |n|) - (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (DECLARE (SPECIAL |$sz| |$n|)) (PROGN (SETQ |n| |$n|) (SETQ |l| |$sz|) (LOOP (COND - ((NOT (AND (< |$n| |l|) (DIGIT-CHAR-P (SCHAR |$ln| |$n|)))) + ((NOT + (AND (< |$n| |l|) + (DIGIT-CHAR-P (SCHAR (|lexerInputLine| |lex|) |$n|)))) (RETURN NIL)) (T (SETQ |$n| (+ |$n| 1))))) (COND - ((OR (EQUAL |$n| |l|) (NOT (CHAR= (SCHAR |$ln| |$n|) (|char| '_)))) + ((OR (EQUAL |$n| |l|) + (NOT (CHAR= (SCHAR (|lexerInputLine| |lex|) |$n|) (|char| '_)))) (COND ((AND (EQUAL |n| |$n|) |zro|) "0") - (T (|subString| |$ln| |n| (- |$n| |n|))))) - (T (SETQ |str| (|subString| |$ln| |n| (- |$n| |n|))) - (SETQ |$n| (+ |$n| 1)) (SETQ |a| (|shoeEsc|)) - (SETQ |bb| (|shoeInteger1| |zro|)) (CONCAT |str| |bb|)))))) + (T (|subString| (|lexerInputLine| |lex|) |n| (- |$n| |n|))))) + (T (SETQ |str| (|subString| (|lexerInputLine| |lex|) |n| (- |$n| |n|))) + (SETQ |$n| (+ |$n| 1)) (SETQ |a| (|shoeEsc| |lex|)) + (SETQ |bb| (|shoeInteger1| |lex| |zro|)) (CONCAT |str| |bb|)))))) (DEFUN |shoeIntValue| (|s|) (LET* (|d| |ival| |ns|) @@ -378,41 +418,46 @@ (SETQ |i| (+ |i| 1)))) |ival|))) -(DEFUN |shoeNumber| () +(DEFUN |shoeNumber| (|lex|) (LET* (|w| |n| |a|) - (DECLARE (SPECIAL |$ln| |$floatok| |$sz| |$n|)) + (DECLARE (SPECIAL |$floatok| |$sz| |$n|)) (PROGN - (SETQ |a| (|shoeInteger|)) + (SETQ |a| (|shoeInteger| |lex|)) (COND ((NOT (< |$n| |$sz|)) (|shoeLeafInteger| |a|)) - ((AND |$floatok| (CHAR= (SCHAR |$ln| |$n|) (|char| '|.|))) + ((AND |$floatok| + (CHAR= (SCHAR (|lexerInputLine| |lex|) |$n|) (|char| '|.|))) (SETQ |n| |$n|) (SETQ |$n| (+ |$n| 1)) (COND - ((AND (< |$n| |$sz|) (CHAR= (SCHAR |$ln| |$n|) (|char| '|.|))) + ((AND (< |$n| |$sz|) + (CHAR= (SCHAR (|lexerInputLine| |lex|) |$n|) (|char| '|.|))) (SETQ |$n| |n|) (|shoeLeafInteger| |a|)) - (T (SETQ |w| (|shoeInteger1| T)) (|shoeExponent| |a| |w|)))) + (T (SETQ |w| (|shoeInteger1| |lex| T)) + (|shoeExponent| |lex| |a| |w|)))) (T (|shoeLeafInteger| |a|)))))) -(DEFUN |shoeExponent| (|a| |w|) +(DEFUN |shoeExponent| (|lex| |a| |w|) (LET* (|c1| |e| |c| |n|) - (DECLARE (SPECIAL |$ln| |$sz| |$n|)) + (DECLARE (SPECIAL |$sz| |$n|)) (COND ((NOT (< |$n| |$sz|)) (|shoeLeafFloat| |a| |w| 0)) - (T (SETQ |n| |$n|) (SETQ |c| (SCHAR |$ln| |$n|)) + (T (SETQ |n| |$n|) (SETQ |c| (SCHAR (|lexerInputLine| |lex|) |$n|)) (COND ((OR (CHAR= |c| (|char| 'E)) (CHAR= |c| (|char| '|e|))) (SETQ |$n| (+ |$n| 1)) (COND ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|) (|shoeLeafFloat| |a| |w| 0)) - ((DIGIT-CHAR-P (SCHAR |$ln| |$n|)) (SETQ |e| (|shoeInteger|)) - (SETQ |e| (|shoeIntValue| |e|)) (|shoeLeafFloat| |a| |w| |e|)) - (T (SETQ |c1| (SCHAR |$ln| |$n|)) + ((DIGIT-CHAR-P (SCHAR (|lexerInputLine| |lex|) |$n|)) + (SETQ |e| (|shoeInteger| |lex|)) (SETQ |e| (|shoeIntValue| |e|)) + (|shoeLeafFloat| |a| |w| |e|)) + (T (SETQ |c1| (SCHAR (|lexerInputLine| |lex|) |$n|)) (COND ((OR (CHAR= |c1| (|char| '+)) (CHAR= |c1| (|char| '-))) (SETQ |$n| (+ |$n| 1)) (COND ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|) (|shoeLeafFloat| |a| |w| 0)) - ((DIGIT-CHAR-P (SCHAR |$ln| |$n|)) (SETQ |e| (|shoeInteger|)) + ((DIGIT-CHAR-P (SCHAR (|lexerInputLine| |lex|) |$n|)) + (SETQ |e| (|shoeInteger| |lex|)) (SETQ |e| (|shoeIntValue| |e|)) (|shoeLeafFloat| |a| |w| (COND ((CHAR= |c1| (|char| '-)) (- |e|)) @@ -420,17 +465,19 @@ (T (SETQ |$n| |n|) (|shoeLeafFloat| |a| |w| 0)))))))) (T (|shoeLeafFloat| |a| |w| 0))))))) -(DEFUN |shoeError| () +(DEFUN |shoeError| (|lex|) (LET* (|n|) - (DECLARE (SPECIAL |$ln| |$linepos| |$n|)) + (DECLARE (SPECIAL |$linepos| |$n|)) (PROGN (SETQ |n| |$n|) (SETQ |$n| (+ |$n| 1)) (|SoftShoeError| (CONS |$linepos| |n|) (CONCAT "The character whose number is " - (WRITE-TO-STRING (CHAR-CODE (SCHAR |$ln| |n|))) + (WRITE-TO-STRING + (CHAR-CODE + (SCHAR (|lexerInputLine| |lex|) |n|))) " is not a Boot character")) - (|shoeLeafError| (SCHAR |$ln| |n|))))) + (|shoeLeafError| (SCHAR (|lexerInputLine| |lex|) |n|))))) (DEFUN |shoeKeyWord| (|st|) (|tableValue| |shoeKeyTable| |st|)) |