Generic indicator factory

AuraTrader/TestMethodCallFromRecordParams.pas

@@ -13,20 +13,36 @@ uses
     Myc.Data.Records;
 
 type
-    InvokeAttribute = class(TCustomAttribute);
+    TIndicatorProc<TValue, TResult> = reference to function(const Value: TValue): TResult;
-    FactoryAttribute = class(TCustomAttribute);
+    TIndicatorFactoryProc<TParams, TValue, TResult> = reference to function(const Params: TParams): TIndicatorProc<TValue, TResult>;
 
-    TMyProc<TValue, TResult> = reference to function(const [ref] Value: TValue): TResult;
+    IndicatorFactoryAttribute = class(TCustomAttribute);
-    TFactoryProc<TParams, TValue, TResult> = reference to function(const [ref] Params: TParams): TMyProc<TValue, TResult>;
 
-    TMyWorker = record
+    TGenericIndicatorFactory = class
+    private
+        FParameterLayout: TDataRecord.TLayout;
+        FFactoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>;
+    public
+        constructor Create(
+            const AParameterLayout: TDataRecord.TLayout;
+            const AFactoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>
+        );
+
+        class function CreateFromTemplate<T>: TGenericIndicatorFactory;
+
+        function CreateIndicator(const Params: TDataRecord): TIndicatorProc<TDataRecord, TDataRecord>;
+        property ParameterLayout: TDataRecord.TLayout read FParameterLayout;
+    end;
+
+    TMyWorker = class
+    published
         type
             TParams = record
                 Log: Int64;
                 text: String;
             end;
 
-            TValue = record
+            TArgs = record
                 xyz: Double;
             end;
 
@@ -35,98 +51,187 @@ type
                 desc: String;
             end;
 
-        [Factory]
+        [IndicatorFactory]
-        class function CreateFactory: TFactoryProc<TParams, TValue, TResult>; static;
+        class function CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>; static;
     end;
 
 procedure Test1(const Log: TStrings);
 
 implementation
 
-class function TMyWorker.CreateFactory: TFactoryProc<TParams, TValue, TResult>;
+class function TMyWorker.CreateFactory: TIndicatorFactoryProc<TParams, TArgs, TResult>;
 begin
     Result :=
-        function(const [ref] Params: TParams): TMyProc<TValue, TResult>
+        function(const Params: TParams): TIndicatorProc<TArgs, TResult>
         begin
             var Log := TStrings(Params.Log);
             var text := Params.text;
 
             Result :=
-                function(const [ref] Value: TValue): TResult
+                function(const Args: TArgs): TResult
                 begin
                     // Use Format to avoid locale issues with float conversion
-                    Log.Add(Format('Val=%f   (...%s)', [Value.xyz, text]));
+                    Log.Add(Format('Val=%f   (...%s)', [Args.xyz, text]));
                     Result.desc := 'done';
                 end;
         end;
 end;
 
-type
+constructor TGenericIndicatorFactory.Create(
-    TInvokeProc = reference to procedure(const Value, Res: TDataRecord);
+    const AParameterLayout: TDataRecord.TLayout;
-
+    const AFactoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>
-function CreateInvoker(Ctx: TRttiContext; CallFunc: TValue): TInvokeProc;
+);
 begin
-    var rttiMyProc := Ctx.GetType(CallFunc.TypeInfo);
+    inherited Create;
-    var workerInvokeMethod := rttiMyProc.GetMethod('Invoke');
+    FParameterLayout := AParameterLayout;
-    var workerParamTypeInfo := workerInvokeMethod.GetParameters[0].ParamType.Handle;
+    FFactoryProc := AFactoryProc;
-    var args: array[0..0] of TValue;
+end;
-    Result :=
+
-        procedure(const Value, Res: TDataRecord)
+class function TGenericIndicatorFactory.CreateFromTemplate<T>: TGenericIndicatorFactory;
+var
+    Ctx: TRttiContext;
+    rttiType: TRttiType;
+    templateFactoryMethod: TRttiMethod;
+    parameterLayout: TDataRecord.TLayout;
+    factoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>;
+
+begin
+    // This function creates a generic factory from a template class (like TMyWorker).
+    // It uses RTTI to find the necessary types (TParams, TValue, TResult) and the
+    // factory method, and then constructs a set of wrappers to adapt the specific
+    // types of the template to the generic TDataRecord used by this factory.
+    Ctx := TRttiContext.Create;
+    rttiType := Ctx.GetType(TypeInfo(T));
+
+    // Find nested record types for parameters, values, and results.
+    var paramsType := Ctx.FindType(rttiType.QualifiedName + '.' + 'TParams');
+    if not Assigned(paramsType) then
+        raise EArgumentException.CreateFmt('TParams not found in "%s"', [rttiType.Name]);
+
+    var argsType := Ctx.FindType(rttiType.QualifiedName + '.' + 'TArgs');
+    if not Assigned(paramsType) then
+        raise EArgumentException.CreateFmt('TArgs not found in "%s"', [rttiType.Name]);
+
+    var resultType := Ctx.FindType(rttiType.QualifiedName + '.' + 'TResult');
+    if not Assigned(paramsType) then
+        raise EArgumentException.CreateFmt('TResult not found in "%s"', [rttiType.Name]);
+
+    // Find the static factory method marked with the [Factory] attribute.
+    templateFactoryMethod := nil;
+    for var method in rttiType.GetMethods do
+    begin
+        if method.HasAttribute<IndicatorFactoryAttribute> then
         begin
-            TValue.MakeWithoutCopy(Value.RawData, workerParamTypeInfo, args[0], true);
+            templateFactoryMethod := method;
-            workerInvokeMethod.Invoke(CallFunc, args).ExtractRawData(Res.RawData);
+            break;
         end;
+    end;
+    if not Assigned(templateFactoryMethod) then
+        raise EArgumentException.CreateFmt('[Factory] attribute not found on any method in "%s"', [rttiType.Name]);
+
+    // Create the layout for the parameters, which will be exposed by this factory.
+    parameterLayout := TDataRecord.TLayout.FromRecord(paramsType.Handle);
+
+    // Create the main factory procedure. This is a double-nested anonymous method
+    // that wraps the template's specific factory and worker functions.
+    factoryProc :=
+        function(const Params: TDataRecord): TIndicatorProc<TDataRecord, TDataRecord>
+        var
+            // Capture the created worker proc from the original factory as a TValue to manage its lifetime.
+            workerProcAsValue: TValue;
+        begin
+            // Outer anonymous method: This is the factory proc.
+            // It gets called with a TDataRecord of parameters.
+
+            // 1. Invoke the template's static factory method (e.g., TMyWorker.CreateFactory)
+            var factoryProcAsValue := templateFactoryMethod.Invoke(TValue.Empty, []);
+
+            // 2. Invoke the factory proc itself to get the actual worker proc.
+            var rttiFactoryProc := Ctx.GetType(factoryProcAsValue.TypeInfo) as TRttiInterfaceType;
+            var factoryInvokeMethod := rttiFactoryProc.GetMethod('Invoke');
+
+            // The parameter for this 'Invoke' call is the TParams record.
+            // Wrap the incoming TDataRecord 'Params' into a TValue for the call.
+            var factoryParamTypeInfo := factoryInvokeMethod.GetParameters[0].ParamType.Handle;
+            Assert(factoryParamTypeInfo = paramsType.Handle);
+
+            var factoryArg: array[0..0] of TValue;
+            TValue.Make(Params.RawData, factoryParamTypeInfo, factoryArg[0]);
+
+            // This call returns the worker proc (e.g., a TIndicatorProc<TValue, TResult>) as a TValue.
+            workerProcAsValue := factoryInvokeMethod.Invoke(factoryProcAsValue, factoryArg);
+
+            // 3. Return a new anonymous method that wraps the worker proc.
+            // This wrapper conforms to the generic TIndicatorProc<TDataRecord, TDataRecord> signature.
+            var rttiWorkerProc := Ctx.GetType(workerProcAsValue.TypeInfo);
+            var indicatorInvokeMethod := rttiWorkerProc.GetMethod('Invoke');
+            var indicatorParamTypeInfo := indicatorInvokeMethod.GetParameters[0].ParamType.Handle;
+            var indicatorResultTypeInfo := indicatorInvokeMethod.ReturnType.Handle;
+
+            Assert(indicatorParamTypeInfo = argsType.Handle);
+            Assert(indicatorResultTypeInfo = resultType.Handle);
+
+            var valueLayout := TDataRecord.TLayout.FromRecord(indicatorParamTypeInfo);
+            var resultLayout := TDataRecord.TLayout.FromRecord(indicatorResultTypeInfo);
+
+            Result :=
+                function(const Value: TDataRecord): TDataRecord
+                begin
+                    // Inner anonymous method: This is the actual indicator proc wrapper.
+                    Assert(Value.Layout = valueLayout);
+
+                    // Prepare argument for the worker proc invocation.
+                    var args: array[0..0] of TValue;
+                    TValue.MakeWithoutCopy(Value.RawData, indicatorParamTypeInfo, args[0], true);
+
+                    // Invoke the actual worker proc.
+                    var resultAsTValue := indicatorInvokeMethod.Invoke(workerProcAsValue, args);
+
+                    // The result is a TValue containing the result record (e.g., TMyWorker.TResult).
+                    // Copy its contents into a new TDataRecord to return it.
+                    Assert(TDataRecord.TLayout.FromRecord(resultAsTValue.TypeInfo) = resultLayout);
+
+                    Result := TDataRecord.Create(resultLayout);
+                    var src := resultAsTValue.GetReferenceToRawData;
+                    resultLayout.Copy(src, Result.RawData);
+
+                    // Erase all raw data in the TValue, leaving it as an empty capsule. Ownership it taken
+                    // over to the resulting TDataRecord.
+                    FillChar(src^, resultLayout.Size, 0);
+                end;
+        end;
+
+    // Create the final factory instance with the generated layout and wrapper procedure.
+    Result := TGenericIndicatorFactory.Create(parameterLayout, factoryProc);
+end;
+
+function TGenericIndicatorFactory.CreateIndicator(const Params: TDataRecord): TIndicatorProc<TDataRecord, TDataRecord>;
+begin
+    // The factory proc does all the heavy lifting. We just need to call it.
+    // A real implementation might add checks, e.g., that the layout of Params matches.
+    Assert(
+        (not Assigned(FParameterLayout.Fields)) or (Params.Layout = FParameterLayout),
+        'Invalid parameter layout for indicator creation'
+    );
+    Result := FFactoryProc(Params);
 end;
 
 procedure Test1(const Log: TStrings);
 begin
+    var fact := TGenericIndicatorFactory.CreateFromTemplate<TMyWorker>;
+
     var params := TDataRecord.FromRecord<TMyWorker.TParams>;
     params.SetValue<Int64>('Log', Int64(Log));
     params.SetValue<String>('text', 'The quick brown fox jumps...');
 
-    var workerValueParam := TDataRecord.FromRecord<TMyWorker.TValue>;
+    var indi := fact.CreateIndicator(params);
-    workerValueParam.SetValue<Double>('xyz', 3.14159);
 
-    var finalResultRec := TDataRecord.FromRecord<TMyWorker.TResult>;
+    var args := TDataRecord.FromRecord<TMyWorker.TArgs>;
+    args.SetValue<Double>('xyz', 3.14159);
 
-    var invoke: TInvokeProc;
+    var res := indi(args);
 
-    ////////////
+    var desc := res.GetValue<String>('desc');
-
-    var Ctx := TRttiContext.Create;
-    var rttiType := Ctx.GetType(TypeInfo(TMyWorker));
-
-    // Find and invoke the method marked with [Factory] attribute.
-    for var method in rttiType.GetMethods do
-    begin
-        if method.HasAttribute<FactoryAttribute> then
-        begin
-            // First invocation returns the factory procedure itself (an interface).
-            var createFuncValue := method.Invoke(TValue.Empty, []);
-            // Anonymous methods are interfaces, so we get the TRttiInterfaceType.
-            var rttiCreateFunc := Ctx.GetType(createFuncValue.TypeInfo) as TRttiInterfaceType;
-            // The actual code is in the 'Invoke' method of that interface.
-            var factoryInvokeMethod := rttiCreateFunc.GetMethod('Invoke');
-
-            // Prepare the argument for the factory proc: a pointer to 'params'
-            var factoryArg: array[0..0] of TValue;
-            var factoryParamTypeInfo := factoryInvokeMethod.GetParameters[0].ParamType.Handle;
-            TValue.Make(params.RawData, factoryParamTypeInfo, factoryArg[0]);
-
-            var myProcValue := factoryInvokeMethod.Invoke(createFuncValue, factoryArg);
-
-            invoke := CreateInvoker(Ctx, myProcValue);
-            break;
-        end;
-    end;
-
-    //////////
-
-    Assert(Assigned(invoke));
-
-    invoke(workerValueParam, finalResultRec);
-
-    var desc := finalResultRec.GetValue<String>('desc');
     Log.Add('Final result description: ' + desc);
     Assert(desc = 'done');
 end;

Src/Myc.Data.Records.pas

@@ -32,10 +32,15 @@ type
 
                 constructor Create(const AName: string; AFieldType: TFieldType; ATypeInfo: PTypeInfo; AOffset: Integer);
 
+                procedure Copy(Src, Dst: Pointer);
+
                 function GetSize: Integer; inline;
                 function GetAlignedSize: Integer; inline;
 
             public
+                class operator Equal(const A, B: TField): Boolean;
+                class operator NotEqual(const A, B: TField): Boolean; inline;
+
                 property FieldType: TFieldType read FFieldType;
                 property Name: string read FName;
                 property Size: Integer read GetSize;
@@ -54,13 +59,22 @@ type
                 FFields: TArray<TField>;
 
                 constructor Create(const AFields: TArray<TField>);
+                function GetSize: Integer;
 
             public
-                class function FromRecord<T>: TLayout; static;
+                class function FromRecord<T>: TLayout; overload; static;
+                class function FromRecord(ATypeInfo: PtypeInfo): TLayout; overload; static;
+
+                class operator Equal(const A, B: TLayout): Boolean;
+                class operator NotEqual(const A, B: TLayout): Boolean; inline;
+
                 class function Construct(const Def: TArray<TFieldDef>): TLayout; static;
 
+                procedure Copy(Src, Dst: Pointer);
+
                 function IndexOf(const Name: String): Integer;
                 property Fields: TArray<TField> read FFields;
+                property Size: Integer read GetSize;
             end;
 
         const
@@ -110,12 +124,7 @@ constructor TDataRecord.Create(const ALayout: TLayout);
 begin
     FLayout := ALayout;
 
-    var bufSize := 0;
+    SetLength(FBuffer, FLayout.Size);
-    if Length(FLayout.Fields) > 0 then
-        with FLayout.Fields[High(FLayout.Fields)] do
-            bufSize := Offset + AlignedSize;
-
-    SetLength(FBuffer, bufSize);
     for var i := 0 to High(FLayout.Fields) do
         FLayout.Fields[i].InitField(FBuffer);
 end;
@@ -269,48 +278,7 @@ end;
 procedure TDataRecord.TField.FromType(const [ref] Buffer: TBytes; const Src);
 begin
     Assert(FOffset + Size <= Length(Buffer));
-
+    Copy(@Src, @Buffer[FOffset]);
-    var Dst := @Buffer[FOffset];
-    case FFieldType of
-        dfFloat:
-        begin
-            Assert(FTypeInfo.Kind = tkFloat);
-            case GetTypeData(FTypeInfo).FloatType of
-                ftSingle: PSingle(Dst)^ := PSingle(@Src)^;
-                ftDouble: PDouble(Dst)^ := PDouble(@Src)^;
-            else
-                Assert(false);
-            end;
-        end;
-        dfInteger:
-        begin
-            case FTypeInfo.Kind of
-                tkInteger: PInteger(Dst)^ := PInteger(@Src)^;
-                tkInt64: PInt64(Dst)^ := PInt64(@Src)^;
-            else
-                Assert(false);
-            end;
-        end;
-        dfString:
-        begin
-            Assert(FTypeInfo.Kind in [tkString, tkLString, tkUString, tkWString]);
-            PString(Dst)^ := PString(@Src)^;
-        end;
-        dfTimestamp:
-        begin
-            Assert(FTypeInfo.Kind = tkFloat);
-            Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDateTime)).Name);
-            PDateTime(Dst)^ := PDateTime(@Src)^;
-        end;
-        dfRecord:
-        begin
-            Assert(FTypeInfo = System.TypeInfo(TDataRecord));
-            Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDataRecord)).Name);
-            TDataRecord(Dst^) := TDataRecord(Src);
-        end;
-    else
-        Assert(false);
-    end;
 end;
 
 function TDataRecord.TField.GetSize: Integer;
@@ -390,6 +358,60 @@ begin
     end;
 end;
 
+procedure TDataRecord.TField.Copy(Src, Dst: Pointer);
+begin
+    case FFieldType of
+        dfFloat:
+        begin
+            Assert(FTypeInfo.Kind = tkFloat);
+            case GetTypeData(FTypeInfo).FloatType of
+                ftSingle: PSingle(Dst)^ := PSingle(Src)^;
+                ftDouble: PDouble(Dst)^ := PDouble(Src)^;
+            else
+                Assert(false);
+            end;
+        end;
+        dfInteger:
+        begin
+            case FTypeInfo.Kind of
+                tkInteger: PInteger(Dst)^ := PInteger(Src)^;
+                tkInt64: PInt64(Dst)^ := PInt64(Src)^;
+            else
+                Assert(false);
+            end;
+        end;
+        dfString:
+        begin
+            Assert(FTypeInfo.Kind in [tkString, tkLString, tkUString, tkWString]);
+            PString(Dst)^ := PString(Src)^;
+        end;
+        dfTimestamp:
+        begin
+            Assert(FTypeInfo.Kind = tkFloat);
+            Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDateTime)).Name);
+            PDateTime(Dst)^ := PDateTime(Src)^;
+        end;
+        dfRecord:
+        begin
+            Assert(FTypeInfo = System.TypeInfo(TDataRecord));
+            Assert(FTypeInfo.Name = PTypeInfo(System.TypeInfo(TDataRecord)).Name);
+            TDataRecord(Dst^) := TDataRecord(Src^);
+        end;
+    else
+        Assert(false);
+    end;
+end;
+
+class operator TDataRecord.TField.Equal(const A, B: TField): Boolean;
+begin
+    Result := (A.FFieldType = B.FFieldType) and (A.FTypeInfo = B.FTypeInfo) and (A.FOffset = B.FOffset) and (A.FName = B.FName);
+end;
+
+class operator TDataRecord.TField.NotEqual(const A, B: TField): Boolean;
+begin
+    Result := not (A = B);
+end;
+
 constructor TDataRecord.TLayout.Create(const AFields: TArray<TField>);
 begin
     FFields := AFields;
@@ -419,12 +441,25 @@ begin
     Result.Create(Fields);
 end;
 
+procedure TDataRecord.TLayout.Copy(Src, Dst: Pointer);
+begin
+    for var i := 0 to High(FFields) do
+    begin
+        var ofs := FFields[i].Offset;
+        var S: PByte := Src;
+        inc(S, ofs);
+        var D: PByte := Dst;
+        inc(D, ofs);
+        FFields[i].Copy(S, D);
+    end;
+end;
+
 { TLayout }
 
-class function TDataRecord.TLayout.FromRecord<T>: TLayout;
+class function TDataRecord.TLayout.FromRecord(ATypeInfo: PtypeInfo): TLayout;
 begin
     var ctx := TRttiContext.Create;
-    var rttiType := ctx.GetType(TypeInfo(T));
+    var rttiType := ctx.GetType(ATypeInfo);
     var rttiFields := rttiType.GetFields;
     var fields: TArray<TField>;
 
@@ -467,6 +502,21 @@ begin
     Result.Create(fields);
 end;
 
+{ TLayout }
+
+class function TDataRecord.TLayout.FromRecord<T>: TLayout;
+begin
+    Result := FromRecord(TypeInfo(T));
+end;
+
+function TDataRecord.TLayout.GetSize: Integer;
+begin
+    Result := 0;
+    if Length(FFields) > 0 then
+        with FFields[High(FFields)] do
+            Result := Offset + Size;
+end;
+
 function TDataRecord.TLayout.IndexOf(const Name: String): Integer;
 begin
     for var i := 0 to High(FFields) do
@@ -475,4 +525,20 @@ begin
     exit(-1);
 end;
 
+class operator TDataRecord.TLayout.Equal(const A, B: TLayout): Boolean;
+begin
+    if Length(A.FFields) <> Length(B.FFields) then
+        exit(false);
+
+    for var i := 0 to High(A.FFields) do
+        if A.FFields[i] <> B.FFields[i] then
+            exit(false);
+    exit(true);
+end;
+
+class operator TDataRecord.TLayout.NotEqual(const A, B: TLayout): Boolean;
+begin
+    Result := not (A = B);
+end;
+
 end.