diff options
| -rw-r--r-- | src/ChangeLog | 6 | ||||
| -rw-r--r-- | src/boot/scanner.boot | 260 | ||||
| -rw-r--r-- | src/boot/strap/scanner.clisp | 355 |
3 files changed, 343 insertions, 278 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 9adb8f94..a4787328 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2012-05-24 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * boot/scanner.boot (%Lexer): New record structure. + Add a lexer parameter to all lexing functions that need one. + Adjust their callers. + 2012-05-23 Gabriel Dos Reis <gdr@cs.tamu.edu> * boot/tokens.boot: "@" is now a new keyword. diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot index 91298559..6dcbce92 100644 --- a/src/boot/scanner.boot +++ b/src/boot/scanner.boot @@ -60,97 +60,108 @@ dqToList s == s = nil => nil first s -shoeNextLine s== +--% +structure %Lexer == + Record(line: %String, pos: %Short) with + lexerInputLine == (.line) + lexerCurrentPosition == (.pos) + +makeLexer() == + mk%Lexer(nil,nil) + +--% + +shoeNextLine(lex,s) == bStreamNull s => false $linepos := s [$f,:$r] := s - $ln := sourceLineString $f - $n := firstNonblankPosition($ln,0) - $sz := #$ln + lexerInputLine(lex) := sourceLineString $f + $n := firstNonblankPosition(lexerInputLine lex,0) + $sz := #lexerInputLine lex $n = nil => true - stringChar($ln,$n) = shoeTAB => + stringChar(lexerInputLine lex,$n) = shoeTAB => a := makeString(7-($n rem 8),char " ") - stringChar($ln,$n) := char " " - $ln := strconc(a,$ln) - s1 := [makeSourceLine($ln,sourceLineNumber $f),:$r] - shoeNextLine s1 + stringChar(lexerInputLine lex,$n) := char " " + lexerInputLine(lex) := strconc(a,lexerInputLine lex) + s1 := [makeSourceLine(lexerInputLine lex,sourceLineNumber $f),:$r] + shoeNextLine(lex,s1) true shoeLineToks s == $f: local := nil $r: local := nil - $ln: local := nil $n: local := nil $sz: local := nil $floatok: local := true $linepos: local := s - not shoeNextLine s => [nil,:nil] + lex := makeLexer() + not shoeNextLine(lex,s) => [nil,:nil] $n = nil => shoeLineToks $r - stringChar($ln,0) = char ")" => - command := shoeLine? $ln => + stringChar(lexerInputLine lex,0) = char ")" => + command := shoeLine? lexerInputLine lex => dq := dqUnit makeToken($linepos,shoeLeafLine command,0) [[dq],:$r] - command := shoeLisp? $ln => shoeLispToken($r,command) + command := shoeLisp? lexerInputLine lex => shoeLispToken(lex,$r,command) shoeLineToks $r toks := [] while $n < $sz repeat - toks := dqAppend(toks,shoeToken()) + toks := dqAppend(toks,shoeToken lex) toks = nil => shoeLineToks $r [[toks],:$r] -shoeLispToken(s,string)== +shoeLispToken(lex,s,string)== if #string = 0 or stringChar(string,0) = char ";" then string := '"" - ln := $ln + ln := lexerInputLine lex linepos := $linepos - [r,:st] := shoeAccumulateLines(s,string) + [r,:st] := shoeAccumulateLines(lex,s,string) dq := dqUnit makeToken(linepos,shoeLeafLisp st,0) [[dq],:r] -shoeAccumulateLines(s,string)== - not shoeNextLine s => [s,:string] - $n = nil => shoeAccumulateLines($r,string) - #$ln = 0 => shoeAccumulateLines($r,string) - stringChar($ln,0) = char ")" => - command := shoeLisp? $ln +shoeAccumulateLines(lex,s,string)== + not shoeNextLine(lex,s) => [s,:string] + $n = nil => shoeAccumulateLines(lex,$r,string) + #lexerInputLine lex = 0 => shoeAccumulateLines(lex,$r,string) + stringChar(lexerInputLine lex,0) = char ")" => + command := shoeLisp? lexerInputLine lex command and #command > 0 => stringChar(command,0) = char ";" => - shoeAccumulateLines($r,string) + shoeAccumulateLines(lex,$r,string) a := charPosition(char ";",command,0) => - shoeAccumulateLines($r, + shoeAccumulateLines(lex,$r, strconc(string,subString(command,0,a-1))) - shoeAccumulateLines($r,strconc(string,command)) - shoeAccumulateLines($r,string) + shoeAccumulateLines(lex,$r,strconc(string,command)) + shoeAccumulateLines(lex,$r,string) [s,:string] -- returns true if token t is closing `parenthesis'. shoeCloser t == shoeKeyWord t in '(CPAREN CBRACK) -shoeToken() == +shoeToken lex == linepos := $linepos n := $n - ch := stringChar($ln,$n) + ch := stringChar(lexerInputLine lex,$n) b := - shoeStartsComment() => - shoeComment() + shoeStartsComment lex => + shoeComment lex [] - shoeStartsNegComment() => - shoeNegComment() + shoeStartsNegComment lex => + shoeNegComment lex [] - ch = char "!" => shoeLispEscape() - shoePunctuation codePoint ch => shoePunct() - shoeStartsId ch => shoeWord(false) + ch = char "!" => shoeLispEscape lex + shoePunctuation codePoint ch => shoePunct lex + shoeStartsId ch => shoeWord(lex,false) ch = char " " => - shoeSpace() + shoeSpace lex [] - ch = char "_"" => shoeString() - digit? ch => shoeNumber() - ch = char "__" => shoeEscape() + ch = char "_"" => shoeString lex + digit? ch => shoeNumber lex + ch = char "__" => shoeEscape lex ch = shoeTAB => $n := $n + 1 [] - shoeError() + shoeError lex b = nil => nil dqUnit makeToken(linepos,b,n) @@ -193,15 +204,15 @@ shoeLeafError x == shoeLeafSpaces x == ["SPACES",x] -shoeLispEscape()== +shoeLispEscape lex == $n := $n + 1 $n >= $sz => SoftShoeError([$linepos,:$n],'"lisp escape error") - shoeLeafError stringChar($ln,$n) - a := shoeReadLispString($ln,$n) + shoeLeafError stringChar(lexerInputLine lex,$n) + a := shoeReadLispString(lexerInputLine lex,$n) a = nil => SoftShoeError([$linepos,:$n],'"lisp escape error") - shoeLeafError stringChar($ln,$n) + shoeLeafError stringChar(lexerInputLine lex,$n) [exp,n] := a n = nil => $n := $sz @@ -209,110 +220,110 @@ shoeLispEscape()== $n := n shoeLeafLispExp exp -shoeEscape() == +shoeEscape lex == $n := $n + 1 - shoeEsc() => shoeWord true + shoeEsc lex => shoeWord(lex,true) nil -shoeEsc()== +shoeEsc lex == $n >= $sz => - shoeNextLine($r) => - while $n = nil repeat shoeNextLine($r) - shoeEsc() + shoeNextLine(lex,$r) => + while $n = nil repeat shoeNextLine(lex,$r) + shoeEsc lex false false - n1 := firstNonblankPosition($ln,$n) + n1 := firstNonblankPosition(lexerInputLine lex,$n) n1 = nil => - shoeNextLine($r) + shoeNextLine(lex,$r) while $n = nil repeat - shoeNextLine($r) - shoeEsc() + shoeNextLine(lex,$r) + shoeEsc lex false true -shoeStartsComment()== +shoeStartsComment lex == $n < $sz => - stringChar($ln,$n) = char "+" => + stringChar(lexerInputLine lex,$n) = char "+" => www := $n + 1 www >= $sz => false - stringChar($ln,www) = char "+" + stringChar(lexerInputLine lex,www) = char "+" false false -shoeStartsNegComment()== +shoeStartsNegComment lex == $n < $sz => - stringChar($ln,$n) = char "-" => + stringChar(lexerInputLine lex,$n) = char "-" => www := $n + 1 www >= $sz => false - stringChar($ln,www) = char "-" + stringChar(lexerInputLine lex,www) = char "-" false false -shoeNegComment()== +shoeNegComment lex == n := $n $n := $sz - shoeLeafNegComment subString($ln,n) + shoeLeafNegComment subString(lexerInputLine lex,n) -shoeComment()== +shoeComment lex == n := $n $n := $sz - shoeLeafComment subString($ln,n) + shoeLeafComment subString(lexerInputLine lex,n) -shoePunct()== - sss := shoeMatch($ln,$n) +shoePunct lex == + sss := shoeMatch(lexerInputLine lex,$n) $n := $n + #sss - shoeKeyTr sss + shoeKeyTr(lex,sss) -shoeKeyTr w== +shoeKeyTr(lex,w) == shoeKeyWord w = "DOT" => - $floatok => shoePossFloat(w) + $floatok => shoePossFloat(lex,w) shoeLeafKey w $floatok := not shoeCloser w shoeLeafKey w -shoePossFloat (w)== - $n >= $sz or not digit? stringChar($ln,$n) => shoeLeafKey w - w := shoeInteger() - shoeExponent('"0",w) +shoePossFloat(lex,w)== + $n >= $sz or not digit? stringChar(lexerInputLine lex,$n) => shoeLeafKey w + w := shoeInteger lex + shoeExponent(lex,'"0",w) -shoeSpace()== +shoeSpace lex == n := $n - $n := firstNonblankPosition($ln,$n) + $n := firstNonblankPosition(lexerInputLine lex,$n) $floatok := true $n = nil => shoeLeafSpaces 0 - $n:= # $ln + $n:= # lexerInputLine lex shoeLeafSpaces ($n-n) -shoeString()== +shoeString lex == $n := $n+1 $floatok := false - shoeLeafString shoeS () + shoeLeafString shoeS lex -shoeS()== +shoeS lex == $n >= $sz => SoftShoeError([$linepos,:$n],'"quote added") '"" n := $n - strsym := charPosition(char "_"",$ln,$n) or $sz - escsym := charPosition(char "__",$ln,$n) or $sz + strsym := charPosition(char "_"",lexerInputLine lex,$n) or $sz + escsym := charPosition(char "__",lexerInputLine lex,$n) or $sz mn := MIN(strsym,escsym) mn=$sz => $n := $sz SoftShoeError([$linepos,:$n],'"quote added") - subString($ln,n) + subString(lexerInputLine lex,n) mn = strsym => $n := mn + 1 - subString($ln,n,mn-n) - str := subString($ln,n,mn-n) + subString(lexerInputLine lex,n,mn-n) + str := subString(lexerInputLine lex,n,mn-n) $n := mn+1 - a := shoeEsc() + a := shoeEsc lex b := a => - str := strconc(str,charString stringChar($ln,$n)) + str := strconc(str,charString stringChar(lexerInputLine lex,$n)) $n := $n + 1 - shoeS() - shoeS() + shoeS lex + shoeS lex strconc(str,b) shoeIdEnd(line,n)== @@ -320,24 +331,24 @@ shoeIdEnd(line,n)== n := n+1 n -shoeW(b) == +shoeW(lex,b) == n1 := $n $n := $n+1 l := $sz - endid := shoeIdEnd($ln,$n) - endid = l or stringChar($ln,endid) ~= char "__" => + endid := shoeIdEnd(lexerInputLine lex,$n) + endid = l or stringChar(lexerInputLine lex,endid) ~= char "__" => $n := endid - [b,subString($ln,n1,endid-n1)] - str := subString($ln,n1,endid-n1) + [b,subString(lexerInputLine lex,n1,endid-n1)] + str := subString(lexerInputLine lex,n1,endid-n1) $n := endid+1 - a := shoeEsc() + a := shoeEsc lex bb := - a => shoeW(true) + a => shoeW(lex,true) [b,'""] -- escape finds space or newline [bb.0 or b,strconc(str,bb.1)] -shoeWord(esp) == - aaa:=shoeW(false) +shoeWord(lex,esp) == + aaa := shoeW(lex,false) w:=aaa.1 $floatok:=false esp or aaa.0 => shoeLeafId w @@ -346,21 +357,21 @@ shoeWord(esp) == shoeLeafKey w shoeLeafId w -shoeInteger() == - shoeInteger1(false) +shoeInteger lex == + shoeInteger1(lex,false) -shoeInteger1(zro) == +shoeInteger1(lex,zro) == n := $n l := $sz - while $n <l and digit? stringChar($ln,$n) repeat + while $n <l and digit? stringChar(lexerInputLine lex,$n) repeat $n := $n+1 - $n = l or stringChar($ln,$n) ~= char "__" => + $n = l or stringChar(lexerInputLine lex,$n) ~= char "__" => n = $n and zro => '"0" - subString($ln,n,$n - n) - str := subString($ln,n,$n - n) + subString(lexerInputLine lex,n,$n - n) + str := subString(lexerInputLine lex,n,$n - n) $n := $n+1 - a := shoeEsc() - bb := shoeInteger1(zro) + a := shoeEsc lex + bb := shoeInteger1(lex,zro) strconc(str,bb) shoeIntValue(s) == @@ -371,40 +382,40 @@ shoeIntValue(s) == ival := 10*ival + d ival -shoeNumber() == - a := shoeInteger() +shoeNumber lex == + a := shoeInteger lex $n >= $sz => shoeLeafInteger a - $floatok and stringChar($ln,$n) = char "." => + $floatok and stringChar(lexerInputLine lex,$n) = char "." => n := $n $n := $n+1 - $n < $sz and stringChar($ln,$n) = char "." => + $n < $sz and stringChar(lexerInputLine lex,$n) = char "." => $n := n shoeLeafInteger a - w := shoeInteger1(true) - shoeExponent(a,w) + w := shoeInteger1(lex,true) + shoeExponent(lex,a,w) shoeLeafInteger a -shoeExponent(a,w)== +shoeExponent(lex,a,w)== $n >= $sz => shoeLeafFloat(a,w,0) n := $n - c := stringChar($ln,$n) + c := stringChar(lexerInputLine lex,$n) c = char "E" or c = char "e" => $n := $n+1 $n >= $sz => $n := n shoeLeafFloat(a,w,0) - digit? stringChar($ln,$n) => - e := shoeInteger() + digit? stringChar(lexerInputLine lex,$n) => + e := shoeInteger lex e := shoeIntValue e shoeLeafFloat(a,w,e) - c1 := stringChar($ln,$n) + c1 := stringChar(lexerInputLine lex,$n) c1 = char "+" or c1 = char "-" => $n := $n+1 $n >= $sz => $n := n shoeLeafFloat(a,w,0) - digit? stringChar($ln,$n) => - e := shoeInteger() + digit? stringChar(lexerInputLine lex,$n) => + e := shoeInteger lex e := shoeIntValue e shoeLeafFloat(a,w,(c1 = char "-" => MINUS e; e)) $n := n @@ -412,13 +423,14 @@ shoeExponent(a,w)== -- FIXME: Missing alternative. shoeLeafFloat(a,w,0) -shoeError()== +shoeError lex == n := $n $n := $n + 1 SoftShoeError([$linepos,:n], strconc( '"The character whose number is ", - toString codePoint stringChar($ln,n),'" is not a Boot character")) - shoeLeafError stringChar($ln,n) + toString codePoint stringChar(lexerInputLine lex,n), + '" is not a Boot character")) + shoeLeafError stringChar(lexerInputLine lex,n) shoeKeyWord st == tableValue(shoeKeyTable,st) 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|)) |