aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2012-06-04 01:38:56 +0000
committerdos-reis <gdr@axiomatics.org>2012-06-04 01:38:56 +0000
commit9093e140828074f9f86e9a88cb705f86ea087af7 (patch)
tree7af466dae4d12ba53d4041d0668d49410ce9a171
parent3e1313d951e807417a344c5fda677b98dcb462c8 (diff)
downloadopen-axiom-9093e140828074f9f86e9a88cb705f86ea087af7.tar.gz
* interp/spad.lisp (SPAD): Adjust.
* interp/spad-parser.boot: Add a reader parameter to all parsing functions. Adjust callers. * interp/newaux.lisp: Adjust form of specialized parsers. * interp/lexing.boot: Add a reader parameter to all lexing functions. Adjust Callers. * interp/io.boot (%Reader): Add source line field. * interp/debug.lisp: Adjust IO and lexer calls. * interp/util.lisp (string2SpadTree): Remove as unused.
-rw-r--r--src/ChangeLog12
-rw-r--r--src/interp/debug.lisp6
-rw-r--r--src/interp/io.boot5
-rw-r--r--src/interp/lexing.boot258
-rw-r--r--src/interp/newaux.lisp44
-rw-r--r--src/interp/spad-parser.boot757
-rw-r--r--src/interp/spad.lisp10
-rw-r--r--src/interp/util.lisp13
8 files changed, 552 insertions, 553 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 2b0225f3..88f507c1 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,17 @@
2012-06-03 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/spad.lisp (SPAD): Adjust.
+ * interp/spad-parser.boot: Add a reader parameter to all parsing
+ functions. Adjust callers.
+ * interp/newaux.lisp: Adjust form of specialized parsers.
+ * interp/lexing.boot: Add a reader parameter to all lexing
+ functions. Adjust Callers.
+ * interp/io.boot (%Reader): Add source line field.
+ * interp/debug.lisp: Adjust IO and lexer calls.
+ * interp/util.lisp (string2SpadTree): Remove as unused.
+
+2012-06-03 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* interp/preparse.lisp ($LineList): Remove.
(INITIALIZE-PREPARSE): Do not set it.
(preparse1): Do not reference it. Do not test for ioTerminal? and
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index 5e038fc5..e0231e65 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -1126,14 +1126,14 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
; **** 5. BOOT Error Handling
-(defun SPAD_SYNTAX_ERROR (&rest byebye)
+(defun SPAD_SYNTAX_ERROR (rd)
"Print syntax error indication, underline character, scrub line."
(BUMPERRORCOUNT '|syntax|)
(COND ((AND (EQ DEBUGMODE 'YES) (NOT(CONSOLEINPUTP IN-STREAM)))
(SPAD_LONG_ERROR))
((SPAD_SHORT_ERROR)))
- (|ioClear!|)
- (throw 'spad_reader nil))
+ (|ioClear!| rd)
+ (throw |$SpadReaderTag| nil))
(defun SPAD_LONG_ERROR ()
(SPAD_ERROR_LOC SPADERRORSTREAM)
diff --git a/src/interp/io.boot b/src/interp/io.boot
index a7fe1849..1d039259 100644
--- a/src/interp/io.boot
+++ b/src/interp/io.boot
@@ -104,9 +104,10 @@ findString(s1,s2,k == 0) ==
--% Reader
--%
structure %Reader ==
- Record(ins: %InputStream, lines: %List %Line) with
+ Record(ins: %InputStream, lines: %List %Line,sline: %Line) with
readerInput == (.ins)
readerLines == (.lines)
+ readerSourceLine == (.sline) -- current input line
makeReader ist ==
- mk%Reader(ist,nil)
+ mk%Reader(ist,nil,makeLine())
diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot
index 09fbd7d5..a5d71f15 100644
--- a/src/interp/lexing.boot
+++ b/src/interp/lexing.boot
@@ -40,10 +40,7 @@ import io
namespace BOOT
-module lexing where
- matchString: %String -> %Maybe %Short
- matchAdvanceString: %String -> %Maybe %Short
- matchAdvanceKeyword: %Symbol -> %Thing
+module lexing
--%
--% Line abstract datatype
@@ -99,17 +96,14 @@ lineAdvanceChar! l ==
lineCurrentIndex(l) := n
lineCurrentChar(l) := lineBuffer(l).n
-++ Current input line
-$spadLine := makeLine()
-
++ List of lines returned from preparse
$lineStack := nil
-nextLine st ==
+nextLine rd ==
$lineStack = nil => nil
[[n,:l],:$lineStack] := $lineStack
l := strconc(l,'" ")
- lineNewLine!(l,$spadLine,n)
+ lineNewLine!(l,readerSourceLine rd,n)
SETQ(LINE,l)
$currentLine := l
@@ -123,23 +117,24 @@ IN_-STREAM := 'T
OUT_-STREAM := 'T
++ Advances IN-STREAM, invoking Next Line if necessary
-advanceChar!() ==
+advanceChar! rd ==
repeat
- not lineAtEnd? $spadLine => return lineAdvanceChar! $spadLine
- nextLine IN_-STREAM => return currentChar()
+ not lineAtEnd? readerSourceLine rd =>
+ return lineAdvanceChar! readerSourceLine rd
+ nextLine rd => return currentChar rd
return nil
--%
++ Returns the current character of the line, initially blank for
++ an unread line
-currentChar() ==
- linePastEnd? $spadLine => charByName "Return"
- lineCurrentChar $spadLine
+currentChar rd ==
+ linePastEnd? readerSourceLine rd => charByName "Return"
+ lineCurrentChar readerSourceLine rd
-nextChar() ==
- lineAtEnd? $spadLine => charByName '"Return"
- lineNextChar $spadLine
+nextChar rd ==
+ lineAtEnd? readerSourceLine rd => charByName '"Return"
+ lineNextChar readerSourceLine rd
--%
@@ -174,25 +169,25 @@ $validTokens := 0
++ Subroutine of getSpadIntegerToken.
++ Read a the characters of a decimal integer and returns its value.
-getDecimalNumberToken buf ==
+getDecimalNumberToken(rd,buf) ==
repeat
- SUFFIX(currentChar(),buf)
- not DIGITP nextChar() => leave nil
- advanceChar!()
+ SUFFIX(currentChar rd,buf)
+ not DIGITP nextChar rd => leave nil
+ advanceChar! rd
readIntegerIfCan buf
++ Subroutine of getSpadIntegerToken.
++ We just read the radix of an integer number; parse the
++ digits forming that integer token.
-getIntegerInRadix(buf,r) ==
- r < 2 => SPAD__SYNTAX__ERROR()
+getIntegerInRadix(rd,buf,r) ==
+ r < 2 => SPAD__SYNTAX__ERROR rd
mark := #buf + 1
repeat
- SUFFIX(currentChar(),buf)
- d := rdigit? nextChar()
+ SUFFIX(currentChar rd,buf)
+ d := rdigit? nextChar rd
d = nil => leave nil
- d >= r => SPAD__SYNTAX__ERROR()
- advanceChar!()
+ d >= r => SPAD__SYNTAX__ERROR rd
+ advanceChar! rd
PARSE_-INTEGER(buf,KEYWORD::START,mark,KEYWORD::RADIX,r)
radixSuffix? c ==
@@ -203,61 +198,61 @@ radixSuffix? c ==
++ format, where the radix is implicitly taken to be 10. Or the spelling
++ can explicitly specify a radix. That radix can be anything
++ in the range 2..36
-getSpadIntegerToken() ==
+getSpadIntegerToken rd ==
buf := MAKE_-ADJUSTABLE_-STRING 0
- val := getDecimalNumberToken buf
- advanceChar!()
- if radixSuffix? currentChar() then
- val := getIntegerInRadix(buf,val)
- advanceChar!()
+ val := getDecimalNumberToken(rd,buf)
+ advanceChar! rd
+ if radixSuffix? currentChar rd then
+ val := getIntegerInRadix(rd,buf,val)
+ advanceChar! rd
makeToken(val,'NUMBER,#buf)
-getNumberToken() ==
+getNumberToken rd ==
buf := nil
repeat
- buf := [currentChar(),:buf]
- digit? nextChar() => advanceChar!()
+ buf := [currentChar rd,:buf]
+ digit? nextChar rd => advanceChar! rd
leave nil
- advanceChar!()
+ advanceChar! rd
sz := #buf -- keep track of digit count
makeToken(readIntegerIfCan listToString reverse! buf,'NUMBER,sz)
-getArgumentDesignator() ==
- advanceChar!()
- tok := getNumberToken()
+getArgumentDesignator rd ==
+ advanceChar! rd
+ tok := getNumberToken rd
makeToken(makeSymbol strconc('"#",formatToString('"~D",tokenSymbol tok)),
'ARGUMENT_-DESIGNATOR,$nonblank)
-getToken() ==
- not skipBlankChars() => nil
- tt := tokenLookaheadType currentChar()
+getToken rd ==
+ not skipBlankChars rd => nil
+ tt := tokenLookaheadType(rd,currentChar rd)
tt is 'EOF => makeToken(nil,'_*EOF,$nonblank)
tt is 'ESCAPE =>
- advanceChar!()
- getIdentifier(true)
- tt is 'ARGUMENT_-DESIGNATOR => getArgumentDesignator()
- tt is 'ID => getIdentifier(false)
- tt is 'NUM => getSpadIntegerToken()
- tt is 'STRING => getSpadString()
- tt is 'SPECIAL_-CHAR => getSpecial()
- getGliph(tt)
-
-tryGetToken() ==
- tok := getToken() =>
+ advanceChar! rd
+ getIdentifier(rd,true)
+ tt is 'ARGUMENT_-DESIGNATOR => getArgumentDesignator rd
+ tt is 'ID => getIdentifier(rd,false)
+ tt is 'NUM => getSpadIntegerToken rd
+ tt is 'STRING => getSpadString rd
+ tt is 'SPECIAL_-CHAR => getSpecial rd
+ getGliph(rd,tt)
+
+tryGetToken rd ==
+ tok := getToken rd =>
$validTokens := $validTokens + 1
tok
nil
++ Returns the current token or gets a new one if necessary
-currentToken() ==
+currentToken rd ==
$validTokens > 0 => $currentToken
- $currentToken := tryGetToken()
+ $currentToken := tryGetToken rd
++ Returns the token after the current token, or nil if there is none after
-nextToken() ==
- currentToken()
+nextToken rd ==
+ currentToken rd
$validTokens > 1 => $nextToken
- $nextToken := tryGetToken()
+ $nextToken := tryGetToken rd
matchToken(tok,typ,sym == nil) ==
tok ~= nil and symbolEq?(tokenType tok,typ) and
@@ -266,21 +261,21 @@ matchToken(tok,typ,sym == nil) ==
++ Return the current token if it has type `typ', and possibly the
++ same spelling as `sym'.
-matchCurrentToken(typ,sym == nil) ==
- matchToken(currentToken(),typ,sym)
+matchCurrentToken(rd,typ,sym == nil) ==
+ matchToken(currentToken rd,typ,sym)
++ Return the next token if it has type `typ;, and possibly the same
++ spelling as `sym'.
-matchNextToken(typ,sym == nil) ==
- matchToken(nextToken(),typ,sym)
+matchNextToken(rd,typ,sym == nil) ==
+ matchToken(nextToken rd,typ,sym)
++ Makes the next token be the current token.
-advanceToken() ==
- $validTokens = 0 => $currentToken := tryGetToken()
+advanceToken rd ==
+ $validTokens = 0 => $currentToken := tryGetToken rd
$validTokens = 1 =>
$validTokens := $validTokens - 1
$priorToken := copyToken $currentToken
- $currentToken := tryGetToken()
+ $currentToken := tryGetToken rd
$validTokens = 2 =>
$priorToken := copyToken $currentToken
$currentToken := copyToken $nextToken
@@ -293,8 +288,8 @@ makeSymbolOf tok ==
char? tokenSymbol tok => makeSymbol charString tokenSymbol tok
tokenSymbol tok
-currentSymbol() ==
- makeSymbolOf currentToken()
+currentSymbol rd ==
+ makeSymbolOf currentToken rd
tokenStackClear!() ==
$validTokens := 0
@@ -303,10 +298,10 @@ tokenStackClear!() ==
$priorToken := makeToken(nil,nil,nil)
++ Predicts the kind of token to follow, based on the given initial character
-tokenLookaheadType c ==
+tokenLookaheadType(rd,c) ==
c = nil => 'EOF
c = char "__" => 'ESCAPE
- c = char "#" and digit? nextChar() => 'ARGUMENT_-DESIGNATOR
+ c = char "#" and digit? nextChar rd => 'ARGUMENT_-DESIGNATOR
digit? c => 'NUM
c = char "%" or c = char "?" or c = char "?" or alphabetic? c => 'ID
c = char "_"" => 'STRING
@@ -314,45 +309,45 @@ tokenLookaheadType c ==
p := property(makeSymbol charString c,'GLIPH) => p
'SPECIAL_-CHAR
-skipBlankChars() ==
+skipBlankChars rd ==
$nonblank := true
repeat
- c := currentChar()
+ c := currentChar rd
c = nil => return false
- tokenLookaheadType c = 'WHITE =>
+ tokenLookaheadType(rd,c) = 'WHITE =>
$nonblank := false
- advanceChar!() = nil => return false
+ advanceChar! rd = nil => return false
return true
-getSpadString() ==
+getSpadString rd ==
buf := nil
- currentChar() ~= char "_"" => nil
- advanceChar!()
+ currentChar rd ~= char "_"" => nil
+ advanceChar! rd
repeat
- currentChar() = char "_"" => leave nil
- buf := [(currentChar() = char "__" => advanceChar!(); currentChar()),:buf]
- advanceChar!() = nil =>
+ currentChar rd = char "_"" => leave nil
+ buf := [(currentChar rd = char "__" => advanceChar! rd; currentChar rd),:buf]
+ advanceChar! rd = nil =>
sayBrightly '"close quote inserted"
leave nil
- advanceChar!()
+ advanceChar! rd
makeToken(listToString reverse! buf,'SPADSTRING)
++ Take a special character off the input stream. We let the type name
++ of each special character be the atom whose print name is the
++ character itself
-getSpecial() ==
- c := currentChar()
- advanceChar!()
+getSpecial rd ==
+ c := currentChar rd
+ advanceChar! rd
makeToken(c,'SPECIAL_-CHAR)
-getGliph(gliphs) ==
- buf := [currentChar()]
- advanceChar!()
+getGliph(rd,gliphs) ==
+ buf := [currentChar rd]
+ advanceChar! rd
repeat
- gliphs := symbolAssoc(makeSymbol charString currentChar(),gliphs) =>
- buf := [currentChar(),:buf]
+ gliphs := symbolAssoc(makeSymbol charString currentChar rd,gliphs) =>
+ buf := [currentChar rd,:buf]
gliphs := rest gliphs
- advanceChar!()
+ advanceChar! rd
s := makeSymbol listToString reverse! buf
return makeToken(s,'GLIPH,$nonblank)
@@ -363,20 +358,20 @@ Keywords == [
"if", "iterate", "break", "from", "exit", "leave", "return",
"not", "repeat", "until", "while", "for", "import", "inline" ]
-getIdentifier(esc?) ==
- buf := [currentChar()]
- advanceChar!()
+getIdentifier(rd,esc?) ==
+ buf := [currentChar rd]
+ advanceChar! rd
repeat
- c := currentChar()
+ c := currentChar rd
c = char "__" =>
- advanceChar!() = nil => leave nil
- buf := [currentChar(),:buf]
+ advanceChar! rd = nil => leave nil
+ buf := [currentChar rd,:buf]
esc? := true
- advanceChar!() = nil => leave nil
+ advanceChar! rd = nil => leave nil
alphabetic? c or digit? c
or scalarMember?(c,[char "%",char "'",char "?",char "!"]) =>
buf := [c,:buf]
- advanceChar!() = nil => leave nil
+ advanceChar! rd = nil => leave nil
leave nil
s := makeSymbol listToString reverse! buf
tt :=
@@ -412,73 +407,74 @@ quoteIfString tok ==
escapeKeywords(symbolName tokenSymbol tok,tokenSymbol tok)
symbolName tokenSymbol tok
-ungetTokens() ==
+ungetTokens rd ==
$validTokens = 0 => true
$validTokens = 1 =>
cursym := quoteIfString $currentToken
- curline := lineCurrentSegment $spadLine
+ curline := lineCurrentSegment readerSourceLine rd
revisedline := strconc(cursym,curline,'" ")
- lineNewLine!(revisedline,$spadLine,lineNumber $spadLine)
+ lineNewLine!(revisedline,readerSourceLine rd,lineNumber readerSourceLine rd)
$nonblank := tokenNonblank? $currentToken
$validTokens := 0
$validTokens = 2 =>
cursym := quoteIfString $currentToken
nextsym := quoteIfString $nextToken
- curline := lineCurrentSegment $spadLine
+ curline := lineCurrentSegment readerSourceLine rd
revisedline := strconc((tokenNonblank? $currentToken => '""; '" "),
cursym,(tokenNonblank? $nextToken => '""; '" "),nextsym,curline,'" ")
$nonblank := tokenNonblank? $currentToken
- lineNewLine!(revisedline,$spadLine,lineNumber $spadLine)
+ lineNewLine!(revisedline,readerSourceLine rd,lineNumber readerSourceLine rd)
$validTokens := 0
coreError '"How many tokens do you think you have?"
++ Returns length of X if X matches initial segment of IN-STREAM.
++ Otherwise, return nil.
-matchString x ==
- ungetTokens()
- skipBlankChars()
- not linePastEnd? $spadLine and currentChar() ~= nil =>
+matchString(rd,x) ==
+ ungetTokens rd
+ skipBlankChars rd
+ not linePastEnd? readerSourceLine rd and currentChar rd ~= nil =>
nx := #x
- buf := lineBuffer $spadLine
- idx := lineCurrentIndex $spadLine
+ buf := lineBuffer readerSourceLine rd
+ idx := lineCurrentIndex readerSourceLine rd
nx + idx > #buf => nil
and/[stringChar(x,i) = stringChar(buf,idx + i) for i in 0..nx-1] and nx
nil
++ Same as matchString except if successful, advance inputstream past `x'.
-matchAdvanceString x ==
- n := #x >= #quoteIfString currentToken() and matchString x =>
- lineCurrentIndex($spadLine) := lineCurrentIndex $spadLine + n
+matchAdvanceString(rd,x) ==
+ n := #x >= #quoteIfString currentToken rd and matchString(rd,x) =>
+ lineCurrentIndex(readerSourceLine rd) :=
+ lineCurrentIndex readerSourceLine rd + n
c :=
- linePastEnd? $spadLine => charByName '"Space"
- lineBuffer($spadLine).(lineCurrentIndex $spadLine)
- lineCurrentChar($spadLine) := c
+ linePastEnd? readerSourceLine rd => charByName '"Space"
+ lineBuffer(readerSourceLine rd).(lineCurrentIndex readerSourceLine rd)
+ lineCurrentChar(readerSourceLine rd) := c
$priorToken := makeToken(makeSymbol x,'IDENTIFIER,$nonblank)
n
nil
-matchAdvanceKeyword kwd ==
- matchToken(currentToken(),'KEYWORD,kwd) =>
- advanceToken()
+matchAdvanceKeyword(rd,kwd) ==
+ matchToken(currentToken rd,'KEYWORD,kwd) =>
+ advanceToken rd
true
false
-matchKeywordNext kwd ==
- matchToken(nextToken(),'KEYWORD,kwd)
+matchKeywordNext(rd,kwd) ==
+ matchToken(nextToken rd,'KEYWORD,kwd)
-matchSpecial c ==
- matchToken(currentToken(),'SPECIAL_-CHAR,c)
+matchSpecial(rd,c) ==
+ matchToken(currentToken rd,'SPECIAL_-CHAR,c)
-matchAdvanceSpecial c ==
- matchSpecial c =>
- advanceToken()
+matchAdvanceSpecial(rd,c) ==
+ matchSpecial(rd,c) =>
+ advanceToken rd
true
false
-matchAdvanceGlyph s ==
- matchToken(currentToken(),'GLIPH,s) =>
- advanceToken()
+matchAdvanceGlyph(rd,s) ==
+ matchToken(currentToken rd,'GLIPH,s) =>
+ advanceToken rd
true
false
@@ -590,8 +586,8 @@ nthStack n ==
--%
-ioClear!() ==
- lineClear! $spadLine
+ioClear! rd ==
+ lineClear! readerSourceLine rd
tokenStackClear!()
reduceStackClear()
$SPAD => nextLinesClear!()
diff --git a/src/interp/newaux.lisp b/src/interp/newaux.lisp
index c11a6760..182ec453 100644
--- a/src/interp/newaux.lisp
+++ b/src/interp/newaux.lisp
@@ -105,7 +105,7 @@
(\@ 996 997) (|pretend| 995 996)
(\.) (\! \! 1002 1001)
(\, 110 111)
- (\; 81 82 (|parseSemicolon|))
+ (\; 81 82 |parseSemicolon|)
(< 400 400) (> 400 400)
(<< 400 400) (>> 400 400)
(<= 400 400) (>= 400 400)
@@ -114,14 +114,14 @@
(|in| 400 400)
(|case| 400 400)
(|add| 400 120)
- (|with| 2000 400 (|parseInfixWith|))
+ (|with| 2000 400 |parseInfixWith|)
(|has| 400 400)
(|where| 121 104) ; must be 121 for SPAD, 126 for boot--> nboot
(|when| 112 190)
(|is| 400 400) (|isnt| 400 400)
(|and| 250 251) (|or| 200 201)
(/\\ 250 251) (\\/ 200 201)
- (\.\. SEGMENT 401 699 (|parseSegmentTail|))
+ (\.\. SEGMENT 401 699 |parseSegmentTail|)
(=> 123 103)
(+-> 998 121)
(== DEF 122 121)
@@ -130,39 +130,39 @@
(\:- 125 124) (\:= 125 124)))
(mapcar #'(LAMBDA (J) (MAKENEWOP J `|Nud|))
- '((|for| 130 350 (|parseLoop|))
- (|while| 130 190 (|parseLoop|))
- (|until| 130 190 (|parseLoop|))
- (|repeat| 130 190 (|parseLoop|))
- (|import| 120 0 (|parseImport|) )
- (|inline| 120 0 (|parseInline|) )
- (|forall| 998 999 (|parseScheme|))
- (|exist| 998 999 (|parseScheme|))
+ '((|for| 130 350 |parseLoop|)
+ (|while| 130 190 |parseLoop|)
+ (|until| 130 190 |parseLoop|)
+ (|repeat| 130 190 |parseLoop|)
+ (|import| 120 0 |parseImport|)
+ (|inline| 120 0 |parseInline|)
+ (|forall| 998 999 |parseScheme|)
+ (|exist| 998 999 |parseScheme|)
(|unless|)
(|add| 900 120)
- (|with| 1000 300 (|parseWith|))
+ (|with| 1000 300 |parseWith|)
(|has| 400 400)
(- 701 700) ; right-prec. wants to be -1 + left-prec
;; (\+ 701 700)
(\# 999 998)
(\! 1002 1001)
- (\' 999 999 (|parseData|))
+ (\' 999 999 |parseData|)
(-> 1001 1002)
(\: 194 195)
(|not| 260 259 NIL)
(~ 260 259 nil)
(= 400 700)
- (|return| 202 201 (|parseReturn|))
- (|try| 202 201 (|parseTry|))
- (|throw| 202 201 (|parseThrow|))
- (|leave| 202 201 (|parseLeave|))
- (|exit| 202 201 (|parseExit|))
- (|break| 202 201 (|parseJump|))
- (|iterate| 202 201 (|parseJump|))
+ (|return| 202 201 |parseReturn|)
+ (|try| 202 201 |parseTry|)
+ (|throw| 202 201 |parseThrow|)
+ (|leave| 202 201 |parseLeave|)
+ (|exit| 202 201 |parseExit|)
+ (|break| 202 201 |parseJump|)
+ (|iterate| 202 201 |parseJump|)
(|from|)
(|yield|)
- (|if| 130 0 (|parseConditional|)) ; was 130
- (|case| 130 190 (|parseMatch|))
+ (|if| 130 0 |parseConditional|) ; was 130
+ (|case| 130 190 |parseMatch|)
(\| 0 190)
(|suchthat|)
(|then| 0 114)
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot
index 506affd9..bab426f3 100644
--- a/src/interp/spad-parser.boot
+++ b/src/interp/spad-parser.boot
@@ -215,13 +215,13 @@ preparse rd ==
--%
-macro compulsorySyntax s ==
- s or SPAD__SYNTAX__ERROR()
+macro compulsorySyntax(rd,s) ==
+ s or SPAD__SYNTAX__ERROR rd
-repeatedSyntax(l,p) ==
+repeatedSyntax(rd,l,p) ==
n := stackSize $reduceStack
once := false
- while apply(p,nil) repeat
+ while apply(p,rd,nil) repeat
once := true
not once => nil
x := nil
@@ -232,51 +232,51 @@ repeatedSyntax(l,p) ==
--%
-parseToken tt ==
- tok := matchCurrentToken tt =>
+parseToken(rd,tt) ==
+ tok := matchCurrentToken(rd,tt) =>
pushReduction(makeSymbol strconc(symbolName tt,'"Token"),tokenSymbol tok)
- advanceToken()
+ advanceToken rd
true
false
-parseGlyph s ==
- matchCurrentToken('GLIPH,s) =>
- advanceToken()
+parseGlyph(rd,s) ==
+ matchCurrentToken(rd,'GLIPH,s) =>
+ advanceToken rd
true
false
-parseNBGlyph tok ==
- matchCurrentToken('GLIPH,tok) and $nonblank =>
- advanceToken()
+parseNBGlyph(rd,tok) ==
+ matchCurrentToken(rd,'GLIPH,tok) and $nonblank =>
+ advanceToken rd
true
false
-parseString() ==
- parseToken 'SPADSTRING
+parseString rd ==
+ parseToken(rd,'SPADSTRING)
-parseInteger() ==
- parseToken 'NUMBER
+parseInteger rd ==
+ parseToken(rd,'NUMBER)
-parseFloatBasePart() ==
- matchAdvanceGlyph "." =>
- $nonblank and (t := matchCurrentToken 'NUMBER) =>
+parseFloatBasePart rd ==
+ matchAdvanceGlyph(rd,".") =>
+ $nonblank and (t := matchCurrentToken(rd,'NUMBER)) =>
t := copyToken t
- advanceToken()
+ advanceToken rd
pushReduction('parseFloatBasePart,tokenNonblank? t)
pushReduction('parseFloatBasePart,tokenSymbol t)
pushReduction('parseFloatBasePart,0)
pushReduction('parseFloatBasePart,0)
nil
-parseFloatBase() ==
- integer? currentSymbol() and currentChar() = char "." and
- nextChar() ~= char "." and parseInteger() =>
- compulsorySyntax parseFloatBasePart()
- integer? currentSymbol() and charUpcase currentChar() = char "E"
- and parseInteger() =>
+parseFloatBase rd ==
+ integer? currentSymbol rd and currentChar rd = char "." and
+ nextChar rd ~= char "." and parseInteger rd =>
+ compulsorySyntax(rd,parseFloatBasePart rd)
+ integer? currentSymbol rd and charUpcase currentChar rd = char "E"
+ and parseInteger rd =>
pushReduction('parseBase,0)
pushReduction('parseBase,0)
- digit? currentChar() and currentSymbol() is "." =>
+ digit? currentChar rd and currentSymbol rd is "." =>
pushReduction('parseBase,0)
pushReduction('parseBase,0)
nil
@@ -290,201 +290,201 @@ floatExponent x ==
nil
nil
-parseFloatExponent() ==
- not ident? currentSymbol() => nil
- symbolMember?(currentSymbol(),'(e E)) and
- charMember?(currentChar(),[char "+",char "-"]) =>
- advanceToken()
- parseInteger() => true
- matchAdvanceGlyph "+" => compulsorySyntax parseInteger()
- matchAdvanceGlyph "-" =>
- compulsorySyntax parseInteger()
+parseFloatExponent rd ==
+ not ident? currentSymbol rd => nil
+ symbolMember?(currentSymbol rd,'(e E)) and
+ charMember?(currentChar rd,[char "+",char "-"]) =>
+ advanceToken rd
+ parseInteger rd => true
+ matchAdvanceGlyph(rd,"+") => compulsorySyntax(rd,parseInteger rd)
+ matchAdvanceGlyph(rd,"-") =>
+ compulsorySyntax(rd,parseInteger rd)
pushReduction('parseFloatExponent,-popStack1())
pushReduction('parseFloatExponent,0)
- g := floatExponent currentSymbol() =>
- advanceToken()
+ g := floatExponent currentSymbol rd =>
+ advanceToken rd
pushReduction('parseFloatExponent,g)
nil
-parseFloat() ==
- parseFloatBase() =>
- $nonblank and parseFloatExponent()
+parseFloat rd ==
+ parseFloatBase rd =>
+ $nonblank and parseFloatExponent rd
or pushReduction('parseFloat,0)
pushReduction('parseFloat,
MAKE_-FLOAT(popStack4(),popStack2(),popStack2(),popStack1()))
nil
-parseName() ==
- parseToken 'IDENTIFIER and pushReduction('parseName,popStack1())
+parseName rd ==
+ parseToken(rd,'IDENTIFIER) and pushReduction('parseName,popStack1())
-parseKeyword() ==
- parseToken 'KEYWORD and pushReduction('parseKeyword,popStack1())
+parseKeyword rd ==
+ parseToken(rd,'KEYWORD) and pushReduction('parseKeyword,popStack1())
-parseFormalParameter() ==
- parseToken 'ARGUMENT_-DESIGNATOR
+parseFormalParameter rd ==
+ parseToken(rd,'ARGUMENT_-DESIGNATOR)
-parseOperatorFunctionName() ==
- id := makeSymbolOf(matchCurrentToken 'KEYWORD
- or matchCurrentToken 'GLIPH
- or matchCurrentToken 'SPECIAL_-CHAR)
+parseOperatorFunctionName rd ==
+ id := makeSymbolOf(matchCurrentToken(rd,'KEYWORD)
+ or matchCurrentToken(rd,'GLIPH)
+ or matchCurrentToken(rd,'SPECIAL_-CHAR))
symbolMember?(id,$OperatorFunctionNames) =>
pushReduction('parseOperatorFunctionName,id)
- advanceToken()
+ advanceToken rd
true
false
-parseAnyId() ==
- parseName() => true
- parseKeyword() => true
- matchString '"$" =>
- pushReduction('parseAnyId,currentSymbol())
- advanceToken()
+parseAnyId rd ==
+ parseName rd => true
+ parseKeyword rd => true
+ matchString(rd,'"$") =>
+ pushReduction('parseAnyId,currentSymbol rd)
+ advanceToken rd
true
- parseOperatorFunctionName()
+ parseOperatorFunctionName rd
-parseQuad() ==
- matchAdvanceString '"$" and pushReduction('parseQuad,"$")
+parseQuad rd ==
+ matchAdvanceString(rd,'"$") and pushReduction('parseQuad,"$")
-parsePrimary1() ==
- parseName() =>
- $nonblank and currentSymbol() is "(" =>
- compulsorySyntax parsePrimary1()
+parsePrimary1 rd ==
+ parseName rd =>
+ $nonblank and currentSymbol rd is "(" =>
+ compulsorySyntax(rd,parsePrimary1 rd)
pushReduction('parsePrimary1,[popStack2(),popStack1()])
true
- parseQuad() or parseString() or parseInteger() or
- parseFormalParameter() => true
- matchSpecial char "'" =>
- compulsorySyntax parseData()
+ parseQuad rd or parseString rd or parseInteger rd or
+ parseFormalParameter rd => true
+ matchSpecial(rd,char "'") =>
+ compulsorySyntax(rd,parseData rd)
pushReduction('parsePrimary1,popStack1())
- parseSequence() or parseEnclosure()
+ parseSequence rd or parseEnclosure rd
-parsePrimaryNoFloat() ==
- parsePrimary1() =>
- parseTokenTail() or true
+parsePrimaryNoFloat rd ==
+ parsePrimary1 rd =>
+ parseTokenTail rd or true
false
-parsePrimary() ==
- parseFloat() or parsePrimaryNoFloat()
+parsePrimary rd ==
+ parseFloat rd or parsePrimaryNoFloat rd
-parsePrimaryOrQM() ==
- matchAdvanceString '"?" => pushReduction('parsePrimaryOrQM,"?")
- parsePrimary()
+parsePrimaryOrQM rd ==
+ matchAdvanceString(rd,'"?") => pushReduction('parsePrimaryOrQM,"?")
+ parsePrimary rd
-parseSpecialKeyWord() ==
- matchCurrentToken 'IDENTIFIER =>
- tokenSymbol(currentToken()) := unAbbreviateKeyword currentSymbol()
+parseSpecialKeyWord rd ==
+ matchCurrentToken(rd,'IDENTIFIER) =>
+ tokenSymbol(currentToken rd) := unAbbreviateKeyword currentSymbol rd
nil
-parseSexpr1() ==
- parseInteger() or parseString() or parseAnyId() => true
- matchAdvanceSpecial char "'" =>
- compulsorySyntax parseSexpr1()
+parseSexpr1 rd ==
+ parseInteger rd or parseString rd or parseAnyId rd => true
+ matchAdvanceSpecial(rd,char "'") =>
+ compulsorySyntax(rd,parseSexpr1 rd)
pushReduction('parseSexpr1,["QUOTE",popStack1()])
- matchAdvanceGlyph "[" =>
+ matchAdvanceGlyph(rd,"[") =>
stackUpdated?($reduceStack) := false
- repeatedSyntax('parseSexpr1,function PARSE_-Sexpr1)
+ repeatedSyntax(rd,'parseSexpr1,function PARSE_-Sexpr1)
if not stackUpdated? $reduceStack then
pushReduction('parseSexpr1,nil)
- compulsorySyntax matchAdvanceGlyph "]"
+ compulsorySyntax(rd,matchAdvanceGlyph(rd,"]"))
pushReduction('parseSexpr1,LIST2VEC popStack1())
- matchAdvanceGlyph "(" =>
+ matchAdvanceGlyph(rd,"(") =>
stackUpdated?($reduceStack) := false
- repeatedSyntax('parseSexpr1,function PARSE_-Sexpr1)
- if parseGlyph "." then
- compulsorySyntax parseSexpr1()
+ repeatedSyntax(rd,'parseSexpr1,function PARSE_-Sexpr1)
+ if parseGlyph(rd,".") then
+ compulsorySyntax(rd,parseSexpr1 rd)
pushReduction('parseSexpr1,append!(popStack2(),popStack1()))
if not stackUpdated? $reduceStack then
pushReduction('parseSexpr1,nil)
- compulsorySyntax matchAdvanceGlyph ")"
+ compulsorySyntax(rd,matchAdvanceGlyph(rd,")"))
nil
-parseSexpr() ==
- advanceToken()
- parseSexpr1()
+parseSexpr rd ==
+ advanceToken rd
+ parseSexpr1 rd
-parseData() ==
- parseSexpr() and pushReduction('parseData,["QUOTE",popStack1()])
+parseData rd ==
+ parseSexpr rd and pushReduction('parseData,["QUOTE",popStack1()])
-parseCommand() ==
- matchAdvanceString '")" => --FIXME: remove matchAdvanceString
- compulsorySyntax parseSpecialKeyWord()
- compulsorySyntax parseSpecialCommand()
+parseCommand rd ==
+ matchAdvanceString(rd,'")") => --FIXME: remove matchAdvanceString
+ compulsorySyntax(rd,parseSpecialKeyWord rd)
+ compulsorySyntax(rd,parseSpecialCommand rd)
pushReduction('parseStatement,nil)
nil
-parseTokenOption() ==
- matchAdvanceString '")" and compulsorySyntax PARSE_-TokenList()
+parseTokenOption rd ==
+ matchAdvanceString(rd,'")") and compulsorySyntax(rd,PARSE_-TokenList rd)
dollarTran(dom,x) ==
x is [.,:.] => [['elt,dom,first x],:rest x]
['elt,dom,x]
-parseQualification() ==
- matchAdvanceString '"$" =>
- compulsorySyntax parsePrimary1()
+parseQualification rd ==
+ matchAdvanceString(rd,'"$") =>
+ compulsorySyntax(rd,parsePrimary1 rd)
pushReduction('parseQualification,dollarTran(popStack1(),popStack1()))
nil
-parseTokenTail() ==
- currentSymbol() is "$" and
- (alphabetic? currentChar() or currentChar() = char "$"
- or currentChar() = char "%" or currentChar() = char "(") =>
+parseTokenTail rd ==
+ currentSymbol rd is "$" and
+ (alphabetic? currentChar rd or currentChar rd = char "$"
+ or currentChar rd = char "%" or currentChar rd = char "(") =>
tok := copyToken $priorToken
- parseQualification()
+ parseQualification rd
$priorToken := tok
nil
-parseSelector() ==
- $nonblank and currentSymbol() is "." and currentChar() ~= char " "
- and matchAdvanceGlyph "." =>
- compulsorySyntax parsePrimaryNoFloat()
+parseSelector rd ==
+ $nonblank and currentSymbol rd is "." and currentChar rd ~= char " "
+ and matchAdvanceGlyph(rd,".") =>
+ compulsorySyntax(rd,parsePrimaryNoFloat rd)
pushReduction('parseSelector,[popStack2(),popStack1()])
- parseFloat()
- or matchAdvanceGlyph "." and compulsorySyntax parsePrimary() =>
+ parseFloat rd
+ or matchAdvanceGlyph(rd,".") and compulsorySyntax(rd,parsePrimary rd) =>
pushReduction('parseSelector,[popStack2(),popStack1()])
nil
-parseApplication() ==
- parsePrimary() =>
- repeatedSyntax('selectors,function parseSelector)
- parseApplication() and
+parseApplication rd ==
+ parsePrimary rd =>
+ repeatedSyntax(rd,'selectors,function parseSelector)
+ parseApplication rd and
pushReduction('parseApplication,[popStack2(),popStack1()])
true
nil
-parseOperation($ParseMode,rbp) ==
- matchCurrentToken 'IDENTIFIER => nil
- s := currentSymbol()
+parseOperation(rd,$ParseMode,rbp) ==
+ matchCurrentToken(rd,'IDENTIFIER) => nil
+ s := currentSymbol rd
not symbol? s or property(s,$ParseMode) = nil => nil
rbp >= parseLeftBindingPowerOf(s,$ParseMode) => nil
- parseGetSemanticForm(s,$ParseMode,ELEMN(property(s,$ParseMode),5,nil))
+ parseGetSemanticForm(rd,s,$ParseMode,ELEMN(property(s,$ParseMode),5,nil))
-parseLedPart rbp ==
- parseOperation('Led,rbp) and
+parseLedPart(rd,rbp) ==
+ parseOperation(rd,'Led,rbp) and
pushReduction('parseLedPart,popStack1())
-parseNudPart rbp ==
- parseOperation('Nud,rbp) or parseReduction() or parseForm() =>
+parseNudPart(rd,rbp) ==
+ parseOperation(rd,'Nud,rbp) or parseReduction rd or parseForm rd =>
pushReduction('parseNudPart,popStack1())
-parseExpr rbp ==
- parseNudPart rbp =>
- repeatedSyntax('parseExpr,function(() +-> parseLedPart rbp))
+parseExpr(rd,rbp) ==
+ parseNudPart(rd,rbp) =>
+ repeatedSyntax(rd,'parseExpr,function(rd +-> parseLedPart(rd,rbp)))
pushReduction('parseExpr,popStack1())
nil
-parseInfix() ==
- pushReduction('parseInfix,currentSymbol())
- advanceToken()
- parseTokenTail()
- compulsorySyntax parseExpression()
+parseInfix rd ==
+ pushReduction('parseInfix,currentSymbol rd)
+ advanceToken rd
+ parseTokenTail rd
+ compulsorySyntax(rd,parseExpression rd)
pushReduction('parseInfix,[popStack2(),popStack2(),popStack1()])
-parsePrefix() ==
- pushReduction('parsePrefix,currentSymbol())
- advanceToken()
- parseTokenTail()
- compulsorySyntax parseExpression()
+parsePrefix rd ==
+ pushReduction('parsePrefix,currentSymbol rd)
+ advanceToken rd
+ parseTokenTail rd
+ compulsorySyntax(rd,parseExpression rd)
pushReduction('parsePrefix,[popStack2(),popStack1()])
parseLeftBindingPowerOf(x,p) ==
@@ -495,69 +495,72 @@ parseRightBindingPowerOf(x,p) ==
y := property(x,p) => ELEMN(y,4,105)
105
-parseGetSemanticForm(x,p,y) ==
- z := EVAL y => z -- FIXME get rid of EVAL.
- p = "Nud" => parsePrefix()
- p = "Led" => parseInfix()
+parseGetSemanticForm(rd,x,p,y) ==
+ z :=
+ ident? y => apply(y,rd,nil)
+ EVAL y -- FIXME get rid of EVAL.
+ z ~= nil => z
+ p = "Nud" => parsePrefix rd
+ p = "Led" => parseInfix rd
nil
-parseExpression() ==
- parseExpr parseRightBindingPowerOf(makeSymbolOf $priorToken,$ParseMode)
+parseExpression rd ==
+ parseExpr(rd,parseRightBindingPowerOf(makeSymbolOf $priorToken,$ParseMode))
and pushReduction('parseExpression,popStack1())
-parseSegmentTail() ==
- parseGlyph ".." =>
+parseSegmentTail rd ==
+ parseGlyph(rd,"..") =>
seg :=
- parseExpression() => ["SEGMENT",popStack2(),popStack1()]
+ parseExpression rd => ["SEGMENT",popStack2(),popStack1()]
["SEGMENT",popStack1()]
pushReduction('parseSegmentTail,seg)
nil
-parseReductionOp() ==
- s := currentSymbol()
+parseReductionOp rd ==
+ s := currentSymbol rd
if string? s then
s := makeSymbol s -- FIXME: abolish string-quoted operators
- ident? s and property(s,'Led) and matchNextToken('GLIPH,"/") =>
+ ident? s and property(s,'Led) and matchNextToken(rd,'GLIPH,"/") =>
pushReduction('parseReductionOp,s)
- advanceToken()
- advanceToken()
+ advanceToken rd
+ advanceToken rd
true
false
-parseReduction() ==
- parseReductionOp() =>
- compulsorySyntax parseExpr 1000
+parseReduction rd ==
+ parseReductionOp rd =>
+ compulsorySyntax(rd,parseExpr(rd,1000))
pushReduction('parseReduction,["%Reduce",popStack2(),popStack1()])
nil
-parseCategory() ==
- matchAdvanceKeyword "if" =>
- compulsorySyntax parseExpression()
- compulsorySyntax matchAdvanceKeyword "then"
- compulsorySyntax parseCategory()
+parseCategory rd ==
+ matchAdvanceKeyword(rd,"if") =>
+ compulsorySyntax(rd,parseExpression rd)
+ compulsorySyntax(rd,matchAdvanceKeyword(rd,"then"))
+ compulsorySyntax(rd,parseCategory rd)
stackUpdated?($reduceStack) := false
- matchAdvanceKeyword "else" and compulsorySyntax parseCategory()
+ matchAdvanceKeyword(rd,"else") and compulsorySyntax(rd,parseCategory rd)
if not stackUpdated? $reduceStack then
pushReduction('alternateCategory,nil)
pushReduction('parseCategory,["if",popStack3(),popStack2(),popStack1()])
- matchAdvanceGlyph "(" =>
- compulsorySyntax parseCategory()
+ matchAdvanceGlyph(rd,"(") =>
+ compulsorySyntax(rd,parseCategory rd)
stackUpdated?($reduceStack) := false
- repeatedSyntax('unnamedCategory,function(() +->
- matchAdvanceSpecial char ";" and compulsorySyntax parseCategory()))
+ repeatedSyntax(rd,'unnamedCategory,function( rd +->
+ matchAdvanceSpecial(rd,char ";") and compulsorySyntax(rd,parseCategory rd)))
if not stackUpdated? $reduceStack then
pushReduction('unnamedCategory,nil)
- compulsorySyntax matchAdvanceSpecial char ")"
+ compulsorySyntax(rd,matchAdvanceSpecial(rd,char ")"))
pushReduction('parseCategory,["CATEGORY",popStack2(),:popStack1()])
- matchAdvanceKeyword "assume" =>
- compulsorySyntax parseName()
- compulsorySyntax matchAdvanceGlyph "=="
- compulsorySyntax parseFormula()
+ matchAdvanceKeyword(rd,"assume") =>
+ compulsorySyntax(rd,parseName rd)
+ compulsorySyntax(rd,matchAdvanceGlyph(rd,"=="))
+ compulsorySyntax(rd,parseFormula rd)
pushReduction('assumption,['ATTRIBUTE,['%Rule,popStack2(),popStack1()]])
- g := lineNumber $spadLine
- parseApplication() or parseOperatorFunctionName() =>
- matchAdvanceGlyph ":" =>
- compulsorySyntax parseExpression()
+ g := lineNumber readerSourceLine rd
+ parseApplication rd or parseOperatorFunctionName rd =>
+ matchAdvanceGlyph(rd,":") =>
+ compulsorySyntax(rd,parseExpression rd)
pushReduction('parseCategory,["%Signature",popStack2(),popStack1()])
recordSignatureDocumentation(nthStack 1,g)
true
@@ -566,367 +569,367 @@ parseCategory() ==
true
nil
-parseWith() ==
- matchAdvanceKeyword "with" =>
- compulsorySyntax parseCategory()
+parseWith rd ==
+ matchAdvanceKeyword(rd,"with") =>
+ compulsorySyntax(rd,parseCategory rd)
pushReduction('parseWith,["with",popStack1()])
nil
-parseInfixWith() ==
- parseWith() and
+parseInfixWith rd ==
+ parseWith rd and
pushReduction('parseInfixWith,["Join",popStack2(),popStack1()])
-parseElseClause() ==
- currentSymbol() is "if" => parseConditional()
- parseExpression()
+parseElseClause rd ==
+ currentSymbol rd is "if" => parseConditional rd
+ parseExpression rd
-parseQuantifier() ==
- matchAdvanceKeyword "forall" =>
+parseQuantifier rd ==
+ matchAdvanceKeyword(rd,"forall") =>
pushReduction('parseQuantifier,'%Forall)
- matchAdvanceKeyword "exist" =>
+ matchAdvanceKeyword(rd,"exist") =>
pushReduction('parseQuantifier,'%Exist)
nil
-parseQuantifiedVariable() ==
- parseName() =>
- compulsorySyntax matchAdvanceGlyph ":"
- compulsorySyntax parseApplication()
+parseQuantifiedVariable rd ==
+ parseName rd =>
+ compulsorySyntax(rd,matchAdvanceGlyph(rd,":"))
+ compulsorySyntax(rd,parseApplication rd)
pushReduction('parseQuantifiedVariable,[":",popStack2(),popStack1()])
nil
-parseQuantifiedVariableList() ==
- matchAdvanceGlyph "(" =>
- compulsorySyntax parseQuantifiedVariable()
- repeatedSyntax('repeatedVars,function(() +->
- matchAdvanceSpecial char "," and parseQuantifiedVariable()))
+parseQuantifiedVariableList rd ==
+ matchAdvanceGlyph(rd,"(") =>
+ compulsorySyntax(rd,parseQuantifiedVariable rd)
+ repeatedSyntax(rd,'repeatedVars,function(rd +->
+ matchAdvanceSpecial(rd,char ",") and parseQuantifiedVariable rd))
and pushReduction('parseQuantifiedVariableList,
["%Sequence",popStack2(),:popStack1()])
- compulsorySyntax matchAdvanceSpecial char ")"
+ compulsorySyntax(rd,matchAdvanceSpecial(rd,char ")"))
nil
-parseFormula() ==
- parseQuantifier() =>
- compulsorySyntax parseQuantifiedVariableList()
- compulsorySyntax matchAdvanceGlyph "."
- compulsorySyntax parseExpression()
+parseFormula rd ==
+ parseQuantifier rd =>
+ compulsorySyntax(rd,parseQuantifiedVariableList rd)
+ compulsorySyntax(rd,matchAdvanceGlyph(rd,"."))
+ compulsorySyntax(rd,parseExpression rd)
pushReduction('parseFormula,[popStack3(),popStack2(),popStack1()])
- parseExpression()
+ parseExpression rd
++ quantified types. At the moment, these are used only in
++ pattern-mathing cases.
++ -- gdr, 2009-06-14.
-parseScheme() ==
- parseQuantifier() =>
- compulsorySyntax parseQuantifiedVariableList()
- compulsorySyntax matchAdvanceGlyph "."
- compulsorySyntax parseExpr 200
+parseScheme rd ==
+ parseQuantifier rd =>
+ compulsorySyntax(rd,parseQuantifiedVariableList rd)
+ compulsorySyntax(rd,matchAdvanceGlyph(rd,"."))
+ compulsorySyntax(rd,parseExpr(rd,200))
pushReduction('parseScheme,[popStack3(),popStack2(),popStack1()])
- parseApplication()
+ parseApplication rd
-parseConditional() ==
- matchAdvanceKeyword "if" =>
- compulsorySyntax parseExpression()
- compulsorySyntax matchAdvanceKeyword "then"
- compulsorySyntax parseExpression()
+parseConditional rd ==
+ matchAdvanceKeyword(rd,"if") =>
+ compulsorySyntax(rd,parseExpression rd)
+ compulsorySyntax(rd,matchAdvanceKeyword(rd,"then"))
+ compulsorySyntax(rd,parseExpression rd)
stackUpdated?($reduceStack) := false
- if matchAdvanceKeyword "else" then
- parseElseClause()
+ if matchAdvanceKeyword(rd,"else") then
+ parseElseClause rd
if not stackUpdated? $reduceStack then
pushReduction('elseBranch,nil)
pushReduction('parseConditional,["if",popStack3(),popStack2(),popStack1()])
nil
-parseSemicolon() ==
- matchAdvanceSpecial char ";" =>
- parseExpr 82 or pushReduction('parseSemicolon,"/throwAway")
+parseSemicolon rd ==
+ matchAdvanceSpecial(rd,char ";") =>
+ parseExpr(rd,82) or pushReduction('parseSemicolon,"/throwAway")
pushReduction('parseSemicolon,[";",popStack2(),popStack1()])
nil
++ We should factorize these boilerplates
-parseReturn() ==
- matchAdvanceKeyword "return" =>
- compulsorySyntax parseExpression()
+parseReturn rd ==
+ matchAdvanceKeyword(rd,"return") =>
+ compulsorySyntax(rd,parseExpression rd)
pushReduction('parseReturn,["return",popStack1()])
nil
-parseThrow() ==
- matchAdvanceKeyword "throw" =>
- compulsorySyntax parseExpression()
+parseThrow rd ==
+ matchAdvanceKeyword(rd,"throw") =>
+ compulsorySyntax(rd,parseExpression rd)
pushReduction('parseReturn,["%Throw",popStack1()])
nil
-parseExit() ==
- matchAdvanceKeyword "exit" =>
+parseExit rd ==
+ matchAdvanceKeyword(rd,"exit") =>
x :=
- parseExpression() => popStack1()
+ parseExpression rd => popStack1()
"$NoValue"
pushReduction('parseExit,["exit",x])
nil
-parseLeave() ==
- matchAdvanceKeyword "leave" =>
+parseLeave rd ==
+ matchAdvanceKeyword(rd,"leave") =>
x :=
- parseExpression() => popStack1()
+ parseExpression rd => popStack1()
"$NoValue"
pushReduction('parseLeave,["leave",x])
nil
-parseJump() ==
- s := currentSymbol() =>
- advanceToken()
+parseJump rd ==
+ s := currentSymbol rd =>
+ advanceToken rd
pushReduction('parseJump,s)
nil
-parseForm() ==
- matchAdvanceKeyword "iterate" =>
+parseForm rd ==
+ matchAdvanceKeyword(rd,"iterate") =>
pushReduction('parseForm,["iterate"])
- matchAdvanceKeyword "yield" =>
- compulsorySyntax parseApplication()
+ matchAdvanceKeyword(rd,"yield") =>
+ compulsorySyntax(rd,parseApplication rd)
pushReduction('parseForm,["yield",popStack1()])
- parseApplication()
+ parseApplication rd
-parseVariable() ==
- parseName() =>
- matchAdvanceGlyph ":" =>
- compulsorySyntax parseApplication()
+parseVariable rd ==
+ parseName rd =>
+ matchAdvanceGlyph(rd,":") =>
+ compulsorySyntax(rd,parseApplication rd)
pushReduction('parseVariable,[":",popStack2(),popStack1()])
true
- parsePrimary()
-
-parseIterator() ==
- matchAdvanceKeyword "for" =>
- compulsorySyntax parseVariable()
- compulsorySyntax matchAdvanceKeyword "in"
- compulsorySyntax parseExpression()
- matchAdvanceKeyword "by" and compulsorySyntax parseExpr 200 and
+ parsePrimary rd
+
+parseIterator rd ==
+ matchAdvanceKeyword(rd,"for") =>
+ compulsorySyntax(rd,parseVariable rd)
+ compulsorySyntax(rd,matchAdvanceKeyword(rd,"in"))
+ compulsorySyntax(rd,parseExpression rd)
+ matchAdvanceKeyword(rd,"by") and compulsorySyntax(rd,parseExpr(rd,200)) and
pushReduction('parseIterator,["INBY",popStack3(),popStack2(),popStack1()])
or pushReduction('parseIterator,["IN",popStack2(),popStack1()])
- matchAdvanceGlyph "|" and compulsorySyntax parseExpr 111 and
+ matchAdvanceGlyph(rd,"|") and compulsorySyntax(rd,parseExpr(rd,111)) and
pushReduction('parseIterator,["|",popStack1()])
true
- matchAdvanceKeyword "while" =>
- compulsorySyntax parseExpr 190
+ matchAdvanceKeyword(rd,"while") =>
+ compulsorySyntax(rd,parseExpr(rd,190))
pushReduction('parseIterator,["WHILE",popStack1()])
- matchAdvanceKeyword "until" =>
- compulsorySyntax parseExpr 190
+ matchAdvanceKeyword(rd,"until") =>
+ compulsorySyntax(rd,parseExpr(rd,190))
pushReduction('parseIterator,["UNTIL",popStack1()])
nil
-parseIteratorTails() ==
- matchAdvanceKeyword "repeat" =>
+parseIteratorTails rd ==
+ matchAdvanceKeyword(rd,"repeat") =>
stackUpdated?($reduceStack) := false
- repeatedSyntax('parseIteratorTails,function parseIterator)
+ repeatedSyntax(rd,'parseIteratorTails,function parseIterator)
if not stackUpdated? $reduceStack then
pushReduction('crossIterators,nil)
- repeatedSyntax('parseIteratorTails,function parseIterator)
+ repeatedSyntax(rd,'parseIteratorTails,function parseIterator)
-parseLoop() ==
- repeatedSyntax('iterators,function parseIterator) =>
- compulsorySyntax matchAdvanceKeyword "repeat"
- compulsorySyntax parseExpr 110
+parseLoop rd ==
+ repeatedSyntax(rd,'iterators,function parseIterator) =>
+ compulsorySyntax(rd,matchAdvanceKeyword(rd,"repeat"))
+ compulsorySyntax(rd,parseExpr(rd,110))
pushReduction('parseLoop,["REPEAT",:popStack2(),popStack1()])
- matchAdvanceKeyword "repeat" =>
- compulsorySyntax parseExpr 110
+ matchAdvanceKeyword(rd,"repeat") =>
+ compulsorySyntax(rd,parseExpr(rd,110))
pushReduction('parseLoop,["REPEAT",popStack1()])
nil
-parseOpenBracket() ==
- s := currentSymbol()
+parseOpenBracket rd ==
+ s := currentSymbol rd
s is "[" or s is ["elt",.,"["] =>
do
s is ["elt",:.] =>
pushReduction('parseOpenBracket,["elt",second s,"construct"])
pushReduction('parseOpenBracket,"construct")
- advanceToken()
+ advanceToken rd
true
false
-parseOpenBrace() ==
- s := currentSymbol()
+parseOpenBrace rd ==
+ s := currentSymbol rd
s is "{" or s is ["elt",.,"{"] =>
do
s is ["elt",:.] =>
pushReduction('parseOpenBracket,["elt",second s,"brace"])
pushReduction('parseOpenBracket,"construct") --FIXME: should be brace
- advanceToken()
+ advanceToken rd
true
false
-parseSequence1() ==
+parseSequence1 rd ==
do
- parseExpression() =>
+ parseExpression rd =>
pushReduction('parseSequence1,[popStack2(),popStack1()])
pushReduction('parseSequence1,[popStack1()])
- parseIteratorTails() and
+ parseIteratorTails rd and
pushReduction('parseSequence1,["COLLECT",:popStack1(),popStack1()])
true
-parseSequence() ==
- parseOpenBracket() =>
- compulsorySyntax parseSequence1()
- compulsorySyntax matchAdvanceSpecial char "]"
- parseOpenBrace() =>
- compulsorySyntax parseSequence1()
- compulsorySyntax matchAdvanceSpecial char "}"
+parseSequence rd ==
+ parseOpenBracket rd =>
+ compulsorySyntax(rd,parseSequence1 rd)
+ compulsorySyntax(rd,matchAdvanceSpecial(rd,char "]"))
+ parseOpenBrace rd =>
+ compulsorySyntax(rd,parseSequence1 rd)
+ compulsorySyntax(rd,matchAdvanceSpecial(rd,char "}"))
pushReduction('parseSequence,["brace",popStack1()])
nil
-parseEnclosure() ==
- matchAdvanceGlyph "(" =>
- parseExpr 6 =>
- compulsorySyntax matchAdvanceSpecial char ")"
- matchAdvanceSpecial char ")" =>
+parseEnclosure rd ==
+ matchAdvanceGlyph(rd,"(") =>
+ parseExpr(rd,6) =>
+ compulsorySyntax(rd,matchAdvanceSpecial(rd,char ")"))
+ matchAdvanceSpecial(rd,char ")") =>
pushReduction('parseEnclosure,["%Comma"])
- SPAD__SYNTAX__ERROR()
- matchAdvanceGlyph "{" =>
- parseExpr 6 =>
- compulsorySyntax matchAdvanceSpecial char "}"
+ SPAD__SYNTAX__ERROR rd
+ matchAdvanceGlyph(rd,"{") =>
+ parseExpr(rd,6) =>
+ compulsorySyntax(rd,matchAdvanceSpecial(rd,char "}"))
pushReduction('parseEnclosure,["brace",["construct",popStack1()]])
- matchAdvanceSpecial char "}" =>
+ matchAdvanceSpecial(rd,char "}") =>
pushReduction('parseEnclosure,["brace"])
- SPAD__SYNTAX__ERROR()
- matchAdvanceGlyph "[|" =>
- parseStatement() =>
- compulsorySyntax matchAdvanceGlyph "|]"
+ SPAD__SYNTAX__ERROR rd
+ matchAdvanceGlyph(rd,"[|") =>
+ parseStatement rd =>
+ compulsorySyntax(rd,matchAdvanceGlyph(rd,"|]"))
pushReduction('parseEnclosure,["[||]",popStack1()])
- SPAD__SYNTAX__ERROR()
+ SPAD__SYNTAX__ERROR rd
nil
-parseCatch() ==
- matchSpecial char ";" and matchKeywordNext "catch" =>
- advanceToken()
- advanceToken()
- compulsorySyntax parseGlyph "("
- compulsorySyntax parseQuantifiedVariable()
- compulsorySyntax matchAdvanceSpecial char ")"
- compulsorySyntax parseGlyph "=>"
- compulsorySyntax parseExpression()
+parseCatch rd ==
+ matchSpecial(rd,char ";") and matchKeywordNext(rd,"catch") =>
+ advanceToken rd
+ advanceToken rd
+ compulsorySyntax(rd,parseGlyph(rd,"("))
+ compulsorySyntax(rd,parseQuantifiedVariable rd)
+ compulsorySyntax(rd,matchAdvanceSpecial(rd,char ")"))
+ compulsorySyntax(rd,parseGlyph(rd,"=>"))
+ compulsorySyntax(rd,parseExpression rd)
pushReduction('parseCatch,[popStack2(),popStack1()])
nil
-parseFinally() ==
- matchSpecial char ";" and matchKeywordNext "finally" =>
- advanceToken()
- advanceToken()
- compulsorySyntax parseExpression()
+parseFinally rd ==
+ matchSpecial(rd,char ";") and matchKeywordNext(rd,"finally") =>
+ advanceToken rd
+ advanceToken rd
+ compulsorySyntax(rd,parseExpression rd)
nil
-parseTry() ==
- matchAdvanceKeyword "try" =>
- compulsorySyntax parseExpression()
+parseTry rd ==
+ matchAdvanceKeyword(rd,"try") =>
+ compulsorySyntax(rd,parseExpression rd)
-- exception handlers: either a finally-expression, or
-- a series of catch-expressions optionally followed by
-- a finally-expression.
- parseFinally() =>
+ parseFinally rd =>
pushReduction('parseTry,["%Try",popStack2(),nil,popStack1()])
- compulsorySyntax repeatedSyntax('handlers,function parseCatch) =>
+ compulsorySyntax(rd,repeatedSyntax(rd,'handlers,function parseCatch)) =>
stackUpdated?($reduceStack) := false
- parseFinally()
+ parseFinally rd
if not stackUpdated? $reduceStack then
pushReduction('finalizer,nil)
pushReduction('parseTry,["%Try",popStack3(),popStack2(),popStack1()])
- SPAD__SYNTAX__ERROR()
+ SPAD__SYNTAX__ERROR rd
nil
-parseMatch() ==
- matchAdvanceKeyword "case" =>
- compulsorySyntax parseExpr 400
- compulsorySyntax matchAdvanceKeyword "is"
- compulsorySyntax parseExpr 110
+parseMatch rd ==
+ matchAdvanceKeyword(rd,"case") =>
+ compulsorySyntax(rd,parseExpr(rd,400))
+ compulsorySyntax(rd,matchAdvanceKeyword(rd,"is"))
+ compulsorySyntax(rd,parseExpr(rd,110))
pushReduction('parseMatch,["%Match",popStack2(),popStack1()])
nil
++ domain inlining. Same syntax as import directive; except
++ deliberate restriction on naming one type at a time.
++ -- gdr, 2009-02-28.
-parseInline() ==
- matchAdvanceKeyword "inline" =>
- compulsorySyntax parseExpr 1000
+parseInline rd ==
+ matchAdvanceKeyword(rd,"inline") =>
+ compulsorySyntax(rd,parseExpr(rd,1000))
pushReduction('parseInline,["%Inline",popStack1()])
nil
-parseImport() ==
- matchAdvanceKeyword "import" =>
- compulsorySyntax parseExpr 1000
- matchAdvanceGlyph ":" =>
- compulsorySyntax parseExpression()
- compulsorySyntax matchAdvanceKeyword "from"
- compulsorySyntax parseExpr 1000
+parseImport rd ==
+ matchAdvanceKeyword(rd,"import") =>
+ compulsorySyntax(rd,parseExpr(rd,1000))
+ matchAdvanceGlyph(rd,":") =>
+ compulsorySyntax(rd,parseExpression rd)
+ compulsorySyntax(rd,matchAdvanceKeyword(rd,"from"))
+ compulsorySyntax(rd,parseExpr(rd,1000))
pushReduction('parseImport,
["%SignatureImport",popStack3(),popStack2(),popStack1()])
stackUpdated?($reduceStack) := false
- repeatedSyntax('imports,function(() +-> matchAdvanceSpecial char ","
- and compulsorySyntax parseExpr 1000))
+ repeatedSyntax(rd,'imports,function(rd +-> matchAdvanceSpecial(rd,char ",")
+ and compulsorySyntax(rd,parseExpr(rd,1000))))
if not stackUpdated? $reduceStack then
pushReduction('imports,nil)
pushReduction('parseImport,["import",popStack2(),:popStack1()])
nil
-parseStatement() ==
- parseExpr 0 =>
- repeatedSyntax('statements,function(() +-> matchAdvanceGlyph ","
- and compulsorySyntax parseExpr 0)) =>
+parseStatement rd ==
+ parseExpr(rd,0) =>
+ repeatedSyntax(rd,'statements,function(rd +-> matchAdvanceGlyph(rd,",")
+ and compulsorySyntax(rd,parseExpr(rd,0)))) =>
pushReduction('parseStatement,["Series",popStack2(),:popStack1()])
true
false
-parseNewExpr() ==
- matchString '")" =>
+parseNewExpr rd ==
+ matchString(rd,'")") =>
processSynonyms()
- compulsorySyntax parseCommand()
- SETQ(DEFINITION__NAME,currentSymbol())
- parseStatement()
+ compulsorySyntax(rd,parseCommand rd)
+ SETQ(DEFINITION__NAME,currentSymbol rd)
+ parseStatement rd
--%
-isTokenDelimiter() ==
- symbolMember?(currentSymbol(),[")","END__UNIT","NIL"])
+isTokenDelimiter rd ==
+ symbolMember?(currentSymbol rd,[")","END__UNIT","NIL"])
-parseTokenList() ==
- repeatedSyntax('tokenList,function(() +->
- (isTokenDelimiter() => nil; pushReduction('parseTokenList,currentSymbol());
- advanceToken(); true)))
+parseTokenList rd ==
+ repeatedSyntax(rd,'tokenList,function(rd +->
+ (isTokenDelimiter rd => nil; pushReduction('parseTokenList,currentSymbol rd);
+ advanceToken rd; true)))
-parseCommandTail() ==
+parseCommandTail rd ==
stackUpdated?($reduceStack) := false
- repeatedSyntax('options,function parseTokenOption)
+ repeatedSyntax(rd,'options,function parseTokenOption)
if not stackUpdated? $reduceStack then
pushReduction('options,nil)
- atEndOfLine() and
+ atEndOfLine rd and
pushReduction('parseCommandTail,[popStack2(),:popStack1()])
systemCommand popStack1()
true
-parseOption() ==
- matchAdvanceString '")" => --FIXME: kill matchAdvanceString
- compulsorySyntax repeatedSyntax('options,function parsePrimaryOrQM)
+parseOption rd ==
+ matchAdvanceString(rd,'")") => --FIXME: kill matchAdvanceString
+ compulsorySyntax(rd,repeatedSyntax(rd,'options,function parsePrimaryOrQM))
-parseTokenCommandTail() ==
+parseTokenCommandTail rd ==
stackUpdated?($reduceStack) := false
- repeatedSyntax('options,function parseOption)
+ repeatedSyntax(rd,'options,function parseOption)
if not stackUpdated? $reduceStack then
pushReduction('options,nil)
- atEndOfLine() and
+ atEndOfLine rd and
pushReduction('parseCommandTail,[popStack2(),:popStack1()])
systemCommand popStack1()
true
-parseSpecialCommand() ==
- matchAdvanceString '"show" => --FIXME: kill matchAdvanceString
+parseSpecialCommand rd ==
+ matchAdvanceString(rd,'"show") => --FIXME: kill matchAdvanceString
stackUpdated?($reduceStack) := true
- repeatedSyntax('commands,function(() +-> matchAdvanceString '"?"
- or parseExpression()))
+ repeatedSyntax(rd,'commands,function(rd +-> matchAdvanceString(rd,'"?")
+ or parseExpression rd))
if not stackUpdated? $reduceStack then
pushReduction('commdnds,nil)
pushReduction('parseSpecialCommand,["show",popStack1()])
- compulsorySyntax parseCommandTail()
- symbolMember?(currentSymbol(),$noParseCommands) =>
- apply(currentSymbol(),nil)
+ compulsorySyntax(rd,parseCommandTail rd)
+ symbolMember?(currentSymbol rd,$noParseCommands) =>
+ apply(currentSymbol rd,nil)
true
- symbolMember?(currentSymbol(),$tokenCommands) and parseTokenList() =>
- compulsorySyntax parseTokenCommandTail()
- repeatedSyntax('parseSpecialCommand,function parsePrimaryOrQM) and
- compulsorySyntax parseCommandTail()
+ symbolMember?(currentSymbol rd,$tokenCommands) and parseTokenList rd =>
+ compulsorySyntax(rd,parseTokenCommandTail rd)
+ repeatedSyntax(rd,'parseSpecialCommand,function parsePrimaryOrQM) and
+ compulsorySyntax(rd,parseCommandTail rd)
--%
@@ -972,11 +975,11 @@ parseSpadFile sourceFile ==
-- Spad because few parse forms have slightly different representations
-- depending on whether we are interpreter mode or compiler mode.
$InteractiveMode: local := false
- INIT_-BOOT_/SPAD_-READER()
-- we need to restore the global input stream state after we
-- finished messing with it.
IN_-STREAM: local := MAKE_-INSTREAM sourceFile
rd := makeReader IN_-STREAM
+ INIT_-BOOT_/SPAD_-READER rd
-- If soureFile cannot be processed for whatever reasons
-- get out of here instead of being stuck later.
@@ -989,12 +992,12 @@ parseSpadFile sourceFile ==
$lineStack: local := preparse rd
$lineStack = nil => leave nil -- explicit end of input
LINE: local := CDAR $lineStack
- CATCH($SpadReaderTag,parseNewExpr())
+ CATCH($SpadReaderTag,parseNewExpr rd)
asts := [parseTransform postTransform popStack1(), :asts]
-- we accumulated the parse trees in reverse order
reverse! asts
finally -- clean up the mess, and get out of here
- ioClear!()
+ ioClear! rd
SHUT readerInput rd
--%
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index e0ccf4be..13e21e27 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -58,11 +58,11 @@
(defvar MARG 0 "Margin for testing by ?OP")
(defvar |uc| 'UC)
-(defun init-boot/spad-reader ()
+(defun init-boot/spad-reader (rd)
(setq $SPAD_ERRORS (VECTOR 0 0 0))
(setq SPADERRORSTREAM |$OutputStream|)
(|nextLinesClear!|)
- (|ioClear!|))
+ (|ioClear!| rd))
(defun spad (ifile
&aux
@@ -83,11 +83,11 @@
`((FLUID . |true|)
(|special| . ,(COPY-TREE |$InitialDomainsInScope|)))
(|addBinding| '|$Information| NIL (|makeInitialModemapFrame|)))))
- (init-boot/spad-reader)
(unwind-protect
(progn
(setq in-stream (open ifile :direction :input))
(setq rd (|makeReader| in-stream))
+ (init-boot/spad-reader rd)
(initialize-preparse rd)
(setq out-stream |$OutputStream|)
(loop
@@ -100,14 +100,14 @@
(when |$lineStack|
(let ((LINE (cdar |$lineStack|)))
(declare (special LINE))
- (|parseNewExpr|)
+ (|parseNewExpr| rd)
(let ((parseout (|popStack1|)) )
(when parseout
(let ((|$OutputStream| out-stream))
(|translateSpad| parseout))
(format out-stream "~&")))
))))
- (|ioClear!|)))
+ (|ioClear!| rd)))
(shut in-stream))
T))
diff --git a/src/interp/util.lisp b/src/interp/util.lisp
index 7f74ed54..9429a13e 100644
--- a/src/interp/util.lisp
+++ b/src/interp/util.lisp
@@ -260,19 +260,6 @@
(|closeAllDatabaseStreams|)
)
-
-(DEFUN |string2SpadTree| (LINE)
- (DECLARE (SPECIAL LINE))
- (if (and (> (LENGTH LINE) 0) (EQ (CHAR LINE 0) #\) ))
- (|processSynonyms|))
- (|ioClear!|)
- (LET* ((|$lineStack| (LIST (CONS 1 LINE)))
- ($SPAD T)
- (PARSEOUT (PROG2 (|parseNewExpr|) (|popStack1|))))
- (DECLARE (SPECIAL |$lineStack| $SPAD))
- PARSEOUT))
-
-
;; the following are for conditional reading
#+:ieee-floating-point (defparameter $ieee t)
#-:ieee-floating-point (defparameter $ieee nil)