3476 lines
112 KiB
ObjectPascal
3476 lines
112 KiB
ObjectPascal
unit dpglib.DelphiGenerator;
|
|
|
|
interface
|
|
uses
|
|
System.Classes,
|
|
System.SysUtils,
|
|
dpgrtl.types,
|
|
dpglib.Utils,
|
|
dpglib.Types,
|
|
dpglib.CodeGenerator,
|
|
dpglib.DelphiCharFormatter,
|
|
dpglib.DelphiBlockFinishingInfo;
|
|
|
|
type
|
|
// -------------------------------------------------------------------------
|
|
// TDelphiGenerator class declaration
|
|
// -------------------------------------------------------------------------
|
|
TDelphiGenerator = class( TCodeGenerator,
|
|
ICodeGenerator)
|
|
|
|
protected
|
|
fSaveText : boolean;
|
|
fSyntacticPredLevel : integer;
|
|
|
|
// ------------------------------------------------------------
|
|
// Grammar parameters set up to handle different grammar classes.
|
|
// There are used to get instance of tests out of code generation.
|
|
// ------------------------------------------------------------
|
|
fLabeledElemType : AnsiString;
|
|
fLabeledElemInit : AnsiString;
|
|
|
|
fCommonExtraArgs : AnsiString;
|
|
fCommonExtraParams : AnsiString;
|
|
fCommonLocalVars : AnsiString;
|
|
|
|
fLT1Value : AnsiString;
|
|
|
|
fExceptionThrown : AnsiString;
|
|
fThrowNoViable : AnsiString;
|
|
|
|
fSemPreds : TStringList;
|
|
|
|
// ------------------------------------------------------------
|
|
// AST studd
|
|
// ------------------------------------------------------------
|
|
fCurrentASTResult : AnsiString;
|
|
|
|
|
|
// ------------------------------------------------------------
|
|
// Tracks the rule being generated. Used for mapTreeId.
|
|
// ------------------------------------------------------------
|
|
fCurrentRule : IRuleBlock;
|
|
|
|
function altIsEmpty( pAlt: IAlternative) : boolean;
|
|
function throw( pLA1: ILookahead) : AnsiString;
|
|
|
|
function needsLexerInit : boolean;
|
|
|
|
private
|
|
// function suitableForCaseExpression( pAlt: IAlternative): boolean;
|
|
function lookaheadIsEmpty( pAlt: IAlternative; pMaxDepth: integer): boolean;
|
|
// function lookaheadString( pK: integer): AnsiString;
|
|
|
|
procedure genRule( pRuleSymbol : IRuleSymbol);
|
|
procedure genSemPred( pSemPred : AnsiString);
|
|
procedure genSynPred( pBlock : ISynPredBlock;
|
|
pLookaheadExpr : AnsiString);
|
|
function genCommonBlock( pBlock : IAlternativeBlock;
|
|
pNoTestForSingle : boolean) : TDelphiBlockFinishingInfo;
|
|
procedure genBlockFinish( pHowToFinish : TDelphiBlockFinishingInfo;
|
|
pNoViableAction : AnsiString;
|
|
pSingleLine : boolean = false);
|
|
|
|
protected
|
|
GenAST : boolean;
|
|
|
|
protected
|
|
// ------------------------------------------------------------
|
|
// Internals
|
|
// ------------------------------------------------------------
|
|
procedure genTokens;
|
|
procedure genUses;
|
|
procedure genUses2;
|
|
procedure genClassDecl;
|
|
procedure genMethodDecl( pRuleSymbol : IRuleSymbol;
|
|
pLength : integer=0;
|
|
pFull : boolean=true);
|
|
procedure genClassDef;
|
|
procedure genRuleLocals( pRuleBlock: IRuleBlock);
|
|
procedure genInitLiterals;
|
|
procedure genNextToken;
|
|
|
|
procedure genLiteralsTest;
|
|
procedure genLiteralsTestForPartialToken;
|
|
procedure genBlockInitAction( pBlock : IAlternativeBlock);
|
|
|
|
procedure genRuleInvocation( pRuleRefElem : IRuleRefElem);
|
|
procedure genAlt( pAlt : IAlternative;
|
|
pBlk : IAlternativeBlock);
|
|
|
|
// ------------------------------------------------------------
|
|
// ICodeGenerator overrides
|
|
// ------------------------------------------------------------
|
|
procedure Gen( pGrammar : IGrammar); overload; override;
|
|
|
|
|
|
|
|
|
|
procedure genMatch( pAtom : IGrammarAtom);
|
|
procedure genMatchUsingAtomText( pAtom : IGrammarAtom);
|
|
procedure genMatchUsingAtomTokenType(pAtom : IGrammarAtom);
|
|
|
|
function getValueString( pType : integer): AnsiString;
|
|
|
|
|
|
procedure genPredictExpr( pLaList : TInterfaceList;
|
|
pLaDepth : integer);
|
|
|
|
|
|
|
|
protected
|
|
procedure Gen( pAction : IActionElem); overload; override;
|
|
procedure Gen( pBlock : IAlternativeBlock); overload; override;
|
|
procedure Gen( pEnd : IBlockEndElem); overload; override;
|
|
procedure Gen( pAtom : ICharLiteralElem); overload; override;
|
|
procedure Gen( pAtom : ICharRangeElem); overload; override;
|
|
procedure Gen( pAtom : IGrammarAtom); overload; override;
|
|
procedure Gen( pBlk : IRuleBlock); overload; override;
|
|
procedure Gen( pElem : IRuleEndElem); overload; override;
|
|
procedure Gen( pRuleRef : IRuleRefElem); overload; override;
|
|
procedure Gen( pAtom : IStringLiteralElem); overload; override;
|
|
procedure Gen( pBlk : ISynPredBlock); overload; override;
|
|
procedure Gen( pTokenRef: ITokenRefElem); overload; override;
|
|
procedure Gen( pElem : ITokenRangeElem); overload; override;
|
|
procedure Gen( pBlock : IOneOrMoreBlock); overload; override;
|
|
procedure Gen( pBlock : INMBlock); overload; override;
|
|
procedure Gen( pWc : IWildcardElem); overload; override;
|
|
procedure Gen( pBlock : IZeroOrMoreBlock); overload; override;
|
|
|
|
|
|
function getLookaheadTestExpr( pAlt : IAlternative;
|
|
pMaxDepth : integer) : AnsiString; overload;
|
|
function getLookaheadTestExpr( pLaList : TInterfaceList;
|
|
pLaDepth : integer) : AnsiString; overload;
|
|
function getLookaheadTestTerm( pK : integer;
|
|
pLA : ILookahead) : AnsiString;
|
|
function getLookaheadString( pK: integer) : AnsiString;
|
|
|
|
protected
|
|
function addSemPred( pSemPred: AnsiString): integer;
|
|
procedure exitIfError;
|
|
|
|
protected
|
|
fIsLexer : boolean;
|
|
fIsParser : boolean;
|
|
fIsTreeWalker : boolean;
|
|
|
|
fLexerGrammar : ILexerGrammar;
|
|
fParserGrammar : IParserGrammar;
|
|
fTreeWalkerGrammar : ITreeWalkerGrammar;
|
|
|
|
public
|
|
constructor Create( OutputDir : AnsiString;
|
|
ExchangeDir : AnsiString);
|
|
destructor Destroy; override;
|
|
|
|
end;
|
|
|
|
|
|
implementation
|
|
uses
|
|
dpglib.GrammarMaker,
|
|
dpglib.RuleSymbol,
|
|
dpglib.Version,
|
|
dpglib.Messages;
|
|
|
|
// ----------------------------------------------------------------------------
|
|
// Constructor
|
|
// ----------------------------------------------------------------------------
|
|
constructor TDelphiGenerator.Create( OutputDir : AnsiString;
|
|
ExchangeDir : AnsiString);
|
|
begin
|
|
inherited;
|
|
|
|
fSaveText := true;
|
|
fSyntacticPredLevel := 0;
|
|
fCharFormatter := TDelphiCharFormatter.Create;
|
|
|
|
fIsLexer := false;
|
|
fIsParser := false;
|
|
fIsTreeWalker := false;
|
|
|
|
fLexerGrammar := nil;
|
|
fParserGrammar := nil;
|
|
fTreeWalkerGrammar := nil;
|
|
|
|
GenAST := false;
|
|
end;
|
|
|
|
// ----------------------------------------------------------------------------
|
|
// Destructor
|
|
// ----------------------------------------------------------------------------
|
|
destructor TDelphiGenerator.Destroy;
|
|
begin
|
|
fLexerGrammar := nil;
|
|
fParserGrammar := nil;
|
|
fTreeWalkerGrammar := nil;
|
|
|
|
fCharFormatter := nil;
|
|
fCurrentRule := nil;
|
|
|
|
FreeAndNil(fSemPreds);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
// ****************************************************************************
|
|
// ICodeGenerator overrides
|
|
// ****************************************************************************
|
|
// ----------------------------------------------------------------------------
|
|
// Gen (grammar)
|
|
// ----------------------------------------------------------------------------
|
|
procedure TDelphiGenerator.Gen(pGrammar: IGrammar);
|
|
begin
|
|
fGrammar := pGrammar;
|
|
fGrammar.Generator := self;
|
|
fAnalyzer := fGrammar.LLkAnalyzer;
|
|
fTool := fGrammar.Tool;
|
|
|
|
fTabs := 0;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Set up internals depending on grammar type
|
|
// ---------------------------------------------------------------
|
|
fGrammar.QueryInterface( ILexerGrammar, fLexerGrammar);
|
|
fGrammar.QueryInterface( IParserGrammar, fParserGrammar);
|
|
fGrammar.QueryInterface( ITreeWalkerGrammar, fTreeWalkerGrammar);
|
|
|
|
if fLexerGrammar <> nil then fIsLexer := true;
|
|
if fParserGrammar <> nil then fIsParser := true;
|
|
if fTreeWalkerGrammar<> nil then fIsTreeWalker := true;
|
|
|
|
if fLexerGrammar <> nil then fLT1Value := 'LA(1)';
|
|
if fParserGrammar <> nil then fLT1Value := 'LT(1)';
|
|
if fTreeWalkerGrammar<> nil then fLT1Value := '_t';
|
|
|
|
fThrowNoViable := 'Raise EMismatchedChar.Create(' +
|
|
'LA(1), _first, InputState.FileName, InputState.Line, InputState.Column);';
|
|
|
|
if Assigned(fParserGrammar)
|
|
then GenAST := fParserGrammar.BuildAST
|
|
else GenAST := false;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate token exchange and token type definition file.
|
|
// ---------------------------------------------------------------
|
|
genTokenExchange;
|
|
genTokens;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Calculate the output file name, and open it.
|
|
// ---------------------------------------------------------------
|
|
fFile := fOutDir + fGrammar.UnitName + '.pas';
|
|
fOutput := TFileStream.Create( fFile, fmCreate);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate red tape
|
|
// ---------------------------------------------------------------
|
|
println('// ============================================================================');
|
|
println('// This file is generated by the Delphi Parser Generator.');
|
|
println('// ----------------------------------------------------------------------------');
|
|
println('// DPG version: ' + version);
|
|
println('// Grammar: ' + fGrammar.GrammarFile);
|
|
println('// ============================================================================');
|
|
println('unit ' + fGrammar.UnitName + ';');
|
|
println('');
|
|
println('interface');
|
|
println('');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate uses clause, class declaration
|
|
// ---------------------------------------------------------------
|
|
genUses;
|
|
genClassDecl;
|
|
|
|
println('');
|
|
println('implementation');
|
|
genUses2;
|
|
println('');
|
|
// println('uses');
|
|
// INC(fTabs);
|
|
// println('dpgException,');
|
|
// println('dpgExceptionSemantic,');
|
|
|
|
// if fIsLexer then
|
|
// println('dpgExceptionMismatchedChar;')
|
|
// else
|
|
// println('dpgExceptionMismatchedToken;');
|
|
|
|
|
|
// DEC(fTabs);
|
|
// println('');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate the class definition
|
|
// ---------------------------------------------------------------
|
|
genClassDef;
|
|
|
|
|
|
println('end.');
|
|
fOutput.Free;
|
|
end;
|
|
|
|
// ****************************************************************************
|
|
// Internals
|
|
// ****************************************************************************
|
|
// ============================================================================
|
|
// Gen(Action) - {...}
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pAction: IActionElem);
|
|
begin
|
|
if pAction.IsSemPred then
|
|
genSemPred( pAction.ActionText)
|
|
|
|
else
|
|
begin
|
|
if fGrammar.HasSynPred then
|
|
begin
|
|
println('');
|
|
println('if InputState.Guessing = 0 then');
|
|
println('begin');
|
|
INC(fTabs);
|
|
end;
|
|
|
|
printAction( pAction.ActionText);
|
|
|
|
if fGrammar.HasSynPred then
|
|
begin
|
|
DEC(fTabs );
|
|
println('end;');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Gen(AlternativeBlock)
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pBlock: IAlternativeBlock);
|
|
var
|
|
htf : TDelphiBlockFinishingInfo;
|
|
cur : AnsiString;
|
|
begin
|
|
genBlockInitAction( pBlock);
|
|
|
|
// Tell AST generation to build subrule result
|
|
cur := fCurrentASTResult;
|
|
if pBlock.Lbl <> '' then
|
|
fCurrentASTResult := pBlock.Lbl;
|
|
|
|
fGrammar.LLkAnalyzer.Deterministic( pBlock);
|
|
|
|
htf := genCommonBlock( pBlock, true);
|
|
genBlockFinish( htf, throw(pBlock.Look(1)), true);
|
|
|
|
// Restore previous AST generation
|
|
fCurrentASTResult := cur;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Gen(CharLiteralElem)
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pAtom: ICharLiteralElem);
|
|
var
|
|
oldSaveText: boolean;
|
|
|
|
begin
|
|
if pAtom.Lbl <> '' then
|
|
println(pAtom.Lbl + ' := ' + fLT1Value + ';');
|
|
|
|
oldSaveText := fSaveText;
|
|
fSaveText := fSaveText and (pAtom.AutoGenType = AUTOGEN_NONE);
|
|
|
|
if oldSaveText and not fSaveText then
|
|
println('SaveConsumedInput := false;');
|
|
|
|
genMatch( pAtom);
|
|
|
|
if oldSaveText and not fSaveText then
|
|
println('SaveConsumedInput := true;');
|
|
|
|
fSaveText := oldSaveText;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Gen(CharRangeElem)
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pAtom: ICharRangeElem);
|
|
var
|
|
oldSaveText: boolean;
|
|
|
|
begin
|
|
if (pAtom.Lbl <> '') and (fSyntacticPredLevel = 0) then
|
|
println(pAtom.Lbl + ':=' + fLT1Value + ';');
|
|
|
|
oldSaveText := fSaveText;
|
|
fSaveText := fSaveText and (pAtom.AutoGenType = AUTOGEN_NONE);
|
|
|
|
if oldSaveText and not fSaveText then
|
|
println('SaveConsumedInput := false;');
|
|
|
|
if pAtom.BeginChar < pAtom.EndChar then
|
|
println('match( [' + CharSetToStr( [pAtom.BeginChar..pAtom.EndChar]) + ']);')
|
|
else
|
|
println('match( [' + CharSetToStr( [pAtom.EndChar..pAtom.BeginChar]) + ']);');
|
|
|
|
if oldSaveText and not fSaveText then
|
|
println('SaveConsumedInput := true;');
|
|
|
|
fSaveText := oldSaveText;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Gen(OneOrMoreBlock) - (...)+
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pBlock: IOneOrMoreBlock);
|
|
var
|
|
i : integer;
|
|
lbl : AnsiString;
|
|
cnt : AnsiString;
|
|
predictExit : AnsiString;
|
|
nonGreedyExitPath : boolean;
|
|
nonGreedyExitDepth: integer;
|
|
laList : TInterfaceList;
|
|
htf : TDelphiBlockFinishingInfo;
|
|
exitBranch : AnsiString;
|
|
|
|
|
|
begin
|
|
if pBlock.Lbl <> '' then
|
|
begin
|
|
cnt := '_cnt_' + pBlock.Lbl;
|
|
lbl := '_loop' + pBlock.Lbl;
|
|
end
|
|
else
|
|
begin
|
|
cnt := '_cnt_' + IntToStr(pBlock.ID);
|
|
lbl := '_loop' + IntToStr(pBlock.ID);
|
|
end;
|
|
|
|
println(cnt + ' := 0;');
|
|
println('');
|
|
println('while(true) do');
|
|
println('begin');
|
|
INC(fTabs);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate init action for (...)+
|
|
// ---------------------------------------------------------------
|
|
genBlockInitAction( pBlock);
|
|
fGrammar.LLkAnalyzer.Deterministic( pBlock);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate exit test if greedy set to false and an alt is ambigous
|
|
// with exit branch or when lookahead derived purely from
|
|
// end-of-file. Lookahead analysis stops when end-of-file is hit,
|
|
// returning set (epsilon). Since (epsilon) is not ambigous with
|
|
// any real tokens, no error is reported by deterministic() routines
|
|
// and we have to check for the case where the lookahead depth
|
|
// didn't get set to NONDETERMINISTIC (this only happens when the
|
|
// FOLLOW contains real atoms + epsilon.
|
|
// ---------------------------------------------------------------
|
|
nonGreedyExitPath := false;
|
|
nonGreedyExitDepth := fGrammar.MaxK;
|
|
|
|
if (not pBlock.Greedy) and
|
|
(pBlock.ExitDepth <= fGrammar.MaxK) and
|
|
pBlock.ExitCache[pBlock.ExitDepth].HasEpsilon then
|
|
begin
|
|
nonGreedyExitPath := true;
|
|
nonGreedyExitDepth:= pBlock.ExitDepth;
|
|
end
|
|
|
|
else if (not pBlock.Greedy) and (pBlock.ExitDepth = NONDETERMINISTIC) then
|
|
nonGreedyExitPath := true;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate exit test if greedy set to false and an alternative
|
|
// is ambiguous with exit branch.
|
|
// ---------------------------------------------------------------
|
|
if nonGreedyExitPath then
|
|
begin
|
|
// ------------------------------------------------------------
|
|
// Generate lookahead test expression
|
|
// ------------------------------------------------------------
|
|
laList := TInterfaceList.Create;
|
|
for i:=1 to nonGreedyExitDepth do
|
|
laList.Add( pBlock.ExitCache[i]);
|
|
predictExit := getLookaheadTestExpr( laList, nonGreedyExitDepth);
|
|
|
|
println('// non-greedy exit test');
|
|
println('if (' + cnt + ') >= 1) and ');
|
|
|
|
INC(fTabs);
|
|
printAction('{'+#13+#10 + predictExit +#13+#10+'}');
|
|
println('then break;');
|
|
println('');
|
|
DEC(fTabs);
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Prepare exit branch
|
|
// ---------------------------------------------------------------
|
|
exitBranch := '';
|
|
exitBranch := exitBranch + 'if ' + cnt + ' >= 1 then' +#13+#10;
|
|
exitBranch := exitBranch + fTab + 'break' +#13+#10;
|
|
exitBranch := exitBranch + 'else' +#13+#10;
|
|
exitBranch := exitBranch + fTab + throw(pBlock.Look(1)) +#13+#10;
|
|
|
|
htf := genCommonBlock(pBlock,false);
|
|
genBlockFinish( htf, exitBranch);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Finalize the loop
|
|
// ---------------------------------------------------------------
|
|
println('');
|
|
println('INC(' + cnt + ');');
|
|
DEC(fTabs);
|
|
println('end;');
|
|
end;
|
|
|
|
|
|
// ================================================================================================
|
|
// M to N Block (...)@(m,n)
|
|
// ================================================================================================
|
|
procedure TDelphiGenerator.Gen( pBlock: INMBlock);
|
|
var
|
|
i : integer;
|
|
lbl : AnsiString;
|
|
cnt : AnsiString;
|
|
predictExit : AnsiString;
|
|
nonGreedyExitPath : boolean;
|
|
nonGreedyExitDepth: integer;
|
|
laList : TInterfaceList;
|
|
htf : TDelphiBlockFinishingInfo;
|
|
exitBranch : AnsiString;
|
|
|
|
m : integer;
|
|
n : integer;
|
|
mStr : AnsiString;
|
|
nStr : AnsiString;
|
|
|
|
|
|
begin
|
|
if pBlock.Lbl <> '' then
|
|
begin
|
|
cnt := '_cnt_' + pBlock.Lbl;
|
|
lbl := '_loop' + pBlock.Lbl;
|
|
end
|
|
else
|
|
begin
|
|
cnt := '_cnt_' + IntToStr(pBlock.ID);
|
|
lbl := '_loop' + IntToStr(pBlock.ID);
|
|
end;
|
|
|
|
m := pBlock.Low;
|
|
n := pBlock.High;
|
|
mStr := IntToStr( m);
|
|
nStr := IntToStr( n);
|
|
|
|
|
|
println(cnt + ' := 0;');
|
|
println('');
|
|
// println('while(true) do');
|
|
println('while ' +cnt+ ' < ' +nStr+ ' do');
|
|
println('begin');
|
|
INC(fTabs);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate init action for (...)@
|
|
// ---------------------------------------------------------------
|
|
genBlockInitAction( pBlock);
|
|
fGrammar.LLkAnalyzer.Deterministic( pBlock);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate exit test if greedy set to false and an alt is ambigous
|
|
// with exit branch or when lookahead derived purely from
|
|
// end-of-file. Lookahead analysis stops when end-of-file is hit,
|
|
// returning set (epsilon). Since (epsilon) is not ambigous with
|
|
// any real tokens, no error is reported by deterministic() routines
|
|
// and we have to check for the case where the lookahead depth
|
|
// didn't get set to NONDETERMINISTIC (this only happens when the
|
|
// FOLLOW contains real atoms + epsilon.
|
|
// ---------------------------------------------------------------
|
|
nonGreedyExitPath := false;
|
|
nonGreedyExitDepth := fGrammar.MaxK;
|
|
|
|
if (not pBlock.Greedy) and
|
|
(pBlock.ExitDepth <= fGrammar.MaxK) and
|
|
pBlock.ExitCache[pBlock.ExitDepth].HasEpsilon then
|
|
begin
|
|
nonGreedyExitPath := true;
|
|
nonGreedyExitDepth:= pBlock.ExitDepth;
|
|
end
|
|
|
|
else if (not pBlock.Greedy) and (pBlock.ExitDepth = NONDETERMINISTIC) then
|
|
nonGreedyExitPath := true;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate exit test if greedy set to false and an alternative
|
|
// is ambiguous with exit branch.
|
|
// ---------------------------------------------------------------
|
|
if nonGreedyExitPath then
|
|
begin
|
|
// ------------------------------------------------------------
|
|
// Generate lookahead test expression
|
|
// ------------------------------------------------------------
|
|
laList := TInterfaceList.Create;
|
|
for i:=1 to nonGreedyExitDepth do
|
|
laList.Add( pBlock.ExitCache[i]);
|
|
|
|
predictExit := getLookaheadTestExpr( laList, nonGreedyExitDepth);
|
|
|
|
println('// non-greedy exit test');
|
|
println('if (' + cnt + ') >= 1) and ');
|
|
|
|
INC(fTabs);
|
|
printAction('{'+#13+#10 + predictExit +#13+#10+'}');
|
|
println('then break;');
|
|
println('');
|
|
DEC(fTabs);
|
|
end;
|
|
|
|
|
|
// ---------------------------------------------------------------
|
|
// Prepare exit branch
|
|
// ---------------------------------------------------------------
|
|
exitBranch := '';
|
|
|
|
// ---------------------------------------------------------------
|
|
// @(m)
|
|
//
|
|
// The exit condition is tested by teh *while* loop, so here we
|
|
// define the exception generation.
|
|
// ---------------------------------------------------------------
|
|
if (m>0) and (m=n) then
|
|
exitBranch := fTab + throw(pBlock.Look(1)) +#13+#10
|
|
|
|
// -------------------------------------------------------------------------
|
|
// @(,n)
|
|
// -------------------------------------------------------------------------
|
|
else if (m=0) and (n>0) then
|
|
exitBranch := fTab + 'break' +#13+#10
|
|
|
|
// -------------------------------------------------------------------------
|
|
// @(m,n), @(m,)
|
|
// -------------------------------------------------------------------------
|
|
else if (m>0) and (n>m) then
|
|
begin
|
|
exitBranch := '';
|
|
exitBranch := exitBranch + 'if ' +cnt+ ' >= ' +mStr+ ' then' +#13+#10;
|
|
exitBranch := exitBranch + fTab + 'break' +#13+#10;
|
|
exitBranch := exitBranch + 'else' +#13+#10;
|
|
exitBranch := exitBranch + fTab + throw(pBlock.Look(1)) +#13+#10;
|
|
end;
|
|
|
|
htf := genCommonBlock(pBlock,false);
|
|
genBlockFinish( htf, exitBranch);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Finalize the loop
|
|
// ---------------------------------------------------------------
|
|
println('');
|
|
println('INC(' + cnt + ');');
|
|
DEC(fTabs);
|
|
println('end;');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Gen(RuleRef)
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pRuleRef: IRuleRefElem);
|
|
var
|
|
ts : ITokenSymbol;
|
|
rs : IRuleSymbol;
|
|
save : boolean;
|
|
rname : AnsiString;
|
|
|
|
begin
|
|
ts := fGrammar.Symbol[pRuleRef.TargetRule];
|
|
|
|
// ---------------------------------------------------------------
|
|
// If the symbol not exists in the grammar, error...
|
|
// ---------------------------------------------------------------
|
|
if ts = nil then
|
|
begin
|
|
if fIsLexer
|
|
then rname := TCodeGenerator.decodeLexerRuleName( pRuleRef.TargetRule)
|
|
else rname := pRuleRef.TargetRule;
|
|
|
|
fTool.Error(Format(MSG_E_RULENOTDEFINED,[rname]),
|
|
fGrammar.GrammarFile,
|
|
pRuleRef.Line,
|
|
pRuleRef.Column);
|
|
exit;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// If the symbol exists, but not defined, error...
|
|
// ---------------------------------------------------------------
|
|
rs := ts as IRuleSymbol;
|
|
|
|
if not rs.Defined then
|
|
begin
|
|
if fIsLexer then
|
|
rname := TCodeGenerator.decodeLexerRuleName( pRuleRef.TargetRule)
|
|
else
|
|
rname := pRuleRef.TargetRule;
|
|
|
|
fTool.Error(Format(MSG_E_RULENOTDEFINED,[rname]),
|
|
fGrammar.GrammarFile,
|
|
pRuleRef.Line,
|
|
pRuleRef.Column);
|
|
exit;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// If in lexer and ! on ruleref or alt or rule, save buffer index
|
|
// to kill later.
|
|
// ---------------------------------------------------------------
|
|
if fIsLexer and ((not fSaveText) or (pRuleRef.AutoGenType = AUTOGEN_BANG)) then
|
|
println('_save := Length( TokenText);');
|
|
|
|
print('');
|
|
// ---------------------------------------------------------------
|
|
// Process return value if any.
|
|
// ---------------------------------------------------------------
|
|
if pRuleRef.IdAssign <> '' then
|
|
begin
|
|
// ------------------------------------------------------------
|
|
// Warn if the rule has no return value.
|
|
// ------------------------------------------------------------
|
|
if rs.Block.ReturnAction = '' then
|
|
begin
|
|
|
|
fTool.Warning( Format(MSG_W_RULEHASNORETURN,[pRuleRef.TargetRule]),
|
|
fGrammar.GrammarFile,
|
|
pRuleRef.Line,
|
|
pRuleRef.Column);
|
|
end;
|
|
|
|
_print( pRuleRef.IdAssign + ' := ');
|
|
end
|
|
|
|
else begin
|
|
// ------------------------------------------------------------
|
|
// Warn about return value if any, but not inside syntactic
|
|
// predicate.
|
|
// ------------------------------------------------------------
|
|
if (not fIsLexer) and
|
|
(fSyntacticPredLevel = 0) and
|
|
(rs.Block.ReturnAction <> '') then
|
|
begin
|
|
fTool.Warning( Format(MSG_W_RULEHASRETURN,[pRuleRef.TargetRule]),
|
|
fGrammar.GrammarFile,
|
|
pRuleRef.Line,
|
|
pRuleRef.Column);
|
|
end;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Call the rule.
|
|
// ---------------------------------------------------------------
|
|
genRuleInvocation( pRuleRef);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Now kill the buffer...
|
|
// ---------------------------------------------------------------
|
|
if fIsLexer and ((not fSaveText) or (pRuleRef.AutoGenType = AUTOGEN_BANG)) then
|
|
println('TokenText := Copy(TokenText, 1, _save);');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Always generate variable for rule return on labeled rules
|
|
// ---------------------------------------------------------------
|
|
if pRuleRef.Lbl <> '' then
|
|
begin
|
|
if fIsTreeWalker then
|
|
;
|
|
|
|
|
|
if fIsLexer then
|
|
println( pRuleRef.Lbl + ' := ReturnToken;');
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
// ============================================================================
|
|
// Gen(ZeroOrMoreBlock) (...)*
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pBlock: IZeroOrMoreBlock);
|
|
var
|
|
i: integer;
|
|
nonGreedyExitPath : boolean;
|
|
nonGreedyExitDepth : integer;
|
|
predictExit : AnsiString;
|
|
laList : TInterfaceList;
|
|
htf : TDelphiBlockFinishingInfo;
|
|
|
|
begin
|
|
println('');
|
|
println('while(true) do');
|
|
println('begin');
|
|
INC(fTabs);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate the init action for ()+ ()* inside the loop.
|
|
// This allows us to do useful EOF checking.
|
|
// ---------------------------------------------------------------
|
|
genBlockInitAction( pBlock);
|
|
fGrammar.LLkAnalyzer.Deterministic( pBlock);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate exit test if greedy set to false and an alt is ambigous
|
|
// with exit branch or when lookahead derived purely from end-of-file.
|
|
// Lookahead analysis stops when end-of-file is hit, returning set
|
|
// (epsilon). Since (epsilon) is not ambigous with any real tokens,
|
|
// no error is reported by deterministic() routines and we have to
|
|
// check for to NONDETERMINISTIC (this only happens when the FOLLOW
|
|
// contains real atoms + epsilon).
|
|
// ---------------------------------------------------------------
|
|
nonGreedyExitPath := false;
|
|
nonGreedyExitDepth := fGrammar.MaxK;
|
|
|
|
if (not pBlock.Greedy) and
|
|
(pBlock.ExitDepth <= fGrammar.MaxK) and
|
|
(pBlock.ExitCache[pBlock.ExitDepth].HasEpsilon) then
|
|
begin
|
|
nonGreedyExitPath := true;
|
|
nonGreedyExitDepth:= pBlock.ExitDepth;
|
|
end
|
|
|
|
else if (not pBlock.Greedy) and (pBlock.ExitDepth = NONDETERMINISTIC) then
|
|
nonGreedyExitPath := true;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate exit test if greedy set to false and an alternative
|
|
// is ambiguous with exit branch.
|
|
// ---------------------------------------------------------------
|
|
if nonGreedyExitPath then
|
|
begin
|
|
// ------------------------------------------------------------
|
|
// Generate lookahead test expression
|
|
// ------------------------------------------------------------
|
|
laList := TInterfaceList.Create;
|
|
for i:=1 to nonGreedyExitDepth do
|
|
laList.Add( pBlock.ExitCache[i]);
|
|
predictExit := getLookaheadTestExpr( laList, nonGreedyExitDepth);
|
|
|
|
println('// non-greedy exit test');
|
|
println('if' + predictExit + ' then');
|
|
INC(fTabs);
|
|
println('break;');
|
|
println('');
|
|
DEC(fTabs);
|
|
end;
|
|
|
|
htf := genCommonBlock( pBlock, false);
|
|
genBlockFinish( htf, fTab + 'break;', true);
|
|
|
|
DEC( fTabs);
|
|
println('end;');
|
|
println('');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genTokens
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genTokens;
|
|
var
|
|
i : integer;
|
|
len : integer;
|
|
xxx : integer;
|
|
line : AnsiString;
|
|
frm : AnsiString;
|
|
_file : AnsiString;
|
|
|
|
name : AnsiString;
|
|
value : AnsiString;
|
|
ts : ITokenSymbol;
|
|
ss : IStringSymbol;
|
|
|
|
begin
|
|
// ---------------------------------------------------------------
|
|
// Calculate the output file name, and open it.
|
|
// ---------------------------------------------------------------
|
|
_file := (*fOutDir +*) fGrammar.ExportVocab + 'Tokens.pas';
|
|
_file := fOutDir + fGrammar.UnitName + 'Tokens.pas';
|
|
fOutput := TFileStream.Create( _file, fmCreate);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Calculate maximum length of the token names.
|
|
// ---------------------------------------------------------------
|
|
len := 0;
|
|
for i:=0 to fGrammar.TokenManager.Vocabulary.Count -1 do
|
|
begin
|
|
ts := fGrammar.TokenManager.TokenSymbolAt[i];
|
|
|
|
if ts <> nil then
|
|
if len < Length( ts.ID) then
|
|
len := Length( ts.ID);
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Add prefix length also
|
|
// ---------------------------------------------------------------
|
|
if Length(fTokPrefix) > Length( fLitPrefix)
|
|
then len := len + Length( fTokPrefix)
|
|
else len := len + Length( fLitPrefix);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Write a header :)
|
|
// ---------------------------------------------------------------
|
|
println('// ============================================================================');
|
|
println('// This file is generated by the Delphi Parser Generator.');
|
|
println('// ----------------------------------------------------------------------------');
|
|
println('// DPG version: ' + version);
|
|
println('// Grammar: ' + fGrammar.GrammarFile);
|
|
println('// ============================================================================');
|
|
println('unit ' + fGrammar.ExportVocab + 'Tokens;');
|
|
println('');
|
|
println('interface');
|
|
println('');
|
|
println('const');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Write out the tokens
|
|
// ---------------------------------------------------------------
|
|
fTabs := 1;
|
|
frm := '%-' + IntToStr(len) + 's = %s;';
|
|
|
|
for name in fGrammar.TokenManager.Vocabulary.Keys do
|
|
begin
|
|
value := IntToStr( fGrammar.TokenManager.Vocabulary.Items[name]);
|
|
ts := fGrammar.TokenManager.TokenSymbol[name];
|
|
ss := nil;
|
|
|
|
if ts <> nil then
|
|
ts.QueryInterface( IStringSymbol, ss);
|
|
|
|
if name[1] <> '<' then
|
|
begin
|
|
// ---------------------------------------------------------
|
|
// Handle AnsiString symbols.
|
|
// ---------------------------------------------------------
|
|
if name[1] = '"' then
|
|
begin
|
|
if ss <> nil then
|
|
begin
|
|
if ss.Lbl = '' then
|
|
ss.Lbl := fLitPrefix + Copy( name, 2, Length(name)-2);
|
|
|
|
line := Format( frm, [ss.Lbl, value]);
|
|
println( line);
|
|
end;
|
|
end
|
|
|
|
// ---------------------------------------------------------
|
|
// Handle token symbols.
|
|
// ---------------------------------------------------------
|
|
else
|
|
begin
|
|
if ts <> nil then
|
|
begin
|
|
line := Format( frm, [fTokPrefix + name, value]);
|
|
println( line);
|
|
end
|
|
// else
|
|
// fGrammar.Tool.Error( 'Undefined token symbol' + name);
|
|
end
|
|
end
|
|
end;
|
|
|
|
(*
|
|
for i:=0 to fGrammar.TokenManager.Vocabulary.Count -1 do
|
|
begin
|
|
name := fGrammar.TokenManager.Vocabulary.Names[i];
|
|
value := fGrammar.TokenManager.Vocabulary.Values[name];
|
|
ts := fGrammar.TokenManager.TokenSymbol[name];
|
|
ss := nil;
|
|
|
|
if ts <> nil then
|
|
ts.QueryInterface( IStringSymbol, ss);
|
|
|
|
if name[1] <> '<' then
|
|
begin
|
|
// ---------------------------------------------------------
|
|
// Handle AnsiString symbols.
|
|
// ---------------------------------------------------------
|
|
if name[1] = '"' then
|
|
begin
|
|
if ss <> nil then
|
|
begin
|
|
if ss.Lbl = '' then
|
|
ss.Lbl := fLitPrefix + Copy( name, 2, Length(name)-2);
|
|
|
|
line := Format( frm, [ss.Lbl, value]);
|
|
println( line);
|
|
end;
|
|
end
|
|
|
|
// ---------------------------------------------------------
|
|
// Handle token symbols.
|
|
// ---------------------------------------------------------
|
|
else
|
|
begin
|
|
if ts <> nil then
|
|
begin
|
|
line := Format( frm, [fTokPrefix + name, value]);
|
|
println( line);
|
|
end
|
|
// else
|
|
// fGrammar.Tool.Error( 'Undefined token symbol' + name);
|
|
end
|
|
end
|
|
end;
|
|
*)
|
|
fTabs := 0;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate the rest...
|
|
// ---------------------------------------------------------------
|
|
println('');
|
|
println('implementation');
|
|
println('end.');
|
|
|
|
fOutput.Free;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genInitLiterals
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genInitLiterals;
|
|
var
|
|
i : integer;
|
|
l : integer;
|
|
len : integer;
|
|
line : AnsiString;
|
|
frm : AnsiString;
|
|
|
|
name : AnsiString;
|
|
value : AnsiString;
|
|
|
|
s : AnsiString;
|
|
|
|
begin
|
|
println('// ----------------------------------------------------------------------------');
|
|
println('// InitLiterals');
|
|
println('// ----------------------------------------------------------------------------');
|
|
println('procedure ' + fGrammar.GrammarName + '.initialize;');
|
|
println('begin');
|
|
INC(fTabs);
|
|
|
|
if not fLexerGrammar.CaseSensitive then
|
|
begin
|
|
println('fCaseSensitive := false;');
|
|
println('fLiterals.CaseSensitive := false;');
|
|
println('');
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Calculate maximum length of the AnsiString literal names.
|
|
// ---------------------------------------------------------------
|
|
len := 0;
|
|
|
|
for name in fGrammar.TokenManager.Vocabulary.Keys do
|
|
begin
|
|
if name[1] = '"' then
|
|
begin
|
|
l := Length(name) -2;
|
|
|
|
if len < l then
|
|
len := l;
|
|
end;
|
|
end;
|
|
|
|
(*
|
|
for i:=0 to fGrammar.TokenManager.Vocabulary.Count -1 do
|
|
begin
|
|
name := fGrammar.TokenManager.Vocabulary.Names[i];
|
|
|
|
if name[1] = '"' then
|
|
begin
|
|
name := Copy( name, 2, Length(name)-2);
|
|
|
|
if len < Length( name) then
|
|
len := Length( name);
|
|
end;
|
|
end;
|
|
*)
|
|
// ---------------------------------------------------------------
|
|
// Add minimum 1 extra space for spearator
|
|
// ---------------------------------------------------------------
|
|
INC(len);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Write out the code
|
|
// ---------------------------------------------------------------
|
|
for s in fGrammar.TokenManager.Vocabulary.Keys do
|
|
begin
|
|
value := IntToStr( fGrammar.TokenManager.Vocabulary.Items[s]);
|
|
|
|
if not fLexerGrammar.CaseSensitive
|
|
then name := AnsiLowerCase(s)
|
|
else name := s;
|
|
|
|
if name[1] = '"' then
|
|
begin
|
|
name := Copy( name, 2, Length(name)-2);
|
|
frm := 'fLiterals[''%s''%' + IntToStr( len - Length(name)) +'s] :=%3.3s;';
|
|
line := Format( frm, [name,' ',value]);
|
|
println(line);
|
|
end
|
|
end;
|
|
|
|
(*
|
|
for i:=0 to fGrammar.TokenManager.Vocabulary.Count -1 do
|
|
begin
|
|
name := fGrammar.TokenManager.Vocabulary.Names[i];
|
|
value := fGrammar.TokenManager.Vocabulary.Values[name];
|
|
|
|
if not fLexerGrammar.CaseSensitive then
|
|
name := LowerCase( name);
|
|
|
|
if name[1] = '"' then
|
|
begin
|
|
name := Copy( name, 2, Length(name)-2);
|
|
frm := 'fLiterals[''%s''%' + IntToStr( len - Length(name)) +'s] :=%3.3s;';
|
|
line := Format( frm, [name,' ',value]);
|
|
println(line);
|
|
end;
|
|
end;
|
|
*)
|
|
|
|
// ---------------------------------------------------------------
|
|
// Close the procedure
|
|
// ---------------------------------------------------------------
|
|
DEC(fTabs);
|
|
println('end;');
|
|
println('');
|
|
end;
|
|
|
|
// ----------------------------------------------------------------------------
|
|
// genNextToken
|
|
// ----------------------------------------------------------------------------
|
|
procedure TDelphiGenerator.genNextToken;
|
|
var
|
|
i : integer;
|
|
b : boolean;
|
|
a : IAlternative;
|
|
rs : IRuleSymbol;
|
|
rb : IRuleBlock;
|
|
|
|
filterMode : boolean;
|
|
filterRule : AnsiString;
|
|
|
|
errFin : AnsiString;
|
|
blkFin : TDelphiBlockFinishingInfo;
|
|
first : TByteSet;
|
|
|
|
begin
|
|
// ---------------------------------------------------------------
|
|
// Generate method header
|
|
// ---------------------------------------------------------------
|
|
println('// ----------------------------------------------------------------------------');
|
|
println('// NextToken');
|
|
println('// ----------------------------------------------------------------------------');
|
|
println('function ' + fGrammar.GrammarName + '.NextToken : IToken;');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Check for at least 1 public rule.
|
|
// ---------------------------------------------------------------
|
|
b := false;
|
|
for i:=0 to fGrammar.Rules.Count -1 do
|
|
begin
|
|
fGrammar.Rules.Items[i].QueryInterface(IRuleSymbol, rs);
|
|
|
|
if rs.Access = 'public' then
|
|
begin
|
|
b := true;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// If the grammar has no public rule, then generate fake method
|
|
// returning TT_EOF
|
|
// ---------------------------------------------------------------
|
|
if b = false then
|
|
begin
|
|
println('begin');
|
|
INC(fTabs);
|
|
println('result := TToken.Create(TT_EOF);');
|
|
DEC(fTabs);
|
|
println('end;');
|
|
exit;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// OK. Here we have at least one public rule.
|
|
// Create a synthesized NextToken rule
|
|
// ---------------------------------------------------------------
|
|
rb := TGrammarMaker.CreateNextTokenRule( fGrammar, fGrammar.Rules, 'NextToken');
|
|
rs := TRuleSymbol.Create('mNextToken');
|
|
|
|
rs.Defined := true;
|
|
rs.Block := rb;
|
|
rs.Access := 'private';
|
|
fGrammar.Define( rs);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Analyze the rule
|
|
// ---------------------------------------------------------------
|
|
fGrammar.LLkAnalyzer.Deterministic(rb);
|
|
first := rb.Look(1).LaSet;
|
|
|
|
// ---------------------------------------------------------------
|
|
// OK, now generate...
|
|
// ---------------------------------------------------------------
|
|
filterMode := fLexerGrammar.FilterMode;
|
|
filterRule := fLexerGrammar.FilterRule;
|
|
|
|
// ---------------------------------------------------------------
|
|
// ...local vars...
|
|
// ---------------------------------------------------------------
|
|
// println('var');
|
|
// INC(fTabs);
|
|
// println('_ttype : integer;');
|
|
|
|
// ---------------------------------------------------------------
|
|
// If the lexer isn't a filter lexer, then we need the FIRST set
|
|
// in error message.
|
|
// ---------------------------------------------------------------
|
|
if not filterMode then
|
|
begin
|
|
println('var');
|
|
println(fTab + '_first : TCharSet;');
|
|
println('');
|
|
end
|
|
|
|
// ---------------------------------------------------------------
|
|
// In filter lexer check that this is a simple filter or a filter
|
|
// rule is defined. If filter rule defined, then define local var
|
|
// to mark the lexer state.
|
|
// ---------------------------------------------------------------
|
|
else
|
|
begin
|
|
if filterRule <> '' then
|
|
begin
|
|
println('var');
|
|
println(fTab + '_mark : integer;');
|
|
println('');
|
|
end;
|
|
end;
|
|
|
|
println('begin');
|
|
INC(fTabs);
|
|
|
|
// ---------------------------------------------------------------
|
|
// ...local var init...
|
|
// ---------------------------------------------------------------
|
|
// ---------------------------------------------------------------
|
|
// If the lexer isn't a filter lexer, initialize FIRST set.
|
|
// in error message.
|
|
// ---------------------------------------------------------------
|
|
if not filterMode then
|
|
begin
|
|
println('_first := [' + CharSetToStr( first) + '];');
|
|
println('');
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// ...code...
|
|
// ---------------------------------------------------------------
|
|
println('while( true) do');
|
|
println('begin');
|
|
INC(fTabs);
|
|
// println('_ttype := TT_INVALID;');
|
|
// println('CommitToPath := false;');
|
|
|
|
if filterRule <> '' then
|
|
begin
|
|
// ------------------------------------------------------------
|
|
// Here's a good place to ensure that the filter rule
|
|
// actually exists.
|
|
// ------------------------------------------------------------
|
|
if not fGrammar.Defined( encodeLexerRuleName( filterRule)) then
|
|
fTool.Error(Format(MSG_E_NOFILTERRULE, [filterRule]))
|
|
else
|
|
begin
|
|
fGrammar.Symbol[encodeLexerRuleName(filterRule)].QueryInterface( IRuleSymbol,rs);
|
|
|
|
if rs.Access <> 'protected' then
|
|
fTool.Error( Format( MSG_E_PROTECTEDFILTER, [filterRule]));
|
|
// fTool.Error('Filter rule ' + filterRule + 'must be protected.');
|
|
end;
|
|
|
|
println('_mark := mark;');
|
|
end;
|
|
|
|
println('ResetText;');
|
|
println('');
|
|
|
|
// ------------------------------------------------------------
|
|
// Generate try around whole thing to trap scanner errors.
|
|
// ------------------------------------------------------------
|
|
println('try');
|
|
INC(fTabs);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Test for public lexical rules with empty paths
|
|
// ---------------------------------------------------------------
|
|
for i:=0 to rb.Alternatives.Count -1 do
|
|
begin
|
|
rb.Alternatives[i].QueryInterface(IAlternative, a);
|
|
|
|
if a.Cache[1].Epsilon <> [] then
|
|
begin
|
|
|
|
fTool.Warning( MSG_W_OPTIONALPATH,
|
|
fGrammar.GrammarFile,
|
|
0,
|
|
0);
|
|
|
|
// fTool.Warning('Optional path found in NextToken.');
|
|
// fLexerGrammar.Tool.Warning('Optional path found in NextToken.');
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate the block
|
|
// ---------------------------------------------------------------
|
|
genCommonBlock( rb, false);
|
|
|
|
errFin := 'if LA(1) = EOF_CHAR then' +#13+#10;
|
|
errFin := errFin + 'begin' +#13+#10;
|
|
errFin := errFin + fTab + 'uponEof;' +#13+#10;
|
|
errFin := errFin + fTab + 'result := TToken.Create(TT_EOF);' +#13+#10;
|
|
errFin := errFin + 'end' +#13+#10;
|
|
errFin := errFin +#13+#10;
|
|
|
|
// ------------------------------------------------------------
|
|
// Filter mode
|
|
// ------------------------------------------------------------
|
|
if filterMode then
|
|
begin
|
|
if filterRule = '' then
|
|
begin
|
|
errFin := errFin + 'else' +#13+#10;
|
|
errFin := errFin + 'begin' +#13+#10;
|
|
errFin := errFin + fTab + 'consume;' +#13+#10;
|
|
errFin := errFin + fTab + 'continue;' +#13+#10;
|
|
errFin := errFin + 'end;';// +#13+#10;
|
|
end
|
|
|
|
else
|
|
begin
|
|
errFin := errFin + 'else' +#13+#10;
|
|
errFin := errFin + 'begin' +#13+#10;
|
|
errFin := errFin + fTab + 'commit;' +#13+#10;
|
|
errFin := errFin +#13+#10;
|
|
errFin := errFin + fTab + 'try' +#13+#10;
|
|
errFin := errFin + fTab + fTab +'m' +filterRule +'(false);' +#13+#10;
|
|
errFin := errFin + fTab + 'except' +#13+#10;
|
|
errFin := errFin + fTab + fTab + 'on e:Exception do' +#13+#10;
|
|
errFin := errFin + fTab + fTab + 'begin' +#13+#10;
|
|
errFin := errFin + fTab + fTab + fTab + 'reportError(e);' +#13+#10;
|
|
errFin := errFin + fTab + fTab + fTab + 'consume;' +#13+#10;
|
|
errFin := errFin + fTab + fTab + 'end;' +#13+#10;
|
|
errFin := errFin + fTab + 'end;' +#13+#10;
|
|
errFin := errFin +#13+#10;
|
|
errFin := errFin + fTab + 'continue;' +#13+#10;
|
|
errFin := errFin + 'end;' +#13+#10;
|
|
end;
|
|
end
|
|
|
|
// ------------------------------------------------------------
|
|
// Normal mode
|
|
// ------------------------------------------------------------
|
|
else
|
|
begin
|
|
errFin := errFin + 'else'+#13+#10;
|
|
errFin := errFin + fTab +
|
|
'Raise EMismatchedChar.Create(' +
|
|
'LA(1), _first, InputState.FileName, InputState.Line, InputState.Column);' +#13+#10;
|
|
end;
|
|
|
|
blkFin := TDelphiBlockFinishingInfo.Create;
|
|
blkFin.NeedAnErrorClause := true;
|
|
blkFin.GeneratedAnIf := true;
|
|
blkFin.GeneratedSwitch := false;
|
|
|
|
genBlockFinish( blkFin, errFin);
|
|
|
|
// ---------------------------------------------------------------
|
|
// At this point a valid token has been matched, undo "mark" that
|
|
// was done
|
|
// ---------------------------------------------------------------
|
|
if filterMode and (filterRule <> '') then
|
|
begin
|
|
println('');
|
|
println('commit;');
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate literals test if desired.
|
|
// Make sure _ttype is set first; note _returnToken must be
|
|
// non-null as the rule was required to create it.
|
|
// ---------------------------------------------------------------
|
|
println('');
|
|
println('// --------------------------------------------------------------');
|
|
println('// If we found a SKIP token, then try again...');
|
|
println('// --------------------------------------------------------------');
|
|
println('if result = nil then');
|
|
INC(fTabs);
|
|
println('continue;');
|
|
println('');
|
|
DEC(fTabs);
|
|
|
|
if fLexerGrammar.TestLiterals then
|
|
begin
|
|
println('// --------------------------------------------------------------');
|
|
println('// Literals test');
|
|
println('// --------------------------------------------------------------');
|
|
println('result.TokenType := TestLiteral(result.TokenType);');
|
|
println('');
|
|
end;
|
|
|
|
println('// --------------------------------------------------------------');
|
|
println('// Now we have a valid token, so exit the function');
|
|
println('// --------------------------------------------------------------');
|
|
println('break;');
|
|
println('');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Close try block
|
|
// ---------------------------------------------------------------
|
|
DEC(fTabs);
|
|
println('except');
|
|
INC(fTabs);
|
|
|
|
if fLexerGrammar.FilterMode then
|
|
begin
|
|
if filterRule = '' then
|
|
begin
|
|
println('consume;');
|
|
println('continue;');
|
|
end
|
|
|
|
else
|
|
begin
|
|
println('rewind(_mark);');
|
|
println('ResetText;');
|
|
println('');
|
|
println('try');
|
|
println(fTab + 'm'+filterRule+'(false);');
|
|
println('');
|
|
println('except');
|
|
println(fTab + 'on e:Exception do');
|
|
println(fTab + 'begin');
|
|
println(fTab + fTab + 'reportError(e);');
|
|
println(fTab + fTab + 'consume;');
|
|
println(fTab + 'end;');
|
|
println('end;');
|
|
end;
|
|
end
|
|
|
|
else
|
|
begin
|
|
println('Raise;');
|
|
end;
|
|
|
|
DEC(fTabs);
|
|
println('end;');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Close while(true) block
|
|
// ---------------------------------------------------------------
|
|
DEC(fTabs);
|
|
println('end;');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Finish the method
|
|
// ---------------------------------------------------------------
|
|
fTabs := 0;
|
|
println('end;');
|
|
println('');
|
|
end;
|
|
|
|
|
|
// ================================================================================================
|
|
// genUses
|
|
//
|
|
// Generate uses clause form interface section.
|
|
// ================================================================================================
|
|
procedure TDelphiGenerator.genUses;
|
|
var
|
|
i : integer;
|
|
items : TStringList;
|
|
|
|
begin
|
|
items := fGrammar.UsesList;
|
|
|
|
if fGrammar.ExportVocab = ''
|
|
then items.Add( fGrammar.UnitName + 'Tokens')
|
|
else items.Add(fGrammar.ExportVocab + 'Tokens');
|
|
|
|
fTabs := 0;
|
|
println('uses');
|
|
fTabs := 1;
|
|
|
|
for i:=0 to items.count -1 do
|
|
begin
|
|
print( items.Strings[i]);
|
|
|
|
if i < (items.Count -1) then
|
|
_println(',')
|
|
else
|
|
_println(';');
|
|
end;
|
|
|
|
fTabs := 0;
|
|
println('');
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// genUses2
|
|
//
|
|
// Generate uses clause form implementation section.
|
|
// ================================================================================================
|
|
procedure TDelphiGenerator.genUses2;
|
|
var
|
|
i : integer;
|
|
items : TStringList;
|
|
|
|
begin
|
|
items := fGrammar.UsesList2;
|
|
|
|
fTabs := 0;
|
|
println('uses');
|
|
fTabs := 1;
|
|
|
|
for i:=0 to items.count -1 do
|
|
begin
|
|
print( items.Strings[i]);
|
|
|
|
if i < (items.Count -1) then
|
|
_println(',')
|
|
else
|
|
_println(';');
|
|
end;
|
|
|
|
fTabs := 0;
|
|
println('');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genClassDecl
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genClassDecl;
|
|
var
|
|
i : integer;
|
|
rs : IRuleSymbol;
|
|
|
|
cntPriv : integer;
|
|
cntProt : integer;
|
|
cntPub : integer;
|
|
lenMax : integer;
|
|
|
|
fmt : AnsiString;
|
|
|
|
begin
|
|
fTabs := 0;
|
|
|
|
// ---------------------------------------------------------------
|
|
// generate "class" section
|
|
// ---------------------------------------------------------------
|
|
if fGrammar.ConstAction <> nil then
|
|
begin
|
|
println('const');
|
|
inc(fTabs);
|
|
println('// =========================================================================');
|
|
println('// Const declarations from grammar.');
|
|
println('// =========================================================================');
|
|
printAction( fGrammar.ConstAction.TokenText);
|
|
println('');
|
|
dec(fTabs);
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// generate "type" section
|
|
// ---------------------------------------------------------------
|
|
println('type');
|
|
INC(fTabs);
|
|
|
|
if fGrammar.TypeAction <> nil then
|
|
begin
|
|
println('// =========================================================================');
|
|
println('// Type declarations from grammar.');
|
|
println('// =========================================================================');
|
|
printAction( fGrammar.TypeAction.TokenText);
|
|
println('');
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate class declaration header
|
|
// ---------------------------------------------------------------
|
|
println('// =========================================================================');
|
|
println('// Class ' + fGrammar.GrammarName + ' declaration');
|
|
println('// =========================================================================');
|
|
if fIsLexer then
|
|
println( fGrammar.GrammarName + ' = class( TLexer)')
|
|
|
|
else if fIsParser then
|
|
println( fGrammar.GrammarName + ' = class( TLLkParser)');
|
|
|
|
println('');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate memberdecl{...} section
|
|
// ---------------------------------------------------------------
|
|
if fGrammar.MemberDecl <> '' then
|
|
begin
|
|
printAction( fGrammar.MemberDecl);
|
|
println('');
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Mandatory method declarations for lexer grammar.
|
|
// ---------------------------------------------------------------
|
|
if fIsLexer then
|
|
begin
|
|
if needsLexerInit then
|
|
begin
|
|
println('protected // Internals');
|
|
println(fTab + 'procedure initialize; override;');
|
|
println('');
|
|
end;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Calculate counts and length
|
|
// ---------------------------------------------------------------
|
|
cntPriv := 0;
|
|
cntProt := 0;
|
|
cntPub := 0;
|
|
lenMax := 0;
|
|
|
|
for i:=0 to fGrammar.Rules.Count -1 do
|
|
begin
|
|
fGrammar.Rules.Items[i].QueryInterface( IRuleSymbol, rs);
|
|
|
|
if rs.Access = 'private' then
|
|
INC( cntPriv)
|
|
else if rs.Access = 'protected' then
|
|
INC( cntProt)
|
|
else
|
|
INC( cntPub);
|
|
|
|
if Length( rs.ID) > lenMax then
|
|
lenMax := Length( rs.ID);
|
|
end;
|
|
|
|
INC( lenMax);
|
|
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate private method declarations
|
|
// ---------------------------------------------------------------
|
|
if cntPriv > 0 then
|
|
begin
|
|
fTabs := 1;
|
|
println('private // Private grammar rules');
|
|
fTabs := 2;
|
|
|
|
for i:=0 to fGrammar.Rules.Count -1 do
|
|
begin
|
|
fGrammar.Rules.Items[i].QueryInterface( IRuleSymbol, rs);
|
|
|
|
if rs.Access = 'private' then
|
|
genMethodDecl( rs, lenMax, false);
|
|
end;
|
|
|
|
fTabs := 1;
|
|
println('');
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate protected method declarations
|
|
// ---------------------------------------------------------------
|
|
if cntProt > 0 then
|
|
begin
|
|
fmt := 'procedure %-' + IntToStr( lenMax) + 's' + ' pCreate: boolean);';
|
|
|
|
fTabs := 1;
|
|
println('public // Protected grammar rules');
|
|
println(' // Must callable from parser too');
|
|
fTabs := 2;
|
|
|
|
for i:=0 to fGrammar.Rules.Count -1 do
|
|
begin
|
|
fGrammar.Rules.Items[i].QueryInterface( IRuleSymbol, rs);
|
|
|
|
if rs.Access = 'protected' then
|
|
genMethodDecl( rs, lenMax, false);
|
|
end;
|
|
|
|
fTabs := 1;
|
|
println('');
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate public method declarations
|
|
//
|
|
// NOTE:
|
|
//
|
|
// by definition!!!!
|
|
// ---------------------------------------------------------------
|
|
if cntPub > 0 then
|
|
begin
|
|
|
|
fTabs := 1;
|
|
if fIsLexer
|
|
then println('public // Public grammar rules')
|
|
else println('public // Public grammar rules');
|
|
fTabs := 2;
|
|
|
|
for i:=0 to fGrammar.Rules.Count -1 do
|
|
begin
|
|
fGrammar.Rules.Items[i].QueryInterface( IRuleSymbol, rs);
|
|
|
|
if rs.Access = 'public' then
|
|
genMethodDecl( rs, lenMax, false);
|
|
end;
|
|
|
|
fTabs := 1;
|
|
println('');
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// NextToken method declaration for lexer grammar.
|
|
// ---------------------------------------------------------------
|
|
if fIsLexer then
|
|
begin
|
|
println('public');
|
|
INC(fTabs);
|
|
println('function NextToken: IToken; override;');
|
|
DEC(fTabs);
|
|
end;
|
|
|
|
println('end;');
|
|
fTabs := 0;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genMethodDecl
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genMethodDecl( pRuleSymbol : IRuleSymbol;
|
|
pLength : integer;
|
|
pFull : boolean);
|
|
var
|
|
rb : IRuleBlock;
|
|
l : AnsiString;
|
|
fmt: AnsiString;
|
|
|
|
begin
|
|
// ---------------------------------------------------------------
|
|
// Special case: Public method in lexer grammar. In this case the
|
|
// rule should not have parameters and return value.
|
|
// ---------------------------------------------------------------
|
|
if (pRuleSymbol.Access = 'public') and fIsLexer then
|
|
begin
|
|
// ------------------------------------------------------------
|
|
// Generate declaration
|
|
// ------------------------------------------------------------
|
|
if not pFull then
|
|
begin
|
|
fmt := 'procedure %-' + IntToStr( pLength) + 's' + '( pCreate: boolean);';
|
|
println( Format(fmt, [pRuleSymbol.ID]));
|
|
end
|
|
|
|
// ------------------------------------------------------------
|
|
// Generate definition
|
|
// ------------------------------------------------------------
|
|
else
|
|
begin
|
|
l := 'procedure ' + fGrammar.GrammarName + '.' + pRuleSymbol.ID;
|
|
l := l + '( pCreate: boolean);';
|
|
println( l);
|
|
end;
|
|
end
|
|
|
|
// ---------------------------------------------------------------
|
|
// General case
|
|
// ---------------------------------------------------------------
|
|
else
|
|
begin
|
|
l := '';
|
|
rb := pRuleSymbol.Block;
|
|
|
|
// ------------------------------------------------------------
|
|
// Determine method type (function/procedure)
|
|
// ------------------------------------------------------------
|
|
if rb.ReturnAction <> '' then
|
|
l := 'function '
|
|
else
|
|
l := 'procedure ';
|
|
|
|
// ------------------------------------------------------------
|
|
// gernerate class name
|
|
// ------------------------------------------------------------
|
|
if pFull then
|
|
l := l + fGrammar.GrammarName + '.' + pRuleSymbol.ID
|
|
else
|
|
begin
|
|
fmt := '%-' + IntToStr( pLength) + 's';
|
|
l := l + Format( fmt, [pRuleSymbol.ID]);
|
|
end;
|
|
|
|
// ------------------------------------------------------------
|
|
// Generate arguments for lexer grammar
|
|
// ------------------------------------------------------------
|
|
if fIsLexer then
|
|
begin
|
|
l := l + '( pCreate: boolean';
|
|
|
|
if rb.Arguments <> '' then
|
|
l := l + '; ' + rb.Arguments;
|
|
|
|
l := l + ')';
|
|
end
|
|
|
|
// ------------------------------------------------------------
|
|
// Generate arguments for parser grammar
|
|
// ------------------------------------------------------------
|
|
else if fIsParser then
|
|
begin
|
|
if rb.Arguments <> '' then
|
|
l := l + '( ' + rb.Arguments + ')';
|
|
end;
|
|
|
|
// ------------------------------------------------------------
|
|
// Generate return value
|
|
// ------------------------------------------------------------
|
|
if rb.ReturnAction <> '' then
|
|
l := l + ': ' + rb.ReturnAction;
|
|
|
|
// ------------------------------------------------------------
|
|
// Close the declaration
|
|
// ------------------------------------------------------------
|
|
l := l + ';';
|
|
|
|
println( l);
|
|
end;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genBlockFinish
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genBlockFinish( pHowToFinish : TDelphiBlockFinishingInfo;
|
|
pNoViableAction : AnsiString;
|
|
pSingleLine : boolean);
|
|
begin
|
|
if pHowToFinish.NeedAnErrorClause and
|
|
(pHowToFinish.GeneratedAnIf or
|
|
pHowToFinish.GeneratedSwitch) then
|
|
begin
|
|
// ------------------------------------------------------------
|
|
// Handle generated if
|
|
// ------------------------------------------------------------
|
|
if pHowToFinish.GeneratedAnIf then
|
|
begin
|
|
// if not pSingleLine then
|
|
println('');
|
|
|
|
println('else');
|
|
|
|
if not pSingleLine then
|
|
println('begin');
|
|
end
|
|
|
|
// ------------------------------------------------------------
|
|
// Handle generated switch
|
|
// ------------------------------------------------------------
|
|
else
|
|
println('begin');
|
|
|
|
INC(fTabs);
|
|
// printAction( '{'+#13+#10+#13+#10+pNoViableAction+#13+#10+'}');
|
|
printAction( '{'+#13+#10+#13+#10+pNoViableAction+'}');
|
|
DEC(fTabs);
|
|
|
|
if not pSingleLine then
|
|
println('end;');
|
|
end;
|
|
|
|
if pHowToFinish.PostScript <> '' then
|
|
printAction( '{'+#13+#10+#13+#10+pHowToFinish.PostScript+#13+#10+'}');
|
|
|
|
if pHowToFinish.NeedAClosingEnd then
|
|
begin
|
|
DEC(fTabs);
|
|
println('end;');
|
|
end;
|
|
|
|
// println('');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genCommonBlock
|
|
// ============================================================================
|
|
function TDelphiGenerator.genCommonBlock( pBlock : IAlternativeBlock;
|
|
pNoTestForSingle : boolean)
|
|
: TDelphiBlockFinishingInfo;
|
|
var
|
|
nIF : integer;
|
|
closingBracesOfIFSequence : integer;
|
|
oldSaveText : boolean;
|
|
p : ILookahead;
|
|
alt : IAlternative;
|
|
i : integer;
|
|
ps : AnsiString;
|
|
e : AnsiString;
|
|
unpredicted : boolean;
|
|
hasEmptyAlt : boolean;
|
|
|
|
effectiveDepth : integer;
|
|
startDepth : integer;
|
|
altDepth : integer;
|
|
semPred : AnsiString;
|
|
|
|
begin
|
|
result := TDelphiBlockFinishingInfo.Create;
|
|
nIF := 0;
|
|
closingBracesOfIFSequence := 0;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Save the save text state
|
|
// ---------------------------------------------------------------
|
|
oldSaveText := fSaveText;
|
|
fSaveText := fSaveText and pBlock.AutoGen;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Is this block inverted? If so, generate special-case code.
|
|
// ---------------------------------------------------------------
|
|
if pBlock.IsNot and fAnalyzer.SubRuleCanBeInverted( pBlock, fIsLexer) then
|
|
begin
|
|
p := fAnalyzer.Look( 1, pBlock);
|
|
|
|
// ------------------------------------------------------------
|
|
// Variable assignment for labeled elems
|
|
// ------------------------------------------------------------
|
|
if (pBlock.Lbl <> '') and (fSyntacticPredLevel = 0) then
|
|
println( pBlock.Lbl + ':= ' + fLT1Value + ';');
|
|
|
|
// ------------------------------------------------------------
|
|
// Match the alternative
|
|
// ------------------------------------------------------------
|
|
println('match( [' + CharSetToStr(p.LaSet) + ']);');
|
|
exit;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Special handling for single alt.
|
|
// ---------------------------------------------------------------
|
|
if pBlock.Alternatives.Count = 1 then
|
|
begin
|
|
alt := pBlock.Alternative[0];
|
|
|
|
// ------------------------------------------------------------
|
|
// Generate a warning if there is a synPred for single alt.
|
|
// ------------------------------------------------------------
|
|
if alt.SynPred <> nil then
|
|
|
|
fTool.Warning( MSG_W_SYNTSUPERFLUOUS,
|
|
fGrammar.GrammarFile,
|
|
alt.SynPred.Line,
|
|
alt.SynPred.Column);
|
|
|
|
if pNoTestForSingle then
|
|
begin
|
|
if alt.SemPred <> '' then
|
|
genSemPred( alt.SemPred);
|
|
|
|
genAlt( alt, pBlock);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Do non-LL(1) and nondeterministic cases.
|
|
// This is tricky in the lexer, because of cases like:
|
|
// STAR : '*';
|
|
// ASSIGN_STAR : "*=";
|
|
// Since NextToken is generated whitout a loop, then the STAR will
|
|
// have end-of-token as it's lookahead set for LA(2). So we must
|
|
// generate the alternatives containing trailing end-of-token in
|
|
// their lookahead sets *after* the alternatives without end-of-token.
|
|
// This implements the usual lexer convention that longer matches
|
|
// come before shorter ones, e.g. "*=" matches ASSIGN_STAR not STAR.
|
|
//
|
|
// For non-lexer grammars, this does not sort the alternatives by
|
|
// depth. Note that alternatives whose lookahead is purely end-of-token
|
|
// at k=1 end up as default or else clauses.
|
|
// ---------------------------------------------------------------
|
|
if fIsLexer
|
|
then startDepth := fLexerGrammar.MaxK
|
|
else startDepth := 0;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Check for empty alternative in the block
|
|
// ---------------------------------------------------------------
|
|
hasEmptyAlt := false;
|
|
|
|
for i:=0 to pBlock.Alternatives.Count -1 do
|
|
begin
|
|
if altIsEmpty( pBlock.Alternative[i]) then
|
|
begin
|
|
hasEmptyAlt := true;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate syntactic predicates first!
|
|
//
|
|
// Note: the rule must have minimum one non-empty alternative which
|
|
// has no syntactic predicate
|
|
// ---------------------------------------------------------------
|
|
if pBlock.HasASynPred then
|
|
begin
|
|
for i:=0 to pBlock.Alternatives.Count -1 do
|
|
begin
|
|
alt := pBlock.Alternative[i];
|
|
|
|
if alt.SynPred <> nil then
|
|
begin
|
|
println('if not _spMatch then');
|
|
println('begin');
|
|
INC(fTabs);
|
|
|
|
genSynPred( alt.SynPred, e);
|
|
|
|
INC(fTabs);
|
|
genAlt( alt, pBlock);
|
|
DEC(fTabs);
|
|
println('end;');
|
|
DEC(fTabs);
|
|
println('end;');
|
|
println('');
|
|
end;
|
|
end;
|
|
|
|
// ------------------------------------------------------
|
|
// Well, the rest of the alternatives must be in an if
|
|
// clause.
|
|
// ------------------------------------------------------
|
|
println('if not _spMatch then');
|
|
println('begin');
|
|
INC(fTabs);
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Now generate the normal alternatives
|
|
// ---------------------------------------------------------------
|
|
for altDepth := startDepth downto 0 do
|
|
begin
|
|
for i:=0 to pBlock.Alternatives.Count -1 do
|
|
begin
|
|
alt := pBlock.Alternative[i];
|
|
unpredicted := False;
|
|
|
|
// ---------------------------------------------------------
|
|
// Skip already generates alternatives with syntactic
|
|
// predicates.
|
|
// ---------------------------------------------------------
|
|
if alt.SynPred <> nil then
|
|
continue;
|
|
|
|
// ---------------------------------------------------------
|
|
// Lexer grammar
|
|
// ---------------------------------------------------------
|
|
if fIsLexer then
|
|
begin
|
|
// ------------------------------------------------------
|
|
// Calculate the "effective depth" of the alt, which is
|
|
// the max depth at which cache[dept] <> end-of-token.
|
|
// ------------------------------------------------------
|
|
effectiveDepth := alt.LookaheadDepth;
|
|
|
|
// ------------------------------------------------------
|
|
// If the alt's lookahead depth is NONDETERMINISTIC then
|
|
// use the maximum lookahead.
|
|
// ------------------------------------------------------
|
|
if effectiveDepth = NONDETERMINISTIC then
|
|
effectiveDepth := fLexerGrammar.MaxK;
|
|
|
|
while (effectiveDepth >= 1) and
|
|
(alt.Cache[effectiveDepth].HasEpsilon or
|
|
(alt.Cache[effectiveDepth].LaSet = [1..255])) do
|
|
begin
|
|
DEC(effectiveDepth);
|
|
end;
|
|
|
|
// ------------------------------------------------------
|
|
// Ignore alts whose effective depth is other than the
|
|
// ones we are generating for this iteration.
|
|
// ------------------------------------------------------
|
|
if effectiveDepth <> altDepth then
|
|
continue;
|
|
|
|
unpredicted := lookaheadIsEmpty( alt, effectiveDepth);
|
|
e := getLookaheadTestExpr( alt, effectiveDepth);
|
|
end
|
|
|
|
// ---------------------------------------------------------
|
|
// Non-lexer grammar.
|
|
// ---------------------------------------------------------
|
|
else
|
|
begin
|
|
unpredicted := lookaheadIsEmpty( alt, fGrammar.MaxK);
|
|
e := getLookaheadTestExpr( alt, fGrammar.MaxK);
|
|
end;
|
|
|
|
// ---------------------------------------------------------
|
|
// If the alternative is empty, then don't generate checking
|
|
// code for the follow set, and say we don't need an error
|
|
// clause. The following token will handle the possible
|
|
// token mismatch.
|
|
// ---------------------------------------------------------
|
|
if altIsEmpty(alt) then
|
|
begin
|
|
result.NeedAnErrorClause := false;
|
|
continue;
|
|
end
|
|
|
|
else if (unpredicted) and
|
|
(alt.SemPred = '') and
|
|
(alt.SynPred = nil) then
|
|
begin
|
|
// ------------------------------------------------------
|
|
// The alt has empty prediction set and no predicate to
|
|
// help out. If we have not generated a previous if, just
|
|
// put {...} around the end-of-token clause.
|
|
// ------------------------------------------------------
|
|
if nIF = 0 then
|
|
begin
|
|
println('begin');
|
|
end
|
|
else
|
|
begin
|
|
println('else');
|
|
println('begin');
|
|
end;
|
|
|
|
result.NeedAnErrorClause := false;
|
|
end
|
|
|
|
else
|
|
begin
|
|
// ------------------------------------------------------
|
|
// Generate semantic predicate
|
|
// ------------------------------------------------------
|
|
if alt.SemPred <> '' then
|
|
begin
|
|
semPred := Copy( alt.SemPred,2,Length(alt.SemPred)-2);
|
|
|
|
if e = 'true' then
|
|
e := '( ' + semPred + ')'
|
|
else
|
|
e := '(' + e + ' and (' + semPred + '))';
|
|
end;
|
|
|
|
// ------------------------------------------------------
|
|
// Generate syntactic predicate
|
|
// ------------------------------------------------------
|
|
if nIF > 0 then
|
|
begin
|
|
println('');
|
|
|
|
// if pBlock.HasASynPred then
|
|
// e := e + ' and not _spMatch';
|
|
|
|
println('else if ' + e + ' then');
|
|
println('begin');
|
|
end
|
|
else
|
|
begin
|
|
// if pBlock.HasASynPred then
|
|
// e := e + ' and not _spMatch';
|
|
|
|
println('if ' + e + ' then');
|
|
println('begin');
|
|
end;
|
|
end;
|
|
|
|
INC(nIF);
|
|
INC(fTabs);
|
|
genAlt( alt, pBlock);
|
|
DEC(fTabs);
|
|
|
|
if i = pBlock.Alternatives.Count -2 then
|
|
begin
|
|
if hasEmptyAlt
|
|
then println('end;')
|
|
else println('end')
|
|
end
|
|
else
|
|
println('end')
|
|
end;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Close the synpred's if
|
|
// ---------------------------------------------------------------
|
|
if pBlock.HasASynPred then
|
|
result.NeedAClosingEnd := true;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Restore save text state.
|
|
// ---------------------------------------------------------------
|
|
fSaveText := oldSaveText;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Return the finishing info.
|
|
// ---------------------------------------------------------------
|
|
result.PostScript := ps;
|
|
result.GeneratedAnIf := nIF > 0;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// suitableForCaseExpression
|
|
// ============================================================================
|
|
//function TDelphiGenerator.suitableForCaseExpression( pAlt: IAlternative): boolean;
|
|
//begin
|
|
// result := false;
|
|
//end;
|
|
|
|
// ============================================================================
|
|
// lookaheadIsEmpty
|
|
// ============================================================================
|
|
function TDelphiGenerator.lookaheadIsEmpty( pAlt : IAlternative;
|
|
pMaxDepth: integer): boolean;
|
|
var
|
|
depth : integer;
|
|
i : integer;
|
|
p : TByteSet;
|
|
|
|
begin
|
|
result := true;
|
|
depth := pAlt.LookaheadDepth;
|
|
|
|
if depth = NONDETERMINISTIC then
|
|
depth := fGrammar.MaxK;
|
|
|
|
for i:=1 to depth do
|
|
begin
|
|
p := pAlt.Cache[i].LaSet;
|
|
|
|
if p <> [] then
|
|
begin
|
|
result := false;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genClassDef
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genClassDef;
|
|
var
|
|
i : integer;
|
|
rs : IRuleSymbol;
|
|
|
|
begin
|
|
// ---------------------------------------------------------------
|
|
// Generate rules
|
|
// ---------------------------------------------------------------
|
|
for i:=0 to fGrammar.Rules.Count -1 do
|
|
begin
|
|
rs := fGrammar.Rules[i] as IRuleSymbol;
|
|
|
|
if rs.ID <> 'mNextToken' then
|
|
genRule( fGrammar.Rules[i] as IRuleSymbol);
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate lexer specific methods
|
|
// ---------------------------------------------------------------
|
|
if fIsLexer then
|
|
begin
|
|
genNextToken;
|
|
|
|
if needsLexerInit then
|
|
genInitLiterals;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// finally generate member definitions,....
|
|
// ---------------------------------------------------------------
|
|
if fGrammar.MemberDef <> '' then
|
|
printAction( fgrammar.MemberDef);
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genRule
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genRule(pRuleSymbol: IRuleSymbol);
|
|
var
|
|
rblk : IRuleBlock;
|
|
ulEx : IExceptionSpec;
|
|
alt : IAlternative;
|
|
pred : AnsiString;
|
|
htf : TDelphiBlockFinishingInfo;
|
|
// sl : TInterfaceList;
|
|
// sp : ISynPredBlock;
|
|
// i : integer;
|
|
follow : TByteSet;
|
|
rname : AnsiString;
|
|
|
|
begin
|
|
fTabs := 0;
|
|
|
|
// ---------------------------------------------------------------
|
|
// If the rule not defined, leave.
|
|
// ---------------------------------------------------------------
|
|
if not pRuleSymbol.Defined then
|
|
begin
|
|
if fIsLexer then
|
|
rname := TCodeGenerator.decodeLexerRuleName( pRuleSymbol.ID)
|
|
else
|
|
rname := pRuleSymbol.ID;
|
|
|
|
fTool.Error( Format( MSG_E_RULENOTDEFINED, [rname]),
|
|
fGrammar.GrammarFile,
|
|
-1,0);
|
|
|
|
// fTool.Error('Undefined rule: "' + pRuleSymbol.ID);
|
|
exit;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Get the rule block
|
|
// ---------------------------------------------------------------
|
|
rblk := pRuleSymbol.Block;
|
|
|
|
println('// ============================================================================');
|
|
println('// ' + pRuleSymbol.ID);
|
|
println('// ============================================================================');
|
|
genMethodDecl( pRuleSymbol, 0, true);
|
|
genRuleLocals( rblk);
|
|
|
|
println('begin');
|
|
INC(fTabs);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Initialize some of the local variables
|
|
// ---------------------------------------------------------------
|
|
if fIsLexer then
|
|
begin
|
|
println('_begin := Length( TokenText) +1;');
|
|
println('_token := nil;');
|
|
println('_ttype := TT_' + TCodeGenerator.decodeLexerRuleName(pRuleSymbol.ID)+';');
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Initialize synpred vars
|
|
// ---------------------------------------------------------------
|
|
if rblk.HasASynPred then
|
|
begin
|
|
println('_spMatch := false;');
|
|
println('_mkMatch := 0;');
|
|
end;
|
|
println('');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate try block around the entire rule if necessary
|
|
// ---------------------------------------------------------------
|
|
if (rblk.ExHandlerType <> '') or
|
|
(rblk.DefaultErrorHandler and (not fIsLexer)) then
|
|
begin
|
|
println('try');
|
|
INC(fTabs);
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate block init action
|
|
// ---------------------------------------------------------------
|
|
genBlockInitAction( rblk);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate the alternatives
|
|
// ---------------------------------------------------------------
|
|
if rblk.Alternatives.Count = 1 then
|
|
begin
|
|
// ------------------------------------------------------------
|
|
// One alternative -- use simple form
|
|
// ------------------------------------------------------------
|
|
alt := rblk.Alternative[0];
|
|
pred := alt.SemPred;
|
|
|
|
if pred <> '' then
|
|
genSemPred( pred);
|
|
|
|
if alt.SynPred <> nil then
|
|
begin
|
|
fTool.Warning( MSG_W_SYNTIGNORED,
|
|
fGrammar.GrammarFile,
|
|
alt.SynPred.Line,
|
|
alt.SynPred.Column);
|
|
end;
|
|
|
|
genAlt( alt, rblk);
|
|
end
|
|
|
|
else
|
|
begin
|
|
// ------------------------------------------------------------
|
|
// More than one alternatives -- generate complex form
|
|
// ------------------------------------------------------------
|
|
fGrammar.LLkAnalyzer.Deterministic( rblk);
|
|
|
|
htf := genCommonBlock( rblk, false);
|
|
genBlockFinish( htf, throw(rblk.Look(1)), true);
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate exception handler
|
|
// ---------------------------------------------------------------
|
|
if (rblk.ExHandlerType <> '') or
|
|
(rblk.DefaultErrorHandler and (not fIsLexer)) then
|
|
begin
|
|
println('');
|
|
|
|
// ------------------------------------------------------------
|
|
// Generate user exception-handler code, or....
|
|
// ------------------------------------------------------------
|
|
if rblk.ExHandlerType <> '' then
|
|
begin
|
|
DEC( fTabs);
|
|
println(rblk.ExHandlerType);
|
|
INC(fTabs);
|
|
|
|
if( rblk.ExHandlerType = 'except') then
|
|
begin
|
|
println('on e:Exception do');
|
|
println('begin');
|
|
INC(fTabs);
|
|
end;
|
|
end
|
|
|
|
// ------------------------------------------------------------
|
|
// ... default error handler code....
|
|
// ------------------------------------------------------------
|
|
else
|
|
begin
|
|
DEC( fTabs);
|
|
println('except');
|
|
INC(fTabs);
|
|
println('on e:Exception do');
|
|
println('begin');
|
|
INC(fTabs);
|
|
end;
|
|
|
|
// ------------------------------------------------------------
|
|
// Generate code to handle error if not guessing...
|
|
// ------------------------------------------------------------
|
|
if fGrammar.HasSynPred then
|
|
begin
|
|
println('if InputState.Guessing = 0 then');
|
|
println('begin');
|
|
INC(fTabs);
|
|
end;
|
|
|
|
// ------------------------------------------------------------
|
|
// Now the real handler...
|
|
// ------------------------------------------------------------
|
|
if rblk.ExHandlerType <> '' then
|
|
begin
|
|
printAction( rblk.ExHandlerCode);
|
|
end
|
|
|
|
else
|
|
begin
|
|
follow := rblk.EndElem.Look(1).LaSet;
|
|
|
|
println('reportError(e);');
|
|
println('Consume;');
|
|
println('ConsumeUntil( [' +
|
|
TokenSetToStr(follow,fGrammar.TokenManager)+
|
|
']);');
|
|
end;
|
|
|
|
// ---------------------------------------------------------
|
|
// When guiessing, rethrow exception
|
|
// ---------------------------------------------------------
|
|
if fGrammar.HasSynPred then
|
|
begin
|
|
DEC(fTabs);
|
|
|
|
println('end');
|
|
|
|
if rblk.ExHandlerType <> 'finally' then
|
|
begin
|
|
println('else');
|
|
println(fTab + 'Raise;');
|
|
end;
|
|
end;
|
|
|
|
DEC(fTabs);
|
|
println('end;');
|
|
|
|
if rblk.ExHandlerType <> 'finally' then
|
|
begin
|
|
DEC(fTabs);
|
|
println('end;');
|
|
end;
|
|
end;
|
|
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate literals test for lexer rules so marked
|
|
// ---------------------------------------------------------------
|
|
if rblk.TestLiterals then
|
|
begin
|
|
if pRuleSymbol.Access = 'protected'
|
|
then genLiteralsTestForPartialToken
|
|
else genLiteralsTest;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// If doing a lexer rule, dump code to create token if necessary.
|
|
// ---------------------------------------------------------------
|
|
if fIsLexer then
|
|
begin
|
|
println('');
|
|
println('if (_ttype <> TT_SKIP) and (pCreate = true) then');
|
|
println('begin');
|
|
INC(fTabs);
|
|
println('_token := makeToken( _ttype);');
|
|
println('_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);');
|
|
DEC(fTabs);
|
|
println('end;');
|
|
println('');
|
|
println('ReturnToken := _token;');
|
|
end;
|
|
|
|
DEC( fTabs);
|
|
println('end;');
|
|
println('');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genRuleInvocation
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genRuleInvocation( pRuleRefElem: IRuleRefElem);
|
|
var
|
|
rs: IRuleSymbol;
|
|
|
|
begin
|
|
// _print( pRuleRefElem.TargetRule + '( ');
|
|
|
|
_print( pRuleRefElem.TargetRule);
|
|
|
|
if fIsLexer or (pRuleRefElem.Args <> '') then
|
|
_print('(');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Lexers must tell rule if it should set _returnToken
|
|
// ---------------------------------------------------------------
|
|
if fIsLexer then
|
|
begin
|
|
// ------------------------------------------------------------
|
|
// If labeled, could access Token, so tell the rule to generate
|
|
// ------------------------------------------------------------
|
|
if pRuleRefElem.Lbl <> '' then
|
|
_print('true')
|
|
else
|
|
_print('false');
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Process arguments to method, if any...
|
|
// ---------------------------------------------------------------
|
|
if pRuleRefElem.Args <> '' then
|
|
begin
|
|
if fIsLexer then
|
|
_print(', ');
|
|
|
|
_print(pRuleRefElem.Args);
|
|
|
|
|
|
// ------------------------------------------------------------
|
|
// Warn if the rule accepts no arguments
|
|
// ------------------------------------------------------------
|
|
rs := fGrammar.Symbol[pRuleRefElem.TargetRule] as IRuleSymbol;
|
|
|
|
if rs.Block.Arguments = '' then
|
|
begin
|
|
fTool.Warning( Format( MSG_W_RULEACCEPTSNOARGS, [pRuleRefElem.TargetRule]),
|
|
fGrammar.GrammarFile,
|
|
pRuleRefElem.Line,
|
|
pRuleRefElem.Column);
|
|
end;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Close the invocation
|
|
// ---------------------------------------------------------------
|
|
if fIsLexer or (pRuleRefElem.Args <> '') then
|
|
_print(')');
|
|
|
|
_println(';');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genSemPred
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genSemPred(pSemPred: AnsiString);
|
|
var
|
|
semPred: AnsiString;
|
|
|
|
begin
|
|
semPred := Trim( Copy( pSemPred, 2, Length( pSemPred) -2));
|
|
|
|
println('');
|
|
println('if not (' + semPred + ') then');
|
|
INC(fTabs);
|
|
println( 'Raise ESemantic.Create(''' +
|
|
sempred +''', InputState.FileName, InputState.Line, InputState.Column);');
|
|
println('');
|
|
DEC(fTabs);
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genSynPred
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genSynPred( pBlock : ISynPredBlock;
|
|
pLookaheadExpr : AnsiString);
|
|
var
|
|
id : AnsiString;
|
|
|
|
begin
|
|
id := IntToStr( pBlock.ID);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Save input state
|
|
// ---------------------------------------------------------------
|
|
println('_mkMatch := mark;');
|
|
println('_spMatch := true;');
|
|
println('');
|
|
println('InputState.Guessing := InputState.Guessing + 1;');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Once inside the try, assume synpred works unless exception caught.
|
|
// ---------------------------------------------------------------
|
|
INC(fSyntacticPredLevel);
|
|
println('');
|
|
println('try');
|
|
INC(fTabs);
|
|
gen( pBlock as IAlternativeBlock);
|
|
DEC(fTabs);
|
|
println('except');
|
|
INC(fTabs);
|
|
println('_spMatch := false;');
|
|
DEC(fTabs);
|
|
println('end;');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Restore input state.
|
|
// ---------------------------------------------------------------
|
|
println('');
|
|
println('rewind( _mkMatch);');
|
|
println('InputState.Guessing := InputState.Guessing - 1;');
|
|
|
|
DEC(fSyntacticPredLevel);
|
|
// DEC(fTabs);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Close lookahead test
|
|
// ---------------------------------------------------------------
|
|
// println('end;');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Test synpred result
|
|
// ---------------------------------------------------------------
|
|
println('');
|
|
println('if _spMatch then');
|
|
println('begin');
|
|
// INC(fTabs);
|
|
end;
|
|
|
|
|
|
// ============================================================================
|
|
// genBlockInitAction
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genBlockInitAction( pBlock: IAlternativeBlock);
|
|
begin
|
|
if pBlock.InitAction <> '' then
|
|
begin
|
|
printAction( pBlock.InitAction);
|
|
println('');
|
|
end;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genAlt
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genAlt( pAlt : IAlternative;
|
|
pBlk : IAlternativeBlock);
|
|
var
|
|
oldSaveText : boolean;
|
|
elem : IAlternativeElem;
|
|
be : IBlockEndElem;
|
|
|
|
begin
|
|
// ---------------------------------------------------------------
|
|
// Save state
|
|
// ---------------------------------------------------------------
|
|
oldSaveText := fSaveText;
|
|
fSaveText := fSaveText and pAlt.DoAutoGen;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate try block around the alt for error handling
|
|
// ---------------------------------------------------------------
|
|
if pAlt.ExHandlerType <> '' then
|
|
begin
|
|
println('try');
|
|
INC(fTabs);
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate elems
|
|
// ---------------------------------------------------------------
|
|
elem := pAlt.Head;
|
|
while elem.QueryInterface(IBlockEndElem, be) <> S_OK do
|
|
begin
|
|
elem.Generate;
|
|
elem := elem.Next;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Close try block
|
|
// ---------------------------------------------------------------
|
|
if pAlt.ExHandlerType <> '' then
|
|
begin
|
|
println('');
|
|
|
|
DEC(fTabs);
|
|
println( pAlt.ExHandlerType);
|
|
INC(fTabs);
|
|
|
|
if pAlt.ExHandlerType = 'except' then
|
|
begin
|
|
println('on e:Exception do');
|
|
println('begin');
|
|
INC(fTabs);
|
|
end;
|
|
|
|
if fGrammar.HasSynPred then
|
|
begin
|
|
println('if InputState.Guessing = 0 then');
|
|
println('begin');
|
|
INC(fTabs);
|
|
end;
|
|
|
|
printAction( pAlt.ExHandlerCode);
|
|
|
|
if fGrammar.HasSynPred then
|
|
begin
|
|
DEC(fTabs);
|
|
println('end;');
|
|
end;
|
|
|
|
if pAlt.ExHandlerType = 'except' then
|
|
begin
|
|
DEC(fTabs);
|
|
println('end;');
|
|
end;
|
|
|
|
DEC(fTabs);
|
|
println('end');
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Restore state
|
|
// ---------------------------------------------------------------
|
|
fSaveText := oldSaveText;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genLiteralsTest
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genLiteralsTest;
|
|
begin
|
|
// println('');
|
|
// println('// --------------------------------------------------------------');
|
|
// println('// Consult literals table...');
|
|
// println('// --------------------------------------------------------------');
|
|
println('_ttype := TestLiteral( _ttype);');
|
|
println('');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genLiteralsTestForPartialToken
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genLiteralsTestForPartialToken;
|
|
begin
|
|
println('_ttype := TestLiteral( Copy( TokenText, _begin, Length(TokenText)-_begin+1), _ttype);');
|
|
println('');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Gen(StringLiteral)
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pAtom: IStringLiteralElem);
|
|
var
|
|
oldSaveText: boolean;
|
|
|
|
begin
|
|
if (pAtom.Lbl <> '') and (fSyntacticPredLevel = 0) then
|
|
println(pAtom.Lbl + ' := ' + fLT1Value + ';');
|
|
|
|
oldSaveText := fSaveText;
|
|
fSaveText := fSaveText and (pAtom.AutoGenType = AUTOGEN_NONE);
|
|
|
|
if oldSaveText and not fSaveText then
|
|
println('SaveConsumedInput := false;');
|
|
|
|
genMatch( pAtom);
|
|
|
|
if oldSaveText and not fSaveText then
|
|
println('SaveConsumedInput := true;');
|
|
|
|
fSaveText := oldSaveText;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genMatch
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genMatch(pAtom: IGrammarAtom);
|
|
var
|
|
cle : ICharLiteralElem;
|
|
sle : IStringLiteralElem;
|
|
wce : IWildcardElem;
|
|
tre : ITokenRefElem;
|
|
|
|
begin
|
|
pAtom.QueryInterface( ICharLiteralElem, cle);
|
|
pAtom.QueryInterface( IStringLiteralElem, sle);
|
|
pAtom.QueryInterface( IWildcardElem, wce);
|
|
pAtom.QueryInterface( ITokenRefElem, tre);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate match for char literal elem.
|
|
// ---------------------------------------------------------------
|
|
if cle <> nil then
|
|
begin
|
|
if fIsLexer then
|
|
genMatchUsingAtomText( pAtom)
|
|
else
|
|
begin
|
|
fTool.Error( Format( MSG_E_CHARLITINNONLEXER, [pAtom.AtomText]));
|
|
// fTool.Error('Cannot reference character literals in non-lexer grammar: ' +
|
|
// pAtom.AtomText);
|
|
end;
|
|
end
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate match for AnsiString literal elem.
|
|
// ---------------------------------------------------------------
|
|
else if sle <> nil then
|
|
begin
|
|
if fIsLexer
|
|
then genMatchUsingAtomText( pAtom)
|
|
else genMatchUsingAtomTokenType( pAtom);
|
|
end
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate match for token ref elem.
|
|
// ---------------------------------------------------------------
|
|
else if tre <> nil then
|
|
genMatchUsingAtomText( pAtom)
|
|
|
|
// ---------------------------------------------------------------
|
|
// Generate match for wildcard elem.
|
|
// ---------------------------------------------------------------
|
|
else if wce <> nil then
|
|
gen( wce);
|
|
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genMatchUsingAtomText
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genMatchUsingAtomText( pAtom: IGrammarAtom);
|
|
var
|
|
cle : ICharLiteralElem;
|
|
sle : IStringLiteralElem;
|
|
|
|
begin
|
|
pAtom.QueryInterface(ICharLiteralElem, cle);
|
|
pAtom.QueryInterface(IStringLiteralElem, sle);
|
|
|
|
if not pAtom.IsNot then print('match(')
|
|
else print('matchNot(');
|
|
|
|
if cle <> nil then
|
|
_print( CharSetToStr([pAtom.AtomText[1]]))
|
|
|
|
else if sle <> nil then
|
|
_print( '''' + Copy( pAtom.AtomText, 2, Length( pAtom.AtomText)-2) + '''')
|
|
|
|
else
|
|
_print( TokenSetToStr( [pAtom.TokenType], fGrammar.TokenManager));
|
|
|
|
_println(');');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genMatchUsingAtomTokenType
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genMatchUsingAtomTokenType( pAtom: IGrammarAtom);
|
|
begin
|
|
if not pAtom.IsNot
|
|
then println('match(' + getValueString( pAtom.TokenType) + ');')
|
|
else println('matchNot(' + getValueString( pAtom.TokenType) + ');');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// getValueString
|
|
// ============================================================================
|
|
function TDelphiGenerator.getValueString(pType : integer): AnsiString;
|
|
var
|
|
ts: ITokenSymbol;
|
|
ss: IStringSymbol;
|
|
cs: AnsiString;
|
|
id: AnsiString;
|
|
// lbl: AnsiString;
|
|
|
|
begin
|
|
if fIsLexer then
|
|
begin
|
|
println('//TODO:getValueString(lexer)');
|
|
|
|
|
|
end
|
|
|
|
else
|
|
begin
|
|
result := TokenSetToStr( [pType], fGrammar.TokenManager);
|
|
|
|
ts := fGrammar.TokenManager.TokenSymbolByType[pType];
|
|
|
|
if ts = nil then
|
|
begin
|
|
result := 'TT_' + IntToStr( pType);
|
|
exit;
|
|
end;
|
|
|
|
id := ts.ID;
|
|
ts.QueryInterface(IStringSymbol,ss);
|
|
|
|
if ss <> nil then
|
|
begin
|
|
// ---------------------------------------------------------
|
|
// In AnsiString literal, use predefined label if any. If no
|
|
// predefined, try to mangle into LT_xxxx.
|
|
// If can't mangle, use int as last resort.
|
|
// ---------------------------------------------------------
|
|
if ss.Lbl <> '' then
|
|
result := ss.Lbl
|
|
|
|
else
|
|
begin
|
|
// result := magleLiteral( tId);
|
|
if result = '' then
|
|
result := 'LT_' + IntToStr( pType);
|
|
end;
|
|
end
|
|
|
|
else
|
|
begin
|
|
if id = 'EOF'
|
|
then result := 'TT_EOF'
|
|
else result := id;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Gen(WildCard)
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pWc: IWildcardElem);
|
|
begin
|
|
if (pWc.Lbl <> '') and (fSyntacticPredLevel = 0) then
|
|
println( pWc.Lbl + ' := ' + fLT1Value + ';');
|
|
|
|
if fIsLexer then
|
|
begin
|
|
if fSaveText and (pWc.AutoGenType = AUTOGEN_BANG) then
|
|
println('SaveConsumedInput := false;');
|
|
|
|
println('matchNot( EOF_CHAR );');
|
|
|
|
if fSaveText and (pWc.AutoGenType = AUTOGEN_BANG) then
|
|
println('SaveConsumedInput := true;');
|
|
end
|
|
|
|
else if fIsParser then
|
|
println('matchNot( ' + getValueString(0) + ');');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// addSemPred
|
|
// ============================================================================
|
|
function TDelphiGenerator.addSemPred(pSemPred: AnsiString): integer;
|
|
begin
|
|
result := fSemPreds.Add( pSemPred);
|
|
end;
|
|
|
|
// ============================================================================
|
|
// exitIfError
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.exitIfError;
|
|
begin
|
|
{ TODO : exitIfError }
|
|
end;
|
|
|
|
|
|
// ============================================================================
|
|
// genPredictExpr
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genPredictExpr( pLaList : TInterfaceList;
|
|
pLaDepth : integer);
|
|
var
|
|
i : integer;
|
|
la : ILookahead;
|
|
|
|
begin
|
|
print('( ');
|
|
|
|
for i:=0 to pLaDepth -1 do
|
|
begin
|
|
if i <> 1 then
|
|
begin
|
|
println(') and');
|
|
print('( ');
|
|
end;
|
|
|
|
pLaList.Items[i].QueryInterface(ILookahead, la);
|
|
|
|
// ------------------------------------------------------------
|
|
// Syntactic predicates can yield <end-of-syn-pred> (epsilon)
|
|
// lookahead- There is no way to predic what that token would
|
|
// be. Allow anything instead.
|
|
// ------------------------------------------------------------
|
|
if la.HasEpsilon then
|
|
_print('true')
|
|
else
|
|
_print(getLookaheadTestTerm(i,la));
|
|
end;
|
|
|
|
_println(')');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// getLookaheadTestExpr
|
|
// ============================================================================
|
|
function TDelphiGenerator.getLookaheadTestExpr( pLaList : TInterfaceList;
|
|
pLaDepth : integer): AnsiString;
|
|
var
|
|
i : integer;
|
|
la : ILookahead;
|
|
|
|
begin
|
|
result := '( ';
|
|
|
|
for i:=0 to pLaDepth -1 do
|
|
begin
|
|
|
|
pLaList.Items[i].QueryInterface(ILookahead, la);
|
|
|
|
// ------------------------------------------------------------
|
|
// Syntactic predicates can yield <end-of-syn-pred> (epsilon)
|
|
// lookahead. There is no way to predic what that token would
|
|
// be. Allow anything instead.
|
|
// ------------------------------------------------------------
|
|
if la.HasEpsilon then
|
|
// result := result + 'true'
|
|
else
|
|
begin
|
|
if i <> 0 then
|
|
result := result + ') and (';
|
|
|
|
result := result + getLookaheadTestTerm(i+1,la);
|
|
end;
|
|
end;
|
|
|
|
result := result + ')';
|
|
end;
|
|
|
|
// ============================================================================
|
|
// getLookaheadTestExpr
|
|
// ============================================================================
|
|
function TDelphiGenerator.getLookaheadTestExpr( pAlt : IAlternative;
|
|
pMaxDepth: integer): AnsiString;
|
|
var
|
|
i : integer;
|
|
depth : integer;
|
|
laList : TInterfaceList;
|
|
|
|
begin
|
|
if pAlt.LookaheadDepth <> NONDETERMINISTIC then
|
|
depth := pAlt.LookaheadDepth
|
|
else
|
|
depth := fGrammar.MaxK;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Empty lookahead can result from alt with semantic pred that can
|
|
// see end-of-token. E.g. A: {pred}? ('a')? ;
|
|
// ---------------------------------------------------------------
|
|
if pMaxDepth = 0 then
|
|
result := 'true'
|
|
|
|
else
|
|
begin
|
|
laList := TInterfaceList.Create;
|
|
|
|
for i:=1 to depth do
|
|
begin
|
|
if pAlt.Cache[i].LaSet <> [1..255] then
|
|
laList.Add( pAlt.Cache[i])
|
|
else
|
|
break;
|
|
end;
|
|
|
|
result := '(' + getLookaheadTestExpr( laList, i-1) + ')';
|
|
end;
|
|
|
|
|
|
|
|
end;
|
|
|
|
// ============================================================================
|
|
// getLookaheadTestTerm
|
|
// ============================================================================
|
|
function TDelphiGenerator.getLookaheadTestTerm( pK : integer;
|
|
pLA : ILookahead): AnsiString;
|
|
begin
|
|
result := getLookaheadString( pK) + ' in ';
|
|
|
|
if fIsLexer then
|
|
result := result + '[' + CharSetToStr( pLa.LaSet) + ']'
|
|
|
|
else if fIsParser then
|
|
result := result + '[' + TokenSetToStr( pLa.LaSet, fGrammar.TokenManager) + ']';
|
|
end;
|
|
|
|
// ============================================================================
|
|
// getLookaheadString
|
|
// ============================================================================
|
|
function TDelphiGenerator.getLookaheadString(pK: integer): AnsiString;
|
|
begin
|
|
result := 'LA(' + IntToStr( pK) + ')';
|
|
end;
|
|
|
|
// ============================================================================
|
|
// genRuleLocals
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.genRuleLocals(pRuleBlock: IRuleBlock);
|
|
var
|
|
i : integer;
|
|
vars : TStringList;
|
|
vName : AnsiString;
|
|
vType : AnsiString;
|
|
|
|
lElems : TInterfaceList;
|
|
lOom : TInterfaceList;
|
|
lM2N : TInterfaceList;
|
|
|
|
// lSyn : TInterfaceList;
|
|
elem : IAlternativeElem;
|
|
oom : IOneOrMoreBlock;
|
|
m2n : INMBlock;
|
|
// syn : ISynPredBlock;
|
|
|
|
begin
|
|
vars := TStringList.Create;
|
|
vars.Sorted := true;
|
|
vars.Duplicates := dupIgnore;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Add mandatory local variables for lexer grammar.
|
|
// ---------------------------------------------------------------
|
|
if fIsLexer then
|
|
begin
|
|
vars.Add('_begin=integer');
|
|
vars.Add('_ttype=integer');
|
|
vars.Add('_save=integer');
|
|
vars.Add('_token=IToken');
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Collect labeled elems
|
|
// ---------------------------------------------------------------
|
|
lElems := pRuleBlock.LabeledElems;
|
|
|
|
for i:=0 to lElems.Count -1 do
|
|
begin
|
|
lElems[i].QueryInterface( IAlternativeElem, elem);
|
|
if LowerCase(elem.Lbl) <> 'result' then
|
|
vars.Add( elem.Lbl + '=IToken');
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Collect labels for (...)+ subrules
|
|
// ---------------------------------------------------------------
|
|
lOom := pRuleBlock.OneOrMoreBlocks;
|
|
for i:=0 to lOom.Count -1 do
|
|
begin
|
|
lOom.Items[i].QueryInterface(IOneOrMoreBlock, oom);
|
|
|
|
if oom <> nil then
|
|
begin
|
|
if oom.Lbl <> '' then
|
|
vName := '_cnt_' + oom.Lbl + '=integer'
|
|
else
|
|
vName := '_cnt_' + IntToStr( oom.ID) + '=integer';
|
|
|
|
vars.Add(vName);
|
|
end;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Collect labels for (...)@ subrules
|
|
// ---------------------------------------------------------------
|
|
lM2N := pRuleBlock.NMBlocks;
|
|
for i:=0 to lM2N.Count -1 do
|
|
begin
|
|
lM2N.Items[i].QueryInterface(INMBlock, m2n);
|
|
|
|
if m2n <> nil then
|
|
begin
|
|
if m2n.Lbl <> ''
|
|
then vName := '_cnt_' + m2n.Lbl + '=integer'
|
|
else vName := '_cnt_' + IntToStr( m2n.ID) + '=integer';
|
|
|
|
vars.Add(vName);
|
|
end;
|
|
end;
|
|
|
|
|
|
// ---------------------------------------------------------------
|
|
// Collect labels for SynPred subrules
|
|
// ---------------------------------------------------------------
|
|
if pRuleBlock.HasASynPred then
|
|
begin
|
|
vars.Add('_spMatch=boolean');
|
|
vars.Add('_mkMatch=integer');
|
|
end;
|
|
|
|
(* lSyn := pRuleBlock.SynPredBlocks;
|
|
for i:=0 to lSyn.Count -1 do
|
|
begin
|
|
lSyn.Items[i].QueryInterface(ISynPredBlock, syn);
|
|
|
|
if syn <> nil then
|
|
begin
|
|
vName := '_sp' + IntToStr( syn.ID) + '=boolean';
|
|
vars.Add(vName);
|
|
|
|
vName := '_mk' + IntToStr( syn.ID) + '=integer';
|
|
vars.Add(vName);
|
|
end;
|
|
end;
|
|
*)
|
|
// ---------------------------------------------------------------
|
|
// Now generate ....
|
|
// ---------------------------------------------------------------
|
|
if (vars.Count > 0) or (pRuleBlock.Locals <> '')then
|
|
begin
|
|
println('var');
|
|
INC(fTabs);
|
|
|
|
// ------------------------------------------------------------
|
|
// Generate labeled elems
|
|
// ------------------------------------------------------------
|
|
for i:=0 to vars.Count -1 do
|
|
begin
|
|
vName := vars.Names [i];
|
|
vType := vars.Values[vName];
|
|
|
|
println( vName + ': ' + vType + ';');
|
|
end;
|
|
|
|
// ------------------------------------------------------------
|
|
// Generate locals{...}
|
|
// ------------------------------------------------------------
|
|
if pRuleBlock.Locals <> '' then
|
|
printAction( pRuleBlock.Locals);
|
|
|
|
DEC(fTabs);
|
|
println('');
|
|
end;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Gen(TokenRef)
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pTokenRef: ITokenRefElem);
|
|
begin
|
|
if not fIsLexer then
|
|
begin
|
|
if (pTokenRef.Lbl <> '') and (fSyntacticPredLevel = 0) then
|
|
println(pTokenRef.Lbl + ' := ' + fLT1Value + ';');
|
|
|
|
genMatch( pTokenRef);
|
|
end
|
|
else
|
|
fTool.Panic('Token reference found in lexer...');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Gen(TokenRange)
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pElem: ITokenRangeElem);
|
|
begin
|
|
if not fIsLexer then
|
|
begin
|
|
if (pElem.Lbl <> '') and (fSyntacticPredLevel = 0) then
|
|
println( pElem.Lbl + ' := ' + fLT1Value + ';');
|
|
|
|
if pElem.BeginToken < pElem.EndToken then
|
|
println('match( [' +
|
|
TokenSetToStr( [pElem.BeginToken..pElem.EndToken],
|
|
fGrammar.TokenManager) +
|
|
']);')
|
|
else
|
|
println('match( [' +
|
|
TokenSetToStr( [pElem.EndToken..pElem.BeginToken],
|
|
fGrammar.TokenManager) +
|
|
']);');
|
|
end;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Gen(GrammarAtom)
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pAtom: IGrammarAtom);
|
|
var
|
|
tr : ITokenRefElem;
|
|
|
|
begin
|
|
if pAtom.QueryInterface(ITokenRefElem, tr) = S_OK then
|
|
Gen(tr)
|
|
else
|
|
println('***InternalError:GrammarAtom generation***');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Gen(BlockEnd)
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pEnd: IBlockEndElem);
|
|
begin
|
|
println('***InternalError:BlockEndElem generation***');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Gen(RuleEndElem)
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pElem: IRuleEndElem);
|
|
begin
|
|
println('***InternalError:RuleEndElem generation***');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Gen(SynPredBlock)
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pBlk: ISynPredBlock);
|
|
begin
|
|
println('***InternalError:SynPredBlock generation***');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Gen(RuleBlock)
|
|
// ============================================================================
|
|
procedure TDelphiGenerator.Gen(pBlk: IRuleBlock);
|
|
begin
|
|
println('***InternalError:RuleBlock generation***');
|
|
end;
|
|
|
|
|
|
function TDelphiGenerator.altIsEmpty(pAlt: IAlternative): boolean;
|
|
var
|
|
elem : IAlternativeElem;
|
|
be : IBlockEndElem;
|
|
|
|
begin
|
|
elem := pAlt.Head;
|
|
|
|
if elem.QueryInterface(IBlockEndElem, be) = S_OK then
|
|
result := true
|
|
else
|
|
result := false;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// ============================================================================
|
|
// throw
|
|
// ============================================================================
|
|
function TDelphiGenerator.throw(pLA1: ILookahead): AnsiString;
|
|
begin
|
|
if fIsLexer then
|
|
result := 'Raise EMismatchedChar.Create( LA(1), [' +
|
|
CharSetToStr( pLA1.LaSet) +
|
|
'], InputState.FileName, InputState.Line, InputState.Column);'
|
|
|
|
else
|
|
result := 'Raise EMismatchedToken.Create( LT(1), [' +
|
|
TokenSetToStr( pLA1.LaSet, fGrammar.TokenManager) +
|
|
'], InputState.FileName);';
|
|
end;
|
|
|
|
// ============================================================================
|
|
// needsLexerInit
|
|
// ============================================================================
|
|
function TDelphiGenerator.needsLexerInit: boolean;
|
|
var
|
|
i : integer;
|
|
name : AnsiString;
|
|
|
|
begin
|
|
if fIsLexer then
|
|
begin
|
|
for name in fGrammar.TokenManager.Vocabulary.Keys do
|
|
begin
|
|
if name[1] = '"' then
|
|
begin
|
|
result := true;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
// for i:=0 to fGrammar.TokenManager.Vocabulary.Count -1 do
|
|
// begin
|
|
// name := fGrammar.TokenManager.Vocabulary.Names[i];
|
|
//
|
|
// if name[1] = '"' then
|
|
// begin
|
|
// result := true;
|
|
// break;
|
|
// end;
|
|
// end;
|
|
|
|
if not fLexerGrammar.CaseSensitive then
|
|
result := true;
|
|
end
|
|
else
|
|
result := false;
|
|
end;
|
|
|
|
end.
|