From 8beb5d95b2b295adf2f1fb41fb0dee6c992ee2b3 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Sun, 14 Dec 2025 09:00:02 +0100 Subject: [PATCH] Broker example --- ASTPlayground/MainForm.fmx | 3 +- Src/Myc.Trade.Broker.pas | 156 +++++++++++++++++++++++++++++++++++++ 2 files changed, 158 insertions(+), 1 deletion(-) create mode 100644 Src/Myc.Trade.Broker.pas diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index 69759ff..b2df71f 100644 --- a/ASTPlayground/MainForm.fmx +++ b/ASTPlayground/MainForm.fmx @@ -253,7 +253,8 @@ object Form1: TForm1 ' ((.Buy broker) "AAPL" 10 150.0)' ' ((.Buy broker) "MSFT" 5 50.0)' ' ' - ' ((.ListPositions broker) (fn [t] (print t)))' + ' ((.ListPositions broker) ' + ' (fn [symbol amount] (print symbol ": " amount)))' ')') StyledSettings = [Size, Style, FontColor] TextSettings.Font.Family = 'Consolas' diff --git a/Src/Myc.Trade.Broker.pas b/Src/Myc.Trade.Broker.pas new file mode 100644 index 0000000..13c2727 --- /dev/null +++ b/Src/Myc.Trade.Broker.pas @@ -0,0 +1,156 @@ +unit Myc.Trade.Broker; + +interface + +uses + System.SysUtils, + System.Classes, + System.Generics.Collections, + Myc.Data.Value, + Myc.Ast.Types, + Myc.Ast.Scope, + Myc.Ast.RTL.TypeRegistry; + +{$TYPEINFO ON} + +type + TSymProc = reference to procedure(const Symbol: String; Amount: Integer); + + // Das Interface, das im AST-Skript verfügbar sein wird. + IMycBroker = interface + ['{D8E9F1A2-B3C4-4D5E-F6A7-B8C9D0E1F2A3}'] + + function Buy(const Symbol: string; Amount: Integer; Price: Double): Boolean; + function Sell(const Symbol: string; Amount: Integer; Price: Double): Boolean; + + function GetCash: Double; + function GetPosition(const Symbol: string): Integer; + + // Iteriert über alle Positionen und ruft für jede den Callback auf. + // Benötigt Registrierung von TProc. + procedure ListPositions(const Callback: TSymProc); + + property Cash: Double read GetCash; + end; + +procedure RegisterBroker(const Scope: IExecutionScope); + +implementation + +type + TMockBroker = class(TInterfacedObject, IMycBroker) + strict private + FCash: Double; + FPositions: TDictionary; + public + constructor Create(const AInitialCash: Double); + destructor Destroy; override; + + function Buy(const Symbol: string; Amount: Integer; Price: Double): Boolean; + function Sell(const Symbol: string; Amount: Integer; Price: Double): Boolean; + function GetCash: Double; + function GetPosition(const Symbol: string): Integer; + procedure ListPositions(const Callback: TSymProc); + end; + +// ----------------------------------------------------------------------------- +// TMockBroker +// ----------------------------------------------------------------------------- + +constructor TMockBroker.Create(const AInitialCash: Double); +begin + inherited Create; + FCash := AInitialCash; + FPositions := TDictionary.Create; +end; + +destructor TMockBroker.Destroy; +begin + FPositions.Free; + inherited Destroy; +end; + +function TMockBroker.Buy(const Symbol: string; Amount: Integer; Price: Double): Boolean; +var + cost: Double; + currentPos: Integer; +begin + cost := Amount * Price; + if FCash < cost then + exit(False); + + FCash := FCash - cost; + + if not FPositions.TryGetValue(Symbol, currentPos) then + currentPos := 0; + + FPositions.AddOrSetValue(Symbol, currentPos + Amount); + Result := True; +end; + +function TMockBroker.Sell(const Symbol: string; Amount: Integer; Price: Double): Boolean; +var + revenue: Double; + currentPos: Integer; +begin + revenue := Amount * Price; + FCash := FCash + revenue; + + if not FPositions.TryGetValue(Symbol, currentPos) then + currentPos := 0; + + FPositions.AddOrSetValue(Symbol, currentPos - Amount); + Result := True; +end; + +function TMockBroker.GetCash: Double; +begin + Result := FCash; +end; + +function TMockBroker.GetPosition(const Symbol: string): Integer; +begin + if not FPositions.TryGetValue(Symbol, Result) then + Result := 0; +end; + +procedure TMockBroker.ListPositions(const Callback: TSymProc); +var + pair: TPair; +begin + // Safety check: Wenn das Script nil übergibt, nichts tun. + if not Assigned(Callback) then + exit; + + for pair in FPositions do + begin + Callback(pair.Key, pair.Value); + end; +end; + +// ----------------------------------------------------------------------------- +// Registrierung +// ----------------------------------------------------------------------------- + +procedure RegisterBroker(const Scope: IExecutionScope); +begin + // 1. Registrierung des Callback-Typs. + // Dies ermöglicht dem TypeRegistry-Marshaller, die Signatur von Invoke(string, integer) zu analysieren + // und AST-Lambdas (TDataValue.TFunc) in native TProc zu wrappen. + TRtlTypeRegistry.RegisterType; + + // 2. Registrierung des Broker-Interfaces + TRtlTypeRegistry.RegisterType; + + // 3. Factory registrieren + var argTypes := TArray.Create(TTypes.Float); + + TRtlTypeRegistry.RegisterFactory( + Scope, + 'create-broker', + argTypes, + function(const Args: TArray): IMycBroker begin Result := TMockBroker.Create(Args[0].AsScalar.Value.AsDouble); end + ); +end; + +end.