Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Optimizing DataRecord

Browse Source
This commit is contained in:
Michael Schimmel
2025-07-18 01:50:41 +02:00
parent c203871c9f
commit 57319a55c1
1 changed files with 49 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Myc.DataRecord.pas
+49 -47
View File
@@ -10,26 +10,25 @@ uses
System.Generics.Defaults;
type
// Provides generic access to a value of type T.
IAccess<T> = interface
['{1D422E3A-25C8-459B-A480-2E246942CF56}']
function GetValue: T;
procedure SetValue(const Value: T);
property Value: T read GetValue write SetValue;
end;
// Describes the memory layout of a field in the data buffer.
TFieldLayout = record
Key: string;
Offset: Integer;
Size: Integer;
TypeInfo: PTypeInfo;
end;
// A record that provides field-level access to data, stored in a packed byte buffer.
TDataRecord = record
public
type
// Provides generic access to a value of type T.
IField<T> = interface
function GetValue: T;
procedure SetValue(const Value: T);
property Value: T read GetValue write SetValue;
end;
// Describes the field and its memory layout in the data buffer.
TFieldLayout = record
Name: string;
Offset: Integer;
Size: Integer;
TypeInfo: PTypeInfo;
end;
// Builder for dynamically creating a TDataRecord.
TBuilder = record
private
@@ -44,37 +43,40 @@ type
private
FLayout: TArray<TFieldLayout>;
FBuffer: TBytes;
public
class operator Initialize(out Dest: TDataRecord);
class operator Finalize(var Dest: TDataRecord);
public
function GetAccess<T>(const Name: String): IAccess<T>;
class operator Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
class function CreateFromRec<T>(const Rec: T): TDataRecord; static;
class function CreateBuilder: TDataRecord.TBuilder; static;
class operator Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
function GetField<T>(const Name: String): IField<T>;
property Layout: TArray<TFieldLayout> read FLayout;
end;
// Accessor for reading/writing data directly from/to the TBytes buffer.
TByteAccessor<T> = class(TInterfacedObject, IAccess<T>)
TByteAccessor<T> = class(TInterfacedObject, TDataRecord.IField<T>)
private
FBuffer: TBytes;
FLayout: TFieldLayout;
FField: TDataRecord.TFieldLayout;
public
constructor Create(ABuffer: TBytes; const ALayout: TFieldLayout);
constructor Create(ABuffer: TBytes; const AField: TDataRecord.TFieldLayout);
function GetValue: T;
procedure SetValue(const Value: T);
end;
// Comparer for sorting and searching field layouts by their string key (Singleton).
TFieldLayoutComparer = class(TComparer<TFieldLayout>)
TFieldLayoutComparer = class(TComparer<TDataRecord.TFieldLayout>)
strict private
class var
FDefault: IComparer<TFieldLayout>;
FDefault: IComparer<TDataRecord.TFieldLayout>;
class constructor CreateClass;
class destructor DestroyClass;
public
function Compare(const Left, Right: TFieldLayout): Integer; override;
class property Default: IComparer<TFieldLayout> read FDefault;
function Compare(const Left, Right: TDataRecord.TFieldLayout): Integer; override;
class property Default: IComparer<TDataRecord.TFieldLayout> read FDefault;
end;
procedure Testfunc;
@@ -96,43 +98,43 @@ begin
FDefault := nil;
end;
function TFieldLayoutComparer.Compare(const Left, Right: TFieldLayout): Integer;
function TFieldLayoutComparer.Compare(const Left, Right: TDataRecord.TFieldLayout): Integer;
begin
Result := TComparer<string>.Default.Compare(Left.Key, Right.Key);
Result := TComparer<string>.Default.Compare(Left.Name, Right.Name);
end;
{$endregion}
{$region 'TByteAccessor<T>'}
constructor TByteAccessor<T>.Create(ABuffer: TBytes; const ALayout: TFieldLayout);
constructor TByteAccessor<T>.Create(ABuffer: TBytes; const AField: TDataRecord.TFieldLayout);
begin
inherited Create;
FBuffer := ABuffer;
FLayout := ALayout;
FField := AField;
end;
function TByteAccessor<T>.GetValue: T;
type
PT = ^T;
begin
Result := PT(@FBuffer[FLayout.Offset])^;
Result := PT(@FBuffer[FField.Offset])^;
end;
procedure TByteAccessor<T>.SetValue(const Value: T);
type
PT = ^T;
begin
PT(@FBuffer[FLayout.Offset])^ := Value;
PT(@FBuffer[FField.Offset])^ := Value;
end;
{$endregion}
{$region 'TDataRecord'}
function TDataRecord.GetAccess<T>(const Name: String): IAccess<T>;
function TDataRecord.GetField<T>(const Name: String): IField<T>;
var
dummyLayout: TFieldLayout;
index: Integer;
begin
Result := nil;
dummyLayout.Key := Name;
dummyLayout.Name := Name;
if TArray.BinarySearch<TFieldLayout>(FLayout, dummyLayout, index, TFieldLayoutComparer.Default) then
begin
@@ -236,7 +238,7 @@ begin
var ofs: NativeUInt := 0;
for pair in FStagedValues do
begin
layout.Key := pair.Key;
layout.Name := pair.Key;
layout.Size := pair.Value.DataSize;
ofs := (ofs + 15) and not 15;
@@ -287,8 +289,8 @@ procedure Testfunc;
var
testRec: TTestRec;
R: TDataRecord;
nameAccess: IAccess<String>;
bAccess: IAccess<Integer>;
nameAccess: TDataRecord.IField<String>;
bAccess: TDataRecord.IField<Integer>;
const
JSON_DATA = '{"IntValue": 123, "StringValue": "Hello JSON", "FloatValue": 99.9, "BoolValue": true}';
begin
@@ -301,12 +303,12 @@ begin
R := TDataRecord.CreateFromRec<TTestRec>(testRec);
// Test reading a string value
nameAccess := R.GetAccess<String>('Name');
nameAccess := R.GetField<String>('Name');
Assert(Assigned(nameAccess));
Assert(nameAccess.Value = 'Hi');
// Test reading an integer value
bAccess := R.GetAccess<Integer>('B');
bAccess := R.GetField<Integer>('B');
Assert(Assigned(bAccess));
Assert(bAccess.Value = 5);
@@ -314,11 +316,11 @@ begin
bAccess.Value := 99;
Assert(bAccess.Value = 99);
// Verify it was written back to the buffer
var bAccess2 := R.GetAccess<Integer>('B');
var bAccess2 := R.GetField<Integer>('B');
Assert(bAccess2.Value = 99);
// Verify that a request for a wrong type returns nil
var aAccess := R.GetAccess<String>('A');
var aAccess := R.GetField<String>('A');
Assert(not Assigned(aAccess));
// Test the builder pattern
@@ -329,29 +331,29 @@ begin
var T := S;
var dblAccess := T.GetAccess<Double>('ZValue');
var dblAccess := T.GetField<Double>('ZValue');
Assert(Assigned(dblAccess));
Assert(dblAccess.Value = 222.0);
var strAccess := T.GetAccess<String>('AValue');
var strAccess := T.GetField<String>('AValue');
Assert(Assigned(strAccess));
Assert(strAccess.Value = 'Builder Test');
{
// Test JSON parsing
var jsonRec := TDataRecord.CreateFromJSON(JSON_DATA);
var intAccess := jsonRec.GetAccess<Int64>('IntValue');
var intAccess := jsonRec.GetField<Int64>('IntValue');
Assert(Assigned(intAccess));
Assert(intAccess.Value = 123);
strAccess := jsonRec.GetAccess<string>('StringValue');
strAccess := jsonRec.GetField<string>('StringValue');
Assert(Assigned(strAccess));
Assert(strAccess.Value = 'Hello JSON');
dblAccess := jsonRec.GetAccess<Double>('FloatValue');
dblAccess := jsonRec.GetField<Double>('FloatValue');
Assert(Assigned(dblAccess));
Assert(dblAccess.Value = 99.9);
var boolAccess := jsonRec.GetAccess<Boolean>('BoolValue');
var boolAccess := jsonRec.GetField<Boolean>('BoolValue');
Assert(Assigned(boolAccess));
Assert(boolAccess.Value = true);
}