diff --git a/.gitignore b/.gitignore index c3247aa..f219175 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,5 @@ bin -dcu +*.dcu prj.dpgxcon\Win32 prj.dpgxcon\Win64 diff --git a/prj.lib/Delphi12Athens/mr.dpglib.dpk b/prj.lib/Delphi12Athens/mr.dpglib.dpk new file mode 100644 index 0000000..d0dd6bb --- /dev/null +++ b/prj.lib/Delphi12Athens/mr.dpglib.dpk @@ -0,0 +1,94 @@ +package mr.dpglib; + +{$R *.res} +{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION OFF} +{$OVERFLOWCHECKS ON} +{$RANGECHECKS ON} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES ON} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DEFINE DEBUG} +{$ENDIF IMPLICITBUILDING} +{$LIBVERSION '290'} +{$IMPLICITBUILD ON} + +requires + rtl, + mr.dpgrtl; + +contains + dpglib.ActionElem in '..\..\src.lib\dpglib.ActionElem.pas', + dpglib.Alternative in '..\..\src.lib\dpglib.Alternative.pas', + dpglib.AlternativeBlock in '..\..\src.lib\dpglib.AlternativeBlock.pas', + dpglib.AlternativeElem in '..\..\src.lib\dpglib.AlternativeElem.pas', + dpglib.BlockContext in '..\..\src.lib\dpglib.BlockContext.pas', + dpglib.BlockEndElem in '..\..\src.lib\dpglib.BlockEndElem.pas', + dpglib.BlockWithImpliedExitPath in '..\..\src.lib\dpglib.BlockWithImpliedExitPath.pas', + dpglib.CharLiteralElem in '..\..\src.lib\dpglib.CharLiteralElem.pas', + dpglib.CharRangeElem in '..\..\src.lib\dpglib.CharRangeElem.pas', + dpglib.CodeGenerator in '..\..\src.lib\dpglib.CodeGenerator.pas', + dpglib.DelphiBlockFinishingInfo in '..\..\src.lib\dpglib.DelphiBlockFinishingInfo.pas', + dpglib.DelphiCharFormatter in '..\..\src.lib\dpglib.DelphiCharFormatter.pas', + dpglib.DelphiGenerator in '..\..\src.lib\dpglib.DelphiGenerator.pas', + dpglib.DpgLexer in '..\..\src.lib\dpglib.DpgLexer.pas', + dpglib.DpgLexerTokens in '..\..\src.lib\dpglib.DpgLexerTokens.pas', + dpglib.DpgParser in '..\..\src.lib\dpglib.DpgParser.pas', + dpglib.DpgParserTokens in '..\..\src.lib\dpglib.DpgParserTokens.pas', + dpglib.ExceptionHandler in '..\..\src.lib\dpglib.ExceptionHandler.pas', + dpglib.ExceptionSpec in '..\..\src.lib\dpglib.ExceptionSpec.pas', + dpglib.Grammar in '..\..\src.lib\dpglib.Grammar.pas', + dpglib.GrammarAtom in '..\..\src.lib\dpglib.GrammarAtom.pas', + dpglib.GrammarBehavior in '..\..\src.lib\dpglib.GrammarBehavior.pas', + dpglib.GrammarElem in '..\..\src.lib\dpglib.GrammarElem.pas', + dpglib.GrammarMaker in '..\..\src.lib\dpglib.GrammarMaker.pas', + dpglib.GrammarSymbol in '..\..\src.lib\dpglib.GrammarSymbol.pas', + dpglib.LexerGrammar in '..\..\src.lib\dpglib.LexerGrammar.pas', + dpglib.LLkAnalyzer in '..\..\src.lib\dpglib.LLkAnalyzer.pas', + dpglib.Lookahead in '..\..\src.lib\dpglib.Lookahead.pas', + dpglib.Messages in '..\..\src.lib\dpglib.Messages.pas', + dpglib.NMBlock in '..\..\src.lib\dpglib.NMBlock.pas', + dpglib.OneOrMoreBlock in '..\..\src.lib\dpglib.OneOrMoreBlock.pas', + dpglib.ParserGrammar in '..\..\src.lib\dpglib.ParserGrammar.pas', + dpglib.PrettyPrinter in '..\..\src.lib\dpglib.PrettyPrinter.pas', + dpglib.RuleBlock in '..\..\src.lib\dpglib.RuleBlock.pas', + dpglib.RuleEndElem in '..\..\src.lib\dpglib.RuleEndElem.pas', + dpglib.RuleRefElem in '..\..\src.lib\dpglib.RuleRefElem.pas', + dpglib.RuleSymbol in '..\..\src.lib\dpglib.RuleSymbol.pas', + dpglib.StringLiteralElem in '..\..\src.lib\dpglib.StringLiteralElem.pas', + dpglib.StringSymbol in '..\..\src.lib\dpglib.StringSymbol.pas', + dpglib.SynPredBlock in '..\..\src.lib\dpglib.SynPredBlock.pas', + dpglib.TokenLexer in '..\..\src.lib\dpglib.TokenLexer.pas', + dpglib.TokenLexerTokens in '..\..\src.lib\dpglib.TokenLexerTokens.pas', + dpglib.TokenManager in '..\..\src.lib\dpglib.TokenManager.pas', + dpglib.TokenParser in '..\..\src.lib\dpglib.TokenParser.pas', + dpglib.TokenParserTokens in '..\..\src.lib\dpglib.TokenParserTokens.pas', + dpglib.TokenRangeElem in '..\..\src.lib\dpglib.TokenRangeElem.pas', + dpglib.TokenRefElem in '..\..\src.lib\dpglib.TokenRefElem.pas', + dpglib.TokenSymbol in '..\..\src.lib\dpglib.TokenSymbol.pas', + dpglib.Tool in '..\..\src.lib\dpglib.Tool.pas', + dpglib.TreeBlockContext in '..\..\src.lib\dpglib.TreeBlockContext.pas', + dpglib.TreeElem in '..\..\src.lib\dpglib.TreeElem.pas', + dpglib.TreeParserGrammar in '..\..\src.lib\dpglib.TreeParserGrammar.pas', + dpglib.types in '..\..\src.lib\dpglib.types.pas', + dpglib.Utils in '..\..\src.lib\dpglib.Utils.pas', + dpglib.Version in '..\..\src.lib\dpglib.Version.pas', + dpglib.WildCardElem in '..\..\src.lib\dpglib.WildCardElem.pas', + dpglib.ZeroOrMoreBlock in '..\..\src.lib\dpglib.ZeroOrMoreBlock.pas'; + +end. diff --git a/prj.lib/Delphi12Athens/mr.dpglib.dproj b/prj.lib/Delphi12Athens/mr.dpglib.dproj new file mode 100644 index 0000000..788490b --- /dev/null +++ b/prj.lib/Delphi12Athens/mr.dpglib.dproj @@ -0,0 +1,1060 @@ + + + {C9486433-BA52-4FD4-B132-20939D3AECF6} + mr.dpglib.dpk + 20.3 + None + True + Debug + Win32 + 1 + Package + mr.dpglib + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + true + true + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + mr_dpglib + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 290 + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + true + + + DEBUG;$(DCC_Define) + true + false + true + true + true + true + true + + + false + true + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + + MainSource + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Package + + + + mr.dpglib.dpk + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + true + + + + + true + + + + + true + + + + + + 1 + + + 0 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\values-v35 + 1 + + + res\values-v35 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + 1 + + + 0 + + + + + 1 + .framework + + + 1 + .framework + + + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + + + 1 + + + 1 + + + + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + True + False + False + + + 12 + + + + + diff --git a/src.lib/dpglib.ActionElem.pas b/src.lib/dpglib.ActionElem.pas new file mode 100644 index 0000000..ab043d5 --- /dev/null +++ b/src.lib/dpglib.ActionElem.pas @@ -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. diff --git a/src.lib/dpglib.Alternative.pas b/src.lib/dpglib.Alternative.pas new file mode 100644 index 0000000..56b8165 --- /dev/null +++ b/src.lib/dpglib.Alternative.pas @@ -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. diff --git a/src.lib/dpglib.AlternativeBlock.pas b/src.lib/dpglib.AlternativeBlock.pas new file mode 100644 index 0000000..2fa8a01 --- /dev/null +++ b/src.lib/dpglib.AlternativeBlock.pas @@ -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 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. diff --git a/src.lib/dpglib.AlternativeElem.pas b/src.lib/dpglib.AlternativeElem.pas new file mode 100644 index 0000000..fc9eb2c --- /dev/null +++ b/src.lib/dpglib.AlternativeElem.pas @@ -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. diff --git a/src.lib/dpglib.BlockContext.pas b/src.lib/dpglib.BlockContext.pas new file mode 100644 index 0000000..fc95de7 --- /dev/null +++ b/src.lib/dpglib.BlockContext.pas @@ -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. diff --git a/src.lib/dpglib.BlockEndElem.pas b/src.lib/dpglib.BlockEndElem.pas new file mode 100644 index 0000000..acad028 --- /dev/null +++ b/src.lib/dpglib.BlockEndElem.pas @@ -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. diff --git a/src.lib/dpglib.BlockWithImpliedExitPath.pas b/src.lib/dpglib.BlockWithImpliedExitPath.pas new file mode 100644 index 0000000..62e0678 --- /dev/null +++ b/src.lib/dpglib.BlockWithImpliedExitPath.pas @@ -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. diff --git a/src.lib/dpglib.CharLiteralElem.pas b/src.lib/dpglib.CharLiteralElem.pas new file mode 100644 index 0000000..9ad8c92 --- /dev/null +++ b/src.lib/dpglib.CharLiteralElem.pas @@ -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. diff --git a/src.lib/dpglib.CharRangeElem.pas b/src.lib/dpglib.CharRangeElem.pas new file mode 100644 index 0000000..91d2fb1 --- /dev/null +++ b/src.lib/dpglib.CharRangeElem.pas @@ -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. diff --git a/src.lib/dpglib.CodeGenerator.pas b/src.lib/dpglib.CodeGenerator.pas new file mode 100644 index 0000000..ca6c2bd --- /dev/null +++ b/src.lib/dpglib.CodeGenerator.pas @@ -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 gen(), 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. diff --git a/src.lib/dpglib.DelphiBlockFinishingInfo.pas b/src.lib/dpglib.DelphiBlockFinishingInfo.pas new file mode 100644 index 0000000..1f6ba78 --- /dev/null +++ b/src.lib/dpglib.DelphiBlockFinishingInfo.pas @@ -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. diff --git a/src.lib/dpglib.DelphiCharFormatter.pas b/src.lib/dpglib.DelphiCharFormatter.pas new file mode 100644 index 0000000..be61be5 --- /dev/null +++ b/src.lib/dpglib.DelphiCharFormatter.pas @@ -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. diff --git a/src.lib/dpglib.DelphiGenerator.pas b/src.lib/dpglib.DelphiGenerator.pas new file mode 100644 index 0000000..7b17684 --- /dev/null +++ b/src.lib/dpglib.DelphiGenerator.pas @@ -0,0 +1,3475 @@ +unit dpglib.DelphiGenerator; + +interface +uses + System.Classes, + System.SysUtils, + dpgrtl.types, + dpglib.Utils, + dpglib.Types, + dpglib.CodeGenerator, + dpglib.DelphiCharFormatter, + dpglib.DelphiBlockFinishingInfo; + +type + // ------------------------------------------------------------------------- + // TDelphiGenerator class declaration + // ------------------------------------------------------------------------- + TDelphiGenerator = class( TCodeGenerator, + ICodeGenerator) + + protected + fSaveText : boolean; + fSyntacticPredLevel : integer; + + // ------------------------------------------------------------ + // Grammar parameters set up to handle different grammar classes. + // There are used to get instance of tests out of code generation. + // ------------------------------------------------------------ + fLabeledElemType : AnsiString; + fLabeledElemInit : AnsiString; + + fCommonExtraArgs : AnsiString; + fCommonExtraParams : AnsiString; + fCommonLocalVars : AnsiString; + + fLT1Value : AnsiString; + + fExceptionThrown : AnsiString; + fThrowNoViable : AnsiString; + + fSemPreds : TStringList; + + // ------------------------------------------------------------ + // AST studd + // ------------------------------------------------------------ + fCurrentASTResult : AnsiString; + + + // ------------------------------------------------------------ + // Tracks the rule being generated. Used for mapTreeId. + // ------------------------------------------------------------ + fCurrentRule : IRuleBlock; + + function altIsEmpty( pAlt: IAlternative) : boolean; + function throw( pLA1: ILookahead) : AnsiString; + + function needsLexerInit : boolean; + + private +// function suitableForCaseExpression( pAlt: IAlternative): boolean; + function lookaheadIsEmpty( pAlt: IAlternative; pMaxDepth: integer): boolean; +// function lookaheadString( pK: integer): AnsiString; + + procedure genRule( pRuleSymbol : IRuleSymbol); + procedure genSemPred( pSemPred : AnsiString); + procedure genSynPred( pBlock : ISynPredBlock; + pLookaheadExpr : AnsiString); + function genCommonBlock( pBlock : IAlternativeBlock; + pNoTestForSingle : boolean) : TDelphiBlockFinishingInfo; + procedure genBlockFinish( pHowToFinish : TDelphiBlockFinishingInfo; + pNoViableAction : AnsiString; + pSingleLine : boolean = false); + + protected + GenAST : boolean; + + protected + // ------------------------------------------------------------ + // Internals + // ------------------------------------------------------------ + procedure genTokens; + procedure genUses; + procedure genUses2; + procedure genClassDecl; + procedure genMethodDecl( pRuleSymbol : IRuleSymbol; + pLength : integer=0; + pFull : boolean=true); + procedure genClassDef; + procedure genRuleLocals( pRuleBlock: IRuleBlock); + procedure genInitLiterals; + procedure genNextToken; + + procedure genLiteralsTest; + procedure genLiteralsTestForPartialToken; + procedure genBlockInitAction( pBlock : IAlternativeBlock); + + procedure genRuleInvocation( pRuleRefElem : IRuleRefElem); + procedure genAlt( pAlt : IAlternative; + pBlk : IAlternativeBlock); + + // ------------------------------------------------------------ + // ICodeGenerator overrides + // ------------------------------------------------------------ + procedure Gen( pGrammar : IGrammar); overload; override; + + + + + procedure genMatch( pAtom : IGrammarAtom); + procedure genMatchUsingAtomText( pAtom : IGrammarAtom); + procedure genMatchUsingAtomTokenType(pAtom : IGrammarAtom); + + function getValueString( pType : integer): AnsiString; + + + procedure genPredictExpr( pLaList : TInterfaceList; + pLaDepth : integer); + + + + protected + procedure Gen( pAction : IActionElem); overload; override; + procedure Gen( pBlock : IAlternativeBlock); overload; override; + procedure Gen( pEnd : IBlockEndElem); overload; override; + procedure Gen( pAtom : ICharLiteralElem); overload; override; + procedure Gen( pAtom : ICharRangeElem); overload; override; + procedure Gen( pAtom : IGrammarAtom); overload; override; + procedure Gen( pBlk : IRuleBlock); overload; override; + procedure Gen( pElem : IRuleEndElem); overload; override; + procedure Gen( pRuleRef : IRuleRefElem); overload; override; + procedure Gen( pAtom : IStringLiteralElem); overload; override; + procedure Gen( pBlk : ISynPredBlock); overload; override; + procedure Gen( pTokenRef: ITokenRefElem); overload; override; + procedure Gen( pElem : ITokenRangeElem); overload; override; + procedure Gen( pBlock : IOneOrMoreBlock); overload; override; + procedure Gen( pBlock : INMBlock); overload; override; + procedure Gen( pWc : IWildcardElem); overload; override; + procedure Gen( pBlock : IZeroOrMoreBlock); overload; override; + + + function getLookaheadTestExpr( pAlt : IAlternative; + pMaxDepth : integer) : AnsiString; overload; + function getLookaheadTestExpr( pLaList : TInterfaceList; + pLaDepth : integer) : AnsiString; overload; + function getLookaheadTestTerm( pK : integer; + pLA : ILookahead) : AnsiString; + function getLookaheadString( pK: integer) : AnsiString; + + protected + function addSemPred( pSemPred: AnsiString): integer; + procedure exitIfError; + + protected + fIsLexer : boolean; + fIsParser : boolean; + fIsTreeWalker : boolean; + + fLexerGrammar : ILexerGrammar; + fParserGrammar : IParserGrammar; + fTreeWalkerGrammar : ITreeWalkerGrammar; + + public + constructor Create( OutputDir : AnsiString; + ExchangeDir : AnsiString); + destructor Destroy; override; + + end; + + +implementation +uses + dpglib.GrammarMaker, + dpglib.RuleSymbol, + dpglib.Version, + dpglib.Messages; + +// ---------------------------------------------------------------------------- +// Constructor +// ---------------------------------------------------------------------------- +constructor TDelphiGenerator.Create( OutputDir : AnsiString; + ExchangeDir : AnsiString); +begin + inherited; + + fSaveText := true; + fSyntacticPredLevel := 0; + fCharFormatter := TDelphiCharFormatter.Create; + + fIsLexer := false; + fIsParser := false; + fIsTreeWalker := false; + + fLexerGrammar := nil; + fParserGrammar := nil; + fTreeWalkerGrammar := nil; + + GenAST := false; +end; + +// ---------------------------------------------------------------------------- +// Destructor +// ---------------------------------------------------------------------------- +destructor TDelphiGenerator.Destroy; +begin + fLexerGrammar := nil; + fParserGrammar := nil; + fTreeWalkerGrammar := nil; + + fCharFormatter := nil; + fCurrentRule := nil; + + FreeAndNil(fSemPreds); + + inherited; +end; + +// **************************************************************************** +// ICodeGenerator overrides +// **************************************************************************** +// ---------------------------------------------------------------------------- +// Gen (grammar) +// ---------------------------------------------------------------------------- +procedure TDelphiGenerator.Gen(pGrammar: IGrammar); +begin + fGrammar := pGrammar; + fGrammar.Generator := self; + fAnalyzer := fGrammar.LLkAnalyzer; + fTool := fGrammar.Tool; + + fTabs := 0; + + // --------------------------------------------------------------- + // Set up internals depending on grammar type + // --------------------------------------------------------------- + fGrammar.QueryInterface( ILexerGrammar, fLexerGrammar); + fGrammar.QueryInterface( IParserGrammar, fParserGrammar); + fGrammar.QueryInterface( ITreeWalkerGrammar, fTreeWalkerGrammar); + + if fLexerGrammar <> nil then fIsLexer := true; + if fParserGrammar <> nil then fIsParser := true; + if fTreeWalkerGrammar<> nil then fIsTreeWalker := true; + + if fLexerGrammar <> nil then fLT1Value := 'LA(1)'; + if fParserGrammar <> nil then fLT1Value := 'LT(1)'; + if fTreeWalkerGrammar<> nil then fLT1Value := '_t'; + + fThrowNoViable := 'Raise EMismatchedChar.Create(' + + 'LA(1), _first, InputState.FileName, InputState.Line, InputState.Column);'; + + if Assigned(fParserGrammar) + then GenAST := fParserGrammar.BuildAST + else GenAST := false; + + // --------------------------------------------------------------- + // Generate token exchange and token type definition file. + // --------------------------------------------------------------- + genTokenExchange; + genTokens; + + // --------------------------------------------------------------- + // Calculate the output file name, and open it. + // --------------------------------------------------------------- + fFile := fOutDir + fGrammar.UnitName + '.pas'; + fOutput := TFileStream.Create( fFile, fmCreate); + + // --------------------------------------------------------------- + // Generate red tape + // --------------------------------------------------------------- + println('// ============================================================================'); + println('// This file is generated by the Delphi Parser Generator.'); + println('// ----------------------------------------------------------------------------'); + println('// DPG version: ' + version); + println('// Grammar: ' + fGrammar.GrammarFile); + println('// ============================================================================'); + println('unit ' + fGrammar.UnitName + ';'); + println(''); + println('interface'); + println(''); + + // --------------------------------------------------------------- + // Generate uses clause, class declaration + // --------------------------------------------------------------- + genUses; + genClassDecl; + + println(''); + println('implementation'); + genUses2; + println(''); +// println('uses'); +// INC(fTabs); +// println('dpgException,'); +// println('dpgExceptionSemantic,'); + +// if fIsLexer then +// println('dpgExceptionMismatchedChar;') +// else +// println('dpgExceptionMismatchedToken;'); + + +// DEC(fTabs); +// println(''); + + // --------------------------------------------------------------- + // Generate the class definition + // --------------------------------------------------------------- + genClassDef; + + + println('end.'); + fOutput.Free; +end; + +// **************************************************************************** +// Internals +// **************************************************************************** +// ============================================================================ +// Gen(Action) - {...} +// ============================================================================ +procedure TDelphiGenerator.Gen(pAction: IActionElem); +begin + if pAction.IsSemPred then + genSemPred( pAction.ActionText) + + else + begin + if fGrammar.HasSynPred then + begin + println(''); + println('if InputState.Guessing = 0 then'); + println('begin'); + INC(fTabs); + end; + + printAction( pAction.ActionText); + + if fGrammar.HasSynPred then + begin + DEC(fTabs ); + println('end;'); + end; + end; +end; + +// ============================================================================ +// Gen(AlternativeBlock) +// ============================================================================ +procedure TDelphiGenerator.Gen(pBlock: IAlternativeBlock); +var + htf : TDelphiBlockFinishingInfo; + cur : AnsiString; +begin + genBlockInitAction( pBlock); + + // Tell AST generation to build subrule result + cur := fCurrentASTResult; + if pBlock.Lbl <> '' then + fCurrentASTResult := pBlock.Lbl; + + fGrammar.LLkAnalyzer.Deterministic( pBlock); + + htf := genCommonBlock( pBlock, true); + genBlockFinish( htf, throw(pBlock.Look(1)), true); + + // Restore previous AST generation + fCurrentASTResult := cur; +end; + +// ============================================================================ +// Gen(CharLiteralElem) +// ============================================================================ +procedure TDelphiGenerator.Gen(pAtom: ICharLiteralElem); +var + oldSaveText: boolean; + +begin + if pAtom.Lbl <> '' then + println(pAtom.Lbl + ' := ' + fLT1Value + ';'); + + oldSaveText := fSaveText; + fSaveText := fSaveText and (pAtom.AutoGenType = AUTOGEN_NONE); + + if oldSaveText and not fSaveText then + println('SaveConsumedInput := false;'); + + genMatch( pAtom); + + if oldSaveText and not fSaveText then + println('SaveConsumedInput := true;'); + + fSaveText := oldSaveText; +end; + +// ============================================================================ +// Gen(CharRangeElem) +// ============================================================================ +procedure TDelphiGenerator.Gen(pAtom: ICharRangeElem); +var + oldSaveText: boolean; + +begin + if (pAtom.Lbl <> '') and (fSyntacticPredLevel = 0) then + println(pAtom.Lbl + ':=' + fLT1Value + ';'); + + oldSaveText := fSaveText; + fSaveText := fSaveText and (pAtom.AutoGenType = AUTOGEN_NONE); + + if oldSaveText and not fSaveText then + println('SaveConsumedInput := false;'); + + if pAtom.BeginChar < pAtom.EndChar then + println('match( [' + CharSetToStr( [pAtom.BeginChar..pAtom.EndChar]) + ']);') + else + println('match( [' + CharSetToStr( [pAtom.EndChar..pAtom.BeginChar]) + ']);'); + + if oldSaveText and not fSaveText then + println('SaveConsumedInput := true;'); + + fSaveText := oldSaveText; +end; + +// ============================================================================ +// Gen(OneOrMoreBlock) - (...)+ +// ============================================================================ +procedure TDelphiGenerator.Gen(pBlock: IOneOrMoreBlock); +var + i : integer; + lbl : AnsiString; + cnt : AnsiString; + predictExit : AnsiString; + nonGreedyExitPath : boolean; + nonGreedyExitDepth: integer; + laList : TInterfaceList; + htf : TDelphiBlockFinishingInfo; + exitBranch : AnsiString; + + +begin + if pBlock.Lbl <> '' then + begin + cnt := '_cnt_' + pBlock.Lbl; + lbl := '_loop' + pBlock.Lbl; + end + else + begin + cnt := '_cnt_' + IntToStr(pBlock.ID); + lbl := '_loop' + IntToStr(pBlock.ID); + end; + + println(cnt + ' := 0;'); + println(''); + println('while(true) do'); + println('begin'); + INC(fTabs); + + // --------------------------------------------------------------- + // Generate init action for (...)+ + // --------------------------------------------------------------- + genBlockInitAction( pBlock); + fGrammar.LLkAnalyzer.Deterministic( pBlock); + + // --------------------------------------------------------------- + // Generate exit test if greedy set to false and an alt is ambigous + // with exit branch or when lookahead derived purely from + // end-of-file. Lookahead analysis stops when end-of-file is hit, + // returning set (epsilon). Since (epsilon) is not ambigous with + // any real tokens, no error is reported by deterministic() routines + // and we have to check for the case where the lookahead depth + // didn't get set to NONDETERMINISTIC (this only happens when the + // FOLLOW contains real atoms + epsilon. + // --------------------------------------------------------------- + nonGreedyExitPath := false; + nonGreedyExitDepth := fGrammar.MaxK; + + if (not pBlock.Greedy) and + (pBlock.ExitDepth <= fGrammar.MaxK) and + pBlock.ExitCache[pBlock.ExitDepth].HasEpsilon then + begin + nonGreedyExitPath := true; + nonGreedyExitDepth:= pBlock.ExitDepth; + end + + else if (not pBlock.Greedy) and (pBlock.ExitDepth = NONDETERMINISTIC) then + nonGreedyExitPath := true; + + // --------------------------------------------------------------- + // Generate exit test if greedy set to false and an alternative + // is ambiguous with exit branch. + // --------------------------------------------------------------- + if nonGreedyExitPath then + begin + // ------------------------------------------------------------ + // Generate lookahead test expression + // ------------------------------------------------------------ + laList := TInterfaceList.Create; + for i:=1 to nonGreedyExitDepth do + laList.Add( pBlock.ExitCache[i]); + predictExit := getLookaheadTestExpr( laList, nonGreedyExitDepth); + + println('// non-greedy exit test'); + println('if (' + cnt + ') >= 1) and '); + + INC(fTabs); + printAction('{'+#13+#10 + predictExit +#13+#10+'}'); + println('then break;'); + println(''); + DEC(fTabs); + end; + + // --------------------------------------------------------------- + // Prepare exit branch + // --------------------------------------------------------------- + exitBranch := ''; + exitBranch := exitBranch + 'if ' + cnt + ' >= 1 then' +#13+#10; + exitBranch := exitBranch + fTab + 'break' +#13+#10; + exitBranch := exitBranch + 'else' +#13+#10; + exitBranch := exitBranch + fTab + throw(pBlock.Look(1)) +#13+#10; + + htf := genCommonBlock(pBlock,false); + genBlockFinish( htf, exitBranch); + + // --------------------------------------------------------------- + // Finalize the loop + // --------------------------------------------------------------- + println(''); + println('INC(' + cnt + ');'); + DEC(fTabs); + println('end;'); +end; + + +// ================================================================================================ +// M to N Block (...)@(m,n) +// ================================================================================================ +procedure TDelphiGenerator.Gen( pBlock: INMBlock); +var + i : integer; + lbl : AnsiString; + cnt : AnsiString; + predictExit : AnsiString; + nonGreedyExitPath : boolean; + nonGreedyExitDepth: integer; + laList : TInterfaceList; + htf : TDelphiBlockFinishingInfo; + exitBranch : AnsiString; + + m : integer; + n : integer; + mStr : AnsiString; + nStr : AnsiString; + + +begin + if pBlock.Lbl <> '' then + begin + cnt := '_cnt_' + pBlock.Lbl; + lbl := '_loop' + pBlock.Lbl; + end + else + begin + cnt := '_cnt_' + IntToStr(pBlock.ID); + lbl := '_loop' + IntToStr(pBlock.ID); + end; + + m := pBlock.Low; + n := pBlock.High; + mStr := IntToStr( m); + nStr := IntToStr( n); + + + println(cnt + ' := 0;'); + println(''); +// println('while(true) do'); + println('while ' +cnt+ ' < ' +nStr+ ' do'); + println('begin'); + INC(fTabs); + + // --------------------------------------------------------------- + // Generate init action for (...)@ + // --------------------------------------------------------------- + genBlockInitAction( pBlock); + fGrammar.LLkAnalyzer.Deterministic( pBlock); + + // --------------------------------------------------------------- + // Generate exit test if greedy set to false and an alt is ambigous + // with exit branch or when lookahead derived purely from + // end-of-file. Lookahead analysis stops when end-of-file is hit, + // returning set (epsilon). Since (epsilon) is not ambigous with + // any real tokens, no error is reported by deterministic() routines + // and we have to check for the case where the lookahead depth + // didn't get set to NONDETERMINISTIC (this only happens when the + // FOLLOW contains real atoms + epsilon. + // --------------------------------------------------------------- + nonGreedyExitPath := false; + nonGreedyExitDepth := fGrammar.MaxK; + + if (not pBlock.Greedy) and + (pBlock.ExitDepth <= fGrammar.MaxK) and + pBlock.ExitCache[pBlock.ExitDepth].HasEpsilon then + begin + nonGreedyExitPath := true; + nonGreedyExitDepth:= pBlock.ExitDepth; + end + + else if (not pBlock.Greedy) and (pBlock.ExitDepth = NONDETERMINISTIC) then + nonGreedyExitPath := true; + + // --------------------------------------------------------------- + // Generate exit test if greedy set to false and an alternative + // is ambiguous with exit branch. + // --------------------------------------------------------------- + if nonGreedyExitPath then + begin + // ------------------------------------------------------------ + // Generate lookahead test expression + // ------------------------------------------------------------ + laList := TInterfaceList.Create; + for i:=1 to nonGreedyExitDepth do + laList.Add( pBlock.ExitCache[i]); + + predictExit := getLookaheadTestExpr( laList, nonGreedyExitDepth); + + println('// non-greedy exit test'); + println('if (' + cnt + ') >= 1) and '); + + INC(fTabs); + printAction('{'+#13+#10 + predictExit +#13+#10+'}'); + println('then break;'); + println(''); + DEC(fTabs); + end; + + + // --------------------------------------------------------------- + // Prepare exit branch + // --------------------------------------------------------------- + exitBranch := ''; + + // --------------------------------------------------------------- + // @(m) + // + // The exit condition is tested by teh *while* loop, so here we + // define the exception generation. + // --------------------------------------------------------------- + if (m>0) and (m=n) then + exitBranch := fTab + throw(pBlock.Look(1)) +#13+#10 + + // ------------------------------------------------------------------------- + // @(,n) + // ------------------------------------------------------------------------- + else if (m=0) and (n>0) then + exitBranch := fTab + 'break' +#13+#10 + + // ------------------------------------------------------------------------- + // @(m,n), @(m,) + // ------------------------------------------------------------------------- + else if (m>0) and (n>m) then + begin + exitBranch := ''; + exitBranch := exitBranch + 'if ' +cnt+ ' >= ' +mStr+ ' then' +#13+#10; + exitBranch := exitBranch + fTab + 'break' +#13+#10; + exitBranch := exitBranch + 'else' +#13+#10; + exitBranch := exitBranch + fTab + throw(pBlock.Look(1)) +#13+#10; + end; + + htf := genCommonBlock(pBlock,false); + genBlockFinish( htf, exitBranch); + + // --------------------------------------------------------------- + // Finalize the loop + // --------------------------------------------------------------- + println(''); + println('INC(' + cnt + ');'); + DEC(fTabs); + println('end;'); +end; + +// ============================================================================ +// Gen(RuleRef) +// ============================================================================ +procedure TDelphiGenerator.Gen(pRuleRef: IRuleRefElem); +var + ts : ITokenSymbol; + rs : IRuleSymbol; + save : boolean; + rname : AnsiString; + +begin + ts := fGrammar.Symbol[pRuleRef.TargetRule]; + + // --------------------------------------------------------------- + // If the symbol not exists in the grammar, error... + // --------------------------------------------------------------- + if ts = nil then + begin + if fIsLexer + then rname := TCodeGenerator.decodeLexerRuleName( pRuleRef.TargetRule) + else rname := pRuleRef.TargetRule; + + fTool.Error(Format(MSG_E_RULENOTDEFINED,[rname]), + fGrammar.GrammarFile, + pRuleRef.Line, + pRuleRef.Column); + exit; + end; + + // --------------------------------------------------------------- + // If the symbol exists, but not defined, error... + // --------------------------------------------------------------- + rs := ts as IRuleSymbol; + + if not rs.Defined then + begin + if fIsLexer then + rname := TCodeGenerator.decodeLexerRuleName( pRuleRef.TargetRule) + else + rname := pRuleRef.TargetRule; + + fTool.Error(Format(MSG_E_RULENOTDEFINED,[rname]), + fGrammar.GrammarFile, + pRuleRef.Line, + pRuleRef.Column); + exit; + end; + + // --------------------------------------------------------------- + // If in lexer and ! on ruleref or alt or rule, save buffer index + // to kill later. + // --------------------------------------------------------------- + if fIsLexer and ((not fSaveText) or (pRuleRef.AutoGenType = AUTOGEN_BANG)) then + println('_save := Length( TokenText);'); + + print(''); + // --------------------------------------------------------------- + // Process return value if any. + // --------------------------------------------------------------- + if pRuleRef.IdAssign <> '' then + begin + // ------------------------------------------------------------ + // Warn if the rule has no return value. + // ------------------------------------------------------------ + if rs.Block.ReturnAction = '' then + begin + + fTool.Warning( Format(MSG_W_RULEHASNORETURN,[pRuleRef.TargetRule]), + fGrammar.GrammarFile, + pRuleRef.Line, + pRuleRef.Column); + end; + + _print( pRuleRef.IdAssign + ' := '); + end + + else begin + // ------------------------------------------------------------ + // Warn about return value if any, but not inside syntactic + // predicate. + // ------------------------------------------------------------ + if (not fIsLexer) and + (fSyntacticPredLevel = 0) and + (rs.Block.ReturnAction <> '') then + begin + fTool.Warning( Format(MSG_W_RULEHASRETURN,[pRuleRef.TargetRule]), + fGrammar.GrammarFile, + pRuleRef.Line, + pRuleRef.Column); + end; + end; + + // --------------------------------------------------------------- + // Call the rule. + // --------------------------------------------------------------- + genRuleInvocation( pRuleRef); + + // --------------------------------------------------------------- + // Now kill the buffer... + // --------------------------------------------------------------- + if fIsLexer and ((not fSaveText) or (pRuleRef.AutoGenType = AUTOGEN_BANG)) then + println('TokenText := Copy(TokenText, 1, _save);'); + + // --------------------------------------------------------------- + // Always generate variable for rule return on labeled rules + // --------------------------------------------------------------- + if pRuleRef.Lbl <> '' then + begin + if fIsTreeWalker then + ; + + + if fIsLexer then + println( pRuleRef.Lbl + ' := ReturnToken;'); + end; +end; + + + + +// ============================================================================ +// Gen(ZeroOrMoreBlock) (...)* +// ============================================================================ +procedure TDelphiGenerator.Gen(pBlock: IZeroOrMoreBlock); +var + i: integer; + nonGreedyExitPath : boolean; + nonGreedyExitDepth : integer; + predictExit : AnsiString; + laList : TInterfaceList; + htf : TDelphiBlockFinishingInfo; + +begin + println(''); + println('while(true) do'); + println('begin'); + INC(fTabs); + + // --------------------------------------------------------------- + // Generate the init action for ()+ ()* inside the loop. + // This allows us to do useful EOF checking. + // --------------------------------------------------------------- + genBlockInitAction( pBlock); + fGrammar.LLkAnalyzer.Deterministic( pBlock); + + // --------------------------------------------------------------- + // Generate exit test if greedy set to false and an alt is ambigous + // with exit branch or when lookahead derived purely from end-of-file. + // Lookahead analysis stops when end-of-file is hit, returning set + // (epsilon). Since (epsilon) is not ambigous with any real tokens, + // no error is reported by deterministic() routines and we have to + // check for to NONDETERMINISTIC (this only happens when the FOLLOW + // contains real atoms + epsilon). + // --------------------------------------------------------------- + nonGreedyExitPath := false; + nonGreedyExitDepth := fGrammar.MaxK; + + if (not pBlock.Greedy) and + (pBlock.ExitDepth <= fGrammar.MaxK) and + (pBlock.ExitCache[pBlock.ExitDepth].HasEpsilon) then + begin + nonGreedyExitPath := true; + nonGreedyExitDepth:= pBlock.ExitDepth; + end + + else if (not pBlock.Greedy) and (pBlock.ExitDepth = NONDETERMINISTIC) then + nonGreedyExitPath := true; + + // --------------------------------------------------------------- + // Generate exit test if greedy set to false and an alternative + // is ambiguous with exit branch. + // --------------------------------------------------------------- + if nonGreedyExitPath then + begin + // ------------------------------------------------------------ + // Generate lookahead test expression + // ------------------------------------------------------------ + laList := TInterfaceList.Create; + for i:=1 to nonGreedyExitDepth do + laList.Add( pBlock.ExitCache[i]); + predictExit := getLookaheadTestExpr( laList, nonGreedyExitDepth); + + println('// non-greedy exit test'); + println('if' + predictExit + ' then'); + INC(fTabs); + println('break;'); + println(''); + DEC(fTabs); + end; + + htf := genCommonBlock( pBlock, false); + genBlockFinish( htf, fTab + 'break;', true); + + DEC( fTabs); + println('end;'); + println(''); +end; + +// ============================================================================ +// genTokens +// ============================================================================ +procedure TDelphiGenerator.genTokens; +var + i : integer; + len : integer; + xxx : integer; + line : AnsiString; + frm : AnsiString; + _file : AnsiString; + + name : AnsiString; + value : AnsiString; + ts : ITokenSymbol; + ss : IStringSymbol; + +begin + // --------------------------------------------------------------- + // Calculate the output file name, and open it. + // --------------------------------------------------------------- + _file := (*fOutDir +*) fGrammar.ExportVocab + 'Tokens.pas'; + _file := fOutDir + fGrammar.UnitName + 'Tokens.pas'; + fOutput := TFileStream.Create( _file, fmCreate); + + // --------------------------------------------------------------- + // Calculate maximum length of the token names. + // --------------------------------------------------------------- + len := 0; + for i:=0 to fGrammar.TokenManager.Vocabulary.Count -1 do + begin + ts := fGrammar.TokenManager.TokenSymbolAt[i]; + + if ts <> nil then + if len < Length( ts.ID) then + len := Length( ts.ID); + end; + + // --------------------------------------------------------------- + // Add prefix length also + // --------------------------------------------------------------- + if Length(fTokPrefix) > Length( fLitPrefix) + then len := len + Length( fTokPrefix) + else len := len + Length( fLitPrefix); + + // --------------------------------------------------------------- + // Write a header :) + // --------------------------------------------------------------- + println('// ============================================================================'); + println('// This file is generated by the Delphi Parser Generator.'); + println('// ----------------------------------------------------------------------------'); + println('// DPG version: ' + version); + println('// Grammar: ' + fGrammar.GrammarFile); + println('// ============================================================================'); + println('unit ' + fGrammar.ExportVocab + 'Tokens;'); + println(''); + println('interface'); + println(''); + println('const'); + + // --------------------------------------------------------------- + // Write out the tokens + // --------------------------------------------------------------- + fTabs := 1; + frm := '%-' + IntToStr(len) + 's = %s;'; + + for name in fGrammar.TokenManager.Vocabulary.Keys do + begin + value := IntToStr( fGrammar.TokenManager.Vocabulary.Items[name]); + ts := fGrammar.TokenManager.TokenSymbol[name]; + ss := nil; + + if ts <> nil then + ts.QueryInterface( IStringSymbol, ss); + + if name[1] <> '<' then + begin + // --------------------------------------------------------- + // Handle AnsiString symbols. + // --------------------------------------------------------- + if name[1] = '"' then + begin + if ss <> nil then + begin + if ss.Lbl = '' then + ss.Lbl := fLitPrefix + Copy( name, 2, Length(name)-2); + + line := Format( frm, [ss.Lbl, value]); + println( line); + end; + end + + // --------------------------------------------------------- + // Handle token symbols. + // --------------------------------------------------------- + else + begin + if ts <> nil then + begin + line := Format( frm, [fTokPrefix + name, value]); + println( line); + end +// else +// fGrammar.Tool.Error( 'Undefined token symbol' + name); + end + end + end; + +(* + for i:=0 to fGrammar.TokenManager.Vocabulary.Count -1 do + begin + name := fGrammar.TokenManager.Vocabulary.Names[i]; + value := fGrammar.TokenManager.Vocabulary.Values[name]; + ts := fGrammar.TokenManager.TokenSymbol[name]; + ss := nil; + + if ts <> nil then + ts.QueryInterface( IStringSymbol, ss); + + if name[1] <> '<' then + begin + // --------------------------------------------------------- + // Handle AnsiString symbols. + // --------------------------------------------------------- + if name[1] = '"' then + begin + if ss <> nil then + begin + if ss.Lbl = '' then + ss.Lbl := fLitPrefix + Copy( name, 2, Length(name)-2); + + line := Format( frm, [ss.Lbl, value]); + println( line); + end; + end + + // --------------------------------------------------------- + // Handle token symbols. + // --------------------------------------------------------- + else + begin + if ts <> nil then + begin + line := Format( frm, [fTokPrefix + name, value]); + println( line); + end +// else +// fGrammar.Tool.Error( 'Undefined token symbol' + name); + end + end + end; +*) + fTabs := 0; + + // --------------------------------------------------------------- + // Generate the rest... + // --------------------------------------------------------------- + println(''); + println('implementation'); + println('end.'); + + fOutput.Free; +end; + +// ============================================================================ +// genInitLiterals +// ============================================================================ +procedure TDelphiGenerator.genInitLiterals; +var + i : integer; + l : integer; + len : integer; + line : AnsiString; + frm : AnsiString; + + name : AnsiString; + value : AnsiString; + + s : AnsiString; + +begin + println('// ----------------------------------------------------------------------------'); + println('// InitLiterals'); + println('// ----------------------------------------------------------------------------'); + println('procedure ' + fGrammar.GrammarName + '.initialize;'); + println('begin'); + INC(fTabs); + + if not fLexerGrammar.CaseSensitive then + begin + println('fCaseSensitive := false;'); + println('fLiterals.CaseSensitive := false;'); + println(''); + end; + + // --------------------------------------------------------------- + // Calculate maximum length of the AnsiString literal names. + // --------------------------------------------------------------- + len := 0; + + for name in fGrammar.TokenManager.Vocabulary.Keys do + begin + if name[1] = '"' then + begin + l := Length(name) -2; + + if len < l then + len := l; + end; + end; + +(* + for i:=0 to fGrammar.TokenManager.Vocabulary.Count -1 do + begin + name := fGrammar.TokenManager.Vocabulary.Names[i]; + + if name[1] = '"' then + begin + name := Copy( name, 2, Length(name)-2); + + if len < Length( name) then + len := Length( name); + end; + end; +*) + // --------------------------------------------------------------- + // Add minimum 1 extra space for spearator + // --------------------------------------------------------------- + INC(len); + + // --------------------------------------------------------------- + // Write out the code + // --------------------------------------------------------------- + for s in fGrammar.TokenManager.Vocabulary.Keys do + begin + value := IntToStr( fGrammar.TokenManager.Vocabulary.Items[s]); + + if not fLexerGrammar.CaseSensitive + then name := AnsiLowerCase(s) + else name := s; + + if name[1] = '"' then + begin + name := Copy( name, 2, Length(name)-2); + frm := 'fLiterals[''%s''%' + IntToStr( len - Length(name)) +'s] :=%3.3s;'; + line := Format( frm, [name,' ',value]); + println(line); + end + end; + +(* + for i:=0 to fGrammar.TokenManager.Vocabulary.Count -1 do + begin + name := fGrammar.TokenManager.Vocabulary.Names[i]; + value := fGrammar.TokenManager.Vocabulary.Values[name]; + + if not fLexerGrammar.CaseSensitive then + name := LowerCase( name); + + if name[1] = '"' then + begin + name := Copy( name, 2, Length(name)-2); + frm := 'fLiterals[''%s''%' + IntToStr( len - Length(name)) +'s] :=%3.3s;'; + line := Format( frm, [name,' ',value]); + println(line); + end; + end; +*) + + // --------------------------------------------------------------- + // Close the procedure + // --------------------------------------------------------------- + DEC(fTabs); + println('end;'); + println(''); +end; + +// ---------------------------------------------------------------------------- +// genNextToken +// ---------------------------------------------------------------------------- +procedure TDelphiGenerator.genNextToken; +var + i : integer; + b : boolean; + a : IAlternative; + rs : IRuleSymbol; + rb : IRuleBlock; + + filterMode : boolean; + filterRule : AnsiString; + + errFin : AnsiString; + blkFin : TDelphiBlockFinishingInfo; + first : TByteSet; + +begin + // --------------------------------------------------------------- + // Generate method header + // --------------------------------------------------------------- + println('// ----------------------------------------------------------------------------'); + println('// NextToken'); + println('// ----------------------------------------------------------------------------'); + println('function ' + fGrammar.GrammarName + '.NextToken : IToken;'); + + // --------------------------------------------------------------- + // Check for at least 1 public rule. + // --------------------------------------------------------------- + b := false; + for i:=0 to fGrammar.Rules.Count -1 do + begin + fGrammar.Rules.Items[i].QueryInterface(IRuleSymbol, rs); + + if rs.Access = 'public' then + begin + b := true; + break; + end; + end; + + // --------------------------------------------------------------- + // If the grammar has no public rule, then generate fake method + // returning TT_EOF + // --------------------------------------------------------------- + if b = false then + begin + println('begin'); + INC(fTabs); + println('result := TToken.Create(TT_EOF);'); + DEC(fTabs); + println('end;'); + exit; + end; + + // --------------------------------------------------------------- + // OK. Here we have at least one public rule. + // Create a synthesized NextToken rule + // --------------------------------------------------------------- + rb := TGrammarMaker.CreateNextTokenRule( fGrammar, fGrammar.Rules, 'NextToken'); + rs := TRuleSymbol.Create('mNextToken'); + + rs.Defined := true; + rs.Block := rb; + rs.Access := 'private'; + fGrammar.Define( rs); + + // --------------------------------------------------------------- + // Analyze the rule + // --------------------------------------------------------------- + fGrammar.LLkAnalyzer.Deterministic(rb); + first := rb.Look(1).LaSet; + + // --------------------------------------------------------------- + // OK, now generate... + // --------------------------------------------------------------- + filterMode := fLexerGrammar.FilterMode; + filterRule := fLexerGrammar.FilterRule; + + // --------------------------------------------------------------- + // ...local vars... + // --------------------------------------------------------------- +// println('var'); +// INC(fTabs); +// println('_ttype : integer;'); + + // --------------------------------------------------------------- + // If the lexer isn't a filter lexer, then we need the FIRST set + // in error message. + // --------------------------------------------------------------- + if not filterMode then + begin + println('var'); + println(fTab + '_first : TCharSet;'); + println(''); + end + + // --------------------------------------------------------------- + // In filter lexer check that this is a simple filter or a filter + // rule is defined. If filter rule defined, then define local var + // to mark the lexer state. + // --------------------------------------------------------------- + else + begin + if filterRule <> '' then + begin + println('var'); + println(fTab + '_mark : integer;'); + println(''); + end; + end; + + println('begin'); + INC(fTabs); + + // --------------------------------------------------------------- + // ...local var init... + // --------------------------------------------------------------- + // --------------------------------------------------------------- + // If the lexer isn't a filter lexer, initialize FIRST set. + // in error message. + // --------------------------------------------------------------- + if not filterMode then + begin + println('_first := [' + CharSetToStr( first) + '];'); + println(''); + end; + + // --------------------------------------------------------------- + // ...code... + // --------------------------------------------------------------- + println('while( true) do'); + println('begin'); + INC(fTabs); +// println('_ttype := TT_INVALID;'); +// println('CommitToPath := false;'); + + if filterRule <> '' then + begin + // ------------------------------------------------------------ + // Here's a good place to ensure that the filter rule + // actually exists. + // ------------------------------------------------------------ + if not fGrammar.Defined( encodeLexerRuleName( filterRule)) then + fTool.Error(Format(MSG_E_NOFILTERRULE, [filterRule])) + else + begin + fGrammar.Symbol[encodeLexerRuleName(filterRule)].QueryInterface( IRuleSymbol,rs); + + if rs.Access <> 'protected' then + fTool.Error( Format( MSG_E_PROTECTEDFILTER, [filterRule])); +// fTool.Error('Filter rule ' + filterRule + 'must be protected.'); + end; + + println('_mark := mark;'); + end; + + println('ResetText;'); + println(''); + + // ------------------------------------------------------------ + // Generate try around whole thing to trap scanner errors. + // ------------------------------------------------------------ + println('try'); + INC(fTabs); + + // --------------------------------------------------------------- + // Test for public lexical rules with empty paths + // --------------------------------------------------------------- + for i:=0 to rb.Alternatives.Count -1 do + begin + rb.Alternatives[i].QueryInterface(IAlternative, a); + + if a.Cache[1].Epsilon <> [] then + begin + + fTool.Warning( MSG_W_OPTIONALPATH, + fGrammar.GrammarFile, + 0, + 0); + +// fTool.Warning('Optional path found in NextToken.'); +// fLexerGrammar.Tool.Warning('Optional path found in NextToken.'); + break; + end; + end; + + // --------------------------------------------------------------- + // Generate the block + // --------------------------------------------------------------- + genCommonBlock( rb, false); + + errFin := 'if LA(1) = EOF_CHAR then' +#13+#10; + errFin := errFin + 'begin' +#13+#10; + errFin := errFin + fTab + 'uponEof;' +#13+#10; + errFin := errFin + fTab + 'result := TToken.Create(TT_EOF);' +#13+#10; + errFin := errFin + 'end' +#13+#10; + errFin := errFin +#13+#10; + + // ------------------------------------------------------------ + // Filter mode + // ------------------------------------------------------------ + if filterMode then + begin + if filterRule = '' then + begin + errFin := errFin + 'else' +#13+#10; + errFin := errFin + 'begin' +#13+#10; + errFin := errFin + fTab + 'consume;' +#13+#10; + errFin := errFin + fTab + 'continue;' +#13+#10; + errFin := errFin + 'end;';// +#13+#10; + end + + else + begin + errFin := errFin + 'else' +#13+#10; + errFin := errFin + 'begin' +#13+#10; + errFin := errFin + fTab + 'commit;' +#13+#10; + errFin := errFin +#13+#10; + errFin := errFin + fTab + 'try' +#13+#10; + errFin := errFin + fTab + fTab +'m' +filterRule +'(false);' +#13+#10; + errFin := errFin + fTab + 'except' +#13+#10; + errFin := errFin + fTab + fTab + 'on e:Exception do' +#13+#10; + errFin := errFin + fTab + fTab + 'begin' +#13+#10; + errFin := errFin + fTab + fTab + fTab + 'reportError(e);' +#13+#10; + errFin := errFin + fTab + fTab + fTab + 'consume;' +#13+#10; + errFin := errFin + fTab + fTab + 'end;' +#13+#10; + errFin := errFin + fTab + 'end;' +#13+#10; + errFin := errFin +#13+#10; + errFin := errFin + fTab + 'continue;' +#13+#10; + errFin := errFin + 'end;' +#13+#10; + end; + end + + // ------------------------------------------------------------ + // Normal mode + // ------------------------------------------------------------ + else + begin + errFin := errFin + 'else'+#13+#10; + errFin := errFin + fTab + + 'Raise EMismatchedChar.Create(' + + 'LA(1), _first, InputState.FileName, InputState.Line, InputState.Column);' +#13+#10; + end; + + blkFin := TDelphiBlockFinishingInfo.Create; + blkFin.NeedAnErrorClause := true; + blkFin.GeneratedAnIf := true; + blkFin.GeneratedSwitch := false; + + genBlockFinish( blkFin, errFin); + + // --------------------------------------------------------------- + // At this point a valid token has been matched, undo "mark" that + // was done + // --------------------------------------------------------------- + if filterMode and (filterRule <> '') then + begin + println(''); + println('commit;'); + end; + + // --------------------------------------------------------------- + // Generate literals test if desired. + // Make sure _ttype is set first; note _returnToken must be + // non-null as the rule was required to create it. + // --------------------------------------------------------------- + println(''); + println('// --------------------------------------------------------------'); + println('// If we found a SKIP token, then try again...'); + println('// --------------------------------------------------------------'); + println('if result = nil then'); + INC(fTabs); + println('continue;'); + println(''); + DEC(fTabs); + + if fLexerGrammar.TestLiterals then + begin + println('// --------------------------------------------------------------'); + println('// Literals test'); + println('// --------------------------------------------------------------'); + println('result.TokenType := TestLiteral(result.TokenType);'); + println(''); + end; + + println('// --------------------------------------------------------------'); + println('// Now we have a valid token, so exit the function'); + println('// --------------------------------------------------------------'); + println('break;'); + println(''); + + // --------------------------------------------------------------- + // Close try block + // --------------------------------------------------------------- + DEC(fTabs); + println('except'); + INC(fTabs); + + if fLexerGrammar.FilterMode then + begin + if filterRule = '' then + begin + println('consume;'); + println('continue;'); + end + + else + begin + println('rewind(_mark);'); + println('ResetText;'); + println(''); + println('try'); + println(fTab + 'm'+filterRule+'(false);'); + println(''); + println('except'); + println(fTab + 'on e:Exception do'); + println(fTab + 'begin'); + println(fTab + fTab + 'reportError(e);'); + println(fTab + fTab + 'consume;'); + println(fTab + 'end;'); + println('end;'); + end; + end + + else + begin + println('Raise;'); + end; + + DEC(fTabs); + println('end;'); + + // --------------------------------------------------------------- + // Close while(true) block + // --------------------------------------------------------------- + DEC(fTabs); + println('end;'); + + // --------------------------------------------------------------- + // Finish the method + // --------------------------------------------------------------- + fTabs := 0; + println('end;'); + println(''); +end; + + +// ================================================================================================ +// genUses +// +// Generate uses clause form interface section. +// ================================================================================================ +procedure TDelphiGenerator.genUses; +var + i : integer; + items : TStringList; + +begin + items := fGrammar.UsesList; + + if fGrammar.ExportVocab = '' + then items.Add( fGrammar.UnitName + 'Tokens') + else items.Add(fGrammar.ExportVocab + 'Tokens'); + + fTabs := 0; + println('uses'); + fTabs := 1; + + for i:=0 to items.count -1 do + begin + print( items.Strings[i]); + + if i < (items.Count -1) then + _println(',') + else + _println(';'); + end; + + fTabs := 0; + println(''); +end; + +// ================================================================================================ +// genUses2 +// +// Generate uses clause form implementation section. +// ================================================================================================ +procedure TDelphiGenerator.genUses2; +var + i : integer; + items : TStringList; + +begin + items := fGrammar.UsesList2; + + fTabs := 0; + println('uses'); + fTabs := 1; + + for i:=0 to items.count -1 do + begin + print( items.Strings[i]); + + if i < (items.Count -1) then + _println(',') + else + _println(';'); + end; + + fTabs := 0; + println(''); +end; + +// ============================================================================ +// genClassDecl +// ============================================================================ +procedure TDelphiGenerator.genClassDecl; +var + i : integer; + rs : IRuleSymbol; + + cntPriv : integer; + cntProt : integer; + cntPub : integer; + lenMax : integer; + + fmt : AnsiString; + +begin + fTabs := 0; + + // --------------------------------------------------------------- + // generate "class" section + // --------------------------------------------------------------- + if fGrammar.ConstAction <> nil then + begin + println('const'); + inc(fTabs); + println('// ========================================================================='); + println('// Const declarations from grammar.'); + println('// ========================================================================='); + printAction( fGrammar.ConstAction.TokenText); + println(''); + dec(fTabs); + end; + + // --------------------------------------------------------------- + // generate "type" section + // --------------------------------------------------------------- + println('type'); + INC(fTabs); + + if fGrammar.TypeAction <> nil then + begin + println('// ========================================================================='); + println('// Type declarations from grammar.'); + println('// ========================================================================='); + printAction( fGrammar.TypeAction.TokenText); + println(''); + end; + + // --------------------------------------------------------------- + // Generate class declaration header + // --------------------------------------------------------------- + println('// ========================================================================='); + println('// Class ' + fGrammar.GrammarName + ' declaration'); + println('// ========================================================================='); + if fIsLexer then + println( fGrammar.GrammarName + ' = class( TLexer)') + + else if fIsParser then + println( fGrammar.GrammarName + ' = class( TLLkParser)'); + + println(''); + + // --------------------------------------------------------------- + // Generate memberdecl{...} section + // --------------------------------------------------------------- + if fGrammar.MemberDecl <> '' then + begin + printAction( fGrammar.MemberDecl); + println(''); + end; + + // --------------------------------------------------------------- + // Mandatory method declarations for lexer grammar. + // --------------------------------------------------------------- + if fIsLexer then + begin + if needsLexerInit then + begin + println('protected // Internals'); + println(fTab + 'procedure initialize; override;'); + println(''); + end; + end; + + // --------------------------------------------------------------- + // Calculate counts and length + // --------------------------------------------------------------- + cntPriv := 0; + cntProt := 0; + cntPub := 0; + lenMax := 0; + + for i:=0 to fGrammar.Rules.Count -1 do + begin + fGrammar.Rules.Items[i].QueryInterface( IRuleSymbol, rs); + + if rs.Access = 'private' then + INC( cntPriv) + else if rs.Access = 'protected' then + INC( cntProt) + else + INC( cntPub); + + if Length( rs.ID) > lenMax then + lenMax := Length( rs.ID); + end; + + INC( lenMax); + + + // --------------------------------------------------------------- + // Generate private method declarations + // --------------------------------------------------------------- + if cntPriv > 0 then + begin + fTabs := 1; + println('private // Private grammar rules'); + fTabs := 2; + + for i:=0 to fGrammar.Rules.Count -1 do + begin + fGrammar.Rules.Items[i].QueryInterface( IRuleSymbol, rs); + + if rs.Access = 'private' then + genMethodDecl( rs, lenMax, false); + end; + + fTabs := 1; + println(''); + end; + + // --------------------------------------------------------------- + // Generate protected method declarations + // --------------------------------------------------------------- + if cntProt > 0 then + begin + fmt := 'procedure %-' + IntToStr( lenMax) + 's' + ' pCreate: boolean);'; + + fTabs := 1; + println('public // Protected grammar rules'); + println(' // Must callable from parser too'); + fTabs := 2; + + for i:=0 to fGrammar.Rules.Count -1 do + begin + fGrammar.Rules.Items[i].QueryInterface( IRuleSymbol, rs); + + if rs.Access = 'protected' then + genMethodDecl( rs, lenMax, false); + end; + + fTabs := 1; + println(''); + end; + + // --------------------------------------------------------------- + // Generate public method declarations + // + // NOTE: + // + // by definition!!!! + // --------------------------------------------------------------- + if cntPub > 0 then + begin + + fTabs := 1; + if fIsLexer + then println('public // Public grammar rules') + else println('public // Public grammar rules'); + fTabs := 2; + + for i:=0 to fGrammar.Rules.Count -1 do + begin + fGrammar.Rules.Items[i].QueryInterface( IRuleSymbol, rs); + + if rs.Access = 'public' then + genMethodDecl( rs, lenMax, false); + end; + + fTabs := 1; + println(''); + end; + + // --------------------------------------------------------------- + // NextToken method declaration for lexer grammar. + // --------------------------------------------------------------- + if fIsLexer then + begin + println('public'); + INC(fTabs); + println('function NextToken: IToken; override;'); + DEC(fTabs); + end; + + println('end;'); + fTabs := 0; +end; + +// ============================================================================ +// genMethodDecl +// ============================================================================ +procedure TDelphiGenerator.genMethodDecl( pRuleSymbol : IRuleSymbol; + pLength : integer; + pFull : boolean); +var + rb : IRuleBlock; + l : AnsiString; + fmt: AnsiString; + +begin + // --------------------------------------------------------------- + // Special case: Public method in lexer grammar. In this case the + // rule should not have parameters and return value. + // --------------------------------------------------------------- + if (pRuleSymbol.Access = 'public') and fIsLexer then + begin + // ------------------------------------------------------------ + // Generate declaration + // ------------------------------------------------------------ + if not pFull then + begin + fmt := 'procedure %-' + IntToStr( pLength) + 's' + '( pCreate: boolean);'; + println( Format(fmt, [pRuleSymbol.ID])); + end + + // ------------------------------------------------------------ + // Generate definition + // ------------------------------------------------------------ + else + begin + l := 'procedure ' + fGrammar.GrammarName + '.' + pRuleSymbol.ID; + l := l + '( pCreate: boolean);'; + println( l); + end; + end + + // --------------------------------------------------------------- + // General case + // --------------------------------------------------------------- + else + begin + l := ''; + rb := pRuleSymbol.Block; + + // ------------------------------------------------------------ + // Determine method type (function/procedure) + // ------------------------------------------------------------ + if rb.ReturnAction <> '' then + l := 'function ' + else + l := 'procedure '; + + // ------------------------------------------------------------ + // gernerate class name + // ------------------------------------------------------------ + if pFull then + l := l + fGrammar.GrammarName + '.' + pRuleSymbol.ID + else + begin + fmt := '%-' + IntToStr( pLength) + 's'; + l := l + Format( fmt, [pRuleSymbol.ID]); + end; + + // ------------------------------------------------------------ + // Generate arguments for lexer grammar + // ------------------------------------------------------------ + if fIsLexer then + begin + l := l + '( pCreate: boolean'; + + if rb.Arguments <> '' then + l := l + '; ' + rb.Arguments; + + l := l + ')'; + end + + // ------------------------------------------------------------ + // Generate arguments for parser grammar + // ------------------------------------------------------------ + else if fIsParser then + begin + if rb.Arguments <> '' then + l := l + '( ' + rb.Arguments + ')'; + end; + + // ------------------------------------------------------------ + // Generate return value + // ------------------------------------------------------------ + if rb.ReturnAction <> '' then + l := l + ': ' + rb.ReturnAction; + + // ------------------------------------------------------------ + // Close the declaration + // ------------------------------------------------------------ + l := l + ';'; + + println( l); + end; +end; + +// ============================================================================ +// genBlockFinish +// ============================================================================ +procedure TDelphiGenerator.genBlockFinish( pHowToFinish : TDelphiBlockFinishingInfo; + pNoViableAction : AnsiString; + pSingleLine : boolean); +begin + if pHowToFinish.NeedAnErrorClause and + (pHowToFinish.GeneratedAnIf or + pHowToFinish.GeneratedSwitch) then + begin + // ------------------------------------------------------------ + // Handle generated if + // ------------------------------------------------------------ + if pHowToFinish.GeneratedAnIf then + begin +// if not pSingleLine then + println(''); + + println('else'); + + if not pSingleLine then + println('begin'); + end + + // ------------------------------------------------------------ + // Handle generated switch + // ------------------------------------------------------------ + else + println('begin'); + + INC(fTabs); +// printAction( '{'+#13+#10+#13+#10+pNoViableAction+#13+#10+'}'); + printAction( '{'+#13+#10+#13+#10+pNoViableAction+'}'); + DEC(fTabs); + + if not pSingleLine then + println('end;'); + end; + + if pHowToFinish.PostScript <> '' then + printAction( '{'+#13+#10+#13+#10+pHowToFinish.PostScript+#13+#10+'}'); + + if pHowToFinish.NeedAClosingEnd then + begin + DEC(fTabs); + println('end;'); + end; + +// println(''); +end; + +// ============================================================================ +// genCommonBlock +// ============================================================================ +function TDelphiGenerator.genCommonBlock( pBlock : IAlternativeBlock; + pNoTestForSingle : boolean) + : TDelphiBlockFinishingInfo; +var + nIF : integer; + closingBracesOfIFSequence : integer; + oldSaveText : boolean; + p : ILookahead; + alt : IAlternative; + i : integer; + ps : AnsiString; + e : AnsiString; + unpredicted : boolean; + hasEmptyAlt : boolean; + + effectiveDepth : integer; + startDepth : integer; + altDepth : integer; + semPred : AnsiString; + +begin + result := TDelphiBlockFinishingInfo.Create; + nIF := 0; + closingBracesOfIFSequence := 0; + + // --------------------------------------------------------------- + // Save the save text state + // --------------------------------------------------------------- + oldSaveText := fSaveText; + fSaveText := fSaveText and pBlock.AutoGen; + + // --------------------------------------------------------------- + // Is this block inverted? If so, generate special-case code. + // --------------------------------------------------------------- + if pBlock.IsNot and fAnalyzer.SubRuleCanBeInverted( pBlock, fIsLexer) then + begin + p := fAnalyzer.Look( 1, pBlock); + + // ------------------------------------------------------------ + // Variable assignment for labeled elems + // ------------------------------------------------------------ + if (pBlock.Lbl <> '') and (fSyntacticPredLevel = 0) then + println( pBlock.Lbl + ':= ' + fLT1Value + ';'); + + // ------------------------------------------------------------ + // Match the alternative + // ------------------------------------------------------------ + println('match( [' + CharSetToStr(p.LaSet) + ']);'); + exit; + end; + + // --------------------------------------------------------------- + // Special handling for single alt. + // --------------------------------------------------------------- + if pBlock.Alternatives.Count = 1 then + begin + alt := pBlock.Alternative[0]; + + // ------------------------------------------------------------ + // Generate a warning if there is a synPred for single alt. + // ------------------------------------------------------------ + if alt.SynPred <> nil then + + fTool.Warning( MSG_W_SYNTSUPERFLUOUS, + fGrammar.GrammarFile, + alt.SynPred.Line, + alt.SynPred.Column); + + if pNoTestForSingle then + begin + if alt.SemPred <> '' then + genSemPred( alt.SemPred); + + genAlt( alt, pBlock); + exit; + end; + end; + + // --------------------------------------------------------------- + // Do non-LL(1) and nondeterministic cases. + // This is tricky in the lexer, because of cases like: + // STAR : '*'; + // ASSIGN_STAR : "*="; + // Since NextToken is generated whitout a loop, then the STAR will + // have end-of-token as it's lookahead set for LA(2). So we must + // generate the alternatives containing trailing end-of-token in + // their lookahead sets *after* the alternatives without end-of-token. + // This implements the usual lexer convention that longer matches + // come before shorter ones, e.g. "*=" matches ASSIGN_STAR not STAR. + // + // For non-lexer grammars, this does not sort the alternatives by + // depth. Note that alternatives whose lookahead is purely end-of-token + // at k=1 end up as default or else clauses. + // --------------------------------------------------------------- + if fIsLexer + then startDepth := fLexerGrammar.MaxK + else startDepth := 0; + + // --------------------------------------------------------------- + // Check for empty alternative in the block + // --------------------------------------------------------------- + hasEmptyAlt := false; + + for i:=0 to pBlock.Alternatives.Count -1 do + begin + if altIsEmpty( pBlock.Alternative[i]) then + begin + hasEmptyAlt := true; + break; + end; + end; + + // --------------------------------------------------------------- + // Generate syntactic predicates first! + // + // Note: the rule must have minimum one non-empty alternative which + // has no syntactic predicate + // --------------------------------------------------------------- + if pBlock.HasASynPred then + begin + for i:=0 to pBlock.Alternatives.Count -1 do + begin + alt := pBlock.Alternative[i]; + + if alt.SynPred <> nil then + begin + println('if not _spMatch then'); + println('begin'); + INC(fTabs); + + genSynPred( alt.SynPred, e); + + INC(fTabs); + genAlt( alt, pBlock); + DEC(fTabs); + println('end;'); + DEC(fTabs); + println('end;'); + println(''); + end; + end; + + // ------------------------------------------------------ + // Well, the rest of the alternatives must be in an if + // clause. + // ------------------------------------------------------ + println('if not _spMatch then'); + println('begin'); + INC(fTabs); + end; + + // --------------------------------------------------------------- + // Now generate the normal alternatives + // --------------------------------------------------------------- + for altDepth := startDepth downto 0 do + begin + for i:=0 to pBlock.Alternatives.Count -1 do + begin + alt := pBlock.Alternative[i]; + unpredicted := False; + + // --------------------------------------------------------- + // Skip already generates alternatives with syntactic + // predicates. + // --------------------------------------------------------- + if alt.SynPred <> nil then + continue; + + // --------------------------------------------------------- + // Lexer grammar + // --------------------------------------------------------- + if fIsLexer then + begin + // ------------------------------------------------------ + // Calculate the "effective depth" of the alt, which is + // the max depth at which cache[dept] <> end-of-token. + // ------------------------------------------------------ + effectiveDepth := alt.LookaheadDepth; + + // ------------------------------------------------------ + // If the alt's lookahead depth is NONDETERMINISTIC then + // use the maximum lookahead. + // ------------------------------------------------------ + if effectiveDepth = NONDETERMINISTIC then + effectiveDepth := fLexerGrammar.MaxK; + + while (effectiveDepth >= 1) and + (alt.Cache[effectiveDepth].HasEpsilon or + (alt.Cache[effectiveDepth].LaSet = [1..255])) do + begin + DEC(effectiveDepth); + end; + + // ------------------------------------------------------ + // Ignore alts whose effective depth is other than the + // ones we are generating for this iteration. + // ------------------------------------------------------ + if effectiveDepth <> altDepth then + continue; + + unpredicted := lookaheadIsEmpty( alt, effectiveDepth); + e := getLookaheadTestExpr( alt, effectiveDepth); + end + + // --------------------------------------------------------- + // Non-lexer grammar. + // --------------------------------------------------------- + else + begin + unpredicted := lookaheadIsEmpty( alt, fGrammar.MaxK); + e := getLookaheadTestExpr( alt, fGrammar.MaxK); + end; + + // --------------------------------------------------------- + // If the alternative is empty, then don't generate checking + // code for the follow set, and say we don't need an error + // clause. The following token will handle the possible + // token mismatch. + // --------------------------------------------------------- + if altIsEmpty(alt) then + begin + result.NeedAnErrorClause := false; + continue; + end + + else if (unpredicted) and + (alt.SemPred = '') and + (alt.SynPred = nil) then + begin + // ------------------------------------------------------ + // The alt has empty prediction set and no predicate to + // help out. If we have not generated a previous if, just + // put {...} around the end-of-token clause. + // ------------------------------------------------------ + if nIF = 0 then + begin + println('begin'); + end + else + begin + println('else'); + println('begin'); + end; + + result.NeedAnErrorClause := false; + end + + else + begin + // ------------------------------------------------------ + // Generate semantic predicate + // ------------------------------------------------------ + if alt.SemPred <> '' then + begin + semPred := Copy( alt.SemPred,2,Length(alt.SemPred)-2); + + if e = 'true' then + e := '( ' + semPred + ')' + else + e := '(' + e + ' and (' + semPred + '))'; + end; + + // ------------------------------------------------------ + // Generate syntactic predicate + // ------------------------------------------------------ + if nIF > 0 then + begin + println(''); + +// if pBlock.HasASynPred then +// e := e + ' and not _spMatch'; + + println('else if ' + e + ' then'); + println('begin'); + end + else + begin +// if pBlock.HasASynPred then +// e := e + ' and not _spMatch'; + + println('if ' + e + ' then'); + println('begin'); + end; + end; + + INC(nIF); + INC(fTabs); + genAlt( alt, pBlock); + DEC(fTabs); + + if i = pBlock.Alternatives.Count -2 then + begin + if hasEmptyAlt + then println('end;') + else println('end') + end + else + println('end') + end; + end; + + // --------------------------------------------------------------- + // Close the synpred's if + // --------------------------------------------------------------- + if pBlock.HasASynPred then + result.NeedAClosingEnd := true; + + // --------------------------------------------------------------- + // Restore save text state. + // --------------------------------------------------------------- + fSaveText := oldSaveText; + + // --------------------------------------------------------------- + // Return the finishing info. + // --------------------------------------------------------------- + result.PostScript := ps; + result.GeneratedAnIf := nIF > 0; +end; + +// ============================================================================ +// suitableForCaseExpression +// ============================================================================ +//function TDelphiGenerator.suitableForCaseExpression( pAlt: IAlternative): boolean; +//begin +// result := false; +//end; + +// ============================================================================ +// lookaheadIsEmpty +// ============================================================================ +function TDelphiGenerator.lookaheadIsEmpty( pAlt : IAlternative; + pMaxDepth: integer): boolean; +var + depth : integer; + i : integer; + p : TByteSet; + +begin + result := true; + depth := pAlt.LookaheadDepth; + + if depth = NONDETERMINISTIC then + depth := fGrammar.MaxK; + + for i:=1 to depth do + begin + p := pAlt.Cache[i].LaSet; + + if p <> [] then + begin + result := false; + break; + end; + end; +end; + +// ============================================================================ +// genClassDef +// ============================================================================ +procedure TDelphiGenerator.genClassDef; +var + i : integer; + rs : IRuleSymbol; + +begin + // --------------------------------------------------------------- + // Generate rules + // --------------------------------------------------------------- + for i:=0 to fGrammar.Rules.Count -1 do + begin + rs := fGrammar.Rules[i] as IRuleSymbol; + + if rs.ID <> 'mNextToken' then + genRule( fGrammar.Rules[i] as IRuleSymbol); + end; + + // --------------------------------------------------------------- + // Generate lexer specific methods + // --------------------------------------------------------------- + if fIsLexer then + begin + genNextToken; + + if needsLexerInit then + genInitLiterals; + end; + + // --------------------------------------------------------------- + // finally generate member definitions,.... + // --------------------------------------------------------------- + if fGrammar.MemberDef <> '' then + printAction( fgrammar.MemberDef); +end; + +// ============================================================================ +// genRule +// ============================================================================ +procedure TDelphiGenerator.genRule(pRuleSymbol: IRuleSymbol); +var + rblk : IRuleBlock; + ulEx : IExceptionSpec; + alt : IAlternative; + pred : AnsiString; + htf : TDelphiBlockFinishingInfo; +// sl : TInterfaceList; +// sp : ISynPredBlock; +// i : integer; + follow : TByteSet; + rname : AnsiString; + +begin + fTabs := 0; + + // --------------------------------------------------------------- + // If the rule not defined, leave. + // --------------------------------------------------------------- + if not pRuleSymbol.Defined then + begin + if fIsLexer then + rname := TCodeGenerator.decodeLexerRuleName( pRuleSymbol.ID) + else + rname := pRuleSymbol.ID; + + fTool.Error( Format( MSG_E_RULENOTDEFINED, [rname]), + fGrammar.GrammarFile, + -1,0); + +// fTool.Error('Undefined rule: "' + pRuleSymbol.ID); + exit; + end; + + // --------------------------------------------------------------- + // Get the rule block + // --------------------------------------------------------------- + rblk := pRuleSymbol.Block; + + println('// ============================================================================'); + println('// ' + pRuleSymbol.ID); + println('// ============================================================================'); + genMethodDecl( pRuleSymbol, 0, true); + genRuleLocals( rblk); + + println('begin'); + INC(fTabs); + + // --------------------------------------------------------------- + // Initialize some of the local variables + // --------------------------------------------------------------- + if fIsLexer then + begin + println('_begin := Length( TokenText) +1;'); + println('_token := nil;'); + println('_ttype := TT_' + TCodeGenerator.decodeLexerRuleName(pRuleSymbol.ID)+';'); + end; + + // --------------------------------------------------------------- + // Initialize synpred vars + // --------------------------------------------------------------- + if rblk.HasASynPred then + begin + println('_spMatch := false;'); + println('_mkMatch := 0;'); + end; + println(''); + + // --------------------------------------------------------------- + // Generate try block around the entire rule if necessary + // --------------------------------------------------------------- + if (rblk.ExHandlerType <> '') or + (rblk.DefaultErrorHandler and (not fIsLexer)) then + begin + println('try'); + INC(fTabs); + end; + + // --------------------------------------------------------------- + // Generate block init action + // --------------------------------------------------------------- + genBlockInitAction( rblk); + + // --------------------------------------------------------------- + // Generate the alternatives + // --------------------------------------------------------------- + if rblk.Alternatives.Count = 1 then + begin + // ------------------------------------------------------------ + // One alternative -- use simple form + // ------------------------------------------------------------ + alt := rblk.Alternative[0]; + pred := alt.SemPred; + + if pred <> '' then + genSemPred( pred); + + if alt.SynPred <> nil then + begin + fTool.Warning( MSG_W_SYNTIGNORED, + fGrammar.GrammarFile, + alt.SynPred.Line, + alt.SynPred.Column); + end; + + genAlt( alt, rblk); + end + + else + begin + // ------------------------------------------------------------ + // More than one alternatives -- generate complex form + // ------------------------------------------------------------ + fGrammar.LLkAnalyzer.Deterministic( rblk); + + htf := genCommonBlock( rblk, false); + genBlockFinish( htf, throw(rblk.Look(1)), true); + end; + + // --------------------------------------------------------------- + // Generate exception handler + // --------------------------------------------------------------- + if (rblk.ExHandlerType <> '') or + (rblk.DefaultErrorHandler and (not fIsLexer)) then + begin + println(''); + + // ------------------------------------------------------------ + // Generate user exception-handler code, or.... + // ------------------------------------------------------------ + if rblk.ExHandlerType <> '' then + begin + DEC( fTabs); + println(rblk.ExHandlerType); + INC(fTabs); + + if( rblk.ExHandlerType = 'except') then + begin + println('on e:Exception do'); + println('begin'); + INC(fTabs); + end; + end + + // ------------------------------------------------------------ + // ... default error handler code.... + // ------------------------------------------------------------ + else + begin + DEC( fTabs); + println('except'); + INC(fTabs); + println('on e:Exception do'); + println('begin'); + INC(fTabs); + end; + + // ------------------------------------------------------------ + // Generate code to handle error if not guessing... + // ------------------------------------------------------------ + if fGrammar.HasSynPred then + begin + println('if InputState.Guessing = 0 then'); + println('begin'); + INC(fTabs); + end; + + // ------------------------------------------------------------ + // Now the real handler... + // ------------------------------------------------------------ + if rblk.ExHandlerType <> '' then + begin + printAction( rblk.ExHandlerCode); + end + + else + begin + follow := rblk.EndElem.Look(1).LaSet; + + println('reportError(e);'); + println('Consume;'); + println('ConsumeUntil( [' + + TokenSetToStr(follow,fGrammar.TokenManager)+ + ']);'); + end; + + // --------------------------------------------------------- + // When guiessing, rethrow exception + // --------------------------------------------------------- + if fGrammar.HasSynPred then + begin + DEC(fTabs); + + println('end'); + + if rblk.ExHandlerType <> 'finally' then + begin + println('else'); + println(fTab + 'Raise;'); + end; + end; + + DEC(fTabs); + println('end;'); + + if rblk.ExHandlerType <> 'finally' then + begin + DEC(fTabs); + println('end;'); + end; + end; + + + // --------------------------------------------------------------- + // Generate literals test for lexer rules so marked + // --------------------------------------------------------------- + if rblk.TestLiterals then + begin + if pRuleSymbol.Access = 'protected' + then genLiteralsTestForPartialToken + else genLiteralsTest; + end; + + // --------------------------------------------------------------- + // If doing a lexer rule, dump code to create token if necessary. + // --------------------------------------------------------------- + if fIsLexer then + begin + println(''); + println('if (_ttype <> TT_SKIP) and (pCreate = true) then'); + println('begin'); + INC(fTabs); + println('_token := makeToken( _ttype);'); + println('_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);'); + DEC(fTabs); + println('end;'); + println(''); + println('ReturnToken := _token;'); + end; + + DEC( fTabs); + println('end;'); + println(''); +end; + +// ============================================================================ +// genRuleInvocation +// ============================================================================ +procedure TDelphiGenerator.genRuleInvocation( pRuleRefElem: IRuleRefElem); +var + rs: IRuleSymbol; + +begin +// _print( pRuleRefElem.TargetRule + '( '); + + _print( pRuleRefElem.TargetRule); + + if fIsLexer or (pRuleRefElem.Args <> '') then + _print('('); + + // --------------------------------------------------------------- + // Lexers must tell rule if it should set _returnToken + // --------------------------------------------------------------- + if fIsLexer then + begin + // ------------------------------------------------------------ + // If labeled, could access Token, so tell the rule to generate + // ------------------------------------------------------------ + if pRuleRefElem.Lbl <> '' then + _print('true') + else + _print('false'); + end; + + // --------------------------------------------------------------- + // Process arguments to method, if any... + // --------------------------------------------------------------- + if pRuleRefElem.Args <> '' then + begin + if fIsLexer then + _print(', '); + + _print(pRuleRefElem.Args); + + + // ------------------------------------------------------------ + // Warn if the rule accepts no arguments + // ------------------------------------------------------------ + rs := fGrammar.Symbol[pRuleRefElem.TargetRule] as IRuleSymbol; + + if rs.Block.Arguments = '' then + begin + fTool.Warning( Format( MSG_W_RULEACCEPTSNOARGS, [pRuleRefElem.TargetRule]), + fGrammar.GrammarFile, + pRuleRefElem.Line, + pRuleRefElem.Column); + end; + end; + + // --------------------------------------------------------------- + // Close the invocation + // --------------------------------------------------------------- + if fIsLexer or (pRuleRefElem.Args <> '') then + _print(')'); + + _println(';'); +end; + +// ============================================================================ +// genSemPred +// ============================================================================ +procedure TDelphiGenerator.genSemPred(pSemPred: AnsiString); +var + semPred: AnsiString; + +begin + semPred := Trim( Copy( pSemPred, 2, Length( pSemPred) -2)); + + println(''); + println('if not (' + semPred + ') then'); + INC(fTabs); + println( 'Raise ESemantic.Create(''' + + sempred +''', InputState.FileName, InputState.Line, InputState.Column);'); + println(''); + DEC(fTabs); +end; + +// ============================================================================ +// genSynPred +// ============================================================================ +procedure TDelphiGenerator.genSynPred( pBlock : ISynPredBlock; + pLookaheadExpr : AnsiString); +var + id : AnsiString; + +begin + id := IntToStr( pBlock.ID); + + // --------------------------------------------------------------- + // Save input state + // --------------------------------------------------------------- + println('_mkMatch := mark;'); + println('_spMatch := true;'); + println(''); + println('InputState.Guessing := InputState.Guessing + 1;'); + + // --------------------------------------------------------------- + // Once inside the try, assume synpred works unless exception caught. + // --------------------------------------------------------------- + INC(fSyntacticPredLevel); + println(''); + println('try'); + INC(fTabs); + gen( pBlock as IAlternativeBlock); + DEC(fTabs); + println('except'); + INC(fTabs); + println('_spMatch := false;'); + DEC(fTabs); + println('end;'); + + // --------------------------------------------------------------- + // Restore input state. + // --------------------------------------------------------------- + println(''); + println('rewind( _mkMatch);'); + println('InputState.Guessing := InputState.Guessing - 1;'); + + DEC(fSyntacticPredLevel); +// DEC(fTabs); + + // --------------------------------------------------------------- + // Close lookahead test + // --------------------------------------------------------------- +// println('end;'); + + // --------------------------------------------------------------- + // Test synpred result + // --------------------------------------------------------------- + println(''); + println('if _spMatch then'); + println('begin'); +// INC(fTabs); +end; + + +// ============================================================================ +// genBlockInitAction +// ============================================================================ +procedure TDelphiGenerator.genBlockInitAction( pBlock: IAlternativeBlock); +begin + if pBlock.InitAction <> '' then + begin + printAction( pBlock.InitAction); + println(''); + end; +end; + +// ============================================================================ +// genAlt +// ============================================================================ +procedure TDelphiGenerator.genAlt( pAlt : IAlternative; + pBlk : IAlternativeBlock); +var + oldSaveText : boolean; + elem : IAlternativeElem; + be : IBlockEndElem; + +begin + // --------------------------------------------------------------- + // Save state + // --------------------------------------------------------------- + oldSaveText := fSaveText; + fSaveText := fSaveText and pAlt.DoAutoGen; + + // --------------------------------------------------------------- + // Generate try block around the alt for error handling + // --------------------------------------------------------------- + if pAlt.ExHandlerType <> '' then + begin + println('try'); + INC(fTabs); + end; + + // --------------------------------------------------------------- + // Generate elems + // --------------------------------------------------------------- + elem := pAlt.Head; + while elem.QueryInterface(IBlockEndElem, be) <> S_OK do + begin + elem.Generate; + elem := elem.Next; + end; + + // --------------------------------------------------------------- + // Close try block + // --------------------------------------------------------------- + if pAlt.ExHandlerType <> '' then + begin + println(''); + + DEC(fTabs); + println( pAlt.ExHandlerType); + INC(fTabs); + + if pAlt.ExHandlerType = 'except' then + begin + println('on e:Exception do'); + println('begin'); + INC(fTabs); + end; + + if fGrammar.HasSynPred then + begin + println('if InputState.Guessing = 0 then'); + println('begin'); + INC(fTabs); + end; + + printAction( pAlt.ExHandlerCode); + + if fGrammar.HasSynPred then + begin + DEC(fTabs); + println('end;'); + end; + + if pAlt.ExHandlerType = 'except' then + begin + DEC(fTabs); + println('end;'); + end; + + DEC(fTabs); + println('end'); + end; + + // --------------------------------------------------------------- + // Restore state + // --------------------------------------------------------------- + fSaveText := oldSaveText; +end; + +// ============================================================================ +// genLiteralsTest +// ============================================================================ +procedure TDelphiGenerator.genLiteralsTest; +begin +// println(''); +// println('// --------------------------------------------------------------'); +// println('// Consult literals table...'); +// println('// --------------------------------------------------------------'); + println('_ttype := TestLiteral( _ttype);'); + println(''); +end; + +// ============================================================================ +// genLiteralsTestForPartialToken +// ============================================================================ +procedure TDelphiGenerator.genLiteralsTestForPartialToken; +begin + println('_ttype := TestLiteral( Copy( TokenText, _begin, Length(TokenText)-_begin+1), _ttype);'); + println(''); +end; + +// ============================================================================ +// Gen(StringLiteral) +// ============================================================================ +procedure TDelphiGenerator.Gen(pAtom: IStringLiteralElem); +var + oldSaveText: boolean; + +begin + if (pAtom.Lbl <> '') and (fSyntacticPredLevel = 0) then + println(pAtom.Lbl + ' := ' + fLT1Value + ';'); + + oldSaveText := fSaveText; + fSaveText := fSaveText and (pAtom.AutoGenType = AUTOGEN_NONE); + + if oldSaveText and not fSaveText then + println('SaveConsumedInput := false;'); + + genMatch( pAtom); + + if oldSaveText and not fSaveText then + println('SaveConsumedInput := true;'); + + fSaveText := oldSaveText; +end; + +// ============================================================================ +// genMatch +// ============================================================================ +procedure TDelphiGenerator.genMatch(pAtom: IGrammarAtom); +var + cle : ICharLiteralElem; + sle : IStringLiteralElem; + wce : IWildcardElem; + tre : ITokenRefElem; + +begin + pAtom.QueryInterface( ICharLiteralElem, cle); + pAtom.QueryInterface( IStringLiteralElem, sle); + pAtom.QueryInterface( IWildcardElem, wce); + pAtom.QueryInterface( ITokenRefElem, tre); + + // --------------------------------------------------------------- + // Generate match for char literal elem. + // --------------------------------------------------------------- + if cle <> nil then + begin + if fIsLexer then + genMatchUsingAtomText( pAtom) + else + begin + fTool.Error( Format( MSG_E_CHARLITINNONLEXER, [pAtom.AtomText])); +// fTool.Error('Cannot reference character literals in non-lexer grammar: ' + +// pAtom.AtomText); + end; + end + + // --------------------------------------------------------------- + // Generate match for AnsiString literal elem. + // --------------------------------------------------------------- + else if sle <> nil then + begin + if fIsLexer + then genMatchUsingAtomText( pAtom) + else genMatchUsingAtomTokenType( pAtom); + end + + // --------------------------------------------------------------- + // Generate match for token ref elem. + // --------------------------------------------------------------- + else if tre <> nil then + genMatchUsingAtomText( pAtom) + + // --------------------------------------------------------------- + // Generate match for wildcard elem. + // --------------------------------------------------------------- + else if wce <> nil then + gen( wce); + +end; + +// ============================================================================ +// genMatchUsingAtomText +// ============================================================================ +procedure TDelphiGenerator.genMatchUsingAtomText( pAtom: IGrammarAtom); +var + cle : ICharLiteralElem; + sle : IStringLiteralElem; + +begin + pAtom.QueryInterface(ICharLiteralElem, cle); + pAtom.QueryInterface(IStringLiteralElem, sle); + + if not pAtom.IsNot then print('match(') + else print('matchNot('); + + if cle <> nil then + _print( CharSetToStr([pAtom.AtomText[1]])) + + else if sle <> nil then + _print( '''' + Copy( pAtom.AtomText, 2, Length( pAtom.AtomText)-2) + '''') + + else + _print( TokenSetToStr( [pAtom.TokenType], fGrammar.TokenManager)); + + _println(');'); +end; + +// ============================================================================ +// genMatchUsingAtomTokenType +// ============================================================================ +procedure TDelphiGenerator.genMatchUsingAtomTokenType( pAtom: IGrammarAtom); +begin + if not pAtom.IsNot + then println('match(' + getValueString( pAtom.TokenType) + ');') + else println('matchNot(' + getValueString( pAtom.TokenType) + ');'); +end; + +// ============================================================================ +// getValueString +// ============================================================================ +function TDelphiGenerator.getValueString(pType : integer): AnsiString; +var + ts: ITokenSymbol; + ss: IStringSymbol; + cs: AnsiString; + id: AnsiString; +// lbl: AnsiString; + +begin + if fIsLexer then + begin + println('//TODO:getValueString(lexer)'); + + + end + + else + begin + result := TokenSetToStr( [pType], fGrammar.TokenManager); + + ts := fGrammar.TokenManager.TokenSymbolByType[pType]; + + if ts = nil then + begin + result := 'TT_' + IntToStr( pType); + exit; + end; + + id := ts.ID; + ts.QueryInterface(IStringSymbol,ss); + + if ss <> nil then + begin + // --------------------------------------------------------- + // In AnsiString literal, use predefined label if any. If no + // predefined, try to mangle into LT_xxxx. + // If can't mangle, use int as last resort. + // --------------------------------------------------------- + if ss.Lbl <> '' then + result := ss.Lbl + + else + begin +// result := magleLiteral( tId); + if result = '' then + result := 'LT_' + IntToStr( pType); + end; + end + + else + begin + if id = 'EOF' + then result := 'TT_EOF' + else result := id; + end; + end; +end; + +// ============================================================================ +// Gen(WildCard) +// ============================================================================ +procedure TDelphiGenerator.Gen(pWc: IWildcardElem); +begin + if (pWc.Lbl <> '') and (fSyntacticPredLevel = 0) then + println( pWc.Lbl + ' := ' + fLT1Value + ';'); + + if fIsLexer then + begin + if fSaveText and (pWc.AutoGenType = AUTOGEN_BANG) then + println('SaveConsumedInput := false;'); + + println('matchNot( EOF_CHAR );'); + + if fSaveText and (pWc.AutoGenType = AUTOGEN_BANG) then + println('SaveConsumedInput := true;'); + end + + else if fIsParser then + println('matchNot( ' + getValueString(0) + ');'); +end; + +// ============================================================================ +// addSemPred +// ============================================================================ +function TDelphiGenerator.addSemPred(pSemPred: AnsiString): integer; +begin + result := fSemPreds.Add( pSemPred); +end; + +// ============================================================================ +// exitIfError +// ============================================================================ +procedure TDelphiGenerator.exitIfError; +begin +{ TODO : exitIfError } +end; + + +// ============================================================================ +// genPredictExpr +// ============================================================================ +procedure TDelphiGenerator.genPredictExpr( pLaList : TInterfaceList; + pLaDepth : integer); +var + i : integer; + la : ILookahead; + +begin + print('( '); + + for i:=0 to pLaDepth -1 do + begin + if i <> 1 then + begin + println(') and'); + print('( '); + end; + + pLaList.Items[i].QueryInterface(ILookahead, la); + + // ------------------------------------------------------------ + // Syntactic predicates can yield (epsilon) + // lookahead- There is no way to predic what that token would + // be. Allow anything instead. + // ------------------------------------------------------------ + if la.HasEpsilon then + _print('true') + else + _print(getLookaheadTestTerm(i,la)); + end; + + _println(')'); +end; + +// ============================================================================ +// getLookaheadTestExpr +// ============================================================================ +function TDelphiGenerator.getLookaheadTestExpr( pLaList : TInterfaceList; + pLaDepth : integer): AnsiString; +var + i : integer; + la : ILookahead; + +begin + result := '( '; + + for i:=0 to pLaDepth -1 do + begin + + pLaList.Items[i].QueryInterface(ILookahead, la); + + // ------------------------------------------------------------ + // Syntactic predicates can yield (epsilon) + // lookahead. There is no way to predic what that token would + // be. Allow anything instead. + // ------------------------------------------------------------ + if la.HasEpsilon then +// result := result + 'true' + else + begin + if i <> 0 then + result := result + ') and ('; + + result := result + getLookaheadTestTerm(i+1,la); + end; + end; + + result := result + ')'; +end; + +// ============================================================================ +// getLookaheadTestExpr +// ============================================================================ +function TDelphiGenerator.getLookaheadTestExpr( pAlt : IAlternative; + pMaxDepth: integer): AnsiString; +var + i : integer; + depth : integer; + laList : TInterfaceList; + +begin + if pAlt.LookaheadDepth <> NONDETERMINISTIC then + depth := pAlt.LookaheadDepth + else + depth := fGrammar.MaxK; + + // --------------------------------------------------------------- + // Empty lookahead can result from alt with semantic pred that can + // see end-of-token. E.g. A: {pred}? ('a')? ; + // --------------------------------------------------------------- + if pMaxDepth = 0 then + result := 'true' + + else + begin + laList := TInterfaceList.Create; + + for i:=1 to depth do + begin + if pAlt.Cache[i].LaSet <> [1..255] then + laList.Add( pAlt.Cache[i]) + else + break; + end; + + result := '(' + getLookaheadTestExpr( laList, i-1) + ')'; + end; + + + +end; + +// ============================================================================ +// getLookaheadTestTerm +// ============================================================================ +function TDelphiGenerator.getLookaheadTestTerm( pK : integer; + pLA : ILookahead): AnsiString; +begin + result := getLookaheadString( pK) + ' in '; + + if fIsLexer then + result := result + '[' + CharSetToStr( pLa.LaSet) + ']' + + else if fIsParser then + result := result + '[' + TokenSetToStr( pLa.LaSet, fGrammar.TokenManager) + ']'; +end; + +// ============================================================================ +// getLookaheadString +// ============================================================================ +function TDelphiGenerator.getLookaheadString(pK: integer): AnsiString; +begin + result := 'LA(' + IntToStr( pK) + ')'; +end; + +// ============================================================================ +// genRuleLocals +// ============================================================================ +procedure TDelphiGenerator.genRuleLocals(pRuleBlock: IRuleBlock); +var + i : integer; + vars : TStringList; + vName : AnsiString; + vType : AnsiString; + + lElems : TInterfaceList; + lOom : TInterfaceList; + lM2N : TInterfaceList; + +// lSyn : TInterfaceList; + elem : IAlternativeElem; + oom : IOneOrMoreBlock; + m2n : INMBlock; +// syn : ISynPredBlock; + +begin + vars := TStringList.Create; + vars.Sorted := true; + vars.Duplicates := dupIgnore; + + // --------------------------------------------------------------- + // Add mandatory local variables for lexer grammar. + // --------------------------------------------------------------- + if fIsLexer then + begin + vars.Add('_begin=integer'); + vars.Add('_ttype=integer'); + vars.Add('_save=integer'); + vars.Add('_token=IToken'); + end; + + // --------------------------------------------------------------- + // Collect labeled elems + // --------------------------------------------------------------- + lElems := pRuleBlock.LabeledElems; + + for i:=0 to lElems.Count -1 do + begin + lElems[i].QueryInterface( IAlternativeElem, elem); + if LowerCase(elem.Lbl) <> 'result' then + vars.Add( elem.Lbl + '=IToken'); + end; + + // --------------------------------------------------------------- + // Collect labels for (...)+ subrules + // --------------------------------------------------------------- + lOom := pRuleBlock.OneOrMoreBlocks; + for i:=0 to lOom.Count -1 do + begin + lOom.Items[i].QueryInterface(IOneOrMoreBlock, oom); + + if oom <> nil then + begin + if oom.Lbl <> '' then + vName := '_cnt_' + oom.Lbl + '=integer' + else + vName := '_cnt_' + IntToStr( oom.ID) + '=integer'; + + vars.Add(vName); + end; + end; + + // --------------------------------------------------------------- + // Collect labels for (...)@ subrules + // --------------------------------------------------------------- + lM2N := pRuleBlock.NMBlocks; + for i:=0 to lM2N.Count -1 do + begin + lM2N.Items[i].QueryInterface(INMBlock, m2n); + + if m2n <> nil then + begin + if m2n.Lbl <> '' + then vName := '_cnt_' + m2n.Lbl + '=integer' + else vName := '_cnt_' + IntToStr( m2n.ID) + '=integer'; + + vars.Add(vName); + end; + end; + + + // --------------------------------------------------------------- + // Collect labels for SynPred subrules + // --------------------------------------------------------------- + if pRuleBlock.HasASynPred then + begin + vars.Add('_spMatch=boolean'); + vars.Add('_mkMatch=integer'); + end; + +(* lSyn := pRuleBlock.SynPredBlocks; + for i:=0 to lSyn.Count -1 do + begin + lSyn.Items[i].QueryInterface(ISynPredBlock, syn); + + if syn <> nil then + begin + vName := '_sp' + IntToStr( syn.ID) + '=boolean'; + vars.Add(vName); + + vName := '_mk' + IntToStr( syn.ID) + '=integer'; + vars.Add(vName); + end; + end; +*) + // --------------------------------------------------------------- + // Now generate .... + // --------------------------------------------------------------- + if (vars.Count > 0) or (pRuleBlock.Locals <> '')then + begin + println('var'); + INC(fTabs); + + // ------------------------------------------------------------ + // Generate labeled elems + // ------------------------------------------------------------ + for i:=0 to vars.Count -1 do + begin + vName := vars.Names [i]; + vType := vars.Values[vName]; + + println( vName + ': ' + vType + ';'); + end; + + // ------------------------------------------------------------ + // Generate locals{...} + // ------------------------------------------------------------ + if pRuleBlock.Locals <> '' then + printAction( pRuleBlock.Locals); + + DEC(fTabs); + println(''); + end; +end; + +// ============================================================================ +// Gen(TokenRef) +// ============================================================================ +procedure TDelphiGenerator.Gen(pTokenRef: ITokenRefElem); +begin + if not fIsLexer then + begin + if (pTokenRef.Lbl <> '') and (fSyntacticPredLevel = 0) then + println(pTokenRef.Lbl + ' := ' + fLT1Value + ';'); + + genMatch( pTokenRef); + end + else + fTool.Panic('Token reference found in lexer...'); +end; + +// ============================================================================ +// Gen(TokenRange) +// ============================================================================ +procedure TDelphiGenerator.Gen(pElem: ITokenRangeElem); +begin + if not fIsLexer then + begin + if (pElem.Lbl <> '') and (fSyntacticPredLevel = 0) then + println( pElem.Lbl + ' := ' + fLT1Value + ';'); + + if pElem.BeginToken < pElem.EndToken then + println('match( [' + + TokenSetToStr( [pElem.BeginToken..pElem.EndToken], + fGrammar.TokenManager) + + ']);') + else + println('match( [' + + TokenSetToStr( [pElem.EndToken..pElem.BeginToken], + fGrammar.TokenManager) + + ']);'); + end; +end; + +// ============================================================================ +// Gen(GrammarAtom) +// ============================================================================ +procedure TDelphiGenerator.Gen(pAtom: IGrammarAtom); +var + tr : ITokenRefElem; + +begin + if pAtom.QueryInterface(ITokenRefElem, tr) = S_OK then + Gen(tr) + else + println('***InternalError:GrammarAtom generation***'); +end; + +// ============================================================================ +// Gen(BlockEnd) +// ============================================================================ +procedure TDelphiGenerator.Gen(pEnd: IBlockEndElem); +begin + println('***InternalError:BlockEndElem generation***'); +end; + +// ============================================================================ +// Gen(RuleEndElem) +// ============================================================================ +procedure TDelphiGenerator.Gen(pElem: IRuleEndElem); +begin + println('***InternalError:RuleEndElem generation***'); +end; + +// ============================================================================ +// Gen(SynPredBlock) +// ============================================================================ +procedure TDelphiGenerator.Gen(pBlk: ISynPredBlock); +begin + println('***InternalError:SynPredBlock generation***'); +end; + +// ============================================================================ +// Gen(RuleBlock) +// ============================================================================ +procedure TDelphiGenerator.Gen(pBlk: IRuleBlock); +begin + println('***InternalError:RuleBlock generation***'); +end; + + +function TDelphiGenerator.altIsEmpty(pAlt: IAlternative): boolean; +var + elem : IAlternativeElem; + be : IBlockEndElem; + +begin + elem := pAlt.Head; + + if elem.QueryInterface(IBlockEndElem, be) = S_OK then + result := true + else + result := false; +end; + +// ============================================================================ +// ============================================================================ +// throw +// ============================================================================ +function TDelphiGenerator.throw(pLA1: ILookahead): AnsiString; +begin + if fIsLexer then + result := 'Raise EMismatchedChar.Create( LA(1), [' + + CharSetToStr( pLA1.LaSet) + + '], InputState.FileName, InputState.Line, InputState.Column);' + + else + result := 'Raise EMismatchedToken.Create( LT(1), [' + + TokenSetToStr( pLA1.LaSet, fGrammar.TokenManager) + + '], InputState.FileName);'; +end; + +// ============================================================================ +// needsLexerInit +// ============================================================================ +function TDelphiGenerator.needsLexerInit: boolean; +var + i : integer; + name : AnsiString; + +begin + if fIsLexer then + begin + for name in fGrammar.TokenManager.Vocabulary.Keys do + begin + if name[1] = '"' then + begin + result := true; + break; + end; + end; + +// for i:=0 to fGrammar.TokenManager.Vocabulary.Count -1 do +// begin +// name := fGrammar.TokenManager.Vocabulary.Names[i]; +// +// if name[1] = '"' then +// begin +// result := true; +// break; +// end; +// end; + + if not fLexerGrammar.CaseSensitive then + result := true; + end + else + result := false; +end; + +end. diff --git a/src.lib/dpglib.DpgLexer.pas b/src.lib/dpglib.DpgLexer.pas new file mode 100644 index 0000000..37ca13f --- /dev/null +++ b/src.lib/dpglib.DpgLexer.pas @@ -0,0 +1,1879 @@ +// ============================================================================ +// This file is generated by the Delphi Parser Generator. +// ---------------------------------------------------------------------------- +// DPG version: 2.0.1.0r +// Grammar: dpglib.dpgLexer.g +// ============================================================================ +unit dpglib.DpgLexer; + +interface + +uses + Classes, + SysUtils, + dpglib.DpgLexerTokens, + dpgrtl.lexer, + dpgrtl.types; + +type + // ========================================================================= + // Class TDpgLexer declaration + // ========================================================================= + TDpgLexer = class( TLexer) + + protected // Internals + procedure initialize; override; + + public // Protected grammar rules + // Must callable from parser too + procedure mESC ( pCreate: boolean); + procedure mDNUMBER ( pCreate: boolean); + procedure mXNUMBER ( pCreate: boolean); + function mINT_RULEREF ( pCreate: boolean): integer; + procedure mWS_LOOP ( pCreate: boolean); + procedure mSLCOMMENT ( pCreate: boolean); + procedure mMLCOMMENT1 ( pCreate: boolean); + procedure mMLCOMMENT2 ( pCreate: boolean); + procedure mDDIGIT ( pCreate: boolean); + procedure mXDIGIT ( pCreate: boolean); + + public // Public grammar rules + procedure mLPAREN ( pCreate: boolean); + procedure mRPAREN ( pCreate: boolean); + procedure mRCURLY ( pCreate: boolean); + procedure mCOLON ( pCreate: boolean); + procedure mSEMI ( pCreate: boolean); + procedure mCOMMA ( pCreate: boolean); + procedure mASSIGN ( pCreate: boolean); + procedure mIMPLIES ( pCreate: boolean); + procedure mQUEST ( pCreate: boolean); + procedure mPLUS ( pCreate: boolean); + procedure mSTAR ( pCreate: boolean); + procedure mAT ( pCreate: boolean); + procedure mNOT ( pCreate: boolean); + procedure mOR ( pCreate: boolean); + procedure mBANG ( pCreate: boolean); + procedure mWILDCARD ( pCreate: boolean); + procedure mRANGE ( pCreate: boolean); + procedure mOPEN ( pCreate: boolean); + procedure mCLOSE ( pCreate: boolean); + procedure mCARET ( pCreate: boolean); + procedure mTREE_BEGIN ( pCreate: boolean); + procedure mCHARLIT ( pCreate: boolean); + procedure mSTRINGLIT ( pCreate: boolean); + procedure mINTEGER ( pCreate: boolean); + procedure mARGACTION ( pCreate: boolean); + procedure mACTION ( pCreate: boolean); + procedure mTOKENREF ( pCreate: boolean); + procedure mRULEREF ( pCreate: boolean); + procedure mCOMMENT ( pCreate: boolean); + procedure mWS ( pCreate: boolean); + + public + function NextToken: IToken; override; + end; + +implementation +uses + dpgrtl.exception, + dpgrtl.token; + + +// ============================================================================ +// mLPAREN +// ============================================================================ +procedure TDpgLexer.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 TDpgLexer.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; + +// ============================================================================ +// mRCURLY +// ============================================================================ +procedure TDpgLexer.mRCURLY( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_RCURLY; + + 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; + +// ============================================================================ +// mCOLON +// ============================================================================ +procedure TDpgLexer.mCOLON( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_COLON; + + 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; + +// ============================================================================ +// mSEMI +// ============================================================================ +procedure TDpgLexer.mSEMI( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_SEMI; + + 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; + +// ============================================================================ +// mCOMMA +// ============================================================================ +procedure TDpgLexer.mCOMMA( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_COMMA; + + 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 TDpgLexer.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; + +// ============================================================================ +// mIMPLIES +// ============================================================================ +procedure TDpgLexer.mIMPLIES( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_IMPLIES; + + 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; + +// ============================================================================ +// mQUEST +// ============================================================================ +procedure TDpgLexer.mQUEST( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_QUEST; + + 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; + +// ============================================================================ +// mPLUS +// ============================================================================ +procedure TDpgLexer.mPLUS( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_PLUS; + + 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; + +// ============================================================================ +// mSTAR +// ============================================================================ +procedure TDpgLexer.mSTAR( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_STAR; + + 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; + +// ============================================================================ +// mAT +// ============================================================================ +procedure TDpgLexer.mAT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_AT; + + 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; + +// ============================================================================ +// mNOT +// ============================================================================ +procedure TDpgLexer.mNOT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_NOT; + + 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; + +// ============================================================================ +// mOR +// ============================================================================ +procedure TDpgLexer.mOR( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_OR; + + 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; + +// ============================================================================ +// mBANG +// ============================================================================ +procedure TDpgLexer.mBANG( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_BANG; + + 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; + +// ============================================================================ +// mWILDCARD +// ============================================================================ +procedure TDpgLexer.mWILDCARD( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_WILDCARD; + + 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; + +// ============================================================================ +// mRANGE +// ============================================================================ +procedure TDpgLexer.mRANGE( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_RANGE; + + 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; + +// ============================================================================ +// mOPEN +// ============================================================================ +procedure TDpgLexer.mOPEN( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_OPEN; + + 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; + +// ============================================================================ +// mCLOSE +// ============================================================================ +procedure TDpgLexer.mCLOSE( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_CLOSE; + + 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; + +// ============================================================================ +// mCARET +// ============================================================================ +procedure TDpgLexer.mCARET( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_CARET; + + 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; + +// ============================================================================ +// mTREE_BEGIN +// ============================================================================ +procedure TDpgLexer.mTREE_BEGIN( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_TREE_BEGIN; + + 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; + +// ============================================================================ +// mCHARLIT +// ============================================================================ +procedure TDpgLexer.mCHARLIT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_CHARLIT; + + SaveConsumedInput := false; + match(''''); + SaveConsumedInput := true; + if (( LA(1) in ['\'])) then + begin + mESC(false); + end + + else if (( LA(1) in [#1..'&','('..'[',']'..#255])) then + begin + matchNot(''''); + end + + else + Raise EMismatchedChar.Create( LA(1), [#1..'&','('..#255], InputState.FileName, InputState.Line, InputState.Column); + SaveConsumedInput := false; + match(''''); + SaveConsumedInput := true; + + 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; + +// ============================================================================ +// mESC +// ============================================================================ +procedure TDpgLexer.mESC( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + d1: IToken; + d2: IToken; + number: AnsiString; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_ESC; + + SaveConsumedInput := false; + match('\'); + SaveConsumedInput := true; + if (( LA(1) in ['r'])) then + begin + match('r'); + TokenText[ Length( TokenText)] := AnsiChar(13); + end + + else if (( LA(1) in ['n'])) then + begin + match('n'); + TokenText[ Length( TokenText)] := AnsiChar(10); + end + + else if (( LA(1) in ['t'])) then + begin + match('t'); + TokenText[ Length( TokenText)] := AnsiChar(9); + end + + else if (( LA(1) in ['\'])) then + begin + match('\'); + end + + else if (( LA(1) in [''''])) then + begin + match(''''); + end + + else if (( LA(1) in ['"'])) then + begin + match('"'); + end + + else if (( LA(1) in ['x'])) then + begin + match('x'); + _save := Length( TokenText); + mXDIGIT(true); + TokenText := Copy(TokenText, 1, _save); + d1 := ReturnToken; + _save := Length( TokenText); + mXDIGIT(true); + TokenText := Copy(TokenText, 1, _save); + d2 := ReturnToken; + number := '$' + d1.TokenText + d2.TokenText; + TokenText[ Length( TokenText)] := AnsiChar( StrToInt( number)); + end + + else + Raise EMismatchedChar.Create( LA(1), ['"','''','\','n','r','t','x'], 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; + +// ============================================================================ +// mSTRINGLIT +// ============================================================================ +procedure TDpgLexer.mSTRINGLIT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_STRINGLIT; + + match('"'); + + while(true) do + begin + if (( LA(1) in ['\'])) then + begin + mESC(false); + end + + else 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; + +// ============================================================================ +// mINTEGER +// ============================================================================ +procedure TDpgLexer.mINTEGER( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + i: integer; + v: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_INTEGER; + + if (( LA(1) in ['0'..'9'])) then + begin + mDNUMBER(false); + v := 0; + for i:=1 to Length( TokenText) do + begin + v := v * 10 + ord( TokenText[i]) - ord('0'); + end; + + TokenText := IntToStr( v); + end + + else if (( LA(1) in ['$'])) then + begin + mXNUMBER(false); + 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); + end + + else + Raise EMismatchedChar.Create( LA(1), ['$','0'..'9'], 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; + +// ============================================================================ +// mDNUMBER +// ============================================================================ +procedure TDpgLexer.mDNUMBER( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_DNUMBER; + + match( ['0'..'9']); + + while(true) do + begin + if (( LA(1) in ['0'..'9'])) then + begin + mDDIGIT(false); + 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; + +// ============================================================================ +// mXNUMBER +// ============================================================================ +procedure TDpgLexer.mXNUMBER( pCreate: boolean); +var + _begin: integer; + _cnt_64: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_XNUMBER; + + SaveConsumedInput := false; + match('$'); + SaveConsumedInput := true; + _cnt_64 := 0; + + while(true) do + begin + if (( LA(1) in ['0'..'9','A'..'F','a'..'f'])) then + begin + mXDIGIT(false); + end + + else + begin + if _cnt_64 >= 1 then + break + else + Raise EMismatchedChar.Create( LA(1), ['0'..'9','A'..'F','a'..'f'], InputState.FileName, InputState.Line, InputState.Column); + end; + + INC(_cnt_64); + 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; + +// ============================================================================ +// mARGACTION +// ============================================================================ +procedure TDpgLexer.mARGACTION( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_ARGACTION; + + SaveConsumedInput := false; + match('['); + SaveConsumedInput := true; + + while(true) do + begin + 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 + matchNot(']'); + end + + else + break; + end; + + SaveConsumedInput := false; + match(']'); + SaveConsumedInput := true; + + 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; + +// ============================================================================ +// mACTION +// ============================================================================ +procedure TDpgLexer.mACTION( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_ACTION; + + match('{'); + + while(true) do + begin + 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 + matchNot('}'); + end + + else + break; + end; + + match('}'); + if (( LA(1) in ['?'])) then + begin + SaveConsumedInput := false; + match('?'); + SaveConsumedInput := true; + _ttype := TT_SEMPRED; + 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; + +// ============================================================================ +// mTOKENREF +// ============================================================================ +procedure TDpgLexer.mTOKENREF( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_TOKENREF; + + match( ['A'..'Z']); + + 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; + + _ttype := TestLiteral( _ttype); + + + 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; + +// ============================================================================ +// mRULEREF +// ============================================================================ +procedure TDpgLexer.mRULEREF( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + t: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_RULEREF; + + t := mINT_RULEREF(false); + _ttype := t; + if ( t = LT_uses) then + begin + mWS_LOOP(false); + if (( LA(1) in ['{'])) then + begin + match('{'); + _ttype := TT_USES; + end; + end + + else if ( t = LT_options) then + begin + mWS_LOOP(false); + if (( LA(1) in ['{'])) then + begin + match('{'); + _ttype := TT_OPTIONS; + end; + end + + else if ( t = LT_tokens) then + begin + mWS_LOOP(false); + if (( LA(1) in ['{'])) then + begin + match('{'); + _ttype := TT_TOKENS; + end; + 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_RULEREF +// ============================================================================ +function TDpgLexer.mINT_RULEREF( pCreate: boolean): integer; +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_INT_RULEREF; + + _ttype := TT_RULEREF; + + match( ['a'..'z']); + + 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; + + result := TestLiteral( _ttype); + + 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_LOOP +// ============================================================================ +procedure TDpgLexer.mWS_LOOP( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_WS_LOOP; + + + while(true) do + begin + if (( LA(1) in [#9..#10,#13,' '])) then + begin + mWS(false); + end + + else if (( LA(1) in ['(','/'])) then + begin + mCOMMENT(false); + 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; + +// ============================================================================ +// mCOMMENT +// ============================================================================ +procedure TDpgLexer.mCOMMENT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_COMMENT; + + if (( LA(1) in ['/']) and (LA(2) in ['/'])) then + begin + mSLCOMMENT(false); + _ttype := TT_SKIP; + end + + else if (( LA(1) in ['/']) and (LA(2) in ['*'])) then + begin + mMLCOMMENT2(false); + _ttype := TT_SKIP; + end + + else if (( LA(1) in ['('])) then + begin + mMLCOMMENT1(false); + _ttype := TT_SKIP; + end + + else + Raise EMismatchedChar.Create( LA(1), ['(','/'], 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; + +// ============================================================================ +// mSLCOMMENT +// ============================================================================ +procedure TDpgLexer.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); + + 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; + +// ============================================================================ +// mMLCOMMENT1 +// ============================================================================ +procedure TDpgLexer.mMLCOMMENT1( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_MLCOMMENT1; + + 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 + matchNot( EOF_CHAR ); + 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; + +// ============================================================================ +// mMLCOMMENT2 +// ============================================================================ +procedure TDpgLexer.mMLCOMMENT2( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_MLCOMMENT2; + + 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 + matchNot( EOF_CHAR ); + 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; + +// ============================================================================ +// mDDIGIT +// ============================================================================ +procedure TDpgLexer.mDDIGIT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_DDIGIT; + + 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 TDpgLexer.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; + +// ============================================================================ +// mWS +// ============================================================================ +procedure TDpgLexer.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); + tab; + 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; + +// ---------------------------------------------------------------------------- +// NextToken +// ---------------------------------------------------------------------------- +function TDpgLexer.NextToken : IToken; +var + _first : TCharSet; + +begin + _first := [#9..#10,#13,' '..'$',''''..',','.'..'[','^','a'..'~']; + + while( true) do + begin + ResetText; + + try + if (( LA(1) in ['=']) and (LA(2) in ['>'])) then + begin + mIMPLIES(true); + result := ReturnToken; + end + + else if (( LA(1) in ['.']) and (LA(2) in ['.'])) then + begin + mRANGE(true); + result := ReturnToken; + end + + else if (( LA(1) in ['(','/']) and (LA(2) in ['*','/'])) then + begin + mCOMMENT(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 + mRCURLY(true); + result := ReturnToken; + end + + else if (( LA(1) in [':'])) then + begin + mCOLON(true); + result := ReturnToken; + end + + else if (( LA(1) in [';'])) then + begin + mSEMI(true); + result := ReturnToken; + end + + else if (( LA(1) in [','])) then + begin + mCOMMA(true); + result := ReturnToken; + end + + else if (( LA(1) in ['='])) then + begin + mASSIGN(true); + result := ReturnToken; + end + + else if (( LA(1) in ['?'])) then + begin + mQUEST(true); + result := ReturnToken; + end + + else if (( LA(1) in ['+'])) then + begin + mPLUS(true); + result := ReturnToken; + end + + else if (( LA(1) in ['*'])) then + begin + mSTAR(true); + result := ReturnToken; + end + + else if (( LA(1) in ['@'])) then + begin + mAT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['~'])) then + begin + mNOT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['|'])) then + begin + mOR(true); + result := ReturnToken; + end + + else if (( LA(1) in ['!'])) then + begin + mBANG(true); + result := ReturnToken; + end + + else if (( LA(1) in ['.'])) then + begin + mWILDCARD(true); + result := ReturnToken; + end + + else if (( LA(1) in ['<'])) then + begin + mOPEN(true); + result := ReturnToken; + end + + else if (( LA(1) in ['>'])) then + begin + mCLOSE(true); + result := ReturnToken; + end + + else if (( LA(1) in ['^'])) then + begin + mCARET(true); + result := ReturnToken; + end + + else if (( LA(1) in ['#'])) then + begin + mTREE_BEGIN(true); + result := ReturnToken; + end + + else if (( LA(1) in [''''])) then + begin + mCHARLIT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['"'])) then + begin + mSTRINGLIT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['$','0'..'9'])) then + begin + mINTEGER(true); + result := ReturnToken; + end + + else if (( LA(1) in ['['])) then + begin + mARGACTION(true); + result := ReturnToken; + end + + else if (( LA(1) in ['{'])) then + begin + mACTION(true); + result := ReturnToken; + end + + else if (( LA(1) in ['A'..'Z'])) then + begin + mTOKENREF(true); + result := ReturnToken; + end + + else if (( LA(1) in ['a'..'z'])) then + begin + mRULEREF(true); + result := ReturnToken; + end + + else if (( LA(1) in [#9..#10,#13,' '])) then + begin + mWS(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; + +// ---------------------------------------------------------------------------- +// InitLiterals +// ---------------------------------------------------------------------------- +procedure TDpgLexer.initialize; +begin + fLiterals['finally' ] := 21; + fLiterals['returns' ] := 18; + fLiterals['public' ] := 17; + fLiterals['parser' ] := 9; + fLiterals['unit' ] := 4; + fLiterals['tokens' ] := 12; + fLiterals['uses' ] := 5; + fLiterals['treeparser' ] := 10; + fLiterals['memberdecl' ] := 13; + fLiterals['local' ] := 19; + fLiterals['lexer' ] := 8; + fLiterals['memberdef' ] := 14; + fLiterals['except' ] := 20; + fLiterals['protected' ] := 16; + fLiterals['type' ] := 7; + fLiterals['private' ] := 15; + fLiterals['options' ] := 11; + fLiterals['const' ] := 6; +end; + +end. diff --git a/src.lib/dpglib.DpgLexerTokens.pas b/src.lib/dpglib.DpgLexerTokens.pas new file mode 100644 index 0000000..1f48477 --- /dev/null +++ b/src.lib/dpglib.DpgLexerTokens.pas @@ -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. diff --git a/src.lib/dpglib.DpgParser.pas b/src.lib/dpglib.DpgParser.pas new file mode 100644 index 0000000..43d2105 --- /dev/null +++ b/src.lib/dpglib.DpgParser.pas @@ -0,0 +1,1457 @@ +// ============================================================================ +// This file is generated by the Delphi Parser Generator. +// ---------------------------------------------------------------------------- +// DPG version: 2.0.1.0r +// Grammar: dpglib.dpgParser.g +// ============================================================================ +unit dpglib.DpgParser; + +interface + +uses + Classes, + SysUtils, + dpglib.DpgParserTokens, + dpglib.types, + dpgrtl.llkparser, + dpgrtl.types; + +type + // ========================================================================= + // Class TDpgParser declaration + // ========================================================================= + TDpgParser = class( TLLkParser) + + 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; + + public // Public grammar rules + procedure grammar ; + function qualifiedId : IToken; + procedure usesDecl ; + procedure constDecl ; + procedure typeDecl ; + procedure classDecl ; + procedure qualifiedUsesName ; + function id : IToken; + procedure classOptions ; + procedure classTokens ; + procedure classMemberDecl ; + procedure rules ; + procedure classMemberDef ; + function optionValue : IToken; + procedure tokenSpecOptions ( t: IToken); + procedure rule ; + procedure ruleExceptionBlock ; + procedure altExceptionBlock ; + procedure ruleOptions ; + procedure block ; + procedure alternative ; + procedure elem ; + procedure element ; + procedure elementOptions ; + procedure range ( pTokenLabel: IToken); + procedure terminal ( pTokenLabel: IToken); + procedure notTerminal ( pTokenLabel: IToken); + procedure ebnf ( pTokenLabel: IToken; pTokenNot: boolean); + procedure tree ; + procedure rootNode ; + function astTypeSpec : integer; + procedure subRuleOptions ; + + end; + +implementation +uses + dpgrtl.exception, + dpgrtl.token; + + +// ============================================================================ +// grammar +// ============================================================================ +procedure TDpgParser.grammar; +var + unitName: IToken; + +begin + + match(LT_unit); + unitName := qualifiedId; + fGrammarUnit := unitName.TokenText; + match(TT_SEMI); + if (( LA(1) in [TT_USES])) then + begin + usesDecl; + end; + if (( LA(1) in [LT_const])) then + begin + constDecl; + end; + if (( LA(1) in [LT_type])) then + begin + typeDecl; + end; + classDecl; + fGrammarMaker.endGrammar; +end; + +// ============================================================================ +// qualifiedId +// ============================================================================ +function TDpgParser.qualifiedId: IToken; +var + buf : AnsiString; + a : IToken; + +begin + + a := id; + buf := a.TokenText; + + while(true) do + begin + if (( LA(1) in [TT_WILDCARD])) then + begin + match(TT_WILDCARD); + a := id; + buf := buf + '.' + a.TokenText; + end + + else + break; + end; + + // ----------------------------------------------------------- + // 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; +end; + +// ============================================================================ +// usesDecl +// ============================================================================ +procedure TDpgParser.usesDecl; +begin + + match(TT_USES); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + qualifiedUsesName; + match(TT_SEMI); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// constDecl +// ============================================================================ +procedure TDpgParser.constDecl; +var + a: IToken; + +begin + + match(LT_const); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefConstAction( a); +end; + +// ============================================================================ +// typeDecl +// ============================================================================ +procedure TDpgParser.typeDecl; +var + a: IToken; + +begin + + match(LT_type); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefTypeAction( a); +end; + +// ============================================================================ +// classDecl +// ============================================================================ +procedure TDpgParser.classDecl; +var + grType : integer; + grObject : IToken; + grSuper : IToken; + +begin + + grObject := nil; + grSuper := nil; + + if (( LA(1) in [LT_lexer])) then + begin + match(LT_lexer); + grType := 0; + end + + else if (( LA(1) in [LT_parser])) then + begin + match(LT_parser); + grType := 1; + end + + else if (( LA(1) in [LT_treeparser])) then + begin + match(LT_treeparser); + grType := 2; + end + + else + Raise EMismatchedToken.Create( LT(1), [LT_lexer..LT_treeparser], InputState.FileName); + grObject := id; + match(TT_SEMI); + // --------------------------------------------------------- + // 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); + if (( LA(1) in [TT_OPTIONS])) then + begin + classOptions; + end; + if ((( LA(1) in [TT_TOKENS])) and (grType=0)) then + begin + classTokens; + end; + if (( LA(1) in [LT_memberdecl])) then + begin + classMemberDecl; + end; + rules; + if (( LA(1) in [LT_memberdef])) then + begin + classMemberDef; + end; +end; + +// ============================================================================ +// qualifiedUsesName +// ============================================================================ +procedure TDpgParser.qualifiedUsesName; +var + r: IToken; + id: AnsiString; + +begin + + if (( LA(1) in [TT_TOKENREF])) then + begin + r := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_RULEREF])) then + begin + r := LT(1); + match(TT_RULEREF); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName); + id := r.TokenText; + + while(true) do + begin + if (( LA(1) in [TT_WILDCARD])) then + begin + match(TT_WILDCARD); + if (( LA(1) in [TT_TOKENREF])) then + begin + r := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_RULEREF])) then + begin + r := LT(1); + match(TT_RULEREF); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName); + id := id +'.'+ r.TokenText; + end + + else + break; + end; + + fGrammarMaker.defineUses(id); +end; + +// ============================================================================ +// id +// ============================================================================ +function TDpgParser.id: IToken; +begin + + if (( LA(1) in [TT_TOKENREF])) then + begin + result := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_RULEREF])) then + begin + result := LT(1); + match(TT_RULEREF); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName); +end; + +// ============================================================================ +// classOptions +// ============================================================================ +procedure TDpgParser.classOptions; +var + optName : IToken; + optValue : IToken; + +begin + + match(TT_OPTIONS); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + optName := id; + match(TT_ASSIGN); + optValue := optionValue; + match(TT_SEMI); + fGrammarMaker.setGrammarOption( optName, optValue); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// classTokens +// ============================================================================ +procedure TDpgParser.classTokens; +var + tokenName: IToken; + tokenString: IToken; + +begin + + match(TT_TOKENS); + + while(true) do + begin + if (( LA(1) in [TT_STRINGLIT,TT_TOKENREF])) then + begin + tokenName := nil; + tokenString := nil; + if (( LA(1) in [TT_TOKENREF])) then + begin + tokenName := LT(1); + match(TT_TOKENREF); + if (( LA(1) in [TT_ASSIGN])) then + begin + match(TT_ASSIGN); + tokenString := LT(1); + match(TT_STRINGLIT); + end; + fGrammarMaker.defineToken( tokenName, tokenString); + if (( LA(1) in [TT_OPEN])) then + begin + tokenSpecOptions(tokenName); + end; + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + tokenString := LT(1); + match(TT_STRINGLIT); + fGrammarMaker.defineToken( tokenName, tokenString); + if (( LA(1) in [TT_OPEN])) then + begin + tokenSpecOptions(tokenString); + end; + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_STRINGLIT,TT_TOKENREF], InputState.FileName); + match(TT_SEMI); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// classMemberDecl +// ============================================================================ +procedure TDpgParser.classMemberDecl; +var + memberDecl: IToken; + +begin + + match(LT_memberdecl); + memberDecl := LT(1); + match(TT_ACTION); + fGrammarMaker.refMemberDecl(memberDecl); +end; + +// ============================================================================ +// rules +// ============================================================================ +procedure TDpgParser.rules; +begin + + + while(true) do + begin + if (( LA(1) in [LT_private..LT_public,TT_TOKENREF..TT_RULEREF])) then + begin + rule; + end + + else + break; + end; + +end; + +// ============================================================================ +// classMemberDef +// ============================================================================ +procedure TDpgParser.classMemberDef; +var + memberDef: IToken; + +begin + + match(LT_memberdef); + memberDef := LT(1); + match(TT_ACTION); + fGrammarMaker.refMemberDef(memberDef); +end; + +// ============================================================================ +// optionValue +// ============================================================================ +function TDpgParser.optionValue: IToken; +begin + + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + result := qualifiedId; + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + result := LT(1); + match(TT_STRINGLIT); + end + + else if (( LA(1) in [TT_CHARLIT])) then + begin + result := LT(1); + match(TT_CHARLIT); + end + + else if (( LA(1) in [TT_INTEGER])) then + begin + result := LT(1); + match(TT_INTEGER); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_CHARLIT..TT_INTEGER,TT_TOKENREF..TT_RULEREF], InputState.FileName); +end; + +// ============================================================================ +// tokenSpecOptions +// ============================================================================ +procedure TDpgParser.tokenSpecOptions( t: IToken); +var + name : IToken; + value : IToken; + +begin + + name := nil; + value := nil; + + match(TT_OPEN); + name := id; + match(TT_ASSIGN); + value := optionValue; + fGrammarMaker.refTokenSpecElemOption( t, name, value); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + name := id; + match(TT_ASSIGN); + value := optionValue; + fGrammarMaker.refTokenSpecElemOption( t, name, value); + end + + else + break; + end; + + match(TT_CLOSE); +end; + +// ============================================================================ +// rule +// ============================================================================ +procedure TDpgParser.rule; +var + args: IToken; + initAction: IToken; + locals: IToken; + ret: IToken; + access : AnsiString; + ag : integer; + returns : IToken; + name : IToken; + +begin + + access := 'public'; + args := nil; + name := nil; + ag := AUTOGEN_NONE; + + if (( LA(1) in [LT_public])) then + begin + match(LT_public); + access := 'public'; + end + + else if (( LA(1) in [LT_protected])) then + begin + match(LT_protected); + access := 'protected'; + end + + else if (( LA(1) in [LT_private])) then + begin + match(LT_private); + access := 'private'; + end; + name := id; + if (( LA(1) in [TT_ARGACTION])) then + begin + args := LT(1); + match(TT_ARGACTION); + end; + if (( LA(1) in [LT_returns])) then + begin + match(LT_returns); + ret := LT(1); + match(TT_ARGACTION); + end; + fGrammarMaker.defineRuleName( name, access, true, ''); + + if args <> nil then + fGrammarMaker.refArgAction( args); + + if ret <> nil then + fGrammarMaker.refReturnAction( ret); + if (( LA(1) in [TT_OPTIONS])) then + begin + ruleOptions; + end; + if (( LA(1) in [LT_local])) then + begin + match(LT_local); + locals := LT(1); + match(TT_ACTION); + fGrammarMaker.refRuleLocals( locals); + end; + if (( LA(1) in [TT_ACTION])) then + begin + initAction := LT(1); + match(TT_ACTION); + fGrammarMaker.refInitAction( initAction); + end; + match(TT_COLON); + block; + match(TT_SEMI); + if (( LA(1) in [LT_except..LT_finally])) then + begin + ruleExceptionBlock; + end; + fGrammarMaker.endRule(''); +end; + +// ============================================================================ +// ruleExceptionBlock +// ============================================================================ +procedure TDpgParser.ruleExceptionBlock; +var + a: IToken; + t: IToken; + +begin + + if (( LA(1) in [LT_except])) then + begin + t := LT(1); + match(LT_except); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefRuleExHandler( t, a); + end + + else if (( LA(1) in [LT_finally])) then + begin + t := LT(1); + match(LT_finally); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefRuleExHandler( t, a); + end + + else + Raise EMismatchedToken.Create( LT(1), [LT_except..LT_finally], InputState.FileName); +end; + +// ============================================================================ +// altExceptionBlock +// ============================================================================ +procedure TDpgParser.altExceptionBlock; +var + a: IToken; + t: IToken; + +begin + + if (( LA(1) in [LT_except])) then + begin + t := LT(1); + match(LT_except); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefAltExHandler( t, a); + end + + else if (( LA(1) in [LT_finally])) then + begin + t := LT(1); + match(LT_finally); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefAltExHandler( t, a); + end + + else + Raise EMismatchedToken.Create( LT(1), [LT_except..LT_finally], InputState.FileName); +end; + +// ============================================================================ +// ruleOptions +// ============================================================================ +procedure TDpgParser.ruleOptions; +var + optName : IToken; + optValue : IToken; + +begin + + match(TT_OPTIONS); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + optName := id; + match(TT_ASSIGN); + optValue := optionValue; + match(TT_SEMI); + fGrammarMaker.setRuleOption( optName, optValue); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// block +// ============================================================================ +procedure TDpgParser.block; +begin + + INC( fNesting); + + alternative; + + while(true) do + begin + if (( LA(1) in [TT_OR])) then + begin + match(TT_OR); + alternative; + end + + else + break; + end; + + DEC(fNesting); +end; + +// ============================================================================ +// alternative +// ============================================================================ +procedure TDpgParser.alternative; +var + autoGen : boolean; + +begin + + autoGen := true; + + fGrammarMaker.beginAlt( autoGen); + + while(true) do + begin + if (( LA(1) in [TT_SEMPRED,TT_LPAREN,TT_NOT,TT_WILDCARD,TT_TREE_BEGIN..TT_STRINGLIT,TT_ACTION..TT_RULEREF])) then + begin + elem; + end + + else + break; + end; + + if (( LA(1) in [LT_except..LT_finally])) then + begin + altExceptionBlock; + end; + fGrammarMaker.endAlt; +end; + +// ============================================================================ +// elem +// ============================================================================ +procedure TDpgParser.elem; +begin + + element; + if (( LA(1) in [TT_OPEN])) then + begin + elementOptions; + end; +end; + +// ============================================================================ +// element +// ============================================================================ +procedure TDpgParser.element; +var + action: IToken; + ag: IToken; + args: IToken; + ruleRef: IToken; + semPred: IToken; + tokenRef: IToken; + assignId : IToken; + assignLabel : IToken; + autoGen : integer; + +begin + + assignId := nil; + assignLabel := nil; + autoGen := AUTOGEN_NONE; + + if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_ASSIGN])) then + begin + assignId := id; + match(TT_ASSIGN); + if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_COLON])) then + begin + assignLabel := id; + match(TT_COLON); + checkEndRule(assignLabel); + end; + if (( LA(1) in [TT_RULEREF])) then + begin + ruleRef := LT(1); + match(TT_RULEREF); + if (( LA(1) in [TT_ARGACTION])) then + begin + args := LT(1); + match(TT_ARGACTION); + end; + if (( LA(1) in [TT_BANG])) then + begin + ag := LT(1); + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refRule( assignId, ruleRef, assignLabel, args, autoGen); + end + + else if (( LA(1) in [TT_TOKENREF])) then + begin + tokenRef := LT(1); + match(TT_TOKENREF); + if (( LA(1) in [TT_ARGACTION])) then + begin + args := LT(1); + match(TT_ARGACTION); + end; + fGrammarMaker.refToken( assignId, tokenRef, assignLabel, args, false, autoGen, lastInRule); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName); + end + + else if (( LA(1) in [TT_LPAREN,TT_NOT,TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF..TT_RULEREF]) and (LA(2) in [LT_except..TT_SEMPRED,TT_OPTIONS,TT_LPAREN..TT_RPAREN,TT_COLON..TT_SEMI,TT_NOT..TT_OPEN,TT_CARET..TT_STRINGLIT,TT_ARGACTION..TT_RULEREF])) then + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_COLON])) then + begin + assignLabel := id; + match(TT_COLON); + checkEndRule(assignLabel); + end; + if (( LA(1) in [TT_RULEREF])) then + begin + ruleRef := LT(1); + match(TT_RULEREF); + if (( LA(1) in [TT_ARGACTION])) then + begin + args := LT(1); + match(TT_ARGACTION); + end; + if (( LA(1) in [TT_BANG])) then + begin + ag := LT(1); + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refRule( assignId, ruleRef, assignLabel, args, autoGen); + end + + else if (( LA(1) in [TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF]) and (LA(2) in [TT_RANGE])) then + begin + range(assignLabel); + end + + else if (( LA(1) in [TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF]) and (LA(2) in [LT_except..TT_SEMPRED,TT_LPAREN..TT_RPAREN,TT_SEMI,TT_NOT..TT_WILDCARD,TT_OPEN,TT_CARET..TT_STRINGLIT,TT_ARGACTION..TT_RULEREF])) then + begin + terminal(assignLabel); + end + + else if (( LA(1) in [TT_NOT])) then + begin + match(TT_NOT); + if (( LA(1) in [TT_CHARLIT,TT_TOKENREF])) then + begin + notTerminal(assignLabel); + end + + else if (( LA(1) in [TT_LPAREN])) then + begin + ebnf( assignLabel, true); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_LPAREN,TT_CHARLIT,TT_TOKENREF], InputState.FileName); + end + + else if (( LA(1) in [TT_LPAREN])) then + begin + ebnf( assignLabel, false); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_LPAREN,TT_NOT,TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF..TT_RULEREF], InputState.FileName); + end + + else if (( LA(1) in [TT_ACTION])) then + begin + action := LT(1); + match(TT_ACTION); + fGrammarMaker.refAction( action); + end + + else if (( LA(1) in [TT_SEMPRED])) then + begin + semPred := LT(1); + match(TT_SEMPRED); + fGrammarMaker.refSemPred( semPred); + end + + else if (( LA(1) in [TT_TREE_BEGIN])) then + begin + tree; + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_SEMPRED,TT_LPAREN,TT_NOT,TT_WILDCARD,TT_TREE_BEGIN..TT_STRINGLIT,TT_ACTION..TT_RULEREF], InputState.FileName); +end; + +// ============================================================================ +// elementOptions +// ============================================================================ +procedure TDpgParser.elementOptions; +var + name : IToken; + value : IToken; + +begin + + match(TT_OPEN); + name := id; + match(TT_ASSIGN); + value := optionValue; + fGrammarMaker.refElemOption(name,value); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + name := id; + match(TT_ASSIGN); + value := optionValue; + fGrammarMaker.refElemOption(name,value); + end + + else + break; + end; + + match(TT_CLOSE); +end; + +// ============================================================================ +// range +// ============================================================================ +procedure TDpgParser.range( pTokenLabel: IToken); +var + crLeft: IToken; + crRight: IToken; + trLeft: IToken; + trRight: IToken; + autoGen: integer; + +begin + + autoGen := AUTOGEN_NONE; + + if (( LA(1) in [TT_CHARLIT])) then + begin + crLeft := LT(1); + match(TT_CHARLIT); + match(TT_RANGE); + crRight := LT(1); + match(TT_CHARLIT); + if (( LA(1) in [TT_BANG])) then + begin + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refCharRange( crLeft, crRight, pTokenLabel, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_STRINGLIT,TT_TOKENREF])) then + begin + if (( LA(1) in [TT_TOKENREF])) then + begin + trLeft := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + trLeft := LT(1); + match(TT_STRINGLIT); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_STRINGLIT,TT_TOKENREF], InputState.FileName); + match(TT_RANGE); + if (( LA(1) in [TT_TOKENREF])) then + begin + trRight := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + trRight := LT(1); + match(TT_STRINGLIT); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_STRINGLIT,TT_TOKENREF], InputState.FileName); + autoGen := astTypeSpec; + fGrammarMaker.refTokenRange( trLeft, trRight, pTokenLabel, autoGen, lastInRule); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF], InputState.FileName); +end; + +// ============================================================================ +// terminal +// ============================================================================ +procedure TDpgParser.terminal( pTokenLabel: IToken); +var + aa: IToken; + cl: IToken; + sl: IToken; + tr: IToken; + wc: IToken; + autoGen : integer; + +begin + + autoGen := AUTOGEN_NONE; + aa := nil; + + if (( LA(1) in [TT_CHARLIT])) then + begin + cl := LT(1); + match(TT_CHARLIT); + if (( LA(1) in [TT_BANG])) then + begin + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refCharLiteral( cl, pTokenLabel, false, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_TOKENREF])) then + begin + tr := LT(1); + match(TT_TOKENREF); + autoGen := astTypeSpec; + if (( LA(1) in [TT_ARGACTION])) then + begin + aa := LT(1); + match(TT_ARGACTION); + end; + fGrammarMaker.refToken( nil, tr, pTokenLabel, aa, false, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + sl := LT(1); + match(TT_STRINGLIT); + autoGen := astTypeSpec; + fGrammarMaker.refStringLiteral( sl, pTokenLabel, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_WILDCARD])) then + begin + wc := LT(1); + match(TT_WILDCARD); + autogen := astTypeSpec; + fGrammarMaker.refWildCard( wc, pTokenLabel, autoGen); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF], InputState.FileName); +end; + +// ============================================================================ +// notTerminal +// ============================================================================ +procedure TDpgParser.notTerminal( pTokenLabel: IToken); +var + cl: IToken; + tr: IToken; + autoGen : integer; + +begin + + autoGen := AUTOGEN_NONE; + + if (( LA(1) in [TT_CHARLIT])) then + begin + cl := LT(1); + match(TT_CHARLIT); + if (( LA(1) in [TT_BANG])) then + begin + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refCharLiteral( cl, pTokenLabel, true, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_TOKENREF])) then + begin + tr := LT(1); + match(TT_TOKENREF); + autoGen := astTypeSpec; + fGrammarMaker.refToken( nil, tr, pTokenLabel, nil, true, autoGen, lastInRule); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_CHARLIT,TT_TOKENREF], InputState.FileName); +end; + +// ============================================================================ +// ebnf +// ============================================================================ +procedure TDpgParser.ebnf( pTokenLabel: IToken; pTokenNot: boolean); +var + aa: IToken; + lp: IToken; + m: IToken; + n: IToken; + +begin + + lp := LT(1); + match(TT_LPAREN); + fGrammarMaker.beginSubrule( pTokenLabel, lp, pTokenNot); + if (( LA(1) in [TT_OPTIONS])) then + begin + subRuleOptions; + if (( LA(1) in [TT_ACTION])) then + begin + aa := LT(1); + match(TT_ACTION); + fGrammarMaker.refInitAction(aa); + end; + match(TT_COLON); + end + + else if (( LA(1) in [TT_ACTION]) and (LA(2) in [TT_COLON])) then + begin + aa := LT(1); + match(TT_ACTION); + fGrammarMaker.refInitAction(aa); + match(TT_COLON); + end; + block; + match(TT_RPAREN); + if (( LA(1) in [TT_QUEST])) then + begin + match(TT_QUEST); + fGrammarMaker.optionalSubrule; + end + + else if (( LA(1) in [TT_STAR])) then + begin + match(TT_STAR); + fGrammarMaker.zeroOrMoreSubrule; + end + + else if (( LA(1) in [TT_PLUS])) then + begin + match(TT_PLUS); + fGrammarMaker.oneOrMoreSubrule; + end + + else if (( LA(1) in [TT_AT])) then + begin + match(TT_AT); + fGrammarMaker.nmSubrule; + match(TT_LPAREN); + if (( LA(1) in [TT_INTEGER])) then + begin + m := LT(1); + match(TT_INTEGER); + fGrammarMaker.refRangeLow( StrToInt(m.TokenText)); + if (( LA(1) in [TT_COMMA])) then + begin + match(TT_COMMA); + fGrammarMaker.refRangeHigh( maxint); + if (( LA(1) in [TT_INTEGER])) then + begin + n := LT(1); + match(TT_INTEGER); + fGrammarMaker.refRangeHigh(StrToInt(n.TokenText)); + end; + end; + end + + else if (( LA(1) in [TT_COMMA])) then + begin + match(TT_COMMA); + n := LT(1); + match(TT_INTEGER); + fGrammarMaker.refRangeHigh(StrToInt(n.TokenText)); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_COMMA,TT_INTEGER], InputState.FileName); + match(TT_RPAREN); + end + + else if (( LA(1) in [TT_IMPLIES])) then + begin + match(TT_IMPLIES); + fGrammarMaker.synPred; + end; + fGrammarMaker.endSubRule; +end; + +// ============================================================================ +// tree +// ============================================================================ +procedure TDpgParser.tree; +var + _cnt_75: integer; + lp: IToken; + +begin + + lp := LT(1); + match(TT_TREE_BEGIN); + fGrammarMaker.BeginTree(lp); + rootNode; + fGrammarMaker.BeginChildList; + _cnt_75 := 0; + + while(true) do + begin + if (( LA(1) in [TT_SEMPRED,TT_LPAREN,TT_NOT,TT_WILDCARD,TT_TREE_BEGIN..TT_STRINGLIT,TT_ACTION..TT_RULEREF])) then + begin + element; + end + + else + begin + if _cnt_75 >= 1 then + break + else + Raise EMismatchedToken.Create( LT(1), [TT_SEMPRED,TT_LPAREN,TT_NOT,TT_WILDCARD,TT_TREE_BEGIN..TT_STRINGLIT,TT_ACTION..TT_RULEREF], InputState.FileName); + end; + + INC(_cnt_75); + end; + fGrammarMaker.EndChildList; + match(TT_RPAREN); + fGrammarMaker.EndTree; +end; + +// ============================================================================ +// rootNode +// ============================================================================ +procedure TDpgParser.rootNode; +var + l : IToken; + +begin + + if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_COLON])) then + begin + l := id; + match(TT_COLON); + CheckEndRule(l); + end; + terminal(l); +end; + +// ============================================================================ +// astTypeSpec +// ============================================================================ +function TDpgParser.astTypeSpec: integer; +begin + + result := AUTOGEN_NONE; + + if (( LA(1) in [TT_CARET])) then + begin + match(TT_CARET); + result := AUTOGEN_CARET; + end + + else if (( LA(1) in [TT_BANG])) then + begin + match(TT_BANG); + result := AUTOGEN_BANG; + end; +end; + +// ============================================================================ +// subRuleOptions +// ============================================================================ +procedure TDpgParser.subRuleOptions; +var + optName : IToken; + optValue : IToken; + +begin + + match(TT_OPTIONS); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + optName := id; + match(TT_ASSIGN); + optValue := optionValue; + match(TT_SEMI); + fGrammarMaker.setSubruleOption( optName, optValue); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// 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; +end. diff --git a/src.lib/dpglib.DpgParserTokens.pas b/src.lib/dpglib.DpgParserTokens.pas new file mode 100644 index 0000000..75cec9a --- /dev/null +++ b/src.lib/dpglib.DpgParserTokens.pas @@ -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. diff --git a/src.lib/dpglib.ExceptionHandler.pas b/src.lib/dpglib.ExceptionHandler.pas new file mode 100644 index 0000000..88ce72c --- /dev/null +++ b/src.lib/dpglib.ExceptionHandler.pas @@ -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. diff --git a/src.lib/dpglib.ExceptionSpec.pas b/src.lib/dpglib.ExceptionSpec.pas new file mode 100644 index 0000000..36d5abb --- /dev/null +++ b/src.lib/dpglib.ExceptionSpec.pas @@ -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. diff --git a/src.lib/dpglib.Grammar.pas b/src.lib/dpglib.Grammar.pas new file mode 100644 index 0000000..a35a8be --- /dev/null +++ b/src.lib/dpglib.Grammar.pas @@ -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. diff --git a/src.lib/dpglib.GrammarAtom.pas b/src.lib/dpglib.GrammarAtom.pas new file mode 100644 index 0000000..e89b522 --- /dev/null +++ b/src.lib/dpglib.GrammarAtom.pas @@ -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. diff --git a/src.lib/dpglib.GrammarBehavior.pas b/src.lib/dpglib.GrammarBehavior.pas new file mode 100644 index 0000000..1200e5e --- /dev/null +++ b/src.lib/dpglib.GrammarBehavior.pas @@ -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. diff --git a/src.lib/dpglib.GrammarElem.pas b/src.lib/dpglib.GrammarElem.pas new file mode 100644 index 0000000..1f68e8b --- /dev/null +++ b/src.lib/dpglib.GrammarElem.pas @@ -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. diff --git a/src.lib/dpglib.GrammarMaker.pas b/src.lib/dpglib.GrammarMaker.pas new file mode 100644 index 0000000..83eacc4 --- /dev/null +++ b/src.lib/dpglib.GrammarMaker.pas @@ -0,0 +1,1715 @@ +unit dpglib.GrammarMaker; + +interface +uses + System.Classes, + System.Contnrs, + Generics.Collections, + System.AnsiStrings, + dpgrtl.types, + dpglib.Types, + dpglib.GrammarBehavior, + dpglib.BlockContext; + +type + TContextStack = TObjectStack; + + TGrammarMaker = class( TGrammarBehavior) + protected + + public + // ------------------------------------------------------------ + // Constructor/destructor + // ------------------------------------------------------------ + constructor Create( pTool: ITool; + pAnalyzer: ILLkAnalyzer; + pExchangeDir: AnsiString); + destructor Destroy; override; + + // ------------------------------------------------------------ + // Class methods + // ------------------------------------------------------------ + class + function CreateNextTokenRule( pGrammar : IGrammar; + pLexRules : TInterfaceList; + pRuleName : AnsiString): IRuleBlock; + + private + function CreateOptionalRuleRef( pRule : AnsiString; + pStart : IToken): IAlternativeBlock; + + procedure LabelElem( pElem : IAlternativeElem; + pLabel : IToken); + + procedure SetBlock( pDst : IAlternativeBlock; + pSrc : IAlternativeBlock); + + protected + // ------------------------------------------------------------ + // Protected members + // ------------------------------------------------------------ + fBlocks : TContextStack; + fLastRuleRef : IRuleRefElem; + fRuleEnd : IRuleEndElem; + fRuleBlock : IRuleBlock; + fCurrentExceptionSpec : IExceptionSpec; + + fNested : integer; + fGrammarError : boolean; + + procedure AddElemToCurrentAlt( pElem: IAlternativeElem); + function Context: TBlockContext; + + public + procedure NoAutoGenSubRule; + + // ------------------------------------------------------------ + // IGrammarBehavior overrides + // ------------------------------------------------------------ + procedure AbortGrammar; override; + procedure BeginAlt( pDoAutoGen: boolean); override; + + procedure BeginExceptionGroup; override; + procedure BeginExceptionSpec( pLabel : IToken); override; + procedure BeginSubRule( pLabel : IToken; + pStart : IToken; + pNot : boolean); override; + + procedure BeginTree( pStart : IToken); override; + procedure BeginChildList; override; + + + procedure DefineRuleName( pRule : IToken; + pAccess : AnsiString; + pAutoGen : boolean; + pComment : AnsiString); override; + + procedure DefineUses( pUses : AnsiString); override; + + procedure EndAlt; override; + procedure EndExceptionGroup; override; + procedure EndExceptionSpec; override; + procedure EndGrammar; override; + procedure EndRule( pRule : AnsiString); override; + procedure EndSubRule; override; + + procedure EndTree; override; + procedure EndChildList; override; + + procedure HasError; override; + + procedure OneOrMoreSubRule; override; + procedure NMSubRule; override; + procedure OptionalSubRule; override; + + + procedure refRangeLow( M : integer); override; + procedure refRangeHigh( N : integer); override; + + + procedure RefAction( pAction : IToken); override; + procedure RefArgAction( pAction : IToken); override; + + procedure RefCharLiteral( pLiteral : IToken; + pLabel : IToken; + pInverted : boolean; + pAutoGenType : integer; + pLastInRule : boolean); override; + + procedure RefCharRange( pToken1 : IToken; + pToken2 : IToken; + pLabel : IToken; + pAutoGenType : integer; + pLastInRule : boolean); override; + + procedure RefTokenSpecElemOption( pToken : IToken; + pOption : IToken; + pValue : IToken); override; + + procedure RefElemOption( pOption : IToken; + pValue : IToken); override; + + procedure RefExceptionHandler( pTypeAndName : IToken; + pAction : IToken); override; + procedure RefInitAction( pAction : IToken); override; + procedure RefReturnAction( pAction : IToken); override; + + procedure RefRule( pAssignId : IToken; + pRuleName : IToken; + pLabel : IToken; + pArguments : IToken; + pAutoGenType : integer); override; + + procedure RefRuleExHandler( pExHandlerType : IToken; + pExHandlerCode : IToken); override; + + procedure RefAltExHandler( pExHandlerType : IToken; + pExHandlerCode : IToken); override; + + procedure RefRuleLocals( pLocals : IToken); override; + + procedure RefSemPred( pSemPred : IToken); override; + + procedure RefStringLiteral( pLiteral : IToken; + pLabel : IToken; + pAutoGenType : integer; + pLastInRule : boolean); override; + + procedure RefToken( pAssignId : IToken; + pToken : IToken; + pLabel : IToken; + pArguments : IToken; + pInverted : boolean; + pAutoGenType : integer; + pLAstInRule : boolean); override; + + procedure RefTokenRange( pToken1 : IToken; + pToken2 : IToken; + pLabel : IToken; + pAutoGenType : integer; + pLastInRule : boolean); override; + + procedure RefWildCard( pToken : IToken; + pLabel : IToken; + pAutoGenType : integer); override; + procedure Reset; override; + procedure SetArgOfRuleRef( pArguments : IToken); override; + procedure SetRuleOption( pOption : IToken; + pValue : IToken); override; + procedure SetSubRuleOption( pOption : IToken; + pValue : IToken); override; + + procedure SynPred; override; + procedure ZeroOrMoreSubRule; override; + + procedure SetUserExceptions( pThrow : AnsiString); override; + + end; + + +implementation +uses + System.SysUtils, + dpgrtl.token, + dpgrtl.exception, + + dpglib.Messages, + dpglib.DpgParserTokens, + dpglib.Alternative, + dpglib.AlternativeBlock, + dpglib.ExceptionSpec, + dpglib.ExceptionHandler, + dpglib.BlockEndElem, + dpglib.RuleBlock, + dpglib.RuleRefElem, + dpglib.RuleEndElem, + dpglib.RuleSymbol, + dpglib.OneOrMoreBlock, + dpglib.ActionElem, + dpglib.CharLiteralElem, + dpglib.CharRangeElem, + dpglib.StringLiteralElem, + dpglib.TokenRefElem, + dpglib.TokenRangeElem, + dpglib.WildCardElem, + dpglib.SynPredBlock, + dpglib.ZeroOrMoreBlock, + dpglib.NMBlock, + + dpglib.TreeBlockContext, + dpglib.TreeElem, + dpglib.CodeGenerator, + dpglib.DelphiGenerator; //!!!! + +// **************************************************************************** +// Constructor/destructor +// **************************************************************************** +// ---------------------------------------------------------------------------- +// Constructor +// ---------------------------------------------------------------------------- +constructor TGrammarMaker.Create( pTool : ITool; + pAnalyzer : ILLkAnalyzer; + pExchangeDir: AnsiString); +begin + inherited; + + // --------------------------------------------------------------- + // Create BlockContext + // --------------------------------------------------------------- + fBlocks := TContextStack.Create; + + // --------------------------------------------------------------- + // Create fUsesList. It holds the list of uses clause items until + // the grammar is created. + // --------------------------------------------------------------- + fUsesList := TStringList.Create; + fUsesList.Sorted := true; + fUsesList.Duplicates := dupIgnore; +end; + +// ---------------------------------------------------------------------------- +// Destructor +// ---------------------------------------------------------------------------- +destructor TGrammarMaker.Destroy; +begin + FreeAndNil( fBlocks); + FreeAndNil( fUsesList); + + inherited; +end; + +// **************************************************************************** +// IGrammarBehavior overrides +// **************************************************************************** +// ============================================================================ +// AbortGrammar +// ============================================================================ +procedure TGrammarMaker.AbortGrammar; +var + grName: AnsiString; + +begin + grName := 'unknown'; + + if fGrammar <> nil then + grName := fGrammar.GetClassName; + + fTool.Error( Format( MSG_E_ABORTGRAMMAR, [grName])); +// fTool.Error('Aborting grammar "' + grName + '" do to errors.'); + + inherited; +end; + +// ================================================================================================ +// addElemToCurrentAlt +// ================================================================================================ +procedure TGrammarMaker.addElemToCurrentAlt( pElem: IAlternativeElem); +begin + pElem.EnclosingRule := fRuleBlock.RuleName; + Context.AddAlternativeElem( pElem); +end; + +// ============================================================================ +// ============================================================================ +// BeginAlt +// ============================================================================ +procedure TGrammarMaker.BeginAlt(pDoAutoGen: boolean); +var + alt: IAlternative; + +begin + alt := TAlternative.Create; + alt.DoAutoGen := pDoAutoGen; + + Context.Block.AddAlternative( alt); +end; + +// ============================================================================ +// ============================================================================ +// BeginExceptionGroup +// ============================================================================ +procedure TGrammarMaker.BeginExceptionGroup; +var + rb: IRuleBlock; + +begin + if Context.Block.QueryInterface( IRuleBlock, rb) <> S_OK then + fTool.Panic( 'Internal: "beginExceptionGroup" called outside of a rule block'); +end; + +// ============================================================================ +// ============================================================================ +// BeginExceptionSpec +// +// Add an exception spec to an exception group or rule block. +// ============================================================================ +procedure TGrammarMaker.BeginExceptionSpec(pLabel: IToken); +begin + // --------------------------------------------------------------- + // Hack the label AnsiString a bit to remove leading/trailing space. + // --------------------------------------------------------------- + if pLabel.TokenText <> '' then + pLabel.TokenText := Trim(pLabel.TokenText); + + // --------------------------------------------------------------- + // Don't check for 'currentExceptionSpec <> nil' because syntax + // errors may leave it set to something. + // --------------------------------------------------------------- + fCurrentExceptionSpec := TExceptionSpec.Create( pLabel); +end; + +// ============================================================================ +// ============================================================================ +// BeginSubRule +// ============================================================================ +procedure TGrammarMaker.BeginSubRule( pLabel : IToken; + pStart : IToken; + pNot : boolean); +begin + // --------------------------------------------------------------- + // We don't know what kind of subrule it is yet. + // Push a dummy one that will allow us to collect the alternatives. + // Later, we'll switch to real object. + // --------------------------------------------------------------- + fBlocks.Push( TBlockContext.Create); + Context.Block := TAlternativeBlock.Create( fGrammar, pStart, pNot); + Context.AltNum := 0; + INC( fNested); + + // --------------------------------------------------------------- + // Create final node to which the last element of each alternative + // will point. + // --------------------------------------------------------------- + Context.BlockEnd := TBlockEndElem.Create( fGrammar); + + // --------------------------------------------------------------- + // Make sure end node points to start of block. + // --------------------------------------------------------------- + Context.BlockEnd.Block := Context.Block; + + labelElem( Context.Block, pLabel); +end; + +// ============================================================================ +// ============================================================================ +// defineRuleName +// ============================================================================ +procedure TGrammarMaker.defineRuleName( pRule : IToken; + pAccess : AnsiString; + pAutoGen : boolean; + pComment : AnsiString); +var + rb : IRuleBlock; + rs : IRuleSymbol; + id : AnsiString; + +begin + // --------------------------------------------------------------- + // Handle lexical rule definition + // --------------------------------------------------------------- + if pRule.TokenType = TT_TOKENREF then + begin + // ------------------------------------------------------------ + // Lexical rule must be defined in lexer. Anything else is an + // error. + // ------------------------------------------------------------ + if not fIsLexer then + begin +// fTool.Error('Lexical rule "' + pRule.TokenText + '" defined outside of lexer', + + fTool.Error(Format( MSG_E_LEXNOTINLEXER, [pRule.TokenText]), + fGrammar.GrammarFile, + pRule.TokenLine, + pRule.TokenColumn); + + pRule.TokenText := LowerCase( pRule.TokenText); + end + end + + // --------------------------------------------------------------- + // Handle parser rule definition + // --------------------------------------------------------------- + else + begin + // ------------------------------------------------------------ + // Parser rule must be defined in non-lexer grammars. So define + // it in a lexer is an error. + // ------------------------------------------------------------ + if fIsLexer then + begin +// fTool.Error('Lexical rule names must be upper case, "' + pRule.TokenText + '" is not', + fTool.Error(Format( MSG_E_LEXCAPITAL, [pRule.TokenText]), + fGrammar.GrammarFile, + pRule.TokenLine, + pRule.TokenColumn); + + pRule.TokenText := UpperCase( pRule.TokenText); + end; + end; + + inherited; + + + if pRule.TokenType = TT_TOKENREF then + id := TCodeGenerator.encodeLexerRuleName( pRule.TokenText) + else + id := pRule.TokenText; + + fGrammar.Symbol[id].QueryInterface(IRuleSymbol,rs); + rb := TRuleBlock.Create( fGrammar, pRule.TokenText, pRule.TokenLine, pAutoGen); + + // --------------------------------------------------------------- + // Lexer rules do not generate default error handling. + // --------------------------------------------------------------- + rb.EnclosingRule := pRule.TokenText; + rb.DefaultErrorHandler := fGrammar.DefaultErrorHandler; + fRuleEnd := TRuleEndElem.Create( fGrammar); + fRuleBlock := rb; + + fBlocks.Push( TBlockContext.Create); + + Context.Block := rb; + rs.Block := rb; + rb.EndElem := fRuleEnd; + fNested := 0; +end; + +// ============================================================================ +// ============================================================================ +// defineUses +// ============================================================================ +procedure TGrammarMaker.defineUses(pUses: AnsiString); +begin + fUsesList.Add( pUses); +end; + +// ============================================================================ +// ============================================================================ +// EndAlt +// ============================================================================ +procedure TGrammarMaker.EndAlt; +begin + // --------------------------------------------------------------- + // All rule-level alts link to ruleEnd + // --------------------------------------------------------------- + if fNested = 0 then + addElemToCurrentAlt( fRuleEnd) + else + addElemToCurrentAlt( Context.BlockEnd); + + Context.AltNum := Context.AltNum +1; +end; + +// ============================================================================ +// ============================================================================ +// endExceptionGroup +// ============================================================================ +procedure TGrammarMaker.endExceptionGroup; +begin +end; + +// ============================================================================ +// ============================================================================ +// endExceptionSpec +// ============================================================================ +procedure TGrammarMaker.endExceptionSpec; +var + rb : IRuleBlock; + +begin +(* + if fCurrentExceptionSpec = nil then + fTool.Panic( 'Exception processing internal error - no active exception spec'); + + // --------------------------------------------------------------- + // Named rule + // --------------------------------------------------------------- + if Context.Block.QueryInterface( IRuleBlock, rb) = S_OK then + rb.AddExceptionSpec(fCurrentExceptionSpec) + + // --------------------------------------------------------------- + // It must be a plain-old alternative block + // --------------------------------------------------------------- + else + if Context.CurrentAlt.ExceptionSpec <> nil then + fTool.Error('Alternative already has an exception specification', + fGrammar.GrammarFile, + Context.Block.Line, + Context.Block.Column) + else + Context.CurrentAlt.ExceptionSpec := fCurrentExceptionSpec; + + fCurrentExceptionSpec := nil; +*) +end; + +// ============================================================================ +// ============================================================================ +// endGrammar +// ============================================================================ +procedure TGrammarMaker.endGrammar; +begin + if fGrammarError then + AbortGrammar; +end; + +// ============================================================================ +// ============================================================================ +// endRule +// ============================================================================ +procedure TGrammarMaker.endRule(pRule: AnsiString); +var + ctx : TBlockContext; + +begin + // --------------------------------------------------------------- + // Remove scope + // --------------------------------------------------------------- + ctx := fBlocks.Extract; +// ctx := fBlocks.Pop as TBlockContext; + + // --------------------------------------------------------------- + // Record the start of this block in the ending node. + // --------------------------------------------------------------- + fRuleEnd.Block := ctx.Block; + fRuleEnd.Block.PrepareForAnalysis; +end; + +// ============================================================================ +// ============================================================================ +// endSubRule +// ============================================================================ +procedure TGrammarMaker.endSubRule; +var + ctx : TBlockContext; + ab : IAlternativeBlock; + syn : ISynPredBlock; + zom : IZeroOrMoreBlock; + oom : IOneOrMoreBlock; + +begin + DEC( fNested); + + // --------------------------------------------------------------- + // Remove subrule context from scope stack. + // --------------------------------------------------------------- +// ctx := fBlocks.Pop as TBlockContext; + ctx := fBlocks.Extract; + ab := ctx.Block; + + // --------------------------------------------------------------- + // If the subrule is marked with ~, check that it is a valid + // candidate forn analysis. + // --------------------------------------------------------------- + ab.QueryInterface( ISynPredBlock, syn); + ab.QueryInterface( IZeroOrMoreBlock, zom); + ab.QueryInterface( IOneOrMoreBlock, oom); + + if ab.IsNot and (syn = nil) and (zom = nil) and (oom = nil) then + begin + if not fAnalyzer.SubRuleCanBeInverted( ab, fIsLexer) then + begin + fTool.Error( MSG_E_NONINVSUBRULE, + fGrammar.GrammarFile, + ab.Line, + ab.Column); + end; + end; + + // --------------------------------------------------------------- + // Add the subrule as element if not a synpred + // --------------------------------------------------------------- + if syn <> nil then + begin + // ------------------------------------------------------------ + // Record a reference to the recently-recognized syn pred in + // the enclosing block. + // ------------------------------------------------------------ + Context.Block.HasASynPred := true; + Context.CurrentAlt.SynPred := syn; + + fGrammar.HasSynPred := true; + syn.RemoveTracking( fGrammar); + end + + else + addElemToCurrentAlt( ab); + + ctx.BlockEnd.Block.PrepareForAnalysis; +end; + +// ============================================================================ +// ============================================================================ +// HasError +// ============================================================================ +procedure TGrammarMaker.HasError; +begin + fGrammarError := true; +end; + +// ============================================================================ +// ============================================================================ +// OneOrMoreSubRule +// ============================================================================ +procedure TGrammarMaker.OneOrMoreSubRule; +var + oom: IOneOrMoreBlock; + old: TBlockContext; + +begin + if Context.Block.IsNot then + begin +// fTool.Error( '"~" cannot be applied to (...)+ subrule', + fTool.Error( MSG_E_NONINVOOM, + fGrammar.GrammarFile, + Context.Block.Line, + Context.Block.Column); + end; + + // --------------------------------------------------------------- + // Create the right kind of object now that we know that is and + // switch the list of alternatives. Adjust the stack of blocks. + // Copy any init action also. + // --------------------------------------------------------------- + oom := TOneOrMoreBlock.Create( fGrammar); + setBlock( oom, Context.Block); + +// old := fBlocks.Pop as TBlockContext; + old := fBlocks.Extract; + fBlocks.Push( TBlockContext.Create); + + Context.Block := oom; + Context.BlockEnd := old.BlockEnd; + Context.BlockEnd.Block := oom; + + fRuleBlock.OneOrMoreBlocks.Add( oom); +end; + +// ================================================================================================ +// MToNSubrule +// ================================================================================================ +procedure TGrammarMaker.NMSubRule; +var + NM : INMBlock; + old : TBlockContext; + +begin + if Context.Block.IsNot then + begin +// fTool.Error( '"~" cannot be applied to (...)@ subrule', + fTool.Error( MSG_E_NONINVN2M, + fGrammar.GrammarFile, + Context.Block.Line, + Context.Block.Column); + end; + + // --------------------------------------------------------------- + // Create the right kind of object now that we know that is and + // switch the list of alternatives. Adjust the stack of blocks. + // Copy any init action also. + // --------------------------------------------------------------- + NM := TNMBlock.Create( fGrammar); + setBlock( NM, Context.Block); + +// old := fBlocks.Pop as TBlockContext; + old := fBlocks.Extract; + fBlocks.Push( TBlockContext.Create); + + Context.Block := NM; + Context.BlockEnd := old.BlockEnd; + Context.BlockEnd.Block := NM; + + fRuleBlock.NMBlocks.Add( NM); +end; + + +// ============================================================================ +// ============================================================================ +// OptionalSubRule +// ============================================================================ +procedure TGrammarMaker.OptionalSubRule; +begin + if Context.Block.IsNot then + begin + fTool.Error( MSG_E_NONINVZOO, + fGrammar.GrammarFile, + Context.Block.Line, + Context.Block.Column); + end; + + // --------------------------------------------------------------- + // Convert (X)? -> (X|) so that we can ignore optional blocks + // altogether. It already thinks that we have a simple subrule, + // just add option block. + // --------------------------------------------------------------- + BeginAlt( false); + EndAlt; +end; + +// ============================================================================ +// ============================================================================ +// refAction +// ============================================================================ +procedure TGrammarMaker.refAction(pAction: IToken); +begin + Context.Block.HasAnAction := true; + addElemToCurrentAlt( TActionElem.Create( fGrammar, pAction)); +end; + +// ================================================================================================ +// RefRangeLow +// ================================================================================================ +procedure TGrammarMaker.RefRangeLow( M: integer); +var + NM: INMBlock; + +begin + Context.Block.QueryInterface( INMBlock, NM); + NM.Low := M; + NM.High := M; +end; + +// ================================================================================================ +// RefRangeHigh +// ================================================================================================ +procedure TGrammarMaker.RefRangeHigh( N: integer); +var + NM: INMBlock; + +begin + Context.Block.QueryInterface( INMBlock, NM); + NM.High := N; +end; + + +// ============================================================================ +// ============================================================================ +// RefArgAction +// ============================================================================ +procedure TGrammarMaker.RefArgAction(pAction: IToken); +var + rb: IRuleBlock; + +begin + Context.Block.QueryInterface( IRuleBlock, rb); + rb.Arguments := pAction.TokenText; +end; + +// ============================================================================ +// ============================================================================ +// refCharLiteral +// ============================================================================ +procedure TGrammarMaker.refCharLiteral( pLiteral : IToken; + pLabel : IToken; + pInverted : boolean; + pAutoGenType: integer; + pLastInRule : boolean); +var + cl : ICharLiteralElem; + ignore: AnsiString; + +begin + // --------------------------------------------------------------- + // Character literal only valid in lexer grammar! + // --------------------------------------------------------------- + if not fIsLexer then + begin + fTool.Error( MSG_E_CHARINPARSER, + fGrammar.GrammarFile, + pLiteral.TokenLine, + pLiteral.TokenColumn); + exit; + end; + + cl := TCharLiteralElem.Create( fLexerGrammar, + pLiteral, + pInverted, + pAutoGenType); + + AddElemToCurrentAlt( cl); + LabelElem( cl, pLabel); + + // --------------------------------------------------------------- + // If ignore option is set, must add an optional call to the + // specified rule. + // --------------------------------------------------------------- + ignore := fRuleBlock.IgnoreRule; + + if (not pLastInRule) and (ignore <> '') then + AddElemToCurrentAlt( CreateOptionalRuleRef( ignore, pLiteral)); +end; + +// ============================================================================ +// ============================================================================ +// RefCharRange +// ============================================================================ +procedure TGrammarMaker.RefCharRange( pToken1 : IToken; + pToken2 : IToken; + pLabel : IToken; + pAutoGenType: integer; + pLastInRule : boolean); +var +// lg : ILexerGrammar; + cr : ICharRangeElem; + + rangeMin : integer; + rangeMax : integer; + ignore : AnsiString; + +begin + // --------------------------------------------------------------- + // Character range only valid in lexer + // --------------------------------------------------------------- + if not fIsLexer then + begin + fTool.Error(MSG_E_CHARRANGEINPARSER, + fGrammar.GrammarFile, + pToken1.TokenLine, + pToken1.TokenColumn); + exit; + end; + +// rangeMin := TLexer.TokenTypeForCharLiteral( pToken1.TokenText); +// rangeMax := TLexer.TokenTypeForCharLiteral( pToken2.TokenText); + rangeMin := pToken1.TokenType; + rangeMax := pToken2.TokenType; + + if rangeMax < rangeMin then + begin + fTool.Error(MSG_E_MALFORMEDRANGE, + fGrammar.GrammarFile, + pToken1.TokenLine, + pToken2.TokenColumn); + exit; + end; + + // --------------------------------------------------------------- + // Generate a warning for non-lowercase ASCII when case-insensitive + // (Later...) + // --------------------------------------------------------------- +{ TODO : Case sensitive thing in refCharRange } + + cr := TCharRangeElem.Create( fGrammar, pToken1, pToken2, pAutoGenType); + addElemToCurrentAlt( cr); + labelElem( cr, pLabel); + + // --------------------------------------------------------------- + // If ignore option is set, must add an optional call to the + // specified rule. + // --------------------------------------------------------------- + ignore := fRuleBlock.IgnoreRule; + + if (not pLastInRule) and (ignore <> '') then + AddElemToCurrentAlt( createOptionalRuleRef( ignore, pToken1)); +end; + +// ============================================================================ +// ============================================================================ +// refTokenSpecElemOption +// ============================================================================ +procedure TGrammarMaker.refTokenSpecElemOption( pToken : IToken; + pOption : IToken; + pValue : IToken); +var + ts: ITokenSymbol; + +begin + ts := fGrammar.TokenManager.TokenSymbol[pToken.TokenText]; + + if ts <> nil then + if pOption.TokenText = 'AST' then + ts.ASTNodeType := pValue.TokenText + + else + fTool.Error( Format( MSG_E_ILLEGALTOKENSOPT, [pOption.TokenText]), + fGrammar.GrammarFile, + pOption.TokenLine, + pOption.TokenColumn) + else + fTool.Panic( Format( MSG_E_NOTOKENSTOKEN, [pToken.TokenText])); +end; + +// ================================================================================================ +// refElemOption +// ================================================================================================ +procedure TGrammarMaker.refElemOption( pOption : IToken; + pValue : IToken); +var + sl : IStringLiteralElem; + tr : ITokenRefElem; + wc : IWildcardElem; + ga : IGrammarAtom; + e : IAlternativeElem; + +begin + e := Context.CurrentElem; + + e.QueryInterface( IStringLiteralElem, sl); + e.QueryInterface( ITokenRefElem, tr); + e.QueryInterface( IWildCardElem, wc); + e.QueryInterface( IGrammarAtom, ga); + + if (sl <> nil) or (tr <> nil) or (wc <> nil) then + ga.SetOption( pOption, pValue) + + else + fTool.Error( Format( MSG_E_ILLEGALELEMOPT, [pOption.TokenText]), + fGrammar.GrammarFile, + pOption.TokenLine, + pOption.TokenColumn); +end; + +// ============================================================================ +// ============================================================================ +// refExceptionHandler +// +// Add an exception handler to an exception spec. +// ============================================================================ +procedure TGrammarMaker.refExceptionHandler( pTypeAndName : IToken; + pAction : IToken); +begin + if fCurrentExceptionSpec = nil then + fTool.Panic('Exception handler processing internal error...') + else + fCurrentExceptionSpec.AddHandler( TExceptionHandler.Create( pTypeAndName, pAction)); +end; + +// ============================================================================ +// ============================================================================ +// refInitAction +// ============================================================================ +procedure TGrammarMaker.refInitAction(pAction: IToken); +begin + Context.Block.InitAction := pAction.TokenText; +end; + +// ============================================================================ +// ============================================================================ +// refReturnAction +// ============================================================================ +procedure TGrammarMaker.refReturnAction(pAction: IToken); +var + rb : IRuleBlock; + rs : IRuleSymbol; + name : AnsiString; + +begin + Context.Block.QueryInterface( IRuleBlock, rb); + + if fIsLexer then + begin + name := TCodeGenerator.encodeLexerRuleName( rb.RuleName); + fGrammar.Symbol[name].QueryInterface(IRuleSymbol,rs); + + if rs.Access = 'public' then + begin + + fTool.Warning(MSG_W_LEXPUBLICRETURN, + fGrammar.GrammarFile, + pAction.TokenLine, + pAction.TokenColumn); + exit; + end; + end; + + rb.ReturnAction := pAction.TokenText; +end; + +// ============================================================================ +// ============================================================================ +// refRule +// ============================================================================ +procedure TGrammarMaker.refRule( pAssignId : IToken; + pRuleName : IToken; + pLabel : IToken; + pArguments : IToken; + pAutoGenType : integer); +var +// lg: ILexerGrammar; + id: AnsiString; + rs: IRuleSymbol; + +begin + // --------------------------------------------------------------- + // Disallow parser rule references in the lexer. + // --------------------------------------------------------------- + if fIsLexer then + begin + if pRuleName.TokenType <> TT_TOKENREF then + begin + fTool.Error( Format( MSG_E_PARSERRULEINLEXER, [pRuleName.TokenText]), + fGrammar.GrammarFile, + pRuleName.TokenLine, + pRuleName.TokenColumn); + exit; + end; + + if pAutoGenType = AUTOGEN_CARET then + begin + fTool.Error( MSG_E_ASTINLEXER, + fGrammar.GrammarFile, + pRuleName.TokenLine, + pRuleName.TokenColumn); + end; + end; + + inherited; + + fLastRuleRef := TRuleRefElem.Create( fGrammar, pRuleName, pAutoGenType); + + if pArguments <> nil then + fLastRuleRef.Args := pArguments.TokenText; + + if pAssignId <> nil then + fLastRuleRef.IdAssign := pAssignId.TokenText; + + addElemToCurrentAlt( fLastRuleRef); + + if pRuleName.TokenType = TT_TOKENREF then + id := TCodeGenerator.encodeLexerRuleName( pRuleName.TokenText) + else + id := pRuleName.TokenText; + + fGrammar.Symbol[id].QueryInterface( IRuleSymbol, rs); + rs.AddReference( fLastRuleRef); + LabelElem( fLastRuleRef, pLabel); +end; + +// ============================================================================ +// ============================================================================ +// RefSemPred +// ============================================================================ +procedure TGrammarMaker.RefSemPred(pSemPred: IToken); +var + ae : IActionElem; + +begin + if Context.CurrentAlt.AtStart then + Context.CurrentAlt.SemPred := pSemPred.TokenText + + else + begin + ae := TActionElem.Create( fGrammar, pSemPred); + ae.IsSemPred := true; + + addElemToCurrentAlt( ae); + end; +end; + +// ============================================================================ +// ============================================================================ +// refStringLiteral +// ============================================================================ +procedure TGrammarMaker.refStringLiteral( pLiteral : IToken; + pLabel : IToken; + pAutoGenType: integer; + pLastInRule : boolean); +var +// tg : ITreeWalkerGrammar; +// lg : ILexerGrammar; + sl : IStringLiteralElem; + ignore: AnsiString; + +begin + inherited; + + if Supports( fGrammar, ITreeWalkerGrammar) then + begin + if pAutoGenType = AUTOGEN_CARET then + fTool.Error( '^ not allowed here', + fGrammar.GrammarFile, + pLiteral.TokenLine, + pLiteral.TokenColumn); + end; + + sl := TStringLiteralElem.Create( fGrammar, pLiteral, pAutoGenType); + + addElemToCurrentAlt( sl); + labelElem( sl, pLabel); + + // --------------------------------------------------------------- + // if ignore option is set, must add an optional call to the + // specified rule. + // --------------------------------------------------------------- + ignore := fRuleBlock.IgnoreRule; + + if (not pLastInRule) and (ignore <> '') then + AddElemToCurrentAlt( CreateOptionalRuleRef( ignore, pLiteral)); +end; + +// ============================================================================ +// ============================================================================ +// RefToken +// ============================================================================ +procedure TGrammarMaker.RefToken( pAssignId : IToken; + pToken : IToken; + pLabel : IToken; + pArguments : IToken; + pInverted : boolean; + pAutoGenType : integer; + pLastInRule : boolean); +var + te : ITokenRefElem; + ignore: AnsiString; + +begin + if fIsLexer then + begin + if pAutoGenType = AUTOGEN_CARET then + begin + fTool.Error(MSG_E_ASTINLEXER, + fGrammar.GrammarFile, + pToken.TokenLine, + pToken.TokenColumn); + end; + + if pInverted then + begin + fTool.Error(MSG_E_INVTOKENINLEXER, + fGrammar.GrammarFile, + pToken.TokenLine, + pToken.TokenColumn); + end; + + RefRule( pAssignId, pToken, pLabel, pArguments, pAutoGenType); + + // ------------------------------------------------------------ + // if ignore option is set, must add an optional call to the + // specified rule. + // ------------------------------------------------------------ + ignore := fRuleBlock.IgnoreRule; + + if (not pLastInRule) and (ignore <> '') then + AddElemToCurrentAlt( CreateOptionalRuleRef( ignore, pToken)); + end + + else + begin + // ------------------------------------------------------------ + // Cannot have token ref args or assignment outside of a lexer + // ------------------------------------------------------------ + if pAssignId <> nil then + begin + fTool.Error(MSG_E_INVTOKENREFINLEXER, + fGrammar.GrammarFile, + pAssignId.TokenLine, + pAssignId.TokenColumn); + end; + + if pArguments <> nil then + begin + fTool.Error(MSG_E_INVTOKENPARAMLEXER, + fGrammar.GrammarFile, + pArguments.TokenLine, + pArguments.TokenColumn); + end; + + inherited; + + te := TTokenRefElem.Create( fGrammar, pToken, pInverted, pAutoGenType); + + AddElemToCurrentAlt(te); + LabelElem(te, pLabel); + end; +end; + +// ============================================================================ +// ============================================================================ +// RefTokenRange +// ============================================================================ +procedure TGrammarMaker.RefTokenRange( pToken1 : IToken; + pToken2 : IToken; + pLabel : IToken; + pAutoGenType: integer; + pLastInRule : boolean); +var +// lg : ILexerGrammar; + tr : ITokenRangeElem; + +begin + if fIsLexer then + begin + fTool.Error(MSG_E_TOKENRANGEINLEXER, + fGrammar.GrammarFile, + pToken1.TokenLine, + pToken1.TokenColumn); + exit; + end; + + inherited; + + if pToken1.TokenType < pToken2.TokenType then + tr := TTokenRangeElem.Create( fGrammar, pToken1, pToken2, pAutoGenType) + + else + begin + fTool.Error(MSG_E_MALFORMEDRANGE, + fGrammar.GrammarFile, + pToken1.TokenLine, + pToken2.TokenColumn); + exit; + end; + + AddElemToCurrentAlt( tr); + LabelElem( tr, pLabel); +end; + + +// ============================================================================ +// ============================================================================ +// RefWildCard +// ============================================================================ +procedure TGrammarMaker.RefWildCard( pToken : IToken; + pLabel : IToken; + pAutoGenType: integer); +var + wc : IWildcardElem; + +begin + wc := TWildcardElem.Create(fGrammar, pToken, pAutoGenType); + AddElemToCurrentAlt(wc); + LabelElem(wc, pLabel); +end; + +// ============================================================================ +// ============================================================================ +// Reset +// ============================================================================ +procedure TGrammarMaker.Reset; +begin + inherited; + + if fBlocks <> nil then + fBlocks.Free; + +// fBlocks := TObjectStack.Create; + fBlocks := TContextStack.Create; + fLastRuleRef := nil; + fRuleEnd := nil; + fRuleBlock := nil; + fCurrentExceptionSpec := nil; + fNested := 0; + fGrammarError := false; +end; + +// ============================================================================ +// ============================================================================ +// SetArgOfRuleRef +// ============================================================================ +procedure TGrammarMaker.setArgOfRuleRef(pArguments: IToken); +begin + fLastRuleRef.Args := pArguments.TokenText; +end; + +// ============================================================================ +// ============================================================================ +// SetRuleOption +// ============================================================================ +procedure TGrammarMaker.SetRuleOption(pOption, pValue: IToken); +begin + fRuleBlock.SetOption( pOption, pValue); +end; + +// ============================================================================ +// ============================================================================ +// SetSubRuleOption +// ============================================================================ +procedure TGrammarMaker.SetSubRuleOption(pOption, pValue: IToken); +begin + Context.Block.SetOption( pOption, pValue); +end; + +// ============================================================================ +// ============================================================================ +// ZeroOrMoreSubRule +// ============================================================================ +procedure TGrammarMaker.ZeroOrMoreSubRule; +var + zb : IZeroOrMoreBlock; + old: TBlockContext; + +begin + if Context.Block.IsNot then + begin + fTool.Error(MSG_E_NONINVZOM, + fGrammar.GrammarFile, + Context.Block.Line, + Context.Block.Column); + end; + + // --------------------------------------------------------------- + // Create the right kind of object now that we know what that is + // and switch the list of alternatives. Adjust the stack of blocks. + // Copy any init action also. + // --------------------------------------------------------------- + zb := TZeroOrMoreBlock.Create( fGrammar); + SetBlock( zb, Context.Block); + +// old := fBlocks.Pop as TBlockContext; + old := fBlocks.Extract; + fBlocks.Push( TBlockContext.Create); + + Context.Block := zb; + Context.BlockEnd := old.BlockEnd; + Context.BlockEnd.Block := zb; +end; + +// ============================================================================ +// ============================================================================ +// SynPred +// ============================================================================ +procedure TGrammarMaker.SynPred; +var + alt: IAlternative; + sb : ISynPredBlock; + old: TBlockContext; + +begin + alt := nil; + + if Context.Block.IsNot then + begin + fTool.Error(MSG_E_NONINVSYNTPRED, + fGrammar.GrammarFile, + Context.Block.Line, + Context.Block.Column); + end; + + // --------------------------------------------------------------- + // Create the right kind of object now that we know what that is + // and switch the list of alternatives. Adjust the stack of blocks. + // Copy any init action also. + // --------------------------------------------------------------- + sb := TSynPredBlock.Create( fGrammar); + SetBlock( sb, Context.Block); + +// old := fBlocks.Pop as TBlockContext; + old := fBlocks.Extract; + fBlocks.Push( TBlockContext.Create); + + Context.Block := sb; + Context.BlockEnd := old.BlockEnd; + Context.BlockEnd.Block := sb; + + fRuleBlock.HasASynPred := true; + fRuleBlock.SynPredBlocks.Add( sb); +end; + +// ============================================================================ +// ============================================================================ +// SetUserExceptions +// ============================================================================ +procedure TGrammarMaker.SetUserExceptions( pThrow: AnsiString); +//var +// rb: IRuleBlock; + +begin +// Context.Block.QueryInterface(IRuleBlock,rb); +// rb.ThrowSpec := pThrow; +end; + +// **************************************************************************** +// Internals +// **************************************************************************** +// ============================================================================ +// ============================================================================ +// Context +// ============================================================================ +function TGrammarMaker.Context: TBlockContext; +begin + if fBlocks.Count <> 0 + then result := fBlocks.Peek + else result := nil; +end; + +// ============================================================================ +// ============================================================================ +// LabelElem +// ============================================================================ +procedure TGrammarMaker.LabelElem( pElem : IAlternativeElem; + pLabel: IToken); +var + elem : IAlternativeElem; + i : integer; + l : AnsiString; + +begin + if pLabel <> nil then + begin + for i:=0 to fRuleBlock.LabeledElems.Count -1 do + begin + fRuleBlock.LabeledElems.Items[i].QueryInterface(IAlternativeElem,elem); + l := elem.Lbl; + + // --------------------------------------------------------- + // If the label already defined -> error, exit + // RM. Why??? I want to allow it. Maximum give a warning, but + // not for 'result' label. + // --------------------------------------------------------- + if (l<>'') and (l = pLabel.TokenText) and (l<>'result') then + begin +// fTool.Warning( 'Label "' + l + '" has already been defined', +// fGrammar.GrammarFile, +// pLabel.TokenLine, +// pLabel.TokenColumn); + end; + end; + + // --------------------------------------------------------- + // Add this node to the list of labeled elems + // --------------------------------------------------------- + pElem.Lbl := pLabel.TokenText; + fRuleBlock.LabeledElems.Add( pElem); + end; +end; + +// **************************************************************************** +// Class methods +// **************************************************************************** +// ================================================================================================ +// CreateNextTokenRule +// ================================================================================================ +class function TGrammarMaker.CreateNextTokenRule( pGrammar : IGrammar; + pLexRules : TInterfaceList; + pRuleName : AnsiString): IRuleBlock; +var + alt : IAlternative; + rb : IRuleBlock; + re : IRuleEndElem; + rr : IRuleRefElem; + rs : IRuleSymbol; + i : integer; + rname : AnsiString; + +begin + // --------------------------------------------------------------- + // Create actual rule data structure + // --------------------------------------------------------------- + rb := TRuleBlock.Create( pGrammar, pRuleName); + re := TRuleEndElem.Create( pGrammar); + + rb.DefaultErrorHandler := pGrammar.DefaultErrorHandler; + rb.EndElem := re; + re.Block := rb; + + // --------------------------------------------------------------- + // Add an alternative for each element of the rules vector. + // --------------------------------------------------------------- + for i:=0 to pLexRules.Count-1 do + begin + pLexRules.Items[i].QueryInterface(IRuleSymbol,rs); + + if not rs.Defined then + begin + rname := TDelphiGenerator.decodeLexerRuleName( rs.ID); + + pGrammar.Tool.Error( Format( MSG_E_LEXRULENOTDEFINED, [rname]), + pGrammar.GrammarFile, + -2, 0); + end + + else begin + // --------------------------------------------------------- + // Create a rule ref to lexer rule. + // The Token is a TT_RULEREF not a TT_TOKENREF since + // conversion to mRuleName has alread taken place. + // --------------------------------------------------------- + if rs.Access = 'public' then + begin + rr := TRuleRefElem.Create( pGrammar, + TToken.Create(TT_RULEREF, rs.ID), + AUTOGEN_NONE); + + rr.Lbl := 'result'; + rr.EnclosingRule := 'NextToken'; + rr.Next := re; + + alt := TAlternative.Create( rr); + alt.DoAutoGen := true; + + rb.AddAlternative( alt); + rs.AddReference( rr); + end + end + end; + + rb.AutoGen := true; + rb.PrepareForAnalysis; + + result := rb +end; + +// ============================================================================ +// ============================================================================ +// CreateOptionalRuleRef +// +// Return block as if they had typed: "( rule )?" +// ============================================================================ +function TGrammarMaker.CreateOptionalRuleRef( pRule : AnsiString; + pStart : IToken): IAlternativeBlock; +var + alt : IAlternative; + optAlt : IAlternative; + ab : IAlternativeBlock; + be : IBlockEndElem; + t : IToken; + rr : IRuleRefElem; + mrule : AnsiString; + +begin + // --------------------------------------------------------------- + // Make the subrule + // --------------------------------------------------------------- + ab := TAlternativeBlock.Create( fGrammar, pStart, false); + + // --------------------------------------------------------------- + // Make sure the rule is defined. + // --------------------------------------------------------------- + mRule := TCodeGenerator.encodeLexerRuleName( pRule); + + if not fGrammar.Defined( mrule) then + fGrammar.Define( TRuleSymbol.Create(mrule)); + + // --------------------------------------------------------------- + // Make the rule ref elem. + // --------------------------------------------------------------- + t := TToken.Create( TT_TOKENREF, pRule); + t.TokenLine := pStart.TokenLine; + t.TokenColumn := pStart.TokenColumn; + + rr := TRuleRefElem.Create( fGrammar, t, AUTOGEN_NONE); + rr.EnclosingRule := fRuleBlock.RuleName; + + // --------------------------------------------------------------- + // Make the end of block elem. + // --------------------------------------------------------------- + be := TBlockEndElem.Create( fGrammar); + be.Block := ab; + + // --------------------------------------------------------------- + // Make an alternative, putting the rule ref into it. + // --------------------------------------------------------------- + alt := TAlternative.Create( rr); + alt.AddElem( be); + + // --------------------------------------------------------------- + // Add the alternative to this block. + // --------------------------------------------------------------- + ab.AddAlternative( alt); + + // --------------------------------------------------------------- + // Create an empty (optional) alt and add to 'ab' + // --------------------------------------------------------------- + optAlt := TAlternative.Create; + optAlt.AddElem( be); + + ab.AddAlternative(optAlt); + ab.PrepareForAnalysis; + + result := ab; +end; + +// ============================================================================ +// ============================================================================ +// SetBlock +// ============================================================================ +procedure TGrammarMaker.SetBlock(pDst, pSrc: IAlternativeBlock); +begin + pDst.Alternatives := pSrc.Alternatives; + pDst.InitAction := pSrc.InitAction; + pDst.Lbl := pSrc.Lbl; + pDst.HasASynPred := pSrc.HasASynPred; + pDst.HasAnAction := pSrc.HasAnAction; + pDst.WarnFollowAmbig := pSrc.WarnFollowAmbig; + pDst.GenAmbigWarnings:= pSrc.GenAmbigWarnings; + pDst.Line := pSrc.Line; + pDst.Greedy := pSrc.Greedy; + pDst.GreedySet := pSrc.GreedySet; +end; + +// ============================================================================ +// ============================================================================ +// NoAutoGenSubRule +// ============================================================================ +procedure TGrammarMaker.NoAutoGenSubRule; +begin + Context.Block.AutoGen := false; +end; + +// ============================================================================ +// ============================================================================ +// refRuleLocals +// ============================================================================ +procedure TGrammarMaker.RefRuleLocals(pLocals: IToken); +begin + fRuleBlock.Locals := pLocals.TokenText; +end; + +// ============================================================================ +// RefRuleExHandler +// ============================================================================ +procedure TGrammarMaker.RefRuleExHandler( pExHandlerType: IToken; + pExHandlerCode: IToken); +begin + fRuleBlock.ExHandlerType := pExHandlerType.TokenText; + fRuleBlock.ExHandlerCode := pExHandlerCode.TokenText; +end; + +// ============================================================================ +// RefAltExHandler +// ============================================================================ +procedure TGrammarMaker.RefAltExHandler( pExHandlerType: IToken; + pExHandlerCode: IToken); +begin + Context.CurrentAlt.ExHandlerType := pExHandlerType.TokenText; + Context.CurrentAlt.ExHandlerCode := pExHandlerCode.TokenText; +end; + + + +// @@@: AST stuff +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// AST stuff +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Begin Tree +// ================================================================================================ +procedure TGrammarMaker.BeginTree( pStart: IToken); +begin + if Supports( fGrammar, ITreeWalkerGrammar) then + begin + fBlocks.Push( TTreeBlockContext.Create); + + Context.Block := TTreeElem.Create(fGrammar, pStart, true); + Context.AltNum := 0; + end; +end; + +// ================================================================================================ +// Begin Child List +// ================================================================================================ +procedure TGrammarMaker.BeginChildList; +begin + Context.Block.AddAlternative( TAlternative.Create); +end; + +// ================================================================================================ +// End Child List +// ================================================================================================ +procedure TGrammarMaker.EndChildList; +var + be: IBlockEndElem; + +begin + // ---------------------------------------------------------------- + // create a final node to which the last elememt of the single + // alternative will point. Done for compatibility with analyzer. + // Does NOT point to any block like alternative blocks because the + // TreeElement is not a block. This is used only as a placeholder. + // ---------------------------------------------------------------- + be := TBlockEndElem.Create( fGrammar); + be.Block := Context.Block; + + AddElemToCurrentAlt(be); +end; + +// ================================================================================================ +// End Tree +// ================================================================================================ +procedure TGrammarMaker.EndTree; +var + ctx: TBlockContext; + +begin + ctx := fBlocks.Extract; + AddElemToCurrentAlt(ctx.Block); + + // TODO: ctx.free here ??? +end; + +end. diff --git a/src.lib/dpglib.GrammarSymbol.pas b/src.lib/dpglib.GrammarSymbol.pas new file mode 100644 index 0000000..c17e5c5 --- /dev/null +++ b/src.lib/dpglib.GrammarSymbol.pas @@ -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. diff --git a/src.lib/dpglib.LLkAnalyzer.pas b/src.lib/dpglib.LLkAnalyzer.pas new file mode 100644 index 0000000..8054fb5 --- /dev/null +++ b/src.lib/dpglib.LLkAnalyzer.pas @@ -0,0 +1,1550 @@ +// ============================================================================ +// LLkAnalyzer +// +// Checked.... +// ============================================================================ +unit dpglib.LLkAnalyzer; + +interface +uses + System.Classes, + dpgrtl.types, + dpglib.Types, + dpglib.Lookahead; + +type + + TLLkAnalyzer = class( TInterfacedObject, + ILLkAnalyzer) + + protected + DEBUG_ANALYZER : boolean; + fCurrentBlock : IAlternativeBlock; + fTool : ITool; + fGrammar : IGrammar; + fLexical : boolean; + fCharFormatter : ICharFormatter; + + private + function altUsesWildcardDefault( pAlt : IAlternative): boolean; + procedure removeCompetingPredictionSets(var pSet: TByteSet; + pElem: IALternativeElem); + function getAltLookahead( pBlk : IAlternativeBlock; + pAlt : integer; + pK : integer): ILookahead; + function DeterminisiticImpliedPath( pBlk : IBlockWithImpliedExitPath): boolean; + + protected + // ------------------------------------------------------------ + // ILLkAnalyzer methods + // ------------------------------------------------------------ + procedure SetGrammar( pGrammar: IGrammar); + + function Deterministic( pBlk: IAlternativeBlock): boolean; overload; + function Deterministic( pBlk: IOneOrMoreBlock) : boolean; overload; + function Deterministic( pBlk: IZeroOrMoreBlock) : boolean; overload; + + function Look( k: integer; pElem: IActionElem) : ILookahead; overload; + function Look( k: integer; pBlk : IAlternativeBlock) : ILookahead; overload; + function Look( k: integer; pEnd : IBlockEndElem) : ILookahead; overload; + function Look( k: integer; pAtom: ICharLiteralElem) : ILookahead; overload; + function Look( k: integer; pElem: ICharRangeElem) : ILookahead; overload; + function Look( k: integer; pAtom: IGrammarAtom) : ILookahead; overload; + function Look( k: integer; pBlk: IOneOrMoreBlock) : ILookahead; overload; + function Look( k: integer; pBlk: INMBlock) : ILookahead; overload; + function Look( k: integer; pElem: IRuleBlock) : ILookahead; overload; + function Look( k: integer; pEnd: IRuleEndElem) : ILookahead; overload; + function Look( k: integer; pElem: IRuleRefElem) : ILookahead; overload; + function Look( k: integer; pAtom: IStringLiteralElem) : ILookahead; overload; + function Look( k: integer; pBlk : ISynPredBlock) : ILookahead; overload; + function Look( k: integer; pElem: ITokenRangeElem) : ILookahead; overload; + function Look( k: integer; pElem: ITreeElem) : ILookahead; overload; + function Look( k: integer; pElem: IWildCardElem) : ILookahead; overload; + function Look( k: integer; pBlk: IZeroOrMoreBlock) : ILookahead; overload; + function Look( k: integer; pElem: AnsiString) : ILookahead; overload; + + function FOLLOW( k: integer; pEnd: IRuleEndElem) : ILookahead; + + function SubRuleCanBeInverted( pBlock : IAlternativeBlock; + pIsLexer : boolean): boolean; + + public + constructor Create( pTool: ITool); + destructor Destroy; override; + end; + +implementation +uses + System.SysUtils, + dpglib.Messages, + dpglib.Utils, + dpglib.CodeGenerator, + dpglib.DelphiCharFormatter; + +{ TLLkAnalyzer } + +// **************************************************************************** +// Constructor/destructor +// **************************************************************************** +// ============================================================================ +// Constructor +// ============================================================================ +constructor TLLkAnalyzer.Create(pTool: ITool); +begin + inherited Create; + + DEBUG_ANALYZER := false; + fLexical := false; + + fCurrentBlock := nil; + fGrammar := nil; + fTool := pTool; + fCharFormatter := TDelphiCharFormatter.Create; +end; + +// ============================================================================ +// Destructor +// ============================================================================ +destructor TLLkAnalyzer.Destroy; +begin + fCurrentBlock := nil; + fTool := nil; + fGrammar := nil; + fCharFormatter := nil; + + inherited; +end; + +// **************************************************************************** +// Internals +// **************************************************************************** +// ============================================================================ +// ============================================================================ +// Deterministic +// +// Is this block of alternatives LL(k)? Fill in alternative cache for this blk. +// Return true if the block is deterministic. +// ============================================================================ +function TLLkAnalyzer.Deterministic( pBlk: IAlternativeBlock): boolean; +var + k : integer; + i,j : integer; + l : integer; + nalts : integer; + save : IAlternativeBlock; + elem : IAlternativeElem; + + zom : IZeroOrMoreBlock; + oom : IOneOrMoreBlock; + + haveAmbig : boolean; + p : ILookahead; + q : ILookahead; + r : array of ILookahead; + sets : TInterfaceList; + + ai : IAlternative; + aj : IAlternative; + + bei : IBlockEndElem; + bej : IBlockEndElem; + +begin + result := true; + nalts := pBlk.Alternatives.Count; + save := fCurrentBlock; + fCurrentBlock := pBlk; + + pBlk.QueryInterface(IOneOrMoreBlock, oom); + pBlk.QueryInterface(IZeroOrMoreBlock, zom); + + // --------------------------------------------------------------- + // Don't allow nongreedy (...) blocks + // --------------------------------------------------------------- + if (pBlk.Greedy = false) and (oom = nil) and (zom = nil) then + begin + fTool.Warning( MSG_W_INVNONGREEDY, + fGrammar.GrammarFile, + pBlk.Line, + pBlk.Column); + end; + + // --------------------------------------------------------------- + // SPECIAL CASE: only one alternative. We don't need to check the + // determinism, but other code expects the lookahead cache to be + // set for the single alt. + // --------------------------------------------------------------- + if nalts = 1 then + begin + elem := pBlk.Alternative[0].Head; + fCurrentBlock.AltI := 0; + + if pBlk.Alternative[0].CacheSize < 2 then + pBlk.Alternative[0].CacheSize := 2; + + pBlk.Alternative[0].Cache[1] := elem.Look(1); + pBlk.Alternative[0].LookaheadDepth := 1; + + fCurrentBlock := save; + result := true; + exit; + end; + + // --------------------------------------------------------------- + // GENERAL CASE + // --------------------------------------------------------------- + SetLength( r, fGrammar.MaxK +1); + + for i:=0 to nalts -1 do + begin + fCurrentBlock.AltI := i; + + for j:=i+1 to nalts-1 do + begin + fCurrentBlock.AltJ := j; + fCurrentBlock.AnalyzisAlt := j; + + // --------------------------------------------------------- + // Always attempt minimum lookahead possible. + // --------------------------------------------------------- + k := 1; + + // --------------------------------------------------------- + // Check to see if there is a lookahead depth that + // distinguishes between alternatives i and j. + // --------------------------------------------------------- + haveAmbig := true; + + while haveAmbig and (k <= fGrammar.MaxK) do + begin + haveAmbig := false; + + p := getAltLookahead( pBlk, i, k); + q := getAltLookahead( pBlk, j, k); + r[k] := p.Intersection(q); + + if not r[k].IsNil then + begin + haveAmbig := true; + INC(k); + end; + end; + + ai := pBlk.Alternative[i]; + aj := pBlk.Alternative[j]; + + if haveAmbig then + begin + result := false; + + ai.LookaheadDepth := NONDETERMINISTIC; + aj.LookaheadDepth := NONDETERMINISTIC; + + ai.Head.QueryInterface( IBlockEndElem, bei); + aj.Head.QueryInterface( IBlockEndElem, bej); + + // ------------------------------------------------------ + // if ith alt starts with a syntactic predicate, computing + // the lookahead is still done for code generation, but + // messages should not be generated when comparing against + // alt j. Alternatives with syn preds that are unnecessary + // do not result in syn pred try-blocks. + // ------------------------------------------------------ + if ai.SynPred <> nil then + // --------------------------------------------------- + // The alt with the (...)=> block is nondeterministic + // for sure. If the (...)=> conflicts with alt j, j is + // nondeterministic. This prevents alt j from being in + // any switch statements. + // Move on to next alternative=>no possible ambiguity! + // --------------------------------------------------- + + // ------------------------------------------------------ + // if ith alt starts with a semantic predicate, computing + // the lookahead is still done for code generation, but + // messages should not be generated when comparing against + // alt j. + // ------------------------------------------------------ + else if ai.SemPred <> '' then + + // ------------------------------------------------------ + // if jth alt is exactly the wildcard or wildcard root of + // tree, then remove elements of alt i lookahead from alt + // j's lookahead. + // Don't do an ambiguity warning. + // ------------------------------------------------------ + else if altUsesWildcardDefault( aj) then + + // ------------------------------------------------------ + // If the user specified warnWhenFollowAmbig=false, then we + // can turn off this warning IF one of the alts is empty; + // that is, it points immediately at the end block. + // ------------------------------------------------------ + else if (pBlk.WarnFollowAmbig = false) and + ((bei <> nil) or (bej <> nil)) then + + // ------------------------------------------------------ + // If they have the generateAmbigWarnings option off for + // the block then don't generate a warning. + // ------------------------------------------------------ + else if pBlk.GenAmbigWarnings = false then + + // ------------------------------------------------------ + // If greedy=true and *one* empty alt shut off warning. + // ------------------------------------------------------ + else if pBlk.Greedy and pBlk.GreedySet and + (((bei = nil) and (bej <> nil)) or + ((bei <> nil) and (bej = nil)))then + + // ------------------------------------------------------ + // We have no choice, but to report a nondetermism. + // ------------------------------------------------------ + else + begin + sets := TInterfaceList.Create; + for l:=1 to fGrammar.MaxK do + sets.Add( r[l]); + + fTool.WarnAltAmbiguity( fGrammar, + pBlk, + fLexical, + fGrammar.MaxK, + sets, + i, + j); + + FreeAndNil( sets); + end; + end + else + begin + if ai.LookaheadDepth < k then ai.LookaheadDepth := k; + if aj.LookaheadDepth < k then aj.LookaheadDepth := k; + end; + end; + end; + + r := nil; + fCurrentBlock := save; +end; + +// ============================================================================ +// ============================================================================ +// Deterministic (...)+ +// +// Is (...)+ block LL(1)? Fill in alternative cache for this block. +// return true if the block is deterministic +// ============================================================================ +function TLLkAnalyzer.Deterministic(pBlk: IOneOrMoreBlock): boolean; +var + save : IAlternativeBlock; + blkOK : boolean; + det : boolean; + +begin + save := fCurrentBlock; + fCurrentBlock := pBlk; + + blkOK := Deterministic( pBlk as IAlternativeBlock); + // --------------------------------------------------------------- + // Block has been checked, now check that what follows does not + // conflict with the lookahead of the (...)+ block. + // --------------------------------------------------------------- + det := DeterminisiticImpliedPath( pBlk); + fCurrentBlock := save; + + result := blkOK and det; +end; + +// ============================================================================ +// ============================================================================ +// Deterministic (...)* +// +// Is (...)* block LL(1)? Fill in alternative cache for this block. +// return true if the block is deterministic +// ============================================================================ +function TLLkAnalyzer.Deterministic(pBlk: IZeroOrMoreBlock): boolean; +var + save : IAlternativeBlock; + blkOK : boolean; + det : boolean; + +begin + save := fCurrentBlock; + fCurrentBlock := pBlk; + + blkOK := Deterministic( pBlk as IAlternativeBlock); + // --------------------------------------------------------------- + // Block has been checked, now check that what follows does not + // conflict with the lookahead of the (...)* block. + // --------------------------------------------------------------- + det := DeterminisiticImpliedPath( pBlk); + fCurrentBlock := save; + + result := blkOK and det; +end; + +// ============================================================================ +// ============================================================================ +// DeterminisiticImpliedPath +// +// Is this (...)* or (...)+ LL(k)? +// ============================================================================ +function TLLkAnalyzer.DeterminisiticImpliedPath( pBlk: IBlockWithImpliedExitPath): boolean; +var + k : integer; + alt : IAlternative; + alts : TInterfaceList; + nalts : integer; + + i : integer; + l : integer; + be : IBlockEndElem; + p : ILookahead; + r : array of ILookahead; + sets : TInterfaceList; + haveAmbig : boolean; + follow : ILookahead; + +begin + result := true; + alts := pBlk.Alternatives; + nalts := alts.Count; + + fCurrentBlock.AltJ := -1; + + for i:=0 to nalts-1 do + begin + alt := pBlk.Alternative[i]; + + if alt.Head.QueryInterface(IBlockEndElem,be) = S_OK then + begin + fTool.Warning( MSG_W_INVEMPTYALT, + fGrammar.GrammarFile, + pBlk.Line, + pBlk.Column); + end; + + // ------------------------------------------------------------ + // Assume each alternative is LL(1) with exit branch. + // ------------------------------------------------------------ + k := 1; + + // ------------------------------------------------------------ + // Check to see if there is a lookahead depth that distinguishes + // between alternative i and the exit branch. + // ------------------------------------------------------------ + SetLength( r, fGrammar.MaxK +1); + + fCurrentBlock.AltI := i; + haveAmbig := true; + + while haveAmbig and (k <= fGrammar.MaxK) do + begin + haveAmbig := false; + follow := pBlk.Next.Look(k); + pBlk.ExitCache[k] := follow; + + p := getAltLookahead( pBlk, i, k); + r[k] := follow.Intersection(p); + + if not r[k].IsNil then + begin + haveAmbig := true; + INC(k); + end; + end; + + + if haveAmbig then + begin + result := false; + + alt.LookaheadDepth:= NONDETERMINISTIC; + pBlk.ExitDepth := NONDETERMINISTIC; + + // --------------------------------------------------------- + // If the user specified warnWhenFollowAmbig=false, then we + // can turn off this warning. + // --------------------------------------------------------- + if not pBlk.WarnFollowAmbig then + + // --------------------------------------------------------- + // If they have the generateAmbigWarnings option off for the block + // then don't generate a warning. + // --------------------------------------------------------- + else if not pBlk.GenAmbigWarnings then + + // --------------------------------------------------------- + // If greedy=true and alt not empty, shut off warning + // --------------------------------------------------------- + else if pBlk.Greedy and pBlk.GreedySet and (be = nil) then + + + // --------------------------------------------------------- + // If greedy=false then shut off warning...will have + // to add "if FOLLOW break" + // block during code gen to compensate for removal of warning. + // --------------------------------------------------------- + else if (not pBlk.Greedy) and (be = nil) then +(* // if FOLLOW not single k-string (|set[k]| can + // be > 1 actually) then must warn them that + // loop may terminate incorrectly. + // For example, ('a'..'d')+ ("ad"|"cb") + if (!lookaheadEquivForApproxAndFullAnalysis(blk.exitCache, grammar.maxk)) { + tool.warning(new AnsiString[]{ + "nongreedy block may exit incorrectly due", + "\tto limitations of linear approximate lookahead (first k-1 sets", + "\tin lookahead not singleton)."}, + grammar.getFilename(), blk.getLine(), blk.getColumn()); +*) + + // --------------------------------------------------------- + // No choice but to generate a warning + // --------------------------------------------------------- + else + begin + sets := TInterfaceList.Create; + for l:= 1 to fGrammar.MaxK do + sets.Add( r[l]); + + fTool.WarnAltExitAmbiguity( fgrammar, + pBlk, + fLexical, + fGrammar.MaxK, + sets, + i); + + FreeAndNil(sets); + end; + end + + else + begin + if alt.LookaheadDepth < k then alt.LookaheadDepth := k; + if pBlk.ExitDepth < k then pBlk.ExitDepth := k; + end; + end; + + r := nil; +end; + +// ============================================================================ +// ============================================================================ +// FOLLOW +// +// Compute the lookahead set of whatever follows references to +// the rule associated witht the FOLLOW block. +// ============================================================================ +function TLLkAnalyzer.FOLLOW(k: integer; pEnd: IRuleEndElem): ILookahead; +var + ts : ITokenSymbol; + rb : IRuleBlock; + rs : IRuleSymbol; + re : IRuleEndElem; + rr : IRuleRefElem; + lg : ILexerGrammar; + rule : AnsiString; + i : integer; + q : ILookahead; + +begin + // --------------------------------------------------------------- + // What rule are we trying to compute FOLLOW of? + // --------------------------------------------------------------- + pEnd.Block.QueryInterface(IRuleBlock, rb); + + if fLexical then + rule := TCodeGenerator.encodeLexerRuleName( rb.RuleName) + else + rule := rb.RuleName; + + // --------------------------------------------------------------- + // Are we in the midst of computing this FOLLOW already. + // --------------------------------------------------------------- + if pEnd.Lock[k] then + begin + result := TLookahead.Create( rule); + exit; + end; + + // --------------------------------------------------------------- + // Check to see if there is cached value. + // --------------------------------------------------------------- + if pEnd.Cache[k] <> nil then + begin + // ------------------------------------------------------------ + // If the cache is a complete computation then simply return it + // ------------------------------------------------------------ + if pEnd.Cache[k].Cycle = '' then + begin + result := pEnd.Cache[k].clone; + exit; + end; + + // ------------------------------------------------------------ + // A cache entry exists, but it is a reference to a cyclic com- + // putation. + // ------------------------------------------------------------ + ts := fGrammar.Symbol[pEnd.Cache[k].Cycle]; + ts.QueryInterface( IRuleSymbol, rs); + re := rs.Block.EndElem; + + // ------------------------------------------------------------ + // The other entry may not exist because it is still being + // computed when this cycle cache entry was found here. + // ------------------------------------------------------------ + if re.Cache[k] = nil then + begin + // --------------------------------------------------------- + // return the cycle...that's all we can do at the moment. + // --------------------------------------------------------- + result := pEnd.Cache[k].clone; + exit; + end + else + begin + // --------------------------------------------------------- + // Replace this cache entry with the entry from the + // referenced computation. Eventually, this percolates a + // complete (no cycle reference) cache entry to this node + // (or at least gets it closer and closer). This is not + // crucial, but makes cache lookup faster as we might have + // to look up lots of cycle references before finding a + // complete reference. + // --------------------------------------------------------- + pEnd.Cache[k] := re.Cache[k].clone; + result := re.Cache[k].clone; + exit; + end; + end; + + pEnd.Lock[k] := true; + result := TLookahead.Create; + + ts := fGrammar.Symbol[rule]; + ts.QueryInterface( IRuleSymbol, rs); + + // --------------------------------------------------------------- + // Walk list of references to this rule to compute FOLLOW + // --------------------------------------------------------------- + for i:=0 to rs.ReferenceCount-1 do + begin + rr := rs.Reference[i]; + q := rr.Next.Look(k); + + // ------------------------------------------------------------ + // If there is a cycle then if the cycle is to the rule for + // this end block, you have a cycle to yourself. Remove the + // cycle indication--the lookahead is complete. + // ------------------------------------------------------------ + if q.Cycle = rule then + q.Cycle := ''; + + // ------------------------------------------------------------ + // Add the lookahead into the curretn FOLLOW computation set. + // ------------------------------------------------------------ + result.CombineWith( q); + end; + + pEnd.Lock[k] := false; + + // --------------------------------------------------------------- + // If no rules follow this, it can be a start symbol or called by + // a start symbol. Set the follow to be end of file. + // --------------------------------------------------------------- +// if result.IsNil and (result.Cycle = '') then + + + if (result.LaSet = []) and (result.Cycle = '') then + begin + // ------------------------------------------------------------ + // Lexical grammars use Epsilon to indicate that the end of rule + // has been hit. EOF would be misleading; any AnsiCharacter can + // follow a token rule not just EOF as in a grammar (where a + // start symbol is followed by EOF). There is no sequence info + // in a lexer between tokens to indicate what is the last token + // to be seen. + // ------------------------------------------------------------ + if fGrammar.QueryInterface(ILexerGrammar, lg) = S_OK then + result.HasEpsilon := true + + else + result.LaSet := result.LaSet + [TT_EOF] + end; + + // --------------------------------------------------------------- + // Cache the result of the FOLLOW computation. + // --------------------------------------------------------------- + pEnd.Cache[k] := result.clone; +end; + +// ============================================================================ +// ============================================================================ +// getAltLookahead +// ============================================================================ +function TLLkAnalyzer.getAltLookahead( pBlk : IAlternativeBlock; + pAlt : integer; + pK : integer): ILookahead; +var + alt : IAlternative; + elem : IAlternativeElem; + +begin + alt := pBlk.Alternative[pAlt]; + elem := alt.Head; + + if alt.Cache[pK] = nil then + alt.Cache[pK] := elem.Look( pK); + + result := alt.Cache[pK].clone; +end; + +// ============================================================================ +// ============================================================================ +// Look (Action) +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pElem: IActionElem): ILookahead; +begin + result := pElem.Next.Look(k); +end; + +// ============================================================================ +// ============================================================================ +// Look (AlternativeBlock) +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pBlk: IAlternativeBlock): ILookahead; +var + save : IAlternativeBlock; + elem : IAlternativeElem; + alt : IAlternative; + i : integer; + +begin + save := fCurrentBlock; + fCurrentBlock := pBlk; + result := TLookahead.Create; + + for i:=0 to pBlk.Alternatives.Count -1 do + begin + fCurrentBlock.AnalyzisAlt := i; + alt := pBlk.Alternative[i]; + elem := alt.Head; + + result.CombineWith( elem.Look(k)); + end; + + if (k=1) and pBlk.IsNot and SubRuleCanBeInverted( pBlk, fLexical) then + begin + if fLexical then + result.LaSet := fGrammar.CharVocabulary - result.LaSet + else + result.LaSet := [TT_USER..fGrammar.TokenManager.MaxTokenType] - result.LaSet; + end; + + fCurrentBlock := save; +end; + +// ============================================================================ +// Look (BlockEnd) +// +// Compute what follows this place-holder node and possibly what begins the +// associated loop unless the node is locked. +// +// If we hit the end of a loop, we have to include what tokens can begin the +// loop as well. If the start node is locked, then we simply found an empty +// path through this subrule while analyzing it. If the start node is not +// locked, then this node was hit during a FOLLOW operation and the FIRST of +// this block must be included in that lookahead computation. +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pEnd: IBlockEndElem): ILookahead; +var + zom : IZeroOrMoreBlock; + oom : IOneOrMoreBlock; + spb : ISynPredBlock; + +begin + // --------------------------------------------------------------- + // computation in progress => the tokens we would have computed + // (had we not been locked) will be included in the set by that + // computation with the lock on this node. + // --------------------------------------------------------------- + if pEnd.Lock[k] then + begin + result := TLookahead.Create; + exit; + end; + + // --------------------------------------------------------------- + // Hitting the end of loop means you can see what begins the loop + // --------------------------------------------------------------- + pEnd.Block.QueryInterface( IZeroOrMoreBlock, zom); + pEnd.Block.QueryInterface( IOneOrMoreBlock, oom); + + if (zom <> nil) or (oom <> nil) then + begin + // ------------------------------------------------------------ + // Compute what can start the block, but lock end-node so + // we don't do it twice in the same computation. + // ------------------------------------------------------------ + pEnd.Lock[k] := true; + result := Look( k, pEnd.Block); + pEnd.Lock[k] := false; + end + else + result := TLookahead.Create; + + // --------------------------------------------------------------- + // Syntactic predicates such as ( (A)? )=> have no follow per + // se. We cannot accurately say what would be matched following + // a syntactic predicate (you MIGHT be ok if you said it was + // whatever followed the alternative predicted by the predicate). + // Hence, (like end-of-token) we return Epsilon to indicate + // "unknown lookahead." + // --------------------------------------------------------------- + if pEnd.QueryInterface( ISynPredBlock, spb) = S_OK then + result.HasEpsilon := true + + // ------------------------------------------------------------ + // Compute what can follow the block + // ------------------------------------------------------------ + else + result.CombineWith( pEnd.Block.Next.Look(k)); //??? +end; + +// ============================================================================ +// ============================================================================ +// Look (CharLiteral) +// +// Return this AnsiChar as the lookahead if k=1. +// ### Doesn't work for ( 'a' 'b' | 'a' ~'b' ) yet!!! +// +// If the atom has the 'not' flag on, then create the set complement of the +// tokenType which is the set of all AnsiCharacters referenced in the grammar with +// this AnsiChar turned off. +// Also remove AnsiCharacters from the set that are currently allocated for +// predicting previous alternatives. This avoids ambiguity messages and is more +// properly what is meant. +// +// NOTE: we do NOT include exit path in the exclusion set. E.g., +// ( 'a' | ~'a' )* 'b' +// should exit upon seeing a 'b' during the loop. +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pAtom: ICharLiteralElem): ILookahead; +var + b: TByteSet; + +begin + // --------------------------------------------------------------- + // Handle lexer case + // --------------------------------------------------------------- + if fLexical then + begin + // ------------------------------------------------------------ + // Skip until analysis hits k=1 + // ------------------------------------------------------------ + if k > 1 then + begin + result := pAtom.Next.Look(k-1); + exit; + end; + + // ------------------------------------------------------------ + // Inverted AnsiCharacter literal e.g.: ~'c' + // ------------------------------------------------------------ + if pAtom.IsNot then + begin + b := fGrammar.CharVocabulary; + + // --------------------------------------------------------- + // Remove stuff predicted by preceding alts and follow of + // block. + // --------------------------------------------------------- + removeCompetingPredictionSets( b, pAtom); + + // --------------------------------------------------------- + // Remove elem that is stated not to be in the set + // --------------------------------------------------------- + b := b - [pAtom.TokenType]; + + result := TLookahead.Create(b); + end + + // ------------------------------------------------------------ + // Non-inverted AnsiCharacter literal e.g.: 'c' + // ------------------------------------------------------------ + else + result := TLookahead.Create( pAtom.TokenType); + end + + // --------------------------------------------------------------- + // Handle parser/treewalker case. AnsiCharacter literal reference is + // invalid in non-lexer grammars. This should have been avoided by + // GrammarMaker. + // --------------------------------------------------------------- + else + begin + fTool.Panic('Character literal reference found in parser'); + result := nil; + end +end; + +// ============================================================================ +// ============================================================================ +// Look (CharRange) +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pElem: ICharRangeElem): ILookahead; +begin + if k > 1 then + result := pElem.Next.Look(k-1) + else + result := TLookahead.Create([ord(pElem.BeginChar)..ord(pElem.EndChar)]); +end; + +// ============================================================================ +// ============================================================================ +// Look (GrammarAtom) +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pAtom: IGrammarAtom): ILookahead; +var + b: TByteSet; + +begin + // --------------------------------------------------------------- + // Handle parser/treewalker case. + // --------------------------------------------------------------- + if not fLexical then + begin + // ------------------------------------------------------------ + // Skip until analysis hits k=1 + // ------------------------------------------------------------ + if k > 1 then + begin + result := pAtom.Next.Look( k-1); + exit; + end; + + // ------------------------------------------------------------ + // Inverted token reference e.g.: ~INTEGER + // ------------------------------------------------------------ + if pAtom.IsNot then + begin + b := [TT_USER..fGrammar.TokenManager.MaxTokenType]; + + // --------------------------------------------------------- + // Remove stuff predicted by preceding alts and follow of + // block. + // --------------------------------------------------------- + removeCompetingPredictionSets( b, pAtom); + + // --------------------------------------------------------- + // Remove elem that is stated not to be in the set + // --------------------------------------------------------- + b := b - [pAtom.TokenType]; + + result := TLookahead.Create(b); + end + + // ------------------------------------------------------------ + // Non-inverted token reference e.g.: HEXINT + // ------------------------------------------------------------ + else + result := TLookahead.Create( pAtom.TokenType); + end + + // --------------------------------------------------------------- + // Handle lexer case. Token reference is not valid in lexer + // grammars. This should have been avoided by GrammarMaker. + // --------------------------------------------------------------- + else begin + fTool.Panic('Token reference found in lexer.'); + result := nil; + end; +end; + +// ============================================================================ +// ============================================================================ +// Look (...)+ +// +// The lookahead of a (...)+ block is the combined lookahead of all alternatives +// and, if an empty path is found, the lookahead of what follows the block. +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pBlk: IOneOrMoreBlock): ILookahead; +begin + result := Look( k, pBlk as IAlternativeBlock); +end; + +// ================================================================================================ +// Look (...)@(n,m) +// ================================================================================================ +function TLLkAnalyzer.Look( k: integer; pBlk: INMBlock): ILookahead; +var + i: integer; + +begin + if k <= pBlk.Low then + result := look(k, pBlk as IAlternativeBlock) + + else if k <= pBlk.High then + begin + result := look(k, pBlk as IAlternativeBlock); + + for i:=pBlk.Low+1 to k do + result.CombineWith( pBlk.Next.Look(k-i+1)); + end + + else {k > pBlk.High} + begin + result := TLookahead.Create; // create empty one + + for i:=pBlk.Low+1 to k do + result.CombineWith( pBlk.Next.Look(k-i+1)); + end +end; + + +// ============================================================================ +// ============================================================================ +// Look (...)* +// +// The (...)* element is the combined lookahead of the alternatives and what can +// follow the loop. +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pBlk: IZeroOrMoreBlock): ILookahead; +begin + result := look( k, pBlk as IAlternativeBlock); + result.CombineWith( pBlk.Next.Look(k)); +end; + +// ============================================================================ +// ============================================================================ +// Look (RuleBlock) +// +// Combine the lookahead computed for each alternative. Lock the node so that +// no other computation may come back on itself -- infinite loop. This also +// implies infinite left-recursion in the grammar +// (or an error in this algorithm ;)). +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pElem: IRuleBlock): ILookahead; +begin + result := Look( k, pElem as IAlternativeBlock); +end; + +// ============================================================================ +// ============================================================================ +// Look (RuleEnd) +// +// Lexical rules never compute follow. They set epsilon and the code generator +// generates code to check for any AnsiCharacter. The code generator must remove the +// tokens used to predict any previous alts in the same block. +// +// When the last node of a rule is reached and noFOLLOW, it implies that a +// "local" FOLLOW will be computed after this call. I.e., +// +// a : b A; +// b : B | ; +// c : b C; +// +// Here, when computing the look of rule b from rule a, we want only +// {B,EPSILON_TYPE} so that look(b A) will be {B,A} not {B,A,C}. +// +// If the end block is not locked and the FOLLOW is wanted, the algorithm must +// compute the lookahead of what follows references to this rule. If end block +// is locked, FOLLOW will return an empty set with a cycle to the rule +// associated with this end block. +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pEnd: IRuleEndElem): ILookahead; +begin + if pEnd.noFOLLOW or fLexical then + begin + result := TLookahead.Create; + result.HasEpsilon := true; + result.Epsilon := [k]; + end + else + result := FOLLOW( k, pEnd); +end; + +// ============================================================================ +// ============================================================================ +// Look (RuleRef) +// +// When computing ruleref lookahead, we don't want the FOLLOW computation done +// if an empty path exists for the rule. The FOLLOW is too loose of a set... +// we want only to include the "local" FOLLOW or what can follow this +// particular ref to the node. In other words, we use context information to +// reduce the complexity of the analysis and strengthen the parser. +// +// The noFOLLOW flag is used as a means of restricting the FOLLOW to a +// "local" FOLLOW. This variable is orthogonal to the 'lock' variable that +// prevents infinite recursion. noFOLLOW does not care about what k is. +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pElem: IRuleRefElem): ILookahead; +var + ts : ITokenSymbol; + rs : IRuleSymbol; + rb : IRuleBlock; + re : IRuleEndElem; + se : boolean; + p : ILookahead; + q : ILookahead; + depths: TByteSet; + i : integer; + + rname : AnsiString; + cname : AnsiString; + +begin + rs := nil; + ts := fGrammar.Symbol[pElem.TargetRule]; + + if ts <> nil then + ts.QueryInterface(IRuleSymbol, rs); + + // --------------------------------------------------------------- + // The symbol not exists in the grammar. + // --------------------------------------------------------------- + if rs = nil then + begin + if fLexical then + rname := TCodeGenerator.decodeLexerRuleName( pElem.TargetRule) + else + rname := pElem.TargetRule; + + + fTool.Error(Format( MSG_E_RULENOTDEFINED, [rname]), + fGrammar.GrammarFile, + pElem.Line, + pElem.Column); + +// fGrammar.Tool.Error( 'No definition of rule "' + rname + '"', +// fGrammar.GrammarFile, +// pElem.Line, +// pElem.Column); + result := TLookahead.Create; + exit; + end; + + // --------------------------------------------------------------- + // The symbol not defined in the grammar + // --------------------------------------------------------------- + if not rs.Defined then + begin + if fLexical then + rname := TCodeGenerator.decodeLexerRuleName( pElem.TargetRule) + else + rname := pElem.TargetRule; + + fTool.Error(Format( MSG_E_RULENOTDEFINED, [rname]), + fGrammar.GrammarFile, + pElem.Line, + pElem.Column); + +// fGrammar.Tool.Error( 'No definition of rule "' + rname + '"', +// fGrammar.GrammarFile, +// pElem.Line, +// pElem.Column); + result := TLookahead.Create; + exit; + end; + + rb := rs.Block; + re := rb.EndElem; + se := re.noFOLLOW; + re.noFOLLOW := true; + + // --------------------------------------------------------------- + // Go off the rule and get the lookahead (w/o FOLLOW) + // --------------------------------------------------------------- + p := Look( k, pElem.TargetRule); + + // --------------------------------------------------------------- + // Restore state of end block + // --------------------------------------------------------------- + re.noFOLLOW := se; + + // --------------------------------------------------------------- + // Check for infinite recursion. If a cycle is returned: trouble!! + // --------------------------------------------------------------- + if p.Cycle <> '' then + begin + if fLexical then + begin + rname := TCodeGenerator.decodeLexerRuleName( pElem.TargetRule); + cname := TCodeGenerator.decodeLexerRuleName( p.Cycle); + end + else + begin + rname := pElem.TargetRule; + cname := p.Cycle; + end; + + fTool.Error(Format( MSG_E_INFRECURSION, [cname,rname]), + fGrammar.GrammarFile, + pElem.Line, + pElem.Column); + +// fTool.Error('infinite recursion to rule "' + +// cname + +// '" from rule " ' + +// rname + +// '"', +// fGrammar.GrammarFile, +// pElem.Line, +// pElem.Column); + end; + + // --------------------------------------------------------------- + // Is the local FOLLOW required? + // --------------------------------------------------------------- + if p.HasEpsilon then + begin + // ------------------------------------------------------------ + // Remove Epsilon + // ------------------------------------------------------------ + p.HasEpsilon := false; + + // ------------------------------------------------------------ + // For each lookahead depth that saw epsilon + // + // Note: any of these look() computations for local follow can + // set EPSILON in the set again if the end of this rule + // is found. + // ------------------------------------------------------------ + depths := p.Epsilon; + p.Epsilon:= []; + + for i:=0 to 255 do + begin + if (depths * [i]) <> [] then + begin + q := pElem.Next.Look( k - (k - i)); + p.CombineWith(q); + end; + end; + end; + + result := p; +end; + +// ============================================================================ +// ============================================================================ +// Look (StringLiteral) +// ============================================================================ +function TLLkAnalyzer.Look( k : integer; + pAtom : IStringLiteralElem): ILookahead; +begin + // --------------------------------------------------------------- + // Create Lookahead for lexer grammar + // --------------------------------------------------------------- + if fLexical then + begin + if k > Length( pAtom.ProcessedAtomText) then + result := pAtom.Next.Look( k - Length( pAtom.ProcessedAtomText)) + else + result := TLookahead.Create( ord(pAtom.ProcessedAtomText[k])); + end + + // --------------------------------------------------------------- + // Create Lookahead for non-lexer grammar + // --------------------------------------------------------------- + else + begin + if k > 1 then + result := pAtom.Next.Look( k-1) + else + begin + if pAtom.IsNot then + result := TLookahead.Create([TT_USER..fGrammar.TokenManager.MaxTokenType] - [pAtom.TokenType]) + else + result := TLookahead.Create( pAtom.TokenType); + end; + end; +end; + +// ============================================================================ +// ============================================================================ +// Look (...)=> +// +// The lookahead of a (...)=> block is the lookahead of what follows the block. +// By definition, the syntactic predicate block defines static analysis (you +// want to try it out at run-time). +// The LOOK of (a)=>A B is A for LL(1) +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pBlk: ISynPredBlock): ILookahead; +begin + result := pBlk.Next.Look(k); +end; + +// ============================================================================ +// ============================================================================ +// Look (TT_XXX .. TT_YYY) +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pElem: ITokenRangeElem): ILookahead; +begin + if k > 1 then + result := pElem.Next.Look(k-1) + else + result := TLookahead.Create([pElem.BeginToken..pElem.EndToken]); +end; + +// ============================================================================ +// ============================================================================ +// Look (.) +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pElem: IWildCardElem): ILookahead; +var + b : TByteSet; + +begin + // --------------------------------------------------------------- + // Skip until analysis hits k=1 + // --------------------------------------------------------------- + if k > 1 then + result := pElem.Next.Look( k - 1) + + else + begin + if fLexical then + b := fGrammar.CharVocabulary + else + b := [TT_USER..fGrammar.TokenManager.MaxTokenType]; + +{ TODO : look(wildcard) delete 'removeCompeting...' if don't needed } + removeCompetingPredictionSets( b, pElem); + result := TLookahead.Create( b); + end; +end; + +// ============================================================================ +// ============================================================================ +// Look (rule name) +// +// Compute the combined lookahead for all productions of a rule. If the +// lookahead returns with epsilon, at least one epsilon path exists (one that +// consumes no tokens). The noFOLLOW flag being set for this endruleblk, +// indicates that the a rule ref invoked this rule. +// +// Currently only look(RuleRef) calls this. There is no need for the code +// generator to call this. +// ============================================================================ +function TLLkAnalyzer.Look(k: integer; pElem: AnsiString): ILookahead; +var + ts : ITokenSymbol; + rs : IRuleSymbol; + rb : IRuleBlock; + +begin + ts := fGrammar.Symbol[pElem]; + ts.QueryInterface( IRuleSymbol, rs); + rb := rs.Block; + + // --------------------------------------------------------------- + // Check for infinite recursion + // --------------------------------------------------------------- + if rb.Lock[k] then + begin + result := TLookahead.Create( pElem); + exit; + end; + + // --------------------------------------------------------------- + // Well, the lookahead wasn't computed before, so do it. + // --------------------------------------------------------------- + if rb.Cache[k] = nil then + begin + rb.Lock [k] := true; + rb.Cache[k] := Look( k, rb as IRuleBlock); + rb.Lock [k] := false; + end; + + result := rb.Cache[k].clone; +end; + + + + +// ---------------------------------------------------------------------------- +// Look (tree) +// ---------------------------------------------------------------------------- +function TLLkAnalyzer.Look(k: integer; pElem: ITreeElem): ILookahead; +begin +{ TODO : look(tree) not implemented } + if k > 1 then + result := pElem.Next.Look( k-1) + else + begin + result := nil; + end; +end; + +// ============================================================================ +// ============================================================================ +// SetGrammar +// ============================================================================ +procedure TLLkAnalyzer.SetGrammar(pGrammar: IGrammar); +var + lg : ILexerGrammar; + +begin + fGrammar := pGrammar; + + if fGrammar.QueryInterface(ILexerGrammar,lg) = S_OK then + fLexical := true + else + fLexical := false; +end; + + +// ============================================================================ +// ============================================================================ +// altUsesWildcardDefault +// +// Return true is someone used the '.' wildcard default idiom, which means the +// alternative has only two elems: wildcard-elem followed by block-end-elem. +// ============================================================================ +function TLLkAnalyzer.altUsesWildcardDefault( pAlt: IAlternative): boolean; +var + head : IAlternativeElem; + wc : IWildcardElem; + be : IBlockEndElem; + +begin + wc := nil; + be := nil; + result := false; + head := pAlt.Head; + + head.QueryInterface( IWildcardElem, wc); + + if head.next <> nil then + head.Next.QueryInterface( IBlockEndElem, be); + + if (wc <> nil) and (be <> nil) then + result := true; +end; + +// ============================================================================ +// ============================================================================ +// subRuleCanBeInverted +// ============================================================================ +function TLLkAnalyzer.subRuleCanBeInverted( pBlock : IAlternativeBlock; + pIsLexer : boolean): boolean; +var + zom : IZeroOrMoreBlock; + oom : IOneOrMoreBlock; + spb : ISynPredBlock; + + i : integer; + alt : IAlternative; + + elt : IAlternativeElem; + cLit : ICharLiteralElem; + cRng : ICharRangeELem; + tRef : ITokenRefElem; + tRng : ITokenRangeElem; + sLit : IStringLiteralElem; + be : IBlockEndElem; + + +begin + result := false; + + // --------------------------------------------------------------- + // Cannot invert (...)*, (...)+, (...)=> + // --------------------------------------------------------------- + pBlock.QueryInterface( IZeroOrMoreBlock, zom); + pBlock.QueryInterface( IOneOrMoreBlock, oom); + pBlock.QueryInterface( ISynPredBlock, spb); + + if (zom <> nil) or (oom <> nil) or (spb <> nil) then + exit; + + // --------------------------------------------------------------- + // Cannot invert an empty subrule + // --------------------------------------------------------------- + if pBlock.Alternatives.Count = 0 then + exit; + + // --------------------------------------------------------------- + // The block must only contain alternatives with a single element, + // where each element is a AnsiChar, token, AnsiChar range or token range. + // --------------------------------------------------------------- + for i:=0 to pBlock.Alternatives.Count -1 do + begin + alt := pBlock.Alternative[i]; + + // ------------------------------------------------------------ + // Cannot have anything interesting in the alternative ... + // ------------------------------------------------------------ + if (alt.SynPred <> nil) or + (alt.SemPred <> '') or + (alt.ExHandlerType <> '') then + begin + exit; + end; + + // ------------------------------------------------------------ + // ... and there must be one simple element + // ------------------------------------------------------------ + elt := alt.Head; + + elt.QueryInterface( ICharLiteralElem, cLit); + elt.QueryInterface( ICharRangeElem, cRng); + elt.QueryInterface( ITokenRefElem, tRef); + elt.QueryInterface( ITokenRangeElem, tRng); + elt.QueryInterface( IStringLiteralElem, sLit); + + elt.Next.QueryInterface( IBlockEndElem, be); + + if( not (( cLit <> nil) or + ( cRng <> nil) or + ( tRef <> nil) or + ( tRng <> nil) or + ((sLit <> nil) and pIsLexer)) + or + (be = nil) + or + (pBlock.AutoGenType <> AUTOGEN_NONE)) + then + begin + exit; + end; + end; + + result := true; +end; + +// ============================================================================ +// ============================================================================ +// removeCompetingPredictionSets +// +// Remove the prediction sets from preceding alternatives, but *only* if this +// element is the first element of the alternative. The class members +// 'fCurrentBlock' and 'fCurrentBlock.AnalysisAlt' must be set correctly. +// ============================================================================ +procedure TLLkAnalyzer.removeCompetingPredictionSets( var pSet : TByteSet; + pElem : IAlternativeElem); +var + i : integer; + head : IGrammarElem; + elem : IAlternativeElem; + +begin + // --------------------------------------------------------------- + // Only do this if the element is the first element of the alter- + // native, because we are making an implicit assumption that k==1. + // --------------------------------------------------------------- + head := fCurrentBlock.Alternative[fCurrentBlock.AnalyzisAlt].Head; + + if pElem = head then + begin + for i:=0 to fCurrentBlock.AnalyzisAlt -1 do + begin + elem := fCurrentBlock.Alternative[i].Head; + pSet := pSet - elem.Look(1).LaSet; + end + end; +end; + +end. diff --git a/src.lib/dpglib.LexerGrammar.pas b/src.lib/dpglib.LexerGrammar.pas new file mode 100644 index 0000000..b726c41 --- /dev/null +++ b/src.lib/dpglib.LexerGrammar.pas @@ -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. diff --git a/src.lib/dpglib.Lookahead.pas b/src.lib/dpglib.Lookahead.pas new file mode 100644 index 0000000..80199a9 --- /dev/null +++ b/src.lib/dpglib.Lookahead.pas @@ -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 {} 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 + '+ '; + + 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. diff --git a/src.lib/dpglib.Messages.pas b/src.lib/dpglib.Messages.pas new file mode 100644 index 0000000..a07370b --- /dev/null +++ b/src.lib/dpglib.Messages.pas @@ -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. diff --git a/src.lib/dpglib.NMBlock.pas b/src.lib/dpglib.NMBlock.pas new file mode 100644 index 0000000..7613712 --- /dev/null +++ b/src.lib/dpglib.NMBlock.pas @@ -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. diff --git a/src.lib/dpglib.OneOrMoreBlock.pas b/src.lib/dpglib.OneOrMoreBlock.pas new file mode 100644 index 0000000..2b08fe4 --- /dev/null +++ b/src.lib/dpglib.OneOrMoreBlock.pas @@ -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. diff --git a/src.lib/dpglib.ParserGrammar.pas b/src.lib/dpglib.ParserGrammar.pas new file mode 100644 index 0000000..239ac55 --- /dev/null +++ b/src.lib/dpglib.ParserGrammar.pas @@ -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. diff --git a/src.lib/dpglib.PrettyPrinter.pas b/src.lib/dpglib.PrettyPrinter.pas new file mode 100644 index 0000000..216a781 --- /dev/null +++ b/src.lib/dpglib.PrettyPrinter.pas @@ -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. diff --git a/src.lib/dpglib.RuleBlock.pas b/src.lib/dpglib.RuleBlock.pas new file mode 100644 index 0000000..22b123c --- /dev/null +++ b/src.lib/dpglib.RuleBlock.pas @@ -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. diff --git a/src.lib/dpglib.RuleEndElem.pas b/src.lib/dpglib.RuleEndElem.pas new file mode 100644 index 0000000..3daab86 --- /dev/null +++ b/src.lib/dpglib.RuleEndElem.pas @@ -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. diff --git a/src.lib/dpglib.RuleRefElem.pas b/src.lib/dpglib.RuleRefElem.pas new file mode 100644 index 0000000..7a3ea5d --- /dev/null +++ b/src.lib/dpglib.RuleRefElem.pas @@ -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. diff --git a/src.lib/dpglib.RuleSymbol.pas b/src.lib/dpglib.RuleSymbol.pas new file mode 100644 index 0000000..fceecc1 --- /dev/null +++ b/src.lib/dpglib.RuleSymbol.pas @@ -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 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. diff --git a/src.lib/dpglib.StringSymbol.pas b/src.lib/dpglib.StringSymbol.pas new file mode 100644 index 0000000..17ba46a --- /dev/null +++ b/src.lib/dpglib.StringSymbol.pas @@ -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. diff --git a/src.lib/dpglib.SynPredBlock.pas b/src.lib/dpglib.SynPredBlock.pas new file mode 100644 index 0000000..1e776f6 --- /dev/null +++ b/src.lib/dpglib.SynPredBlock.pas @@ -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. diff --git a/src.lib/dpglib.TokenLexer.pas b/src.lib/dpglib.TokenLexer.pas new file mode 100644 index 0000000..52bbeb9 --- /dev/null +++ b/src.lib/dpglib.TokenLexer.pas @@ -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. diff --git a/src.lib/dpglib.TokenLexerTokens.pas b/src.lib/dpglib.TokenLexerTokens.pas new file mode 100644 index 0000000..6f9d3d4 --- /dev/null +++ b/src.lib/dpglib.TokenLexerTokens.pas @@ -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. diff --git a/src.lib/dpglib.TokenManager.pas b/src.lib/dpglib.TokenManager.pas new file mode 100644 index 0000000..4fd1e0a --- /dev/null +++ b/src.lib/dpglib.TokenManager.pas @@ -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 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=0) and (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. + diff --git a/src.lib/dpglib.TokenParser.pas b/src.lib/dpglib.TokenParser.pas new file mode 100644 index 0000000..923c2e7 --- /dev/null +++ b/src.lib/dpglib.TokenParser.pas @@ -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. diff --git a/src.lib/dpglib.TokenParserTokens.pas b/src.lib/dpglib.TokenParserTokens.pas new file mode 100644 index 0000000..f2d8e11 --- /dev/null +++ b/src.lib/dpglib.TokenParserTokens.pas @@ -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. diff --git a/src.lib/dpglib.TokenRangeElem.pas b/src.lib/dpglib.TokenRangeElem.pas new file mode 100644 index 0000000..3308c63 --- /dev/null +++ b/src.lib/dpglib.TokenRangeElem.pas @@ -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. diff --git a/src.lib/dpglib.TokenRefElem.pas b/src.lib/dpglib.TokenRefElem.pas new file mode 100644 index 0000000..d88e418 --- /dev/null +++ b/src.lib/dpglib.TokenRefElem.pas @@ -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. diff --git a/src.lib/dpglib.TokenSymbol.pas b/src.lib/dpglib.TokenSymbol.pas new file mode 100644 index 0000000..8d62559 --- /dev/null +++ b/src.lib/dpglib.TokenSymbol.pas @@ -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. diff --git a/src.lib/dpglib.Tool.pas b/src.lib/dpglib.Tool.pas new file mode 100644 index 0000000..ba002fe --- /dev/null +++ b/src.lib/dpglib.Tool.pas @@ -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 + '' + + 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. diff --git a/src.lib/dpglib.TreeBlockContext.pas b/src.lib/dpglib.TreeBlockContext.pas new file mode 100644 index 0000000..d854e2b --- /dev/null +++ b/src.lib/dpglib.TreeBlockContext.pas @@ -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. diff --git a/src.lib/dpglib.TreeElem.pas b/src.lib/dpglib.TreeElem.pas new file mode 100644 index 0000000..945603e --- /dev/null +++ b/src.lib/dpglib.TreeElem.pas @@ -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. diff --git a/src.lib/dpglib.TreeParserGrammar.pas b/src.lib/dpglib.TreeParserGrammar.pas new file mode 100644 index 0000000..dc44733 --- /dev/null +++ b/src.lib/dpglib.TreeParserGrammar.pas @@ -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. diff --git a/src.lib/dpglib.Utils.pas b/src.lib/dpglib.Utils.pas new file mode 100644 index 0000000..cb1035d --- /dev/null +++ b/src.lib/dpglib.Utils.pas @@ -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. diff --git a/src.lib/dpglib.Version.pas b/src.lib/dpglib.Version.pas new file mode 100644 index 0000000..e593b9f --- /dev/null +++ b/src.lib/dpglib.Version.pas @@ -0,0 +1,9 @@ +unit dpglib.Version; + +interface +const + version: string = '2.1.0.0r'; + +implementation + +end. diff --git a/src.lib/dpglib.WildCardElem.pas b/src.lib/dpglib.WildCardElem.pas new file mode 100644 index 0000000..455199f --- /dev/null +++ b/src.lib/dpglib.WildCardElem.pas @@ -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. diff --git a/src.lib/dpglib.ZeroOrMoreBlock.pas b/src.lib/dpglib.ZeroOrMoreBlock.pas new file mode 100644 index 0000000..d05e1e8 --- /dev/null +++ b/src.lib/dpglib.ZeroOrMoreBlock.pas @@ -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. diff --git a/src.lib/dpglib.types.pas b/src.lib/dpglib.types.pas new file mode 100644 index 0000000..1ab6055 --- /dev/null +++ b/src.lib/dpglib.types.pas @@ -0,0 +1,1402 @@ +unit dpglib.types; + +interface +uses + System.Classes, + System.Contnrs, + Generics.Collections, + System.SysUtils, + dpgrtl.types, + dpgrtl.token; + + +const + NONDETERMINISTIC = MaxInt; + LOOKAHEAD_DEPTH_INIT = -1; + +type + IAlternative = interface; + IRuleBlock = interface; + IRuleRefElem = interface; + IExceptionSpec = interface; + ITool = interface; + ILookahead = interface; + + IGrammar = interface; + ILexerGrammar = interface; + ICodeGenerator = interface; + + TLookaheadArray = array of ILookahead; + EdpgNoViable = class( Exception) end; + + TTokenIdMap = TObjectDictionary; + + + // ========================================================================= + // IDelphiCharFormatter + // ========================================================================= + ICharFormatter = interface + ['{F8B49B48-29B9-4C5A-A9A1-7600C683F44D}'] + + function EscapeChar( pChar : integer; + pForCharLiteral : boolean) : AnsiString; + function EscapeString( pString : AnsiString) : AnsiString; + function LiteralChar( pChar : integer) : AnsiString; + function LiteralString( pString : AnsiString) : AnsiString; + end; + + // ========================================================================= + // IGrammarSymbol + // ========================================================================= + IGrammarSymbol = interface + ['{C78B6BF5-4E55-4E7D-8CAB-11AAF3DE1CBD}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetID: AnsiString; + procedure SetID( pID: AnsiString); + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property ID: AnsiString read GetID write SetID; + end; + + // ========================================================================= + // ITokenSymbol + // ========================================================================= + ITokenSymbol = interface( IGrammarSymbol) + ['{68D34FAC-810F-460D-ACB7-AB52F4A5BFC8}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetTokenType : integer; + function GetParaphrase : AnsiString; + function GetASTNodeType : AnsiString; + + procedure SetTokenType( pTokenType : integer); + procedure SetParaphrase( pParaphrase : AnsiString); + procedure SetASTNodeType( pASTNodeType : AnsiString); + + // ------------------------------------------------------------ + // Methods + // ------------------------------------------------------------ + function Clone : ITokenSymbol; + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property TokenType : integer read GetTokenType write SetTokenType; + property Paraphrase : AnsiString read GetParaphrase write SetParaphrase; + property ASTNodeType : AnsiString read GetASTNodeType write SetASTNodeType; + end; + + // ========================================================================= + // IStringSymbol + // ========================================================================= + IStringSymbol = interface( ITokenSymbol) + ['{8C7FDC02-1C10-4178-880A-0CC2BF04A658}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetLabel: AnsiString; + procedure SetLabel( pLabel: AnsiString); + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property Lbl : AnsiString read GetLabel write SetLabel; + end; + + // ========================================================================= + // IRuleSymbol + // ========================================================================= + IRuleSymbol = interface( IGrammarSymbol) + ['{B9E4397C-8245-4F8E-9EA3-CEAA3ABA7C9C}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + 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); + + // ------------------------------------------------------------ + // Methods + // ------------------------------------------------------------ + procedure AddReference( pReference : IRuleRefElem); + function ReferenceCount: integer; + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property Block : IRuleBlock read GetBlock write SetBlock; + property Defined : boolean read GetDefined write SetDefined; + property Access : AnsiString read GetAccess write SetAccess; + property Comment : AnsiString read GetComment write SetComment; + property References : TInterfaceList read GetReferences; + + // ------------------------------------------------------------ + // Property arrays + // ------------------------------------------------------------ + property Reference[i: integer]: IRuleRefElem read GetReference; + end; + + // ========================================================================= + // ITokenManager + // ========================================================================= + ITokenManager = interface + ['{44F4CE9E-6465-4F37-B64C-91A96C6FCFB6}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + 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( pName : AnsiString) : ITokenSymbol; + function GetTokenDefined( pName : AnsiString) : boolean; + + procedure SetName( Name : AnsiString); + procedure SetReadOnly( ReadOnly : boolean); + procedure SetMaxTokenType( TokenType : byte); + + // ------------------------------------------------------------ + // Methods + // ------------------------------------------------------------ + function Clone : ITokenManager; + + function TokenSymbolKeys : TStringList; + function TokenSymbolElems : TInterfaceList; + + procedure MapToTokenSymbol( pName : AnsiString; pTS: ITokenSymbol); + procedure Define( pTS: ITokenSymbol); + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property ReadOnly : boolean read GetReadOnly write SetReadOnly; + property Name : AnsiString read GetName write SetName; + property MaxTokenType : byte read GetMaxTokenType write SetMaxTokenType; + property NextTokenType : byte read GetNextTokenType; + property Vocabulary : TTokenIdMap read GetVocabulary; + + // ------------------------------------------------------------ + // Property arrays + // ------------------------------------------------------------ + property TokenStringAt [i: integer] : AnsiString read GetTokenStringAt; + property TokenSymbolAt [i: integer] : ITokenSymbol read GetTokenSymbolAt; + property TokenSymbol [s: AnsiString] : ITokenSymbol read GetTokenSymbol; + property TokenSymbolByType [i: integer] : ITokenSymbol read GetTokenSymbolByType; + property TokenDefined [s: AnsiString] : boolean read GetTokenDefined; + end; + + // ========================================================================= + // ILookahead + // ========================================================================= + ILookahead = interface + ['{CCC4893F-321A-400A-BFA2-4945ECE26985}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + 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); + + // ------------------------------------------------------------ + // Methods + // ------------------------------------------------------------ + function Intersection( LA : ILookahead) : ILookahead; + + procedure CombineWith( LA : ILookahead); overload; + procedure CombineWith( LA : TByteSet); overload; + + function IsNil: boolean; + function Clone: ILookahead; + function AsString( TM: ITokenManager=nil) : AnsiString; + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property LaSet : TByteSet read GetLaSet write SetLaSet; + property Epsilon : TByteSet read GetEpsilon write SetEpsilon; + property HasEpsilon : boolean read GetHasEpsilon write SetHasEpsilon; + property Cycle : AnsiString read GetCycle write SetCycle; + end; + + // ========================================================================= + // IGrammarElem + // ========================================================================= + IGrammarElem = interface + ['{610659C4-9CA1-4E5F-B9BF-EFAB36E193B6}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetLine : integer; + function GetColumn : integer; + + procedure SetLine( pLine : integer); + procedure SetColumn( pColumn : integer); + + // ------------------------------------------------------------ + // Methods + // ------------------------------------------------------------ + procedure Generate; + function Look( pK: integer): ILookahead; + function AsString : AnsiString; + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property Line : integer read GetLine write SetLine; + property Column : integer read GetColumn write SetColumn; + end; + + // ========================================================================= + // IAlternativeElem + // ========================================================================= + IAlternativeElem = interface( IGrammarElem) + ['{A4223F57-F869-4BBA-951B-71CC7A3B4423}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetAutoGenType : integer; + function GetLabel : AnsiString; + function GetEnclosingRule : AnsiString; + function GetNext : IAlternativeElem; + + procedure SetLabel( Lbl : AnsiString); + procedure SetEnclosingRule( Rule : AnsiString); + procedure SetNext( Next : IAlternativeElem); + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property AutoGenType : integer read GetAutoGenType; + + property Lbl : AnsiString read GetLabel + write SetLabel; + + property Next : IAlternativeElem read GetNext + write SetNext; + + property EnclosingRule: AnsiString read GetEnclosingRule + write SetEnclosingRule; + end; + + // ========================================================================= + // IAlternativeBlock + // ========================================================================= + IAlternativeBlock = interface( IAlternativeElem) + ['{64EB220E-B7AA-407C-8AB9-0AFD7631705C}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + 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 GetAnalyzisAlt : integer; + function GetAltI : integer; + function GetAltJ : integer; + + function GetAlternatives : TInterfaceList; + function GetAlternative( i: integer) : IAlternative; + + procedure SetInitAction( pAction : AnsiString); + procedure SetAutoGen( pAutoGen : boolean); + procedure SetNot( pNot : boolean); + procedure SetHasASynPred( pSynPred : boolean); + procedure SetHasAnAction( pAction : boolean); + procedure SetWarnFollowAmbig( pWarn : boolean); + procedure SetGenAmbigWarnings(pGen : boolean); + procedure SetGreedy( pGreedy : boolean); + procedure SetGreedySet( pGreedySet : boolean); + procedure SetAnalyzisAlt( pAlt : integer); + procedure SetAltI( pAltI : integer); + procedure SetAltJ( pAltJ : integer); + + procedure SetAlternatives( pAlts : TInterfaceList); + + // ------------------------------------------------------------ + // Methods + // ------------------------------------------------------------ + procedure AddAlternative( pAlt: IAlternative); + procedure SetOption( pKey: IToken; pValue: IToken); + procedure PrepareForAnalysis; + procedure RemoveTracking( pGrammar: IGrammar); + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property InitAction : AnsiString read GetInitAction + write SetInitAction; + property AutoGen : boolean read GetAutoGen + write SetAutoGen; + property Alternatives : TInterfaceList read GetAlternatives + write SetAlternatives; + property IsNot : boolean read GetNot + write SetNot; + property HasASynPred : boolean read GetHasASynPred + write SetHasASynPred; + property HasAnAction : boolean read GetHasAnAction + write SetHasAnAction; + property WarnFollowAmbig: boolean read GetWarnFollowAmbig + write SetWarnFollowAmbig; + property GenAmbigWarnings:boolean read GetGenAmbigWarnings + write SetGenAmbigWarnings; + property Greedy : boolean read GetGreedy + write SetGreedy; + property GreedySet : boolean read GetGreedySet + write SetGreedySet; + property AnalyzisAlt : integer read GetAnalyzisAlt + write SetAnalyzisAlt; + property AltI : integer read GetAltI + write SetAltI; + property AltJ : integer read GetAltJ + write SetAltJ; + property ID : integer read GetID; + + // ------------------------------------------------------------ + // Properties arrays + // ------------------------------------------------------------ + property Alternative[ i: integer]: IAlternative read GetAlternative; + end; + + // ========================================================================= + // IActionElem + // ========================================================================= + IActionElem = interface( IAlternativeElem) + ['{64BA1E8B-4A55-4B30-9B3E-BC1A67B56FC0}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetActionText : AnsiString; + function GetSemPred : boolean; + + procedure SetSempred( pSemPred: boolean); + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property ActionText : AnsiString read GetActionText; + property IsSemPred : boolean read GetSemPred + write SetSempred; + end; + + // ========================================================================= + // IBlockEndElem + // ========================================================================= + IBlockEndElem = interface( IAlternativeElem) + ['{0604D7BD-BB3B-4D55-AC2A-4B94A38411F5}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetBlock: IAlternativeBlock; + function GetLock( i: integer): boolean; + + procedure SetBlock( pBlock: IAlternativeBlock); + procedure SetLock( i: integer; pLock: boolean); + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property Block : IAlternativeBlock read GetBlock write SetBlock; + property Lock[i: integer] : boolean read GetLock write SetLock; + end; + + // ========================================================================= + // IRuleEndElem + // ========================================================================= + IRuleEndElem = interface( IBlockEndElem) + ['{75E2BBD5-DD35-4213-9754-E918A2FE019D}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetnoFOLLOW: boolean; + function GetCache(i: integer): ILookahead; + + procedure SetnoFOLLOW( pnoFOLLOW: boolean); + procedure SetCache(i:integer; pCache : ILookahead); + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property noFOLLOW: boolean read GetnoFOLLOW write SetnoFOLLOW; + property Cache[i:integer]: ILookahead read GetCache write SetCache; + end; + + // ========================================================================= + // IRuleRefElem + // ========================================================================= + IRuleRefElem = interface( IAlternativeElem) + ['{442F7CB0-E5B6-49A8-9323-3240F6D433DA}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetTargetRule : AnsiString; + function GetIdAssign : AnsiString; + function GetArgs : AnsiString; + + procedure SetTargetRule( pTargetRule : AnsiString); + procedure SetIdAssign( pIdAssign : AnsiString); + procedure SetArgs( pArgs : AnsiString); + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property TargetRule : AnsiString read GetTargetRule write SetTargetRule; + property IdAssign : AnsiString read GetIdAssign write SetIdAssign; + property Args : AnsiString read GetArgs write SetArgs; + end; + + // ========================================================================= + // ICharRangeElem + // ========================================================================= + ICharRangeElem = interface( IAlternativeElem) + ['{B9EF3E2A-3605-4F84-899F-6205BA8AC3CE}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetBeginChar : ansichar; + function GetEndChar : ansichar; + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property BeginChar : ansichar read GetBeginChar; + property EndChar : ansichar read GetEndChar; + end; + + // ========================================================================= + // ITokenRangeElem + // ========================================================================= + ITokenRangeElem = interface( IAlternativeElem) + ['{E13E3468-4A4E-4EE1-B904-6A350659FC6D}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetBeginToken : integer; + function GetEndToken : integer; + function GetBeginText : AnsiString; + function GetEndText : AnsiString; + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property BeginToken : integer read GetBeginToken; + property EndToken : integer read GetEndToken; + property BeginText : AnsiString read GetBeginText; + property EndText : AnsiString read GetEndText; + end; + + // ========================================================================= + // IGrammarAtom + // ========================================================================= + IGrammarAtom = interface( IAlternativeElem) + ['{6C0D8223-1397-445C-8A29-B4342646AE9C}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetAtomText : AnsiString; + function GetASTNodeType: AnsiString; + function GetTokenType : integer; + function GetIsNot : boolean; + + procedure SetASTNodeType( pASTNodeType : AnsiString); + + // ------------------------------------------------------------ + // Methods + // ------------------------------------------------------------ + procedure SetOption( pKey: IToken; pValue: IToken); + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property AtomText : AnsiString read GetAtomText; + property TokenType : integer read GetTokenType; + property IsNot : boolean read GetIsNot; + property ASTNodeType : AnsiString read GetASTNodeType + write SetASTNodeType; + end; + + // ========================================================================= + // ICharLiteralElem + // ========================================================================= + ICharLiteralElem = interface( IGrammarAtom) + ['{48DAC974-AAAB-4414-B082-975E92764766}'] + end; + + // ========================================================================= + // IStringLiteralElem + // ========================================================================= + IStringLiteralElem = interface( IGrammarAtom) + ['{BBB9C32B-6C7A-4C5F-A9A0-68144DE0D972}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetProcessedAtomText: AnsiString; + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property ProcessedAtomText: AnsiString read GetProcessedAtomText; + end; + + // ========================================================================= + // ITokenRefElem + // ========================================================================= + ITokenRefElem = interface( IGrammarAtom) + ['{A1C07916-8D97-4303-A6BC-0F0DA89FA978}'] + end; + + // ========================================================================= + // IWildcardElem + // ========================================================================= + IWildcardElem = interface( IGrammarAtom) + ['{BF7795F2-3B59-4FAF-9B49-E69EBF612D5B}'] + end; + + // ========================================================================= + // IRuleBlock + // ========================================================================= + IRuleBlock = interface( IAlternativeBlock) + ['{39336114-1512-4BD2-872B-C916755331AB}'] + + function GetRuleName : AnsiString; + function GetArguments : AnsiString; + function GetReturnAction : AnsiString; + function GetLocals : AnsiString; + function GetEndNode : IRuleEndElem; + + function GetTestLiterals : boolean; + function GetLabeledElems : TInterfaceList; + + function GetIgnoreRule : AnsiString; + function GetExHandlerType : AnsiString; + function GetExHandlerCode : AnsiString; + + function GetDefErrorHandler : boolean; + 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 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); + + procedure SetOption( pKey, pValue : IToken); + function IsLexerAutoGenRule: boolean; +// function FindExceptionSpec( pLabel : string): IExceptionSpec; + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property RuleName : AnsiString read GetRuleName + write SetRuleName; + property LabeledElems : TInterfaceList read GetLabeledElems + write SetLabeledElems; + + property DefaultErrorHandler : boolean read GetDefErrorHandler + write SetDefErrorHandler; + property EndElem : IRuleEndElem read GetEndNode + write SetEndNode; + + property Arguments : AnsiString read GetArguments + write SetArguments; + + property IgnoreRule : AnsiString read GetIgnoreRule + write SetIgnoreRule; + property ReturnAction: AnsiString read GetReturnAction + write SetReturnAction; + property Locals : AnsiString read GetLocals + write SetLocals; + property TestLiterals: boolean read GetTestLiterals + write SetTestLiterals; + + property OneOrMoreBlocks: TInterfaceList read GetOneOrMoreBlocks; + property NMBlocks : TInterfaceList read GetNMBlocks; + property SynPredBlocks : TInterfaceList read GetSynPredBlocks; + + property ExHandlerType : AnsiString read GetExHandlerType + write SetExHandlerType; + property ExHandlerCode : AnsiString read GetExHandlerCode + write SetExHandlerCode; + + // ------------------------------------------------------------ + // Property arrays + // ------------------------------------------------------------ + property Lock[ i: integer]: boolean read GetLock + write SetLock; + + property Cache[i: integer]: ILookahead read GetCache + write SetCache; + end; + + // ========================================================================= + // ISynPredBlock + // ========================================================================= + ISynPredBlock = interface( IAlternativeBlock) + ['{5E6EF230-0B1B-4A20-95C7-EFE8D9A710CB}'] + end; + + // ========================================================================= + // ITreeElem + // ========================================================================= + ITreeElem = interface( IAlternativeBlock) + ['{E522A79A-3825-4346-A449-4588D4858D5B}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetRoot: IGrammarAtom; + procedure SetRoot( pRoot: IGrammarAtom); + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property Root: IGrammarAtom read GetRoot write SetRoot; + end; + + // ========================================================================= + // IBlockWithImpliedExitPath + // ========================================================================= + IBlockWithImpliedExitPath = interface( IAlternativeBlock) + ['{1D4DAE7A-230E-4699-ADB1-5872665A7B90}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetExitDepth: integer; + function GetExitCache( i: integer) : ILookahead; + + procedure SetExitDepth( pDepth: integer); + procedure SetExitCache( i: integer; pExitCache: ILookahead); + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property ExitCache[i:integer]: ILookahead read GetExitCache + write SetExitCache; + property ExitDepth: integer read GetExitDepth + write SetExitDepth; + end; + + // ========================================================================= + // IZeroOrMoreBlock + // ========================================================================= + IZeroOrMoreBlock = interface( IBlockWithImpliedExitPath) + ['{BED0D2F1-FF2F-47C5-846A-DBCE97551C3F}'] + end; + + // ========================================================================= + // IOneOrMoreBlock + // ========================================================================= + IOneOrMoreBlock = interface( IBlockWithImpliedExitPath) + ['{0BD0A437-3376-42EA-BA77-8FF0E49EEC65}'] + end; + + // ========================================================================= + // INMBlock + // ========================================================================= + INMBlock = interface( IBlockWithImpliedExitPath) + ['{0BD0A437-3376-42EA-BA77-8FF0E49EEC65}'] + function GetLow : integer; + function GetHigh : integer; + + procedure SetLow( Value: integer); + procedure SetHigh(Value: integer); + + property Low : integer read GetLow write SetLow; + property High : integer read GetHigh write SetHigh; + end; + + + // ========================================================================= + // IExceptionHandler + // ========================================================================= + IExceptionHandler = interface + ['{B7AC1616-FE56-461F-8E92-A8666A077D55}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetTypeAndName : IToken; + function GetAction : IToken; + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property TypeAndName : IToken read GetTypeAndName; + property Action : IToken read GetAction; + end; + + // ========================================================================= + // IExceptionSpec + // ========================================================================= + IExceptionSpec = interface + ['{D83D6221-E5DE-432C-BDCE-1E9EDAF72FDE}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetLabel : IToken; + function GetHandlers: TInterfaceList; + + // ------------------------------------------------------------ + // Methods + // ------------------------------------------------------------ + procedure AddHandler( pHandler: IExceptionHandler); + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property Lbl : IToken read GetLabel; + property Handlers : TInterfaceList read GetHandlers; + end; + + // ========================================================================= + // IAlternative + // ========================================================================= + IAlternative = interface + ['{54C18FB4-CD6D-483C-A03B-0D0F467D9A90}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetHead : IAlternativeElem; + function GetTail : IAlternativeElem; + function GetSynPredBlock : ISynPredBlock; + function GetSemPred : AnsiString; + + function GetCacheSize : integer; + function GetLookaheadDepth : integer; + function GetTreeSpecifier : IToken; + function GetDoAutoGen : boolean; + + function GetExHandlerType : AnsiString; + function GetExHandlerCode : AnsiString; + + procedure SetHead( pHead : IAlternativeElem); + procedure SetTail( pTail : IAlternativeElem); + + procedure SetSynPredBlock( pBlock : ISynPredBlock); + procedure SetSemPred( pSemPred : AnsiString); + + procedure SetCacheSize( pSize : integer); + procedure SetLookaheadDepth( pDepth : integer); + procedure SetTreeSpecifier( pTreeSpecifier : IToken); + procedure SetDoAutoGen( pDoAutoGen : boolean); + + procedure SetExHandlerType( pType : AnsiString); + procedure SetExHandlerCode( pCode : AnsiString); + + function GetCache( i:integer): ILookahead; + procedure SetCache( i: integer; pLookahead: ILookahead); + + // ------------------------------------------------------------ + // Methods + // ------------------------------------------------------------ + procedure AddElem( pElem: IAlternativeElem); + function AtStart: boolean; + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property Head : IAlternativeElem read GetHead + write SetHead; + property Tail : IAlternativeElem read GetTail + write SetTail; + property SynPred : ISynPredBlock read GetSynPredBlock + write SetSynPredBlock; + property SemPred : AnsiString read GetSemPred + write SetSemPred; + + property ExHandlerType : AnsiString read GetExHandlerType + write SetExHandlerType; + + property ExHandlerCode : AnsiString read GetExHandlerCode + write SetExHandlerCode; + + property CacheSize : integer read GetCacheSize + write SetCacheSize; + property LookaheadDepth : integer read GetLookaheadDepth + write SetLookaheadDepth; + property TreeSpecifier : IToken read GetTreeSpecifier + write SetTreeSpecifier; + property DoAutoGen : boolean read GetDoAutoGen + write SetDoAutoGen; + property Cache[i: integer]: ILookahead read GetCache + write SetCache; + end; + + // ========================================================================= + // IBlockContext + // ========================================================================= + IBlockContext = interface + ['{97FD1C1E-8443-4B28-9B04-5E90CD99055C}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetBlock : IAlternativeBlock; + function GetBlockEnd : IBlockEndElem; + function GetAltNum : integer; + + procedure SetBlock( pBlock : IAlternativeBlock); + procedure SetBlockEnd( pBlockEnd : IBlockEndElem); + procedure SetAltNum( pAltNum : integer); + + // ------------------------------------------------------------ + // Methods + // ------------------------------------------------------------ + procedure AddAlternativeElem( pElem: IAlternativeElem); + function CurrentAlt : IAlternative; + function CurrentElem : IAlternativeElem; + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property Block : IAlternativeBlock read GetBlock write SetBlock; + property BlockEnd : IBlockEndElem read GetBlockEnd write SetBlockEnd; + property AltNum : integer read GetAltNum write SetAltNum; + end; + + // ========================================================================= + // ITreeBlockContext + // ========================================================================= + ITreeBlockContext = interface( IBlockContext) + ['{04963303-C0B7-487D-9D24-6E5C56337EE3}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ +// function GetNextElemIsRoot: boolean; +// procedure SetNextElemIsRoot( pRoot: boolean); +// +// property NextElemIsRoot: boolean read GetNextElemIsRoot +// write SetNextElemIsRoot; + end; + + // ========================================================================= + // ICodeGenerator + // ========================================================================= + ICodeGenerator = interface + procedure Gen(pGrammar: IGrammar); overload; +// procedure Gen(pGrammar: ILexerGrammar); overload; + procedure Gen(pElem : IActionElem); overload; + procedure Gen(pElem : IAlternativeBlock); overload; + procedure Gen(pElem : IBlockEndElem); overload; + procedure Gen(pElem : ICharLiteralElem); overload; + procedure Gen(pElem : ICharRangeElem); overload; + procedure Gen(pElem : IGrammarAtom); overload; + procedure Gen(pElem : IOneOrMoreBlock); overload; + procedure Gen(pElem : INMBlock); overload; + procedure Gen(pElem : IRuleBlock); overload; + procedure Gen(pElem : IRuleEndElem); overload; + procedure Gen(pElem : IRuleRefElem); overload; + procedure Gen(pElem : IStringLiteralElem); overload; + procedure Gen(pElem : ISynPredBlock); overload; + procedure Gen(pElem : ITokenRangeElem); overload; + procedure Gen(pElem : ITreeElem); overload; + procedure Gen(pElem : IWildCardElem); overload; + procedure Gen(pElem : IZeroOrMoreBlock); overload; + end; + + // ========================================================================= + // IGrammarAnalyzer + // ========================================================================= + IGrammarAnalyzer = interface + ['{7690F384-E2A3-477F-93A7-E4FDE800582A}'] + end; + + // ========================================================================= + // ILLkAnalyzer + // ========================================================================= + ILLkAnalyzer = interface( IGrammarAnalyzer) + ['{719F8B79-C3D3-436E-941A-AEF12E6D5477}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + procedure SetGrammar( pGrammar: IGrammar); + + // ------------------------------------------------------------ + // Methods + // ------------------------------------------------------------ + function Deterministic( pBlk: IAlternativeBlock): boolean; overload; + function Deterministic( pBlk: IOneOrMoreBlock) : boolean; overload; + function Deterministic( pBlk: IZeroOrMoreBlock) : boolean; overload; + + function Look( k: integer; pElem: IActionElem) : ILookahead; overload; + function Look( k: integer; pElem: IAlternativeBlock) : ILookahead; overload; + function Look( k: integer; pElem: IBlockEndElem) : ILookahead; overload; + function Look( k: integer; pElem: ICharLiteralElem) : ILookahead; overload; + function Look( k: integer; pElem: ICharRangeElem) : ILookahead; overload; + function Look( k: integer; pElem: IGrammarAtom) : ILookahead; overload; + function Look( k: integer; pElem: IOneOrMoreBlock) : ILookahead; overload; + function Look( k: integer; pElem: IRuleBlock) : ILookahead; overload; + function Look( k: integer; pElem: IRuleEndElem) : ILookahead; overload; + function Look( k: integer; pElem: IRuleRefElem) : ILookahead; overload; + function Look( k: integer; pElem: IStringLiteralElem) : ILookahead; overload; + function Look( k: integer; pElem: ISynPredBlock) : ILookahead; overload; + function Look( k: integer; pElem: ITokenRangeElem) : ILookahead; overload; + function Look( k: integer; pElem: ITreeElem) : ILookahead; overload; + function Look( k: integer; pElem: IWildCardElem) : ILookahead; overload; + function Look( k: integer; pElem: IZeroOrMoreBlock) : ILookahead; overload; + function Look( k: integer; pElem: AnsiString) : ILookahead; overload; + + function FOLLOW( k: integer; pElem: IRuleEndElem) : ILookahead; + + function SubRuleCanBeInverted( pBlock : IAlternativeBlock; + pIsLexer : boolean): boolean; + + property Grammar : IGrammar write SetGrammar; + end; + + // ========================================================================= + // IToolErrorHandler interface + // ========================================================================= + IToolErrorHandler = interface + procedure Warning( pMessage: string; FileName:string=''; Line:integer=0; Column:integer=0); + procedure Error( pMessage: string; FileName:string=''; Line:integer=0; Column:integer=0); + procedure Panic( pMessage: string; FileName:string=''; Line:integer=0; Column:integer=0); + end; + + // ========================================================================= + // ITool + // ========================================================================= + ITool = interface + ['{6925CCC7-A72C-4731-9172-D762BFA668E4}'] + + // ------------------------------------------------------------ + // property handling + // ------------------------------------------------------------ + function GetWarningCount : integer; + function GetErrorCount : integer; + + // ------------------------------------------------------------ + // Methods + // ------------------------------------------------------------ + procedure Go; + + // ------------------------------------------------------------ + // Debug methods + // ------------------------------------------------------------ + procedure Debug( pMessage : AnsiString); + + // ------------------------------------------------------------ + // Standard diagnostic methods + // ------------------------------------------------------------ + 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); + + // ------------------------------------------------------------ + // Special diagnostic methods + // ------------------------------------------------------------ + 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); + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property WarningCount : integer read GetWarningCount; + property ErrorCount : integer read GetErrorCount; + end; + + // ------------------------------------------------------------------------- + // IGrammar interface + // ------------------------------------------------------------------------- + IGrammar = interface + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetTool : ITool; + function GetCodeGenerator : ICodeGenerator; + function GetAnalyzer : ILLkAnalyzer; + function GetTokenManager : ITokenManager; + + function GetGrammarName : AnsiString; + function GetFileName : AnsiString; + function GetUnitName : AnsiString; + function GetGrammarFile : AnsiString; + + function GetImportVocab : IToken; + function GetExportVocab : AnsiString; + + function GetDefErrorHandler: boolean; + function GetHasSynPred : boolean; + function GetMemberAction : IToken; + function GetMemberDecl : AnsiString; + function GetMemberDef : AnsiString; + function GetCharVocabulary: TByteSet; + function GetSymbol( pRule: AnsiString): ITokenSymbol; + function GetRules : TInterfaceList; + function GetUsesList : TStringList; + function GetUsesList2 : TStringList; + function GetConstAction : IToken; + function GetTypeAction : IToken; + + function GetMaxK : integer; + + procedure SetAnalyzer( pAnalyzer: ILLkAnalyzer); + procedure SetUnitName( pUnit : AnsiString); + procedure SetImportVocab( pVocab : IToken); + procedure SetExportVocab( pVocab : AnsiString); + procedure SetDefErrorHandler( pHandler : boolean); + procedure SetHasSynPred( pSynPred : boolean); + procedure SetMemberAction( pAction : IToken); + procedure SetMemberDecl( pDecl : AnsiString); + procedure SetMemberDef( pDef : AnsiString); + procedure SetCharVocabulary( pVocab : TByteSet); + procedure SetCodeGenerator( pGenerator : ICodeGenerator); + procedure SetConstAction( pConst : IToken); + procedure SetTypeAction( pType : IToken); + procedure SetGrammarFile( pFile : AnsiString); + + + // ------------------------------------------------------------ + // Methods + // ------------------------------------------------------------ + procedure Generate; + function GetClassName: AnsiString; + function Defined( pID: AnsiString): boolean; + procedure Define( pSymbol: IRuleSymbol); + function SetOption( pOption, pValue: IToken): boolean; + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property LLkAnalyzer : ILLkAnalyzer read GetAnalyzer write SetAnalyzer; + property Generator : ICodeGenerator read GetCodeGenerator + write SetCodeGenerator; + property MaxK: integer read GetMaxK; + property Tool : ITool read GetTool; + property FileName : AnsiString read GetFileName; + property TokenManager: ITokenManager read GetTokenManager; + property Symbol[s: AnsiString]: ITokenSymbol read GetSymbol; + property HasSynPred : boolean read GetHasSynPred + write SetHasSynPred; + + property ImportVocab: IToken write SetImportVocab; + + property ExportVocab: AnsiString read GetExportVocab + write SetExportVocab; + + property DefaultErrorHandler : boolean read GetDefErrorHandler + write SetDefErrorHandler; + property MemberAction : IToken read GetMemberAction + write SetMemberAction; + property CharVocabulary: TByteSet read GetCharVocabulary + write SetCharVocabulary; + + property GrammarName : AnsiString read GetGrammarName; + property UnitName : AnsiString read GetUnitName + write SetUnitName; + + property Rules : TInterfaceList read GetRules; + property UsesList : TStringList read GetUsesList; + property UsesList2 : TStringList read GetUsesList2; + + property MemberDecl : AnsiString read GetMemberDecl + write SetMemberDecl; + property MemberDef : AnsiString read GetMemberDef + write SetMemberDef; + +// property ImportVocabulary: string read GetImportVocab +// write SetImportVocab; +// property ExportVocabulary: string read GetExportVocab +// write SetExportVocab; + property ConstAction: IToken read GetConstAction + write SetConstAction; + property TypeAction: IToken read GetTypeAction + write SetTypeAction; + property GrammarFile: AnsiString read GetGrammarFile + write SetGrammarFile; + end; + + // ========================================================================= + // ILexerGrammar interface + // ========================================================================= + ILexerGrammar = interface( IGrammar) + ['{99C98AC7-5808-4B46-A353-58C95AFFDF6A}'] + + // ------------------------------------------------------------ + // Property handling + // ------------------------------------------------------------ + function GetTestLiterals : boolean; + function GetCaseSensitive : boolean; + function GetFilterMode : boolean; + function GetFilterRule : AnsiString; + + // ------------------------------------------------------------ + // Properties + // ------------------------------------------------------------ + property TestLiterals : boolean read GetTestLiterals; + property CaseSensitive : boolean read GetCaseSensitive; + property FilterMode : boolean read GetFilterMode; + property FilterRule : AnsiString read GetFilterRule; + end; + + // ------------------------------------------------------------------------- + // IParserGrammar interface + // ------------------------------------------------------------------------- + IParserGrammar = interface( IGrammar) + ['{BD8E9F0F-0FDE-448D-95B8-27CD15408BD0}'] + + function GetBuildAST: boolean; + procedure SetBuildAST( Value: boolean); + + property BuildAST : boolean read GetBuildAST write SetBuildAST; + end; + + // ------------------------------------------------------------------------- + // ITreeWalkerGrammar interface + // ------------------------------------------------------------------------- + ITreeWalkerGrammar = interface( IGrammar) + ['{BD09EF54-5842-4CA0-ACE7-12ACA18EF0AF}'] + end; + + // ========================================================================= + // IGrammarBehavior + // ========================================================================= + IGrammarBehavior = interface + ['{1D8177D4-CDB4-44AF-915E-2388FF389A69}'] + + function Grammar: IGrammar; + + procedure AbortGrammar; + + procedure BeginAlt( pDoAST: boolean); + procedure BeginExceptionGroup; + procedure BeginExceptionSpec( pLabel : IToken); + procedure BeginSubRule( pLabel : IToken; + pStart : IToken; + pNot : boolean); + + procedure BeginTree( pStart : IToken); + procedure BeginChildList; + + procedure DefineGrammarUnit( pUnit : AnsiString); + procedure DefineRuleName( pRule : IToken; + pAccess : AnsiString; + pRuleAST : boolean; + pDocComment : AnsiString); + + procedure DefineToken( pTokenName : IToken; + pTokenLiteral : IToken); + + procedure DefineUses( pUses : AnsiString); + + procedure EndAlt; + procedure EndExceptionGroup; + procedure EndExceptionSpec; + procedure EndGrammar; + procedure EndOptions; + procedure EndRule( pRuleName : AnsiString); + procedure EndSubRule; + procedure EndTree; + procedure EndChildList; + + procedure HasError; + + procedure NoASTSubRule; + procedure OneOrMoreSubRule; + procedure NMSubrule; + procedure OptionalSubRule; + + procedure refRangeLow( M : integer); + procedure refRangeHigh( N : integer); + + + procedure RefAction( pAction : IToken); + procedure RefArgAction( pAction : IToken); + + procedure RefCharLiteral( pLiteral : IToken; + pLabel : IToken; + pInverted : boolean; + pAutoGenType : integer; + pLastInRule : boolean); + + procedure RefCharRange( pToken1 : IToken; + pToken2 : IToken; + pLabel : IToken; + pAutoGenType : integer; + pLastInRule : boolean); + + procedure RefConstAction( pConstAction : IToken); + procedure RefTypeAction( pTypeAction : IToken); + + procedure RefElemOption( pOption : IToken; + pValue : IToken); + + procedure RefTokenSpecElemOption( pToken : IToken; + pOption : IToken; + pValue : IToken); + + procedure RefExceptionHandler( pTypeAndName : IToken; + pAction : IToken); + + procedure RefInitAction( pAction : IToken); + procedure RefRuleLocals( pLocals : IToken); + procedure RefMemberDecl( pDecl : IToken); + procedure RefMemberDef( pDef : IToken); + procedure RefReturnAction( pAction : IToken); + + procedure RefRule( pAssignId : IToken; + pRuleName : IToken; + pLabel : IToken; + pArguments : IToken; + pAutoGenType : integer); + + procedure RefRuleExHandler( pExHandlerType : IToken; + pExHandlerCode : IToken); + + procedure RefAltExHandler( pExHandlerType : IToken; + pExHandlerCode : IToken); + + procedure RefSemPred( pSemPred : IToken); + + procedure RefStringLiteral( pLiteral : IToken; + pLabel : IToken; + pAutoGenType : integer; + pLastInRule : boolean); + + procedure RefToken( pAssignId : IToken; + pToken : IToken; + pLabel : IToken; + pArguments : IToken; + pInverted : boolean; + pAutoGenType : integer; + pLAstInRule : boolean); + + procedure RefTokenRange( pToken1 : IToken; + pToken2 : IToken; + pLabel : IToken; + pAutoGenType : integer; + pLastInRule : boolean); + + procedure RefWildCard( pToken : IToken; + pLabel : IToken; + pAutoGenType : integer); + + procedure Reset; + + procedure SetArgOfRuleRef( pArguments : IToken); + procedure SetCharVocabulary( pVocabulary : TByteSet); + + procedure SetFileOption( pOption : IToken; + pValue : IToken; + pFileName : AnsiString); + + procedure SetGrammarOption( pOption : IToken; + pValue : IToken); + + procedure SetRuleOption( pOption : IToken; + pValue : IToken); + + procedure SetSubRuleOption( pOption : IToken; + pValue : IToken); + + procedure SetUserExceptions( pException : AnsiString); + + procedure StartLexer( pFileName : AnsiString; + pLexerName : IToken; + pSuperClass : IToken); + + procedure StartParser( pFileName : AnsiString; + pLexerName : IToken; + pSuperClass : IToken); + + + procedure StartTreeWalker( pFileName : AnsiString; + pLexerName : IToken; + pSuperClass : IToken); + + procedure SynPred; + procedure ZeroOrMoreSubRule; + end; + + + +implementation + +end. + diff --git a/src.lib/grammar/dpglib.DpgLexer.g b/src.lib/grammar/dpglib.DpgLexer.g new file mode 100644 index 0000000..632de53 --- /dev/null +++ b/src.lib/grammar/dpglib.DpgLexer.g @@ -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)); + } + ) + ; + diff --git a/src.lib/grammar/dpglib.DpgLexer.pas b/src.lib/grammar/dpglib.DpgLexer.pas new file mode 100644 index 0000000..e1fd4c8 --- /dev/null +++ b/src.lib/grammar/dpglib.DpgLexer.pas @@ -0,0 +1,1879 @@ +// ============================================================================ +// This file is generated by the Delphi Parser Generator. +// ---------------------------------------------------------------------------- +// DPG version: 2.1.0.0r +// Grammar: dpglib.dpgLexer.g +// ============================================================================ +unit dpglib.DpgLexer; + +interface + +uses + System.Classes, + dpglib.DpgLexerTokens, + dpgrtl.lexer, + dpgrtl.types, + System.SysUtils; + +type + // ========================================================================= + // Class TDpgLexer declaration + // ========================================================================= + TDpgLexer = class( TLexer) + + protected // Internals + procedure initialize; override; + + public // Protected grammar rules + // Must callable from parser too + procedure mESC ( pCreate: boolean); + procedure mDNUMBER ( pCreate: boolean); + procedure mXNUMBER ( pCreate: boolean); + function mINT_RULEREF ( pCreate: boolean): integer; + procedure mWS_LOOP ( pCreate: boolean); + procedure mSLCOMMENT ( pCreate: boolean); + procedure mMLCOMMENT1 ( pCreate: boolean); + procedure mMLCOMMENT2 ( pCreate: boolean); + procedure mDDIGIT ( pCreate: boolean); + procedure mXDIGIT ( pCreate: boolean); + + public // Public grammar rules + procedure mLPAREN ( pCreate: boolean); + procedure mRPAREN ( pCreate: boolean); + procedure mRCURLY ( pCreate: boolean); + procedure mCOLON ( pCreate: boolean); + procedure mSEMI ( pCreate: boolean); + procedure mCOMMA ( pCreate: boolean); + procedure mASSIGN ( pCreate: boolean); + procedure mIMPLIES ( pCreate: boolean); + procedure mQUEST ( pCreate: boolean); + procedure mPLUS ( pCreate: boolean); + procedure mSTAR ( pCreate: boolean); + procedure mAT ( pCreate: boolean); + procedure mNOT ( pCreate: boolean); + procedure mOR ( pCreate: boolean); + procedure mBANG ( pCreate: boolean); + procedure mWILDCARD ( pCreate: boolean); + procedure mRANGE ( pCreate: boolean); + procedure mOPEN ( pCreate: boolean); + procedure mCLOSE ( pCreate: boolean); + procedure mCARET ( pCreate: boolean); + procedure mTREE_BEGIN ( pCreate: boolean); + procedure mCHARLIT ( pCreate: boolean); + procedure mSTRINGLIT ( pCreate: boolean); + procedure mINTEGER ( pCreate: boolean); + procedure mARGACTION ( pCreate: boolean); + procedure mACTION ( pCreate: boolean); + procedure mTOKENREF ( pCreate: boolean); + procedure mRULEREF ( pCreate: boolean); + procedure mCOMMENT ( pCreate: boolean); + procedure mWS ( pCreate: boolean); + + public + function NextToken: IToken; override; + end; + +implementation +uses + dpgrtl.exception, + dpgrtl.token; + + +// ============================================================================ +// mLPAREN +// ============================================================================ +procedure TDpgLexer.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 TDpgLexer.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; + +// ============================================================================ +// mRCURLY +// ============================================================================ +procedure TDpgLexer.mRCURLY( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_RCURLY; + + 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; + +// ============================================================================ +// mCOLON +// ============================================================================ +procedure TDpgLexer.mCOLON( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_COLON; + + 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; + +// ============================================================================ +// mSEMI +// ============================================================================ +procedure TDpgLexer.mSEMI( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_SEMI; + + 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; + +// ============================================================================ +// mCOMMA +// ============================================================================ +procedure TDpgLexer.mCOMMA( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_COMMA; + + 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 TDpgLexer.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; + +// ============================================================================ +// mIMPLIES +// ============================================================================ +procedure TDpgLexer.mIMPLIES( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_IMPLIES; + + 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; + +// ============================================================================ +// mQUEST +// ============================================================================ +procedure TDpgLexer.mQUEST( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_QUEST; + + 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; + +// ============================================================================ +// mPLUS +// ============================================================================ +procedure TDpgLexer.mPLUS( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_PLUS; + + 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; + +// ============================================================================ +// mSTAR +// ============================================================================ +procedure TDpgLexer.mSTAR( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_STAR; + + 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; + +// ============================================================================ +// mAT +// ============================================================================ +procedure TDpgLexer.mAT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_AT; + + 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; + +// ============================================================================ +// mNOT +// ============================================================================ +procedure TDpgLexer.mNOT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_NOT; + + 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; + +// ============================================================================ +// mOR +// ============================================================================ +procedure TDpgLexer.mOR( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_OR; + + 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; + +// ============================================================================ +// mBANG +// ============================================================================ +procedure TDpgLexer.mBANG( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_BANG; + + 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; + +// ============================================================================ +// mWILDCARD +// ============================================================================ +procedure TDpgLexer.mWILDCARD( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_WILDCARD; + + 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; + +// ============================================================================ +// mRANGE +// ============================================================================ +procedure TDpgLexer.mRANGE( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_RANGE; + + 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; + +// ============================================================================ +// mOPEN +// ============================================================================ +procedure TDpgLexer.mOPEN( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_OPEN; + + 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; + +// ============================================================================ +// mCLOSE +// ============================================================================ +procedure TDpgLexer.mCLOSE( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_CLOSE; + + 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; + +// ============================================================================ +// mCARET +// ============================================================================ +procedure TDpgLexer.mCARET( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_CARET; + + 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; + +// ============================================================================ +// mTREE_BEGIN +// ============================================================================ +procedure TDpgLexer.mTREE_BEGIN( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_TREE_BEGIN; + + 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; + +// ============================================================================ +// mCHARLIT +// ============================================================================ +procedure TDpgLexer.mCHARLIT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_CHARLIT; + + SaveConsumedInput := false; + match(''''); + SaveConsumedInput := true; + if (( LA(1) in ['\'])) then + begin + mESC(false); + end + + else if (( LA(1) in [#1..'&','('..'[',']'..#255])) then + begin + matchNot(''''); + end + + else + Raise EMismatchedChar.Create( LA(1), [#1..'&','('..#255], InputState.FileName, InputState.Line, InputState.Column); + SaveConsumedInput := false; + match(''''); + SaveConsumedInput := true; + + 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; + +// ============================================================================ +// mESC +// ============================================================================ +procedure TDpgLexer.mESC( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + d1: IToken; + d2: IToken; + number: AnsiString; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_ESC; + + SaveConsumedInput := false; + match('\'); + SaveConsumedInput := true; + if (( LA(1) in ['r'])) then + begin + match('r'); + TokenText[ Length( TokenText)] := AnsiChar(13); + end + + else if (( LA(1) in ['n'])) then + begin + match('n'); + TokenText[ Length( TokenText)] := AnsiChar(10); + end + + else if (( LA(1) in ['t'])) then + begin + match('t'); + TokenText[ Length( TokenText)] := AnsiChar(9); + end + + else if (( LA(1) in ['\'])) then + begin + match('\'); + end + + else if (( LA(1) in [''''])) then + begin + match(''''); + end + + else if (( LA(1) in ['"'])) then + begin + match('"'); + end + + else if (( LA(1) in ['x'])) then + begin + match('x'); + _save := Length( TokenText); + mXDIGIT(true); + TokenText := Copy(TokenText, 1, _save); + d1 := ReturnToken; + _save := Length( TokenText); + mXDIGIT(true); + TokenText := Copy(TokenText, 1, _save); + d2 := ReturnToken; + number := '$' + d1.TokenText + d2.TokenText; + TokenText[ Length( TokenText)] := AnsiChar( StrToInt( number)); + end + + else + Raise EMismatchedChar.Create( LA(1), ['"','''','\','n','r','t','x'], 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; + +// ============================================================================ +// mSTRINGLIT +// ============================================================================ +procedure TDpgLexer.mSTRINGLIT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_STRINGLIT; + + match('"'); + + while(true) do + begin + if (( LA(1) in ['\'])) then + begin + mESC(false); + end + + else 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; + +// ============================================================================ +// mINTEGER +// ============================================================================ +procedure TDpgLexer.mINTEGER( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + i: integer; + v: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_INTEGER; + + if (( LA(1) in ['0'..'9'])) then + begin + mDNUMBER(false); + v := 0; + for i:=1 to Length( TokenText) do + begin + v := v * 10 + ord( TokenText[i]) - ord('0'); + end; + + TokenText := IntToStr( v); + end + + else if (( LA(1) in ['$'])) then + begin + mXNUMBER(false); + 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); + end + + else + Raise EMismatchedChar.Create( LA(1), ['$','0'..'9'], 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; + +// ============================================================================ +// mDNUMBER +// ============================================================================ +procedure TDpgLexer.mDNUMBER( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_DNUMBER; + + match( ['0'..'9']); + + while(true) do + begin + if (( LA(1) in ['0'..'9'])) then + begin + mDDIGIT(false); + 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; + +// ============================================================================ +// mXNUMBER +// ============================================================================ +procedure TDpgLexer.mXNUMBER( pCreate: boolean); +var + _begin: integer; + _cnt_64: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_XNUMBER; + + SaveConsumedInput := false; + match('$'); + SaveConsumedInput := true; + _cnt_64 := 0; + + while(true) do + begin + if (( LA(1) in ['0'..'9','A'..'F','a'..'f'])) then + begin + mXDIGIT(false); + end + + else + begin + if _cnt_64 >= 1 then + break + else + Raise EMismatchedChar.Create( LA(1), ['0'..'9','A'..'F','a'..'f'], InputState.FileName, InputState.Line, InputState.Column); + end; + + INC(_cnt_64); + 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; + +// ============================================================================ +// mARGACTION +// ============================================================================ +procedure TDpgLexer.mARGACTION( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_ARGACTION; + + SaveConsumedInput := false; + match('['); + SaveConsumedInput := true; + + while(true) do + begin + 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 + matchNot(']'); + end + + else + break; + end; + + SaveConsumedInput := false; + match(']'); + SaveConsumedInput := true; + + 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; + +// ============================================================================ +// mACTION +// ============================================================================ +procedure TDpgLexer.mACTION( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_ACTION; + + match('{'); + + while(true) do + begin + 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 + matchNot('}'); + end + + else + break; + end; + + match('}'); + if (( LA(1) in ['?'])) then + begin + SaveConsumedInput := false; + match('?'); + SaveConsumedInput := true; + _ttype := TT_SEMPRED; + 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; + +// ============================================================================ +// mTOKENREF +// ============================================================================ +procedure TDpgLexer.mTOKENREF( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_TOKENREF; + + match( ['A'..'Z']); + + 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; + + _ttype := TestLiteral( _ttype); + + + 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; + +// ============================================================================ +// mRULEREF +// ============================================================================ +procedure TDpgLexer.mRULEREF( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + t: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_RULEREF; + + t := mINT_RULEREF(false); + _ttype := t; + if ( t = LT_uses) then + begin + mWS_LOOP(false); + if (( LA(1) in ['{'])) then + begin + match('{'); + _ttype := TT_USES; + end; + end + + else if ( t = LT_options) then + begin + mWS_LOOP(false); + if (( LA(1) in ['{'])) then + begin + match('{'); + _ttype := TT_OPTIONS; + end; + end + + else if ( t = LT_tokens) then + begin + mWS_LOOP(false); + if (( LA(1) in ['{'])) then + begin + match('{'); + _ttype := TT_TOKENS; + end; + 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_RULEREF +// ============================================================================ +function TDpgLexer.mINT_RULEREF( pCreate: boolean): integer; +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_INT_RULEREF; + + _ttype := TT_RULEREF; + + match( ['a'..'z']); + + 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; + + result := TestLiteral( _ttype); + + 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_LOOP +// ============================================================================ +procedure TDpgLexer.mWS_LOOP( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_WS_LOOP; + + + while(true) do + begin + if (( LA(1) in [#9..#10,#13,' '])) then + begin + mWS(false); + end + + else if (( LA(1) in ['(','/'])) then + begin + mCOMMENT(false); + 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; + +// ============================================================================ +// mCOMMENT +// ============================================================================ +procedure TDpgLexer.mCOMMENT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_COMMENT; + + if (( LA(1) in ['/']) and (LA(2) in ['/'])) then + begin + mSLCOMMENT(false); + _ttype := TT_SKIP; + end + + else if (( LA(1) in ['/']) and (LA(2) in ['*'])) then + begin + mMLCOMMENT2(false); + _ttype := TT_SKIP; + end + + else if (( LA(1) in ['('])) then + begin + mMLCOMMENT1(false); + _ttype := TT_SKIP; + end + + else + Raise EMismatchedChar.Create( LA(1), ['(','/'], 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; + +// ============================================================================ +// mSLCOMMENT +// ============================================================================ +procedure TDpgLexer.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); + + 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; + +// ============================================================================ +// mMLCOMMENT1 +// ============================================================================ +procedure TDpgLexer.mMLCOMMENT1( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_MLCOMMENT1; + + 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 + matchNot( EOF_CHAR ); + 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; + +// ============================================================================ +// mMLCOMMENT2 +// ============================================================================ +procedure TDpgLexer.mMLCOMMENT2( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_MLCOMMENT2; + + 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 + matchNot( EOF_CHAR ); + 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; + +// ============================================================================ +// mDDIGIT +// ============================================================================ +procedure TDpgLexer.mDDIGIT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_DDIGIT; + + 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 TDpgLexer.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; + +// ============================================================================ +// mWS +// ============================================================================ +procedure TDpgLexer.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); + tab; + 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; + +// ---------------------------------------------------------------------------- +// NextToken +// ---------------------------------------------------------------------------- +function TDpgLexer.NextToken : IToken; +var + _first : TCharSet; + +begin + _first := [#9..#10,#13,' '..'$',''''..',','.'..'[','^','a'..'~']; + + while( true) do + begin + ResetText; + + try + if (( LA(1) in ['=']) and (LA(2) in ['>'])) then + begin + mIMPLIES(true); + result := ReturnToken; + end + + else if (( LA(1) in ['.']) and (LA(2) in ['.'])) then + begin + mRANGE(true); + result := ReturnToken; + end + + else if (( LA(1) in ['(','/']) and (LA(2) in ['*','/'])) then + begin + mCOMMENT(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 + mRCURLY(true); + result := ReturnToken; + end + + else if (( LA(1) in [':'])) then + begin + mCOLON(true); + result := ReturnToken; + end + + else if (( LA(1) in [';'])) then + begin + mSEMI(true); + result := ReturnToken; + end + + else if (( LA(1) in [','])) then + begin + mCOMMA(true); + result := ReturnToken; + end + + else if (( LA(1) in ['='])) then + begin + mASSIGN(true); + result := ReturnToken; + end + + else if (( LA(1) in ['?'])) then + begin + mQUEST(true); + result := ReturnToken; + end + + else if (( LA(1) in ['+'])) then + begin + mPLUS(true); + result := ReturnToken; + end + + else if (( LA(1) in ['*'])) then + begin + mSTAR(true); + result := ReturnToken; + end + + else if (( LA(1) in ['@'])) then + begin + mAT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['~'])) then + begin + mNOT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['|'])) then + begin + mOR(true); + result := ReturnToken; + end + + else if (( LA(1) in ['!'])) then + begin + mBANG(true); + result := ReturnToken; + end + + else if (( LA(1) in ['.'])) then + begin + mWILDCARD(true); + result := ReturnToken; + end + + else if (( LA(1) in ['<'])) then + begin + mOPEN(true); + result := ReturnToken; + end + + else if (( LA(1) in ['>'])) then + begin + mCLOSE(true); + result := ReturnToken; + end + + else if (( LA(1) in ['^'])) then + begin + mCARET(true); + result := ReturnToken; + end + + else if (( LA(1) in ['#'])) then + begin + mTREE_BEGIN(true); + result := ReturnToken; + end + + else if (( LA(1) in [''''])) then + begin + mCHARLIT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['"'])) then + begin + mSTRINGLIT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['$','0'..'9'])) then + begin + mINTEGER(true); + result := ReturnToken; + end + + else if (( LA(1) in ['['])) then + begin + mARGACTION(true); + result := ReturnToken; + end + + else if (( LA(1) in ['{'])) then + begin + mACTION(true); + result := ReturnToken; + end + + else if (( LA(1) in ['A'..'Z'])) then + begin + mTOKENREF(true); + result := ReturnToken; + end + + else if (( LA(1) in ['a'..'z'])) then + begin + mRULEREF(true); + result := ReturnToken; + end + + else if (( LA(1) in [#9..#10,#13,' '])) then + begin + mWS(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; + +// ---------------------------------------------------------------------------- +// InitLiterals +// ---------------------------------------------------------------------------- +procedure TDpgLexer.initialize; +begin + fLiterals['finally' ] := 21; + fLiterals['returns' ] := 18; + fLiterals['public' ] := 17; + fLiterals['parser' ] := 9; + fLiterals['unit' ] := 4; + fLiterals['tokens' ] := 12; + fLiterals['uses' ] := 5; + fLiterals['treeparser' ] := 10; + fLiterals['memberdecl' ] := 13; + fLiterals['local' ] := 19; + fLiterals['lexer' ] := 8; + fLiterals['memberdef' ] := 14; + fLiterals['except' ] := 20; + fLiterals['protected' ] := 16; + fLiterals['type' ] := 7; + fLiterals['private' ] := 15; + fLiterals['options' ] := 11; + fLiterals['const' ] := 6; +end; + +end. diff --git a/src.lib/grammar/dpglib.DpgLexerTokens.pas b/src.lib/grammar/dpglib.DpgLexerTokens.pas new file mode 100644 index 0000000..ab813d6 --- /dev/null +++ b/src.lib/grammar/dpglib.DpgLexerTokens.pas @@ -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. diff --git a/src.lib/grammar/dpglib.DpgLexerTokens.txt b/src.lib/grammar/dpglib.DpgLexerTokens.txt new file mode 100644 index 0000000..c69a33c --- /dev/null +++ b/src.lib/grammar/dpglib.DpgLexerTokens.txt @@ -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 diff --git a/src.lib/grammar/dpglib.DpgParser.g b/src.lib/grammar/dpglib.DpgParser.g new file mode 100644 index 0000000..cb1b09f --- /dev/null +++ b/src.lib/grammar/dpglib.DpgParser.g @@ -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; +} + + diff --git a/src.lib/grammar/dpglib.DpgParser.pas b/src.lib/grammar/dpglib.DpgParser.pas new file mode 100644 index 0000000..aa3e61a --- /dev/null +++ b/src.lib/grammar/dpglib.DpgParser.pas @@ -0,0 +1,1457 @@ +// ============================================================================ +// This file is generated by the Delphi Parser Generator. +// ---------------------------------------------------------------------------- +// DPG version: 2.1.0.0r +// Grammar: dpglib.dpgParser.g +// ============================================================================ +unit dpglib.DpgParser; + +interface + +uses + System.Classes, + dpglib.DpgParserTokens, + dpglib.types, + dpgrtl.llkparser, + dpgrtl.types, + System.SysUtils; + +type + // ========================================================================= + // Class TDpgParser declaration + // ========================================================================= + TDpgParser = class( TLLkParser) + + 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; + + public // Public grammar rules + procedure grammar ; + function qualifiedId : IToken; + procedure usesDecl ; + procedure constDecl ; + procedure typeDecl ; + procedure classDecl ; + procedure qualifiedUsesName ; + function id : IToken; + procedure classOptions ; + procedure classTokens ; + procedure classMemberDecl ; + procedure rules ; + procedure classMemberDef ; + function optionValue : IToken; + procedure tokenSpecOptions ( t: IToken); + procedure rule ; + procedure ruleExceptionBlock ; + procedure altExceptionBlock ; + procedure ruleOptions ; + procedure block ; + procedure alternative ; + procedure elem ; + procedure element ; + procedure elementOptions ; + procedure range ( pTokenLabel: IToken); + procedure terminal ( pTokenLabel: IToken); + procedure notTerminal ( pTokenLabel: IToken); + procedure ebnf ( pTokenLabel: IToken; pTokenNot: boolean); + procedure tree ; + procedure rootNode ; + function astTypeSpec : integer; + procedure subRuleOptions ; + + end; + +implementation +uses + dpgrtl.exception, + dpgrtl.token; + + +// ============================================================================ +// grammar +// ============================================================================ +procedure TDpgParser.grammar; +var + unitName: IToken; + +begin + + match(LT_unit); + unitName := qualifiedId; + fGrammarUnit := unitName.TokenText; + match(TT_SEMI); + if (( LA(1) in [TT_USES])) then + begin + usesDecl; + end; + if (( LA(1) in [LT_const])) then + begin + constDecl; + end; + if (( LA(1) in [LT_type])) then + begin + typeDecl; + end; + classDecl; + fGrammarMaker.endGrammar; +end; + +// ============================================================================ +// qualifiedId +// ============================================================================ +function TDpgParser.qualifiedId: IToken; +var + buf : AnsiString; + a : IToken; + +begin + + a := id; + buf := a.TokenText; + + while(true) do + begin + if (( LA(1) in [TT_WILDCARD])) then + begin + match(TT_WILDCARD); + a := id; + buf := buf + '.' + a.TokenText; + end + + else + break; + end; + + // ----------------------------------------------------------- + // 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; +end; + +// ============================================================================ +// usesDecl +// ============================================================================ +procedure TDpgParser.usesDecl; +begin + + match(TT_USES); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + qualifiedUsesName; + match(TT_SEMI); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// constDecl +// ============================================================================ +procedure TDpgParser.constDecl; +var + a: IToken; + +begin + + match(LT_const); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefConstAction( a); +end; + +// ============================================================================ +// typeDecl +// ============================================================================ +procedure TDpgParser.typeDecl; +var + a: IToken; + +begin + + match(LT_type); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefTypeAction( a); +end; + +// ============================================================================ +// classDecl +// ============================================================================ +procedure TDpgParser.classDecl; +var + grType : integer; + grObject : IToken; + grSuper : IToken; + +begin + + grObject := nil; + grSuper := nil; + + if (( LA(1) in [LT_lexer])) then + begin + match(LT_lexer); + grType := 0; + end + + else if (( LA(1) in [LT_parser])) then + begin + match(LT_parser); + grType := 1; + end + + else if (( LA(1) in [LT_treeparser])) then + begin + match(LT_treeparser); + grType := 2; + end + + else + Raise EMismatchedToken.Create( LT(1), [LT_lexer..LT_treeparser], InputState.FileName); + grObject := id; + match(TT_SEMI); + // --------------------------------------------------------- + // 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); + if (( LA(1) in [TT_OPTIONS])) then + begin + classOptions; + end; + if ((( LA(1) in [TT_TOKENS])) and (grType=0)) then + begin + classTokens; + end; + if (( LA(1) in [LT_memberdecl])) then + begin + classMemberDecl; + end; + rules; + if (( LA(1) in [LT_memberdef])) then + begin + classMemberDef; + end; +end; + +// ============================================================================ +// qualifiedUsesName +// ============================================================================ +procedure TDpgParser.qualifiedUsesName; +var + r: IToken; + id: AnsiString; + +begin + + if (( LA(1) in [TT_TOKENREF])) then + begin + r := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_RULEREF])) then + begin + r := LT(1); + match(TT_RULEREF); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName); + id := r.TokenText; + + while(true) do + begin + if (( LA(1) in [TT_WILDCARD])) then + begin + match(TT_WILDCARD); + if (( LA(1) in [TT_TOKENREF])) then + begin + r := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_RULEREF])) then + begin + r := LT(1); + match(TT_RULEREF); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName); + id := id +'.'+ r.TokenText; + end + + else + break; + end; + + fGrammarMaker.defineUses(id); +end; + +// ============================================================================ +// id +// ============================================================================ +function TDpgParser.id: IToken; +begin + + if (( LA(1) in [TT_TOKENREF])) then + begin + result := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_RULEREF])) then + begin + result := LT(1); + match(TT_RULEREF); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName); +end; + +// ============================================================================ +// classOptions +// ============================================================================ +procedure TDpgParser.classOptions; +var + optName : IToken; + optValue : IToken; + +begin + + match(TT_OPTIONS); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + optName := id; + match(TT_ASSIGN); + optValue := optionValue; + match(TT_SEMI); + fGrammarMaker.setGrammarOption( optName, optValue); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// classTokens +// ============================================================================ +procedure TDpgParser.classTokens; +var + tokenName: IToken; + tokenString: IToken; + +begin + + match(TT_TOKENS); + + while(true) do + begin + if (( LA(1) in [TT_STRINGLIT,TT_TOKENREF])) then + begin + tokenName := nil; + tokenString := nil; + if (( LA(1) in [TT_TOKENREF])) then + begin + tokenName := LT(1); + match(TT_TOKENREF); + if (( LA(1) in [TT_ASSIGN])) then + begin + match(TT_ASSIGN); + tokenString := LT(1); + match(TT_STRINGLIT); + end; + fGrammarMaker.defineToken( tokenName, tokenString); + if (( LA(1) in [TT_OPEN])) then + begin + tokenSpecOptions(tokenName); + end; + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + tokenString := LT(1); + match(TT_STRINGLIT); + fGrammarMaker.defineToken( tokenName, tokenString); + if (( LA(1) in [TT_OPEN])) then + begin + tokenSpecOptions(tokenString); + end; + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_STRINGLIT,TT_TOKENREF], InputState.FileName); + match(TT_SEMI); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// classMemberDecl +// ============================================================================ +procedure TDpgParser.classMemberDecl; +var + memberDecl: IToken; + +begin + + match(LT_memberdecl); + memberDecl := LT(1); + match(TT_ACTION); + fGrammarMaker.refMemberDecl(memberDecl); +end; + +// ============================================================================ +// rules +// ============================================================================ +procedure TDpgParser.rules; +begin + + + while(true) do + begin + if (( LA(1) in [LT_private..LT_public,TT_TOKENREF..TT_RULEREF])) then + begin + rule; + end + + else + break; + end; + +end; + +// ============================================================================ +// classMemberDef +// ============================================================================ +procedure TDpgParser.classMemberDef; +var + memberDef: IToken; + +begin + + match(LT_memberdef); + memberDef := LT(1); + match(TT_ACTION); + fGrammarMaker.refMemberDef(memberDef); +end; + +// ============================================================================ +// optionValue +// ============================================================================ +function TDpgParser.optionValue: IToken; +begin + + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + result := qualifiedId; + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + result := LT(1); + match(TT_STRINGLIT); + end + + else if (( LA(1) in [TT_CHARLIT])) then + begin + result := LT(1); + match(TT_CHARLIT); + end + + else if (( LA(1) in [TT_INTEGER])) then + begin + result := LT(1); + match(TT_INTEGER); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_CHARLIT..TT_INTEGER,TT_TOKENREF..TT_RULEREF], InputState.FileName); +end; + +// ============================================================================ +// tokenSpecOptions +// ============================================================================ +procedure TDpgParser.tokenSpecOptions( t: IToken); +var + name : IToken; + value : IToken; + +begin + + name := nil; + value := nil; + + match(TT_OPEN); + name := id; + match(TT_ASSIGN); + value := optionValue; + fGrammarMaker.refTokenSpecElemOption( t, name, value); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + name := id; + match(TT_ASSIGN); + value := optionValue; + fGrammarMaker.refTokenSpecElemOption( t, name, value); + end + + else + break; + end; + + match(TT_CLOSE); +end; + +// ============================================================================ +// rule +// ============================================================================ +procedure TDpgParser.rule; +var + args: IToken; + initAction: IToken; + locals: IToken; + ret: IToken; + access : AnsiString; + ag : integer; + returns : IToken; + name : IToken; + +begin + + access := 'public'; + args := nil; + name := nil; + ag := AUTOGEN_NONE; + + if (( LA(1) in [LT_public])) then + begin + match(LT_public); + access := 'public'; + end + + else if (( LA(1) in [LT_protected])) then + begin + match(LT_protected); + access := 'protected'; + end + + else if (( LA(1) in [LT_private])) then + begin + match(LT_private); + access := 'private'; + end; + name := id; + if (( LA(1) in [TT_ARGACTION])) then + begin + args := LT(1); + match(TT_ARGACTION); + end; + if (( LA(1) in [LT_returns])) then + begin + match(LT_returns); + ret := LT(1); + match(TT_ARGACTION); + end; + fGrammarMaker.defineRuleName( name, access, true, ''); + + if args <> nil then + fGrammarMaker.refArgAction( args); + + if ret <> nil then + fGrammarMaker.refReturnAction( ret); + if (( LA(1) in [TT_OPTIONS])) then + begin + ruleOptions; + end; + if (( LA(1) in [LT_local])) then + begin + match(LT_local); + locals := LT(1); + match(TT_ACTION); + fGrammarMaker.refRuleLocals( locals); + end; + if (( LA(1) in [TT_ACTION])) then + begin + initAction := LT(1); + match(TT_ACTION); + fGrammarMaker.refInitAction( initAction); + end; + match(TT_COLON); + block; + match(TT_SEMI); + if (( LA(1) in [LT_except..LT_finally])) then + begin + ruleExceptionBlock; + end; + fGrammarMaker.endRule(''); +end; + +// ============================================================================ +// ruleExceptionBlock +// ============================================================================ +procedure TDpgParser.ruleExceptionBlock; +var + a: IToken; + t: IToken; + +begin + + if (( LA(1) in [LT_except])) then + begin + t := LT(1); + match(LT_except); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefRuleExHandler( t, a); + end + + else if (( LA(1) in [LT_finally])) then + begin + t := LT(1); + match(LT_finally); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefRuleExHandler( t, a); + end + + else + Raise EMismatchedToken.Create( LT(1), [LT_except..LT_finally], InputState.FileName); +end; + +// ============================================================================ +// altExceptionBlock +// ============================================================================ +procedure TDpgParser.altExceptionBlock; +var + a: IToken; + t: IToken; + +begin + + if (( LA(1) in [LT_except])) then + begin + t := LT(1); + match(LT_except); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefAltExHandler( t, a); + end + + else if (( LA(1) in [LT_finally])) then + begin + t := LT(1); + match(LT_finally); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefAltExHandler( t, a); + end + + else + Raise EMismatchedToken.Create( LT(1), [LT_except..LT_finally], InputState.FileName); +end; + +// ============================================================================ +// ruleOptions +// ============================================================================ +procedure TDpgParser.ruleOptions; +var + optName : IToken; + optValue : IToken; + +begin + + match(TT_OPTIONS); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + optName := id; + match(TT_ASSIGN); + optValue := optionValue; + match(TT_SEMI); + fGrammarMaker.setRuleOption( optName, optValue); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// block +// ============================================================================ +procedure TDpgParser.block; +begin + + INC( fNesting); + + alternative; + + while(true) do + begin + if (( LA(1) in [TT_OR])) then + begin + match(TT_OR); + alternative; + end + + else + break; + end; + + DEC(fNesting); +end; + +// ============================================================================ +// alternative +// ============================================================================ +procedure TDpgParser.alternative; +var + autoGen : boolean; + +begin + + autoGen := true; + + fGrammarMaker.beginAlt( autoGen); + + while(true) do + begin + if (( LA(1) in [TT_SEMPRED,TT_LPAREN,TT_NOT,TT_WILDCARD,TT_TREE_BEGIN..TT_STRINGLIT,TT_ACTION..TT_RULEREF])) then + begin + elem; + end + + else + break; + end; + + if (( LA(1) in [LT_except..LT_finally])) then + begin + altExceptionBlock; + end; + fGrammarMaker.endAlt; +end; + +// ============================================================================ +// elem +// ============================================================================ +procedure TDpgParser.elem; +begin + + element; + if (( LA(1) in [TT_OPEN])) then + begin + elementOptions; + end; +end; + +// ============================================================================ +// element +// ============================================================================ +procedure TDpgParser.element; +var + action: IToken; + ag: IToken; + args: IToken; + ruleRef: IToken; + semPred: IToken; + tokenRef: IToken; + assignId : IToken; + assignLabel : IToken; + autoGen : integer; + +begin + + assignId := nil; + assignLabel := nil; + autoGen := AUTOGEN_NONE; + + if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_ASSIGN])) then + begin + assignId := id; + match(TT_ASSIGN); + if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_COLON])) then + begin + assignLabel := id; + match(TT_COLON); + checkEndRule(assignLabel); + end; + if (( LA(1) in [TT_RULEREF])) then + begin + ruleRef := LT(1); + match(TT_RULEREF); + if (( LA(1) in [TT_ARGACTION])) then + begin + args := LT(1); + match(TT_ARGACTION); + end; + if (( LA(1) in [TT_BANG])) then + begin + ag := LT(1); + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refRule( assignId, ruleRef, assignLabel, args, autoGen); + end + + else if (( LA(1) in [TT_TOKENREF])) then + begin + tokenRef := LT(1); + match(TT_TOKENREF); + if (( LA(1) in [TT_ARGACTION])) then + begin + args := LT(1); + match(TT_ARGACTION); + end; + fGrammarMaker.refToken( assignId, tokenRef, assignLabel, args, false, autoGen, lastInRule); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName); + end + + else if (( LA(1) in [TT_LPAREN,TT_NOT,TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF..TT_RULEREF]) and (LA(2) in [LT_except..TT_SEMPRED,TT_OPTIONS,TT_LPAREN..TT_RPAREN,TT_COLON..TT_SEMI,TT_NOT..TT_OPEN,TT_CARET..TT_STRINGLIT,TT_ARGACTION..TT_RULEREF])) then + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_COLON])) then + begin + assignLabel := id; + match(TT_COLON); + checkEndRule(assignLabel); + end; + if (( LA(1) in [TT_RULEREF])) then + begin + ruleRef := LT(1); + match(TT_RULEREF); + if (( LA(1) in [TT_ARGACTION])) then + begin + args := LT(1); + match(TT_ARGACTION); + end; + if (( LA(1) in [TT_BANG])) then + begin + ag := LT(1); + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refRule( assignId, ruleRef, assignLabel, args, autoGen); + end + + else if (( LA(1) in [TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF]) and (LA(2) in [TT_RANGE])) then + begin + range(assignLabel); + end + + else if (( LA(1) in [TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF]) and (LA(2) in [LT_except..TT_SEMPRED,TT_LPAREN..TT_RPAREN,TT_SEMI,TT_NOT..TT_WILDCARD,TT_OPEN,TT_CARET..TT_STRINGLIT,TT_ARGACTION..TT_RULEREF])) then + begin + terminal(assignLabel); + end + + else if (( LA(1) in [TT_NOT])) then + begin + match(TT_NOT); + if (( LA(1) in [TT_CHARLIT,TT_TOKENREF])) then + begin + notTerminal(assignLabel); + end + + else if (( LA(1) in [TT_LPAREN])) then + begin + ebnf( assignLabel, true); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_LPAREN,TT_CHARLIT,TT_TOKENREF], InputState.FileName); + end + + else if (( LA(1) in [TT_LPAREN])) then + begin + ebnf( assignLabel, false); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_LPAREN,TT_NOT,TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF..TT_RULEREF], InputState.FileName); + end + + else if (( LA(1) in [TT_ACTION])) then + begin + action := LT(1); + match(TT_ACTION); + fGrammarMaker.refAction( action); + end + + else if (( LA(1) in [TT_SEMPRED])) then + begin + semPred := LT(1); + match(TT_SEMPRED); + fGrammarMaker.refSemPred( semPred); + end + + else if (( LA(1) in [TT_TREE_BEGIN])) then + begin + tree; + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_SEMPRED,TT_LPAREN,TT_NOT,TT_WILDCARD,TT_TREE_BEGIN..TT_STRINGLIT,TT_ACTION..TT_RULEREF], InputState.FileName); +end; + +// ============================================================================ +// elementOptions +// ============================================================================ +procedure TDpgParser.elementOptions; +var + name : IToken; + value : IToken; + +begin + + match(TT_OPEN); + name := id; + match(TT_ASSIGN); + value := optionValue; + fGrammarMaker.refElemOption(name,value); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + name := id; + match(TT_ASSIGN); + value := optionValue; + fGrammarMaker.refElemOption(name,value); + end + + else + break; + end; + + match(TT_CLOSE); +end; + +// ============================================================================ +// range +// ============================================================================ +procedure TDpgParser.range( pTokenLabel: IToken); +var + crLeft: IToken; + crRight: IToken; + trLeft: IToken; + trRight: IToken; + autoGen: integer; + +begin + + autoGen := AUTOGEN_NONE; + + if (( LA(1) in [TT_CHARLIT])) then + begin + crLeft := LT(1); + match(TT_CHARLIT); + match(TT_RANGE); + crRight := LT(1); + match(TT_CHARLIT); + if (( LA(1) in [TT_BANG])) then + begin + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refCharRange( crLeft, crRight, pTokenLabel, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_STRINGLIT,TT_TOKENREF])) then + begin + if (( LA(1) in [TT_TOKENREF])) then + begin + trLeft := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + trLeft := LT(1); + match(TT_STRINGLIT); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_STRINGLIT,TT_TOKENREF], InputState.FileName); + match(TT_RANGE); + if (( LA(1) in [TT_TOKENREF])) then + begin + trRight := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + trRight := LT(1); + match(TT_STRINGLIT); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_STRINGLIT,TT_TOKENREF], InputState.FileName); + autoGen := astTypeSpec; + fGrammarMaker.refTokenRange( trLeft, trRight, pTokenLabel, autoGen, lastInRule); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF], InputState.FileName); +end; + +// ============================================================================ +// terminal +// ============================================================================ +procedure TDpgParser.terminal( pTokenLabel: IToken); +var + aa: IToken; + cl: IToken; + sl: IToken; + tr: IToken; + wc: IToken; + autoGen : integer; + +begin + + autoGen := AUTOGEN_NONE; + aa := nil; + + if (( LA(1) in [TT_CHARLIT])) then + begin + cl := LT(1); + match(TT_CHARLIT); + if (( LA(1) in [TT_BANG])) then + begin + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refCharLiteral( cl, pTokenLabel, false, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_TOKENREF])) then + begin + tr := LT(1); + match(TT_TOKENREF); + autoGen := astTypeSpec; + if (( LA(1) in [TT_ARGACTION])) then + begin + aa := LT(1); + match(TT_ARGACTION); + end; + fGrammarMaker.refToken( nil, tr, pTokenLabel, aa, false, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + sl := LT(1); + match(TT_STRINGLIT); + autoGen := astTypeSpec; + fGrammarMaker.refStringLiteral( sl, pTokenLabel, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_WILDCARD])) then + begin + wc := LT(1); + match(TT_WILDCARD); + autogen := astTypeSpec; + fGrammarMaker.refWildCard( wc, pTokenLabel, autoGen); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF], InputState.FileName); +end; + +// ============================================================================ +// notTerminal +// ============================================================================ +procedure TDpgParser.notTerminal( pTokenLabel: IToken); +var + cl: IToken; + tr: IToken; + autoGen : integer; + +begin + + autoGen := AUTOGEN_NONE; + + if (( LA(1) in [TT_CHARLIT])) then + begin + cl := LT(1); + match(TT_CHARLIT); + if (( LA(1) in [TT_BANG])) then + begin + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refCharLiteral( cl, pTokenLabel, true, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_TOKENREF])) then + begin + tr := LT(1); + match(TT_TOKENREF); + autoGen := astTypeSpec; + fGrammarMaker.refToken( nil, tr, pTokenLabel, nil, true, autoGen, lastInRule); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_CHARLIT,TT_TOKENREF], InputState.FileName); +end; + +// ============================================================================ +// ebnf +// ============================================================================ +procedure TDpgParser.ebnf( pTokenLabel: IToken; pTokenNot: boolean); +var + aa: IToken; + lp: IToken; + m: IToken; + n: IToken; + +begin + + lp := LT(1); + match(TT_LPAREN); + fGrammarMaker.beginSubrule( pTokenLabel, lp, pTokenNot); + if (( LA(1) in [TT_OPTIONS])) then + begin + subRuleOptions; + if (( LA(1) in [TT_ACTION])) then + begin + aa := LT(1); + match(TT_ACTION); + fGrammarMaker.refInitAction(aa); + end; + match(TT_COLON); + end + + else if (( LA(1) in [TT_ACTION]) and (LA(2) in [TT_COLON])) then + begin + aa := LT(1); + match(TT_ACTION); + fGrammarMaker.refInitAction(aa); + match(TT_COLON); + end; + block; + match(TT_RPAREN); + if (( LA(1) in [TT_QUEST])) then + begin + match(TT_QUEST); + fGrammarMaker.optionalSubrule; + end + + else if (( LA(1) in [TT_STAR])) then + begin + match(TT_STAR); + fGrammarMaker.zeroOrMoreSubrule; + end + + else if (( LA(1) in [TT_PLUS])) then + begin + match(TT_PLUS); + fGrammarMaker.oneOrMoreSubrule; + end + + else if (( LA(1) in [TT_AT])) then + begin + match(TT_AT); + fGrammarMaker.nmSubrule; + match(TT_LPAREN); + if (( LA(1) in [TT_INTEGER])) then + begin + m := LT(1); + match(TT_INTEGER); + fGrammarMaker.refRangeLow( StrToInt(m.TokenText)); + if (( LA(1) in [TT_COMMA])) then + begin + match(TT_COMMA); + fGrammarMaker.refRangeHigh( maxint); + if (( LA(1) in [TT_INTEGER])) then + begin + n := LT(1); + match(TT_INTEGER); + fGrammarMaker.refRangeHigh(StrToInt(n.TokenText)); + end; + end; + end + + else if (( LA(1) in [TT_COMMA])) then + begin + match(TT_COMMA); + n := LT(1); + match(TT_INTEGER); + fGrammarMaker.refRangeHigh(StrToInt(n.TokenText)); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_COMMA,TT_INTEGER], InputState.FileName); + match(TT_RPAREN); + end + + else if (( LA(1) in [TT_IMPLIES])) then + begin + match(TT_IMPLIES); + fGrammarMaker.synPred; + end; + fGrammarMaker.endSubRule; +end; + +// ============================================================================ +// tree +// ============================================================================ +procedure TDpgParser.tree; +var + _cnt_75: integer; + lp: IToken; + +begin + + lp := LT(1); + match(TT_TREE_BEGIN); + fGrammarMaker.BeginTree(lp); + rootNode; + fGrammarMaker.BeginChildList; + _cnt_75 := 0; + + while(true) do + begin + if (( LA(1) in [TT_SEMPRED,TT_LPAREN,TT_NOT,TT_WILDCARD,TT_TREE_BEGIN..TT_STRINGLIT,TT_ACTION..TT_RULEREF])) then + begin + element; + end + + else + begin + if _cnt_75 >= 1 then + break + else + Raise EMismatchedToken.Create( LT(1), [TT_SEMPRED,TT_LPAREN,TT_NOT,TT_WILDCARD,TT_TREE_BEGIN..TT_STRINGLIT,TT_ACTION..TT_RULEREF], InputState.FileName); + end; + + INC(_cnt_75); + end; + fGrammarMaker.EndChildList; + match(TT_RPAREN); + fGrammarMaker.EndTree; +end; + +// ============================================================================ +// rootNode +// ============================================================================ +procedure TDpgParser.rootNode; +var + l : IToken; + +begin + + if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_COLON])) then + begin + l := id; + match(TT_COLON); + CheckEndRule(l); + end; + terminal(l); +end; + +// ============================================================================ +// astTypeSpec +// ============================================================================ +function TDpgParser.astTypeSpec: integer; +begin + + result := AUTOGEN_NONE; + + if (( LA(1) in [TT_CARET])) then + begin + match(TT_CARET); + result := AUTOGEN_CARET; + end + + else if (( LA(1) in [TT_BANG])) then + begin + match(TT_BANG); + result := AUTOGEN_BANG; + end; +end; + +// ============================================================================ +// subRuleOptions +// ============================================================================ +procedure TDpgParser.subRuleOptions; +var + optName : IToken; + optValue : IToken; + +begin + + match(TT_OPTIONS); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + optName := id; + match(TT_ASSIGN); + optValue := optionValue; + match(TT_SEMI); + fGrammarMaker.setSubruleOption( optName, optValue); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// 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; +end. diff --git a/src.lib/grammar/dpglib.DpgParserTokens.pas b/src.lib/grammar/dpglib.DpgParserTokens.pas new file mode 100644 index 0000000..72049ce --- /dev/null +++ b/src.lib/grammar/dpglib.DpgParserTokens.pas @@ -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. diff --git a/src.lib/grammar/dpglib.DpgParserTokens.txt b/src.lib/grammar/dpglib.DpgParserTokens.txt new file mode 100644 index 0000000..f451461 --- /dev/null +++ b/src.lib/grammar/dpglib.DpgParserTokens.txt @@ -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 diff --git a/src.lib/grammar/dpglib.TokenLexer.g b/src.lib/grammar/dpglib.TokenLexer.g new file mode 100644 index 0000000..cfd487d --- /dev/null +++ b/src.lib/grammar/dpglib.TokenLexer.g @@ -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; + } + ; diff --git a/src.lib/grammar/dpglib.TokenLexer.pas b/src.lib/grammar/dpglib.TokenLexer.pas new file mode 100644 index 0000000..d782367 --- /dev/null +++ b/src.lib/grammar/dpglib.TokenLexer.pas @@ -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. diff --git a/src.lib/grammar/dpglib.TokenLexerTokens.pas b/src.lib/grammar/dpglib.TokenLexerTokens.pas new file mode 100644 index 0000000..0811647 --- /dev/null +++ b/src.lib/grammar/dpglib.TokenLexerTokens.pas @@ -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. diff --git a/src.lib/grammar/dpglib.TokenLexerTokens.txt b/src.lib/grammar/dpglib.TokenLexerTokens.txt new file mode 100644 index 0000000..b5385f3 --- /dev/null +++ b/src.lib/grammar/dpglib.TokenLexerTokens.txt @@ -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 diff --git a/src.lib/grammar/dpglib.TokenParser.g b/src.lib/grammar/dpglib.TokenParser.g new file mode 100644 index 0000000..1531847 --- /dev/null +++ b/src.lib/grammar/dpglib.TokenParser.g @@ -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; + } + ; + + \ No newline at end of file diff --git a/src.lib/grammar/dpglib.TokenParser.pas b/src.lib/grammar/dpglib.TokenParser.pas new file mode 100644 index 0000000..5e88381 --- /dev/null +++ b/src.lib/grammar/dpglib.TokenParser.pas @@ -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. diff --git a/src.lib/grammar/dpglib.TokenParserTokens.pas b/src.lib/grammar/dpglib.TokenParserTokens.pas new file mode 100644 index 0000000..21d1863 --- /dev/null +++ b/src.lib/grammar/dpglib.TokenParserTokens.pas @@ -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. diff --git a/src.lib/grammar/dpglib.TokenParserTokens.txt b/src.lib/grammar/dpglib.TokenParserTokens.txt new file mode 100644 index 0000000..d16eb25 --- /dev/null +++ b/src.lib/grammar/dpglib.TokenParserTokens.txt @@ -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 diff --git a/src.lib/grammar/test/Lexer.g b/src.lib/grammar/test/Lexer.g new file mode 100644 index 0000000..81a0833 --- /dev/null +++ b/src.lib/grammar/test/Lexer.g @@ -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)); + } + ) + ; + diff --git a/src.lib/grammar/test/Parser.g b/src.lib/grammar/test/Parser.g new file mode 100644 index 0000000..57b0fa3 --- /dev/null +++ b/src.lib/grammar/test/Parser.g @@ -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; +} + + diff --git a/src.lib/grammar/test/z.dpglib.DpgLexer.pas b/src.lib/grammar/test/z.dpglib.DpgLexer.pas new file mode 100644 index 0000000..cc123df --- /dev/null +++ b/src.lib/grammar/test/z.dpglib.DpgLexer.pas @@ -0,0 +1,1746 @@ +// ============================================================================ +// This file is generated by the Delphi Parser Generator. +// ---------------------------------------------------------------------------- +// DPG version: 2.0.1.0r +// Grammar: lexer.g +// ============================================================================ +unit dpglib.DpgLexer; + +interface + +uses + Classes, + SysUtils, + dpglib.DpgLexerTokens, + dpgrtl.lexer, + dpgrtl.types; + +type + // ========================================================================= + // Class TDpgLexer declaration + // ========================================================================= + TDpgLexer = class( TLexer) + + protected // Internals + procedure initialize; override; + + public // Protected grammar rules + // Must callable from parser too + procedure mESC ( pCreate: boolean); + procedure mDNUMBER ( pCreate: boolean); + procedure mXNUMBER ( pCreate: boolean); + function mINT_RULEREF ( pCreate: boolean): integer; + procedure mWS_LOOP ( pCreate: boolean); + procedure mSLCOMMENT ( pCreate: boolean); + procedure mMLCOMMENT1 ( pCreate: boolean); + procedure mMLCOMMENT2 ( pCreate: boolean); + procedure mDDIGIT ( pCreate: boolean); + procedure mXDIGIT ( pCreate: boolean); + + public // Public grammar rules + procedure mLPAREN ( pCreate: boolean); + procedure mRPAREN ( pCreate: boolean); + procedure mRCURLY ( pCreate: boolean); + procedure mCOLON ( pCreate: boolean); + procedure mSEMI ( pCreate: boolean); + procedure mCOMMA ( pCreate: boolean); + procedure mASSIGN ( pCreate: boolean); + procedure mIMPLIES ( pCreate: boolean); + procedure mQUEST ( pCreate: boolean); + procedure mPLUS ( pCreate: boolean); + procedure mSTAR ( pCreate: boolean); + procedure mAT ( pCreate: boolean); + procedure mNOT ( pCreate: boolean); + procedure mOR ( pCreate: boolean); + procedure mBANG ( pCreate: boolean); + procedure mWILDCARD ( pCreate: boolean); + procedure mRANGE ( pCreate: boolean); + procedure mCHARLIT ( pCreate: boolean); + procedure mSTRINGLIT ( pCreate: boolean); + procedure mINTEGER ( pCreate: boolean); + procedure mARGACTION ( pCreate: boolean); + procedure mACTION ( pCreate: boolean); + procedure mTOKENREF ( pCreate: boolean); + procedure mRULEREF ( pCreate: boolean); + procedure mCOMMENT ( pCreate: boolean); + procedure mWS ( pCreate: boolean); + + public + function NextToken: IToken; override; + end; + +implementation +uses + dpgrtl.exception, + dpgrtl.token; + + +// ============================================================================ +// mLPAREN +// ============================================================================ +procedure TDpgLexer.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 TDpgLexer.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; + +// ============================================================================ +// mRCURLY +// ============================================================================ +procedure TDpgLexer.mRCURLY( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_RCURLY; + + 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; + +// ============================================================================ +// mCOLON +// ============================================================================ +procedure TDpgLexer.mCOLON( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_COLON; + + 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; + +// ============================================================================ +// mSEMI +// ============================================================================ +procedure TDpgLexer.mSEMI( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_SEMI; + + 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; + +// ============================================================================ +// mCOMMA +// ============================================================================ +procedure TDpgLexer.mCOMMA( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_COMMA; + + 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 TDpgLexer.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; + +// ============================================================================ +// mIMPLIES +// ============================================================================ +procedure TDpgLexer.mIMPLIES( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_IMPLIES; + + 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; + +// ============================================================================ +// mQUEST +// ============================================================================ +procedure TDpgLexer.mQUEST( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_QUEST; + + 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; + +// ============================================================================ +// mPLUS +// ============================================================================ +procedure TDpgLexer.mPLUS( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_PLUS; + + 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; + +// ============================================================================ +// mSTAR +// ============================================================================ +procedure TDpgLexer.mSTAR( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_STAR; + + 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; + +// ============================================================================ +// mAT +// ============================================================================ +procedure TDpgLexer.mAT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_AT; + + 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; + +// ============================================================================ +// mNOT +// ============================================================================ +procedure TDpgLexer.mNOT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_NOT; + + 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; + +// ============================================================================ +// mOR +// ============================================================================ +procedure TDpgLexer.mOR( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_OR; + + 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; + +// ============================================================================ +// mBANG +// ============================================================================ +procedure TDpgLexer.mBANG( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_BANG; + + 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; + +// ============================================================================ +// mWILDCARD +// ============================================================================ +procedure TDpgLexer.mWILDCARD( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_WILDCARD; + + 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; + +// ============================================================================ +// mRANGE +// ============================================================================ +procedure TDpgLexer.mRANGE( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_RANGE; + + 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; + +// ============================================================================ +// mCHARLIT +// ============================================================================ +procedure TDpgLexer.mCHARLIT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_CHARLIT; + + SaveConsumedInput := false; + match(''''); + SaveConsumedInput := true; + if (( LA(1) in ['\'])) then + begin + mESC(false); + end + + else if (( LA(1) in [#1..'&','('..'[',']'..#255])) then + begin + matchNot(''''); + end + + else + Raise EMismatchedChar.Create( LA(1), [#1..'&','('..#255], InputState.FileName, InputState.Line, InputState.Column); + SaveConsumedInput := false; + match(''''); + SaveConsumedInput := true; + + 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; + +// ============================================================================ +// mESC +// ============================================================================ +procedure TDpgLexer.mESC( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + d1: IToken; + d2: IToken; + number: AnsiString; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_ESC; + + SaveConsumedInput := false; + match('\'); + SaveConsumedInput := true; + if (( LA(1) in ['r'])) then + begin + match('r'); + TokenText[ Length( TokenText)] := AnsiChar(13); + end + + else if (( LA(1) in ['n'])) then + begin + match('n'); + TokenText[ Length( TokenText)] := AnsiChar(10); + end + + else if (( LA(1) in ['t'])) then + begin + match('t'); + TokenText[ Length( TokenText)] := AnsiChar(9); + end + + else if (( LA(1) in ['\'])) then + begin + match('\'); + end + + else if (( LA(1) in [''''])) then + begin + match(''''); + end + + else if (( LA(1) in ['"'])) then + begin + match('"'); + end + + else if (( LA(1) in ['x'])) then + begin + match('x'); + _save := Length( TokenText); + mXDIGIT(true); + TokenText := Copy(TokenText, 1, _save); + d1 := ReturnToken; + _save := Length( TokenText); + mXDIGIT(true); + TokenText := Copy(TokenText, 1, _save); + d2 := ReturnToken; + number := '$' + d1.TokenText + d2.TokenText; + TokenText[ Length( TokenText)] := AnsiChar( StrToInt( number)); + end + + else + Raise EMismatchedChar.Create( LA(1), ['"','''','\','n','r','t','x'], 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; + +// ============================================================================ +// mSTRINGLIT +// ============================================================================ +procedure TDpgLexer.mSTRINGLIT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_STRINGLIT; + + match('"'); + + while(true) do + begin + if (( LA(1) in ['\'])) then + begin + mESC(false); + end + + else 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; + +// ============================================================================ +// mINTEGER +// ============================================================================ +procedure TDpgLexer.mINTEGER( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + i: integer; + v: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_INTEGER; + + if (( LA(1) in ['0'..'9'])) then + begin + mDNUMBER(false); + v := 0; + for i:=1 to Length( TokenText) do + begin + v := v * 10 + ord( TokenText[i]) - ord('0'); + end; + + TokenText := IntToStr( v); + end + + else if (( LA(1) in ['$'])) then + begin + mXNUMBER(false); + 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); + end + + else + Raise EMismatchedChar.Create( LA(1), ['$','0'..'9'], 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; + +// ============================================================================ +// mDNUMBER +// ============================================================================ +procedure TDpgLexer.mDNUMBER( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_DNUMBER; + + match( ['0'..'9']); + + while(true) do + begin + if (( LA(1) in ['0'..'9'])) then + begin + mDDIGIT(false); + 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; + +// ============================================================================ +// mXNUMBER +// ============================================================================ +procedure TDpgLexer.mXNUMBER( pCreate: boolean); +var + _begin: integer; + _cnt_60: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_XNUMBER; + + SaveConsumedInput := false; + match('$'); + SaveConsumedInput := true; + _cnt_60 := 0; + + while(true) do + begin + if (( LA(1) in ['0'..'9','A'..'F','a'..'f'])) then + begin + mXDIGIT(false); + end + + else + begin + if _cnt_60 >= 1 then + break + else + Raise EMismatchedChar.Create( LA(1), ['0'..'9','A'..'F','a'..'f'], InputState.FileName, InputState.Line, InputState.Column); + end; + + INC(_cnt_60); + 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; + +// ============================================================================ +// mARGACTION +// ============================================================================ +procedure TDpgLexer.mARGACTION( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_ARGACTION; + + SaveConsumedInput := false; + match('['); + SaveConsumedInput := true; + + while(true) do + begin + 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 + matchNot(']'); + end + + else + break; + end; + + SaveConsumedInput := false; + match(']'); + SaveConsumedInput := true; + + 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; + +// ============================================================================ +// mACTION +// ============================================================================ +procedure TDpgLexer.mACTION( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_ACTION; + + match('{'); + + while(true) do + begin + 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 + matchNot('}'); + end + + else + break; + end; + + match('}'); + if (( LA(1) in ['?'])) then + begin + SaveConsumedInput := false; + match('?'); + SaveConsumedInput := true; + _ttype := TT_SEMPRED; + 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; + +// ============================================================================ +// mTOKENREF +// ============================================================================ +procedure TDpgLexer.mTOKENREF( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_TOKENREF; + + match( ['A'..'Z']); + + 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; + + _ttype := TestLiteral( _ttype); + + + 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; + +// ============================================================================ +// mRULEREF +// ============================================================================ +procedure TDpgLexer.mRULEREF( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + t: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_RULEREF; + + t := mINT_RULEREF(false); + _ttype := t; + if ( t = LT_uses) then + begin + mWS_LOOP(false); + if (( LA(1) in ['{'])) then + begin + match('{'); + _ttype := TT_USES; + end; + end + + else if ( t = LT_options) then + begin + mWS_LOOP(false); + if (( LA(1) in ['{'])) then + begin + match('{'); + _ttype := TT_OPTIONS; + end; + end + + else if ( t = LT_tokens) then + begin + mWS_LOOP(false); + if (( LA(1) in ['{'])) then + begin + match('{'); + _ttype := TT_TOKENS; + end; + 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_RULEREF +// ============================================================================ +function TDpgLexer.mINT_RULEREF( pCreate: boolean): integer; +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_INT_RULEREF; + + _ttype := TT_RULEREF; + + match( ['a'..'z']); + + 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; + + result := TestLiteral( _ttype); + + 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_LOOP +// ============================================================================ +procedure TDpgLexer.mWS_LOOP( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_WS_LOOP; + + + while(true) do + begin + if (( LA(1) in [#9..#10,#13,' '])) then + begin + mWS(false); + end + + else if (( LA(1) in ['(','/'])) then + begin + mCOMMENT(false); + 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; + +// ============================================================================ +// mCOMMENT +// ============================================================================ +procedure TDpgLexer.mCOMMENT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_COMMENT; + + if (( LA(1) in ['/']) and (LA(2) in ['/'])) then + begin + mSLCOMMENT(false); + _ttype := TT_SKIP; + end + + else if (( LA(1) in ['/']) and (LA(2) in ['*'])) then + begin + mMLCOMMENT2(false); + _ttype := TT_SKIP; + end + + else if (( LA(1) in ['('])) then + begin + mMLCOMMENT1(false); + _ttype := TT_SKIP; + end + + else + Raise EMismatchedChar.Create( LA(1), ['(','/'], 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; + +// ============================================================================ +// mSLCOMMENT +// ============================================================================ +procedure TDpgLexer.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); + + 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; + +// ============================================================================ +// mMLCOMMENT1 +// ============================================================================ +procedure TDpgLexer.mMLCOMMENT1( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_MLCOMMENT1; + + 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 + matchNot( EOF_CHAR ); + 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; + +// ============================================================================ +// mMLCOMMENT2 +// ============================================================================ +procedure TDpgLexer.mMLCOMMENT2( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_MLCOMMENT2; + + 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 + matchNot( EOF_CHAR ); + 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; + +// ============================================================================ +// mDDIGIT +// ============================================================================ +procedure TDpgLexer.mDDIGIT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_DDIGIT; + + 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 TDpgLexer.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; + +// ============================================================================ +// mWS +// ============================================================================ +procedure TDpgLexer.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); + tab; + 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; + +// ---------------------------------------------------------------------------- +// NextToken +// ---------------------------------------------------------------------------- +function TDpgLexer.NextToken : IToken; +var + _first : TCharSet; + +begin + _first := [#9..#10,#13,' '..'"','$',''''..',','.'..';','=','?'..'[','a'..'~']; + + while( true) do + begin + ResetText; + + try + if (( LA(1) in ['=']) and (LA(2) in ['>'])) then + begin + mIMPLIES(true); + result := ReturnToken; + end + + else if (( LA(1) in ['.']) and (LA(2) in ['.'])) then + begin + mRANGE(true); + result := ReturnToken; + end + + else if (( LA(1) in ['(','/']) and (LA(2) in ['*','/'])) then + begin + mCOMMENT(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 + mRCURLY(true); + result := ReturnToken; + end + + else if (( LA(1) in [':'])) then + begin + mCOLON(true); + result := ReturnToken; + end + + else if (( LA(1) in [';'])) then + begin + mSEMI(true); + result := ReturnToken; + end + + else if (( LA(1) in [','])) then + begin + mCOMMA(true); + result := ReturnToken; + end + + else if (( LA(1) in ['='])) then + begin + mASSIGN(true); + result := ReturnToken; + end + + else if (( LA(1) in ['?'])) then + begin + mQUEST(true); + result := ReturnToken; + end + + else if (( LA(1) in ['+'])) then + begin + mPLUS(true); + result := ReturnToken; + end + + else if (( LA(1) in ['*'])) then + begin + mSTAR(true); + result := ReturnToken; + end + + else if (( LA(1) in ['@'])) then + begin + mAT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['~'])) then + begin + mNOT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['|'])) then + begin + mOR(true); + result := ReturnToken; + end + + else if (( LA(1) in ['!'])) then + begin + mBANG(true); + result := ReturnToken; + end + + else if (( LA(1) in ['.'])) then + begin + mWILDCARD(true); + result := ReturnToken; + end + + else if (( LA(1) in [''''])) then + begin + mCHARLIT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['"'])) then + begin + mSTRINGLIT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['$','0'..'9'])) then + begin + mINTEGER(true); + result := ReturnToken; + end + + else if (( LA(1) in ['['])) then + begin + mARGACTION(true); + result := ReturnToken; + end + + else if (( LA(1) in ['{'])) then + begin + mACTION(true); + result := ReturnToken; + end + + else if (( LA(1) in ['A'..'Z'])) then + begin + mTOKENREF(true); + result := ReturnToken; + end + + else if (( LA(1) in ['a'..'z'])) then + begin + mRULEREF(true); + result := ReturnToken; + end + + else if (( LA(1) in [#9..#10,#13,' '])) then + begin + mWS(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; + +// ---------------------------------------------------------------------------- +// InitLiterals +// ---------------------------------------------------------------------------- +procedure TDpgLexer.initialize; +begin + fLiterals['unit' ] := 4; + fLiterals['uses' ] := 5; + fLiterals['const' ] := 6; + fLiterals['type' ] := 7; + fLiterals['lexer' ] := 8; + fLiterals['parser' ] := 9; + fLiterals['options' ] := 10; + fLiterals['tokens' ] := 11; + fLiterals['memberdecl' ] := 12; + fLiterals['memberdef' ] := 13; + fLiterals['private' ] := 14; + fLiterals['protected' ] := 15; + fLiterals['public' ] := 16; + fLiterals['returns' ] := 17; + fLiterals['local' ] := 18; + fLiterals['except' ] := 19; + fLiterals['finally' ] := 20; +end; + +end. diff --git a/src.lib/grammar/test/z.dpglib.DpgLexerTokens.pas b/src.lib/grammar/test/z.dpglib.DpgLexerTokens.pas new file mode 100644 index 0000000..888f5af --- /dev/null +++ b/src.lib/grammar/test/z.dpglib.DpgLexerTokens.pas @@ -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. diff --git a/src.lib/grammar/test/z.dpglib.DpgLexerTokens.txt b/src.lib/grammar/test/z.dpglib.DpgLexerTokens.txt new file mode 100644 index 0000000..73f7711 --- /dev/null +++ b/src.lib/grammar/test/z.dpglib.DpgLexerTokens.txt @@ -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 diff --git a/src.lib/save/z.dpglib.DpgLexer.pas b/src.lib/save/z.dpglib.DpgLexer.pas new file mode 100644 index 0000000..446f651 --- /dev/null +++ b/src.lib/save/z.dpglib.DpgLexer.pas @@ -0,0 +1,1749 @@ +// ============================================================================ +// This file is generated by the Delphi Parser Generator. +// ---------------------------------------------------------------------------- +// DPG version: 2.0.1.0r +// Grammar: dpglib.DpgLexer.g +// ============================================================================ +unit dpglib.DpgLexer; + +interface + +uses + Classes, + SysUtils, + dpglib.DpgLexerTokens, + dpgrtl.lexer, + dpgrtl.types; + +type + // ========================================================================= + // Class TDpgLexer declaration + // ========================================================================= + TDpgLexer = class( TLexer) + + protected // Internals + procedure initialize; override; + + public // Protected grammar rules + // Must callable from parser too + procedure mESC ( pCreate: boolean); + procedure mDNUMBER ( pCreate: boolean); + procedure mXNUMBER ( pCreate: boolean); + function mINT_RULEREF ( pCreate: boolean): integer; + procedure mWS_LOOP ( pCreate: boolean); + procedure mSLCOMMENT ( pCreate: boolean); + procedure mMLCOMMENT1 ( pCreate: boolean); + procedure mMLCOMMENT2 ( pCreate: boolean); + procedure mDDIGIT ( pCreate: boolean); + procedure mXDIGIT ( pCreate: boolean); + + public // Public grammar rules + procedure mLPAREN ( pCreate: boolean); + procedure mRPAREN ( pCreate: boolean); + procedure mRCURLY ( pCreate: boolean); + procedure mCOLON ( pCreate: boolean); + procedure mSEMI ( pCreate: boolean); + procedure mCOMMA ( pCreate: boolean); + procedure mASSIGN ( pCreate: boolean); + procedure mIMPLIES ( pCreate: boolean); + procedure mQUEST ( pCreate: boolean); + procedure mPLUS ( pCreate: boolean); + procedure mSTAR ( pCreate: boolean); + procedure mAT ( pCreate: boolean); + procedure mNOT ( pCreate: boolean); + procedure mOR ( pCreate: boolean); + procedure mBANG ( pCreate: boolean); + procedure mWILDCARD ( pCreate: boolean); + procedure mRANGE ( pCreate: boolean); + procedure mCHARLIT ( pCreate: boolean); + procedure mSTRINGLIT ( pCreate: boolean); + procedure mINTEGER ( pCreate: boolean); + procedure mARGACTION ( pCreate: boolean); + procedure mACTION ( pCreate: boolean); + procedure mTOKENREF ( pCreate: boolean); + procedure mRULEREF ( pCreate: boolean); + procedure mCOMMENT ( pCreate: boolean); + procedure mWS ( pCreate: boolean); + + public + function NextToken: IToken; override; + end; + +implementation +uses + dpgrtl.exception, + dpgrtl.token; + + +// ============================================================================ +// mLPAREN +// ============================================================================ +procedure TDpgLexer.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 TDpgLexer.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; + +// ============================================================================ +// mRCURLY +// ============================================================================ +procedure TDpgLexer.mRCURLY( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_RCURLY; + + 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; + +// ============================================================================ +// mCOLON +// ============================================================================ +procedure TDpgLexer.mCOLON( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_COLON; + + 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; + +// ============================================================================ +// mSEMI +// ============================================================================ +procedure TDpgLexer.mSEMI( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_SEMI; + + 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; + +// ============================================================================ +// mCOMMA +// ============================================================================ +procedure TDpgLexer.mCOMMA( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_COMMA; + + 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 TDpgLexer.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; + +// ============================================================================ +// mIMPLIES +// ============================================================================ +procedure TDpgLexer.mIMPLIES( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_IMPLIES; + + 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; + +// ============================================================================ +// mQUEST +// ============================================================================ +procedure TDpgLexer.mQUEST( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_QUEST; + + 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; + +// ============================================================================ +// mPLUS +// ============================================================================ +procedure TDpgLexer.mPLUS( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_PLUS; + + 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; + +// ============================================================================ +// mSTAR +// ============================================================================ +procedure TDpgLexer.mSTAR( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_STAR; + + 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; + +// ============================================================================ +// mAT +// ============================================================================ +procedure TDpgLexer.mAT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_AT; + + 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; + +// ============================================================================ +// mNOT +// ============================================================================ +procedure TDpgLexer.mNOT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_NOT; + + 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; + +// ============================================================================ +// mOR +// ============================================================================ +procedure TDpgLexer.mOR( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_OR; + + 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; + +// ============================================================================ +// mBANG +// ============================================================================ +procedure TDpgLexer.mBANG( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_BANG; + + 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; + +// ============================================================================ +// mWILDCARD +// ============================================================================ +procedure TDpgLexer.mWILDCARD( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_WILDCARD; + + 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; + +// ============================================================================ +// mRANGE +// ============================================================================ +procedure TDpgLexer.mRANGE( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_RANGE; + + 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; + +// ============================================================================ +// mCHARLIT +// ============================================================================ +procedure TDpgLexer.mCHARLIT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_CHARLIT; + + SaveConsumedInput := false; + match(''''); + SaveConsumedInput := true; + if (( LA(1) in ['\'])) then + begin + mESC(false); + end + + else if (( LA(1) in [#1..'&','('..'[',']'..#255])) then + begin + matchNot(''''); + end + + else + Raise EMismatchedChar.Create( LA(1), [#1..'&','('..#255], InputState.FileName, InputState.Line, InputState.Column); + SaveConsumedInput := false; + match(''''); + SaveConsumedInput := true; + + 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; + +// ============================================================================ +// mESC +// ============================================================================ +procedure TDpgLexer.mESC( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + d1: IToken; + d2: IToken; + number: AnsiString; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_ESC; + + SaveConsumedInput := false; + match('\'); + SaveConsumedInput := true; + if (( LA(1) in ['r'])) then + begin + match('r'); + TokenText[ Length( TokenText)] := AnsiChar(13); + end + + else if (( LA(1) in ['n'])) then + begin + match('n'); + TokenText[ Length( TokenText)] := AnsiChar(10); + end + + else if (( LA(1) in ['t'])) then + begin + match('t'); + TokenText[ Length( TokenText)] := AnsiChar(9); + end + + else if (( LA(1) in ['\'])) then + begin + match('\'); + end + + else if (( LA(1) in [''''])) then + begin + match(''''); + end + + else if (( LA(1) in ['"'])) then + begin + match('"'); + end + + else if (( LA(1) in ['x'])) then + begin + match('x'); + _save := Length( TokenText); + mXDIGIT(true); + TokenText := Copy(TokenText, 1, _save); + d1 := ReturnToken; + _save := Length( TokenText); + mXDIGIT(true); + TokenText := Copy(TokenText, 1, _save); + d2 := ReturnToken; + number := '$' + d1.TokenText + d2.TokenText; + TokenText[ Length( TokenText)] := AnsiChar( StrToInt( number)); + end + + else + Raise EMismatchedChar.Create( LA(1), ['"','''','\','n','r','t','x'], 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; + +// ============================================================================ +// mSTRINGLIT +// ============================================================================ +procedure TDpgLexer.mSTRINGLIT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + _la1 : AnsiChar; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_STRINGLIT; + + match('"'); + + while(true) do + begin + _la1 := LA(1); + + if (( LA(1) in ['\'])) then + begin + mESC(false); + end + + else 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; + +// ============================================================================ +// mINTEGER +// ============================================================================ +procedure TDpgLexer.mINTEGER( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + i: integer; + v: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_INTEGER; + + if (( LA(1) in ['0'..'9'])) then + begin + mDNUMBER(false); + v := 0; + for i:=1 to Length( TokenText) do + begin + v := v * 10 + ord( TokenText[i]) - ord('0'); + end; + + TokenText := IntToStr( v); + end + + else if (( LA(1) in ['$'])) then + begin + mXNUMBER(false); + 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); + end + + else + Raise EMismatchedChar.Create( LA(1), ['$','0'..'9'], 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; + +// ============================================================================ +// mDNUMBER +// ============================================================================ +procedure TDpgLexer.mDNUMBER( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_DNUMBER; + + match( ['0'..'9']); + + while(true) do + begin + if (( LA(1) in ['0'..'9'])) then + begin + mDDIGIT(false); + 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; + +// ============================================================================ +// mXNUMBER +// ============================================================================ +procedure TDpgLexer.mXNUMBER( pCreate: boolean); +var + _begin: integer; + _cnt_60: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_XNUMBER; + + SaveConsumedInput := false; + match('$'); + SaveConsumedInput := true; + _cnt_60 := 0; + + while(true) do + begin + if (( LA(1) in ['0'..'9','A'..'F','a'..'f'])) then + begin + mXDIGIT(false); + end + + else + begin + if _cnt_60 >= 1 then + break + else + Raise EMismatchedChar.Create( LA(1), ['0'..'9','A'..'F','a'..'f'], InputState.FileName, InputState.Line, InputState.Column); + end; + + INC(_cnt_60); + 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; + +// ============================================================================ +// mARGACTION +// ============================================================================ +procedure TDpgLexer.mARGACTION( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_ARGACTION; + + SaveConsumedInput := false; + match('['); + SaveConsumedInput := true; + + while(true) do + begin + 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 + matchNot(']'); + end + + else + break; + end; + + SaveConsumedInput := false; + match(']'); + SaveConsumedInput := true; + + 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; + +// ============================================================================ +// mACTION +// ============================================================================ +procedure TDpgLexer.mACTION( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_ACTION; + + match('{'); + + while(true) do + begin + 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 + matchNot('}'); + end + + else + break; + end; + + match('}'); + if (( LA(1) in ['?'])) then + begin + SaveConsumedInput := false; + match('?'); + SaveConsumedInput := true; + _ttype := TT_SEMPRED; + 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; + +// ============================================================================ +// mTOKENREF +// ============================================================================ +procedure TDpgLexer.mTOKENREF( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_TOKENREF; + + match( ['A'..'Z']); + + 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; + + _ttype := TestLiteral( _ttype); + + + 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; + +// ============================================================================ +// mRULEREF +// ============================================================================ +procedure TDpgLexer.mRULEREF( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + t: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_RULEREF; + + t := mINT_RULEREF(false); + _ttype := t; + if ( t = LT_uses) then + begin + mWS_LOOP(false); + if (( LA(1) in ['{'])) then + begin + match('{'); + _ttype := TT_USES; + end; + end + + else if ( t = LT_options) then + begin + mWS_LOOP(false); + if (( LA(1) in ['{'])) then + begin + match('{'); + _ttype := TT_OPTIONS; + end; + end + + else if ( t = LT_tokens) then + begin + mWS_LOOP(false); + if (( LA(1) in ['{'])) then + begin + match('{'); + _ttype := TT_TOKENS; + end; + 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_RULEREF +// ============================================================================ +function TDpgLexer.mINT_RULEREF( pCreate: boolean): integer; +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_INT_RULEREF; + + _ttype := TT_RULEREF; + + match( ['a'..'z']); + + 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; + + result := TestLiteral( _ttype); + + 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_LOOP +// ============================================================================ +procedure TDpgLexer.mWS_LOOP( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_WS_LOOP; + + + while(true) do + begin + if (( LA(1) in [#9..#10,#13,' '])) then + begin + mWS(false); + end + + else if (( LA(1) in ['(','/'])) then + begin + mCOMMENT(false); + 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; + +// ============================================================================ +// mCOMMENT +// ============================================================================ +procedure TDpgLexer.mCOMMENT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_COMMENT; + + if (( LA(1) in ['/']) and (LA(2) in ['/'])) then + begin + mSLCOMMENT(false); + _ttype := TT_SKIP; + end + + else if (( LA(1) in ['/']) and (LA(2) in ['*'])) then + begin + mMLCOMMENT2(false); + _ttype := TT_SKIP; + end + + else if (( LA(1) in ['('])) then + begin + mMLCOMMENT1(false); + _ttype := TT_SKIP; + end + + else + Raise EMismatchedChar.Create( LA(1), ['(','/'], 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; + +// ============================================================================ +// mSLCOMMENT +// ============================================================================ +procedure TDpgLexer.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); + + 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; + +// ============================================================================ +// mMLCOMMENT1 +// ============================================================================ +procedure TDpgLexer.mMLCOMMENT1( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_MLCOMMENT1; + + 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 + matchNot( EOF_CHAR ); + 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; + +// ============================================================================ +// mMLCOMMENT2 +// ============================================================================ +procedure TDpgLexer.mMLCOMMENT2( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_MLCOMMENT2; + + 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 + matchNot( EOF_CHAR ); + 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; + +// ============================================================================ +// mDDIGIT +// ============================================================================ +procedure TDpgLexer.mDDIGIT( pCreate: boolean); +var + _begin: integer; + _save: integer; + _token: IToken; + _ttype: integer; + +begin + _begin := Length( TokenText) +1; + _token := nil; + _ttype := TT_DDIGIT; + + 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 TDpgLexer.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; + +// ============================================================================ +// mWS +// ============================================================================ +procedure TDpgLexer.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); + tab; + 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; + +// ---------------------------------------------------------------------------- +// NextToken +// ---------------------------------------------------------------------------- +function TDpgLexer.NextToken : IToken; +var + _first : TCharSet; + +begin + _first := [#9..#10,#13,' '..'"','$',''''..',','.'..';','=','?'..'[','a'..'~']; + + while( true) do + begin + ResetText; + + try + if (( LA(1) in ['=']) and (LA(2) in ['>'])) then + begin + mIMPLIES(true); + result := ReturnToken; + end + + else if (( LA(1) in ['.']) and (LA(2) in ['.'])) then + begin + mRANGE(true); + result := ReturnToken; + end + + else if (( LA(1) in ['(','/']) and (LA(2) in ['*','/'])) then + begin + mCOMMENT(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 + mRCURLY(true); + result := ReturnToken; + end + + else if (( LA(1) in [':'])) then + begin + mCOLON(true); + result := ReturnToken; + end + + else if (( LA(1) in [';'])) then + begin + mSEMI(true); + result := ReturnToken; + end + + else if (( LA(1) in [','])) then + begin + mCOMMA(true); + result := ReturnToken; + end + + else if (( LA(1) in ['='])) then + begin + mASSIGN(true); + result := ReturnToken; + end + + else if (( LA(1) in ['?'])) then + begin + mQUEST(true); + result := ReturnToken; + end + + else if (( LA(1) in ['+'])) then + begin + mPLUS(true); + result := ReturnToken; + end + + else if (( LA(1) in ['*'])) then + begin + mSTAR(true); + result := ReturnToken; + end + + else if (( LA(1) in ['@'])) then + begin + mAT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['~'])) then + begin + mNOT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['|'])) then + begin + mOR(true); + result := ReturnToken; + end + + else if (( LA(1) in ['!'])) then + begin + mBANG(true); + result := ReturnToken; + end + + else if (( LA(1) in ['.'])) then + begin + mWILDCARD(true); + result := ReturnToken; + end + + else if (( LA(1) in [''''])) then + begin + mCHARLIT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['"'])) then + begin + mSTRINGLIT(true); + result := ReturnToken; + end + + else if (( LA(1) in ['$','0'..'9'])) then + begin + mINTEGER(true); + result := ReturnToken; + end + + else if (( LA(1) in ['['])) then + begin + mARGACTION(true); + result := ReturnToken; + end + + else if (( LA(1) in ['{'])) then + begin + mACTION(true); + result := ReturnToken; + end + + else if (( LA(1) in ['A'..'Z'])) then + begin + mTOKENREF(true); + result := ReturnToken; + end + + else if (( LA(1) in ['a'..'z'])) then + begin + mRULEREF(true); + result := ReturnToken; + end + + else if (( LA(1) in [#9..#10,#13,' '])) then + begin + mWS(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; + +// ---------------------------------------------------------------------------- +// InitLiterals +// ---------------------------------------------------------------------------- +procedure TDpgLexer.initialize; +begin + fLiterals['unit' ] := 4; + fLiterals['uses' ] := 5; + fLiterals['const' ] := 6; + fLiterals['type' ] := 7; + fLiterals['lexer' ] := 8; + fLiterals['parser' ] := 9; + fLiterals['options' ] := 10; + fLiterals['tokens' ] := 11; + fLiterals['memberdecl' ] := 12; + fLiterals['memberdef' ] := 13; + fLiterals['private' ] := 14; + fLiterals['protected' ] := 15; + fLiterals['public' ] := 16; + fLiterals['returns' ] := 17; + fLiterals['local' ] := 18; + fLiterals['except' ] := 19; + fLiterals['finally' ] := 20; +end; + +end. diff --git a/src.lib/save/z.dpglib.DpgLexerTokens.pas b/src.lib/save/z.dpglib.DpgLexerTokens.pas new file mode 100644 index 0000000..984453f --- /dev/null +++ b/src.lib/save/z.dpglib.DpgLexerTokens.pas @@ -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. diff --git a/src.lib/save/z.dpglib.DpgParser.pas b/src.lib/save/z.dpglib.DpgParser.pas new file mode 100644 index 0000000..8a8a54c --- /dev/null +++ b/src.lib/save/z.dpglib.DpgParser.pas @@ -0,0 +1,1297 @@ +// ============================================================================ +// This file is generated by the Delphi Parser Generator. +// ---------------------------------------------------------------------------- +// DPG version: 2.0.1.0r +// Grammar: dpglib.DpgParser.g +// ============================================================================ +unit dpglib.DpgParser; + +interface + +uses + Classes, + SysUtils, + dpglib.DpgParserTokens, + dpglib.types, + dpgrtl.llkparser, + dpgrtl.types; + +type + // ========================================================================= + // Class TDpgParser declaration + // ========================================================================= + TDpgParser = class( TLLkParser) + + 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; + + public // Public grammar rules + procedure grammar ; + function qualifiedId : IToken; + procedure usesDecl ; + procedure constDecl ; + procedure typeDecl ; + procedure classDecl ; + procedure qualifiedUsesName ; + function id : IToken; + procedure classOptions ; + procedure classTokens ; + procedure classMemberDecl ; + procedure rules ; + procedure classMemberDef ; + function optionValue : IToken; + procedure rule ; + procedure ruleExceptionBlock ; + procedure altExceptionBlock ; + procedure ruleOptions ; + procedure block ; + procedure alternative ; + procedure elem ; + procedure element ; + procedure range ( pTokenLabel: IToken); + procedure terminal ( pTokenLabel: IToken); + procedure notTerminal ( pTokenLabel: IToken); + procedure ebnf ( pTokenLabel: IToken; pTokenNot: boolean); + function astTypeSpec : integer; + procedure subRuleOptions ; + + end; + +implementation +uses + dpgrtl.exception, + dpgrtl.token; + + +// ============================================================================ +// grammar +// ============================================================================ +procedure TDpgParser.grammar; +var + unitName: IToken; + +begin + + match(LT_unit); + unitName := qualifiedId; + fGrammarUnit := unitName.TokenText; + match(TT_SEMI); + if (( LA(1) in [TT_USES])) then + begin + usesDecl; + end; + if (( LA(1) in [LT_const])) then + begin + constDecl; + end; + if (( LA(1) in [LT_type])) then + begin + typeDecl; + end; + classDecl; + fGrammarMaker.endGrammar; +end; + +// ============================================================================ +// qualifiedId +// ============================================================================ +function TDpgParser.qualifiedId: IToken; +var + buf : AnsiString; + a : IToken; + +begin + + a := id; + buf := a.TokenText; + + while(true) do + begin + if (( LA(1) in [TT_WILDCARD])) then + begin + match(TT_WILDCARD); + a := id; + buf := buf + '.' + a.TokenText; + end + + else + break; + end; + + // ----------------------------------------------------------- + // 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; +end; + +// ============================================================================ +// usesDecl +// ============================================================================ +procedure TDpgParser.usesDecl; +begin + + match(TT_USES); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + qualifiedUsesName; + match(TT_SEMI); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// constDecl +// ============================================================================ +procedure TDpgParser.constDecl; +var + a: IToken; + +begin + + match(LT_const); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefConstAction( a); +end; + +// ============================================================================ +// typeDecl +// ============================================================================ +procedure TDpgParser.typeDecl; +var + a: IToken; + +begin + + match(LT_type); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefTypeAction( a); +end; + +// ============================================================================ +// classDecl +// ============================================================================ +procedure TDpgParser.classDecl; +var + grType : integer; + grObject : IToken; + grSuper : IToken; + +begin + + grObject := nil; + grSuper := nil; + + if (( LA(1) in [LT_lexer])) then + begin + match(LT_lexer); + grType := 0; + end + + else if (( LA(1) in [LT_parser])) then + begin + match(LT_parser); + grType := 1; + end + + else + Raise EMismatchedToken.Create( LT(1), [LT_lexer..LT_parser], InputState.FileName); + grObject := id; + match(TT_SEMI); + // --------------------------------------------------------- + // 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); + if (( LA(1) in [TT_OPTIONS])) then + begin + classOptions; + end; + if ((( LA(1) in [TT_TOKENS])) and (grType=0)) then + begin + classTokens; + end; + if (( LA(1) in [LT_memberdecl])) then + begin + classMemberDecl; + end; + rules; + if (( LA(1) in [LT_memberdef])) then + begin + classMemberDef; + end; +end; + +// ============================================================================ +// qualifiedUsesName +// ============================================================================ +procedure TDpgParser.qualifiedUsesName; +var + r: IToken; + id: AnsiString; + +begin + + if (( LA(1) in [TT_TOKENREF])) then + begin + r := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_RULEREF])) then + begin + r := LT(1); + match(TT_RULEREF); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName); + id := r.TokenText; + + while(true) do + begin + if (( LA(1) in [TT_WILDCARD])) then + begin + match(TT_WILDCARD); + if (( LA(1) in [TT_TOKENREF])) then + begin + r := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_RULEREF])) then + begin + r := LT(1); + match(TT_RULEREF); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName); + id := id +'.'+ r.TokenText; + end + + else + break; + end; + + fGrammarMaker.defineUses(id); +end; + +// ============================================================================ +// id +// ============================================================================ +function TDpgParser.id: IToken; +begin + + if (( LA(1) in [TT_TOKENREF])) then + begin + result := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_RULEREF])) then + begin + result := LT(1); + match(TT_RULEREF); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName); +end; + +// ============================================================================ +// classOptions +// ============================================================================ +procedure TDpgParser.classOptions; +var + optName : IToken; + optValue : IToken; + +begin + + match(TT_OPTIONS); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + optName := id; + match(TT_ASSIGN); + optValue := optionValue; + match(TT_SEMI); + fGrammarMaker.setGrammarOption( optName, optValue); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// classTokens +// ============================================================================ +procedure TDpgParser.classTokens; +var + tokenName: IToken; + tokenString: IToken; + +begin + + match(TT_TOKENS); + + while(true) do + begin + if (( LA(1) in [TT_STRINGLIT,TT_TOKENREF])) then + begin + tokenName := nil; + tokenString := nil; + if (( LA(1) in [TT_TOKENREF])) then + begin + tokenName := LT(1); + match(TT_TOKENREF); + if (( LA(1) in [TT_ASSIGN])) then + begin + match(TT_ASSIGN); + tokenString := LT(1); + match(TT_STRINGLIT); + end; + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + tokenString := LT(1); + match(TT_STRINGLIT); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_STRINGLIT,TT_TOKENREF], InputState.FileName); + match(TT_SEMI); + fGrammarMaker.defineToken( tokenName, tokenString); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// classMemberDecl +// ============================================================================ +procedure TDpgParser.classMemberDecl; +var + memberDecl: IToken; + +begin + + match(LT_memberdecl); + memberDecl := LT(1); + match(TT_ACTION); + fGrammarMaker.refMemberDecl(memberDecl); +end; + +// ============================================================================ +// rules +// ============================================================================ +procedure TDpgParser.rules; +begin + + + while(true) do + begin + if (( LA(1) in [LT_private..LT_public,TT_TOKENREF..TT_RULEREF])) then + begin + rule; + end + + else + break; + end; + +end; + +// ============================================================================ +// classMemberDef +// ============================================================================ +procedure TDpgParser.classMemberDef; +var + memberDef: IToken; + +begin + + match(LT_memberdef); + memberDef := LT(1); + match(TT_ACTION); + fGrammarMaker.refMemberDef(memberDef); +end; + +// ============================================================================ +// optionValue +// ============================================================================ +function TDpgParser.optionValue: IToken; +begin + + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + result := qualifiedId; + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + result := LT(1); + match(TT_STRINGLIT); + end + + else if (( LA(1) in [TT_CHARLIT])) then + begin + result := LT(1); + match(TT_CHARLIT); + end + + else if (( LA(1) in [TT_INTEGER])) then + begin + result := LT(1); + match(TT_INTEGER); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_CHARLIT..TT_INTEGER,TT_TOKENREF..TT_RULEREF], InputState.FileName); +end; + +// ============================================================================ +// rule +// ============================================================================ +procedure TDpgParser.rule; +var + args: IToken; + initAction: IToken; + locals: IToken; + ret: IToken; + access : AnsiString; + ag : integer; + returns : IToken; + name : IToken; + +begin + + access := 'public'; + args := nil; + name := nil; + ag := AUTOGEN_NONE; + + if (( LA(1) in [LT_public])) then + begin + match(LT_public); + access := 'public'; + end + + else if (( LA(1) in [LT_protected])) then + begin + match(LT_protected); + access := 'protected'; + end + + else if (( LA(1) in [LT_private])) then + begin + match(LT_private); + access := 'private'; + end; + name := id; + if (( LA(1) in [TT_ARGACTION])) then + begin + args := LT(1); + match(TT_ARGACTION); + end; + if (( LA(1) in [LT_returns])) then + begin + match(LT_returns); + ret := LT(1); + match(TT_ARGACTION); + end; + fGrammarMaker.defineRuleName( name, access, true, ''); + + if args <> nil then + fGrammarMaker.refArgAction( args); + + if ret <> nil then + fGrammarMaker.refReturnAction( ret); + if (( LA(1) in [TT_OPTIONS])) then + begin + ruleOptions; + end; + if (( LA(1) in [LT_local])) then + begin + match(LT_local); + locals := LT(1); + match(TT_ACTION); + fGrammarMaker.refRuleLocals( locals); + end; + if (( LA(1) in [TT_ACTION])) then + begin + initAction := LT(1); + match(TT_ACTION); + fGrammarMaker.refInitAction( initAction); + end; + match(TT_COLON); + block; + match(TT_SEMI); + if (( LA(1) in [LT_except..LT_finally])) then + begin + ruleExceptionBlock; + end; + fGrammarMaker.endRule(''); +end; + +// ============================================================================ +// ruleExceptionBlock +// ============================================================================ +procedure TDpgParser.ruleExceptionBlock; +var + a: IToken; + t: IToken; + +begin + + if (( LA(1) in [LT_except])) then + begin + t := LT(1); + match(LT_except); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefRuleExHandler( t, a); + end + + else if (( LA(1) in [LT_finally])) then + begin + t := LT(1); + match(LT_finally); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefRuleExHandler( t, a); + end + + else + Raise EMismatchedToken.Create( LT(1), [LT_except..LT_finally], InputState.FileName); +end; + +// ============================================================================ +// altExceptionBlock +// ============================================================================ +procedure TDpgParser.altExceptionBlock; +var + a: IToken; + t: IToken; + +begin + + if (( LA(1) in [LT_except])) then + begin + t := LT(1); + match(LT_except); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefAltExHandler( t, a); + end + + else if (( LA(1) in [LT_finally])) then + begin + t := LT(1); + match(LT_finally); + a := LT(1); + match(TT_ACTION); + fGrammarMaker.RefAltExHandler( t, a); + end + + else + Raise EMismatchedToken.Create( LT(1), [LT_except..LT_finally], InputState.FileName); +end; + +// ============================================================================ +// ruleOptions +// ============================================================================ +procedure TDpgParser.ruleOptions; +var + optName : IToken; + optValue : IToken; + +begin + + match(TT_OPTIONS); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + optName := id; + match(TT_ASSIGN); + optValue := optionValue; + match(TT_SEMI); + fGrammarMaker.setRuleOption( optName, optValue); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// block +// ============================================================================ +procedure TDpgParser.block; +begin + + INC( fNesting); + + alternative; + + while(true) do + begin + if (( LA(1) in [TT_OR])) then + begin + match(TT_OR); + alternative; + end + + else + break; + end; + + DEC(fNesting); +end; + +// ============================================================================ +// alternative +// ============================================================================ +procedure TDpgParser.alternative; +var + autoGen : boolean; + +begin + + autoGen := true; + + fGrammarMaker.beginAlt( autoGen); + + while(true) do + begin + if (( LA(1) in [TT_SEMPRED,TT_LPAREN,TT_NOT,TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_ACTION..TT_RULEREF])) then + begin + elem; + end + + else + break; + end; + + if (( LA(1) in [LT_except..LT_finally])) then + begin + altExceptionBlock; + end; + fGrammarMaker.endAlt; +end; + +// ============================================================================ +// elem +// ============================================================================ +procedure TDpgParser.elem; +begin + + element; +end; + +// ============================================================================ +// element +// ============================================================================ +procedure TDpgParser.element; +var + action: IToken; + ag: IToken; + args: IToken; + ruleRef: IToken; + semPred: IToken; + tokenRef: IToken; + assignId : IToken; + assignLabel : IToken; + autoGen : integer; + +begin + + assignId := nil; + assignLabel := nil; + autoGen := AUTOGEN_NONE; + + if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_ASSIGN])) then + begin + assignId := id; + match(TT_ASSIGN); + if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_COLON])) then + begin + assignLabel := id; + match(TT_COLON); + checkEndRule(assignLabel); + end; + if (( LA(1) in [TT_RULEREF])) then + begin + ruleRef := LT(1); + match(TT_RULEREF); + if (( LA(1) in [TT_ARGACTION])) then + begin + args := LT(1); + match(TT_ARGACTION); + end; + if (( LA(1) in [TT_BANG])) then + begin + ag := LT(1); + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refRule( assignId, ruleRef, assignLabel, args, autoGen); + end + + else if (( LA(1) in [TT_TOKENREF])) then + begin + tokenRef := LT(1); + match(TT_TOKENREF); + if (( LA(1) in [TT_ARGACTION])) then + begin + args := LT(1); + match(TT_ARGACTION); + end; + fGrammarMaker.refToken( assignId, tokenRef, assignLabel, args, false, autoGen, lastInRule); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName); + end + + else if (( LA(1) in [TT_LPAREN,TT_NOT,TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF..TT_RULEREF]) and (LA(2) in [LT_except..TT_SEMPRED,TT_OPTIONS,TT_LPAREN..TT_RPAREN,TT_COLON..TT_SEMI,TT_NOT..TT_STRINGLIT,TT_ARGACTION..TT_RULEREF])) then + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_COLON])) then + begin + assignLabel := id; + match(TT_COLON); + checkEndRule(assignLabel); + end; + if (( LA(1) in [TT_RULEREF])) then + begin + ruleRef := LT(1); + match(TT_RULEREF); + if (( LA(1) in [TT_ARGACTION])) then + begin + args := LT(1); + match(TT_ARGACTION); + end; + if (( LA(1) in [TT_BANG])) then + begin + ag := LT(1); + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refRule( assignId, ruleRef, assignLabel, args, autoGen); + end + + else if (( LA(1) in [TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF]) and (LA(2) in [TT_RANGE])) then + begin + range(assignLabel); + end + + else if (( LA(1) in [TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF]) and (LA(2) in [LT_except..TT_SEMPRED,TT_LPAREN..TT_RPAREN,TT_SEMI,TT_NOT..TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_ARGACTION..TT_RULEREF])) then + begin + terminal(assignLabel); + end + + else if (( LA(1) in [TT_NOT])) then + begin + match(TT_NOT); + if (( LA(1) in [TT_CHARLIT,TT_TOKENREF])) then + begin + notTerminal(assignLabel); + end + + else if (( LA(1) in [TT_LPAREN])) then + begin + ebnf( assignLabel, true); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_LPAREN,TT_CHARLIT,TT_TOKENREF], InputState.FileName); + end + + else if (( LA(1) in [TT_LPAREN])) then + begin + ebnf( assignLabel, false); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_LPAREN,TT_NOT,TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF..TT_RULEREF], InputState.FileName); + end + + else if (( LA(1) in [TT_ACTION])) then + begin + action := LT(1); + match(TT_ACTION); + fGrammarMaker.refAction( action); + end + + else if (( LA(1) in [TT_SEMPRED])) then + begin + semPred := LT(1); + match(TT_SEMPRED); + fGrammarMaker.refSemPred( semPred); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_SEMPRED,TT_LPAREN,TT_NOT,TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_ACTION..TT_RULEREF], InputState.FileName); +end; + +// ============================================================================ +// range +// ============================================================================ +procedure TDpgParser.range( pTokenLabel: IToken); +var + crLeft: IToken; + crRight: IToken; + trLeft: IToken; + trRight: IToken; + autoGen: integer; + +begin + + autoGen := AUTOGEN_NONE; + + if (( LA(1) in [TT_CHARLIT])) then + begin + crLeft := LT(1); + match(TT_CHARLIT); + match(TT_RANGE); + crRight := LT(1); + match(TT_CHARLIT); + if (( LA(1) in [TT_BANG])) then + begin + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refCharRange( crLeft, crRight, pTokenLabel, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_STRINGLIT,TT_TOKENREF])) then + begin + if (( LA(1) in [TT_TOKENREF])) then + begin + trLeft := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + trLeft := LT(1); + match(TT_STRINGLIT); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_STRINGLIT,TT_TOKENREF], InputState.FileName); + match(TT_RANGE); + if (( LA(1) in [TT_TOKENREF])) then + begin + trRight := LT(1); + match(TT_TOKENREF); + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + trRight := LT(1); + match(TT_STRINGLIT); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_STRINGLIT,TT_TOKENREF], InputState.FileName); + autoGen := astTypeSpec; + fGrammarMaker.refTokenRange( trLeft, trRight, pTokenLabel, autoGen, lastInRule); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF], InputState.FileName); +end; + +// ============================================================================ +// terminal +// ============================================================================ +procedure TDpgParser.terminal( pTokenLabel: IToken); +var + aa: IToken; + cl: IToken; + sl: IToken; + tr: IToken; + wc: IToken; + autoGen : integer; + +begin + + autoGen := AUTOGEN_NONE; + aa := nil; + + if (( LA(1) in [TT_CHARLIT])) then + begin + cl := LT(1); + match(TT_CHARLIT); + if (( LA(1) in [TT_BANG])) then + begin + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refCharLiteral( cl, pTokenLabel, false, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_TOKENREF])) then + begin + tr := LT(1); + match(TT_TOKENREF); + autoGen := astTypeSpec; + if (( LA(1) in [TT_ARGACTION])) then + begin + aa := LT(1); + match(TT_ARGACTION); + end; + fGrammarMaker.refToken( nil, tr, pTokenLabel, aa, false, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_STRINGLIT])) then + begin + sl := LT(1); + match(TT_STRINGLIT); + autoGen := astTypeSpec; + fGrammarMaker.refStringLiteral( sl, pTokenLabel, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_WILDCARD])) then + begin + wc := LT(1); + match(TT_WILDCARD); + autogen := astTypeSpec; + fGrammarMaker.refWildCard( wc, pTokenLabel, autoGen); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF], InputState.FileName); +end; + +// ============================================================================ +// notTerminal +// ============================================================================ +procedure TDpgParser.notTerminal( pTokenLabel: IToken); +var + cl: IToken; + tr: IToken; + autoGen : integer; + +begin + + autoGen := AUTOGEN_NONE; + + if (( LA(1) in [TT_CHARLIT])) then + begin + cl := LT(1); + match(TT_CHARLIT); + if (( LA(1) in [TT_BANG])) then + begin + match(TT_BANG); + autoGen := AUTOGEN_BANG; + end; + fGrammarMaker.refCharLiteral( cl, pTokenLabel, true, autoGen, lastInRule); + end + + else if (( LA(1) in [TT_TOKENREF])) then + begin + tr := LT(1); + match(TT_TOKENREF); + autoGen := astTypeSpec; + fGrammarMaker.refToken( nil, tr, pTokenLabel, nil, true, autoGen, lastInRule); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_CHARLIT,TT_TOKENREF], InputState.FileName); +end; + +// ============================================================================ +// ebnf +// ============================================================================ +procedure TDpgParser.ebnf( pTokenLabel: IToken; pTokenNot: boolean); +var + aa: IToken; + lp: IToken; + m: IToken; + n: IToken; + +begin + + lp := LT(1); + match(TT_LPAREN); + fGrammarMaker.beginSubrule( pTokenLabel, lp, pTokenNot); + if (( LA(1) in [TT_OPTIONS])) then + begin + subRuleOptions; + if (( LA(1) in [TT_ACTION])) then + begin + aa := LT(1); + match(TT_ACTION); + fGrammarMaker.refInitAction(aa); + end; + match(TT_COLON); + end + + else if (( LA(1) in [TT_ACTION]) and (LA(2) in [TT_COLON])) then + begin + aa := LT(1); + match(TT_ACTION); + fGrammarMaker.refInitAction(aa); + match(TT_COLON); + end; + block; + match(TT_RPAREN); + if (( LA(1) in [TT_QUEST])) then + begin + match(TT_QUEST); + fGrammarMaker.optionalSubrule; + end + + else if (( LA(1) in [TT_STAR])) then + begin + match(TT_STAR); + fGrammarMaker.zeroOrMoreSubrule; + end + + else if (( LA(1) in [TT_PLUS])) then + begin + match(TT_PLUS); + fGrammarMaker.oneOrMoreSubrule; + end + + else if (( LA(1) in [TT_AT])) then + begin + match(TT_AT); + fGrammarMaker.nmSubrule; + match(TT_LPAREN); + if (( LA(1) in [TT_INTEGER])) then + begin + m := LT(1); + match(TT_INTEGER); + fGrammarMaker.refRangeLow( StrToInt(m.TokenText)); + if (( LA(1) in [TT_COMMA])) then + begin + match(TT_COMMA); + fGrammarMaker.refRangeHigh( maxint); + if (( LA(1) in [TT_INTEGER])) then + begin + n := LT(1); + match(TT_INTEGER); + fGrammarMaker.refRangeHigh(StrToInt(n.TokenText)); + end; + end; + end + + else if (( LA(1) in [TT_COMMA])) then + begin + match(TT_COMMA); + n := LT(1); + match(TT_INTEGER); + fGrammarMaker.refRangeHigh(StrToInt(n.TokenText)); + end + + else + Raise EMismatchedToken.Create( LT(1), [TT_COMMA,TT_INTEGER], InputState.FileName); + match(TT_RPAREN); + end + + else if (( LA(1) in [TT_IMPLIES])) then + begin + match(TT_IMPLIES); + fGrammarMaker.synPred; + end; + fGrammarMaker.endSubRule; +end; + +// ============================================================================ +// astTypeSpec +// ============================================================================ +function TDpgParser.astTypeSpec: integer; +begin + + result := AUTOGEN_NONE; + + if (( LA(1) in [TT_BANG])) then + begin + match(TT_BANG); + result := AUTOGEN_BANG; + end; +end; + +// ============================================================================ +// subRuleOptions +// ============================================================================ +procedure TDpgParser.subRuleOptions; +var + optName : IToken; + optValue : IToken; + +begin + + match(TT_OPTIONS); + + while(true) do + begin + if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then + begin + optName := id; + match(TT_ASSIGN); + optValue := optionValue; + match(TT_SEMI); + fGrammarMaker.setSubruleOption( optName, optValue); + end + + else + break; + end; + + match(TT_RCURLY); +end; + +// ============================================================================ +// 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; +end. diff --git a/src.lib/save/z.dpglib.DpgParserTokens.pas b/src.lib/save/z.dpglib.DpgParserTokens.pas new file mode 100644 index 0000000..552b72b --- /dev/null +++ b/src.lib/save/z.dpglib.DpgParserTokens.pas @@ -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. diff --git a/src.lib/save/z.dpglib.TokenLexer.pas b/src.lib/save/z.dpglib.TokenLexer.pas new file mode 100644 index 0000000..622b559 --- /dev/null +++ b/src.lib/save/z.dpglib.TokenLexer.pas @@ -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. diff --git a/src.lib/save/z.dpglib.TokenLexerTokens.pas b/src.lib/save/z.dpglib.TokenLexerTokens.pas new file mode 100644 index 0000000..177a67b --- /dev/null +++ b/src.lib/save/z.dpglib.TokenLexerTokens.pas @@ -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. diff --git a/src.lib/save/z.dpglib.TokenParser.pas b/src.lib/save/z.dpglib.TokenParser.pas new file mode 100644 index 0000000..34fbba7 --- /dev/null +++ b/src.lib/save/z.dpglib.TokenParser.pas @@ -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. diff --git a/src.lib/save/z.dpglib.TokenParserTokens.pas b/src.lib/save/z.dpglib.TokenParserTokens.pas new file mode 100644 index 0000000..e286327 --- /dev/null +++ b/src.lib/save/z.dpglib.TokenParserTokens.pas @@ -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.