Rootnode can now be of multiple types (not just Unit)

Author: Irame

Source/DelphiAST.Consts.pas

@@ -65,6 +65,7 @@ interface
     ntImplementation,
     ntImplements,
     ntIn,
+    ntInclude,
     ntIndex,
     ntIndexed,
     ntInherited,
@@ -73,6 +74,7 @@ interface
     ntIs,
     ntLabel,
     ntLHS,
+    ntLibrary,
     ntLiteral,
     ntLower,
     ntLowerEqual,
@@ -90,6 +92,7 @@ interface
     ntParameters,
     ntPath,
     ntPositionalArgument,
+    ntProgramm,
     ntProtected,
     ntPrivate,
     ntProperty,
@@ -220,6 +223,7 @@ interface
     'implementation',
     'implements',
     'in',
+    'include',
     'index',
     'indexed',
     'inherited',
@@ -228,6 +232,7 @@ interface
     'is',
     'label',
     'lhs',
+    'library',
     'literal',
     'lower',
     'lowerequal',
@@ -245,6 +250,7 @@ interface
     'parameters',
     'path',
     'positionalargument',
+    'programm',
     'protected',
     'private',
     'property',

Source/DelphiAST.pas

@@ -61,7 +61,9 @@   TPasSyntaxTreeBuilder = class(TmwSimplePasParEx)
     procedure CallInheritedPropertyParameterList;
     procedure SetCurrentCompoundNodesEndPosition;
     procedure DoOnComment(Sender: TObject; const Text: string);
+    procedure PushRootNode(Typ: TSyntaxNodeType);
   protected
+    FRootNode: TSyntaxNode;
     FStack: TNodeStack;
     FComments: TObjectList<TCommentNode>;
     procedure AccessSpecifier; override;
@@ -145,6 +147,7 @@   TPasSyntaxTreeBuilder = class(TmwSimplePasParEx)
     procedure Identifier; override;
     procedure ImplementationSection; override;
     procedure ImplementsSpecifier; override;
+    procedure IncludeFile; override;
     procedure IndexSpecifier; override;
     procedure IndexOp; override;
     procedure InheritedStatement; override;
@@ -157,6 +160,7 @@   TPasSyntaxTreeBuilder = class(TmwSimplePasParEx)
     procedure InterfaceSection; override;
     procedure InterfaceType; override;
     procedure LabelId; override;
+    procedure LibraryFile; override;
     procedure MainUsesClause; override;
     procedure MainUsedUnitStatement; override;
     procedure MethodKind; override;
@@ -166,6 +170,7 @@   TPasSyntaxTreeBuilder = class(TmwSimplePasParEx)
     procedure Number; override;
     procedure ObjectNameOfMethod; override;
     procedure OutParameter; override;
+    procedure PackageFile; override;
     procedure ParameterFormal; override;
     procedure ParameterName; override;
     procedure PointerSymbol; override;
@@ -174,6 +179,7 @@   TPasSyntaxTreeBuilder = class(TmwSimplePasParEx)
     procedure ProcedureHeading; override;
     procedure ProcedureDeclarationSection; override;
     procedure ProcedureProcedureName; override;
+    procedure ProgramFile; override;
     procedure PropertyName; override;
     procedure PropertyParameterList; override;
     procedure RaiseStatement; override;
@@ -1501,6 +1507,16 @@ procedure TPasSyntaxTreeBuilder.ImplementsSpecifier;
   end;
 end;
 
+procedure TPasSyntaxTreeBuilder.IncludeFile;
+begin
+  PushRootNode(ntInclude);
+  try
+    inherited;
+  finally
+    FStack.Pop;
+  end;
+end;
+
 procedure TPasSyntaxTreeBuilder.IndexOp;
 begin
   FStack.Push(ntIndexed);
@@ -1635,6 +1651,16 @@ procedure TPasSyntaxTreeBuilder.LabelId;
   inherited;
 end;
 
+procedure TPasSyntaxTreeBuilder.LibraryFile;
+begin
+  PushRootNode(ntLibrary);
+  try
+    inherited;
+  finally
+    FStack.Pop;
+  end;
+end;
+
 procedure TPasSyntaxTreeBuilder.MainUsedUnitStatement;
 var
   NameNode, PathNode, PathLiteralNode, Temp: TSyntaxNode;
@@ -1787,6 +1813,16 @@ procedure TPasSyntaxTreeBuilder.OutParameter;
   end;
 end;
 
+procedure TPasSyntaxTreeBuilder.PackageFile;
+begin
+  PushRootNode(ntPackage);
+  try
+    inherited;
+  finally
+    FStack.Pop;
+  end;
+end;
+
 procedure TPasSyntaxTreeBuilder.ParameterFormal;
 begin
   FStack.Push(ntParameters);
@@ -1868,6 +1904,16 @@ procedure TPasSyntaxTreeBuilder.PropertyName;
   inherited PropertyName;
 end;
 
+procedure TPasSyntaxTreeBuilder.ProgramFile;
+begin
+  PushRootNode(ntProgramm);
+  try
+    inherited;
+  finally
+    FStack.Pop;
+  end;
+end;
+
 procedure TPasSyntaxTreeBuilder.PropertyParameterList;
 var
   TreeBuilderMethod: TTreeBuilderMethod;
@@ -2047,26 +2093,29 @@ class function TPasSyntaxTreeBuilder.Run(const FileName: string;
 
 function TPasSyntaxTreeBuilder.Run(SourceStream: TStream): TSyntaxNode;
 begin
-  Result := TSyntaxNode.Create(ntUnit);
   try
+    FRootNode := nil;
     FStack.Clear;
-    FStack.Push(Result);
-    try
-      self.OnMessage := ParserMessage;
-      inherited Run('', SourceStream);
-    finally
-      FStack.Pop;
-    end;
+    self.OnMessage := ParserMessage;
+    inherited Run('', SourceStream);
   except
     on E: EParserException do
-      raise ESyntaxTreeException.Create(E.Line, E.Col, Lexer.FileName, E.Message, Result);
+      if FRootNode <> nil then
+        raise ESyntaxTreeException.Create(E.Line, E.Col, Lexer.FileName, E.Message, FRootNode)
+      else
+        raise;
     on E: ESyntaxError do
-      raise ESyntaxTreeException.Create(E.PosXY.X, E.PosXY.Y, Lexer.FileName, E.Message, Result);
+      if FRootNode <> nil then
+        raise ESyntaxTreeException.Create(E.PosXY.X, E.PosXY.Y, Lexer.FileName, E.Message, FRootNode)
+      else
+        raise;
     else
-      FreeAndNil(Result);
+      FreeAndNil(FRootNode);
       raise;
   end;
 
+  Result := FRootNode;
+
   Assert(FStack.Count = 0);
 end;
 
@@ -2458,12 +2507,13 @@ procedure TPasSyntaxTreeBuilder.UnaryMinus;
 end;
 
 procedure TPasSyntaxTreeBuilder.UnitFile;
-var
-  Temp: TSyntaxNode;
 begin
-  Temp := FStack.Peek;
-  AssignLexerPositionToNode(Lexer, Temp);
-  inherited;
+  PushRootNode(ntUnit);
+  try
+    inherited;
+  finally
+    FStack.Pop;
+  end;
 end;
 
 procedure TPasSyntaxTreeBuilder.UnitId;
@@ -2730,6 +2780,16 @@ procedure TPasSyntaxTreeBuilder.WithStatement;
   end;
 end;
 
+procedure TPasSyntaxTreeBuilder.PushRootNode(Typ: TSyntaxNodeType);
+begin
+  Assert(FRootNode = nil); 
+  Assert(FStack.Count = 0);
+   
+  FRootNode := TSyntaxNode.Create(Typ);
+
+  FStack.Push(FRootNode);
+end;
+
 { ESyntaxTreeException }
 
 constructor ESyntaxTreeException.Create(Line, Col: Integer; const FileName, Msg: string;