diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/debug.lisp | 6 | ||||
| -rw-r--r-- | src/interp/io.boot | 5 | ||||
| -rw-r--r-- | src/interp/lexing.boot | 258 | ||||
| -rw-r--r-- | src/interp/newaux.lisp | 44 | ||||
| -rw-r--r-- | src/interp/spad-parser.boot | 757 | ||||
| -rw-r--r-- | src/interp/spad.lisp | 10 | ||||
| -rw-r--r-- | src/interp/util.lisp | 13 |
7 files changed, 540 insertions, 553 deletions
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) |