Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Testing TValue as Params

Browse Source
This commit is contained in:
Michael Schimmel
2025-07-27 23:12:48 +02:00
parent 78e89f345e
commit 1ddc295c9d
4 changed files with 176 additions and 172 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Myc.Trade.Indicators.Common.pas
+1 -2
View File
@@ -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<TBollingerBands>;
IndicatorRegistry.RegisterTemplate<TATR>;
IndicatorRegistry.RegisterTemplate<TKeltnerChannels>;
// IndicatorRegistry.RegisterTemplate<TMean>;
IndicatorRegistry.RegisterTemplate<TMean>;
end.
Src/Myc.Trade.Indicators.pas
+164 -100
View File
@@ -5,8 +5,9 @@ interface
{$M+}
uses
System.Rtti,
Myc.Data.Pipeline,
Myc.Data.Records;
System.Classes;
type
TIndicatorFactoryProc<TParams, TValue, TResult> = reference to function(const Params: TParams): TConvertFunc<TValue, TResult>;
@@ -61,47 +62,56 @@ type
property Hint: string read FHint;
end;
TFieldDef = record
public
Identifier: String;
TypeName: String;
end;
TFieldLayout = TArray<TFieldDef>;
// 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<TDataRecord, TDataRecord>;
function CreateIndicator(const Params: TValue): TConvertFunc<TValue, TValue>;
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<TDataRecord, TDataRecord, TDataRecord>;
FFactoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
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<TDataRecord, TDataRecord, TDataRecord>;
const AShortName, AName, AHint: String
const AFactoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
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<TValue, TValue>; overload;
class function CreateFromTemplate<T>: TGenericIndicatorFactory;
function CreateIndicator(const Params: TDataRecord): TConvertFunc<TDataRecord, TDataRecord>;
property ParameterLayout: TDataRecord.TLayout read GetParameterLayout;
property ArgumentLayout: TDataRecord.TLayout read GetArgumentLayout;
property ResultLayout: TDataRecord.TLayout read GetResultLayout;
function CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>; 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<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>; 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<TItem>;
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<TIndicatorTemplate>;
@@ -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<TDataRecord, TDataRecord, TDataRecord>;
const AShortName, AName, AHint: String
const AFactoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
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<T>: TGenericIndicatorFactory;
@@ -191,14 +226,14 @@ var
rttiType: TRttiType;
paramsType, argsType, resultType: TRttiType;
templateFactoryMethod: TRttiMethod;
parameterLayout, argumentLayout, resultLayout: TDataRecord.TLayout;
factoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>;
factoryProc: TIndicatorFactoryProc<TValue, TValue, TValue>;
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<TDataRecord, TDataRecord>
function(const Params: TValue): TConvertFunc<TValue, TValue>
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<TValue, TResult>) 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<TDataRecord, TDataRecord> signature.
var rttiWorkerProc := Ctx.GetType(workerProcAsValue.TypeInfo);
// This wrapper conforms to the generic TIndicatorProc<TValue, TValue> 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<TDataRecord, TDataRecord>;
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<TValue, TValue>;
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<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>;
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<TParams>(Params));
Result := function(const Args: TArgs): TResult begin Result := cIndicator(TValue.From<TArgs>(Args)).AsType<TResult>; end;
end;
{ TIndicatorRegistry.TItem }
@@ -402,6 +410,12 @@ begin
FHint := AHint;
end;
function TIndicatorRegistry.TItem.CreateIndicator<TParams, TArgs, TResult>(const Params: TParams): TConvertFunc<TArgs, TResult>;
begin
var cIndicator := FFactory.CreateIndicator(TValue.From<TParams>(Params));
Result := function(const Args: TArgs): TResult begin Result := cIndicator(TValue.From<TArgs>(Args)).AsType<TResult>; 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]);