Files
bds.mr.dpg/src.lib/dpglib.GrammarMaker.pas
T
2026-01-03 18:33:48 +01:00

1716 lines
62 KiB
ObjectPascal

unit dpglib.GrammarMaker;
interface
uses
System.Classes,
System.Contnrs,
Generics.Collections,
System.AnsiStrings,
dpgrtl.types,
dpglib.Types,
dpglib.GrammarBehavior,
dpglib.BlockContext;
type
TContextStack = TObjectStack<TBlockContext>;
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.