unit Myc.Trade.Indicators; interface uses Myc.Data.Pipeline, Myc.Data.Records; {$M+} type TIndicatorFactoryProc = reference to function(const Params: TParams): TConvertFunc; (* Sample definition of an indicator template: type [IndicatorName('HMA', 'Hull Moving Average')] [IndicatorHint('A fast, smooth moving average that minimizes lag.')] THMA = class type TParams = record Period: Integer; end; TArgs = record Value: Double; end; TResult = record HMA: Double; end; [IndicatorFactory] class function CreateFactory: TIndicatorFactoryProc; static; // Hard coded version: class function CreateHMA( Period: Integer ): TConvertFunc; static; end; *) IndicatorFactoryAttribute = class(TCustomAttribute); // Attribute to provide a short and a long name for an indicator. IndicatorNameAttribute = class(TCustomAttribute) private FName: string; FShortName: string; public constructor Create(const AShortName, AName: string); property ShortName: string read FShortName; property Name: string read FName; end; // Attribute to provide a descriptive hint for an indicator. IndicatorHintAttribute = class(TCustomAttribute) private FHint: string; public constructor Create(const AHint: string); property Hint: string read FHint; end; // 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 CreateIndicator(const Params: TDataRecord): TConvertFunc; property ParameterLayout: TDataRecord.TLayout read GetParameterLayout; property ArgumentLayout: TDataRecord.TLayout read GetArgumentLayout; property ResultLayout: TDataRecord.TLayout read GetResultLayout; end; TGenericIndicatorFactory = class(TInterfacedObject, IIndicatorFactory) private FParameterLayout: TDataRecord.TLayout; 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; public constructor Create( const AParameterLayout, AArgumentLayout, AResultLayout: TDataRecord.TLayout; const AFactoryProc: TIndicatorFactoryProc; const AShortName, AName, AHint: String ); 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; property Name: String read FName; property ShortName: String read FShortName; property Hint: String read FHint; end; TIndicatorRegistry = class public // Represents a registered indicator, combining the factory with its metadata. type TItem = class private FFactory: IIndicatorFactory; FName: string; FShortName: string; FHint: string; public constructor Create(const AFactory: IIndicatorFactory; const AShortName, AName, AHint: string); property Factory: IIndicatorFactory read FFactory; property Name: string read FName; property ShortName: string read FShortName; property Hint: string read FHint; end; private FItems: TArray; public constructor Create; destructor Destroy; override; // Register indicator from a template class procedure RegisterTemplate; // Register a pre-built indicator factory procedure RegisterIndicator(const Factory: IIndicatorFactory; const ShortName, Name, Hint: String); // Find a registered factory by its short name function Find(const ShortName: string): TItem; // Provides read-only access to the list of all registered indicator items property Items: TArray read FItems; end; var Registry: TIndicatorRegistry; implementation uses System.SysUtils, System.TypInfo, System.Rtti; constructor IndicatorNameAttribute.Create(const AShortName, AName: string); begin inherited Create; FShortName := AShortName; FName := AName; end; constructor IndicatorHintAttribute.Create(const AHint: string); begin inherited Create; FHint := AHint; end; { TGenericIndicatorFactory } constructor TGenericIndicatorFactory.Create( const AParameterLayout, AArgumentLayout, AResultLayout: TDataRecord.TLayout; const AFactoryProc: TIndicatorFactoryProc; const AShortName, AName, AHint: String ); begin inherited Create; FParameterLayout := AParameterLayout; FArgumentLayout := AArgumentLayout; FResultLayout := AResultLayout; FFactoryProc := AFactoryProc; FShortName := AShortName; FName := AName; FHint := AHint; end; class function TGenericIndicatorFactory.CreateFromTemplate: TGenericIndicatorFactory; var Ctx: TRttiContext; rttiType: TRttiType; paramsType, argsType, resultType: TRttiType; templateFactoryMethod: TRttiMethod; parameterLayout, argumentLayout, resultLayout: TDataRecord.TLayout; factoryProc: TIndicatorFactoryProc; shortName, name, hint: string; 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. Ctx := TRttiContext.Create; rttiType := Ctx.GetType(TypeInfo(T)); // Find the static factory method marked with the [IndicatorFactory] attribute. templateFactoryMethod := nil; for var method in rttiType.GetMethods do begin if method.HasAttribute then begin templateFactoryMethod := method; break; end; end; if not Assigned(templateFactoryMethod) then raise EArgumentException.CreateFmt('[IndicatorFactory] attribute not found on any method in "%s"', [rttiType.Name]); // Ensure the found method has the expected signature of a TIndicatorFactoryProc<>. // If any part of the signature check fails, raise an exception. var returnType := templateFactoryMethod.ReturnType; var rttiFactoryProcType, rttiIndicatorProcType: TRttiInterfaceType; var factoryInvoke, indicatorInvoke: TRttiMethod; try // Level 1: Factory method signature if not ((templateFactoryMethod.MethodKind in [mkFunction, mkClassFunction]) and (Length(templateFactoryMethod.GetParameters) = 0) and Assigned(returnType) and (returnType.TypeKind = tkInterface)) then raise EArgumentException.Create('factory creator'); // Level 2: Factory procedure signature rttiFactoryProcType := returnType as TRttiInterfaceType; factoryInvoke := rttiFactoryProcType.GetMethod('Invoke'); if not (Assigned(factoryInvoke) and (Length(factoryInvoke.GetParameters) = 1) and (pfConst in factoryInvoke.GetParameters[0].Flags) and (factoryInvoke.GetParameters[0].ParamType.TypeKind = tkRecord) and Assigned(factoryInvoke.ReturnType) and (factoryInvoke.ReturnType.TypeKind = tkInterface)) then raise EArgumentException.Create('factory'); // Level 3: Indicator procedure signature rttiIndicatorProcType := factoryInvoke.ReturnType as TRttiInterfaceType; indicatorInvoke := rttiIndicatorProcType.GetMethod('Invoke'); if not (Assigned(indicatorInvoke) and (Length(indicatorInvoke.GetParameters) = 1) and (pfConst in indicatorInvoke.GetParameters[0].Flags) and (indicatorInvoke.GetParameters[0].ParamType.TypeKind = tkRecord) and Assigned(indicatorInvoke.ReturnType) and (indicatorInvoke.ReturnType.TypeKind = tkRecord)) then raise EArgumentException.Create('indicator'); except on E: EArgumentException do raise EArgumentException.CreateFmt( 'Method "%s" marked with [IndicatorFactory] has an invalid %s signature. It has to match TIndicatorFactoryProc<>.', [templateFactoryMethod.ToString, E.Message]); end; // Get types from the now-validated factory method declaration. paramsType := factoryInvoke.GetParameters[0].ParamType; argsType := indicatorInvoke.GetParameters[0].ParamType; resultType := indicatorInvoke.ReturnType; Assert(paramsType.TypeKind = tkRecord); 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); // Extract metadata from attributes on the template type T. shortName := ''; name := ''; hint := ''; for var attr in rttiType.GetAttributes do begin if attr is IndicatorNameAttribute then begin // Read properties from IndicatorNameAttribute. var nameAttr := attr as IndicatorNameAttribute; shortName := nameAttr.ShortName; name := nameAttr.Name; end else if attr is IndicatorHintAttribute then begin // Read property from IndicatorHintAttribute. var hintAttr := attr as IndicatorHintAttribute; hint := hintAttr.Hint; end; end; // Apply default value for ShortName if it wasn't provided via attribute. if shortName.IsEmpty then begin shortName := rttiType.Name; end; // 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 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 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. 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); // 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); var currentIndicatorInvoke := rttiWorkerProc.GetMethod('Invoke'); var indicatorParamTypeInfo := currentIndicatorInvoke.GetParameters[0].ParamType.Handle; Result := function(const Args: TDataRecord): TDataRecord 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); end; end; // Create the final factory instance with all layouts and extracted metadata. Result := TGenericIndicatorFactory.Create(parameterLayout, argumentLayout, resultLayout, factoryProc, shortName, name, hint); end; function TGenericIndicatorFactory.CreateIndicator(const Params: TDataRecord): 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; begin Result := FArgumentLayout; end; function TGenericIndicatorFactory.GetParameterLayout: TDataRecord.TLayout; begin Result := FParameterLayout; end; function TGenericIndicatorFactory.GetResultLayout: TDataRecord.TLayout; begin Result := FResultLayout; end; { TIndicatorRegistry.TItem } constructor TIndicatorRegistry.TItem.Create(const AFactory: IIndicatorFactory; const AShortName, AName, AHint: string); begin inherited Create; FFactory := AFactory; FShortName := AShortName; FName := AName; FHint := AHint; end; { TIndicatorRegistry } constructor TIndicatorRegistry.Create; begin inherited; FItems := nil; end; destructor TIndicatorRegistry.Destroy; var item: TItem; begin for item in FItems do item.Free; FItems := nil; inherited; end; function TIndicatorRegistry.Find(const ShortName: string): TIndicatorRegistry.TItem; begin for var item in FItems do begin if SameText(item.ShortName, ShortName) then begin Result := item; exit; end; end; Result := nil; 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]); // Create the registry item and add it to the list. item := TItem.Create(Factory, ShortName, Name, Hint); var i := Length(FItems); SetLength(FItems, i + 1); FItems[i] := item; end; procedure TIndicatorRegistry.RegisterTemplate; begin // Create the factory object, which holds both the factory interface and the metadata properties. var factory := TGenericIndicatorFactory.CreateFromTemplate; // Pass the factory interface and the metadata properties to the core registration method. RegisterIndicator(factory, factory.ShortName, factory.Name, factory.Hint); end; initialization Registry := TIndicatorRegistry.Create; finalization Registry.Free; end.