Performance optimizations

Demo/DelphiASTDemo.dproj

@@ -1,7 +1,7 @@
 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
     <PropertyGroup>
         <ProjectGuid>{6DAA4B8F-6103-4418-BAA9-E92227FE34C9}</ProjectGuid>
-        <ProjectVersion>17.2</ProjectVersion>
+        <ProjectVersion>18.1</ProjectVersion>
         <FrameworkType>VCL</FrameworkType>
         <MainSource>DelphiASTDemo.dpr</MainSource>
         <Base>True</Base>
@@ -49,6 +49,7 @@
         <DCC_K>false</DCC_K>
     </PropertyGroup>
     <PropertyGroup Condition="'$(Base_Win32)'!=''">
+        <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
         <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
         <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
         <DCC_UsePackage>IndyIPClient;FireDACASADriver;FireDACSqliteDriver;bindcompfmx;FireDACDSDriver;DBXSqliteDriver;vcldbx;FireDACPgDriver;FireDACODBCDriver;RESTBackendComponents;fmx;rtl;dbrtl;DbxClientDriver;IndySystem;FireDACCommon;bindcomp;inetdb;tethering;inetdbbde;DBXInterBaseDriver;DataSnapClient;DataSnapServer;DataSnapCommon;DBXOdbcDriver;vclFireDAC;DataSnapProviderClient;xmlrtl;DataSnapNativeClient;DBXSybaseASEDriver;DbxCommonDriver;svnui;vclimg;IndyProtocols;dbxcds;DBXMySQLDriver;DatasnapConnectorsFreePascal;FireDACCommonDriver;MetropolisUILiveTile;bindcompdbx;bindengine;vclactnband;vcldb;soaprtl;vcldsnap;bindcompvcl;vclie;fmxFireDAC;FireDACADSDriver;DBXDb2Driver;vcltouch;DBXOracleDriver;CustomIPTransport;vclribbon;VclSmp;FireDACMSSQLDriver;FireDAC;dsnap;DBXInformixDriver;fmxase;vcl;IndyCore;IndyIPServer;DataSnapServerMidas;DBXMSSQLDriver;IndyIPCommon;VCLRESTComponents;dsnapcon;FireDACIBDriver;DBXFirebirdDriver;inet;CloudService;DataSnapFireDAC;fmxobj;DataSnapConnectors;FireDACDBXDriver;FireDACMySQLDriver;soapmidas;vclx;soapserver;inetdbxpress;CodeSiteExpressPkg;svn;DBXSybaseASADriver;dsnapxml;FireDACOracleDriver;FireDACInfxDriver;FireDACDb2Driver;fmxdae;RESTComponents;bdertl;FireDACMSAccDriver;dbexpress;DataSnapIndy10ServerTransport;adortl;$(DCC_UsePackage)</DCC_UsePackage>

Demo/uMainForm.dfm

@@ -18,10 +18,24 @@ object MainForm: TMainForm
     Left = 0
     Top = 0
     Width = 666
-    Height = 389
+    Height = 370
     Align = alClient
     ScrollBars = ssBoth
     TabOrder = 0
+    ExplicitHeight = 389
+  end
+  object StatusBar: TStatusBar
+    Left = 0
+    Top = 370
+    Width = 666
+    Height = 19
+    Panels = <
+      item
+        Width = 50
+      end>
+    ExplicitLeft = 344
+    ExplicitTop = 216
+    ExplicitWidth = 0
   end
   object MainMenu: TMainMenu
     Left = 224

Demo/uMainForm.pas

@@ -6,50 +6,66 @@ interface
 
 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
-  Dialogs, Menus, StdCtrls, SimpleParser.Lexer.Types;
+  Dialogs, Menus, StdCtrls, ComCtrls;
 
 type
   TMainForm = class(TForm)
     OutputMemo: TMemo;
     MainMenu: TMainMenu;
     OpenDelphiUnit1: TMenuItem;
     OpenDialog: TOpenDialog;
+    StatusBar: TStatusBar;
     procedure OpenDelphiUnit1Click(Sender: TObject);
-  private
-    function Parse(const FileName: string): string;
-  public
-    { Public declarations }
-  end;
-
-  TIncludeHandler = class(TInterfacedObject, IIncludeHandler)
-  private
-    FPath: string;
-  public
-    constructor Create(const Path: string);
-    function GetIncludeFileContent(const FileName: string): string;
   end;
 
 var
   MainForm: TMainForm;
 
+function Parse(const FileName: string; out StatusText: string): string;
+
 implementation
 
 uses
-  DelphiAST, DelphiAST.Writer, DelphiAST.Classes, IOUtils;
+  DelphiAST, DelphiAST.Writer, DelphiAST.Classes,
+  SimpleParser.Lexer.Types, IOUtils, Diagnostics;
 
 {$IFNDEF FPC}
   {$R *.dfm}
 {$ELSE}
   {$R *.lfm}
 {$ENDIF}
 
-function TMainForm.Parse(const FileName: string): string;
+type
+  TIncludeHandler = class(TInterfacedObject, IIncludeHandler)
+  private
+    FPath: string;
+  public
+    constructor Create(const Path: string);
+    function GetIncludeFileContent(const FileName: string): string;
+  end;
+
+function MemoryUsed: Cardinal;
+var
+  st: TMemoryManagerState;
+  sb: TSmallBlockTypeState;
+begin
+  GetMemoryManagerState(st);
+  Result := st.TotalAllocatedMediumBlockSize + st.TotalAllocatedLargeBlockSize;
+  for sb in st.SmallBlockTypeStates do
+    Result := Result + sb.UseableBlockSize * sb.AllocatedBlockCount;
+end;
+
+function Parse(const FileName: string; out StatusText: string): string;
 var
   SyntaxTree: TSyntaxNode;
+  memused: Cardinal;
+  sw: TStopwatch;
 begin
-  Result := '';
   try
+    sw := TStopwatch.StartNew;
+    memused := MemoryUsed;
     SyntaxTree := TPasSyntaxTreeBuilder.Run(FileName, False, TIncludeHandler.Create(ExtractFilePath(FileName)));
+    StatusText := Format('Parsed file in %d ms - used memory: %d K', [sw.ElapsedMilliseconds, (MemoryUsed - memused) div 1024]);
     try
       Result := TSyntaxTreeWriter.ToXML(SyntaxTree, True);
     finally
@@ -63,9 +79,14 @@ function TMainForm.Parse(const FileName: string): string;
 end;
 
 procedure TMainForm.OpenDelphiUnit1Click(Sender: TObject);
+var
+  StatusText: string;
 begin
   if OpenDialog.Execute then
-    OutputMemo.Lines.Text := Parse(OpenDialog.FileName);
+  begin
+    OutputMemo.Lines.Text := Parse(OpenDialog.FileName, StatusText);
+    StatusBar.Panels[0].Text := StatusText;
+  end
 end;
 
 { TIncludeHandler }

Source/DelphiAST.Classes.pas

@@ -121,9 +121,6 @@   TOperatorInfo = record
 
   TOperators = class
   strict private
-    class var FOps: TDictionary<TSyntaxNodeType, TOperatorInfo>;
-    class constructor Create;
-    class destructor Destroy;
     class function GetItem(Typ: TSyntaxNodeType): TOperatorInfo; static;
   public
     class function IsOpName(Typ: TSyntaxNodeType): Boolean;
@@ -163,29 +160,23 @@   TOperators = class
 
 { TOperators }
 
-class constructor TOperators.Create;
-var
-  I: Integer;
-begin
-  FOps := TDictionary<TSyntaxNodeType, TOperatorInfo>.Create;
-
-  for I := Low(OperatorsInfo) to High(OperatorsInfo) do
-    FOps.Add(OperatorsInfo[I].Typ, OperatorsInfo[I]);
-end;
-
-class destructor TOperators.Destroy;
-begin
-  FOps.Free;
-end;
-
 class function TOperators.GetItem(Typ: TSyntaxNodeType): TOperatorInfo;
+var
+  i: Integer;
 begin
-  Result := FOps[Typ];
+  for i := 0 to High(OperatorsInfo) do
+    if OperatorsInfo[i].Typ = Typ then
+      Exit(OperatorsInfo[i]);
 end;
 
 class function TOperators.IsOpName(Typ: TSyntaxNodeType): Boolean;
+var
+  i: Integer;
 begin
-  Result := FOps.ContainsKey(Typ);
+  for i := 0 to High(OperatorsInfo) do
+    if OperatorsInfo[i].Typ = Typ then
+      Exit(True);
+  Result := False;
 end;
 
 function IsRoundClose(Typ: TSyntaxNodeType): Boolean; inline;
@@ -362,31 +353,30 @@ class procedure TExpressionTools.RawNodeListToTree(RawParentNode: TSyntaxNode; R
 procedure TSyntaxNode.SetAttribute(const Key: TAttributeName; const Value: string);
 var
   AttributeEntry: PAttributeEntry;
-  NewAttributeEntry: TAttributeEntry;
+  len: Integer;
 begin
-  if TryGetAttributeEntry(Key, AttributeEntry) then
-    AttributeEntry^.Value := Value
-  else
+  if not TryGetAttributeEntry(Key, AttributeEntry) then
   begin
-    NewAttributeEntry.Key := Key;
-    NewAttributeEntry.Value := Value;
-    SetLength(FAttributes, Length(FAttributes) + 1);
-    FAttributes[Length(FAttributes) - 1] := NewAttributeEntry;
+    len := Length(FAttributes);
+    SetLength(FAttributes, len + 1);
+    AttributeEntry := @FAttributes[len];
+    AttributeEntry^.Key := Key;
   end;
+  AttributeEntry^.Value := Value;
 end;
 
 function TSyntaxNode.TryGetAttributeEntry(const Key: TAttributeName; var AttributeEntry: PAttributeEntry): boolean;
 var
   i: integer;
 begin
-  for i := 0 to Length(FAttributes) - 1 do
+  for i := 0 to High(FAttributes) do
     if FAttributes[i].Key = Key then
     begin
       AttributeEntry := @FAttributes[i];
-      Exit(true);
+      Exit(True);
     end;
 
-  Exit(false);
+  Result := False;
 end;
 
 function TSyntaxNode.AddChild(Node: TSyntaxNode): TSyntaxNode;
@@ -408,16 +398,18 @@ function TSyntaxNode.AddChild(Typ: TSyntaxNodeType): TSyntaxNode;
 
 function TSyntaxNode.Clone: TSyntaxNode;
 var
-  ChildNode: TSyntaxNode;
-  Attr: TPair<TAttributeName, string>;
+  i: Integer;
 begin
   Result := TSyntaxNodeClass(Self.ClassType).Create(FTyp);
 
-  for ChildNode in FChildNodes do
-    Result.AddChild(ChildNode.Clone);
+  SetLength(Result.FChildNodes, Length(FChildNodes));
+  for i := 0 to High(FChildNodes) do
+  begin
+    Result.FChildNodes[i] := FChildNodes[i].Clone;
+    Result.FChildNodes[i].FParentNode := Result;
+  end;
 
-  for Attr in FAttributes do
-    Result.SetAttribute(Attr.Key, Attr.Value);
+  Result.FAttributes := Copy(FAttributes);
 
   Result.Col := Self.Col;
   Result.Line := Self.Line;
@@ -428,29 +420,20 @@ constructor TSyntaxNode.Create(Typ: TSyntaxNodeType);
 begin
   inherited Create;
   FTyp := Typ;
-  SetLength(FAttributes, 0);
-  SetLength(FChildNodes, 0);
-  FParentNode := nil;
 end;
 
 procedure TSyntaxNode.ExtractChild(Node: TSyntaxNode);
 var
-  NodeIndex, i: integer;
+  i: integer;
 begin
-  NodeIndex := -1;
-  for i := 0 to Length(FChildNodes) - 1 do
+  for i := 0 to High(FChildNodes) do
     if FChildNodes[i] = Node then
     begin
-      NodeIndex := i;
-      break;
+      if i < High(FChildNodes) then
+        Move(FChildNodes[i + 1], FChildNodes[i], SizeOf(TSyntaxNode) * (Length(FChildNodes) - i - 1));
+      SetLength(FChildNodes, High(FChildNodes));
+      Break;
     end;
-
-  if NodeIndex >= 0 then
-  begin
-    if NodeIndex < High(FChildNodes) then
-      Move(FChildNodes[NodeIndex + 1], FChildNodes[NodeIndex], SizeOf(FChildNodes[0]) * (Length(FChildNodes) - NodeIndex - 1));
-    SetLength(FChildNodes, Length(FChildNodes) - 1);
-  end;   
 end;
 
 procedure TSyntaxNode.DeleteChild(Node: TSyntaxNode);
@@ -463,25 +446,19 @@ destructor TSyntaxNode.Destroy;
 var
   i: integer;
 begin
-  for i := 0 to Length(FChildNodes) - 1 do
-    FChildNodes[i].Free;
-  SetLength(FChildNodes, 0);
-
-  SetLength(FAttributes, 0);  
+  for i := 0 to High(FChildNodes) do
+    FreeAndNil(FChildNodes[i]);
   inherited;
 end;
 
 function TSyntaxNode.FindNode(Typ: TSyntaxNodeType): TSyntaxNode;
 var
-  Node: TSyntaxNode;
+  i: Integer;
 begin
+  for i := 0 to High(FChildNodes) do
+    if FChildNodes[i].Typ = Typ then
+      Exit(FChildNodes[i]);
   Result := nil;
-  for Node in FChildNodes do
-    if Node.Typ = Typ then
-    begin
-      Result := Node;
-      Break;
-    end;
 end;
 
 function TSyntaxNode.GetAttribute(const Key: TAttributeName): string;

Source/DelphiAST.Consts.pas

@@ -289,17 +289,7 @@ interface
     'slashescomment'
   );
 
-const
-  sENUM              = 'enum';
-  sSUBRANGE          = 'subrange';
-
-  function AttributeNameToStr(const AttributeName : TAttributeName) : string;
-
-implementation
-
-function AttributeNameToStr(const AttributeName : TAttributeName) : string;
-const
-  AttributeNameStrings : array[TAttributeName] of string = (
+  AttributeNameStrings: array[TAttributeName] of string = (
     'type',
     'class',
     'forwarded',
@@ -313,8 +303,7 @@ function AttributeNameToStr(const AttributeName : TAttributeName) : string;
     'overload',
     'abstract'
   );
-begin
-  Exit(AttributeNameStrings[AttributeName]);
-end;
+
+implementation
 
 end.

Source/DelphiAST.Writer.pas

@@ -94,7 +94,7 @@ class procedure TSyntaxTreeWriter.NodeToXML(const Builder: TStringBuilder;
       Builder.Append(' value="' + XMLEncode(TValuedSyntaxNode(Node).Value) + '"');
 
     for Attr in Node.Attributes do
-      Builder.Append(' ' + AttributeNameToStr(Attr.Key) + '="' + XMLEncode(Attr.Value) + '"');
+      Builder.Append(' ' + AttributeNameStrings[Attr.Key] + '="' + XMLEncode(Attr.Value) + '"');
     if HasChildren then
       Builder.Append('>')
     else