From e03155179a6b08e1b590b700fa952529b49c9ccc Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Fri, 19 Sep 2025 23:53:48 +0200 Subject: [PATCH] Anonymous recursions --- ASTPlayground/ASTPlayground.dpr | 3 +- ASTPlayground/ASTPlayground.dproj | 1 + ASTPlayground/MainForm.pas | 56 +++++++++++++++++++++-------- Src/AST/Myc.Ast.RTL.Core.pas | 6 ++-- Src/AST/Myc.Ast.RTL.pas | 60 +++++++++++++++---------------- Src/AST/Myc.Ast.pas | 4 +-- Src/Myc.Utils.pas | 45 +++++++++++++++++++++++ 7 files changed, 126 insertions(+), 49 deletions(-) create mode 100644 Src/Myc.Utils.pas diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr index b81eed5..6cecc29 100644 --- a/ASTPlayground/ASTPlayground.dpr +++ b/ASTPlayground/ASTPlayground.dpr @@ -19,7 +19,8 @@ uses Myc.Ast.Binding in '..\Src\AST\Myc.Ast.Binding.pas', Myc.Ast.RTL in '..\Src\AST\Myc.Ast.RTL.pas', Myc.Ast.Dumper in '..\Src\AST\Myc.Ast.Dumper.pas', - Myc.Ast.RTL.Core in '..\Src\AST\Myc.Ast.RTL.Core.pas'; + Myc.Ast.RTL.Core in '..\Src\AST\Myc.Ast.RTL.Core.pas', + Myc.Utils in '..\Src\Myc.Utils.pas'; {$R *.res} diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj index 2eeac5b..572879e 100644 --- a/ASTPlayground/ASTPlayground.dproj +++ b/ASTPlayground/ASTPlayground.dproj @@ -151,6 +151,7 @@ + Base diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 5e10417..bc4d1a8 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -31,6 +31,9 @@ uses Myc.Ast.Evaluator, Myc.Ast.Printer, Myc.Ast.Dumper, + Myc.Data.Decimal, + Myc.Ast.Binding, + Myc.Ast.RTL, FMX.Layouts, FMX.Objects, Myc.Ast.Debugger; @@ -110,8 +113,6 @@ implementation uses Myc.Data.Scalar.JSON, - Myc.Data.Decimal, - Myc.Ast.Binding, System.Diagnostics, // For TStopwatch Myc.Ast.Json; // For TAstJson serialization @@ -184,9 +185,6 @@ begin resultValue := ExecuteAst(mainBlock, FGScope); - //TODO Dieses Assert löst aus: - // "The final result should be 15, but is 10 (T:\Myc\ASTPlayground\MainForm.pas, line 186)" - Assert(TScalar.FromInteger(15) = resultValue.AsScalar, 'The final result should be 15, but is ' + resultValue.AsScalar.ToString); end; @@ -282,14 +280,14 @@ var result: TDataValue; sw: TStopwatch; begin - Memo1.Lines.Clear; - Memo1.Lines.Add('--- Recursive fib with AST---'); - sw := TStopwatch.StartNew; - - root := + // Create a setup script to define a memoize-compatible 'fib' function globally. + var fibAst := TAst.Block( [ - TAst.VarDecl( + // 1. var fib; (Declare the name so it can be captured by the lambda. Initializer is nil) + TAst.VarDecl(TAst.Identifier('fib')), + // 2. var fib_impl = lambda(n) { ... fib(n-1) + fib(n-2) ... }; + TAst.Assign( TAst.Identifier('fib'), TAst.LambdaExpr( [TAst.Identifier('n')], @@ -297,6 +295,7 @@ begin TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))), TAst.Identifier('n'), TAst.BinaryExpr( + // Recursive calls now use the re-bindable name 'fib' instead of 'Self' TAst.FunctionCall( TAst.Identifier('Self'), [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))] @@ -309,14 +308,43 @@ begin ) ) ) - ), + ) + ] + ); + + var fibScope := TAstBinder.Bind(fibAst, FGScope).CreateScope(FGScope); + var visitor := CreateVisitor(fibScope); + Result := visitor.Execute(fibAst); + + Memo1.Lines.Clear; + Memo1.Lines.Add('--- Recursive fib with AST---'); + sw := TStopwatch.StartNew; + + root := TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(TScalar.FromInt64(30))]); + + FLastAst := root; + // Execute with fibScope as parent. The helper function handles debug/prod switching. + result := ExecuteAst(root, fibScope); + + sw.Stop; + Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); + + Memo1.Lines.Add(''); + Memo1.Lines.Add('--- Memoized recursive fib with AST (using global fib)---'); + sw := TStopwatch.StartNew; + + root := + TAst.Block( + [ + // Create a memoized version by calling the RTL function on the global 'fib' + TAst.Assign(TAst.Identifier('fib'), TAst.FunctionCall(TAst.Identifier('Memoize'), [TAst.Identifier('fib')])), + // Call the memoized function TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(TScalar.FromInt64(30))]) ] ); FLastAst := root; - // Execute with FGScope as parent. The helper function handles debug/prod switching. - result := ExecuteAst(root, FGScope); + result := ExecuteAst(root, fibScope); sw.Stop; Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); diff --git a/Src/AST/Myc.Ast.RTL.Core.pas b/Src/AST/Myc.Ast.RTL.Core.pas index d5ddd28..adf8515 100644 --- a/Src/AST/Myc.Ast.RTL.Core.pas +++ b/Src/AST/Myc.Ast.RTL.Core.pas @@ -3,6 +3,7 @@ unit Myc.Ast.RTL.Core; interface uses + Myc.Utils, Myc.Data.Scalar, Myc.Data.Value, Myc.Ast.RTL; @@ -122,7 +123,6 @@ end; class function TRtlFunctions.Memoize(const Args: TArray): TDataValue; var funcToMemoize: TDataValue.TFunc; - cache: TDictionary; memoizedFunc: TDataValue.TFunc; begin if Length(Args) <> 1 then @@ -130,8 +130,8 @@ begin if Args[0].Kind <> vkMethod then raise EArgumentException.Create('The argument to Memoize must be a function.'); + var cCache: TManaged> := TDictionary.Create; funcToMemoize := Args[0].AsMethod(); - cache := TDictionary.Create; memoizedFunc := function(const AArgs: TArray): TDataValue @@ -151,6 +151,8 @@ begin else key := argScalar.Value.AsInt64; + var cache: TDictionary := cCache; + if cache.TryGetValue(key, Result) then exit; diff --git a/Src/AST/Myc.Ast.RTL.pas b/Src/AST/Myc.Ast.RTL.pas index 9d17a37..d428583 100644 --- a/Src/AST/Myc.Ast.RTL.pas +++ b/Src/AST/Myc.Ast.RTL.pas @@ -54,34 +54,10 @@ type const AArgs: TArray; out AArg: TScalar ): Boolean; static; inline; - class function CreateScalarWrapper(AFuncName: string; AFuncPtr: Pointer): TDataValue.TFunc; static; public class procedure RegisterAll(const AScope: IExecutionScope); static; end; -// This is the "Wrapper Generator" for the (TScalar):TScalar signature. -// It creates a high-performance anonymous method that uses a direct function pointer. -class function TRtlRegistry.CreateScalarWrapper(AFuncName: string; AFuncPtr: Pointer): TDataValue.TFunc; -var - // Statically typed pointer to the native function. - nativeFunc: TNativeScalarFunc; -begin - nativeFunc := AFuncPtr; - - // This is the generated wrapper that will be registered with the interpreter. - Result := - function(const Args: TArray): TDataValue - var - argScalar: TScalar; - begin - // 1. Optimized argument validation and unpacking. - GetSingleNumericArg(AFuncName, Args, argScalar); - - // 2. Direct, statically typed call via pointer. - Result := TDataValue(nativeFunc(argScalar)); - end; -end; - { TRtlRegistry } class function TRtlRegistry.GetSingleNumericArg(const AName: string; const AArgs: TArray; out AArg: TScalar): Boolean; @@ -123,6 +99,9 @@ begin if not (attribute is TRtlFunctionAttribute) then continue; + if method.MethodKind <> mkClassFunction then + continue; + rtlAttribute := attribute as TRtlFunctionAttribute; wrapper := nil; @@ -134,7 +113,21 @@ begin if param.ParamType.Handle = TypeInfo(TScalar) then begin // Signature matches: class function(Arg: TScalar): TScalar; - wrapper := CreateScalarWrapper(rtlAttribute.Name, method.CodeAddress); + // Build a factory that captures the method's name and CodeAddress. + var wrapperFactory := + function(AName: string; CodeAddress: Pointer): TDataValue.TFunc + begin + Result := + function(const Args: TArray): TDataValue + var + argScalar: TScalar; + begin + GetSingleNumericArg(AName, Args, argScalar); + Result := TDataValue(TNativeScalarFunc(CodeAddress)(argScalar)); + end; + end; + + wrapper := wrapperFactory(rtlAttribute.Name, method.CodeAddress); end; end else if (Length(method.GetParameters) = 1) and (method.ReturnType.Handle = TypeInfo(TDataValue)) then @@ -143,12 +136,19 @@ begin if (pfConst in param.Flags) and (param.ParamType.Handle = TypeInfo(TArray)) then begin // Signature matches: class function(const Args: TArray): TDataValue; - // For these, we can just cast the pointer directly. No wrapper needed. - wrapper := - function(const Args: TArray): TDataValue + // Build a factory that captures the method's CodeAddress. + var wrapperFactory := + function(CodeAddress: Pointer): TDataValue.TFunc begin - Result := TNativeDataValueFunc1(method.CodeAddress)(Args); + Result := + function(const Args: TArray): TDataValue + begin + Result := TNativeDataValueFunc1(CodeAddress)(Args); + end; end; + + // Create the wrapper + wrapper := wrapperFactory(method.CodeAddress); end; end; @@ -158,7 +158,7 @@ begin break; // Found our attribute, proceed to next method end else - raise ENotImplemented.Create('Native method wrapper not implemented'); + raise ENotImplemented.CreateFmt('Native method wrapper for %s() not implemented', [method.Name]); end; end; finally diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 4738c85..be6fd35 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -37,7 +37,7 @@ type class function LambdaExpr(const AParameters: TArray; const ABody: IAstNode): ILambdaExpressionNode; static; class function FunctionCall(const ACallee: IAstNode; const AArguments: TArray): IFunctionCallNode; static; class function Block(const AExpressions: array of IAstNode): IBlockExpressionNode; static; - class function VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IAstNode): IVariableDeclarationNode; static; + class function VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IAstNode = nil): IVariableDeclarationNode; static; class function Assign(const AIdentifier: IIdentifierNode; const AValue: IAstNode): IAssignmentNode; static; class function AssignResult(const AValue: IAstNode): IAssignmentNode; static; deprecated; class function Indexer(const ABase: IAstNode; const AIndex: IAstNode): IIndexerNode; static; @@ -780,7 +780,7 @@ begin Result := TUnaryExpressionNode.Create(AOperator, ARight); end; -class function TAst.VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IAstNode): IVariableDeclarationNode; +class function TAst.VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IAstNode = nil): IVariableDeclarationNode; begin Result := TVariableDeclarationNode.Create(AIdentifier, AInitializer); end; diff --git a/Src/Myc.Utils.pas b/Src/Myc.Utils.pas new file mode 100644 index 0000000..ccd7dc2 --- /dev/null +++ b/Src/Myc.Utils.pas @@ -0,0 +1,45 @@ +unit Myc.Utils; + +interface + +type + TManaged = record + private + type + TObj = class(TInterfacedObject) + FValue: T; + constructor Create(AValue: T); + destructor Destroy; override; + end; + var + FIntf: IInterface; + public + class operator Implicit(A: T): TManaged; overload; + class operator Implicit(const Upvalue: TManaged): T; overload; + end; + +implementation + +constructor TManaged.TObj.Create(AValue: T); +begin + inherited Create; + FValue := AValue; +end; + +destructor TManaged.TObj.Destroy; +begin + FValue.Free; + inherited; +end; + +class operator TManaged.Implicit(A: T): TManaged; +begin + Result.FIntf := TObj.Create(A); +end; + +class operator TManaged.Implicit(const Upvalue: TManaged): T; +begin + Result := (Upvalue.FIntf as TObj).FValue; +end; + +end.