Binder refactoring, Monster refactoring
This commit is contained in:
Michael Schimmel
File diff suppressed because one or more lines are too long
@@ -22,7 +22,6 @@ uses
|
||||
Myc.Ast.Script in '..\Src\AST\Myc.Ast.Script.pas',
|
||||
Myc.Ast.Types in '..\Src\AST\Myc.Ast.Types.pas',
|
||||
Myc.Data.Keyword in '..\Src\Data\Myc.Data.Keyword.pas',
|
||||
Myc.Ast.Binding.Nodes in '..\Src\AST\Myc.Ast.Binding.Nodes.pas',
|
||||
Myc.Ast.MacroExpander in '..\Src\AST\Myc.Ast.MacroExpander.pas',
|
||||
Myc.Ast.TypeChecker in '..\Src\AST\Myc.Ast.TypeChecker.pas',
|
||||
Myc.Ast.Lowering in '..\Src\AST\Myc.Ast.Lowering.pas',
|
||||
|
||||
@@ -152,7 +152,6 @@
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Script.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Types.pas"/>
|
||||
<DCCReference Include="..\Src\Data\Myc.Data.Keyword.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Binding.Nodes.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.MacroExpander.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.TypeChecker.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Lowering.pas"/>
|
||||
|
||||
@@ -27,6 +27,7 @@ uses
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast.Scope,
|
||||
Myc.Ast,
|
||||
Myc.Ast.Visitor,
|
||||
Myc.Ast.Evaluator,
|
||||
Myc.Ast.Dumper,
|
||||
Myc.Data.Decimal,
|
||||
@@ -262,7 +263,7 @@ begin
|
||||
FWorkspace.Align := TAlignLayout.Client;
|
||||
FWorkspace.ClipChildren := true;
|
||||
FWorkspace.OnMouseDown := WorkspaceMouseDown;
|
||||
|
||||
{
|
||||
TAst.RegisterLibrary(
|
||||
procedure(const Scope: IExecutionScope)
|
||||
var
|
||||
@@ -356,7 +357,7 @@ begin
|
||||
);
|
||||
end
|
||||
);
|
||||
|
||||
}
|
||||
ClearButtonClick(Self);
|
||||
end;
|
||||
|
||||
|
||||
@@ -49,7 +49,8 @@ type
|
||||
property Workspace: TAuraWorkspace read GetWorkspace;
|
||||
end;
|
||||
|
||||
TAstVisualizer = class(TAstVisitor, IAstVisualizer)
|
||||
// Inherits from the new generic TAstVisitor<TAuraNode>
|
||||
TAstVisualizer = class(TAstVisitor<TAuraNode>, IAstVisualizer)
|
||||
private
|
||||
FExprDepth: Integer;
|
||||
FParentControl: TControl;
|
||||
@@ -63,30 +64,30 @@ type
|
||||
procedure SetParentControl(const Value: TControl);
|
||||
protected
|
||||
// Visitor implementations for each AST node type.
|
||||
function VisitConstant(const Node: IConstantNode): TDataValue; override;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
|
||||
function VisitKeyword(const Node: IKeywordNode): 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 VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
|
||||
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
|
||||
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
|
||||
function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override;
|
||||
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
|
||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
|
||||
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
|
||||
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
|
||||
function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
|
||||
function VisitConstant(const Node: IConstantNode): TAuraNode; override;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): TAuraNode; override;
|
||||
function VisitKeyword(const Node: IKeywordNode): TAuraNode; override;
|
||||
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAuraNode; override;
|
||||
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAuraNode; override;
|
||||
function VisitIfExpression(const Node: IIfExpressionNode): TAuraNode; override;
|
||||
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAuraNode; override;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAuraNode; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TAuraNode; override;
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TAuraNode; override;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): TAuraNode; override;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAuraNode; override;
|
||||
function VisitAssignment(const Node: IAssignmentNode): TAuraNode; override;
|
||||
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TAuraNode; override;
|
||||
function VisitQuasiquote(const Node: IQuasiquoteNode): TAuraNode; override;
|
||||
function VisitUnquote(const Node: IUnquoteNode): TAuraNode; override;
|
||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TAuraNode; override;
|
||||
function VisitIndexer(const Node: IIndexerNode): TAuraNode; override;
|
||||
function VisitMemberAccess(const Node: IMemberAccessNode): TAuraNode; override;
|
||||
function VisitRecordLiteral(const Node: IRecordLiteralNode): TAuraNode; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): TAuraNode; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAuraNode; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TAuraNode; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): TAuraNode; override;
|
||||
|
||||
public
|
||||
constructor Create(AWorkspace: TAuraWorkspace; AParentControl: TControl; AExprDepth: Integer);
|
||||
@@ -593,126 +594,126 @@ begin
|
||||
FParentControl := Value;
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
||||
function TAstVisualizer.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraAddSeriesItemNode.Create(Self, Node));
|
||||
Result := TAuraAddSeriesItemNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
||||
function TAstVisualizer.VisitAssignment(const Node: IAssignmentNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraAssignmentNode.Create(Self, Node));
|
||||
Result := TAuraAssignmentNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
// --- Visitor Implementations ---
|
||||
|
||||
function TAstVisualizer.VisitConstant(const Node: IConstantNode): TDataValue;
|
||||
function TAstVisualizer.VisitConstant(const Node: IConstantNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraConstantNode.Create(Self, Node));
|
||||
Result := TAuraConstantNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||
function TAstVisualizer.VisitIdentifier(const Node: IIdentifierNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraIdentifierNode.Create(Self, Node));
|
||||
Result := TAuraIdentifierNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitKeyword(const Node: IKeywordNode): TDataValue;
|
||||
function TAstVisualizer.VisitKeyword(const Node: IKeywordNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraKeywordNode.Create(Self, Node));
|
||||
Result := TAuraKeywordNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
||||
function TAstVisualizer.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraBinaryExpressionNode.Create(Self, Node));
|
||||
Result := TAuraBinaryExpressionNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
||||
function TAstVisualizer.VisitBlockExpression(const Node: IBlockExpressionNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraBlockExpressionNode.Create(Self, Node));
|
||||
Result := TAuraBlockExpressionNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
||||
function TAstVisualizer.VisitCreateSeries(const Node: ICreateSeriesNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraCreateSeriesNode.Create(Self, Node));
|
||||
Result := TAuraCreateSeriesNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||
function TAstVisualizer.VisitFunctionCall(const Node: IFunctionCallNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraFunctionCallNode.Create(Self, Node));
|
||||
Result := TAuraFunctionCallNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
||||
function TAstVisualizer.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraUnaryExpressionNode.Create(Self, Node));
|
||||
Result := TAuraUnaryExpressionNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
||||
function TAstVisualizer.VisitIfExpression(const Node: IIfExpressionNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraIfExpressionNode.Create(Self, Node));
|
||||
Result := TAuraIfExpressionNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
||||
function TAstVisualizer.VisitIndexer(const Node: IIndexerNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraIndexerNode.Create(Self, Node));
|
||||
Result := TAuraIndexerNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
||||
function TAstVisualizer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraLambdaExpressionNode.Create(Self, Node));
|
||||
Result := TAuraLambdaExpressionNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
|
||||
function TAstVisualizer.VisitMacroDefinition(const Node: IMacroDefinitionNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraMacroDefinitionNode.Create(Self, Node));
|
||||
Result := TAuraMacroDefinitionNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
|
||||
function TAstVisualizer.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraMacroExpansionNode.Create(Self, Node));
|
||||
Result := TAuraMacroExpansionNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
||||
function TAstVisualizer.VisitMemberAccess(const Node: IMemberAccessNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraMemberAccessNode.Create(Self, Node));
|
||||
Result := TAuraMemberAccessNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
|
||||
function TAstVisualizer.VisitRecordLiteral(const Node: IRecordLiteralNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraRecordLiteralNode.Create(Self, Node));
|
||||
Result := TAuraRecordLiteralNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue;
|
||||
function TAstVisualizer.VisitQuasiquote(const Node: IQuasiquoteNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraQuasiquoteNode.Create(Self, Node));
|
||||
Result := TAuraQuasiquoteNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitRecurNode(const Node: IRecurNode): TDataValue;
|
||||
function TAstVisualizer.VisitRecurNode(const Node: IRecurNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraRecurNode.Create(Self, Node));
|
||||
Result := TAuraRecurNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
||||
function TAstVisualizer.VisitSeriesLength(const Node: ISeriesLengthNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraSeriesLengthNode.Create(Self, Node));
|
||||
Result := TAuraSeriesLengthNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
||||
function TAstVisualizer.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraTernaryExpressionNode.Create(Self, Node));
|
||||
Result := TAuraTernaryExpressionNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitUnquote(const Node: IUnquoteNode): TDataValue;
|
||||
function TAstVisualizer.VisitUnquote(const Node: IUnquoteNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraUnquoteNode.Create(Self, Node));
|
||||
Result := TAuraUnquoteNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
|
||||
function TAstVisualizer.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraUnquoteSplicingNode.Create(Self, Node));
|
||||
Result := TAuraUnquoteSplicingNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
function TAstVisualizer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
||||
function TAstVisualizer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAuraNode;
|
||||
begin
|
||||
Result := TDataValue.FromGeneric<TAuraNode>(TAuraVariableDeclarationNode.Create(Self, Node));
|
||||
Result := TAuraVariableDeclarationNode.Create(Self, Node);
|
||||
end;
|
||||
|
||||
{ TAutoFitControl }
|
||||
@@ -1517,16 +1518,8 @@ begin
|
||||
end;
|
||||
|
||||
function TAuraLambdaExpressionNode.CreateAst: IAstNode;
|
||||
var
|
||||
params: TArray<IIdentifierNode>;
|
||||
i: Integer;
|
||||
begin
|
||||
// Re-use FNode.Parameters which is the source of truth
|
||||
SetLength(params, Length(FNode.Parameters));
|
||||
for i := 0 to High(FNode.Parameters) do
|
||||
params[i] := TAst.Identifier(FNode.Parameters[i].Name);
|
||||
|
||||
Result := TAst.LambdaExpr(params, FBodyNode.CreateAst);
|
||||
Result := TAst.LambdaExpr(FNode.Parameters, FBodyNode.CreateAst);
|
||||
end;
|
||||
|
||||
procedure TAuraLambdaExpressionNode.SetupNode;
|
||||
@@ -1966,7 +1959,7 @@ end;
|
||||
|
||||
function TAuraUnquoteSplicingNode.CreateAst: IAstNode;
|
||||
begin
|
||||
Result := TAst.UnquoteSplicing(FExpressionNode.CreateAst);
|
||||
Result := TAst.UnquoteSplicing(FExpressionNode.CreateAst.AsQuasiquote);
|
||||
end;
|
||||
|
||||
procedure TAuraUnquoteSplicingNode.SetupNode;
|
||||
|
||||
@@ -11,82 +11,89 @@ uses
|
||||
|
||||
type
|
||||
// This visitor converts an AST expression subtree into a single string.
|
||||
TAstToTextVisitor = class(TAstVisitor)
|
||||
public
|
||||
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 VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): 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 VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override;
|
||||
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
|
||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
|
||||
// It inherits from the generic visitor, returning a 'string' for each node.
|
||||
TAstToTextVisitor = class(TAstVisitor<string>)
|
||||
protected
|
||||
function VisitConstant(const Node: IConstantNode): string; override;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): string; override;
|
||||
function VisitKeyword(const Node: IKeywordNode): string; override;
|
||||
function VisitBinaryExpression(const Node: IBinaryExpressionNode): string; override;
|
||||
function VisitUnaryExpression(const Node: IUnaryExpressionNode): string; override;
|
||||
function VisitIfExpression(const Node: IIfExpressionNode): string; override;
|
||||
function VisitTernaryExpression(const Node: ITernaryExpressionNode): string; override;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): string; override;
|
||||
function VisitMacroDefinition(const Node: IMacroDefinitionNode): string; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): string; override;
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): string; override;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): string; override;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): string; override;
|
||||
function VisitAssignment(const Node: IAssignmentNode): string; override;
|
||||
function VisitIndexer(const Node: IIndexerNode): string; override;
|
||||
function VisitMemberAccess(const Node: IMemberAccessNode): string; override;
|
||||
function VisitQuasiquote(const Node: IQuasiquoteNode): string; override;
|
||||
function VisitUnquote(const Node: IUnquoteNode): string; override;
|
||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): string; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): string; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): string; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): string; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): string; override;
|
||||
function VisitRecordLiteral(const Node: IRecordLiteralNode): string; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Classes, // For TStringBuilder
|
||||
Myc.Data.Keyword;
|
||||
|
||||
{ TAstToTextVisitor }
|
||||
|
||||
function TAstToTextVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): string;
|
||||
var
|
||||
seriesStr, valueStr, lookbackStr: string;
|
||||
begin
|
||||
seriesStr := Node.Series.Accept(Self).AsText;
|
||||
valueStr := Node.Value.Accept(Self).AsText;
|
||||
seriesStr := Accept(Node.Series);
|
||||
valueStr := Accept(Node.Value);
|
||||
lookbackStr := '';
|
||||
if Assigned(Node.Lookback) then
|
||||
lookbackStr := ', ' + Node.Lookback.Accept(Self).AsText;
|
||||
lookbackStr := ', ' + Accept(Node.Lookback);
|
||||
Result := Format('%s.add(%s%s)', [seriesStr, valueStr, lookbackStr]);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitAssignment(const Node: IAssignmentNode): string;
|
||||
begin
|
||||
Result := Node.Identifier.Name + ' := ' + Node.Value.Accept(Self).AsText;
|
||||
Result := Node.Identifier.Name + ' := ' + Accept(Node.Value);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): string;
|
||||
begin
|
||||
var leftStr := Node.Left.Accept(Self).AsText;
|
||||
var rightStr := Node.Right.Accept(Self).AsText;
|
||||
var leftStr := Accept(Node.Left);
|
||||
var rightStr := Accept(Node.Right);
|
||||
Result := '(' + leftStr + ' ' + Node.Operator.ToString + ' ' + rightStr + ')';
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): string;
|
||||
begin
|
||||
Result := '{...}';
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitConstant(const Node: IConstantNode): string;
|
||||
begin
|
||||
Result := Node.Value.ToString;
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): string;
|
||||
begin
|
||||
Result := 'new series(' + Node.Definition + ')';
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitFunctionCall(const Node: IFunctionCallNode): string;
|
||||
var
|
||||
i: Integer;
|
||||
sb: TStringBuilder;
|
||||
calleeStr: string;
|
||||
begin
|
||||
calleeStr := Node.Callee.Accept(Self).AsText;
|
||||
calleeStr := Accept(Node.Callee);
|
||||
|
||||
sb := TStringBuilder.Create;
|
||||
try
|
||||
@@ -94,7 +101,7 @@ begin
|
||||
sb.Append('(');
|
||||
for i := 0 to High(Node.Arguments) do
|
||||
begin
|
||||
sb.Append(Node.Arguments[i].Accept(Self).AsText);
|
||||
sb.Append(Accept(Node.Arguments[i]));
|
||||
if i < High(Node.Arguments) then
|
||||
sb.Append(', ');
|
||||
end;
|
||||
@@ -105,7 +112,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode): string;
|
||||
begin
|
||||
// To represent a macro expansion as a single line of text, the most
|
||||
// informative representation is the original call itself. We can simply
|
||||
@@ -113,7 +120,7 @@ begin
|
||||
Result := VisitFunctionCall(Node);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitRecurNode(const Node: IRecurNode): string;
|
||||
var
|
||||
i: Integer;
|
||||
sb: TStringBuilder;
|
||||
@@ -123,7 +130,7 @@ begin
|
||||
sb.Append('recur(');
|
||||
for i := 0 to High(Node.Arguments) do
|
||||
begin
|
||||
sb.Append(Node.Arguments[i].Accept(Self).AsText);
|
||||
sb.Append(Accept(Node.Arguments[i]));
|
||||
if i < High(Node.Arguments) then
|
||||
sb.Append(', ');
|
||||
end;
|
||||
@@ -134,33 +141,38 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitIdentifier(const Node: IIdentifierNode): string;
|
||||
begin
|
||||
Result := Node.Name;
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitIfExpression(const Node: IIfExpressionNode): string;
|
||||
begin
|
||||
Result := Node.Condition.Accept(Self).AsText;
|
||||
Result := Accept(Node.Condition);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitIndexer(const Node: IIndexerNode): string;
|
||||
var
|
||||
baseStr, indexStr: string;
|
||||
begin
|
||||
baseStr := Node.Base.Accept(Self).AsText;
|
||||
indexStr := Node.Index.Accept(Self).AsText;
|
||||
baseStr := Accept(Node.Base);
|
||||
indexStr := Accept(Node.Index);
|
||||
Result := Format('%s[%s]', [baseStr, indexStr]);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitKeyword(const Node: IKeywordNode): string;
|
||||
begin
|
||||
Result := ':' + Node.Value.Name;
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): string;
|
||||
var
|
||||
i: Integer;
|
||||
sb: TStringBuilder;
|
||||
begin
|
||||
sb := TStringBuilder.Create;
|
||||
try
|
||||
sb.Append(#$03BB + '(');
|
||||
sb.Append(WideChar($03BB) + '('); // Lambda char
|
||||
if Length(Node.Parameters) > 0 then
|
||||
begin
|
||||
for i := 0 to High(Node.Parameters) do
|
||||
@@ -177,7 +189,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitMacroDefinition(const Node: IMacroDefinitionNode): string;
|
||||
var
|
||||
i: Integer;
|
||||
sb: TStringBuilder;
|
||||
@@ -204,56 +216,61 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitMemberAccess(const Node: IMemberAccessNode): string;
|
||||
var
|
||||
baseStr: string;
|
||||
begin
|
||||
baseStr := Node.Base.Accept(Self).AsText;
|
||||
baseStr := Accept(Node.Base);
|
||||
Result := Format('%s.%s', [baseStr, Node.Member.Value.Name]);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitQuasiquote(const Node: IQuasiquoteNode): string;
|
||||
begin
|
||||
Result := '`' + Node.Expression.Accept(Self).AsText;
|
||||
Result := '`' + Accept(Node.Expression);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): string;
|
||||
begin
|
||||
Result := '~' + Node.Expression.Accept(Self).AsText;
|
||||
Result := '{...}';
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitUnquote(const Node: IUnquoteNode): string;
|
||||
begin
|
||||
Result := '~@' + Node.Expression.Accept(Self).AsText;
|
||||
Result := '~' + Accept(Node.Expression);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): string;
|
||||
begin
|
||||
Result := '~@' + Accept(Node.Expression);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): string;
|
||||
var
|
||||
seriesStr: string;
|
||||
begin
|
||||
seriesStr := Node.Series.Accept(Self).AsText;
|
||||
seriesStr := Accept(Node.Series);
|
||||
Result := Format('length(%s)', [seriesStr]);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): string;
|
||||
begin
|
||||
var condStr := Node.Condition.Accept(Self).AsText;
|
||||
var thenStr := Node.ThenBranch.Accept(Self).AsText;
|
||||
var elseStr := Node.ElseBranch.Accept(Self).AsText;
|
||||
var condStr := Accept(Node.Condition);
|
||||
var thenStr := Accept(Node.ThenBranch);
|
||||
var elseStr := Accept(Node.ElseBranch);
|
||||
Result := Format('(%s ? %s : %s)', [condStr, thenStr, elseStr]);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): string;
|
||||
begin
|
||||
Result := Node.Operator.ToString + ' ' + Node.Right.Accept(Self).AsText;
|
||||
Result := Node.Operator.ToString + ' ' + Accept(Node.Right);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
||||
function TAstToTextVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): string;
|
||||
var
|
||||
initStr: string;
|
||||
begin
|
||||
if Assigned(Node.Initializer) then
|
||||
initStr := ' := ' + Node.Initializer.Accept(Self).AsText
|
||||
initStr := ' := ' + Accept(Node.Initializer)
|
||||
else
|
||||
initStr := '';
|
||||
Result := 'var ' + Node.Identifier.Name + initStr;
|
||||
|
||||
@@ -9,7 +9,8 @@ uses
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast.Visitor,
|
||||
Myc.Ast.Scope,
|
||||
Myc.Data.Value;
|
||||
Myc.Data.Value,
|
||||
Myc.Ast;
|
||||
|
||||
type
|
||||
// This visitor analyzes the AST to find all variables that need to be "lifted" or "boxed"
|
||||
@@ -17,23 +18,28 @@ type
|
||||
TUpvalueAnalyzer = class(TAstTransformer)
|
||||
private
|
||||
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
|
||||
FCurrentScope: IScopeDescriptor;
|
||||
FCurrentDescriptor: IScopeDescriptor;
|
||||
FDeclarationMap: TDictionary<IScopeDescriptor, TDictionary<string, IVariableDeclarationNode>>;
|
||||
procedure MarkDeclarationForBoxing(const AName: string);
|
||||
protected
|
||||
// Overridden Visit methods to perform analysis during traversal.
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override;
|
||||
public
|
||||
constructor Create(const AParent: IScopeDescriptor);
|
||||
destructor Destroy; override;
|
||||
|
||||
// Added Execute method
|
||||
function Execute(const ARootNode: IAstNode): IAstNode;
|
||||
|
||||
class function Analyze(const ARootNode: IAstNode; const AParent: IScopeDescriptor): THashSet<IVariableDeclarationNode>; static;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Generics.Defaults,
|
||||
Myc.Ast.Types;
|
||||
|
||||
{ TUpvalueAnalyzer }
|
||||
@@ -42,22 +48,28 @@ constructor TUpvalueAnalyzer.Create(const AParent: IScopeDescriptor);
|
||||
begin
|
||||
inherited Create;
|
||||
FBoxedDeclarations := THashSet<IVariableDeclarationNode>.Create;
|
||||
FDeclarationMap := TDictionary<IScopeDescriptor, TDictionary<string, IVariableDeclarationNode>>.Create;
|
||||
FCurrentScope := TScope.CreateDescriptor(AParent);
|
||||
FDeclarationMap :=
|
||||
TObjectDictionary<IScopeDescriptor, TDictionary<string, IVariableDeclarationNode>>
|
||||
.Create([doOwnsValues], TEqualityComparer<IScopeDescriptor>.Default);
|
||||
FCurrentDescriptor := TScope.CreateDescriptor(AParent);
|
||||
end;
|
||||
|
||||
destructor TUpvalueAnalyzer.Destroy;
|
||||
begin
|
||||
for var dict in FDeclarationMap.Values do
|
||||
dict.Free;
|
||||
FDeclarationMap.Free;
|
||||
FBoxedDeclarations.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TUpvalueAnalyzer.Execute(const ARootNode: IAstNode): IAstNode;
|
||||
begin
|
||||
// Accept will call the Visit... methods and traverse the tree
|
||||
Result := Accept(ARootNode);
|
||||
end;
|
||||
|
||||
class function TUpvalueAnalyzer.Analyze(const ARootNode: IAstNode; const AParent: IScopeDescriptor): THashSet<IVariableDeclarationNode>;
|
||||
var
|
||||
analyzer: TUpvalueAnalyzer;
|
||||
analyzer: TUpvalueAnalyzer; // Changed to concrete type
|
||||
begin
|
||||
if not Assigned(ARootNode) then
|
||||
exit(THashSet<IVariableDeclarationNode>.Create);
|
||||
@@ -78,12 +90,12 @@ var
|
||||
declarationScope: IScopeDescriptor;
|
||||
i: Integer;
|
||||
begin
|
||||
symbol := FCurrentScope.FindSymbol(AName);
|
||||
symbol := FCurrentDescriptor.FindSymbol(AName);
|
||||
if symbol.Address.Kind <> akLocalOrParent then
|
||||
exit;
|
||||
|
||||
// Walk up the scope chain to find the scope where the variable was declared.
|
||||
declarationScope := FCurrentScope;
|
||||
declarationScope := FCurrentDescriptor;
|
||||
for i := 1 to symbol.Address.ScopeDepth do
|
||||
begin
|
||||
if not Assigned(declarationScope.Parent) then
|
||||
@@ -101,13 +113,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUpvalueAnalyzer.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||
function TUpvalueAnalyzer.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
|
||||
var
|
||||
symbol: TResolvedSymbol;
|
||||
begin
|
||||
if Assigned(FCurrentScope) then
|
||||
if Assigned(FCurrentDescriptor) then
|
||||
begin
|
||||
symbol := FCurrentScope.FindSymbol(Node.Name);
|
||||
symbol := FCurrentDescriptor.FindSymbol(Node.Name);
|
||||
|
||||
if (symbol.Address.Kind = akLocalOrParent) and (symbol.Address.ScopeDepth > 0) then
|
||||
begin
|
||||
@@ -116,54 +128,62 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
// As a traverser, return the original node wrapped in a TDataValue.
|
||||
Result := TDataValue.FromIntf<IIdentifierNode>(Node);
|
||||
// This is a leaf node, do not call inherited.
|
||||
Result := Node;
|
||||
end;
|
||||
|
||||
function TUpvalueAnalyzer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
||||
function TUpvalueAnalyzer.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
|
||||
var
|
||||
N: TLambdaExpressionNode;
|
||||
begin
|
||||
N := (Node as TLambdaExpressionNode);
|
||||
|
||||
// A lambda creates a new lexical scope, inheriting from the current one.
|
||||
FCurrentScope := TScope.CreateDescriptor(FCurrentScope);
|
||||
FCurrentDescriptor := TScope.CreateDescriptor(FCurrentDescriptor);
|
||||
try
|
||||
// Define the lambda's parameters within its new scope.
|
||||
// We use TTypes.Unknown as type inference hasn't run yet.
|
||||
for var param in Node.Parameters do
|
||||
FCurrentScope.Define(param.Name, TTypes.Unknown);
|
||||
for var param in N.Parameters do
|
||||
FCurrentDescriptor.Define(Accept(param).AsIdentifier.Name, TTypes.Unknown);
|
||||
|
||||
// Traverse the lambda body within the new scope context.
|
||||
Node.Body.Accept(Self);
|
||||
N.Body := Accept(N.Body); // Manual traversal
|
||||
|
||||
// We do not transform, just analyze. Return the original node wrapped.
|
||||
Result := TDataValue.FromIntf<ILambdaExpressionNode>(Node);
|
||||
Result := N;
|
||||
finally
|
||||
// Restore the parent scope after leaving the lambda.
|
||||
FCurrentScope := FCurrentScope.Parent;
|
||||
FCurrentDescriptor := FCurrentDescriptor.Parent;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUpvalueAnalyzer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
||||
function TUpvalueAnalyzer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
|
||||
var
|
||||
scopeDeclarations: TDictionary<string, IVariableDeclarationNode>;
|
||||
N: TVariableDeclarationNode;
|
||||
begin
|
||||
N := (Node as TVariableDeclarationNode);
|
||||
|
||||
// Traverse the initializer first. It's evaluated in the current scope
|
||||
// before the new variable is defined.
|
||||
if Assigned(Node.Initializer) then
|
||||
Node.Initializer.Accept(Self);
|
||||
if Assigned(N.Initializer) then
|
||||
N.Initializer := Accept(N.Initializer);
|
||||
|
||||
// Traverse the identifier
|
||||
Accept(N.Identifier);
|
||||
|
||||
// After processing the initializer, define the variable in the current scope.
|
||||
// We use TTypes.Unknown as type inference hasn't run yet.
|
||||
FCurrentScope.Define(Node.Identifier.Name, TTypes.Unknown);
|
||||
FCurrentDescriptor.Define(N.Identifier.Name, TTypes.Unknown);
|
||||
|
||||
// Map this declaration node to its scope and name for later lookup.
|
||||
if not FDeclarationMap.TryGetValue(FCurrentScope, scopeDeclarations) then
|
||||
if not FDeclarationMap.TryGetValue(FCurrentDescriptor, scopeDeclarations) then
|
||||
begin
|
||||
scopeDeclarations := TDictionary<string, IVariableDeclarationNode>.Create;
|
||||
FDeclarationMap.Add(FCurrentScope, scopeDeclarations);
|
||||
FDeclarationMap.Add(FCurrentDescriptor, scopeDeclarations);
|
||||
end;
|
||||
scopeDeclarations.Add(Node.Identifier.Name, Node);
|
||||
scopeDeclarations.Add(N.Identifier.Name, N);
|
||||
|
||||
// As a traverser, return the original node wrapped in a TDataValue.
|
||||
Result := TDataValue.FromIntf<IVariableDeclarationNode>(Node);
|
||||
Result := N;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -1,144 +0,0 @@
|
||||
unit Myc.Ast.Binding.Nodes;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
System.Generics.Collections,
|
||||
Myc.Data.Scalar,
|
||||
Myc.Data.Value,
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast.Visitor,
|
||||
Myc.Ast.Scope,
|
||||
Myc.Ast.Types,
|
||||
Myc.Ast;
|
||||
|
||||
type
|
||||
TBoundIdentifierNode = class(TIdentifierNode)
|
||||
private
|
||||
FAddress: TResolvedAddress;
|
||||
public
|
||||
constructor Create(const AUnboundNode: IIdentifierNode; const AAddress: TResolvedAddress);
|
||||
property Address: TResolvedAddress read FAddress;
|
||||
end;
|
||||
|
||||
TBoundVariableDeclarationNode = class(TVariableDeclarationNode)
|
||||
private
|
||||
FIsBoxed: Boolean;
|
||||
public
|
||||
constructor Create(const AIdentifier: IIdentifierNode; AInitializer: IAstNode; AIsBoxed: Boolean);
|
||||
property IsBoxed: Boolean read FIsBoxed;
|
||||
end;
|
||||
|
||||
TBoundLambdaExpressionNode = class(TLambdaExpressionNode)
|
||||
private
|
||||
FScopeDescriptor: IScopeDescriptor;
|
||||
FUpvalues: TArray<TResolvedAddress>;
|
||||
FHasNestedLambdas: Boolean;
|
||||
public
|
||||
constructor Create(
|
||||
const AUnboundNode: ILambdaExpressionNode;
|
||||
const ABody: IAstNode;
|
||||
const AParameters: TArray<IIdentifierNode>;
|
||||
const AScopeDescriptor: IScopeDescriptor;
|
||||
const AUpvalues: TArray<TResolvedAddress>;
|
||||
AHasNestedLambdas: Boolean
|
||||
);
|
||||
property ScopeDescriptor: IScopeDescriptor read FScopeDescriptor;
|
||||
property Upvalues: TArray<TResolvedAddress> read FUpvalues;
|
||||
property HasNestedLambdas: Boolean read FHasNestedLambdas;
|
||||
end;
|
||||
|
||||
TBoundFunctionCallNode = class(TFunctionCallNode)
|
||||
private
|
||||
FIsTailCall: Boolean;
|
||||
public
|
||||
constructor Create(
|
||||
const AUnboundNode: IFunctionCallNode;
|
||||
const ACallee: IAstNode;
|
||||
const AArguments: TArray<IAstNode>;
|
||||
AIsTailCall: Boolean
|
||||
);
|
||||
property IsTailCall: Boolean read FIsTailCall;
|
||||
end;
|
||||
|
||||
TBoundRecordLiteralNode = class(TRecordLiteralNode)
|
||||
private
|
||||
FDefinition: IScalarRecordDefinition;
|
||||
public
|
||||
constructor Create(const AFields: TArray<TRecordFieldLiteral>; const ADef: IScalarRecordDefinition);
|
||||
property Definition: IScalarRecordDefinition read FDefinition write FDefinition;
|
||||
end;
|
||||
|
||||
// Represents a bound record literal that maps to a generic (non-scalar) record
|
||||
TBoundGenericRecordLiteralNode = class(TRecordLiteralNode)
|
||||
private
|
||||
FDefinition: IGenericRecordDefinition;
|
||||
public
|
||||
constructor Create(const AFields: TArray<TRecordFieldLiteral>; const ADef: IGenericRecordDefinition);
|
||||
property Definition: IGenericRecordDefinition read FDefinition write FDefinition;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Myc.Data.Keyword;
|
||||
|
||||
{ TBoundIdentifierNode }
|
||||
constructor TBoundIdentifierNode.Create(const AUnboundNode: IIdentifierNode; const AAddress: TResolvedAddress);
|
||||
begin
|
||||
inherited Create(AUnboundNode.Name);
|
||||
FAddress := AAddress;
|
||||
end;
|
||||
|
||||
{ TBoundVariableDeclarationNode }
|
||||
constructor TBoundVariableDeclarationNode.Create(const AIdentifier: IIdentifierNode; AInitializer: IAstNode; AIsBoxed: Boolean);
|
||||
begin
|
||||
inherited Create(AIdentifier, AInitializer);
|
||||
FIsBoxed := AIsBoxed;
|
||||
end;
|
||||
|
||||
{ TBoundLambdaExpressionNode }
|
||||
constructor TBoundLambdaExpressionNode.Create(
|
||||
const AUnboundNode: ILambdaExpressionNode;
|
||||
const ABody: IAstNode;
|
||||
const AParameters: TArray<IIdentifierNode>;
|
||||
const AScopeDescriptor: IScopeDescriptor;
|
||||
const AUpvalues: TArray<TResolvedAddress>;
|
||||
AHasNestedLambdas: Boolean
|
||||
);
|
||||
begin
|
||||
inherited Create(AParameters, ABody);
|
||||
FScopeDescriptor := AScopeDescriptor;
|
||||
FUpvalues := AUpvalues;
|
||||
FHasNestedLambdas := AHasNestedLambdas;
|
||||
end;
|
||||
|
||||
{ TBoundFunctionCallNode }
|
||||
constructor TBoundFunctionCallNode.Create(
|
||||
const AUnboundNode: IFunctionCallNode;
|
||||
const ACallee: IAstNode;
|
||||
const AArguments: TArray<IAstNode>;
|
||||
AIsTailCall: Boolean
|
||||
);
|
||||
begin
|
||||
inherited Create(ACallee, AArguments);
|
||||
FIsTailCall := AIsTailCall;
|
||||
end;
|
||||
|
||||
{ TBoundGenericRecordLiteralNode }
|
||||
constructor TBoundGenericRecordLiteralNode.Create(const AFields: TArray<TRecordFieldLiteral>; const ADef: IGenericRecordDefinition);
|
||||
begin
|
||||
inherited Create(AFields);
|
||||
FDefinition := ADef;
|
||||
end;
|
||||
|
||||
{ TBoundRecordLiteralNode }
|
||||
constructor TBoundRecordLiteralNode.Create(const AFields: TArray<TRecordFieldLiteral>; const ADef: IScalarRecordDefinition);
|
||||
begin
|
||||
inherited Create(AFields);
|
||||
FDefinition := ADef;
|
||||
end;
|
||||
|
||||
end.
|
||||
+137
-295
@@ -36,30 +36,24 @@ type
|
||||
procedure EnterScope;
|
||||
procedure ExitScope;
|
||||
function IsValidIdentifier(const Name: string): Boolean;
|
||||
function SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue; overload;
|
||||
|
||||
protected
|
||||
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
|
||||
function VisitKeyword(const Node: IKeywordNode): TDataValue; override;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
|
||||
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
|
||||
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
|
||||
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
|
||||
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
|
||||
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
|
||||
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
|
||||
function VisitConstant(const Node: IConstantNode): TDataValue; override;
|
||||
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
|
||||
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
|
||||
function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
|
||||
// --- Core Binding Logic (Mutators) ---
|
||||
function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
|
||||
// --- Transformation Logic ---
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
|
||||
|
||||
// --- Standard Traversal (Use inherited) ---
|
||||
function VisitKeyword(const Node: IKeywordNode): IAstNode; override;
|
||||
function VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode; override;
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): IAstNode; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): IAstNode; override;
|
||||
function VisitConstant(const Node: IConstantNode): IAstNode; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode; override;
|
||||
|
||||
public
|
||||
constructor Create(const AInitialScope: IExecutionScope);
|
||||
@@ -78,8 +72,7 @@ implementation
|
||||
uses
|
||||
System.Generics.Defaults,
|
||||
System.Character,
|
||||
Myc.Data.Keyword,
|
||||
Myc.Ast.Binding.Nodes;
|
||||
Myc.Data.Keyword;
|
||||
|
||||
type
|
||||
TResolvedAddressComparer = class(TEqualityComparer<TResolvedAddress>)
|
||||
@@ -111,7 +104,7 @@ begin
|
||||
|
||||
FInitialScope := AInitialScope;
|
||||
FCurrentDescriptor := AInitialScope.CreateDescriptor;
|
||||
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(True);
|
||||
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(True); // Use Comparer
|
||||
FNestedLambdaCount := 0;
|
||||
FBoxedDeclarations := nil;
|
||||
end;
|
||||
@@ -123,13 +116,6 @@ begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TAstBinder.SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue;
|
||||
begin
|
||||
if (not NodeData.IsVoid) and (NodeData.Kind = vkInterface) then
|
||||
(NodeData.AsIntf<IAstNode> as TAstNode).StaticType := AType;
|
||||
Result := NodeData;
|
||||
end;
|
||||
|
||||
class function TAstBinder.Bind(const InitialScope: IExecutionScope; const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
|
||||
begin
|
||||
var binder := TAstBinder.Create(InitialScope) as IAstBinder;
|
||||
@@ -165,40 +151,42 @@ end;
|
||||
|
||||
function TAstBinder.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
|
||||
begin
|
||||
// Pre-pass: Find all variables that need boxing
|
||||
FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode, FCurrentDescriptor.Parent);
|
||||
try
|
||||
EnterScope;
|
||||
try
|
||||
var transformedValue := Accept(RootNode);
|
||||
if transformedValue.IsVoid then
|
||||
Result := TAst.Block([])
|
||||
else
|
||||
Result := transformedValue.AsIntf<IAstNode>;
|
||||
// Main pass: Run the mutator
|
||||
Result := Accept(RootNode); // Accept returns IAstNode
|
||||
if not Assigned(Result) then
|
||||
Result := TAst.Block([]);
|
||||
|
||||
// Set the type of the root expression (e.g., the final 'do' block)
|
||||
(Result as TAstNode).StaticType := TTypes.Unknown;
|
||||
Descriptor := FCurrentDescriptor;
|
||||
finally
|
||||
ExitScope;
|
||||
end;
|
||||
finally
|
||||
FBoxedDeclarations.Free; // Free the set
|
||||
FBoxedDeclarations := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
|
||||
function TAstBinder.VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode;
|
||||
begin
|
||||
// Macros are compile-time only. The Binder (Phase 2) should not see them.
|
||||
raise Exception.Create('TMyAstBinder: MacroDefinition node encountered.');
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
|
||||
function TAstBinder.VisitMacroExpansionNode(const Node: IMacroExpansionNode): IAstNode;
|
||||
begin
|
||||
// The MacroExpander (Phase 1) should have unwrapped this.
|
||||
// We only visit the *expanded* body.
|
||||
Result := Accept(Node.ExpandedBody);
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||
var
|
||||
boundCall: TBoundFunctionCallNode;
|
||||
callee: IAstNode;
|
||||
args: TArray<IAstNode>;
|
||||
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
|
||||
begin
|
||||
// --- Transformation: Keyword-as-Function ---
|
||||
if (Node.Callee is TKeywordNode) then
|
||||
@@ -209,105 +197,44 @@ begin
|
||||
'Keyword :%s expects exactly one argument (the record/map), but got %d',
|
||||
[keywordNode.Value.Name, Length(Node.Arguments)]);
|
||||
|
||||
var baseNode := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
|
||||
// Manually visit the argument, as we are replacing this node
|
||||
var baseNode := Accept(Node.Arguments[0]);
|
||||
var memberAccessNode := TAst.MemberAccess(baseNode, keywordNode);
|
||||
|
||||
// Visit the *new* node to bind it
|
||||
Result := Accept(memberAccessNode);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// --- Default: Bind as a standard function call ---
|
||||
callee := Accept(Node.Callee).AsIntf<IAstNode>;
|
||||
args := AcceptNodes<IAstNode>(Node.Arguments);
|
||||
// Use the inherited implementation to visit children (Callee, Arguments)
|
||||
// and mutate their properties in place.
|
||||
Result := inherited VisitFunctionCall(Node);
|
||||
|
||||
// Create the node, always marking IsTailCall as false.
|
||||
// The Lowerer (Phase 4) will set this flag correctly.
|
||||
boundCall := TBoundFunctionCallNode.Create(Node, callee, args, False);
|
||||
|
||||
Result := SetType(TDataValue.FromIntf<IFunctionCallNode>(boundCall), TTypes.Unknown);
|
||||
// Set metadata for *this* node
|
||||
(Node as TFunctionCallNode).IsTailCall := False; // Default, TCO (Phase 5) will set this
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
||||
var
|
||||
boundIdentifier, boundValue: IAstNode;
|
||||
boundNode: IAssignmentNode;
|
||||
begin
|
||||
boundIdentifier := Accept(Node.Identifier).AsIntf<IAstNode>;
|
||||
boundValue := Accept(Node.Value).AsIntf<IAstNode>;
|
||||
boundNode := TAst.Assign(boundIdentifier as TBoundIdentifierNode, boundValue);
|
||||
Result := SetType(TDataValue.FromIntf<IAssignmentNode>(boundNode), TTypes.Unknown);
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
||||
var
|
||||
left, right: IAstNode;
|
||||
boundNode: IBinaryExpressionNode;
|
||||
begin
|
||||
left := Accept(Node.Left).AsIntf<IAstNode>;
|
||||
right := Accept(Node.Right).AsIntf<IAstNode>;
|
||||
boundNode := TAst.BinaryExpr(left, Node.Operator, right);
|
||||
Result := SetType(TDataValue.FromIntf<IBinaryExpressionNode>(boundNode), TTypes.Unknown);
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
||||
var
|
||||
exprs: TArray<IAstNode>;
|
||||
i: Integer;
|
||||
transformedValue: TDataValue;
|
||||
exprList: TList<IAstNode>;
|
||||
boundNode: IBlockExpressionNode;
|
||||
begin
|
||||
exprList := TList<IAstNode>.Create;
|
||||
try
|
||||
for i := 0 to High(Node.Expressions) do
|
||||
begin
|
||||
transformedValue := Accept(Node.Expressions[i]);
|
||||
if not transformedValue.IsVoid then
|
||||
exprList.Add(transformedValue.AsIntf<IAstNode>);
|
||||
end;
|
||||
exprs := exprList.ToArray;
|
||||
finally
|
||||
exprList.Free;
|
||||
end;
|
||||
|
||||
if (Length(exprs) = Length(Node.Expressions)) then
|
||||
begin
|
||||
var same := True;
|
||||
for i := 0 to High(exprs) do
|
||||
if exprs[i] <> Node.Expressions[i] then
|
||||
begin
|
||||
same := False;
|
||||
break;
|
||||
end;
|
||||
if same then
|
||||
boundNode := Node
|
||||
else
|
||||
boundNode := TAst.Block(exprs);
|
||||
end
|
||||
else
|
||||
boundNode := TAst.Block(exprs);
|
||||
|
||||
Result := SetType(TDataValue.FromIntf<IBlockExpressionNode>(boundNode), TTypes.Unknown);
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitConstant(const Node: IConstantNode): TDataValue;
|
||||
function TAstBinder.VisitConstant(const Node: IConstantNode): IAstNode;
|
||||
begin
|
||||
// Set type (Phase 3)
|
||||
case Node.Value.Kind of
|
||||
TDataValueKind.vkScalar:
|
||||
Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.FromScalarKind(Node.Value.AsScalar.Kind));
|
||||
TDataValueKind.vkText: Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Text);
|
||||
TDataValueKind.vkVoid: Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Void);
|
||||
TDataValueKind.vkScalar: (Node as TAstNode).StaticType := TTypes.FromScalarKind(Node.Value.AsScalar.Kind);
|
||||
TDataValueKind.vkText: (Node as TAstNode).StaticType := TTypes.Text;
|
||||
TDataValueKind.vkVoid: (Node as TAstNode).StaticType := TTypes.Void;
|
||||
else
|
||||
Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Unknown);
|
||||
(Node as TAstNode).StaticType := TTypes.Unknown;
|
||||
end;
|
||||
Result := Node;
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitKeyword(const Node: IKeywordNode): TDataValue;
|
||||
function TAstBinder.VisitKeyword(const Node: IKeywordNode): IAstNode;
|
||||
begin
|
||||
Result := SetType(TDataValue.FromIntf<IKeywordNode>(Node), TTypes.Keyword);
|
||||
(Node as TAstNode).StaticType := TTypes.Keyword;
|
||||
Result := Node;
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
||||
function TAstBinder.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode;
|
||||
var
|
||||
elemType: IStaticType;
|
||||
begin
|
||||
@@ -317,197 +244,100 @@ begin
|
||||
on E: Exception do
|
||||
elemType := TTypes.Unknown;
|
||||
end;
|
||||
Result := SetType(TDataValue.FromIntf<ICreateSeriesNode>(Node), TTypes.CreateSeries(elemType));
|
||||
(Node as TAstNode).StaticType := TTypes.CreateSeries(elemType);
|
||||
Result := Node;
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
||||
var
|
||||
seriesNode, valueNode, lookbackNode: IAstNode;
|
||||
function TAstBinder.VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode;
|
||||
begin
|
||||
seriesNode := Accept(Node.Series).AsIntf<IAstNode>;
|
||||
valueNode := Accept(Node.Value).AsIntf<IAstNode>;
|
||||
if Node.Lookback <> nil then
|
||||
lookbackNode := Accept(Node.Lookback).AsIntf<IAstNode>
|
||||
else
|
||||
lookbackNode := nil;
|
||||
|
||||
var boundNode := TAst.AddSeriesItem(seriesNode as TIdentifierNode, valueNode, lookbackNode);
|
||||
Result := SetType(TDataValue.FromIntf<IAddSeriesItemNode>(boundNode), TTypes.Void);
|
||||
// Visit children
|
||||
Result := inherited VisitAddSeriesItem(Node);
|
||||
(Node as TAstNode).StaticType := TTypes.Void;
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
||||
function TAstBinder.VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode;
|
||||
begin
|
||||
Accept(Node.Series);
|
||||
Result := SetType(TDataValue.FromIntf<ISeriesLengthNode>(Node), TTypes.Ordinal);
|
||||
// Visit children
|
||||
Result := inherited VisitSeriesLength(Node);
|
||||
(Node as TAstNode).StaticType := TTypes.Ordinal;
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
||||
var
|
||||
condition, thenBranch, elseBranch: IAstNode;
|
||||
boundNode: IIfExpressionNode;
|
||||
begin
|
||||
condition := Accept(Node.Condition).AsIntf<IAstNode>;
|
||||
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
|
||||
if Assigned(Node.ElseBranch) then
|
||||
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>
|
||||
else
|
||||
elseBranch := nil;
|
||||
|
||||
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
|
||||
boundNode := TAst.IfExpr(condition, thenBranch, elseBranch)
|
||||
else
|
||||
boundNode := Node;
|
||||
|
||||
Result := SetType(TDataValue.FromIntf<IIfExpressionNode>(boundNode), TTypes.Unknown);
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
||||
var
|
||||
baseNode, indexNode: IAstNode;
|
||||
boundNode: IIndexerNode;
|
||||
begin
|
||||
baseNode := Accept(Node.Base).AsIntf<IAstNode>;
|
||||
indexNode := Accept(Node.Index).AsIntf<IAstNode>;
|
||||
boundNode := TAst.Indexer(baseNode, indexNode);
|
||||
Result := SetType(TDataValue.FromIntf<IIndexerNode>(boundNode), TTypes.Unknown);
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
||||
var
|
||||
baseNode: IAstNode;
|
||||
boundNode: IMemberAccessNode;
|
||||
begin
|
||||
baseNode := Accept(Node.Base).AsIntf<IAstNode>;
|
||||
boundNode := TAst.MemberAccess(baseNode, Node.Member);
|
||||
Result := SetType(TDataValue.FromIntf<IMemberAccessNode>(boundNode), TTypes.Unknown);
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
|
||||
var
|
||||
i: Integer;
|
||||
boundFields: TArray<TRecordFieldLiteral>;
|
||||
valNode: IAstNode;
|
||||
valType: IStaticType;
|
||||
allScalar: Boolean;
|
||||
begin
|
||||
SetLength(boundFields, Length(Node.Fields));
|
||||
allScalar := True;
|
||||
|
||||
for i := 0 to High(Node.Fields) do
|
||||
begin
|
||||
valNode := Accept(Node.Fields[i].Value).AsIntf<IAstNode>;
|
||||
valType := (valNode as TAstNode).StaticType;
|
||||
|
||||
if not (valType.Kind in [stOrdinal, stFloat, stKeyword, stUnknown]) then
|
||||
allScalar := False;
|
||||
|
||||
boundFields[i] := TRecordFieldLiteral.Create(Node.Fields[i].Key, valNode);
|
||||
end;
|
||||
|
||||
if allScalar then
|
||||
begin
|
||||
var boundNode := TBoundRecordLiteralNode.Create(boundFields, nil);
|
||||
Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(boundNode), TTypes.Unknown);
|
||||
end
|
||||
else
|
||||
begin
|
||||
var genBoundNode := TBoundGenericRecordLiteralNode.Create(boundFields, nil);
|
||||
Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(genBoundNode), TTypes.Unknown);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
||||
function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
|
||||
var
|
||||
i: integer;
|
||||
boundParams: TArray<IIdentifierNode>;
|
||||
boundBody: IAstNode;
|
||||
lambdaScope: IScopeDescriptor;
|
||||
upvalues: TArray<TResolvedAddress>;
|
||||
hasNestedLambdas: Boolean;
|
||||
lastNestedLambdaCount: Integer;
|
||||
boundLambda: ILambdaExpressionNode;
|
||||
N: TLambdaExpressionNode;
|
||||
adr: TResolvedAddress;
|
||||
begin
|
||||
N := (Node as TLambdaExpressionNode);
|
||||
|
||||
// We do *not* call inherited, as we must manage the scope manually.
|
||||
|
||||
FUpvalueStack.Push(TUpvalueMapping.Create(TResolvedAddressComparer.Create));
|
||||
try
|
||||
EnterScope;
|
||||
try
|
||||
// Define <self> (slot 0)
|
||||
FCurrentDescriptor.Define('<self>', TTypes.Unknown);
|
||||
|
||||
SetLength(boundParams, Length(Node.Parameters));
|
||||
for i := 0 to High(Node.Parameters) do
|
||||
// Define parameters
|
||||
for i := 0 to High(N.Parameters) do
|
||||
begin
|
||||
var paramNode := Node.Parameters[i];
|
||||
var paramNode := N.Parameters[i];
|
||||
var slotIndex := FCurrentDescriptor.Define(paramNode.Name, TTypes.Unknown);
|
||||
var address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
|
||||
boundParams[i] := TBoundIdentifierNode.Create(paramNode, address);
|
||||
(boundParams[i] as TAstNode).StaticType := TTypes.Unknown;
|
||||
adr := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
|
||||
|
||||
// Mutate the parameter node with its address
|
||||
(paramNode as TIdentifierNode).Address := adr;
|
||||
(paramNode as TAstNode).StaticType := TTypes.Unknown;
|
||||
end;
|
||||
|
||||
lastNestedLambdaCount := FNestedLambdaCount;
|
||||
boundBody := Accept(Node.Body).AsIntf<IAstNode>;
|
||||
hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
|
||||
lambdaScope := FCurrentDescriptor;
|
||||
// Visit the body *within the new scope*
|
||||
var lastNestedLambdaCount := FNestedLambdaCount;
|
||||
N.Body := Accept(N.Body);
|
||||
N.HasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
|
||||
|
||||
// Save the descriptor for the evaluator
|
||||
N.ScopeDescriptor := FCurrentDescriptor;
|
||||
finally
|
||||
ExitScope;
|
||||
end;
|
||||
|
||||
// --- Extract Upvalues ---
|
||||
var upvalueMapping := FUpvalueStack.Peek;
|
||||
var sortedPairs := upvalueMapping.ToArray;
|
||||
// Sort by index (Value)
|
||||
TArray.Sort<TPair<TResolvedAddress, Integer>>(
|
||||
sortedPairs,
|
||||
TComparer<TPair<TResolvedAddress, Integer>>.Construct(
|
||||
function(const Left, Right: TPair<TResolvedAddress, Integer>): Integer begin Result := Left.Value - Right.Value; end
|
||||
)
|
||||
);
|
||||
SetLength(upvalues, Length(sortedPairs));
|
||||
for i := 0 to High(sortedPairs) do
|
||||
upvalues[i] := sortedPairs[i].Key;
|
||||
|
||||
var uvArr: TArray<TResolvedAddress>;
|
||||
SetLength(uvArr, Length(sortedPairs));
|
||||
for i := 0 to High(uvArr) do
|
||||
uvArr[i] := sortedPairs[i].Key;
|
||||
N.Upvalues := uvArr;
|
||||
|
||||
finally
|
||||
FUpvalueStack.Pop;
|
||||
end;
|
||||
|
||||
inc(FNestedLambdaCount);
|
||||
boundLambda := TBoundLambdaExpressionNode.Create(Node, boundBody, boundParams, lambdaScope, upvalues, hasNestedLambdas);
|
||||
Result := SetType(TDataValue.FromIntf<ILambdaExpressionNode>(boundLambda), TTypes.Unknown);
|
||||
// Type will be set by TypeChecker
|
||||
Result := Node;
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitRecurNode(const Node: IRecurNode): TDataValue;
|
||||
function TAstBinder.VisitRecurNode(const Node: IRecurNode): IAstNode;
|
||||
begin
|
||||
var boundNode := TAst.Recur(AcceptNodes<IAstNode>(Node.Arguments));
|
||||
Result := SetType(TDataValue.FromIntf<IRecurNode>(boundNode), TTypes.Void);
|
||||
// Visit children
|
||||
Result := inherited VisitRecurNode(Node);
|
||||
(Node as TAstNode).StaticType := TTypes.Void; // Recur never returns a value
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
||||
var
|
||||
condition, thenBranch, elseBranch: IAstNode;
|
||||
boundNode: ITernaryExpressionNode;
|
||||
begin
|
||||
condition := Accept(Node.Condition).AsIntf<IAstNode>;
|
||||
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
|
||||
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
|
||||
|
||||
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
|
||||
boundNode := TAst.TernaryExpr(condition, thenBranch, elseBranch)
|
||||
else
|
||||
boundNode := Node;
|
||||
|
||||
Result := SetType(TDataValue.FromIntf<ITernaryExpressionNode>(boundNode), TTypes.Unknown);
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
||||
var
|
||||
right: IAstNode;
|
||||
boundNode: IUnaryExpressionNode;
|
||||
begin
|
||||
right := Accept(Node.Right).AsIntf<IAstNode>;
|
||||
boundNode := TAst.UnaryExpr(Node.Operator, right);
|
||||
Result := SetType(TDataValue.FromIntf<IUnaryExpressionNode>(boundNode), TTypes.Unknown);
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||
function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
|
||||
var
|
||||
symbol: TResolvedSymbol;
|
||||
boundNode: IIdentifierNode;
|
||||
adr: TResolvedAddress;
|
||||
begin
|
||||
symbol := FCurrentDescriptor.FindSymbol(Node.Name);
|
||||
@@ -517,52 +347,64 @@ begin
|
||||
begin
|
||||
if (adr.ScopeDepth > 0) and (FUpvalueStack.Count > 0) then
|
||||
begin
|
||||
// Handle Upvalue
|
||||
var upvalue := FUpvalueStack.Peek;
|
||||
// --- Handle Upvalue ---
|
||||
var upvalueMap := FUpvalueStack.Peek;
|
||||
// Adjust address to be relative to the captured scope
|
||||
dec(adr.ScopeDepth);
|
||||
|
||||
var upvalueIndex: Integer;
|
||||
if not upvalue.TryGetValue(adr, upvalueIndex) then
|
||||
if not upvalueMap.TryGetValue(adr, upvalueIndex) then
|
||||
begin
|
||||
upvalueIndex := upvalue.Count;
|
||||
upvalue.Add(adr, upvalueIndex);
|
||||
// This is a new upvalue for this lambda
|
||||
upvalueIndex := upvalueMap.Count;
|
||||
upvalueMap.Add(adr, upvalueIndex);
|
||||
end;
|
||||
boundNode := TBoundIdentifierNode.Create(Node, TResolvedAddress.Create(akUpvalue, 0, upvalueIndex));
|
||||
|
||||
// Mutate the node to point to the Upvalue slot
|
||||
(Node as TIdentifierNode).Address := TResolvedAddress.Create(akUpvalue, 0, upvalueIndex);
|
||||
end
|
||||
else
|
||||
// Handle LocalOrParent
|
||||
boundNode := TBoundIdentifierNode.Create(Node, adr);
|
||||
begin
|
||||
// --- Handle LocalOrParent ---
|
||||
// Mutate the node to point to the Local/Parent slot
|
||||
(Node as TIdentifierNode).Address := adr;
|
||||
end;
|
||||
|
||||
Result := SetType(TDataValue.FromIntf<IIdentifierNode>(boundNode), symbol.StaticType);
|
||||
(Node as TAstNode).StaticType := symbol.StaticType; // Set type from scope
|
||||
end
|
||||
else
|
||||
raise Exception.CreateFmt('Undefined identifier: "%s"', [Node.Name]);
|
||||
|
||||
Result := Node;
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
||||
function TAstBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
|
||||
var
|
||||
initializer: IAstNode;
|
||||
slotIndex: Integer;
|
||||
address: TResolvedAddress;
|
||||
boundIdentifier: IIdentifierNode;
|
||||
isBoxed: Boolean;
|
||||
boundDecl: IVariableDeclarationNode;
|
||||
N: TVariableDeclarationNode;
|
||||
begin
|
||||
if not IsValidIdentifier(Node.Identifier.Name) then
|
||||
raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]);
|
||||
N := (Node as TVariableDeclarationNode);
|
||||
|
||||
initializer := nil;
|
||||
if Node.Initializer <> nil then
|
||||
initializer := Accept(Node.Initializer).AsIntf<IAstNode>;
|
||||
if not IsValidIdentifier(N.Identifier.Name) then
|
||||
raise Exception.CreateFmt('Invalid identifier name: "%s".', [N.Identifier.Name]);
|
||||
|
||||
slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name, TTypes.Unknown);
|
||||
// 1. Visit initializer *first*
|
||||
if Assigned(N.Initializer) then
|
||||
N.Initializer := Accept(N.Initializer);
|
||||
|
||||
// 2. Define variable in *current* scope
|
||||
slotIndex := FCurrentDescriptor.Define(N.Identifier.Name, TTypes.Unknown);
|
||||
address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
|
||||
boundIdentifier := TBoundIdentifierNode.Create(Node.Identifier, address);
|
||||
(boundIdentifier as TAstNode).StaticType := TTypes.Unknown;
|
||||
|
||||
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
|
||||
boundDecl := TBoundVariableDeclarationNode.Create(boundIdentifier, initializer, isBoxed);
|
||||
// 3. Mutate the Identifier node (which is NOT visited by inherited call)
|
||||
(N.Identifier as TIdentifierNode).Address := address;
|
||||
(N.Identifier as TAstNode).StaticType := TTypes.Unknown; // TypeChecker will set this
|
||||
|
||||
Result := SetType(TDataValue.FromIntf<IVariableDeclarationNode>(boundDecl), TTypes.Unknown);
|
||||
// 4. Mutate this declaration node
|
||||
N.IsBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
|
||||
|
||||
Result := Node;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -11,8 +11,7 @@ uses
|
||||
Myc.Ast.Visitor,
|
||||
Myc.Ast.Scope,
|
||||
Myc.Ast.Types,
|
||||
Myc.Ast,
|
||||
Myc.Ast.Binding.Nodes;
|
||||
Myc.Ast;
|
||||
|
||||
type
|
||||
IAstTCO = interface(IAstVisitor)
|
||||
@@ -21,22 +20,27 @@ type
|
||||
|
||||
// This transformer runs *after* the Lowerer (Phase 4).
|
||||
// Its sole responsibility is to identify tail calls (TCO)
|
||||
// and set the `IsTailCall` flag on TBoundFunctionCallNode.
|
||||
// and set the `IsTailCall` flag on TFunctionCallNode.
|
||||
TAstTCO = class(TAstTransformer, IAstTCO)
|
||||
private
|
||||
FIsTailStack: TStack<Boolean>;
|
||||
FNextIsTail: Boolean;
|
||||
protected
|
||||
function Accept(const Node: IAstNode): TDataValue; override;
|
||||
function Accept(const Node: IAstNode): IAstNode; override;
|
||||
// Overrides for TCO propagation
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
|
||||
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
|
||||
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
|
||||
function VisitIfExpression(const Node: IIfExpressionNode): IAstNode; override;
|
||||
function VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode; override;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): IAstNode; override;
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): IAstNode; override;
|
||||
|
||||
// Operands are never in tail position.
|
||||
function VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode; override;
|
||||
function VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode; override;
|
||||
|
||||
// The core TCO logic
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
@@ -70,140 +74,169 @@ end;
|
||||
|
||||
function TAstTCO.Execute(const RootNode: IAstNode): IAstNode;
|
||||
begin
|
||||
var transformedValue := Accept(RootNode);
|
||||
if transformedValue.IsVoid then
|
||||
Result := TAst.Block([])
|
||||
else
|
||||
Result := transformedValue.AsIntf<IAstNode>;
|
||||
Result := Accept(RootNode); // Use IAstNode-returning Accept
|
||||
if not Assigned(Result) then
|
||||
Result := TAst.Block([]);
|
||||
end;
|
||||
|
||||
function TAstTCO.Accept(const Node: IAstNode): TDataValue;
|
||||
function TAstTCO.Accept(const Node: IAstNode): IAstNode;
|
||||
begin
|
||||
if (not Assigned(Node)) or Done then
|
||||
if (not Assigned(Node)) then
|
||||
begin
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
FIsTailStack.Push(FNextIsTail);
|
||||
try
|
||||
// Call inherited Accept, which handles the data unwrapping
|
||||
Result := inherited Accept(Node);
|
||||
finally
|
||||
FNextIsTail := FIsTailStack.Pop;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
||||
function TAstTCO.VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode;
|
||||
begin
|
||||
// Operands are never in tail position.
|
||||
FNextIsTail := False;
|
||||
|
||||
// Call inherited, which will visit Left and Right with FNextIsTail = False
|
||||
Result := inherited VisitBinaryExpression(Node);
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode;
|
||||
begin
|
||||
// Operand is never in tail position.
|
||||
FNextIsTail := False;
|
||||
|
||||
// Call inherited, which will visit Right with FNextIsTail = False
|
||||
Result := inherited VisitUnaryExpression(Node);
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
|
||||
var
|
||||
i: Integer;
|
||||
isContextTail: Boolean;
|
||||
N: TBlockExpressionNode;
|
||||
begin
|
||||
N := (Node as TBlockExpressionNode);
|
||||
isContextTail := FIsTailStack.Peek;
|
||||
for i := 0 to High(Node.Expressions) do
|
||||
|
||||
// We must manually iterate here to set FNextIsTail for each child
|
||||
for i := 0 to High(N.Expressions) do
|
||||
begin
|
||||
// Only the last expression in a block is in tail position
|
||||
FNextIsTail := isContextTail and (i = High(Node.Expressions));
|
||||
Accept(Node.Expressions[i]);
|
||||
FNextIsTail := isContextTail and (i = High(N.Expressions));
|
||||
N.Expressions[i] := Accept(N.Expressions[i]);
|
||||
end;
|
||||
Result := TDataValue.FromIntf<IBlockExpressionNode>(Node);
|
||||
Result := N;
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
||||
function TAstTCO.VisitIfExpression(const Node: IIfExpressionNode): IAstNode;
|
||||
var
|
||||
isContextTail: Boolean;
|
||||
N: TIfExpressionNode;
|
||||
begin
|
||||
N := (Node as TIfExpressionNode);
|
||||
isContextTail := FIsTailStack.Peek;
|
||||
|
||||
// Condition is never in tail position
|
||||
FNextIsTail := False;
|
||||
Accept(Node.Condition);
|
||||
N.Condition := Accept(N.Condition);
|
||||
|
||||
// Then/Else branches ARE in tail position if the IfExpr is
|
||||
FNextIsTail := isContextTail;
|
||||
Accept(Node.ThenBranch);
|
||||
if Assigned(Node.ElseBranch) then
|
||||
Accept(Node.ElseBranch);
|
||||
N.ThenBranch := Accept(N.ThenBranch);
|
||||
N.ElseBranch := Accept(N.ElseBranch);
|
||||
|
||||
Result := TDataValue.FromIntf<IIfExpressionNode>(Node);
|
||||
Result := N;
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
||||
function TAstTCO.VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode;
|
||||
var
|
||||
isContextTail: Boolean;
|
||||
N: TTernaryExpressionNode;
|
||||
begin
|
||||
N := (Node as TTernaryExpressionNode);
|
||||
isContextTail := FIsTailStack.Peek;
|
||||
|
||||
// Condition is never in tail position
|
||||
FNextIsTail := False;
|
||||
Accept(Node.Condition);
|
||||
N.Condition := Accept(N.Condition);
|
||||
|
||||
// Then/Else branches ARE in tail position if the TernaryExpr is
|
||||
FNextIsTail := isContextTail;
|
||||
Accept(Node.ThenBranch);
|
||||
Accept(Node.ElseBranch);
|
||||
N.ThenBranch := Accept(N.ThenBranch);
|
||||
N.ElseBranch := Accept(N.ElseBranch);
|
||||
|
||||
Result := TDataValue.FromIntf<ITernaryExpressionNode>(Node);
|
||||
Result := N;
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
||||
function TAstTCO.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
|
||||
var
|
||||
N: TLambdaExpressionNode;
|
||||
begin
|
||||
// Parameters are never in tail position
|
||||
FNextIsTail := False;
|
||||
AcceptNodes<IIdentifierNode>(Node.Parameters);
|
||||
N := (Node as TLambdaExpressionNode);
|
||||
|
||||
// The body of a lambda is *always* a tail position (relative to the lambda)
|
||||
FNextIsTail := True;
|
||||
Accept(Node.Body);
|
||||
N.Body := Accept(N.Body);
|
||||
|
||||
Result := TDataValue.FromIntf<ILambdaExpressionNode>(Node);
|
||||
Result := N;
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitRecurNode(const Node: IRecurNode): TDataValue;
|
||||
function TAstTCO.VisitRecurNode(const Node: IRecurNode): IAstNode;
|
||||
var
|
||||
N: TRecurNode;
|
||||
begin
|
||||
if not FIsTailStack.Peek then
|
||||
raise Exception.Create('''recur'' can only be used in a tail position.');
|
||||
|
||||
N := (Node as TRecurNode);
|
||||
|
||||
// Arguments are not in tail position
|
||||
FNextIsTail := False;
|
||||
AcceptNodes<IAstNode>(Node.Arguments);
|
||||
N.Arguments := AcceptNodes<IAstNode>(N.Arguments, function(Node: IAstNode): IAstNode begin exit(Node) end);
|
||||
|
||||
Result := TDataValue.FromIntf<IRecurNode>(Node);
|
||||
Result := N;
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
|
||||
function TAstTCO.VisitMacroExpansionNode(const Node: IMacroExpansionNode): IAstNode;
|
||||
var
|
||||
N: TMacroExpansionNode;
|
||||
begin
|
||||
N := (Node as TMacroExpansionNode);
|
||||
|
||||
// Propagate tail call status to the expanded body
|
||||
FNextIsTail := FIsTailStack.Peek;
|
||||
Accept(Node.ExpandedBody);
|
||||
N.ExpandedBody := Accept(N.ExpandedBody);
|
||||
|
||||
// Also visit the original call nodes, though they are not in tail pos
|
||||
FNextIsTail := False;
|
||||
Accept(Node.Callee);
|
||||
AcceptNodes<IAstNode>(Node.Arguments);
|
||||
N.Callee := Accept(N.Callee);
|
||||
N.Arguments := AcceptNodes<IAstNode>(N.Arguments, function(Node: IAstNode): IAstNode begin exit(Node) end);
|
||||
|
||||
Result := TDataValue.FromIntf<IMacroExpansionNode>(Node);
|
||||
Result := N;
|
||||
end;
|
||||
|
||||
function TAstTCO.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||
function TAstTCO.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
|
||||
var
|
||||
callee: IAstNode;
|
||||
args: TArray<IAstNode>;
|
||||
isTailCall: Boolean;
|
||||
N: TFunctionCallNode;
|
||||
begin
|
||||
isTailCall := FIsTailStack.Peek;
|
||||
N := (Node as TFunctionCallNode);
|
||||
|
||||
// Arguments are not in tail position
|
||||
FNextIsTail := False;
|
||||
callee := Accept(Node.Callee).AsIntf<IAstNode>;
|
||||
args := AcceptNodes<IAstNode>(Node.Arguments);
|
||||
N.Callee := Accept(N.Callee);
|
||||
N.Arguments := AcceptNodes<IAstNode>(N.Arguments, function(Node: IAstNode): IAstNode begin exit(Node) end);
|
||||
|
||||
// If TCO status changed, we MUST rebuild the node.
|
||||
var boundNode := (Node as TBoundFunctionCallNode);
|
||||
if (boundNode.IsTailCall <> isTailCall) or (callee <> Node.Callee) or (args <> Node.Arguments) then
|
||||
begin
|
||||
var newBoundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
|
||||
(newBoundCall as TAstNode).StaticType := (Node as TAstNode).StaticType;
|
||||
Result := TDataValue.FromIntf<IFunctionCallNode>(newBoundCall);
|
||||
end
|
||||
else
|
||||
Result := TDataValue.FromIntf<IFunctionCallNode>(Node); // No change
|
||||
// Mutate the node with the TCO status
|
||||
N.IsTailCall := isTailCall;
|
||||
|
||||
Result := N;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
+81
-102
@@ -9,7 +9,8 @@ uses
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast.Visitor,
|
||||
Myc.Data.Value,
|
||||
Myc.Data.Scalar;
|
||||
Myc.Data.Scalar,
|
||||
Myc.Ast;
|
||||
|
||||
type
|
||||
// Dumps a bound AST into a human-readable format for debugging purposes.
|
||||
@@ -18,7 +19,8 @@ type
|
||||
procedure Execute(const RootNode: IAstNode);
|
||||
end;
|
||||
|
||||
TAstDumper = class(TAstVisitor)
|
||||
// Inherits from the new non-generic TAstVisitor base class
|
||||
TAstDumper = class(TAstVisitor, IAstDumper)
|
||||
private
|
||||
FOutput: TStrings;
|
||||
FIndent: Integer;
|
||||
@@ -29,30 +31,31 @@ type
|
||||
function FormatAddress(const Addr: TResolvedAddress): string;
|
||||
|
||||
protected
|
||||
function VisitConstant(const Node: IConstantNode): TDataValue; override;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
|
||||
function VisitKeyword(const Node: IKeywordNode): 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 VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
|
||||
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
|
||||
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
|
||||
function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override;
|
||||
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
|
||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
|
||||
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
|
||||
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
|
||||
function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
|
||||
// Override abstract procedures from TAstVisitor
|
||||
procedure VisitConstant(const Node: IConstantNode); override;
|
||||
procedure VisitIdentifier(const Node: IIdentifierNode); override;
|
||||
procedure VisitKeyword(const Node: IKeywordNode); override;
|
||||
procedure VisitBinaryExpression(const Node: IBinaryExpressionNode); override;
|
||||
procedure VisitUnaryExpression(const Node: IUnaryExpressionNode); override;
|
||||
procedure VisitIfExpression(const Node: IIfExpressionNode); override;
|
||||
procedure VisitTernaryExpression(const Node: ITernaryExpressionNode); override;
|
||||
procedure VisitLambdaExpression(const Node: ILambdaExpressionNode); override;
|
||||
procedure VisitFunctionCall(const Node: IFunctionCallNode); override;
|
||||
procedure VisitMacroExpansionNode(const Node: IMacroExpansionNode); override;
|
||||
procedure VisitRecurNode(const Node: IRecurNode); override;
|
||||
procedure VisitBlockExpression(const Node: IBlockExpressionNode); override;
|
||||
procedure VisitVariableDeclaration(const Node: IVariableDeclarationNode); override;
|
||||
procedure VisitAssignment(const Node: IAssignmentNode); override;
|
||||
procedure VisitMacroDefinition(const Node: IMacroDefinitionNode); override;
|
||||
procedure VisitQuasiquote(const Node: IQuasiquoteNode); override;
|
||||
procedure VisitUnquote(const Node: IUnquoteNode); override;
|
||||
procedure VisitUnquoteSplicing(const Node: IUnquoteSplicingNode); override;
|
||||
procedure VisitIndexer(const Node: IIndexerNode); override;
|
||||
procedure VisitMemberAccess(const Node: IMemberAccessNode); override;
|
||||
procedure VisitRecordLiteral(const Node: IRecordLiteralNode); override;
|
||||
procedure VisitCreateSeries(const Node: ICreateSeriesNode); override;
|
||||
procedure VisitAddSeriesItem(const Node: IAddSeriesItemNode); override;
|
||||
procedure VisitSeriesLength(const Node: ISeriesLengthNode); override;
|
||||
|
||||
public
|
||||
// Creates a new instance of the AST dumper.
|
||||
@@ -67,8 +70,8 @@ type
|
||||
implementation
|
||||
|
||||
uses
|
||||
Myc.Data.Keyword,
|
||||
Myc.Ast.Binding.Nodes;
|
||||
Myc.Data.Keyword;
|
||||
// Myc.Ast.Binding.Nodes; // Removed
|
||||
|
||||
{ TAstDumper }
|
||||
|
||||
@@ -132,47 +135,45 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitConstant(const Node: IConstantNode): TDataValue;
|
||||
procedure TAstDumper.VisitConstant(const Node: IConstantNode);
|
||||
begin
|
||||
LogFmt('Constant: %s', [Node.Value.ToString]);
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||
procedure TAstDumper.VisitIdentifier(const Node: IIdentifierNode);
|
||||
var
|
||||
N: TIdentifierNode;
|
||||
begin
|
||||
if Node is TBoundIdentifierNode then
|
||||
LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress((Node as TBoundIdentifierNode).Address)])
|
||||
N := (Node as TIdentifierNode);
|
||||
if N.Address.Kind <> akUnresolved then
|
||||
LogFmt('Identifier: %s -> %s', [N.Name, FormatAddress(N.Address)])
|
||||
else
|
||||
LogFmt('Identifier: %s (unbound)', [Node.Name]);
|
||||
Result := TDataValue.Void;
|
||||
LogFmt('Identifier: %s (unbound)', [N.Name]);
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitKeyword(const Node: IKeywordNode): TDataValue;
|
||||
procedure TAstDumper.VisitKeyword(const Node: IKeywordNode);
|
||||
begin
|
||||
LogFmt('Keyword: :%s', [Node.Value.Name]);
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
||||
procedure TAstDumper.VisitBinaryExpression(const Node: IBinaryExpressionNode);
|
||||
begin
|
||||
LogFmt('BinaryExpression: %s', [Node.Operator.ToString]);
|
||||
Indent;
|
||||
Node.Left.Accept(Self);
|
||||
Node.Right.Accept(Self);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
||||
procedure TAstDumper.VisitUnaryExpression(const Node: IUnaryExpressionNode);
|
||||
begin
|
||||
LogFmt('UnaryExpression: %s', [Node.Operator.ToString]);
|
||||
Indent;
|
||||
Node.Right.Accept(Self);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
||||
procedure TAstDumper.VisitIfExpression(const Node: IIfExpressionNode);
|
||||
begin
|
||||
Log('IfExpression');
|
||||
Indent;
|
||||
@@ -186,10 +187,9 @@ begin
|
||||
Node.ElseBranch.Accept(Self);
|
||||
end;
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
||||
procedure TAstDumper.VisitTernaryExpression(const Node: ITernaryExpressionNode);
|
||||
begin
|
||||
Log('TernaryExpression');
|
||||
Indent;
|
||||
@@ -200,25 +200,24 @@ begin
|
||||
Log('Else:');
|
||||
Node.ElseBranch.Accept(Self);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
||||
procedure TAstDumper.VisitLambdaExpression(const Node: ILambdaExpressionNode);
|
||||
var
|
||||
param: IIdentifierNode;
|
||||
upvalueAddr: TResolvedAddress;
|
||||
pair: TPair<string, Integer>;
|
||||
boundNode: TBoundLambdaExpressionNode;
|
||||
boundNode: TLambdaExpressionNode;
|
||||
begin
|
||||
if Node is TBoundLambdaExpressionNode then
|
||||
boundNode := Node as TLambdaExpressionNode;
|
||||
|
||||
if Assigned(boundNode.ScopeDescriptor) then
|
||||
begin
|
||||
boundNode := Node as TBoundLambdaExpressionNode;
|
||||
LogFmt('LambdaExpression (HasNested: %s)', [boundNode.HasNestedLambdas.ToString(TUseBoolStrs.True)]);
|
||||
Indent;
|
||||
|
||||
Log('Parameters:');
|
||||
Indent;
|
||||
for param in boundNode.Parameters do
|
||||
for var param in boundNode.Parameters do
|
||||
param.Accept(Self);
|
||||
Unindent;
|
||||
|
||||
@@ -248,38 +247,35 @@ begin
|
||||
Indent;
|
||||
Log('Parameters:');
|
||||
Indent;
|
||||
for param in Node.Parameters do
|
||||
for var param in Node.Parameters do
|
||||
param.Accept(Self);
|
||||
Unindent;
|
||||
Log('Body:');
|
||||
Node.Body.Accept(Self);
|
||||
Unindent;
|
||||
end;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||
procedure TAstDumper.VisitFunctionCall(const Node: IFunctionCallNode);
|
||||
var
|
||||
arg: IAstNode;
|
||||
N: TFunctionCallNode;
|
||||
begin
|
||||
if Node is TBoundFunctionCallNode then
|
||||
LogFmt('FunctionCall (IsTailCall: %s)', [(Node as TBoundFunctionCallNode).IsTailCall.ToString(TUseBoolStrs.True)])
|
||||
else
|
||||
Log('FunctionCall (unbound)');
|
||||
N := (Node as TFunctionCallNode);
|
||||
LogFmt('FunctionCall (IsTailCall: %s)', [N.IsTailCall.ToString(TUseBoolStrs.True)]);
|
||||
|
||||
Indent;
|
||||
Log('Callee:');
|
||||
Node.Callee.Accept(Self);
|
||||
LogFmt('Arguments (%d):', [Length(Node.Arguments)]);
|
||||
N.Callee.Accept(Self);
|
||||
LogFmt('Arguments (%d):', [Length(N.Arguments)]);
|
||||
Indent;
|
||||
for arg in Node.Arguments do
|
||||
for arg in N.Arguments do
|
||||
arg.Accept(Self);
|
||||
Unindent;
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
|
||||
procedure TAstDumper.VisitMacroExpansionNode(const Node: IMacroExpansionNode);
|
||||
var
|
||||
arg: IAstNode;
|
||||
begin
|
||||
@@ -303,10 +299,9 @@ begin
|
||||
Unindent;
|
||||
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitRecurNode(const Node: IRecurNode): TDataValue;
|
||||
procedure TAstDumper.VisitRecurNode(const Node: IRecurNode);
|
||||
var
|
||||
arg: IAstNode;
|
||||
begin
|
||||
@@ -319,10 +314,9 @@ begin
|
||||
arg.Accept(Self);
|
||||
Unindent;
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
||||
procedure TAstDumper.VisitBlockExpression(const Node: IBlockExpressionNode);
|
||||
var
|
||||
expr: IAstNode;
|
||||
begin
|
||||
@@ -331,28 +325,26 @@ begin
|
||||
for expr in Node.Expressions do
|
||||
expr.Accept(Self);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
||||
procedure TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNode);
|
||||
var
|
||||
N: TVariableDeclarationNode;
|
||||
begin
|
||||
if Node is TBoundVariableDeclarationNode then
|
||||
LogFmt('VariableDeclaration (IsBoxed: %s)', [(Node as TBoundVariableDeclarationNode).IsBoxed.ToString(TUseBoolStrs.True)])
|
||||
else
|
||||
Log('VariableDeclaration (unbound)');
|
||||
N := (Node as TVariableDeclarationNode);
|
||||
LogFmt('VariableDeclaration (IsBoxed: %s)', [N.IsBoxed.ToString(TUseBoolStrs.True)]);
|
||||
|
||||
Indent;
|
||||
Node.Identifier.Accept(Self);
|
||||
if Assigned(Node.Initializer) then
|
||||
N.Identifier.Accept(Self);
|
||||
if Assigned(N.Initializer) then
|
||||
begin
|
||||
Log('Initializer:');
|
||||
Node.Initializer.Accept(Self);
|
||||
N.Initializer.Accept(Self);
|
||||
end;
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
||||
procedure TAstDumper.VisitAssignment(const Node: IAssignmentNode);
|
||||
begin
|
||||
Log('Assignment');
|
||||
Indent;
|
||||
@@ -360,12 +352,9 @@ begin
|
||||
Log('Value:');
|
||||
Node.Value.Accept(Self);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
|
||||
var
|
||||
param: IIdentifierNode;
|
||||
procedure TAstDumper.VisitMacroDefinition(const Node: IMacroDefinitionNode);
|
||||
begin
|
||||
Log('MacroDefinition');
|
||||
Indent;
|
||||
@@ -377,7 +366,7 @@ begin
|
||||
|
||||
Log('Parameters:');
|
||||
Indent;
|
||||
for param in Node.Parameters do
|
||||
for var param in Node.Parameters do
|
||||
param.Accept(Self);
|
||||
Unindent;
|
||||
|
||||
@@ -387,37 +376,33 @@ begin
|
||||
Unindent;
|
||||
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue;
|
||||
procedure TAstDumper.VisitQuasiquote(const Node: IQuasiquoteNode);
|
||||
begin
|
||||
Log('Quasiquote');
|
||||
Indent;
|
||||
Node.Expression.Accept(Self);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitUnquote(const Node: IUnquoteNode): TDataValue;
|
||||
procedure TAstDumper.VisitUnquote(const Node: IUnquoteNode);
|
||||
begin
|
||||
Log('Unquote');
|
||||
Indent;
|
||||
Node.Expression.Accept(Self);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
|
||||
procedure TAstDumper.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode);
|
||||
begin
|
||||
Log('UnquoteSplicing');
|
||||
Indent;
|
||||
Node.Expression.Accept(Self);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
||||
procedure TAstDumper.VisitIndexer(const Node: IIndexerNode);
|
||||
begin
|
||||
Log('Indexer');
|
||||
Indent;
|
||||
@@ -426,10 +411,9 @@ begin
|
||||
Log('Index:');
|
||||
Node.Index.Accept(Self);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
||||
procedure TAstDumper.VisitMemberAccess(const Node: IMemberAccessNode);
|
||||
begin
|
||||
Log('MemberAccess');
|
||||
Indent;
|
||||
@@ -438,10 +422,9 @@ begin
|
||||
Log('Member:');
|
||||
Node.Member.Accept(Self);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
|
||||
procedure TAstDumper.VisitRecordLiteral(const Node: IRecordLiteralNode);
|
||||
var
|
||||
field: TRecordFieldLiteral;
|
||||
begin
|
||||
@@ -455,16 +438,14 @@ begin
|
||||
Unindent;
|
||||
end;
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
||||
procedure TAstDumper.VisitCreateSeries(const Node: ICreateSeriesNode);
|
||||
begin
|
||||
LogFmt('CreateSeries: %s', [Node.Definition]);
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
||||
procedure TAstDumper.VisitAddSeriesItem(const Node: IAddSeriesItemNode);
|
||||
begin
|
||||
Log('AddSeriesItem');
|
||||
Indent;
|
||||
@@ -478,17 +459,15 @@ begin
|
||||
Node.Lookback.Accept(Self);
|
||||
end;
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TAstDumper.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
||||
procedure TAstDumper.VisitSeriesLength(const Node: ISeriesLengthNode);
|
||||
begin
|
||||
Log('SeriesLength');
|
||||
Indent;
|
||||
Log('Series:');
|
||||
Node.Series.Accept(Self);
|
||||
Unindent;
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -9,43 +9,44 @@ uses
|
||||
Myc.Data.Scalar,
|
||||
Myc.Data.Value,
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast.Visitor,
|
||||
Myc.Ast.Binding,
|
||||
Myc.Ast.Scope;
|
||||
|
||||
type
|
||||
// The standard AST evaluator for production use.
|
||||
TEvaluatorVisitor = class(TAstVisitor, IEvaluatorVisitor)
|
||||
// This class inherits directly from TInterfacedObject as it is an
|
||||
// Interpreter (AST -> TDataValue), not a Transformer (AST -> IAstNode).
|
||||
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor, IEvaluatorVisitor)
|
||||
private
|
||||
FScope: IExecutionScope;
|
||||
class var
|
||||
procedure HandleTCO(var ResultValue: TDataValue);
|
||||
|
||||
protected
|
||||
function VisitConstant(const Node: IConstantNode): TDataValue; override;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
|
||||
function VisitKeyword(const Node: IKeywordNode): 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 VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
|
||||
function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override;
|
||||
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
|
||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): 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 VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
|
||||
// IAstVisitor methods made virtual for TDebugEvaluatorVisitor to override
|
||||
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
|
||||
function VisitKeyword(const Node: IKeywordNode): TDataValue; virtual;
|
||||
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual;
|
||||
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; virtual;
|
||||
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; virtual;
|
||||
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; virtual;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; virtual;
|
||||
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; virtual;
|
||||
function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; virtual;
|
||||
function VisitUnquote(const Node: IUnquoteNode): TDataValue; virtual;
|
||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; virtual;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; virtual;
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; virtual;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; virtual;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; virtual;
|
||||
function VisitAssignment(const Node: IAssignmentNode): TDataValue; virtual;
|
||||
function VisitIndexer(const Node: IIndexerNode): TDataValue; virtual;
|
||||
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; virtual;
|
||||
function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; virtual;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; virtual;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; virtual;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual;
|
||||
function VisitRecurNode(const Node: IRecurNode): TDataValue; virtual;
|
||||
|
||||
function IsTruthy(const AValue: TDataValue): Boolean; inline;
|
||||
|
||||
@@ -68,11 +69,12 @@ implementation
|
||||
uses
|
||||
System.TypInfo,
|
||||
System.Generics.Defaults,
|
||||
Myc.Ast, // Added
|
||||
Myc.Data.Keyword,
|
||||
Myc.Data.Decimal,
|
||||
Myc.Data.Series,
|
||||
Myc.Data.Scalar.JSON,
|
||||
Myc.Ast.Binding.Nodes;
|
||||
Myc.Data.Scalar.JSON;
|
||||
// Myc.Ast.Binding.Nodes; // Removed
|
||||
|
||||
// Helper type for TCO via trampolining.
|
||||
type
|
||||
@@ -206,7 +208,7 @@ end;
|
||||
|
||||
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
||||
var
|
||||
boundNode: TBoundLambdaExpressionNode;
|
||||
boundNode: TLambdaExpressionNode; // Changed
|
||||
capturedCells: TArray<IValueCell>;
|
||||
i: Integer;
|
||||
sourceAddresses: TArray<TResolvedAddress>;
|
||||
@@ -214,7 +216,7 @@ var
|
||||
visitorFactory: TEvaluatorFactory;
|
||||
begin
|
||||
// Cast to the bound node to access binder-specific information.
|
||||
boundNode := Node as TBoundLambdaExpressionNode;
|
||||
boundNode := Node as TLambdaExpressionNode; // Changed
|
||||
|
||||
// Create the closure by capturing the value cells of all upvalues from the current scope.
|
||||
sourceAddresses := boundNode.Upvalues;
|
||||
@@ -257,13 +259,13 @@ begin
|
||||
|
||||
// Capture the closure itself in slot 0 for 'recur' to find it.
|
||||
adr.SlotIndex := 0;
|
||||
lambdaScope[adr] := closure;
|
||||
lambdaScope[adr] := TDataValue(closure); // Explicit cast
|
||||
|
||||
// Populate the scope with the actual parameters passed to the function.
|
||||
for i := 0 to High(ArgValues) do
|
||||
begin
|
||||
// Parameters in a bound lambda must be bound identifiers.
|
||||
adr.SlotIndex := (params[i] as TBoundIdentifierNode).Address.SlotIndex;
|
||||
adr.SlotIndex := (params[i] as TIdentifierNode).Address.SlotIndex; // Changed
|
||||
lambdaScope[adr] := ArgValues[i];
|
||||
end;
|
||||
|
||||
@@ -273,7 +275,7 @@ begin
|
||||
end;
|
||||
|
||||
// The result of visiting a lambda node is the callable closure itself.
|
||||
Result := closure;
|
||||
Result := TDataValue(closure); // Explicit cast
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
|
||||
@@ -303,7 +305,7 @@ function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDa
|
||||
var
|
||||
calleeValue: TDataValue;
|
||||
argValues: TArray<TDataValue>;
|
||||
boundNode: TBoundFunctionCallNode;
|
||||
boundNode: TFunctionCallNode; // Changed
|
||||
begin
|
||||
calleeValue := Node.Callee.Accept(Self);
|
||||
if calleeValue.Kind <> vkMethod then
|
||||
@@ -314,7 +316,7 @@ begin
|
||||
for var i := 0 to High(argNodes) do
|
||||
argValues[i] := argNodes[i].Accept(Self);
|
||||
|
||||
boundNode := Node as TBoundFunctionCallNode;
|
||||
boundNode := Node as TFunctionCallNode; // Changed
|
||||
if boundNode.IsTailCall then
|
||||
begin
|
||||
// This is a tail call. Return a thunk to be processed by the trampoline.
|
||||
@@ -363,7 +365,7 @@ var
|
||||
itemValue, lookbackValue, seriesVar: TDataValue;
|
||||
lookback: Int64;
|
||||
begin
|
||||
seriesVar := FScope[(Node.Series as TBoundIdentifierNode).Address];
|
||||
seriesVar := FScope[(Node.Series as TIdentifierNode).Address]; // Changed
|
||||
itemValue := Node.Value.Accept(Self);
|
||||
lookback := -1;
|
||||
|
||||
@@ -397,7 +399,7 @@ begin
|
||||
// Evaluate the new value.
|
||||
Result := Node.Value.Accept(Self);
|
||||
// Assign it. The scope's SetValues implementation now handles boxing correctly.
|
||||
FScope[(Node.Identifier as TBoundIdentifierNode).Address] := Result;
|
||||
FScope[(Node.Identifier as TIdentifierNode).Address] := Result; // Changed
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
|
||||
@@ -408,7 +410,7 @@ end;
|
||||
function TEvaluatorVisitor.VisitKeyword(const Node: IKeywordNode): TDataValue;
|
||||
begin
|
||||
// Return the keyword as a TScalar value
|
||||
Result := TDataValue(TScalar.FromKeyword(Node.Value));
|
||||
Result := TDataValue(TScalar.FromKeyword(Node.Value)); // Explicit cast
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
||||
@@ -434,7 +436,7 @@ end;
|
||||
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||
begin
|
||||
// The scope's GetValues implementation now handles unboxing automatically.
|
||||
Result := FScope[(Node as TBoundIdentifierNode).Address];
|
||||
Result := FScope[(Node as TIdentifierNode).Address]; // Changed
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
||||
@@ -458,7 +460,7 @@ begin
|
||||
series := baseValue.AsSeries;
|
||||
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]);
|
||||
Result := series.Items[Integer(index)];
|
||||
Result := TDataValue(series.Items[Integer(index)]); // Explicit cast
|
||||
end;
|
||||
vkRecordSeries:
|
||||
begin
|
||||
@@ -487,7 +489,7 @@ begin
|
||||
case baseValue.Kind of
|
||||
vkRecordSeries: Result := TDataValue.FromSeries(baseValue.AsRecordSeries[Node.Member.Value]);
|
||||
|
||||
vkRecord: Result := baseValue.AsRecord[Node.Member.Value];
|
||||
vkRecord: Result := TDataValue(baseValue.AsRecord[Node.Member.Value]); // Explicit cast
|
||||
|
||||
// --- NEW GENERIC PATH ---
|
||||
vkGenericRecord:
|
||||
@@ -509,10 +511,10 @@ var
|
||||
i: Integer;
|
||||
begin
|
||||
// Check which type the binder created
|
||||
if Node is TBoundGenericRecordLiteralNode then
|
||||
if Node is TGenericRecordLiteralNode then // Changed
|
||||
begin
|
||||
// --- NEW GENERIC PATH ---
|
||||
var boundNode := Node as TBoundGenericRecordLiteralNode;
|
||||
var boundNode := Node as TGenericRecordLiteralNode; // Changed
|
||||
var genFields: TArray<TPair<IKeyword, TDataValue>>;
|
||||
SetLength(genFields, Length(boundNode.Fields));
|
||||
|
||||
@@ -530,10 +532,10 @@ begin
|
||||
var dynRec := TDynamicRecord.Create(genFields);
|
||||
Result := TDataValue.FromGenericRecord(dynRec);
|
||||
end
|
||||
else if Node is TBoundRecordLiteralNode then
|
||||
else if Node is TRecordLiteralNode then // Changed
|
||||
begin
|
||||
// --- EXISTING SCALAR PATH ---
|
||||
var boundNode := Node as TBoundRecordLiteralNode;
|
||||
var boundNode := Node as TRecordLiteralNode; // Changed
|
||||
var values: TArray<TScalar.TValue>;
|
||||
SetLength(values, Length(boundNode.Fields));
|
||||
|
||||
@@ -554,7 +556,7 @@ end;
|
||||
function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
||||
var
|
||||
address: TResolvedAddress;
|
||||
boundNode: TBoundVariableDeclarationNode;
|
||||
boundNode: TVariableDeclarationNode; // Changed
|
||||
begin
|
||||
// First, evaluate the initializer to get the variable's initial value.
|
||||
if Assigned(Node.Initializer) then
|
||||
@@ -562,9 +564,9 @@ begin
|
||||
else
|
||||
Result := TDataValue.Void;
|
||||
|
||||
// After binding, all declaration nodes are TBoundVariableDeclarationNode
|
||||
boundNode := Node as TBoundVariableDeclarationNode;
|
||||
address := (boundNode.Identifier as TBoundIdentifierNode).Address;
|
||||
// After binding, all declaration nodes are TVariableDeclarationNode
|
||||
boundNode := Node as TVariableDeclarationNode; // Changed
|
||||
address := (boundNode.Identifier as TIdentifierNode).Address; // Changed
|
||||
|
||||
// Check the IsBoxed flag set by the binder.
|
||||
if boundNode.IsBoxed then
|
||||
@@ -599,7 +601,7 @@ begin
|
||||
+ ' and '
|
||||
+ rightValue.AsScalar.Kind.ToString
|
||||
+ ' .');
|
||||
Result := resScalar;
|
||||
Result := TDataValue(resScalar); // Explicit cast
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
||||
@@ -614,7 +616,7 @@ begin
|
||||
var res: TScalar;
|
||||
if not TScalar.TryUnaryOperation(Node.Operator, rightValue.AsScalar, res) then
|
||||
raise ENotSupportedException.Create('Unary operation not supported for scalar type' + rightValue.AsScalar.Kind.ToString + '.');
|
||||
Result := res;
|
||||
Result := TDataValue(res); // Explicit cast
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
||||
@@ -649,7 +651,7 @@ var
|
||||
seriesValue: TDataValue;
|
||||
len: Int64;
|
||||
begin
|
||||
seriesValue := FScope[(Node.Series as TBoundIdentifierNode).Address];
|
||||
seriesValue := FScope[(Node.Series as TIdentifierNode).Address]; // Changed
|
||||
|
||||
case seriesValue.Kind of
|
||||
vkSeries: len := seriesValue.AsSeries.Count;
|
||||
@@ -658,7 +660,7 @@ begin
|
||||
raise EArgumentException.CreateFmt('Cannot get length of type %s.', [GetEnumName(TypeInfo(TDataValueKind), Ord(seriesValue.Kind))]);
|
||||
end;
|
||||
|
||||
Result := TScalar.FromInt64(len);
|
||||
Result := TDataValue(TScalar.FromInt64(len)); // Explicit cast
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
+213
-408
@@ -20,9 +20,9 @@ type
|
||||
|
||||
// TJsonAstConverter implements the visitor pattern for serialization
|
||||
// and uses factory functions for deserialization.
|
||||
TJsonAstConverter = class(TAstVisitor, IJsonAstConverter)
|
||||
// Inherits from the new generic visitor base class
|
||||
TJsonAstConverter = class(TAstVisitor<TJSONObject>, IJsonAstConverter)
|
||||
private
|
||||
FJsonObjectStack: TStack<TJSONObject>;
|
||||
procedure DataValueToJson(const AValue: TDataValue; const AParent: TJSONObject; const AName: string);
|
||||
function JsonToNode(const AJson: TJSONValue; const ExpectedType: String = ''): IAstNode;
|
||||
function JsonToDataValue(const AObj: TJSONObject; const AName: string): TDataValue;
|
||||
@@ -52,37 +52,36 @@ type
|
||||
function JsonToAddSeriesItemNode(const AObj: TJSONObject): IAddSeriesItemNode;
|
||||
function JsonToSeriesLengthNode(const AObj: TJSONObject): ISeriesLengthNode;
|
||||
protected
|
||||
// IAstVisitor implementation for serialization
|
||||
function VisitConstant(const Node: IConstantNode): TDataValue; override;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
|
||||
function VisitKeyword(const Node: IKeywordNode): 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 VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
|
||||
function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override;
|
||||
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
|
||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): 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 VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
|
||||
// IAstVisitor implementation for serialization (T = TJSONObject)
|
||||
function VisitConstant(const Node: IConstantNode): TJSONObject; override;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): TJSONObject; override;
|
||||
function VisitKeyword(const Node: IKeywordNode): TJSONObject; override;
|
||||
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TJSONObject; override;
|
||||
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TJSONObject; override;
|
||||
function VisitIfExpression(const Node: IIfExpressionNode): TJSONObject; override;
|
||||
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TJSONObject; override;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TJSONObject; override;
|
||||
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TJSONObject; override;
|
||||
function VisitQuasiquote(const Node: IQuasiquoteNode): TJSONObject; override;
|
||||
function VisitUnquote(const Node: IUnquoteNode): TJSONObject; override;
|
||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TJSONObject; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TJSONObject; override;
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TJSONObject; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): TJSONObject; override;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): TJSONObject; override;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TJSONObject; override;
|
||||
function VisitAssignment(const Node: IAssignmentNode): TJSONObject; override;
|
||||
function VisitIndexer(const Node: IIndexerNode): TJSONObject; override;
|
||||
function VisitMemberAccess(const Node: IMemberAccessNode): TJSONObject; override;
|
||||
function VisitRecordLiteral(const Node: IRecordLiteralNode): TJSONObject; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): TJSONObject; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TJSONObject; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TJSONObject; override;
|
||||
|
||||
function Serialize(const RootNode: IAstNode): TJSONObject;
|
||||
function Deserialize(const AJson: TJSONObject): IAstNode;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@@ -95,13 +94,7 @@ uses
|
||||
constructor TJsonAstConverter.Create;
|
||||
begin
|
||||
inherited;
|
||||
FJsonObjectStack := TStack<TJSONObject>.Create;
|
||||
end;
|
||||
|
||||
destructor TJsonAstConverter.Destroy;
|
||||
begin
|
||||
FJsonObjectStack.Free;
|
||||
inherited;
|
||||
// FJsonObjectStack removed
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.Deserialize(const AJson: TJSONObject): IAstNode;
|
||||
@@ -145,506 +138,322 @@ begin
|
||||
AParent.AddPair(AName, valObj);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitConstant(const Node: IConstantNode): TDataValue;
|
||||
var
|
||||
obj: TJSONObject;
|
||||
function TJsonAstConverter.VisitConstant(const Node: IConstantNode): TJSONObject;
|
||||
begin
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('Constant'));
|
||||
DataValueToJson(Node.Value, obj, 'Value');
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('Constant'));
|
||||
DataValueToJson(Node.Value, Result, 'Value');
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||
var
|
||||
obj: TJSONObject;
|
||||
function TJsonAstConverter.VisitIdentifier(const Node: IIdentifierNode): TJSONObject;
|
||||
begin
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('Identifier'));
|
||||
obj.AddPair('Name', TJSONString.Create(Node.Name));
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('Identifier'));
|
||||
Result.AddPair('Name', TJSONString.Create(Node.Name));
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitKeyword(const Node: IKeywordNode): TDataValue;
|
||||
var
|
||||
obj: TJSONObject;
|
||||
function TJsonAstConverter.VisitKeyword(const Node: IKeywordNode): TJSONObject;
|
||||
begin
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('Keyword'));
|
||||
obj.AddPair('Name', TJSONString.Create(Node.Value.Name));
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('Keyword'));
|
||||
Result.AddPair('Name', TJSONString.Create(Node.Value.Name));
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
||||
function TJsonAstConverter.VisitBinaryExpression(const Node: IBinaryExpressionNode): TJSONObject;
|
||||
var
|
||||
obj, leftObj, rightObj: TJSONObject;
|
||||
leftObj, rightObj: TJSONObject;
|
||||
begin
|
||||
Node.Left.Accept(Self);
|
||||
Node.Right.Accept(Self);
|
||||
leftObj := Accept(Node.Left);
|
||||
rightObj := Accept(Node.Right);
|
||||
|
||||
rightObj := FJsonObjectStack.Pop;
|
||||
leftObj := FJsonObjectStack.Pop;
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('BinaryExpr'));
|
||||
obj.AddPair('Operator', TJSONString.Create(Node.Operator.ToString));
|
||||
obj.AddPair('Left', leftObj);
|
||||
obj.AddPair('Right', rightObj);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('BinaryExpr'));
|
||||
Result.AddPair('Operator', TJSONString.Create(Node.Operator.ToString));
|
||||
Result.AddPair('Left', leftObj);
|
||||
Result.AddPair('Right', rightObj);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
||||
function TJsonAstConverter.VisitUnaryExpression(const Node: IUnaryExpressionNode): TJSONObject;
|
||||
var
|
||||
obj, rightObj: TJSONObject;
|
||||
rightObj: TJSONObject;
|
||||
begin
|
||||
Node.Right.Accept(Self);
|
||||
rightObj := FJsonObjectStack.Pop;
|
||||
rightObj := Accept(Node.Right);
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('UnaryExpr'));
|
||||
obj.AddPair('Operator', TJSONString.Create(Node.Operator.ToString));
|
||||
obj.AddPair('Right', rightObj);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('UnaryExpr'));
|
||||
Result.AddPair('Operator', TJSONString.Create(Node.Operator.ToString));
|
||||
Result.AddPair('Right', rightObj);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
||||
function TJsonAstConverter.VisitIfExpression(const Node: IIfExpressionNode): TJSONObject;
|
||||
var
|
||||
obj, condObj, thenObj, elseObj: TJSONObject;
|
||||
condObj, thenObj, elseObj: TJSONObject;
|
||||
begin
|
||||
Node.Condition.Accept(Self);
|
||||
Node.ThenBranch.Accept(Self);
|
||||
if Assigned(Node.ElseBranch) then
|
||||
Node.ElseBranch.Accept(Self);
|
||||
condObj := Accept(Node.Condition);
|
||||
thenObj := Accept(Node.ThenBranch);
|
||||
elseObj := Accept(Node.ElseBranch); // Accept handles nil
|
||||
|
||||
if Assigned(Node.ElseBranch) then
|
||||
elseObj := FJsonObjectStack.Pop
|
||||
else
|
||||
elseObj := nil;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('IfExpr'));
|
||||
Result.AddPair('Condition', condObj);
|
||||
Result.AddPair('ThenBranch', thenObj);
|
||||
|
||||
thenObj := FJsonObjectStack.Pop;
|
||||
condObj := FJsonObjectStack.Pop;
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('IfExpr'));
|
||||
obj.AddPair('Condition', condObj);
|
||||
obj.AddPair('ThenBranch', thenObj);
|
||||
if Assigned(elseObj) then
|
||||
obj.AddPair('ElseBranch', elseObj)
|
||||
Result.AddPair('ElseBranch', elseObj)
|
||||
else
|
||||
obj.AddPair('ElseBranch', TJSONNull.Create);
|
||||
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result.AddPair('ElseBranch', TJSONNull.Create);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
||||
function TJsonAstConverter.VisitTernaryExpression(const Node: ITernaryExpressionNode): TJSONObject;
|
||||
var
|
||||
obj, condObj, thenObj, elseObj: TJSONObject;
|
||||
condObj, thenObj, elseObj: TJSONObject;
|
||||
begin
|
||||
Node.Condition.Accept(Self);
|
||||
Node.ThenBranch.Accept(Self);
|
||||
Node.ElseBranch.Accept(Self);
|
||||
condObj := Accept(Node.Condition);
|
||||
thenObj := Accept(Node.ThenBranch);
|
||||
elseObj := Accept(Node.ElseBranch);
|
||||
|
||||
elseObj := FJsonObjectStack.Pop;
|
||||
thenObj := FJsonObjectStack.Pop;
|
||||
condObj := FJsonObjectStack.Pop;
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('TernaryExpr'));
|
||||
obj.AddPair('Condition', condObj);
|
||||
obj.AddPair('ThenBranch', thenObj);
|
||||
obj.AddPair('ElseBranch', elseObj);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('TernaryExpr'));
|
||||
Result.AddPair('Condition', condObj);
|
||||
Result.AddPair('ThenBranch', thenObj);
|
||||
Result.AddPair('ElseBranch', elseObj);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
||||
function TJsonAstConverter.VisitLambdaExpression(const Node: ILambdaExpressionNode): TJSONObject;
|
||||
var
|
||||
obj, bodyObj: TJSONObject;
|
||||
bodyObj: TJSONObject;
|
||||
paramsArray: TJSONArray;
|
||||
tempParams: TArray<TJSONObject>;
|
||||
param: IIdentifierNode;
|
||||
i: Integer;
|
||||
begin
|
||||
for param in Node.Parameters do
|
||||
param.Accept(Self);
|
||||
Node.Body.Accept(Self);
|
||||
|
||||
bodyObj := FJsonObjectStack.Pop;
|
||||
|
||||
SetLength(tempParams, Length(Node.Parameters));
|
||||
for i := High(tempParams) downto 0 do
|
||||
tempParams[i] := FJsonObjectStack.Pop;
|
||||
bodyObj := Accept(Node.Body);
|
||||
|
||||
paramsArray := TJSONArray.Create;
|
||||
for i := 0 to High(tempParams) do
|
||||
paramsArray.Add(tempParams[i]);
|
||||
for var param in Node.Parameters do
|
||||
paramsArray.Add(Accept(param));
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('LambdaExpr'));
|
||||
obj.AddPair('Parameters', paramsArray);
|
||||
obj.AddPair('Body', bodyObj);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('LambdaExpr'));
|
||||
Result.AddPair('Parameters', paramsArray);
|
||||
Result.AddPair('Body', bodyObj);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
|
||||
function TJsonAstConverter.VisitMacroDefinition(const Node: IMacroDefinitionNode): TJSONObject;
|
||||
var
|
||||
obj, nameObj, bodyObj: TJSONObject;
|
||||
nameObj, bodyObj: TJSONObject;
|
||||
paramsArray: TJSONArray;
|
||||
tempParams: TArray<TJSONObject>;
|
||||
param: IIdentifierNode;
|
||||
i: Integer;
|
||||
begin
|
||||
Node.Name.Accept(Self);
|
||||
for param in Node.Parameters do
|
||||
param.Accept(Self);
|
||||
Node.Body.Accept(Self);
|
||||
|
||||
bodyObj := FJsonObjectStack.Pop;
|
||||
|
||||
SetLength(tempParams, Length(Node.Parameters));
|
||||
for i := High(tempParams) downto 0 do
|
||||
tempParams[i] := FJsonObjectStack.Pop;
|
||||
|
||||
nameObj := FJsonObjectStack.Pop;
|
||||
nameObj := Accept(Node.Name);
|
||||
bodyObj := Accept(Node.Body);
|
||||
|
||||
paramsArray := TJSONArray.Create;
|
||||
for i := 0 to High(tempParams) do
|
||||
paramsArray.Add(tempParams[i]);
|
||||
for var param in Node.Parameters do
|
||||
paramsArray.Add(Accept(param));
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('MacroDef'));
|
||||
obj.AddPair('Name', nameObj);
|
||||
obj.AddPair('Parameters', paramsArray);
|
||||
obj.AddPair('Body', bodyObj);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('MacroDef'));
|
||||
Result.AddPair('Name', nameObj);
|
||||
Result.AddPair('Parameters', paramsArray);
|
||||
Result.AddPair('Body', bodyObj);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue;
|
||||
var
|
||||
obj, exprObj: TJSONObject;
|
||||
function TJsonAstConverter.VisitQuasiquote(const Node: IQuasiquoteNode): TJSONObject;
|
||||
begin
|
||||
Node.Expression.Accept(Self);
|
||||
exprObj := FJsonObjectStack.Pop;
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('Quasiquote'));
|
||||
obj.AddPair('Expression', exprObj);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('Quasiquote'));
|
||||
Result.AddPair('Expression', Accept(Node.Expression));
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitUnquote(const Node: IUnquoteNode): TDataValue;
|
||||
var
|
||||
obj, exprObj: TJSONObject;
|
||||
function TJsonAstConverter.VisitUnquote(const Node: IUnquoteNode): TJSONObject;
|
||||
begin
|
||||
Node.Expression.Accept(Self);
|
||||
exprObj := FJsonObjectStack.Pop;
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('Unquote'));
|
||||
obj.AddPair('Expression', exprObj);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('Unquote'));
|
||||
Result.AddPair('Expression', Accept(Node.Expression));
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
|
||||
var
|
||||
obj, exprObj: TJSONObject;
|
||||
function TJsonAstConverter.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TJSONObject;
|
||||
begin
|
||||
Node.Expression.Accept(Self);
|
||||
exprObj := FJsonObjectStack.Pop;
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('UnquoteSplicing'));
|
||||
obj.AddPair('Expression', exprObj);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('UnquoteSplicing'));
|
||||
Result.AddPair('Expression', Accept(Node.Expression));
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||
function TJsonAstConverter.VisitFunctionCall(const Node: IFunctionCallNode): TJSONObject;
|
||||
var
|
||||
obj, calleeObj: TJSONObject;
|
||||
calleeObj: TJSONObject;
|
||||
argsArray: TJSONArray;
|
||||
tempArgs: TArray<TJSONObject>;
|
||||
arg: IAstNode;
|
||||
i: Integer;
|
||||
begin
|
||||
Node.Callee.Accept(Self);
|
||||
for arg in Node.Arguments do
|
||||
arg.Accept(Self);
|
||||
|
||||
SetLength(tempArgs, Length(Node.Arguments));
|
||||
for i := High(tempArgs) downto 0 do
|
||||
tempArgs[i] := FJsonObjectStack.Pop;
|
||||
calleeObj := Accept(Node.Callee);
|
||||
|
||||
argsArray := TJSONArray.Create;
|
||||
for i := 0 to High(tempArgs) do
|
||||
argsArray.Add(tempArgs[i]);
|
||||
for arg in Node.Arguments do
|
||||
argsArray.Add(Accept(arg));
|
||||
|
||||
calleeObj := FJsonObjectStack.Pop;
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('FunctionCall'));
|
||||
obj.AddPair('Callee', calleeObj);
|
||||
obj.AddPair('Arguments', argsArray);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('FunctionCall'));
|
||||
Result.AddPair('Callee', calleeObj);
|
||||
Result.AddPair('Arguments', argsArray);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
|
||||
function TJsonAstConverter.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TJSONObject;
|
||||
var
|
||||
obj, calleeObj, bodyObj: TJSONObject;
|
||||
calleeObj, bodyObj: TJSONObject;
|
||||
argsArray: TJSONArray;
|
||||
tempArgs: TArray<TJSONObject>;
|
||||
arg: IAstNode;
|
||||
i: Integer;
|
||||
begin
|
||||
// Serialize all children first: Callee, Arguments, and the new ExpandedBody
|
||||
Node.Callee.Accept(Self);
|
||||
for arg in Node.Arguments do
|
||||
arg.Accept(Self);
|
||||
Node.ExpandedBody.Accept(Self);
|
||||
|
||||
// Pop children's JSON from stack in reverse order of visitation
|
||||
bodyObj := FJsonObjectStack.Pop;
|
||||
|
||||
SetLength(tempArgs, Length(Node.Arguments));
|
||||
for i := High(tempArgs) downto 0 do
|
||||
tempArgs[i] := FJsonObjectStack.Pop;
|
||||
|
||||
calleeObj := FJsonObjectStack.Pop;
|
||||
|
||||
// Build JSON array for arguments
|
||||
argsArray := TJSONArray.Create;
|
||||
for var argObj in tempArgs do
|
||||
argsArray.Add(argObj);
|
||||
|
||||
// Create the final JSON object for this node
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('MacroExpansion'));
|
||||
obj.AddPair('Callee', calleeObj);
|
||||
obj.AddPair('Arguments', argsArray);
|
||||
obj.AddPair('ExpandedBody', bodyObj);
|
||||
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitRecurNode(const Node: IRecurNode): TDataValue;
|
||||
var
|
||||
obj: TJSONObject;
|
||||
argsArray: TJSONArray;
|
||||
tempArgs: TArray<TJSONObject>;
|
||||
arg: IAstNode;
|
||||
i: Integer;
|
||||
begin
|
||||
for arg in Node.Arguments do
|
||||
arg.Accept(Self);
|
||||
|
||||
SetLength(tempArgs, Length(Node.Arguments));
|
||||
for i := High(tempArgs) downto 0 do
|
||||
tempArgs[i] := FJsonObjectStack.Pop;
|
||||
calleeObj := Accept(Node.Callee);
|
||||
bodyObj := Accept(Node.ExpandedBody);
|
||||
|
||||
argsArray := TJSONArray.Create;
|
||||
for i := 0 to High(tempArgs) do
|
||||
argsArray.Add(tempArgs[i]);
|
||||
for arg in Node.Arguments do
|
||||
argsArray.Add(Accept(arg));
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('Recur'));
|
||||
obj.AddPair('Arguments', argsArray);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('MacroExpansion'));
|
||||
Result.AddPair('Callee', calleeObj);
|
||||
Result.AddPair('Arguments', argsArray);
|
||||
Result.AddPair('ExpandedBody', bodyObj);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
||||
function TJsonAstConverter.VisitRecurNode(const Node: IRecurNode): TJSONObject;
|
||||
var
|
||||
argsArray: TJSONArray;
|
||||
arg: IAstNode;
|
||||
begin
|
||||
argsArray := TJSONArray.Create;
|
||||
for arg in Node.Arguments do
|
||||
argsArray.Add(Accept(arg));
|
||||
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('Recur'));
|
||||
Result.AddPair('Arguments', argsArray);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitBlockExpression(const Node: IBlockExpressionNode): TJSONObject;
|
||||
var
|
||||
obj: TJSONObject;
|
||||
exprsArray: TJSONArray;
|
||||
tempExprs: TArray<TJSONObject>;
|
||||
expr: IAstNode;
|
||||
i: Integer;
|
||||
begin
|
||||
for expr in Node.Expressions do
|
||||
expr.Accept(Self);
|
||||
|
||||
SetLength(tempExprs, Length(Node.Expressions));
|
||||
for i := High(tempExprs) downto 0 do
|
||||
tempExprs[i] := FJsonObjectStack.Pop;
|
||||
|
||||
exprsArray := TJSONArray.Create;
|
||||
for i := 0 to High(tempExprs) do
|
||||
exprsArray.Add(tempExprs[i]);
|
||||
for expr in Node.Expressions do
|
||||
exprsArray.Add(Accept(expr));
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('Block'));
|
||||
obj.AddPair('Expressions', exprsArray);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('Block'));
|
||||
Result.AddPair('Expressions', exprsArray);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
||||
function TJsonAstConverter.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TJSONObject;
|
||||
var
|
||||
obj, identObj, initObj: TJSONObject;
|
||||
identObj, initObj: TJSONObject;
|
||||
begin
|
||||
Node.Identifier.Accept(Self);
|
||||
if Assigned(Node.Initializer) then
|
||||
Node.Initializer.Accept(Self);
|
||||
identObj := Accept(Node.Identifier);
|
||||
initObj := Accept(Node.Initializer); // Accept handles nil
|
||||
|
||||
if Assigned(Node.Initializer) then
|
||||
initObj := FJsonObjectStack.Pop
|
||||
else
|
||||
initObj := nil;
|
||||
identObj := FJsonObjectStack.Pop;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('VarDecl'));
|
||||
Result.AddPair('Identifier', identObj);
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('VarDecl'));
|
||||
obj.AddPair('Identifier', identObj);
|
||||
if Assigned(initObj) then
|
||||
obj.AddPair('Initializer', initObj)
|
||||
Result.AddPair('Initializer', initObj)
|
||||
else
|
||||
obj.AddPair('Initializer', TJSONNull.Create);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result.AddPair('Initializer', TJSONNull.Create);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
||||
function TJsonAstConverter.VisitAssignment(const Node: IAssignmentNode): TJSONObject;
|
||||
var
|
||||
obj, identObj, valueObj: TJSONObject;
|
||||
identObj, valueObj: TJSONObject;
|
||||
begin
|
||||
Node.Identifier.Accept(Self);
|
||||
Node.Value.Accept(Self);
|
||||
identObj := Accept(Node.Identifier);
|
||||
valueObj := Accept(Node.Value);
|
||||
|
||||
valueObj := FJsonObjectStack.Pop;
|
||||
identObj := FJsonObjectStack.Pop;
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('Assignment'));
|
||||
obj.AddPair('Identifier', identObj);
|
||||
obj.AddPair('Value', valueObj);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('Assignment'));
|
||||
Result.AddPair('Identifier', identObj);
|
||||
Result.AddPair('Value', valueObj);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
||||
function TJsonAstConverter.VisitIndexer(const Node: IIndexerNode): TJSONObject;
|
||||
var
|
||||
obj, baseObj, indexObj: TJSONObject;
|
||||
baseObj, indexObj: TJSONObject;
|
||||
begin
|
||||
Node.Base.Accept(Self);
|
||||
Node.Index.Accept(Self);
|
||||
baseObj := Accept(Node.Base);
|
||||
indexObj := Accept(Node.Index);
|
||||
|
||||
indexObj := FJsonObjectStack.Pop;
|
||||
baseObj := FJsonObjectStack.Pop;
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('Indexer'));
|
||||
obj.AddPair('Base', baseObj);
|
||||
obj.AddPair('Index', indexObj);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('Indexer'));
|
||||
Result.AddPair('Base', baseObj);
|
||||
Result.AddPair('Index', indexObj);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
||||
function TJsonAstConverter.VisitMemberAccess(const Node: IMemberAccessNode): TJSONObject;
|
||||
var
|
||||
obj, baseObj, memberObj: TJSONObject;
|
||||
baseObj, memberObj: TJSONObject;
|
||||
begin
|
||||
Node.Base.Accept(Self);
|
||||
Node.Member.Accept(Self);
|
||||
baseObj := Accept(Node.Base);
|
||||
memberObj := Accept(Node.Member);
|
||||
|
||||
memberObj := FJsonObjectStack.Pop;
|
||||
baseObj := FJsonObjectStack.Pop;
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('MemberAccess'));
|
||||
obj.AddPair('Base', baseObj);
|
||||
obj.AddPair('Member', memberObj);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('MemberAccess'));
|
||||
Result.AddPair('Base', baseObj);
|
||||
Result.AddPair('Member', memberObj);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
|
||||
function TJsonAstConverter.VisitRecordLiteral(const Node: IRecordLiteralNode): TJSONObject;
|
||||
var
|
||||
obj, fieldObj: TJSONObject;
|
||||
fieldsArray: TJSONArray;
|
||||
field: TRecordFieldLiteral;
|
||||
fieldObj: TJSONObject;
|
||||
begin
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('RecordLiteral'));
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('RecordLiteral'));
|
||||
|
||||
fieldsArray := TJSONArray.Create;
|
||||
for field in Node.Fields do
|
||||
begin
|
||||
field.Value.Accept(Self); // This pushes the value JSON onto the stack
|
||||
|
||||
fieldObj := TJSONObject.Create;
|
||||
fieldObj.AddPair('Name', TJSONString.Create(field.Key.Value.Name));
|
||||
fieldObj.AddPair('Value', FJsonObjectStack.Pop);
|
||||
fieldObj.AddPair('Value', Accept(field.Value)); // Get TJSONObject
|
||||
fieldsArray.Add(fieldObj);
|
||||
end;
|
||||
|
||||
obj.AddPair('Fields', fieldsArray);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result.AddPair('Fields', fieldsArray);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
||||
var
|
||||
obj: TJSONObject;
|
||||
function TJsonAstConverter.VisitCreateSeries(const Node: ICreateSeriesNode): TJSONObject;
|
||||
begin
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('CreateSeries'));
|
||||
obj.AddPair('Definition', TJSONString.Create(Node.Definition));
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('CreateSeries'));
|
||||
Result.AddPair('Definition', TJSONString.Create(Node.Definition));
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
||||
function TJsonAstConverter.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TJSONObject;
|
||||
var
|
||||
obj, seriesObj, valueObj, lookbackObj: TJSONObject;
|
||||
seriesObj, valueObj, lookbackObj: TJSONObject;
|
||||
begin
|
||||
Node.Series.Accept(Self);
|
||||
Node.Value.Accept(Self);
|
||||
if Assigned(Node.Lookback) then
|
||||
Node.Lookback.Accept(Self);
|
||||
seriesObj := Accept(Node.Series);
|
||||
valueObj := Accept(Node.Value);
|
||||
lookbackObj := Accept(Node.Lookback); // Accept handles nil
|
||||
|
||||
if Assigned(Node.Lookback) then
|
||||
lookbackObj := FJsonObjectStack.Pop
|
||||
else
|
||||
lookbackObj := nil;
|
||||
valueObj := FJsonObjectStack.Pop;
|
||||
seriesObj := FJsonObjectStack.Pop;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('AddSeriesItem'));
|
||||
Result.AddPair('Series', seriesObj);
|
||||
Result.AddPair('Value', valueObj);
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('AddSeriesItem'));
|
||||
obj.AddPair('Series', seriesObj);
|
||||
obj.AddPair('Value', valueObj);
|
||||
if Assigned(lookbackObj) then
|
||||
obj.AddPair('Lookback', lookbackObj)
|
||||
Result.AddPair('Lookback', lookbackObj)
|
||||
else
|
||||
obj.AddPair('Lookback', TJSONNull.Create);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result.AddPair('Lookback', TJSONNull.Create);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
||||
function TJsonAstConverter.VisitSeriesLength(const Node: ISeriesLengthNode): TJSONObject;
|
||||
var
|
||||
obj, seriesObj: TJSONObject;
|
||||
seriesObj: TJSONObject;
|
||||
begin
|
||||
Node.Series.Accept(Self);
|
||||
seriesObj := FJsonObjectStack.Pop;
|
||||
seriesObj := Accept(Node.Series);
|
||||
|
||||
obj := TJSONObject.Create;
|
||||
obj.AddPair('NodeType', TJSONString.Create('SeriesLength'));
|
||||
obj.AddPair('Series', seriesObj);
|
||||
FJsonObjectStack.Push(obj);
|
||||
Result := TDataValue.Void;
|
||||
Result := TJSONObject.Create;
|
||||
Result.AddPair('NodeType', TJSONString.Create('SeriesLength'));
|
||||
Result.AddPair('Series', seriesObj);
|
||||
end;
|
||||
|
||||
{ TJsonAstConverter - Deserialization }
|
||||
@@ -827,7 +636,7 @@ end;
|
||||
|
||||
function TJsonAstConverter.JsonToUnquoteSplicingNode(const AObj: TJSONObject): IUnquoteSplicingNode;
|
||||
begin
|
||||
Result := TAst.UnquoteSplicing(JsonToNode(AObj.GetValue('Expression')));
|
||||
Result := TAst.UnquoteSplicing(JsonToNode(AObj.GetValue('Expression')).AsQuasiquote);
|
||||
end;
|
||||
|
||||
function TJsonAstConverter.JsonToFunctionCallNode(const AObj: TJSONObject): IFunctionCallNode;
|
||||
@@ -1020,16 +829,12 @@ end;
|
||||
|
||||
function TJsonAstConverter.Serialize(const RootNode: IAstNode): TJSONObject;
|
||||
begin
|
||||
FJsonObjectStack.Clear;
|
||||
if not Assigned(RootNode) then
|
||||
exit(nil);
|
||||
|
||||
RootNode.Accept(Self);
|
||||
|
||||
if FJsonObjectStack.Count <> 1 then
|
||||
raise EInvalidOpException.Create('JSON serialization stack is corrupt.');
|
||||
|
||||
Result := FJsonObjectStack.Pop;
|
||||
// Call Accept, which returns TDataValue(vkGeneric(TJSONObject))
|
||||
// and unwrap it.
|
||||
Result := RootNode.Accept(Self).AsGeneric<TJSONObject>;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -12,8 +12,7 @@ uses
|
||||
Myc.Ast.Visitor,
|
||||
Myc.Ast.Scope,
|
||||
Myc.Ast.Types,
|
||||
Myc.Ast,
|
||||
Myc.Ast.Binding.Nodes;
|
||||
Myc.Ast;
|
||||
|
||||
type
|
||||
IAstLowerer = interface(IAstVisitor)
|
||||
@@ -30,7 +29,7 @@ type
|
||||
function SetType(const Node: IAstNode; const AType: IStaticType): IAstNode;
|
||||
protected
|
||||
// Override to find nodes to lower
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
@@ -50,6 +49,7 @@ uses
|
||||
constructor TAstLowerer.Create;
|
||||
var
|
||||
op: TScalar.TBinaryOp;
|
||||
uOp: TScalar.TUnaryOp; // Added for unary
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
@@ -59,7 +59,8 @@ begin
|
||||
FBinaryOperators.Add(op.ToString, op);
|
||||
|
||||
FUnaryOperators := TDictionary<string, TScalar.TUnaryOp>.Create;
|
||||
FUnaryOperators.Add('not', TScalar.TUnaryOp.Not);
|
||||
for uOp := Low(TScalar.TUnaryOp) to High(TScalar.TUnaryOp) do // Changed
|
||||
FUnaryOperators.Add(uOp.ToString, uOp);
|
||||
// Note: '-' is handled as a special case in VisitFunctionCall
|
||||
end;
|
||||
|
||||
@@ -78,11 +79,9 @@ end;
|
||||
|
||||
function TAstLowerer.Execute(const RootNode: IAstNode): IAstNode;
|
||||
begin
|
||||
var transformedValue := Accept(RootNode);
|
||||
if transformedValue.IsVoid then
|
||||
Result := TAst.Block([])
|
||||
else
|
||||
Result := transformedValue.AsIntf<IAstNode>;
|
||||
Result := Accept(RootNode); // Use IAstNode-returning Accept
|
||||
if not Assigned(Result) then
|
||||
Result := TAst.Block([]);
|
||||
|
||||
if Assigned(Result) then
|
||||
(Result as TAstNode).StaticType := (Result as TAstNode).StaticType;
|
||||
@@ -90,25 +89,18 @@ end;
|
||||
|
||||
function TAstLowerer.SetType(const Node: IAstNode; const AType: IStaticType): IAstNode;
|
||||
begin
|
||||
if Assigned(Node) then // Add nil check for safety
|
||||
(Node as TAstNode).StaticType := AType;
|
||||
Result := Node;
|
||||
end;
|
||||
|
||||
function TAstLowerer.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||
function TAstLowerer.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
|
||||
var
|
||||
calleeIdentifier: TIdentifierNode;
|
||||
binaryOp: TScalar.TBinaryOp;
|
||||
unaryOp: TScalar.TUnaryOp;
|
||||
left, right: IAstNode;
|
||||
begin
|
||||
// --- Transformation: Keyword-as-Function ---
|
||||
// (This logic is correctly handled in TAstBinder)
|
||||
if (Node.Callee is TKeywordNode) then
|
||||
begin
|
||||
// This node should have been transformed by the TAstBinder.
|
||||
exit(inherited VisitFunctionCall(Node));
|
||||
end;
|
||||
|
||||
// --- Optimization: Operator Folding ---
|
||||
if (Node.Callee is TIdentifierNode) then
|
||||
begin
|
||||
@@ -118,10 +110,12 @@ begin
|
||||
begin
|
||||
if FBinaryOperators.TryGetValue(calleeIdentifier.Name, binaryOp) then
|
||||
begin
|
||||
left := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
|
||||
right := Accept(Node.Arguments[1]).AsIntf<IAstNode>;
|
||||
// Note: We MUST visit children *before* creating the new node
|
||||
left := Accept(Node.Arguments[0]);
|
||||
right := Accept(Node.Arguments[1]);
|
||||
var binExpr := TAst.BinaryExpr(left, binaryOp, right);
|
||||
Result := TDataValue.FromIntf<IAstNode>(SetType(binExpr, (Node as TAstNode).StaticType));
|
||||
// Copy metadata (StaticType) from old node to new node
|
||||
Result := SetType(binExpr, (Node as TAstNode).StaticType);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
@@ -130,23 +124,25 @@ begin
|
||||
begin
|
||||
if FUnaryOperators.TryGetValue(calleeIdentifier.Name, unaryOp) then
|
||||
begin
|
||||
right := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
|
||||
right := Accept(Node.Arguments[0]);
|
||||
var unExpr := TAst.UnaryExpr(unaryOp, right);
|
||||
Result := TDataValue.FromIntf<IAstNode>(SetType(unExpr, (Node as TAstNode).StaticType));
|
||||
// Copy metadata
|
||||
Result := SetType(unExpr, (Node as TAstNode).StaticType);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if (calleeIdentifier.Name = '-') then
|
||||
begin
|
||||
right := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
|
||||
right := Accept(Node.Arguments[0]);
|
||||
var unExpr := TAst.UnaryExpr(TScalar.TUnaryOp.Negate, right);
|
||||
Result := TDataValue.FromIntf<IAstNode>(SetType(unExpr, (Node as TAstNode).StaticType));
|
||||
// Copy metadata
|
||||
Result := SetType(unExpr, (Node as TAstNode).StaticType);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// If no rewrite matched, continue traversal
|
||||
// If no rewrite matched, continue traversal using the base implementation
|
||||
Result := inherited VisitFunctionCall(Node);
|
||||
end;
|
||||
|
||||
|
||||
@@ -12,8 +12,7 @@ uses
|
||||
Myc.Ast.Visitor,
|
||||
Myc.Ast.Scope,
|
||||
Myc.Ast.Types,
|
||||
Myc.Ast,
|
||||
Myc.Ast.Binding; // Required for TAstBinder.Bind
|
||||
Myc.Ast;
|
||||
|
||||
type
|
||||
IAstMacroExpander = interface(IAstVisitor)
|
||||
@@ -31,11 +30,12 @@ type
|
||||
FMacroScope: IExecutionScope;
|
||||
function TransformAndSpliceNodes(const ANodes: TArray<IAstNode>): TArray<IAstNode>;
|
||||
protected
|
||||
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
|
||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
|
||||
function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
|
||||
// Override the new IAstNode-returning methods
|
||||
function VisitUnquote(const Node: IUnquoteNode): IAstNode; override;
|
||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
|
||||
function VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; override;
|
||||
public
|
||||
constructor Create(const AMacroScope: IExecutionScope; const AEvaluate: TEvaluateProc);
|
||||
class function Expand(const MacroScope: IExecutionScope; const RootNode: IAstNode; const AEvaluate: TEvaluateProc): IAstNode;
|
||||
@@ -50,11 +50,10 @@ type
|
||||
FCurrentDescriptor: IScopeDescriptor;
|
||||
FEvaluatorFactory: TEvaluatorFactory;
|
||||
protected
|
||||
function Accept(const Node: IAstNode): TDataValue; override;
|
||||
// Finds macro definitions
|
||||
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
|
||||
function VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode; override;
|
||||
// Finds and expands macro calls
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
|
||||
public
|
||||
constructor Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
|
||||
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
|
||||
@@ -71,6 +70,7 @@ implementation
|
||||
|
||||
uses
|
||||
System.Generics.Defaults,
|
||||
Myc.Ast.Binding, // Required for TAstBinder.Bind
|
||||
Myc.Ast.Evaluator, // Required for TEvaluatorVisitor.Execute
|
||||
Myc.Data.Keyword;
|
||||
|
||||
@@ -89,14 +89,19 @@ class function TExpansionVisitor.Expand(
|
||||
const AEvaluate: TEvaluateProc
|
||||
): IAstNode;
|
||||
begin
|
||||
var expander := TExpansionVisitor.Create(MacroScope, AEvaluate) as IAstTransformer;
|
||||
Result := expander.Execute(RootNode);
|
||||
var expander := TExpansionVisitor.Create(MacroScope, AEvaluate);
|
||||
try
|
||||
Result := expander.Accept(RootNode); // Use IAstNode-returning Accept
|
||||
finally
|
||||
expander.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TExpansionVisitor.TransformAndSpliceNodes(const ANodes: TArray<IAstNode>): TArray<IAstNode>;
|
||||
var
|
||||
newList: TList<IAstNode>;
|
||||
nodeToSplice: IAstNode;
|
||||
transformedNode: IAstNode;
|
||||
begin
|
||||
newList := TList<IAstNode>.Create;
|
||||
try
|
||||
@@ -126,9 +131,10 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
var transformedValue := node.Accept(self);
|
||||
if not transformedValue.IsVoid then
|
||||
newList.Add(transformedValue.AsIntf<IAstNode>);
|
||||
// Use the IAstNode-returning Accept helper
|
||||
transformedNode := Self.Accept(node);
|
||||
if Assigned(transformedNode) then
|
||||
newList.Add(transformedNode);
|
||||
end;
|
||||
end;
|
||||
Result := newList.ToArray;
|
||||
@@ -137,7 +143,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue;
|
||||
function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): IAstNode;
|
||||
var
|
||||
value: TDataValue;
|
||||
expr: IAstNode;
|
||||
@@ -155,7 +161,7 @@ begin
|
||||
var argValue := FMacroScope.Values[symbol.Address];
|
||||
if argValue.Kind = vkInterface then
|
||||
begin
|
||||
Result := argValue;
|
||||
Result := argValue.AsIntf<IAstNode>; // Return the node directly
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
@@ -167,44 +173,44 @@ begin
|
||||
// If the result is an AST node (e.g. from a helper function), return it directly.
|
||||
if value.Kind = vkInterface then
|
||||
begin
|
||||
Result := value;
|
||||
Result := value.AsIntf<IAstNode>;
|
||||
exit;
|
||||
end;
|
||||
|
||||
// If the result is a scalar, text, or void, wrap it in a TConstantNode.
|
||||
if value.Kind in [vkScalar, vkText, vkVoid] then
|
||||
begin
|
||||
Result := TDataValue.FromIntf<IAstNode>(TAst.Constant(value));
|
||||
Result := TAst.Constant(value);
|
||||
end
|
||||
else
|
||||
raise Exception.CreateFmt('Cannot unquote complex runtime value of type %s at compile time.', [value.Kind.ToString]);
|
||||
end;
|
||||
|
||||
function TExpansionVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
|
||||
function TExpansionVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode;
|
||||
begin
|
||||
// This should be handled by the caller (VisitFunctionCall / VisitBlockExpression)
|
||||
raise Exception.Create('Unquote-splicing (`~@`) can only appear inside a list form (e.g., a function call or a `do` block).');
|
||||
end;
|
||||
|
||||
function TExpansionVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||
function TExpansionVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
|
||||
var
|
||||
newArgs: TArray<IAstNode>;
|
||||
transformedCallee: IAstNode;
|
||||
begin
|
||||
transformedCallee := Self.Accept(Node.Callee).AsIntf<IAstNode>;
|
||||
transformedCallee := Self.Accept(Node.Callee); // Calls IAstNode helper
|
||||
newArgs := TransformAndSpliceNodes(Node.Arguments);
|
||||
Result := TDataValue.FromIntf<IFunctionCallNode>(TAst.FunctionCall(transformedCallee, newArgs));
|
||||
Result := TAst.FunctionCall(transformedCallee, newArgs);
|
||||
end;
|
||||
|
||||
function TExpansionVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
||||
function TExpansionVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
|
||||
var
|
||||
newExprs: TArray<IAstNode>;
|
||||
begin
|
||||
newExprs := TransformAndSpliceNodes(Node.Expressions);
|
||||
Result := TDataValue.FromIntf<IBlockExpressionNode>(TAst.Block(newExprs));
|
||||
Result := TAst.Block(newExprs);
|
||||
end;
|
||||
|
||||
function TExpansionVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
|
||||
function TExpansionVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode;
|
||||
begin
|
||||
// Record literals do not support splicing.
|
||||
// We just use the default TAstTransformer implementation which visits child values.
|
||||
@@ -238,40 +244,30 @@ end;
|
||||
function TMacroExpander.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
|
||||
begin
|
||||
// This executes the transformation (Accept)
|
||||
var transformedValue := Accept(RootNode);
|
||||
Result := Accept(RootNode); // Calls the IAstNode-returning helper
|
||||
|
||||
if transformedValue.IsVoid then
|
||||
Result := TAst.Block([])
|
||||
else
|
||||
Result := transformedValue.AsIntf<IAstNode>;
|
||||
if not Assigned(Result) then
|
||||
Result := TAst.Block([]); // e.g. if root was (defmacro ...)
|
||||
|
||||
Descriptor := FCurrentDescriptor;
|
||||
end;
|
||||
|
||||
function TMacroExpander.Accept(const Node: IAstNode): TDataValue;
|
||||
begin
|
||||
// Standard transformer Accept
|
||||
if (not Assigned(Node)) or Done then
|
||||
exit;
|
||||
Result := Node.Accept(Self);
|
||||
end;
|
||||
|
||||
function TMacroExpander.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
|
||||
function TMacroExpander.VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode;
|
||||
begin
|
||||
// Register the macro in the current descriptor
|
||||
FCurrentDescriptor.DefineMacro(Node.Name.Name, Node);
|
||||
// Remove the (defmacro ...) node from the AST; it's compile-time only.
|
||||
Result := TDataValue.Void;
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TMacroExpander.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||
function TMacroExpander.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
|
||||
var
|
||||
calleeIdentifier: TIdentifierNode;
|
||||
macroDef: IMacroDefinitionNode;
|
||||
i: Integer;
|
||||
begin
|
||||
// Check if this is an identifier
|
||||
if not (Node.Callee is TIdentifierNode) then
|
||||
if Node.Callee.Kind <> akIdentifier then
|
||||
exit(inherited VisitFunctionCall(Node));
|
||||
|
||||
calleeIdentifier := Node.Callee as TIdentifierNode;
|
||||
@@ -292,7 +288,7 @@ begin
|
||||
|
||||
// 2. Populate scope: Map parameter names to the *un-evaluated* AST nodes
|
||||
for i := 0 to High(params) do
|
||||
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
|
||||
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i])); // Use FromIntf
|
||||
|
||||
// 3. Create the evaluation callback (TEvaluateProc)
|
||||
var evaluatorProc: TEvaluateProc;
|
||||
@@ -300,26 +296,33 @@ begin
|
||||
function(const ANodeToEvaluate: IAstNode): TDataValue
|
||||
var
|
||||
subDescriptor: IScopeDescriptor;
|
||||
evalScope: IExecutionScope;
|
||||
evaluator: IEvaluatorVisitor;
|
||||
boundSubAst: IAstNode;
|
||||
begin
|
||||
// This is the compile-time evaluation (Binder + Evaluator)
|
||||
// It runs in the *current* context (FInitialScope + FCurrentDescriptor)
|
||||
// not the expansionScope.
|
||||
var tempInitScope := TScope.CreateScope(FInitialScope.Parent, FCurrentDescriptor, nil);
|
||||
var boundSubAst := TAstBinder.Bind(tempInitScope, ANodeToEvaluate, subDescriptor);
|
||||
var evalScope := subDescriptor.CreateScope(tempInitScope);
|
||||
var evaluator := FEvaluatorFactory(evalScope);
|
||||
|
||||
// Bind (mutates ANodeToEvaluate) and get its descriptor
|
||||
boundSubAst := TAstBinder.Bind(tempInitScope, ANodeToEvaluate, subDescriptor);
|
||||
|
||||
// Create eval scope from the new descriptor
|
||||
evalScope := subDescriptor.CreateScope(tempInitScope);
|
||||
|
||||
evaluator := FEvaluatorFactory(evalScope);
|
||||
Result := evaluator.Execute(boundSubAst);
|
||||
end;
|
||||
|
||||
// 4. Expand the macro body using the TExpansionVisitor
|
||||
var expandedBody := TExpansionVisitor.Expand(expansionScope, macroDef.Body.Expression, evaluatorProc);
|
||||
var expandedBody := TExpansionVisitor.Expand(expansionScope, macroDef.Body.AsUnquoteSplicing.Expression, evaluatorProc);
|
||||
|
||||
// 5. Wrap the result in a MacroExpansionNode (for debugging/tracing)
|
||||
var macroNode := TMacroExpansionNode.Create(Node, expandedBody);
|
||||
var macroNode := TAst.MacroExpansionNode(Node, expandedBody);
|
||||
|
||||
// 6. IMPORTANT: Re-run the expander on the *new* AST fragment
|
||||
// to handle macros that expand into other macros.
|
||||
Result := Self.Accept(macroNode);
|
||||
Result := Self.Accept(macroNode); // Calls the IAstNode helper, returns IAstNode
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -38,6 +38,34 @@ type
|
||||
ISeriesLengthNode = interface;
|
||||
IRecurNode = interface;
|
||||
|
||||
// Defines the concrete kinds of AST nodes
|
||||
TAstNodeKind = (
|
||||
akConstant,
|
||||
akIdentifier,
|
||||
akKeyword,
|
||||
akBinaryExpression,
|
||||
akUnaryExpression,
|
||||
akIfExpression,
|
||||
akTernaryExpression,
|
||||
akLambdaExpression,
|
||||
akFunctionCall,
|
||||
akMacroExpansion,
|
||||
akBlockExpression,
|
||||
akVariableDeclaration,
|
||||
akAssignment,
|
||||
akMacroDefinition,
|
||||
akQuasiquote,
|
||||
akUnquote,
|
||||
akUnquoteSplicing,
|
||||
akIndexer,
|
||||
akMemberAccess,
|
||||
akRecordLiteral,
|
||||
akCreateSeries,
|
||||
akAddSeriesItem,
|
||||
akSeriesLength,
|
||||
akRecur
|
||||
);
|
||||
|
||||
// --- Concrete Type Definitions ---
|
||||
|
||||
// Defines how an identifier's address was resolved.
|
||||
@@ -88,7 +116,37 @@ type
|
||||
end;
|
||||
|
||||
IAstNode = interface(IInterface)
|
||||
{$region 'private'}
|
||||
function GetKind: TAstNodeKind;
|
||||
{$endregion}
|
||||
function Accept(const Visitor: IAstVisitor): TDataValue;
|
||||
|
||||
function AsConstant: IConstantNode;
|
||||
function AsIdentifier: IIdentifierNode;
|
||||
function AsKeyword: IKeywordNode;
|
||||
function AsBinaryExpression: IBinaryExpressionNode;
|
||||
function AsUnaryExpression: IUnaryExpressionNode;
|
||||
function AsIfExpression: IIfExpressionNode;
|
||||
function AsTernaryExpression: ITernaryExpressionNode;
|
||||
function AsLambdaExpression: ILambdaExpressionNode;
|
||||
function AsFunctionCall: IFunctionCallNode;
|
||||
function AsMacroExpansion: IMacroExpansionNode;
|
||||
function AsBlockExpression: IBlockExpressionNode;
|
||||
function AsVariableDeclaration: IVariableDeclarationNode;
|
||||
function AsAssignment: IAssignmentNode;
|
||||
function AsMacroDefinition: IMacroDefinitionNode;
|
||||
function AsQuasiquote: IQuasiquoteNode;
|
||||
function AsUnquote: IUnquoteNode;
|
||||
function AsUnquoteSplicing: IUnquoteSplicingNode;
|
||||
function AsIndexer: IIndexerNode;
|
||||
function AsMemberAccess: IMemberAccessNode;
|
||||
function AsRecordLiteral: IRecordLiteralNode;
|
||||
function AsCreateSeries: ICreateSeriesNode;
|
||||
function AsAddSeriesItem: IAddSeriesItemNode;
|
||||
function AsSeriesLength: ISeriesLengthNode;
|
||||
function AsRecur: IRecurNode;
|
||||
|
||||
property Kind: TAstNodeKind read GetKind;
|
||||
end;
|
||||
|
||||
IConstantNode = interface(IAstNode)
|
||||
@@ -221,11 +279,11 @@ type
|
||||
{$region 'private'}
|
||||
function GetName: IIdentifierNode;
|
||||
function GetParameters: TArray<IIdentifierNode>;
|
||||
function GetBody: IQuasiquoteNode;
|
||||
function GetBody: IAstNode;
|
||||
{$endregion}
|
||||
property Name: IIdentifierNode read GetName;
|
||||
property Parameters: TArray<IIdentifierNode> read GetParameters;
|
||||
property Body: IQuasiquoteNode read GetBody;
|
||||
property Body: IAstNode read GetBody;
|
||||
end;
|
||||
|
||||
// Represents a quasiquoted expression, e.g., `(a b)
|
||||
@@ -247,9 +305,9 @@ type
|
||||
// Represents an unquote-splicing expression, e.g., ~@y
|
||||
IUnquoteSplicingNode = interface(IAstNode)
|
||||
{$region 'private'}
|
||||
function GetExpression: IAstNode;
|
||||
function GetExpression: IQuasiquoteNode;
|
||||
{$endregion}
|
||||
property Expression: IAstNode read GetExpression;
|
||||
property Expression: IQuasiquoteNode read GetExpression;
|
||||
end;
|
||||
|
||||
IIndexerNode = interface(IAstNode)
|
||||
|
||||
@@ -278,7 +278,8 @@ begin
|
||||
raise EArgumentException.Create('The argument to Memoize must be a function.');
|
||||
|
||||
// create a managed dictionary
|
||||
var cCache: TDataValue := TDictionary<Int64, TDataValue>.Create;
|
||||
var cCache: TDataValue;
|
||||
cCache.FromObj(TDictionary<Int64, TDataValue>.Create);
|
||||
|
||||
funcToMemoize := Args[0].AsMethod();
|
||||
|
||||
|
||||
+58
-81
@@ -181,6 +181,7 @@ type
|
||||
|
||||
// --- Internal Printer Implementation ---
|
||||
|
||||
// Inherits from the new non-generic TAstVisitor
|
||||
TPrettyPrintVisitor = class(TAstVisitor)
|
||||
private
|
||||
FBuilder: TStringBuilder;
|
||||
@@ -193,32 +194,33 @@ type
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function GetResult: string;
|
||||
// IAstVisitor
|
||||
// Helper
|
||||
function Execute(const RootNode: IAstNode): TDataValue;
|
||||
function VisitConstant(const Node: IConstantNode): TDataValue; override;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
|
||||
function VisitKeyword(const Node: IKeywordNode): 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 VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
|
||||
function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; override;
|
||||
function VisitUnquote(const Node: IUnquoteNode): TDataValue; override;
|
||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): 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 VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
|
||||
// Override abstract procedures from TAstVisitor
|
||||
procedure VisitConstant(const Node: IConstantNode); override;
|
||||
procedure VisitIdentifier(const Node: IIdentifierNode); override;
|
||||
procedure VisitKeyword(const Node: IKeywordNode); override;
|
||||
procedure VisitBinaryExpression(const Node: IBinaryExpressionNode); override;
|
||||
procedure VisitUnaryExpression(const Node: IUnaryExpressionNode); override;
|
||||
procedure VisitIfExpression(const Node: IIfExpressionNode); override;
|
||||
procedure VisitTernaryExpression(const Node: ITernaryExpressionNode); override;
|
||||
procedure VisitLambdaExpression(const Node: ILambdaExpressionNode); override;
|
||||
procedure VisitMacroDefinition(const Node: IMacroDefinitionNode); override;
|
||||
procedure VisitQuasiquote(const Node: IQuasiquoteNode); override;
|
||||
procedure VisitUnquote(const Node: IUnquoteNode); override;
|
||||
procedure VisitUnquoteSplicing(const Node: IUnquoteSplicingNode); override;
|
||||
procedure VisitFunctionCall(const Node: IFunctionCallNode); override;
|
||||
procedure VisitMacroExpansionNode(const Node: IMacroExpansionNode); override;
|
||||
procedure VisitBlockExpression(const Node: IBlockExpressionNode); override;
|
||||
procedure VisitVariableDeclaration(const Node: IVariableDeclarationNode); override;
|
||||
procedure VisitAssignment(const Node: IAssignmentNode); override;
|
||||
procedure VisitIndexer(const Node: IIndexerNode); override;
|
||||
procedure VisitMemberAccess(const Node: IMemberAccessNode); override;
|
||||
procedure VisitRecordLiteral(const Node: IRecordLiteralNode); override;
|
||||
procedure VisitCreateSeries(const Node: ICreateSeriesNode); override;
|
||||
procedure VisitAddSeriesItem(const Node: IAddSeriesItemNode); override;
|
||||
procedure VisitSeriesLength(const Node: ISeriesLengthNode); override;
|
||||
procedure VisitRecurNode(const Node: IRecurNode); override;
|
||||
end;
|
||||
|
||||
{ TLexer }
|
||||
@@ -592,7 +594,7 @@ begin
|
||||
if (Length(tailNodes) <> 3) or (tailTokens[0].Kind <> tkIdentifier) then
|
||||
raise Exception.Create('Syntax Error: ''defmacro'' requires a name, a parameter list, and a body.');
|
||||
|
||||
var macroName := IIdentifierNode(tailNodes[0]);
|
||||
var macroName := tailNodes[0].AsIdentifier;
|
||||
var macroParams := elements[2].Params;
|
||||
|
||||
if tailTokens[2].Kind <> tkBacktick then
|
||||
@@ -670,7 +672,7 @@ begin
|
||||
begin
|
||||
NextToken;
|
||||
expr := ParseExpression;
|
||||
Result.Node := TAst.UnquoteSplicing(expr.Node);
|
||||
Result.Node := TAst.UnquoteSplicing(expr.Node.AsQuasiquote);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@@ -781,7 +783,7 @@ begin
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode);
|
||||
var
|
||||
val: TDataValue;
|
||||
begin
|
||||
@@ -790,22 +792,19 @@ begin
|
||||
Append('"' + val.AsText + '"')
|
||||
else
|
||||
Append(val.ToString);
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode);
|
||||
begin
|
||||
Append(Node.Name);
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitKeyword(const Node: IKeywordNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitKeyword(const Node: IKeywordNode);
|
||||
begin
|
||||
Append(':' + Node.Value.Name);
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode);
|
||||
begin
|
||||
Append('(' + Node.Operator.ToString);
|
||||
Append(' ');
|
||||
@@ -813,19 +812,17 @@ begin
|
||||
Append(' ');
|
||||
Node.Right.Accept(Self);
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode);
|
||||
begin
|
||||
Append('(' + Node.Operator.ToString);
|
||||
Append(' ');
|
||||
Node.Right.Accept(Self);
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode);
|
||||
begin
|
||||
Append('(if ');
|
||||
Node.Condition.Accept(Self);
|
||||
@@ -840,10 +837,9 @@ begin
|
||||
Unindent;
|
||||
NewLine;
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode);
|
||||
begin
|
||||
Append('(? ');
|
||||
Node.Condition.Accept(Self);
|
||||
@@ -855,17 +851,15 @@ begin
|
||||
Unindent;
|
||||
NewLine;
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode);
|
||||
var
|
||||
param: IIdentifierNode;
|
||||
sb: TStringBuilder;
|
||||
begin
|
||||
sb := TStringBuilder.Create;
|
||||
try
|
||||
for param in Node.Parameters do
|
||||
for var param in Node.Parameters do
|
||||
sb.Append(param.Name + ' ');
|
||||
if sb.Length > 0 then
|
||||
sb.Remove(sb.Length - 1, 1); // remove trailing space
|
||||
@@ -881,17 +875,15 @@ begin
|
||||
Unindent;
|
||||
NewLine;
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitMacroDefinition(const Node: IMacroDefinitionNode);
|
||||
var
|
||||
param: IIdentifierNode;
|
||||
sb: TStringBuilder;
|
||||
begin
|
||||
sb := TStringBuilder.Create;
|
||||
try
|
||||
for param in Node.Parameters do
|
||||
for var param in Node.Parameters do
|
||||
sb.Append(param.Name + ' ');
|
||||
if sb.Length > 0 then
|
||||
sb.Remove(sb.Length - 1, 1);
|
||||
@@ -907,33 +899,29 @@ begin
|
||||
Unindent;
|
||||
NewLine;
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitQuasiquote(const Node: IQuasiquoteNode);
|
||||
begin
|
||||
Append('`');
|
||||
Node.Expression.Accept(Self);
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitUnquote(const Node: IUnquoteNode);
|
||||
begin
|
||||
Append('~');
|
||||
Node.Expression.Accept(Self);
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode);
|
||||
begin
|
||||
// To handle '~@', we need to check if the expression is an identifier '@'.
|
||||
// However, the parser logic now handles this, so we just print '~@'.
|
||||
Append('~@');
|
||||
Node.Expression.Accept(Self);
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode);
|
||||
var
|
||||
arg: IAstNode;
|
||||
begin
|
||||
@@ -942,7 +930,7 @@ begin
|
||||
begin
|
||||
Append('''');
|
||||
Node.Arguments[0].Accept(Self);
|
||||
exit(TDataValue.Void);
|
||||
exit;
|
||||
end;
|
||||
|
||||
Append('(');
|
||||
@@ -957,17 +945,16 @@ begin
|
||||
Unindent;
|
||||
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode);
|
||||
begin
|
||||
// For pretty-printing, show the original macro call, not the expanded body.
|
||||
// Delegate to the regular VisitFunctionCall to print it as such.
|
||||
Result := VisitFunctionCall(Node);
|
||||
VisitFunctionCall(Node);
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitRecurNode(const Node: IRecurNode);
|
||||
var
|
||||
arg: IAstNode;
|
||||
begin
|
||||
@@ -981,10 +968,9 @@ begin
|
||||
Unindent;
|
||||
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNode);
|
||||
var
|
||||
expr: IAstNode;
|
||||
begin
|
||||
@@ -998,10 +984,9 @@ begin
|
||||
Unindent;
|
||||
NewLine;
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode);
|
||||
begin
|
||||
Append('(def ');
|
||||
Node.Identifier.Accept(Self);
|
||||
@@ -1011,47 +996,43 @@ begin
|
||||
Node.Initializer.Accept(Self);
|
||||
end;
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitAssignment(const Node: IAssignmentNode);
|
||||
begin
|
||||
Append('(assign ');
|
||||
Node.Identifier.Accept(Self);
|
||||
Append(' ');
|
||||
Node.Value.Accept(Self);
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitIndexer(const Node: IIndexerNode);
|
||||
begin
|
||||
Append('(get ');
|
||||
Node.Base.Accept(Self);
|
||||
Append(' ');
|
||||
Node.Index.Accept(Self);
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitMemberAccess(const Node: IMemberAccessNode);
|
||||
begin
|
||||
Append('(.');
|
||||
Node.Member.Accept(Self);
|
||||
Append(' ');
|
||||
Node.Base.Accept(Self);
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode);
|
||||
var
|
||||
field: TRecordFieldLiteral;
|
||||
begin
|
||||
if Length(Node.Fields) = 0 then
|
||||
begin
|
||||
Append('{}');
|
||||
exit(TDataValue.Void);
|
||||
exit;
|
||||
end;
|
||||
|
||||
Append('{');
|
||||
@@ -1066,16 +1047,14 @@ begin
|
||||
Unindent;
|
||||
NewLine;
|
||||
Append('}');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitCreateSeries(const Node: ICreateSeriesNode);
|
||||
begin
|
||||
Append(Format('(new-series "%s")', [Node.Definition]));
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode);
|
||||
begin
|
||||
Append('(add-item ');
|
||||
Node.Series.Accept(Self);
|
||||
@@ -1087,15 +1066,13 @@ begin
|
||||
Node.Lookback.Accept(Self);
|
||||
end;
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
||||
procedure TPrettyPrintVisitor.VisitSeriesLength(const Node: ISeriesLengthNode);
|
||||
begin
|
||||
Append('(count ');
|
||||
Node.Series.Accept(Self);
|
||||
Append(')');
|
||||
Result := TDataValue.Void;
|
||||
end;
|
||||
|
||||
{ TAstScript }
|
||||
|
||||
+196
-176
@@ -12,8 +12,7 @@ uses
|
||||
Myc.Ast.Visitor,
|
||||
Myc.Ast.Scope,
|
||||
Myc.Ast.Types,
|
||||
Myc.Ast,
|
||||
Myc.Ast.Binding.Nodes;
|
||||
Myc.Ast;
|
||||
|
||||
type
|
||||
IAstTypeChecker = interface(IAstVisitor)
|
||||
@@ -27,33 +26,34 @@ type
|
||||
TTypeChecker = class(TAstTransformer, IAstTypeChecker)
|
||||
private
|
||||
FCurrentDescriptor: IScopeDescriptor;
|
||||
function SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue;
|
||||
function SetType(const Node: IAstNode; const AType: IStaticType): IAstNode;
|
||||
protected
|
||||
// Override all visit methods to perform type checking
|
||||
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
|
||||
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
|
||||
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
|
||||
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
|
||||
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
|
||||
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
|
||||
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
|
||||
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
|
||||
function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override;
|
||||
function VisitAssignment(const Node: IAssignmentNode): IAstNode; override;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
|
||||
function VisitIfExpression(const Node: IIfExpressionNode): IAstNode; override;
|
||||
function VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode; override;
|
||||
function VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode; override;
|
||||
function VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode; override;
|
||||
function VisitMemberAccess(const Node: IMemberAccessNode): IAstNode; override;
|
||||
function VisitIndexer(const Node: IIndexerNode): IAstNode; override;
|
||||
function VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): IAstNode; override;
|
||||
|
||||
// Base cases (types are already set by Binder)
|
||||
function VisitConstant(const Node: IConstantNode): IAstNode; override;
|
||||
function VisitKeyword(const Node: IKeywordNode): IAstNode; override;
|
||||
|
||||
// Base cases (types are already known from binder)
|
||||
function VisitConstant(const Node: IConstantNode): TDataValue; override;
|
||||
function VisitKeyword(const Node: IKeywordNode): TDataValue; override;
|
||||
// Compile-time nodes (should not be present)
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override;
|
||||
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): IAstNode; override;
|
||||
function VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode; override;
|
||||
public
|
||||
constructor Create(const ADescriptor: IScopeDescriptor);
|
||||
function Execute(const RootNode: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode;
|
||||
@@ -85,165 +85,166 @@ end;
|
||||
function TTypeChecker.Execute(const RootNode: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode;
|
||||
begin
|
||||
FCurrentDescriptor := ADescriptor;
|
||||
var transformedValue := Accept(RootNode);
|
||||
if transformedValue.IsVoid then
|
||||
Result := TAst.Block([])
|
||||
else
|
||||
Result := transformedValue.AsIntf<IAstNode>;
|
||||
(Result as TAstNode).StaticType := (Result as TAstNode).StaticType;
|
||||
Result := Accept(RootNode); // Use IAstNode-returning Accept
|
||||
if not Assigned(Result) then
|
||||
Result := TAst.Block([]);
|
||||
|
||||
// (Result as TAstNode).StaticType is set by the last Visit call
|
||||
end;
|
||||
|
||||
function TTypeChecker.SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue;
|
||||
function TTypeChecker.SetType(const Node: IAstNode; const AType: IStaticType): IAstNode;
|
||||
begin
|
||||
if (not NodeData.IsVoid) and (NodeData.Kind = vkInterface) then
|
||||
(NodeData.AsIntf<IAstNode> as TAstNode).StaticType := AType;
|
||||
Result := NodeData;
|
||||
if Assigned(Node) then
|
||||
(Node as TAstNode).StaticType := AType;
|
||||
Result := Node;
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitConstant(const Node: IConstantNode): TDataValue;
|
||||
function TTypeChecker.VisitConstant(const Node: IConstantNode): IAstNode;
|
||||
begin
|
||||
// Type was set by Binder, just propagate it up.
|
||||
Result := TDataValue.FromIntf<IConstantNode>(Node);
|
||||
Result := inherited VisitConstant(Node);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitKeyword(const Node: IKeywordNode): TDataValue;
|
||||
function TTypeChecker.VisitKeyword(const Node: IKeywordNode): IAstNode;
|
||||
begin
|
||||
// Type was set by Binder, just propagate it up.
|
||||
Result := TDataValue.FromIntf<IKeywordNode>(Node);
|
||||
Result := inherited VisitKeyword(Node);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
|
||||
function TTypeChecker.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
|
||||
begin
|
||||
// Type was set by Binder (read from scope), just propagate it up.
|
||||
Result := TDataValue.FromIntf<IIdentifierNode>(Node);
|
||||
Result := inherited VisitIdentifier(Node);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitRecurNode(const Node: IRecurNode): TDataValue;
|
||||
function TTypeChecker.VisitRecurNode(const Node: IRecurNode): IAstNode;
|
||||
begin
|
||||
// Type was set by Binder (TTypes.Void), just propagate it up.
|
||||
Result := TDataValue.FromIntf<IRecurNode>(Node);
|
||||
Result := inherited VisitRecurNode(Node);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
|
||||
function TTypeChecker.VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode;
|
||||
begin
|
||||
raise Exception.Create('TTypeChecker: MacroDefinition node encountered.');
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
|
||||
function TTypeChecker.VisitMacroExpansionNode(const Node: IMacroExpansionNode): IAstNode;
|
||||
begin
|
||||
raise Exception.Create('TTypeChecker: MacroExpansionNode node encountered.');
|
||||
// TypeChecker runs *after* expansion, so we just visit the body.
|
||||
Result := Accept(Node.ExpandedBody);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
||||
function TTypeChecker.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
|
||||
var
|
||||
initNode: IAstNode;
|
||||
initType: IStaticType;
|
||||
boundIdent: TBoundIdentifierNode;
|
||||
boundIdent: TIdentifierNode;
|
||||
adr: TResolvedAddress;
|
||||
begin
|
||||
// 1. Visit the initializer (if it exists) to get its (now-inferred) type.
|
||||
// 1. Visit children first (Identifier is leaf, Initializer is traversed)
|
||||
inherited;
|
||||
|
||||
// 2. Get initializer type
|
||||
if Assigned(Node.Initializer) then
|
||||
begin
|
||||
initNode := Accept(Node.Initializer).AsIntf<IAstNode>;
|
||||
initType := (initNode as TAstNode).StaticType;
|
||||
end
|
||||
initType := (Node.Initializer as TAstNode).StaticType
|
||||
else
|
||||
initType := TTypes.Void;
|
||||
|
||||
// 2. Get the address from the bound identifier.
|
||||
boundIdent := (Node.Identifier as TBoundIdentifierNode);
|
||||
// 3. Get the address from the bound identifier.
|
||||
boundIdent := (Node.Identifier as TIdentifierNode);
|
||||
adr := boundIdent.Address;
|
||||
|
||||
// 3. Update the type in the scope descriptor (which was set to Unknown by the binder).
|
||||
// 4. Update the type in the scope descriptor (which was set to Unknown by the binder).
|
||||
FCurrentDescriptor.UpdateType(adr.SlotIndex, initType);
|
||||
|
||||
// 4. Update the static types of the nodes themselves.
|
||||
// 5. Update the static types of the nodes themselves.
|
||||
(boundIdent as TAstNode).StaticType := initType;
|
||||
Result := SetType(TDataValue.FromIntf(Node), initType);
|
||||
Result := SetType(Node, initType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
||||
function TTypeChecker.VisitAssignment(const Node: IAssignmentNode): IAstNode;
|
||||
var
|
||||
boundIdentifier, boundValue: IAstNode;
|
||||
targetType, sourceType: IStaticType;
|
||||
begin
|
||||
boundIdentifier := Accept(Node.Identifier).AsIntf<IAstNode>;
|
||||
boundValue := Accept(Node.Value).AsIntf<IAstNode>;
|
||||
// 1. Visit children first (Identifier, Value)
|
||||
inherited;
|
||||
|
||||
targetType := (boundIdentifier as TAstNode).StaticType;
|
||||
sourceType := (boundValue as TAstNode).StaticType;
|
||||
// 2. Get types
|
||||
targetType := (Node.Identifier as TAstNode).StaticType;
|
||||
sourceType := (Node.Value as TAstNode).StaticType;
|
||||
|
||||
// 3. Check assignment
|
||||
if not TTypeRules.CanAssign(targetType, sourceType) then
|
||||
raise ETypeException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]);
|
||||
|
||||
Result := SetType(TDataValue.FromIntf<IAssignmentNode>(Node), targetType);
|
||||
Result := SetType(Node, targetType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
|
||||
function TTypeChecker.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
|
||||
var
|
||||
boundNode: TBoundLambdaExpressionNode;
|
||||
boundBody: IAstNode;
|
||||
boundNode: TLambdaExpressionNode;
|
||||
bodyType, methodType: IStaticType;
|
||||
paramTypes: TArray<IStaticType>;
|
||||
i: Integer;
|
||||
savedDescriptor: IScopeDescriptor;
|
||||
begin
|
||||
boundNode := (Node as TBoundLambdaExpressionNode);
|
||||
boundNode := (Node as TLambdaExpressionNode);
|
||||
|
||||
// 1. Enter the lambda's scope
|
||||
// 1. Enter the lambda's scope (which Binder already created)
|
||||
savedDescriptor := FCurrentDescriptor;
|
||||
FCurrentDescriptor := boundNode.ScopeDescriptor;
|
||||
try
|
||||
// 2. Set parameter types (currently Unknown, but required for signature)
|
||||
// 2. Parameters are leaves, so we don't try to evaluate them
|
||||
|
||||
// 3. Get parameter types (currently Unknown, but required for signature)
|
||||
SetLength(paramTypes, Length(boundNode.Parameters));
|
||||
for i := 0 to High(boundNode.Parameters) do
|
||||
paramTypes[i] := (boundNode.Parameters[i] as TAstNode).StaticType; // Propagates Unknown
|
||||
|
||||
// 3. Visit the body to infer its return type
|
||||
boundBody := Accept(boundNode.Body).AsIntf<IAstNode>;
|
||||
bodyType := (boundBody as TAstNode).StaticType;
|
||||
// 4. Visit the body to infer its return type
|
||||
Accept(boundNode.Body);
|
||||
bodyType := (boundNode.Body as TAstNode).StaticType;
|
||||
|
||||
// 4. Create the final method type
|
||||
// 5. Create the final method type
|
||||
methodType := TTypes.CreateMethod(paramTypes, bodyType);
|
||||
|
||||
// 5. Update the type for <self> (Slot 0) in the descriptor
|
||||
// 6. Update the type for <self> (Slot 0) in the descriptor
|
||||
FCurrentDescriptor.UpdateType(0, methodType);
|
||||
|
||||
finally
|
||||
// 6. Restore parent descriptor
|
||||
FCurrentDescriptor := FCurrentDescriptor.Parent;
|
||||
// 7. Restore parent descriptor
|
||||
FCurrentDescriptor := savedDescriptor;
|
||||
end;
|
||||
|
||||
// 7. Set the type of the lambda node itself
|
||||
Result := SetType(TDataValue.FromIntf<ILambdaExpressionNode>(boundNode), methodType);
|
||||
// 8. Set the type of the lambda node itself
|
||||
Result := SetType(boundNode, methodType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
||||
function TTypeChecker.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
|
||||
var
|
||||
callee: IAstNode;
|
||||
args: TArray<IAstNode>;
|
||||
calleeType, retType: IStaticType;
|
||||
i: Integer;
|
||||
begin
|
||||
// 1. Visit children first (bottom-up)
|
||||
callee := Accept(Node.Callee).AsIntf<IAstNode>;
|
||||
args := AcceptNodes<IAstNode>(Node.Arguments);
|
||||
inherited;
|
||||
|
||||
// 2. Get callee type (now inferred)
|
||||
calleeType := (callee as TAstNode).StaticType;
|
||||
calleeType := (Node.Callee as TAstNode).StaticType;
|
||||
retType := TTypes.Unknown; // Default if not a method
|
||||
|
||||
// 3. Perform type checking
|
||||
if calleeType.Kind = TStaticTypeKind.stMethod then
|
||||
begin
|
||||
var signature := calleeType.Signature;
|
||||
if Length(args) <> Length(signature.ParamTypes) then
|
||||
raise ETypeException.CreateFmt('Function expects %d arguments, but got %d', [Length(signature.ParamTypes), Length(args)]);
|
||||
if Length(Node.Arguments) <> Length(signature.ParamTypes) then
|
||||
raise ETypeException
|
||||
.CreateFmt('Function expects %d arguments, but got %d', [Length(signature.ParamTypes), Length(Node.Arguments)]);
|
||||
|
||||
retType := signature.ReturnType;
|
||||
|
||||
// Check argument types
|
||||
for i := 0 to High(args) do
|
||||
for i := 0 to High(Node.Arguments) do
|
||||
begin
|
||||
var argType := (args[i] as TAstNode).StaticType;
|
||||
var argType := (Node.Arguments[i] as TAstNode).StaticType;
|
||||
var paramType := signature.ParamTypes[i];
|
||||
if not TTypeRules.CanAssign(paramType, argType) then
|
||||
raise ETypeException
|
||||
@@ -254,99 +255,111 @@ begin
|
||||
raise ETypeException.CreateFmt('Cannot invoke type %s as a function.', [calleeType.ToString]);
|
||||
|
||||
// 4. Set the type for this call node
|
||||
Result := SetType(TDataValue.FromIntf<IFunctionCallNode>(Node), retType);
|
||||
Result := SetType(Node, retType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
||||
function TTypeChecker.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
|
||||
var
|
||||
blockType: IStaticType;
|
||||
exprs: TArray<IAstNode>;
|
||||
begin
|
||||
exprs := AcceptNodes<IAstNode>(Node.Expressions);
|
||||
// 1. Visit children
|
||||
inherited;
|
||||
|
||||
if Length(exprs) > 0 then
|
||||
blockType := (exprs[High(exprs)] as TAstNode).StaticType
|
||||
// 2. Type is type of last expression
|
||||
if Length(Node.Expressions) > 0 then
|
||||
blockType := (Node.Expressions[High(Node.Expressions)] as TAstNode).StaticType
|
||||
else
|
||||
blockType := TTypes.Void;
|
||||
|
||||
Result := SetType(TDataValue.FromIntf<IBlockExpressionNode>(Node), blockType);
|
||||
Result := SetType(Node, blockType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
||||
function TTypeChecker.VisitIfExpression(const Node: IIfExpressionNode): IAstNode;
|
||||
var
|
||||
condition, thenBranch, elseBranch: IAstNode;
|
||||
conditionType, thenType, elseType, resultType: IStaticType;
|
||||
begin
|
||||
condition := Accept(Node.Condition).AsIntf<IAstNode>;
|
||||
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
|
||||
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>; // Accept(nil) returns void
|
||||
// 1. Visit children
|
||||
inherited;
|
||||
|
||||
conditionType := (condition as TAstNode).StaticType;
|
||||
// 2. Check condition
|
||||
conditionType := (Node.Condition as TAstNode).StaticType;
|
||||
if (conditionType.Kind <> stUnknown) and not TTypeRules.CanAssign(TTypes.Ordinal, conditionType) then
|
||||
raise ETypeException.CreateFmt('If condition must be Ordinal, but got %s', [conditionType.ToString]);
|
||||
|
||||
thenType := (thenBranch as TAstNode).StaticType;
|
||||
// 3. Promote branch types
|
||||
thenType := (Node.ThenBranch as TAstNode).StaticType;
|
||||
elseType :=
|
||||
if elseBranch <> nil then (elseBranch as TAstNode).StaticType
|
||||
if Node.ElseBranch <> nil then (Node.ElseBranch as TAstNode).StaticType
|
||||
else TTypes.Void;
|
||||
|
||||
resultType := TTypeRules.Promote(thenType, elseType);
|
||||
Result := SetType(TDataValue.FromIntf<IIfExpressionNode>(Node), resultType);
|
||||
Result := SetType(Node, resultType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
|
||||
function TTypeChecker.VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode;
|
||||
var
|
||||
condition, thenBranch, elseBranch: IAstNode;
|
||||
conditionType, thenType, elseType, resultType: IStaticType;
|
||||
begin
|
||||
condition := Accept(Node.Condition).AsIntf<IAstNode>;
|
||||
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
|
||||
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
|
||||
// 1. Visit children
|
||||
inherited;
|
||||
|
||||
conditionType := (condition as TAstNode).StaticType;
|
||||
// 2. Check condition
|
||||
conditionType := (Node.Condition as TAstNode).StaticType;
|
||||
if (conditionType.Kind <> stUnknown) and not TTypeRules.CanAssign(TTypes.Ordinal, conditionType) then
|
||||
raise ETypeException.CreateFmt('Ternary condition must be Ordinal, but got %s', [conditionType.ToString]);
|
||||
|
||||
thenType := (thenBranch as TAstNode).StaticType;
|
||||
elseType := (elseBranch as TAstNode).StaticType;
|
||||
// 3. Promote branch types
|
||||
thenType := (Node.ThenBranch as TAstNode).StaticType;
|
||||
elseType := (Node.ElseBranch as TAstNode).StaticType;
|
||||
|
||||
resultType := TTypeRules.Promote(thenType, elseType);
|
||||
Result := SetType(TDataValue.FromIntf<ITernaryExpressionNode>(Node), resultType);
|
||||
Result := SetType(Node, resultType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
||||
function TTypeChecker.VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode;
|
||||
var
|
||||
left, right: IAstNode;
|
||||
leftType, rightType, resultType: IStaticType;
|
||||
begin
|
||||
left := Accept(Node.Left).AsIntf<IAstNode>;
|
||||
right := Accept(Node.Right).AsIntf<IAstNode>;
|
||||
leftType := (left as TAstNode).StaticType;
|
||||
rightType := (right as TAstNode).StaticType;
|
||||
// 1. Visit children
|
||||
inherited;
|
||||
|
||||
// 2. Get types
|
||||
leftType := (Node.Left as TAstNode).StaticType;
|
||||
rightType := (Node.Right as TAstNode).StaticType;
|
||||
|
||||
// 3. Resolve
|
||||
resultType := TTypeRules.ResolveBinaryOp(Node.Operator, leftType, rightType);
|
||||
Result := SetType(TDataValue.FromIntf<IBinaryExpressionNode>(Node), resultType);
|
||||
Result := SetType(Node, resultType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
||||
function TTypeChecker.VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode;
|
||||
var
|
||||
right: IAstNode;
|
||||
rightType, resultType: IStaticType;
|
||||
begin
|
||||
right := Accept(Node.Right).AsIntf<IAstNode>;
|
||||
rightType := (right as TAstNode).StaticType;
|
||||
// 1. Visit children
|
||||
inherited;
|
||||
|
||||
// 2. Get types
|
||||
rightType := (Node.Right as TAstNode).StaticType;
|
||||
|
||||
// 3. Resolve
|
||||
resultType := TTypeRules.ResolveUnaryOp(Node.Operator, rightType);
|
||||
Result := SetType(TDataValue.FromIntf<IUnaryExpressionNode>(Node), resultType);
|
||||
Result := SetType(Node, resultType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
||||
function TTypeChecker.VisitMemberAccess(const Node: IMemberAccessNode): IAstNode;
|
||||
var
|
||||
baseNode: IAstNode;
|
||||
baseType, elemType: IStaticType;
|
||||
fieldIndex: Integer;
|
||||
begin
|
||||
baseNode := Accept(Node.Base).AsIntf<IAstNode>;
|
||||
baseType := (baseNode as TAstNode).StaticType;
|
||||
// 1. Visit children
|
||||
inherited;
|
||||
|
||||
// 2. Get types
|
||||
baseType := (Node.Base as TAstNode).StaticType;
|
||||
elemType := TTypes.Unknown;
|
||||
|
||||
// 3. Resolve
|
||||
if (baseType.Kind <> TStaticTypeKind.stUnknown) then
|
||||
begin
|
||||
if (baseType.Kind = TStaticTypeKind.stRecord) or (baseType.Kind = TStaticTypeKind.stRecordSeries) then
|
||||
@@ -376,20 +389,22 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Result := SetType(TDataValue.FromIntf<IMemberAccessNode>(Node), elemType);
|
||||
Result := SetType(Node, elemType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
||||
function TTypeChecker.VisitIndexer(const Node: IIndexerNode): IAstNode;
|
||||
var
|
||||
baseNode, indexNode: IAstNode;
|
||||
baseType, indexType, elemType: IStaticType;
|
||||
begin
|
||||
baseNode := Accept(Node.Base).AsIntf<IAstNode>;
|
||||
indexNode := Accept(Node.Index).AsIntf<IAstNode>;
|
||||
baseType := (baseNode as TAstNode).StaticType;
|
||||
indexType := (indexNode as TAstNode).StaticType;
|
||||
// 1. Visit children
|
||||
inherited;
|
||||
|
||||
// 2. Get types
|
||||
baseType := (Node.Base as TAstNode).StaticType;
|
||||
indexType := (Node.Index as TAstNode).StaticType;
|
||||
elemType := TTypes.Unknown;
|
||||
|
||||
// 3. Resolve
|
||||
if (baseType.Kind <> TStaticTypeKind.stUnknown) then
|
||||
begin
|
||||
if (baseType.Kind <> TStaticTypeKind.stSeries) and (baseType.Kind <> TStaticTypeKind.stRecordSeries) then
|
||||
@@ -404,13 +419,12 @@ begin
|
||||
elemType := TTypes.CreateRecord(baseType.Definition);
|
||||
end;
|
||||
|
||||
Result := SetType(TDataValue.FromIntf<IIndexerNode>(Node), elemType);
|
||||
Result := SetType(Node, elemType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
|
||||
function TTypeChecker.VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode;
|
||||
var
|
||||
i: Integer;
|
||||
boundFields: TArray<TRecordFieldLiteral>;
|
||||
scalarDefFields: TArray<TScalarRecordField>;
|
||||
def: IScalarRecordDefinition;
|
||||
staticType: IStaticType;
|
||||
@@ -418,19 +432,22 @@ var
|
||||
valType: IStaticType;
|
||||
scalarKind: TScalar.TKind;
|
||||
allScalar: Boolean;
|
||||
N: TGenericRecordLiteralNode; // Parser creates this type
|
||||
begin
|
||||
SetLength(boundFields, Length(Node.Fields));
|
||||
SetLength(scalarDefFields, Length(Node.Fields));
|
||||
// 1. Visit all child nodes first to infer their types
|
||||
inherited;
|
||||
|
||||
N := (Node as TGenericRecordLiteralNode);
|
||||
|
||||
SetLength(scalarDefFields, Length(N.Fields));
|
||||
allScalar := True;
|
||||
|
||||
// 1. Visit all child nodes first to infer their types
|
||||
for i := 0 to High(Node.Fields) do
|
||||
// 2. Check if this record literal can be a TScalarRecord
|
||||
for i := 0 to High(N.Fields) do
|
||||
begin
|
||||
valNode := Accept(Node.Fields[i].Value).AsIntf<IAstNode>;
|
||||
valNode := N.Fields[i].Value;
|
||||
valType := (valNode as TAstNode).StaticType;
|
||||
boundFields[i] := TRecordFieldLiteral.Create(Node.Fields[i].Key, valNode);
|
||||
|
||||
// 2. Check if this field fits the scalar path
|
||||
if (valType.Kind = stOrdinal) then
|
||||
scalarKind := TScalar.TKind.Ordinal
|
||||
else if (valType.Kind = stFloat) then
|
||||
@@ -444,51 +461,51 @@ begin
|
||||
end;
|
||||
|
||||
if allScalar then
|
||||
scalarDefFields[i] := TScalarRecordField.Create(Node.Fields[i].Key.Value, scalarKind);
|
||||
scalarDefFields[i] := TScalarRecordField.Create(N.Fields[i].Key.Value, scalarKind);
|
||||
end;
|
||||
|
||||
// 3. Create the appropriate record type (Scalar or Generic)
|
||||
// 3. Create the appropriate record type (Scalar or Generic) and mutate the node
|
||||
if allScalar then
|
||||
begin
|
||||
def := TScalarRecordRegistry.Intern(scalarDefFields);
|
||||
staticType := TTypes.CreateRecord(def);
|
||||
// We can re-use the TBoundRecordLiteralNode from the binder
|
||||
(Node as TBoundRecordLiteralNode).Definition := def;
|
||||
N.Definition := def; // Mutate
|
||||
N.GenericDefinition := nil; // Mutate
|
||||
end
|
||||
else
|
||||
begin
|
||||
var genDefFields: TArray<TPair<IKeyword, IStaticType>>;
|
||||
SetLength(genDefFields, Length(boundFields));
|
||||
for i := 0 to High(boundFields) do
|
||||
genDefFields[i] := TPair<IKeyword, IStaticType>.Create(boundFields[i].Key.Value, (boundFields[i].Value as TAstNode).StaticType);
|
||||
SetLength(genDefFields, Length(N.Fields));
|
||||
for i := 0 to High(N.Fields) do
|
||||
genDefFields[i] := TPair<IKeyword, IStaticType>.Create(N.Fields[i].Key.Value, (N.Fields[i].Value as TAstNode).StaticType);
|
||||
|
||||
var genDef := TGenericRecordRegistry.Intern(genDefFields);
|
||||
staticType := TTypes.CreateGenericRecord(genDef);
|
||||
// Re-use the TBoundGenericRecordLiteralNode from the binder
|
||||
(Node as TBoundGenericRecordLiteralNode).Definition := genDef;
|
||||
N.GenericDefinition := genDef; // Mutate
|
||||
N.Definition := nil; // Mutate
|
||||
end;
|
||||
|
||||
Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(Node), staticType);
|
||||
Result := SetType(N, staticType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
|
||||
function TTypeChecker.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode;
|
||||
begin
|
||||
// Type was set by Binder, just propagate it up.
|
||||
Result := TDataValue.FromIntf<ICreateSeriesNode>(Node);
|
||||
Result := inherited VisitCreateSeries(Node);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
||||
function TTypeChecker.VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode;
|
||||
var
|
||||
seriesNode, valueNode, lookbackNode: IAstNode;
|
||||
seriesType, valueType: IStaticType;
|
||||
begin
|
||||
seriesNode := Accept(Node.Series).AsIntf<IAstNode>;
|
||||
valueNode := Accept(Node.Value).AsIntf<IAstNode>;
|
||||
lookbackNode := Accept(Node.Lookback).AsIntf<IAstNode>;
|
||||
// 1. Visit children
|
||||
inherited;
|
||||
|
||||
seriesType := (seriesNode as TAstNode).StaticType;
|
||||
valueType := (valueNode as TAstNode).StaticType;
|
||||
// 2. Get types
|
||||
seriesType := (Node.Series as TAstNode).StaticType;
|
||||
valueType := (Node.Value as TAstNode).StaticType;
|
||||
|
||||
// 3. Check types
|
||||
if (seriesType.Kind <> stUnknown) then
|
||||
begin
|
||||
if (seriesType.Kind <> TStaticTypeKind.stSeries) then
|
||||
@@ -499,30 +516,33 @@ begin
|
||||
.CreateFmt('Cannot add item of type %s to series of type %s', [valueType.ToString, seriesType.ElementType.ToString]);
|
||||
end;
|
||||
|
||||
if (lookbackNode <> nil) then
|
||||
if (Node.Lookback <> nil) then
|
||||
begin
|
||||
var lookbackType := (lookbackNode as TAstNode).StaticType;
|
||||
var lookbackType := (Node.Lookback as TAstNode).StaticType;
|
||||
if (lookbackType.Kind <> stUnknown) and not (lookbackType.Kind = TStaticTypeKind.stOrdinal) then
|
||||
raise ETypeException.Create('Lookback parameter for "add" must be an ordinal value.');
|
||||
end;
|
||||
|
||||
Result := SetType(TDataValue.FromIntf<IAddSeriesItemNode>(Node), TTypes.Void);
|
||||
Result := SetType(Node, TTypes.Void);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
|
||||
function TTypeChecker.VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode;
|
||||
var
|
||||
seriesNode: IAstNode;
|
||||
seriesType: IStaticType;
|
||||
begin
|
||||
seriesNode := Accept(Node.Series).AsIntf<IAstNode>;
|
||||
seriesType := (seriesNode as TAstNode).StaticType;
|
||||
// 1. Visit children
|
||||
inherited;
|
||||
|
||||
// 2. Get type
|
||||
seriesType := (Node.Series as TAstNode).StaticType;
|
||||
|
||||
// 3. Check type
|
||||
if (seriesType.Kind <> stUnknown)
|
||||
and (seriesType.Kind <> TStaticTypeKind.stSeries)
|
||||
and (seriesType.Kind <> TStaticTypeKind.stRecordSeries) then
|
||||
raise ETypeException.CreateFmt('"length" requires a series, but got %s', [seriesType.ToString]);
|
||||
|
||||
Result := SetType(TDataValue.FromIntf<ISeriesLengthNode>(Node), TTypes.Ordinal);
|
||||
Result := SetType(Node, TTypes.Ordinal);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
+665
-361
File diff suppressed because it is too large
Load Diff
+1163
-655
File diff suppressed because it is too large
Load Diff
@@ -62,7 +62,6 @@ type
|
||||
class operator Implicit(const AValue: TDataValue): TScalar; overload; inline;
|
||||
class operator Implicit(const AValue: String): TDataValue; overload; inline;
|
||||
class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline;
|
||||
class operator Implicit(const AValue: TObject): TDataValue; overload; inline;
|
||||
|
||||
// atomic operations
|
||||
function CompareAndSet(const Expected, NewValue: TDataValue): Boolean;
|
||||
@@ -77,6 +76,9 @@ type
|
||||
class function FromPtr(const AValue: Pointer): TDataValue; static; inline;
|
||||
function AsPtr: Pointer; inline;
|
||||
|
||||
// This take ownership of the object!
|
||||
procedure FromObj(const AValue: TObject); inline;
|
||||
|
||||
class function Map(const SourceSeries: ISeries; const MapperFunc: TFunc): ISeries; static;
|
||||
|
||||
class function FromRecordSeries(const AValue: IRecordSeries): TDataValue; static; inline;
|
||||
@@ -158,12 +160,17 @@ function TDataValue.AsGeneric<T>: T;
|
||||
begin
|
||||
if FKind <> vkGeneric then
|
||||
raise EInvalidCast.Create('Cannot read value as generic of ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
|
||||
if PTypeInfo(TypeInfo(T)).Kind <> tkInterface then
|
||||
begin
|
||||
{$ifdef DEBUG}
|
||||
var val := TVal<T>(FInterface);
|
||||
if val.TypeHandle <> TypeInfo(T) then
|
||||
raise EInvalidCast.Create('Generic type is not a ' + String(PTypeInfo(TypeInfo(T)).Name) + '.');
|
||||
{$endif}
|
||||
Result := TVal<T>(FInterface).Value;
|
||||
end
|
||||
else
|
||||
IInterface(Pointer(@Result)^) := FInterface
|
||||
end;
|
||||
|
||||
function TDataValue.AsIntf<T>: T;
|
||||
@@ -278,6 +285,9 @@ end;
|
||||
class function TDataValue.FromGeneric<T>(const [ref] AValue: T): TDataValue;
|
||||
begin
|
||||
Result.FKind := vkGeneric;
|
||||
if PTypeInfo(TypeInfo(T)).Kind = tkInterface then
|
||||
Result.FInterface := IInterface(Pointer(@AValue)^)
|
||||
else
|
||||
Result.FInterface := TVal<T>.Create(AValue);
|
||||
end;
|
||||
|
||||
@@ -473,10 +483,10 @@ begin
|
||||
TFunc(Result.FInterface) := AValue;
|
||||
end;
|
||||
|
||||
class operator TDataValue.Implicit(const AValue: TObject): TDataValue;
|
||||
procedure TDataValue.FromObj(const AValue: TObject);
|
||||
begin
|
||||
Result.FKind := vkManagedObject;
|
||||
Result.FInterface := TObjVal.Create(AValue);
|
||||
FKind := vkManagedObject;
|
||||
FInterface := TObjVal.Create(AValue);
|
||||
end;
|
||||
|
||||
class operator TDataValue.Implicit(const AValue: TDataValue): TScalar;
|
||||
|
||||
Reference in New Issue
Block a user