From b20cd8e688f482696f3a9a022c97bba055a98c89 Mon Sep 17 00:00:00 2001 From: Abu Abacus Date: Sat, 3 Jan 2026 18:32:50 +0100 Subject: [PATCH] Initial check in rtl --- .gitignore | 7 + prj.rtl/Delphi12Athens/mr.dpgrtl.dpk | 56 ++ prj.rtl/Delphi12Athens/mr.dpgrtl.dproj | 1022 ++++++++++++++++++++++++ src.rtl/ast/dpgrtl.astBase.pas | 357 +++++++++ src.rtl/ast/dpgrtl.astCommon.pas | 14 + src.rtl/ast/dpgrtl.astFactory.pas | 349 ++++++++ src.rtl/ast/dpgrtl.astPair.pas | 64 ++ src.rtl/dpgrtl.charbuffer.pas | 156 ++++ src.rtl/dpgrtl.charqueue.pas | 291 +++++++ src.rtl/dpgrtl.exception.pas | 258 ++++++ src.rtl/dpgrtl.inputbuffer.pas | 123 +++ src.rtl/dpgrtl.lexer.pas | 593 ++++++++++++++ src.rtl/dpgrtl.lexerstate.pas | 221 +++++ src.rtl/dpgrtl.llkparser.pas | 103 +++ src.rtl/dpgrtl.parser.pas | 231 ++++++ src.rtl/dpgrtl.parserstate.pas | 125 +++ src.rtl/dpgrtl.stringmap.pas | 123 +++ src.rtl/dpgrtl.token.pas | 139 ++++ src.rtl/dpgrtl.tokenbuffer.pas | 162 ++++ src.rtl/dpgrtl.tokenqueue.pas | 157 ++++ src.rtl/dpgrtl.treeparser.pas | 147 ++++ src.rtl/dpgrtl.treeparserstate.pas | 49 ++ src.rtl/dpgrtl.types.pas | 182 +++++ 23 files changed, 4929 insertions(+) create mode 100644 prj.rtl/Delphi12Athens/mr.dpgrtl.dpk create mode 100644 prj.rtl/Delphi12Athens/mr.dpgrtl.dproj create mode 100644 src.rtl/ast/dpgrtl.astBase.pas create mode 100644 src.rtl/ast/dpgrtl.astCommon.pas create mode 100644 src.rtl/ast/dpgrtl.astFactory.pas create mode 100644 src.rtl/ast/dpgrtl.astPair.pas create mode 100644 src.rtl/dpgrtl.charbuffer.pas create mode 100644 src.rtl/dpgrtl.charqueue.pas create mode 100644 src.rtl/dpgrtl.exception.pas create mode 100644 src.rtl/dpgrtl.inputbuffer.pas create mode 100644 src.rtl/dpgrtl.lexer.pas create mode 100644 src.rtl/dpgrtl.lexerstate.pas create mode 100644 src.rtl/dpgrtl.llkparser.pas create mode 100644 src.rtl/dpgrtl.parser.pas create mode 100644 src.rtl/dpgrtl.parserstate.pas create mode 100644 src.rtl/dpgrtl.stringmap.pas create mode 100644 src.rtl/dpgrtl.token.pas create mode 100644 src.rtl/dpgrtl.tokenbuffer.pas create mode 100644 src.rtl/dpgrtl.tokenqueue.pas create mode 100644 src.rtl/dpgrtl.treeparser.pas create mode 100644 src.rtl/dpgrtl.treeparserstate.pas create mode 100644 src.rtl/dpgrtl.types.pas diff --git a/.gitignore b/.gitignore index 0d5da40..c3247aa 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,14 @@ bin +dcu prj.dpgxcon\Win32 prj.dpgxcon\Win64 +*.res +*.identcache +*.local +*.dsk +*.dsv + # documentation intermediate files (TeX) *.aux *.bmt diff --git a/prj.rtl/Delphi12Athens/mr.dpgrtl.dpk b/prj.rtl/Delphi12Athens/mr.dpgrtl.dpk new file mode 100644 index 0000000..a15dfa8 --- /dev/null +++ b/prj.rtl/Delphi12Athens/mr.dpgrtl.dpk @@ -0,0 +1,56 @@ +package mr.dpgrtl; + +{$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; + +contains + dpgrtl.charbuffer in '..\..\src.rtl\dpgrtl.charbuffer.pas', + dpgrtl.charqueue in '..\..\src.rtl\dpgrtl.charqueue.pas', + dpgrtl.exception in '..\..\src.rtl\dpgrtl.exception.pas', + dpgrtl.inputbuffer in '..\..\src.rtl\dpgrtl.inputbuffer.pas', + dpgrtl.lexer in '..\..\src.rtl\dpgrtl.lexer.pas', + dpgrtl.lexerstate in '..\..\src.rtl\dpgrtl.lexerstate.pas', + dpgrtl.llkparser in '..\..\src.rtl\dpgrtl.llkparser.pas', + dpgrtl.parser in '..\..\src.rtl\dpgrtl.parser.pas', + dpgrtl.parserstate in '..\..\src.rtl\dpgrtl.parserstate.pas', + dpgrtl.stringmap in '..\..\src.rtl\dpgrtl.stringmap.pas', + dpgrtl.token in '..\..\src.rtl\dpgrtl.token.pas', + dpgrtl.tokenbuffer in '..\..\src.rtl\dpgrtl.tokenbuffer.pas', + dpgrtl.tokenqueue in '..\..\src.rtl\dpgrtl.tokenqueue.pas', + dpgrtl.treeparser in '..\..\src.rtl\dpgrtl.treeparser.pas', + dpgrtl.treeparserstate in '..\..\src.rtl\dpgrtl.treeparserstate.pas', + dpgrtl.types in '..\..\src.rtl\dpgrtl.types.pas', + dpgrtl.astBase in '..\..\src.rtl\ast\dpgrtl.astBase.pas', + dpgrtl.astCommon in '..\..\src.rtl\ast\dpgrtl.astCommon.pas', + dpgrtl.astFactory in '..\..\src.rtl\ast\dpgrtl.astFactory.pas', + dpgrtl.astPair in '..\..\src.rtl\ast\dpgrtl.astPair.pas'; + +end. diff --git a/prj.rtl/Delphi12Athens/mr.dpgrtl.dproj b/prj.rtl/Delphi12Athens/mr.dpgrtl.dproj new file mode 100644 index 0000000..172ba23 --- /dev/null +++ b/prj.rtl/Delphi12Athens/mr.dpgrtl.dproj @@ -0,0 +1,1022 @@ + + + {73DADB21-ED0B-4F97-9247-D2244A755A32} + mr.dpgrtl.dpk + 20.3 + None + True + Debug + Win32 + 1 + Package + mr.dpgrtl + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + ..\..\dcu\Delphi12Athens\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + true + true + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + mr_dpgrtl + 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.dpgrtl.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.rtl/ast/dpgrtl.astBase.pas b/src.rtl/ast/dpgrtl.astBase.pas new file mode 100644 index 0000000..07eafa2 --- /dev/null +++ b/src.rtl/ast/dpgrtl.astBase.pas @@ -0,0 +1,357 @@ +{ + * A Child-Sibling Tree. + * + * A tree with PLUS at the root and with two children 3 and 4 is + * structured as: + * + * PLUS + * | + * 3 -- 4 + * + * and can be specified easily in LISP notation as + * + * (PLUS 3 4) + * + * where every '(' starts a new subtree. + * + * These trees are particular useful for translators because of + * the flexibility of the children lists. They are also very easy + * to walk automatically, whereas trees with specific children + * reference fields can't easily be walked automatically. + * + * This class contains the basic support for an AST. + * Most people will create ASTs that are subclasses of + * BaseAST or of CommonAST. + */ +} +unit dpgrtl.astBase; + +interface +uses + System.Classes, + Generics.Collections, + dpgrtl.Token; + + +type + TAST = class; + TASTList = TList; + + TAST = class + protected + fDown : TAST; + fRight : TAST; + + fAstText : AnsiString; + fAstType : integer; + fAstLine : integer; + fAstColumn : integer; + + private + fVerbose : boolean; // verbose string conversion + fTokenNames : TStringList; + + private + procedure DoFindAll( NodeToSearch : TAST; + // v : Vector; + Target : TAST; + PartialMatch : boolean); + + protected + function GetNumberofChildren: integer; + + function GetEquals( Node : TAST): boolean; virtual; + function GetEqualsList( Node : TAST): boolean; virtual; + function GetEqualsListPartial( Node : TAST): boolean; virtual; + function GetEqualsTree( Node : TAST): boolean; virtual; + function GetEqualsTreePartial( Node : TAST): boolean; virtual; + + function GetTokenNames : TStringList; + + procedure SetVerbose( Verbose : boolean; + Names : TStringList); + + public + procedure Initialize( AstType : integer; + AstText : AnsiString); overload; virtual; abstract; + + procedure Initialize( Node : TAST); overload; virtual; abstract; + procedure Initialize( Token : TToken); overload; virtual; abstract; + + procedure AddChild( node: TAST); + procedure RemoveChildren; + + public + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + + public + property NumberOfChildren : integer read GetNumberofChildren; + + property NextSibling : TAST read fRight write fRight; + property FirstChild : TAST read fDown write fDown; + + property AstText : AnsiString read fAstText write fAstText; + property AstType : integer read fAstType write fAstType; + property AstLine : integer read fAstLine write fAstLine; + property AstColumn : integer read fAstColumn write fAstColumn; + + property Equals [n: TAST]: boolean read GetEquals; + property EqualsList [n: TAST]: boolean read GetEqualsList; + property EqualsListPartial [n: TAST]: boolean read GetEqualsListPartial; + property EqualsTree [n: TAST]: boolean read GetEqualsTree; + property EqualsTreePartial [n: TAST]: boolean read GetEqualsTreepartial; + end; + + TASTClass = class of TAST; + + +implementation + +{ TastBase } + +procedure TAST.AfterConstruction; +begin + inherited; + fTokenNames := TStringList.Create; +end; + +procedure TAST.BeforeDestruction; +begin + fTokenNames.Free; + inherited; +end; + +// ================================================================================================ +// DoFindAll +// ================================================================================================ +procedure TAST.DoFindAll(NodeToSearch, Target: TAST; PartialMatch: boolean); +var + sibling: TAST; + +begin + // start walking sibling lists, looking for matches + sibling := NodeToSearch; + + while Assigned(sibling) do + begin + if ( PartialMatch and sibling.EqualsTreePartial[Target]) or + ( not PartialMatch and sibling.EqualsTree[Target]) then + // v.appendelement(sibling) + ; + + if Assigned( sibling.FirstChild) then + DoFindAll( sibling.FirstChild, {v,} Target, PartialMatch); + + sibling := sibling.NextSibling + end; + +end; + + +// ================================================================================================ +// Get Number of Children +// ================================================================================================ +function TAST.GetNumberofChildren: integer; +var + t: TAST; + n: integer; + +begin + t := fDown; + n := 0; + + if Assigned(t) then + begin + INC(n); + + while Assigned(t.fRight) do + begin + t := t.fRight; + INC(n) + end; + end; + + result := n +end; + +// ================================================================================================ +// Get Equals +// ================================================================================================ +function TAST.GetEquals(Node: TAST): boolean; +begin + if Assigned(Node) + then result := (Node.fAstText = fAstText) and (Node.fAstType = fAstType) + else result := false +end; + +// ================================================================================================ +// Get Equals List +// ================================================================================================ +function TAST.GetEqualsList(Node: TAST): boolean; +var + sibling: TAST; + +begin + result := false; + + if Assigned(Node) then + begin + sibling := self; + + while Assigned(sibling) and Assigned(Node) do + begin + // as a quick optimization, check roots firt + if not sibling.Equals[Node] then + break; + + // if roots match, do full list match test on children + if Assigned( sibling.FirstChild) then + begin + if not sibling.FirstChild.EqualsList[Node.FirstChild] then + break + end + + // sibling has no kids, make sure Node doesn't either + else if Assigned(Node.FirstChild) then + break; + + sibling := sibling .NextSibling; + Node := Node .NextSibling; + end; + + if not Assigned(sibling) and not Assigned(Node) then + result := true + end; +end; + +// ================================================================================================ +// Get Equals List Partial +// +// Is Node a subtree of this list ? The siblings of the root are NOT ignored. +// ================================================================================================ +function TAST.GetEqualsListPartial(Node: TAST): boolean; +var + sibling: TAST; + +begin + result := false; + + if Assigned(Node) then + begin + sibling := self; + + while Assigned(sibling) and Assigned(Node) do + begin + // as a quick optimization, check roots firt + if not sibling.Equals[Node] then + break; + + // if roots match, do partial list match test on children + if Assigned( sibling.FirstChild) then + if not sibling.FirstChild.EqualsListPartial[Node.FirstChild] then + break + end; + + if not Assigned(sibling) and Assigned(Node) + then result := false + else result := true + end; +end; + +// ================================================================================================ +// Get Equals Tree +// +// Is the tree rooted at *self* equals to *Node* ? +// The sibling of *self* are ignored. +// ================================================================================================ +function TAST.GetEqualsTree(Node: TAST): boolean; +begin + result := false; + + if Equals[Node] then + begin + // if roots match, do full list match test on children + if Assigned(FirstChild) then + begin + if not FirstChild.EqualsList[Node.FirstChild] then + exit; + end + + // No kids, make sure *Node* hasn't either + else if Assigned(Node.FirstChild) then + exit; + end; + + result := true +end; + +// ================================================================================================ +// Get Equals Tree Partial +// ================================================================================================ +function TAST.GetEqualsTreePartial(Node: TAST): boolean; +begin + result := false; + + if Equals[Node] then + if Assigned(FirstChild) then + if not FirstChild.EqualsListPartial[Node] then + exit; + + result := true +end; + +// ================================================================================================ +// Get Token Names +// ================================================================================================ +function TAST.GetTokenNames: TStringList; +begin + result := TStringList.Create; + result.AddStrings(fTokenNames); +end; + +// ================================================================================================ +// Set Verbose +// ================================================================================================ +procedure TAST.SetVerbose(Verbose: boolean; Names: TStringList); +begin + fVerbose := Verbose; + fTokenNames.Clear; + ftokenNames.AddStrings(Names); +end; + +// ================================================================================================ +// AddChild +// ================================================================================================ +procedure TAST.AddChild(node: TAST); +var + n: TAST; + +begin + if Assigned(node) then + begin + n := fDown; + + if Assigned(n) then + begin + while Assigned(n.fRight) do + n := n.fRight; + + n.fRight := node + end + + else + fDown := node + end; +end; + +// ================================================================================================ +// Remove Children +// ================================================================================================ +procedure TAST.RemoveChildren; +begin + fDown := nil +end; + + +end. diff --git a/src.rtl/ast/dpgrtl.astCommon.pas b/src.rtl/ast/dpgrtl.astCommon.pas new file mode 100644 index 0000000..84792e9 --- /dev/null +++ b/src.rtl/ast/dpgrtl.astCommon.pas @@ -0,0 +1,14 @@ +unit dpgrtl.astCommon; + +interface +uses + dpgrtl.astBase; + +type + TastCommon = class( TAST) + + end; + +implementation + +end. diff --git a/src.rtl/ast/dpgrtl.astFactory.pas b/src.rtl/ast/dpgrtl.astFactory.pas new file mode 100644 index 0000000..3d2a75a --- /dev/null +++ b/src.rtl/ast/dpgrtl.astFactory.pas @@ -0,0 +1,349 @@ +// AST Support code shared by TreeParser and Parser. +// We use delegation to share code (and have only one +// bit of code to maintain) rather than subclassing +// or superclassing (forces AST support code to be +// loaded even when you don't want to do AST stuff). +// +// Typically, setASTNodeType is used to specify the +// homogeneous type of node to create, but you can override +// create to make heterogeneous nodes etc... + +unit dpgrtl.astFactory; + +interface +uses + Generics.Collections, + dpgrtl.types, + dpgrtl.astBase, + dpgrtl.astPair; + +type + TTokenToASTMap = TDictionary; + + TASTFactory = class + protected + // How to specify the classname to create for a particular + // token type. Note that DPG allows you to say, for example, + // + // tokens + // { + // PLUS; + // ... + // } + // + // and it tracks everything statically. #[PLUS] will make you + // a PLUSNode w/o use of this table. + // + // For tokens that DPG cannot track statically like #[i], + // you can use this table to map PLUS (Integer) -> PLUSNode (Class) + // etc... DPG sets the class map from the tokens {...} section + // via the ASTFactory(Hashtable) ctor in antlr.Parser. + + fASTNodeTypeName : AnsiString; + fASTNodeTypeClass : TASTClass; + + fTokenToASTMap : TTokenToASTMap; + + protected + function GetASTClass( TokenType: integer): TASTClass; + procedure SetASTClass( TokenType: integer; ASTClass: TASTClass); + + public + function CreateAST( TokenType: integer=TT_INVALID; + TokenText: string = ''): TAST; overload; + + function CreateAST( TokenType: integer; + TokenText: string; + ASTName : string) : TAST; overload; + + function CreateAST( ASTName : string) : TAST; overload; + + function CreateAST( AST : TAST) : TAST; overload; + function CreateAST( Token : IToken) : TAST; overload; + + function Clone( AST : TAST) : TAST; + function CloneList( AST : TAST) : TAST; + function CloneTree( AST : TAST) : TAST; + + function Make( Nodes : array of TAST) : TAST; + procedure MakeRoot( ASTPair : TASTPair; + Root : TAST); + + + public + constructor Create( map: TTokenToASTMap); + destructor Destroy; override; + + public + property ASTClass[t: integer] : TASTClass read GetASTClass + write SetASTClass; + + end; + + +implementation +uses + System.RTTI, + dpgrtl.astCommon, + System.SysUtils; + +{ TASTFactory } + +// ================================================================================================ +// Constructor +// ================================================================================================ +constructor TASTFactory.Create(map: TTokenToASTMap); +begin + inherited Create; + fTokenToASTMap := TTokenToASTMap.Create; + +// SetTokenToASTMap(map); +end; + +// ================================================================================================ +// Destructor +// ================================================================================================ +destructor TASTFactory.Destroy; +begin + FreeAndNil(fTokenToASTMap); + inherited; +end; + + +// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Interface +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Create AST (TokenType,TokenText) +// +// Create a new empty AST node. If the user did not specify an AST node type, then create a +// default one: *TastCommon* +// ================================================================================================ +function TASTFactory.CreateAST(TokenType: integer; TokenText: string): TAST; +begin + result := ASTClass[TokenType].Create; + + if Assigned(result) then + result.Initialize( TokenType, AnsiString(TokenText)); +end; + +// ================================================================================================ +// Create AST (AST Class Name) +// ================================================================================================ +function TASTFactory.CreateAST(ASTName: string): TAST; +var + ctx : TRttiContext; + typ : TRttiType; + +begin + result := nil; + ctx := TRttiContext.Create; + typ := ctx.FindType(ASTName); + + if Assigned(typ) then + result := TASTClass(typ).Create; +end; + +// ================================================================================================ +// Create AST +// ================================================================================================ +function TASTFactory.CreateAST(TokenType: integer; TokenText, ASTName: string): TAST; +begin + result := CreateAST( ASTName); + + if Assigned(result) then + result.Initialize( TokenType, AnsiString(TokenText)) +end; + +// ================================================================================================ +// Create AST +// ================================================================================================ +function TASTFactory.CreateAST(AST: TAST): TAST; +begin + result := nil; + + if Assigned(AST) then + result := CreateAST(AST.ClassName); + + if Assigned(result) then + result.Initialize( AST.AstType, AST.AstText); +end; + +// ================================================================================================ +// Create AST +// ================================================================================================ +function TASTFactory.CreateAST(Token: IToken): TAST; +begin + result := nil; + + if Assigned(Token) then + result := CreateAST( Token.TokenType, string(Token.TokenText)) +end; + +// ================================================================================================ +// Clone +// ================================================================================================ +function TASTFactory.Clone( AST: TAST) : TAST; +begin + result := nil; + + if Assigned(AST) then + result := CreateAST(AST); +end; + +// ================================================================================================ +// Clone List +// +// Duplicate a tree including siblings of root. +// ================================================================================================ +function TASTFactory.CloneList( AST: TAST): TAST; +var + nt: TAST; + +begin + result := CloneTree(AST); + nt := result; + + while Assigned(AST) do + begin + AST := AST.NextSibling; + + nt.NextSibling := CloneTree(AST); + nt := nt.NextSibling; + end; +end; + +// ================================================================================================ +// Clone Tree +// +// Duplicate a tree, assuming this is a root node of a tree. +// Duplicate that node and what's below; ignore siblings of a root node. +// ================================================================================================ +function TASTFactory.CloneTree( AST: TAST): TAST; +begin + result := Clone(AST); + + if Assigned(result) then + result.FirstChild := CloneList( AST.FirstChild) +end; + +// ================================================================================================ +// Make +// +// Make a tree from a list of nodes. The first element in the array is the root. +// If the root is null, then the tree is a simple list not a tree. +// Handles null children nodes correctly. +// +// For example, build(a, b, null, c) yields tree (a b c). +// build(null,a,b) yields tree (nil a b). +// ================================================================================================ +function TASTFactory.Make(Nodes: array of TAST): TAST; +var + i : integer; + root : TAST; + tail : TAST; + +begin + result := nil; + + if Length(Nodes) > 0 then + begin + root := Nodes[Low(Nodes)]; + tail := nil; + + if Assigned(root) then + root.FirstChild := nil; + + // link in children + for i:=Low(Nodes)+1 to High(Nodes) do + begin + // ignore nil nodes + if Nodes[i] = nil then + continue; + + if not Assigned(root) then + begin + root := nodes[i]; + tail := nodes[i]; + end + + else if not Assigned(tail) then + begin + root.FirstChild := Nodes[i]; + tail := root.FirstChild; + end + + else begin + tail.NextSibling:= Nodes[i]; + tail := tail.NextSibling; + end; + + while Assigned(tail.NextSibling) do + tail := tail.NextSibling; + end + end +end; + +// ================================================================================================ +// Make root +// ================================================================================================ +procedure TASTFactory.MakeRoot(ASTPair: TASTPair; Root: TAST); +begin + if Assigned(Root) then + begin + Root.AddChild(ASTPair.Root); + + ASTPair.Child := ASTPair.Root; + ASTPair.AdvanceChildToEnd; + ASTPair.Root := Root; + end +end; + +// @@@: Property handlers +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Property handlers +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Get the AST class that assigned to a token type +// ================================================================================================ +function TASTFactory.GetASTClass(TokenType: integer): TASTClass; +begin + result := nil; + + if Assigned( fTokenToASTMap) then + fTokenToASTMap.TryGetValue( TokenType, result); + + if not Assigned(result) then + result := fASTNodeTypeClass; + + if not Assigned(result) then + result := TastCommon; +end; + +// ================================================================================================ +// Assign an AST class to a token type +// ================================================================================================ +procedure TASTFactory.SetASTClass(TokenType: integer; ASTClass: TASTClass); +begin + if Assigned( fTokenToASTMap) then + begin + if fTokenToASTMap.ContainsKey(TokenType) then + fTokenToASTMap.Remove(TokenType); + + if Assigned(ASTClass) then + fTokenToASTMap.Add(TokenType,ASTClass) + end +end; + +end. diff --git a/src.rtl/ast/dpgrtl.astPair.pas b/src.rtl/ast/dpgrtl.astPair.pas new file mode 100644 index 0000000..9ddce7d --- /dev/null +++ b/src.rtl/ast/dpgrtl.astPair.pas @@ -0,0 +1,64 @@ +unit dpgrtl.astPair; + +interface +uses + dpgrtl.astBase; + +type + TASTPair = class + public + Root : TAST; + Child : TAST; + + public + procedure AdvanceChildToEnd; + function Clone: TASTPair; + function ToString: string; override; + + end; + +implementation + +{ TASTPair } + +// ================================================================================================ +// Advance Child To End +// ================================================================================================ +procedure TASTPair.AdvanceChildToEnd; +begin + if Assigned(Child) then + while Assigned( Child.NextSibling) do + Child := Child.NextSibling +end; + +// ================================================================================================ +// Clone +// ================================================================================================ +function TASTPair.Clone: TASTPair; +begin + result := TASTPair.Create; + result.Root := Root; + result.Child := Child; +end; + +// ================================================================================================ +// As String +// ================================================================================================ +function TASTPair.ToString: string; +var + r: string; + c: string; + +begin + if Assigned(Root) + then r := Root.ToString + else r := 'nil'; + + if Assigned(Child) + then c := Child.ToString + else c := 'nil'; + + result := '[' + r + ',' + c + ']' +end; + +end. diff --git a/src.rtl/dpgrtl.charbuffer.pas b/src.rtl/dpgrtl.charbuffer.pas new file mode 100644 index 0000000..512a354 --- /dev/null +++ b/src.rtl/dpgrtl.charbuffer.pas @@ -0,0 +1,156 @@ +// TODO: jo lenne cache-elni az LA(x) karaktereket... + +unit dpgrtl.charbuffer; + +interface +uses + System.Classes, + dpgrtl.types, + dpgrtl.inputbuffer, + dpgrtl.charqueue; + +type + TCharBuffer = class( TInputBuffer, IInputBuffer, ICharBuffer) + protected + fStream : TStream; + fQueue : TCharQueue; + + protected + function GetNext: AnsiChar; + procedure Fill( Amount: integer); + + // ------------------------------------------------------------ + // TInputBuffer overrides + // ------------------------------------------------------------ + protected + procedure Remove( ACount: integer); override; + + // ------------------------------------------------------------ + // ICharBuffer + // ------------------------------------------------------------ + protected + function LA( i: integer): AnsiChar; + + // ------------------------------------------------------------ + // Construction/destruction + // ------------------------------------------------------------ + public + constructor Create( AStream: TStream); + + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + end; + +implementation + +{ TCharBuffer } + +// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Construction/destruction +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Constructor +// ================================================================================================ +constructor TCharBuffer.Create(AStream: TStream); +begin + inherited Create; + fStream := AStream +end; + +// ================================================================================================ +// After Destruction +// ================================================================================================ +procedure TCharBuffer.AfterConstruction; +begin + inherited; + + fMarkerCount := 0; + fMarkerOffset := 0; + fNumToConsume := 0; + + fQueue := TCharQueue.Create +end; + +// ================================================================================================ +// Before Destruction +// ================================================================================================ +procedure TCharBuffer.BeforeDestruction; +begin + fQueue.Free; + inherited +end; + +// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Interface +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// LA +// +// Ensures that the 'fQueue' object holds sufficient characters, and gets the 'i'th Look Ahead +// character from the 'fQueue'. +// ================================================================================================ +function TCharBuffer.LA(i: integer): AnsiChar; +begin + Fill(i); + result := fQueue.Items[fMarkerOffset +i] +end; + +// @@@: Internals +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Internals +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Get Next +// ================================================================================================ +function TCharBuffer.GetNext: AnsiChar; +begin + if fStream.Read( result, 1) <> 1 then + result := #0 +end; + +// ================================================================================================ +// Fill +// ================================================================================================ +procedure TCharBuffer.Fill(Amount: integer); +begin + SyncConsume; + + while fQueue.Count < (Amount +fMarkerOffset) do + fQueue.Add(GetNext) +end; + +// @@@: Overrides +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Overrides +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Remove +// ================================================================================================ +procedure TCharBuffer.Remove(ACount: integer); +begin + fQueue.Remove(ACount) +end; + +end. diff --git a/src.rtl/dpgrtl.charqueue.pas b/src.rtl/dpgrtl.charqueue.pas new file mode 100644 index 0000000..341fb96 --- /dev/null +++ b/src.rtl/dpgrtl.charqueue.pas @@ -0,0 +1,291 @@ +unit dpgrtl.charqueue; + +interface +uses + dpgrtl.types; + +type + TCharQueue = class( TInterfacedObject) + private + fBlockLog : integer; // log2 of block size + fBlockSize : integer; // block size + + fOffset : integer; // logical start of the vector + fCount : integer; // items in a vector + fArray : TCharMatrix; // data + + private + procedure Expand( i: integer); + + protected + function GetItem( i:integer): AnsiChar; + procedure SetItem( i:integer; Value:AnsiChar); + + public + procedure Clear; + procedure Add( Value : AnsiChar); + procedure Remove( ACount: integer); + + public + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + + public + property Count : integer read fCount; + property Items[i:integer] : AnsiChar read GetItem write SetItem; + end; + +implementation +uses + System.Math, + System.SysUtils; + +{ TCharQueue } + +// @@@: construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// construction/destruction +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// After Construction +// ================================================================================================ +procedure TCharQueue.AfterConstruction; +begin + inherited; + + fBlockLog := trunc( log2( 4096)); + fBlockSize := trunc( IntPower(2, fBlockLog)); + + fArray := nil; + fOffset := 0; + fCount := 0; +end; + +// ================================================================================================ +// Before Destruction +// ================================================================================================ +procedure TCharQueue.BeforeDestruction; +var + i: integer; + +begin + Clear; + + for i:=Low(fArray) to High(fArray) do + fArray[i] := nil; + + fArray := nil; + inherited; +end; + +// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Interface +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Add +// ================================================================================================ +procedure TCharQueue.Add(Value: AnsiChar); +begin + Items[ fCount +1] := Value +end; + +// ================================================================================================ +// Remove +// +// Removes 'Count' items from the beginning of the queue. If the 'Count' is bigger than the +// count then simply clear the Queue. +// ================================================================================================ +procedure TCharQueue.Remove( ACount: integer); +var + tmp: TCharMatrix; + i : integer; + +begin + if ACount > 0 then + begin + // ------------------------------------------------------------ + // if the removable item count > than the item count, then + // simply clear the queue... + // ------------------------------------------------------------ + if ACount > fCount then + Clear + + + // ------------------------------------------------------------ + // ...else calculate the new offset and count values. If the + // one or more blocks in the vector beginning is freed, then + // move these blocks to the end of the vector. + // ------------------------------------------------------------ + else begin + INC( fOffset, ACount); + DEC( fCount, ACount); + + SetLength( tmp, 1); + + // --------------------------------------------------------- + // Well, not so efficient, but simple + // --------------------------------------------------------- + while fOffset > fBlockSize -1 do + begin + tmp[0] := fArray[0]; + + // -------------------------------------------- + // clear the free block + // -------------------------------------------- + for i:=0 to High(tmp[0]) do + tmp[0,i] := #0; + + // -------------------------------------------- + // shift blocks down + // -------------------------------------------- + for i:=0 to High(fArray)-1 do + fArray[i] := fArray[i+1]; + + // -------------------------------------------- + // set the vector's last block + // -------------------------------------------- + fArray[High(fArray)] := tmp[0]; + + DEC( fOffset, fBlockSize) + end; + + tmp := nil + end + end +end; + +// ================================================================================================ +// Clear +// +// This is a real pain in the ass. I'm not in the mood to optimize it. +// ================================================================================================ +procedure TCharQueue.Clear; +var + i: integer; + +begin + for i:=1 to fCount do + Items[i] := #0; + + fOffset := 0; + fCount := 0; +end; + + +// @@@: Property Handlers +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Property Handlers +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Get Item +// +// Get the item specified by it's index. If the index less than 1 or bigger than the size of +// the queue, an ERangeError exception will be generated. +// ================================================================================================ +function TCharQueue.GetItem(i: integer): AnsiChar; +var + block: integer; + index: integer; + +begin + // ------------------------------------------------------------------------- + // Check for valid index value. + // ------------------------------------------------------------------------- + if i > fCount then raise ERangeError.CreateFmt( 'Index "%d" is too big', [i]); + if i < 1 then raise ERangeError.CreateFmt( 'Index is less than 1', []); + + // ------------------------------------------------------------------------- + // Now process the request. + // ------------------------------------------------------------------------- + block := (i -1 +fOffset) shr fBlockLog; + index := (i -1 +fOffset) and (fBlockSize -1); + + result := fArray[block,index]; +end; + +// ================================================================================================ +// Set Item +// +// Set the item specified by it's index. If the the index bigger than the count of the Queue +// then the Queue will be resized to hold this data. If the index less than 1 an ERangeError +// exception will be generated. +// ================================================================================================ +procedure TCharQueue.SetItem(i: integer; Value: AnsiChar); +var + block: integer; + index: integer; + +begin + // ------------------------------------------------------------------------- + // Check for valid index value. + // ------------------------------------------------------------------------- + if i < 1 then raise ERangeError.CreateFmt( 'Index is less than 1', []); + + // ------------------------------------------------------------------------- + // If the index bigger than the size of the Queue then expand the Queue. + // ------------------------------------------------------------------------- + if i > fCount then + begin + Expand(i); + fCount := i; + end; + + // ------------------------------------------------------------------------- + // Now process the request. + // ------------------------------------------------------------------------- + block := (i -1 +fOffset) shr fBlockLog; + index := (i -1 +fOffset) and (fBlockSize -1); + + fArray[block,index] := Value +end; + +// @@@: Internals +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Internals +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Expand +// +// Expands the Queue. The size of expanding is always fBlockSize*n. +// ================================================================================================ +procedure TCharQueue.Expand(i: integer); +var + hi: integer; + bn: integer; + j : integer; + +begin + if (i-1)+fOffset >= (High(fArray)+1) * fBlockSize then + begin + hi := High(fArray) +1; + bn := (i-1+fOffset) shr fBlockLog; + + SetLength( fArray, bn+1); + + for j:=hi to bn do + SetLength( fArray[j], fBlockSize); + end; +end; + +end. diff --git a/src.rtl/dpgrtl.exception.pas b/src.rtl/dpgrtl.exception.pas new file mode 100644 index 0000000..aa209d2 --- /dev/null +++ b/src.rtl/dpgrtl.exception.pas @@ -0,0 +1,258 @@ +unit dpgrtl.exception; + +interface +uses + dpgrtl.types, + System.SysUtils; + +type + EException = class(Exception) + strict protected + fFileName : string; + fLine : integer; + fColumn : integer; + + public + constructor Create( AFileName : string; + ALine : integer; + AColumn : integer); + + public + property FileName : string read fFileName; + property Line : integer read fLine; + property Column : integer read fColumn; + + end; + + EMismatchedChar = class( EException) + strict protected + fCharSet : TCharSet; + fString : AnsiString; + + fFoundChar : AnsiChar; + fFoundString: AnsiString; + + fInverted : boolean; + + public + function ToString: string; override; + + public + constructor Create( AFoundChar : AnsiChar; + ACharSet : TCharSet; + AFileName : string; + ALine : integer; + AColumn : integer; + AInverted : boolean=false); overload; + + constructor Create( AFoundString : AnsiString; + AExpectedString : AnsiString; + AFileName : string; + ALine : integer; + AColumn : integer); overload; + + + + public + property FoundChar : AnsiChar read fFoundChar; + property FoundString : AnsiString read fFoundString; + property CharSet : TCharSet read fCharSet; + property Str : AnsiString read fString; + property Inverted : boolean read fInverted; + end; + + EMismatchedToken = class (EException) + strict protected + fToken : IToken; + fTokenSet : TByteSet; + fFoundToken : IToken; + fInverted : boolean; + + public + constructor Create( AFoundToken : IToken; + ATokenType : byte; + AFileName : string; + AInverted : boolean=false); overload; + + constructor Create( AFoundToken : IToken; + ATokenSet : TByteSet; + AFileName : string; + AInverted : boolean=false); overload; + + procedure BeforeDestruction; override; + + public + property FoundToken : IToken read fFoundToken; + property TokenSet : TByteSet read fTokenSet; + property Inverted : boolean read fInverted; + end; + + ESemantic = class (EException) + strict protected + fAssert : AnsiString; + + public + constructor Create( ASemPred : AnsiString; + AFileName : string; + ALine : integer=0; + AColumn : integer=0); + + public + property Assert: AnsiString read fAssert; + + end; + +implementation + +{ EException } + +// @@@: EException ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// EException +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// constructor +// ================================================================================================ +constructor EException.Create(AFileName: string; ALine, AColumn: integer); +begin + fFileName := AFileName; + fLine := ALine; + fColumn := AColumn; +end; + +{ EMismatchedChar } + +// @@@: EMismatchedChar +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// EMismatchedChar +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// constructor([char..char]) +// ================================================================================================ +constructor EMismatchedChar.Create( AFoundChar : AnsiChar; + ACharSet : TCharSet; + AFileName : string; + ALine : integer; + AColumn : integer; + AInverted : boolean=false); +begin + inherited Create( AFileName, ALine, AColumn); + + fCharSet := ACharSet; + fString := ''; + + fFoundChar := AFoundChar; + fFoundString := ''; + + fInverted := AInverted +end; + +// ================================================================================================ +// constructor(string) +// ================================================================================================ +constructor EMismatchedChar.Create( AFoundString : AnsiString; + AExpectedString : AnsiString; + AFileName : string; + ALine : integer; + AColumn : integer); +begin + inherited Create( AFileName, ALine, AColumn); + + fCharSet := []; + fString := AExpectedString; + + fFoundChar := #0; + fFoundString := AFoundString; + + fInverted := false +end; + +// ================================================================================================ +// ToString +// ================================================================================================ +function EMismatchedChar.ToString: string; +begin + result := '?' +end; + +{ EMismatchedToken } + +// @@@: EMismatchedToken ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// EMismatchedToken +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// constructor +// ================================================================================================ +constructor EMismatchedToken.Create(AFoundToken : IToken; + ATokenType : byte; + AFileName : string; + AInverted : boolean=false); +begin + inherited Create(AFileName, AFoundToken.TokenLine, AFoundToken.TokenColumn); + + fFoundToken := AFoundToken; + fTokenSet := [ATokenType]; + fInverted := AInverted +end; + +// ================================================================================================ +// constructor +// ================================================================================================ +constructor EMismatchedToken.Create(AFoundToken : IToken; + ATokenSet : TByteSet; + AFileName : string; + AInverted : boolean=false); +begin + inherited Create(AFileName, AFoundToken.TokenLine, AFoundToken.TokenColumn); + + fFoundToken := AFoundToken; + fTokenSet := ATokenSet; + fInverted := AInverted +end; + +// ================================================================================================ +// Before Destruction +// ================================================================================================ +procedure EMismatchedToken.BeforeDestruction; +begin + fFoundToken := nil; + inherited +end; + +{ ESemantic } + +// @@@: ESemantic +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// ESemantic +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// constructor +// ================================================================================================ +constructor ESemantic.Create(ASemPred: AnsiString; AFileName: string; ALine, AColumn: integer); +begin + inherited Create( AFileName, ALine, AColumn); + fAssert := ASemPred +end; + +end. diff --git a/src.rtl/dpgrtl.inputbuffer.pas b/src.rtl/dpgrtl.inputbuffer.pas new file mode 100644 index 0000000..fa32101 --- /dev/null +++ b/src.rtl/dpgrtl.inputbuffer.pas @@ -0,0 +1,123 @@ +unit dpgrtl.inputbuffer; + +interface +uses + dpgrtl.types; + +type + TInputBuffer = class( TInterfacedObject, IInputBuffer) + protected + fMarkerCount : integer; + fMarkerOffset : integer; + fNumToConsume : integer; + + protected + procedure Remove( Num: integer); virtual; abstract; + procedure SyncConsume; inline; + + protected + function GetMarked: boolean; inline; + + procedure Consume; inline; + procedure Commit; inline; + + function Mark: integer; + procedure Rewind( Value: integer); + end; + + +implementation + +{ TInputBuffer } + +// @@@: IInputBuffer implementation +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// IInputBuffer implementation +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Mark +// +// Returns an integer marker theh can be used to rewind the buffer to its current state. +// ================================================================================================ +function TInputBuffer.Mark: integer; +begin + SyncConsume; + INC( fMarkerCount); + + result := fMarkerOffset +end; + +// ================================================================================================ +// Consume +// +// Mark another input item for deferred consumption. +// ================================================================================================ +procedure TInputBuffer.Consume; +begin + INC( fNumToConsume); +end; + +// ================================================================================================ +// Commit +// +// This method updates the state of the input buffer so that the text matched since the most +// recent Mark() is no longer held by the buffer. So, you either do a mark/rewind for failed +// predicate or mark/commit to keep on parsing without rewinding the input. +// ================================================================================================ +procedure TInputBuffer.Commit; +begin + if fMarkerCount > 0 then + DEC( fMarkerCount) +end; + +// ================================================================================================ +// Rewind +// +// Rewind the character buffer to a marker. 'Value' marker returned previously from mark. +// ================================================================================================ +procedure TInputBuffer.Rewind(Value: integer); +begin + SyncConsume; + + fMarkerOffset := Value; + DEC( fMarkerCount) +end; + +// ================================================================================================ +// GetMarked +// ================================================================================================ +function TInputBuffer.GetMarked: boolean; +begin + result := fMarkerCount <> 0 +end; + +// @@@: Internals +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Internals +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Sync Consume +// ================================================================================================ +procedure TInputBuffer.SyncConsume; +begin + if fNumToConsume > 0 then + begin + if fMarkerCount > 0 + then INC( fMarkerOffset, fNumToConsume) + else Remove( fNumToConsume); + + fNumToConsume := 0 + end +end; + +end. diff --git a/src.rtl/dpgrtl.lexer.pas b/src.rtl/dpgrtl.lexer.pas new file mode 100644 index 0000000..b9b9ac0 --- /dev/null +++ b/src.rtl/dpgrtl.lexer.pas @@ -0,0 +1,593 @@ +unit dpgrtl.lexer; + +interface +uses + System.Classes, + System.SysUtils, + System.AnsiStrings, + dpgrtl.types, + dpgrtl.token, + dpgrtl.stringmap, + dpgrtl.lexerstate; + +type + TLexer = class( TInterfacedObject, ITokenStream) + protected + TokenText : AnsiString; + + fTokenClass : TTokenClass; + fLexerState : ILexerState; + fLiterals : TStringMap; + + fCaseSensitive : boolean; + fSaveConsumedInput: boolean; + + fReturnToken : IToken; + + // ---------------------------------------------------------------------- + // Property Handlers + // ---------------------------------------------------------------------- + private + function GetTokenClass: TTokenClass; + procedure SetTokenClass( AClass: TTokenClass); + + // ---------------------------------------------------------------------- + // ITokenStream + // ---------------------------------------------------------------------- + protected + function NextToken: IToken; virtual; abstract; + + protected + // ------------------------------------------------------------------- + procedure Append( AChar : AnsiChar); overload; + procedure Append( AString : AnsiString); overload; + + // ------------------------------------------------------------------- + procedure Consume; + procedure ConsumeUntil( AChar : AnsiChar); overload; + procedure ConsumeUntil( ASet : TCharSet); overload; + + // ------------------------------------------------------------------- + procedure MatchNot( AChar : AnsiChar); + + procedure Match( AChar : AnsiChar); overload; + procedure Match( ASet : TCharSet); overload; + procedure Match( AString : AnsiString); overload; + procedure Match( AChar1 : AnsiChar; + AChar2 : AnsiChar); overload; + + // ------------------------------------------------------------------- + function TestLiteral( AType : integer): integer; overload; + function TestLiteral( AText : AnsiString; + AType : integer): integer; overload; + + // ------------------------------------------------------------------- + procedure Tab; virtual; + procedure UponEof; virtual; + procedure Initialize; virtual; + procedure ReportError( e: Exception); virtual; + + // ------------------------------------------------------------------- + function LA(i:integer): AnsiChar; + function Mark: integer; + procedure Rewind( Pos: integer); + procedure Commit; + procedure NewLine; + procedure ResetText; + + // ------------------------------------------------------------------- + function MakeToken( ATokenType : integer; + ATokenText : AnsiString=''): IToken; + + public + constructor Create( ABuffer: ICharBuffer); overload; + constructor Create( AState : ILexerState); overload; + constructor Create( AStream: TStream); overload; + + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + + public + property SaveConsumedInput : boolean read fSaveConsumedInput + write fSaveConsumedInput; + + property CaseSensitive : boolean read fCaseSensitive + write fCaseSensitive; + + property TokenClass : TTokenClass read GetTokenClass + write SetTokenClass; + + property InputState : ILexerState read fLexerState + write fLexerState; + + property ReturnToken : IToken read fReturnToken + write fReturnToken; + end; + + TLexerClass = class of TLexer; + +implementation +uses + dpgrtl.exception; + +{ TLexer } + + + +// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Construction/destruction +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Constructor(ICharBuffer) +// ================================================================================================ +constructor TLexer.Create( ABuffer: ICharBuffer); +begin + inherited Create; + fLexerState := TLexerState.Create( ABuffer); +end; + +// ================================================================================================ +// Constructor(ILexerState) +// ================================================================================================ +constructor TLexer.Create( AState: ILexerState); +begin + inherited Create; + fLexerState := AState +end; + +// ================================================================================================ +// Constructor(TStream) +// ================================================================================================ +constructor TLexer.Create( AStream: TStream); +begin + inherited Create; + fLexerState := TLexerState.Create( AStream) +end; + +// ================================================================================================ +// After Construction +// ================================================================================================ +procedure TLexer.AfterConstruction; +begin + inherited; + + fLiterals := TStringMap.Create; + fLiterals.CaseSensitive := true; + fCaseSensitive := true; + fSaveConsumedInput := true; + + Initialize; +end; + +// ================================================================================================ +// Before Destruction +// ================================================================================================ +procedure TLexer.BeforeDestruction; +begin + fLexerState := nil; + fLiterals.Free; + + inherited +end; + + + +// @@@: Property Handlers +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Property Handlers +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Get Token Class +// ================================================================================================ +function TLexer.GetTokenClass: TTokenClass; +begin + if fTokenClass = nil + then result := TToken + else result := fTokenClass +end; + +// ================================================================================================ +// Set Token Class +// ================================================================================================ +procedure TLexer.SetTokenClass( AClass: TTokenClass); +begin + fTokenClass := AClass +end; + + + +// @@@: Internals +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Internals +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Append(Char) +// ================================================================================================ +procedure TLexer.Append( AChar: AnsiChar); +begin + if fSaveConsumedInput then + TokenText := TokenText +AChar +end; + +// ================================================================================================ +// Append(String) +// ================================================================================================ +procedure TLexer.Append( AString: AnsiString); +begin + if fSaveConsumedInput then + TokenText := TokenText +AString +end; + +// ================================================================================================ +// Consume +// ================================================================================================ +procedure TLexer.Consume; +var + chr: AnsiChar; + +begin + chr := LA(1); + + if fLexerState.Guessing = 0 then + begin + Append(chr); + + if chr = #9 + then TAB + else fLexerState.Column := fLexerState.Column +1; + end; + + fLexerState.InputBuffer.Consume +end; + +// ================================================================================================ +// ComsumeUntil(Char) +// ================================================================================================ +procedure TLexer.ConsumeUntil(AChar: AnsiChar); +var + chr: AnsiChar; + +begin + chr := LA(1); + + while (chr <> EOF_CHAR) and (chr <> AChar) do + begin + Consume; + chr := LA(1) + end +end; + +// ================================================================================================ +// ConsumeUntil(Set) +// ================================================================================================ +procedure TLexer.ConsumeUntil(ASet: TCharSet); +var + chr: AnsiChar; + +begin + chr := LA(1); + + while (chr <> EOF_CHAR) and not(chr in ASet) do + begin + Consume; + chr := LA(1) + end +end; + +// ================================================================================================ +// Match Not(Char) +// ================================================================================================ +procedure TLexer.MatchNot(AChar: AnsiChar); +var + chr : AnsiChar; + la1 : AnsiChar; + +begin + if not fCaseSensitive then + begin + chr := UpCase( AChar); + la1 := UpCase( LA(1)); + end + + else begin + chr := AChar; + la1 := LA(1); + end; + + if la1 = chr then + Raise EMismatchedChar.Create( LA(1), + [AChar], + fLexerState.FileName, + fLexerState.Line, + fLexerState.Column, + true) + else + Consume +end; + +// ================================================================================================ +// Match(Char) +// ================================================================================================ +procedure TLexer.Match(AChar: AnsiChar); +var + chr : AnsiChar; + la1 : AnsiChar; + +begin + if not fCaseSensitive then + begin + chr := UpCase( AChar); + la1 := UpCase( LA(1)); + end + + else begin + chr := AChar; + la1 := LA(1); + end; + + if la1 <> chr then + Raise EMismatchedChar.Create( LA(1), + [AChar], + fLexerState.FileName, + fLexerState.Line, + fLexerState.Column, + false) + else + Consume +end; + +// ================================================================================================ +// Match(CharSet) +// ================================================================================================ +procedure TLexer.Match(ASet: TCharSet); +var + la1: AnsiChar; + +begin + la1 := LA(1); + + if not (la1 in ASet) then + Raise EMismatchedChar.Create( la1, + ASet, + fLexerState.FileName, + fLexerState.Line, + fLexerState.Column, + false) + else + Consume +end; + + +// ================================================================================================ +// Match(Char..Char) +// ================================================================================================ +procedure TLexer.Match(AChar1, AChar2: AnsiChar); +var + chr1: AnsiChar; + chr2: AnsiChar; + la1 : AnsiChar; + +begin + if not fCaseSensitive then + begin + chr1 := UpCase( AChar1); + chr2 := UpCase( AChar2); + la1 := UpCase( LA(1)); + end + + else begin + chr1 := AChar1; + chr2 := AChar2; + la1 := LA(1); + end; + + if not (la1 in [chr1..chr2]) then + Raise EMismatchedChar.Create( la1, + [chr1..chr2], + fLexerState.FileName, + fLexerState.Line, + fLexerState.Column, + false) + else + Consume +end; + +// ================================================================================================ +// Match(string) +// ================================================================================================ +procedure TLexer.Match(AString: AnsiString); +var + la1 : AnsiChar; + s : AnsiString; + str : AnsiString; + len : integer; + i : integer; + +begin + if not fCaseSensitive + then str := AnsiUpperCase( AString) + else str := AString; + + len := Length(str); + s := ''; + + for i:=1 to len do + begin + if not fCaseSensitive + then la1 := UpCase(LA(1)) + else la1 := LA(1); + + s := s + la1; + + if la1 <> str[i] then + Raise EMismatchedChar.Create( s, + str, + fLexerState.FileName, + fLexerState.Line, + fLexerState.Column) + else + Consume + end; +end; + +// ================================================================================================ +// Test Literal +// ================================================================================================ +function TLexer.TestLiteral(AType: integer): integer; +begin + result := fLiterals.Value[TokenText]; + + if result < 0 then + result := AType +end; + +// ================================================================================================ +// Test Literal +// ================================================================================================ +function TLexer.TestLiteral(AText: AnsiString; AType: integer): integer; +begin + result := fLiterals.Value[AText]; + + if result < 0 then + result := AType +end; + +// ================================================================================================ +// Tab +// +// Advance the current column number by an appropriate amount. If you do not override this +// to specify how much to jump for a tab, then tabs are counted as one char. This method is +// called from consume(). +// +// update inputState->column as function of inputState->column and tab stops. For example, +// if tab stops are columns 1 and 5 etc... and column is 3, then add 2 to column. +// ================================================================================================ +procedure TLexer.Tab; +begin + fLexerState.Column := fLexerState.Column +1; +end; + +// ================================================================================================ +// UponEof +// +// This method is called by YourLexer::nextToken() when the lexer has hit EOF condition. +// EOF is NOT a character. This method is not called if EOF is reached during syntactic +// predicate evaluation or during evaluation of normal lexical rules, which presumably +// would be an IOException. This traps the "normal" EOF condition. +// +// UponEOF() is called after the complete evaluation of the previous token and only if your +// parser asks for another token beyond that last non-EOF token. +// +// You might want to throw token or char stream exceptions like: "Heh, premature eof" or a +// retry stream exception ("I found the end of this file, go back to referencing file"). +// ================================================================================================ +procedure TLexer.UponEof; +begin +end; + +// ================================================================================================ +// Initialize +// ================================================================================================ +procedure TLexer.Initialize; +begin +end; +// ================================================================================================ +// ReportError +// ================================================================================================ +procedure TLexer.ReportError(e: Exception); +begin +end; + +// ================================================================================================ +// LA +// ================================================================================================ +function TLexer.LA(i: integer): AnsiChar; +begin + result := fLexerState.InputBuffer.LA(i) +end; + +// ================================================================================================ +// Commit +// ================================================================================================ +procedure TLexer.Commit; +begin + fLexerState.InputBuffer.Commit +end; + +// ================================================================================================ +// Mark +// ================================================================================================ +function TLexer.Mark: integer; +begin + result := fLexerState.InputBuffer.Mark +end; + +// ================================================================================================ +// Pos +// ================================================================================================ +procedure TLexer.Rewind(Pos: integer); +begin + fLexerState.InputBuffer.Rewind(Pos) +end; + +// ================================================================================================ +// ResetText +// ================================================================================================ +procedure TLexer.ResetText; +begin + TokenText := ''; + + with fLexerState do + begin + TokenStartLine := Line; + TokenStartColumn := Column; + end +end; + +// ================================================================================================ +// NewLine +// ================================================================================================ +procedure TLexer.NewLine; +begin + with fLexerState do + begin + Line := Line +1; + Column := 1; + end +end; + +// ================================================================================================ +// MakeToken +// ================================================================================================ +function TLexer.MakeToken(ATokenType: integer; ATokenText: AnsiString): IToken; +begin + if fTokenClass = nil then + fTokenClass := TToken; + + result := fTokenClass.Create( ATokenType, ATokenText); + + with result, fLexerState do + begin + TokenLine := Line; + TokenColumn := Column + end; +end; + + +end. diff --git a/src.rtl/dpgrtl.lexerstate.pas b/src.rtl/dpgrtl.lexerstate.pas new file mode 100644 index 0000000..e4aadfb --- /dev/null +++ b/src.rtl/dpgrtl.lexerstate.pas @@ -0,0 +1,221 @@ +unit dpgrtl.lexerstate; + +interface +uses + System.Classes, + dpgrtl.types, + dpgrtl.charbuffer; + +type + TLexerState = class( TInterfacedObject, ILexerState) + private + fFileName : string; + fLine : integer; + fColumn : integer; + fGuessing : integer; + + fInputBuffer : ICharBuffer; + + fTokenStartLine : integer; + fTokenStartColumn : integer; + + // ------------------------------------------------------------ + // ILexerState + // ------------------------------------------------------------ + protected + function GetFileName : string; + function GetLine : integer; + function GetColumn : integer; + function GetGuessing : integer; + + function GetInputBuffer : ICharBuffer; + + function GetTokenStartLine : integer; + function GetTokenStartColumn : integer; + + procedure SetFileName( Value: string); + procedure SetLine( Value: integer); + procedure SetColumn( Value: integer); + procedure SetGuessing( Value: integer); + + procedure SetTokenStartLine( Value: integer); + procedure SetTokenStartColumn( Value: integer); + + public + constructor Create( AStream: TStream); overload; + constructor Create( ABuffer: ICharBuffer); overload; + + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + end; + +implementation + +{ TLexerState } + +// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Construction/destruction +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Constructor +// ================================================================================================ +constructor TLexerState.Create(AStream: TStream); +begin + inherited Create; + fInputBuffer := TCharBuffer.Create(AStream) +end; + +// ================================================================================================ +// Constructor +// ================================================================================================ +constructor TLexerState.Create(ABuffer: ICharBuffer); +begin + inherited Create; + fInputBuffer := ABuffer +end; + +// ================================================================================================ +// After Construction +// ================================================================================================ +procedure TLexerState.AfterConstruction; +begin + inherited; + + fFileName := ''; + fLine := 1; + fColumn := 1; + fGuessing := 0; + + fTokenStartLine := 1; + fTokenStartColumn := 1; +end; + +// ================================================================================================ +// Before Destruction +// ================================================================================================ +procedure TLexerState.BeforeDestruction; +begin + fInputBuffer := nil; + inherited; +end; + +// @@@: ILexerState +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// ILexerState +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Get File Name +// ================================================================================================ +function TLexerState.GetFileName: string; +begin + result := fFileName +end; + +// ================================================================================================ +// Get Line number +// ================================================================================================ +function TLexerState.GetLine: integer; +begin + result := fLine +end; + +// ================================================================================================ +// Get Column number +// ================================================================================================ +function TLexerState.GetColumn: integer; +begin + result := fColumn +end; + +// ================================================================================================ +// Get Guessing +// ================================================================================================ +function TLexerState.GetGuessing: integer; +begin + result := fGuessing +end; + +// ================================================================================================ +// Get Input Buffer +// ================================================================================================ +function TLexerState.GetInputBuffer: ICharBuffer; +begin + result := fInputBuffer +end; + +// ================================================================================================ +// Get Token Start Line +// ================================================================================================ +function TLexerState.GetTokenStartLine: integer; +begin + result := fTokenStartLine +end; + +// ================================================================================================ +// Get Token Start Column +// ================================================================================================ +function TLexerState.GetTokenStartColumn: integer; +begin + result := fTokenStartColumn +end; + +// ================================================================================================ +// Set File Name +// ================================================================================================ +procedure TLexerState.SetFileName(Value: string); +begin + fFileName := Value +end; + +// ================================================================================================ +// Set Line number +// ================================================================================================ +procedure TLexerState.SetLine(Value: integer); +begin + fLine := Value +end; + +// ================================================================================================ +// Set Column Number +// ================================================================================================ +procedure TLexerState.SetColumn(Value: integer); +begin + fColumn := Value +end; + +// ================================================================================================ +// Set Guessing +// ================================================================================================ +procedure TLexerState.SetGuessing(Value: integer); +begin + fGuessing := Value +end; + +// ================================================================================================ +// Set Token Start Line +// ================================================================================================ +procedure TLexerState.SetTokenStartLine(Value: integer); +begin + fTokenStartLine := Value +end; + +// ================================================================================================ +// Set Token Start Column +// ================================================================================================ +procedure TLexerState.SetTokenStartColumn(Value: integer); +begin + fTokenStartColumn := Value +end; + +end. diff --git a/src.rtl/dpgrtl.llkparser.pas b/src.rtl/dpgrtl.llkparser.pas new file mode 100644 index 0000000..27613cb --- /dev/null +++ b/src.rtl/dpgrtl.llkparser.pas @@ -0,0 +1,103 @@ +unit dpgrtl.llkparser; + +interface +uses + dpgrtl.types, + dpgrtl.parser; + +type + TllkParser = class( TParser) + protected + fK : integer; + + // ---------------------------------------------------------------------- + // Interface + // ---------------------------------------------------------------------- + public + procedure Consume; override; + function LA(i:integer):byte; override; + function LT(i:integer):IToken; override; + + // ---------------------------------------------------------------------- + // Construction/destruction + // ---------------------------------------------------------------------- + public + constructor Create( AParserState: IParserState; K: integer); overload; + constructor Create( ATokenBuffer: ITokenBuffer; K: integer); overload; + constructor Create( ATokenStream: ITokenStream; K: integer); overload; + end; + +implementation + +{ TllkParser } + +// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Construction/destruction +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Constructor(ParserState) +// ================================================================================================ +constructor TllkParser.Create(AParserState: IParserState; K: integer); +begin + inherited Create( AParserState); + fK := K +end; + +// ================================================================================================ +// Constructor(TokenBuffer) +// ================================================================================================ +constructor TllkParser.Create(ATokenBuffer: ITokenBuffer; K: integer); +begin + inherited Create(ATokenBuffer); + fK := K +end; + +// ================================================================================================ +// Constructor(TokenStream) +// ================================================================================================ +constructor TllkParser.Create(ATokenStream: ITokenStream; K: integer); +begin + inherited Create(ATokenStream); + fK := K +end; + +// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Interface +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Consume +// ================================================================================================ +procedure TllkParser.Consume; +begin + fParserState.InputBuffer.Consume +end; + +// ================================================================================================ +// LA +// ================================================================================================ +function TllkParser.LA(i: integer): byte; +begin + result := fParserState.InputBuffer.LA(i) +end; + +// ================================================================================================ +// LT +// ================================================================================================ +function TllkParser.LT(i: integer): IToken; +begin + result := fParserState.InputBuffer.LT(i) +end; + +end. diff --git a/src.rtl/dpgrtl.parser.pas b/src.rtl/dpgrtl.parser.pas new file mode 100644 index 0000000..1613f52 --- /dev/null +++ b/src.rtl/dpgrtl.parser.pas @@ -0,0 +1,231 @@ +unit dpgrtl.parser; + +interface +uses + System.SysUtils, + dpgrtl.types; + +type + TParser = class + protected + fParserState : IParserState; + + // ---------------------------------------------------------------------- + // Interface + // ---------------------------------------------------------------------- + public + procedure ConsumeUntil( ATokenType : byte); overload; + procedure ConsumeUntil( ATokenSet : TByteSet); overload; + + procedure Match( ATokenSet : TByteSet); overload; + procedure Match( ATokenType : byte); overload; + procedure MatchNot( ATokenType : byte); + + function Mark: integer; virtual; + procedure Rewind( Pos: integer); virtual; + + procedure ReportError( e: Exception); overload; virtual; + procedure ReportError( s: string); overload; virtual; + + procedure Consume; virtual; abstract; + function LA(i:integer): byte; virtual; abstract; + function LT(i:integer): IToken; virtual; abstract; + + // ---------------------------------------------------------------------- + // Construction/destruction + // ---------------------------------------------------------------------- + public + constructor Create( AState : IParserState); overload; + constructor Create( ABuffer: ITokenBuffer); overload; + constructor Create( AStream: ITokenStream); overload; + + // ---------------------------------------------------------------------- + public + property InputState : IParserState read fParserState + write fParserState; + end; + + TParserClass = class of TParser; + +implementation +uses + dpgrtl.exception, + dpgrtl.parserstate, + dpgrtl.tokenbuffer; + +{ TParser } + +// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Construction/destruction +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Constructor(ParserState) +// ================================================================================================ +constructor TParser.Create(AState: IParserState); +begin + inherited Create; + fParserState := AState +end; + +// ================================================================================================ +// Constructor(TokenBuffer) +// ================================================================================================ +constructor TParser.Create(ABuffer: ITokenBuffer); +begin + inherited Create; + fParserState := TParserState.Create( ABuffer) +end; + +// ================================================================================================ +// Constructor(TokenStream) +// ================================================================================================ +constructor TParser.Create(AStream: ITokenStream); +var + tb: TTokenBuffer; + +begin + inherited Create; + + tb := TTokenBuffer.Create(AStream); + fParserState := TParserState.Create(tb); +end; + +// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Interface +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// ConsumeUntil(TokenType) +// ================================================================================================ +procedure TParser.ConsumeUntil(ATokenType: byte); +var + la1: byte; + +begin + la1 := LA(1); + + while (la1 <> TT_EOF) and (la1 <> ATokenType) do + begin + Consume; + la1 := LA(1) + end +end; + +// ================================================================================================ +// ConsumeUntil(TokenSet) +// ================================================================================================ +procedure TParser.ConsumeUntil(ATokenSet: TByteSet); +var + la1: byte; + +begin + la1 := LA(1); + + while (la1 <> TT_EOF) and not(la1 in ATokenSet) do + begin + Consume; + la1 := LA(1) + end +end; + +// ================================================================================================ +// Match Not +// +// Make sure current lookahead symbol NOT matches token type 'pTokenType'. Throw an exception +// upon mismatch, which is catched by either the error handler or by the syntactic predicate. +// ================================================================================================ +procedure TParser.MatchNot(ATokenType: byte); +var + la1: byte; + +begin + la1 := LA(1); + + if la1 = ATokenType + then Raise EMismatchedToken.Create( LT(1), ATokenType, fParserState.FileName, true) + else Consume +end; + +// ================================================================================================ +// Match +// +// Make sure current lookahead symbol matches token type 'pTokenType'. Throw an exception upon +// mismatch, which is catched by either the error handler or by the syntactic predicate. +// ================================================================================================ +procedure TParser.Match(ATokenType: byte); +var + la1: byte; + lt1: IToken; + +begin + la1 := LA(1); + + if la1 <> ATokenType then + begin + lt1 := LT(1); + Raise EMismatchedToken.Create( lt1, ATokenType, fParserState.FileName, false) + end; + + Consume +end; + +// ================================================================================================ +// Match +// +// Make sure current lookahead symbol matches the given set. Throw an exception upon mismatch, +// which is catched by either the error handler or by the syntactic predicate. +// ================================================================================================ +procedure TParser.Match(ATokenSet: TByteSet); +var + la1: byte; + +begin + la1 := LA(1); + + if not (la1 in ATokenSet) + then Raise EMismatchedToken.Create( LT(1), ATokenSet, fParserState.FileName, false) + else Consume +end; + +// ================================================================================================ +// Mark +// ================================================================================================ +function TParser.Mark: integer; +begin + result := fParserState.InputBuffer.Mark +end; + +// ================================================================================================ +// Rewind +// ================================================================================================ +procedure TParser.Rewind(Pos: integer); +begin + fParserState.InputBuffer.Rewind(Pos) +end; + +// ================================================================================================ +// Report Error +// ================================================================================================ +procedure TParser.ReportError(e: Exception); +begin +end; + +// ================================================================================================ +// Report Error +// ================================================================================================ +procedure TParser.ReportError(s: string); +begin +end; + +end. diff --git a/src.rtl/dpgrtl.parserstate.pas b/src.rtl/dpgrtl.parserstate.pas new file mode 100644 index 0000000..79110f2 --- /dev/null +++ b/src.rtl/dpgrtl.parserstate.pas @@ -0,0 +1,125 @@ +unit dpgrtl.parserstate; + +interface +uses + dpgrtl.types; + +type + TParserState = class( TInterfacedObject, IParserState) + protected + fFileName : string; + fGuessing : integer; + fInputBuffer : ITokenBuffer; + + // ---------------------------------------------------------------------- + // IParserState + // ---------------------------------------------------------------------- + protected + function GetInputBuffer : ITokenBuffer; + function GetFileName : string; + function GetGuessing : integer; + + procedure SetFileName( Value: string); + procedure SetGuessing( Value: integer); + + // ---------------------------------------------------------------------- + // Construction/destruction + // ---------------------------------------------------------------------- + public + constructor Create( ABuffer: ITokenBuffer); + + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + end; + +implementation + +{ TParserState } + +// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Construction/destruction +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Constructor +// ================================================================================================ +constructor TParserState.Create(ABuffer: ITokenBuffer); +begin + inherited Create; + fInputBuffer := ABuffer +end; + +// ================================================================================================ +// After Construction +// ================================================================================================ +procedure TParserState.AfterConstruction; +begin + inherited; + fFileName := ''; + fGuessing := 0 +end; + +// ================================================================================================ +// Before Destruction +// ================================================================================================ +procedure TParserState.BeforeDestruction; +begin + fInputBuffer := nil; + inherited +end; + +// @@@: IParserState implementation +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// IParserState implementation +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Get File Name +// ================================================================================================ +function TParserState.GetFileName: string; +begin + result := fFileName +end; + +// ================================================================================================ +// Get Guessing +// ================================================================================================ +function TParserState.GetGuessing: integer; +begin + result := fGuessing +end; + +// ================================================================================================ +// Get Input Buffer +// ================================================================================================ +function TParserState.GetInputBuffer: ITokenBuffer; +begin + result := fInputBuffer +end; + +// ================================================================================================ +// Set File Name +// ================================================================================================ +procedure TParserState.SetFileName(Value: string); +begin + fFileName := Value +end; + +// ================================================================================================ +// Set Guessing +// ================================================================================================ +procedure TParserState.SetGuessing(Value: integer); +begin + fGuessing := Value +end; + +end. diff --git a/src.rtl/dpgrtl.stringmap.pas b/src.rtl/dpgrtl.stringmap.pas new file mode 100644 index 0000000..284e0b5 --- /dev/null +++ b/src.rtl/dpgrtl.stringmap.pas @@ -0,0 +1,123 @@ +unit dpgrtl.stringmap; + +interface +uses + System.Classes; + +type + TStringMap = class + strict protected + fData : TStringList; + + private + function GetCaseSensitive : boolean; + function GetValue(Name:AnsiString): integer; + + procedure SetCaseSensitive( Value: boolean); + procedure SetValue( Name:AnsiString; Value: integer); + + public + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + + procedure Clear; + procedure Sort; + + public + property CaseSensitive : boolean read GetCaseSensitive + write SetCaseSensitive; + + property Value[Name:AnsiString] : integer read GetValue + write SetValue; default; + end; + +implementation +uses + System.SysUtils; + +{ TStringMap } + +// ================================================================================================ +// After Construction +// ================================================================================================ +procedure TStringMap.AfterConstruction; +begin + inherited; + fData := TStringList.Create +end; + +// ================================================================================================ +// Before Destruction +// ================================================================================================ +procedure TStringMap.BeforeDestruction; +begin + fData.Free; + inherited +end; + +// ================================================================================================ +// Get CaseSensitive +// ================================================================================================ +function TStringMap.GetCaseSensitive: boolean; +begin + result := fData.CaseSensitive +end; + +// ================================================================================================ +// Get Value +// ================================================================================================ +function TStringMap.GetValue(Name: AnsiString): integer; +var + idx: integer; + +begin + idx := fData.IndexOfName(String(Name)); + + if idx >= 0 + then result := StrToIntDef( fData.ValueFromIndex[idx], -1) + else result := -1 +end; + + +// ================================================================================================ +// Set CaseSensitive +// ================================================================================================ +procedure TStringMap.SetCaseSensitive(Value: boolean); +begin + fData.CaseSensitive := Value +end; + +// ================================================================================================ +// Set Value +// ================================================================================================ +procedure TStringMap.SetValue(Name: AnsiString; Value: integer); +var + idx: integer; + val: string; + +begin + idx := fData.IndexOfName(String(Name)); + val := IntToStr(Value); + + if idx >= 0 + then fData.ValueFromIndex[idx] := val + else fData.Add(String(Name)+'='+val) +end; + +// ================================================================================================ +// Clear +// ================================================================================================ +procedure TStringMap.Clear; +begin + fData.Clear +end; + +// ================================================================================================ +// Sort +// ================================================================================================ +procedure TStringMap.Sort; +begin + fData.Sort +end; + +end. diff --git a/src.rtl/dpgrtl.token.pas b/src.rtl/dpgrtl.token.pas new file mode 100644 index 0000000..dc06a5b --- /dev/null +++ b/src.rtl/dpgrtl.token.pas @@ -0,0 +1,139 @@ +unit dpgrtl.token; + +interface +uses + dpgrtl.types; + +type + TToken = class( TInterfacedObject, IToken) + strict protected + fTokenType : byte; + fTokenText : AnsiString; + fTokenLine : integer; + fTokenColumn : integer; + + protected + function GetTokenType : byte; + function GetTokenText : AnsiString; + function GetTokenLine : integer; + function GetTokenColumn : integer; + + procedure SetTokenType( Value: byte); + procedure SetTokenText( Value: AnsiString); + procedure SetTokenLine( Value: integer); + procedure SetTokenColumn( Value: integer); + + public + function Clone: IToken; + + public + constructor Create( ATokenType : byte=TT_INVALID; + ATokenText : AnsiString=''; + ATokenLine : integer=0; + ATokenColumn: integer=0); + public + end; + + TTokenClass = class of TToken; + +var + badToken : IToken; + nullToken: IToken; + +implementation + +// ================================================================================================ +// constructor +// ================================================================================================ +constructor TToken.Create( ATokenType : byte; + ATokenText : AnsiString; + ATokenLine : integer; + ATokenColumn: integer); +begin + fTokenType := ATokenType; + fTokenText := ATokenText; + fTokenLine := ATokenLine; + fTokenColumn:= ATokenColumn +end; + +// ================================================================================================ +// Get Token Text +// ================================================================================================ +function TToken.GetTokenText: AnsiString; +begin + result := fTokenText +end; + +// ================================================================================================ +// Get Token Type +// ================================================================================================ +function TToken.GetTokenType: byte; +begin + result := fTokenType +end; + +// ================================================================================================ +// Get Token Line +// ================================================================================================ +function TToken.GetTokenLine: integer; +begin + result := fTokenLine +end; + +// ================================================================================================ +// Get Token Column +// ================================================================================================ +function TToken.GetTokenColumn: integer; +begin + result := fTokenColumn +end; + + +// ================================================================================================ +// Set Token Text +// ================================================================================================ +procedure TToken.SetTokenText( Value: AnsiString); +begin + fTokenText := Value +end; + +// ================================================================================================ +// Set Token Type +// ================================================================================================ +procedure TToken.SetTokenType( Value: byte); +begin + fTokenType := Value +end; + +// ================================================================================================ +// Set Token Line +// ================================================================================================ +procedure TToken.SetTokenLine( Value: integer); +begin + fTokenLine := Value +end; + +// ================================================================================================ +// Set Token Line +// ================================================================================================ +procedure TToken.SetTokenColumn( Value: integer); +begin + fTokenColumn := Value +end; + +// ================================================================================================ +// Clone +// ================================================================================================ +function TToken.Clone: IToken; +begin + result := TToken.Create( fTokenType, fTokenText, fTokenLine, fTokenColumn); +end; + +initialization + badToken := TToken.Create( TT_INVALID); + nullToken := TToken.Create( TT_INVALID); + +finalization + badToken := nil; + nullToken := nil; +end. diff --git a/src.rtl/dpgrtl.tokenbuffer.pas b/src.rtl/dpgrtl.tokenbuffer.pas new file mode 100644 index 0000000..3e5aefb --- /dev/null +++ b/src.rtl/dpgrtl.tokenbuffer.pas @@ -0,0 +1,162 @@ +unit dpgrtl.tokenbuffer; + +interface +uses + dpgrtl.types, + dpgrtl.inputbuffer, + dpgrtl.tokenqueue; + +type + TTokenBuffer = class( TInputBuffer, IInputBuffer, ITokenBuffer) + protected + fStream : ITokenStream; + fQueue : TTokenQueue; + + // ------------------------------------------------------------ + // Internals + // ------------------------------------------------------------ + protected + function GetNext: IToken; inline; + procedure Fill( Amount: integer); + + // ------------------------------------------------------------ + // TInputBuffer override + // ------------------------------------------------------------ + protected + procedure Remove( Num: integer); override; + + // ------------------------------------------------------------ + // ITokenBuffer + // ------------------------------------------------------------ + protected + function LA(i: integer): integer; + function LT(i: integer): IToken; + + public + constructor Create( AStream: ITokenStream); + + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + end; + +implementation + +{ TTokenBuffer } + +// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Construction/destruction +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Constructor +// ================================================================================================ +constructor TTokenBuffer.Create(AStream: ITokenStream); +begin + inherited Create; + fStream := AStream; +end; + +// ================================================================================================ +// After Construction +// ================================================================================================ +procedure TTokenBuffer.AfterConstruction; +begin + inherited; + fQueue := TTokenQueue.Create +end; + +// ================================================================================================ +// Before Destruction +// ================================================================================================ +procedure TTokenBuffer.BeforeDestruction; +begin + fStream := nil; + fQueue.Free; + inherited +end; + + + +// @@@: ITokenBuffer implementation +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// ITokenBuffer implementation +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// LA +// +// Ensure that the 'fQueue' object hold sufficient tokens, and gets the 'i'th LookAhead token +// type from the 'fQueue'. +// ================================================================================================ +function TTokenBuffer.LA(i: integer): integer; +begin + Fill(i); + result := fQueue.Items[ fMarkerOffset +i -1].TokenType +end; + +// ================================================================================================ +// LT +// ================================================================================================ +function TTokenBuffer.LT(i: integer): IToken; +begin + Fill(i); + result := fQueue.Items[ fMarkerOffset +i -1] +end; + + + +// @@@: Internals +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Internals +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Get Next +// ================================================================================================ +function TTokenBuffer.GetNext: IToken; +begin + result := fStream.NextToken +end; + +// ================================================================================================ +// Fill +// ================================================================================================ +procedure TTokenBuffer.Fill(Amount: integer); +begin + SyncConsume; + + while fQueue.Count < (Amount +fMarkerOffset) do + fQueue.Add( GetNext); +end; + +// @@@: TInputBuffer overrides ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// TInputBuffer overrides +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Remove +// ================================================================================================ +procedure TTokenBuffer.Remove(Num: integer); +begin + fQueue.Remove(Num) +end; + +end. diff --git a/src.rtl/dpgrtl.tokenqueue.pas b/src.rtl/dpgrtl.tokenqueue.pas new file mode 100644 index 0000000..f490a1b --- /dev/null +++ b/src.rtl/dpgrtl.tokenqueue.pas @@ -0,0 +1,157 @@ +unit dpgrtl.tokenqueue; + +interface +uses + System.Classes, + dpgrtl.types; + +type + TTokenQueue = class( TInterfacedObject) + private + fItems : TInterfaceList; + + private + function GetCount : integer; + function GetItem(i:integer): IToken; + procedure SetItem(i:integer;value:IToken); + + public + procedure Clear; + procedure Add( Item: IToken); + procedure Remove( Num: integer=1); + + public + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + + public + property Count : integer read GetCount; + property Items[i:integer] : IToken read GetItem write SetItem; + end; + +implementation +uses + System.SysUtils; + +{ TTokenQueue } + +// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Construction/destruction +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// After Construction +// ================================================================================================ +procedure TTokenQueue.AfterConstruction; +begin + inherited; + + fItems := TInterfaceList.Create; +end; + +// ================================================================================================ +// Before Destruction +// ================================================================================================ +procedure TTokenQueue.BeforeDestruction; +begin + FreeAndNil(fItems); + inherited; +end; + + + +// @@@: Interface +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Interface +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Clear +// ================================================================================================ +procedure TTokenQueue.Clear; +begin + fItems.Clear; +end; + +// ================================================================================================ +// Add +// ================================================================================================ +procedure TTokenQueue.Add(Item: IToken); +begin + if Assigned(Item) then + fItems.Add(Item) +end; + +// ================================================================================================ +// Remove +// ================================================================================================ +procedure TTokenQueue.Remove(Num: integer); +var + i: integer; + +begin + if Num > 0 then + begin + if Num >= fItems.Count then + fItems.Clear + + else + for i:=0 to Num -1 do + fItems.Delete(0) + end +end; + + + +// @@@: Property Handlers +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// +// Property Handlers +// +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +// ================================================================================================ +// Get Count +// ================================================================================================ +function TTokenQueue.GetCount: integer; +begin + result := fItems.Count +end; + +// ================================================================================================ +// Get Item +// ================================================================================================ +function TTokenQueue.GetItem(i: integer): IToken; +begin + // ------------------------------------------------------------------------- + // Check for valid index value. + // ------------------------------------------------------------------------- + if i > fItems.Count then raise ERangeError.CreateFmt( 'Index "%d" is too big', [i]); + if i < 0 then raise ERangeError.CreateFmt( 'Index is less than 0', []); + + result := fItems[i] as IToken +end; + +// ================================================================================================ +// Set Item +// ================================================================================================ +procedure TTokenQueue.SetItem(i: integer; value: IToken); +begin + if i > fItems.Count then raise ERangeError.CreateFmt( 'Index "%d" is too big', [i]); + if i < 0 then raise ERangeError.CreateFmt( 'Index is less than 0', []); + + fItems.Items[i] := value +end; + +end. diff --git a/src.rtl/dpgrtl.treeparser.pas b/src.rtl/dpgrtl.treeparser.pas new file mode 100644 index 0000000..28f90c4 --- /dev/null +++ b/src.rtl/dpgrtl.treeparser.pas @@ -0,0 +1,147 @@ +unit dpgrtl.treeparser; + +interface +uses + dpgrtl.types, + dpgrtl.astBase, + dpgrtl.astFactory, + dpgrtl.treeparserstate; + +type + TTreeParser = class + + // The AST Null object; the parsing cursor is set to this when + // it is found to be null. This way, we can test the token type + // of a node without having to have tests for null everywhere. + + // public static ASTNULLType ASTNULL = new ASTNULLType + + + protected + fASTNULL : TAST; + + + + // Where did this rule leave off parsing; + // avoids a return parameter + fRetTree : TAST; + + fInputState : TTreeParserState; + + // table of token type to token names + fTokenNames : TTokenNameMap; + + // AST return value for a rule is squirreled away here + fRetAST : TAST; + + // AST support code; parser and tree parser delegate to this object + fASTFactory : TASTFactory; + + // Used to keep track of indent depth for trace In/Out + fTraceDepth : integer; + + protected + procedure match( ast : TAST; + typ : integer); overload; + + procedure match( ast : TAST; + bits : TByteSet); overload; + + procedure matchNot(ast : TAST; + typ : integer); + + + + private + function GetTokenName( i: integer): AnsiString; + + public + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + + public + property AST : TAST read fRetAST; + + property ASTFactory : TASTFactory read fASTFactory; + + property TokenName[i: integer] : AnsiString read GetTokenName; + property TokenNames : TTokenNameMap read fTokenNames; + + end; + +implementation +uses + dpgrtl.exception, + System.SysUtils; + +{ TTreeParser } + +// ================================================================================================ +// After Construction +// ================================================================================================ +procedure TTreeParser.AfterConstruction; +begin + inherited; + + fTraceDepth := 0; + fInputState := TTreeParserState .Create; + fTokenNames := TTokenNameMap .Create; + fASTFactory := TASTFactory .Create(nil); +end; + +// ================================================================================================ +// Before Destruction +// ================================================================================================ +procedure TTreeParser.BeforeDestruction; +begin + FreeAndNil( fTokenNames); + FreeAndNil( fInputState); + FreeAndNil( fASTFactory); + inherited +end; + +// ================================================================================================ +// Get Token Name +// ================================================================================================ +function TTreeParser.GetTokenName(i: integer): AnsiString; +begin + result := ''; + + if Assigned(fTokenNames) then + fTokenNames.TryGetValue(i, result) +end; + +// ================================================================================================ +// match( AST, type) +// ================================================================================================ +procedure TTreeParser.match(ast: TAST; typ: integer); +begin + // TODO: Exception creation check! + + if (ast = nil) or (ast = fASTNULL) or (ast.AstType <> typ) then + raise Exception.Create('TREE: Mismatched token.'); +end; + +// ================================================================================================ +// match ( AST, byteset) +// +// Make sure current lookahead symbol matches the given set. +// Throw an exception upon mismatch, which is catch by either the error handler or by the +// syntactic predicate. +// ================================================================================================ +procedure TTreeParser.match(ast: TAST; bits: TByteSet); +begin + if (ast = nil) or (ast = fASTNULL) or not (ast.AstType in bits) then + raise Exception.Create('TREE: Mismatched token.'); +end; + +// ================================================================================================ +// match not +// ================================================================================================ +procedure TTreeParser.matchNot(ast: TAST; typ: integer); +begin + if (ast = nil) or (ast = fASTNULL) or (ast.AstType = typ) then + raise Exception.Create('TREE: Mismatched token.'); +end; + +end. diff --git a/src.rtl/dpgrtl.treeparserstate.pas b/src.rtl/dpgrtl.treeparserstate.pas new file mode 100644 index 0000000..5ba32dd --- /dev/null +++ b/src.rtl/dpgrtl.treeparserstate.pas @@ -0,0 +1,49 @@ +unit dpgrtl.treeparserstate; + +interface +uses + dpgrtl.types; + +type + TTreeParserState = class( TInterfacedObject, ITreeParserState) + protected + fGuessing : integer; + + protected + function GetGuessing: integer; + procedure SetGuessing( Value: integer); + + public + procedure AfterConstruction; override; + end; + +implementation + +{ TParserState } + +// ================================================================================================ +// After Construction +// ================================================================================================ +procedure TTreeParserState.AfterConstruction; +begin + inherited; + fGuessing := 0; +end; + +// ================================================================================================ +// Get Guessing +// ================================================================================================ +function TTreeParserState.GetGuessing: integer; +begin + result := fGuessing +end; + +// ================================================================================================ +// Set Guessing +// ================================================================================================ +procedure TTreeParserState.SetGuessing(Value: integer); +begin + fGuessing := Value +end; + +end. diff --git a/src.rtl/dpgrtl.types.pas b/src.rtl/dpgrtl.types.pas new file mode 100644 index 0000000..d319cb5 --- /dev/null +++ b/src.rtl/dpgrtl.types.pas @@ -0,0 +1,182 @@ +unit dpgrtl.types; + +interface +uses + Generics.Collections, + System.SysUtils; + +const + // ------------------------------------------------------------------------- + // autogen values + // ------------------------------------------------------------------------- + AUTOGEN_INVALID = 0; + AUTOGEN_NONE = 1; + AUTOGEN_CARET = 2; + AUTOGEN_BANG = 3; + + // ------------------------------------------------------------------------- + // predefined token types + // ------------------------------------------------------------------------- + TT_SKIP = $FF; + TT_INVALID = 0; + TT_EOF = 1; + TT_NTLA = 2; // null tree lookahead + TT_USER = 4; + + EOF_CHAR = #0; + +type + TByteSet = set of 0..255; + TCharSet = set of AnsiChar; + TCharMatrix = array of array of AnsiChar; + + TTokenNameMap = TDictionary; + + // =================================================================================== + // IToken interface + // =================================================================================== + IToken = interface + ['{BFB516D6-7175-40C8-9AA0-592CA11AD391}'] + + function GetTokenType : byte; + function GetTokenText : AnsiString; + function GetTokenLine : integer; + function GetTokenColumn : integer; + + procedure SetTokenType( Value: byte); + procedure SetTokenText( Value: AnsiString); + procedure SetTokenLine( Value: integer); + procedure SetTokenColumn( Value: integer); + + function Clone: IToken; + + property TokenType : byte read GetTokenType write SetTokenType; + property TokenText : AnsiString read GetTokenText write SetTokenText; + property TokenLine : integer read GetTokenLine write SetTokenLine; + property TokenColumn : integer read GetTokenColumn write SetTokenColumn; + end; + + // =================================================================================== + // ITokenStream interface + // =================================================================================== + ITokenStream = interface + ['{48293450-4B0C-455B-BC3C-313363C503D2}'] + + function NextToken: IToken; + end; + + // =================================================================================== + // IInputBuffer interface + // =================================================================================== + IInputBuffer = interface + ['{936C26A0-E25F-4B4E-9FD3-5E8E7FC23B17}'] + + function GetMarked: boolean; + + procedure Consume; + procedure Commit; + + function Mark: integer; + procedure Rewind( Value: integer); + + property Marked: boolean read GetMarked; + end; + + // =================================================================================== + // ICharBuffer interface + // =================================================================================== + ICharBuffer = interface( IInputBuffer) + ['{AA5CD21F-7982-4FF4-BB52-7A02B65C35A8}'] + + function LA(i: integer): AnsiChar; + end; + + // =================================================================================== + // ITokenBuffer interface + // =================================================================================== + ITokenBuffer = interface( IInputBuffer) + ['{1FD2EB56-5385-49B0-815D-8B7F96E33F1A}'] + + function LA(i: integer): integer; + function LT(i: integer): IToken; + end; + + // =================================================================================== + // ILexerState + // =================================================================================== + ILexerState = interface + ['{D6E15235-CADC-48BA-9390-376284515FAA}'] + + function GetFileName : string; + function GetLine : integer; + function GetColumn : integer; + function GetGuessing : integer; + + function GetInputBuffer : ICharBuffer; + + function GetTokenStartLine : integer; + function GetTokenStartColumn : integer; + + procedure SetFileName( Value: string); + procedure SetLine( Value: integer); + procedure SetColumn( Value: integer); + procedure SetGuessing( Value: integer); + + procedure SetTokenStartLine( Value: integer); + procedure SetTokenStartColumn( Value: integer); + + property FileName : string read GetFileName + write SetFileName; + + property Line : integer read GetLine + write SetLine; + + property Column : integer read GetColumn + write SetColumn; + + property Guessing : integer read GetGuessing + write SetGuessing; + + property TokenStartLine : integer read GetTokenStartLine + write SetTokenStartLine; + + property TokenStartColumn : integer read GetTokenStartColumn + write SetTokenStartColumn; + + property InputBuffer : ICharBuffer read GetInputBuffer; + end; + + // =================================================================================== + // IParserState + // =================================================================================== + IParserState = interface + ['{763A4DAD-91F5-4225-A68D-8FE4B1A29164}'] + + function GetFileName : string; + function GetGuessing : integer; + function GetInputBuffer : ITokenBuffer; + + procedure SetFileName( Value: string); + procedure SetGuessing( Value: integer); + + property FileName : string read GetFileName write SetFileName; + property Guessing : integer read GetGuessing write SetGuessing; + property InputBuffer : ITokenBuffer read GetInputBuffer; + end; + + // =================================================================================== + // ITreeParserState + // =================================================================================== + ITreeParserState = interface + ['{439DCDAA-B1AB-482A-BAAE-843917F60E42}'] + + function GetGuessing: integer; + procedure SetGuessing( Value: integer); + + property Guessing: integer read GetGuessing write SetGuessing; + end; + + +implementation + +end.