-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. -- Copyright (C) 2007-2016, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are -- met: -- -- - Redistributions of source code must retain the above copyright -- notice, this list of conditions and the following disclaimer. -- -- - Redistributions in binary form must reproduce the above copyright -- notice, this list of conditions and the following disclaimer in -- the documentation and/or other materials provided with the -- distribution. -- -- - Neither the name of The Numerical ALgorithms Group Ltd. nor the -- names of its contributors may be used to endorse or promote products -- derived from this software without specific prior written permission. -- -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS -- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A -- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER -- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, -- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- -- -- Abstract: -- This file defines the Boot grammar and parser. The parser -- is hand-written based on `parser combinators' technology. -- import includer import scanner import ast namespace BOOTTRAN module parser --% --% Snapshot of the parser state --% structure %ParserState == Record(toks: %List %Tokens, trees: %List %Ast, pren: %Short, scp: %Short, cur: %Token,tu: %LoadUnit) with parserTokens == (.toks) -- remaining token sequence parserTrees == (.trees) -- list of successful parse trees parserNesting == (.pren) -- parenthesis nesting level parserScope == (.scp) -- scope nesting level parserCurrentToken == (.cur) -- current token parserLoadUnit == (.tu) -- current translation unit makeParserState toks == mk%ParserState(toks,nil,0,0,nil,makeLoadUnit()) ++ Access the value of the current token macro parserTokenValue ps == tokenValue parserCurrentToken ps ++ Access the class of the current token macro parserTokenClass ps == tokenClass parserCurrentToken ps ++ Access the position of the current token macro parserTokenPosition ps == tokenPosition parserCurrentToken ps macro parserGensymSequenceNumber ps == currentGensymNumber parserLoadUnit ps --% bpFirstToken ps == parserCurrentToken(ps) := parserTokens ps = nil => mk%Token("ERROR","NOMORE",parserTokenPosition ps) first parserTokens ps true bpFirstTok ps == parserCurrentToken(ps) := parserTokens ps = nil => mk%Token("ERROR","NOMORE",parserTokenPosition ps) first parserTokens ps parserNesting ps > 0 and parserTokenClass ps = "KEY" => parserTokenValue ps is "SETTAB" => parserScope(ps) := parserScope ps + 1 bpNext ps parserTokenValue ps is "BACKTAB" => parserScope(ps) := parserScope ps - 1 bpNext ps parserTokenValue ps is "BACKSET" => bpNext ps true true bpNext ps == parserTokens(ps) := rest parserTokens ps bpFirstTok ps bpNextToken ps == parserTokens(ps) := rest parserTokens ps bpFirstToken ps bpRequire(ps,f) == apply(f,[ps]) or bpTrap ps bpState ps == [parserTokens ps,parserTrees ps,parserNesting ps,parserScope ps] bpRestore(ps,x)== parserTokens(ps) := first x bpFirstToken ps parserTrees(ps) := second x parserNesting(ps) := third x parserScope(ps) := CADDDR x true bpPush(ps,x) == parserTrees(ps) := [x,:parserTrees ps] bpPushId ps == parserTrees(ps) := [bfReName parserTokenValue ps,:parserTrees ps] bpPop1 ps == a := first parserTrees ps parserTrees(ps) := rest parserTrees ps a bpPop2 ps == a := second parserTrees ps parserTrees(ps).rest := CDDR parserTrees ps a bpPop3 ps == a := third parserTrees ps parserTrees(ps).rest.rest := CDDDR parserTrees ps a bpIndentParenthesized(ps,f) == scope := parserScope ps try parserScope(ps) := 0 a := parserCurrentToken ps bpEqPeek(ps,"OPAREN") => parserNesting(ps) := parserNesting ps + 1 bpNext ps apply(f,[ps]) and bpFirstTok ps and (bpEqPeek(ps,"CPAREN") or bpParenTrap(ps,a)) => parserNesting(ps) := parserNesting ps - 1 bpNextToken ps parserScope ps = 0 => true parserTokens(ps) := [:bpAddTokens(ps,parserScope ps),:parserTokens ps] bpFirstToken ps parserNesting ps = 0 => bpCancel ps true true bpEqPeek(ps,"CPAREN") => bpPush(ps,bfTuple []) parserNesting(ps) := parserNesting ps - 1 bpNextToken ps true bpParenTrap(ps,a) false finally parserScope(ps) := scope bpParenthesized(ps,f) == a := parserCurrentToken ps bpEqKey(ps,"OPAREN") => apply(f,[ps]) and (bpEqKey(ps,"CPAREN") or bpParenTrap(ps,a)) => true bpEqKey(ps,"CPAREN") => bpPush(ps,bfTuple []) true bpParenTrap(ps,a) false bpBracket(ps,f) == a := parserCurrentToken ps bpEqKey(ps,"OBRACK") => apply(f,[ps]) and (bpEqKey(ps,"CBRACK") or bpBrackTrap(ps,a)) => bpPush(ps,bpPop1 ps) bpEqKey(ps,"CBRACK") => bpPush(ps,[]) bpBrackTrap(ps,a) false bpPileBracketed(ps,f) == bpEqKey(ps,"SETTAB") => bpEqKey(ps,"BACKTAB") => true apply(f,[ps]) and (bpEqKey(ps,"BACKTAB") or bpPileTrap ps) => bpPush(ps,bpPop1 ps) false false bpListof(ps,f,str1,g)== apply(f,[ps]) => bpEqKey(ps,str1) and bpRequire(ps,f) => a := parserTrees ps parserTrees(ps) := nil while bpEqKey(ps,str1) and bpRequire(ps,f) repeat nil parserTrees(ps) := [reverse! parserTrees ps,:a] bpPush(ps,apply(g,[[bpPop3 ps,bpPop2 ps,:bpPop1 ps]])) true false -- to do , bpListofFun(ps,f,h,g)== apply(f,[ps]) => apply(h,[ps]) and bpRequire(ps,f) => a := parserTrees ps parserTrees(ps) := nil while apply(h,[ps]) and bpRequire(ps,f) repeat nil parserTrees(ps) := [reverse! parserTrees ps,:a] bpPush(ps,apply(g,[[bpPop3 ps,bpPop2 ps,:bpPop1 ps]])) true false bpList(ps,f,str1)== apply(f,[ps]) => bpEqKey(ps,str1) and bpRequire(ps,f) => a := parserTrees ps parserTrees(ps) := nil while bpEqKey(ps,str1) and bpRequire(ps,f) repeat nil parserTrees(ps) := [reverse! parserTrees ps,:a] bpPush(ps,[bpPop3 ps,bpPop2 ps,:bpPop1 ps]) bpPush(ps,[bpPop1 ps]) bpPush(ps,nil) bpOneOrMore(ps,f) == apply(f,[ps])=> a := parserTrees ps parserTrees(ps) := nil while apply(f,[ps]) repeat nil parserTrees(ps) := [reverse! parserTrees ps,:a] bpPush(ps,[bpPop2 ps,:bpPop1 ps]) false -- s must transform the head of the stack bpAnyNo(ps,s) == while apply(s,[ps]) repeat nil true -- AndOr(k,p,f)= k p bpAndOr(ps,keyword,p,f)== bpEqKey(ps,keyword) and bpRequire(ps,p) and bpPush(ps,apply(f,[parserLoadUnit ps,bpPop1 ps])) bpConditional(ps,f) == bpEqKey(ps,"IF") and bpRequire(ps,function bpWhere) and (bpEqKey(ps,"BACKSET") or true) => bpEqKey(ps,"SETTAB") => bpEqKey(ps,"THEN") => bpRequire(ps,f) and bpElse(ps,f) and bpEqKey(ps,"BACKTAB") bpMissing(ps,"THEN") bpEqKey(ps,"THEN") => bpRequire(ps,f) and bpElse(ps,f) bpMissing(ps,"then") false bpElse(ps,f)== a := bpState ps bpBacksetElse ps => bpRequire(ps,f) and bpPush(ps,bfIf(bpPop3 ps,bpPop2 ps,bpPop1 ps)) bpRestore(ps,a) bpPush(ps,bfIfThenOnly(bpPop2 ps,bpPop1 ps)) bpBacksetElse ps == bpEqKey(ps,"BACKSET") => bpEqKey(ps,"ELSE") bpEqKey(ps,"ELSE") bpEqPeek(ps,s) == parserTokenClass ps = "KEY" and symbolEq?(s,parserTokenValue ps) bpEqKey(ps,s) == parserTokenClass ps = "KEY" and symbolEq?(s,parserTokenValue ps) and bpNext ps bpEqKeyNextTok(ps,s) == parserTokenClass ps = "KEY" and symbolEq?(s,parserTokenValue ps) and bpNextToken ps bpPileTrap ps == bpMissing(ps,"BACKTAB") bpBrackTrap(ps,x) == bpMissingMate(ps,"]",x) bpParenTrap(ps,x) == bpMissingMate(ps,")",x) bpSpecificErrorHere(ps,key) == bpSpecificErrorAtToken(parserCurrentToken ps, key) bpSpecificErrorAtToken(tok, key) == a := tokenPosition tok SoftShoeError(a,key) bpGeneralErrorHere ps == bpSpecificErrorHere(ps,'"syntax error") bpIgnoredFromTo(pos1, pos2) == shoeConsole strconc('"ignored from line ", toString lineNo pos1) shoeConsole lineString pos1 shoeConsole strconc(shoeSpaces lineCharacter pos1,'"|") shoeConsole strconc('"ignored through line ", toString lineNo pos2) shoeConsole lineString pos2 shoeConsole strconc(shoeSpaces lineCharacter pos2,'"|") bpMissingMate(ps,close,open)== bpSpecificErrorAtToken(open, '"possibly missing mate") bpMissing(ps,close) bpMissing(ps,s) == bpSpecificErrorHere(ps,strconc(PNAME s,'" possibly missing")) throw 'TRAPPED : BootParserException bpCompMissing(ps,s) == bpEqKey(ps,s) or bpMissing(ps,s) bpTrap ps == bpGeneralErrorHere ps throw 'TRAPPED : BootParserException bpRecoverTrap ps == bpFirstToken ps pos1 := parserTokenPosition ps bpMoveTo(ps,0) pos2 := parserTokenPosition ps bpIgnoredFromTo(pos1, pos2) bpPush(ps,[['"pile syntax error"]]) bpListAndRecover(ps,f)== a := parserTrees ps b := nil parserTrees(ps) := nil done := false c := parserTokens ps while not done repeat found := try apply(f,[ps]) catch(e: BootParserException) => e if found is "TRAPPED" then parserTokens(ps) := c bpRecoverTrap ps else if not found then parserTokens(ps) := c bpGeneralErrorHere ps bpRecoverTrap ps if bpEqKey(ps,"BACKSET") then c := parserTokens ps else if bpEqPeek(ps,"BACKTAB") or parserTokens ps = nil then done := true else parserTokens(ps) := c bpGeneralErrorHere ps bpRecoverTrap ps if bpEqPeek(ps,"BACKTAB") or parserTokens ps = nil then done:=true else bpNext ps c := parserTokens ps b := [bpPop1 ps,:b] parserTrees(ps) := a bpPush(ps,reverse! b) bpMoveTo(ps,n) == parserTokens ps = nil => true bpEqPeek(ps,"BACKTAB") => n=0 => true bpNextToken ps parserScope(ps) := parserScope ps - 1 bpMoveTo(ps,n-1) bpEqPeek(ps,"BACKSET") => n=0 => true bpNextToken ps bpMoveTo(ps,n) bpEqPeek(ps,"SETTAB") => bpNextToken ps bpMoveTo(ps,n+1) bpEqPeek(ps,"OPAREN") => bpNextToken ps parserNesting(ps) := parserNesting(ps) + 1 bpMoveTo(ps,n) bpEqPeek(ps,"CPAREN") => bpNextToken ps parserNesting(ps) := parserNesting ps - 1 bpMoveTo(ps,n) bpNextToken ps bpMoveTo(ps,n) -- A fully qualified name could be interpreted as a left reduction -- of an '::' infix operator. At the moment, we don't use -- that general interpretation. -- When this routine is called, a symbol is already pushed on the -- stack. When this routine finished execution, we have either -- reduced a '::' and a name, or nothing. In either case, a -- symbol is present on the stack. bpQualifiedName ps == bpEqPeek(ps,"COLON-COLON") => bpNext ps parserTokenClass ps = "ID" and bpPushId ps and bpNext ps and bpPush(ps,bfColonColon(bpPop2 ps, bpPop1 ps)) false ++ Name: ++ ID ++ Name :: ID bpName ps == parserTokenClass ps = "ID" => bpPushId ps bpNext ps bpAnyNo(ps,function bpQualifiedName) false ++ Constant: ++ INTEGER ++ FLOAT ++ LISP ++ LISPEXPR ++ LINE ++ QUOTE S-Expression ++ STRING ++ INERT bpConstTok ps == parserTokenClass ps in '(INTEGER FLOAT) => bpPush(ps,parserTokenValue ps) bpNext ps parserTokenClass ps = "LISP" => bpPush(ps,%Lisp parserTokenValue ps) and bpNext ps parserTokenClass ps = "LISPEXP" => bpPush(ps,parserTokenValue ps) and bpNext ps parserTokenClass ps = "LINE" => bpPush(ps,["+LINE",parserTokenValue ps]) and bpNext ps bpEqPeek(ps,"QUOTE") => bpNext ps bpRequire(ps,function bpSexp) and bpPush(ps,bfSymbol bpPop1 ps) bpString ps or bpFunction ps or bpInert ps bpInert ps == parserTokenClass ps = 'INERT => bpPush(ps,bfInert parserTokenValue ps) and bpNext ps nil bpChar ps == parserTokenClass ps = "ID" and parserTokenValue ps is "char" => a := bpState ps bpApplication ps => s := bpPop1 ps s is ["char",.] => bpPush(ps,s) bpRestore(ps,a) false false false ++ Subroutine of bpExportItem. Parses tails of ExportItem. bpExportItemTail ps == bpEqKey(ps,"BEC") and bpRequire(ps,function bpAssign) and bpPush(ps,%Assignment(bpPop2 ps, bpPop1 ps)) or bpSimpleDefinitionTail ps ++ ExportItem: ++ Structure ++ TypeAliasDefinition ++ Signature ++ Signature := Where ++ Signature == Where bpExportItem ps == bpEqPeek(ps,"STRUCTURE") => bpStruct ps a := bpState ps bpName ps => bpEqPeek(ps,"COLON") => bpRestore(ps,a) bpRequire(ps,function bpSignature) bpExportItemTail ps or true bpRestore(ps,a) bpTypeAliasDefinition ps false ++ ExportItemList: ++ Signature ++ ExportItemList Signature bpExportItemList ps == bpListAndRecover(ps,function bpExportItem) ++ ModuleInterface: ++ WHERE pile-bracketed ExporItemList bpModuleInterface ps == bpEqKey(ps,"WHERE") => bpPileBracketed(ps,function bpExportItemList) or (bpExportItem ps and bpPush(ps,[bpPop1 ps])) or bpTrap ps bpPush(ps,nil) ++ ModuleExports: ++ OPAREN IdList CPAREN bpModuleExports ps == bpParenthesized(ps,function bpIdList) => bpPush(ps,bfUntuple bpPop1 ps) bpPush(ps,nil) ++ Parse a module definitoin ++ Module: ++ MODULE Name OptionalModuleExports OptionalModuleInterface bpModule ps == bpEqKey(ps,"MODULE") => bpRequire(ps,function bpName) bpModuleExports ps bpModuleInterface ps bpPush(ps,%Module(bpPop3 ps,bpPop2 ps,bpPop1 ps)) nil ++ Provenance: ++ IN Application bpProvenance ps == bpEqKey(ps,"IN") => bpApplication ps or return bpTrap ps x := bpPop1 ps x isnt [["ELT","System","LoadUnit"],['QUOTE,lib]] => bpGeneralErrorHere ps bpPush(ps,%LoadUnit lib) bpPush(ps,nil) ++ Parse a module import, or a import declaration for a foreign entity. ++ Import: ++ IMPORT Signature FOR Name ++ IMPORT Signature IN Application FOR Name ++ IMPORT Name ++ IMPORT NAMESPACE LongName bpImport ps == bpEqKey(ps,"IMPORT") => bpEqKey(ps,"NAMESPACE") => bpLeftAssoc(ps,'(DOT),function bpName) and bpPush(ps,%Import bfNamespace bpPop1 ps) or bpTrap ps a := bpState ps bpRequire(ps,function bpName) bpEqPeek(ps,"COLON") => bpRestore(ps,a) bpRequire(ps,function bpSignature) bpProvenance ps bpEqKey(ps,"FOR") or bpTrap ps bpRequire(ps,function bpName) bpPush(ps,%ImportSignature(bpPop1 ps, bpPop2 ps, bpPop1 ps)) bpPush(ps,%Import bpPop1 ps) false ++ ++ Namespace: ++ NAMESPACE Name bpNamespace ps == bpEqKey(ps,"NAMESPACE") and (bpName ps or bpDot ps) and bpPush(ps,bfNamespace bpPop1 ps) -- Parse a type alias defnition: -- TypeAliasDefinition: -- TypeName <=> logical-expression bpTypeAliasDefinition ps == bpTypeName ps and bpEqKey(ps,"TDEF") and bpLogical ps and bpPush(ps,%TypeAlias(bpPop2 ps,bpPop1 ps)) bpTypeName ps == bpTerm(ps,function bpIdList) or bpTrap ps ++ Parse a signature declaration ++ Signature: ++ Name COLON Mapping bpSignature ps == bpName ps and bpSignatureTail ps bpSignatureTail ps == bpEqKey(ps,"COLON") and bpRequire(ps,function bpTyping) and bpPush(ps,bfSignature(bpPop2 ps,bpPop1 ps)) ++ SimpleMapping: ++ Application ++ Application -> Application bpSimpleMapping ps == bpApplication ps => bpEqKey(ps,"ARROW") and bpRequire(ps,function bpApplication) and bpPush(ps,%Mapping(bpPop1 ps, [bpPop1 ps])) true false ++ ArgtypeList: ++ ( ArgtypeSequence ) ++ ArgtypeSequence: ++ SimpleMapping ++ SimpleMapping , ArgtypeSequence bpArgtypeList ps == bpTuple(ps,function bpSimpleMapping) ++ Parse a mapping expression ++ Mapping: ++ ArgtypeList -> Application bpMapping ps == bpParenthesized(ps,function bpArgtypeList) and bpEqKey(ps,"ARROW") and bpApplication ps and bpPush(ps,%Mapping(bpPop1 ps, bfUntuple bpPop1 ps)) bpCancel ps == a := bpState ps bpEqKeyNextTok(ps,"SETTAB") => bpCancel ps => bpEqKeyNextTok(ps,"BACKTAB") => true bpRestore(ps,a) false bpEqKeyNextTok(ps,"BACKTAB") => true bpRestore(ps,a) false false bpAddTokens(ps,n) == n=0 => nil n>0=> [mk%Token("KEY","SETTAB",parserTokenPosition ps),:bpAddTokens(ps,n-1)] [mk%Token("KEY","BACKTAB",parserTokenPosition ps),:bpAddTokens(ps,n+1)] bpExceptions ps == bpEqPeek(ps,"DOT") or bpEqPeek(ps,"QUOTE") or bpEqPeek(ps,"OPAREN") or bpEqPeek(ps,"CPAREN") or bpEqPeek(ps,"SETTAB") or bpEqPeek(ps,"BACKTAB") or bpEqPeek(ps,"BACKSET") bpSexpKey ps == parserTokenClass ps = "KEY" and not bpExceptions ps => a := parserTokenValue ps has SHOEINF a = nil => bpPush(ps,keywordId parserTokenValue ps) and bpNext ps bpPush(ps,a) and bpNext ps false bpAnyId ps == bpEqKey(ps,"MINUS") and (parserTokenClass ps = "INTEGER" or bpTrap ps) and bpPush(ps,-parserTokenValue ps) and bpNext ps or bpSexpKey ps or parserTokenClass ps in '(ID INTEGER STRING FLOAT) and bpPush(ps,parserTokenValue ps) and bpNext ps bpSexp ps == bpAnyId ps or bpEqKey(ps,"QUOTE") and bpRequire(ps,function bpSexp) and bpPush(ps,bfSymbol bpPop1 ps) or bpIndentParenthesized(ps,function bpSexp1) bpSexp1 ps == bpFirstTok ps and bpSexp ps and (bpEqKey(ps,"DOT") and bpSexp ps and bpPush(ps,[bpPop2 ps,:bpPop1 ps]) or bpSexp1 ps and bpPush(ps,[bpPop2 ps,:bpPop1 ps])) or bpPush(ps,nil) bpPrimary1 ps == bpParenthesizedApplication ps or bpDot ps or bpConstTok ps or bpConstruct ps or bpCase ps or bpStruct ps or bpPDefinition ps or bpBPileDefinition ps bpParenthesizedApplication ps == bpName ps and bpAnyNo(ps,function bpArgumentList) bpArgumentList ps == bpPDefinition ps and bpPush(ps,bfApplication(bpPop2 ps, bpPop1 ps)) bpPrimary ps == bpFirstTok ps and (bpPrimary1 ps or bpPrefixOperator ps ) bpDot ps == bpEqKey(ps,"DOT") and bpPush(ps,bfDot()) bpPrefixOperator ps == parserTokenClass ps = "KEY" and parserTokenValue ps has SHOEPRE and bpPushId ps and bpNext ps bpInfixOperator ps == parserTokenClass ps = "KEY" and parserTokenValue ps has SHOEINF and bpPushId ps and bpNext ps bpSelector ps == bpEqKey(ps,"DOT") and (bpPrimary ps and bpPush(ps,bfElt(bpPop2 ps,bpPop1 ps)) or bpPush(ps,bfSuffixDot bpPop1 ps)) bpApplication ps== bpPrimary ps and bpAnyNo(ps,function bpSelector) and (bpApplication ps and bpPush(ps,bfApplication(bpPop2 ps,bpPop1 ps)) or true) or bpNamespace ps ++ Typing: ++ SimpleType ++ Mapping ++ FORALL Variable DOT Typing bpTyping ps == bpEqKey(ps,"FORALL") => bpRequire(ps,function bpVariable) (bpDot ps and bpPop1 ps) or bpTrap ps bpRequire(ps,function bpTyping) bpPush(ps,%Forall(bpPop2 ps, bpPop1 ps)) bpMapping ps or bpSimpleMapping ps ++ Typed: ++ Application : Typing ++ Application @ Typing bpTyped ps == bpApplication ps and bpSignatureTail ps => true bpEqKey(ps,"AT") => bpRequire(ps,function bpTyping) and bpPush(ps,bfRestrict(bpPop2 ps, bpPop1 ps)) true bpExpt ps == bpRightAssoc(ps,'(POWER),function bpTyped) bpInfKey(ps,s) == parserTokenClass ps = "KEY" and symbolMember?(parserTokenValue ps,s) and bpPushId ps and bpNext ps bpInfGeneric(ps,s) == bpInfKey(ps,s) and (bpEqKey(ps,"BACKSET") or true) bpRightAssoc(ps,o,p)== a := bpState ps apply(p,[ps]) => while bpInfGeneric(ps,o) and (bpRightAssoc(ps,o,p) or bpTrap ps) repeat bpPush(ps,bfInfApplication(bpPop2 ps,bpPop2 ps,bpPop1 ps)) true bpRestore(ps,a) false bpLeftAssoc(ps,operations,parser)== apply(parser,[ps]) => while bpInfGeneric(ps,operations) and bpRequire(ps,parser) repeat bpPush(ps,bfInfApplication(bpPop2 ps,bpPop2 ps,bpPop1 ps)) true false bpString ps == parserTokenClass ps = "STRING" and bpPush(ps,quote makeSymbol parserTokenValue ps) and bpNext ps bpFunction ps == bpEqKey(ps,"FUNCTION") and bpRequire(ps,function bpPrimary1) and bpPush(ps,bfFunction bpPop1 ps) bpThetaName ps == parserTokenClass ps = "ID" and parserTokenValue ps has SHOETHETA => bpPushId ps bpNext ps false bpReduceOperator ps == bpInfixOperator ps or bpString ps or bpThetaName ps bpReduce ps == a := bpState ps bpReduceOperator ps and bpEqKey(ps,"SLASH") => bpEqPeek(ps,"OBRACK") => bpRequire(ps,function bpDConstruct) and bpPush(ps,bfReduceCollect(parserLoadUnit ps,bpPop2 ps,bpPop1 ps)) bpRequire(ps,function bpApplication) and bpPush(ps,bfReduce(parserLoadUnit ps,bpPop2 ps,bpPop1 ps)) bpRestore(ps,a) false bpTimes ps == bpReduce ps or bpLeftAssoc(ps,'(TIMES SLASH),function bpExpt) bpEuclid ps == bpLeftAssoc(ps,'(QUO REM),function bpTimes) bpMinus ps == bpInfGeneric(ps,'(MINUS)) and bpRequire(ps,function bpEuclid) and bpPush(ps,bfApplication(bpPop2 ps,bpPop1 ps)) or bpEuclid ps bpArith ps == bpLeftAssoc(ps,'(PLUS MINUS),function bpMinus) bpIs ps == bpArith ps and bpInfKey(ps,'(IS ISNT)) and bpRequire(ps,function bpPattern) => bpPush(ps,bfISApplication(parserLoadUnit ps,bpPop2 ps,bpPop2 ps,bpPop1 ps)) bpEqKey(ps,"HAS") and bpRequire(ps,function bpApplication) => bpPush(ps,bfHas(bpPop2 ps, bpPop1 ps)) true bpCompare ps == bpIs ps and (bpInfKey(ps,'(SHOEEQ SHOENE LT LE GT GE IN)) and bpRequire(ps,function bpIs) and bpPush(ps,bfInfApplication(bpPop2 ps,bpPop2 ps,bpPop1 ps)) or true) or bpLeave ps or bpThrow ps bpAnd ps == bpLeftAssoc(ps,'(AND),function bpCompare) bpThrow ps == bpEqKey(ps,"THROW") and bpApplication ps => -- Allow user-supplied matching type tag bpSignatureTail ps bpPush(ps,bfThrow bpPop1 ps) nil ++ Try: ++ try Assign CatchItems bpTry ps == bpEqKey(ps,"TRY") => bpAssign ps cs := [] while bpHandler(ps,"CATCH") repeat bpCatchItem ps cs := [bpPop1 ps,:cs] bpHandler(ps,"FINALLY") => bpFinally ps and bpPush(ps,bfTry(bpPop2 ps,reverse! [bpPop1 ps,:cs])) cs = nil => bpTrap ps -- missing handlers bpPush(ps,bfTry(bpPop1 ps,reverse! cs)) nil bpCatchItem ps == bpRequire(ps,function bpExceptionVariable) and (bpEqKey(ps,"EXIT") or bpTrap ps) and bpRequire(ps,function bpAssign) and bpPush(ps,%Catch(bpPop2 ps,bpPop1 ps)) bpExceptionVariable ps == t := parserCurrentToken ps bpEqKey(ps,"OPAREN") and bpRequire(ps,function bpSignature) and (bpEqKey(ps,"CPAREN") or bpMissing(ps,t)) or bpTrap ps bpFinally ps == bpRequire(ps,function bpAssign) and bpPush(ps,%Finally bpPop1 ps) bpHandler(ps,key) == s := bpState ps (bpEqKey(ps,"BACKSET") or bpEqKey(ps,"SEMICOLON")) and bpEqKey(ps,key) => true bpRestore(ps,s) false ++ Leave: ++ LEAVE Logical bpLeave ps == bpEqKey(ps,"LEAVE") and bpRequire(ps,function bpLogical) and bpPush(ps,bfLeave bpPop1 ps) ++ Do: ++ IN Namespace Do ++ DO Assign bpDo ps == bpEqKey(ps,"IN") => bpRequire(ps,function bpNamespace) bpRequire(ps,function bpDo) bpPush(ps,bfAtScope(bpPop2 ps,bpPop1 ps)) bpEqKey(ps,"DO") and bpRequire(ps,function bpAssign) and bpPush(ps,bpPop1 ps) ++ Return: ++ RETURN Assign ++ Leave ++ Throw ++ And bpReturn ps== (bpEqKey(ps,"RETURN") and bpRequire(ps,function bpAssign) and bpPush(ps,bfReturnNoName bpPop1 ps)) or bpLeave ps or bpThrow ps or bpAnd ps or bpDo ps bpLogical ps == bpLeftAssoc(ps,'(OR),function bpReturn) bpExpression ps == bpEqKey(ps,"COLON") and (bpLogical ps and bpPush(ps,bfApplication ("COLON",bpPop1 ps)) or bpTrap ps) or bpLogical ps bpStatement ps == bpConditional(ps,function bpWhere) or bpLoop ps or bpExpression ps or bpTry ps bpLoop ps == bpIterators ps and (bpCompMissing(ps,"REPEAT") and bpRequire(ps,function bpWhere) and bpPush(ps,bfLp(parserLoadUnit ps,bpPop2 ps,bpPop1 ps))) or bpEqKey(ps,"REPEAT") and bpRequire(ps,function bpLogical) and bpPush(ps,bfLoop1(parserLoadUnit ps,bpPop1 ps)) bpSuchThat ps == bpAndOr(ps,"BAR",function bpWhere,function bfSuchthat) bpWhile ps == bpAndOr(ps,"WHILE",function bpLogical,function bfWhile) bpUntil ps == bpAndOr(ps,"UNTIL",function bpLogical,function bfUntil) bpFormal ps == bpVariable ps or bpDot ps bpForIn ps == bpEqKey(ps,"FOR") and bpRequire(ps,function bpFormal) and (bpCompMissing(ps,"IN")) and (bpRequire(ps,function bpSeg) and (bpEqKey(ps,"BY") and bpRequire(ps,function bpArith) and bpPush(ps,bfForInBy(parserLoadUnit ps,bpPop3 ps,bpPop2 ps,bpPop1 ps))) or bpPush(ps,bfForin(parserLoadUnit ps,bpPop2 ps,bpPop1 ps))) bpSeg ps == bpArith ps and (bpEqKey(ps,"SEG") and (bpArith ps and bpPush(ps,bfSegment2(bpPop2 ps,bpPop1 ps)) or bpPush(ps,bfSegment1(bpPop1 ps))) or true) bpIterator ps == bpForIn ps or bpSuchThat ps or bpWhile ps or bpUntil ps bpIteratorList ps == bpOneOrMore(ps,function bpIterator) and bpPush(ps,bfIterators bpPop1 ps) bpCrossBackSet ps == bpEqKey(ps,"CROSS") and (bpEqKey(ps,"BACKSET") or true) bpIterators ps == bpListofFun(ps,function bpIteratorList, function bpCrossBackSet,function bfCross) bpAssign ps == a := bpState ps bpStatement ps => bpEqPeek(ps,"BEC") => bpRestore(ps,a) bpRequire(ps,function bpAssignment) bpEqPeek(ps,"GIVES") => bpRestore(ps,a) bpRequire(ps,function bpLambda) bpEqPeek(ps,"LARROW") => bpRestore(ps,a) bpRequire(ps,function bpKeyArg) true bpRestore(ps,a) false bpAssignment ps == bpAssignVariable ps and bpEqKey(ps,"BEC") and bpRequire(ps,function bpAssign) and bpPush(ps,bfAssign(parserLoadUnit ps,bpPop2 ps,bpPop1 ps)) ++ Parse a lambda expression ++ Lambda ::= Variable +-> Assign bpLambda ps == bpVariable ps and bpEqKey(ps,"GIVES") and bpRequire(ps,function bpAssign) and bpPush(ps,bfLambda(bpPop2 ps,bpPop1 ps)) bpKeyArg ps == bpName ps and bpEqKey(ps,"LARROW") and bpLogical ps and bpPush(ps,bfKeyArg(bpPop2 ps,bpPop1 ps)) -- should only be allowed in sequences bpExit ps == bpAssign ps and (bpEqKey(ps,"EXIT") and (bpRequire(ps,function bpWhere) and bpPush(ps,bfExit(bpPop2 ps,bpPop1 ps))) or true) bpDefinition ps == bpEqKey(ps,"MACRO") => bpName ps and bpStoreName ps and bpCompoundDefinitionTail(ps,function %Macro) or bpTrap ps a := bpState ps bpExit ps => bpEqPeek(ps,"DEF") => bpRestore(ps,a) bpDef ps bpEqPeek(ps,"TDEF") => bpRestore(ps,a) bpTypeAliasDefinition ps true bpRestore(ps,a) false bpStoreName ps == enclosingFunction(parserLoadUnit ps) := first parserTrees ps sideConditions(parserLoadUnit ps) := nil true bpDef ps == bpName ps and bpStoreName ps and bpDefTail(ps,function %Definition) or bpNamespace ps and bpSimpleDefinitionTail ps bpDDef ps == bpName ps and bpDefTail(ps,function %Definition) ++ Parse the remaining of a simple definition. bpSimpleDefinitionTail ps == bpEqKey(ps,"DEF") and bpRequire(ps,function bpWhere) and bpPush(ps,%ConstantDefinition(bpPop2 ps, bpPop1 ps)) ++ Parse the remaining of a compound definition. bpCompoundDefinitionTail(ps,f) == bpVariable ps and bpEqKey(ps,"DEF") and bpRequire(ps,function bpWhere) and bpPush(ps,apply(f,[bpPop3 ps,bpPop2 ps,bpPop1 ps])) ++ Parse the remainding of a definition. When we reach this point ++ we know we must parse a definition and we have already parsed ++ the name of the main operator in the definition. bpDefTail(ps,f) == bpSimpleDefinitionTail ps or bpCompoundDefinitionTail(ps,f) bpWhere ps == bpDefinition ps and (bpEqKey(ps,"WHERE") and bpRequire(ps,function bpDefinitionItem) and bpPush(ps,bfWhere(parserLoadUnit ps,bpPop1 ps,bpPop1 ps)) or true) bpDefinitionItem ps == a := bpState ps bpDDef ps => true bpRestore(ps,a) bpBDefinitionPileItems ps => true bpRestore(ps,a) bpPDefinitionItems ps => true bpRestore(ps,a) bpWhere ps bpDefinitionPileItems ps == bpListAndRecover(ps,function bpDefinitionItem) and bpPush(ps,%Pile bpPop1 ps) bpBDefinitionPileItems ps == bpPileBracketed(ps,function bpDefinitionPileItems) bpSemiColonDefinition ps == bpSemiListing(ps,function bpDefinitionItem,function %Pile) bpPDefinitionItems ps == bpParenthesized(ps,function bpSemiColonDefinition) bpComma ps == bpModule ps or bpImport ps or bpTuple(ps,function bpWhere) bpTuple(ps,p) == bpListofFun(ps,p,function bpCommaBackSet,function bfTuple) bpCommaBackSet ps == bpEqKey(ps,"COMMA") and (bpEqKey(ps,"BACKSET") or true) bpSemiColon ps == bpSemiListing(ps,function bpComma,function bfSequence) bpSemiListing(ps,p,f) == bpListofFun(ps,p,function bpSemiBackSet,f) bpSemiBackSet ps == bpEqKey(ps,"SEMICOLON") and (bpEqKey(ps,"BACKSET") or true) bpPDefinition ps == bpIndentParenthesized(ps,function bpSemiColon) bpPileItems ps == bpListAndRecover(ps,function bpSemiColon) and bpPush(ps,bfSequence bpPop1 ps) bpBPileDefinition ps == bpPileBracketed(ps,function bpPileItems) bpIteratorTail ps == (bpEqKey(ps,"REPEAT") or true) and bpIterators ps bpConstruct ps == bpBracket(ps,function bpConstruction) bpConstruction ps== bpComma ps and (bpIteratorTail ps and bpPush(ps,bfCollect(parserLoadUnit ps,bpPop2 ps,bpPop1 ps)) or bpPush(ps,bfTupleConstruct bpPop1 ps)) bpDConstruct ps == bpBracket(ps,function bpDConstruction) bpDConstruction ps == bpComma ps and (bpIteratorTail ps and bpPush(ps,bfDCollect(bpPop2 ps,bpPop1 ps)) or bpPush(ps,bfDTuple bpPop1 ps)) --PATTERN bpPattern ps == bpBracketPattern ps or bpChar ps or bpName ps or bpConstTok ps bpBracketPattern ps == bpBracket(ps,function bpPatternL) and bpPush(ps,bfConstruct bpPop1 ps) bpEqual ps == bpEqKey(ps,"SHOEEQ") and (bpApplication ps or bpConstTok ps or bpTrap ps) and bpPush(ps,bfEqual bpPop1 ps) bpRegularPatternItem ps == bpEqual ps or bpConstTok ps or bpDot ps or bpName ps and ((bpEqKey(ps,"BEC") and bpRequire(ps,function bpPattern) and bpPush(ps,bfAssign(parserLoadUnit ps,bpPop2 ps,bpPop1 ps))) or true) or bpBracketPattern ps bpRegularPatternItemL ps == bpRegularPatternItem ps and bpPush(ps,[bpPop1 ps]) bpRegularList ps == bpListof(ps,function bpRegularPatternItemL,"COMMA",function bfAppend) bpPatternColon ps == bpEqKey(ps,"COLON") and bpRequire(ps,function bpRegularPatternItem) and bpPush(ps,[bfColon bpPop1 ps]) -- only one colon bpPatternL ps == bpPatternList ps and bpPush(ps,bfTuple bpPop1 ps) bpPatternList ps == bpRegularPatternItemL ps => while (bpEqKey(ps,"COMMA") and (bpRegularPatternItemL ps or (bpPatternTail ps and bpPush(ps,[:bpPop2 ps,:bpPop1 ps]) or bpTrap ps;false) )) repeat bpPush(ps,[:bpPop2 ps,:bpPop1 ps]) true bpPatternTail ps bpPatternTail ps == bpPatternColon ps and (bpEqKey(ps,"COMMA") and bpRequire(ps,function bpRegularList) and bpPush(ps,[:bpPop2 ps,:bpPop1 ps]) or true) -- BOUND VARIABLE ++ We are parsing parameters in a function definition. We have ++ just seen a parameter name; we are attempting to see whether ++ it might be followed by a type annotation, or whether it actually ++ a form with a specific pattern structure, or whether it has ++ a default value. bpRegularBVItemTail ps == bpSignatureTail ps or bpEqKey(ps,"BEC") and bpRequire(ps,function bpPattern) and bpPush(ps,bfAssign(parserLoadUnit ps,bpPop2 ps,bpPop1 ps)) or bpEqKey(ps,"IS") and bpRequire(ps,function bpPattern) and bpPush(ps,bfAssign(parserLoadUnit ps,bpPop2 ps,bpPop1 ps)) or bpEqKey(ps,"DEF") and bpRequire(ps,function bpApplication) and bpPush(ps,%DefaultValue(bpPop2 ps, bpPop1 ps)) bpRegularBVItem ps == bpBVString ps or bpConstTok ps or (bpName ps and (bpRegularBVItemTail ps or true)) or bpBracketPattern ps bpBVString ps == parserTokenClass ps = "STRING" and bpPush(ps,["BVQUOTE",makeSymbol parserTokenValue ps]) and bpNext ps bpRegularBVItemL ps == bpRegularBVItem ps and bpPush(ps,[bpPop1 ps]) bpColonName ps == bpEqKey(ps,"COLON") and (bpName ps or bpBVString ps or bpTrap ps) -- at most one colon at end bpBoundVariablelist ps == bpRegularBVItemL ps => while (bpEqKey(ps,"COMMA") and (bpRegularBVItemL ps or (bpColonName ps and bpPush(ps,bfColonAppend(bpPop2 ps,bpPop1 ps)) or bpTrap ps;false) )) repeat bpPush(ps,[:bpPop2 ps,:bpPop1 ps]) true bpColonName ps and bpPush(ps,bfColonAppend(nil,bpPop1 ps)) bpVariable ps == bpParenthesized(ps,function bpBoundVariablelist) and bpPush(ps,bfTupleIf bpPop1 ps) or bpBracketPattern ps or bpName ps or bpConstTok ps bpAssignVariable ps == bpBracketPattern ps or bpAssignLHS ps bpAssignLHS ps == not bpName ps => false bpSignatureTail ps => true -- variable declaration bpArgumentList ps and (bpEqPeek(ps,"DOT") or (bpEqPeek(ps,"BEC") and bpPush(ps,bfPlace bpPop1 ps)) or bpTrap ps) bpEqKey(ps,"DOT") => -- field path bpList(ps,function bpPrimary,"DOT") and bpChecknull ps and bpPush(ps,bfTuple([bpPop2 ps,:bpPop1 ps])) true bpChecknull ps == a := bpPop1 ps a = nil => bpTrap ps bpPush(ps,a) bpStruct ps == bpEqKey(ps,"STRUCTURE") and bpRequire(ps,function bpTypeName) and (bpEqKey(ps,"DEF") or bpTrap ps) and (bpRecord ps or bpTypeList ps) and bpPush(ps,%Structure(bpPop2 ps,bpPop1 ps)) ++ Record: ++ "Record" "(" FieldList ")" bpRecord ps == s := bpState ps bpName ps and bpPop1 ps is "Record" => (bpParenthesized(ps,function bpFieldList) or bpTrap ps) and bpGlobalAccessors ps and bpPush(ps,%Record(bfUntuple bpPop2 ps,bpPop1 ps)) bpRestore(ps,s) false ++ FieldList: ++ Signature ++ Signature , FieldList bpFieldList ps == bpTuple(ps,function bpSignature) bpGlobalAccessors ps == bpEqKey(ps,"WITH") => bpPileBracketed(ps,function bpAccessorDefinitionList) or bpTrap ps bpPush(ps,nil) bpAccessorDefinitionList ps == bpListAndRecover(ps,function bpAccessorDefinition) ++ AccessorDefinition: ++ Name DEF FieldSection bpAccessorDefinition ps == bpRequire(ps,function bpName) and (bpEqKey(ps,"DEF") or bpTrap ps) and bpRequire(ps,function bpFieldSection) and bpPush(ps,%AccessorDef(bpPop2 ps,bpPop1 ps)) ++ FieldSection: ++ "(" DOT Name ")" bpFieldSection ps == bpParenthesized(ps,function bpSelectField) bpSelectField ps == bpEqKey(ps,"DOT") and bpName ps bpTypeList ps == bpPileBracketed(ps,function bpTypeItemList) or bpTypeItem ps and bpPush(ps,[bpPop1 ps]) bpTypeItem ps == bpTerm(ps,function bpIdList) bpTypeItemList ps == bpListAndRecover(ps,function bpTypeItem) bpTerm(ps,idListParser) == bpRequire(ps,function bpName) and ((bpParenthesized(ps,idListParser) and bpPush(ps,bfNameArgs(bpPop2 ps,bpPop1 ps))) or bpName ps and bpPush(ps,bfNameArgs(bpPop2 ps,bpPop1 ps))) or bpPush(ps,bfNameOnly bpPop1 ps) bpIdList ps == bpTuple(ps,function bpName) bpCase ps == bpEqKey(ps,"CASE") and bpRequire(ps,function bpWhere) and (bpEqKey(ps,"OF") or bpMissing(ps,"OF")) and bpPiledCaseItems ps bpPiledCaseItems ps == bpPileBracketed(ps,function bpCaseItemList) and bpPush(ps,bfCase(parserLoadUnit ps,bpPop2 ps,bpPop1 ps)) bpCaseItemList ps == bpListAndRecover(ps,function bpCaseItem) bpCasePatternVar ps == bpName ps or bpDot ps bpCasePatternVarList ps == bpTuple(ps,function bpCasePatternVar) bpCaseItem ps == (bpTerm(ps,function bpCasePatternVarList) or bpTrap ps) and (bpEqKey(ps,"EXIT") or bpTrap ps) and bpRequire(ps,function bpWhere) and bpPush(ps,bfCaseItem(bpPop2 ps,bpPop1 ps)) ++ Main entry point into the parser module. bpOutItem ps == op := enclosingFunction parserLoadUnit ps varno := parserGensymSequenceNumber ps try enclosingFunction(parserLoadUnit ps) := nil parserGensymSequenceNumber(ps) := 0 bpRequire(ps,function bpComma) catch(e: BootSpecificError) => bpSpecificErrorHere(ps,e) bpTrap ps finally parserGensymSequenceNumber(ps) := varno enclosingFunction(parserLoadUnit ps) := op b := bpPop1 ps t := b is ["+LINE",:.] => [ b ] b is ["L%T",l,r] and symbol? l => $InteractiveMode => [["SETQ",l,r]] [["DEFPARAMETER",l,r]] translateToplevel(ps,b,false) bpPush(ps,t)