Generic indicator factory
This commit is contained in:
Michael Schimmel
@@ -13,20 +13,36 @@ uses
|
||||
Myc.Data.Records;
|
||||
|
||||
type
|
||||
InvokeAttribute = class(TCustomAttribute);
|
||||
FactoryAttribute = class(TCustomAttribute);
|
||||
TIndicatorProc<TValue, TResult> = reference to function(const Value: TValue): TResult;
|
||||
TIndicatorFactoryProc<TParams, TValue, TResult> = reference to function(const Params: TParams): TIndicatorProc<TValue, TResult>;
|
||||
|
||||
TMyProc<TValue, TResult> = reference to function(const [ref] Value: TValue): TResult;
|
||||
TFactoryProc<TParams, TValue, TResult> = reference to function(const [ref] Params: TParams): TMyProc<TValue, TResult>;
|
||||
IndicatorFactoryAttribute = class(TCustomAttribute);
|
||||
|
||||
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]
|
||||
class function CreateFactory: TFactoryProc<TParams, TValue, TResult>; static;
|
||||
[IndicatorFactory]
|
||||
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
|
||||
TInvokeProc = reference to procedure(const Value, Res: TDataRecord);
|
||||
|
||||
function CreateInvoker(Ctx: TRttiContext; CallFunc: TValue): TInvokeProc;
|
||||
constructor TGenericIndicatorFactory.Create(
|
||||
const AParameterLayout: TDataRecord.TLayout;
|
||||
const AFactoryProc: TIndicatorFactoryProc<TDataRecord, TDataRecord, TDataRecord>
|
||||
);
|
||||
begin
|
||||
var rttiMyProc := Ctx.GetType(CallFunc.TypeInfo);
|
||||
var workerInvokeMethod := rttiMyProc.GetMethod('Invoke');
|
||||
var workerParamTypeInfo := workerInvokeMethod.GetParameters[0].ParamType.Handle;
|
||||
var args: array[0..0] of TValue;
|
||||
Result :=
|
||||
procedure(const Value, Res: TDataRecord)
|
||||
inherited Create;
|
||||
FParameterLayout := AParameterLayout;
|
||||
FFactoryProc := AFactoryProc;
|
||||
end;
|
||||
|
||||
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);
|
||||
workerInvokeMethod.Invoke(CallFunc, args).ExtractRawData(Res.RawData);
|
||||
templateFactoryMethod := method;
|
||||
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>;
|
||||
workerValueParam.SetValue<Double>('xyz', 3.14159);
|
||||
var indi := fact.CreateIndicator(params);
|
||||
|
||||
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 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');
|
||||
var desc := res.GetValue<String>('desc');
|
||||
Log.Add('Final result description: ' + desc);
|
||||
Assert(desc = 'done');
|
||||
end;
|
||||
|
||||
Reference in New Issue
Block a user