diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 14 | ||||
| -rw-r--r-- | src/boot/scanner.boot | 262 | ||||
| -rw-r--r-- | src/boot/strap/scanner.clisp | 365 |
3 files changed, 379 insertions, 262 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 786d22e7..debe24eb 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,19 @@ 2012-05-24 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/scanner.boot: Eliminate fluid variable $n. + (lexerRefresh?): New. + (lexerSetLine!): Likewise. + (lexerSkipBlank!): Likewise. + (lexerSkipToEnd!): Likewise. + (lexerAdvancePosition!): Likewise. + (lexerCharCountToCompleteTab): Likewise. + (lexerCurrentChar): Likewise. + (lexerCharPosition): Likewise. + (lexerCharacterAt): Likewise. + (lexerEol?): Likewise. + +2012-05-24 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/scanner.boot (lexerLineLength): New. (shoeNextLine): Use it in replacement of $sz. (shoeLineToks): Likewise. diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot index a87f5e48..b9272757 100644 --- a/src/boot/scanner.boot +++ b/src/boot/scanner.boot @@ -62,28 +62,80 @@ dqToList s == --% structure %Lexer == - Record(line: %String, pos: %Short) with + Record(line: %String, pos: %Maybe %Short) with lexerLineString == (.line) lexerCurrentPosition == (.pos) makeLexer() == mk%Lexer(nil,nil) +++ Return true if the lexer wants a fresh input line. +macro lexerRefresh? lex == + lexerCurrentPosition lex = nil + macro lexerLineLength lex == #lexerLineString lex +++ Make the lexer ready to process a new input line. +lexerSetLine!(lex,line) == + lexerLineString(lex) := line + lexerCurrentPosition(lex) := 0 + +++ Adjust the current position to the next non-blank character. +lexerSkipBlank! lex == + lexerCurrentPosition(lex) := + firstNonblankPosition(lexerLineString lex,lexerCurrentPosition lex) + +++ Move the current position by a given amount +lexerAdvancePosition!(lex,n == 1) == + lexerCurrentPosition(lex) := lexerCurrentPosition lex + n + +++ Move the current position to end of line. +lexerSkipToEnd! lex == + lexerCurrentPosition(lex) := lexerLineLength lex + +++ Set the current position at a given index. +lexerPosition!(lex,k) == + lexerCurrentPosition(lex) := k + +++ Return the amount of space characters need to complete a tab +++ to its next logical stop. +lexerCharCountToCompleteTab lex == + 7 - (lexerCurrentPosition lex rem 8) + + +++ Access the character the current position. +macro lexerCurrentChar lex == + stringChar(lexerLineString lex,lexerCurrentPosition lex) + +++ Access the character at a given position. +macro lexerCharacterAt(lex,k) == + stringChar(lexerLineString lex,k) + +++ Return the position of next character `c', or end of line. +lexerCharPosition(lex,c) == + charPosition(c,lexerLineString lex,lexerCurrentPosition lex) + or lexerLineLength lex + +++ Return true if the current position is at end of line. +lexerEol? lex == + lexerCurrentPosition lex >= lexerLineLength lex + --% +lexerReadLisp lex == + shoeReadLispString(lexerLineString lex,lexerCurrentPosition lex) + shoeNextLine(lex,s) == bStreamNull s => false $linepos := s [$f,:$r] := s - lexerLineString(lex) := sourceLineString $f - $n := firstNonblankPosition(lexerLineString lex,0) - $n = nil => true - stringChar(lexerLineString lex,$n) = shoeTAB => - a := makeString(7-($n rem 8),char " ") - stringChar(lexerLineString lex,$n) := char " " + lexerSetLine!(lex,sourceLineString $f) + lexerSkipBlank! lex + lexerRefresh? lex => true + lexerCurrentChar lex = shoeTAB => + a := makeString(lexerCharCountToCompleteTab lex,char " ") + lexerCurrentChar(lex) := char " " lexerLineString(lex) := strconc(a,lexerLineString lex) s1 := [makeSourceLine(lexerLineString lex,sourceLineNumber $f),:$r] shoeNextLine(lex,s1) @@ -92,20 +144,19 @@ shoeNextLine(lex,s) == shoeLineToks s == $f: local := nil $r: local := nil - $n: local := nil $floatok: local := true $linepos: local := s lex := makeLexer() not shoeNextLine(lex,s) => [nil,:nil] - $n = nil => shoeLineToks $r - stringChar(lexerLineString lex,0) = char ")" => + lexerRefresh? lex => shoeLineToks $r + lexerCharacterAt(lex,0) = char ")" => command := shoeLine? lexerLineString lex => dq := dqUnit makeToken($linepos,shoeLeafLine command,0) [[dq],:$r] command := shoeLisp? lexerLineString lex => shoeLispToken(lex,$r,command) shoeLineToks $r toks := [] - while $n < lexerLineLength lex repeat + while not lexerEol? lex repeat toks := dqAppend(toks,shoeToken lex) toks = nil => shoeLineToks $r [[toks],:$r] @@ -121,9 +172,9 @@ shoeLispToken(lex,s,string)== shoeAccumulateLines(lex,s,string)== not shoeNextLine(lex,s) => [s,:string] - $n = nil => shoeAccumulateLines(lex,$r,string) + lexerRefresh? lex => shoeAccumulateLines(lex,$r,string) lexerLineLength lex = 0 => shoeAccumulateLines(lex,$r,string) - stringChar(lexerLineString lex,0) = char ")" => + lexerCharacterAt(lex,0) = char ")" => command := shoeLisp? lexerLineString lex command and #command > 0 => stringChar(command,0) = char ";" => @@ -141,8 +192,8 @@ shoeCloser t == shoeToken lex == linepos := $linepos - n := $n - ch := stringChar(lexerLineString lex,$n) + n := lexerCurrentPosition lex + ch := lexerCurrentChar lex b := shoeStartsComment lex => shoeComment lex @@ -160,7 +211,7 @@ shoeToken lex == digit? ch => shoeNumber lex ch = char "__" => shoeEscape lex ch = shoeTAB => - $n := $n + 1 + lexerAdvancePosition! lex [] shoeError lex b = nil => nil @@ -206,73 +257,74 @@ shoeLeafSpaces x == ["SPACES",x] shoeLispEscape lex == - $n := $n + 1 - $n >= lexerLineLength lex => - SoftShoeError([$linepos,:$n],'"lisp escape error") - shoeLeafError stringChar(lexerLineString lex,$n) - a := shoeReadLispString(lexerLineString lex,$n) + lexerAdvancePosition! lex + lexerEol? lex => + SoftShoeError([$linepos,:lexerCurrentPosition lex],'"lisp escape error") + shoeLeafError lexerCurrentChar lex + a := lexerReadLisp lex a = nil => - SoftShoeError([$linepos,:$n],'"lisp escape error") - shoeLeafError stringChar(lexerLineString lex,$n) + SoftShoeError([$linepos,:lexerCurrentPosition lex],'"lisp escape error") + shoeLeafError lexerCurrentChar lex [exp,n] := a n = nil => - $n := lexerLineLength lex + lexerSkipToEnd! lex shoeLeafLispExp exp - $n := n + lexerPosition!(lex,n) shoeLeafLispExp exp shoeEscape lex == - $n := $n + 1 + lexerAdvancePosition! lex shoeEsc lex => shoeWord(lex,true) nil shoeEsc lex == - $n >= lexerLineLength lex => + lexerEol? lex => shoeNextLine(lex,$r) => - while $n = nil repeat shoeNextLine(lex,$r) + while lexerRefresh? lex repeat + shoeNextLine(lex,$r) shoeEsc lex false false - n1 := firstNonblankPosition(lexerLineString lex,$n) + n1 := firstNonblankPosition(lexerLineString lex,lexerCurrentPosition lex) n1 = nil => shoeNextLine(lex,$r) - while $n = nil repeat + while lexerRefresh? lex repeat shoeNextLine(lex,$r) shoeEsc lex false true shoeStartsComment lex == - $n < lexerLineLength lex => - stringChar(lexerLineString lex,$n) = char "+" => - www := $n + 1 + not lexerEol? lex => + lexerCurrentChar lex = char "+" => + www := lexerCurrentPosition lex + 1 www >= lexerLineLength lex => false - stringChar(lexerLineString lex,www) = char "+" + lexerCharacterAt(lex,www) = char "+" false false shoeStartsNegComment lex == - $n < lexerLineLength lex => - stringChar(lexerLineString lex,$n) = char "-" => - www := $n + 1 + not lexerEol? lex => + lexerCurrentChar lex = char "-" => + www := lexerCurrentPosition lex + 1 www >= lexerLineLength lex => false - stringChar(lexerLineString lex,www) = char "-" + lexerCharacterAt(lex,www) = char "-" false false shoeNegComment lex == - n := $n - $n := lexerLineLength lex + n := lexerCurrentPosition lex + lexerSkipToEnd! lex shoeLeafNegComment subString(lexerLineString lex,n) shoeComment lex == - n := $n - $n := lexerLineLength lex + n := lexerCurrentPosition lex + lexerSkipToEnd! lex shoeLeafComment subString(lexerLineString lex,n) shoePunct lex == - sss := shoeMatch(lexerLineString lex,$n) - $n := $n + #sss + sss := shoeMatch lex + lexerAdvancePosition!(lex,#sss) shoeKeyTr(lex,sss) shoeKeyTr(lex,w) == @@ -283,65 +335,66 @@ shoeKeyTr(lex,w) == shoeLeafKey w shoePossFloat(lex,w)== - $n >= lexerLineLength lex or not digit? stringChar(lexerLineString lex,$n) => shoeLeafKey w + lexerEol? lex or not digit? lexerCurrentChar lex => shoeLeafKey w w := shoeInteger lex shoeExponent(lex,'"0",w) shoeSpace lex == - n := $n - $n := firstNonblankPosition(lexerLineString lex,$n) + n := lexerCurrentPosition lex + lexerSkipBlank! lex $floatok := true - $n = nil => + lexerRefresh? lex => shoeLeafSpaces 0 - $n:= lexerLineLength lex - shoeLeafSpaces ($n-n) + lexerSkipToEnd! lex + shoeLeafSpaces(lexerCurrentPosition lex - n) shoeString lex == - $n := $n+1 + lexerAdvancePosition! lex $floatok := false shoeLeafString shoeS lex shoeS lex == - $n >= lexerLineLength lex => - SoftShoeError([$linepos,:$n],'"quote added") + lexerEol? lex => + SoftShoeError([$linepos,:lexerCurrentPosition lex],'"quote added") '"" - n := $n - strsym := charPosition(char "_"",lexerLineString lex,$n) or lexerLineLength lex - escsym := charPosition(char "__",lexerLineString lex,$n) or lexerLineLength lex + n := lexerCurrentPosition lex + strsym := lexerCharPosition(lex,char "_"") + escsym := lexerCharPosition(lex,char "__") mn := MIN(strsym,escsym) mn = lexerLineLength lex => - $n := lexerLineLength lex - SoftShoeError([$linepos,:$n],'"quote added") + lexerSkipToEnd! lex + SoftShoeError([$linepos,:lexerCurrentPosition lex],'"quote added") subString(lexerLineString lex,n) mn = strsym => - $n := mn + 1 + lexerPosition!(lex,mn + 1) subString(lexerLineString lex,n,mn-n) str := subString(lexerLineString lex,n,mn-n) - $n := mn+1 + lexerPosition!(lex,mn + 1) a := shoeEsc lex b := a => - str := strconc(str,charString stringChar(lexerLineString lex,$n)) - $n := $n + 1 + str := strconc(str,charString lexerCurrentChar lex) + lexerAdvancePosition! lex shoeS lex shoeS lex strconc(str,b) -shoeIdEnd(line,n)== - while n<#line and shoeIdChar stringChar(line,n) repeat - n := n+1 +shoeIdEnd lex == + n := lexerCurrentPosition lex + while n < lexerLineLength lex and shoeIdChar lexerCharacterAt(lex,n) repeat + n := n + 1 n shoeW(lex,b) == - n1 := $n - $n := $n+1 + n1 := lexerCurrentPosition lex + lexerAdvancePosition! lex l := lexerLineLength lex - endid := shoeIdEnd(lexerLineString lex,$n) - endid = l or stringChar(lexerLineString lex,endid) ~= char "__" => - $n := endid + endid := shoeIdEnd lex + endid = l or lexerCharacterAt(lex,endid) ~= char "__" => + lexerPosition!(lex,endid) [b,subString(lexerLineString lex,n1,endid-n1)] str := subString(lexerLineString lex,n1,endid-n1) - $n := endid+1 + lexerPosition!(lex,endid + 1) a := shoeEsc lex bb := a => shoeW(lex,true) @@ -362,15 +415,14 @@ shoeInteger lex == shoeInteger1(lex,false) shoeInteger1(lex,zro) == - n := $n - l := lexerLineLength lex - while $n <l and digit? stringChar(lexerLineString lex,$n) repeat - $n := $n+1 - $n = l or stringChar(lexerLineString lex,$n) ~= char "__" => - n = $n and zro => '"0" - subString(lexerLineString lex,n,$n - n) - str := subString(lexerLineString lex,n,$n - n) - $n := $n+1 + n := lexerCurrentPosition lex + while not lexerEol? lex and digit? lexerCurrentChar lex repeat + lexerAdvancePosition! lex + lexerEol? lex or lexerCurrentChar lex ~= char "__" => + n = lexerCurrentPosition lex and zro => '"0" + subString(lexerLineString lex,n,lexerCurrentPosition lex - n) + str := subString(lexerLineString lex,n,lexerCurrentPosition lex - n) + lexerAdvancePosition! lex a := shoeEsc lex bb := shoeInteger1(lex,zro) strconc(str,bb) @@ -385,53 +437,53 @@ shoeIntValue(s) == shoeNumber lex == a := shoeInteger lex - $n >= lexerLineLength lex => shoeLeafInteger a - $floatok and stringChar(lexerLineString lex,$n) = char "." => - n := $n - $n := $n+1 - $n < lexerLineLength lex and stringChar(lexerLineString lex,$n) = char "." => - $n := n + lexerEol? lex => shoeLeafInteger a + $floatok and lexerCurrentChar lex = char "." => + n := lexerCurrentPosition lex + lexerAdvancePosition! lex + not lexerEol? lex and lexerCurrentChar lex = char "." => + lexerPosition!(lex,n) shoeLeafInteger a w := shoeInteger1(lex,true) shoeExponent(lex,a,w) shoeLeafInteger a shoeExponent(lex,a,w)== - $n >= lexerLineLength lex => shoeLeafFloat(a,w,0) - n := $n - c := stringChar(lexerLineString lex,$n) + lexerEol? lex => shoeLeafFloat(a,w,0) + n := lexerCurrentPosition lex + c := lexerCurrentChar lex c = char "E" or c = char "e" => - $n := $n+1 - $n >= lexerLineLength lex => - $n := n + lexerAdvancePosition! lex + lexerEol? lex => + lexerPosition!(lex,n) shoeLeafFloat(a,w,0) - digit? stringChar(lexerLineString lex,$n) => + digit? lexerCurrentChar lex => e := shoeInteger lex e := shoeIntValue e shoeLeafFloat(a,w,e) - c1 := stringChar(lexerLineString lex,$n) + c1 := lexerCurrentChar lex c1 = char "+" or c1 = char "-" => - $n := $n+1 - $n >= lexerLineLength lex => - $n := n + lexerAdvancePosition! lex + lexerEol? lex => + lexerPosition!(lex,n) shoeLeafFloat(a,w,0) - digit? stringChar(lexerLineString lex,$n) => + digit? lexerCurrentChar lex => e := shoeInteger lex e := shoeIntValue e shoeLeafFloat(a,w,(c1 = char "-" => MINUS e; e)) - $n := n + lexerPosition!(lex,n) shoeLeafFloat(a,w,0) -- FIXME: Missing alternative. shoeLeafFloat(a,w,0) shoeError lex == - n := $n - $n := $n + 1 + n := lexerCurrentPosition lex + lexerAdvancePosition! lex SoftShoeError([$linepos,:n], strconc( '"The character whose number is ", - toString codePoint stringChar(lexerLineString lex,n), + toString codePoint lexerCharacterAt(lex,n), '" is not a Boot character")) - shoeLeafError stringChar(lexerLineString lex,n) + shoeLeafError lexerCharacterAt(lex,n) shoeKeyWord st == tableValue(shoeKeyTable,st) @@ -439,8 +491,8 @@ shoeKeyWord st == shoeKeyWordP st == tableValue(shoeKeyTable,st) ~= nil -shoeMatch(l,i) == - shoeSubStringMatch(l,shoeDict,i) +shoeMatch lex == + shoeSubStringMatch(lexerLineString lex,shoeDict,lexerCurrentPosition lex) shoeSubStringMatch(l,d,i) == h := codePoint stringChar(l, i) diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp index e428c877..48582bbf 100644 --- a/src/boot/strap/scanner.clisp +++ b/src/boot/strap/scanner.clisp @@ -34,21 +34,70 @@ (DEFUN |makeLexer| () (|mk%Lexer| NIL NIL)) +(DEFMACRO |lexerRefresh?| (|bfVar#1|) + (|applySubst| (LIST (CONS '|bfVar#1| |bfVar#1|)) + '(NULL (|lexerCurrentPosition| |bfVar#1|)))) + (DEFMACRO |lexerLineLength| (|bfVar#1|) (|applySubst| (LIST (CONS '|bfVar#1| |bfVar#1|)) '(LENGTH (|lexerLineString| |bfVar#1|)))) +(DEFUN |lexerSetLine!| (|lex| |line|) + (PROGN + (SETF (|lexerLineString| |lex|) |line|) + (SETF (|lexerCurrentPosition| |lex|) 0))) + +(DEFUN |lexerSkipBlank!| (|lex|) + (SETF (|lexerCurrentPosition| |lex|) + (|firstNonblankPosition| (|lexerLineString| |lex|) + (|lexerCurrentPosition| |lex|)))) + +(DEFUN |lexerAdvancePosition!| (|lex| &OPTIONAL (|n| 1)) + (SETF (|lexerCurrentPosition| |lex|) (+ (|lexerCurrentPosition| |lex|) |n|))) + +(DEFUN |lexerSkipToEnd!| (|lex|) + (SETF (|lexerCurrentPosition| |lex|) (|lexerLineLength| |lex|))) + +(DEFUN |lexerPosition!| (|lex| |k|) (SETF (|lexerCurrentPosition| |lex|) |k|)) + +(DEFUN |lexerCharCountToCompleteTab| (|lex|) + (- 7 (REM (|lexerCurrentPosition| |lex|) 8))) + +(DEFMACRO |lexerCurrentChar| (|bfVar#1|) + (|applySubst| (LIST (CONS '|bfVar#1| |bfVar#1|)) + '(SCHAR (|lexerLineString| |bfVar#1|) + (|lexerCurrentPosition| |bfVar#1|)))) + +(DEFMACRO |lexerCharacterAt| (|bfVar#2| |bfVar#1|) + (|applySubst| (LIST (CONS '|bfVar#2| |bfVar#2|) (CONS '|bfVar#1| |bfVar#1|)) + '(SCHAR (|lexerLineString| |bfVar#2|) |bfVar#1|))) + +(DEFUN |lexerCharPosition| (|lex| |c|) + (OR + (|charPosition| |c| (|lexerLineString| |lex|) + (|lexerCurrentPosition| |lex|)) + (|lexerLineLength| |lex|))) + +(DEFUN |lexerEol?| (|lex|) + (NOT (< (|lexerCurrentPosition| |lex|) (|lexerLineLength| |lex|)))) + +(DEFUN |lexerReadLisp| (|lex|) + (|shoeReadLispString| (|lexerLineString| |lex|) + (|lexerCurrentPosition| |lex|))) + (DEFUN |shoeNextLine| (|lex| |s|) (LET* (|s1| |a|) - (DECLARE (SPECIAL |$n| |$r| |$f| |$linepos|)) + (DECLARE (SPECIAL |$r| |$f| |$linepos|)) (COND ((|bStreamNull| |s|) NIL) (T (SETQ |$linepos| |s|) (SETQ |$f| (CAR |s|)) (SETQ |$r| (CDR |s|)) - (SETF (|lexerLineString| |lex|) (|sourceLineString| |$f|)) - (SETQ |$n| (|firstNonblankPosition| (|lexerLineString| |lex|) 0)) - (COND ((NULL |$n|) T) - ((CHAR= (SCHAR (|lexerLineString| |lex|) |$n|) |shoeTAB|) - (SETQ |a| (|makeString| (- 7 (REM |$n| 8)) (|char| '| |))) - (SETF (SCHAR (|lexerLineString| |lex|) |$n|) (|char| '| |)) + (|lexerSetLine!| |lex| (|sourceLineString| |$f|)) + (|lexerSkipBlank!| |lex|) + (COND ((|lexerRefresh?| |lex|) T) + ((EQUAL (|lexerCurrentChar| |lex|) |shoeTAB|) + (SETQ |a| + (|makeString| (|lexerCharCountToCompleteTab| |lex|) + (|char| '| |))) + (SETF (|lexerCurrentChar| |lex|) (|char| '| |)) (SETF (|lexerLineString| |lex|) (CONCAT |a| (|lexerLineString| |lex|))) (SETQ |s1| @@ -62,19 +111,18 @@ (DEFUN |shoeLineToks| (|s|) (LET* ((|$f| NIL) (|$r| NIL) - (|$n| NIL) (|$floatok| T) (|$linepos| |s|) |toks| |dq| |command| |lex|) - (DECLARE (SPECIAL |$f| |$r| |$n| |$floatok| |$linepos|)) + (DECLARE (SPECIAL |$f| |$r| |$floatok| |$linepos|)) (PROGN (SETQ |lex| (|makeLexer|)) (COND ((NOT (|shoeNextLine| |lex| |s|)) (CONS NIL NIL)) - ((NULL |$n|) (|shoeLineToks| |$r|)) - ((CHAR= (SCHAR (|lexerLineString| |lex|) 0) (|char| '|)|)) + ((|lexerRefresh?| |lex|) (|shoeLineToks| |$r|)) + ((CHAR= (|lexerCharacterAt| |lex| 0) (|char| '|)|)) (COND ((SETQ |command| (|shoeLine?| (|lexerLineString| |lex|))) (SETQ |dq| @@ -86,7 +134,7 @@ (T (|shoeLineToks| |$r|)))) (T (SETQ |toks| NIL) (LOOP - (COND ((NOT (< |$n| (|lexerLineLength| |lex|))) (RETURN NIL)) + (COND ((|lexerEol?| |lex|) (RETURN NIL)) (T (SETQ |toks| (|dqAppend| |toks| (|shoeToken| |lex|)))))) (COND ((NULL |toks|) (|shoeLineToks| |$r|)) (T (CONS (LIST |toks|) |$r|)))))))) @@ -108,12 +156,12 @@ (DEFUN |shoeAccumulateLines| (|lex| |s| |string|) (LET* (|a| |command|) - (DECLARE (SPECIAL |$r| |$n|)) + (DECLARE (SPECIAL |$r|)) (COND ((NOT (|shoeNextLine| |lex| |s|)) (CONS |s| |string|)) - ((NULL |$n|) (|shoeAccumulateLines| |lex| |$r| |string|)) + ((|lexerRefresh?| |lex|) (|shoeAccumulateLines| |lex| |$r| |string|)) ((EQL (|lexerLineLength| |lex|) 0) (|shoeAccumulateLines| |lex| |$r| |string|)) - ((CHAR= (SCHAR (|lexerLineString| |lex|) 0) (|char| '|)|)) + ((CHAR= (|lexerCharacterAt| |lex| 0) (|char| '|)|)) (SETQ |command| (|shoeLisp?| (|lexerLineString| |lex|))) (COND ((AND |command| (PLUSP (LENGTH |command|))) @@ -136,11 +184,11 @@ (DEFUN |shoeToken| (|lex|) (LET* (|b| |ch| |n| |linepos|) - (DECLARE (SPECIAL |$n| |$linepos|)) + (DECLARE (SPECIAL |$linepos|)) (PROGN (SETQ |linepos| |$linepos|) - (SETQ |n| |$n|) - (SETQ |ch| (SCHAR (|lexerLineString| |lex|) |$n|)) + (SETQ |n| (|lexerCurrentPosition| |lex|)) + (SETQ |ch| (|lexerCurrentChar| |lex|)) (SETQ |b| (COND ((|shoeStartsComment| |lex|) (|shoeComment| |lex|) NIL) ((|shoeStartsNegComment| |lex|) (|shoeNegComment| |lex|) @@ -152,7 +200,7 @@ ((CHAR= |ch| (|char| '|"|)) (|shoeString| |lex|)) ((DIGIT-CHAR-P |ch|) (|shoeNumber| |lex|)) ((CHAR= |ch| (|char| '_)) (|shoeEscape| |lex|)) - ((EQUAL |ch| |shoeTAB|) (SETQ |$n| (+ |$n| 1)) NIL) + ((EQUAL |ch| |shoeTAB|) (|lexerAdvancePosition!| |lex|) NIL) (T (|shoeError| |lex|)))) (COND ((NULL |b|) NIL) (T (|dqUnit| (|makeToken| |linepos| |b| |n|))))))) @@ -187,95 +235,97 @@ (DEFUN |shoeLispEscape| (|lex|) (LET* (|n| |exp| |a|) - (DECLARE (SPECIAL |$linepos| |$n|)) + (DECLARE (SPECIAL |$linepos|)) (PROGN - (SETQ |$n| (+ |$n| 1)) + (|lexerAdvancePosition!| |lex|) (COND - ((NOT (< |$n| (|lexerLineLength| |lex|))) - (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error") - (|shoeLeafError| (SCHAR (|lexerLineString| |lex|) |$n|))) - (T (SETQ |a| (|shoeReadLispString| (|lexerLineString| |lex|) |$n|)) + ((|lexerEol?| |lex|) + (|SoftShoeError| (CONS |$linepos| (|lexerCurrentPosition| |lex|)) + "lisp escape error") + (|shoeLeafError| (|lexerCurrentChar| |lex|))) + (T (SETQ |a| (|lexerReadLisp| |lex|)) (COND ((NULL |a|) - (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error") - (|shoeLeafError| (SCHAR (|lexerLineString| |lex|) |$n|))) + (|SoftShoeError| (CONS |$linepos| (|lexerCurrentPosition| |lex|)) + "lisp escape error") + (|shoeLeafError| (|lexerCurrentChar| |lex|))) (T (SETQ |exp| (CAR |a|)) (SETQ |n| (CADR |a|)) - (COND - ((NULL |n|) (SETQ |$n| (|lexerLineLength| |lex|)) - (|shoeLeafLispExp| |exp|)) - (T (SETQ |$n| |n|) (|shoeLeafLispExp| |exp|)))))))))) + (COND ((NULL |n|) (|lexerSkipToEnd!| |lex|) (|shoeLeafLispExp| |exp|)) + (T (|lexerPosition!| |lex| |n|) + (|shoeLeafLispExp| |exp|)))))))))) (DEFUN |shoeEscape| (|lex|) - (DECLARE (SPECIAL |$n|)) (PROGN - (SETQ |$n| (+ |$n| 1)) + (|lexerAdvancePosition!| |lex|) (COND ((|shoeEsc| |lex|) (|shoeWord| |lex| T)) (T NIL)))) (DEFUN |shoeEsc| (|lex|) (LET* (|n1|) - (DECLARE (SPECIAL |$r| |$n|)) + (DECLARE (SPECIAL |$r|)) (COND - ((NOT (< |$n| (|lexerLineLength| |lex|))) + ((|lexerEol?| |lex|) (COND ((|shoeNextLine| |lex| |$r|) - (LOOP (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |lex| |$r|)))) + (LOOP + (COND ((NOT (|lexerRefresh?| |lex|)) (RETURN NIL)) + (T (|shoeNextLine| |lex| |$r|)))) (|shoeEsc| |lex|) NIL) (T NIL))) - (T (SETQ |n1| (|firstNonblankPosition| (|lexerLineString| |lex|) |$n|)) + (T + (SETQ |n1| + (|firstNonblankPosition| (|lexerLineString| |lex|) + (|lexerCurrentPosition| |lex|))) (COND ((NULL |n1|) (|shoeNextLine| |lex| |$r|) - (LOOP (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |lex| |$r|)))) + (LOOP + (COND ((NOT (|lexerRefresh?| |lex|)) (RETURN NIL)) + (T (|shoeNextLine| |lex| |$r|)))) (|shoeEsc| |lex|) NIL) (T T)))))) (DEFUN |shoeStartsComment| (|lex|) (LET* (|www|) - (DECLARE (SPECIAL |$n|)) (COND - ((< |$n| (|lexerLineLength| |lex|)) + ((NOT (|lexerEol?| |lex|)) (COND - ((CHAR= (SCHAR (|lexerLineString| |lex|) |$n|) (|char| '+)) - (SETQ |www| (+ |$n| 1)) + ((CHAR= (|lexerCurrentChar| |lex|) (|char| '+)) + (SETQ |www| (+ (|lexerCurrentPosition| |lex|) 1)) (COND ((NOT (< |www| (|lexerLineLength| |lex|))) NIL) - (T (CHAR= (SCHAR (|lexerLineString| |lex|) |www|) (|char| '+))))) + (T (CHAR= (|lexerCharacterAt| |lex| |www|) (|char| '+))))) (T NIL))) (T NIL)))) (DEFUN |shoeStartsNegComment| (|lex|) (LET* (|www|) - (DECLARE (SPECIAL |$n|)) (COND - ((< |$n| (|lexerLineLength| |lex|)) + ((NOT (|lexerEol?| |lex|)) (COND - ((CHAR= (SCHAR (|lexerLineString| |lex|) |$n|) (|char| '-)) - (SETQ |www| (+ |$n| 1)) + ((CHAR= (|lexerCurrentChar| |lex|) (|char| '-)) + (SETQ |www| (+ (|lexerCurrentPosition| |lex|) 1)) (COND ((NOT (< |www| (|lexerLineLength| |lex|))) NIL) - (T (CHAR= (SCHAR (|lexerLineString| |lex|) |www|) (|char| '-))))) + (T (CHAR= (|lexerCharacterAt| |lex| |www|) (|char| '-))))) (T NIL))) (T NIL)))) (DEFUN |shoeNegComment| (|lex|) (LET* (|n|) - (DECLARE (SPECIAL |$n|)) (PROGN - (SETQ |n| |$n|) - (SETQ |$n| (|lexerLineLength| |lex|)) + (SETQ |n| (|lexerCurrentPosition| |lex|)) + (|lexerSkipToEnd!| |lex|) (|shoeLeafNegComment| (|subString| (|lexerLineString| |lex|) |n|))))) (DEFUN |shoeComment| (|lex|) (LET* (|n|) - (DECLARE (SPECIAL |$n|)) (PROGN - (SETQ |n| |$n|) - (SETQ |$n| (|lexerLineLength| |lex|)) + (SETQ |n| (|lexerCurrentPosition| |lex|)) + (|lexerSkipToEnd!| |lex|) (|shoeLeafComment| (|subString| (|lexerLineString| |lex|) |n|))))) (DEFUN |shoePunct| (|lex|) (LET* (|sss|) - (DECLARE (SPECIAL |$n|)) (PROGN - (SETQ |sss| (|shoeMatch| (|lexerLineString| |lex|) |$n|)) - (SETQ |$n| (+ |$n| (LENGTH |sss|))) + (SETQ |sss| (|shoeMatch| |lex|)) + (|lexerAdvancePosition!| |lex| (LENGTH |sss|)) (|shoeKeyTr| |lex| |sss|)))) (DEFUN |shoeKeyTr| (|lex| |w|) @@ -286,92 +336,89 @@ (T (SETQ |$floatok| (NOT (|shoeCloser| |w|))) (|shoeLeafKey| |w|)))) (DEFUN |shoePossFloat| (|lex| |w|) - (DECLARE (SPECIAL |$n|)) (COND - ((OR (NOT (< |$n| (|lexerLineLength| |lex|))) - (NOT (DIGIT-CHAR-P (SCHAR (|lexerLineString| |lex|) |$n|)))) + ((OR (|lexerEol?| |lex|) (NOT (DIGIT-CHAR-P (|lexerCurrentChar| |lex|)))) (|shoeLeafKey| |w|)) (T (SETQ |w| (|shoeInteger| |lex|)) (|shoeExponent| |lex| "0" |w|)))) (DEFUN |shoeSpace| (|lex|) (LET* (|n|) - (DECLARE (SPECIAL |$floatok| |$n|)) + (DECLARE (SPECIAL |$floatok|)) (PROGN - (SETQ |n| |$n|) - (SETQ |$n| (|firstNonblankPosition| (|lexerLineString| |lex|) |$n|)) + (SETQ |n| (|lexerCurrentPosition| |lex|)) + (|lexerSkipBlank!| |lex|) (SETQ |$floatok| T) (COND - ((NULL |$n|) (|shoeLeafSpaces| 0) (SETQ |$n| (|lexerLineLength| |lex|))) - (T (|shoeLeafSpaces| (- |$n| |n|))))))) + ((|lexerRefresh?| |lex|) (|shoeLeafSpaces| 0) (|lexerSkipToEnd!| |lex|)) + (T (|shoeLeafSpaces| (- (|lexerCurrentPosition| |lex|) |n|))))))) (DEFUN |shoeString| (|lex|) - (DECLARE (SPECIAL |$floatok| |$n|)) + (DECLARE (SPECIAL |$floatok|)) (PROGN - (SETQ |$n| (+ |$n| 1)) + (|lexerAdvancePosition!| |lex|) (SETQ |$floatok| NIL) (|shoeLeafString| (|shoeS| |lex|)))) (DEFUN |shoeS| (|lex|) (LET* (|b| |a| |str| |mn| |escsym| |strsym| |n|) - (DECLARE (SPECIAL |$linepos| |$n|)) + (DECLARE (SPECIAL |$linepos|)) (COND - ((NOT (< |$n| (|lexerLineLength| |lex|))) - (|SoftShoeError| (CONS |$linepos| |$n|) "quote added") "") - (T (SETQ |n| |$n|) - (SETQ |strsym| - (OR (|charPosition| (|char| '|"|) (|lexerLineString| |lex|) |$n|) - (|lexerLineLength| |lex|))) - (SETQ |escsym| - (OR (|charPosition| (|char| '_) (|lexerLineString| |lex|) |$n|) - (|lexerLineLength| |lex|))) + ((|lexerEol?| |lex|) + (|SoftShoeError| (CONS |$linepos| (|lexerCurrentPosition| |lex|)) + "quote added") + "") + (T (SETQ |n| (|lexerCurrentPosition| |lex|)) + (SETQ |strsym| (|lexerCharPosition| |lex| (|char| '|"|))) + (SETQ |escsym| (|lexerCharPosition| |lex| (|char| '_))) (SETQ |mn| (MIN |strsym| |escsym|)) (COND - ((EQUAL |mn| (|lexerLineLength| |lex|)) - (SETQ |$n| (|lexerLineLength| |lex|)) - (|SoftShoeError| (CONS |$linepos| |$n|) "quote added") + ((EQUAL |mn| (|lexerLineLength| |lex|)) (|lexerSkipToEnd!| |lex|) + (|SoftShoeError| (CONS |$linepos| (|lexerCurrentPosition| |lex|)) + "quote added") (|subString| (|lexerLineString| |lex|) |n|)) - ((EQUAL |mn| |strsym|) (SETQ |$n| (+ |mn| 1)) + ((EQUAL |mn| |strsym|) (|lexerPosition!| |lex| (+ |mn| 1)) (|subString| (|lexerLineString| |lex|) |n| (- |mn| |n|))) (T (SETQ |str| (|subString| (|lexerLineString| |lex|) |n| (- |mn| |n|))) - (SETQ |$n| (+ |mn| 1)) (SETQ |a| (|shoeEsc| |lex|)) + (|lexerPosition!| |lex| (+ |mn| 1)) (SETQ |a| (|shoeEsc| |lex|)) (SETQ |b| (COND (|a| (SETQ |str| - (CONCAT |str| - (STRING - (SCHAR (|lexerLineString| |lex|) |$n|)))) - (SETQ |$n| (+ |$n| 1)) (|shoeS| |lex|)) + (CONCAT |str| (STRING (|lexerCurrentChar| |lex|)))) + (|lexerAdvancePosition!| |lex|) (|shoeS| |lex|)) (T (|shoeS| |lex|)))) (CONCAT |str| |b|))))))) -(DEFUN |shoeIdEnd| (|line| |n|) - (PROGN - (LOOP - (COND - ((NOT (AND (< |n| (LENGTH |line|)) (|shoeIdChar| (SCHAR |line| |n|)))) - (RETURN NIL)) - (T (SETQ |n| (+ |n| 1))))) - |n|)) +(DEFUN |shoeIdEnd| (|lex|) + (LET* (|n|) + (PROGN + (SETQ |n| (|lexerCurrentPosition| |lex|)) + (LOOP + (COND + ((NOT + (AND (< |n| (|lexerLineLength| |lex|)) + (|shoeIdChar| (|lexerCharacterAt| |lex| |n|)))) + (RETURN NIL)) + (T (SETQ |n| (+ |n| 1))))) + |n|))) (DEFUN |shoeW| (|lex| |b|) (LET* (|bb| |a| |str| |endid| |l| |n1|) - (DECLARE (SPECIAL |$n|)) (PROGN - (SETQ |n1| |$n|) - (SETQ |$n| (+ |$n| 1)) + (SETQ |n1| (|lexerCurrentPosition| |lex|)) + (|lexerAdvancePosition!| |lex|) (SETQ |l| (|lexerLineLength| |lex|)) - (SETQ |endid| (|shoeIdEnd| (|lexerLineString| |lex|) |$n|)) + (SETQ |endid| (|shoeIdEnd| |lex|)) (COND ((OR (EQUAL |endid| |l|) - (NOT (CHAR= (SCHAR (|lexerLineString| |lex|) |endid|) (|char| '_)))) - (SETQ |$n| |endid|) + (NOT (CHAR= (|lexerCharacterAt| |lex| |endid|) (|char| '_)))) + (|lexerPosition!| |lex| |endid|) (LIST |b| (|subString| (|lexerLineString| |lex|) |n1| (- |endid| |n1|)))) (T (SETQ |str| (|subString| (|lexerLineString| |lex|) |n1| (- |endid| |n1|))) - (SETQ |$n| (+ |endid| 1)) (SETQ |a| (|shoeEsc| |lex|)) + (|lexerPosition!| |lex| (+ |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)))))))) @@ -389,25 +436,28 @@ (DEFUN |shoeInteger| (|lex|) (|shoeInteger1| |lex| NIL)) (DEFUN |shoeInteger1| (|lex| |zro|) - (LET* (|bb| |a| |str| |l| |n|) - (DECLARE (SPECIAL |$n|)) + (LET* (|bb| |a| |str| |n|) (PROGN - (SETQ |n| |$n|) - (SETQ |l| (|lexerLineLength| |lex|)) + (SETQ |n| (|lexerCurrentPosition| |lex|)) (LOOP (COND ((NOT - (AND (< |$n| |l|) - (DIGIT-CHAR-P (SCHAR (|lexerLineString| |lex|) |$n|)))) + (AND (NOT (|lexerEol?| |lex|)) + (DIGIT-CHAR-P (|lexerCurrentChar| |lex|)))) (RETURN NIL)) - (T (SETQ |$n| (+ |$n| 1))))) + (T (|lexerAdvancePosition!| |lex|)))) (COND - ((OR (EQUAL |$n| |l|) - (NOT (CHAR= (SCHAR (|lexerLineString| |lex|) |$n|) (|char| '_)))) - (COND ((AND (EQUAL |n| |$n|) |zro|) "0") - (T (|subString| (|lexerLineString| |lex|) |n| (- |$n| |n|))))) - (T (SETQ |str| (|subString| (|lexerLineString| |lex|) |n| (- |$n| |n|))) - (SETQ |$n| (+ |$n| 1)) (SETQ |a| (|shoeEsc| |lex|)) + ((OR (|lexerEol?| |lex|) + (NOT (CHAR= (|lexerCurrentChar| |lex|) (|char| '_)))) + (COND ((AND (EQUAL |n| (|lexerCurrentPosition| |lex|)) |zro|) "0") + (T + (|subString| (|lexerLineString| |lex|) |n| + (- (|lexerCurrentPosition| |lex|) |n|))))) + (T + (SETQ |str| + (|subString| (|lexerLineString| |lex|) |n| + (- (|lexerCurrentPosition| |lex|) |n|))) + (|lexerAdvancePosition!| |lex|) (SETQ |a| (|shoeEsc| |lex|)) (SETQ |bb| (|shoeInteger1| |lex| |zro|)) (CONCAT |str| |bb|)))))) (DEFUN |shoeIntValue| (|s|) @@ -425,71 +475,72 @@ (DEFUN |shoeNumber| (|lex|) (LET* (|w| |n| |a|) - (DECLARE (SPECIAL |$floatok| |$n|)) + (DECLARE (SPECIAL |$floatok|)) (PROGN (SETQ |a| (|shoeInteger| |lex|)) - (COND ((NOT (< |$n| (|lexerLineLength| |lex|))) (|shoeLeafInteger| |a|)) - ((AND |$floatok| - (CHAR= (SCHAR (|lexerLineString| |lex|) |$n|) (|char| '|.|))) - (SETQ |n| |$n|) (SETQ |$n| (+ |$n| 1)) + (COND ((|lexerEol?| |lex|) (|shoeLeafInteger| |a|)) + ((AND |$floatok| (CHAR= (|lexerCurrentChar| |lex|) (|char| '|.|))) + (SETQ |n| (|lexerCurrentPosition| |lex|)) + (|lexerAdvancePosition!| |lex|) (COND - ((AND (< |$n| (|lexerLineLength| |lex|)) - (CHAR= (SCHAR (|lexerLineString| |lex|) |$n|) - (|char| '|.|))) - (SETQ |$n| |n|) (|shoeLeafInteger| |a|)) + ((AND (NOT (|lexerEol?| |lex|)) + (CHAR= (|lexerCurrentChar| |lex|) (|char| '|.|))) + (|lexerPosition!| |lex| |n|) (|shoeLeafInteger| |a|)) (T (SETQ |w| (|shoeInteger1| |lex| T)) (|shoeExponent| |lex| |a| |w|)))) (T (|shoeLeafInteger| |a|)))))) (DEFUN |shoeExponent| (|lex| |a| |w|) (LET* (|c1| |e| |c| |n|) - (DECLARE (SPECIAL |$n|)) - (COND - ((NOT (< |$n| (|lexerLineLength| |lex|))) (|shoeLeafFloat| |a| |w| 0)) - (T (SETQ |n| |$n|) (SETQ |c| (SCHAR (|lexerLineString| |lex|) |$n|)) - (COND - ((OR (CHAR= |c| (|char| 'E)) (CHAR= |c| (|char| '|e|))) - (SETQ |$n| (+ |$n| 1)) - (COND - ((NOT (< |$n| (|lexerLineLength| |lex|))) (SETQ |$n| |n|) - (|shoeLeafFloat| |a| |w| 0)) - ((DIGIT-CHAR-P (SCHAR (|lexerLineString| |lex|) |$n|)) - (SETQ |e| (|shoeInteger| |lex|)) (SETQ |e| (|shoeIntValue| |e|)) - (|shoeLeafFloat| |a| |w| |e|)) - (T (SETQ |c1| (SCHAR (|lexerLineString| |lex|) |$n|)) - (COND - ((OR (CHAR= |c1| (|char| '+)) (CHAR= |c1| (|char| '-))) - (SETQ |$n| (+ |$n| 1)) - (COND - ((NOT (< |$n| (|lexerLineLength| |lex|))) (SETQ |$n| |n|) - (|shoeLeafFloat| |a| |w| 0)) - ((DIGIT-CHAR-P (SCHAR (|lexerLineString| |lex|) |$n|)) - (SETQ |e| (|shoeInteger| |lex|)) (SETQ |e| (|shoeIntValue| |e|)) - (|shoeLeafFloat| |a| |w| - (COND ((CHAR= |c1| (|char| '-)) (- |e|)) - (T |e|)))) - (T (SETQ |$n| |n|) (|shoeLeafFloat| |a| |w| 0)))))))) - (T (|shoeLeafFloat| |a| |w| 0))))))) + (COND ((|lexerEol?| |lex|) (|shoeLeafFloat| |a| |w| 0)) + (T (SETQ |n| (|lexerCurrentPosition| |lex|)) + (SETQ |c| (|lexerCurrentChar| |lex|)) + (COND + ((OR (CHAR= |c| (|char| 'E)) (CHAR= |c| (|char| '|e|))) + (|lexerAdvancePosition!| |lex|) + (COND + ((|lexerEol?| |lex|) (|lexerPosition!| |lex| |n|) + (|shoeLeafFloat| |a| |w| 0)) + ((DIGIT-CHAR-P (|lexerCurrentChar| |lex|)) + (SETQ |e| (|shoeInteger| |lex|)) (SETQ |e| (|shoeIntValue| |e|)) + (|shoeLeafFloat| |a| |w| |e|)) + (T (SETQ |c1| (|lexerCurrentChar| |lex|)) + (COND + ((OR (CHAR= |c1| (|char| '+)) (CHAR= |c1| (|char| '-))) + (|lexerAdvancePosition!| |lex|) + (COND + ((|lexerEol?| |lex|) (|lexerPosition!| |lex| |n|) + (|shoeLeafFloat| |a| |w| 0)) + ((DIGIT-CHAR-P (|lexerCurrentChar| |lex|)) + (SETQ |e| (|shoeInteger| |lex|)) + (SETQ |e| (|shoeIntValue| |e|)) + (|shoeLeafFloat| |a| |w| + (COND ((CHAR= |c1| (|char| '-)) (- |e|)) + (T |e|)))) + (T (|lexerPosition!| |lex| |n|) + (|shoeLeafFloat| |a| |w| 0)))))))) + (T (|shoeLeafFloat| |a| |w| 0))))))) (DEFUN |shoeError| (|lex|) (LET* (|n|) - (DECLARE (SPECIAL |$linepos| |$n|)) + (DECLARE (SPECIAL |$linepos|)) (PROGN - (SETQ |n| |$n|) - (SETQ |$n| (+ |$n| 1)) + (SETQ |n| (|lexerCurrentPosition| |lex|)) + (|lexerAdvancePosition!| |lex|) (|SoftShoeError| (CONS |$linepos| |n|) (CONCAT "The character whose number is " (WRITE-TO-STRING - (CHAR-CODE - (SCHAR (|lexerLineString| |lex|) |n|))) + (CHAR-CODE (|lexerCharacterAt| |lex| |n|))) " is not a Boot character")) - (|shoeLeafError| (SCHAR (|lexerLineString| |lex|) |n|))))) + (|shoeLeafError| (|lexerCharacterAt| |lex| |n|))))) (DEFUN |shoeKeyWord| (|st|) (|tableValue| |shoeKeyTable| |st|)) (DEFUN |shoeKeyWordP| (|st|) (|tableValue| |shoeKeyTable| |st|)) -(DEFUN |shoeMatch| (|l| |i|) (|shoeSubStringMatch| |l| |shoeDict| |i|)) +(DEFUN |shoeMatch| (|lex|) + (|shoeSubStringMatch| (|lexerLineString| |lex|) |shoeDict| + (|lexerCurrentPosition| |lex|))) (DEFUN |shoeSubStringMatch| (|l| |d| |i|) (LET* (|eql| |ls| |s| |s1| |done| |ll| |u| |h|) |