From 1ddc295c9ded972843e08164ffd39b1b45ad59b7 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Sun, 27 Jul 2025 23:12:48 +0200 Subject: [PATCH] Testing TValue as Params --- AuraTrader/MainForm.pas | 3 + AuraTrader/TestMethodCallFromRecordParams.pas | 78 +----- Src/Myc.Trade.Indicators.Common.pas | 3 +- Src/Myc.Trade.Indicators.pas | 264 +++++++++++------- 4 files changed, 176 insertions(+), 172 deletions(-) diff --git a/AuraTrader/MainForm.pas b/AuraTrader/MainForm.pas index fdc3b89..62c6eb1 100644 --- a/AuraTrader/MainForm.pas +++ b/AuraTrader/MainForm.pas @@ -51,6 +51,7 @@ uses FMX.ActnList, DynamicFMXControl, Myc.FMX.Chart, + Myc.Trade.Indicators, Myc.Trade.Indicators.Common, StrategyTest, TestMethodCallFromRecordParams; @@ -255,6 +256,8 @@ begin ); NewWorkspace; + + IndicatorRegistry.LogRegistry(LogMemo.Lines); end; procedure TForm1.FormDestroy(Sender: TObject); diff --git a/AuraTrader/TestMethodCallFromRecordParams.pas b/AuraTrader/TestMethodCallFromRecordParams.pas index f3b1fba..76c8c2e 100644 --- a/AuraTrader/TestMethodCallFromRecordParams.pas +++ b/AuraTrader/TestMethodCallFromRecordParams.pas @@ -5,6 +5,7 @@ interface uses System.SysUtils, System.Classes, + System.Rtti, Myc.Data.Records, Myc.Data.Pipeline, Myc.Trade.Indicators; @@ -52,8 +53,6 @@ type end; procedure Test1(const Log: TStrings); -procedure TestSma(const Log: TStrings); - implementation uses @@ -81,20 +80,18 @@ procedure Test1(const Log: TStrings); begin var fact := TGenericIndicatorFactory.CreateFromTemplate; - var params := TDataRecord.FromRecord; - params.SetValue('Log', Int64(Log)); - params.SetValue('text', 'The quick brown fox jumps...'); + var params: TMyWorker.TParams; + params.Log := Int64(Log); + params.text := 'The quick brown fox jumps...'; - var indi := fact.CreateIndicator(params); + var indi := fact.CreateIndicator(params); - var args := TDataRecord.FromRecord; - args.SetValue('xyz', 3.14159); + var args: TMyWorker.TArgs; + args.xyz := 3.14159; var res := indi(args); - var desc := res.GetValue('desc'); - Log.Add('Final result description: ' + desc); - Assert(desc = 'done'); + Log.Add('Final result description: ' + res.desc); end; { TSmaIndicator } @@ -147,63 +144,4 @@ begin end; end; -procedure TestSma(const Log: TStrings); -var - fact: TGenericIndicatorFactory; - params: TDataRecord; - indi: TConvertFunc; - args: TDataRecord; - res: TDataRecord; - smaValue: Double; -begin - Log.Add(''); - Log.Add('--- Testing SMA ---'); - - fact := TGenericIndicatorFactory.CreateFromTemplate; - - // 1. Setup indicator parameters. - params := TDataRecord.FromRecord; - params.SetValue('Period', 3); - Log.Add(Format('Creating SMA with Period=%d', [params.GetValue('Period')])); - - // 2. Create the indicator instance. - indi := fact.CreateIndicator(params); - - // 3. Create the arguments record (can be reused). - args := TDataRecord.FromRecord; - - // 4. Feed values and check results. - args.SetValue('Value', 10.0); - res := indi(args); - smaValue := res.GetValue('Sma'); - Log.Add(Format('Input: 10.0 -> SMA: %f', [smaValue])); - Assert(SameValue(smaValue, 10.0)); // Avg of [10] is 10 - - args.SetValue('Value', 11.0); - res := indi(args); - smaValue := res.GetValue('Sma'); - Log.Add(Format('Input: 11.0 -> SMA: %f', [smaValue])); - Assert(SameValue(smaValue, 10.5)); // Avg of [10, 11] is 10.5 - - args.SetValue('Value', 12.0); - res := indi(args); - smaValue := res.GetValue('Sma'); - Log.Add(Format('Input: 12.0 -> SMA: %f', [smaValue])); - Assert(SameValue(smaValue, 11.0)); // Avg of [10, 11, 12] is 11 - - args.SetValue('Value', 13.0); - res := indi(args); - smaValue := res.GetValue('Sma'); - Log.Add(Format('Input: 13.0 -> SMA: %f', [smaValue])); - Assert(SameValue(smaValue, 12.0)); // Avg of [11, 12, 13] is 12 - - args.SetValue('Value', 14.0); - res := indi(args); - smaValue := res.GetValue('Sma'); - Log.Add(Format('Input: 14.0 -> SMA: %f', [smaValue])); - Assert(SameValue(smaValue, 13.0)); // Avg of [12, 13, 14] is 13 - - Log.Add('SMA test successful.'); -end; - end. diff --git a/Src/Myc.Trade.Indicators.Common.pas b/Src/Myc.Trade.Indicators.Common.pas index da96a17..cd2bbf5 100644 --- a/Src/Myc.Trade.Indicators.Common.pas +++ b/Src/Myc.Trade.Indicators.Common.pas @@ -6,7 +6,6 @@ uses System.SysUtils, System.Math, System.Rtti, - Myc.Data.Records, Myc.Data.Pipeline, Myc.Data.Series, Myc.Trade.Types, @@ -1071,6 +1070,6 @@ initialization IndicatorRegistry.RegisterTemplate; IndicatorRegistry.RegisterTemplate; IndicatorRegistry.RegisterTemplate; - // IndicatorRegistry.RegisterTemplate; + IndicatorRegistry.RegisterTemplate; end. diff --git a/Src/Myc.Trade.Indicators.pas b/Src/Myc.Trade.Indicators.pas index 6e5f7d4..0090992 100644 --- a/Src/Myc.Trade.Indicators.pas +++ b/Src/Myc.Trade.Indicators.pas @@ -5,8 +5,9 @@ interface {$M+} uses + System.Rtti, Myc.Data.Pipeline, - Myc.Data.Records; + System.Classes; type TIndicatorFactoryProc = reference to function(const Params: TParams): TConvertFunc; @@ -61,47 +62,56 @@ type property Hint: string read FHint; end; + TFieldDef = record + public + Identifier: String; + TypeName: String; + end; + + TFieldLayout = TArray; + // Interface for creating an indicator instance. Only contains functional aspects. IIndicatorFactory = interface - {$region 'private'} - function GetArgumentLayout: TDataRecord.TLayout; - function GetParameterLayout: TDataRecord.TLayout; - function GetResultLayout: TDataRecord.TLayout; - {$endregion} + function GetParams: TFieldLayout; + function GetArgs: TFieldLayout; + function GetResults: TFieldLayout; - function CreateIndicator(const Params: TDataRecord): TConvertFunc; + function CreateIndicator(const Params: TValue): TConvertFunc; - property ParameterLayout: TDataRecord.TLayout read GetParameterLayout; - property ArgumentLayout: TDataRecord.TLayout read GetArgumentLayout; - property ResultLayout: TDataRecord.TLayout read GetResultLayout; + // Provides the layout for the indicator's parameters, arguments, and results. + property Params: TFieldLayout read GetParams; + property Args: TFieldLayout read GetArgs; + property Results: TFieldLayout read GetResults; end; TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory) private - FParameterLayout: TDataRecord.TLayout; - FFactoryProc: TIndicatorFactoryProc; + FFactoryProc: TIndicatorFactoryProc; FName: String; - FArgumentLayout: TDataRecord.TLayout; - FResultLayout: TDataRecord.TLayout; FShortName: String; FHint: String; - function GetArgumentLayout: TDataRecord.TLayout; - function GetParameterLayout: TDataRecord.TLayout; - function GetResultLayout: TDataRecord.TLayout; + FParams: TFieldLayout; + FArgs: TFieldLayout; + FResults: TFieldLayout; + + class function LayoutFromRecordType(RecordType: TRttiType): TFieldLayout; static; + public constructor Create( - const AParameterLayout, AArgumentLayout, AResultLayout: TDataRecord.TLayout; - const AFactoryProc: TIndicatorFactoryProc; - const AShortName, AName, AHint: String + const AFactoryProc: TIndicatorFactoryProc; + const AShortName, AName, AHint: String; + const AParams, AArgs, AResults: TFieldLayout ); + // IIndicatorFactory + function GetParams: TFieldLayout; + function GetArgs: TFieldLayout; + function GetResults: TFieldLayout; + function CreateIndicator(const Params: TValue): TConvertFunc; overload; + class function CreateFromTemplate: TGenericIndicatorFactory; - function CreateIndicator(const Params: TDataRecord): TConvertFunc; - - property ParameterLayout: TDataRecord.TLayout read GetParameterLayout; - property ArgumentLayout: TDataRecord.TLayout read GetArgumentLayout; - property ResultLayout: TDataRecord.TLayout read GetResultLayout; + function CreateIndicator(const Params: TParams): TConvertFunc; overload; property Name: String read FName; property ShortName: String read FShortName; @@ -120,6 +130,7 @@ type FHint: string; public constructor Create(const AFactory: IIndicatorFactory; const AShortName, AName, AHint: string); + function CreateIndicator(const Params: TParams): TConvertFunc; overload; property Factory: IIndicatorFactory read FFactory; property Name: string read FName; property ShortName: string read FShortName; @@ -127,10 +138,14 @@ type end; private FItems: TArray; + public constructor Create; destructor Destroy; override; + // Writes the contents of the registry (just like the log) + procedure LogRegistry(const Log: TStrings); + // Register indicator from a template class procedure RegisterTemplate; @@ -151,8 +166,7 @@ implementation uses System.SysUtils, - System.TypInfo, - System.Rtti; + System.TypInfo; constructor IndicatorNameAttribute.Create(const AShortName, AName: string); begin @@ -170,19 +184,40 @@ end; { TGenericIndicatorFactory } constructor TGenericIndicatorFactory.Create( - const AParameterLayout, AArgumentLayout, AResultLayout: TDataRecord.TLayout; - const AFactoryProc: TIndicatorFactoryProc; - const AShortName, AName, AHint: String + const AFactoryProc: TIndicatorFactoryProc; + const AShortName, AName, AHint: String; + const AParams, AArgs, AResults: TFieldLayout ); begin inherited Create; - FParameterLayout := AParameterLayout; - FArgumentLayout := AArgumentLayout; - FResultLayout := AResultLayout; FFactoryProc := AFactoryProc; FShortName := AShortName; FName := AName; FHint := AHint; + FParams := AParams; + FArgs := AArgs; + FResults := AResults; +end; + +class function TGenericIndicatorFactory.LayoutFromRecordType(RecordType: TRttiType): TFieldLayout; +var + rttiRecordType: TRttiRecordType; + field: TRttiField; + i: Integer; +begin + if not RecordType.IsRecord then + raise EArgumentException.CreateFmt('Record type expected, but got %s', [RecordType.Name]); + + rttiRecordType := RecordType as TRttiRecordType; + var fields := rttiRecordType.GetFields; + SetLength(Result, Length(fields)); + i := 0; + for field in fields do + begin + Result[i].Identifier := field.Name; + Result[i].TypeName := field.FieldType.Name; + Inc(i); + end; end; class function TGenericIndicatorFactory.CreateFromTemplate: TGenericIndicatorFactory; @@ -191,14 +226,14 @@ var rttiType: TRttiType; paramsType, argsType, resultType: TRttiType; templateFactoryMethod: TRttiMethod; - parameterLayout, argumentLayout, resultLayout: TDataRecord.TLayout; - factoryProc: TIndicatorFactoryProc; + factoryProc: TIndicatorFactoryProc; shortName, name, hint: string; + paramsLayout, argsLayout, resultsLayout: TFieldLayout; begin // This function creates a generic factory from a template class. // It uses RTTI to find the necessary types by inspecting the factory method signature, // and then constructs a set of wrappers to adapt the specific types of the template - // to the generic TDataRecord used by this factory. + // to the generic TValue used by this factory. Ctx := TRttiContext.Create; rttiType := Ctx.GetType(TypeInfo(T)); @@ -265,10 +300,10 @@ begin Assert(argsType.TypeKind = tkRecord); Assert(resultType.TypeKind = tkRecord); - // Create the layouts for parameters, arguments, and results. - parameterLayout := TDataRecord.TLayout.FromRecord(paramsType.Handle); - argumentLayout := TDataRecord.TLayout.FromRecord(argsType.Handle); - resultLayout := TDataRecord.TLayout.FromRecord(resultType.Handle); + // Generate layouts from RTTI types. + paramsLayout := LayoutFromRecordType(paramsType); + argsLayout := LayoutFromRecordType(argsType); + resultsLayout := LayoutFromRecordType(resultType); // Extract metadata from attributes on the template type T. shortName := ''; @@ -300,95 +335,68 @@ begin // 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): TConvertFunc + function(const Params: TValue): TConvertFunc begin // Outer anonymous method: This is the factory proc. - // It gets called with a TDataRecord of parameters. + // It gets called with a TValue wrapping the parameters record. // 1. Invoke the template's static factory method (e.g., TMyWorker.CreateFactory) - var factoryProcAsValue := templateFactoryMethod.Invoke(TValue.Empty, []); + var factoryProc := 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 rttiFactoryProc := Ctx.GetType(factoryProc.TypeInfo) as TRttiInterfaceType; var currentFactoryInvoke := rttiFactoryProc.GetMethod('Invoke'); // The parameter for this 'Invoke' call is the TParams record. - // Wrap the incoming TDataRecord 'Params' into a TValue for the call. + // Wrap the incoming TValue 'Params' into a TValue for the call. var factoryParamTypeInfo := currentFactoryInvoke.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) as a TValue. - var workerProcAsValue := currentFactoryInvoke.Invoke(factoryProcAsValue, factoryArg); + var workerProc := currentFactoryInvoke.Invoke(factoryProc, [Params]); // 3. Return a new anonymous method that wraps the worker proc. - // This wrapper conforms to the generic TIndicatorProc signature. - var rttiWorkerProc := Ctx.GetType(workerProcAsValue.TypeInfo); + // This wrapper conforms to the generic TIndicatorProc signature. + var rttiWorkerProc := Ctx.GetType(workerProc.TypeInfo); var currentIndicatorInvoke := rttiWorkerProc.GetMethod('Invoke'); - var indicatorParamTypeInfo := currentIndicatorInvoke.GetParameters[0].ParamType.Handle; Result := - function(const Args: TDataRecord): TDataRecord + function(const Args: TValue): TValue begin - // Sadly, it's not possible to inject a buffer into a TValue. So we need to copy both Args and Result. - // Inner anonymous method: This is the actual indicator proc wrapper. - // The layouts are captured from the outer scope. - Assert(Args.Layout = argumentLayout); - - // Prepare argument for the indicator proc invocation. - // TValue just carries the data, ownership is held by the caller. - var argVal: array[0..0] of TValue; - TValue.MakeWithoutCopy(Args.RawData, indicatorParamTypeInfo, argVal[0], true); - // Invoke the actual indicator proc. - var resultAsTValue := currentIndicatorInvoke.Invoke(workerProcAsValue, argVal); - - // The result is a TValue containing the result record. - // Raw copy and erase all data from the TValue, leaving it as an empty capsule. Ownership is taken - // over to the resulting TDataRecord. This works because the memory layouts are exactly the same. - Assert(TDataRecord.TLayout.FromRecord(resultAsTValue.TypeInfo) = resultLayout); - - var buf: TBytes; - var resultSize := resultLayout.Size; - SetLength(buf, resultSize); - - var src := resultAsTValue.GetReferenceToRawData; - Move(src^, buf[0], resultSize); - FillChar(src^, resultSize, 0); - - Result.Create(resultLayout, buf); + Result := currentIndicatorInvoke.Invoke(workerProc, [Args]); end; end; // Create the final factory instance with all layouts and extracted metadata. - Result := TGenericIndicatorFactory.Create(parameterLayout, argumentLayout, resultLayout, factoryProc, shortName, name, hint); + Result := TGenericIndicatorFactory.Create(factoryProc, shortName, name, hint, paramsLayout, argsLayout, resultsLayout); end; -function TGenericIndicatorFactory.CreateIndicator(const Params: TDataRecord): TConvertFunc; +function TGenericIndicatorFactory.GetParams: TFieldLayout; +begin + Result := FParams; +end; + +function TGenericIndicatorFactory.GetArgs: TFieldLayout; +begin + Result := FArgs; +end; + +function TGenericIndicatorFactory.GetResults: TFieldLayout; +begin + Result := FResults; +end; + +function TGenericIndicatorFactory.CreateIndicator(const Params: TValue): TConvertFunc; begin - Assert( - (not Assigned(FParameterLayout.Fields)) or (Params.Layout = FParameterLayout), - 'Invalid parameter layout for indicator creation' - ); Result := FFactoryProc(Params); end; -function TGenericIndicatorFactory.GetArgumentLayout: TDataRecord.TLayout; +function TGenericIndicatorFactory.CreateIndicator(const Params: TParams): TConvertFunc; begin - Result := FArgumentLayout; -end; - -function TGenericIndicatorFactory.GetParameterLayout: TDataRecord.TLayout; -begin - Result := FParameterLayout; -end; - -function TGenericIndicatorFactory.GetResultLayout: TDataRecord.TLayout; -begin - Result := FResultLayout; + var cIndicator := FFactoryProc(TValue.From(Params)); + Result := function(const Args: TArgs): TResult begin Result := cIndicator(TValue.From(Args)).AsType; end; end; { TIndicatorRegistry.TItem } @@ -402,6 +410,12 @@ begin FHint := AHint; end; +function TIndicatorRegistry.TItem.CreateIndicator(const Params: TParams): TConvertFunc; +begin + var cIndicator := FFactory.CreateIndicator(TValue.From(Params)); + Result := function(const Args: TArgs): TResult begin Result := cIndicator(TValue.From(Args)).AsType; end; +end; + { TIndicatorRegistry } constructor TIndicatorRegistry.Create; @@ -433,13 +447,63 @@ begin Result := nil; end; +procedure TIndicatorRegistry.LogRegistry(const Log: TStrings); +var + item: TItem; + + procedure DoLog(const Txt: String); + begin + Log.Add(Txt); + end; + + procedure LogLayout(const LayoutName: string; const Layout: TFieldLayout); + var + field: TFieldDef; + begin + DoLog(Format(' %s:', [LayoutName])); + if Length(Layout) = 0 then + begin + DoLog(' (none)'); + end + else + begin + for field in Layout do + DoLog(Format(' - %s: %s', [field.Identifier, field.TypeName])); + end; + end; + +begin + if not Assigned(Log) then + exit; + + Log.Clear; + DoLog(Format('Indicator Registry Content (%d items)', [Length(FItems)])); + DoLog('=========================================='); + DoLog(''); + + if Length(FItems) = 0 then + begin + DoLog('(Registry is empty)'); + exit; + end; + + for item in FItems do + begin + DoLog(Format('Indicator "%s" (%s)', [item.Name, item.ShortName])); + if not item.Hint.IsEmpty then + DoLog(Format(' Hint: %s', [item.Hint])); + + LogLayout('Params', item.Factory.Params); + LogLayout('Args', item.Factory.Args); + LogLayout('Result', item.Factory.Results); + DoLog(''); + end; +end; + procedure TIndicatorRegistry.RegisterIndicator(const Factory: IIndicatorFactory; const ShortName, Name, Hint: String); var item: TItem; begin - if not Assigned(Factory) then - raise EArgumentException.Create('Factory'); - if Assigned(Find(ShortName)) then raise EArgumentException.CreateFmt('Indicator with ShortName "%s" is already registered.', [ShortName]);