unit dpglib.GrammarMaker; interface uses System.Classes, System.Contnrs, Generics.Collections, System.AnsiStrings, dpgrtl.types, dpglib.Types, dpglib.GrammarBehavior, dpglib.BlockContext; type TContextStack = TObjectStack; TGrammarMaker = class( TGrammarBehavior) protected public // ------------------------------------------------------------ // Constructor/destructor // ------------------------------------------------------------ constructor Create( pTool: ITool; pAnalyzer: ILLkAnalyzer; pExchangeDir: AnsiString); destructor Destroy; override; // ------------------------------------------------------------ // Class methods // ------------------------------------------------------------ class function CreateNextTokenRule( pGrammar : IGrammar; pLexRules : TInterfaceList; pRuleName : AnsiString): IRuleBlock; private function CreateOptionalRuleRef( pRule : AnsiString; pStart : IToken): IAlternativeBlock; procedure LabelElem( pElem : IAlternativeElem; pLabel : IToken); procedure SetBlock( pDst : IAlternativeBlock; pSrc : IAlternativeBlock); protected // ------------------------------------------------------------ // Protected members // ------------------------------------------------------------ fBlocks : TContextStack; fLastRuleRef : IRuleRefElem; fRuleEnd : IRuleEndElem; fRuleBlock : IRuleBlock; fCurrentExceptionSpec : IExceptionSpec; fNested : integer; fGrammarError : boolean; procedure AddElemToCurrentAlt( pElem: IAlternativeElem); function Context: TBlockContext; public procedure NoAutoGenSubRule; // ------------------------------------------------------------ // IGrammarBehavior overrides // ------------------------------------------------------------ procedure AbortGrammar; override; procedure BeginAlt( pDoAutoGen: boolean); override; procedure BeginExceptionGroup; override; procedure BeginExceptionSpec( pLabel : IToken); override; procedure BeginSubRule( pLabel : IToken; pStart : IToken; pNot : boolean); override; procedure BeginTree( pStart : IToken); override; procedure BeginChildList; override; procedure DefineRuleName( pRule : IToken; pAccess : AnsiString; pAutoGen : boolean; pComment : AnsiString); override; procedure DefineUses( pUses : AnsiString); override; procedure EndAlt; override; procedure EndExceptionGroup; override; procedure EndExceptionSpec; override; procedure EndGrammar; override; procedure EndRule( pRule : AnsiString); override; procedure EndSubRule; override; procedure EndTree; override; procedure EndChildList; override; procedure HasError; override; procedure OneOrMoreSubRule; override; procedure NMSubRule; override; procedure OptionalSubRule; override; procedure refRangeLow( M : integer); override; procedure refRangeHigh( N : integer); override; procedure RefAction( pAction : IToken); override; procedure RefArgAction( pAction : IToken); override; procedure RefCharLiteral( pLiteral : IToken; pLabel : IToken; pInverted : boolean; pAutoGenType : integer; pLastInRule : boolean); override; procedure RefCharRange( pToken1 : IToken; pToken2 : IToken; pLabel : IToken; pAutoGenType : integer; pLastInRule : boolean); override; procedure RefTokenSpecElemOption( pToken : IToken; pOption : IToken; pValue : IToken); override; procedure RefElemOption( pOption : IToken; pValue : IToken); override; procedure RefExceptionHandler( pTypeAndName : IToken; pAction : IToken); override; procedure RefInitAction( pAction : IToken); override; procedure RefReturnAction( pAction : IToken); override; procedure RefRule( pAssignId : IToken; pRuleName : IToken; pLabel : IToken; pArguments : IToken; pAutoGenType : integer); override; procedure RefRuleExHandler( pExHandlerType : IToken; pExHandlerCode : IToken); override; procedure RefAltExHandler( pExHandlerType : IToken; pExHandlerCode : IToken); override; procedure RefRuleLocals( pLocals : IToken); override; procedure RefSemPred( pSemPred : IToken); override; procedure RefStringLiteral( pLiteral : IToken; pLabel : IToken; pAutoGenType : integer; pLastInRule : boolean); override; procedure RefToken( pAssignId : IToken; pToken : IToken; pLabel : IToken; pArguments : IToken; pInverted : boolean; pAutoGenType : integer; pLAstInRule : boolean); override; procedure RefTokenRange( pToken1 : IToken; pToken2 : IToken; pLabel : IToken; pAutoGenType : integer; pLastInRule : boolean); override; procedure RefWildCard( pToken : IToken; pLabel : IToken; pAutoGenType : integer); override; procedure Reset; override; procedure SetArgOfRuleRef( pArguments : IToken); override; procedure SetRuleOption( pOption : IToken; pValue : IToken); override; procedure SetSubRuleOption( pOption : IToken; pValue : IToken); override; procedure SynPred; override; procedure ZeroOrMoreSubRule; override; procedure SetUserExceptions( pThrow : AnsiString); override; end; implementation uses System.SysUtils, dpgrtl.token, dpgrtl.exception, dpglib.Messages, dpglib.DpgParserTokens, dpglib.Alternative, dpglib.AlternativeBlock, dpglib.ExceptionSpec, dpglib.ExceptionHandler, dpglib.BlockEndElem, dpglib.RuleBlock, dpglib.RuleRefElem, dpglib.RuleEndElem, dpglib.RuleSymbol, dpglib.OneOrMoreBlock, dpglib.ActionElem, dpglib.CharLiteralElem, dpglib.CharRangeElem, dpglib.StringLiteralElem, dpglib.TokenRefElem, dpglib.TokenRangeElem, dpglib.WildCardElem, dpglib.SynPredBlock, dpglib.ZeroOrMoreBlock, dpglib.NMBlock, dpglib.TreeBlockContext, dpglib.TreeElem, dpglib.CodeGenerator, dpglib.DelphiGenerator; //!!!! // **************************************************************************** // Constructor/destructor // **************************************************************************** // ---------------------------------------------------------------------------- // Constructor // ---------------------------------------------------------------------------- constructor TGrammarMaker.Create( pTool : ITool; pAnalyzer : ILLkAnalyzer; pExchangeDir: AnsiString); begin inherited; // --------------------------------------------------------------- // Create BlockContext // --------------------------------------------------------------- fBlocks := TContextStack.Create; // --------------------------------------------------------------- // Create fUsesList. It holds the list of uses clause items until // the grammar is created. // --------------------------------------------------------------- fUsesList := TStringList.Create; fUsesList.Sorted := true; fUsesList.Duplicates := dupIgnore; end; // ---------------------------------------------------------------------------- // Destructor // ---------------------------------------------------------------------------- destructor TGrammarMaker.Destroy; begin FreeAndNil( fBlocks); FreeAndNil( fUsesList); inherited; end; // **************************************************************************** // IGrammarBehavior overrides // **************************************************************************** // ============================================================================ // AbortGrammar // ============================================================================ procedure TGrammarMaker.AbortGrammar; var grName: AnsiString; begin grName := 'unknown'; if fGrammar <> nil then grName := fGrammar.GetClassName; fTool.Error( Format( MSG_E_ABORTGRAMMAR, [grName])); // fTool.Error('Aborting grammar "' + grName + '" do to errors.'); inherited; end; // ================================================================================================ // addElemToCurrentAlt // ================================================================================================ procedure TGrammarMaker.addElemToCurrentAlt( pElem: IAlternativeElem); begin pElem.EnclosingRule := fRuleBlock.RuleName; Context.AddAlternativeElem( pElem); end; // ============================================================================ // ============================================================================ // BeginAlt // ============================================================================ procedure TGrammarMaker.BeginAlt(pDoAutoGen: boolean); var alt: IAlternative; begin alt := TAlternative.Create; alt.DoAutoGen := pDoAutoGen; Context.Block.AddAlternative( alt); end; // ============================================================================ // ============================================================================ // BeginExceptionGroup // ============================================================================ procedure TGrammarMaker.BeginExceptionGroup; var rb: IRuleBlock; begin if Context.Block.QueryInterface( IRuleBlock, rb) <> S_OK then fTool.Panic( 'Internal: "beginExceptionGroup" called outside of a rule block'); end; // ============================================================================ // ============================================================================ // BeginExceptionSpec // // Add an exception spec to an exception group or rule block. // ============================================================================ procedure TGrammarMaker.BeginExceptionSpec(pLabel: IToken); begin // --------------------------------------------------------------- // Hack the label AnsiString a bit to remove leading/trailing space. // --------------------------------------------------------------- if pLabel.TokenText <> '' then pLabel.TokenText := Trim(pLabel.TokenText); // --------------------------------------------------------------- // Don't check for 'currentExceptionSpec <> nil' because syntax // errors may leave it set to something. // --------------------------------------------------------------- fCurrentExceptionSpec := TExceptionSpec.Create( pLabel); end; // ============================================================================ // ============================================================================ // BeginSubRule // ============================================================================ procedure TGrammarMaker.BeginSubRule( pLabel : IToken; pStart : IToken; pNot : boolean); begin // --------------------------------------------------------------- // We don't know what kind of subrule it is yet. // Push a dummy one that will allow us to collect the alternatives. // Later, we'll switch to real object. // --------------------------------------------------------------- fBlocks.Push( TBlockContext.Create); Context.Block := TAlternativeBlock.Create( fGrammar, pStart, pNot); Context.AltNum := 0; INC( fNested); // --------------------------------------------------------------- // Create final node to which the last element of each alternative // will point. // --------------------------------------------------------------- Context.BlockEnd := TBlockEndElem.Create( fGrammar); // --------------------------------------------------------------- // Make sure end node points to start of block. // --------------------------------------------------------------- Context.BlockEnd.Block := Context.Block; labelElem( Context.Block, pLabel); end; // ============================================================================ // ============================================================================ // defineRuleName // ============================================================================ procedure TGrammarMaker.defineRuleName( pRule : IToken; pAccess : AnsiString; pAutoGen : boolean; pComment : AnsiString); var rb : IRuleBlock; rs : IRuleSymbol; id : AnsiString; begin // --------------------------------------------------------------- // Handle lexical rule definition // --------------------------------------------------------------- if pRule.TokenType = TT_TOKENREF then begin // ------------------------------------------------------------ // Lexical rule must be defined in lexer. Anything else is an // error. // ------------------------------------------------------------ if not fIsLexer then begin // fTool.Error('Lexical rule "' + pRule.TokenText + '" defined outside of lexer', fTool.Error(Format( MSG_E_LEXNOTINLEXER, [pRule.TokenText]), fGrammar.GrammarFile, pRule.TokenLine, pRule.TokenColumn); pRule.TokenText := LowerCase( pRule.TokenText); end end // --------------------------------------------------------------- // Handle parser rule definition // --------------------------------------------------------------- else begin // ------------------------------------------------------------ // Parser rule must be defined in non-lexer grammars. So define // it in a lexer is an error. // ------------------------------------------------------------ if fIsLexer then begin // fTool.Error('Lexical rule names must be upper case, "' + pRule.TokenText + '" is not', fTool.Error(Format( MSG_E_LEXCAPITAL, [pRule.TokenText]), fGrammar.GrammarFile, pRule.TokenLine, pRule.TokenColumn); pRule.TokenText := UpperCase( pRule.TokenText); end; end; inherited; if pRule.TokenType = TT_TOKENREF then id := TCodeGenerator.encodeLexerRuleName( pRule.TokenText) else id := pRule.TokenText; fGrammar.Symbol[id].QueryInterface(IRuleSymbol,rs); rb := TRuleBlock.Create( fGrammar, pRule.TokenText, pRule.TokenLine, pAutoGen); // --------------------------------------------------------------- // Lexer rules do not generate default error handling. // --------------------------------------------------------------- rb.EnclosingRule := pRule.TokenText; rb.DefaultErrorHandler := fGrammar.DefaultErrorHandler; fRuleEnd := TRuleEndElem.Create( fGrammar); fRuleBlock := rb; fBlocks.Push( TBlockContext.Create); Context.Block := rb; rs.Block := rb; rb.EndElem := fRuleEnd; fNested := 0; end; // ============================================================================ // ============================================================================ // defineUses // ============================================================================ procedure TGrammarMaker.defineUses(pUses: AnsiString); begin fUsesList.Add( pUses); end; // ============================================================================ // ============================================================================ // EndAlt // ============================================================================ procedure TGrammarMaker.EndAlt; begin // --------------------------------------------------------------- // All rule-level alts link to ruleEnd // --------------------------------------------------------------- if fNested = 0 then addElemToCurrentAlt( fRuleEnd) else addElemToCurrentAlt( Context.BlockEnd); Context.AltNum := Context.AltNum +1; end; // ============================================================================ // ============================================================================ // endExceptionGroup // ============================================================================ procedure TGrammarMaker.endExceptionGroup; begin end; // ============================================================================ // ============================================================================ // endExceptionSpec // ============================================================================ procedure TGrammarMaker.endExceptionSpec; var rb : IRuleBlock; begin (* if fCurrentExceptionSpec = nil then fTool.Panic( 'Exception processing internal error - no active exception spec'); // --------------------------------------------------------------- // Named rule // --------------------------------------------------------------- if Context.Block.QueryInterface( IRuleBlock, rb) = S_OK then rb.AddExceptionSpec(fCurrentExceptionSpec) // --------------------------------------------------------------- // It must be a plain-old alternative block // --------------------------------------------------------------- else if Context.CurrentAlt.ExceptionSpec <> nil then fTool.Error('Alternative already has an exception specification', fGrammar.GrammarFile, Context.Block.Line, Context.Block.Column) else Context.CurrentAlt.ExceptionSpec := fCurrentExceptionSpec; fCurrentExceptionSpec := nil; *) end; // ============================================================================ // ============================================================================ // endGrammar // ============================================================================ procedure TGrammarMaker.endGrammar; begin if fGrammarError then AbortGrammar; end; // ============================================================================ // ============================================================================ // endRule // ============================================================================ procedure TGrammarMaker.endRule(pRule: AnsiString); var ctx : TBlockContext; begin // --------------------------------------------------------------- // Remove scope // --------------------------------------------------------------- ctx := fBlocks.Extract; // ctx := fBlocks.Pop as TBlockContext; // --------------------------------------------------------------- // Record the start of this block in the ending node. // --------------------------------------------------------------- fRuleEnd.Block := ctx.Block; fRuleEnd.Block.PrepareForAnalysis; end; // ============================================================================ // ============================================================================ // endSubRule // ============================================================================ procedure TGrammarMaker.endSubRule; var ctx : TBlockContext; ab : IAlternativeBlock; syn : ISynPredBlock; zom : IZeroOrMoreBlock; oom : IOneOrMoreBlock; begin DEC( fNested); // --------------------------------------------------------------- // Remove subrule context from scope stack. // --------------------------------------------------------------- // ctx := fBlocks.Pop as TBlockContext; ctx := fBlocks.Extract; ab := ctx.Block; // --------------------------------------------------------------- // If the subrule is marked with ~, check that it is a valid // candidate forn analysis. // --------------------------------------------------------------- ab.QueryInterface( ISynPredBlock, syn); ab.QueryInterface( IZeroOrMoreBlock, zom); ab.QueryInterface( IOneOrMoreBlock, oom); if ab.IsNot and (syn = nil) and (zom = nil) and (oom = nil) then begin if not fAnalyzer.SubRuleCanBeInverted( ab, fIsLexer) then begin fTool.Error( MSG_E_NONINVSUBRULE, fGrammar.GrammarFile, ab.Line, ab.Column); end; end; // --------------------------------------------------------------- // Add the subrule as element if not a synpred // --------------------------------------------------------------- if syn <> nil then begin // ------------------------------------------------------------ // Record a reference to the recently-recognized syn pred in // the enclosing block. // ------------------------------------------------------------ Context.Block.HasASynPred := true; Context.CurrentAlt.SynPred := syn; fGrammar.HasSynPred := true; syn.RemoveTracking( fGrammar); end else addElemToCurrentAlt( ab); ctx.BlockEnd.Block.PrepareForAnalysis; end; // ============================================================================ // ============================================================================ // HasError // ============================================================================ procedure TGrammarMaker.HasError; begin fGrammarError := true; end; // ============================================================================ // ============================================================================ // OneOrMoreSubRule // ============================================================================ procedure TGrammarMaker.OneOrMoreSubRule; var oom: IOneOrMoreBlock; old: TBlockContext; begin if Context.Block.IsNot then begin // fTool.Error( '"~" cannot be applied to (...)+ subrule', fTool.Error( MSG_E_NONINVOOM, fGrammar.GrammarFile, Context.Block.Line, Context.Block.Column); end; // --------------------------------------------------------------- // Create the right kind of object now that we know that is and // switch the list of alternatives. Adjust the stack of blocks. // Copy any init action also. // --------------------------------------------------------------- oom := TOneOrMoreBlock.Create( fGrammar); setBlock( oom, Context.Block); // old := fBlocks.Pop as TBlockContext; old := fBlocks.Extract; fBlocks.Push( TBlockContext.Create); Context.Block := oom; Context.BlockEnd := old.BlockEnd; Context.BlockEnd.Block := oom; fRuleBlock.OneOrMoreBlocks.Add( oom); end; // ================================================================================================ // MToNSubrule // ================================================================================================ procedure TGrammarMaker.NMSubRule; var NM : INMBlock; old : TBlockContext; begin if Context.Block.IsNot then begin // fTool.Error( '"~" cannot be applied to (...)@ subrule', fTool.Error( MSG_E_NONINVN2M, fGrammar.GrammarFile, Context.Block.Line, Context.Block.Column); end; // --------------------------------------------------------------- // Create the right kind of object now that we know that is and // switch the list of alternatives. Adjust the stack of blocks. // Copy any init action also. // --------------------------------------------------------------- NM := TNMBlock.Create( fGrammar); setBlock( NM, Context.Block); // old := fBlocks.Pop as TBlockContext; old := fBlocks.Extract; fBlocks.Push( TBlockContext.Create); Context.Block := NM; Context.BlockEnd := old.BlockEnd; Context.BlockEnd.Block := NM; fRuleBlock.NMBlocks.Add( NM); end; // ============================================================================ // ============================================================================ // OptionalSubRule // ============================================================================ procedure TGrammarMaker.OptionalSubRule; begin if Context.Block.IsNot then begin fTool.Error( MSG_E_NONINVZOO, fGrammar.GrammarFile, Context.Block.Line, Context.Block.Column); end; // --------------------------------------------------------------- // Convert (X)? -> (X|) so that we can ignore optional blocks // altogether. It already thinks that we have a simple subrule, // just add option block. // --------------------------------------------------------------- BeginAlt( false); EndAlt; end; // ============================================================================ // ============================================================================ // refAction // ============================================================================ procedure TGrammarMaker.refAction(pAction: IToken); begin Context.Block.HasAnAction := true; addElemToCurrentAlt( TActionElem.Create( fGrammar, pAction)); end; // ================================================================================================ // RefRangeLow // ================================================================================================ procedure TGrammarMaker.RefRangeLow( M: integer); var NM: INMBlock; begin Context.Block.QueryInterface( INMBlock, NM); NM.Low := M; NM.High := M; end; // ================================================================================================ // RefRangeHigh // ================================================================================================ procedure TGrammarMaker.RefRangeHigh( N: integer); var NM: INMBlock; begin Context.Block.QueryInterface( INMBlock, NM); NM.High := N; end; // ============================================================================ // ============================================================================ // RefArgAction // ============================================================================ procedure TGrammarMaker.RefArgAction(pAction: IToken); var rb: IRuleBlock; begin Context.Block.QueryInterface( IRuleBlock, rb); rb.Arguments := pAction.TokenText; end; // ============================================================================ // ============================================================================ // refCharLiteral // ============================================================================ procedure TGrammarMaker.refCharLiteral( pLiteral : IToken; pLabel : IToken; pInverted : boolean; pAutoGenType: integer; pLastInRule : boolean); var cl : ICharLiteralElem; ignore: AnsiString; begin // --------------------------------------------------------------- // Character literal only valid in lexer grammar! // --------------------------------------------------------------- if not fIsLexer then begin fTool.Error( MSG_E_CHARINPARSER, fGrammar.GrammarFile, pLiteral.TokenLine, pLiteral.TokenColumn); exit; end; cl := TCharLiteralElem.Create( fLexerGrammar, pLiteral, pInverted, pAutoGenType); AddElemToCurrentAlt( cl); LabelElem( cl, pLabel); // --------------------------------------------------------------- // If ignore option is set, must add an optional call to the // specified rule. // --------------------------------------------------------------- ignore := fRuleBlock.IgnoreRule; if (not pLastInRule) and (ignore <> '') then AddElemToCurrentAlt( CreateOptionalRuleRef( ignore, pLiteral)); end; // ============================================================================ // ============================================================================ // RefCharRange // ============================================================================ procedure TGrammarMaker.RefCharRange( pToken1 : IToken; pToken2 : IToken; pLabel : IToken; pAutoGenType: integer; pLastInRule : boolean); var // lg : ILexerGrammar; cr : ICharRangeElem; rangeMin : integer; rangeMax : integer; ignore : AnsiString; begin // --------------------------------------------------------------- // Character range only valid in lexer // --------------------------------------------------------------- if not fIsLexer then begin fTool.Error(MSG_E_CHARRANGEINPARSER, fGrammar.GrammarFile, pToken1.TokenLine, pToken1.TokenColumn); exit; end; // rangeMin := TLexer.TokenTypeForCharLiteral( pToken1.TokenText); // rangeMax := TLexer.TokenTypeForCharLiteral( pToken2.TokenText); rangeMin := pToken1.TokenType; rangeMax := pToken2.TokenType; if rangeMax < rangeMin then begin fTool.Error(MSG_E_MALFORMEDRANGE, fGrammar.GrammarFile, pToken1.TokenLine, pToken2.TokenColumn); exit; end; // --------------------------------------------------------------- // Generate a warning for non-lowercase ASCII when case-insensitive // (Later...) // --------------------------------------------------------------- { TODO : Case sensitive thing in refCharRange } cr := TCharRangeElem.Create( fGrammar, pToken1, pToken2, pAutoGenType); addElemToCurrentAlt( cr); labelElem( cr, pLabel); // --------------------------------------------------------------- // If ignore option is set, must add an optional call to the // specified rule. // --------------------------------------------------------------- ignore := fRuleBlock.IgnoreRule; if (not pLastInRule) and (ignore <> '') then AddElemToCurrentAlt( createOptionalRuleRef( ignore, pToken1)); end; // ============================================================================ // ============================================================================ // refTokenSpecElemOption // ============================================================================ procedure TGrammarMaker.refTokenSpecElemOption( pToken : IToken; pOption : IToken; pValue : IToken); var ts: ITokenSymbol; begin ts := fGrammar.TokenManager.TokenSymbol[pToken.TokenText]; if ts <> nil then if pOption.TokenText = 'AST' then ts.ASTNodeType := pValue.TokenText else fTool.Error( Format( MSG_E_ILLEGALTOKENSOPT, [pOption.TokenText]), fGrammar.GrammarFile, pOption.TokenLine, pOption.TokenColumn) else fTool.Panic( Format( MSG_E_NOTOKENSTOKEN, [pToken.TokenText])); end; // ================================================================================================ // refElemOption // ================================================================================================ procedure TGrammarMaker.refElemOption( pOption : IToken; pValue : IToken); var sl : IStringLiteralElem; tr : ITokenRefElem; wc : IWildcardElem; ga : IGrammarAtom; e : IAlternativeElem; begin e := Context.CurrentElem; e.QueryInterface( IStringLiteralElem, sl); e.QueryInterface( ITokenRefElem, tr); e.QueryInterface( IWildCardElem, wc); e.QueryInterface( IGrammarAtom, ga); if (sl <> nil) or (tr <> nil) or (wc <> nil) then ga.SetOption( pOption, pValue) else fTool.Error( Format( MSG_E_ILLEGALELEMOPT, [pOption.TokenText]), fGrammar.GrammarFile, pOption.TokenLine, pOption.TokenColumn); end; // ============================================================================ // ============================================================================ // refExceptionHandler // // Add an exception handler to an exception spec. // ============================================================================ procedure TGrammarMaker.refExceptionHandler( pTypeAndName : IToken; pAction : IToken); begin if fCurrentExceptionSpec = nil then fTool.Panic('Exception handler processing internal error...') else fCurrentExceptionSpec.AddHandler( TExceptionHandler.Create( pTypeAndName, pAction)); end; // ============================================================================ // ============================================================================ // refInitAction // ============================================================================ procedure TGrammarMaker.refInitAction(pAction: IToken); begin Context.Block.InitAction := pAction.TokenText; end; // ============================================================================ // ============================================================================ // refReturnAction // ============================================================================ procedure TGrammarMaker.refReturnAction(pAction: IToken); var rb : IRuleBlock; rs : IRuleSymbol; name : AnsiString; begin Context.Block.QueryInterface( IRuleBlock, rb); if fIsLexer then begin name := TCodeGenerator.encodeLexerRuleName( rb.RuleName); fGrammar.Symbol[name].QueryInterface(IRuleSymbol,rs); if rs.Access = 'public' then begin fTool.Warning(MSG_W_LEXPUBLICRETURN, fGrammar.GrammarFile, pAction.TokenLine, pAction.TokenColumn); exit; end; end; rb.ReturnAction := pAction.TokenText; end; // ============================================================================ // ============================================================================ // refRule // ============================================================================ procedure TGrammarMaker.refRule( pAssignId : IToken; pRuleName : IToken; pLabel : IToken; pArguments : IToken; pAutoGenType : integer); var // lg: ILexerGrammar; id: AnsiString; rs: IRuleSymbol; begin // --------------------------------------------------------------- // Disallow parser rule references in the lexer. // --------------------------------------------------------------- if fIsLexer then begin if pRuleName.TokenType <> TT_TOKENREF then begin fTool.Error( Format( MSG_E_PARSERRULEINLEXER, [pRuleName.TokenText]), fGrammar.GrammarFile, pRuleName.TokenLine, pRuleName.TokenColumn); exit; end; if pAutoGenType = AUTOGEN_CARET then begin fTool.Error( MSG_E_ASTINLEXER, fGrammar.GrammarFile, pRuleName.TokenLine, pRuleName.TokenColumn); end; end; inherited; fLastRuleRef := TRuleRefElem.Create( fGrammar, pRuleName, pAutoGenType); if pArguments <> nil then fLastRuleRef.Args := pArguments.TokenText; if pAssignId <> nil then fLastRuleRef.IdAssign := pAssignId.TokenText; addElemToCurrentAlt( fLastRuleRef); if pRuleName.TokenType = TT_TOKENREF then id := TCodeGenerator.encodeLexerRuleName( pRuleName.TokenText) else id := pRuleName.TokenText; fGrammar.Symbol[id].QueryInterface( IRuleSymbol, rs); rs.AddReference( fLastRuleRef); LabelElem( fLastRuleRef, pLabel); end; // ============================================================================ // ============================================================================ // RefSemPred // ============================================================================ procedure TGrammarMaker.RefSemPred(pSemPred: IToken); var ae : IActionElem; begin if Context.CurrentAlt.AtStart then Context.CurrentAlt.SemPred := pSemPred.TokenText else begin ae := TActionElem.Create( fGrammar, pSemPred); ae.IsSemPred := true; addElemToCurrentAlt( ae); end; end; // ============================================================================ // ============================================================================ // refStringLiteral // ============================================================================ procedure TGrammarMaker.refStringLiteral( pLiteral : IToken; pLabel : IToken; pAutoGenType: integer; pLastInRule : boolean); var // tg : ITreeWalkerGrammar; // lg : ILexerGrammar; sl : IStringLiteralElem; ignore: AnsiString; begin inherited; if Supports( fGrammar, ITreeWalkerGrammar) then begin if pAutoGenType = AUTOGEN_CARET then fTool.Error( '^ not allowed here', fGrammar.GrammarFile, pLiteral.TokenLine, pLiteral.TokenColumn); end; sl := TStringLiteralElem.Create( fGrammar, pLiteral, pAutoGenType); addElemToCurrentAlt( sl); labelElem( sl, pLabel); // --------------------------------------------------------------- // if ignore option is set, must add an optional call to the // specified rule. // --------------------------------------------------------------- ignore := fRuleBlock.IgnoreRule; if (not pLastInRule) and (ignore <> '') then AddElemToCurrentAlt( CreateOptionalRuleRef( ignore, pLiteral)); end; // ============================================================================ // ============================================================================ // RefToken // ============================================================================ procedure TGrammarMaker.RefToken( pAssignId : IToken; pToken : IToken; pLabel : IToken; pArguments : IToken; pInverted : boolean; pAutoGenType : integer; pLastInRule : boolean); var te : ITokenRefElem; ignore: AnsiString; begin if fIsLexer then begin if pAutoGenType = AUTOGEN_CARET then begin fTool.Error(MSG_E_ASTINLEXER, fGrammar.GrammarFile, pToken.TokenLine, pToken.TokenColumn); end; if pInverted then begin fTool.Error(MSG_E_INVTOKENINLEXER, fGrammar.GrammarFile, pToken.TokenLine, pToken.TokenColumn); end; RefRule( pAssignId, pToken, pLabel, pArguments, pAutoGenType); // ------------------------------------------------------------ // if ignore option is set, must add an optional call to the // specified rule. // ------------------------------------------------------------ ignore := fRuleBlock.IgnoreRule; if (not pLastInRule) and (ignore <> '') then AddElemToCurrentAlt( CreateOptionalRuleRef( ignore, pToken)); end else begin // ------------------------------------------------------------ // Cannot have token ref args or assignment outside of a lexer // ------------------------------------------------------------ if pAssignId <> nil then begin fTool.Error(MSG_E_INVTOKENREFINLEXER, fGrammar.GrammarFile, pAssignId.TokenLine, pAssignId.TokenColumn); end; if pArguments <> nil then begin fTool.Error(MSG_E_INVTOKENPARAMLEXER, fGrammar.GrammarFile, pArguments.TokenLine, pArguments.TokenColumn); end; inherited; te := TTokenRefElem.Create( fGrammar, pToken, pInverted, pAutoGenType); AddElemToCurrentAlt(te); LabelElem(te, pLabel); end; end; // ============================================================================ // ============================================================================ // RefTokenRange // ============================================================================ procedure TGrammarMaker.RefTokenRange( pToken1 : IToken; pToken2 : IToken; pLabel : IToken; pAutoGenType: integer; pLastInRule : boolean); var // lg : ILexerGrammar; tr : ITokenRangeElem; begin if fIsLexer then begin fTool.Error(MSG_E_TOKENRANGEINLEXER, fGrammar.GrammarFile, pToken1.TokenLine, pToken1.TokenColumn); exit; end; inherited; if pToken1.TokenType < pToken2.TokenType then tr := TTokenRangeElem.Create( fGrammar, pToken1, pToken2, pAutoGenType) else begin fTool.Error(MSG_E_MALFORMEDRANGE, fGrammar.GrammarFile, pToken1.TokenLine, pToken2.TokenColumn); exit; end; AddElemToCurrentAlt( tr); LabelElem( tr, pLabel); end; // ============================================================================ // ============================================================================ // RefWildCard // ============================================================================ procedure TGrammarMaker.RefWildCard( pToken : IToken; pLabel : IToken; pAutoGenType: integer); var wc : IWildcardElem; begin wc := TWildcardElem.Create(fGrammar, pToken, pAutoGenType); AddElemToCurrentAlt(wc); LabelElem(wc, pLabel); end; // ============================================================================ // ============================================================================ // Reset // ============================================================================ procedure TGrammarMaker.Reset; begin inherited; if fBlocks <> nil then fBlocks.Free; // fBlocks := TObjectStack.Create; fBlocks := TContextStack.Create; fLastRuleRef := nil; fRuleEnd := nil; fRuleBlock := nil; fCurrentExceptionSpec := nil; fNested := 0; fGrammarError := false; end; // ============================================================================ // ============================================================================ // SetArgOfRuleRef // ============================================================================ procedure TGrammarMaker.setArgOfRuleRef(pArguments: IToken); begin fLastRuleRef.Args := pArguments.TokenText; end; // ============================================================================ // ============================================================================ // SetRuleOption // ============================================================================ procedure TGrammarMaker.SetRuleOption(pOption, pValue: IToken); begin fRuleBlock.SetOption( pOption, pValue); end; // ============================================================================ // ============================================================================ // SetSubRuleOption // ============================================================================ procedure TGrammarMaker.SetSubRuleOption(pOption, pValue: IToken); begin Context.Block.SetOption( pOption, pValue); end; // ============================================================================ // ============================================================================ // ZeroOrMoreSubRule // ============================================================================ procedure TGrammarMaker.ZeroOrMoreSubRule; var zb : IZeroOrMoreBlock; old: TBlockContext; begin if Context.Block.IsNot then begin fTool.Error(MSG_E_NONINVZOM, fGrammar.GrammarFile, Context.Block.Line, Context.Block.Column); end; // --------------------------------------------------------------- // Create the right kind of object now that we know what that is // and switch the list of alternatives. Adjust the stack of blocks. // Copy any init action also. // --------------------------------------------------------------- zb := TZeroOrMoreBlock.Create( fGrammar); SetBlock( zb, Context.Block); // old := fBlocks.Pop as TBlockContext; old := fBlocks.Extract; fBlocks.Push( TBlockContext.Create); Context.Block := zb; Context.BlockEnd := old.BlockEnd; Context.BlockEnd.Block := zb; end; // ============================================================================ // ============================================================================ // SynPred // ============================================================================ procedure TGrammarMaker.SynPred; var alt: IAlternative; sb : ISynPredBlock; old: TBlockContext; begin alt := nil; if Context.Block.IsNot then begin fTool.Error(MSG_E_NONINVSYNTPRED, fGrammar.GrammarFile, Context.Block.Line, Context.Block.Column); end; // --------------------------------------------------------------- // Create the right kind of object now that we know what that is // and switch the list of alternatives. Adjust the stack of blocks. // Copy any init action also. // --------------------------------------------------------------- sb := TSynPredBlock.Create( fGrammar); SetBlock( sb, Context.Block); // old := fBlocks.Pop as TBlockContext; old := fBlocks.Extract; fBlocks.Push( TBlockContext.Create); Context.Block := sb; Context.BlockEnd := old.BlockEnd; Context.BlockEnd.Block := sb; fRuleBlock.HasASynPred := true; fRuleBlock.SynPredBlocks.Add( sb); end; // ============================================================================ // ============================================================================ // SetUserExceptions // ============================================================================ procedure TGrammarMaker.SetUserExceptions( pThrow: AnsiString); //var // rb: IRuleBlock; begin // Context.Block.QueryInterface(IRuleBlock,rb); // rb.ThrowSpec := pThrow; end; // **************************************************************************** // Internals // **************************************************************************** // ============================================================================ // ============================================================================ // Context // ============================================================================ function TGrammarMaker.Context: TBlockContext; begin if fBlocks.Count <> 0 then result := fBlocks.Peek else result := nil; end; // ============================================================================ // ============================================================================ // LabelElem // ============================================================================ procedure TGrammarMaker.LabelElem( pElem : IAlternativeElem; pLabel: IToken); var elem : IAlternativeElem; i : integer; l : AnsiString; begin if pLabel <> nil then begin for i:=0 to fRuleBlock.LabeledElems.Count -1 do begin fRuleBlock.LabeledElems.Items[i].QueryInterface(IAlternativeElem,elem); l := elem.Lbl; // --------------------------------------------------------- // If the label already defined -> error, exit // RM. Why??? I want to allow it. Maximum give a warning, but // not for 'result' label. // --------------------------------------------------------- if (l<>'') and (l = pLabel.TokenText) and (l<>'result') then begin // fTool.Warning( 'Label "' + l + '" has already been defined', // fGrammar.GrammarFile, // pLabel.TokenLine, // pLabel.TokenColumn); end; end; // --------------------------------------------------------- // Add this node to the list of labeled elems // --------------------------------------------------------- pElem.Lbl := pLabel.TokenText; fRuleBlock.LabeledElems.Add( pElem); end; end; // **************************************************************************** // Class methods // **************************************************************************** // ================================================================================================ // CreateNextTokenRule // ================================================================================================ class function TGrammarMaker.CreateNextTokenRule( pGrammar : IGrammar; pLexRules : TInterfaceList; pRuleName : AnsiString): IRuleBlock; var alt : IAlternative; rb : IRuleBlock; re : IRuleEndElem; rr : IRuleRefElem; rs : IRuleSymbol; i : integer; rname : AnsiString; begin // --------------------------------------------------------------- // Create actual rule data structure // --------------------------------------------------------------- rb := TRuleBlock.Create( pGrammar, pRuleName); re := TRuleEndElem.Create( pGrammar); rb.DefaultErrorHandler := pGrammar.DefaultErrorHandler; rb.EndElem := re; re.Block := rb; // --------------------------------------------------------------- // Add an alternative for each element of the rules vector. // --------------------------------------------------------------- for i:=0 to pLexRules.Count-1 do begin pLexRules.Items[i].QueryInterface(IRuleSymbol,rs); if not rs.Defined then begin rname := TDelphiGenerator.decodeLexerRuleName( rs.ID); pGrammar.Tool.Error( Format( MSG_E_LEXRULENOTDEFINED, [rname]), pGrammar.GrammarFile, -2, 0); end else begin // --------------------------------------------------------- // Create a rule ref to lexer rule. // The Token is a TT_RULEREF not a TT_TOKENREF since // conversion to mRuleName has alread taken place. // --------------------------------------------------------- if rs.Access = 'public' then begin rr := TRuleRefElem.Create( pGrammar, TToken.Create(TT_RULEREF, rs.ID), AUTOGEN_NONE); rr.Lbl := 'result'; rr.EnclosingRule := 'NextToken'; rr.Next := re; alt := TAlternative.Create( rr); alt.DoAutoGen := true; rb.AddAlternative( alt); rs.AddReference( rr); end end end; rb.AutoGen := true; rb.PrepareForAnalysis; result := rb end; // ============================================================================ // ============================================================================ // CreateOptionalRuleRef // // Return block as if they had typed: "( rule )?" // ============================================================================ function TGrammarMaker.CreateOptionalRuleRef( pRule : AnsiString; pStart : IToken): IAlternativeBlock; var alt : IAlternative; optAlt : IAlternative; ab : IAlternativeBlock; be : IBlockEndElem; t : IToken; rr : IRuleRefElem; mrule : AnsiString; begin // --------------------------------------------------------------- // Make the subrule // --------------------------------------------------------------- ab := TAlternativeBlock.Create( fGrammar, pStart, false); // --------------------------------------------------------------- // Make sure the rule is defined. // --------------------------------------------------------------- mRule := TCodeGenerator.encodeLexerRuleName( pRule); if not fGrammar.Defined( mrule) then fGrammar.Define( TRuleSymbol.Create(mrule)); // --------------------------------------------------------------- // Make the rule ref elem. // --------------------------------------------------------------- t := TToken.Create( TT_TOKENREF, pRule); t.TokenLine := pStart.TokenLine; t.TokenColumn := pStart.TokenColumn; rr := TRuleRefElem.Create( fGrammar, t, AUTOGEN_NONE); rr.EnclosingRule := fRuleBlock.RuleName; // --------------------------------------------------------------- // Make the end of block elem. // --------------------------------------------------------------- be := TBlockEndElem.Create( fGrammar); be.Block := ab; // --------------------------------------------------------------- // Make an alternative, putting the rule ref into it. // --------------------------------------------------------------- alt := TAlternative.Create( rr); alt.AddElem( be); // --------------------------------------------------------------- // Add the alternative to this block. // --------------------------------------------------------------- ab.AddAlternative( alt); // --------------------------------------------------------------- // Create an empty (optional) alt and add to 'ab' // --------------------------------------------------------------- optAlt := TAlternative.Create; optAlt.AddElem( be); ab.AddAlternative(optAlt); ab.PrepareForAnalysis; result := ab; end; // ============================================================================ // ============================================================================ // SetBlock // ============================================================================ procedure TGrammarMaker.SetBlock(pDst, pSrc: IAlternativeBlock); begin pDst.Alternatives := pSrc.Alternatives; pDst.InitAction := pSrc.InitAction; pDst.Lbl := pSrc.Lbl; pDst.HasASynPred := pSrc.HasASynPred; pDst.HasAnAction := pSrc.HasAnAction; pDst.WarnFollowAmbig := pSrc.WarnFollowAmbig; pDst.GenAmbigWarnings:= pSrc.GenAmbigWarnings; pDst.Line := pSrc.Line; pDst.Greedy := pSrc.Greedy; pDst.GreedySet := pSrc.GreedySet; end; // ============================================================================ // ============================================================================ // NoAutoGenSubRule // ============================================================================ procedure TGrammarMaker.NoAutoGenSubRule; begin Context.Block.AutoGen := false; end; // ============================================================================ // ============================================================================ // refRuleLocals // ============================================================================ procedure TGrammarMaker.RefRuleLocals(pLocals: IToken); begin fRuleBlock.Locals := pLocals.TokenText; end; // ============================================================================ // RefRuleExHandler // ============================================================================ procedure TGrammarMaker.RefRuleExHandler( pExHandlerType: IToken; pExHandlerCode: IToken); begin fRuleBlock.ExHandlerType := pExHandlerType.TokenText; fRuleBlock.ExHandlerCode := pExHandlerCode.TokenText; end; // ============================================================================ // RefAltExHandler // ============================================================================ procedure TGrammarMaker.RefAltExHandler( pExHandlerType: IToken; pExHandlerCode: IToken); begin Context.CurrentAlt.ExHandlerType := pExHandlerType.TokenText; Context.CurrentAlt.ExHandlerCode := pExHandlerCode.TokenText; end; // @@@: AST stuff +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ // ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ // ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ // // AST stuff // // ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ // ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ // ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ // ================================================================================================ // Begin Tree // ================================================================================================ procedure TGrammarMaker.BeginTree( pStart: IToken); begin if Supports( fGrammar, ITreeWalkerGrammar) then begin fBlocks.Push( TTreeBlockContext.Create); Context.Block := TTreeElem.Create(fGrammar, pStart, true); Context.AltNum := 0; end; end; // ================================================================================================ // Begin Child List // ================================================================================================ procedure TGrammarMaker.BeginChildList; begin Context.Block.AddAlternative( TAlternative.Create); end; // ================================================================================================ // End Child List // ================================================================================================ procedure TGrammarMaker.EndChildList; var be: IBlockEndElem; begin // ---------------------------------------------------------------- // create a final node to which the last elememt of the single // alternative will point. Done for compatibility with analyzer. // Does NOT point to any block like alternative blocks because the // TreeElement is not a block. This is used only as a placeholder. // ---------------------------------------------------------------- be := TBlockEndElem.Create( fGrammar); be.Block := Context.Block; AddElemToCurrentAlt(be); end; // ================================================================================================ // End Tree // ================================================================================================ procedure TGrammarMaker.EndTree; var ctx: TBlockContext; begin ctx := fBlocks.Extract; AddElemToCurrentAlt(ctx.Block); // TODO: ctx.free here ??? end; end.