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.