622 lines
22 KiB
ObjectPascal
622 lines
22 KiB
ObjectPascal
unit dpglib.RuleBlock;
|
|
|
|
interface
|
|
uses
|
|
System.Classes,
|
|
dpgrtl.types,
|
|
dpglib.Types,
|
|
dpglib.Lookahead,
|
|
dpglib.AlternativeBlock;
|
|
|
|
type
|
|
// =========================================================================
|
|
// TRuleBlock class specification
|
|
// =========================================================================
|
|
TRuleBlock = class( TAlternativeBlock,
|
|
IRuleBlock,
|
|
IAlternativeBlock,
|
|
IAlternativeElem,
|
|
IGrammarElem)
|
|
// ---------------------------------------------------------------
|
|
// Members
|
|
// ---------------------------------------------------------------
|
|
protected
|
|
fRuleName : AnsiString;
|
|
fArguments : AnsiString;
|
|
fThrowSpec : AnsiString;
|
|
fReturnAction : AnsiString;
|
|
fLocals : AnsiString;
|
|
fIgnoreRule : AnsiString;
|
|
|
|
fExHandlerType : AnsiString;
|
|
fExHandlerCode : AnsiString;
|
|
|
|
fEndNode : IRuleEndElem;
|
|
|
|
fLock : array of boolean;
|
|
fCache : array of ILookahead;
|
|
|
|
fTestLiterals : boolean;
|
|
fDefErrorHandler : boolean;
|
|
|
|
fLabeledElems : TInterfaceList;
|
|
fOneOrMoreBlocks : TInterfaceList;
|
|
fNMBlocks : TInterfaceList;
|
|
fSynPredBlocks : TInterfaceList;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Internals
|
|
// ---------------------------------------------------------------
|
|
// protected
|
|
// function FindExceptionSpec( pSpec: AnsiString) : IExceptionSpec; overload;
|
|
// function FindExceptionSpec( pSpec: IToken): IExceptionSpec; overload;
|
|
|
|
|
|
// ---------------------------------------------------------------
|
|
// Constructor/destructor
|
|
// ---------------------------------------------------------------
|
|
public
|
|
constructor Create( pGrammar : IGrammar;
|
|
pID : AnsiString); overload;
|
|
constructor Create( pGrammar : IGrammar;
|
|
pID : AnsiString;
|
|
pLine : integer;
|
|
pDoAutoGen : boolean); overload;
|
|
|
|
|
|
destructor Destroy; override;
|
|
|
|
// ---------------------------------------------------------------
|
|
// IGrammarElem overrides
|
|
// ---------------------------------------------------------------
|
|
public
|
|
procedure Generate;
|
|
function Look( pK: integer): ILookahead;
|
|
function AsString : AnsiString;
|
|
|
|
// ---------------------------------------------------------------
|
|
// IAlternativeBlock overrides
|
|
// ---------------------------------------------------------------
|
|
public
|
|
procedure PrepareForAnalysis; override;
|
|
|
|
// ---------------------------------------------------------------
|
|
// IRuleBlock methods
|
|
// ---------------------------------------------------------------
|
|
protected
|
|
function GetRuleName : AnsiString;
|
|
function GetArguments : AnsiString;
|
|
function GetThrowSpec : AnsiString;
|
|
function GetReturnAction : AnsiString;
|
|
function GetLocals : AnsiString;
|
|
function GetEndNode : IRuleEndElem;
|
|
|
|
function GetTestLiterals : boolean;
|
|
function GetLabeledElems : TInterfaceList;
|
|
|
|
function GetExHandlerType : AnsiString;
|
|
function GetExHandlerCode : AnsiString;
|
|
|
|
function GetDefErrorHandler : boolean;
|
|
function GetIgnoreRule : AnsiString;
|
|
function GetOneOrMoreBlocks : TInterfaceList;
|
|
function GetNMBlocks : TInterfaceList;
|
|
function GetSynPredBlocks : TInterfaceList;
|
|
|
|
function GetLock( i: integer): boolean;
|
|
function GetCache(i: integer): ILookahead;
|
|
|
|
procedure SetRuleName( pRuleName : AnsiString);
|
|
procedure SetArguments( pArguments : AnsiString);
|
|
procedure SetThrowSpec( pThrowSpec : AnsiString);
|
|
procedure SetReturnAction( pAction : AnsiString);
|
|
procedure SetLocals( pLocals : AnsiString);
|
|
procedure SetEndNode( pNode : IRuleEndElem);
|
|
|
|
procedure SetTestLiterals( pTestLiterals : boolean);
|
|
procedure SetLabeledElems( pLabeledElems : TInterfaceList);
|
|
|
|
procedure SetExHandlerType( pExType : AnsiString);
|
|
procedure SetExHandlerCode( pExCode : AnsiString);
|
|
|
|
procedure SetDefErrorHandler( pErrorHandler : boolean);
|
|
procedure SetIgnoreRule( pRule : AnsiString);
|
|
|
|
procedure SetLock( i:integer; pLock : boolean);
|
|
procedure SetCache(i:integer; pCache : ILookahead);
|
|
|
|
public
|
|
procedure AddExceptionSpec( pExceptionSpec : IExceptionSpec);
|
|
procedure SetOption( pKey, pValue : IToken);
|
|
function IsLexerAutoGenRule: boolean;
|
|
end;
|
|
|
|
implementation
|
|
uses
|
|
System.SysUtils,
|
|
dpglib.Messages;
|
|
|
|
// ****************************************************************************
|
|
// Constructor/destructor
|
|
// ****************************************************************************
|
|
// ============================================================================
|
|
// Constructor
|
|
// ============================================================================
|
|
constructor TRuleBlock.Create(pGrammar: IGrammar; pID: AnsiString);
|
|
var
|
|
pg: IParserGrammar;
|
|
|
|
begin
|
|
inherited Create( pGrammar);
|
|
|
|
fRuleName := pID;
|
|
fLabeledElems := TInterfaceList.Create;
|
|
fOneOrMoreBlocks := TInterfaceList.Create;
|
|
fNMBlocks := TInterfaceList.Create;
|
|
fSynPredBlocks := TInterfaceList.Create;
|
|
fLine := 0;
|
|
|
|
SetLength( fCache, fGrammar.MaxK +1);
|
|
|
|
if fGrammar.QueryInterface(IParserGrammar, pg) = S_OK then
|
|
fDoAutoGen := true;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Constructor
|
|
// ============================================================================
|
|
constructor TRuleBlock.Create( pGrammar : IGrammar;
|
|
pID : AnsiString;
|
|
pLine : integer;
|
|
pDoAutoGen : boolean);
|
|
begin
|
|
inherited Create( pGrammar);
|
|
|
|
fRuleName := pID;
|
|
fLabeledElems := TInterfaceList.Create;
|
|
fDoAutoGen := pDoAutoGen;
|
|
fOneOrMoreBlocks := TInterfaceList.Create;
|
|
fNMBlocks := TInterfaceList.Create;
|
|
fSynPredBlocks := TInterfaceList.Create;
|
|
fLine := pLine;
|
|
|
|
SetLength( fCache, fGrammar.MaxK +1);
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Destructor
|
|
// ============================================================================
|
|
destructor TRuleBlock.Destroy;
|
|
var
|
|
i : integer;
|
|
|
|
begin
|
|
FreeAndNil( fLabeledElems);
|
|
FreeAndNil( fOneOrMoreBlocks);
|
|
FreeAndNil( fNMBlocks);
|
|
FreeAndNil( fSynPredBlocks);
|
|
|
|
for i:=Low(fCache) to High(fCache) do
|
|
fCache[i] := nil;
|
|
|
|
fCache := nil;
|
|
inherited;
|
|
end;
|
|
|
|
// ****************************************************************************
|
|
// IGrammarElem overrides
|
|
// ****************************************************************************
|
|
// ============================================================================
|
|
// Generate
|
|
// ============================================================================
|
|
procedure TRuleBlock.Generate;
|
|
begin
|
|
fGrammar.Generator.Gen( self);
|
|
end;
|
|
|
|
// ============================================================================
|
|
// Look
|
|
// ============================================================================
|
|
function TRuleBlock.Look(pK: integer): ILookahead;
|
|
begin
|
|
result := fGrammar.LLkAnalyzer.Look( pK, self);
|
|
end;
|
|
|
|
// ============================================================================
|
|
// AsString
|
|
// ============================================================================
|
|
function TRuleBlock.AsString: AnsiString;
|
|
begin
|
|
result := '';
|
|
end;
|
|
|
|
// ****************************************************************************
|
|
// IAlternativeBlock overrides
|
|
// ****************************************************************************
|
|
// ============================================================================
|
|
// PrepareForAnalysis
|
|
// ============================================================================
|
|
procedure TRuleBlock.PrepareForAnalysis;
|
|
begin
|
|
inherited;
|
|
|
|
SetLength( fLock, fGrammar.MaxK +1);
|
|
end;
|
|
|
|
// ****************************************************************************
|
|
// IRuleBlock implementation
|
|
// ****************************************************************************
|
|
// ============================================================================
|
|
// GetArguments
|
|
// ============================================================================
|
|
function TRuleBlock.GetArguments: AnsiString;
|
|
begin
|
|
result := fArguments;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// GetDefErrorHandler
|
|
// ============================================================================
|
|
function TRuleBlock.GetDefErrorHandler: boolean;
|
|
begin
|
|
result := fDefErrorHandler;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// GetEndNode
|
|
// ============================================================================
|
|
function TRuleBlock.GetEndNode: IRuleEndElem;
|
|
begin
|
|
result := fEndNode;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// GetIgnoreRule
|
|
// ============================================================================
|
|
function TRuleBlock.GetIgnoreRule: AnsiString;
|
|
begin
|
|
result := fIgnoreRule;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// GetLock
|
|
// ============================================================================
|
|
function TRuleBlock.GetLock(i: integer): boolean;
|
|
begin
|
|
result := fLock[i];
|
|
end;
|
|
|
|
// ============================================================================
|
|
// GetCache
|
|
// ============================================================================
|
|
function TRuleBlock.GetCache(i: integer): ILookahead;
|
|
begin
|
|
result := fCache[i];
|
|
end;
|
|
|
|
// ============================================================================
|
|
// GetLabeledElems
|
|
// ============================================================================
|
|
function TRuleBlock.GetLabeledElems: TInterfaceList;
|
|
begin
|
|
result := fLabeledElems;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// GetReturnAction
|
|
// ============================================================================
|
|
function TRuleBlock.GetReturnAction: AnsiString;
|
|
begin
|
|
result := fReturnAction;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// GetLocals
|
|
// ============================================================================
|
|
function TRuleBlock.GetLocals: AnsiString;
|
|
begin
|
|
result := fLocals;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// GetRuleName
|
|
// ============================================================================
|
|
function TRuleBlock.GetRuleName: AnsiString;
|
|
begin
|
|
result := fRuleName;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// GetTestLiterals
|
|
// ============================================================================
|
|
function TRuleBlock.GetTestLiterals: boolean;
|
|
begin
|
|
result := fTestLiterals;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// GetThrowSpec
|
|
// ============================================================================
|
|
function TRuleBlock.GetThrowSpec: AnsiString;
|
|
begin
|
|
result := fThrowSpec;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// SetArguments
|
|
// ============================================================================
|
|
procedure TRuleBlock.SetArguments(pArguments: AnsiString);
|
|
begin
|
|
fArguments := pArguments;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// SetDefErrorHandler
|
|
// ============================================================================
|
|
procedure TRuleBlock.SetDefErrorHandler(pErrorHandler: boolean);
|
|
begin
|
|
fDefErrorHandler := pErrorHandler;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// SetEndNode
|
|
// ============================================================================
|
|
procedure TRuleBlock.SetEndNode(pNode: IRuleEndElem);
|
|
begin
|
|
fEndNode := pNode;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// SetIgnoreRule
|
|
// ============================================================================
|
|
procedure TRuleBlock.SetIgnoreRule(pRule: AnsiString);
|
|
begin
|
|
fIgnoreRule := pRule;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// SetLock
|
|
// ============================================================================
|
|
procedure TRuleBlock.SetLock(i: integer; pLock: boolean);
|
|
begin
|
|
fLock[i] := pLock;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// SetCache
|
|
// ============================================================================
|
|
procedure TRuleBlock.SetCache(i: integer; pCache: ILookahead);
|
|
begin
|
|
fCache[i] := pCache;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// SetLabeledElems
|
|
// ============================================================================
|
|
procedure TRuleBlock.SetLabeledElems(pLabeledElems: TInterfaceList);
|
|
begin
|
|
FreeAndNil( fLabeledElems);
|
|
fLabeledElems := pLabeledElems;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// SetReturnAction
|
|
// ============================================================================
|
|
procedure TRuleBlock.SetReturnAction(pAction: AnsiString);
|
|
begin
|
|
fReturnAction := pAction;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// SetLocals
|
|
// ============================================================================
|
|
procedure TRuleBlock.SetLocals(pLocals: AnsiString);
|
|
begin
|
|
fLocals := pLocals;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// SetRuleName
|
|
// ============================================================================
|
|
procedure TRuleBlock.SetRuleName(pRuleName: AnsiString);
|
|
begin
|
|
fRuleName := pRuleName;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// SetTestLiterals
|
|
// ============================================================================
|
|
procedure TRuleBlock.SetTestLiterals(pTestLiterals: boolean);
|
|
begin
|
|
fTestLiterals := pTestLiterals;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// SetThrowSpec
|
|
// ============================================================================
|
|
procedure TRuleBlock.SetThrowSpec(pThrowSpec: AnsiString);
|
|
begin
|
|
fThrowSpec := pThrowSpec;
|
|
end;
|
|
|
|
// ============================================================================
|
|
// AddExceptionSpec
|
|
// ============================================================================
|
|
procedure TRuleBlock.AddExceptionSpec( pExceptionSpec: IExceptionSpec);
|
|
begin
|
|
(*
|
|
if FindExceptionSpec( pExceptionSpec.Lbl.TokenText) <> nil then
|
|
begin
|
|
if pExceptionSpec.Lbl.TokenText <> '' then
|
|
fGrammar.Tool.Error( 'Rule "' + fRuleName + '" already has an exception handler for label: ' + pExceptionSpec.Lbl.TokenText,
|
|
fGrammar.GrammarFile,
|
|
pExceptionSpec.Lbl.TokenLine,
|
|
pExceptionSpec.Lbl.TokenColumn)
|
|
else
|
|
fGrammar.Tool.Error( 'Rule "' + fRuleName + '" already has an exception handler',
|
|
fGrammar.GrammarFile,
|
|
pExceptionSpec.Lbl.TokenLine,
|
|
pExceptionSpec.Lbl.TokenColumn)
|
|
end
|
|
else
|
|
fExceptionSpecs.Add( pExceptionSpec);
|
|
*)
|
|
end;
|
|
|
|
// ============================================================================
|
|
// IsLexerAutoGenRule
|
|
// ============================================================================
|
|
function TRuleBlock.IsLexerAutoGenRule: boolean;
|
|
begin
|
|
result := (fRuleName = 'nextToken');
|
|
end;
|
|
|
|
// ============================================================================
|
|
// SetOption
|
|
// ============================================================================
|
|
procedure TRuleBlock.SetOption(pKey, pValue: IToken);
|
|
var
|
|
lg: ILexerGrammar;
|
|
ts: ITokenSymbol;
|
|
|
|
begin
|
|
// ---------------------------------------------------------------
|
|
// Dummy if. Needed to help commenting ifs.
|
|
// ---------------------------------------------------------------
|
|
if false then
|
|
|
|
// ---------------------------------------------------------------
|
|
// Option: defaultErrorHandler
|
|
// ---------------------------------------------------------------
|
|
else if pKey.TokenText = 'defaultErrorHandler' then
|
|
begin
|
|
if pValue.TokenText = 'true' then
|
|
fDefErrorHandler := true
|
|
else if pValue.TokenText = 'false' then
|
|
fDefErrorHandler := false
|
|
else
|
|
fGrammar.Tool.Error( 'Value for "defaultErrorHandler" must be true or false',
|
|
fGrammar.GrammarFile,
|
|
pKey.TokenLine,
|
|
pKey.TokenColumn)
|
|
end
|
|
|
|
// ---------------------------------------------------------------
|
|
// Option: testLiterals
|
|
// ---------------------------------------------------------------
|
|
else if pKey.TokenText = 'testLiterals' then
|
|
begin
|
|
if pValue.TokenText = 'true' then
|
|
fTestLiterals := true
|
|
else if pValue.TokenText = 'false' then
|
|
fTestLiterals := false
|
|
else
|
|
fGrammar.Tool.Error( 'Value for "testLiterals" must be true or false',
|
|
fGrammar.GrammarFile,
|
|
pKey.TokenLine,
|
|
pKey.TokenColumn)
|
|
end
|
|
|
|
// ---------------------------------------------------------------
|
|
// Option: generateAmbigWarnings
|
|
// ---------------------------------------------------------------
|
|
else if pKey.TokenText = 'generateAmbigWarnings' then
|
|
begin
|
|
if pValue.TokenText = 'true' then
|
|
fGenAmbigWarnings := true
|
|
else if pValue.TokenText = 'false' then
|
|
fGenAmbigWarnings := false
|
|
else
|
|
fGrammar.Tool.Error( 'Value for "generateAmbigWarnings" must be true or false',
|
|
fGrammar.GrammarFile,
|
|
pKey.TokenLine,
|
|
pKey.TokenColumn)
|
|
end
|
|
|
|
// ---------------------------------------------------------------
|
|
// Option: ignore
|
|
// ---------------------------------------------------------------
|
|
else if pKey.TokenText = 'ignore' then
|
|
begin
|
|
if fGrammar.QueryInterface(ILexerGrammar, lg) <> S_OK then
|
|
fGrammar.Tool.Error( '"Ignore" option only valid for lexer rules',
|
|
fGrammar.GrammarFile,
|
|
pKey.TokenLine,
|
|
pKey.TokenColumn)
|
|
else
|
|
fIgnoreRule := pValue.TokenText
|
|
end
|
|
|
|
// ---------------------------------------------------------------
|
|
// Option: paraphrase
|
|
// ---------------------------------------------------------------
|
|
else if pKey.TokenText = 'paraphrase' then
|
|
begin
|
|
if fGrammar.QueryInterface(ILexerGrammar, lg) <> S_OK then
|
|
fGrammar.Tool.Error( '"Paraphrase" option only valid for lexer rules',
|
|
fGrammar.GrammarFile,
|
|
pKey.TokenLine,
|
|
pKey.TokenColumn)
|
|
else
|
|
begin
|
|
ts := fGrammar.TokenManager.TokenSymbol[fRuleName];
|
|
|
|
if ts = nil then
|
|
fGrammar.Tool.Panic('Cannot find token associated with rule ' + fRuleName)
|
|
else
|
|
ts.Paraphrase := pValue.TokenText
|
|
end
|
|
end
|
|
|
|
// ---------------------------------------------------------------
|
|
// Illegal option
|
|
// ---------------------------------------------------------------
|
|
else
|
|
fGrammar.Tool.Error( Format( MSG_W_ILLEGALRULEOPTION, [pKey.TokenText]),
|
|
fGrammar.GrammarFile,
|
|
pKey.TokenLine,
|
|
pKey.TokenColumn);
|
|
end;
|
|
|
|
|
|
// ****************************************************************************
|
|
// Internals
|
|
// ****************************************************************************
|
|
function TRuleBlock.GetOneOrMoreBlocks: TInterfaceList;
|
|
begin
|
|
result := fOneOrMoreBlocks;
|
|
end;
|
|
|
|
function TRuleBlock.GetNMBlocks : TInterfaceList;
|
|
begin
|
|
result := fNMBlocks;
|
|
end;
|
|
|
|
|
|
function TRuleBlock.GetSynPredBlocks: TInterfaceList;
|
|
begin
|
|
result := fSynPredBlocks;
|
|
end;
|
|
|
|
function TRuleBlock.GetExHandlerCode: AnsiString;
|
|
begin
|
|
result := fExHandlerCode;
|
|
end;
|
|
|
|
function TRuleBlock.GetExHandlerType: AnsiString;
|
|
begin
|
|
result := fExHandlerType;
|
|
end;
|
|
|
|
procedure TRuleBlock.SetExHandlerCode(pExCode: AnsiString);
|
|
begin
|
|
fExHandlerCode := pExCode;
|
|
end;
|
|
|
|
procedure TRuleBlock.SetExHandlerType(pExType: AnsiString);
|
|
begin
|
|
fExHandlerType := pExType;
|
|
end;
|
|
|
|
end.
|