aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2012-05-24 13:41:17 +0000
committerdos-reis <gdr@axiomatics.org>2012-05-24 13:41:17 +0000
commite0f051b525d099db53ad1dd926f39ec326558e57 (patch)
tree0cc977ad25fe453ae2c3b08726feb9a237a14269
parentfbcb9ebe438100f7a549329ae14668cd27fde508 (diff)
downloadopen-axiom-e0f051b525d099db53ad1dd926f39ec326558e57.tar.gz
* boot/scanner.boot (%Lexer): New record structure.
Add a lexer parameter to all lexing functions that need one. Adjust their callers.
-rw-r--r--src/ChangeLog6
-rw-r--r--src/boot/scanner.boot260
-rw-r--r--src/boot/strap/scanner.clisp355
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|))