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

Binder refactoring, Monster refactoring

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-02 19:38:52 +01:00
parent 8f29212cba
commit ea39a57b77
22 changed files with 3061 additions and 2638 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Analyzer.pas
+54 -34
View File
@@ -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.
Src/AST/Myc.Ast.Binding.Nodes.pas
-144
View File
@@ -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.
Src/AST/Myc.Ast.Binding.pas
+137 -295
View File
@@ -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.
Src/AST/Myc.Ast.Compiler.TCO.pas
+96 -63
View File
@@ -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.
Src/AST/Myc.Ast.Dumper.pas
+81 -102
View File
@@ -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.
Src/AST/Myc.Ast.Evaluator.pas
+56 -54
View File
@@ -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.
Src/AST/Myc.Ast.JSON.pas
+213 -408
View File
@@ -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.
Src/AST/Myc.Ast.Lowering.pas
+23 -27
View File
@@ -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
(Node as TAstNode).StaticType := AType;
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;
Src/AST/Myc.Ast.MacroExpander.pas
+54 -51
View File
@@ -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.
Src/AST/Myc.Ast.Nodes.pas
+62 -4
View File
@@ -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)
Src/AST/Myc.Ast.RTL.Core.pas
+2 -1
View File
@@ -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();
Src/AST/Myc.Ast.Script.pas
+61 -84
View File
@@ -29,7 +29,7 @@ var
atom ::= number | string | identifier | keyword
(* ---------------------------------------------------------------------- *)
(* ---- Reader-Macros (Syntactic Sugar) ---- *)
(* ---- Reader-Macros (Syntactic Sugar) ---- *)
(* ---------------------------------------------------------------------- *)
reader_macro ::= "'" expression (* (quote ...) *)
@@ -38,7 +38,7 @@ var
| "~@" expression (* (unquote-splicing ...) *)
(* ---------------------------------------------------------------------- *)
(* ---- Lists (S-Expressions) ---- *)
(* ---- Lists (S-Expressions) ---- *)
(* ---------------------------------------------------------------------- *)
(* A list is the primary structure for code. Empty lists () are invalid. *)
@@ -64,7 +64,7 @@ var
function_call ::= expression expression*
(* ---------------------------------------------------------------------- *)
(* ---- Parameter Lists and Records ---- *)
(* ---- Parameter Lists and Records ---- *)
(* ---------------------------------------------------------------------- *)
(* A parameter list is *only* valid inside 'fn' and 'defmacro' *)
@@ -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 }
Src/AST/Myc.Ast.TypeChecker.pas
+196 -176
View File
@@ -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.
Src/AST/Myc.Ast.Visitor.pas
+678 -374
View File
File diff suppressed because it is too large Load Diff
Src/AST/Myc.Ast.pas
+1163 -655
View File
File diff suppressed because it is too large Load Diff
Src/Data/Myc.Data.Value.pas
+19 -9
View File
@@ -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) + '.');
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;
Result := TVal<T>(FInterface).Value;
end
else
IInterface(Pointer(@Result)^) := FInterface
end;
function TDataValue.AsIntf<T>: T;
@@ -278,7 +285,10 @@ end;
class function TDataValue.FromGeneric<T>(const [ref] AValue: T): TDataValue;
begin
Result.FKind := vkGeneric;
Result.FInterface := TVal<T>.Create(AValue);
if PTypeInfo(TypeInfo(T)).Kind = tkInterface then
Result.FInterface := IInterface(Pointer(@AValue)^)
else
Result.FInterface := TVal<T>.Create(AValue);
end;
class function TDataValue.FromPtr(const AValue: Pointer): TDataValue;
@@ -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;