Broker example

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'

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<string>.
+        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<string, Integer>;
+    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<string, Integer>.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<string, Integer>;
+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<string> zu wrappen.
+    TRtlTypeRegistry.RegisterType<TSymProc>;
+
+    // 2. Registrierung des Broker-Interfaces
+    TRtlTypeRegistry.RegisterType<IMycBroker>;
+
+    // 3. Factory registrieren
+    var argTypes := TArray<IStaticType>.Create(TTypes.Float);
+
+    TRtlTypeRegistry.RegisterFactory<IMycBroker>(
+        Scope,
+        'create-broker',
+        argTypes,
+        function(const Args: TArray<TDataValue>): IMycBroker begin Result := TMockBroker.Create(Args[0].AsScalar.Value.AsDouble); end
+    );
+end;
+
+end.