Optimizing DataRecord

Src/Myc.DataRecord.pas

@@ -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>>;
+        FBuffer: TBytes;
-        FKey: string;
+        FLayout: TFieldLayout;
-        function FindIndex: Integer;
     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).
+    // Comparer for sorting and searching field layouts by their string key (Singleton).
-    TPairKeyComparer = class(TComparer<TPair<string, TValue>>)
+    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;
+        function Compare(const Left, Right: TFieldLayout): Integer; override;
-        class property Default: IComparer<TPair<string, TValue>> read FDefault;
+        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'}
+{$region 'TFieldLayoutComparer'}
-class constructor TPairKeyComparer.CreateClass;
+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>'}
+{$region 'TByteAccessor<T>'}
-constructor TValueAccessor<T>.Create(AValues: TArray<TPair<string, TValue>>; const AKey: string);
+constructor TByteAccessor<T>.Create(ABuffer: TBytes; const ALayout: TFieldLayout);
 begin
     inherited Create;
-    FValues := AValues;
+    FBuffer := ABuffer;
-    FKey := AKey;
+    FLayout := ALayout;
 end;
 
-function TValueAccessor<T>.FindIndex: Integer;
+function TByteAccessor<T>.GetValue: T;
-var
+type
-    dummyPair: TPair<string, TValue>;
+    PT = ^T;
 begin
-    // Find the index of the key using binary search with the singleton comparer.
+    Result := PT(@FBuffer[FLayout.Offset])^;
-    dummyPair := TPair<string, TValue>.Create(FKey, TValue.Empty);
-    if not TArray.BinarySearch<TPair<string, TValue>>(FValues, dummyPair, Result, TPairKeyComparer.Default) then
-        Result := -1;
 end;
 
-function TValueAccessor<T>.GetValue: T;
+procedure TByteAccessor<T>.SetValue(const Value: T);
-var
+type
-    idx: Integer;
+    PT = ^T;
 begin
-    idx := FindIndex;
+    PT(@FBuffer[FLayout.Offset])^ := Value;
-    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]);
 end;
 {$endregion}
 
 {$region 'TDataRecord'}
 function TDataRecord.GetAccess<T>(const Name: String): IAccess<T>;
 var
-    dummyPair: TPair<string, TValue>;
+    dummyLayout: TFieldLayout;
-    val: TValue;
     index: Integer;
-    targetTypeInfo: PTypeInfo;
 begin
     Result := nil;
+    dummyLayout.Key := Name;
 
-    // Use a binary search on the sorted array with the singleton comparer.
+    if TArray.BinarySearch<TFieldLayout>(FLayout, dummyLayout, index, TFieldLayoutComparer.Default) then
-    dummyPair := TPair<string, TValue>.Create(Name, TValue.Empty);
-
-    if TArray.BinarySearch<TPair<string, TValue>>(FValues, dummyPair, index, TPairKeyComparer.Default) then
     begin
-        val := FValues[index].Value;
+        if (FLayout[index].TypeInfo <> nil) and (FLayout[index].TypeInfo = System.TypeInfo(T)) then
-        targetTypeInfo := System.TypeInfo(T);
-        if (val.TypeInfo <> nil) and (val.TypeInfo = targetTypeInfo) 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.FLayout := nil;
-    Dest.FValues := nil;
+    Dest.FBuffer := nil;
 end;
 
 class operator TDataRecord.Finalize(var Dest: TDataRecord);
 begin
-    // Finalize the array.
+    if (Dest.FBuffer = nil) or (Dest.FLayout = nil) then
-    Dest.FValues := nil;
+        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.
+    // Overload to accept a TValue directly.
-    FStagedValues.Sort(TPairKeyComparer.Default);
+    FStagedValues.Add(TPair<string, TValue>.Create(Name, Value));
-    Result.FValues := FStagedValues.ToArray;
+end;
-    FStagedValues.Clear; // Clear the list after consuming it.
+
+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.