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

AST Refactoring

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Evaluator.pas
+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.
Src/AST/Myc.Ast.JSON.pas
+1 -1
View File
@@ -297,7 +297,7 @@ begin
for arg in Node.Arguments do
arg.Accept(Self);
SetLength(tempArgs, Node.Arguments.Count);
SetLength(tempArgs, Length(Node.Arguments));
for i := High(tempArgs) downto 0 do
tempArgs[i] := FJsonObjectStack.Pop;
Src/AST/Myc.Ast.Nodes.pas
+4 -2
View File
@@ -182,20 +182,22 @@ type
function GetBody: IAstNode;
function GetScopeDescriptor: IScopeDescriptor;
function GetUpvalues: TArray<TResolvedAddress>;
function GetHasNestedLambdas: Boolean;
{$endregion}
property Parameters: TArray<IIdentifierNode> read GetParameters;
property Body: IAstNode read GetBody;
property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor;
property Upvalues: TArray<TResolvedAddress> read GetUpvalues;
property HasNestedLambdas: Boolean read GetHasNestedLambdas;
end;
IFunctionCallNode = interface(IAstNode)
{$region 'private'}
function GetCallee: IAstNode;
function GetArguments: TList<IAstNode>;
function GetArguments: TArray<IAstNode>;
{$endregion}
property Callee: IAstNode read GetCallee;
property Arguments: TList<IAstNode> read GetArguments;
property Arguments: TArray<IAstNode> read GetArguments;
end;
IBlockExpressionNode = interface(IAstNode)
Src/AST/Myc.Ast.Scope.pas
+3 -3
View File
@@ -43,9 +43,9 @@ uses
type
TValueCell = class(TInterfacedObject, IValueCell)
private
FValue: TDataValue; // <-- Changed from TAstValue
function GetValue: TDataValue; // <-- Changed from TAstValue
procedure SetValue(const AValue: TDataValue); // <-- Changed from TAstValue
FValue: TDataValue;
function GetValue: TDataValue;
procedure SetValue(const AValue: TDataValue);
end;
{ TValueCell }
Src/AST/Myc.Ast.pas
+83 -41
View File
@@ -23,7 +23,7 @@ type
class function IfExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): IIfExpressionNode; static;
class function TernaryExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): ITernaryExpressionNode; static;
class function LambdaExpr(const AParameters: TArray<IIdentifierNode>; const ABody: IAstNode): ILambdaExpressionNode; static;
class function FunctionCall(const ACallee: IAstNode; const AArguments: array of IAstNode): IFunctionCallNode; static;
class function FunctionCall(const ACallee: IAstNode; const AArguments: TArray<IAstNode>): IFunctionCallNode; static;
class function Block(const AExpressions: array of IAstNode): IBlockExpressionNode; static;
class function VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IAstNode): IVariableDeclarationNode; static;
class function Assign(const AIdentifier: IIdentifierNode; const AValue: IAstNode): IAssignmentNode; static;
@@ -44,6 +44,10 @@ type
// TAstTraverser provides a default AST traversal implementation.
TAstTraverser = class abstract(TInterfacedObject, IAstVisitor)
private
FDone: Boolean;
protected
property Done: Boolean read FDone write FDone;
public
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
@@ -179,13 +183,16 @@ type
FBody: IAstNode;
FScopeDescriptor: IScopeDescriptor;
FUpvalues: TArray<TResolvedAddress>;
FHasNestedLambdas: Boolean;
function GetParameters: TArray<IIdentifierNode>;
function GetBody: IAstNode;
function GetScopeDescriptor: IScopeDescriptor;
function GetUpvalues: TArray<TResolvedAddress>;
function GetHasNestedLambdas: Boolean;
public
constructor Create(const AParameters: TArray<IIdentifierNode>; const ABody: IAstNode);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property HasNestedLambdas: Boolean read FHasNestedLambdas write FHasNestedLambdas;
property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor;
end;
@@ -193,12 +200,11 @@ type
TFunctionCallNode = class(TAstNode, IFunctionCallNode)
private
FCallee: IAstNode;
FArguments: TList<IAstNode>;
FArguments: TArray<IAstNode>;
function GetCallee: IAstNode;
function GetArguments: TList<IAstNode>;
function GetArguments: TArray<IAstNode>;
public
constructor Create(const ACallee: IAstNode; const AArguments: array of IAstNode);
destructor Destroy; override;
constructor Create(const ACallee: IAstNode; const AArguments: TArray<IAstNode>);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
@@ -308,6 +314,7 @@ type
FCurrentDescriptor: IScopeDescriptor;
FUpvalueMapStack: TStack<TDictionary<TResolvedAddress, Integer>>;
FUpvalueNodesStack: TStack<TList<IIdentifierNode>>;
FNestedLambdaCount: Integer;
procedure EnterScope;
procedure ExitScope;
public
@@ -587,6 +594,11 @@ begin
Result := FBody;
end;
function TLambdaExpressionNode.GetHasNestedLambdas: Boolean;
begin
Result := FHasNestedLambdas;
end;
function TLambdaExpressionNode.GetParameters: TArray<IIdentifierNode>;
begin
Result := FParameters;
@@ -599,21 +611,11 @@ end;
{ TFunctionCallNode }
constructor TFunctionCallNode.Create(const ACallee: IAstNode; const AArguments: array of IAstNode);
var
arg: IAstNode;
constructor TFunctionCallNode.Create(const ACallee: IAstNode; const AArguments: TArray<IAstNode>);
begin
inherited Create;
FCallee := ACallee;
FArguments := TList<IAstNode>.Create;
for arg in AArguments do
FArguments.Add(arg);
end;
destructor TFunctionCallNode.Destroy;
begin
FArguments.Free;
inherited;
FArguments := AArguments;
end;
function TFunctionCallNode.Accept(const Visitor: IAstVisitor): TDataValue;
@@ -621,7 +623,7 @@ begin
Result := Visitor.VisitFunctionCall(Self);
end;
function TFunctionCallNode.GetArguments: TList<IAstNode>;
function TFunctionCallNode.GetArguments: TArray<IAstNode>;
begin
Result := FArguments;
end;
@@ -829,6 +831,7 @@ begin
FCurrentDescriptor := TAst.CreateDescriptor(AInitialScope);
FUpvalueMapStack := TStack<TDictionary<TResolvedAddress, Integer>>.Create;
FUpvalueNodesStack := TStack<TList<IIdentifierNode>>.Create;
FNestedLambdaCount := 0;
end;
destructor TBinder.Destroy;
@@ -913,8 +916,11 @@ begin
for param in Node.Parameters do
(FCurrentDescriptor as TScopeDescriptor).Define(param.Name);
var lastNestedLambdaCount := FNestedLambdaCount;
inherited VisitLambdaExpression(Node);
(Node as TLambdaExpressionNode).HasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
(Node as TLambdaExpressionNode).FScopeDescriptor := FCurrentDescriptor;
finally
ExitScope;
@@ -941,6 +947,8 @@ begin
upvalueMap.Free;
upvalueNodes.Free;
inc(FNestedLambdaCount);
end;
end;
@@ -1027,7 +1035,7 @@ begin
Result := TScopeDescriptor.Create(nil);
end;
class function TAst.FunctionCall(const ACallee: IAstNode; const AArguments: array of IAstNode): IFunctionCallNode;
class function TAst.FunctionCall(const ACallee: IAstNode; const AArguments: TArray<IAstNode>): IFunctionCallNode;
begin
Result := TFunctionCallNode.Create(ACallee, AArguments);
end;
@@ -1081,22 +1089,29 @@ end;
function TAstTraverser.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
Node.Series.Accept(Self);
Node.Value.Accept(Self);
if not FDone then
Node.Series.Accept(Self);
if not FDone then
Node.Value.Accept(Self);
if Assigned(Node.Lookback) then
Node.Lookback.Accept(Self);
if not FDone then
Node.Lookback.Accept(Self);
end;
function TAstTraverser.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
Node.Value.Accept(Self);
Node.Identifier.Accept(Self);
if not FDone then
Node.Value.Accept(Self);
if not FDone then
Node.Identifier.Accept(Self);
end;
function TAstTraverser.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
Node.Left.Accept(Self);
Node.Right.Accept(Self);
if not FDone then
Node.Left.Accept(Self);
if not FDone then
Node.Right.Accept(Self);
end;
function TAstTraverser.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
@@ -1104,7 +1119,11 @@ var
expr: IAstNode;
begin
for expr in Node.Expressions do
begin
if FDone then
break;
expr.Accept(Self);
end;
end;
function TAstTraverser.VisitConstant(const Node: IConstantNode): TDataValue;
@@ -1119,9 +1138,14 @@ function TAstTraverser.VisitFunctionCall(const Node: IFunctionCallNode): TDataVa
var
arg: IAstNode;
begin
Node.Callee.Accept(Self);
if not FDone then
Node.Callee.Accept(Self);
for arg in Node.Arguments do
begin
if FDone then
break;
arg.Accept(Self);
end;
end;
function TAstTraverser.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
@@ -1130,16 +1154,21 @@ end;
function TAstTraverser.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
Node.Condition.Accept(Self);
Node.ThenBranch.Accept(Self);
if not FDone then
Node.Condition.Accept(Self);
if not FDone then
Node.ThenBranch.Accept(Self);
if Assigned(Node.ElseBranch) then
Node.ElseBranch.Accept(Self);
if not FDone then
Node.ElseBranch.Accept(Self);
end;
function TAstTraverser.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
Node.Base.Accept(Self);
Node.Index.Accept(Self);
if not FDone then
Node.Base.Accept(Self);
if not FDone then
Node.Index.Accept(Self);
end;
function TAstTraverser.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
@@ -1147,38 +1176,51 @@ var
param: IIdentifierNode;
begin
for param in Node.Parameters do
begin
if FDone then
break;
param.Accept(Self);
Node.Body.Accept(Self);
end;
if not FDone then
Node.Body.Accept(Self);
end;
function TAstTraverser.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
// Do not visit the member identifier, as it's not a variable in the current scope.
Node.Base.Accept(Self);
if not FDone then
Node.Base.Accept(Self);
end;
function TAstTraverser.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
Node.Series.Accept(Self);
if not FDone then
Node.Series.Accept(Self);
end;
function TAstTraverser.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
Node.Condition.Accept(Self);
Node.ThenBranch.Accept(Self);
Node.ElseBranch.Accept(Self);
if not FDone then
Node.Condition.Accept(Self);
if not FDone then
Node.ThenBranch.Accept(Self);
if not FDone then
Node.ElseBranch.Accept(Self);
end;
function TAstTraverser.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
Node.Right.Accept(Self);
if not FDone then
Node.Right.Accept(Self);
end;
function TAstTraverser.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
if Assigned(Node.Initializer) then
Node.Initializer.Accept(Self);
Node.Identifier.Accept(Self);
if not FDone then
Node.Initializer.Accept(Self);
if not FDone then
Node.Identifier.Accept(Self);
end;
end.