diff options
author | dos-reis <gdr@axiomatics.org> | 2011-10-17 14:41:00 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2011-10-17 14:41:00 +0000 |
commit | 16111656afaa94a382d61de6c3ec37a9bdca05ef (patch) | |
tree | 50b54aa78118b0e723246f6acc034da705f53d35 /src/interp/spad-parser.boot | |
parent | f699415cce3f73d0f2b63ecb3b1fdc7084ba4cea (diff) | |
download | open-axiom-16111656afaa94a382d61de6c3ec37a9bdca05ef.tar.gz |
* lisp/core.lisp.in: Add ref and deref to support references.
* interp/sys-constants.boot ($OperatorFunctionNames): Add "by" and
"..".
* interp/spad.lisp: Tidy.
* interp/spad-parser.boot: New parsers.
* interp/preparse.lisp: Remove dead codes.
* interp/parsing.lisp (MATCH-ADVANCE-KEYWORD): Remove.
* interp/parse.boot (doParseCategory): Rename from parseCategory.
* interp/newaux.lisp: Tidy.
* interp/lexing.boot (getSpadToken): New.
(Keywords): Remove 'when'.
(matchKeywordNext): New.
(matchSpecial): Likewise.
(matchAdvanceSpecial): Likewise.
(matchAdvanceGlyph): Likewise.
* interp/fnewmeta.lisp: Move variable definitions to preparse.lisp.
Remove Lisp based parsers.
Remove file.
* interp/c-doc.boot (recordAttributeDocumentation): Fix thinko.
* interp/bootlex.lisp (GET-BOOT-TOKEN): Remove.
* interp/Makefile.in: Adjust dependencies.
* boot/parser.boot (bpChar): New.
(bpPattern): Allow character constants.
Diffstat (limited to 'src/interp/spad-parser.boot')
-rw-r--r-- | src/interp/spad-parser.boot | 604 |
1 files changed, 578 insertions, 26 deletions
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot index a7780674..43e04256 100644 --- a/src/interp/spad-parser.boot +++ b/src/interp/spad-parser.boot @@ -42,15 +42,26 @@ -- -- gdr/2007-11-02 -- -import parsing +import preparse import parse -import fnewmeta namespace BOOT --% macro compulsorySyntax s == s or SPAD__SYNTAX__ERROR() +repeatedSyntax(l,p) == + n := stackSize $reduceStack + once := false + while apply(p,nil) repeat + once := true + not once => nil + x := nil + for i in (n+1)..stackSize $reduceStack repeat + x := [popStack1(),:x] + x = nil => true + pushReduction(l,x) + --% parseToken tt == @@ -60,14 +71,77 @@ parseToken tt == true false +parseGlyph s == + matchCurrentToken('GLIPH,s) => + advanceToken() + true + false + +parseNBGlyph tok == + matchCurrentToken('GLIPH,tok) and $nonblank => + advanceToken() + true + false + parseString() == parseToken 'SPADSTRING parseInteger() == parseToken 'NUMBER +parseFloatBasePart() == + matchAdvanceGlyph "." => + $nonblank and (t := matchCurrentToken 'NUMBER) => + t := copyToken t + advanceToken() + 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() => + pushReduction('parseBase,0) + pushReduction('parseBase,0) + digit? currentChar() and currentSymbol() is "." => + pushReduction('parseBase,0) + pushReduction('parseBase,0) + nil + +parseFloatExponent() == + not ident? currentSymbol() => nil + symbolMember?(currentSymbol(),'(e E)) and + charMember?(currentChar(),[char "+",char "-"]) => + advanceToken() + parseInteger() => true + matchAdvanceGlyph "+" => compulsorySyntax parseInteger() + matchAdvanceGlyph "-" => + compulsorySyntax parseInteger() + pushReduction('parseFloatExponent,-popStack1()) + pushReduction('parseFloatExponent,0) + g := FLOATEXPID currentSymbol() => + advanceToken() + pushReduction('parseFloatExponent,g) + nil + +parseFloat() == + parseFloatBase() => + $nonblank and parseFloatExponent() + or pushReduction('parseFloat,0) + pushReduction('parseFloat, + MAKE_-FLOAT(popStack4(),popStack2(),popStack2(),popStack1())) + nil + parseName() == parseToken 'IDENTIFIER and pushReduction('parseName,popStack1()) + +parseKeyword() == + parseToken 'KEYWORD and pushReduction('parseKeyword,popStack1()) parseFormalParameter() == parseToken 'ARGUMENT_-DESIGNATOR @@ -84,6 +158,7 @@ parseOperatorFunctionName() == parseAnyId() == parseName() => true + parseKeyword() => true matchString '"$" => pushReduction('parseAnyId,currentSymbol()) advanceToken() @@ -93,8 +168,26 @@ parseAnyId() == parseQuad() == matchAdvanceString '"$" and pushReduction('parseQuad,"$") +parsePrimary1() == + parseName() => + $nonblank and currentSymbol() is "(" => + compulsorySyntax parsePrimary1() + pushReduction('parsePrimary1,[popStack2(),popStack1()]) + true + parseQuad() or parseString() or parseInteger() or + parseFormalParameter() => true + matchSpecial char "'" => + compulsorySyntax parseData() + pushReduction('parsePrimary1,popStack1()) + parseSequence() or parseEnclosure() + +parsePrimaryNoFloat() == + parsePrimary1() => + parseTokenTail() or true + false + parsePrimary() == - PARSE_-Float() or PARSE_-PrimaryNoFloat() + parseFloat() or parsePrimaryNoFloat() parsePrimaryOrQM() == matchAdvanceString '"?" => pushReduction('parsePrimaryOrQM,"?") @@ -105,8 +198,46 @@ parseSpecialKeyWord() == tokenSymbol(currentToken()) := unAbbreviateKeyword currentSymbol() nil +parseSexpr1() == + parseInteger() or parseString() => true + parseAnyId() => + parseNBGlyph "=" => + compulsorySyntax parseSexpr1() + SETQ(LABLASOC,[[popStack2(),:nthStack 1],:LABLASOC]) + true + true + matchAdvanceSpecial char "'" => + compulsorySyntax parseSexpr1() + pushReduction('parseSexpr1,["QUOTE",popStack1()]) + matchAdvanceGlyph "[" => + stackUpdated?($reduceStack) := false + repeatedSyntax('parseSexpr1,function PARSE_-Sexpr1) + if not stackUpdated? $reduceStack then + pushReduction('parseSexpr1,nil) + compulsorySyntax matchAdvanceGlyph "]" + pushReduction('parseSexpr1,LIST2VEC popStack1()) + matchAdvanceGlyph "(" => + stackUpdated?($reduceStack) := false + repeatedSyntax('parseSexpr1,function PARSE_-Sexpr1) + if parseGlyph "." then + compulsorySyntax parseSexpr1() + pushReduction('parseSexpr1,append!(popStack2(),popStack1())) + if not stackUpdated? $reduceStack then + pushReduction('parseSexpr1,nil) + compulsorySyntax matchAdvanceGlyph ")" + nil + +parseSexpr() == + advanceToken() + parseSexpr1() + +parseData() == + SETQ(LABLASOC,nil) + parseSexpr() and + pushReduction('parseData,["QUOTE",TRANSLABEL(popStack1(),LABLASOC)]) + parseCommand() == - matchAdvanceString '")" => + matchAdvanceString '")" => --FIXME: remove matchAdvanceString compulsorySyntax parseSpecialKeyWord() compulsorySyntax parseSpecialCommand() pushReduction('parseStatement,nil) @@ -117,7 +248,7 @@ parseTokenOption() == parseQualification() == matchAdvanceString '"$" => - compulsorySyntax PARSE_-Primary1() + compulsorySyntax parsePrimary1() pushReduction('parseQualification,dollarTran(popStack1(),popStack1())) nil @@ -130,23 +261,137 @@ parseTokenTail() == $priorToken := tok nil +parseSelector() == + $nonblank and currentSymbol() is "." and currentChar() ~= char " " + and matchAdvanceGlyph "." => + compulsorySyntax parsePrimaryNoFloat() + pushReduction('parseSelector,[popStack2(),popStack1()]) + parseFloat() + or matchAdvanceGlyph "." and compulsorySyntax parsePrimary() => + pushReduction('parseSelector,[popStack2(),popStack1()]) + nil + +parseApplication() == + parsePrimary() => + repeatedSyntax('selectors,function parseSelector) + parseApplication() and + pushReduction('parseApplication,[popStack2(),popStack1()]) + true + nil + +parseOperation($ParseMode,rbp) == + matchCurrentToken 'IDENTIFIER => nil + s := currentSymbol() + not symbol? s or property(s,$ParseMode) = nil => nil + rbp >= parseLeftBindingPowerOf(s,$ParseMode) => nil + parseGetSemanticForm(s,$ParseMode,ELEMN(property(s,$ParseMode),5,nil)) + +parseLedPart rbp == + parseOperation('Led,rbp) and + pushReduction('parseLedPart,popStack1()) + +parseNudPart rbp == + parseOperation('Nud,rbp) or parseReduction() or parseForm() => + pushReduction('parseNudPart,popStack1()) + +parseExpr rbp == + parseNudPart rbp => + repeatedSyntax('parseExpr,function(() +-> parseLedPart rbp)) + pushReduction('parseExpr,popStack1()) + nil + parseInfix() == pushReduction('parseInfix,currentSymbol()) advanceToken() parseTokenTail() - compulsorySyntax PARSE_-Expression() + compulsorySyntax parseExpression() pushReduction('parseInfix,[popStack2(),popStack2(),popStack1()]) parsePrefix() == pushReduction('parsePrefix,currentSymbol()) advanceToken() parseTokenTail() - compulsorySyntax PARSE_-Expression() + compulsorySyntax parseExpression() pushReduction('parsePrefix,[popStack2(),popStack1()]) +parseLeftBindingPowerOf(x,p) == + y := property(x,p) => ELEMN(y,3,0) + 0 + +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() + nil + +parseExpression() == + parseExpr parseRightBindingPowerOf(makeSymbolOf $priorToken,$ParseMode) + and pushReduction('parseExpression,popStack1()) + +parseSegmentTail() == + parseGlyph ".." => + stackUpdated?($reduceStack) := false + parseExpression() + if not stackUpdated? $reduceStack then + pushReduction('segmentTail,nil) + pushReduction('parseSegmentTail,["SEGMENT",popStack2(),popStack1()]) + nil + +parseReductionOp() == + s := currentSymbol() + if string? s then + s := makeSymbol s -- FIXME: abolish string-quoted operators + ident? s and property(s,'Led) and matchNextToken('GLIPH,"/") => + pushReduction('parseReductionOp,s) + advanceToken() + advanceToken() + true + false + +parseReduction() == + parseReductionOp() => + compulsorySyntax parseExpr 1000 + pushReduction('parseReduction,["%Reduce",popStack2(),popStack1()]) + nil + +parseCategory() == + matchAdvanceKeyword "if" => + compulsorySyntax parseExpression() + compulsorySyntax matchAdvanceKeyword "then" + compulsorySyntax parseCategory() + stackUpdated?($reduceStack) := false + matchAdvanceKeyword "else" and compulsorySyntax parseCategory() + if not stackUpdated? $reduceStack then + pushReduction('alternateCategory,nil) + pushReduction('parseCategory,["if",popStack3(),popStack2(),popStack1()]) + matchAdvanceGlyph "(" => + compulsorySyntax parseCategory() + stackUpdated?($reduceStack) := false + repeatedSyntax('unnamedCategory,function(() +-> + matchAdvanceSpecial char ";" and compulsorySyntax parseCategory())) + if not stackUpdated? $reduceStack then + pushReduction('unnamedCategory,nil) + compulsorySyntax matchAdvanceSpecial char ")" + pushReduction('parseCategory,["CATEGORY",popStack2(),:popStack1()]) + g := lineNumber $spadLine + parseApplication() or parseOperatorFunctionName() => + matchAdvanceGlyph ":" => + compulsorySyntax parseExpression() + pushReduction('parseCategory,["%Signature",popStack2(),popStack1()]) + recordSignatureDocumentation(nthStack 1,g) + true + pushReduction('parseCategory,["%Attribute",popStack1()]) + recordAttributeDocumentation(nthStack 1,g) + true + nil + parseWith() == matchAdvanceKeyword "with" => - compulsorySyntax PARSE_-Category() + compulsorySyntax parseCategory() pushReduction('parseWith,["with",popStack1()]) nil @@ -155,17 +400,8 @@ parseInfixWith() == pushReduction('parseInfixWith,["Join",popStack2(),popStack1()]) parseElseClause() == - currentSymbol() is "if" => PARSE_-Conditional() - PARSE_-Expression() - -++ 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 PARSE_-Expr 1000 - pushReduction('parseInline,["%Inline",popStack1()]) - nil + currentSymbol() is "if" => parseConditional() + parseExpression() parseQuantifier() == matchAdvanceKeyword "forall" => @@ -176,28 +412,68 @@ parseQuantifier() == parseQuantifiedVariable() == parseName() => - compulsorySyntax matchAdvanceString '":" - compulsorySyntax PARSE_-Application() + compulsorySyntax matchAdvanceGlyph ":" + compulsorySyntax parseApplication() pushReduction('parseQuantifiedVariable,[":",popStack2(),popStack1()]) nil +parseQuantifiedVariableList() == + matchAdvanceGlyph "(" => + compulsorySyntax parseQuantifiedVariable() + repeatedSyntax('repeatedVars,function(() +-> + matchAdvanceSpecial char "," and parseQuantifiedVariable())) + and pushReduction('parseQuantifiedVariableList, + ["%Sequence",popStack2(),:popStack1()]) + compulsorySyntax matchAdvanceSpecial char ")" + nil + +++ 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 + pushReduction('parseScheme,[popStack3(),popStack2(),popStack1()]) + parseApplication() + +parseConditional() == + matchAdvanceKeyword "if" => + compulsorySyntax parseExpression() + compulsorySyntax matchAdvanceKeyword "then" + compulsorySyntax parseExpression() + stackUpdated?($reduceStack) := false + if matchAdvanceKeyword "else" then + parseElseClause() + if not stackUpdated? $reduceStack then + pushReduction('elseBranch,nil) + pushReduction('parseConditional,["if",popStack3(),popStack2(),popStack1()]) + nil + +parseSemicolon() == + matchAdvanceSpecial char ";" => + parseExpr 82 or pushReduction('parseSemicolon,"/throwAway") + pushReduction('parseSemicolon,[";",popStack2(),popStack1()]) + nil + ++ We should factorize these boilerplates parseReturn() == matchAdvanceKeyword "return" => - compulsorySyntax PARSE_-Expression() + compulsorySyntax parseExpression() pushReduction('parseReturn,["return",popStack1()]) nil parseThrow() == matchAdvanceKeyword "throw" => - compulsorySyntax PARSE_-Expression() + compulsorySyntax parseExpression() pushReduction('parseReturn,["%Throw",popStack1()]) nil parseExit() == matchAdvanceKeyword "exit" => x := - PARSE_-Expression() => popStack1() + parseExpression() => popStack1() "$NoValue" pushReduction('parseExit,["exit",x]) nil @@ -205,7 +481,7 @@ parseExit() == parseLeave() == matchAdvanceKeyword "leave" => x := - PARSE_-Expression() => popStack1() + parseExpression() => popStack1() "$NoValue" pushReduction('parseLeave,["leave",x]) nil @@ -216,12 +492,256 @@ parseJump() == pushReduction('parseJump,s) nil +parseForm() == + matchAdvanceKeyword "iterate" => + pushReduction('parseForm,["iterate"]) + matchAdvanceKeyword "yield" => + compulsorySyntax parseApplication() + pushReduction('parseForm,["yield",popStack1()]) + parseApplication() + +parseVariable() == + parseName() => + matchAdvanceGlyph ":" => + compulsorySyntax parseApplication() + pushReduction('parseVariable,[":",popStack2(),popStack1()]) + true + parsePrimary() + +parseIterator() == + matchAdvanceKeyword "for" => + compulsorySyntax parseVariable() + compulsorySyntax matchAdvanceKeyword "in" + compulsorySyntax parseExpression() + matchAdvanceKeyword "by" and compulsorySyntax parseExpr 200 and + pushReduction('parseIterator,["INBY",popStack3(),popStack2(),popStack1()]) + or pushReduction('parseIterator,["IN",popStack2(),popStack1()]) + matchAdvanceGlyph "|" and compulsorySyntax parseExpr 111 and + pushReduction('parseIterator,["|",popStack1()]) + true + matchAdvanceKeyword "while" => + compulsorySyntax parseExpr 190 + pushReduction('parseIterator,["WHILE",popStack1()]) + matchAdvanceKeyword "until" => + compulsorySyntax parseExpr 190 + pushReduction('parseIterator,["UNTIL",popStack1()]) + nil + +parseIteratorTails() == + matchAdvanceKeyword "repeat" => + stackUpdated?($reduceStack) := false + repeatedSyntax('parseIteratorTails,function parseIterator) + if not stackUpdated? $reduceStack then + pushReduction('crossIterators,nil) + repeatedSyntax('parseIteratorTails,function parseIterator) + +parseLoop() == + repeatedSyntax('iterators,function parseIterator) => + compulsorySyntax matchAdvanceKeyword "repeat" + compulsorySyntax parseExpr 110 + pushReduction('parseLoop,["REPEAT",:popStack2(),popStack1()]) + matchAdvanceKeyword "repeat" => + compulsorySyntax parseExpr 110 + pushReduction('parseLoop,["REPEAT",popStack1()]) + nil + +parseOpenBracket() == + s := currentSymbol() + getToken s is "[" => + do + s is ["elt",:.] => + pushReduction('parseOpenBracket,["elt",second s,"construct"]) + pushReduction('parseOpenBracket,"construct") + advanceToken() + true + false + +parseOpenBrace() == + s := currentSymbol() + getToken s is "{" => + do + s is ["elt",:.] => + pushReduction('parseOpenBracket,["elt",second s,"brace"]) + pushReduction('parseOpenBracket,"construct") --FIXME: should be brace + advanceToken() + true + false + +parseSequence1() == + do + parseExpression() => + pushReduction('parseSequence1,[popStack2(),popStack1()]) + pushReduction('parseSequence1,[popStack1()]) + parseIteratorTails() and + pushReduction('parseSequence1,["COLLECT",:popStack1(),popStack1()]) + true + +parseSequence() == + parseOpenBracket() => + compulsorySyntax parseSequence1() + compulsorySyntax matchAdvanceSpecial char "]" + parseOpenBrace() => + compulsorySyntax parseSequence1() + compulsorySyntax matchAdvanceSpecial char "}" + pushReduction('parseSequence,["brace",popStack1()]) + nil + +parseEnclosure() == + matchAdvanceGlyph "(" => + parseExpr 6 => + compulsorySyntax matchAdvanceSpecial char ")" + matchAdvanceSpecial char ")" => + pushReduction('parseEnclosure,["%Comma"]) + SPAD__SYNTAX__ERROR() + matchAdvanceGlyph "{" => + parseExpr 6 => + compulsorySyntax matchAdvanceSpecial char "}" + pushReduction('parseEnclosure,["brace",["construct",popStack1()]]) + matchAdvanceSpecial char "}" => + pushReduction('parseEnclosure,["brace"]) + SPAD__SYNTAX__ERROR() + matchAdvanceGlyph "[|" => + parseStatement() => + compulsorySyntax matchAdvanceGlyph "|]" + pushReduction('parseEnclosure,["[||]",popStack1()]) + SPAD__SYNTAX__ERROR() + nil + +parseCatch() == + matchSpecial char ";" and matchKeywordNext "catch" => + advanceToken() + advanceToken() + compulsorySyntax parseGlyph "(" + compulsorySyntax parseQuantifiedVariable() + compulsorySyntax matchAdvanceSpecial char ")" + compulsorySyntax parseGlyph "=>" + compulsorySyntax parseExpression() + pushReduction('parseCatch,[popStack2(),popStack1()]) + nil + +parseFinally() == + matchSpecial char ";" and matchKeywordNext "finally" => + advanceToken() + advanceToken() + compulsorySyntax parseExpression() + nil + +parseTry() == + matchAdvanceKeyword "try" => + compulsorySyntax parseExpression() + -- exception handlers: either a finally-expression, or + -- a series of catch-expressions optionally followed by + -- a finally-expression. + parseFinally() => + pushReduction('parseTry,["%Try",popStack2(),nil,popStack1()]) + compulsorySyntax repeatedSyntax('handlers,function parseCatch) => + stackUpdated?($reduceStack) := false + parseFinally() + if not stackUpdated? $reduceStack then + pushReduction('finalizer,nil) + pushReduction('parseTry,["%Try",popStack3(),popStack2(),popStack1()]) + SPAD__SYNTAX__ERROR() + nil + +parseMatch() == + matchAdvanceKeyword "case" => + compulsorySyntax parseExpr 400 + compulsorySyntax matchAdvanceKeyword "is" + compulsorySyntax parseExpr 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 + pushReduction('parseInline,["%Inline",popStack1()]) + nil + +parseImport() == + matchAdvanceKeyword "import" => + compulsorySyntax parseExpr 1000 + matchAdvanceGlyph ":" => + compulsorySyntax parseExpression() + compulsorySyntax matchAdvanceKeyword "from" + compulsorySyntax parseExpr 1000 + pushReduction('parseImport, + ["%SignatureImport",popStack3(),popStack2(),popStack1()]) + stackUpdated?($reduceStack) := false + repeatedSyntax('imports,function(() +-> matchAdvanceSpecial char "," + and compulsorySyntax parseExpr 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)) => + pushReduction('parseStatement,["Series",popStack2(),:popStack1()]) + true + false + parseNewExpr() == matchString '")" => processSynonyms() compulsorySyntax parseCommand() SETQ(DEFINITION__NAME,currentSymbol()) - PARSE_-Statement() + parseStatement() + +--% + +isTokenDelimiter() == + symbolMember?(currentSymbol(),[")","END__UNIT","NIL"]) + +parseTokenList() == + repeatedSyntax('tokenList,function(() +-> + (isTokenDelimiter() => nil; pushReduction('parseTokenList,currentSymbol()); + advanceToken(); true))) + +parseCommandTail() == + stackUpdated?($reduceStack) := false + repeatedSyntax('options,function parseTokenOption) + if not stackUpdated? $reduceStack then + pushReduction('options,nil) + atEndOfLine() and + pushReduction('parseCommandTail,[popStack2(),:popStack1()]) + systemCommand popStack1() + true + +parseOption() == + matchAdvanceString '")" => --FIXME: kill matchAdvanceString + compulsorySyntax repeatedSyntax('options,function parsePrimaryOrQM) + +parseTokenCommandTail() == + stackUpdated?($reduceStack) := false + repeatedSyntax('options,function parseOption) + if not stackUpdated? $reduceStack then + pushReduction('options,nil) + atEndOfLine() and + pushReduction('parseCommandTail,[popStack2(),:popStack1()]) + systemCommand popStack1() + true + +parseSpecialCommand() == + matchAdvanceString '"show" => --FIXME: kill matchAdvanceString + stackUpdated?($reduceStack) := true + repeatedSyntax('commands,function(() +-> matchAdvanceString '"?" + or parseExpression())) + if not stackUpdated? $reduceStack then + pushReduction('commdnds,nil) + pushReduction('parseSpecialCommand,["show",popStack1()]) + compulsorySyntax parseCommandTail() + symbolMember?(currentSymbol(),$noParseCommands) => + apply(currentSymbol(),nil) + true + symbolMember?(currentSymbol(),$tokenCommands) and parseTokenList() => + compulsorySyntax parseTokenCommandTail() + repeatedSyntax('parseSpecialCommand,function parsePrimaryOrQM) and + compulsorySyntax parseCommandTail() --% @@ -267,3 +787,35 @@ parseSpadFile sourceFile == -- we accumulated the parse trees in reverse order reverse! asts +--% + +++ Gliphs are symbol clumps. The gliph property of a symbol gives +++ the tree describing the tokens which begin with that symbol. +++ The token reader uses the gliph property to determine the longest token. +++ Thus `:=' is read as one token not as `:' followed by `='. +for x in [ + ["|", [")"], ["]"]],_ + ["*", ["*"]],_ + ["(", ["|"]],_ + ["+", ["-", [">"]]],_ + ["-", [">"]],_ + ["<", ["="], ["<"]], + ["/", ["\"]],_ + ["\", ["/"]],_ + [">", ["="], [">"]],_ + ["=", ["=", [">"]] ,[">"]],_ + [".", ["."]],_ + ["^", ["="]],_ + ["~", ["="]],_ + ["[", ["|"]],_ + [":", ["="], ["-"], [":"]]_ + ] repeat + property(first x,'GLIPH) := rest x + +++ Generic infix operators +for x in ["-", "=", "*", "rem", "mod", "quo", "div", "/", "^", + "**", "exquo", "+", "-", "<", ">", "<=", ">=", "~=", + "and", "or", "/\", "\/", "<<", ">>"] _ + repeat + property(x,'GENERIC) := true + |