roka/bds.mr.dpg
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial check in lib

Browse Source
This commit is contained in:
Abu Abacus
2026-01-03 18:33:48 +01:00
parent b20cd8e688
commit 5666f85e99
89 changed files with 36370 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src.lib/dpglib.ActionElem.pas
+124
View File
@@ -0,0 +1,124 @@
unit dpglib.ActionElem;
interface
uses
dpgrtl.types,
dpglib.types,
dpglib.AlternativeElem;
type
// =========================================================================
// Class TActionElem declaration
// =========================================================================
TActionElem = class( TAlternativeElem,
IActionElem,
IAlternativeElem,
IGrammarElem)
protected
// ------------------------------------------------------------
// Members
// ------------------------------------------------------------
fActionText : AnsiString;
fIsSemPred : boolean;
public
// ------------------------------------------------------------
// Constructor/destructor
// ------------------------------------------------------------
constructor Create( pGrammar: IGrammar; pToken: IToken);
// ------------------------------------------------------------
// IGrammarElem methods
// ------------------------------------------------------------
procedure Generate;
function Look( pK: integer): ILookahead;
function AsString : AnsiString;
// ------------------------------------------------------------
// IsgpAlternativeElem methods
// ------------------------------------------------------------
// ------------------------------------------------------------
// IActionElem methods
// ------------------------------------------------------------
function GetActionText : AnsiString;
function GetSemPred : boolean;
procedure SetSempred( pSemPred: boolean);
end;
implementation
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TActionElem.Create(pGrammar: IGrammar; pToken: IToken);
begin
inherited Create( pGrammar);
fActionText := pToken.TokenText;
fIsSemPred := false;
end;
// ****************************************************************************
// IActionElem implementation
// ****************************************************************************
// ============================================================================
// GetActionText
// ============================================================================
function TActionElem.GetActionText: AnsiString;
begin
result := fActionText;
end;
// ============================================================================
// GetSemPred
// ============================================================================
function TActionElem.GetSemPred: boolean;
begin
result := fIsSemPred;
end;
// ============================================================================
// SetSemPred
// ============================================================================
procedure TActionElem.SetSempred(pSemPred: boolean);
begin
fIsSemPred := pSemPred;
end;
// ****************************************************************************
// IGrammarElem implementation
// ****************************************************************************
// ============================================================================
// Generate
// ============================================================================
procedure TActionElem.Generate;
begin
fGrammar.Generator.gen( self);
end;
// ============================================================================
// Look
// ============================================================================
function TActionElem.Look(pK: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look( pK, self);
end;
// ============================================================================
// AsString
// ============================================================================
function TActionElem.AsString: AnsiString;
begin
result := ' {' + fActionText;
if fIsSemPred then
result := result + '}?';
end;
end.
src.lib/dpglib.Alternative.pas
+338
View File
@@ -0,0 +1,338 @@
unit dpglib.Alternative;
interface
uses
dpgrtl.types,
dpglib.types;
type
// =========================================================================
// Class TAlternative declaration
// =========================================================================
TAlternative = class( TInterfacedObject,
IAlternative)
protected
// ------------------------------------------------------------
// Head/Tail of AlternativeElem list
// ------------------------------------------------------------
fHead : IAlternativeElem;
fTail : IAlternativeElem;
// ------------------------------------------------------------
// True if AST generation is on for this Alternative.
// ------------------------------------------------------------
fDoAutoGen : boolean;
// ------------------------------------------------------------
// Syntactic predicate if any...
// ------------------------------------------------------------
fSynPredBlock : ISynPredBlock;
// ------------------------------------------------------------
// Semantic predicate if any...
// ------------------------------------------------------------
fSemPred : AnsiString;
// ------------------------------------------------------------
// Exception specification
// ------------------------------------------------------------
fExHandlerType : AnsiString;
fExHandlerCode : AnsiString;
// ------------------------------------------------------------
// Lookahead for alternative. Filled in by deterministic() only
// Used for code gen after calls to deterministic() and used by
// deterministic() for (...)*, (...)+ and (...)? blocks. 1..k.
// ------------------------------------------------------------
fCache : array of ILookahead;
// ------------------------------------------------------------
// Each alt has different lookahead depth possibly. Depth can
// be NONDETERMINISTIC too. 0..n-1.
// ------------------------------------------------------------
fLookaheadDepth: integer;
// ------------------------------------------------------------
// Tree specification a'la -> A B C (not implemented)
// ------------------------------------------------------------
fTreeSpecifier : IToken;
public
// ------------------------------------------------------------
// Constructor/destructor
// ------------------------------------------------------------
constructor Create; overload;
constructor Create( pFirstElem: IAlternativeElem); overload;
destructor Destroy; override;
// ------------------------------------------------------------
// IAlternative methods
// ------------------------------------------------------------
protected
function GetHead : IAlternativeElem;
function GetTail : IAlternativeElem;
function GetSynPredBlock : ISynPredBlock;
function GetSemPred : AnsiString;
function GetExHandlerType : AnsiString;
function GetExHandlerCode : AnsiString;
function GetCacheSize : integer;
function GetLookaheadDepth : integer;
function GetTreeSpecifier : IToken;
function GetDoAutoGen : boolean;
procedure SetHead( pHead : IAlternativeElem);
procedure SetTail( pTail : IAlternativeElem);
procedure SetSynPredBlock( pBlock : ISynPredBlock);
procedure SetSemPred( pSemPred : AnsiString);
procedure SetExHandlerType( pType : AnsiString);
procedure SetExHandlerCode( pCode : AnsiString);
procedure SetCacheSize( pSize : integer);
procedure SetLookaheadDepth( pDepth : integer);
procedure SetTreeSpecifier( pTreeSpecifier : IToken);
procedure SetDoAutoGen( pDoAutoGen : boolean);
function GetCache( i:integer): ILookahead;
procedure SetCache( i: integer; pLookahead: ILookahead);
public
procedure AddElem( pElem: IAlternativeElem);
function AtStart: boolean;
end;
implementation
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ----------------------------------------------------------------------------
// Constructor
// ----------------------------------------------------------------------------
constructor TAlternative.Create;
begin
inherited Create;
end;
// ----------------------------------------------------------------------------
// Constructor
// ----------------------------------------------------------------------------
constructor TAlternative.Create(pFirstElem: IAlternativeElem);
begin
inherited Create;
AddElem( pFirstElem);
end;
// ----------------------------------------------------------------------------
// Destructor
// ----------------------------------------------------------------------------
destructor TAlternative.Destroy;
begin
fHead := nil;
fTail := nil;
fSynPredBlock := nil;
fTreeSpecifier := nil;
//!! fCache := nil;
inherited;
end;
// ****************************************************************************
// IAlternative implementation
// ****************************************************************************
// ----------------------------------------------------------------------------
// GetHead
// ----------------------------------------------------------------------------
function TAlternative.GetHead: IAlternativeElem;
begin
result := fHead;
end;
// ----------------------------------------------------------------------------
// GetTail
// ----------------------------------------------------------------------------
function TAlternative.GetTail: IAlternativeElem;
begin
result := fTail;
end;
// ----------------------------------------------------------------------------
// GetSynPredBlock
// ----------------------------------------------------------------------------
function TAlternative.GetSynPredBlock: ISynPredBlock;
begin
result := fSynPredBlock;
end;
// ----------------------------------------------------------------------------
// GetSemPred
// ----------------------------------------------------------------------------
function TAlternative.GetSemPred: AnsiString;
begin
result := fSemPred;
end;
// ----------------------------------------------------------------------------
// GetCacheSize
// ----------------------------------------------------------------------------
function TAlternative.GetCacheSize: integer;
begin
result := High(fCache) - Low(fCache);
end;
// ----------------------------------------------------------------------------
// GetCache
// ----------------------------------------------------------------------------
function TAlternative.GetCache(i: integer): ILookahead;
begin
result := fCache[i];
end;
// ----------------------------------------------------------------------------
// GetLookaheadDepth
// ----------------------------------------------------------------------------
function TAlternative.GetLookaheadDepth: integer;
begin
result := fLookaheadDepth;
end;
// ----------------------------------------------------------------------------
// GetTreeSpecifier
// ----------------------------------------------------------------------------
function TAlternative.GetTreeSpecifier: IToken;
begin
result := fTreeSpecifier;
end;
// ----------------------------------------------------------------------------
// GetAutoGen
//
// Don't build an AST if there is a tree-rewrite-specifier.
// ----------------------------------------------------------------------------
function TAlternative.GetDoAutoGen: boolean;
begin
result := fDoAutoGen and (fTreeSpecifier = nil);
end;
// ----------------------------------------------------------------------------
// SetTail
// ----------------------------------------------------------------------------
procedure TAlternative.SetTail(pTail: IAlternativeElem);
begin
fTail := pTail;
end;
// ----------------------------------------------------------------------------
// SetHead
// ----------------------------------------------------------------------------
procedure TAlternative.SetHead(pHead: IAlternativeElem);
begin
fHead := pHead;
end;
// ----------------------------------------------------------------------------
// SetSynPredBlock
// ----------------------------------------------------------------------------
procedure TAlternative.SetSynPredBlock(pBlock: ISynPredBlock);
begin
fSynPredBlock := pBlock;
end;
// ----------------------------------------------------------------------------
// SetSemPred
// ----------------------------------------------------------------------------
procedure TAlternative.SetSemPred(pSemPred: AnsiString);
begin
fSemPred := pSemPred;
end;
// ----------------------------------------------------------------------------
// SetCacheSize
// ----------------------------------------------------------------------------
procedure TAlternative.SetCacheSize(pSize: integer);
begin
SetLength( fCache, pSize);
end;
// ----------------------------------------------------------------------------
// SetCache
// ----------------------------------------------------------------------------
procedure TAlternative.SetCache(i: integer; pLookahead: ILookahead);
begin
fCache[i] := pLookahead;
end;
// ----------------------------------------------------------------------------
// SetLookaheadDepth
// ----------------------------------------------------------------------------
procedure TAlternative.SetLookaheadDepth(pDepth: integer);
begin
fLookaheadDepth := pDepth;
end;
// ----------------------------------------------------------------------------
// SetTreeSpecifier
// ----------------------------------------------------------------------------
procedure TAlternative.SetTreeSpecifier(pTreeSpecifier: IToken);
begin
fTreeSpecifier := pTreeSpecifier;
end;
// ----------------------------------------------------------------------------
// SetDoAutoGen
// ----------------------------------------------------------------------------
procedure TAlternative.SetDoAutoGen(pDoAutoGen: boolean);
begin
fDoAutoGen := pDoAutoGen;
end;
// ----------------------------------------------------------------------------
// AddElem
// ----------------------------------------------------------------------------
procedure TAlternative.AddElem(pElem: IAlternativeElem);
begin
if fHead = nil then
begin
fHead := pElem;
fTail := pElem;
end
else
begin
fTail.Next := pElem;
fTail := pElem;
end;
end;
// ----------------------------------------------------------------------------
// AtStart
// ----------------------------------------------------------------------------
function TAlternative.AtStart: boolean;
begin
result := fHead = nil;
end;
function TAlternative.GetExHandlerCode: AnsiString;
begin
result := fExHandlerCode;
end;
function TAlternative.GetExHandlerType: AnsiString;
begin
result := fExHandlerType;
end;
procedure TAlternative.SetExHandlerCode(pCode: AnsiString);
begin
fExHandlerCode := pCode;
end;
procedure TAlternative.SetExHandlerType(pType: AnsiString);
begin
fExHandlerType := pType;
end;
end.
src.lib/dpglib.AlternativeBlock.pas
+610
View File
@@ -0,0 +1,610 @@
unit dpglib.AlternativeBlock;
interface
uses
System.Classes,
dpgrtl.types,
dpglib.types,
dpglib.AlternativeElem;
type
TAlternativeBlock = class( TAlternativeElem,
IAlternativeBlock,
IGrammarElem)
// ---------------------------------------------------------------
// Members
// ---------------------------------------------------------------
protected
fAlternatives : TInterfaceList;
fInitAction : AnsiString;
fLabel : AnsiString;
fAltI : integer;
fAltJ : integer;
fAnalysisAlt : integer;
fHasAnAction : boolean;
fHasASynPred : boolean;
fID : integer;
fNot : boolean;
fGreedy : boolean; // (true)
fGreedySet : boolean; // (false)
fDoAutoGen : boolean; // (true)
fWarnFollowAmbig : boolean; // (true)
fGenAmbigWarnings : boolean; // (true)
// ---------------------------------------------------------------
// Constructor/destructor
// ---------------------------------------------------------------
public
constructor Create( Grammar : IGrammar); overload;
constructor Create( Grammar : IGrammar;
Start : IToken;
Invert : boolean); overload;
// ---------------------------------------------------------------
// IGrammarElem overrides
// ---------------------------------------------------------------
public
procedure Generate;
function Look( K: integer) : ILookahead;
function AsString : AnsiString;
// ---------------------------------------------------------------
// IAlternativeElem overrides
// ---------------------------------------------------------------
protected
function GetLabel : AnsiString;
procedure SetLabel( Lbl: AnsiString);
// ---------------------------------------------------------------
// IAlternativeBlock methods
// ---------------------------------------------------------------
protected
function GetID : integer;
function GetInitAction : AnsiString;
function GetAutoGen : boolean;
function GetNot : boolean;
function GetHasASynPred : boolean;
function GetHasAnAction : boolean;
function GetWarnFollowAmbig : boolean;
function GetGenAmbigWarnings : boolean;
function GetGreedy : boolean;
function GetGreedySet : boolean;
function GetAlternatives : TInterfaceList;
function GetAlternative( i: integer) : IAlternative;
function GetAnalyzisAlt : integer;
function GetAltI : integer;
function GetAltJ : integer;
procedure SetInitAction( Action : AnsiString);
procedure SetAutoGen( AutoGen : boolean);
procedure SetNot( Invert : boolean);
procedure SetHasASynPred( SynPred : boolean);
procedure SetHasAnAction( Action : boolean);
procedure SetWarnFollowAmbig( Warn : boolean);
procedure SetGenAmbigWarnings( Gen : boolean);
procedure SetGreedy( Greedy : boolean);
procedure SetGreedySet( GreedySet : boolean);
procedure SetAlternatives( Alts : TInterfaceList);
procedure SetAnalyzisAlt( Alt : integer);
procedure SetAltI( AltI : integer);
procedure SetAltJ( AltJ : integer);
public
procedure AddAlternative( Alt: IAlternative);
procedure SetOption( Key, Value: IToken);
procedure RemoveTracking( Grammar: IGrammar);
procedure PrepareForAnalysis; virtual;
end;
implementation
uses
System.SysUtils,
dpglib.Messages;
var
fNBlks : integer;
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TAlternativeBlock.Create(Grammar: IGrammar);
begin
inherited Create( Grammar);
fID := fNblks +1;
fNot := false;
fAlternatives := TInterfaceList.Create;
fHasAnAction := false;
fHasASynPred := false;
fGreedy := true;
fGreedySet := false;
fDoAutoGen := true;
fWarnFollowAmbig := true;
fGenAmbigWarnings := true;
inc( fNblks);
end;
// ============================================================================
// Constructor
// ============================================================================
constructor TAlternativeBlock.Create( Grammar : IGrammar;
Start : IToken;
Invert : boolean);
begin
inherited Create( Grammar, Start);
fID := fNblks +1;
fNot := Invert;
fAlternatives := TInterfaceList.Create;
fHasAnAction := false;
fHasASynPred := false;
fGreedy := true;
fGreedySet := false;
fDoAutoGen := true;
fWarnFollowAmbig := true;
fGenAmbigWarnings := true;
inc( fNblks);
end;
// ****************************************************************************
// IGrammarElem overrides
// ****************************************************************************
// ============================================================================
// Generate
// ============================================================================
procedure TAlternativeBlock.Generate;
begin
fGrammar.Generator.gen( self);
end;
// ============================================================================
// Look
// ============================================================================
function TAlternativeBlock.Look(K: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look( K, self);
end;
// ============================================================================
// AsString
// ============================================================================
function TAlternativeBlock.AsString: AnsiString;
begin
result := '';
end;
// ****************************************************************************
// IAlternativeElem overrides
// ****************************************************************************
// ============================================================================
// GetLabel
// ============================================================================
function TAlternativeBlock.GetLabel: AnsiString;
begin
result := fLabel;
end;
// ============================================================================
// SetLabel
// ============================================================================
procedure TAlternativeBlock.SetLabel(Lbl: AnsiString);
begin
fLabel := Lbl;
end;
// ****************************************************************************
// IAlternativeBlock implementation
// ****************************************************************************
// ============================================================================
// GetID
// ============================================================================
function TAlternativeBlock.GetID: integer;
begin
result := fID;
end;
// ============================================================================
// GetInitAction
// ============================================================================
function TAlternativeBlock.GetInitAction: AnsiString;
begin
result := fInitAction;
end;
// ============================================================================
// GetAutoGen
// ============================================================================
function TAlternativeBlock.GetAutoGen: boolean;
begin
result := fDoAutoGen;
end;
// ============================================================================
// GetNot
// ============================================================================
function TAlternativeBlock.GetNot: boolean;
begin
result := fNot;
end;
// ============================================================================
// GetHasASynPred
// ============================================================================
function TAlternativeBlock.GetHasASynPred: boolean;
begin
result := fHasASynPred;
end;
// ============================================================================
// GetGenAmbigWarnings
// ============================================================================
function TAlternativeBlock.GetGenAmbigWarnings: boolean;
begin
result := fGenAmbigWarnings;
end;
// ============================================================================
// GetGreedy
// ============================================================================
function TAlternativeBlock.GetGreedy: boolean;
begin
result := fGreedy;
end;
// ============================================================================
// GetGreedySet
// ============================================================================
function TAlternativeBlock.GetGreedySet: boolean;
begin
result := fGreedySet;
end;
// ============================================================================
// GetHasAnAction
// ============================================================================
function TAlternativeBlock.GetHasAnAction: boolean;
begin
result := fHasAnAction;
end;
// ============================================================================
// GetWarnFollowAmbig
// ============================================================================
function TAlternativeBlock.GetWarnFollowAmbig: boolean;
begin
result := fWarnFollowAmbig;
end;
// ============================================================================
// GetAlternatives
// ============================================================================
function TAlternativeBlock.GetAlternatives: TInterfaceList;
begin
result := fAlternatives;
end;
// ============================================================================
// GetAltI
// ============================================================================
function TAlternativeBlock.GetAltI: integer;
begin
result := fAltI;
end;
// ============================================================================
// GetAltJ
// ============================================================================
function TAlternativeBlock.GetAltJ: integer;
begin
result := fAltJ;
end;
// ============================================================================
// GetAnalyzisAlt
// ============================================================================
function TAlternativeBlock.GetAnalyzisAlt: integer;
begin
result := fAnalysisAlt;
end;
// ============================================================================
// GetAlternative
// ============================================================================
function TAlternativeBlock.GetAlternative(i: integer): IAlternative;
begin
if (i>=0) and (i<fAlternatives.Count) then
fAlternatives.Items[i].QueryInterface(IAlternative, result);
end;
// ============================================================================
// SetInitAction
// ============================================================================
procedure TAlternativeBlock.SetInitAction(Action: AnsiString);
begin
fInitAction := Action;
end;
// ============================================================================
// SetAlternatives
// ============================================================================
procedure TAlternativeBlock.SetAlternatives(Alts: TInterfaceList);
begin
fAlternatives.Free;
fAlternatives := Alts;
end;
// ============================================================================
// SetAutoGen
// ============================================================================
procedure TAlternativeBlock.SetAutoGen(AutoGen: boolean);
begin
fDoAutoGen := AutoGen;
end;
// ============================================================================
// SetNot
// ============================================================================
procedure TAlternativeBlock.SetNot(Invert: boolean);
begin
fNot := Invert;
end;
// ============================================================================
// SetHasASynPred
// ============================================================================
procedure TAlternativeBlock.SetHasASynPred(SynPred: boolean);
begin
fHasASynPred := SynPred;
end;
// ============================================================================
// SetGenAmbigWarnings
// ============================================================================
procedure TAlternativeBlock.SetGenAmbigWarnings(Gen: boolean);
begin
fGenAmbigWarnings := Gen;
end;
// ============================================================================
// SetGreedy
// ============================================================================
procedure TAlternativeBlock.SetGreedy(Greedy: boolean);
begin
fGreedy := Greedy;
end;
// ============================================================================
// SetGreedySet
// ============================================================================
procedure TAlternativeBlock.SetGreedySet(GreedySet: boolean);
begin
fGreedySet := GreedySet;
end;
// ============================================================================
// SetHasAnAction
// ============================================================================
procedure TAlternativeBlock.SetHasAnAction(Action: boolean);
begin
fHasAnAction := Action;
end;
// ============================================================================
// SetWarnFollowAmbig
// ============================================================================
procedure TAlternativeBlock.SetWarnFollowAmbig(Warn: boolean);
begin
fWarnFollowAmbig := Warn;
end;
// ============================================================================
// SetAltI
// ============================================================================
procedure TAlternativeBlock.SetAltI(AltI: integer);
begin
fAltI := AltI;
end;
// ============================================================================
// SetAltJ
// ============================================================================
procedure TAlternativeBlock.SetAltJ(AltJ: integer);
begin
fAltJ := AltJ;
end;
// ============================================================================
// SetAnalyzisAlt
// ============================================================================
procedure TAlternativeBlock.SetAnalyzisAlt(Alt: integer);
begin
fAnalysisAlt := Alt;
end;
// ============================================================================
// AddAlternative
// ============================================================================
procedure TAlternativeBlock.AddAlternative(Alt: IAlternative);
begin
fAlternatives.Add( Alt);
end;
// ============================================================================
// SetOption
// ============================================================================
procedure TAlternativeBlock.SetOption(Key, Value: IToken);
begin
// ---------------------------------------------------------------
// Option: warnWhenFollowAmbig
// ---------------------------------------------------------------
if Key.TokenText = 'warnWhenFollowAmbig' then
begin
if Value.TokenText = 'true' then
fWarnFollowAmbig := true
else if Value.TokenText = 'false' then
fWarnFollowAmbig := false
else
fGrammar.Tool.Error( 'Value for "warnWhenFollowAmbig" must be true or false',
fGrammar.GrammarFile,
Key.TokenLine,
Key.TokenColumn);
end
// ---------------------------------------------------------------
// Option: generateAmbigWarnings
// ---------------------------------------------------------------
else if Key.TokenText = 'generateAmbigWarnings' then
begin
if Value.TokenText = 'true' then
fGenAmbigWarnings := true
else if Value.TokenText = 'false' then
fGenAmbigWarnings := false
else
fGrammar.Tool.Error( 'Value for "generateAmbigWarnings" must be true or false',
fGrammar.GrammarFile,
Key.TokenLine,
Key.TokenColumn);
end
// ---------------------------------------------------------------
// Option: greedy
// ---------------------------------------------------------------
else if Key.TokenText = 'greedy' then
begin
if Value.TokenText = 'true' then
begin
fGreedy := true;
fGreedySet := true;
end
else if Value.TokenText = 'false' then
begin
fGreedy := false;
fGreedySet := true;
end
else
fGrammar.Tool.Error( 'Value for "greedy" must be true or false',
fGrammar.GrammarFile,
Key.TokenLine,
Key.TokenColumn);
end
// ---------------------------------------------------------------
// Invalid option
// ---------------------------------------------------------------
else
begin
fGrammar.Tool.Error( 'Invalid subrule option: "' + Key.TokenText + '"',
fGrammar.GrammarFile,
Key.TokenLine,
Key.TokenColumn);
end;
end;
// ============================================================================
// PrepareForAnalysis
// ============================================================================
procedure TAlternativeBlock.PrepareForAnalysis;
var
i: integer;
a: IAlternative;
begin
for i:=0 to fAlternatives.Count -1 do
begin
// ------------------------------------------------------------
// Deterministic() uses an alternative cache and sets lookahead
// depth.
// ------------------------------------------------------------
if fAlternatives.Items[i].QueryInterface( IAlternative, a) = S_OK then
begin
a.CacheSize := fGrammar.MaxK + 1;
a.LookaheadDepth := LOOKAHEAD_DEPTH_INIT;
end;
end;
end;
// ============================================================================
// RemoveTracking
//
// Walk the syntactic predicate and, for a rule ref R, remove the ref from the
// list of FOLLOW references for R (stored in the symbol table).
// ============================================================================
procedure TAlternativeBlock.RemoveTracking(Grammar: IGrammar);
var
i : integer;
alt : IAlternative;
elem : IAlternativeElem;
ab : IAlternativeBlock;
rr : IRuleRefElem;
rs : IRuleSymbol;
begin
for i:=0 to fAlternatives.Count-1 do
begin
fAlternatives.Items[i].QueryInterface(IAlternative,alt);
elem := alt.Head;
while elem <> nil do
begin
// ---------------------------------------------------------
// Handle RuleRef elements
// ---------------------------------------------------------
if elem.QueryInterface( IRuleRefElem, rr) = S_OK then
begin
Grammar.Symbol[rr.TargetRule].QueryInterface(IRuleSymbol,rs);
if rs = nil then
begin
// pGrammar.Tool.Error( 'Rule "' + rr.TargetRule + '"' +
// 'referenced in (...)=>, but not defined.',
Grammar.Tool.Error( Format( MSG_E_INVRULEINSYNPRED, [rr.TargetRule]),
fGrammar.GrammarFile,
0,0);
end
else
begin
rs.References.Remove( rr);
end;
end
// ---------------------------------------------------------
// Recurse into subrules
// ---------------------------------------------------------
else if elem.QueryInterface(IAlternativeBlock,ab) = S_OK then
begin
ab.RemoveTracking( Grammar);
end;
elem := elem.Next;
end;
end;
end;
initialization
fNBlks := 0;
end.
src.lib/dpglib.AlternativeElem.pas
+157
View File
@@ -0,0 +1,157 @@
unit dpglib.AlternativeElem;
interface
uses
dpgrtl.types,
dpglib.types,
dpglib.GrammarElem;
type
TAlternativeElem = class( TGrammarElem, IAlternativeElem, IGrammarElem)
protected
fNext : IAlternativeElem;
fEnclosingRule : AnsiString;
fAutoGenType : integer;
// ----------------------------------------------------------------------
// Construction/destruction
// ----------------------------------------------------------------------
public
constructor Create( Grammar : IGrammar); overload;
constructor Create( Grammar : IGrammar;
Start : IToken); overload;
constructor Create( Grammar : IGrammar;
Start : IToken;
AutoGenType : integer); overload;
destructor Destroy; override;
// ----------------------------------------------------------------------
// IAlternativeElem
// ----------------------------------------------------------------------
protected
function GetAutoGenType : integer;
function GetNext : IAlternativeElem;
function GetLabel : AnsiString;
function GetEnclosingRule : AnsiString;
procedure SetNext( Next : IAlternativeElem);
procedure SetLabel( Lbl : AnsiString);
procedure SetEnclosingRule( Rule : AnsiString);
end;
implementation
// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Construction/destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Constructor
// ================================================================================================
constructor TAlternativeElem.Create( Grammar: IGrammar);
begin
inherited Create( Grammar);
fAutoGenType := AUTOGEN_NONE;
end;
// ================================================================================================
// Constructor
// ================================================================================================
constructor TAlternativeElem.Create( Grammar : IGrammar;
Start : IToken);
begin
inherited Create( Grammar, Start);
fAutoGenType := AUTOGEN_NONE;
end;
// ================================================================================================
// Constructor
// ================================================================================================
constructor TAlternativeElem.Create( Grammar : IGrammar;
Start : IToken;
AutoGenType: integer);
begin
inherited Create( Grammar, Start);
fAutoGenType := AutoGenType;
end;
// ================================================================================================
// Destructor
// ================================================================================================
destructor TAlternativeElem.Destroy;
begin
fNext := nil;
inherited;
end;
// @@@: IAlternativeElem implementation +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// IAlternativeElem implementation
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Get AutoGenType
// ================================================================================================
function TAlternativeElem.GetAutoGenType: integer;
begin
result := fAutoGenType;
end;
// ================================================================================================
// Get EnclosingRule
// ================================================================================================
function TAlternativeElem.GetEnclosingRule: AnsiString;
begin
result := fEnclosingRule;
end;
// ================================================================================================
// Get Label
// ================================================================================================
function TAlternativeElem.GetLabel: AnsiString;
begin
result := '';
end;
// ================================================================================================
// Get Next
// ================================================================================================
function TAlternativeElem.GetNext: IAlternativeElem;
begin
result := fNext;
end;
// ================================================================================================
// Set EnclosingRule
// ================================================================================================
procedure TAlternativeElem.SetEnclosingRule(Rule: AnsiString);
begin
fEnclosingRule := Rule;
end;
// ================================================================================================
// Set Label
// ================================================================================================
procedure TAlternativeElem.SetLabel(Lbl: AnsiString);
begin
end;
// ================================================================================================
// Set Next
// ================================================================================================
procedure TAlternativeElem.SetNext(Next: IAlternativeElem);
begin
fNext := Next;
end;
end.
src.lib/dpglib.BlockContext.pas
+57
View File
@@ -0,0 +1,57 @@
// ================================================================================================
// BlockContext stores the information needed when creating an alternative (list of elements).
// Entering a subrule requires that we save this state as each block of alternatives requires
// state such as "tail of current alternative."
// ================================================================================================
unit dpglib.BlockContext;
interface
uses
dpglib.types;
type
TBlockContext = class(TObject)
private
fAltNum : integer;
fBlock : IAlternativeBlock;
fBlockEnd : IBlockEndElem;
public
procedure AddAlternativeElem( pElem: IAlternativeElem); virtual;
function CurrentAlt : IAlternative;
function CurrentElem : IAlternativeElem;
public
property AltNum : integer read fAltNum write fAltNum;
property Block : IAlternativeBlock read fBlock write fBlock;
property BlockEnd : IBlockEndElem read fBlockEnd write fBlockEnd;
end;
implementation
// ----------------------------------------------------------------------------
// CurrentAlt
// ----------------------------------------------------------------------------
function TBlockContext.CurrentAlt: IAlternative;
begin
fBlock.Alternatives.Items[fAltNum].QueryInterface( IAlternative, result);
end;
// ----------------------------------------------------------------------------
// CurrentElem
// ----------------------------------------------------------------------------
function TBlockContext.CurrentElem: IAlternativeElem;
begin
result := CurrentAlt.Tail;
end;
// ----------------------------------------------------------------------------
// AddAlternativeElem
// ----------------------------------------------------------------------------
procedure TBlockContext.AddAlternativeElem(pElem: IAlternativeElem);
begin
CurrentAlt.AddElem( pElem);
end;
end.
src.lib/dpglib.BlockEndElem.pas
+130
View File
@@ -0,0 +1,130 @@
// ----------------------------------------------------------------------------
// All alternative blocks are "terminated" by BlockEndElements unless theye are
// rule blocks (in which case they use RuleEndElement).
// ----------------------------------------------------------------------------
unit dpglib.BlockEndElem;
interface
uses
dpglib.types,
dpglib.AlternativeElem;
type
// =========================================================================
// Class TBlockEndElem declaration
// =========================================================================
TBlockEndElem = class( TAlternativeElem,
IBlockEndElem,
IAlternativeElem,
IGrammarElem)
// ---------------------------------------------------------------
// Members
// ---------------------------------------------------------------
protected
fLock : array of boolean;
fBlock : IAlternativeBlock;
// ---------------------------------------------------------------
// Constructor/destructor
// ---------------------------------------------------------------
public
constructor Create( pGrammar: IGrammar);
destructor Destroy; override;
// ---------------------------------------------------------------
// IGrammarElem overrides
// ---------------------------------------------------------------
public
function Look( pK: integer): ILookahead;
function AsString: AnsiString;
// ---------------------------------------------------------------
// IBlockEndElem methods
// ---------------------------------------------------------------
protected
function GetBlock: IAlternativeBlock;
function GetLock( i: integer): boolean;
procedure SetBlock( pBlock: IAlternativeBlock);
procedure SetLock( i: integer; pLock: boolean);
end;
implementation
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TBlockEndElem.Create(pGrammar: IGrammar);
begin
inherited Create( pGrammar);
SetLength( fLock, pGrammar.MaxK + 1);
end;
// ============================================================================
// Destructor
// ============================================================================
destructor TBlockEndElem.Destroy;
begin
fLock := nil;
inherited;
end;
// ****************************************************************************
// IGrammarElem overrides
// ****************************************************************************
// ============================================================================
// Look
// ============================================================================
function TBlockEndElem.Look(pK: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look( pK, self);
end;
// ============================================================================
// AsString
// ============================================================================
function TBlockEndElem.AsString: AnsiString;
begin
result := ' [BlkEnd]';
end;
// ****************************************************************************
// IBlockEndElem overrides
// ****************************************************************************
// ============================================================================
// GetBlock
// ============================================================================
function TBlockEndElem.GetBlock: IAlternativeBlock;
begin
result := fBlock;
end;
// ============================================================================
// GetLock
// ============================================================================
function TBlockEndElem.GetLock(i: integer): boolean;
begin
Result := fLock[i];
end;
// ============================================================================
// SetBlock
// ============================================================================
procedure TBlockEndElem.SetBlock(pBlock: IAlternativeBlock);
begin
fBlock := pBlock;
end;
// ============================================================================
// SetLock
// ============================================================================
procedure TBlockEndElem.SetLock(i: integer; pLock: boolean);
begin
fLock[i] := pLock;
end;
end.
src.lib/dpglib.BlockWithImpliedExitPath.pas
+120
View File
@@ -0,0 +1,120 @@
unit dpglib.BlockWithImpliedExitPath;
interface
uses
dpgrtl.types,
dpglib.types,
dpglib.AlternativeBlock;
type
// =========================================================================
// Class TBlockWithImpliedExitPath declaration
// =========================================================================
TBlockWithImpliedExitPath = class( TAlternativeBlock,
IBlockWithImpliedExitPath,
IAlternativeBlock,
IAlternativeElem,
IGrammarElem)
// ---------------------------------------------------------------
// Members
// ---------------------------------------------------------------
protected
fExitLookaheadDepth : integer;
fExitCache : array of ILookahead;
// ---------------------------------------------------------------
// Constructor/destructor
// ---------------------------------------------------------------
public
constructor Create( pGrammar: IGrammar); overload;
constructor Create( pGrammar: IGrammar; pStart: IToken); overload;
destructor Destroy; override;
// ---------------------------------------------------------------
// IBlockWithImpliedExitPath methods
// ---------------------------------------------------------------
protected
function GetExitDepth: integer;
function GetExitCache( i: integer) : ILookahead;
procedure SetExitDepth( pDepth: integer);
procedure SetExitCache( i: integer; pExitCache: ILookahead);
end;
implementation
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TBlockWithImpliedExitPath.Create( pGrammar : IGrammar);
begin
inherited Create( pGrammar);
SetLength( fExitCache, pGrammar.MaxK + 1);
end;
// ============================================================================
// Constructor
// ============================================================================
constructor TBlockWithImpliedExitPath.Create( pGrammar : IGrammar;
pStart : IToken);
begin
inherited Create( pGrammar, pStart);
SetLength( fExitCache, pGrammar.MaxK + 1);
end;
// ============================================================================
// Destructor
// ============================================================================
destructor TBlockWithImpliedExitPath.Destroy;
var
i: integer;
begin
for i:=Low(fExitCache) to High(fExitCache) do
fExitCache[i] := nil;
fExitCache := nil;
inherited;
end;
// ****************************************************************************
// IBlockWithImpliedExitPath implementation
// ****************************************************************************
// ============================================================================
// GetExitDepth
// ============================================================================
function TBlockWithImpliedExitPath.GetExitDepth: integer;
begin
result := fExitLookaheadDepth;
end;
// ============================================================================
// GetExitCache
// ============================================================================
function TBlockWithImpliedExitPath.GetExitCache( i: integer): ILookahead;
begin
result := fExitCache[i];
end;
// ============================================================================
// SetExitDepth
// ============================================================================
procedure TBlockWithImpliedExitPath.SetExitDepth(pDepth: integer);
begin
fExitLookaheadDepth := pDepth;
end;
// ============================================================================
// SetExitCache
// ============================================================================
procedure TBlockWithImpliedExitPath.SetExitCache( i : integer;
pExitCache : ILookahead);
begin
fExitCache[i] := pExitCache;
end;
end.
src.lib/dpglib.CharLiteralElem.pas
+88
View File
@@ -0,0 +1,88 @@
unit dpglib.CharLiteralElem;
interface
uses
dpgrtl.types,
dpglib.types,
dpglib.GrammarAtom;
type
// =========================================================================
// Class TCharLiteralElem declaration
// =========================================================================
TCharLiteralElem = class( TGrammarAtom,
ICharLiteralElem,
IGrammarAtom,
IAlternativeElem,
IGrammarElem)
public
// ------------------------------------------------------------
// Constructor/destructor
// ------------------------------------------------------------
constructor Create( pGrammar : IGrammar;
pToken : IToken;
pInverted : boolean;
pAutoGenType: integer);
public
// ------------------------------------------------------------
// IGrammarElem methods
// ------------------------------------------------------------
procedure Generate;
function Look( pK: integer): ILookahead;
end;
implementation
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ----------------------------------------------------------------------------
// Constructor
// ----------------------------------------------------------------------------
constructor TCharLiteralElem.Create( pGrammar : IGrammar;
pToken : IToken;
pInverted : boolean;
pAutoGenType: integer);
begin
inherited Create( pGrammar, pToken, AUTOGEN_NONE);
{ TODO 1 -omiki -ctoken : Fix for TokenTypeForCharLiteral }
if pToken.TokenText = '' then
begin
fLine := 1;
exit;
end;
fTokenType := ord(pToken.TokenText[1]);
// token_type = ANTLRLexer.tokentypeforcharliteral(pToken.TokenText);
// pGrammar.charVocabulary.add fTokenType;
fLine := pToken.TokenLine;
fNot := pInverted;
fAutoGenType:= pAutoGenType;
end;
// ****************************************************************************
// IGrammarElem implementation
// ****************************************************************************
// ----------------------------------------------------------------------------
// Generate
// ----------------------------------------------------------------------------
procedure TCharLiteralElem.Generate;
var
elem: ICharLiteralElem;
begin
elem := self;
fGrammar.Generator.Gen(elem);
end;
// ----------------------------------------------------------------------------
// Look
// ----------------------------------------------------------------------------
function TCharLiteralElem.Look(pK: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look( pK, self);
end;
end.
src.lib/dpglib.CharRangeElem.pas
+163
View File
@@ -0,0 +1,163 @@
unit dpglib.CharRangeElem;
interface
uses
dpgrtl.types,
dpglib.types,
dpglib.AlternativeElem;
type
// =========================================================================
// Class TCharRangeElem declaration
// =========================================================================
TCharRangeElem = class( TAlternativeElem,
ICharRangeElem,
IAlternativeElem,
IGrammarElem)
// ---------------------------------------------------------------
// Members
// ---------------------------------------------------------------
protected
fLabel : AnsiString;
fBegin : AnsiChar;
fEnd : AnsiChar;
fBeginText : AnsiString;
fEndText : AnsiString;
// ---------------------------------------------------------------
// Constructor/destructor
// ---------------------------------------------------------------
public
constructor Create( pGrammar : IGrammar;
pToken1 : IToken;
pToken2 : IToken;
pAutoGenType : integer);
// ---------------------------------------------------------------
// IGrammarElem overrides
// ---------------------------------------------------------------
public
procedure Generate;
function Look( pK: integer): ILookahead;
function AsString : AnsiString;
// ---------------------------------------------------------------
// IAlternativeElem overrides
// ---------------------------------------------------------------
protected
function GetLabel : AnsiString;
procedure SetLabel( pLabel: AnsiString);
// ---------------------------------------------------------------
// ICharRangeElem methods
// ---------------------------------------------------------------
protected
function GetBeginChar : AnsiChar;
function GetEndChar : AnsiChar;
end;
implementation
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TCharRangeElem.Create( pGrammar : IGrammar;
pToken1 : IToken;
pToken2 : IToken;
pAutoGenType: integer);
var
i: integer;
begin
inherited Create( pGrammar, pToken1);
fBegin := pToken1.TokenText[1];
fEnd := pToken2.TokenText[1];
fBeginText := pToken1.TokenText;
fEndText := pToken2.TokenText;
fAutoGenType:= pAutoGenType;
// ---------------------------------------------------------------
// Track which AnsiCharacters are referenced in the grammar.
// ---------------------------------------------------------------
for i:=ord( fBegin) to ord( fEnd) do
; // fGrammar.charVocabulary.add(i)
end;
// ****************************************************************************
// IGrammarElem ovrrides
// ****************************************************************************
// ============================================================================
// Generate
// ============================================================================
procedure TCharRangeElem.Generate;
begin
fGrammar.Generator.gen( self);
end;
// ============================================================================
// Look
// ============================================================================
function TCharRangeElem.Look(pK: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look( pK, self);
end;
// ============================================================================
// AsString
// ============================================================================
function TCharRangeElem.AsString: AnsiString;
begin
if fLabel <> '' then
result := ' ' + fLabel + ':' + fBeginText + '..' + fEndText
else
result := ' ' + fBeginText + '..' + fEndText;
end;
// ****************************************************************************
// IAlternativeElem overrides
// ****************************************************************************
// ============================================================================
// GetLabel
// ============================================================================
function TCharRangeElem.GetLabel: AnsiString;
begin
result := fLabel;
end;
// ============================================================================
// SetLabel
// ============================================================================
procedure TCharRangeElem.SetLabel(pLabel: AnsiString);
begin
fLabel := pLabel;
end;
// ****************************************************************************
// ICharRangeElem implementation
// ****************************************************************************
// ============================================================================
// GetBeginChar
// ============================================================================
function TCharRangeElem.GetBeginChar: AnsiChar;
begin
result := fBegin;
end;
// ============================================================================
// GetEndChar
// ============================================================================
function TCharRangeElem.GetEndChar: AnsiChar;
begin
result := fEnd;
end;
end.
src.lib/dpglib.CodeGenerator.pas
+588
View File
@@ -0,0 +1,588 @@
// ============================================================================
// A CodeGenerator knows about a Grammar data structure and
// a grammar analyzer. The Grammar is walked to generate the
// appropriate code for both a parser and lexer (if present).
// This interface may change slightly so that the lexer is
// itself living inside of a Grammar object (in which case,
// this class generates only one recognizer). The main method
// to call is <tt>gen()</tt>, which initiates all code gen.
//
// The interaction of the code generator with the analyzer is
// simple: each subrule block calls deterministic() before generating
// code for the block. Method deterministic() sets lookahead caches
// in each Alternative object. Technically, a code generator
// doesn't need the grammar analyzer if all lookahead analysis
// is done at runtime, but this would result in a slower parser.
//
// This class provides a set of support utilities to handle argument
// list parsing and so on.
// ============================================================================
unit dpglib.CodeGenerator;
interface
uses
System.Classes,
dpgrtl.types,
dpglib.types;
type
// =========================================================================
// TCodeGenerator
// =========================================================================
TCodeGenerator = class( TInterfacedObject,
ICodeGenerator)
// ------------------------------------------------------------
// class functions (statics)
// ------------------------------------------------------------
class function encodeLexerRuleName( pName: AnsiString): AnsiString;
class function decodeLexerRuleName( pName: AnsiString): AnsiString;
protected
// ------------------------------------------------------------
// Members
// ------------------------------------------------------------
fGrammar : IGrammar;
fTool : ITool;
fAnalyzer : ILLkAnalyzer;
fBehavior : IGrammarBehavior;
fCharFormatter : ICharFormatter;
fFile : AnsiString;
fOutput : TStream;
fTabs : integer;
fBitsetUsed : TByteSet;
DEBUG_GEN : boolean;
fTab : AnsiString; // Tab sequence
fTokenTypesFileSuffix : AnsiString; // Token exchange file suffix
fTokenTypesFileExt : AnsiString; // Token exchange file extension
fLitPrefix : AnsiString; // Literal prefix
fTokPrefix : AnsiString; // Token prefix
fOutDir : AnsiString; // Output directory
fExcDir : AnsiString; // Token exchange dir
public
// ------------------------------------------------------------
// Constructor/destructor
// ------------------------------------------------------------
constructor Create( OutputDir: AnsiString;
ExchangeDir: AnsiString);
destructor Destroy; override;
protected
// ------------------------------------------------------------
// Internals
// ------------------------------------------------------------
procedure indent;
procedure _print( pString : AnsiString);
procedure _println( pString : AnsiString);
procedure print( pString : AnsiString);
procedure println( pString : AnsiString);
procedure printAction( pString : AnsiString);
procedure untabifyLines( pStrings : TStringList);
procedure indentLines( pStrings : TStringList);
procedure genTokenExchange;
protected
// ------------------------------------------------------------
// ICodeGenerator methods
// ------------------------------------------------------------
procedure Gen(pGrammar: IGrammar); overload; virtual;
// procedure Gen(pGrammar: ILexerGrammar); overload; virtual; abstract;
procedure Gen(pElem : IActionElem); overload; virtual; abstract;
procedure Gen(pElem : IAlternativeBlock); overload; virtual; abstract;
procedure Gen(pElem : IBlockEndElem); overload; virtual; abstract;
procedure Gen(pElem : ICharLiteralElem); overload; virtual; abstract;
procedure Gen(pElem : ICharRangeElem); overload; virtual; abstract;
procedure Gen(pElem : IGrammarAtom); overload; virtual; abstract;
procedure Gen(pElem : IOneOrMoreBlock); overload; virtual; abstract;
procedure Gen(pElem : INMBlock); overload; virtual; abstract;
procedure Gen(pElem : IRuleBlock); overload; virtual; abstract;
procedure Gen(pElem : IRuleEndElem); overload; virtual; abstract;
procedure Gen(pElem : IRuleRefElem); overload; virtual; abstract;
procedure Gen(pElem : IStringLiteralElem); overload; virtual; abstract;
procedure Gen(pElem : ISynPredBlock); overload; virtual; abstract;
procedure Gen(pElem : ITokenRefElem); overload; virtual; abstract;
procedure Gen(pElem : ITokenRangeElem); overload; virtual; abstract;
procedure Gen(pElem : ITreeElem); overload; virtual; abstract;
procedure Gen(pElem : IWildCardElem); overload; virtual; abstract;
procedure Gen(pElem : IZeroOrMoreBlock); overload; virtual; abstract;
end;
implementation
uses
dpglib.utils,
System.SysUtils,
System.StrUtils;
// ****************************************************************************
//
// Coonstructor/destructor
//
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TCodeGenerator.Create( OutputDir : AnsiString;
ExchangeDir : AnsiString);
begin
inherited Create;
fTab := ' ';
fTabs := 0;
fOutDir := OutputDir;
fExcDir := ExchangeDir;
if fOutDir <> '' then if fOutDir[Length(fOutDir)] <> '\' then fOutDir := fOutDir + '\';
if fExcDir <> '' then if fExcDir[Length(fExcDir)] <> '\' then fExcDir := fExcDir + '\';
fTokenTypesFileSuffix := 'Tokens';
fTokenTypesFileExt := '.txt';
fTokPrefix := 'TT_';
fLitPrefix := 'LT_';
end;
// ============================================================================
// Destructor
// ============================================================================
destructor TCodeGenerator.Destroy;
begin
fGrammar := nil;
fTool := nil;
fAnalyzer := nil;
fBehavior := nil;
fCharFormatter := nil;
inherited;
end;
// ****************************************************************************
//
// ICodeGenerator implementation
//
// ****************************************************************************
// ============================================================================
// Gen
// ============================================================================
procedure TCodeGenerator.Gen(pGrammar: IGrammar);
begin
end;
// ****************************************************************************
//
// Internal utility methods
//
// ****************************************************************************
// ============================================================================
// Indent
// ============================================================================
procedure TCodeGenerator.indent;
var
i: integer;
begin
for i:=1 to fTabs do
_print( fTab);
end;
// ============================================================================
// _print
// ============================================================================
procedure TCodeGenerator._print(pString: AnsiString);
begin
if pString = '' then
pString := ' ';
fOutput.Write( pString[1], Length(pString));
end;
// ============================================================================
// _println
// ============================================================================
procedure TCodeGenerator._println(pString: AnsiString);
begin
_print( pString);
_print( #13+#10);
end;
// ============================================================================
// print
// ============================================================================
procedure TCodeGenerator.print(pString: AnsiString);
begin
indent;
_print( pString);
end;
// ============================================================================
// prinln
// ============================================================================
procedure TCodeGenerator.println(pString: AnsiString);
begin
indent;
_println( pString);
end;
// ============================================================================
// printAction
// ============================================================================
procedure TCodeGenerator.printAction(pString: AnsiString);
var
i : integer;
len : integer;
indent: integer;
stm : TStringStream;
lines : TStringList;
line : AnsiString;
begin
// ---------------------------------------------------------------
// Remove the '{' and '}' or '[' and ']' characters from the
// beginning and from the end.
// ---------------------------------------------------------------
pString := Trim( pString);
pString := Copy(pString,2,Length(pString)-2);
// ---------------------------------------------------------------
// Make AnsiStringlist from the action text.
// ---------------------------------------------------------------
len := 0;
stm := TStringStream.Create( pString);
lines := TStringList.Create;
lines.LoadFromStream( stm);
stm.Free;
// ---------------------------------------------------------------
// Check that the line with the opening bracket (ie. the first)
// has code or not.
// ---------------------------------------------------------------
if Trim(lines.Strings[0]) = '' then
indent := 0
else
indent := 1;
// ---------------------------------------------------------------
// Remove empty lines from the beginning
// ---------------------------------------------------------------
while lines.Count > 0 do
begin
if Trim(lines.Strings[0]) = '' then
lines.Delete(0)
else
break;
end;
// ---------------------------------------------------------------
// Remove empty lines from the end
// ---------------------------------------------------------------
while lines.Count > 0 do
begin
if Trim( lines.Strings[lines.Count-1]) = '' then
lines.Delete(lines.Count-1)
else
break;
end;
// ---------------------------------------------------------------
// If there is a TAB character in the action AnsiString, then simply
// emit the AnsiString. Later we can format this too, but not yet.
// ---------------------------------------------------------------
untabifyLines( lines);
indentLines( lines);
// ------------------------------------------------------------
// Print out the lines, but calculate the indent value
// ------------------------------------------------------------
for i:=0 to lines.Count-1 do
begin
line := lines.Strings[i];
println(line);
end;
end;
// ============================================================================
// genTokenExchange
// ============================================================================
procedure TCodeGenerator.genTokenExchange;
var
i : integer;
fName : AnsiString;
name : AnsiString;
value : AnsiString;
ts : ITokenSymbol;
ss : IStringSymbol;
pTM : ITokenManager;
begin
if fGrammar.ExportVocab = '' then
fGrammar.ExportVocab := fGrammar.UnitName;
fName := fExcDir +
fGrammar.ExportVocab +
fTokenTypesFileSuffix +
fTokenTypesFileExt;
try
pTM := fGrammar.TokenManager;
fOutput := TFileStream.Create( fName, fmCreate);
// ------------------------------------------------------------
// Header
// ------------------------------------------------------------
println( '// $Delphi Parser Generator: ' +
ExtractFileName( fGrammar.GrammarFile) +
' -> ' +
fGrammar.GrammarFile +
fTokenTypesFileSuffix +
fTokenTypesFileExt +
'$');
fTabs := 0;
// ------------------------------------------------------------
// Header grammar name
// ------------------------------------------------------------
println( fGrammar.GetClassName);
// ------------------------------------------------------------
// Generate a definition to for each token type.
// ------------------------------------------------------------
for name in pTM.Vocabulary.Keys do
begin
value := IntToStr(pTM.Vocabulary.Items[name]);
ts := pTM.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
begin
ss.Lbl := fLitPrefix + StringToID( Copy( name, 2, Length(name)-2));
// ss.Lbl := fLitPrefix + Copy( name, 2, Length(name)-2);
//
// ss.Lbl := AnsiReplaceStr( ss.LBL, '$', '_DOLLAR_');
// ss.Lbl := AnsiReplaceStr( ss.LBL, '/', '_SLASH_');
// ss.Lbl := AnsiReplaceStr( ss.LBL, ':', '_COLON_');
// ss.Lbl := AnsiReplaceStr( ss.LBL, '.', '_DOT_');
ss.LBL := AnsiReplaceStr( ss.LBL, 'LT__', 'LT_');
end;
println( ss.Lbl + '=' + name + '=' + value);
end;
end
// ------------------------------------------------------
// Handle token symbols.
// ------------------------------------------------------
else
begin
if ts <> nil then
begin
print( fTokPrefix + name);
if ts.Paraphrase <> '' then
_print( '(' + ts.Paraphrase + ')');
_println( '=' + value);
end
// else
// fGrammar.Tool.Error( 'Undefined token symbol' + name);
end
end
end;
(*
for i:=0 to pTM.Vocabulary.Count -1 do
begin
name := pTM.Vocabulary.Names[i];
value := pTM.Vocabulary.Values[name];
ts := pTM.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
begin
ss.Lbl := fLitPrefix + StringToID( Copy( name, 2, Length(name)-2));
// ss.Lbl := fLitPrefix + Copy( name, 2, Length(name)-2);
//
// ss.Lbl := AnsiReplaceStr( ss.LBL, '$', '_DOLLAR_');
// ss.Lbl := AnsiReplaceStr( ss.LBL, '/', '_SLASH_');
// ss.Lbl := AnsiReplaceStr( ss.LBL, ':', '_COLON_');
// ss.Lbl := AnsiReplaceStr( ss.LBL, '.', '_DOT_');
ss.LBL := AnsiReplaceStr( ss.LBL, 'LT__', 'LT_');
end;
println( ss.Lbl + '=' + name + '=' + value);
end;
end
// ------------------------------------------------------
// Handle token symbols.
// ------------------------------------------------------
else
begin
if ts <> nil then
begin
print( fTokPrefix + name);
if ts.Paraphrase <> '' then
_print( '(' + ts.Paraphrase + ')');
_println( '=' + value);
end
// else
// fGrammar.Tool.Error( 'Undefined token symbol' + name);
end
end
end
*)
finally
if fOutput <> nil then
FreeAndNil( fOutput);
end;
end;
// ============================================================================
// encodeLexerRuleName
// ============================================================================
class function TCodeGenerator.encodeLexerRuleName( pName: AnsiString): AnsiString;
begin
result := 'm' + pName;
end;
// ============================================================================
// encodeLexerRuleName
// ============================================================================
class function TCodeGenerator.decodeLexerRuleName( pName: AnsiString): AnsiString;
begin
if pName[1] = 'm' then
result := Copy( pName, 2, Length(pName) -1)
else
result := pName;
end;
// ============================================================================
// indent
// ============================================================================
procedure TCodeGenerator.indentLines(pStrings: TStringList);
var
minLead : integer;
i : integer;
lead : integer;
s : AnsiString;
begin
if pStrings.Count = 1 then
begin
pStrings.Strings[0] := Trim( pStrings.Strings[0]);
exit;
end;
// ---------------------------------------------------------------
// search for the shortest leading size.
// ---------------------------------------------------------------
minLead := 1000;
for i:=0 to pStrings.Count -1 do
begin
s := pStrings.Strings[i];
lead := Length(s) - Length( TrimLeft( s));
if Trim(s) <> '' then
if minLead > lead then
minLead := lead;
end;
// ---------------------------------------------------------------
// Now shorten the lines
// ---------------------------------------------------------------
for i:=0 to pStrings.Count -1 do
begin
s := pStrings.Strings[i];
s := Copy( s, minLead +1, length(s));
pStrings.Strings[i] := s;
end;
end;
// ============================================================================
// untabify
// ============================================================================
procedure TCodeGenerator.untabifyLines(pStrings: TStringList);
var
i: integer;
j: integer;
k: integer;
l: integer;
p: integer;
s: AnsiString;
x: AnsiString;
begin
l := Length( fTab);
for i:=0 to pStrings.Count -1 do
begin
s := TrimRight(pStrings.Strings[i]);
pStrings.Strings[i] := s;
if pos( #9, s) > 0 then
begin
x := '';
for j:=1 to Length(s) do
begin
if s[j] <> #9 then
begin
x := x + s[j];
end
else
begin
p := l - (Length(x) mod l);
for k:=1 to p do
x := x + ' ';
end;
end;
pStrings.Strings[i] := x;
end;
end;
end;
end.
src.lib/dpglib.DelphiBlockFinishingInfo.pas
+60
View File
@@ -0,0 +1,60 @@
unit dpglib.DelphiBlockFinishingInfo;
interface
uses
System.Classes;
type
TDelphiBlockFinishingInfo = class
public
PostScript : AnsiString;
GeneratedSwitch : boolean;
GeneratedAnIf : boolean;
// ------------------------------------------------------------
// When generating an if or switch, end-of-token lookahead sets
// will become the else or default clause, don't generate an
// error clause in this case.
// ------------------------------------------------------------
NeedAnErrorClause : boolean;
NeedAClosingEnd : boolean;
public
constructor Create; overload;
constructor Create( pPostScript : AnsiString;
pGenSwitch : boolean;
pGenAnIf : boolean;
pNeedEC : boolean); overload;
end;
implementation
{ TDelphiBlockFinishingInfo }
// ============================================================================
// Constructor
// ============================================================================
constructor TDelphiBlockFinishingInfo.Create;
begin
PostScript := '';
GeneratedSwitch := false;
GeneratedAnIf := false;
NeedAnErrorClause := true;
NeedAClosingEnd := false;
end;
// ============================================================================
// Destructor
// ============================================================================
constructor TDelphiBlockFinishingInfo.Create( pPostScript : AnsiString;
pGenSwitch : boolean;
pGenAnIf : boolean;
pNeedEC : boolean);
begin
PostScript := pPostScript;
GeneratedSwitch := pGenSwitch;
GeneratedAnIf := pGenAnIf;
NeedAnErrorClause := pNeedEC;
NeedAClosingEnd := false;
end;
end.
src.lib/dpglib.DelphiCharFormatter.pas
+82
View File
@@ -0,0 +1,82 @@
unit dpglib.DelphiCharFormatter;
interface
uses
System.Classes,
dpglib.types;
type
TDelphiCharFormatter = class( TInterfacedObject, ICharFormatter)
// ----------------------------------------------------------------------
// IdpgCharFormatter methods
// ----------------------------------------------------------------------
public
function EscapeChar( pChar : integer;
pForCharLiteral : boolean) : AnsiString;
function EscapeString( pString : AnsiString) : AnsiString;
function LiteralChar( pChar : integer) : AnsiString;
function LiteralString( pString : AnsiString) : AnsiString;
end;
implementation
{ TDelphiCharFormatter }
// @@@: IdpgCharFormatter +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// IdpgCharFormatter
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// EscapeChar
//
// Given a character value, return a string representing the character that can be embedded
// inside a string literal or character literal.
// ================================================================================================
function TDelphiCharFormatter.EscapeChar( pChar : integer;
pForCharLiteral: boolean): AnsiString;
begin
result := AnsiChar(pChar);
end;
// ================================================================================================
// EscapeString
//
// Converts a string into a representation that can be uses as a literal when surrounded by
// quotes.
// ================================================================================================
function TDelphiCharFormatter.EscapeString(pString: AnsiString): AnsiString;
var
i: integer;
begin
result := '';
for i:=1 to Length(pString) do
result := result + EscapeChar( ord(pString[i]), false);
end;
// ================================================================================================
// LiteralChar
//
// Given a character value, return a string representing a character literal that can be
// recognized by the target language compiler.
// ================================================================================================
function TDelphiCharFormatter.LiteralChar(pChar: integer): AnsiString;
begin
result := '''' + EscapeChar( ord(pChar), true) + '''';
end;
// ================================================================================================
// LiteralString
// ================================================================================================
function TDelphiCharFormatter.LiteralString(pString: AnsiString): AnsiString;
begin
result := '''' + EscapeString( pString) + '''';
end;
end.
src.lib/dpglib.DelphiGenerator.pas
+3475
View File
File diff suppressed because it is too large Load Diff
src.lib/dpglib.DpgLexer.pas
+1879
View File
File diff suppressed because it is too large Load Diff
src.lib/dpglib.DpgLexerTokens.pas
+77
View File
@@ -0,0 +1,77 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.dpgLexer.g
// ============================================================================
unit dpglib.DpgLexerTokens;
interface
const
TT_TREE_BEGIN = 46;
LT_finally = 21;
TT_QUEST = 34;
TT_INT_RULEREF = 54;
TT_IMPLIES = 33;
LT_returns = 18;
TT_WILDCARD = 41;
TT_OR = 39;
TT_CLOSE = 44;
TT_WS = 63;
LT_public = 17;
TT_RCURLY = 28;
TT_COMMA = 31;
LT_parser = 9;
LT_unit = 4;
TT_CHARLIT = 47;
LT_tokens = 12;
LT_uses = 5;
TT_SEMI = 30;
TT_ASSIGN = 32;
TT_OPEN = 43;
LT_treeparser = 10;
LT_memberdecl = 13;
TT_OPTIONS = 24;
TT_AT = 37;
LT_local = 19;
TT_SEMPRED = 22;
TT_CARET = 45;
TT_MLCOMMENT2 = 58;
TT_DDIGIT = 61;
LT_lexer = 8;
LT_memberdef = 14;
TT_RULEREF = 53;
LT_except = 20;
TT_COLON = 29;
TT_EOF = 1;
LT_protected = 16;
TT_INTEGER = 49;
TT_STAR = 36;
TT_ACTION = 51;
LT_type = 7;
LT_private = 15;
TT_LPAREN = 26;
TT_RPAREN = 27;
TT_BANG = 40;
TT_MLCOMMENT1 = 57;
TT_DNUMBER = 59;
TT_TOKENS = 25;
TT_ESC = 65;
TT_USES = 23;
TT_TOKENREF = 52;
TT_NOT = 38;
TT_SLCOMMENT = 56;
TT_STRINGLIT = 48;
TT_XDIGIT = 62;
TT_WS_LOOP = 64;
LT_options = 11;
LT_const = 6;
TT_ARGACTION = 50;
TT_RANGE = 42;
TT_PLUS = 35;
TT_XNUMBER = 60;
TT_COMMENT = 55;
implementation
end.
src.lib/dpglib.DpgParser.pas
+1457
View File
File diff suppressed because it is too large Load Diff
src.lib/dpglib.DpgParserTokens.pas
+77
View File
@@ -0,0 +1,77 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.dpgParser.g
// ============================================================================
unit dpglib.DpgParserTokens;
interface
const
TT_TREE_BEGIN = 46;
LT_finally = 21;
TT_QUEST = 34;
TT_INT_RULEREF = 54;
TT_IMPLIES = 33;
LT_returns = 18;
TT_WILDCARD = 41;
TT_OR = 39;
TT_CLOSE = 44;
TT_WS = 63;
LT_public = 17;
TT_RCURLY = 28;
TT_COMMA = 31;
LT_parser = 9;
TT_CHARLIT = 47;
LT_unit = 4;
LT_tokens = 12;
LT_uses = 5;
TT_SEMI = 30;
TT_ASSIGN = 32;
TT_OPEN = 43;
LT_treeparser = 10;
LT_memberdecl = 13;
TT_OPTIONS = 24;
TT_AT = 37;
LT_local = 19;
TT_SEMPRED = 22;
TT_CARET = 45;
TT_MLCOMMENT2 = 58;
TT_DDIGIT = 61;
LT_lexer = 8;
LT_memberdef = 14;
TT_RULEREF = 53;
LT_except = 20;
TT_COLON = 29;
TT_EOF = 1;
LT_protected = 16;
TT_INTEGER = 49;
TT_STAR = 36;
TT_ACTION = 51;
LT_type = 7;
LT_private = 15;
TT_LPAREN = 26;
TT_RPAREN = 27;
TT_BANG = 40;
TT_MLCOMMENT1 = 57;
TT_DNUMBER = 59;
TT_TOKENS = 25;
TT_ESC = 65;
TT_USES = 23;
TT_TOKENREF = 52;
TT_NOT = 38;
TT_SLCOMMENT = 56;
TT_STRINGLIT = 48;
TT_XDIGIT = 62;
TT_WS_LOOP = 64;
LT_options = 11;
LT_const = 6;
TT_ARGACTION = 50;
TT_RANGE = 42;
TT_PLUS = 35;
TT_XNUMBER = 60;
TT_COMMENT = 55;
implementation
end.
src.lib/dpglib.ExceptionHandler.pas
+83
View File
@@ -0,0 +1,83 @@
unit dpglib.ExceptionHandler;
interface
uses
dpgrtl.types,
dpglib.types;
type
// =========================================================================
// Class TExceptionHandler declaration
// =========================================================================
TExceptionHandler = class( TInterfacedObject,
IExceptionHandler)
// ---------------------------------------------------------------
// Members
// ---------------------------------------------------------------
protected
fTypeAndName : IToken;
fAction : IToken;
// ---------------------------------------------------------------
// Constructor/destructor
// ---------------------------------------------------------------
public
constructor Create( pTypeAndName : IToken;
pAction : IToken);
destructor Destroy; override;
// ---------------------------------------------------------------
// IExceptionHandler methods
// ---------------------------------------------------------------
protected
function GetTypeAndName : IToken;
function GetAction : IToken;
end;
implementation
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TExceptionHandler.Create( pTypeAndName : IToken;
pAction : IToken);
begin
inherited Create;
fTypeAndName := pTypeAndName;
fAction := pAction;
end;
// ============================================================================
// Destructor
// ============================================================================
destructor TExceptionHandler.Destroy;
begin
fTypeAndName := nil;
fAction := nil;
inherited;
end;
// ****************************************************************************
// IExceptionHandler implementation
// ****************************************************************************
// ============================================================================
// GetTypeAndName
// ============================================================================
function TExceptionHandler.GetTypeAndName: IToken;
begin
result := fTypeAndName;
end;
// ============================================================================
// GetAction
// ============================================================================
function TExceptionHandler.GetAction: IToken;
begin
result := fAction;
end;
end.
src.lib/dpglib.ExceptionSpec.pas
+97
View File
@@ -0,0 +1,97 @@
unit dpglib.ExceptionSpec;
interface
uses
System.Classes,
dpgrtl.types,
dpglib.Types;
type
// =========================================================================
// Class TExceptionSpec declaration
// =========================================================================
TExceptionSpec = class( TInterfacedObject,
IExceptionSpec)
// ---------------------------------------------------------------
// Members
// ---------------------------------------------------------------
protected
fLabel : IToken;
fHandlers : TInterfaceList;
// ---------------------------------------------------------------
// Constructor/destructor
// ---------------------------------------------------------------
public
constructor Create( pLabel: IToken);
destructor Destroy; override;
// ---------------------------------------------------------------
// IExceptionSpec methods
// ---------------------------------------------------------------
protected
function GetLabel : IToken;
function GetHandlers: TInterfaceList;
public
procedure AddHandler( pHandler: IExceptionHandler);
end;
implementation
uses
System.SysUtils;
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TExceptionSpec.Create(pLabel: IToken);
begin
inherited Create;
fLabel := pLabel;
fHandlers := TInterfaceList.Create;
end;
// ============================================================================
// Destructor
// ============================================================================
destructor TExceptionSpec.Destroy;
begin
FreeAndNil( fHandlers);
fLabel := nil;
inherited;
end;
// ****************************************************************************
// IExceptionSpec implementation
// ****************************************************************************
// ============================================================================
// GetLabel
// ============================================================================
function TExceptionSpec.GetLabel: IToken;
begin
result := fLabel;
end;
// ============================================================================
// GetHandlers
// ============================================================================
function TExceptionSpec.GetHandlers: TInterfaceList;
begin
result := fHandlers;
end;
// ============================================================================
// AddHandler
// ============================================================================
procedure TExceptionSpec.AddHandler(pHandler: IExceptionHandler);
begin
fHandlers.Add( pHandler);
end;
end.
src.lib/dpglib.Grammar.pas
+626
View File
@@ -0,0 +1,626 @@
unit dpglib.Grammar;
interface
uses
System.Classes,
System.Contnrs,
dpgrtl.types,
dpglib.Types;
type
TGrammar = class( TInterfacedObject, IGrammar)
protected
fCharVocabulary : TByteSet;
fTool : ITool;
fGenerator : ICodeGenerator;
fAnalyzer : ILLkAnalyzer;
fRules : TInterfaceList;
fMaxK : integer;
fSymbols : TStringList; //???
fUses : TStringList;
fUses2 : TStringList;
fConst : IToken;
fType : IToken;
fAnalyzerDebug : boolean;
fInteractive : boolean;
fHasSynPred : boolean;
fHasErrHandling : boolean;
fFileName : AnsiString;
fUnitName : AnsiString;
fGrammarName : AnsiString;
fSuperName : AnsiString;
fGrammarFile : AnsiString;
fTokenManager : ITokenManager;
fImportVocab : IToken;
fExportVocab : AnsiString;
fTraceRules : boolean;
fDebugOutput : boolean;
fDefErrorHandler : boolean;
fMemberAction : IToken;
fMemberDecl : AnsiString;
fMemberDef : AnsiString;
public
// ------------------------------------------------------------
// Constructor/destructor
// ------------------------------------------------------------
constructor Create( pObjectName : IToken;
pTool : ITool;
pSuperName : IToken);
destructor Destroy; override;
// ------------------------------------------------------------
// IGrammar methods
// ------------------------------------------------------------
function GetImportVocab : IToken; virtual;
function GetExportVocab : AnsiString; virtual;
procedure SetImportVocab( pVocab : IToken); virtual;
procedure SetExportVocab( pVocab : AnsiString); virtual;
procedure Generate; virtual; abstract;
function GetFileName : AnsiString;
function GetUnitName : AnsiString;
function GetObjectName : AnsiString;
function GetGrammarName : AnsiString;
function GetSuperName : AnsiString;
function GetMaxK : integer;
function GetTool : ITool;
function GetAnalyzer : ILLkAnalyzer;
function GetCodeGenerator : ICodeGenerator;
function GetTokenManager : ITokenManager;
function GetHasSynPred : boolean;
function GetMemberAction : IToken;
function GetCharVocabulary : TByteSet;
function GetRules : TInterfaceList;
function GetUsesList : TStringList;
function GetUsesList2 : TStringList;
function GetMemberDecl : AnsiString;
function GetMemberDef : AnsiString;
function GetConstAction : IToken;
function GetTypeAction : IToken;
function GetGrammarFile : AnsiString;
function GetDefErrorHandler : boolean;
// function GetDefined( pID : AnsiString): boolean;
function GetSymbol( pRule : AnsiString): ITokenSymbol;
procedure SetUnitName( pUnit : AnsiString);
procedure SetAnalyzer( pAnalyzer : ILLkAnalyzer);
procedure SetTokenManager( pTokenManager : ITokenManager);
procedure SetDefErrorHandler( pHandler : boolean);
procedure SetHasSynPred( pHasSynPred : boolean);
procedure SetMemberAction( pAction : IToken);
procedure SetCharVocabulary( pVocab : TByteSet);
procedure SetMemberDecl( pDecl : AnsiString);
procedure SetMemberDef( pDef : AnsiString);
procedure SetConstAction( pConst : IToken);
procedure SetTypeAction( pType : IToken);
procedure SetCodeGenerator( pGenerator : ICodeGenerator);
procedure SetGrammarFile( pFile : AnsiString);
procedure Define( pSymbol: IRuleSymbol);
function SetOption( pOption: IToken; pValue: IToken): boolean; virtual;
function GetClassName: AnsiString;
function Defined( pID: AnsiString): boolean;
end;
implementation
uses
System.SysUtils,
dpglib.TokenLexer,
dpglib.TokenParser,
dpglib.TokenManager,
dpglib.Messages;
// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Construction/destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Constructor
// ================================================================================================
constructor TGrammar.Create( pObjectName : IToken;
pTool : ITool;
pSuperName : IToken);
begin
inherited Create;
fGrammarName := pObjectName.TokenText;
fTool := pTool;
if pSuperName <> nil then
fSuperName := pSuperName.TokenText
else
fSuperName := '';
fTokenManager := TTokenManager.Create( 'TokenManager', pTool);
fRules := TInterfaceList.Create;
fSymbols := TStringList.Create;
fDefErrorHandler := false;
fMemberDecl := '';
fMemberDef := '';
fConst := nil;
fType := nil;
fImportVocab := nil;
fExportVocab := '';
fCharVocabulary := [1..255];
fMaxK := 1;
// ---------------------------------------------------------------
// Prepare uses list for interface section
// ---------------------------------------------------------------
fUses := TStringList.Create;
fUses.Sorted := true;
fUses.Duplicates := dupIgnore;
fUses.Add( 'Classes' );
fUses.Add( 'SysUtils' );
fUses.Add( 'dpgrtl.types' );
if Supports( self, ILexerGrammar) then fUses.Add( 'dpgrtl.lexer') else
if Supports( self, IParserGrammar) then fUses.Add( 'dpgrtl.llkparser');
// ---------------------------------------------------------------
// Prepare uses list for implementation section
// ---------------------------------------------------------------
fUses2 := TStringList.Create;
fUses2.Sorted := true;
fUses2.Duplicates := dupIgnore;
fUses2.Add( 'dpgrtl.exception' );
fUses2.Add( 'dpgrtl.token' );
// if Supports( self, ILexerGrammar) then fUses2.Add( 'dpgrtl.token');
end;
// ----------------------------------------------------------------------------
// Destructor
// ----------------------------------------------------------------------------
destructor TGrammar.Destroy;
begin
fConst := nil;
fType := nil;
FreeAndNil( fUses);
FreeAndNil( fUses2);
FreeAndNil( fSymbols);
FreeAndNil( fRules);
fTokenManager := nil;
inherited;
end;
// ****************************************************************************
// IGrammar implementation
// ****************************************************************************
// ----------------------------------------------------------------------------
// Define
// ----------------------------------------------------------------------------
procedure TGrammar.Define(pSymbol: IRuleSymbol);
begin
fRules.Add( pSymbol);
fSymbols.AddObject( pSymbol.ID, pointer( pSymbol));
end;
// ----------------------------------------------------------------------------
// GetObjectName
// ----------------------------------------------------------------------------
function TGrammar.GetObjectName: AnsiString;
begin
result := fGrammarName;
end;
// ----------------------------------------------------------------------------
// GetSuperName
// ----------------------------------------------------------------------------
function TGrammar.GetSuperName: AnsiString;
begin
result := fSuperName;
end;
// ----------------------------------------------------------------------------
// GetMaxK
// ----------------------------------------------------------------------------
function TGrammar.GetMaxK: integer;
begin
result := fMaxK;
end;
// ----------------------------------------------------------------------------
// GetAnalyzer
// ----------------------------------------------------------------------------
function TGrammar.GetAnalyzer: ILLkAnalyzer;
begin
result := fAnalyzer;
end;
// ----------------------------------------------------------------------------
// GetDefErrorHandler
// ----------------------------------------------------------------------------
function TGrammar.GetDefErrorHandler: boolean;
begin
result := fDefErrorHandler;
end;
// ----------------------------------------------------------------------------
// GetFileName
// ----------------------------------------------------------------------------
function TGrammar.GetFileName: AnsiString;
begin
result := fFileName;
end;
// ----------------------------------------------------------------------------
// GetSymbol
// ----------------------------------------------------------------------------
function TGrammar.GetSymbol(pRule: AnsiString): ITokenSymbol;
var
idx: integer;
begin
idx := fSymbols.IndexOf( prule);
if idx >= 0 then
result := ITokenSymbol( pointer(fSymbols.Objects[idx]))
else
result := nil;
end;
// ----------------------------------------------------------------------------
// GetDefined
// ----------------------------------------------------------------------------
//function TGrammar.GetDefined(pID: AnsiString): boolean;
//begin
//end;
// ----------------------------------------------------------------------------
// SetAnalyzer
// ----------------------------------------------------------------------------
procedure TGrammar.SetAnalyzer(pAnalyzer: ILLkAnalyzer);
begin
fAnalyzer := pAnalyzer;
end;
// ----------------------------------------------------------------------------
// SetTokenManager
// ----------------------------------------------------------------------------
procedure TGrammar.SetTokenManager(pTokenManager: ITokenManager);
begin
fTokenManager := pTokenManager;
end;
// ============================================================================
// SetOption
//
// Option Value
// -------------------------------------------------------
// k integer
// defaultErrorHandler true/false
// ============================================================================
function TGrammar.SetOption(pOption, pValue: IToken): boolean;
var
k: integer;
s: AnsiString;
begin
result := true;
// ---------------------------------------------------------------
// Option: k
// ---------------------------------------------------------------
if pOption.TokenText = 'k' then
begin
k := StrToIntDef( pValue.TokenText, -1);
if k < 1 then
begin
fTool.Error('option "k" must be a positive integer',
fGrammarFile,
pValue.TokenLine,
pValue.TokenColumn);
result := false;
end
else
fMaxK := k;
end
// ---------------------------------------------------------------
// Option: defaultErrorHandler
// ---------------------------------------------------------------
else if pOption.TokenText = 'defaultErrorHandler' then
begin
if pValue.TokenText = 'true' then
fDefErrorHandler := true
else if pValue.TokenText = 'false' then
fDefErrorHandler := false
else
begin
fTool.Error('Value for "defaultErrorHandler" must be true or false.',
fGrammarFile,
pValue.TokenLine,
pValue.TokenColumn);
result := false;
end;
end
else
begin
s := MSG_W_ILLEGALOPTION;
fTool.Warning( Format( MSG_W_ILLEGALOPTION, [pOption.TokenText]),
fGrammarFile,
pValue.TokenLine,
pValue.TokenColumn);
result := false;
end;
end;
function TGrammar.GetTool: ITool;
begin
result := fTool;
end;
function TGrammar.GetCodeGenerator: ICodeGenerator;
begin
result := fGenerator;
end;
function TGrammar.GetTokenManager: ITokenManager;
begin
result := fTokenManager;
end;
function TGrammar.GetHasSynPred: boolean;
begin
result := fHasSynPred;
end;
function TGrammar.GetMemberAction: IToken;
begin
result := fMemberAction;
end;
procedure TGrammar.SetDefErrorHandler(pHandler: boolean);
begin
fDefErrorHandler := fDefErrorHandler;
end;
procedure TGrammar.SetHasSynPred(pHasSynPred: boolean);
begin
fHasSynPred := pHasSynPred;
end;
procedure TGrammar.SetMemberAction(pAction: IToken);
begin
fMemberAction := pAction;
end;
function TGrammar.GetClassName: AnsiString;
begin
result := fGrammarName;
end;
function TGrammar.Defined(pID: AnsiString): boolean;
begin
if fSymbols.IndexOf( pID) >= 0 then
result := true
else
result := false;
end;
function TGrammar.GetCharVocabulary: TByteSet;
begin
result := fCharVocabulary;
end;
procedure TGrammar.SetCharVocabulary(pVocab: TByteSet);
begin
fCharVocabulary := pVocab;
end;
// ============================================================================
// GetUnitName
// ============================================================================
function TGrammar.GetUnitName: AnsiString;
begin
result := fUnitName;
end;
// ============================================================================
// SetUnitName
// ============================================================================
procedure TGrammar.SetUnitName(pUnit: AnsiString);
begin
fUnitName := pUnit;
fFileName := pUnit + '.pas';
// fExportVocab := pUnit;
end;
// ----------------------------------------------------------------------------
// ----------------------------------------------------------------------------
function TGrammar.GetGrammarName: AnsiString;
begin
result := fGrammarName;
end;
// ----------------------------------------------------------------------------
// ----------------------------------------------------------------------------
function TGrammar.GetRules: TInterfaceList;
begin
result := fRules;
end;
// ----------------------------------------------------------------------------
// GetUsesList
// ----------------------------------------------------------------------------
function TGrammar.GetUsesList: TStringList;
begin
result := fUses;
end;
function TGrammar.GetUsesList2: TStringList;
begin
result := fUses2;
end;
function TGrammar.GetMemberDecl: AnsiString;
begin
result := fMemberDecl;
end;
function TGrammar.GetMemberDef: AnsiString;
begin
result := fMemberDef;
end;
procedure TGrammar.SetMemberDecl(pDecl: AnsiString);
begin
fMemberDecl := pDecl;
end;
procedure TGrammar.SetMemberDef(pDef: AnsiString);
begin
fMemberDef := pDef;
end;
procedure TGrammar.SetCodeGenerator(pGenerator: ICodeGenerator);
begin
fGenerator := pGenerator;
end;
// ============================================================================
// GetImportVocab
// ============================================================================
function TGrammar.GetImportVocab: IToken;
begin
result := fImportVocab;
end;
// ============================================================================
// GetExportVocab
// ============================================================================
function TGrammar.GetExportVocab: AnsiString;
begin
result := fExportVocab;
end;
// ============================================================================
// SetImportVocab
// ============================================================================
procedure TGrammar.SetImportVocab(pVocab: IToken);
var
stream : TFileStream;
lexer : ITokenStream;
parser : TTokenParser;
fname : AnsiString;
begin
if fImportVocab = nil then
begin
try
fImportVocab := pVocab;
fname := pVocab.TokenText + 'Tokens.txt';
stream := TFileStream.Create( fName, fmOpenRead);
except
fTool.Warning( Format( MSG_W_CANTIMPORT, [fname]),
fGrammarFile,
pVocab.TokenLine,
pVocab.TokenColumn);
fImportVocab := nil;
stream := nil;
end;
if stream <> nil then
begin
lexer := TTokenLexer.Create( stream);
parser := TTokenParser.Create(lexer);
try
parser.tokenFile( fTokenManager);
except
end;
FreeAndNil( stream);
end;
end;
end;
// ============================================================================
// SetExportVocab
// ============================================================================
procedure TGrammar.SetExportVocab(pVocab: AnsiString);
begin
fExportVocab := pVocab;
end;
function TGrammar.GetConstAction: IToken;
begin
result := fConst;
end;
function TGrammar.GetTypeAction: IToken;
begin
result := fType;
end;
procedure TGrammar.SetConstAction(pConst: IToken);
begin
fConst := pConst;
end;
procedure TGrammar.SetTypeAction(pType: IToken);
begin
fType := pType;
end;
function TGrammar.GetGrammarFile: AnsiString;
begin
result := fGrammarFile;
end;
procedure TGrammar.SetGrammarFile(pFile: AnsiString);
begin
fGrammarFile := pFile;
end;
end.
src.lib/dpglib.GrammarAtom.pas
+176
View File
@@ -0,0 +1,176 @@
unit dpglib.GrammarAtom;
interface
uses
dpgrtl.types,
dpglib.types,
dpglib.AlternativeElem;
type
// =========================================================================
// Class TGrammarAtom declaration
// =========================================================================
TGrammarAtom = class( TAlternativeElem,
IGrammarAtom,
IAlternativeElem,
IGrammarElem)
protected
// ------------------------------------------------------------
// Members
// ------------------------------------------------------------
fLabel : AnsiString;
fAtomText : AnsiString;
fTokenType : integer;
fNot : boolean;
fASTNodeType : AnsiString;
public
// ------------------------------------------------------------
// Constructor/destructor
// ------------------------------------------------------------
constructor Create( pGrammar : IGrammar;
pToken : IToken;
pAutoGenType: integer);
protected
// ------------------------------------------------------------
// IGrammarElem methods
// ------------------------------------------------------------
function AsString : AnsiString;
// ------------------------------------------------------------
// IAlternativeElem methods
// ------------------------------------------------------------
function GetLabel : AnsiString;
procedure SetLabel(pLabel: AnsiString);
// ------------------------------------------------------------
// IGrammarAtom methods
// ------------------------------------------------------------
function GetAtomText : AnsiString;
function GetASTNodeType: AnsiString;
function GetTokenType : integer;
function GetIsNot : boolean;
procedure SetASTNodeType( pASTNodeType : AnsiString);
procedure SetOption( pKey: IToken; pValue: IToken);
end;
implementation
uses
dpglib.GrammarElem;
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ----------------------------------------------------------------------------
// Constructor
// ----------------------------------------------------------------------------
constructor TGrammarAtom.Create( pGrammar : IGrammar;
pToken : IToken;
pAutoGenType: integer);
begin
inherited Create( pGrammar, pToken, pAutoGenType);
fAtomText := pToken.TokenText;
fTokenType := TT_INVALID;
fNot := false;
end;
// ****************************************************************************
// IGrammarElem implementation
// ****************************************************************************
// ----------------------------------------------------------------------------
// ToString
// ----------------------------------------------------------------------------
function TGrammarAtom.AsString: AnsiString;
begin
result := '';
if fLabel <> '' then result := result + fLabel + ':';
if fNot = true then result := result + '~';
result := result + fAtomtext;
end;
// ****************************************************************************
// IAlternativeElem implementation
// ****************************************************************************
// ----------------------------------------------------------------------------
// GetLabel
// ----------------------------------------------------------------------------
function TGrammarAtom.GetLabel: AnsiString;
begin
result := fLabel;
end;
// ----------------------------------------------------------------------------
// SetLabel
// ----------------------------------------------------------------------------
procedure TGrammarAtom.SetLabel(pLabel: AnsiString);
begin
fLabel := pLabel;
end;
// ****************************************************************************
// IGrammarAtom implementation
// ****************************************************************************
// ----------------------------------------------------------------------------
// GetText
// ----------------------------------------------------------------------------
function TGrammarAtom.GetAtomText: AnsiString;
begin
result := fAtomText;
end;
// ----------------------------------------------------------------------------
// GetType
// ----------------------------------------------------------------------------
function TGrammarAtom.GetTokenType: integer;
begin
result := fTokenType;
end;
// ----------------------------------------------------------------------------
// GetIsNot
// ----------------------------------------------------------------------------
function TGrammarAtom.GetIsNot: boolean;
begin
result := fNot;
end;
// ----------------------------------------------------------------------------
// GetASTNodeType;
// ----------------------------------------------------------------------------
function TGrammarAtom.GetASTNodeType: AnsiString;
begin
result := fASTNodeType;
end;
// ----------------------------------------------------------------------------
// SetASTNodeType
// ----------------------------------------------------------------------------
procedure TGrammarAtom.SetASTNodeType(pASTNodeType: AnsiString);
begin
fASTNodeType := pASTNodeType;
end;
// ----------------------------------------------------------------------------
// SetOption
// ----------------------------------------------------------------------------
procedure TGrammarAtom.SetOption(pKey: IToken; pValue: IToken);
begin
if pKey.TokenText = 'AST' then
SetASTNodeType( pValue.TokenText)
else
fGrammar.Tool.Error( 'Invalid element option: ' + String(pKey.TokenText),
fGrammar.GrammarFile,
pKey.TokenLine,
pKey.TokenColumn);
end;
end.
src.lib/dpglib.GrammarBehavior.pas
+950
View File
@@ -0,0 +1,950 @@
unit dpglib.GrammarBehavior;
interface
uses
System.Classes,
dpgrtl.types,
dpglib.Types;
type
TGrammarBehavior = class( TInterfacedObject, IGrammarBehavior)
protected
fGrammar : IGrammar;
fTool : ITool;
fAnalyzer : ILLkAnalyzer;
fUsesList : TStringList;
fIsLexer : boolean;
fIsParser : boolean;
fIsTreeWalker : boolean;
fLexerGrammar : ILexerGrammar;
fParserGrammar : IParserGrammar;
fTreeWalkerGrammar: ITreeWalkerGrammar;
fLanguage : AnsiString;
fExchangeDir : AnsiString;
fConstAction : IToken;
fTypeAction : IToken;
protected
// ------------------------------------------------------------
// _RefRule
// ------------------------------------------------------------
procedure _RefStringLiteral( pLiteral : IToken);
procedure _RefToken( pToken : IToken);
procedure _RefRule( pRuleName : IToken);
public
constructor Create( pTool : ITool;
pAnalyzer : ILLkAnalyzer;
pExchangeDir : AnsiString);
destructor Destroy; override;
public
// ------------------------------------------------------------
// IGrammarBehavior methods
// ------------------------------------------------------------
function Grammar: IGrammar;
procedure AbortGrammar; virtual;
procedure BeginAlt( pDoAST: boolean); virtual; abstract;
procedure BeginExceptionGroup; virtual; abstract;
procedure BeginExceptionSpec( pLabel : IToken); virtual; abstract;
procedure BeginSubRule( pLabel : IToken;
pStart : IToken;
pNot : boolean); virtual; abstract;
procedure BeginTree( pStart : IToken); virtual; abstract;
procedure BeginChildList; virtual; abstract;
procedure DefineGrammarUnit( pUnit : AnsiString); virtual;
procedure DefineRuleName( pRule : IToken;
pAccess : AnsiString;
pRuleAutoGen : boolean;
pDocComment : AnsiString); virtual;
procedure DefineToken( pTokenName : IToken;
pTokenLiteral : IToken); virtual;
procedure DefineUses( pUses : AnsiString); virtual;
procedure EndAlt; virtual; abstract;
procedure EndExceptionGroup; virtual; abstract;
procedure EndExceptionSpec; virtual; abstract;
procedure EndGrammar; virtual; abstract;
procedure EndOptions; virtual;
procedure EndRule( pRuleName : AnsiString); virtual; abstract;
procedure EndSubRule; virtual; abstract;
procedure EndTree; virtual; abstract;
procedure EndChildList; virtual; abstract;
procedure HasError; virtual; abstract;
procedure NoASTSubRule; virtual; abstract;
procedure OneOrMoreSubRule; virtual; abstract;
procedure NMSubRule; virtual; abstract;
procedure OptionalSubRule; virtual; abstract;
procedure refRangeLow( M : integer); virtual; abstract;
procedure refRangeHigh( N : integer); virtual; abstract;
procedure RefAction( pAction : IToken); virtual; abstract;
procedure RefArgAction( pAction : IToken); virtual; abstract;
procedure RefCharLiteral( pLiteral : IToken;
pLabel : IToken;
pInverted : boolean;
pAutoGenType : integer;
pLastInRule : boolean); virtual; abstract;
procedure RefCharRange( pToken1 : IToken;
pToken2 : IToken;
pLabel : IToken;
pAutoGenType : integer;
pLastInRule : boolean); virtual; abstract;
procedure RefConstAction( pConstAction : IToken); virtual;
procedure RefTypeAction( pTypeAction : IToken); virtual;
procedure RefElemOption( pOption : IToken;
pValue : IToken); virtual; abstract;
procedure RefTokenSpecElemOption( pToken : IToken;
pOption : IToken;
pValue : IToken); virtual; abstract;
procedure RefExceptionHandler( pTypeAndName : IToken;
pAction : IToken); virtual; abstract;
procedure RefInitAction( pAction : IToken); virtual; abstract;
procedure RefMemberDecl( pDecl : IToken); virtual;
procedure RefMemberDef( pDef : IToken); virtual;
procedure RefReturnAction( pAction : IToken); virtual; abstract;
procedure RefRule( pAssignId : IToken;
pRuleName : IToken;
pLabel : IToken;
pArguments : IToken;
pAutoGenType : integer); virtual;
procedure RefRuleExHandler( pExHandlerType : IToken;
pExHandlerCode : IToken); virtual; abstract;
procedure RefAltExHandler( pExHandlerType : IToken;
pExHandlerCode : IToken); virtual; abstract;
procedure RefRuleLocals( pLocals : IToken); virtual; abstract;
procedure RefSemPred( pSemPred : IToken); virtual; abstract;
procedure RefStringLiteral( pLiteral : IToken;
pLabel : IToken;
pAutoGenType : integer;
pLastInRule : boolean); virtual;
procedure RefToken( pAssignId : IToken;
pToken : IToken;
pLabel : IToken;
pArguments : IToken;
pInverted : boolean;
pAutoGenType : integer;
pLAstInRule : boolean); virtual;
procedure RefTokenRange( pToken1 : IToken;
pToken2 : IToken;
pLabel : IToken;
pAutoGenType : integer;
pLastInRule : boolean); virtual;
procedure RefWildCard( pToken : IToken;
pLabel : IToken;
pAutoGenType : integer); virtual; abstract;
procedure Reset; virtual;
procedure SetArgOfRuleRef( pArguments : IToken); virtual; abstract;
procedure SetCharVocabulary( pVocabulary : TByteSet);virtual;
procedure setFileOption( poption : IToken;
pValue : IToken;
pFileName : AnsiString); virtual;
procedure SetGrammarOption( pOption : IToken;
pValue : IToken); virtual;
procedure setRuleOption( pOption : IToken;
pValue : IToken); virtual; abstract;
procedure SetSubRuleOption( pOption : IToken;
pValue : IToken); virtual; abstract;
procedure SetUserExceptions( pException : AnsiString); virtual; abstract;
procedure StartLexer( pFileName : AnsiString;
pLexerName : IToken;
pSuperClass : IToken);
procedure StartParser( pFileName : AnsiString;
pParserName : IToken;
pSuperClass : IToken);
procedure StartTreeWalker( pFileName : AnsiString;
pParserName : IToken;
pSuperClass : IToken);
procedure SynPred; virtual; abstract;
procedure ZeroOrMoreSubRule; virtual; abstract;
end;
implementation
uses
System.SysUtils,
dpglib.Utils,
dpglib.Messages,
dpglib.DpgParserTokens,
dpglib.TokenSymbol,
dpglib.StringSymbol,
dpglib.RuleSymbol,
dpglib.LexerGrammar,
dpglib.ParserGrammar,
dpglib.TreeParserGrammar,
dpglib.CodeGenerator;
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ----------------------------------------------------------------------------
// Constructor
// ----------------------------------------------------------------------------
constructor TGrammarBehavior.Create(pTool : ITool;
pAnalyzer : ILLkAnalyzer;
pExchangeDir: AnsiString);
begin
inherited Create;
fTool := pTool;
fAnalyzer := pAnalyzer;
fLexerGrammar := nil;
fParserGrammar := nil;
fTreeWalkerGrammar:= nil;
fIsLexer := false;
fIsParser := false;
fIsTreeWalker := false;
fConstAction := nil;
fTypeAction := nil;
fLanguage := 'Delphi';
fExchangeDir := pExchangeDir;
if fExchangeDir <> '' then
if fExchangeDir[Length(fExchangeDir)] <> '\' then
fExchangeDir := fExchangeDir + '\';
end;
// ----------------------------------------------------------------------------
// Destructor
// ----------------------------------------------------------------------------
destructor TGrammarBehavior.Destroy;
begin
fTool := nil;
fAnalyzer := nil;
fLexerGrammar := nil;
fParserGrammar := nil;
fTreeWalkerGrammar:= nil;
fIsLexer := false;
fIsParser := false;
fIsTreeWalker := false;
inherited;
end;
// @@@: IGrammarBehavior implementation +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// IGrammarBehavior implementation
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// DefineGrammarUnit
// ================================================================================================
procedure TGrammarBehavior.DefineGrammarUnit(pUnit: AnsiString);
begin
fGrammar.UnitName := pUnit;
end;
// ================================================================================================
// DefineRuleName
// ================================================================================================
procedure TGrammarBehavior.DefineRuleName( pRule : IToken;
pAccess : AnsiString;
pRuleAutoGen: boolean;
pDocComment : AnsiString);
var
id: AnsiString;
ts: ITokenSymbol;
rs: IRuleSymbol;
begin
id := pRule.TokenText;
// ---------------------------------------------------------------
// Handle lexer rule definition. Lexer rule name must be TOKENREF,
// what means: must begin with capital letter.
// ---------------------------------------------------------------
if( pRule.TokenType = TT_TOKENREF) then
begin
// ------------------------------------------------------------
// construct valid name for it...
// ------------------------------------------------------------
id := TCodeGenerator.encodeLexerRuleName( id);
// ------------------------------------------------------------
// If this token not defined in TokenManager, define it. This
// happens when the rule definition is before any reference to
// this rule.
// ------------------------------------------------------------
if not fGrammar.TokenManager.TokenDefined[ pRule.TokenText] then
begin
ts := TTokenSymbol.Create( pRule.TokenText);
ts.TokenType:= fGrammar.TokenManager.NextTokenType;
fGrammar.TokenManager.Define( ts);
end;
end;
// ---------------------------------------------------------------
// Check if the rule is already defined in the grammar. If so,
// show an error message. In this case the generated code is not
// usable....
// ---------------------------------------------------------------
if fGrammar.Defined( id) then
begin
fGrammar.Symbol[id].QueryInterface(IRuleSymbol,rs);
if rs.Defined then
begin
fTool.Error( Format( MSG_E_RULEREDEF,[ id]),
fGrammar.GrammarFile,
pRule.TokenLine,
pRule.TokenColumn);
end;
end
// ---------------------------------------------------------------
// ... else the grammar isn't defined, so define it.
// ---------------------------------------------------------------
else
begin
rs := TRuleSymbol.Create( id);
fGrammar.Define( rs);
end;
rs.Defined := true;
rs.Access := pAccess;
rs.Comment := pDocComment;
end;
// ================================================================================================
// DefineToken
//
// Define a token from tokens {...}.
// Must be label and literal or just label or just a literal.
// ================================================================================================
procedure TGrammarBehavior.DefineToken( pTokenName : IToken;
pTokenLiteral : IToken);
var
i : integer;
name : AnsiString;
literal : AnsiString;
ss : IStringSymbol;
sx : IStringSymbol;
ts : ITokenSymbol;
begin
name := '';
literal := '';
if pTokenName <> nil then name := pTokenName.TokenText;
if pTokenLiteral <> nil then literal := pTokenLiteral.TokenText;
// ---------------------------------------------------------------
// The literal must be a string of printable characters surrounded
// by '"'s. See: dpglib.utils.
// ---------------------------------------------------------------
if literal <> '' then
begin
for i:=2 to Length(literal) -1 do
begin
if not IsPrint( literal[i]) then
begin
fTool.Error( Format( MSG_E_INVSTRINGLITERAL,[ literal]),
fGrammar.GrammarFile,
pTokenLiteral.TokenLine,
pTokenLiteral.TokenColumn);
exit;
end;
end;
end;
// ---------------------------------------------------------------
// OK the literal passed the test, so go...
// ---------------------------------------------------------------
if literal <> '' then
begin
ss := nil;
ts := fGrammar.TokenManager.TokenSymbol[ literal];
if ts <> nil then
ts.QueryInterface( IStringSymbol,ss);
if ss <> nil then
begin
// ---------------------------------------------------------
// This literal is known already.
// If the literal has no label already, but we can provide
// one here, then no problem, just map the label to the literal
// and don't change anything else.
// Otherwise, labels conflict: error.
// ---------------------------------------------------------
if (name = '') or (ss.Lbl <> '') then
begin
fTool.Warning( Format( MSG_W_TOKENSREDEF,[ literal]),
fGrammar.GrammarFile,
pTokenLiteral.TokenLine,
pTokenLiteral.TokenColumn);
exit;
end
// ---------------------------------------------------------
// The literal had no label, but new def does. Set it.
// ---------------------------------------------------------
else if name <> '' then
begin
ss.Lbl := name;
fGrammar.TokenManager.MapToTokenSymbol( name, ss);
end;
end;
// ------------------------------------------------------------
// if they provide a name/label and that name/label already
// exists, just hook this literal onto old token.
// ------------------------------------------------------------
if name <> '' then
begin
ts := fGrammar.TokenManager.TokenSymbol[ name];
if ts <> nil then
begin
// ------------------------------------------------------
// Watch out that the label is not more than just a token.
// If it already has a literal attached, then: conflict.
// ------------------------------------------------------
if ts.QueryInterface( IStringSymbol, sx) = S_OK then
begin
fTool.Warning( Format( MSG_W_TOKENSREDEF,[ name]),
fGrammar.GrammarFile,
pTokenName.TokenLine,
pTokenName.TokenColumn);
exit;
end;
// ------------------------------------------------------
// A simple token symbol such as DECL is defined must
// convert it to a AnsiStringLiteralSymbol with a label by
// co-opting token type and killing old TokenSymbol.
// Kill mapping and entry in vector of token manager.
// ------------------------------------------------------
// ------------------------------------------------------
// Now create AnsiString literal with label.
// ------------------------------------------------------
ss := TStringSymbol.Create( literal);
ss.TokenType := ts.TokenType;
ss.Lbl := name;
// ------------------------------------------------------
// Redefine this critter as a AnsiString literal.
// ------------------------------------------------------
fGrammar.TokenManager.Define( ss);
// ------------------------------------------------------
// Make sure the label can be used also.
// ------------------------------------------------------
fGrammar.TokenManager.MapToTokenSymbol( name, ss);
exit;
end;
end;
// ------------------------------------------------------------
// Here, literal was labeled but not by a known token symbol.
// ------------------------------------------------------------
ss := TStringSymbol.Create( literal);
ss.TokenType:= fGrammar.TokenManager.NextTokenType;
ss.Lbl := name;
fGrammar.TokenManager.Define(ss);
if name <> '' then
fGrammar.TokenManager.MapToTokenSymbol( name, ss);
end
// ---------------------------------------------------------------
// Create a token in the token manager not a literal.
// ---------------------------------------------------------------
else
begin
if fGrammar.TokenManager.TokenDefined[ name] then
begin
fTool.Warning( Format( MSG_W_TOKENSREDEF,[ name]),
fGrammar.GrammarFile,
pTokenName.TokenLine,
pTokenname.TokenColumn);
exit;
end;
ts := TTokenSymbol.Create( name);
ts.TokenType:= fGrammar.TokenManager.NextTokenType;
fGrammar.TokenManager.Define(ts);
end;
end;
// ================================================================================================
// DefineUses
// ================================================================================================
procedure TGrammarBehavior.DefineUses(pUses: AnsiString);
begin
fGrammar.UsesList.Add( pUses);
end;
// ================================================================================================
// EndOptions
//
// Called after the optional options section, to compensate for options that
// may not have been set.
// This method is bigger than it needs to be, but is much more clear if I
// delineate all the cases.
// ================================================================================================
procedure TGrammarBehavior.EndOptions;
begin
{ TODO : EndOptions not implemented... }
end;
// ================================================================================================
// refRule
// ================================================================================================
procedure TGrammarBehavior.refRule( pAssignId : IToken;
pRuleName : IToken;
pLabel : IToken;
pArguments : IToken;
pAutoGenType: integer);
begin
_refRule( pRuleName);
end;
// ============================================================================
// ============================================================================
// RefStringLiteral
// ============================================================================
procedure TGrammarBehavior.refStringLiteral( pLiteral : IToken;
pLabel : IToken;
pAutoGenType : integer;
pLastInRule : boolean);
begin
_refStringLiteral( pLiteral);
end;
// ============================================================================
// ============================================================================
// RefToken
// ============================================================================
procedure TGrammarBehavior.refToken( pAssignId : IToken;
pToken : IToken;
pLabel : IToken;
pArguments : IToken;
pInverted : boolean;
pAutoGenType : integer;
pLAstInRule : boolean);
begin
_refToken( pToken);
end;
// ============================================================================
// ============================================================================
// RefTokenRange
// ============================================================================
procedure TGrammarBehavior.refTokenRange( pToken1 : IToken;
pToken2 : IToken;
pLabel : IToken;
pAutoGenType : integer;
pLastInRule : boolean);
begin
// ---------------------------------------------------------------
// Ensure that the DefineGrammar methods are called;
// otherwise a range addes more token refs to the alternative by
// calling MakeGrammar.refToken etc...
// ---------------------------------------------------------------
if pToken1.TokenText[1] = '"' then
_refStringLiteral( pToken1)
else
_RefToken( pToken1);
if pToken2.TokenText[1] = '"' then
_RefStringLiteral( pToken2)
else
_RefToken( pToken2);
end;
// ============================================================================
// ============================================================================
// SetCharVocabulary
//
// Set the character vocabulary for a lexer.
// ============================================================================
procedure TGrammarBehavior.SetCharVocabulary(pVocabulary: TByteSet);
begin
if fIsLexer then
fLexerGrammar.CharVocabulary := pVocabulary;
end;
// ============================================================================
// ============================================================================
// SetFileOption
// ============================================================================
procedure TGrammarBehavior.SetFileOption( pOption : IToken;
pValue : IToken;
pFileName: AnsiString);
begin
// ---------------------------------------------------------------
// Option: language
// ---------------------------------------------------------------
if pOption.TokenText = 'language' then
if pValue.TokenType = TT_STRINGLIT then
fLanguage := Copy(pValue.TokenText,2,Length(pValue.TokenText)-2)
else if pValue.TokenType in [TT_TOKENREF,TT_RULEREF] then
fLanguage := pValue.TokenText
else
fTool.Error( 'option "language" must be a AnsiString or identifier',
fGrammar.GrammarFile,
pValue.TokenLine,
pValue.TokenColumn)
// ---------------------------------------------------------------
// Other option is error
// ---------------------------------------------------------------
else
fTool.Error( 'Invalid file-level option: "' + poption.TokenText + '"',
fGrammar.GrammarFile,
pValue.TokenLine,
pValue.TokenColumn)
end;
// ----------------------------------------------------------------------------
// SetGrammarOption
// ----------------------------------------------------------------------------
procedure TGrammarBehavior.SetGrammarOption( pOption : IToken;
pValue : IToken);
begin
// ---------------------------------------------------------------
// Option: exportVocab
// ---------------------------------------------------------------
if pOption.TokenText = 'exportVocab' then
if pValue.TokenType in [TT_TOKENREF,TT_RULEREF] then
// fGrammar.ExportVocab := fExchangeDir + pValue.TokenText
fGrammar.ExportVocab := pValue.TokenText
else
fTool.Error( 'option "exportVocab" must be an identifier',
fGrammar.GrammarFile,
pValue.TokenLine,
pValue.TokenColumn)
// ---------------------------------------------------------------
// Option: importVocab
// ---------------------------------------------------------------
else if pOption.TokenText = 'importVocab' then
if pValue.TokenType in [TT_TOKENREF,TT_RULEREF] then
begin
pValue.TokenText := fExchangeDir + pValue.TokenText;
fGrammar.ImportVocab := pValue
end
else
fTool.Error( 'option "importVocab" must be an identifier',
fGrammar.GrammarFile,
pValue.TokenLine,
pValue.TokenColumn)
// ---------------------------------------------------------------
// Other options sent to the grammar
// ---------------------------------------------------------------
else
fGrammar.SetOption( pOption, pValue);
end;
// ================================================================================================
// Start Lexer
// ================================================================================================
procedure TGrammarBehavior.StartLexer( pFileName : AnsiString;
pLexerName : IToken;
pSuperClass : IToken);
begin
// ---------------------------------------------------------------
// Create lexer, and initialize it
// ---------------------------------------------------------------
if fGrammar = nil then
begin
fLexerGrammar := TLexerGrammar.Create(pLexerName,fTool,pSuperClass);
fGrammar := fLexerGrammar;
fGrammar.LLkAnalyzer := fAnalyzer;
fGrammar.GrammarFile := pFileName;
fAnalyzer.Grammar := fGrammar;
fIsLexer := true;
// ------------------------------------------------------------
// Append uses list...
// ------------------------------------------------------------
fGrammar.UsesList.AddStrings( fUsesList);
fGrammar.ConstAction := fConstAction;
fGrammar.TypeAction := fTypeAction;
end
else
fTool.Panic('A grammar already started');
end;
// ================================================================================================
// Start Parser
// ================================================================================================
procedure TGrammarBehavior.StartParser( pFileName : AnsiString;
pParserName : IToken;
pSuperClass : IToken);
begin
// ---------------------------------------------------------------
// Create parser, and initialize it
// ---------------------------------------------------------------
if fGrammar = nil then
begin
fParserGrammar := TParserGrammar.Create(pParserName,fTool,pSuperClass);
fGrammar := fParserGrammar;
fGrammar.LLkAnalyzer := fAnalyzer;
fGrammar.GrammarFile := pFileName;
fAnalyzer.Grammar := fGrammar;
fIsParser := true;
// ------------------------------------------------------------
// Append uses list...
// ------------------------------------------------------------
fGrammar.UsesList.AddStrings( fUsesList);
fGrammar.ConstAction := fConstAction;
fGrammar.TypeAction := fTypeAction;
end
else
fTool.Panic('A grammar already started');
end;
// ================================================================================================
// Start TreeWalker
// ================================================================================================
procedure TGrammarBehavior.StartTreeWalker( pFileName : AnsiString;
pParserName : IToken;
pSuperClass : IToken);
begin
// ---------------------------------------------------------------
// Create parser, and initialize it
// ---------------------------------------------------------------
if fGrammar = nil then
begin
fTreeWalkerGrammar := TTreeParserGrammar.Create( pParserName,fTool,pSuperClass);
fGrammar := fTreeWalkerGrammar;
fGrammar.GrammarFile := pFileName;
fGrammar.LLkAnalyzer := fAnalyzer;
fAnalyzer.Grammar := fGrammar;
fIsParser := true;
// ------------------------------------------------------------
// Append uses list...
// ------------------------------------------------------------
fGrammar.UsesList.AddStrings( fUsesList);
fGrammar.ConstAction := fConstAction;
fGrammar.TypeAction := fTypeAction;
end
else
fTool.Panic('A grammar already started');
end;
// ============================================================================
// ============================================================================
// RefMemberDecl
// ============================================================================
procedure TGrammarBehavior.RefMemberDecl(pDecl: IToken);
begin
if pDecl <> nil then
fGrammar.MemberDecl := pDecl.TokenText;
end;
// ============================================================================
// ============================================================================
// RefMemberDef
// ============================================================================
procedure TGrammarBehavior.RefMemberDef(pDef: IToken);
begin
if pDef <> nil then
fGrammar.MemberDef := pDef.TokenText;
end;
// ============================================================================
// ============================================================================
// Grammar
// ============================================================================
function TGrammarBehavior.Grammar: IGrammar;
begin
result := fGrammar;
end;
// ============================================================================
// ============================================================================
// AbortGrammar
// ============================================================================
procedure TGrammarBehavior.AbortGrammar;
begin
Reset;
end;
// ============================================================================
// ============================================================================
// Reset
// ============================================================================
procedure TGrammarBehavior.Reset;
begin
fGrammar := nil;
fLexerGrammar := nil;
fParserGrammar := nil;
fTreeWalkerGrammar:= nil;
end;
// ****************************************************************************
// Internals
// ****************************************************************************
// ============================================================================
// ============================================================================
// _RefStringLiteral
//
// AnsiStringLiterals are treated like tokens except by the lexer.
// ============================================================================
procedure TGrammarBehavior._RefStringLiteral( pLiteral: IToken);
var
ss : IStringSymbol;
str: AnsiString;
begin
if not fIsLexer then
begin
str := pLiteral.TokenText;
if fGrammar.TokenManager.TokenSymbol[str] = nil then
begin
// fTool.Warning( 'String literal "' + str + '" not defined.',
// fGrammar.GrammarFile,
// pLiteral.TokenLine,
// pLiteral.TokenColumn);
// ss := TStringSymbol.Create( str);
// ss.TokenType:= fGrammar.TokenManager.NextTokenType;
// fGrammar.TokenManager.Define( ss);
end;
end;
end;
// ============================================================================
// ============================================================================
// _RefToken
// ============================================================================
procedure TGrammarBehavior._RefToken( pToken: IToken);
var
id: AnsiString;
ts: ITokenSymbol;
begin
id := pToken.TokenText;
if not fGrammar.TokenManager.TokenDefined[ id] then
begin
// ------------------------------------------------------------
// Defining new TOKENREF is only allowed in lexer..
// ------------------------------------------------------------
if fIsLexer then
begin
ts := TTokenSymbol.Create( id);
ts.TokenType:= fGrammar.TokenManager.NextTokenType;
fGrammar.TokenManager.Define( ts);
end;
end;
end;
// ============================================================================
// ============================================================================
// _refRule
// ============================================================================
procedure TGrammarBehavior._RefRule( pRuleName: IToken);
var
id: AnsiString;
begin
id := pRuleName.TokenText;
if pRuleName.TokenType = TT_TOKENREF then
id := TCodeGenerator.encodeLexerRuleName( id);
if not fGrammar.Defined( id) then
fGrammar.Define( TRuleSymbol.Create( id));
end;
// ============================================================================
// ============================================================================
// RefConstAction
// ============================================================================
procedure TGrammarBehavior.RefConstAction(pConstAction: IToken);
begin
fConstAction := pConstAction;
end;
// ============================================================================
// ============================================================================
// RefTypeAction
// ============================================================================
procedure TGrammarBehavior.RefTypeAction(pTypeAction: IToken);
begin
fTypeAction := pTypeAction;
end;
end.
src.lib/dpglib.GrammarElem.pas
+154
View File
@@ -0,0 +1,154 @@
// ----------------------------------------------------------------------------
// A GrammarElement is a generic node in our data structure that holds a
// grammar in memory. This data structure can be used for static analysis or
// for dynamic analysis (during parsing).
// Every node must know which grammar owns it, how to generate code, and how
// to do analysis.
// ----------------------------------------------------------------------------
unit dpglib.GrammarElem;
interface
uses
dpgrtl.types,
dpglib.types;
type
TGrammarElem = class( TInterfacedObject, IGrammarElem)
protected
fGrammar : IGrammar;
fLine : integer;
fColumn : integer;
// ----------------------------------------------------------------------
// IGrammarElem methods
// ----------------------------------------------------------------------
protected
function GetLine : integer;
function GetColumn : integer;
procedure SetLine( Line : integer);
procedure SetColumn( Colunm : integer);
procedure Generate;
function AsString: AnsiString;
function Look( k: integer): ILookahead;
// ----------------------------------------------------------------------
// Construction/destruction
// ----------------------------------------------------------------------
public
constructor Create( Grammar: IGrammar); overload;
constructor Create( Grammar: IGrammar; Start: IToken); overload;
destructor Destroy; override;
end;
implementation
// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Construction/destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Constructor
// ================================================================================================
constructor TGrammarElem.Create(Grammar: IGrammar);
begin
inherited Create;
fGrammar := Grammar;
fLine := -1;
fColumn := -1;
end;
// ================================================================================================
// Constructor
// ================================================================================================
constructor TGrammarElem.Create(Grammar: IGrammar; Start: IToken);
begin
inherited Create;
fGrammar := Grammar;
fLine := Start.TokenLine;
fColumn := Start.TokenColumn;
end;
// ================================================================================================
// Destructor
// ================================================================================================
destructor TGrammarElem.Destroy;
begin
fGrammar := nil;
inherited;
end;
// @@@: IGrammarElem implementation +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// IGrammarElem implementation
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Get Line
// ================================================================================================
function TGrammarElem.GetLine: integer;
begin
result := fLine;
end;
// ================================================================================================
// Get Column
// ================================================================================================
function TGrammarElem.GetColumn: integer;
begin
result := fColumn;
end;
// ================================================================================================
// Set Line
// ================================================================================================
procedure TGrammarElem.SetLine(Line: integer);
begin
fLine := Line
end;
// ================================================================================================
// Set Column
// ================================================================================================
procedure TGrammarElem.SetColumn(Colunm: integer);
begin
fColumn := Colunm
end;
// ================================================================================================
// Generate
// ================================================================================================
procedure TGrammarElem.Generate;
begin
end;
// ================================================================================================
// Look
// ================================================================================================
function TGrammarElem.Look(k: integer): ILookahead;
begin
result := nil;
end;
// ================================================================================================
// AsString
// ================================================================================================
function TGrammarElem.AsString: AnsiString;
begin
result := ''
end;
end.
src.lib/dpglib.GrammarMaker.pas
+1715
View File
File diff suppressed because it is too large Load Diff
src.lib/dpglib.GrammarSymbol.pas
+79
View File
@@ -0,0 +1,79 @@
unit dpglib.GrammarSymbol;
interface
uses
dpglib.types;
type
TGrammarSymbol = class( TInterfacedObject, IGrammarSymbol)
protected
fID: AnsiString;
// ----------------------------------------------------------------------
// IdpgGrammar methods
// ----------------------------------------------------------------------
protected
function GetID: AnsiString;
procedure SetID( pID: AnsiString);
// ----------------------------------------------------------------------
// Construction/destruction
// ----------------------------------------------------------------------
public
constructor Create; overload;
constructor Create( ID: AnsiString); overload;
end;
implementation
// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Construction/destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Constructor
// ================================================================================================
constructor TGrammarSymbol.Create;
begin
fID := '';
end;
// ================================================================================================
// Constructor
// ================================================================================================
constructor TGrammarSymbol.Create(ID: AnsiString);
begin
fID := ID;
end;
// @@@: IdpgGrammarSymbol implementation ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// IdpgGrammarSymbol implementation
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Get ID
// ================================================================================================
function TGrammarSymbol.GetID: AnsiString;
begin
result := fID;
end;
// ================================================================================================
// Set ID
// ================================================================================================
procedure TGrammarSymbol.SetID(pID: AnsiString);
begin
fID := pID;
end;
end.
src.lib/dpglib.LLkAnalyzer.pas
+1550
View File
File diff suppressed because it is too large Load Diff
src.lib/dpglib.LexerGrammar.pas
+221
View File
@@ -0,0 +1,221 @@
unit dpglib.LexerGrammar;
interface
uses
System.Classes,
System.Contnrs,
dpgrtl.types,
dpglib.Types,
dpglib.Grammar;
type
// =========================================================================
// Class TLexerGrammar
// =========================================================================
TLexerGrammar = class( TGrammar,
IGrammar,
ILexerGrammar)
protected
fTestLiterals : boolean;
fCaseSensitive : boolean;
fFilterMode : boolean;
fFilterRule : AnsiString;
public
// ------------------------------------------------------------
// Constructor/destructor
// ------------------------------------------------------------
constructor Create( pObjectName : IToken;
pTool : ITool;
pSuperName : IToken);
// ------------------------------------------------------------
// IGrammar overrides
// ------------------------------------------------------------
function SetOption( pOption : IToken;
pValue : IToken): boolean;
// ------------------------------------------------------------
// ILexerGrammar methoda
// ------------------------------------------------------------
function GetTestLiterals : boolean;
function GetCaseSensitive : boolean;
function GetFilterMode : boolean;
function GetFilterRule : AnsiString;
end;
implementation
uses
System.SysUtils,
dpglib.DpgLexerTokens,
dpglib.Messages;
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TLexerGrammar.Create( pObjectName : IToken;
pTool : ITool;
pSuperName : IToken);
begin
inherited;
fTestLiterals := false;
fCaseSensitive := true;
fFilterMode := false;
// ---------------------------------------------------------------
// Lexer usually has no default handling
// ---------------------------------------------------------------
fDefErrorHandler := false;
end;
// ****************************************************************************
// ILexerGrammar implementation
// ****************************************************************************
// ============================================================================
// GetTestLiterals
// ============================================================================
function TLexerGrammar.GetTestLiterals: boolean;
begin
result := fTestLiterals;
end;
// ============================================================================
// GetCaseSensitive
// ============================================================================
function TLexerGrammar.GetCaseSensitive: boolean;
begin
result := fCaseSensitive;
end;
// ============================================================================
// GetFilterMode
// ============================================================================
function TLexerGrammar.GetFilterMode: boolean;
begin
result := fFilterMode;
end;
// ============================================================================
// GetFilterRule
// ============================================================================
function TLexerGrammar.GetFilterRule: AnsiString;
begin
result := fFilterRule;
end;
// ****************************************************************************
// IGrammar overrides
// ****************************************************************************
// ============================================================================
// SetOption
//
// Option Value
// -------------------------------------------------------
// testLiterals true/false
// caseSensitive true/false
// filter true/false/ID
// ============================================================================
function TLexerGrammar.SetOption(pOption, pValue: IToken): boolean;
begin
result := true;
// ---------------------------------------------------------------
// Option: testLiterals
// ---------------------------------------------------------------
if pOption.TokenText = 'testLiterals' then
begin
if pValue.TokenText = 'true' then
fTestLiterals := true
else if pValue.TokenText = 'false' then
fTestLiterals := false
else
begin
fTool.Error('Value for "testLiterals" must be true or false',
fGrammarFile,
pValue.TokenLine,
pValue.TokenColumn);
result := false;
end;
end
// ---------------------------------------------------------------
// Option: defaultErrorHandler
// ---------------------------------------------------------------
else if pOption.TokenText = 'defaultErrorHandler' then
begin
fTool.Warning( 'Option "defaultErrorHandler" is invalid for lexer',
fGrammarFile,
pValue.TokenLine,
pValue.TokenColumn);
result := true;
end
// ---------------------------------------------------------------
// Option: caseSensitive
// ---------------------------------------------------------------
else if pOption.TokenText = 'caseSensitive' then
begin
if pValue.TokenText = 'true' then
fCaseSensitive := true
else if pValue.TokenText = 'false' then
fCaseSensitive := false
else
begin
fTool.Error('Value for "caseSensitive" must be true or false',
fGrammarFile,
pValue.TokenLine,
pValue.TokenColumn);
result := false;
end;
end
// ---------------------------------------------------------------
// Option: filter
// ---------------------------------------------------------------
else if pOption.TokenText = 'filter' then
begin
if pValue.TokenText = 'true' then
begin
fFilterMode := true;
fFilterRule := '';
end
else if pValue.TokenText = 'false' then
begin
fFilterMode := false;
fFilterRule := '';
end
else if pValue.TokenType in [TT_TOKENREF] then
begin
fFilterMode := true;
fFilterRule := pValue.TokenText;
end
else
begin
fTool.Error('Value for "filter" must be true or false or an identifier.',
fGrammarFile,
pValue.TokenLine,
pValue.TokenColumn);
result := false;
end;
end
else
result := inherited SetOption(pOption, pValue);
end;
end.
src.lib/dpglib.Lookahead.pas
+373
View File
@@ -0,0 +1,373 @@
// ----------------------------------------------------------------------------
// This object holds all information needed to represent the lookahead for any
// particular lookahead computation for a single lookahead depth.
// Final lookahead information is a simple bit set, but intermediate stages
// need computation cycle and FOLLOW information.
//
// Concerning the "fCycle" variable.
// If lookahead is computed for a RuleEnd node, then computation is part of
// a FOLLOW cycle for this rule.
// If lookahead is computed for a RuleBlock node, the computation is part of
// a FIRST cycle to this rule.
//
// Concerning the "fEpsilon" variable. (epsilonDepth)
// This is not the depth relative to the rule reference that epsilon was
// encountered. That value is:
//
// initial_k - epsilonDepth + 1
//
// Also, lookahead depths past rule ref for local follow are:
//
// initial_k - (initial_k - epsilonDepth)
//
// Used for rule references. If we try to compute look(k, ruleref) and there
// are fewer than k lookahead terminals before the end of the the rule,
// epsilon will be returned (don't want to pass the end of the rule).
// We must track when the the lookahead got stuck. For example,
//
// a : b A B E F G;
// b : C ;
//
// LOOK(5, ref-to(b)) is {<EPSILON>} with depth = 4, which indicates that at
// 2 (5-4+1) tokens ahead, end of rule was reached.
// Therefore, the token at 4=5-(5-4) past rule ref b must be included in the
// set == F.
//
// The situation is complicated by the fact that a computation may hit the
// end of a rule at many different depths. For example,
//
// a : b A B C ;
// b : E F // epsilon depth of 1 relative to initial k=3
// | G // epsilon depth of 2
// ;
//
// Here, LOOK(3,ref-to(b)) returns epsilon, but the depths are {1, 2};
// i.e., 3-(3-1) and 3-(3-2). Those are the lookahead depths past the rule
// ref needed for the local follow.
//
// This is an empty set unless an epsilon is created.
// ----------------------------------------------------------------------------
unit dpglib.Lookahead;
interface
uses
dpgrtl.types,
dpglib.types;
type
TLookahead = class( TInterfacedObject, ILookahead)
protected
// ------------------------------------------------------------
// Actual 'bitset' of the lookahead
// ------------------------------------------------------------
fLaSet : TByteSet;
// ------------------------------------------------------------
// What 'k' values were being computed when end of rule hit?
// ------------------------------------------------------------
fEpsilon : TByteSet;
// ------------------------------------------------------------
// Does this lookahead depth include Epsilon token type? This
// is used to avoid having a bit in the set for Epsilon as it
// conflicts with parsing binary files.
// ------------------------------------------------------------
fHasEpsilon : boolean;
// ------------------------------------------------------------
// Is this computation part of a computation cycle?
// ------------------------------------------------------------
fCycle : AnsiString;
// ----------------------------------------------------------------------
// ILookahead
// ----------------------------------------------------------------------
protected
function GetLaSet : TByteSet;
function GetEpsilon : TByteSet;
function GetHasEpsilon : boolean;
function GetCycle : AnsiString;
procedure SetLaSet( LaSet : TByteSet);
procedure SetEpsilon( Epsilon : TByteSet);
procedure SetHasEpsilon( HasEpsilon : boolean);
procedure SetCycle( Cycle : AnsiString);
function Intersection( LA : ILookahead) : ILookahead;
procedure CombineWith( LA : ILookahead); overload;
procedure CombineWith( LA : TByteSet); overload;
function IsNil : boolean;
function Clone : ILookahead;
function AsString( pTM: ITokenManager=nil) : AnsiString;
// ----------------------------------------------------------------------
// Construction/destruction
// ----------------------------------------------------------------------
public
constructor Create; overload;
constructor Create( La : ILookahead); overload;
constructor Create( LaSet : TByteSet); overload;
constructor Create( Int : integer); overload;
constructor Create( Cycle : AnsiString); overload;
end;
TLookaheadArray = array of ILookahead;
var
nullLookahead : ILookahead;
implementation
uses
System.SysUtils,
dpglib.utils;
// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Construction/destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Constructor
// ================================================================================================
constructor TLookahead.Create;
begin
inherited;
fLaSet := [];
fEpsilon := [];
fHasEpsilon := false;
fCycle := '';
end;
// ================================================================================================
// Constructor(ILookahead)
// ================================================================================================
constructor TLookahead.Create( La: ILookahead);
begin
inherited Create;
fLaSet := La.LaSet;
fEpsilon := La.Epsilon;
fHasEpsilon := La.HasEpsilon;
fCycle := La.Cycle;
end;
// ================================================================================================
// Constructor(TByteSet)
// ================================================================================================
constructor TLookahead.Create( LaSet: TByteSet);
begin
inherited Create;
fLaSet := LaSet;
fEpsilon := [];
fHasEpsilon := false;
fCycle := '';
end;
// ================================================================================================
// Constructor(integer)
// ================================================================================================
constructor TLookahead.Create( Int: integer);
begin
inherited Create;
fLaSet := [Int];
fEpsilon := [];
fHasEpsilon := false;
fCycle := '';
end;
// ================================================================================================
// Constructor(string)
// ================================================================================================
constructor TLookahead.Create( Cycle: AnsiString);
begin
inherited Create;
fLaSet := [];
fEpsilon := [];
fHasEpsilon := false;
fCycle := Cycle;
end;
// @@@: ILookahead implementation +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// ILookahead implementation
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Get LaSet
// ================================================================================================
function TLookahead.GetLaSet: TByteSet;
begin
result := fLaSet;
end;
// ================================================================================================
// Get Epsilon
// ================================================================================================
function TLookahead.GetEpsilon: TByteSet;
begin
result := fEpsilon;
end;
// ================================================================================================
// Get HasEpsilon
// ================================================================================================
function TLookahead.GetHasEpsilon: boolean;
begin
result := fHasEpsilon;
end;
// ================================================================================================
// Get Cycle
// ================================================================================================
function TLookahead.GetCycle: AnsiString;
begin
result := fCycle;
end;
// ================================================================================================
// Set LaSet
// ================================================================================================
procedure TLookahead.SetLaSet( LaSet: TByteSet);
begin
fLaSet := LaSet
end;
// ================================================================================================
// Set Epsilon
// ================================================================================================
procedure TLookahead.SetEpsilon( Epsilon: TByteSet);
begin
fEpsilon := Epsilon
end;
// ================================================================================================
// Set HasEpsilon
// ================================================================================================
procedure TLookahead.SetHasEpsilon( HasEpsilon: boolean);
begin
fHasEpsilon := HasEpsilon
end;
// ================================================================================================
// Set Cycle
// ================================================================================================
procedure TLookahead.SetCycle( Cycle: AnsiString);
begin
fCycle := Cycle
end;
// ================================================================================================
// Intersection
//
// What is the intersection of two lookahead depths?
// Only the Epsilon "bit" and bitset are considered.
// ================================================================================================
function TLookahead.Intersection( LA: ILookahead) : ILookahead;
begin
result := TLookahead.Create;
result.LaSet := fLaSet * LA.LaSet;
if fHasEpsilon and LA.HasEpsilon then
result.HasEpsilon := true;
end;
// ================================================================================================
// CombineWith(ILookahead)
// ================================================================================================
procedure TLookahead.CombineWith( LA: ILookahead);
begin
if fCycle = '' then fCycle := LA.Cycle;
fHasEpsilon := fHasEpsilon or LA.HasEpsilon;
fLaSet := fLaSet + LA.LaSet;
fEpsilon := fEpsilon + LA.Epsilon;
end;
// ================================================================================================
// CombineWith(TByteSet)
// ================================================================================================
procedure TLookahead.CombineWith( LA: TByteSet);
begin
fLaSet := fLaSet + LA;
end;
// ================================================================================================
// IsNil
// ================================================================================================
function TLookahead.IsNil: boolean;
begin
result := (fLaSet = []) and not fHasEpsilon;
end;
// ================================================================================================
// Clone
// ================================================================================================
function TLookahead.Clone: ILookahead;
begin
result := TLookahead.Create( self);
end;
// ================================================================================================
// AsString
// ================================================================================================
function TLookahead.AsString( pTM: ITokenManager): AnsiString;
var
depths: AnsiString;
i : integer;
begin
if pTM = nil then
result := CharSetToStr( fLaSet)
else
result := TokenSetToStr( fLaSet, pTM);
if fHasEpsilon = true then
result := result + '+ <epsilon>';
if fCycle <> '' then
result := result + '; FOLLOW( ' + fCycle + ')';
if fEpsilon <> [] then
begin
depths := '';
for i:=0 to 255 do
begin
if (fEpsilon * [i]) <> [] then
begin
if depths <> '' then
depths := depths + ',';
depths := depths + AnsiString(IntToStr( i));
end;
end;
result := result + '; depths=' + depths;
end;
end;
initialization
nullLookahead := TLookahead.Create;
nullLookahead.HasEpsilon := true;
finalization
nullLookahead := nil;
end.
src.lib/dpglib.Messages.pas
+67
View File
@@ -0,0 +1,67 @@
unit dpglib.Messages;
interface
resourcestring
MSG_W_RULEACCEPTSNOARGS = 'Rule "%s" accepts no arguments.';
MSG_W_RULEHASNORETURN = 'Rule "%s" has no return value.';
MSG_W_RULEHASRETURN = 'Rule "%s" returns a value.';
MSG_W_OPTIONALPATH = 'Optional path found in NextToken.';
MSG_W_SYNTSUPERFLUOUS = 'Syntactic predicate superfluous for single alternative.';
MSG_W_SYNTIGNORED = 'Syntactic predicate ignored for single alternative.';
MSG_E_RULENOTDEFINED = 'Rule "%s" is not defined.';
MSG_E_LEXRULENOTDEFINED = 'Lexer rule "%s" is not defined.';
MSG_E_NOFILTERRULE = 'Filter rule "%s" does not exist in this lexer.';
MSG_W_ILLEGALOPTION = 'Illegal option "%s".';
MSG_W_ILLEGALRULEOPTION = 'Illegal rule option "%s".';
MSG_W_ILLEGALDEMOOPTION = 'Option "%s" is invalid in demo version.';
MSG_W_CANTIMPORT = 'Cannot import "%s".';
// behaviour
MSG_W_TOKENSREDEF = 'Redefinition of literal in tokens {...} "%s".';
MSG_E_RULEREDEF = 'Redefinition of rule "%s".';
// grammar maker
MSG_E_INVSTRINGLITERAL = 'Invalid string literal %s';
MSG_W_LEXPUBLICRETURN = 'Public lexical rules cannot specify return type.';
MSG_E_ABORTGRAMMAR = 'Aborting grammar "%s" do to errors.';
MSG_E_LEXNOTINLEXER = 'Lexical rule "%s" defined outside of lexer.';
MSG_E_LEXCAPITAL = 'Lexical rule names must begin with captal letter. "%s" is not.';
MSG_E_NONINVSUBRULE = 'This subrule cannot be inverted.';
MSG_E_NONINVN2M = '"~" cannot be applied to (...)@ subrule.';
MSG_E_NONINVOOM = '"~" cannot be applied to (...)+ subrule.';
MSG_E_NONINVZOO = '"~" cannot be applied to (...)? subrule.';
MSG_E_NONINVZOM = '"~" cannot be applied to (...)* subrule.';
MSG_E_NONINVSYNTPRED = '"~" cannot be applied to syntactic predicate.';
MSG_E_CHARINPARSER = 'Character literal only valid in lexer.';
MSG_E_CHARRANGEINPARSER = 'Character range only valid in lexer.';
MSG_E_MALFORMEDRANGE = 'Malformed range.';
MSG_E_ILLEGALTOKENSOPT = 'Invalid tokens {...} element option: "%s".';
MSG_E_NOTOKENSTOKEN = 'Cannot find "%s" in tokens {...}.';
MSG_E_ILLEGALELEMOPT = 'Cannot use element option "%s" for this kind of element.';
MSG_E_PARSERRULEINLEXER = 'Parser rule "%s"refenced in lexer.';
MSG_E_ASTINLEXER = 'AST specification "^" not allowed in lexer.';
MSG_E_INVTOKENINLEXER = '~TOKEN is not allowed in lexer.';
MSG_E_INVTOKENREFINLEXER= 'Assignment from token reference only allowed in lexer.';
MSG_E_INVTOKENPARAMLEXER= 'Token reference arguments only allowed in lexer.';
MSG_E_TOKENRANGEINLEXER = 'Token range not allowed in lexer.';
// analyzer
MSG_W_INVNONGREEDY = 'Being nongreedy only makes sense for (...)+ and (...)*';
MSG_W_INVEMPTYALT = 'Empty alternative makes no sense in (...)* or (...)+';
MSG_E_INFRECURSION = 'Infinite recursion to rule "%s" from rule "%s".';
// altblock
MSG_E_INVRULEINSYNPRED = 'Rule "%s" referenced in (...)=>, but not defined.';
MSG_E_PROTECTEDFILTER = 'Filter rule "%s" must be protected.';
MSG_E_CHARLITINNONLEXER = 'Cannot reference character literals in non-lexer grammar: "%s".';
implementation
end.
src.lib/dpglib.NMBlock.pas
+138
View File
@@ -0,0 +1,138 @@
unit dpglib.NMBlock;
interface
uses
dpgrtl.types,
dpglib.types,
dpglib.BlockWithImpliedExitPath;
type
// =========================================================================
// Class TOneOrMoreBlock declaration
// =========================================================================
TNMBlock = class( TBlockWithImpliedExitPath,
INMBlock,
IBlockWithImpliedExitPath,
IAlternativeBlock,
IAlternativeElem,
IGrammarElem)
protected
fM : integer;
fN : integer;
public
procedure AfterConstruction; override;
protected
function GetLow : integer;
function GetHigh : integer;
procedure SetLow( Value: integer);
procedure SetHigh(Value: integer);
// ---------------------------------------------------------------
// IGrammarElem overrides
// ---------------------------------------------------------------
public
procedure Generate;
function Look( pK: integer): ILookahead;
function AsString : AnsiString;
end;
implementation
// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Construction/destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// AftgerConstruction
// ================================================================================================
procedure TNMBlock.AfterConstruction;
begin
fN := 0;
fM := MaxInt;
end;
// @@@: dgpGrammarElem overrides ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// dgpGrammarElem overrides
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Generate
// ================================================================================================
procedure TNMBlock.Generate;
begin
fGrammar.Generator.Gen( self);
end;
// ================================================================================================
// Look
// ================================================================================================
function TNMBlock.Look(pK: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look( pK, self);
end;
// ================================================================================================
// ToString
// ================================================================================================
function TNMBlock.AsString: AnsiString;
begin
result := inherited AsString + '@';
end;
// @@@: Property handlers +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Property handlers
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// GetLow
// ================================================================================================
function TNMBlock.GetLow : integer;
begin
result := fN;
end;
// ================================================================================================
// GetHigh
// ================================================================================================
function TNMBlock.GetHigh : integer;
begin
result := fM
end;
// ================================================================================================
// SetLow
// ================================================================================================
procedure TNMBlock.SetLow( Value: integer);
begin
fN := Value;
end;
// ================================================================================================
// SetHigh
// ================================================================================================
procedure TNMBlock.SetHigh(Value: integer);
begin
fM := Value;
end;
end.
src.lib/dpglib.OneOrMoreBlock.pas
+58
View File
@@ -0,0 +1,58 @@
unit dpglib.OneOrMoreBlock;
interface
uses
dpgrtl.types,
dpglib.types,
dpglib.BlockWithImpliedExitPath;
type
// =========================================================================
// Class TOneOrMoreBlock declaration
// =========================================================================
TOneOrMoreBlock = class( TBlockWithImpliedExitPath,
IOneOrMoreBlock,
IBlockWithImpliedExitPath,
IAlternativeBlock,
IAlternativeElem,
IGrammarElem)
// ----------------------------------------------------------------------
// IGrammarElem overrides
// ----------------------------------------------------------------------
public
procedure Generate;
function Look( pK: integer): ILookahead;
function AsString : AnsiString;
end;
implementation
// ****************************************************************************
// IGrammarElem overrides
// ****************************************************************************
// ============================================================================
// Generate
// ============================================================================
procedure TOneOrMoreBlock.Generate;
begin
fGrammar.Generator.Gen( self);
end;
// ============================================================================
// Look
// ============================================================================
function TOneOrMoreBlock.Look(pK: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look( pK, self);
end;
// ============================================================================
// ToString
// ============================================================================
function TOneOrMoreBlock.AsString: AnsiString;
begin
result := inherited AsString + '+';
end;
end.
src.lib/dpglib.ParserGrammar.pas
+109
View File
@@ -0,0 +1,109 @@
unit dpglib.ParserGrammar;
interface
uses
System.Classes,
System.Contnrs,
dpgrtl.types,
dpglib.Types,
dpglib.Grammar;
type
// =========================================================================
// Class TParserGrammar
// =========================================================================
TParserGrammar = class( TGrammar,
IGrammar,
IParserGrammar)
private
fBuildAST : boolean;
protected
function GetBuildAST: boolean;
procedure SetBuildAST( Value: boolean);
function SetOption( Option: IToken; Value: IToken): boolean;
public
// ------------------------------------------------------------
// Constructor/destructor
// ------------------------------------------------------------
constructor Create( pObjectName : IToken;
pTool : ITool;
pSuperName : IToken);
end;
implementation
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ----------------------------------------------------------------------------
// Constructor
// ----------------------------------------------------------------------------
constructor TParserGrammar.Create( pObjectName : IToken;
pTool : ITool;
pSuperName : IToken);
begin
inherited;
fBuildAST := false
end;
// @@@: IGrammar ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// IGrammar
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Get BuildAST
// ================================================================================================
function TParserGrammar.GetBuildAST: boolean;
begin
result := fBuildAST
end;
// ================================================================================================
// Set BuildAST
// ================================================================================================
procedure TParserGrammar.SetBuildAST(Value: boolean);
begin
fBuildAST := Value
end;
// ================================================================================================
// Set Option
// ================================================================================================
function TParserGrammar.SetOption(Option, Value: IToken): boolean;
begin
result := true;
// ---------------------------------------------------------------
// Option: buildAST
// ---------------------------------------------------------------
if Option.TokenText = 'buildAST' then
begin
if Value.TokenText = 'true' then
fBuildAST := true
else if Value.TokenText = 'false' then
fBuildAST := false
else begin
fTool.Error('Value for "buildAST" must be true or false.',
fGrammarFile,
Value.TokenLine,
Value.TokenColumn);
result := false
end
end
else
result := inherited SetOption(Option, Value);
end;
end.
src.lib/dpglib.PrettyPrinter.pas
+328
View File
@@ -0,0 +1,328 @@
unit dpglib.PrettyPrinter;
interface
uses
System.Classes,
System.SysUtils,
dpgrtl.types,
dpglib.Utils,
dpglib.Types,
dpglib.CodeGenerator,
dpglib.DelphiCharFormatter,
dpglib.DelphiBlockFinishingInfo;
type
TPrettyPrinter = class( TCodeGenerator)
protected
fIsLexer : boolean;
fIsParser : boolean;
fIsTreeWalker : boolean;
fLexerGrammar : ILexerGrammar;
fParserGrammar : IParserGrammar;
fTreeWalkerGrammar: ITreeWalkerGrammar;
protected
procedure genGrammar;
procedure genUses;
procedure genClassDecl;
procedure genClassOptions;
procedure genClassTokens;
procedure genClassMemberDecl;
procedure genClassRules;
procedure genClassMemberDef;
procedure genRuleOptions( blk: IRuleBlock);
procedure genRuleLocals( blk: IRuleBlock);
procedure genRuleInit( blk: IRuleBlock);
procedure genRuleBlock( blk: IRuleBlock);
public
destructor Destroy; override;
public
procedure gen( pGrammar: IGrammar);
end;
implementation
// ============================================================================
// Destructor
// ============================================================================
destructor TPrettyPrinter.Destroy;
begin
fLexerGrammar := nil;
fParserGrammar := nil;
fTreeWalkerGrammar := nil;
inherited;
end;
// ============================================================================
// gen
// ============================================================================
procedure TPrettyPrinter.gen(pGrammar: IGrammar);
begin
if pGrammar <> nil then
begin
fIsLexer := false;
fIsParser := false;
fIsTreeWalker := false;
pGrammar.QueryInterface( ILexerGrammar, fLexerGrammar);
pGrammar.QueryInterface( IParserGrammar, fParserGrammar);
pGrammar.QueryInterface( ITreeWalkerGrammar, fTreeWalkerGrammar);
if fLexerGrammar <> nil then fIsLexer := true;
if fParserGrammar <> nil then fIsParser := true;
if fTreeWalkerGrammar <> nil then fIsTreeWalker := true;
fGrammar := pGrammar;
genGrammar;
end;
end;
// ============================================================================
// genGrammar
// ============================================================================
procedure TPrettyPrinter.genGrammar;
begin
// ---------------------------------------------------------------
// Calculate the output file name, and open it.
// ---------------------------------------------------------------
fFile := fOutDir + fGrammar.UnitName + '.pg';
fOutput := TFileStream.Create( fFile, fmCreate);
// ---------------------------------------------------------------
// Generate red tape
// ---------------------------------------------------------------
println('// ----------------------------------------------------------------------------');
println('// This is a generated file. Do not modify it by hand!');
println('// ----------------------------------------------------------------------------');
println('unit ' + fGrammar.UnitName + ';');
println('');
genUses;
genClassDecl;
fOutput.Free;
end;
// ============================================================================
// genUses
// ============================================================================
procedure TPrettyPrinter.genUses;
var
i: integer;
begin
if fGrammar.UsesList.Count > 0 then
begin
println('uses');
println('{');
INC(fTabs);
for i:=0 to fGrammar.UsesList.Count -1 do
println(fGrammar.UsesList.Strings[i] + ';');
DEC(fTabs);
println('}');
println('');
end;
end;
// ============================================================================
// genClassDecl
// ============================================================================
procedure TPrettyPrinter.genClassDecl;
begin
// ---------------------------------------------------------------
// print class header
// ---------------------------------------------------------------
if fIsLexer then print('lexer ');
if fIsParser then print('parser ');
if fIsTreeWalker then print('treewalker ');
// ---------------------------------------------------------------
// print class name
// ---------------------------------------------------------------
_print( fGrammar.GetClassName);
// ---------------------------------------------------------------
// print superclass (later)
// ---------------------------------------------------------------
// ---------------------------------------------------------------
// Close class header
// ---------------------------------------------------------------
_println(';');
// ---------------------------------------------------------------
// Generate the rest
// ---------------------------------------------------------------
genClassOptions;
genClassTokens;
genClassMemberDecl;
genClassRules;
genClassMemberDef;
end;
// ============================================================================
// genClassOptions
// ============================================================================
procedure TPrettyPrinter.genClassOptions;
begin
println('options');
println('{');
println('}');
println('');
end;
// ============================================================================
// genClassTokens
// ============================================================================
procedure TPrettyPrinter.genClassTokens;
begin
println('tokens');
println('{');
println('}');
println('');
end;
// ============================================================================
// genClassMemberDecl
// ============================================================================
procedure TPrettyPrinter.genClassMemberDecl;
begin
println('memberdecl');
println('{');
println('}');
println('');
end;
// ============================================================================
// genClassMemberDef
// ============================================================================
procedure TPrettyPrinter.genClassMemberDef;
begin
println('memberdef');
println('{');
println('}');
println('');
end;
// ============================================================================
// genClassRules
// ============================================================================
procedure TPrettyPrinter.genClassRules;
var
i : integer;
rs : IRuleSymbol;
rb : IRuleBlock;
begin
for i:=0 to fGrammar.Rules.Count -1 do
begin
rs := fGrammar.Rules[i] as IRuleSymbol;
rb := rs.Block;
if (rb = nil) or (rs.ID = 'mNextToken') then
continue;
println('// ============================================================================');
println('// ' + rb.RuleName);
println('// ============================================================================');
// ------------------------------------------------------------
// Print rule scope.
// ------------------------------------------------------------
if rs.Access = 'public' then print('public ')
else if rs.Access = 'protected' then print('protected ')
else if rs.Access = 'private' then print('private ')
else print(' INVALID SCOPE ');
// ------------------------------------------------------------
// Print rule ID.
// ------------------------------------------------------------
_print( rb.RuleName);
// ------------------------------------------------------------
// Print rule arguments
// ------------------------------------------------------------
if rb.Arguments <> '' then
_print(' ' + rb.Arguments);
// ------------------------------------------------------------
// Print rule returns
// ------------------------------------------------------------
if rb.ReturnAction <> '' then
_print(' returns ' + rb.ReturnAction);
_println(';');
// ------------------------------------------------------------
// print rule things
// ------------------------------------------------------------
genRuleOptions(rb);
genRuleLocals(rb);
genRuleInit(rb);
INC(fTabs);
println(':');
INC(fTabs);
genRuleBlock(rb);
DEC(fTabs);
println(';');
DEC(fTabs);
println('');
end;
end;
// ============================================================================
// genRuleOptions
// ============================================================================
procedure TPrettyPrinter.genRuleOptions(blk: IRuleBlock);
begin
println('options');
println('{');
println('}');
println('');
end;
// ============================================================================
// genRuleLocals
// ============================================================================
procedure TPrettyPrinter.genRuleLocals(blk: IRuleBlock);
begin
println('locals');
println('{');
println('}');
println('');
end;
// ============================================================================
// genRuleInit
// ============================================================================
procedure TPrettyPrinter.genRuleInit(blk: IRuleBlock);
begin
println('{');
println('}');
end;
// ============================================================================
// genRuleBlock
// ============================================================================
procedure TPrettyPrinter.genRuleBlock(blk: IRuleBlock);
begin
end;
end.
src.lib/dpglib.RuleBlock.pas
+621
View File
@@ -0,0 +1,621 @@
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.
src.lib/dpglib.RuleEndElem.pas
+144
View File
@@ -0,0 +1,144 @@
unit dpglib.RuleEndElem;
interface
uses
dpgrtl.types,
dpglib.types,
dpglib.Lookahead,
dpglib.BlockEndElem;
type
// =========================================================================
// Class TRuleEndElem declaration
// =========================================================================
TRuleEndElem = class( TBlockEndElem,
IRuleEndElem,
IBlockEndElem,
IAlternativeElem,
IGrammarElem)
// ---------------------------------------------------------------
// Members
// ---------------------------------------------------------------
protected
fCache : array of ILookahead;
fNoFOLLOW : boolean;
// ---------------------------------------------------------------
// Constructor/destructor
// ---------------------------------------------------------------
public
constructor Create( pGrammar: IGrammar);
destructor Destroy; override;
// ---------------------------------------------------------------
// Constructor/destructor
// ---------------------------------------------------------------
public
procedure Generate;
function Look( pK: integer): ILookahead;
function AsString : AnsiString;
// ---------------------------------------------------------------
// IRuleEndElem methods
// ---------------------------------------------------------------
protected
function GetnoFOLLOW: boolean;
function GetCache(i: integer): ILookahead;
procedure SetnoFOLLOW( pnoFOLLOW: boolean);
procedure SetCache(i:integer; pCache : ILookahead);
end;
implementation
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TRuleEndElem.Create(pGrammar: IGrammar);
begin
inherited Create( pGrammar);
SetLength( fCache, fGrammar.MaxK +1);
end;
// ============================================================================
// Destructor
// ============================================================================
destructor TRuleEndElem.Destroy;
var
i: integer;
begin
for i:=Low(fCache) to High(fCache) do
fCache[i] := nil;
fCache := nil;
inherited;
end;
// ****************************************************************************
// IGrammarElem overrides
// ****************************************************************************
// ============================================================================
// Generate
// ============================================================================
procedure TRuleEndElem.Generate;
begin
fGrammar.Generator.Gen(self);
end;
// ============================================================================
// Look
// ============================================================================
function TRuleEndElem.Look(pK: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look( pK, self);
end;
// ============================================================================
// AsString
// ============================================================================
function TRuleEndElem.AsString: AnsiString;
begin
result := ' [RuleEnd]';
end;
// ****************************************************************************
// IRuleEndElem implementation
// ****************************************************************************
// ============================================================================
// GetnoFOLLOW
// ============================================================================
function TRuleEndElem.GetnoFOLLOW: boolean;
begin
result := fNoFOLLOW;
end;
// ============================================================================
// GetCache
// ============================================================================
function TRuleEndElem.GetCache(i: integer): ILookahead;
begin
result := fCache[i];
end;
// ============================================================================
// SetnoFOLLOW
// ============================================================================
procedure TRuleEndElem.SetnoFOLLOW(pnoFOLLOW: boolean);
begin
fNoFOLLOW := pnoFOLLOW;
end;
// ============================================================================
// SetCache
// ============================================================================
procedure TRuleEndElem.SetCache(i: integer; pCache: ILookahead);
begin
fCache[i] := pCache;
end;
end.
src.lib/dpglib.RuleRefElem.pas
+189
View File
@@ -0,0 +1,189 @@
unit dpglib.RuleRefElem;
interface
uses
dpgrtl.types,
dpglib.Types,
dpglib.AlternativeElem;
type
// =========================================================================
// TRuleRefElem class declaration
// =========================================================================
TRuleRefElem = class( TAlternativeElem,
IRuleRefElem,
IAlternativeElem,
IGrammarElem)
// ---------------------------------------------------------------
// Members
// ---------------------------------------------------------------
protected
fTargetRule : AnsiString;
fIdAssign : AnsiString;
fArgs : AnsiString;
fLabel : AnsiString;
// ---------------------------------------------------------------
// Constructor/destructor
// ---------------------------------------------------------------
public
constructor Create( pGrammar : IGrammar;
pToken : IToken;
pAutoGenType: integer);
// ---------------------------------------------------------------
// IGrammarElem overrides
// ---------------------------------------------------------------
public
procedure Generate;
function Look( pK: integer): ILookahead;
function AsString : AnsiString;
// ---------------------------------------------------------------
// IAlternativeElem overrides
// ---------------------------------------------------------------
protected
function GetLabel : AnsiString;
procedure SetLabel( pLabel: AnsiString);
// ---------------------------------------------------------------
// IRuleRefElem methods
// ---------------------------------------------------------------
protected
function GetTargetRule : AnsiString;
function GetIdAssign : AnsiString;
function GetArgs : AnsiString;
procedure SetTargetRule( pTargetRule : AnsiString);
procedure SetIdAssign( pIdAssign : AnsiString);
procedure SetArgs( pArgs : AnsiString);
end;
implementation
uses
dpglib.CodeGenerator,
dpglib.DpgParserTokens;
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TRuleRefElem.Create( pGrammar : IGrammar;
pToken : IToken;
pAutoGenType: integer);
begin
inherited Create( pGrammar, pToken, pAutoGenType);
fTargetRule := pToken.TokenText;
if pToken.TokenType = TT_TOKENREF then
fTargetRule := TCodeGenerator.encodeLexerRuleName( pToken.TokenText)
else
fTargetRule := pToken.TokenText;
end;
// ****************************************************************************
// IGrammarElem overrides
// ****************************************************************************
// ============================================================================
// Generate
// ============================================================================
procedure TRuleRefElem.Generate;
begin
fGrammar.Generator.Gen(self);
end;
// ============================================================================
// Look
// ============================================================================
function TRuleRefElem.Look(pK: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look( pK, self);
end;
// ============================================================================
// AsString
// ============================================================================
function TRuleRefElem.AsString: AnsiString;
begin
if fArgs <> '' then
result := ' ' + fTargetRule + fArgs
else
result := ' ' + fTargetRule;
end;
// ****************************************************************************
// IAlternativeElem overrides
// ****************************************************************************
// ============================================================================
// GetLabel
// ============================================================================
function TRuleRefElem.GetLabel: AnsiString;
begin
result := fLabel;
end;
// ============================================================================
// SetLabel
// ============================================================================
procedure TRuleRefElem.SetLabel(pLabel: AnsiString);
begin
fLabel := pLabel;
end;
// ****************************************************************************
// IRuleRefElem implementation
// ****************************************************************************
// ============================================================================
// GetTargetRule
// ============================================================================
function TRuleRefElem.GetTargetRule: AnsiString;
begin
result := fTargetRule;
end;
// ============================================================================
// GetIdAssign
// ============================================================================
function TRuleRefElem.GetIdAssign: AnsiString;
begin
result := fIdAssign;
end;
// ============================================================================
// GetArgs
// ============================================================================
function TRuleRefElem.GetArgs: AnsiString;
begin
result := fArgs;
end;
// ============================================================================
// SetTargetRule
// ============================================================================
procedure TRuleRefElem.SetTargetRule(pTargetRule: AnsiString);
begin
fTargetRule := pTargetRule;
end;
// ============================================================================
// SetIdAssign
// ============================================================================
procedure TRuleRefElem.SetIdAssign(pIdAssign: AnsiString);
begin
fIdAssign := pIdAssign;
end;
// ============================================================================
// SetArgs
// ============================================================================
procedure TRuleRefElem.SetArgs(pArgs: AnsiString);
begin
fArgs := pArgs;
end;
end.
src.lib/dpglib.RuleSymbol.pas
+184
View File
@@ -0,0 +1,184 @@
unit dpglib.RuleSymbol;
interface
uses
System.Classes,
dpgrtl.types,
dpglib.types,
dpglib.GrammarSymbol;
type
TRuleSymbol = class( TGrammarSymbol, IRuleSymbol, IGrammarSymbol)
protected
fBlock : IRuleBlock;
fDefined : boolean;
fReferences : TInterfaceList;
fAccess : AnsiString;
fComment : AnsiString;
// ----------------------------------------------------------------------
// IRuleSymbol
// ----------------------------------------------------------------------
protected
function GetBlock : IRuleBlock;
function GetDefined : boolean;
function GetReferences : TInterfaceList;
function GetAccess : AnsiString;
function GetComment : AnsiString;
function GetReference(i: integer): IRuleRefElem;
procedure SetBlock( pBlock : IRuleBlock);
procedure SetDefined( pDefined : boolean);
procedure SetAccess( pAccess : AnsiString);
procedure SetComment( pComment : AnsiString);
procedure AddReference( pRef: IRuleRefElem);
function ReferenceCount: integer;
// ----------------------------------------------------------------------
// Construction/destruction
// ----------------------------------------------------------------------
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
end;
implementation
uses
System.SysUtils;
// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Construction/destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// After Construction
// ================================================================================================
procedure TRuleSymbol.AfterConstruction;
begin
inherited;
fReferences := TInterfaceList.Create;
end;
// ================================================================================================
// Before Destruction
// ================================================================================================
procedure TRuleSymbol.BeforeDestruction;
begin
FreeAndNil( fReferences);
inherited
end;
// @@@: IGrammarSymbol implementation +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// IGrammarSymbol implementation
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Get Block
// ================================================================================================
function TRuleSymbol.GetBlock: IRuleBlock;
begin
result := fBlock;
end;
// ================================================================================================
// Get Defined
// ================================================================================================
function TRuleSymbol.GetDefined: boolean;
begin
result := fDefined;
end;
// ================================================================================================
// Get References
// ================================================================================================
function TRuleSymbol.GetReferences: TInterfaceList;
begin
result := fReferences;
end;
// ================================================================================================
// Get Reference
// ================================================================================================
function TRuleSymbol.GetReference(i: integer): IRuleRefElem;
begin
if (i>=0) and (i<fReferences.Count) then
fReferences.Items[i].QueryInterface( IRuleRefElem, result);
end;
// ================================================================================================
// Get Access
// ================================================================================================
function TRuleSymbol.GetAccess: AnsiString;
begin
result := fAccess;
end;
// ================================================================================================
// Get Comment
// ================================================================================================
function TRuleSymbol.GetComment: AnsiString;
begin
result := fComment;
end;
// ================================================================================================
// Set Block
// ================================================================================================
procedure TRuleSymbol.SetBlock(pBlock: IRuleBlock);
begin
fBlock := pBlock;
end;
// ================================================================================================
// Set Defined
// ================================================================================================
procedure TRuleSymbol.SetDefined(pDefined: boolean);
begin
fDefined := pDefined;
end;
// ================================================================================================
// Set Access
// ================================================================================================
procedure TRuleSymbol.SetAccess(pAccess: AnsiString);
begin
fAccess := pAccess;
end;
// ================================================================================================
// Set Comment
// ================================================================================================
procedure TRuleSymbol.SetComment(pComment: AnsiString);
begin
fComment := pComment;
end;
// ================================================================================================
// Add Reference
// ================================================================================================
procedure TRuleSymbol.AddReference(pRef: IRuleRefElem);
begin
fReferences.Add( pRef);
end;
// ================================================================================================
// Reference Count
// ================================================================================================
function TRuleSymbol.ReferenceCount: integer;
begin
result := fReferences.Count;
end;
end.
src.lib/dpglib.StringLiteralElem.pas
+120
View File
@@ -0,0 +1,120 @@
unit dpglib.StringLiteralElem;
interface
uses
dpgrtl.types,
dpglib.types,
dpglib.GrammarAtom;
type
// =========================================================================
// Class TStringLiteralElem declaration
// =========================================================================
TStringLiteralElem = class(TGrammarAtom,
IStringLiteralElem,
IGrammarAtom,
IAlternativeElem,
IGrammarElem)
// ---------------------------------------------------------------
// Members
// ---------------------------------------------------------------
protected
fProcessedAtomText : AnsiString;
// ---------------------------------------------------------------
// Constructor/destructor
// ---------------------------------------------------------------
public
constructor Create( pGrammar : IGrammar;
pToken : IToken;
pAutoGenType: integer);
// ---------------------------------------------------------------
// IGrammarElem overrides
// ---------------------------------------------------------------
public
procedure Generate;
function Look( pK: integer): ILookahead;
// ---------------------------------------------------------------
// IStringLiteralElem methods
// ---------------------------------------------------------------
protected
function GetProcessedAtomText: AnsiString;
end;
implementation
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TStringLiteralElem.Create( pGrammar : IGrammar;
pToken : IToken;
pAutoGenType: integer);
var
lg: ILexerGrammar;
ts: ITokenSymbol;
begin
inherited Create( pGrammar, pToken, pAutoGenType);
// ---------------------------------------------------------------
// Lexer does not have token types for AnsiString literals
// ---------------------------------------------------------------
if pGrammar.QueryInterface( ILexerGrammar, lg) <> S_OK then
begin
ts := fGrammar.TokenManager.TokenSymbol[ fAtomText];
if ts = nil then
fGrammar.Tool.Error( 'Undefined literal: ' + String(fAtomText),
fGrammar.GrammarFile,
pToken.TokenLine,
pToken.TokenColumn)
else
fTokenType := ts.TokenType;
end;
// ---------------------------------------------------------------
// Process the AnsiString literal text by removing quotes and escaping
// characters. If a lexical grammar, add the characters to the
// char vocabulary.
// (Later if I really need it....)
// ---------------------------------------------------------------
fProcessedAtomText := Copy(fAtomText,2,Length(fAtomText)-2);
end;
// ****************************************************************************
// IGrammarElem overrides
// ****************************************************************************
// ============================================================================
// Generate
// ============================================================================
procedure TStringLiteralElem.Generate;
begin
fGrammar.Generator.Gen( self);
end;
// ============================================================================
// Look
// ============================================================================
function TStringLiteralElem.Look(pK: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look(pK, self);
end;
// ****************************************************************************
// IStringLiteralElem implementation
// ****************************************************************************
// ============================================================================
// GetProcessedAtomText
// ============================================================================
function TStringLiteralElem.GetProcessedAtomText: AnsiString;
begin
result := fProcessedAtomText;
end;
end.
src.lib/dpglib.StringSymbol.pas
+75
View File
@@ -0,0 +1,75 @@
unit dpglib.StringSymbol;
interface
uses
dpglib.types,
dpglib.TokenSymbol;
type
TStringSymbol = class( TTokenSymbol,
IStringSymbol,
ITokenSymbol,
IGrammarSymbol)
protected
fLabel: AnsiString;
// ----------------------------------------------------------------------
// IGrammarSymbol
// ----------------------------------------------------------------------
protected
function Clone: ITokenSymbol;
// ----------------------------------------------------------------------
// IStringSymbol
// ----------------------------------------------------------------------
protected
function GetLabel: AnsiString;
procedure SetLabel( pLabel: AnsiString);
end;
implementation
// @@@: IStringSymbol implementation ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// IStringSymbol implementation
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Get Label
// ================================================================================================
function TStringSymbol.GetLabel: AnsiString;
begin
result := fLabel;
end;
// ================================================================================================
// Set Label
// ================================================================================================
procedure TStringSymbol.SetLabel(pLabel: AnsiString);
begin
fLabel := pLabel;
end;
// ================================================================================================
// Clone
// ================================================================================================
function TStringSymbol.Clone: ITokenSymbol;
var
ss: TStringSymbol;
begin
ss := TStringSymbol.Create( fID);
ss.fTokenType := fTokenType;
ss.fParaphrase := fParaphrase;
ss.fASTNodeType := fASTNodeType;
ss.fLabel := fLabel;
result := ss;
end;
end.
src.lib/dpglib.SynPredBlock.pas
+60
View File
@@ -0,0 +1,60 @@
unit dpglib.SynPredBlock;
interface
uses
dpgrtl.types,
dpglib.types,
dpglib.AlternativeBlock;
type
// =========================================================================
// Class TSynPredBlock declaration
// =========================================================================
TSynPredBlock = class( TAlternativeBlock,
ISynPredBlock,
IAlternativeBlock,
IAlternativeElem,
IGrammarElem)
// ---------------------------------------------------------------
// IGrammarElem overrides
// ---------------------------------------------------------------
public
procedure Generate;
function Look( pK: integer): ILookahead;
function AsString : AnsiString;
end;
implementation
uses
dpglib.lookahead;
// ****************************************************************************
// IGrammarElem overrides
// ****************************************************************************
// ----------------------------------------------------------------------------
// Generate
// ----------------------------------------------------------------------------
procedure TSynPredBlock.Generate;
begin
fGrammar.Generator.Gen( self);
end;
// ----------------------------------------------------------------------------
// Look
// ----------------------------------------------------------------------------
function TSynPredBlock.Look(pK: integer): ILookahead;
begin
result := TLookahead.Create;
// result := fGrammar.LLkAnalyzer.Look( pK, self);
end;
// ----------------------------------------------------------------------------
// ToString
// ----------------------------------------------------------------------------
function TSynPredBlock.AsString: AnsiString;
begin
result := inherited AsString + '=>';
end;
end.
src.lib/dpglib.TokenLexer.pas
+622
View File
@@ -0,0 +1,622 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.tokenLexer.g
// ============================================================================
unit dpglib.TokenLexer;
interface
uses
Classes,
SysUtils,
dpglib.TokenLexerTokens,
dpgrtl.lexer,
dpgrtl.types;
type
// =========================================================================
// Class TTokenLexer declaration
// =========================================================================
TTokenLexer = class( TLexer)
public // Protected grammar rules
// Must callable from parser too
procedure mDIGIT ( pCreate: boolean);
procedure mXDIGIT ( pCreate: boolean);
public // Public grammar rules
procedure mLPAREN ( pCreate: boolean);
procedure mRPAREN ( pCreate: boolean);
procedure mASSIGN ( pCreate: boolean);
procedure mSTRING ( pCreate: boolean);
procedure mID ( pCreate: boolean);
procedure mINT ( pCreate: boolean);
procedure mWS ( pCreate: boolean);
procedure mSLCOMMENT ( pCreate: boolean);
procedure mMLCOMMENT ( pCreate: boolean);
public
function NextToken: IToken; override;
end;
implementation
uses
dpgrtl.exception,
dpgrtl.token;
// ============================================================================
// mLPAREN
// ============================================================================
procedure TTokenLexer.mLPAREN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_LPAREN;
match('(');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mRPAREN
// ============================================================================
procedure TTokenLexer.mRPAREN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_RPAREN;
match(')');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mASSIGN
// ============================================================================
procedure TTokenLexer.mASSIGN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_ASSIGN;
match('=');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mSTRING
// ============================================================================
procedure TTokenLexer.mSTRING( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_STRING;
match('"');
while(true) do
begin
if (( LA(1) in [#1..'!','#'..#255])) then
begin
matchNot('"');
end
else
break;
end;
match('"');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mDIGIT
// ============================================================================
procedure TTokenLexer.mDIGIT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_DIGIT;
match( ['0'..'9']);
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mXDIGIT
// ============================================================================
procedure TTokenLexer.mXDIGIT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_XDIGIT;
if (( LA(1) in ['0'..'9'])) then
begin
match( ['0'..'9']);
end
else if (( LA(1) in ['a'..'f'])) then
begin
match( ['a'..'f']);
end
else if (( LA(1) in ['A'..'F'])) then
begin
match( ['A'..'F']);
end
else
Raise EMismatchedChar.Create( LA(1), ['0'..'9','A'..'F','a'..'f'], InputState.FileName, InputState.Line, InputState.Column);
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mID
// ============================================================================
procedure TTokenLexer.mID( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_ID;
if (( LA(1) in ['a'..'z'])) then
begin
match( ['a'..'z']);
end
else if (( LA(1) in ['A'..'Z'])) then
begin
match( ['A'..'Z']);
end
else
Raise EMismatchedChar.Create( LA(1), ['A'..'Z','a'..'z'], InputState.FileName, InputState.Line, InputState.Column);
while(true) do
begin
if (( LA(1) in ['a'..'z'])) then
begin
match( ['a'..'z']);
end
else if (( LA(1) in ['A'..'Z'])) then
begin
match( ['A'..'Z']);
end
else if (( LA(1) in ['_'])) then
begin
match('_');
end
else if (( LA(1) in ['0'..'9'])) then
begin
match( ['0'..'9']);
end
else
break;
end;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mINT
// ============================================================================
procedure TTokenLexer.mINT( pCreate: boolean);
var
_begin: integer;
_cnt_15: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_INT;
_cnt_15 := 0;
while(true) do
begin
if (( LA(1) in ['0'..'9'])) then
begin
mDIGIT(false);
end
else
begin
if _cnt_15 >= 1 then
break
else
Raise EMismatchedChar.Create( LA(1), ['0'..'9'], InputState.FileName, InputState.Line, InputState.Column);
end;
INC(_cnt_15);
end;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mWS
// ============================================================================
procedure TTokenLexer.mWS( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_WS;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [' '])) then
begin
match(' ');
end
else if (( LA(1) in [#9])) then
begin
match(#9);
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else
Raise EMismatchedChar.Create( LA(1), [#9..#10,#13,' '], InputState.FileName, InputState.Line, InputState.Column);
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mSLCOMMENT
// ============================================================================
procedure TTokenLexer.mSLCOMMENT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_SLCOMMENT;
match('//');
while(true) do
begin
if (( LA(1) in [#1..#9,#11..#12,#14..#255])) then
begin
match( [#1..#9,#11..#12,#14..#255]);
end
else
break;
end;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else
Raise EMismatchedChar.Create( LA(1), [#10,#13], InputState.FileName, InputState.Line, InputState.Column);
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mMLCOMMENT
// ============================================================================
procedure TTokenLexer.mMLCOMMENT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_MLCOMMENT;
match('(*');
while(true) do
begin
// non-greedy exit test
if( LA(1) in ['*']) and (LA(2) in [')']) then
break;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else if (( LA(1) in [#1..#9,#11..#12,#14..#255])) then
begin
match( [#1..#9,#11..#12,#14..#255]);
end
else
break;
end;
match('*)');
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ----------------------------------------------------------------------------
// NextToken
// ----------------------------------------------------------------------------
function TTokenLexer.NextToken : IToken;
var
_first : TCharSet;
begin
_first := [#9..#10,#13,' ','"','('..')','/'..'9','=','A'..'Z','a'..'z'];
while( true) do
begin
ResetText;
try
if (( LA(1) in ['(']) and (LA(2) in ['*'])) then
begin
mMLCOMMENT(true);
result := ReturnToken;
end
else if (( LA(1) in ['('])) then
begin
mLPAREN(true);
result := ReturnToken;
end
else if (( LA(1) in [')'])) then
begin
mRPAREN(true);
result := ReturnToken;
end
else if (( LA(1) in ['='])) then
begin
mASSIGN(true);
result := ReturnToken;
end
else if (( LA(1) in ['"'])) then
begin
mSTRING(true);
result := ReturnToken;
end
else if (( LA(1) in ['A'..'Z','a'..'z'])) then
begin
mID(true);
result := ReturnToken;
end
else if (( LA(1) in ['0'..'9'])) then
begin
mINT(true);
result := ReturnToken;
end
else if (( LA(1) in [#9..#10,#13,' '])) then
begin
mWS(true);
result := ReturnToken;
end
else if (( LA(1) in ['/'])) then
begin
mSLCOMMENT(true);
result := ReturnToken;
end
else
begin
if LA(1) = EOF_CHAR then
begin
uponEof;
result := TToken.Create(TT_EOF);
end
else
Raise EMismatchedChar.Create(LA(1), _first, InputState.FileName, InputState.Line, InputState.Column);
end;
// --------------------------------------------------------------
// If we found a SKIP token, then try again...
// --------------------------------------------------------------
if result = nil then
continue;
// --------------------------------------------------------------
// Now we have a valid token, so exit the function
// --------------------------------------------------------------
break;
except
Raise;
end;
end;
end;
end.
src.lib/dpglib.TokenLexerTokens.pas
+26
View File
@@ -0,0 +1,26 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.tokenLexer.g
// ============================================================================
unit dpglib.TokenLexerTokens;
interface
const
TT_ID = 10;
TT_STRING = 7;
TT_EOF = 1;
TT_XDIGIT = 9;
TT_SLCOMMENT = 13;
TT_ASSIGN = 6;
TT_WS = 12;
TT_LPAREN = 4;
TT_RPAREN = 5;
TT_DIGIT = 8;
TT_MLCOMMENT = 14;
TT_INT = 11;
implementation
end.
src.lib/dpglib.TokenManager.pas
+427
View File
@@ -0,0 +1,427 @@
unit dpglib.TokenManager;
interface
uses
System.Classes,
System.Contnrs,
Generics.Collections,
dpgrtl.types,
dpglib.types,
dpglib.TokenSymbol;
type
TTokenManager = class( TInterfacedObject, ITokenManager)
protected
fName : AnsiString;
fMaxToken : byte;
fReadOnly : boolean;
fTool : ITool;
// fVocabulary : TStringList;
fVocabulary : TTokenIdMap;
fHashTable : TStringList;
protected
// ------------------------------------------------------------
// ITokenManager methods
// ------------------------------------------------------------
function GetName : AnsiString;
function GetReadOnly : boolean;
function GetMaxTokenType : byte;
function GetNextTokenType : byte;
function GetVocabulary : TTokenIdMap;
function GetTokenStringAt( i : integer) : AnsiString;
function GetTokenSymbolByType( t : integer) : ITokenSymbol;
function GetTokenSymbolAt( i : integer) : ITokenSymbol;
function GetTokenSymbol( Name : AnsiString) : ITokenSymbol;
function GetTokenDefined( Name : AnsiString) : boolean;
procedure SetName( Name : AnsiString);
procedure SetReadOnly( ReadOnly : boolean);
procedure SetMaxTokenType( TokenType : byte);
function Clone : ITokenManager;
function TokenSymbolKeys : TStringList;
function TokenSymbolElems : TInterfaceList;
procedure MapToTokenSymbol( Name: AnsiString; TS: ITokenSymbol);
procedure Define( TS: ITokenSymbol);
// ----------------------------------------------------------------------
// Construction/destruction
// ----------------------------------------------------------------------
public
constructor Create( pName: AnsiString; pTool: ITool);
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
end;
implementation
uses
System.SysUtils;
type
TTokenManagerObject = class
private
fTokenSymbol : ITokenSymbol;
public
constructor Create( TS: ITokenSymbol);
destructor Destroy; override;
end;
// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Construction/destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Constructor
// ================================================================================================
constructor TTokenManager.Create( pName: AnsiString; pTool: ITool);
begin
inherited Create;
fName := pName;
fTool := pTool;
end;
// ================================================================================================
// After Construction
// ================================================================================================
procedure TTokenManager.AfterConstruction;
var
ts: ITokenSymbol;
begin
inherited;
fMaxToken := TT_USER;
fReadOnly := false;
// fVocabulary := TStringList.Create;
fVocabulary := TTokenIdMap.Create;
fHashTable := TStringList.Create(true);
// ---------------------------------------------------------------
// Define EOF symbol
// ---------------------------------------------------------------
ts := TTokenSymbol.Create('EOF');
ts.TokenType:= TT_EOF;
Define( ts);
// ---------------------------------------------------------------
// Define <null-tree-lookahead> but only in the vocabulary vector.
// ---------------------------------------------------------------
// fVocabulary.Add('NULL_TREE_LOOKAHEAD=' + IntToStr(TT_NTLA));
fVocabulary.Add('NULL_TREE_LOOKAHEAD=', TT_NTLA);
end;
// ================================================================================================
// Before Destruction
// ================================================================================================
procedure TTokenManager.BeforeDestruction;
var
ts : ITokenSymbol;
i : integer;
begin
// for i:=0 to fHashTable.Count -1 do
// begin
// ts := ITokenSymbol( pointer( fHashTable.Objects[i]));
// ts := nil;
// end;
FreeAndNil( fVocabulary);
FreeAndNil( fHashTable);
fTool := nil;
inherited;
end;
// @@@: ITokenManager implementation ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// ITokenManager implementation
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Get Name
// ================================================================================================
function TTokenManager.GetName: AnsiString;
begin
result := fName;
end;
// ================================================================================================
// Get ReadOnly
// ================================================================================================
function TTokenManager.GetReadOnly: boolean;
begin
result := fReadOnly;
end;
// ================================================================================================
// Get Token String at
// ================================================================================================
function TTokenManager.GetTokenStringAt(i: integer): AnsiString;
begin
if (i>=0) and (i<fHashTable.Count)
then result := AnsiString(fHashTable.Strings[i])
else result := '';
end;
// ================================================================================================
// Get Token Symbol at
// ================================================================================================
function TTokenManager.GetTokenSymbolAt(i: integer): ITokenSymbol;
begin
if (i>=0) and (i<fHashTable.Count)
then result := (fHashTable.Objects[i] as TTokenManagerObject).fTokenSymbol
else result := nil;
end;
// ================================================================================================
// Get Token Symbol
// ================================================================================================
function TTokenManager.GetTokenSymbol(Name: AnsiString): ITokenSymbol;
var
i: integer;
p: pointer;
begin
i := fHashTable.IndexOf( String(Name));
if i>=0
then result := (fHashTable.Objects[i] as TTokenManagerObject).fTokenSymbol
else result := nil;
end;
// ================================================================================================
// Get Token Symbol By ID
// ================================================================================================
function TTokenManager.GetTokenSymbolByType( t: integer): ITokenSymbol;
var
i: integer;
begin
for i:=0 to fHashTable.Count -1 do
begin
result := (fHashTable.Objects[i] as TTokenManagerObject).fTokenSymbol;
//ITokenSymbol( pointer( fHashTable.Objects[i]));
if result.TokenType = t then
exit;
end;
result := nil;
end;
// ================================================================================================
// Get Token Defined
// ================================================================================================
function TTokenManager.GetTokenDefined(Name: AnsiString): boolean;
begin
result := fHashTable.IndexOf( String(Name)) >= 0
end;
// ================================================================================================
// Get Max Token Type
// ================================================================================================
function TTokenManager.GetMaxTokenType: byte;
begin
result := fMaxToken -1
end;
// ================================================================================================
// Get Next Token Type
// ================================================================================================
function TTokenManager.GetNextTokenType: byte;
begin
result := fMaxToken;
INC( fMaxToken)
end;
// ================================================================================================
// Get Vocabulary
// ================================================================================================
function TTokenManager.GetVocabulary: TTokenIdMap;
begin
result := fVocabulary
end;
// ================================================================================================
// Set Name
// ================================================================================================
procedure TTokenManager.SetName(Name: AnsiString);
begin
fName := Name
end;
// ================================================================================================
// Set ReadOnly
// ================================================================================================
procedure TTokenManager.SetReadOnly(ReadOnly: boolean);
begin
fReadOnly := ReadOnly
end;
// ================================================================================================
// Set Max TokenType
// ================================================================================================
procedure TTokenManager.SetMaxTokenType(TokenType: byte);
begin
fMaxToken := TokenType
end;
// ================================================================================================
// Clone
// ================================================================================================
function TTokenManager.Clone: ITokenManager;
var
i : integer;
ts : ITokenSymbol;
begin
result := TTokenManager.Create( fName, fTool);
// ---------------------------------------------------------------
// Clone hash table (Don't use Assign here!!!!!)
// ---------------------------------------------------------------
for i:=0 to fHashTable.Count -1 do
begin
ts := (fHashTable.Objects[i] as TTokenManagerObject).fTokenSymbol;
if ts <> nil then
result.Define( ts.Clone);
end;
// ---------------------------------------------------------------
// Clone vocabulary
// ---------------------------------------------------------------
// for i:=0 to fVocabulary.Count -1 do
// result.Vocabulary.Add( fVocabulary.Strings[i]);
Raise Exception.Create('Check this!!!');
// ---------------------------------------------------------------
// Set max token type
// ---------------------------------------------------------------
result.MaxTokenType := fMaxToken;
end;
// ================================================================================================
// TokenSymbolKeys
// ================================================================================================
function TTokenManager.TokenSymbolKeys: TStringList;
var
i: integer;
begin
result := TStringList.Create;
for i:=0 to fHashTable.Count -1 do
result.Add( fHashTable.Strings[i]);
end;
// ================================================================================================
// TokenSymbolElems
// ================================================================================================
function TTokenManager.TokenSymbolElems: TInterfaceList;
var
i: integer;
begin
result := TInterfaceList.Create;
for i:=0 to fHashTable.Count-1 do
result.Add( (fHashTable.Objects[i] as TTokenManagerObject).fTokenSymbol);
end;
// ================================================================================================
// Define
// ================================================================================================
procedure TTokenManager.Define(TS: ITokenSymbol);
begin
if not fVocabulary.ContainsKey(TS.ID) then
begin
fVocabulary.Add( TS.ID, TS.TokenType);
MapToTokenSymbol( TS.ID, TS);
if fMaxToken <= TS.TokenType then
fMaxToken := TS.TokenType+1;
end;
// ---------------------------------------------------------------
// Add the symbol to the vocabulary vector and hash table
// ---------------------------------------------------------------
// if fVocabulary.IndexOfName( String(TS.ID)) < 0 then
// begin
// fVocabulary.Add( String(TS.ID) + '=' + IntToStr( TS.TokenType));
// MapToTokenSymbol( TS.ID, TS);
//
// if fMaxToken <= TS.TokenType then
// fMaxToken := TS.TokenType+1;
// end;
end;
// ================================================================================================
// Map to Token Symbol
//
// Map a label or a AnsiString to an existing token symbol.
// ================================================================================================
procedure TTokenManager.MapToTokenSymbol( Name: AnsiString; TS: ITokenSymbol);
begin
TS._AddRef;
fHashTable.AddObject( String(Name), TTokenManagerObject.Create(TS));
//// replace vocabulary item if it does exist.
// idx := fVocabulary.IndexOfName(String(TS.ID));
//
// if idx >= 0 then
// fVocabulary[idx] := pName +'='+ IntToStr( pTS.TokenType);
end;
{ TTokenManagerObject }
// @@@: TTokenManagerObject +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// TTokenManagerObject
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Constructor
// ================================================================================================
constructor TTokenManagerObject.Create(TS: ITokenSymbol);
begin
inherited Create;
fTokenSymbol := TS
end;
// ================================================================================================
// Destructor
// ================================================================================================
destructor TTokenManagerObject.Destroy;
begin
fTokenSymbol := nil;
inherited;
end;
end.
src.lib/dpglib.TokenParser.pas
+161
View File
@@ -0,0 +1,161 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.tokenParser.g
// ============================================================================
unit dpglib.TokenParser;
interface
uses
Classes,
SysUtils,
dpglib.StringSymbol,
dpglib.TokenParserTokens,
dpglib.TokenSymbol,
dpglib.Types,
dpgrtl.llkparser,
dpgrtl.types;
type
// =========================================================================
// Class TTokenParser declaration
// =========================================================================
TTokenParser = class( TLLkParser)
public // Public grammar rules
procedure tokenFile ( tm:ITokenManager);
procedure tokenLine ( tm:ITokenManager);
end;
implementation
uses
dpgrtl.exception,
dpgrtl.token;
// ============================================================================
// tokenFile
// ============================================================================
procedure TTokenParser.tokenFile( tm:ITokenManager);
var
name: IToken;
begin
name := LT(1);
match(TT_ID);
while(true) do
begin
if (( LA(1) in [TT_STRING,TT_ID])) then
begin
tokenLine(tm);
end
else
break;
end;
end;
// ============================================================================
// tokenLine
// ============================================================================
procedure TTokenParser.tokenLine( tm:ITokenManager);
var
i: IToken;
id: IToken;
id2: IToken;
lab: IToken;
para: IToken;
s1: IToken;
s2: IToken;
t : IToken;
s : IToken;
v : integer;
sl: IStringSymbol;
ts: ITokenSymbol;
x : AnsiString;
begin
t := nil;
s := nil;
if (( LA(1) in [TT_STRING])) then
begin
s1 := LT(1);
match(TT_STRING);
s := s1;
end
else if (( LA(1) in [TT_ID]) and (LA(2) in [TT_ASSIGN]) and (LA(3) in [TT_STRING])) then
begin
lab := LT(1);
match(TT_ID);
t := lab;
match(TT_ASSIGN);
s2 := LT(1);
match(TT_STRING);
s := s2;
end
else if (( LA(1) in [TT_ID]) and (LA(2) in [TT_LPAREN])) then
begin
id := LT(1);
match(TT_ID);
t := id;
match(TT_LPAREN);
para := LT(1);
match(TT_STRING);
match(TT_RPAREN);
end
else if (( LA(1) in [TT_ID]) and (LA(2) in [TT_ASSIGN]) and (LA(3) in [TT_INT])) then
begin
id2 := LT(1);
match(TT_ID);
t := id2;
end
else
Raise EMismatchedToken.Create( LT(1), [TT_STRING,TT_ID], InputState.FileName);
match(TT_ASSIGN);
i := LT(1);
match(TT_INT);
v := StrToIntDef( i.TokenText, -1);
if s <> nil then
begin
ts := TStringSymbol.Create( s.TokenText);
ts.TokenType := v;
tm.Define(ts);
if t <> nil then
begin
ts := tm.TokenSymbol[s.TokenText];
ts.QueryInterface( IStringSymbol, sl);
sl.Lbl := t.TokenText;
tm.MapToTokenSymbol( t.TokenText, sl);
end;
end
else if t <> nil then
begin
x := Copy( t.TokenText, 4, Length( t.TokenText)-3);
ts := TTokenSymbol.Create( x);
ts.TokenType := v;
tm.Define( ts);
if para <> nil then
begin
ts := tm.TokenSymbol[ t.TokenText];
ts.Paraphrase := para.TokenText;
end;
end;
end;
end.
src.lib/dpglib.TokenParserTokens.pas
+26
View File
@@ -0,0 +1,26 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.tokenParser.g
// ============================================================================
unit dpglib.TokenParserTokens;
interface
const
TT_ID = 10;
TT_STRING = 7;
TT_EOF = 1;
TT_SLCOMMENT = 13;
TT_XDIGIT = 9;
TT_ASSIGN = 6;
TT_WS = 12;
TT_LPAREN = 4;
TT_RPAREN = 5;
TT_DIGIT = 8;
TT_MLCOMMENT = 14;
TT_INT = 11;
implementation
end.
src.lib/dpglib.TokenRangeElem.pas
+168
View File
@@ -0,0 +1,168 @@
unit dpglib.TokenRangeElem;
interface
uses
dpgrtl.types,
dpglib.Types,
dpglib.AlternativeElem;
type
// =========================================================================
// Class TTokenRangeElem declaration
// =========================================================================
TTokenRangeElem = class( TAlternativeElem,
ITokenRangeElem,
IAlternativeElem,
IGrammarElem)
// ---------------------------------------------------------------
// Members
// ---------------------------------------------------------------
protected
fLabel : AnsiString;
fBegin : integer;
fEnd : integer;
fBeginText : AnsiString;
fEndText : AnsiString;
// ---------------------------------------------------------------
// Constructor/destructor
// ---------------------------------------------------------------
public
constructor Create( pGrammar : IGrammar;
pToken1 : IToken;
pToken2 : IToken;
pAutoGenType: integer);
// ---------------------------------------------------------------
// IGrammarElem overrides
// ---------------------------------------------------------------
public
procedure Generate;
function Look( pK: integer): ILookahead;
function AsString : AnsiString;
// ---------------------------------------------------------------
// IAlternativeElem overrides
// ---------------------------------------------------------------
protected
function GetLabel : AnsiString;
procedure SetLabel( pLabel: AnsiString);
// ---------------------------------------------------------------
// ITokenRangeElem methods
// ---------------------------------------------------------------
protected
function GetBeginToken : integer;
function GetEndToken : integer;
function GetBeginText : AnsiString;
function GetEndText : AnsiString;
end;
implementation
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TTokenRangeElem.Create( pGrammar : IGrammar;
pToken1 : IToken;
pToken2 : IToken;
pAutoGenType: integer);
begin
inherited Create( pGrammar, pToken1, pAutoGenType);
fBegin := fGrammar.TokenManager.TokenSymbol[pToken1.TokenText].TokenType;
fEnd := fGrammar.TokenManager.TokenSymbol[pToken2.TokenText].TokenType;
fBeginText := pToken1.TokenText;
fEndText := pToken2.TokenText;
end;
// ****************************************************************************
// IGrammarElem overrides
// ****************************************************************************
// ============================================================================
// Generate
// ============================================================================
procedure TTokenRangeElem.Generate;
begin
fGrammar.Generator.Gen( self);
end;
// ============================================================================
// Look
// ============================================================================
function TTokenRangeElem.Look(pK: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look( pK, self);
end;
// ============================================================================
// AsString
// ============================================================================
function TTokenRangeElem.AsString: AnsiString;
begin
if fLabel <> '' then
result := ' ' + fLabel + ':' + fBeginText + '..' + fEndText
else
result := ' ' + fBeginText + '..' + fEndText;
end;
// ****************************************************************************
// IAlternativeElem overrides
// ****************************************************************************
// ============================================================================
// GetLabel
// ============================================================================
function TTokenRangeElem.GetLabel: AnsiString;
begin
result := fLabel;
end;
// ============================================================================
// SetLabel
// ============================================================================
procedure TTokenRangeElem.SetLabel(pLabel: AnsiString);
begin
fLabel := pLabel;
end;
// ****************************************************************************
// ITokenRangeElem implementation
// ****************************************************************************
// ============================================================================
// GetBeginToken
// ============================================================================
function TTokenRangeElem.GetBeginToken: integer;
begin
result := fBegin;
end;
// ============================================================================
// GetEndToken
// ============================================================================
function TTokenRangeElem.GetEndToken: integer;
begin
result := fEnd;
end;
// ============================================================================
// GetBeginText
// ============================================================================
function TTokenRangeElem.GetBeginText: AnsiString;
begin
result := fBeginText;
end;
// ============================================================================
// GetEndText
// ============================================================================
function TTokenRangeElem.GetEndText: AnsiString;
begin
result := fEndText;
end;
end.
src.lib/dpglib.TokenRefElem.pas
+102
View File
@@ -0,0 +1,102 @@
unit dpglib.TokenRefElem;
interface
uses
dpgrtl.types,
dpglib.Types,
dpglib.GrammarAtom;
type
// =========================================================================
// Class TTokenRefElem declaration
// =========================================================================
TTokenRefElem = class( TGrammarAtom,
ITokenRefElem,
IGrammarAtom,
IAlternativeElem,
IGrammarElem)
// ---------------------------------------------------------------
// Constructor/destructor
// ---------------------------------------------------------------
public
constructor Create( pGrammar : IGrammar;
pToken : IToken;
pInverted : boolean;
pAutoGenType: integer);
// ---------------------------------------------------------------
// IGrammarElem overrides
// ---------------------------------------------------------------
public
procedure Generate;
function Look( pK: integer): ILookahead;
end;
implementation
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TTokenRefElem.Create( pGrammar : IGrammar;
pToken : IToken;
pInverted : boolean;
pAutoGenType: integer);
var
ts: ITokenSymbol;
begin
inherited Create( pGrammar, pToken, pAutoGenType);
fNot := pInverted;
ts := fGrammar.TokenManager.TokenSymbol[fAtomText];
if ts <> nil then
begin
fTokenType := ts.TokenType;
// ------------------------------------------------------------
// Set the AST node type to whatever was set in tokens {...}
// section (if anything).
// After this is create, the element option can set this.
// ------------------------------------------------------------
SetASTNodeType( ts.ASTNodeType);
end
else
begin
fGrammar.Tool.Error( 'Undefined token symbol: ' + String(fAtomText),
fGrammar.GrammarFile,
pToken.TokenLine,
pToken.TokenColumn);
end;
end;
// ****************************************************************************
// IGrammarElem overrides
// ****************************************************************************
// ============================================================================
// Generate
// ============================================================================
procedure TTokenRefElem.Generate;
var
_self: ITokenRefElem;
begin
_self := self;
fGrammar.Generator.Gen(_self);
// fGrammar.Generator.Gen(self as ITokenRefElem);
end;
// ============================================================================
// Look
// ============================================================================
function TTokenRefElem.Look(pK: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look( pK, self);
end;
end.
src.lib/dpglib.TokenSymbol.pas
+125
View File
@@ -0,0 +1,125 @@
unit dpglib.TokenSymbol;
interface
uses
dpgrtl.types,
dpglib.types,
dpglib.GrammarSymbol;
type
TTokenSymbol = class( TGrammarSymbol, ITokenSymbol, IGrammarSymbol)
protected
fTokenType : integer;
fParaphrase : AnsiString;
fASTNodeType : AnsiString;
// ----------------------------------------------------------------------
// Construction/destruction
// ----------------------------------------------------------------------
public
constructor Create( ID: AnsiString);
// ----------------------------------------------------------------------
// IdpgTokenSymbol methods
// ----------------------------------------------------------------------
protected
function GetTokenType : integer;
function GetParaphrase : AnsiString;
function GetASTNodeType : AnsiString;
procedure SetTokenType( TokenType : integer);
procedure SetParaphrase( Paraphrase : AnsiString);
procedure SetASTNodeType( ASTNodeType : AnsiString);
function Clone: ITokenSymbol;
end;
implementation
// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Construction/destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Constructor
// ================================================================================================
constructor TTokenSymbol.Create(ID: AnsiString);
begin
inherited Create( ID);
fTokenType := TT_INVALID;
end;
// @@@: ITokenSymbol implementation +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// ITokenSymbol implementation
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Get Token Type
// ================================================================================================
function TTokenSymbol.GetTokenType: integer;
begin
result := fTokenType;
end;
// ================================================================================================
// Get Paraphrase
// ================================================================================================
function TTokenSymbol.GetParaphrase: AnsiString;
begin
result := fParaphrase;
end;
// ================================================================================================
// Get AST Node Type
// ================================================================================================
function TTokenSymbol.GetASTNodeType: AnsiString;
begin
result := fASTNodeType;
end;
// ================================================================================================
// Set Token Type
// ================================================================================================
procedure TTokenSymbol.SetTokenType(TokenType: integer);
begin
fTokenType := TokenType;
end;
// ================================================================================================
// Set Paraphrase
// ================================================================================================
procedure TTokenSymbol.SetParaphrase(Paraphrase: AnsiString);
begin
fParaphrase := Paraphrase;
end;
// ================================================================================================
// Set AST Node Type
// ================================================================================================
procedure TTokenSymbol.SetASTNodeType(ASTNodeType: AnsiString);
begin
fASTNodeType := ASTNodeType;
end;
// ================================================================================================
// Clone
// ================================================================================================
function TTokenSymbol.Clone: ITokenSymbol;
begin
result := TTokenSymbol.Create( fID);
result.TokenType := fTokenType;
result.Paraphrase := fParaphrase;
result.ASTNodeType:= fASTNodeType;
end;
end.
src.lib/dpglib.Tool.pas
+554
View File
@@ -0,0 +1,554 @@
unit dpglib.Tool;
interface
uses
System.Classes,
System.SysUtils,
dpgrtl.types,
dpgrtl.exception,
dpglib.Types;
type
// =========================================================================
// Class TTool declaration
// =========================================================================
TTool = class( TInterfacedObject,
ITool)
protected
fModuleStream : TStream;
fModuleName : AnsiString;
fOutputDir : AnsiString;
fExchangeDir : AnsiString;
fErrorHandler : IToolErrorHandler;
protected
fWarningCount : integer;
fErrorCount : integer;
protected
// ------------------------------------------------------------
// members
// ------------------------------------------------------------
fGrammarFile : AnsiString;
fGrammar : IGrammar;
function GetWarningCount : integer;
function GetErrorCount : integer;
// ------------------------------------------------------------
// Exception handling
// ------------------------------------------------------------
procedure exMismatchedChar( mc: EMismatchedChar);
procedure exMismatchedToken( mt: EMismatchedToken);
procedure dumpSets( pGrammar : IGrammar;
pLexical : boolean;
pSets : TInterfaceList;
pDepth : integer);
public
// ------------------------------------------------------------
// Constructor/destructor
// ------------------------------------------------------------
constructor Create( pFile : AnsiString;
pErrorHandler : IToolErrorHandler); overload;
constructor Create( pModuleStream : TStream;
pModuleName : AnsiString;
pOutputDir : AnsiString;
pExchangeDir : AnsiString;
pErrorHandler : IToolErrorHandler); overload;
destructor Destroy; override;
public
// ------------------------------------------------------------
// ITool methods
// ------------------------------------------------------------
procedure Go;
function Get_ErrorHandler: IToolErrorHandler;
procedure Debug( pMessage : AnsiString);
procedure Error( pMessage : AnsiString;
pFileName: AnsiString = '';
pLine : integer = 0;
pColumn : integer = 0);
procedure Warning( pMessage : AnsiString;
pFileName: AnsiString = '';
pLine : integer = 0;
pColumn : integer = 0);
procedure Panic( pMessage : AnsiString);
procedure WarnAltAmbiguity( pGrammar : IGrammar;
pBlock : IAlternativeBlock;
pLexical : boolean;
pDepth : integer;
pSets : TInterfaceList;
pAltIdx1 : integer;
pAltIdx2 : integer);
procedure WarnAltExitAmbiguity( pGrammar : IGrammar;
pBlock : IBlockWithImpliedExitPath;
pLexical : boolean;
pDepth : integer;
pSets : TInterfaceList;
pAltIdx : integer);
end;
implementation
uses
dpglib.DpgLexer,
dpglib.DpgParser,
dpglib.CodeGenerator,
dpglib.Utils,
dpglib.LLkAnalyzer,
dpglib.GrammarMaker,
dpglib.DelphiGenerator,
dpglib.PrettyPrinter;
// dpgExceptionPanic;
// ****************************************************************************
//
// Constructor/destructor
//
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TTool.Create( pFile : AnsiString;
pErrorHandler : IToolErrorHandler);
begin
inherited Create;
fGrammar := nil;
fGrammarFile := pFile;
fErrorHandler := pErrorHandler;
fWarningCount := 0;
fErrorCount := 0;
end;
// ============================================================================
// Constructor
// ============================================================================
constructor TTool.Create( pModuleStream : TStream;
pModuleName : AnsiString;
pOutputDir : AnsiString;
pExchangeDir : AnsiString;
pErrorHandler : IToolErrorHandler);
begin
fGrammar := nil;
fWarningCount := 0;
fErrorCount := 0;
fModuleStream := pModuleStream;
fModuleName := pModuleName;
fOutputDir := pOutputDir;
fExchangeDir := pExchangeDir;
fErrorHandler := pErrorHandler;
end;
// ============================================================================
// Destructor
// ============================================================================
destructor TTool.Destroy;
begin
fGrammar := nil;
fErrorHandler := nil;
inherited;
end;
// ****************************************************************************
//
// ITool implementation
//
// ****************************************************************************
// ============================================================================
// Go
// ============================================================================
procedure TTool.Go;
var
parser : TDpgParser;
lexer : TDpgLexer;
gmaker : IGrammarBehavior;
analyzer : ILLkAnalyzer;
gen : ICodeGenerator;
begin
fWarningCount := 0;
fErrorCount := 0;
if (fModuleStream <> nil) and (fModuleName <> '') then
begin
try
analyzer := TLLkAnalyzer .Create( self);
gmaker := TGrammarMaker .Create( self, analyzer, fExchangeDir);
gen := TDelphiGenerator .Create( fOutputDir, fExchangeDir);
lexer := TDpgLexer .Create( fModuleStream);
parser := TDpgParser .Create( lexer, gmaker, self, fExchangeDir);
lexer.InputState.FileName := fModuleName;
parser.InputState.FileName := fModuleName;
except
if fErrorHandler <> nil then
fErrorHandler.Error('Internal error');
exit;
end;
try
parser.grammar;
except
on mc: EMismatchedChar do begin exMismatchedChar( mc); exit; end;
on mt: EMismatchedToken do begin exMismatchedToken(mt); exit; end;
else
begin
if fErrorHandler <> nil then
fErrorHandler.Error('Error: Unexpected exception...');
exit;
end;
end;
if fErrorCount = 0 then
begin
fGrammar := gmaker.Grammar;
try
gen.Gen( gmaker.Grammar);
except
if fErrorHandler <> nil then
fErrorHandler.Error('Unexpected exception in generator');
end;
end
end;
end;
// ============================================================================
// Get_ErrorHandler
// ============================================================================
function TTool.Get_ErrorHandler: IToolErrorHandler;
begin
result := nil;
end;
// ============================================================================
// Error
// ============================================================================
procedure TTool.Error( pMessage : AnsiString;
pFileName: AnsiString;
pLine : integer;
pColumn : integer);
var
msg: AnsiString;
begin
INC(fErrorCount);
if pColumn > 0
then msg := pFileName +'(' +IntToStr(pLine) +',' +IntToStr(pColumn) +'): ' + pMessage
else msg := pFileName +'(' +IntToStr(pLine) +'): ' + pMessage;
if fErrorHandler <> nil then
fErrorHandler.Error( msg, pFileName, pLine, pColumn);
end;
// ============================================================================
// Warning
// ============================================================================
procedure TTool.Warning( pMessage : AnsiString;
pFileName: AnsiString;
pLine : integer;
pColumn : integer);
var
msg: AnsiString;
begin
INC(fWarningCount);
msg := pFileName + '(' + IntToStr( pLine) + '): ' + pMessage;
if fErrorHandler <> nil then
fErrorHandler.Warning( msg, pFileName, pLine, pColumn);
end;
// ============================================================================
// Panic
// ============================================================================
procedure TTool.Panic( pMessage : AnsiString);
var
msg: AnsiString;
begin
msg := pMessage;
if fErrorHandler <> nil then
fErrorHandler.Panic( msg);
// Raise EPanic.Create(msg);
end;
// ============================================================================
// dumpSets
// ============================================================================
procedure TTool.dumpSets( pGrammar : IGrammar;
pLexical : boolean;
pSets : TInterfaceList;
pDepth : integer);
var
i : integer;
msg : AnsiString;
la : ILookahead;
begin
for i:=0 to pDepth-1 do
begin
la := pSets[i] as ILookahead;
msg := Format(' k=%d ', [i+1]);
if la.LaSet = [] then
msg := msg + '<EPS>'
else
if pLexical
then msg := msg + CharSetToStr( la.LaSet)
else msg := msg + TokenSetToStr( la.LaSet, fGrammar.TokenManager);
fErrorHandler.Warning( msg);
end;
end;
// ============================================================================
// WarnAltAmbiguity
// ============================================================================
procedure TTool.WarnAltAmbiguity( pGrammar : IGrammar;
pBlock : IAlternativeBlock;
pLexical : boolean;
pDepth : integer;
pSets : TInterfaceList;
pAltIdx1 : integer;
pAltIdx2 : integer);
var
rb: IRuleBlock;
msg: AnsiString;
ai : IAlternative;
aj : IAlternative;
rri : IRuleRefElem;
rrj : IRuleRefElem;
ri : AnsiString;
rj : AnsiString;
begin
if fErrorHandler = nil then
exit;
pBlock.QueryInterface(IRuleBlock, rb);
// ---------------------------------------------------------------
// prepare locals
// ---------------------------------------------------------------
ai := pBlock.Alternative[pAltIdx1];
aj := pBlock.Alternative[pAltIdx2];
ai.Head.QueryInterface(IRuleRefElem, rri);
aj.Head.QueryInterface(IRuleRefElem, rrj);
// ---------------------------------------------------------------
// Handle ambiguity of rules.
// ---------------------------------------------------------------
if (rb <> nil) and
(rri <> nil) and
(rrj <> nil) and
(pLexical) and
pBlock.AutoGen then
begin
ri := TCodeGenerator.decodeLexerRuleName( rri.TargetRule);
rj := TCodeGenerator.decodeLexerRuleName( rrj.TargetRule);
msg := fGrammarFile +'(1): ';
fErrorHandler.Warning('');
msg := msg + 'Lexical nondeterminism between rules "' +
ri + '" and "' + rj + '"';// upon:';
fErrorHandler.Warning( msg);
end
// ---------------------------------------------------------------
// Handle ambiguity of alternatives.
// ---------------------------------------------------------------
else
begin
fErrorHandler.Warning('');
msg := pGrammar.GrammarFile (*fGrammarFile*) + '(' +
IntToStr( pBlock.Line) + '): ';
if pLexical then
msg := msg + 'lexical ';
msg := msg + 'nondeterminism between alts ' +
IntToStr( pAltIdx1+1) + ' and ' + IntToStr( pAltIdx2+1) +
' of block in rule "' + pBlock.EnclosingRule + '"';// upon:';
fErrorHandler.Warning( msg);
end;
dumpSets( pGrammar, pLexical, pSets, pDepth);
end;
// ============================================================================
// WarnAltExitAmbiguity
// ============================================================================
procedure TTool.WarnAltExitAmbiguity( pGrammar : IGrammar;
pBlock : IBlockWithImpliedExitPath;
pLexical : boolean;
pDepth : integer;
pSets : TInterfaceList;
pAltIdx : integer);
var
fileline : AnsiString;
msg : AnsiString;
begin
if fErrorHandler <> nil then
begin
fileline := fGrammarFile + '(' + IntToStr( pBlock.Line) + '):';
msg := fileline;
if pLexical then
msg := msg + 'lexical';
msg := msg +' nondeterminism between alt ' + IntToStr( pAltIdx) +
' and exit branch of block in rule ' + pBlock.EnclosingRule + '.';
fErrorHandler.Warning('');
fErrorHandler.Warning(msg);
dumpSets( pGrammar, pLexical, pSets, pDepth);
end;
end;
// ============================================================================
// Debug
// ============================================================================
procedure TTool.Debug(pMessage: AnsiString);
begin
if fErrorHandler <> nil then
fErrorHandler.Error(pMessage);
end;
// ============================================================================
// exMismatchedChar
//
// Handle lexer mismatched char exception.
// ============================================================================
procedure TTool.exMismatchedChar(mc: EMismatchedChar);
var
msg : AnsiString;
filename : AnsiString;
begin
fileName := ExtractFileName(mc.FileName);
// ---------------------------------------------------------------
// Handle AnsiString
// ---------------------------------------------------------------
if mc.FoundString <> '' then
msg := 'Unexpected AnsiString token: ' + mc.FoundString
// ---------------------------------------------------------------
// Handle char
// ---------------------------------------------------------------
else
begin
if not mc.Inverted then
msg := 'Expecting [' + CharSetToStr( mc.CharSet) + '] but found ' +
CharSetToStr([mc.FoundChar])
else
msg := 'Not expecting [' + CharSetToStr( mc.CharSet) + '] and found ' +
CharSetToStr([mc.FoundChar])
end;
Error( msg, fileName, mc.Line, mc.Column);
(*
// ---------------------------------------------------------------
// Unexpected AnsiString, AnsiString
// ---------------------------------------------------------------
if mc.ExpCode = EC_CHAR then
msg := 'Unexpected token: ' + CharSetToStr([mc.FoundChar])
// ---------------------------------------------------------------
// Unexpected char, charset
// ---------------------------------------------------------------
else if mc.ExpCode = EC_CHARSET then
if not mc.Invert then
msg := 'Expecting [' + CharSetToStr( mc.CharSet) + '] but found ' +
CharSetToStr([mc.FoundChar])
else
msg := 'Not expecting [' + CharSetToStr( mc.CharSet) + '] and found ' +
CharSetToStr([mc.FoundChar])
// ---------------------------------------------------------------
// Unexpected char, char range
// ---------------------------------------------------------------
else if mc.ExpCode = EC_CHARRANGE then
if not mc.Invert then
msg := 'Expecting [' + CharSetToStr( mc.CharSet) + '] but found ' +
CharSetToStr([mc.FoundChar])
else
msg := 'Not expecting [' + CharSetToStr( mc.CharSet) + '] and found ' +
CharSetToStr([mc.FoundChar])
// ---------------------------------------------------------------
// Unexpected AnsiString
// ---------------------------------------------------------------
else if mc.ExpCode = EC_STRING then
msg := 'Unexpected AnsiString token: ' + mc.FoundStr
// ---------------------------------------------------------------
// Something wrong...
// ---------------------------------------------------------------
else
msg := 'Internal error: Unknown lexer exception.';
Error( msg, fileName, mc.Line, mc.Column);
*)
end;
// ============================================================================
// exMismatchedToken
//
// Handle parser mismatched token exception.
//
// Note: the member fGrammar now valid at this point, so we can use the
// grammar's token manager.
// ============================================================================
procedure TTool.exMismatchedToken(mt: EMismatchedToken);
var
fileName : string;
msg : string;
begin
fileName := ExtractFileName( mt.FileName);
msg := 'Unexpected token: ' + mt.FoundToken.TokenText;
Error( msg, fileName, mt.Line, mt.Column);
end;
function TTool.GetErrorCount: integer;
begin
result := fErrorCount;
end;
function TTool.GetWarningCount: integer;
begin
result := fWarningCount;
end;
end.
src.lib/dpglib.TreeBlockContext.pas
+63
View File
@@ -0,0 +1,63 @@
// The context needed to add root,child elements to a Tree. There is only one alternative
// (i.e., a list of children). We subclass to specialize. MakeGrammar.addElementToCurrentAlt
// will work correctly now for either a block of alts or a Tree child list.
//
// The first time addAlternativeElement is called, it sets the root element
// rather than adding it to one of the alternative lists. Rather than have
// the grammar duplicate the rules for grammar atoms etc... we use the same
// grammar and same refToken behavior etc... We have to special case somewhere
// and here is where we do it.
unit dpglib.TreeBlockContext;
interface
uses
dpglib.types,
dpglib.BlockContext;
type
TTreeBlockContext = class( TBlockContext)
protected
fNextElementIsRoot: boolean;
public
procedure AddAlternativeElem( pElem: IAlternativeElem); override;
public
procedure AfterConstruction; override;
end;
implementation
{ TTreeBlockContext }
// ================================================================================================
// After Construction
// ================================================================================================
procedure TTreeBlockContext.AfterConstruction;
begin
inherited;
fNextElementIsRoot := true;
end;
// ================================================================================================
// Add Alternative Elem
// ================================================================================================
procedure TTreeBlockContext.AddAlternativeElem(pElem: IAlternativeElem);
var
tree: ITreeElem;
begin
Block.QueryInterface( ITreeElem, tree);
if fNextElementIsRoot then
begin
tree.Root := pElem as IGrammarAtom;
fNextElementIsRoot := false
end
else
inherited
end;
end.
src.lib/dpglib.TreeElem.pas
+145
View File
@@ -0,0 +1,145 @@
// A TreeElement is a block with one alternative and a root node
unit dpglib.TreeElem;
interface
uses
dpgrtl.types,
dpglib.types,
dpglib.AlternativeBlock;
type
TTreeElem = class( TAlternativeBlock,
ITreeElem,
IGrammarElem)
protected
fRoot : IGrammarAtom;
// ---------------------------------------------------------------
// ITreeElem
// ---------------------------------------------------------------
protected
function GetRoot: IGrammarAtom;
procedure SetRoot( pRoot: IGrammarAtom);
// ---------------------------------------------------------------
// IGrammarElem
// ---------------------------------------------------------------
public
procedure Generate;
function Look( pK: integer): ILookahead;
function AsString : AnsiString;
public
constructor Create( Grammar : IGrammar;
Start : IToken;
Invert : boolean);
end;
implementation
{ TTreeElem }
// @@@: Construction / destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// Construction / destruction
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Constructor
// ================================================================================================
constructor TTreeElem.Create(Grammar: IGrammar; Start: IToken; Invert: boolean);
begin
inherited
end;
// @@@: ITreeElem implementation ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// ITreeElem implementation
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Get Root
// ================================================================================================
function TTreeElem.GetRoot: IGrammarAtom;
begin
result := fRoot
end;
// ================================================================================================
// Set Root
// ================================================================================================
procedure TTreeElem.SetRoot(pRoot: IGrammarAtom);
begin
fRoot := pRoot
end;
// @@@: IGrammarElem overrides ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// IGrammarElem overrides
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Look
// ================================================================================================
function TTreeElem.Look(pK: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look( pK, self);
end;
// ================================================================================================
// Generate
// ================================================================================================
procedure TTreeElem.Generate;
begin
fGrammar.Generator.Gen( self);
end;
// ================================================================================================
// As String
// ================================================================================================
function TTreeElem.AsString: AnsiString;
var
alt : IAlternative;
elem : IAlternativeElem;
begin
result := ' #(';
if Assigned(fRoot) then
result := result +fRoot.AsString;
alt := fAlternatives.Items[0] as IAlternative;
elem := alt.Head;
while Assigned(elem) do
begin
result := result + elem.AsString;
elem := elem.Next;
end;
result := result +')';
end;
end.
src.lib/dpglib.TreeParserGrammar.pas
+22
View File
@@ -0,0 +1,22 @@
unit dpglib.TreeParserGrammar;
interface
uses
System.Classes,
System.Contnrs,
dpgrtl.types,
dpglib.Types,
dpglib.ParserGrammar;
type
// =========================================================================
// Class TParserGrammar
// =========================================================================
TTreeParserGrammar = class(TParserGrammar,
IGrammar,
ITreeWalkerGrammar)
end;
implementation
end.
src.lib/dpglib.Utils.pas
+622
View File
@@ -0,0 +1,622 @@
unit dpglib.utils;
interface
uses
System.Classes,
Generics.Collections,
dpgrtl.types,
dpglib.types;
type
cType = (ctOther, ctNumber, ctAlpha, ctAlnum, ctPrint);
sType = set of cType;
TCharFormater = function ( c: char): AnsiString;
function IsNumber( c: AnsiChar): boolean;
function IsAlpha( c: AnsiChar): boolean;
function IsAlnum( c: AnsiChar): boolean;
function IsPrint( c: AnsiChar): boolean;
function StringToID( s: AnsiString): AnsiString;
function DelphiCharFormater( c : AnsiChar) : AnsiString;
function DelphiTokenFormater( t : integer;
tm : ITokenManager = nil) : AnsiString;
function TokenSetToStr( pBS : TByteSet;
pTM : ITokenManager = nil): AnsiString;
{
function DelphiTokenFormater( t : integer;
v : TStringList = nil) : AnsiString;
function TokenSetToStr( pBS : TByteSet;
pVocab: TStringList = nil): AnsiString;
}
function CharSetToStr( pBS : TCharSet;
pFmt : TCharFormater= nil): AnsiString; overload;
function CharSetToStr( pBS : TByteSet;
pFmt : TCharFormater= nil): AnsiString; overload;
implementation
uses
System.SysUtils,
System.StrUtils;
var
c : AnsiChar;
cTable: array [AnsiChar] of sType;
// ----------------------------------------------------------------------------
// GetStringOfToken
// ----------------------------------------------------------------------------
{
function GetStringOfToken( t: integer; v: TStringList): AnsiString;
var
i : integer;
p : integer;
name : AnsiString;
value : AnsiString;
str : AnsiString;
begin
result := '';
for i:=0 to v.Count-1 do
begin
name := v.Names[i];
value := v.ValueFromIndex[i];
if StrToIntDef( value,-1) = t then
begin
if name[1] = '"' then
begin
name := Copy(name,2,Length(name)-2);
result := 'LT_' + name;
result := AnsiReplaceText( result, '$', '_DOLLAR_');
result := AnsiReplaceText( result, '/', '_SLASH_');
result := AnsiReplaceText( result, ':', '_COLON_');
result := AnsiReplaceText( result, '.', '_DOT_');
result := AnsiReplaceText( result, 'LT__', 'LT_');
break;
end
else
begin
result := 'TT_' + name;
break;
end;
end;
end;
end;
}
// ----------------------------------------------------------------------------
// GetStringOfToken
// ----------------------------------------------------------------------------
function GetStringOfToken( t: integer; tm: ITokenManager): AnsiString;
var
ts : ITokenSymbol;
ss : IStringSymbol;
begin
result := '';
ts := tm.TokenSymbolByType[t];
if Assigned(ts) then
begin
ts.QueryInterface( IStringSymbol, ss);
if Assigned(ss) then
begin
if ss.Lbl <> ''
then result := ss.Lbl
else result := 'LT_'+ss.ID;
result := AnsiString( AnsiReplaceText( String(result), '#', '_SHARP_'));
result := AnsiString( AnsiReplaceText( String(result), '*', '_STAR_'));
result := AnsiString( AnsiReplaceText( String(result), '$', '_DOLLAR_'));
result := AnsiString( AnsiReplaceText( String(result), '/', '_SLASH_'));
result := AnsiString( AnsiReplaceText( String(result), ':', '_COLON_'));
result := AnsiString( AnsiReplaceText( String(result), '.', '_DOT_'));
result := AnsiString( AnsiReplaceText( String(result), 'LT__', 'LT_'));
end
else
result := 'TT_' +ts.ID;
end
end;
// ----------------------------------------------------------------------------
// DelphiCharFormater
// ----------------------------------------------------------------------------
function DelphiCharFormater( c: AnsiChar): AnsiString;
var
tmp: string;
begin
if isPrint( c) then
if c = '''' then
tmp := ''''''''''
else
tmp := '''' + c + ''''
else
tmp := '#' + IntToStr( ord(c));
result := AnsiString( tmp);
end;
// ----------------------------------------------------------------------------
// DelphiTokenFormater
// ----------------------------------------------------------------------------
function DelphiTokenFormater( t: integer; tm: ITokenManager): AnsiString;
begin
if tm <> nil then
result := GetStringOfToken( t, tm);
if result = '' then
result := AnsiString( 'TT_' + Format('%3.3d',[t]));
end;
{
function DelphiTokenFormater( t: integer; v: TStringList): AnsiString;
begin
if v <> nil then
result := GetStringOfToken( t, v);
if result = '' then
result := 'TT_' + Format('%3.3d',[t]);
end;
}
// ----------------------------------------------------------------------------
// TokenSetToStr
// ----------------------------------------------------------------------------
function TokenSetToStr( pBS : TByteSet;
pTM : ITokenManager): AnsiString;
var
t : integer;
firstToken : integer;
lastToken : integer;
begin
result := '';
t := 0;
while t <= 255 do
begin
// ------------------------------------------------------------
// Find the first "bit" of the range
// ------------------------------------------------------------
while (not (t in pBS)) and (t <= 255) do
INC(t);
// ------------------------------------------------------------
// Check that we are reached the end
// ------------------------------------------------------------
if t = 256 then
break;
// ------------------------------------------------------------
// OK, we found the first "bit" of the range
// ------------------------------------------------------------
firstToken := t;
// ------------------------------------------------------------
// Fin the last "bit" of the range
// ------------------------------------------------------------
while (t in pBS) and (t <= 255) do
INC(t);
lastToken := pred(t);
// ------------------------------------------------------------
// Append "," to the result if this founded range is not the
// first in the result.
// ------------------------------------------------------------
if result <> '' then
result := result + ',';
// ------------------------------------------------------------
// Build the first "bit" into the result
// ------------------------------------------------------------
result := result + DelphiTokenFormater( firstToken, pTM);
// ------------------------------------------------------------
// Build range if the firstChar not equals to the lastChar
// ------------------------------------------------------------
if firstToken <> lastToken then
result := result + '..' + DelphiTokenFormater( lastToken, pTM);
end;
end;
{
function TokenSetToStr( pBS : TByteSet;
pVocab: TStringList): AnsiString;
var
t : integer;
firstToken : integer;
lastToken : integer;
begin
result := '';
t := 0;
while t <= 255 do
begin
// ------------------------------------------------------------
// Find the first "bit" of the range
// ------------------------------------------------------------
while (not (t in pBS)) and (t <= 255) do
INC(t);
// ------------------------------------------------------------
// Check that we are reached the end
// ------------------------------------------------------------
if t = 256 then
break;
// ------------------------------------------------------------
// OK, we found the first "bit" of the range
// ------------------------------------------------------------
firstToken := t;
// ------------------------------------------------------------
// Fin the last "bit" of the range
// ------------------------------------------------------------
while (t in pBS) and (t <= 255) do
INC(t);
lastToken := pred(t);
// ------------------------------------------------------------
// Append "," to the result if this founded range is not the
// first in the result.
// ------------------------------------------------------------
if result <> '' then
result := result + ',';
// ------------------------------------------------------------
// Build the first "bit" into the result
// ------------------------------------------------------------
result := result + DelphiTokenFormater( firstToken, pVocab);
// ------------------------------------------------------------
// Build range if the firstChar not equals to the lastChar
// ------------------------------------------------------------
if firstToken <> lastToken then
result := result + '..' + DelphiTokenFormater( lastToken, pVocab);
end;
end;
}
// ----------------------------------------------------------------------------
// CharSetToStr
// ----------------------------------------------------------------------------
function CharSetToStr( pBS : TCharSet;
pFmt : TCharFormater): AnsiString;
var
c : integer;
firstChar: AnsiChar;
lastChar : AnsiChar;
begin
result := '';
c := 0;
while c <= 255 do
begin
// ------------------------------------------------------------
// Find the first "bit" of the range
// ------------------------------------------------------------
while (not (AnsiChar(c) in pBS)) and (c <= 255) do
INC(c);
// ------------------------------------------------------------
// Check that we are reached the end
// ------------------------------------------------------------
if c = 256 then
break;
// ------------------------------------------------------------
// OK, we found the first "bit" of the range
// ------------------------------------------------------------
firstChar := AnsiChar(c);
// ------------------------------------------------------------
// Find the last "bit" of the range
// ------------------------------------------------------------
while (AnsiChar(c) in pBS) and (c <= 255) do
INC(c);
lastChar := pred(AnsiChar(c));
// ------------------------------------------------------------
// Append "," to the result if this founded range is not the
// first in the result.
// ------------------------------------------------------------
if result <> '' then
result := result + ',';
// ------------------------------------------------------------
// Build the first "bit" into the result
// ------------------------------------------------------------
result := result + DelphiCharFormater( firstChar);
// ------------------------------------------------------------
// Build range if the firstChar not equals to the lastChar
// ------------------------------------------------------------
if firstChar <> lastChar then
result := result + '..' + DelphiCharFormater( lastChar);
end;
end;
// ----------------------------------------------------------------------------
// CharSetToStr
// ----------------------------------------------------------------------------
function CharSetToStr( pBS : TByteSet;
pFmt : TCharFormater): AnsiString;
var
c : integer;
firstChar: AnsiChar;
lastChar : AnsiChar;
begin
result := '';
c := 0;
while c <= 255 do
begin
// ------------------------------------------------------------
// Find the first "bit" of the range
// ------------------------------------------------------------
while (not (c in pBS)) and (c <= 255) do
INC(c);
// ------------------------------------------------------------
// Check that we are reached the end
// ------------------------------------------------------------
if c = 256 then
break;
// ------------------------------------------------------------
// OK, we found the first "bit" of the range
// ------------------------------------------------------------
firstChar := AnsiChar(c);
// ------------------------------------------------------------
// Fin the last "bit" of the range
// ------------------------------------------------------------
while (c in pBS) and (c <= 255) do
INC(c);
lastChar := AnsiChar(pred(c));
// ------------------------------------------------------------
// Append "," to the result if this founded range is not the
// first in the result.
// ------------------------------------------------------------
if result <> '' then
result := result + ',';
// ------------------------------------------------------------
// Build the first "bit" into the result
// ------------------------------------------------------------
result := result + DelphiCharFormater( firstChar);
// ------------------------------------------------------------
// Build range if the firstChar not equals to the lastChar
// ------------------------------------------------------------
if firstChar <> lastChar then
result := result + '..' + DelphiCharFormater( lastChar);
end;
end;
// ----------------------------------------------------------------------------
// IsNumber
// ----------------------------------------------------------------------------
function IsNumber( c: AnsiChar): boolean;
begin
result := ctNumber in cTable[c];
end;
// ----------------------------------------------------------------------------
// IsAlpha
// ----------------------------------------------------------------------------
function IsAlpha( c: AnsiChar): boolean;
begin
result := ctAlpha in cTable[c];
end;
// ----------------------------------------------------------------------------
// IsAlnum
// ----------------------------------------------------------------------------
function IsAlnum( c: AnsiChar): boolean;
begin
result := ctAlnum in cTable[c];
end;
// ----------------------------------------------------------------------------
// IsPrint
// ----------------------------------------------------------------------------
function IsPrint( c: AnsiChar): boolean;
begin
result := ctPrint in cTable[c];
end;
// ================================================================================================
// Convert string to a valid identifier name
// ================================================================================================
function StringToID( s: AnsiString): AnsiString;
var
i: integer;
c: AnsiChar;
begin
result := '';
for c in s do
begin
if IsAlnum(c) then
result := result +c
else if IsPrint(c) then
case c of
' ' : result := result + '_SPACE_';
'!' : result := result + '_EXCL_';
'#' : result := result + '_SHARP_';
'$' : result := result + '_DOLLAR_';
'§' : result := result + '_PARA_';
'%' : result := result + '_PERCENT_';
'&' : result := result + '_AND_';
'''' : result := result + '_APOSTROPHE_';
'(' : result := result + '_LPAREN_';
')' : result := result + '_RPAREN_';
'*' : result := result + '_STAR_';
'+' : result := result + '_PLUS_';
',' : result := result + '_COMMA_';
'-' : result := result + '_MINUS_';
'.' : result := result + '_DOT_';
'/' : result := result + '_SLASH_';
':' : result := result + '_COLON_';
';' : result := result + '_SEMI_';
'<' : result := result + '_LT_';
'=' : result := result + '_EQ_';
'>' : result := result + '_GT_';
'?' : result := result + '_QUESTION_';
'@' : result := result + '_AT_';
'[' : result := result + '_LBRACKET_';
'\' : result := result + '_BS_';
']' : result := result + '_RBRACKET_';
'^' : result := result + '_CARET_';
'{' : result := result + '_LCURLY_';
'|' : result := result + '_OR_';
'}' : result := result + '_RCURLY_';
'~' : result := result + '_TILDE_';
else result := result + Format('_0x2.2%x_',[c]);
end;
end;
if (Length(result) > 0) and (RightStr( result, 1) = '_') then
result := Copy( result, 1, Length(result)-1);
end;
// ****************************************************************************
// Initialization/finalization
// ****************************************************************************
initialization
for c:=#0 to #255 do
cTable[c] := [ctOther];
cTable[ ' '] := [ctPrint];
cTable[ '!'] := [ctPrint];
cTable[ '"'] := [ctPrint];
cTable[ '#'] := [ctPrint];
cTable[ '$'] := [ctPrint];
cTable[ '§'] := [ctPrint];
cTable[ '%'] := [ctPrint];
cTable[ '&'] := [ctPrint];
cTable[ ''''] := [ctPrint];
cTable[ '('] := [ctPrint];
cTable[ ')'] := [ctPrint];
cTable[ '*'] := [ctPrint];
cTable[ '+'] := [ctPrint];
cTable[ ','] := [ctPrint];
cTable[ '-'] := [ctPrint];
cTable[ '.'] := [ctPrint];
cTable[ '/'] := [ctPrint];
cTable[ '0'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '1'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '2'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '3'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '4'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '5'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '6'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '7'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '8'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '9'] := [ctPrint, ctNumber, ctAlnum];
cTable[ ':'] := [ctPrint];
cTable[ ';'] := [ctPrint];
cTable[ '<'] := [ctPrint];
cTable[ '='] := [ctPrint];
cTable[ '>'] := [ctPrint];
cTable[ '?'] := [ctPrint];
cTable[ '@'] := [ctPrint];
cTable[ 'A'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'B'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'C'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'D'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'E'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'F'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'G'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'H'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'I'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'J'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'K'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'L'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'M'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'N'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'O'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'P'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'Q'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'R'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'S'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'T'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'U'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'V'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'W'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'X'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'Y'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'Z'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ '['] := [ctPrint];
cTable[ '\'] := [ctPrint];
cTable[ ']'] := [ctPrint];
cTable[ '^'] := [ctPrint];
cTable[ '_'] := [ctPrint];
cTable[ '`'] := [ctPrint];
cTable[ 'a'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'b'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'c'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'd'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'e'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'f'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'g'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'h'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'i'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'j'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'k'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'l'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'm'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'n'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'o'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'p'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'q'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'r'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 's'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 't'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'u'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'v'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'w'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'x'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'y'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'z'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ '{'] := [ctPrint];
cTable[ '|'] := [ctPrint];
cTable[ '}'] := [ctPrint];
cTable[ '~'] := [ctPrint];
end.
src.lib/dpglib.Version.pas
+9
View File
@@ -0,0 +1,9 @@
unit dpglib.Version;
interface
const
version: string = '2.1.0.0r';
implementation
end.
src.lib/dpglib.WildCardElem.pas
+107
View File
@@ -0,0 +1,107 @@
unit dpglib.WildCardElem;
interface
uses
dpgrtl.types,
dpglib.Types,
dpglib.GrammarAtom;
type
// =========================================================================
// Class TWildcardElem declaration
// =========================================================================
TWildcardElem = class( TGrammarAtom,
IwildcardElem,
IGrammarAtom,
IAlternativeElem,
IGrammarElem)
// ---------------------------------------------------------------
// Constructor/destructor
// ---------------------------------------------------------------
public
constructor Create( pGrammar : IGrammar;
pToken : IToken;
pAutoGenType: integer);
// ---------------------------------------------------------------
// IGrammarElem overrides
// ---------------------------------------------------------------
public
procedure Generate;
function Look( pK: integer): ILookahead;
function AsString: AnsiString;
// ---------------------------------------------------------------
// IAlternativeElem overrides
// ---------------------------------------------------------------
protected
function Get_Label : AnsiString;
procedure Put_Label( pLabel: AnsiString);
end;
implementation
// ****************************************************************************
// Constructor/destructor
// ****************************************************************************
// ============================================================================
// Constructor
// ============================================================================
constructor TWildcardElem.Create( pGrammar : IGrammar;
pToken : IToken;
pAutoGenType: integer);
begin
inherited Create( pGrammar, pToken, pAutoGenType);
fLine := pToken.TokenLine;
end;
// ****************************************************************************
// IGrammarElem overrides
// ****************************************************************************
// ============================================================================
// Generate
// ============================================================================
procedure TWildcardElem.Generate;
begin
fGrammar.Generator.gen( self);
end;
// ============================================================================
// Look
// ============================================================================
function TWildcardElem.Look(pK: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look( pK, self);
end;
// ============================================================================
// AsString
// ============================================================================
function TWildcardElem.AsString: AnsiString;
begin
result := '';
if fLabel <> '' then result := result + fLabel + ':';
result := result + '.';
end;
// ****************************************************************************
// IAlternativeElem overrides
// ****************************************************************************
// ============================================================================
// Get_Label
// ============================================================================
function TWildcardElem.Get_Label: AnsiString;
begin
result := fLabel;
end;
// ============================================================================
// Put_Label
// ============================================================================
procedure TWildcardElem.Put_Label(pLabel: AnsiString);
begin
fLabel := pLabel;
end;
end.
src.lib/dpglib.ZeroOrMoreBlock.pas
+60
View File
@@ -0,0 +1,60 @@
unit dpglib.ZeroOrMoreBlock;
interface
uses
dpgrtl.types,
dpglib.types,
dpglib.BlockWithImpliedExitPath;
type
TZeroOrMoreBlock = class( TBlockWithImpliedExitPath,
IZeroOrMoreBlock,
IBlockWithImpliedExitPath,
IAlternativeBlock,
IAlternativeElem,
IGrammarElem)
// ----------------------------------------------------------------------
// IGrammarElem overrides
// ----------------------------------------------------------------------
public
procedure Generate;
function Look( pK: integer): ILookahead;
function AsString : AnsiString;
end;
implementation
// @@@: IGrammarElem overrides ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
//
// IGrammarElem overrides
//
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// ================================================================================================
// Generate
// ================================================================================================
procedure TZeroOrMoreBlock.Generate;
begin
fGrammar.Generator.Gen( self);
end;
// ================================================================================================
// Look
// ================================================================================================
function TZeroOrMoreBlock.Look(pK: integer): ILookahead;
begin
result := fGrammar.LLkAnalyzer.Look( pK, self)
end;
// ================================================================================================
// AsString
// ================================================================================================
function TZeroOrMoreBlock.AsString: AnsiString;
begin
result := inherited AsString + '*'
end;
end.
src.lib/dpglib.types.pas
+1402
View File
File diff suppressed because it is too large Load Diff
src.lib/grammar/dpglib.DpgLexer.g
+356
View File
@@ -0,0 +1,356 @@
unit dpglib.DpgLexer;
lexer TDpgLexer;
options
{
testLiterals = false;
k = 2;
}
tokens
{
"unit";
"uses";
"const";
"type";
"lexer";
"parser";
"treeparser";
"options";
"tokens";
"memberdecl";
"memberdef";
"private";
"protected";
"public";
"returns";
"local";
"except";
"finally";
SEMPRED;
USES;
OPTIONS;
TOKENS;
}
// ----------------------------------------------------------------------------
// Simple tokens
// ----------------------------------------------------------------------------
LPAREN: '(';
RPAREN: ')';
RCURLY: '}';
COLON: ':';
SEMI: ';';
COMMA: ',';
ASSIGN: '=';
IMPLIES: "=>";
QUEST: '?';
PLUS: '+';
STAR: '*';
AT: '@';
NOT: '~';
OR: '|';
BANG: '!';
WILDCARD: '.';
RANGE: "..";
OPEN: '<';
CLOSE: '>';
CARET: '^';
TREE_BEGIN: "#(";
// ----------------------------------------------------------------------------
// Character literal
// ----------------------------------------------------------------------------
CHARLIT
: '\''! (ESC | ~'\'') '\''! ;
// ----------------------------------------------------------------------------
// String literal
// ----------------------------------------------------------------------------
STRINGLIT
: '"' (ESC | ~'"')* '"' ;
// ----------------------------------------------------------------------------
// Integer
// ----------------------------------------------------------------------------
INTEGER
local
{
i: integer;
v: integer;
}
:
(
DNUMBER
{
v := 0;
for i:=1 to Length( TokenText) do
begin
v := v * 10 + ord( TokenText[i]) - ord('0');
end;
TokenText := IntToStr( v);
}
|
XNUMBER
{
v := 0;
for i:=1 to Length( TokenText) do
begin
case TokenText[i] of
'0'..'9': v := v * 16 + ord(TokenText[i]) - ord('0');
'a'..'z': v := v * 16 + ord(TokenText[i]) - ord('a');
'A'..'Z': v := v * 16 + ord(TokenText[i]) - ord('A');
end;
end;
TokenText := IntToStr( v);
}
)
;
// ----------------------------------------------------------------------------
// Argument action
// ----------------------------------------------------------------------------
ARGACTION
:
'['!
(
options
{
generateAmbigWarnings = false;
}
: '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
| ~']'
)*
']'!
;
// ----------------------------------------------------------------------------
// Action
// ----------------------------------------------------------------------------
ACTION
:
'{'
(
options
{
generateAmbigWarnings = false;
}
: '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
| ~'}'
)*
'}'
( '?'! { _ttype := TT_SEMPRED; } )?
;
// ----------------------------------------------------------------------------
// Token ref
// ----------------------------------------------------------------------------
TOKENREF
options
{
testLiterals = true;
}
: 'A'..'Z' ('a'..'z' | 'A'..'Z' | '_' | '0'..'9')* ;
// ----------------------------------------------------------------------------
// Rule ref
// ----------------------------------------------------------------------------
RULEREF
local
{
t: integer;
}
:
t = INT_RULEREF { _ttype := t; }
(
{t = LT_uses}? WS_LOOP ('{' { _ttype := TT_USES; } )?
| {t = LT_options}? WS_LOOP ('{' { _ttype := TT_OPTIONS; } )?
| {t = LT_tokens}? WS_LOOP ('{' { _ttype := TT_TOKENS; } )?
)?
;
// ----------------------------------------------------------------------------
// Internal rule ref
// ----------------------------------------------------------------------------
protected
INT_RULEREF returns [integer]
{
_ttype := TT_RULEREF;
}
: 'a'..'z' ('a'..'z' | 'A'..'Z' | '_' | '0'..'9')*
{
result := TestLiteral( _ttype);
}
;
// ----------------------------------------------------------------------------
// COMMENT
// ----------------------------------------------------------------------------
COMMENT
: SLCOMMENT { _ttype := TT_SKIP; }
| MLCOMMENT1 { _ttype := TT_SKIP; }
| MLCOMMENT2 { _ttype := TT_SKIP; }
;
// ----------------------------------------------------------------------------
// SLCOMMENT
// ----------------------------------------------------------------------------
protected
SLCOMMENT
:
"//"
( ~( '\r' | '\n') )*
(
options
{
generateAmbigWarnings = false;
}
: '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
)
;
// ============================================================================
// Multi line comment version 1
// Nested comments aren't allowed!
// ============================================================================
protected
MLCOMMENT1
:
"(*"
(
options
{
greedy = false;
generateAmbigWarnings = false;
}
: '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
| .
)*
"*)"
;
// ============================================================================
// Multi line comment version 2
// Nested comments aren't allowed!
// ============================================================================
protected
MLCOMMENT2
:
"/*"
(
options
{
greedy = false;
generateAmbigWarnings = false;
}
: '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
| .
)*
"*/"
;
// ----------------------------------------------------------------------------
// Numbers
// ----------------------------------------------------------------------------
protected DNUMBER: '0'..'9' (DDIGIT)*;
protected XNUMBER: '$'! (XDIGIT)+;
// ----------------------------------------------------------------------------
// Digits
// ----------------------------------------------------------------------------
protected DDIGIT: '0'..'9';
protected XDIGIT: '0'..'9' | 'a'..'f' | 'A'..'F';
// ----------------------------------------------------------------------------
// WS
// ----------------------------------------------------------------------------
WS
:
(
options
{
generateAmbigWarnings = false;
}
: ' '
| '\t' { tab; }
| '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
)
{
_ttype := TT_SKIP;
}
;
// ----------------------------------------------------------------------------
// WS_LOOP
// ----------------------------------------------------------------------------
protected
WS_LOOP
:
(
options
{
greedy = true;
}
: WS
| COMMENT
)*
;
// ----------------------------------------------------------------------------
// Esc
// ----------------------------------------------------------------------------
protected
ESC
local
{
number: AnsiString;
}
:
'\\'!
(
'r' { TokenText[ Length( TokenText)] := AnsiChar(13); }
| 'n' { TokenText[ Length( TokenText)] := AnsiChar(10); }
| 't' { TokenText[ Length( TokenText)] := AnsiChar(9); }
| '\\'
| '\''
| '"'
| 'x' d1:XDIGIT! d2:XDIGIT!
{
number := '$' + d1.TokenText + d2.TokenText;
TokenText[ Length( TokenText)] := AnsiChar( StrToInt( number));
}
)
;
src.lib/grammar/dpglib.DpgLexer.pas
+1879
View File
File diff suppressed because it is too large Load Diff
src.lib/grammar/dpglib.DpgLexerTokens.pas
+77
View File
@@ -0,0 +1,77 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.1.0.0r
// Grammar: dpglib.dpgLexer.g
// ============================================================================
unit dpglib.DpgLexerTokens;
interface
const
TT_TREE_BEGIN = 46;
LT_finally = 21;
TT_QUEST = 34;
TT_INT_RULEREF = 54;
TT_IMPLIES = 33;
LT_returns = 18;
TT_WILDCARD = 41;
TT_OR = 39;
TT_CLOSE = 44;
TT_WS = 63;
LT_public = 17;
TT_RCURLY = 28;
TT_COMMA = 31;
LT_parser = 9;
LT_unit = 4;
TT_CHARLIT = 47;
LT_tokens = 12;
LT_uses = 5;
TT_SEMI = 30;
TT_ASSIGN = 32;
TT_OPEN = 43;
LT_treeparser = 10;
LT_memberdecl = 13;
TT_OPTIONS = 24;
TT_AT = 37;
LT_local = 19;
TT_SEMPRED = 22;
TT_CARET = 45;
TT_MLCOMMENT2 = 58;
TT_DDIGIT = 61;
LT_lexer = 8;
LT_memberdef = 14;
TT_RULEREF = 53;
LT_except = 20;
TT_COLON = 29;
TT_EOF = 1;
LT_protected = 16;
TT_INTEGER = 49;
TT_STAR = 36;
TT_ACTION = 51;
LT_type = 7;
LT_private = 15;
TT_LPAREN = 26;
TT_RPAREN = 27;
TT_BANG = 40;
TT_MLCOMMENT1 = 57;
TT_DNUMBER = 59;
TT_TOKENS = 25;
TT_ESC = 65;
TT_USES = 23;
TT_TOKENREF = 52;
TT_NOT = 38;
TT_SLCOMMENT = 56;
TT_STRINGLIT = 48;
TT_XDIGIT = 62;
TT_WS_LOOP = 64;
LT_options = 11;
LT_const = 6;
TT_ARGACTION = 50;
TT_RANGE = 42;
TT_PLUS = 35;
TT_XNUMBER = 60;
TT_COMMENT = 55;
implementation
end.
src.lib/grammar/dpglib.DpgLexerTokens.txt
+65
View File
@@ -0,0 +1,65 @@
// $Delphi Parser Generator: dpglib.dpgLexer.g -> dpglib.dpgLexer.gTokens.txt$
TDpgLexer
TT_TREE_BEGIN=46
LT_finally="finally"=21
TT_QUEST=34
TT_INT_RULEREF=54
TT_IMPLIES=33
LT_returns="returns"=18
TT_WILDCARD=41
TT_OR=39
TT_CLOSE=44
TT_WS=63
LT_public="public"=17
TT_RCURLY=28
TT_COMMA=31
LT_parser="parser"=9
LT_unit="unit"=4
TT_CHARLIT=47
LT_tokens="tokens"=12
LT_uses="uses"=5
TT_SEMI=30
TT_ASSIGN=32
TT_OPEN=43
LT_treeparser="treeparser"=10
LT_memberdecl="memberdecl"=13
TT_OPTIONS=24
TT_AT=37
LT_local="local"=19
TT_SEMPRED=22
TT_CARET=45
TT_MLCOMMENT2=58
TT_DDIGIT=61
LT_lexer="lexer"=8
LT_memberdef="memberdef"=14
TT_RULEREF=53
LT_except="except"=20
TT_COLON=29
TT_EOF=1
LT_protected="protected"=16
TT_INTEGER=49
TT_STAR=36
TT_ACTION=51
LT_type="type"=7
LT_private="private"=15
TT_LPAREN=26
TT_RPAREN=27
TT_BANG=40
TT_MLCOMMENT1=57
TT_DNUMBER=59
TT_TOKENS=25
TT_ESC=65
TT_USES=23
TT_TOKENREF=52
TT_NOT=38
TT_SLCOMMENT=56
TT_STRINGLIT=48
TT_XDIGIT=62
TT_WS_LOOP=64
LT_options="options"=11
LT_const="const"=6
TT_ARGACTION=50
TT_RANGE=42
TT_PLUS=35
TT_XNUMBER=60
TT_COMMENT=55
src.lib/grammar/dpglib.DpgParser.g
+889
View File
@@ -0,0 +1,889 @@
unit dpglib.DpgParser;
uses
{
dpglib.types;
}
parser TDpgParser;
options
{
defaultErrorHandler = false;
importVocab = dpglib.DpgLexer;
exportVocab = dpglib.DpgParser;
k = 2;
}
memberdecl
{
protected
fGrammarMaker : IGrammarBehavior;
fTool : ITool;
fNesting : integer;
fExchangeDir : AnsiString;
fGrammarFile : AnsiString;
fGrammarUnit : AnsiString;
private
function lastInRule : boolean;
procedure checkEndRule( pToken: IToken);
public
constructor Create( pParserState : IParserState;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString); overload;
constructor Create( pTokenBuffer : ITokenBuffer;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString); overload;
constructor Create( pTokenStream : ITokenStream;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString); overload;
destructor Destroy; override;
}
// ----------------------------------------------------------------------------
// grammar
// ----------------------------------------------------------------------------
grammar
local
{
unitName: IToken;
}
:
"unit" unitName=qualifiedId {fGrammarUnit := unitName.TokenText;} SEMI
(usesDecl)?
(constDecl)?
(typeDecl)?
classDecl
{fGrammarMaker.endGrammar;}
;
// ----------------------------------------------------------------------------
// usesDecl
// ----------------------------------------------------------------------------
usesDecl
:
USES
(
// tr:TOKENREF SEMI {fGrammarMaker.defineUses( tr);}
// | rr:RULEREF SEMI {fGrammarMaker.defineUses( rr);}
qualifiedUsesName SEMI
)*
RCURLY
;
qualifiedUsesName
local
{
id: AnsiString;
}
: ( r:TOKENREF | r:RULEREF ) { id := r.TokenText; }
( WILDCARD
( r:TOKENREF | r:RULEREF) { id := id +'.'+ r.TokenText; }
)*
{
fGrammarMaker.defineUses(id);
}
;
// ----------------------------------------------------------------------------
// constDecl
// ----------------------------------------------------------------------------
constDecl
:
"const"
a:ACTION {fGrammarMaker.RefConstAction( a);}
;
// ----------------------------------------------------------------------------
// typeDecl
// ----------------------------------------------------------------------------
typeDecl
:
"type"
a:ACTION {fGrammarMaker.RefTypeAction( a);}
;
// ----------------------------------------------------------------------------
// classDecl
// ----------------------------------------------------------------------------
classDecl
local
{
grType : integer;
grObject : IToken;
grSuper : IToken;
}
{
grObject := nil;
grSuper := nil;
}
:
// ------------------------------------------------------------
// Determine parser type
// ------------------------------------------------------------
( "lexer" { grType := 0; }
| "parser" { grType := 1; }
| "treeparser" { grType := 2; }
)
// ------------------------------------------------------------
// get class name
// ------------------------------------------------------------
grObject = id
// ------------------------------------------------------------
// get superclass name
// ------------------------------------------------------------
// (
// LPAREN
// grSuper=id
// RPAREN
// )?
SEMI
// ------------------------------------------------------------
// Start the grammar
// ------------------------------------------------------------
{
// ---------------------------------------------------------
// Now we have enough information to start the grammar.
// ---------------------------------------------------------
case grType of
0: fGrammarMaker.StartLexer( InputState.FileName,
grObject,
grSuper);
1: fGrammarMaker.StartParser( InputState.FileName,
grObject,
grSuper);
2: fGrammarMaker.StartTreeWalker( InputState.FileName,
grObject,
grSuper);
end;
fGrammarMaker.defineGrammarUnit( fGrammarUnit);
}
// ------------------------------------------------------------
// Process optional class "options {...}" clause
// ------------------------------------------------------------
(classOptions)?
// ------------------------------------------------------------
// Process optional class "tokens {...}" clause
// But only for lexers.
// ------------------------------------------------------------
( {grType=0}? classTokens)?
// ------------------------------------------------------------
// Process optional class "memberDecl {...}" clause
// ------------------------------------------------------------
(classMemberDecl)?
// ------------------------------------------------------------
// Well, the rules
// ------------------------------------------------------------
rules
// ------------------------------------------------------------
// Process optional class "memberDecl {...}" clause
// ------------------------------------------------------------
(classMemberDef)?
;
// ----------------------------------------------------------------------------
// classOptions
// ----------------------------------------------------------------------------
classOptions
local
{
optName : IToken;
optValue : IToken;
}
:
OPTIONS
(
optName = id
ASSIGN
optValue = optionValue
SEMI
{fGrammarMaker.setGrammarOption( optName, optValue);}
)*
RCURLY
;
// ----------------------------------------------------------------------------
// classTokens
// ----------------------------------------------------------------------------
classTokens
:
TOKENS
(
{
tokenName := nil;
tokenString := nil;
}
(
tokenName:TOKENREF (ASSIGN tokenString:STRINGLIT)?
{
fGrammarMaker.defineToken( tokenName, tokenString);
}
(tokenSpecOptions[tokenName])?
| tokenString:STRINGLIT
{
fGrammarMaker.defineToken( tokenName, tokenString);
}
(tokenSpecOptions[tokenString])?
)
SEMI
)*
RCURLY
;
// ----------------------------------------------------------------------------
// tokenSpecOptions
// ----------------------------------------------------------------------------
tokenSpecOptions[ t: IToken]
local
{
name : IToken;
value : IToken;
}
{
name := nil;
value := nil;
}
: OPEN
name=id ASSIGN value=optionValue
{
fGrammarMaker.refTokenSpecElemOption( t, name, value);
}
(
name=id ASSIGN value=optionValue
{
fGrammarMaker.refTokenSpecElemOption( t, name, value);
}
)*
CLOSE
;
// ----------------------------------------------------------------------------
// classMemberDecl
// ----------------------------------------------------------------------------
classMemberDecl
:
"memberDecl"
memberDecl:ACTION
{fGrammarMaker.refMemberDecl(memberDecl);}
;
// ----------------------------------------------------------------------------
// classMemberDef
// ----------------------------------------------------------------------------
classMemberDef
:
"memberDef"
memberDef:ACTION
{fGrammarMaker.refMemberDef(memberDef);}
;
// ----------------------------------------------------------------------------
// rules
// ----------------------------------------------------------------------------
rules
:
(rule)*
;
// ----------------------------------------------------------------------------
// ruleExceptionBlock
// ----------------------------------------------------------------------------
ruleExceptionBlock
:
t:"except" a:ACTION { fGrammarMaker.RefRuleExHandler( t, a); }
| t:"finally" a:ACTION { fGrammarMaker.RefRuleExHandler( t, a); }
;
// ----------------------------------------------------------------------------
// ruleExceptionBlock
// ----------------------------------------------------------------------------
altExceptionBlock
:
t:"except" a:ACTION { fGrammarMaker.RefAltExHandler( t, a); }
| t:"finally" a:ACTION { fGrammarMaker.RefAltExHandler( t, a); }
;
// ----------------------------------------------------------------------------
// rule
// ----------------------------------------------------------------------------
rule
local
{
access : AnsiString;
ag : integer;
returns : IToken;
name : IToken;
}
{
access := 'public';
args := nil;
name := nil;
ag := AUTOGEN_NONE;
}
:
// ------------------------------------------------------------
// Parse rule scope
// ------------------------------------------------------------
( "public" { access := 'public'; }
| "protected" { access := 'protected'; }
| "private" { access := 'private'; }
)?
// ------------------------------------------------------------
// Parse rule name
// ------------------------------------------------------------
name=id
// ------------------------------------------------------------
// Parse optional BANG operator
// ------------------------------------------------------------
// ( BANG { ag := AUTOGEN_BANG;} )?
// ------------------------------------------------------------
// Optional arguments
// ------------------------------------------------------------
( args:ARGACTION)?
// ------------------------------------------------------------
// Optional return type
// ------------------------------------------------------------
( "returns" ret:ARGACTION)?
// ------------------------------------------------------------
// Now start the rule definition
// ------------------------------------------------------------
{
fGrammarMaker.defineRuleName( name, access, true, '');
if args <> nil then
fGrammarMaker.refArgAction( args);
if ret <> nil then
fGrammarMaker.refReturnAction( ret);
}
// ------------------------------------------------------------
// Optional rule options
// ------------------------------------------------------------
(ruleOptions)?
// ------------------------------------------------------------
// Optional rule local variable declarations
// ------------------------------------------------------------
(
"local"
locals:ACTION
{fGrammarMaker.refRuleLocals( locals);}
)?
// ------------------------------------------------------------
// Optional rule init action
// ------------------------------------------------------------
(
initAction:ACTION
{fGrammarMaker.refInitAction( initAction);}
)?
// ------------------------------------------------------------
// Rule block
// ------------------------------------------------------------
COLON
block
SEMI
// ------------------------------------------------------------
// Optional exception handler
// ------------------------------------------------------------
( ruleExceptionBlock)?
// ------------------------------------------------------------
// Finish the rule
// ------------------------------------------------------------
{ fGrammarMaker.endRule('');}
;
// ----------------------------------------------------------------------------
// block
// ----------------------------------------------------------------------------
block
{
INC( fNesting);
}
: alternative (OR alternative)* {DEC(fNesting);}
;
// ----------------------------------------------------------------------------
// alternative
// ----------------------------------------------------------------------------
alternative
local
{
autoGen : boolean;
}
{
autoGen := true;
}
:
// (BANG {autoGen := false;})?
{fGrammarMaker.beginAlt( autoGen);}
(elem)*
(altExceptionBlock)?
{fGrammarMaker.endAlt;}
;
// ----------------------------------------------------------------------------
// elem
// ----------------------------------------------------------------------------
elem
: element (elementOptions)?
;
// ----------------------------------------------------------------------------
// element options
// ----------------------------------------------------------------------------
elementOptions
local
{
name : IToken;
value : IToken;
}
: OPEN
name=id ASSIGN value=optionValue
{
fGrammarMaker.refElemOption(name,value);
}
(
name=id ASSIGN value=optionValue
{
fGrammarMaker.refElemOption(name,value);
}
)*
CLOSE
;
// ----------------------------------------------------------------------------
// element
// ----------------------------------------------------------------------------
element
local
{
assignId : IToken;
assignLabel : IToken;
autoGen : integer;
}
{
assignId := nil;
assignLabel := nil;
autoGen := AUTOGEN_NONE;
}
:
(
assignId=id ASSIGN
(assignLabel=id COLON {checkEndRule(assignLabel);})?
(
ruleRef:RULEREF (args:ARGACTION)? (ag:BANG {autoGen := AUTOGEN_BANG;})?
{fGrammarMaker.refRule( assignId, ruleRef, assignLabel, args, autoGen);}
|
tokenRef:TOKENREF (args:ARGACTION)?
{fGrammarMaker.refToken( assignId, tokenRef, assignLabel, args, false, autoGen, lastInRule);}
)
)
|
(assignLabel=id COLON {checkEndRule(assignLabel);})?
(
ruleRef:RULEREF (args:ARGACTION)? (ag:BANG {autoGen := AUTOGEN_BANG;})?
{fGrammarMaker.refRule( assignId, ruleRef, assignLabel, args, autoGen);}
| range[assignLabel]
| terminal[assignLabel]
| NOT (notTerminal[assignLabel] | ebnf[ assignLabel, true])
| ebnf[ assignLabel, false]
)
|
action:ACTION
{fGrammarMaker.refAction( action);}
|
semPred:SEMPRED
{fGrammarMaker.refSemPred( semPred);}
|
tree
;
// ----------------------------------------------------------------------------
// tree
// ----------------------------------------------------------------------------
tree
: lp:TREE_BEGIN { fGrammarMaker.BeginTree(lp); }
rootNode { fGrammarMaker.BeginChildList; }
(element)+ { fGrammarMaker.EndChildList; }
RPAREN { fGrammarMaker.EndTree; }
;
// ----------------------------------------------------------------------------
// rootNode
// ----------------------------------------------------------------------------
rootNode
local
{
l : IToken;
}
: (
l=id COLON
{
CheckEndRule(l);
}
)?
terminal[l]
;
// ----------------------------------------------------------------------------
// range
// ----------------------------------------------------------------------------
range [pTokenLabel: IToken]
local
{
autoGen: integer;
}
{
autoGen := AUTOGEN_NONE;
}
:
crLeft:CHARLIT
RANGE
crRight:CHARLIT
(BANG {autoGen := AUTOGEN_BANG;} )?
{fGrammarMaker.refCharRange( crLeft, crRight, pTokenLabel, autoGen, lastInRule);}
|
(trLeft:TOKENREF | trLeft:STRINGLIT)
RANGE
(trRight:TOKENREF | trRight:STRINGLIT)
autoGen=astTypeSpec
{fGrammarMaker.refTokenRange( trLeft, trRight, pTokenLabel, autoGen, lastInRule);}
;
// ----------------------------------------------------------------------------
// terminal
// ----------------------------------------------------------------------------
terminal [pTokenLabel: IToken]
local
{
autoGen : integer;
}
{
autoGen := AUTOGEN_NONE;
aa := nil;
}
:
cl:CHARLIT
(BANG {autoGen := AUTOGEN_BANG;} )?
{fGrammarMaker.refCharLiteral( cl, pTokenLabel, false, autoGen, lastInRule);}
|
tr:TOKENREF
autoGen=astTypeSpec
(aa:ARGACTION)?
{fGrammarMaker.refToken( nil, tr, pTokenLabel, aa, false, autoGen, lastInRule);}
|
sl:STRINGLIT
autoGen=astTypeSpec
{fGrammarMaker.refStringLiteral( sl, pTokenLabel, autoGen, lastInRule);}
|
wc:WILDCARD
autogen=astTypeSpec
{fGrammarMaker.refWildCard( wc, pTokenLabel, autoGen);}
;
// ----------------------------------------------------------------------------
// notTerminal
// ----------------------------------------------------------------------------
notTerminal [pTokenLabel: IToken]
local
{
autoGen : integer;
}
{
autoGen := AUTOGEN_NONE;
}
:
cl:CHARLIT
(BANG {autoGen := AUTOGEN_BANG;} )?
{fGrammarMaker.refCharLiteral( cl, pTokenLabel, true, autoGen, lastInRule);}
|
tr:TOKENREF
autoGen=astTypeSpec
{fGrammarMaker.refToken( nil, tr, pTokenLabel, nil, true, autoGen, lastInRule);}
;
// ----------------------------------------------------------------------------
// ebnf
// ----------------------------------------------------------------------------
ebnf [pTokenLabel: IToken; pTokenNot: boolean]
:
lp:LPAREN
{fGrammarMaker.beginSubrule( pTokenLabel, lp, pTokenNot);}
(
// ---------------------------------------------------------
// 2nd alt and optional branch ambig due to linear approx
// LL(2) issue. COLON ACTION matched correctly in 2nd alt.
// ---------------------------------------------------------
options
{
warnWhenFollowAmbig = false;
}
:
subRuleOptions
(aa:ACTION {fGrammarMaker.refInitAction(aa);} )?
COLON
|
aa:ACTION {fGrammarMaker.refInitAction(aa);}
COLON
)?
block
RPAREN
(
( QUEST { fGrammarMaker.optionalSubrule; }
| STAR { fGrammarMaker.zeroOrMoreSubrule; }
| PLUS { fGrammarMaker.oneOrMoreSubrule; }
| AT { fGrammarMaker.nmSubrule; }
LPAREN
(
m:INTEGER { fGrammarMaker.refRangeLow( StrToInt(m.TokenText)); }
(
COMMA { fGrammarMaker.refRangeHigh( maxint); }
(
n:INTEGER { fGrammarMaker.refRangeHigh(StrToInt(n.TokenText)); }
)?
)?
|
COMMA
n:INTEGER { fGrammarMaker.refRangeHigh(StrToInt(n.TokenText)); }
)
RPAREN
| IMPLIES {fGrammarMaker.synPred; }
)?
// ( BANG {fGrammarMaker.noASTSubrule;} )?
)
{fGrammarMaker.endSubRule;}
;
// ----------------------------------------------------------------------------
// optionValue
// ----------------------------------------------------------------------------
optionValue returns [IToken]
:
result=qualifiedId
| result:STRINGLIT
| result:CHARLIT
| result:INTEGER
;
// ----------------------------------------------------------------------------
// subruleOptions
// ----------------------------------------------------------------------------
subruleOptions
local
{
optName : IToken;
optValue : IToken;
}
:
OPTIONS
(
optName = id
ASSIGN
optValue = optionValue
SEMI
{fGrammarMaker.setSubruleOption( optName, optValue);}
)*
RCURLY
;
// ----------------------------------------------------------------------------
// ruleOptions
// ----------------------------------------------------------------------------
ruleOptions
local
{
optName : IToken;
optValue : IToken;
}
:
OPTIONS
(
optName = id
ASSIGN
optValue = optionValue
SEMI
{fGrammarMaker.setRuleOption( optName, optValue);}
)*
RCURLY
;
// ----------------------------------------------------------------------------
// astTypeSpec
// ----------------------------------------------------------------------------
astTypeSpec returns [integer]
{
result := AUTOGEN_NONE;
}
:
( CARET { result := AUTOGEN_CARET; }
| BANG { result := AUTOGEN_BANG; }
)?
;
// ----------------------------------------------------------------------------
// qualifiedId
// ----------------------------------------------------------------------------
qualifiedId returns [IToken]
local
{
buf : AnsiString;
a : IToken;
}
:
a=id { buf := a.TokenText; }
(
WILDCARD a=id { buf := buf + '.' + a.TokenText; }
)*
{
// -----------------------------------------------------------
// Can either TOKENREF or RULEREF. Should really create QID or
// something else instead.
// -----------------------------------------------------------
result := TToken.Create( TT_TOKENREF, buf);
result.TokenLine := a.TokenLine;
result.TokenColumn := a.TokenColumn;
}
;
// ----------------------------------------------------------------------------
// id
// ----------------------------------------------------------------------------
id returns [IToken]
:
result:TOKENREF
| result:RULEREF
;
memberdef
{
// ============================================================================
// Constructor
// ============================================================================
constructor TDpgParser.Create( pParserState : IParserState;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString);
begin
inherited Create( pParserState, 2);
fGrammarMaker := pGrammarMaker;
fExchangeDir := pExchangeDir;
fTool := pTool;
fNesting := 0;
end;
// ============================================================================
// Constructor
// ============================================================================
constructor TDpgParser.Create( pTokenBuffer : ITokenBuffer;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString);
begin
inherited Create( pTokenBuffer, 2);
fGrammarMaker := pGrammarMaker;
fExchangeDir := pExchangeDir;
fTool := pTool;
fNesting := 0;
end;
// ============================================================================
// Constructor
// ============================================================================
constructor TDpgParser.Create( pTokenStream : ITokenStream;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString);
begin
inherited Create( pTokenStream, 2);
fGrammarMaker := pGrammarMaker;
fExchangeDir := pExchangeDir;
fTool := pTool;
fNesting := 0;
end;
// ============================================================================
// Destructor
// ============================================================================
destructor TDpgParser.Destroy;
begin
fGrammarMaker := nil;
fTool := nil;
inherited;
end;
// ============================================================================
// lastInRule
// ============================================================================
function TDpgParser.lastInRule: boolean;
begin
if (fNesting = 0) and (LA(1) in [TT_SEMI, TT_OR])
then result := true
else result := false;
end;
// ============================================================================
// checkEndRule
// ============================================================================
procedure TDpgParser.checkEndRule( pToken: IToken);
begin
if pToken <> nil then
if pToken.TokenColumn = 1 then
fTool.Warning('Did you forget to close the previous rule?',
InputState.FileName,
pToken.TokenLine,
pToken.TokenColumn);
end;
}
src.lib/grammar/dpglib.DpgParser.pas
+1457
View File
File diff suppressed because it is too large Load Diff
src.lib/grammar/dpglib.DpgParserTokens.pas
+77
View File
@@ -0,0 +1,77 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.1.0.0r
// Grammar: dpglib.dpgParser.g
// ============================================================================
unit dpglib.DpgParserTokens;
interface
const
TT_TREE_BEGIN = 46;
LT_finally = 21;
TT_QUEST = 34;
TT_INT_RULEREF = 54;
TT_IMPLIES = 33;
LT_returns = 18;
TT_WILDCARD = 41;
TT_OR = 39;
TT_CLOSE = 44;
TT_WS = 63;
LT_public = 17;
TT_RCURLY = 28;
TT_COMMA = 31;
LT_parser = 9;
TT_CHARLIT = 47;
LT_unit = 4;
LT_tokens = 12;
LT_uses = 5;
TT_SEMI = 30;
TT_ASSIGN = 32;
TT_OPEN = 43;
LT_treeparser = 10;
LT_memberdecl = 13;
TT_OPTIONS = 24;
TT_AT = 37;
LT_local = 19;
TT_SEMPRED = 22;
TT_CARET = 45;
TT_MLCOMMENT2 = 58;
TT_DDIGIT = 61;
LT_lexer = 8;
LT_memberdef = 14;
TT_RULEREF = 53;
LT_except = 20;
TT_COLON = 29;
TT_EOF = 1;
LT_protected = 16;
TT_INTEGER = 49;
TT_STAR = 36;
TT_ACTION = 51;
LT_type = 7;
LT_private = 15;
TT_LPAREN = 26;
TT_RPAREN = 27;
TT_BANG = 40;
TT_MLCOMMENT1 = 57;
TT_DNUMBER = 59;
TT_TOKENS = 25;
TT_ESC = 65;
TT_USES = 23;
TT_TOKENREF = 52;
TT_NOT = 38;
TT_SLCOMMENT = 56;
TT_STRINGLIT = 48;
TT_XDIGIT = 62;
TT_WS_LOOP = 64;
LT_options = 11;
LT_const = 6;
TT_ARGACTION = 50;
TT_RANGE = 42;
TT_PLUS = 35;
TT_XNUMBER = 60;
TT_COMMENT = 55;
implementation
end.
src.lib/grammar/dpglib.DpgParserTokens.txt
+65
View File
@@ -0,0 +1,65 @@
// $Delphi Parser Generator: dpglib.dpgParser.g -> dpglib.dpgParser.gTokens.txt$
TDpgParser
TT_TREE_BEGIN=46
LT_finally="finally"=21
TT_QUEST=34
TT_INT_RULEREF=54
TT_IMPLIES=33
LT_returns="returns"=18
TT_WILDCARD=41
TT_OR=39
TT_CLOSE=44
TT_WS=63
LT_public="public"=17
TT_RCURLY=28
TT_COMMA=31
LT_parser="parser"=9
TT_CHARLIT=47
LT_unit="unit"=4
LT_tokens="tokens"=12
LT_uses="uses"=5
TT_SEMI=30
TT_ASSIGN=32
TT_OPEN=43
LT_treeparser="treeparser"=10
LT_memberdecl="memberdecl"=13
TT_OPTIONS=24
TT_AT=37
LT_local="local"=19
TT_SEMPRED=22
TT_CARET=45
TT_MLCOMMENT2=58
TT_DDIGIT=61
LT_lexer="lexer"=8
LT_memberdef="memberdef"=14
TT_RULEREF=53
LT_except="except"=20
TT_COLON=29
TT_EOF=1
LT_protected="protected"=16
TT_INTEGER=49
TT_STAR=36
TT_ACTION=51
LT_type="type"=7
LT_private="private"=15
TT_LPAREN=26
TT_RPAREN=27
TT_BANG=40
TT_MLCOMMENT1=57
TT_DNUMBER=59
TT_TOKENS=25
TT_ESC=65
TT_USES=23
TT_TOKENREF=52
TT_NOT=38
TT_SLCOMMENT=56
TT_STRINGLIT=48
TT_XDIGIT=62
TT_WS_LOOP=64
LT_options="options"=11
LT_const="const"=6
TT_ARGACTION=50
TT_RANGE=42
TT_PLUS=35
TT_XNUMBER=60
TT_COMMENT=55
src.lib/grammar/dpglib.TokenLexer.g
+110
View File
@@ -0,0 +1,110 @@
unit dpglib.TokenLexer;
lexer TTokenLexer;
options
{
k = 2;
testLiterals = false;
}
// ----------------------------------------------------------------------------
// Simple tokens
// ----------------------------------------------------------------------------
LPAREN : '(';
RPAREN : ')';
ASSIGN : '=';
STRING : '"' (~'"')* '"';
// ----------------------------------------------------------------------------
// DIGIT
// ----------------------------------------------------------------------------
protected
DIGIT
: '0'..'9'
;
// ----------------------------------------------------------------------------
// XDIGIT
// ----------------------------------------------------------------------------
protected
XDIGIT
: '0'..'9'
| 'a'..'f'
| 'A'..'F'
;
// ----------------------------------------------------------------------------
// ID
// ----------------------------------------------------------------------------
ID
: ('a'..'z' | 'A'..'Z')
('a'..'z' | 'A'..'Z' | '_' | '0'..'9')*
;
// ----------------------------------------------------------------------------
// INT
// ----------------------------------------------------------------------------
INT
: (DIGIT)+
;
// ----------------------------------------------------------------------------
// WS
// ----------------------------------------------------------------------------
WS
:
(
' '
| '\t'
| '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
)
{
_ttype := TT_SKIP;
}
;
// ----------------------------------------------------------------------------
// SLCOMMENT
// ----------------------------------------------------------------------------
SLCOMMENT
: "//"
( ~( '\r' | '\n'))*
(
options
{
generateAmbigWarnings = false;
}
: '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
)
{
_ttype := TT_SKIP;
}
;
// ----------------------------------------------------------------------------
// MLCOMMENT
// ----------------------------------------------------------------------------
MLCOMMENT
: "(*"
(
options
{
greedy = false;
generateAmbigWarnings= false;
}
: '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
| ~('\r' | '\n')
)*
"*)"
{
_ttype := TT_SKIP;
}
;
src.lib/grammar/dpglib.TokenLexer.pas
+622
View File
@@ -0,0 +1,622 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.1.0.0r
// Grammar: dpglib.tokenLexer.g
// ============================================================================
unit dpglib.TokenLexer;
interface
uses
System.Classes,
dpglib.TokenLexerTokens,
dpgrtl.lexer,
dpgrtl.types,
System.SysUtils;
type
// =========================================================================
// Class TTokenLexer declaration
// =========================================================================
TTokenLexer = class( TLexer)
public // Protected grammar rules
// Must callable from parser too
procedure mDIGIT ( pCreate: boolean);
procedure mXDIGIT ( pCreate: boolean);
public // Public grammar rules
procedure mLPAREN ( pCreate: boolean);
procedure mRPAREN ( pCreate: boolean);
procedure mASSIGN ( pCreate: boolean);
procedure mSTRING ( pCreate: boolean);
procedure mID ( pCreate: boolean);
procedure mINT ( pCreate: boolean);
procedure mWS ( pCreate: boolean);
procedure mSLCOMMENT ( pCreate: boolean);
procedure mMLCOMMENT ( pCreate: boolean);
public
function NextToken: IToken; override;
end;
implementation
uses
dpgrtl.exception,
dpgrtl.token;
// ============================================================================
// mLPAREN
// ============================================================================
procedure TTokenLexer.mLPAREN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_LPAREN;
match('(');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mRPAREN
// ============================================================================
procedure TTokenLexer.mRPAREN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_RPAREN;
match(')');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mASSIGN
// ============================================================================
procedure TTokenLexer.mASSIGN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_ASSIGN;
match('=');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mSTRING
// ============================================================================
procedure TTokenLexer.mSTRING( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_STRING;
match('"');
while(true) do
begin
if (( LA(1) in [#1..'!','#'..#255])) then
begin
matchNot('"');
end
else
break;
end;
match('"');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mDIGIT
// ============================================================================
procedure TTokenLexer.mDIGIT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_DIGIT;
match( ['0'..'9']);
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mXDIGIT
// ============================================================================
procedure TTokenLexer.mXDIGIT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_XDIGIT;
if (( LA(1) in ['0'..'9'])) then
begin
match( ['0'..'9']);
end
else if (( LA(1) in ['a'..'f'])) then
begin
match( ['a'..'f']);
end
else if (( LA(1) in ['A'..'F'])) then
begin
match( ['A'..'F']);
end
else
Raise EMismatchedChar.Create( LA(1), ['0'..'9','A'..'F','a'..'f'], InputState.FileName, InputState.Line, InputState.Column);
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mID
// ============================================================================
procedure TTokenLexer.mID( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_ID;
if (( LA(1) in ['a'..'z'])) then
begin
match( ['a'..'z']);
end
else if (( LA(1) in ['A'..'Z'])) then
begin
match( ['A'..'Z']);
end
else
Raise EMismatchedChar.Create( LA(1), ['A'..'Z','a'..'z'], InputState.FileName, InputState.Line, InputState.Column);
while(true) do
begin
if (( LA(1) in ['a'..'z'])) then
begin
match( ['a'..'z']);
end
else if (( LA(1) in ['A'..'Z'])) then
begin
match( ['A'..'Z']);
end
else if (( LA(1) in ['_'])) then
begin
match('_');
end
else if (( LA(1) in ['0'..'9'])) then
begin
match( ['0'..'9']);
end
else
break;
end;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mINT
// ============================================================================
procedure TTokenLexer.mINT( pCreate: boolean);
var
_begin: integer;
_cnt_15: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_INT;
_cnt_15 := 0;
while(true) do
begin
if (( LA(1) in ['0'..'9'])) then
begin
mDIGIT(false);
end
else
begin
if _cnt_15 >= 1 then
break
else
Raise EMismatchedChar.Create( LA(1), ['0'..'9'], InputState.FileName, InputState.Line, InputState.Column);
end;
INC(_cnt_15);
end;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mWS
// ============================================================================
procedure TTokenLexer.mWS( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_WS;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [' '])) then
begin
match(' ');
end
else if (( LA(1) in [#9])) then
begin
match(#9);
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else
Raise EMismatchedChar.Create( LA(1), [#9..#10,#13,' '], InputState.FileName, InputState.Line, InputState.Column);
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mSLCOMMENT
// ============================================================================
procedure TTokenLexer.mSLCOMMENT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_SLCOMMENT;
match('//');
while(true) do
begin
if (( LA(1) in [#1..#9,#11..#12,#14..#255])) then
begin
match( [#1..#9,#11..#12,#14..#255]);
end
else
break;
end;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else
Raise EMismatchedChar.Create( LA(1), [#10,#13], InputState.FileName, InputState.Line, InputState.Column);
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mMLCOMMENT
// ============================================================================
procedure TTokenLexer.mMLCOMMENT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_MLCOMMENT;
match('(*');
while(true) do
begin
// non-greedy exit test
if( LA(1) in ['*']) and (LA(2) in [')']) then
break;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else if (( LA(1) in [#1..#9,#11..#12,#14..#255])) then
begin
match( [#1..#9,#11..#12,#14..#255]);
end
else
break;
end;
match('*)');
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ----------------------------------------------------------------------------
// NextToken
// ----------------------------------------------------------------------------
function TTokenLexer.NextToken : IToken;
var
_first : TCharSet;
begin
_first := [#9..#10,#13,' ','"','('..')','/'..'9','=','A'..'Z','a'..'z'];
while( true) do
begin
ResetText;
try
if (( LA(1) in ['(']) and (LA(2) in ['*'])) then
begin
mMLCOMMENT(true);
result := ReturnToken;
end
else if (( LA(1) in ['('])) then
begin
mLPAREN(true);
result := ReturnToken;
end
else if (( LA(1) in [')'])) then
begin
mRPAREN(true);
result := ReturnToken;
end
else if (( LA(1) in ['='])) then
begin
mASSIGN(true);
result := ReturnToken;
end
else if (( LA(1) in ['"'])) then
begin
mSTRING(true);
result := ReturnToken;
end
else if (( LA(1) in ['A'..'Z','a'..'z'])) then
begin
mID(true);
result := ReturnToken;
end
else if (( LA(1) in ['0'..'9'])) then
begin
mINT(true);
result := ReturnToken;
end
else if (( LA(1) in [#9..#10,#13,' '])) then
begin
mWS(true);
result := ReturnToken;
end
else if (( LA(1) in ['/'])) then
begin
mSLCOMMENT(true);
result := ReturnToken;
end
else
begin
if LA(1) = EOF_CHAR then
begin
uponEof;
result := TToken.Create(TT_EOF);
end
else
Raise EMismatchedChar.Create(LA(1), _first, InputState.FileName, InputState.Line, InputState.Column);
end;
// --------------------------------------------------------------
// If we found a SKIP token, then try again...
// --------------------------------------------------------------
if result = nil then
continue;
// --------------------------------------------------------------
// Now we have a valid token, so exit the function
// --------------------------------------------------------------
break;
except
Raise;
end;
end;
end;
end.
src.lib/grammar/dpglib.TokenLexerTokens.pas
+26
View File
@@ -0,0 +1,26 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.1.0.0r
// Grammar: dpglib.tokenLexer.g
// ============================================================================
unit dpglib.TokenLexerTokens;
interface
const
TT_ID = 10;
TT_STRING = 7;
TT_EOF = 1;
TT_XDIGIT = 9;
TT_SLCOMMENT = 13;
TT_ASSIGN = 6;
TT_WS = 12;
TT_LPAREN = 4;
TT_RPAREN = 5;
TT_DIGIT = 8;
TT_MLCOMMENT = 14;
TT_INT = 11;
implementation
end.
src.lib/grammar/dpglib.TokenLexerTokens.txt
+14
View File
@@ -0,0 +1,14 @@
// $Delphi Parser Generator: dpglib.tokenLexer.g -> dpglib.tokenLexer.gTokens.txt$
TTokenLexer
TT_ID=10
TT_STRING=7
TT_EOF=1
TT_XDIGIT=9
TT_SLCOMMENT=13
TT_ASSIGN=6
TT_WS=12
TT_LPAREN=4
TT_RPAREN=5
TT_DIGIT=8
TT_MLCOMMENT=14
TT_INT=11
src.lib/grammar/dpglib.TokenParser.g
+87
View File
@@ -0,0 +1,87 @@
unit dpglib.TokenParser;
uses
{
dpglib.Types;
dpglib.StringSymbol;
dpglib.TokenSymbol;
}
parser TTokenParser;
options
{
importVocab = dpglib.TokenLexer;
k = 3;
}
tokenFile [tm:ITokenManager]
:
name: ID
(tokenLine[tm])*
;
tokenLine [tm:ITokenManager]
local
{
t : IToken;
s : IToken;
v : integer;
sl: IStringSymbol;
ts: ITokenSymbol;
x : AnsiString;
}
: {
t := nil;
s := nil;
}
( s1: STRING { s := s1; }
| lab: ID { t := lab; }
ASSIGN
s2: STRING { s := s2; }
| id: ID { t := id; }
LPAREN
para: STRING
RPAREN
| id2: ID { t := id2; }
)
ASSIGN
i: INT {
v := StrToIntDef( i.TokenText, -1);
if s <> nil then
begin
ts := TStringSymbol.Create( s.TokenText);
ts.TokenType := v;
tm.Define(ts);
if t <> nil then
begin
ts := tm.TokenSymbol[s.TokenText];
ts.QueryInterface( IStringSymbol, sl);
sl.Lbl := t.TokenText;
tm.MapToTokenSymbol( t.TokenText, sl);
end;
end
else if t <> nil then
begin
x := Copy( t.TokenText, 4, Length( t.TokenText)-3);
ts := TTokenSymbol.Create( x);
ts.TokenType := v;
tm.Define( ts);
if para <> nil then
begin
ts := tm.TokenSymbol[ t.TokenText];
ts.Paraphrase := para.TokenText;
end;
end;
}
;
src.lib/grammar/dpglib.TokenParser.pas
+161
View File
@@ -0,0 +1,161 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.1.0.0r
// Grammar: dpglib.tokenParser.g
// ============================================================================
unit dpglib.TokenParser;
interface
uses
System.Classes,
dpglib.StringSymbol,
dpglib.TokenParserTokens,
dpglib.TokenSymbol,
dpglib.Types,
dpgrtl.llkparser,
dpgrtl.types,
System.SysUtils;
type
// =========================================================================
// Class TTokenParser declaration
// =========================================================================
TTokenParser = class( TLLkParser)
public // Public grammar rules
procedure tokenFile ( tm:ITokenManager);
procedure tokenLine ( tm:ITokenManager);
end;
implementation
uses
dpgrtl.exception,
dpgrtl.token;
// ============================================================================
// tokenFile
// ============================================================================
procedure TTokenParser.tokenFile( tm:ITokenManager);
var
name: IToken;
begin
name := LT(1);
match(TT_ID);
while(true) do
begin
if (( LA(1) in [TT_STRING,TT_ID])) then
begin
tokenLine(tm);
end
else
break;
end;
end;
// ============================================================================
// tokenLine
// ============================================================================
procedure TTokenParser.tokenLine( tm:ITokenManager);
var
i: IToken;
id: IToken;
id2: IToken;
lab: IToken;
para: IToken;
s1: IToken;
s2: IToken;
t : IToken;
s : IToken;
v : integer;
sl: IStringSymbol;
ts: ITokenSymbol;
x : AnsiString;
begin
t := nil;
s := nil;
if (( LA(1) in [TT_STRING])) then
begin
s1 := LT(1);
match(TT_STRING);
s := s1;
end
else if (( LA(1) in [TT_ID]) and (LA(2) in [TT_ASSIGN]) and (LA(3) in [TT_STRING])) then
begin
lab := LT(1);
match(TT_ID);
t := lab;
match(TT_ASSIGN);
s2 := LT(1);
match(TT_STRING);
s := s2;
end
else if (( LA(1) in [TT_ID]) and (LA(2) in [TT_LPAREN])) then
begin
id := LT(1);
match(TT_ID);
t := id;
match(TT_LPAREN);
para := LT(1);
match(TT_STRING);
match(TT_RPAREN);
end
else if (( LA(1) in [TT_ID]) and (LA(2) in [TT_ASSIGN]) and (LA(3) in [TT_INT])) then
begin
id2 := LT(1);
match(TT_ID);
t := id2;
end
else
Raise EMismatchedToken.Create( LT(1), [TT_STRING,TT_ID], InputState.FileName);
match(TT_ASSIGN);
i := LT(1);
match(TT_INT);
v := StrToIntDef( i.TokenText, -1);
if s <> nil then
begin
ts := TStringSymbol.Create( s.TokenText);
ts.TokenType := v;
tm.Define(ts);
if t <> nil then
begin
ts := tm.TokenSymbol[s.TokenText];
ts.QueryInterface( IStringSymbol, sl);
sl.Lbl := t.TokenText;
tm.MapToTokenSymbol( t.TokenText, sl);
end;
end
else if t <> nil then
begin
x := Copy( t.TokenText, 4, Length( t.TokenText)-3);
ts := TTokenSymbol.Create( x);
ts.TokenType := v;
tm.Define( ts);
if para <> nil then
begin
ts := tm.TokenSymbol[ t.TokenText];
ts.Paraphrase := para.TokenText;
end;
end;
end;
end.
src.lib/grammar/dpglib.TokenParserTokens.pas
+26
View File
@@ -0,0 +1,26 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.1.0.0r
// Grammar: dpglib.tokenParser.g
// ============================================================================
unit dpglib.TokenParserTokens;
interface
const
TT_ID = 10;
TT_STRING = 7;
TT_EOF = 1;
TT_SLCOMMENT = 13;
TT_XDIGIT = 9;
TT_ASSIGN = 6;
TT_WS = 12;
TT_LPAREN = 4;
TT_RPAREN = 5;
TT_DIGIT = 8;
TT_MLCOMMENT = 14;
TT_INT = 11;
implementation
end.
src.lib/grammar/dpglib.TokenParserTokens.txt
+14
View File
@@ -0,0 +1,14 @@
// $Delphi Parser Generator: dpglib.tokenParser.g -> dpglib.tokenParser.gTokens.txt$
TTokenParser
TT_ID=10
TT_STRING=7
TT_EOF=1
TT_SLCOMMENT=13
TT_XDIGIT=9
TT_ASSIGN=6
TT_WS=12
TT_LPAREN=4
TT_RPAREN=5
TT_DIGIT=8
TT_MLCOMMENT=14
TT_INT=11
src.lib/grammar/test/Lexer.g
+349
View File
@@ -0,0 +1,349 @@
unit z.dpglib.DpgLexer;
lexer TDpgLexer;
options
{
testLiterals = false;
k = 2;
}
tokens
{
"unit";
"uses";
"const";
"type";
"lexer";
"parser";
"options";
"tokens";
"memberdecl";
"memberdef";
"private";
"protected";
"public";
"returns";
"local";
"except";
"finally";
SEMPRED;
USES;
OPTIONS;
TOKENS;
}
// ----------------------------------------------------------------------------
// Simple tokens
// ----------------------------------------------------------------------------
LPAREN: '(';
RPAREN: ')';
RCURLY: '}';
COLON: ':';
SEMI: ';';
COMMA: ',';
ASSIGN: '=';
IMPLIES: "=>";
QUEST: '?';
PLUS: '+';
STAR: '*';
AT: '@';
NOT: '~';
OR: '|';
BANG: '!';
WILDCARD: '.';
RANGE: "..";
// ----------------------------------------------------------------------------
// Character literal
// ----------------------------------------------------------------------------
CHARLIT
: '\''! (ESC | ~'\'') '\''! ;
// ----------------------------------------------------------------------------
// String literal
// ----------------------------------------------------------------------------
STRINGLIT
: '"' (ESC | ~'"')* '"' ;
// ----------------------------------------------------------------------------
// Integer
// ----------------------------------------------------------------------------
INTEGER
local
{
i: integer;
v: integer;
}
:
(
DNUMBER
{
v := 0;
for i:=1 to Length( TokenText) do
begin
v := v * 10 + ord( TokenText[i]) - ord('0');
end;
TokenText := IntToStr( v);
}
|
XNUMBER
{
v := 0;
for i:=1 to Length( TokenText) do
begin
case TokenText[i] of
'0'..'9': v := v * 16 + ord(TokenText[i]) - ord('0');
'a'..'z': v := v * 16 + ord(TokenText[i]) - ord('a');
'A'..'Z': v := v * 16 + ord(TokenText[i]) - ord('A');
end;
end;
TokenText := IntToStr( v);
}
)
;
// ----------------------------------------------------------------------------
// Argument action
// ----------------------------------------------------------------------------
ARGACTION
:
'['!
(
options
{
generateAmbigWarnings = false;
}
: '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
| ~']'
)*
']'!
;
// ----------------------------------------------------------------------------
// Action
// ----------------------------------------------------------------------------
ACTION
:
'{'
(
options
{
generateAmbigWarnings = false;
}
: '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
| ~'}'
)*
'}'
( '?'! { _ttype := TT_SEMPRED; } )?
;
// ----------------------------------------------------------------------------
// Token ref
// ----------------------------------------------------------------------------
TOKENREF
options
{
testLiterals = true;
}
: 'A'..'Z' ('a'..'z' | 'A'..'Z' | '_' | '0'..'9')* ;
// ----------------------------------------------------------------------------
// Rule ref
// ----------------------------------------------------------------------------
RULEREF
local
{
t: integer;
}
:
t = INT_RULEREF { _ttype := t; }
(
{t = LT_uses}? WS_LOOP ('{' { _ttype := TT_USES; } )?
| {t = LT_options}? WS_LOOP ('{' { _ttype := TT_OPTIONS; } )?
| {t = LT_tokens}? WS_LOOP ('{' { _ttype := TT_TOKENS; } )?
)?
;
// ----------------------------------------------------------------------------
// Internal rule ref
// ----------------------------------------------------------------------------
protected
INT_RULEREF returns [integer]
{
_ttype := TT_RULEREF;
}
: 'a'..'z' ('a'..'z' | 'A'..'Z' | '_' | '0'..'9')*
{
result := TestLiteral( _ttype);
}
;
// ----------------------------------------------------------------------------
// COMMENT
// ----------------------------------------------------------------------------
COMMENT
: SLCOMMENT { _ttype := TT_SKIP; }
| MLCOMMENT1 { _ttype := TT_SKIP; }
| MLCOMMENT2 { _ttype := TT_SKIP; }
;
// ----------------------------------------------------------------------------
// SLCOMMENT
// ----------------------------------------------------------------------------
protected
SLCOMMENT
:
"//"
( ~( '\r' | '\n') )*
(
options
{
generateAmbigWarnings = false;
}
: '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
)
;
// ============================================================================
// Multi line comment version 1
// Nested comments aren't allowed!
// ============================================================================
protected
MLCOMMENT1
:
"(*"
(
options
{
greedy = false;
generateAmbigWarnings = false;
}
: '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
| .
)*
"*)"
;
// ============================================================================
// Multi line comment version 2
// Nested comments aren't allowed!
// ============================================================================
protected
MLCOMMENT2
:
"/*"
(
options
{
greedy = false;
generateAmbigWarnings = false;
}
: '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
| .
)*
"*/"
;
// ----------------------------------------------------------------------------
// Numbers
// ----------------------------------------------------------------------------
protected DNUMBER: '0'..'9' (DDIGIT)*;
protected XNUMBER: '$'! (XDIGIT)+;
// ----------------------------------------------------------------------------
// Digits
// ----------------------------------------------------------------------------
protected DDIGIT: '0'..'9';
protected XDIGIT: '0'..'9' | 'a'..'f' | 'A'..'F';
// ----------------------------------------------------------------------------
// WS
// ----------------------------------------------------------------------------
WS
:
(
options
{
generateAmbigWarnings = false;
}
: ' '
| '\t' { tab; }
| '\r' '\n' { newLine; }
| '\r' { newLine; }
| '\n' { newLine; }
)
{
_ttype := TT_SKIP;
}
;
// ----------------------------------------------------------------------------
// WS_LOOP
// ----------------------------------------------------------------------------
protected
WS_LOOP
:
(
options
{
greedy = true;
}
: WS
| COMMENT
)*
;
// ----------------------------------------------------------------------------
// Esc
// ----------------------------------------------------------------------------
protected
ESC
local
{
number: AnsiString;
}
:
'\\'!
(
'r' { TokenText[ Length( TokenText)] := AnsiChar(13); }
| 'n' { TokenText[ Length( TokenText)] := AnsiChar(10); }
| 't' { TokenText[ Length( TokenText)] := AnsiChar(9); }
| '\\'
| '\''
| '"'
| 'x' d1:XDIGIT! d2:XDIGIT!
{
number := '$' + d1.TokenText + d2.TokenText;
TokenText[ Length( TokenText)] := AnsiChar( StrToInt( number));
}
)
;
src.lib/grammar/test/Parser.g
+798
View File
@@ -0,0 +1,798 @@
unit z.dpglib.DpgParser;
uses
{
z.dpglib.types;
}
parser TDpgParser;
options
{
defaultErrorHandler = false;
importVocab = z.dpglib.DpgLexer;
exportVocab = z.dpglib.DpgParser;
k = 2;
}
memberdecl
{
protected
fGrammarMaker : IGrammarBehavior;
fTool : ITool;
fNesting : integer;
fExchangeDir : AnsiString;
fGrammarFile : AnsiString;
fGrammarUnit : AnsiString;
private
function lastInRule : boolean;
procedure checkEndRule( pToken: IToken);
public
constructor Create( pParserState : IParserState;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString); overload;
constructor Create( pTokenBuffer : ITokenBuffer;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString); overload;
constructor Create( pTokenStream : ITokenStream;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString); overload;
destructor Destroy; override;
}
// ----------------------------------------------------------------------------
// grammar
// ----------------------------------------------------------------------------
grammar
local
{
unitName: IToken;
}
:
"unit" "[" unitName=qualifiedId {fGrammarUnit := unitName.TokenText;} SEMI
(usesDecl)?
(constDecl)?
(typeDecl)?
classDecl
{fGrammarMaker.endGrammar;}
;
// ----------------------------------------------------------------------------
// usesDecl
// ----------------------------------------------------------------------------
usesDecl
:
USES
(
// tr:TOKENREF SEMI {fGrammarMaker.defineUses( tr);}
// | rr:RULEREF SEMI {fGrammarMaker.defineUses( rr);}
qualifiedUsesName SEMI
)*
RCURLY
;
qualifiedUsesName
local
{
id: AnsiString;
}
: ( r:TOKENREF | r:RULEREF ) { id := r.TokenText; }
( WILDCARD
( r:TOKENREF | r:RULEREF) { id := id +'.'+ r.TokenText; }
)*
{
fGrammarMaker.defineUses(id);
}
;
// ----------------------------------------------------------------------------
// constDecl
// ----------------------------------------------------------------------------
constDecl
:
"const"
a:ACTION {fGrammarMaker.RefConstAction( a);}
;
// ----------------------------------------------------------------------------
// typeDecl
// ----------------------------------------------------------------------------
typeDecl
:
"type"
a:ACTION {fGrammarMaker.RefTypeAction( a);}
;
// ----------------------------------------------------------------------------
// classDecl
// ----------------------------------------------------------------------------
classDecl
local
{
grType : integer;
grObject : IToken;
grSuper : IToken;
}
{
grObject := nil;
grSuper := nil;
}
:
// ------------------------------------------------------------
// Determine parser type
// ------------------------------------------------------------
( "lexer" { grType := 0; }
| "parser" { grType := 1; }
)
// ------------------------------------------------------------
// get class name
// ------------------------------------------------------------
grObject = id
// ------------------------------------------------------------
// get superclass name
// ------------------------------------------------------------
// (
// LPAREN
// grSuper=id
// RPAREN
// )?
SEMI
// ------------------------------------------------------------
// Start the grammar
// ------------------------------------------------------------
{
// ---------------------------------------------------------
// Now we have enough information to start the grammar.
// ---------------------------------------------------------
case grType of
0: fGrammarMaker.StartLexer( InputState.FileName,
grObject,
grSuper);
1: fGrammarMaker.StartParser( InputState.FileName,
grObject,
grSuper);
2: fGrammarMaker.StartTreeWalker( InputState.FileName,
grObject,
grSuper);
end;
fGrammarMaker.defineGrammarUnit( fGrammarUnit);
}
// ------------------------------------------------------------
// Process optional class "options {...}" clause
// ------------------------------------------------------------
(classOptions)?
// ------------------------------------------------------------
// Process optional class "tokens {...}" clause
// But only for lexers.
// ------------------------------------------------------------
( {grType=0}? classTokens)?
// ------------------------------------------------------------
// Process optional class "memberDecl {...}" clause
// ------------------------------------------------------------
(classMemberDecl)?
// ------------------------------------------------------------
// Well, the rules
// ------------------------------------------------------------
rules
// ------------------------------------------------------------
// Process optional class "memberDecl {...}" clause
// ------------------------------------------------------------
(classMemberDef)?
;
// ----------------------------------------------------------------------------
// classOptions
// ----------------------------------------------------------------------------
classOptions
local
{
optName : IToken;
optValue : IToken;
}
:
OPTIONS
(
optName = id
ASSIGN
optValue = optionValue
SEMI
{fGrammarMaker.setGrammarOption( optName, optValue);}
)*
RCURLY
;
// ----------------------------------------------------------------------------
// classTokens
// ----------------------------------------------------------------------------
classTokens
:
TOKENS
(
{
tokenName := nil;
tokenString := nil;
}
(
tokenName: TOKENREF (ASSIGN tokenString:STRINGLIT)?
| tokenString: STRINGLIT
)
SEMI
{fGrammarMaker.defineToken( tokenName, tokenString);}
)*
RCURLY
;
// ----------------------------------------------------------------------------
// classMemberDecl
// ----------------------------------------------------------------------------
classMemberDecl
:
"memberDecl"
memberDecl:ACTION
{fGrammarMaker.refMemberDecl(memberDecl);}
;
// ----------------------------------------------------------------------------
// classMemberDef
// ----------------------------------------------------------------------------
classMemberDef
:
"memberDef"
memberDef:ACTION
{fGrammarMaker.refMemberDef(memberDef);}
;
// ----------------------------------------------------------------------------
// rules
// ----------------------------------------------------------------------------
rules
:
(rule)*
;
// ----------------------------------------------------------------------------
// ruleExceptionBlock
// ----------------------------------------------------------------------------
ruleExceptionBlock
:
t:"except" a:ACTION { fGrammarMaker.RefRuleExHandler( t, a); }
| t:"finally" a:ACTION { fGrammarMaker.RefRuleExHandler( t, a); }
;
// ----------------------------------------------------------------------------
// ruleExceptionBlock
// ----------------------------------------------------------------------------
altExceptionBlock
:
t:"except" a:ACTION { fGrammarMaker.RefAltExHandler( t, a); }
| t:"finally" a:ACTION { fGrammarMaker.RefAltExHandler( t, a); }
;
// ----------------------------------------------------------------------------
// rule
// ----------------------------------------------------------------------------
rule
local
{
access : AnsiString;
ag : integer;
returns : IToken;
name : IToken;
}
{
access := 'public';
args := nil;
name := nil;
ag := AUTOGEN_NONE;
}
:
// ------------------------------------------------------------
// Parse rule scope
// ------------------------------------------------------------
( "public" { access := 'public'; }
| "protected" { access := 'protected'; }
| "private" { access := 'private'; }
)?
// ------------------------------------------------------------
// Parse rule name
// ------------------------------------------------------------
name=id
// ------------------------------------------------------------
// Parse optional BANG operator
// ------------------------------------------------------------
// ( BANG { ag := AUTOGEN_BANG;} )?
// ------------------------------------------------------------
// Optional arguments
// ------------------------------------------------------------
( args:ARGACTION)?
// ------------------------------------------------------------
// Optional return type
// ------------------------------------------------------------
( "returns" ret:ARGACTION)?
// ------------------------------------------------------------
// Now start the rule definition
// ------------------------------------------------------------
{
fGrammarMaker.defineRuleName( name, access, true, '');
if args <> nil then
fGrammarMaker.refArgAction( args);
if ret <> nil then
fGrammarMaker.refReturnAction( ret);
}
// ------------------------------------------------------------
// Optional rule options
// ------------------------------------------------------------
(ruleOptions)?
// ------------------------------------------------------------
// Optional rule local variable declarations
// ------------------------------------------------------------
(
"local"
locals:ACTION
{fGrammarMaker.refRuleLocals( locals);}
)?
// ------------------------------------------------------------
// Optional rule init action
// ------------------------------------------------------------
(
initAction:ACTION
{fGrammarMaker.refInitAction( initAction);}
)?
// ------------------------------------------------------------
// Rule block
// ------------------------------------------------------------
COLON
block
SEMI
// ------------------------------------------------------------
// Optional exception handler
// ------------------------------------------------------------
( ruleExceptionBlock)?
// ------------------------------------------------------------
// Finish the rule
// ------------------------------------------------------------
{ fGrammarMaker.endRule('');}
;
// ----------------------------------------------------------------------------
// block
// ----------------------------------------------------------------------------
block
{
INC( fNesting);
}
: alternative (OR alternative)* {DEC(fNesting);}
;
// ----------------------------------------------------------------------------
// alternative
// ----------------------------------------------------------------------------
alternative
local
{
autoGen : boolean;
}
{
autoGen := true;
}
:
// (BANG {autoGen := false;})?
{fGrammarMaker.beginAlt( autoGen);}
(elem)*
(altExceptionBlock)?
{fGrammarMaker.endAlt;}
;
// ----------------------------------------------------------------------------
// elem
// ----------------------------------------------------------------------------
elem
: element
;
// ----------------------------------------------------------------------------
// element
// ----------------------------------------------------------------------------
element
local
{
assignId : IToken;
assignLabel : IToken;
autoGen : integer;
}
{
assignId := nil;
assignLabel := nil;
autoGen := AUTOGEN_NONE;
}
:
(
assignId=id ASSIGN
(assignLabel=id COLON {checkEndRule(assignLabel);})?
(
ruleRef:RULEREF (args:ARGACTION)? (ag:BANG {autoGen := AUTOGEN_BANG;})?
{fGrammarMaker.refRule( assignId, ruleRef, assignLabel, args, autoGen);}
|
tokenRef:TOKENREF (args:ARGACTION)?
{fGrammarMaker.refToken( assignId, tokenRef, assignLabel, args, false, autoGen, lastInRule);}
)
)
|
(assignLabel=id COLON {checkEndRule(assignLabel);})?
(
ruleRef:RULEREF (args:ARGACTION)? (ag:BANG {autoGen := AUTOGEN_BANG;})?
{fGrammarMaker.refRule( assignId, ruleRef, assignLabel, args, autoGen);}
| range[assignLabel]
| terminal[assignLabel]
| NOT (notTerminal[assignLabel] | ebnf[ assignLabel, true])
| ebnf[ assignLabel, false]
)
|
action:ACTION
{fGrammarMaker.refAction( action);}
|
semPred:SEMPRED
{fGrammarMaker.refSemPred( semPred);}
;
// ----------------------------------------------------------------------------
// range
// ----------------------------------------------------------------------------
range [pTokenLabel: IToken]
local
{
autoGen: integer;
}
{
autoGen := AUTOGEN_NONE;
}
:
crLeft:CHARLIT
RANGE
crRight:CHARLIT
(BANG {autoGen := AUTOGEN_BANG;} )?
{fGrammarMaker.refCharRange( crLeft, crRight, pTokenLabel, autoGen, lastInRule);}
|
(trLeft:TOKENREF | trLeft:STRINGLIT)
RANGE
(trRight:TOKENREF | trRight:STRINGLIT)
autoGen=astTypeSpec
{fGrammarMaker.refTokenRange( trLeft, trRight, pTokenLabel, autoGen, lastInRule);}
;
// ----------------------------------------------------------------------------
// terminal
// ----------------------------------------------------------------------------
terminal [pTokenLabel: IToken]
local
{
autoGen : integer;
}
{
autoGen := AUTOGEN_NONE;
aa := nil;
}
:
cl:CHARLIT
(BANG {autoGen := AUTOGEN_BANG;} )?
{fGrammarMaker.refCharLiteral( cl, pTokenLabel, false, autoGen, lastInRule);}
|
tr:TOKENREF
autoGen=astTypeSpec
(aa:ARGACTION)?
{fGrammarMaker.refToken( nil, tr, pTokenLabel, aa, false, autoGen, lastInRule);}
|
sl:STRINGLIT
autoGen=astTypeSpec
{fGrammarMaker.refStringLiteral( sl, pTokenLabel, autoGen, lastInRule);}
|
wc:WILDCARD
autogen=astTypeSpec
{fGrammarMaker.refWildCard( wc, pTokenLabel, autoGen);}
;
// ----------------------------------------------------------------------------
// notTerminal
// ----------------------------------------------------------------------------
notTerminal [pTokenLabel: IToken]
local
{
autoGen : integer;
}
{
autoGen := AUTOGEN_NONE;
}
:
cl:CHARLIT
(BANG {autoGen := AUTOGEN_BANG;} )?
{fGrammarMaker.refCharLiteral( cl, pTokenLabel, true, autoGen, lastInRule);}
|
tr:TOKENREF
autoGen=astTypeSpec
{fGrammarMaker.refToken( nil, tr, pTokenLabel, nil, true, autoGen, lastInRule);}
;
// ----------------------------------------------------------------------------
// ebnf
// ----------------------------------------------------------------------------
ebnf [pTokenLabel: IToken; pTokenNot: boolean]
:
lp:LPAREN
{fGrammarMaker.beginSubrule( pTokenLabel, lp, pTokenNot);}
(
// ---------------------------------------------------------
// 2nd alt and optional branch ambig due to linear approx
// LL(2) issue. COLON ACTION matched correctly in 2nd alt.
// ---------------------------------------------------------
options
{
warnWhenFollowAmbig = false;
}
:
subRuleOptions
(aa:ACTION {fGrammarMaker.refInitAction(aa);} )?
COLON
|
aa:ACTION {fGrammarMaker.refInitAction(aa);}
COLON
)?
block
RPAREN
(
( QUEST { fGrammarMaker.optionalSubrule; }
| STAR { fGrammarMaker.zeroOrMoreSubrule; }
| PLUS { fGrammarMaker.oneOrMoreSubrule; }
| AT { fGrammarMaker.nmSubrule; }
LPAREN
(
m:INTEGER { fGrammarMaker.refRangeLow( StrToInt(m.TokenText)); }
(
COMMA { fGrammarMaker.refRangeHigh( maxint); }
(
n:INTEGER { fGrammarMaker.refRangeHigh(StrToInt(n.TokenText)); }
)?
)?
|
COMMA
n:INTEGER { fGrammarMaker.refRangeHigh(StrToInt(n.TokenText)); }
)
RPAREN
| IMPLIES {fGrammarMaker.synPred; }
)?
// ( BANG {fGrammarMaker.noASTSubrule;} )?
)
{fGrammarMaker.endSubRule;}
;
// ----------------------------------------------------------------------------
// optionValue
// ----------------------------------------------------------------------------
optionValue returns [IToken]
:
result=qualifiedId
| result:STRINGLIT
| result:CHARLIT
| result:INTEGER
;
// ----------------------------------------------------------------------------
// subruleOptions
// ----------------------------------------------------------------------------
subruleOptions
local
{
optName : IToken;
optValue : IToken;
}
:
OPTIONS
(
optName = id
ASSIGN
optValue = optionValue
SEMI
{fGrammarMaker.setSubruleOption( optName, optValue);}
)*
RCURLY
;
// ----------------------------------------------------------------------------
// ruleOptions
// ----------------------------------------------------------------------------
ruleOptions
local
{
optName : IToken;
optValue : IToken;
}
:
OPTIONS
(
optName = id
ASSIGN
optValue = optionValue
SEMI
{fGrammarMaker.setRuleOption( optName, optValue);}
)*
RCURLY
;
// ----------------------------------------------------------------------------
// astTypeSpec
// ----------------------------------------------------------------------------
astTypeSpec returns [integer]
{
result := AUTOGEN_NONE;
}
:
(BANG {result := AUTOGEN_BANG;})?
;
// ----------------------------------------------------------------------------
// qualifiedId
// ----------------------------------------------------------------------------
qualifiedId returns [IToken]
local
{
buf : AnsiString;
a : IToken;
}
:
a=id { buf := a.TokenText; }
(
WILDCARD a=id { buf := buf + '.' + a.TokenText; }
)*
{
// -----------------------------------------------------------
// Can either TOKENREF or RULEREF. Should really create QID or
// something else instead.
// -----------------------------------------------------------
result := TToken.Create( TT_TOKENREF, buf);
result.TokenLine := a.TokenLine;
result.TokenColumn := a.TokenColumn;
}
;
// ----------------------------------------------------------------------------
// id
// ----------------------------------------------------------------------------
id returns [IToken]
:
result:TOKENREF
| result:RULEREF
;
memberdef
{
// ============================================================================
// Constructor
// ============================================================================
constructor TDpgParser.Create( pParserState : IParserState;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString);
begin
inherited Create( pParserState, 2);
fGrammarMaker := pGrammarMaker;
fExchangeDir := pExchangeDir;
fTool := pTool;
fNesting := 0;
end;
// ============================================================================
// Constructor
// ============================================================================
constructor TDpgParser.Create( pTokenBuffer : ITokenBuffer;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString);
begin
inherited Create( pTokenBuffer, 2);
fGrammarMaker := pGrammarMaker;
fExchangeDir := pExchangeDir;
fTool := pTool;
fNesting := 0;
end;
// ============================================================================
// Constructor
// ============================================================================
constructor TDpgParser.Create( pTokenStream : ITokenStream;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString);
begin
inherited Create( pTokenStream, 2);
fGrammarMaker := pGrammarMaker;
fExchangeDir := pExchangeDir;
fTool := pTool;
fNesting := 0;
end;
// ============================================================================
// Destructor
// ============================================================================
destructor TDpgParser.Destroy;
begin
fGrammarMaker := nil;
fTool := nil;
inherited;
end;
// ============================================================================
// lastInRule
// ============================================================================
function TDpgParser.lastInRule: boolean;
begin
if (fNesting = 0) and (LA(1) in [TT_SEMI, TT_OR])
then result := true
else result := false;
end;
// ============================================================================
// checkEndRule
// ============================================================================
procedure TDpgParser.checkEndRule( pToken: IToken);
begin
if pToken <> nil then
if pToken.TokenColumn = 1 then
fTool.Warning('Did you forget to close the previous rule?',
InputState.FileName,
pToken.TokenLine,
pToken.TokenColumn);
end;
}
src.lib/grammar/test/z.dpglib.DpgLexer.pas
+1746
View File
File diff suppressed because it is too large Load Diff
src.lib/grammar/test/z.dpglib.DpgLexerTokens.pas
+72
View File
@@ -0,0 +1,72 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: lexer.g
// ============================================================================
unit dpglib.DpgLexerTokens;
interface
const
TT_EOF = 1;
LT_unit = 4;
LT_uses = 5;
LT_const = 6;
LT_type = 7;
LT_lexer = 8;
LT_parser = 9;
LT_options = 10;
LT_tokens = 11;
LT_memberdecl = 12;
LT_memberdef = 13;
LT_private = 14;
LT_protected = 15;
LT_public = 16;
LT_returns = 17;
LT_local = 18;
LT_except = 19;
LT_finally = 20;
TT_SEMPRED = 21;
TT_USES = 22;
TT_OPTIONS = 23;
TT_TOKENS = 24;
TT_LPAREN = 25;
TT_RPAREN = 26;
TT_RCURLY = 27;
TT_COLON = 28;
TT_SEMI = 29;
TT_COMMA = 30;
TT_ASSIGN = 31;
TT_IMPLIES = 32;
TT_QUEST = 33;
TT_PLUS = 34;
TT_STAR = 35;
TT_AT = 36;
TT_NOT = 37;
TT_OR = 38;
TT_BANG = 39;
TT_WILDCARD = 40;
TT_RANGE = 41;
TT_CHARLIT = 42;
TT_STRINGLIT = 43;
TT_INTEGER = 44;
TT_ARGACTION = 45;
TT_ACTION = 46;
TT_TOKENREF = 47;
TT_RULEREF = 48;
TT_INT_RULEREF = 49;
TT_COMMENT = 50;
TT_SLCOMMENT = 51;
TT_MLCOMMENT1 = 52;
TT_MLCOMMENT2 = 53;
TT_DNUMBER = 54;
TT_XNUMBER = 55;
TT_DDIGIT = 56;
TT_XDIGIT = 57;
TT_WS = 58;
TT_WS_LOOP = 59;
TT_ESC = 60;
implementation
end.
src.lib/grammar/test/z.dpglib.DpgLexerTokens.txt
+60
View File
@@ -0,0 +1,60 @@
// $Delphi Parser Generator: lexer.g -> lexer.gTokens.txt$
TDpgLexer
TT_EOF=1
LT_unit="unit"=4
LT_uses="uses"=5
LT_const="const"=6
LT_type="type"=7
LT_lexer="lexer"=8
LT_parser="parser"=9
LT_options="options"=10
LT_tokens="tokens"=11
LT_memberdecl="memberdecl"=12
LT_memberdef="memberdef"=13
LT_private="private"=14
LT_protected="protected"=15
LT_public="public"=16
LT_returns="returns"=17
LT_local="local"=18
LT_except="except"=19
LT_finally="finally"=20
TT_SEMPRED=21
TT_USES=22
TT_OPTIONS=23
TT_TOKENS=24
TT_LPAREN=25
TT_RPAREN=26
TT_RCURLY=27
TT_COLON=28
TT_SEMI=29
TT_COMMA=30
TT_ASSIGN=31
TT_IMPLIES=32
TT_QUEST=33
TT_PLUS=34
TT_STAR=35
TT_AT=36
TT_NOT=37
TT_OR=38
TT_BANG=39
TT_WILDCARD=40
TT_RANGE=41
TT_CHARLIT=42
TT_STRINGLIT=43
TT_INTEGER=44
TT_ARGACTION=45
TT_ACTION=46
TT_TOKENREF=47
TT_RULEREF=48
TT_INT_RULEREF=49
TT_COMMENT=50
TT_SLCOMMENT=51
TT_MLCOMMENT1=52
TT_MLCOMMENT2=53
TT_DNUMBER=54
TT_XNUMBER=55
TT_DDIGIT=56
TT_XDIGIT=57
TT_WS=58
TT_WS_LOOP=59
TT_ESC=60
src.lib/save/z.dpglib.DpgLexer.pas
+1749
View File
File diff suppressed because it is too large Load Diff
src.lib/save/z.dpglib.DpgLexerTokens.pas
+72
View File
@@ -0,0 +1,72 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.DpgLexer.g
// ============================================================================
unit dpglib.DpgLexerTokens;
interface
const
TT_EOF = 1;
LT_unit = 4;
LT_uses = 5;
LT_const = 6;
LT_type = 7;
LT_lexer = 8;
LT_parser = 9;
LT_options = 10;
LT_tokens = 11;
LT_memberdecl = 12;
LT_memberdef = 13;
LT_private = 14;
LT_protected = 15;
LT_public = 16;
LT_returns = 17;
LT_local = 18;
LT_except = 19;
LT_finally = 20;
TT_SEMPRED = 21;
TT_USES = 22;
TT_OPTIONS = 23;
TT_TOKENS = 24;
TT_LPAREN = 25;
TT_RPAREN = 26;
TT_RCURLY = 27;
TT_COLON = 28;
TT_SEMI = 29;
TT_COMMA = 30;
TT_ASSIGN = 31;
TT_IMPLIES = 32;
TT_QUEST = 33;
TT_PLUS = 34;
TT_STAR = 35;
TT_AT = 36;
TT_NOT = 37;
TT_OR = 38;
TT_BANG = 39;
TT_WILDCARD = 40;
TT_RANGE = 41;
TT_CHARLIT = 42;
TT_STRINGLIT = 43;
TT_INTEGER = 44;
TT_ARGACTION = 45;
TT_ACTION = 46;
TT_TOKENREF = 47;
TT_RULEREF = 48;
TT_INT_RULEREF = 49;
TT_COMMENT = 50;
TT_SLCOMMENT = 51;
TT_MLCOMMENT1 = 52;
TT_MLCOMMENT2 = 53;
TT_DNUMBER = 54;
TT_XNUMBER = 55;
TT_DDIGIT = 56;
TT_XDIGIT = 57;
TT_WS = 58;
TT_WS_LOOP = 59;
TT_ESC = 60;
implementation
end.
src.lib/save/z.dpglib.DpgParser.pas
+1297
View File
File diff suppressed because it is too large Load Diff
src.lib/save/z.dpglib.DpgParserTokens.pas
+72
View File
@@ -0,0 +1,72 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.DpgParser.g
// ============================================================================
unit dpglib.DpgParserTokens;
interface
const
TT_EOF = 1;
LT_unit = 4;
LT_uses = 5;
LT_const = 6;
LT_type = 7;
LT_lexer = 8;
LT_parser = 9;
LT_options = 10;
LT_tokens = 11;
LT_memberdecl = 12;
LT_memberdef = 13;
LT_private = 14;
LT_protected = 15;
LT_public = 16;
LT_returns = 17;
LT_local = 18;
LT_except = 19;
LT_finally = 20;
TT_SEMPRED = 21;
TT_USES = 22;
TT_OPTIONS = 23;
TT_TOKENS = 24;
TT_LPAREN = 25;
TT_RPAREN = 26;
TT_RCURLY = 27;
TT_COLON = 28;
TT_SEMI = 29;
TT_COMMA = 30;
TT_ASSIGN = 31;
TT_IMPLIES = 32;
TT_QUEST = 33;
TT_PLUS = 34;
TT_STAR = 35;
TT_AT = 36;
TT_NOT = 37;
TT_OR = 38;
TT_BANG = 39;
TT_WILDCARD = 40;
TT_RANGE = 41;
TT_CHARLIT = 42;
TT_STRINGLIT = 43;
TT_INTEGER = 44;
TT_ARGACTION = 45;
TT_ACTION = 46;
TT_TOKENREF = 47;
TT_RULEREF = 48;
TT_INT_RULEREF = 49;
TT_COMMENT = 50;
TT_SLCOMMENT = 51;
TT_MLCOMMENT1 = 52;
TT_MLCOMMENT2 = 53;
TT_DNUMBER = 54;
TT_XNUMBER = 55;
TT_DDIGIT = 56;
TT_XDIGIT = 57;
TT_WS = 58;
TT_WS_LOOP = 59;
TT_ESC = 60;
implementation
end.
src.lib/save/z.dpglib.TokenLexer.pas
+622
View File
@@ -0,0 +1,622 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.TokenLexer.g
// ============================================================================
unit dpglib.TokenLexer;
interface
uses
Classes,
SysUtils,
dpglib.TokenLexerTokens,
dpgrtl.lexer,
dpgrtl.types;
type
// =========================================================================
// Class TTokenLexer declaration
// =========================================================================
TTokenLexer = class( TLexer)
public // Protected grammar rules
// Must callable from parser too
procedure mDIGIT ( pCreate: boolean);
procedure mXDIGIT ( pCreate: boolean);
public // Public grammar rules
procedure mLPAREN ( pCreate: boolean);
procedure mRPAREN ( pCreate: boolean);
procedure mASSIGN ( pCreate: boolean);
procedure mSTRING ( pCreate: boolean);
procedure mID ( pCreate: boolean);
procedure mINT ( pCreate: boolean);
procedure mWS ( pCreate: boolean);
procedure mSLCOMMENT ( pCreate: boolean);
procedure mMLCOMMENT ( pCreate: boolean);
public
function NextToken: IToken; override;
end;
implementation
uses
dpgrtl.exception,
dpgrtl.token;
// ============================================================================
// mLPAREN
// ============================================================================
procedure TTokenLexer.mLPAREN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_LPAREN;
match('(');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mRPAREN
// ============================================================================
procedure TTokenLexer.mRPAREN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_RPAREN;
match(')');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mASSIGN
// ============================================================================
procedure TTokenLexer.mASSIGN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_ASSIGN;
match('=');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mSTRING
// ============================================================================
procedure TTokenLexer.mSTRING( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_STRING;
match('"');
while(true) do
begin
if (( LA(1) in [#1..'!','#'..#255])) then
begin
matchNot('"');
end
else
break;
end;
match('"');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mDIGIT
// ============================================================================
procedure TTokenLexer.mDIGIT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_DIGIT;
match( ['0'..'9']);
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mXDIGIT
// ============================================================================
procedure TTokenLexer.mXDIGIT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_XDIGIT;
if (( LA(1) in ['0'..'9'])) then
begin
match( ['0'..'9']);
end
else if (( LA(1) in ['a'..'f'])) then
begin
match( ['a'..'f']);
end
else if (( LA(1) in ['A'..'F'])) then
begin
match( ['A'..'F']);
end
else
Raise EMismatchedChar.Create( LA(1), ['0'..'9','A'..'F','a'..'f'], InputState.FileName, InputState.Line, InputState.Column);
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mID
// ============================================================================
procedure TTokenLexer.mID( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_ID;
if (( LA(1) in ['a'..'z'])) then
begin
match( ['a'..'z']);
end
else if (( LA(1) in ['A'..'Z'])) then
begin
match( ['A'..'Z']);
end
else
Raise EMismatchedChar.Create( LA(1), ['A'..'Z','a'..'z'], InputState.FileName, InputState.Line, InputState.Column);
while(true) do
begin
if (( LA(1) in ['a'..'z'])) then
begin
match( ['a'..'z']);
end
else if (( LA(1) in ['A'..'Z'])) then
begin
match( ['A'..'Z']);
end
else if (( LA(1) in ['_'])) then
begin
match('_');
end
else if (( LA(1) in ['0'..'9'])) then
begin
match( ['0'..'9']);
end
else
break;
end;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mINT
// ============================================================================
procedure TTokenLexer.mINT( pCreate: boolean);
var
_begin: integer;
_cnt_15: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_INT;
_cnt_15 := 0;
while(true) do
begin
if (( LA(1) in ['0'..'9'])) then
begin
mDIGIT(false);
end
else
begin
if _cnt_15 >= 1 then
break
else
Raise EMismatchedChar.Create( LA(1), ['0'..'9'], InputState.FileName, InputState.Line, InputState.Column);
end;
INC(_cnt_15);
end;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mWS
// ============================================================================
procedure TTokenLexer.mWS( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_WS;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [' '])) then
begin
match(' ');
end
else if (( LA(1) in [#9])) then
begin
match(#9);
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else
Raise EMismatchedChar.Create( LA(1), [#9..#10,#13,' '], InputState.FileName, InputState.Line, InputState.Column);
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mSLCOMMENT
// ============================================================================
procedure TTokenLexer.mSLCOMMENT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_SLCOMMENT;
match('//');
while(true) do
begin
if (( LA(1) in [#1..#9,#11..#12,#14..#255])) then
begin
match( [#1..#9,#11..#12,#14..#255]);
end
else
break;
end;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else
Raise EMismatchedChar.Create( LA(1), [#10,#13], InputState.FileName, InputState.Line, InputState.Column);
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mMLCOMMENT
// ============================================================================
procedure TTokenLexer.mMLCOMMENT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_MLCOMMENT;
match('(*');
while(true) do
begin
// non-greedy exit test
if( LA(1) in ['*']) and (LA(2) in [')']) then
break;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else if (( LA(1) in [#1..#9,#11..#12,#14..#255])) then
begin
match( [#1..#9,#11..#12,#14..#255]);
end
else
break;
end;
match('*)');
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ----------------------------------------------------------------------------
// NextToken
// ----------------------------------------------------------------------------
function TTokenLexer.NextToken : IToken;
var
_first : TCharSet;
begin
_first := [#9..#10,#13,' ','"','('..')','/'..'9','=','A'..'Z','a'..'z'];
while( true) do
begin
ResetText;
try
if (( LA(1) in ['(']) and (LA(2) in ['*'])) then
begin
mMLCOMMENT(true);
result := ReturnToken;
end
else if (( LA(1) in ['('])) then
begin
mLPAREN(true);
result := ReturnToken;
end
else if (( LA(1) in [')'])) then
begin
mRPAREN(true);
result := ReturnToken;
end
else if (( LA(1) in ['='])) then
begin
mASSIGN(true);
result := ReturnToken;
end
else if (( LA(1) in ['"'])) then
begin
mSTRING(true);
result := ReturnToken;
end
else if (( LA(1) in ['A'..'Z','a'..'z'])) then
begin
mID(true);
result := ReturnToken;
end
else if (( LA(1) in ['0'..'9'])) then
begin
mINT(true);
result := ReturnToken;
end
else if (( LA(1) in [#9..#10,#13,' '])) then
begin
mWS(true);
result := ReturnToken;
end
else if (( LA(1) in ['/'])) then
begin
mSLCOMMENT(true);
result := ReturnToken;
end
else
begin
if LA(1) = EOF_CHAR then
begin
uponEof;
result := TToken.Create(TT_EOF);
end
else
Raise EMismatchedChar.Create(LA(1), _first, InputState.FileName, InputState.Line, InputState.Column);
end;
// --------------------------------------------------------------
// If we found a SKIP token, then try again...
// --------------------------------------------------------------
if result = nil then
continue;
// --------------------------------------------------------------
// Now we have a valid token, so exit the function
// --------------------------------------------------------------
break;
except
Raise;
end;
end;
end;
end.
src.lib/save/z.dpglib.TokenLexerTokens.pas
+26
View File
@@ -0,0 +1,26 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.TokenLexer.g
// ============================================================================
unit dpglib.TokenLexerTokens;
interface
const
TT_EOF = 1;
TT_LPAREN = 4;
TT_RPAREN = 5;
TT_ASSIGN = 6;
TT_STRING = 7;
TT_DIGIT = 8;
TT_XDIGIT = 9;
TT_ID = 10;
TT_INT = 11;
TT_WS = 12;
TT_SLCOMMENT = 13;
TT_MLCOMMENT = 14;
implementation
end.
src.lib/save/z.dpglib.TokenParser.pas
+161
View File
@@ -0,0 +1,161 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.TokenParser.g
// ============================================================================
unit dpglib.TokenParser;
interface
uses
Classes,
SysUtils,
dpglib.StringSymbol,
dpglib.TokenParserTokens,
dpglib.TokenSymbol,
dpglib.Types,
dpgrtl.llkparser,
dpgrtl.types;
type
// =========================================================================
// Class TTokenParser declaration
// =========================================================================
TTokenParser = class( TLLkParser)
public // Public grammar rules
procedure tokenFile ( tm:ITokenManager);
procedure tokenLine ( tm:ITokenManager);
end;
implementation
uses
dpgrtl.exception,
dpgrtl.token;
// ============================================================================
// tokenFile
// ============================================================================
procedure TTokenParser.tokenFile( tm:ITokenManager);
var
name: IToken;
begin
name := LT(1);
match(TT_ID);
while(true) do
begin
if (( LA(1) in [TT_STRING,TT_ID])) then
begin
tokenLine(tm);
end
else
break;
end;
end;
// ============================================================================
// tokenLine
// ============================================================================
procedure TTokenParser.tokenLine( tm:ITokenManager);
var
i: IToken;
id: IToken;
id2: IToken;
lab: IToken;
para: IToken;
s1: IToken;
s2: IToken;
t : IToken;
s : IToken;
v : integer;
sl: IStringSymbol;
ts: ITokenSymbol;
x : AnsiString;
begin
t := nil;
s := nil;
if (( LA(1) in [TT_STRING])) then
begin
s1 := LT(1);
match(TT_STRING);
s := s1;
end
else if (( LA(1) in [TT_ID]) and (LA(2) in [TT_ASSIGN]) and (LA(3) in [TT_STRING])) then
begin
lab := LT(1);
match(TT_ID);
t := lab;
match(TT_ASSIGN);
s2 := LT(1);
match(TT_STRING);
s := s2;
end
else if (( LA(1) in [TT_ID]) and (LA(2) in [TT_LPAREN])) then
begin
id := LT(1);
match(TT_ID);
t := id;
match(TT_LPAREN);
para := LT(1);
match(TT_STRING);
match(TT_RPAREN);
end
else if (( LA(1) in [TT_ID]) and (LA(2) in [TT_ASSIGN]) and (LA(3) in [TT_INT])) then
begin
id2 := LT(1);
match(TT_ID);
t := id2;
end
else
Raise EMismatchedToken.Create( LT(1), [TT_STRING,TT_ID], InputState.FileName);
match(TT_ASSIGN);
i := LT(1);
match(TT_INT);
v := StrToIntDef( i.TokenText, -1);
if s <> nil then
begin
ts := TStringSymbol.Create( s.TokenText);
ts.TokenType := v;
tm.Define(ts);
if t <> nil then
begin
ts := tm.TokenSymbol[s.TokenText];
ts.QueryInterface( IStringSymbol, sl);
sl.Lbl := t.TokenText;
tm.MapToTokenSymbol( t.TokenText, sl);
end;
end
else if t <> nil then
begin
x := Copy( t.TokenText, 4, Length( t.TokenText)-3);
ts := TTokenSymbol.Create( x);
ts.TokenType := v;
tm.Define( ts);
if para <> nil then
begin
ts := tm.TokenSymbol[ t.TokenText];
ts.Paraphrase := para.TokenText;
end;
end;
end;
end.
src.lib/save/z.dpglib.TokenParserTokens.pas
+26
View File
@@ -0,0 +1,26 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.TokenParser.g
// ============================================================================
unit dpglib.TokenParserTokens;
interface
const
TT_EOF = 1;
TT_LPAREN = 4;
TT_RPAREN = 5;
TT_ASSIGN = 6;
TT_STRING = 7;
TT_DIGIT = 8;
TT_XDIGIT = 9;
TT_ID = 10;
TT_INT = 11;
TT_WS = 12;
TT_SLCOMMENT = 13;
TT_MLCOMMENT = 14;
implementation
end.