RTL custom interface types as records, added callbacks (marshalled using virtual interfaces)

ASTPlayground/ASTPlayground.dpr

@@ -37,7 +37,8 @@ uses
     Myc.Fmx.AstEditor.Handlers.Primitives in '..\Src\AST\Myc.Fmx.AstEditor.Handlers.Primitives.pas',
     Myc.Fmx.AstEditor.Handlers.Control in '..\Src\AST\Myc.Fmx.AstEditor.Handlers.Control.pas',
     Myc.Fmx.AstEditor.Handlers.Data in '..\Src\AST\Myc.Fmx.AstEditor.Handlers.Data.pas',
-    Myc.Ast.RTL.TypeRegistry in '..\Src\AST\Myc.Ast.RTL.TypeRegistry.pas';
+    Myc.Ast.RTL.TypeRegistry in '..\Src\AST\Myc.Ast.RTL.TypeRegistry.pas',
+    Myc.Trade.Broker in '..\Src\Myc.Trade.Broker.pas';
 
 {$R *.res}
 

ASTPlayground/ASTPlayground.dproj

@@ -168,6 +168,7 @@
         <DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Handlers.Control.pas"/>
         <DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Handlers.Data.pas"/>
         <DCCReference Include="..\Src\AST\Myc.Ast.RTL.TypeRegistry.pas"/>
+        <DCCReference Include="..\Src\Myc.Trade.Broker.pas"/>
         <BuildConfiguration Include="Base">
             <Key>Base</Key>
         </BuildConfiguration>

ASTPlayground/MainForm.fmx

@@ -245,15 +245,15 @@ object Form1: TForm1
     Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
     DataDetectorTypes = []
     Lines.Strings = (
-      '(do '
+      '(do'
-      '  (defmacro test [body] `(fn [] ~body ))'
+      '  ;; Broker mit 10.000 Startkapital erstellen'
-      '  (defmacro test2 [body] `(fn [] ~body ))'
+      '  (def broker (create-broker 10000.0))'
-      '  (test2 "hi")'
-      ''
-      '  (def debug-mode :true)'
       '  '
-      '  (stopwatch '
+      '  ;; Aktien kaufen: 10 St'#252'ck von "AAPL" zu 150.0'
-      '     (if debug-mode (print "Debug an")))'
+      '  ((.Buy broker) "AAPL" 10 150.0)'
+      '  ((.Buy broker) "MSFT" 5 50.0)'
+      '  '
+      '  ((.ListPositions broker) (fn [t] (print t)))'
       ')')
     StyledSettings = [Size, Style, FontColor]
     TextSettings.Font.Family = 'Consolas'

ASTPlayground/MainForm.pas

@@ -114,6 +114,7 @@ type
         procedure RTLListViewChange(Sender: TObject);
     private
         FCurrUnboundAst: IAstNode;
+        FCurrCompiled: ILambdaExpressionNode;
         FCurrExec: TCompiledFunction;
         FEnvironment: TAstEnvironment;
         FAstEditor: TAstEditor; // Die Komponente (Facade)
@@ -141,6 +142,7 @@ implementation
 
 uses
     Myc.Data.Scalar.JSON,
+    Myc.Trade.Broker,
     System.Diagnostics, // For TStopwatch
     System.TimeSpan,
     Myc.Ast.Json, // For TAstJson serialization
@@ -306,7 +308,8 @@ begin
     try
         // Use Compile directly. Errors will be raised as ECompilationFailed.
         // We catch them to print to log, but allow flow to continue so UI can be updated.
-        FCurrExec := FEnvironment.Compile(ANode);
+        FCurrCompiled := FEnvironment.Compile(ANode);
+        FCurrExec := FEnvironment.Link(FCurrCompiled);
 
         if Assigned(FCurrExec.Func) then
         begin
@@ -599,7 +602,8 @@ begin
 
     Memo1.Lines.Add('--- Naive recursive fib with AST---');
 
-    var fibExec := TestEnv.Compile(TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)])).Func;
+    FCurrCompiled := TestEnv.Compile(TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]));
+    var fibExec := TestEnv.Link(FCurrCompiled).Func;
 
     sw := TStopwatch.StartNew;
     result := fibExec([]);
@@ -614,7 +618,7 @@ begin
 
     memoizeTest.Define('fib', TAstScript.Parse('(Memoize fib)'));
 
-    var memoizeExec := memoizeTest.Compile(TAstScript.Parse('(fib 25)')).Func;
+    var memoizeExec := memoizeTest.Link(memoizeTest.Compile(TAstScript.Parse('(fib 25)'))).Func;
 
     sw := TStopwatch.StartNew;
     result := memoizeExec([]);
@@ -757,7 +761,8 @@ begin
                 FCurrUnboundAst := converter.Deserialize(jsonObj);
 
                 // Run the full pipeline via environment
-                FCurrExec := FEnvironment.Compile(FCurrUnboundAst);
+                FCurrCompiled := FEnvironment.Compile(FCurrUnboundAst);
+                FCurrExec := FEnvironment.Link(FCurrCompiled);
 
                 Memo1.Lines.Add('AST deserialized and bound successfully from JSON.');
                 Memo1.Lines.Add('You can now visualize it (Middle Mouse Click) or pretty-print it.');
@@ -822,7 +827,7 @@ begin
 
     var seriesAddress := env.RootScope.Define('current_series', TDataValue.Void);
 
-    var callExec := env.Compile(TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [TAst.Identifier('current_series')])).Func;
+    var callExec := env.Link(env.Compile(TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [TAst.Identifier('current_series')]))).Func;
 
     // Simulation Loop
     Memo1.Lines.Clear;
@@ -1169,7 +1174,8 @@ end;
 procedure TForm1.Test1ButtonClick(Sender: TObject);
 begin
     FCurrUnboundAst := TAstScript.Parse('(do (print txt))');
-    var fn := FEnvironment.Compile(FCurrUnboundAst, [TAst.Identifier('txt')]).Func;
+    FCurrCompiled := FEnvironment.Compile(FCurrUnboundAst, [TAst.Identifier('txt')]);
+    var fn := FEnvironment.Link(FCurrCompiled).Func;
     fn(['Hello World']);
     FEnvironment.RootScope.Define('fn', fn);
     UpdateScript;
@@ -1247,14 +1253,17 @@ begin
     Memo1.Lines.Clear;
     Memo1.Lines.Add('--- AST Dump ---');
 
-    if FCurrUnboundAst = nil then
+    if FCurrCompiled = nil then
     begin
-        Memo1.Lines.Add('No AST available.');
+        Memo1.Lines.Add('No compiled AST available.');
         exit;
     end;
 
     // Dump the raw unbound AST first
-    TAstDumper.Dump(FCurrUnboundAst, Memo1.Lines);
+    TAstDumper.Dump(FCurrCompiled, Memo1.Lines);
 end;
 
+initialization
+    TAst.RegisterLibrary(RegisterBroker);
+
 end.

Src/AST/Myc.Ast.Environment.pas

@@ -54,8 +54,8 @@ type
             const Node: IFunctionDefinition;
             const ArgTypes: TArray<IStaticType> = [];
             const Log: ICompilerLog = nil
-        ): TCompiledFunction;
+        ): ILambdaExpressionNode;
-        function Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog): TCompiledFunction;
+        function Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog = nil): TCompiledFunction;
 
         function CreateEnvironment: IEnvironment;
 
@@ -93,9 +93,9 @@ type
             const Node: IAstNode;
             const Params: TArray<IIdentifierNode> = [];
             const ArgTypes: TArray<IStaticType> = []
-        ): TCompiledFunction; overload;
+        ): ILambdaExpressionNode; overload;
-        function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType> = []): TCompiledFunction; overload;
+        function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType> = []): ILambdaExpressionNode; overload;
-        function Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog): TCompiledFunction;
+        function Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog = nil): TCompiledFunction;
 
         function Run(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []; const Args: TArray<TDataValue> = []): TDataValue;
 
@@ -193,8 +193,8 @@ type
             const Node: IFunctionDefinition;
             const ArgTypes: TArray<IStaticType>;
             const Log: ICompilerLog = nil
-        ): TCompiledFunction;
+        ): ILambdaExpressionNode;
-        function Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog): TCompiledFunction;
+        function Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog = nil): TCompiledFunction;
     end;
 
 { TAstEnvironment }
@@ -235,12 +235,12 @@ function TAstEnvironment.Compile(
     const Node: IAstNode;
     const Params: TArray<IIdentifierNode> = [];
     const ArgTypes: TArray<IStaticType> = []
-): TCompiledFunction;
+): ILambdaExpressionNode;
 begin
     Result := FEnvironment.Compile(TAst.LambdaExpr(Params, Node), ArgTypes);
 end;
 
-function TAstEnvironment.Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType> = []): TCompiledFunction;
+function TAstEnvironment.Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType> = []): ILambdaExpressionNode;
 begin
     Result := FEnvironment.Compile(Node, ArgTypes);
 end;
@@ -263,7 +263,8 @@ end;
 procedure TAstEnvironment.Define(const Name: String; const AScript: IAstNode);
 begin
     var compiled := Compile(AScript);
-    RootScope.Define(Name, compiled.Func([]), compiled.StaticType);
+    var linked := Link(compiled);
+    RootScope.Define(Name, linked.Func([]), compiled.StaticType);
 end;
 
 function TAstEnvironment.ExpandMacros(const Node: IAstNode): IAstNode;
@@ -281,7 +282,7 @@ begin
     Result := FEnvironment.GetMacroRegistry;
 end;
 
-function TAstEnvironment.Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog): TCompiledFunction;
+function TAstEnvironment.Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog = nil): TCompiledFunction;
 begin
     Result := FEnvironment.Link(Node, Log);
 end;
@@ -292,7 +293,7 @@ function TAstEnvironment.Run(
     const Args: TArray<TDataValue> = []
 ): TDataValue;
 begin
-    Result := Compile(ANode, Params).Func(Args);
+    Result := Link(Compile(ANode, Params)).Func(Args);
 end;
 
 function TAstEnvironment.Specialize(const Node: IAstNode): IAstNode;
@@ -404,7 +405,7 @@ function TEnvironment.Compile(
     const Node: IFunctionDefinition;
     const ArgTypes: TArray<IStaticType>;
     const Log: ICompilerLog = nil
-): TCompiledFunction;
+): ILambdaExpressionNode;
 var
     layout: IScopeLayout;
     lg: ICompilerLog;
@@ -428,10 +429,10 @@ begin
 
     var specialized := Specialize(typedNode);
 
-    Result := Link(specialized.AsLambdaExpression, lg);
+    Result := specialized.AsLambdaExpression;
 end;
 
-function TEnvironment.Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog): TCompiledFunction;
+function TEnvironment.Link(const Node: ILambdaExpressionNode; const Log: ICompilerLog = nil): TCompiledFunction;
 var
     descriptor: IScopeDescriptor;
     funcType: IStaticType;
@@ -516,7 +517,7 @@ begin
             FFunctionRegistry,
             function(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction
             begin
-                Result := Compile(Node, ArgTypes);
+                Result := Link(Compile(Node, ArgTypes));
             end
         );
 end;

Src/AST/Myc.Ast.RTL.TypeRegistry.pas

@@ -33,6 +33,7 @@ type
 
         // --- Analysis ---
         class function AnalyzeType(ATypeInfo: PTypeInfo): IStaticType; static;
+        class function GenerateMethodType(RType: TRttiMethodType): IStaticType; static;
         class function GenerateInterfaceDefinition(RType: TRttiInterfaceType): IStaticType; static;
         class procedure EnterAnalysis(Info: PTypeInfo); static;
         class procedure ExitAnalysis(Info: PTypeInfo); static;
@@ -72,6 +73,7 @@ type
 implementation
 
 uses
+    Myc.Ast.Evaluator,
     Myc.Ast.RTL.Core;
 
 { TRtlTypeRegistry }
@@ -168,12 +170,71 @@ var
 begin
     rType := FCtx.GetType(ATypeInfo);
     case rType.TypeKind of
-        tkInterface: Result := GenerateInterfaceDefinition(rType as TRttiInterfaceType);
+        // Check for Anonymous Method (treated as Interface in Delphi but should be stMethod in AST)
+        tkInterface:
+        begin
+            var rIntf := rType as TRttiInterfaceType;
+            // If the Interface has an "Invoke" method and is marked as reference-to (or is generic TFunc/TProc),
+            // map it directly to stMethod.
+            // Note: RTTI for "IsReferenceTo" is not always directly available,
+            // but we can check if there is exactly one method named "Invoke".
+            var method := rIntf.GetMethod('Invoke');
+            if Assigned(method) and (Length(rIntf.GetMethods) = 1) then
+            begin
+                // It is functionally a Delegate -> Map to stMethod
+                var params := method.GetParameters;
+                var pTypes: TArray<IStaticType>;
+                SetLength(pTypes, Length(params));
+
+                for var i := 0 to High(params) do
+                    pTypes[i] := ResolveType(params[i].ParamType);
+
+                var retType: IStaticType;
+                if Assigned(method.ReturnType) then
+                    retType := ResolveType(method.ReturnType)
+                else
+                    retType := TTypes.Void;
+
+                Result := TTypes.CreateMethod(pTypes, retType);
+            end
+            else
+            begin
+                // Classic Interface -> Map to Generic Record
+                Result := GenerateInterfaceDefinition(rIntf);
+            end;
+        end;
+
+        // NEW: Support for classic method pointers (of object)
+        tkMethod: Result := GenerateMethodType(rType as TRttiMethodType);
+
     else
         Result := ResolveType(rType);
     end;
 end;
 
+class function TRtlTypeRegistry.GenerateMethodType(RType: TRttiMethodType): IStaticType;
+var
+    params: TArray<TRttiParameter>;
+    pTypes: TArray<IStaticType>;
+    retType: IStaticType;
+    i: Integer;
+begin
+    params := RType.GetParameters;
+    SetLength(pTypes, Length(params));
+
+    for i := 0 to High(params) do
+    begin
+        pTypes[i] := ResolveType(params[i].ParamType);
+    end;
+
+    if Assigned(RType.ReturnType) then
+        retType := ResolveType(RType.ReturnType)
+    else
+        retType := TTypes.Void;
+
+    Result := TTypes.CreateMethod(pTypes, retType);
+end;
+
 class function TRtlTypeRegistry.GenerateInterfaceDefinition(RType: TRttiInterfaceType): IStaticType;
 var
     methods: TArray<TRttiMethod>;
@@ -260,8 +321,80 @@ begin
                         Result := TValue.From<Int64>(sc.Value.AsInt64);
             end;
         end;
-        vkText: Result := TValue.From<string>(AData.AsText);
+
-        vkVoid: Result := TValue.Empty;
+        vkText:
+        begin
+            Result := TValue.From<string>(AData.AsText);
+        end;
+
+        vkMethod:
+        begin
+            // We can only map script methods to Interfaces (Anonymous Methods are Interfaces).
+            if ATargetType.TypeKind <> tkInterface then
+                raise EInteropException.CreateFmt(
+                    'Cannot marshal script method to non-interface type "%s". Target must be an interface or anonymous method.',
+                    [ATargetType.Name]);
+
+            // Cast to Interface Type
+            var rIntf := ATargetType as TRttiInterfaceType;
+            var scriptFunc := AData.AsMethod;
+
+            // Create a proxy
+            var vIntf :=
+                TVirtualInterface.Create(
+                    rIntf.Handle,
+                    procedure(Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue)
+                    var
+                        scriptArgs: TArray<TDataValue>;
+                        scriptResult: TDataValue;
+                        i: Integer;
+                    begin
+                        // Args[0] is always the Instance (Self) for Interfaces, skip it.
+                        SetLength(scriptArgs, Length(Args) - 1);
+                        for i := 0 to High(scriptArgs) do
+                        begin
+                            scriptArgs[i] := FromTValue(Args[i + 1]);
+                        end;
+
+                        try
+                            scriptResult := scriptFunc(scriptArgs);
+
+                            // The caller comes from the Delphi world. We must ensure the TCO stack is flushed before returning.
+                            TEvaluatorVisitor.HandleTCO(scriptResult);
+                        except
+                            on E: Exception do
+                                raise EInteropException
+                                    .CreateFmt('Error executing script callback for "%s.%s": %s', [rIntf.Name, Method.Name, E.Message]);
+                        end;
+
+                        if Assigned(Method.ReturnType) then
+                        begin
+                            Result := ToTValue(scriptResult, Method.ReturnType);
+                        end;
+                    end
+                );
+
+            // Extract the Interface
+            var intfRef: IInterface;
+            if vIntf.QueryInterface(rIntf.GUID, intfRef) = S_OK then
+            begin
+                // Instead of using TValue.From(intfRef) (which creates a TValue of type IInterface),
+                // we force the TValue to the exact target type (e.g. TStringProc).
+                // PassArg requires exact type matching for Interfaces/Anonymous Methods.
+
+                TValue.Make(@intfRef, ATargetType.Handle, Result);
+            end
+            else
+                raise EInteropException.CreateFmt('Failed to create virtual interface for "%s".', [rIntf.Name]);
+        end;
+
+        vkVoid:
+        begin
+            if ATargetType.TypeKind = tkInterface then
+                raise EInteropException.Create(
+                    'Cannot pass Void to Interface parameter (did you mean nil? or is your lambda returning void?)');
+            Result := TValue.Empty;
+        end
     else
         raise EInteropException.CreateFmt('Marshalling for DataKind %s not implemented.', [TRttiEnumerationType.GetName(AData.Kind)]);
     end;
@@ -285,6 +418,7 @@ begin
         // Recursively wrap returned interfaces
         tkInterface: Result := WrapInstance(AValue.AsInterface, AValue.TypeInfo);
     else
+        raise EInteropException.CreateFmt('FromTValue: Unsupported Kind %s', [TRttiEnumerationType.GetName(AValue.Kind)]);
         Result := TDataValue.Void;
     end;
 end;

Src/AST/Myc.Ast.RTL.pas

@@ -107,12 +107,6 @@ type
         class function CreateWrapper_FO_F(CodeAddress: Pointer): TDataValue.TFunc; static;
         class function CreateWrapper_FO_O(CodeAddress: Pointer): TDataValue.TFunc; static;
         class function CreateWrapper_TT_T(CodeAddress: Pointer): TDataValue.TFunc; static;
-        class function CreateStaticWrapper(
-            method: TRttiMethod;
-            retType: IStaticType;
-            argTypes: TArray<IStaticType>;
-            rttiParams: TArray<TRttiParameter>
-        ): TDataValue.TFunc; static;
 
         // --- RTTI Helpers ---
         class function RttiTypeToStaticType(const AType: TRttiType): IStaticType; static;
@@ -124,6 +118,14 @@ type
 
     public
         class procedure RegisterAll(const AScope: IExecutionScope); static;
+
+        class function CreateStaticWrapper(
+            method: TRttiMethod;
+            retType: IStaticType;
+            argTypes: TArray<IStaticType>;
+            rttiParams: TArray<TRttiParameter>
+        ): TDataValue.TFunc; static;
+
         // Public accessor for the TStaticSpecializer
         class function GetStaticSpecialization(const AName: string; const AArgTypes: TArray<IStaticType>): TSpecializedMethod; static;
         class procedure RegisterStaticSpecialization(