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.