Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Re-added the string cache, disabled by default (bonus: also thread-safe) #172

Open
wants to merge 11 commits into
base: master
Choose a base branch
from
Open

Re-added the string cache, disabled by default (bonus: also thread-safe) #172

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
11 commits
Select commit Hold shift + click to select a range
95233e9
Update README.md
vintagedave Aug 4, 2015
643d79f
Merge branch 'master' of https://github.com/vintagedave/DelphiAST
vintagedave Apr 1, 2016
e6baee2
Re-adding string caching (memory optimization, for memory usage and a…
vintagedave Apr 22, 2016
3228e5b
TValuedSyntaxNode uses the string cache
vintagedave Apr 22, 2016
66d852e
Lexer uses the string cache for tokens
vintagedave Apr 22, 2016
1aa71d6
TStringCacheDictionary is not used (was originally written for a dict…
vintagedave Apr 22, 2016
fc0470b
Basic threadsafety for the string cache. Not extensively reviewed. Wh…
vintagedave Apr 22, 2016
5b58370
Fixed typos for case where the ifdef to be threadsafe was turned off
vintagedave Apr 22, 2016
6685524
Comment; also holds lock for AddAndGet (enters lock individually for …
vintagedave Apr 22, 2016
38e35ba
Revert "Update README.md"
vintagedave Apr 22, 2016
b799dd8
Information comment at the top of StringCache.pas
vintagedave Apr 23, 2016
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
71 changes: 64 additions & 7 deletions Source/DelphiAST.Classes.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,8 @@
interface

uses
SysUtils, Generics.Collections, SimpleParser.Lexer.Types, DelphiAST.Consts;
SysUtils, Generics.Collections, SimpleParser.Lexer.Types, DelphiAST.Consts
{$ifdef USESTRINGCACHE}, SimpleParser.StringCache{$endif};

type
EParserException = class(Exception)
Expand All @@ -19,8 +20,14 @@ EParserException = class(Exception)
property Line: Integer read FLine;
property Col: Integer read FCol;
end;

{$ifdef USESTRINGCACHE}
TAttributeEntryValue = TStringId;
{$else}
TAttributeEntryValue = string;
{$endif}

TAttributeEntry = TPair<TAttributeName, string>;
TAttributeEntry = TPair<TAttributeName, TAttributeEntryValue>;
PAttributeEntry = ^TAttributeEntry;

TSyntaxNodeClass = class of TSyntaxNode;
Expand All @@ -32,6 +39,8 @@ TSyntaxNode = class
function GetHasChildren: Boolean;
function GetHasAttributes: Boolean;
function TryGetAttributeEntry(const Key: TAttributeName; var AttributeEntry: PAttributeEntry): boolean;
procedure SetAttributeInternal(const Key: TAttributeName; const Value: TAttributeEntryValue);
{$ifdef USESTRINGCACHE}procedure SetAttribute(const Key: TAttributeName; const Value: TStringId); overload;{$endif}
protected
FAttributes: TArray<TAttributeEntry>;
FChildNodes: TArray<TSyntaxNode>;
Expand All @@ -45,7 +54,7 @@ TSyntaxNode = class

function GetAttribute(const Key: TAttributeName): string;
function HasAttribute(const Key: TAttributeName): Boolean;
procedure SetAttribute(const Key: TAttributeName; const Value: string);
procedure SetAttribute(const Key: TAttributeName; const Value: string); {$ifdef USESTRINGCACHE}overload;{$endif}
procedure ClearAttributes;

function AddChild(Node: TSyntaxNode): TSyntaxNode; overload;
Expand Down Expand Up @@ -80,11 +89,13 @@ TCompoundSyntaxNode = class(TSyntaxNode)

TValuedSyntaxNode = class(TSyntaxNode)
private
FValue: string;
FValue: {$ifdef USESTRINGCACHE}TStringId{$else}string{$endif};
function GetValue: string;
procedure SetValue(const Value: string);
public
function Clone: TSyntaxNode; override;

property Value: string read FValue write FValue;
property Value: string read GetValue write SetValue;
end;

TCommentNode = class(TSyntaxNode)
Expand Down Expand Up @@ -360,6 +371,27 @@ class procedure TExpressionTools.RawNodeListToTree(RawParentNode: TSyntaxNode; R
{ TSyntaxNode }

procedure TSyntaxNode.SetAttribute(const Key: TAttributeName; const Value: string);
{$ifdef USESTRINGCACHE}
var
NewValue : TAttributeEntryValue;
{$endif}
begin
{$ifdef USESTRINGCACHE}
NewValue := TStringCache.Instance.Add(Value);
SetAttributeInternal(Key, NewValue);
{$else}
SetAttributeInternal(Key, Value);
{$endif}
end;

{$ifdef USESTRINGCACHE}
procedure TSyntaxNode.SetAttribute(const Key: TAttributeName; const Value: TStringId);
begin
SetAttributeInternal(Key, Value);
end;
{$endif}

procedure TSyntaxNode.SetAttributeInternal(const Key: TAttributeName; const Value: TAttributeEntryValue);
var
AttributeEntry: PAttributeEntry;
NewAttributeEntry: TAttributeEntry;
Expand Down Expand Up @@ -409,7 +441,7 @@ function TSyntaxNode.AddChild(Typ: TSyntaxNodeType): TSyntaxNode;
function TSyntaxNode.Clone: TSyntaxNode;
var
ChildNode: TSyntaxNode;
Attr: TPair<TAttributeName, string>;
Attr: TPair<TAttributeName, TAttributeEntryValue>;
begin
Result := TSyntaxNodeClass(Self.ClassType).Create(FTyp);

Expand All @@ -431,6 +463,7 @@ constructor TSyntaxNode.Create(Typ: TSyntaxNodeType);
SetLength(FAttributes, 0);
SetLength(FChildNodes, 0);
FParentNode := nil;
{$ifdef USESTRINGCACHE}TStringCache.Instance.IncRef;{$endif}
end;

procedure TSyntaxNode.ExtractChild(Node: TSyntaxNode);
Expand Down Expand Up @@ -463,6 +496,8 @@ destructor TSyntaxNode.Destroy;
var
i: integer;
begin
{$ifdef USESTRINGCACHE}TStringCache.Instance.DecRef;{$endif}

for i := 0 to Length(FChildNodes) - 1 do
FChildNodes[i].Free;
SetLength(FChildNodes, 0);
Expand All @@ -489,7 +524,11 @@ function TSyntaxNode.GetAttribute(const Key: TAttributeName): string;
AttributeEntry: PAttributeEntry;
begin
if TryGetAttributeEntry(Key, AttributeEntry) then
Result := AttributeEntry.Value
{$ifdef USESTRINGCACHE}
Result := TStringCache.Instance.Get(AttributeEntry.Value)
{$else}
Result := AttributeEntry.Value
{$endif}
else
Result := '';
end;
Expand Down Expand Up @@ -535,6 +574,24 @@ function TValuedSyntaxNode.Clone: TSyntaxNode;
TValuedSyntaxNode(Result).Value := Self.Value;
end;

function TValuedSyntaxNode.GetValue: string;
begin
{$ifdef USESTRINGCACHE}
Result := TStringCache.Instance.Get(FValue);
{$else}
Result := FValue;
{$endif}
end;

procedure TValuedSyntaxNode.SetValue(const Value: string);
begin
{$ifdef USESTRINGCACHE}
FValue := TStringCache.Instance.Add(Value);
{$else}
FValue := Value;
{$endif}
end;

{ TCommentNode }

function TCommentNode.Clone: TSyntaxNode;
Expand Down
12 changes: 9 additions & 3 deletions Source/DelphiAST.Writer.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@ TSyntaxTreeWriter = class
implementation

uses
Generics.Collections, DelphiAST.Consts;
Generics.Collections, DelphiAST.Consts, SimpleParser.StringCache;

{$I SimpleParser.inc}
{$IFDEF D18_NEWER}
Expand Down Expand Up @@ -64,7 +64,7 @@ class procedure TSyntaxTreeWriter.NodeToXML(const Builder: TStringBuilder;
var
HasChildren: Boolean;
NewIndent: string;
Attr: TPair<TAttributeName, string>;
Attr: TPair<TAttributeName, TAttributeEntryValue>;
ChildNode: TSyntaxNode;
begin
HasChildren := Node.HasChildren;
Expand Down Expand Up @@ -94,7 +94,13 @@ 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(' ' + AttributeNameToStr(Attr.Key) + '="'
{$ifdef USESTRINGCACHE}
+ XMLEncode(TStringCache.Instance.Get(Attr.Value))
{$else}
+ XMLEncode(Attr.Value)
{$endif}
+ '"');
if HasChildren then
Builder.Append('>')
else
Expand Down
17 changes: 15 additions & 2 deletions Source/SimpleParser/SimpleParser.Lexer.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -397,7 +397,8 @@ TmwPasLex = class(TmwBasePasLex)
implementation

uses
StrUtils;
StrUtils
{$ifdef USESTRINGCACHE}, SimpleParser.StringCache{$endif};

type
TmwPasLexExpressionEvaluation = (leeNone, leeAnd, leeOr);
Expand Down Expand Up @@ -1313,10 +1314,18 @@ constructor TmwBasePasLex.Create;

New(FBuffer);
FillChar(FBuffer^, SizeOf(TBufferRec), 0);

{$ifdef USESTRINGCACHE}
TStringCache.Instance.IncRef;
{$endif}
end;

destructor TmwBasePasLex.Destroy;
begin
{$ifdef USESTRINGCACHE}
TStringCache.Instance.DecRef;
{$endif}

if not FBuffer.SharedBuffer then
FreeMem(FBuffer.Buf);

Expand Down Expand Up @@ -2224,7 +2233,11 @@ function TmwBasePasLex.GetIsSpace: Boolean;

function TmwBasePasLex.GetToken: string;
begin
SetString(Result, (FBuffer.Buf + FTokenPos), GetTokenLen);
{$ifdef USESTRINGCACHE}
Result := TStringCache.Instance.AddAndGet(FBuffer.Buf + FTokenPos, GetTokenLen);
{$else}
SetString(Result, (FBuffer.Buf + FTokenPos), GetTokenLen);
{$endif}
end;

function TmwBasePasLex.GetTokenLen: Integer;
Expand Down
Loading