diff --git a/Src/Myc.DataRecord.pas b/Src/Myc.DataRecord.pas index 536aded..b04ff8f 100644 --- a/Src/Myc.DataRecord.pas +++ b/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>; class operator Initialize(out Dest: TBuilder); class operator Finalize(var Dest: TBuilder); public - procedure AddField(const Name: String; const Value: T); + procedure AddField(const Name: String; const Value: T); overload; + procedure AddField(const Name: String; const Value: TValue); overload; function CreateRec: TDataRecord; end; - private - FValues: TArray>; + FLayout: TArray; + FBuffer: TBytes; class operator Initialize(out Dest: TDataRecord); class operator Finalize(var Dest: TDataRecord); public @@ -42,30 +51,30 @@ type class function CreateFromRec(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 = class(TInterfacedObject, IAccess) + // Accessor for reading/writing data directly from/to the TBytes buffer. + TByteAccessor = class(TInterfacedObject, IAccess) private - FValues: TArray>; - FKey: string; - function FindIndex: Integer; + FBuffer: TBytes; + FLayout: TFieldLayout; public - constructor Create(AValues: TArray>; 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>) + // Comparer for sorting and searching field layouts by their string key (Singleton). + TFieldLayoutComparer = class(TComparer) strict private class var - FDefault: IComparer>; + FDefault: IComparer; class constructor CreateClass; class destructor DestroyClass; public - function Compare(const Left, Right: TPair): Integer; override; - class property Default: IComparer> read FDefault; + function Compare(const Left, Right: TFieldLayout): Integer; override; + class property Default: IComparer 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): Integer; +function TFieldLayoutComparer.Compare(const Left, Right: TFieldLayout): Integer; begin Result := TComparer.Default.Compare(Left.Key, Right.Key); end; {$endregion} -{$region 'TValueAccessor'} -constructor TValueAccessor.Create(AValues: TArray>; const AKey: string); +{$region 'TByteAccessor'} +constructor TByteAccessor.Create(ABuffer: TBytes; const ALayout: TFieldLayout); begin inherited Create; - FValues := AValues; - FKey := AKey; + FBuffer := ABuffer; + FLayout := ALayout; end; -function TValueAccessor.FindIndex: Integer; -var - dummyPair: TPair; +function TByteAccessor.GetValue: T; +type + PT = ^T; begin - // Find the index of the key using binary search with the singleton comparer. - dummyPair := TPair.Create(FKey, TValue.Empty); - if not TArray.BinarySearch>(FValues, dummyPair, Result, TPairKeyComparer.Default) then - Result := -1; + Result := PT(@FBuffer[FLayout.Offset])^; end; -function TValueAccessor.GetValue: T; -var - idx: Integer; +procedure TByteAccessor.SetValue(const Value: T); +type + PT = ^T; begin - idx := FindIndex; - if idx > -1 then - Result := FValues[idx].Value.AsType - else - raise EArgumentException.CreateFmt('Key not found: %s', [FKey]); -end; - -procedure TValueAccessor.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(Value) - else - raise EArgumentException.CreateFmt('Key not found: %s', [FKey]); + PT(@FBuffer[FLayout.Offset])^ := Value; end; {$endregion} {$region 'TDataRecord'} function TDataRecord.GetAccess(const Name: String): IAccess; var - dummyPair: TPair; - 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.Create(Name, TValue.Empty); - - if TArray.BinarySearch>(FValues, dummyPair, index, TPairKeyComparer.Default) then + if TArray.BinarySearch(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.Create(FValues, Name); + Result := TByteAccessor.Create(FBuffer, FLayout[index]); end; end; end; -class function TDataRecord.CreateFromRec(const Rec: T): TDataRecord; -var - ctx: TRttiContext; - recType: TRttiRecordType; - field: TRttiField; - recValue: TValue; - stagedValues: TList>; -begin - stagedValues := TList>.Create; - try - ctx := TRttiContext.Create; - recType := ctx.GetType(TypeInfo(T)) as TRttiRecordType; - recValue := TValue.From(Rec); - - for field in recType.GetFields do - stagedValues.Add(TPair.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>; -begin - stagedValues := TList>.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(i64) then - stagedValues.Add(TPair.Create(pair.JsonString.Value, TValue.From(i64))) - else if pairValue.TryGetValue(dbl) then - stagedValues.Add(TPair.Create(pair.JsonString.Value, TValue.From(dbl))); - end - else if pairValue is TJSONString then - begin - if pairValue.TryGetValue(s) then - stagedValues.Add(TPair.Create(pair.JsonString.Value, TValue.From(s))); - end - else if pairValue is TJSONBool then - begin - if pairValue.TryGetValue(b) then - stagedValues.Add(TPair.Create(pair.JsonString.Value, TValue.From(b))); - end - else if pairValue is TJSONNull then - stagedValues.Add(TPair.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(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(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.Create(Name, TValue.From(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.Create(Name, Value)); +end; + +function TDataRecord.TBuilder.CreateRec: TDataRecord; +var + layoutList: TList; + pair: TPair; + layout: TFieldLayout; +begin + layoutList := TList.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; bAccess: IAccess; 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('B'); + Assert(bAccess2.Value = 99); // Verify that a request for a wrong type returns nil var aAccess := R.GetAccess('A'); @@ -327,18 +323,20 @@ begin // Test the builder pattern var RecBuilder: TDataRecord.TBuilder := TDataRecord.CreateBuilder; - RecBuilder.AddField('ZValue', 222.0); // Changed key to test sorting + RecBuilder.AddField('ZValue', 222.0); RecBuilder.AddField('AValue', 'Builder Test'); var S := RecBuilder.CreateRec; - var dblAccess := S.GetAccess('ZValue'); + var T := S; + + var dblAccess := T.GetAccess('ZValue'); Assert(Assigned(dblAccess)); Assert(dblAccess.Value = 222.0); - var strAccess := S.GetAccess('AValue'); + var strAccess := T.GetAccess('AValue'); Assert(Assigned(strAccess)); Assert(strAccess.Value = 'Builder Test'); - + { // Test JSON parsing var jsonRec := TDataRecord.CreateFromJSON(JSON_DATA); var intAccess := jsonRec.GetAccess('IntValue'); @@ -356,6 +354,7 @@ begin var boolAccess := jsonRec.GetAccess('BoolValue'); Assert(Assigned(boolAccess)); Assert(boolAccess.Value = true); + } end; end.