AST Refactoring

This commit is contained in:
Michael Schimmel
2025-09-12 22:45:29 +02:00
parent a36ca2c7e3
commit be6665ad6e
11 changed files with 428 additions and 633 deletions
+111 -454
View File
@@ -13,14 +13,29 @@ uses
Myc.Ast;
type
// A factory for creating visitors, primarily used by the debugger subsystem.
TVisitorFactory = reference to function(const Scope: IExecutionScope): IAstVisitor;
// The standard AST evaluator for production use.
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor)
private
FScope: IExecutionScope;
protected
function IsTruthy(const AValue: TDataValue): Boolean;
function CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; virtual;
// Returns a closure that can create the correct type of visitor for a lambda's body.
function GetVisitorFactory: TVisitorFactory; virtual;
// Creates the callable closure for a lambda expression. No longer virtual.
function CreateLambdaClosure(
const Node: ILambdaExpressionNode;
const ACapturedCells: TArray<IValueCell>;
const AClosureScope: IExecutionScope
): TDataValue;
property Scope: IExecutionScope read FScope;
public
constructor Create(const AScope: IExecutionScope);
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual;
@@ -39,38 +54,7 @@ type
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual;
end;
TDebugEvaluatorVisitor = class(TEvaluatorVisitor)
private
FLog: TStrings;
FIndentLevel: Integer;
FShowScope: Boolean;
procedure Indent;
procedure Unindent;
procedure AppendLine(const S: string);
procedure AppendMultiline(const S: string);
procedure ShowScope;
protected
function CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; override;
public
constructor Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0);
function VisitConstant(const Node: IConstantNode): TDataValue; override;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
end;
// Registers native Delphi functions into a scope.
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
implementation
@@ -80,46 +64,8 @@ uses
System.Generics.Defaults,
Myc.Data.Decimal,
Myc.Data.Series,
Myc.Ast.Printer,
Myc.Data.Scalar.JSON;
type
TNativeFunction = function(const Args: TArray<TDataValue>): TDataValue;
TClosure = class(TInterfacedObject)
function GetArity: Integer; virtual; abstract;
function Invoke(
const AVisitor: IAstVisitor;
const ASelf: TDataValue;
const AArgNodes: TList<IAstNode>
): TDataValue; virtual; abstract;
end;
TClosureValue = class(TClosure)
private
FLambdaNode: ILambdaExpressionNode;
FClosureScope: IExecutionScope;
FUpvalues: TArray<IValueCell>;
public
constructor Create(
const ALambdaNode: ILambdaExpressionNode;
const AClosureScope: IExecutionScope;
const AUpvalues: TArray<IValueCell>
);
function GetArity: Integer; override;
function Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): TDataValue; override;
end;
TNativeClosure = class(TClosure)
private
FMethod: TNativeFunction;
FArity: Integer;
public
constructor Create(const AMethod: TNativeFunction; AArity: Integer);
function GetArity: Integer; override;
function Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): TDataValue; override;
end;
// --- Native Functions Implementation ---
function NativeCreateRecordSeries(const Args: TArray<TDataValue>): TDataValue;
@@ -128,9 +74,8 @@ var
recordDef: TScalarRecordDefinition;
series: TScalarRecordSeries;
begin
// Arity check is now done by the caller (TNativeClosure.Invoke)
if Args[0].Kind <> vkText then
raise EArgumentException.Create('CreateRecordSeries requires a string argument.');
if (Length(Args) <> 1) or (Args[0].Kind <> vkText) then
raise EArgumentException.Create('CreateRecordSeries requires one string argument.');
jsonDef := Args[0].AsText;
recordDef := TRttiAstHelper.JsonToRecordDefinition(jsonDef);
@@ -146,88 +91,7 @@ end;
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
begin
// Use 'Define' to clearly state that we are adding a new variable
// to the global scope before the binder runs.
AScope.Define('CreateRecordSeries', TNativeClosure.Create(NativeCreateRecordSeries, 1));
end;
{ TClosureValue }
constructor TClosureValue.Create(
const ALambdaNode: ILambdaExpressionNode;
const AClosureScope: IExecutionScope;
const AUpvalues: TArray<IValueCell>
);
begin
inherited Create;
FLambdaNode := ALambdaNode;
FClosureScope := AClosureScope;
FUpvalues := AUpvalues;
end;
function TClosureValue.GetArity: Integer;
begin
Result := Length(FLambdaNode.Parameters);
end;
function TClosureValue.Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): TDataValue;
var
i: Integer;
descriptor: IScopeDescriptor;
callScope: IExecutionScope;
adr: TResolvedAddress;
begin
if (AArgNodes.Count <> GetArity) then
raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [GetArity, AArgNodes.Count]);
descriptor := FLambdaNode.ScopeDescriptor;
if not Assigned(descriptor) then
raise EParserError.Create('Lambda has no scope descriptor. Did the binder run?');
callScope := TExecutionScope.Create(FClosureScope, descriptor, FUpvalues);
adr.Kind := akLocalOrParent;
adr.ScopeDepth := 0;
adr.SlotIndex := 0;
callScope[adr].Value := ASelf;
for i := 0 to AArgNodes.Count - 1 do
begin
adr.SlotIndex := FLambdaNode.Parameters[i].Address.SlotIndex;
callScope[adr].Value := AArgNodes[i].Accept(AVisitor);
end;
Result := FLambdaNode.Body.Accept((AVisitor as TEvaluatorVisitor).CreateVisitorForScope(callScope));
end;
{ TNativeClosure }
constructor TNativeClosure.Create(const AMethod: TNativeFunction; AArity: Integer);
begin
inherited Create;
FMethod := AMethod;
FArity := AArity;
end;
function TNativeClosure.GetArity: Integer;
begin
Result := FArity;
end;
function TNativeClosure.Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): TDataValue;
var
argValues: TArray<TDataValue>;
i: Integer;
begin
if (FArity <> -1) and (AArgNodes.Count <> FArity) then
raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [FArity, AArgNodes.Count]);
// Evaluate argument nodes to get values for the native function
SetLength(argValues, AArgNodes.Count);
for i := 0 to AArgNodes.Count - 1 do
argValues[i] := AArgNodes[i].Accept(AVisitor);
Result := FMethod(argValues);
AScope.Define('CreateRecordSeries', TDataValue(NativeCreateRecordSeries));
end;
{ TEvaluatorVisitor }
@@ -239,16 +103,18 @@ begin
FScope := AScope;
end;
function TEvaluatorVisitor.CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor;
function TEvaluatorVisitor.GetVisitorFactory: TVisitorFactory;
begin
Result := TEvaluatorVisitor.Create(AScope);
// The production visitor returns a factory that creates another production visitor.
Result := function(const AScope: IExecutionScope): IAstVisitor begin Result := TEvaluatorVisitor.Create(AScope); end;
end;
function TEvaluatorVisitor.IsTruthy(const AValue: TDataValue): Boolean;
begin
if (AValue.Kind <> vkScalar) then
begin
Exit(False);
Result := False;
exit;
end;
case AValue.AsScalar.Kind of
@@ -261,26 +127,102 @@ begin
end;
end;
function TEvaluatorVisitor.CreateLambdaClosure(
const Node: ILambdaExpressionNode;
const ACapturedCells: TArray<IValueCell>;
const AClosureScope: IExecutionScope
): TDataValue;
var
closureValue: TDataValue;
visitorFactory: TVisitorFactory;
begin
// Get the appropriate factory via virtual dispatch.
visitorFactory := GetVisitorFactory();
closureValue :=
TDataValue.TFunc(
function(const ArgValues: TArray<TDataValue>): TDataValue
var
lambdaScope: IExecutionScope;
bodyVisitor: IAstVisitor;
i: Integer;
adr: TResolvedAddress;
begin
if (Length(ArgValues) <> Length(Node.Parameters)) then
raise EArgumentException
.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(Node.Parameters), Length(ArgValues)]);
lambdaScope := TExecutionScope.Create(AClosureScope, Node.ScopeDescriptor, ACapturedCells);
adr.Kind := akLocalOrParent;
adr.ScopeDepth := 0;
// Set 'Self' (slot 0) to the captured closureValue for recursion.
adr.SlotIndex := 0;
lambdaScope.Cell[adr].Value := closureValue;
// Populate the actual parameters.
for i := 0 to High(ArgValues) do
begin
adr.SlotIndex := Node.Parameters[i].Address.SlotIndex;
lambdaScope.Cell[adr].Value := ArgValues[i];
end;
// Use the injected factory to create the visitor for the lambda's body.
bodyVisitor := visitorFactory(lambdaScope);
Result := Node.Body.Accept(bodyVisitor);
end
);
Result := closureValue;
end;
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
capturedCells: TArray<IValueCell>;
i: Integer;
sourceAddresses: TArray<TResolvedAddress>;
closureScope: IExecutionScope;
begin
sourceAddresses := Node.Upvalues;
SetLength(capturedCells, Length(sourceAddresses));
for i := 0 to High(sourceAddresses) do
capturedCells[i] := FScope.GetCell(sourceAddresses[i]);
if Node.HasNestedLambdas then
closureScope := FScope
else
closureScope := nil;
Result := CreateLambdaClosure(Node, capturedCells, closureScope);
end;
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
calleeValue: TDataValue;
argValues: TArray<TDataValue>;
i: Integer;
begin
calleeValue := Node.Callee.Accept(Self);
// Check if the value holds an interface and if that interface supports our invocation contract.
if (calleeValue.Kind <> vkInterface) or not (calleeValue.AsInterface is TClosure) then
raise EArgumentException.Create('Expression is not invokable in this context.');
var argNodes := Node.Arguments;
SetLength(argValues, Length(argNodes));
for i := 0 to High(argNodes) do
argValues[i] := argNodes[i].Accept(Self);
// "Tell, Don't Ask": Simply tell the object to invoke itself.
Result := (calleeValue.AsInterface as TClosure).Invoke(Self, calleeValue, Node.Arguments);
if (calleeValue.Kind = vkMethod) then
Result := (calleeValue.AsMethod)(argValues)
else
raise EArgumentException.Create('Expression is not invokable in this context.');
end;
// ... The rest of the Visit... methods are unchanged and remain as they were ...
function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
var
itemValue, lookbackValue, seriesVar: TDataValue;
lookback: Int64;
begin
// The target series must have been resolved by the binder.
seriesVar := FScope[Node.Series.Address].Value;
itemValue := Node.Value.Accept(Self);
lookback := -1;
@@ -297,7 +239,6 @@ begin
lookback := lookbackValue.AsScalar.Value.AsInt64;
end;
// Dispatch based on series type
case seriesVar.Kind of
vkSeries:
begin
@@ -309,7 +250,6 @@ begin
if (itemValue.AsScalar.Kind <> Kind) then
raise EArgumentException
.CreateFmt('Type mismatch: Cannot add %s to a series of %s.', [itemValue.AsScalar.Kind.ToString, Kind.ToString]);
Items.Add(itemValue.AsScalar.Value, lookback);
end;
end;
@@ -326,7 +266,7 @@ begin
else
raise EArgumentException.Create('"add" operation is only supported for series types.');
end;
Result := TDataValue.Void; // 'add' is a procedure, returns void
Result := TDataValue.Void;
end;
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
@@ -395,7 +335,6 @@ begin
begin
if (index < 0) or (index >= Items.TotalCount) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, Items.TotalCount]);
Result := TScalar.Create(Kind, Items[Integer(index)]);
end;
end;
@@ -404,7 +343,6 @@ begin
var series := baseValue.AsRecordSeries.Value;
if (index < 0) or (index >= series.TotalCount) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, series.TotalCount]);
var recordValue := series.Items[Integer(index)];
Result := TDataValue.FromRecord(recordValue);
end;
@@ -414,7 +352,6 @@ begin
if (index < 0) or (index >= memberSeries.Count) then
raise EArgumentException
.CreateFmt('Index %d is out of bounds for member series with %d elements.', [index, memberSeries.Count]);
Result := memberSeries.Items[Integer(index)];
end;
else
@@ -466,22 +403,6 @@ begin
Result := value;
end;
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
capturedCells: TArray<IValueCell>;
i: Integer;
sourceAddresses: TArray<TResolvedAddress>;
begin
// The binder has identified the upvalues. Capture the cells from the current scope
// using the original source addresses provided by the binder.
sourceAddresses := Node.Upvalues;
SetLength(capturedCells, Length(sourceAddresses));
for i := 0 to High(sourceAddresses) do
capturedCells[i] := FScope.GetCell(sourceAddresses[i]);
Result := TClosureValue.Create(Node, FScope, capturedCells) as IInterface;
end;
function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
var
leftValue, rightValue: TDataValue;
@@ -499,18 +420,12 @@ begin
if (leftScalar.Kind <> rightScalar.Kind) then
begin
if (leftScalar.Kind = skInt64) and (rightScalar.Kind = skDouble) then
begin
leftScalar := TScalar.FromDouble(leftScalar.Value.AsInt64);
end
leftScalar := TScalar.FromDouble(leftScalar.Value.AsInt64)
else if (leftScalar.Kind = skDouble) and (rightScalar.Kind = skInt64) then
begin
rightScalar := TScalar.FromDouble(rightScalar.Value.AsInt64);
end
rightScalar := TScalar.FromDouble(rightScalar.Value.AsInt64)
else
begin
raise ENotSupportedException.Create(
'Binary operations are only supported for compatible types. ' + leftScalar.ToString + ' ' + rightScalar.ToString);
end;
end;
case leftScalar.Kind of
@@ -617,7 +532,6 @@ function TEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode
var
expression: IAstNode;
begin
// The result of a block is the result of its last expression.
Result := TDataValue.Void;
for expression in Node.Expressions do
begin
@@ -630,7 +544,7 @@ var
seriesValue: TDataValue;
len: Int64;
begin
seriesValue := Node.Series.Accept(Self);
seriesValue := FScope[Node.Series.Address].Value;
case seriesValue.Kind of
vkSeries: len := seriesValue.AsSeries.Value.Items.Count;
@@ -643,261 +557,4 @@ begin
Result := TScalar.FromInt64(len);
end;
{ TDebugEvaluatorVisitor }
constructor TDebugEvaluatorVisitor.Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer);
begin
inherited Create(AScope);
Assert(Assigned(ALog));
FLog := ALog;
FIndentLevel := AInitialIndent;
FShowScope := AShowScope;
ShowScope;
end;
function TDebugEvaluatorVisitor.CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor;
begin
Result := TDebugEvaluatorVisitor.Create(AScope, FLog, FShowScope, FIndentLevel);
end;
procedure TDebugEvaluatorVisitor.Indent;
begin
inc(FIndentLevel);
end;
procedure TDebugEvaluatorVisitor.Unindent;
begin
dec(FIndentLevel);
end;
procedure TDebugEvaluatorVisitor.AppendLine(const S: string);
var
pad: string;
i: Integer;
begin
pad := '';
for i := 0 to FIndentLevel - 1 do
begin
pad := pad + ':' + ''.PadLeft(3);
end;
FLog.Add(pad + S);
end;
procedure TDebugEvaluatorVisitor.AppendMultiline(const S: string);
begin
var Str := TStringList.Create;
try
Str.Text := s;
for var i := 0 to Str.Count - 1 do
AppendLine(Str[i]);
finally
Str.Free;
end;
end;
procedure TDebugEvaluatorVisitor.ShowScope;
var
scopeDump: TArray<string>;
line: string;
begin
if FShowScope then
begin
AppendLine('-- Scope --');
scopeDump := FScope.Dump.Split([sLineBreak]);
for line in scopeDump do
begin
AppendLine(line);
end;
AppendLine('-----------');
end;
end;
function TDebugEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
AppendLine('AddSeriesItem {');
Indent;
try
Result := inherited VisitAddSeriesItem(Node);
finally
Unindent;
end;
AppendLine('} -> (void)');
end;
function TDebugEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
AppendLine(Format('Assignment to "%s" {', [Node.Identifier.Name]));
Indent;
try
Result := inherited VisitAssignment(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
begin
AppendLine(Format('Constant (%s)', [Node.Value.ToString]));
Result := inherited VisitConstant(Node);
end;
function TDebugEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
begin
AppendLine('CreateSeries {');
Indent;
try
Result := inherited VisitCreateSeries(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
Result := inherited VisitIdentifier(Node);
AppendLine(Format('Identifier "%s" -> %s', [Node.Name, Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
AppendLine(Format('BinaryExpr "%s" {', [Node.Operator.ToString]));
Indent;
try
Result := inherited VisitBinaryExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
AppendLine(Format('UnaryExpr "%s" {', [Node.Operator.ToString]));
Indent;
try
Result := inherited VisitUnaryExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
AppendLine('IfExpr{');
Indent;
try
Result := inherited VisitIfExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
AppendLine('Indexer {');
Indent;
try
Result := inherited VisitIndexer(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
AppendLine(Format('MemberAccess (Member: %s) {', [Node.Member.Name]));
Indent;
try
Result := inherited VisitMemberAccess(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
AppendLine('TernaryExpr{');
Indent;
try
Result := inherited VisitTernaryExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
begin
AppendLine('LambdaExpr{');
Indent;
try
var pp: IAstVisitor := TPrettyPrintVisitor.Create(0);
pp.VisitLambdaExpression(Node);
AppendMultiline((pp as TPrettyPrintVisitor).GetResult);
ShowScope;
Result := inherited VisitLambdaExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
begin
AppendLine('FunctionCall{');
Indent;
try
ShowScope;
Result := inherited VisitFunctionCall(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
begin
AppendLine('Block{');
Indent;
try
Result := inherited VisitBlockExpression(Node);
ShowScope;
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
AppendLine(Format('VarDecl %s :=', [Node.Identifier.Name]));
Indent;
try
Result := inherited VisitVariableDeclaration(Node);
finally
Unindent;
end;
end;
function TDebugEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
AppendLine('SeriesLength {');
Indent;
try
Result := inherited VisitSeriesLength(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
end.