Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Tail call optimization

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-19 11:53:16 +02:00
parent 9be22dea3a
commit abbce15362
11 changed files with 169 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Debugger.pas
-17
View File
@@ -31,13 +31,6 @@ type
public
constructor Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0);
class function CreateVisitor(
const AScope: IExecutionScope;
ALog: TStrings;
AShowScope: Boolean;
AInitialIndent: Integer = 0
): IAstVisitor;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
// The logging overrides for other Visit... methods
function VisitConstant(const Node: IConstantNode): TDataValue; override;
@@ -121,16 +114,6 @@ begin
FLog.Add(pad + S);
end;
class function TDebugEvaluatorVisitor.CreateVisitor(
const AScope: IExecutionScope;
ALog: TStrings;
AShowScope: Boolean;
AInitialIndent: Integer = 0
): IAstVisitor;
begin
Result := TDebugEvaluatorVisitor.Create(AScope, ALog, AShowScope, AInitialIndent);
end;
procedure TDebugEvaluatorVisitor.ShowScope;
var
scopeDump: TArray<string>;
Src/AST/Myc.Ast.Evaluator.pas
+59 -19
View File
@@ -25,10 +25,15 @@ type
// Returns a closure that can create the correct type of visitor for a lambda's body.
function CreateVisitorFactory: TVisitorFactory; virtual;
procedure HandleTCO(var ResultValue: TDataValue);
property Scope: IExecutionScope read FScope;
public
constructor Create(const AScope: IExecutionScope);
// Executes an AST with proper TCO handling. This is the main entry point.
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual;
@@ -59,6 +64,20 @@ uses
Myc.Data.Series,
Myc.Data.Scalar.JSON;
// Helper type for TCO via trampolining.
type
TThunk = record
Callee: TDataValue;
Args: TArray<TDataValue>;
constructor Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>);
end;
constructor TThunk.Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>);
begin
Callee := ACallee;
Args := AArgs;
end;
// --- Native Functions Implementation ---
function NativeCreateRecordSeries(const Args: TArray<TDataValue>): TDataValue;
@@ -96,12 +115,33 @@ begin
FScope := AScope;
end;
function TEvaluatorVisitor.Execute(const RootNode: IAstNode): TDataValue;
begin
if not Assigned(RootNode) then
exit(TDataValue.Void);
Result := RootNode.Accept(Self);
HandleTCO(Result);
end;
function TEvaluatorVisitor.CreateVisitorFactory: TVisitorFactory;
begin
// The production visitor returns a factory that creates another production visitor.
Result := function(const AScope: IExecutionScope): IAstVisitor begin Result := TEvaluatorVisitor.Create(AScope); end;
end;
procedure TEvaluatorVisitor.HandleTCO(var ResultValue: TDataValue);
begin
// This is the central trampoline loop for Tail Call Optimization.
// It runs as long as the evaluation returns a thunk.
while ResultValue.Kind = vkGeneric do
begin
var thunk := ResultValue.AsGeneric<TThunk>;
var callee := thunk.Callee.AsMethod();
ResultValue := callee(thunk.Args);
end;
end;
function TEvaluatorVisitor.IsTruthy(const AValue: TDataValue): Boolean;
begin
if (AValue.Kind <> vkScalar) then
@@ -188,31 +228,31 @@ end;
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
calleeValue: TDataValue;
[weak]
callee: TDataValue.TFunc;
argValues: TArray<TDataValue>;
begin
calleeValue := Node.Callee.Accept(Self);
case calleeValue.Kind of
vkMethod: callee := calleeValue.AsMethod();
else
if calleeValue.Kind <> vkMethod then
raise EArgumentException.Create('Expression is not invokable in this context.');
end;
var argNodes := Node.Arguments;
case Length(argNodes) of
0: Result := callee([]);
1: Result := callee([argNodes[0].Accept(Self)]);
2: Result := callee([argNodes[0].Accept(Self), argNodes[1].Accept(Self)]);
3: Result := callee([argNodes[0].Accept(Self), argNodes[1].Accept(Self), argNodes[2].Accept(Self)]);
4: Result := callee([argNodes[0].Accept(Self), argNodes[1].Accept(Self), argNodes[2].Accept(Self), argNodes[3].Accept(Self)]);
else
var argValues: TArray<TDataValue>;
SetLength(argValues, Length(argNodes));
for var i := 0 to High(argNodes) do
argValues[i] := argNodes[i].Accept(Self);
SetLength(argValues, Length(argNodes));
for var i := 0 to High(argNodes) do
argValues[i] := argNodes[i].Accept(Self);
Result := callee(argValues);
if Node.IsTailCall then
begin
// This is a tail call. Return a thunk to be processed
// by an outer trampoline loop (either in Execute or a parent non-tail-call).
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues));
end
else
begin
// This is a non-tail call. It must execute the call and act as
// the trampoline for any subsequent tail calls it may trigger.
Result := (calleeValue.AsMethod)(argValues);
HandleTCO(Result);
end;
end;
Src/AST/Myc.Ast.JSON.pas
+6
View File
@@ -70,6 +70,7 @@ type
public
constructor Create;
destructor Destroy; override;
function Execute(const RootNode: IAstNode): TDataValue;
function Serialize(const ANode: IAstNode): string;
function Deserialize(const AJson: string): IAstNode;
end;
@@ -127,6 +128,11 @@ begin
end;
end;
function TJsonAstConverter.Execute(const RootNode: IAstNode): TDataValue;
begin
Result := RootNode.Accept(Self);
end;
{ TJsonAstConverter - IAstVisitor for Serialization }
procedure TJsonAstConverter.ScalarToJson(const AScalar: TScalar; const AParent: TJSONObject; const AName: string);
Src/AST/Myc.Ast.Nodes.pas
+2
View File
@@ -85,6 +85,8 @@ type
end;
IAstVisitor = interface
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
Src/AST/Myc.Ast.Printer.pas
+6
View File
@@ -23,6 +23,7 @@ type
destructor Destroy; override;
function GetResult: string;
// IAstVisitor
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
@@ -84,6 +85,11 @@ begin
FBuilder.AppendLine(S);
end;
function TPrettyPrintVisitor.Execute(const RootNode: IAstNode): TDataValue;
begin
Result := RootNode.Accept(Self);
end;
function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
begin
AppendLine(Format('Constant (%s)', [Node.Value.ToString]));
Src/AST/Myc.Ast.Traverser.pas
+7
View File
@@ -17,6 +17,8 @@ type
function Accept(const Node: IAstNode): TDataValue; virtual;
property Done: Boolean read FDone write FDone;
public
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual;
@@ -62,6 +64,11 @@ begin
Result := Node.Accept(Self);
end;
function TAstTraverser.Execute(const RootNode: IAstNode): TDataValue;
begin
Result := RootNode.Accept(Self);
end;
function TAstTraverser.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
Accept(Node.Series);