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:30:28 +02:00
parent d2c47843a7
commit c203871c9f
1 changed files with 159 additions and 160 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Myc.DataRecord.pas
+159 -160
View File
@@ -4,6 +4,7 @@ interface
uses
System.Rtti,
System.TypInfo,
System.SysUtils,
System.Generics.Collections,
System.Generics.Defaults;
@@ -17,24 +18,32 @@ type
property Value: T read GetValue write SetValue;
end;
// A record that provides field-level access to data, stored in a sorted array.
// 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
// Builder for dynamically creating a TDataRecord.
TBuilder = record
private
// Use a list for efficient additions. Will be sorted on creation.
FStagedValues: TList<TPair<string, TValue>>;
class operator Initialize(out Dest: TBuilder);
class operator Finalize(var Dest: TBuilder);
public
procedure AddField<T>(const Name: String; const Value: T);
procedure AddField<T>(const Name: String; const Value: T); overload;
procedure AddField(const Name: String; const Value: TValue); overload;
function CreateRec: TDataRecord;
end;
private
FValues: TArray<TPair<string, TValue>>;
FLayout: TArray<TFieldLayout>;
FBuffer: TBytes;
class operator Initialize(out Dest: TDataRecord);
class operator Finalize(var Dest: TDataRecord);
public
@@ -42,30 +51,30 @@ type
class function CreateFromRec<T>(const Rec: T): TDataRecord; static;
class function CreateBuilder: TDataRecord.TBuilder; static;
class function CreateFromJSON(const JSON: string): TDataRecord; static;
class operator Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
end;
TValueAccessor<T> = class(TInterfacedObject, IAccess<T>)
// Accessor for reading/writing data directly from/to the TBytes buffer.
TByteAccessor<T> = class(TInterfacedObject, IAccess<T>)
private
FValues: TArray<TPair<string, TValue>>;
FKey: string;
function FindIndex: Integer;
FBuffer: TBytes;
FLayout: TFieldLayout;
public
constructor Create(AValues: TArray<TPair<string, TValue>>; const AKey: string);
constructor Create(ABuffer: TBytes; const ALayout: TFieldLayout);
function GetValue: T;
procedure SetValue(const Value: T);
end;
// Comparer for sorting and searching pairs by their string key (Singleton).
TPairKeyComparer = class(TComparer<TPair<string, TValue>>)
// Comparer for sorting and searching field layouts by their string key (Singleton).
TFieldLayoutComparer = class(TComparer<TFieldLayout>)
strict private
class var
FDefault: IComparer<TPair<string, TValue>>;
FDefault: IComparer<TFieldLayout>;
class constructor CreateClass;
class destructor DestroyClass;
public
function Compare(const Left, Right: TPair<string, TValue>): Integer; override;
class property Default: IComparer<TPair<string, TValue>> read FDefault;
function Compare(const Left, Right: TFieldLayout): Integer; override;
class property Default: IComparer<TFieldLayout> read FDefault;
end;
procedure Testfunc;
@@ -73,188 +82,132 @@ procedure Testfunc;
implementation
uses
System.TypInfo,
System.JSON;
System.JSON,
System.Classes;
{$region 'TPairKeyComparer'}
class constructor TPairKeyComparer.CreateClass;
{$region 'TFieldLayoutComparer'}
class constructor TFieldLayoutComparer.CreateClass;
begin
FDefault := TPairKeyComparer.Create;
FDefault := TFieldLayoutComparer.Create;
end;
class destructor TPairKeyComparer.DestroyClass;
class destructor TFieldLayoutComparer.DestroyClass;
begin
FDefault := nil;
end;
function TPairKeyComparer.Compare(const Left, Right: TPair<string, TValue>): Integer;
function TFieldLayoutComparer.Compare(const Left, Right: TFieldLayout): Integer;
begin
Result := TComparer<string>.Default.Compare(Left.Key, Right.Key);
end;
{$endregion}
{$region 'TValueAccessor<T>'}
constructor TValueAccessor<T>.Create(AValues: TArray<TPair<string, TValue>>; const AKey: string);
{$region 'TByteAccessor<T>'}
constructor TByteAccessor<T>.Create(ABuffer: TBytes; const ALayout: TFieldLayout);
begin
inherited Create;
FValues := AValues;
FKey := AKey;
FBuffer := ABuffer;
FLayout := ALayout;
end;
function TValueAccessor<T>.FindIndex: Integer;
var
dummyPair: TPair<string, TValue>;
function TByteAccessor<T>.GetValue: T;
type
PT = ^T;
begin
// Find the index of the key using binary search with the singleton comparer.
dummyPair := TPair<string, TValue>.Create(FKey, TValue.Empty);
if not TArray.BinarySearch<TPair<string, TValue>>(FValues, dummyPair, Result, TPairKeyComparer.Default) then
Result := -1;
Result := PT(@FBuffer[FLayout.Offset])^;
end;
function TValueAccessor<T>.GetValue: T;
var
idx: Integer;
procedure TByteAccessor<T>.SetValue(const Value: T);
type
PT = ^T;
begin
idx := FindIndex;
if idx > -1 then
Result := FValues[idx].Value.AsType<T>
else
raise EArgumentException.CreateFmt('Key not found: %s', [FKey]);
end;
procedure TValueAccessor<T>.SetValue(const Value: T);
var
idx: Integer;
begin
idx := FindIndex;
if idx > -1 then
// Directly modify the TValue within the TPair in the array.
FValues[idx].Value := TValue.From<T>(Value)
else
raise EArgumentException.CreateFmt('Key not found: %s', [FKey]);
PT(@FBuffer[FLayout.Offset])^ := Value;
end;
{$endregion}
{$region 'TDataRecord'}
function TDataRecord.GetAccess<T>(const Name: String): IAccess<T>;
var
dummyPair: TPair<string, TValue>;
val: TValue;
dummyLayout: TFieldLayout;
index: Integer;
targetTypeInfo: PTypeInfo;
begin
Result := nil;
dummyLayout.Key := Name;
// Use a binary search on the sorted array with the singleton comparer.
dummyPair := TPair<string, TValue>.Create(Name, TValue.Empty);
if TArray.BinarySearch<TPair<string, TValue>>(FValues, dummyPair, index, TPairKeyComparer.Default) then
if TArray.BinarySearch<TFieldLayout>(FLayout, dummyLayout, index, TFieldLayoutComparer.Default) then
begin
val := FValues[index].Value;
targetTypeInfo := System.TypeInfo(T);
if (val.TypeInfo <> nil) and (val.TypeInfo = targetTypeInfo) then
if (FLayout[index].TypeInfo <> nil) and (FLayout[index].TypeInfo = System.TypeInfo(T)) then
begin
Result := TValueAccessor<T>.Create(FValues, Name);
Result := TByteAccessor<T>.Create(FBuffer, FLayout[index]);
end;
end;
end;
class function TDataRecord.CreateFromRec<T>(const Rec: T): TDataRecord;
var
ctx: TRttiContext;
recType: TRttiRecordType;
field: TRttiField;
recValue: TValue;
stagedValues: TList<TPair<string, TValue>>;
begin
stagedValues := TList<TPair<string, TValue>>.Create;
try
ctx := TRttiContext.Create;
recType := ctx.GetType(TypeInfo(T)) as TRttiRecordType;
recValue := TValue.From<T>(Rec);
for field in recType.GetFields do
stagedValues.Add(TPair<string, TValue>.Create(field.Name, field.GetValue(recValue.GetReferenceToRawData)));
// Sort the list and assign it to the result array.
stagedValues.Sort(TPairKeyComparer.Default);
Result.FValues := stagedValues.ToArray;
finally
stagedValues.Free;
end;
end;
class function TDataRecord.CreateFromJSON(const JSON: string): TDataRecord;
var
jsonValue: TJSONValue;
jsonObject: TJSONObject;
pair: TJSONPair;
pairValue: TJSONValue;
s: string;
b: Boolean;
i64: Int64;
dbl: Double;
stagedValues: TList<TPair<string, TValue>>;
begin
stagedValues := TList<TPair<string, TValue>>.Create;
try
jsonValue := TJSONObject.ParseJSONValue(JSON);
if not Assigned(jsonValue) or not (jsonValue is TJSONObject) then
begin
Result.FValues := [];
Exit;
end;
try
jsonObject := jsonValue as TJSONObject;
for pair in jsonObject do
begin
pairValue := pair.JsonValue;
if pairValue is TJSONNumber then
begin
if pairValue.TryGetValue<Int64>(i64) then
stagedValues.Add(TPair<string, TValue>.Create(pair.JsonString.Value, TValue.From<Int64>(i64)))
else if pairValue.TryGetValue<Double>(dbl) then
stagedValues.Add(TPair<string, TValue>.Create(pair.JsonString.Value, TValue.From<Double>(dbl)));
end
else if pairValue is TJSONString then
begin
if pairValue.TryGetValue<string>(s) then
stagedValues.Add(TPair<string, TValue>.Create(pair.JsonString.Value, TValue.From<string>(s)));
end
else if pairValue is TJSONBool then
begin
if pairValue.TryGetValue<Boolean>(b) then
stagedValues.Add(TPair<string, TValue>.Create(pair.JsonString.Value, TValue.From<Boolean>(b)));
end
else if pairValue is TJSONNull then
stagedValues.Add(TPair<string, TValue>.Create(pair.JsonString.Value, TValue.Empty));
end;
finally
jsonValue.Free;
end;
// Sort the list and assign it to the result array.
stagedValues.Sort(TPairKeyComparer.Default);
Result.FValues := stagedValues.ToArray;
finally
stagedValues.Free;
end;
end;
class function TDataRecord.CreateBuilder: TDataRecord.TBuilder;
begin
Result := Default(TDataRecord.TBuilder);
end;
class function TDataRecord.CreateFromRec<T>(const Rec: T): TDataRecord;
var
ctx: TRttiContext;
recType: TRttiRecordType;
field: TRttiField;
recValue: TValue;
builder: TBuilder;
begin
builder := CreateBuilder;
ctx := TRttiContext.Create;
recType := ctx.GetType(System.TypeInfo(T)) as TRttiRecordType;
recValue := TValue.From<T>(Rec);
for field in recType.GetFields do
begin
builder.AddField(field.Name, field.GetValue(recValue.GetReferenceToRawData));
end;
Result := builder.CreateRec;
end;
class operator TDataRecord.Assign(var Dest: TDataRecord; const [ref] Src: TDataRecord);
begin
Finalize(Dest);
Dest.FLayout := Src.FLayout;
SetLength(Dest.FBuffer, Length(Src.FBuffer));
for var layout in Dest.FLayout do
begin
var P: PByte := @Dest.FBuffer[layout.Offset];
var Q: PByte := @Src.FBuffer[layout.Offset];
var Val: TValue;
TValue.Make(Q, layout.TypeInfo, val);
val.ExtractRawData(P);
end;
end;
class operator TDataRecord.Initialize(out Dest: TDataRecord);
begin
// Initialize the array for a new TDataRecord instance.
Dest.FValues := nil;
Dest.FLayout := nil;
Dest.FBuffer := nil;
end;
class operator TDataRecord.Finalize(var Dest: TDataRecord);
begin
// Finalize the array.
Dest.FValues := nil;
if (Dest.FBuffer = nil) or (Dest.FLayout = nil) then
Exit;
for var layout in Dest.FLayout do
begin
var P: PByte := @Dest.FBuffer[layout.Offset];
var Val: TValue;
// Move instance from buffer into a managed TValue. It will be destroyed, when it gets out of scope.
TValue.MakeWithoutCopy(P, layout.TypeInfo, val, false);
end;
Dest.FLayout := nil;
Dest.FBuffer := nil;
end;
{$endregion}
@@ -264,12 +217,52 @@ begin
FStagedValues.Add(TPair<string, TValue>.Create(Name, TValue.From<T>(Value)));
end;
function TDataRecord.TBuilder.CreateRec: TDataRecord;
procedure TDataRecord.TBuilder.AddField(const Name: String; const Value: TValue);
begin
// Sort the staged list and create the final record's array from it.
FStagedValues.Sort(TPairKeyComparer.Default);
Result.FValues := FStagedValues.ToArray;
FStagedValues.Clear; // Clear the list after consuming it.
// Overload to accept a TValue directly.
FStagedValues.Add(TPair<string, TValue>.Create(Name, Value));
end;
function TDataRecord.TBuilder.CreateRec: TDataRecord;
var
layoutList: TList<TFieldLayout>;
pair: TPair<string, TValue>;
layout: TFieldLayout;
begin
layoutList := TList<TFieldLayout>.Create;
try
layoutList.Capacity := FStagedValues.Count;
var ofs: NativeUInt := 0;
for pair in FStagedValues do
begin
layout.Key := pair.Key;
layout.Size := pair.Value.DataSize;
ofs := (ofs + 15) and not 15;
layout.Offset := ofs;
inc(ofs, layout.Size);
layout.TypeInfo := pair.Value.TypeInfo;
layoutList.Add(layout);
end;
SetLength(Result.FBuffer, ofs);
for var i := 0 to layoutList.Count - 1 do
begin
var P: PByte := @Result.FBuffer[layoutList[i].Offset];
FStagedValues[i].Value.ExtractRawData(P);
end;
layoutList.Sort(TFieldLayoutComparer.Default);
Result.FLayout := layoutList.ToArray;
finally
layoutList.Free;
end;
FStagedValues.Clear;
end;
class operator TDataRecord.TBuilder.Initialize(out Dest: TBuilder);
@@ -297,7 +290,7 @@ var
nameAccess: IAccess<String>;
bAccess: IAccess<Integer>;
const
JSON_DATA = '{"IntValue": 123, "StringValue": "Hello JSON", "FloatValue": 99.9, "BoolValue": true, "NullValue": null}';
JSON_DATA = '{"IntValue": 123, "StringValue": "Hello JSON", "FloatValue": 99.9, "BoolValue": true}';
begin
testRec.A := 1;
testRec.B := 5;
@@ -320,6 +313,9 @@ begin
// Test writing a value
bAccess.Value := 99;
Assert(bAccess.Value = 99);
// Verify it was written back to the buffer
var bAccess2 := R.GetAccess<Integer>('B');
Assert(bAccess2.Value = 99);
// Verify that a request for a wrong type returns nil
var aAccess := R.GetAccess<String>('A');
@@ -327,18 +323,20 @@ begin
// Test the builder pattern
var RecBuilder: TDataRecord.TBuilder := TDataRecord.CreateBuilder;
RecBuilder.AddField<Double>('ZValue', 222.0); // Changed key to test sorting
RecBuilder.AddField<Double>('ZValue', 222.0);
RecBuilder.AddField<string>('AValue', 'Builder Test');
var S := RecBuilder.CreateRec;
var dblAccess := S.GetAccess<Double>('ZValue');
var T := S;
var dblAccess := T.GetAccess<Double>('ZValue');
Assert(Assigned(dblAccess));
Assert(dblAccess.Value = 222.0);
var strAccess := S.GetAccess<String>('AValue');
var strAccess := T.GetAccess<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');
@@ -356,6 +354,7 @@ begin
var boolAccess := jsonRec.GetAccess<Boolean>('BoolValue');
Assert(Assigned(boolAccess));
Assert(boolAccess.Value = true);
}
end;
end.