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

Major refactoring, split Bound Ast from source Ast

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-22 19:56:51 +02:00
parent 8041f7355f
commit c573628fe5
17 changed files with 1231 additions and 1291 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Binding.pas
+342 -341
View File
@@ -8,16 +8,25 @@ uses
System.Generics.Collections,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Traverser,
Myc.Ast.Scope;
Myc.Ast.Transformer,
Myc.Ast.Scope,
Myc.Ast;
type
TAstBinder = class(TAstTraverser)
// The binder is a transformer that enriches the AST with semantic information
// like resolved addresses, scopes, and tail-call annotations.
IAstBinder = interface(IAstVisitor)
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
end;
TAstBinder = class(TAstTransformer, IAstBinder)
private
type
// Helper class to track upvalues for a lambda expression.
TUpvalueMapping = class
public
Map: TDictionary<TResolvedAddress, Integer>;
Nodes: TList<IIdentifierNode>;
public
constructor Create;
destructor Destroy; override;
end;
@@ -27,60 +36,87 @@ type
FNestedLambdaCount: Integer;
FIsTailStack: TStack<Boolean>;
FNextIsTail: Boolean;
procedure EnterScope;
procedure ExitScope;
protected
function Accept(const Node: IAstNode): TDataValue; override;
function GetCurrentDescriptor: IScopeDescriptor;
function IsValidIdentifier(const Name: string): Boolean;
protected
// Stack management for tail-call state is centralized here.
function Accept(const Node: IAstNode): TDataValue; override;
public
constructor Create(const AInitialScope: IExecutionScope);
destructor Destroy; override;
class function Bind(const RootNode: IAstNode; const ParentScope: IExecutionScope): IScopeDescriptor;
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
class function CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor; static;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
// The binder overrides specific transform methods to enrich the AST.
function TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; override;
function TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; override;
function TransformAssignment(const Node: IAssignmentNode): IAssignmentNode; override;
function TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; override;
function TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode; override;
function TransformRecur(const Node: IRecurNode): IRecurNode; override;
function TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode; override;
function TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode; override;
function TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode; override;
function TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode; override;
function TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode; override;
property CurrentDescriptor: IScopeDescriptor read FCurrentDescriptor;
property CurrentDescriptor: IScopeDescriptor read GetCurrentDescriptor;
end;
TBoundIdentifierNode = class(TIdentifierNode)
private
FAddress: TResolvedAddress;
public
constructor Create(const AUnboundNode: IIdentifierNode; const AAddress: TResolvedAddress);
property Address: TResolvedAddress read FAddress;
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;
implementation
uses
System.Generics.Defaults,
System.Character,
Myc.Ast;
System.Character;
type
TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor)
private
FParent: IScopeDescriptor;
FSymbols: TDictionary<string, Integer>;
function GetParent: IScopeDescriptor;
function GetSlotCount: Integer;
function GetSymbols: TDictionary<string, Integer>;
public
constructor Create(const AParent: IScopeDescriptor);
destructor Destroy; override;
function Define(const Name: string): Integer;
function FindSymbol(const Name: string; out Depth, Index: Integer): Boolean;
function CreateScope(const Parent: IExecutionScope): IExecutionScope;
procedure PopulateFromScope(Scope: TExecutionScope);
property Symbols: TDictionary<string, Integer> read FSymbols;
end;
// A custom equality comparer for TResolvedAddress to ensure correct behavior in TDictionary.
TResolvedAddressComparer = class(TEqualityComparer<TResolvedAddress>)
public
@@ -88,73 +124,68 @@ type
function GetHashCode(const Value: TResolvedAddress): Integer; override;
end;
{ TResolvedAddressComparer }
{ TBoundIdentifierNode }
constructor TBoundIdentifierNode.Create(const AUnboundNode: IIdentifierNode; const AAddress: TResolvedAddress);
begin
inherited Create(AUnboundNode.Name);
FAddress := AAddress;
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;
{ TResolvedAddressComparer }
function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean;
begin
// Use the existing equality operator for the record.
Result := (Left = Right);
end;
function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer;
begin
// Classic hash combining algorithm using prime numbers.
Result := 17;
Result := Result * 23 + Ord(Value.Kind);
Result := Result * 23 + Value.ScopeDepth;
Result := Result * 23 + Value.SlotIndex;
end;
{ TAstBinder }
constructor TAstBinder.Create(const AInitialScope: IExecutionScope);
{ TAstBinder.TUpvalueMapping }
constructor TAstBinder.TUpvalueMapping.Create;
begin
inherited Create;
FCurrentDescriptor := CreateDescriptor(AInitialScope);
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(true);
FNestedLambdaCount := 0;
FIsTailStack := TStack<Boolean>.Create;
// The content of the root node is in a tail position.
FNextIsTail := true;
Map := TDictionary<TResolvedAddress, Integer>.Create(TResolvedAddressComparer.Create);
Nodes := TList<IIdentifierNode>.Create();
end;
destructor TAstBinder.Destroy;
destructor TAstBinder.TUpvalueMapping.Destroy;
begin
FIsTailStack.Free;
FUpvalueStack.Free;
inherited;
end;
function TAstBinder.Accept(const Node: IAstNode): TDataValue;
begin
if not Assigned(Node) or Done then
exit;
FIsTailStack.Push(FNextIsTail);
try
Result := inherited Accept(Node);
finally
FNextIsTail := FIsTailStack.Pop;
end;
end;
class function TAstBinder.Bind(const RootNode: IAstNode; const ParentScope: IExecutionScope): IScopeDescriptor;
var
binder: TAstBinder;
begin
binder := TAstBinder.Create(ParentScope);
try
binder.EnterScope;
try
// Start the traversal
binder.Accept(RootNode);
Result := binder.CurrentDescriptor;
finally
binder.ExitScope;
end;
finally
binder.Free;
end;
Nodes.Free;
Map.Free;
inherited Destroy;
end;
class function TAstBinder.CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor;
@@ -169,318 +200,288 @@ begin
Result := TScopeDescriptor.Create(nil);
end;
constructor TAstBinder.Create(const AInitialScope: IExecutionScope);
begin
inherited Create;
FCurrentDescriptor := CreateDescriptor(AInitialScope);
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(True);
FNestedLambdaCount := 0;
FIsTailStack := TStack<Boolean>.Create;
FNextIsTail := True;
end;
destructor TAstBinder.Destroy;
begin
FIsTailStack.Free;
FUpvalueStack.Free;
inherited;
end;
function TAstBinder.Accept(const Node: IAstNode): TDataValue;
begin
if (not Assigned(Node)) or Done then
exit;
FIsTailStack.Push(FNextIsTail);
try
Result := inherited Accept(Node);
finally
FNextIsTail := FIsTailStack.Pop;
end;
end;
procedure TAstBinder.EnterScope;
begin
FCurrentDescriptor := TScopeDescriptor.Create(FCurrentDescriptor);
end;
function TAstBinder.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
begin
EnterScope;
try
Result := Accept(RootNode).AsIntf<IAstNode>;
Descriptor := FCurrentDescriptor;
finally
ExitScope;
end;
end;
procedure TAstBinder.ExitScope;
begin
FCurrentDescriptor := FCurrentDescriptor.Parent;
end;
function TAstBinder.VisitAssignment(const Node: IAssignmentNode): TDataValue;
function TAstBinder.GetCurrentDescriptor: IScopeDescriptor;
begin
FNextIsTail := False;
inherited;
end;
function TAstBinder.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
FNextIsTail := False;
inherited;
end;
function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
begin
FNextIsTail := False;
var n := Node.Expressions.Count - 1;
for var i := 0 to n do
begin
// The last expression is in a tail position IF the block itself is.
if i = n then
FNextIsTail := FIsTailStack.Peek;
Accept(Node.Expressions[i]);
end;
end;
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
begin
// Annotate this node based on its context, which is on top of the stack.
(Node as TFunctionCallNode).IsTailCall := FIsTailStack.Peek;
// Let the default traverser visit children (callee, args), but ensure
// their context is non-tail.
FNextIsTail := False;
inherited;
end;
function TAstBinder.VisitRecurNode(const Node: IRecurNode): TDataValue;
begin
// Check if the current context is a tail position.
if not FIsTailStack.Peek then
raise Exception.Create('''recur'' can only be used in a tail position.');
// Arguments to recur are not in a tail position.
FNextIsTail := False;
inherited;
end;
function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
var
depth, idx: Integer;
identNode: TIdentifierNode;
upvalue: TUpvalueMapping;
originalAddress: TResolvedAddress;
upvalueIndex: Integer;
begin
identNode := Node as TIdentifierNode;
if identNode.Address.Kind <> akUnresolved then
exit;
if FCurrentDescriptor.FindSymbol(identNode.Name, depth, idx) then
begin
if (depth > 0) and (FUpvalueStack.Count > 0) then
begin
upvalue := FUpvalueStack.Peek;
// Address is relative to the lambda's parent scope.
dec(depth);
originalAddress := TResolvedAddress.Create(akLocalOrParent, depth, idx);
if not upvalue.Map.TryGetValue(originalAddress, upvalueIndex) then
begin
upvalueIndex := upvalue.Map.Count;
upvalue.Map.Add(originalAddress, upvalueIndex);
end;
(Node as TIdentifierNode).Address := TResolvedAddress.Create(akUpvalue, 0, upvalueIndex);
end
else
begin
// 1. case: depth=0 - this is a local var
// 2. case: UpvalueStack is empty - there is no surrounding lambda, we need to reference (and capture) the whole parent scope
(Node as TIdentifierNode).Address := TResolvedAddress.Create(akLocalOrParent, depth, idx);
end;
end
else
raise Exception.CreateFmt('Undefined identifier: "%s"', [identNode.Name]);
end;
function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
// The condition is never in a tail position.
FNextIsTail := False;
Accept(Node.Condition);
// The branches are in a tail position if the if-expression itself is.
FNextIsTail := FIsTailStack.Peek;
Accept(Node.ThenBranch);
if Assigned(Node.ElseBranch) then
Accept(Node.ElseBranch);
end;
function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
param: IIdentifierNode;
sourceAddresses: TArray<TResolvedAddress>;
sortedPairs: TArray<TPair<TResolvedAddress, Integer>>;
begin
FUpvalueStack.Push(TUpvalueMapping.Create);
try
EnterScope;
try
// Reserve slot 0 for the closure itself (for 'recur'),
// using a name that cannot be accessed from source code.
FCurrentDescriptor.Define('<self>');
for param in Node.Parameters do
FCurrentDescriptor.Define(param.Name);
var lastNestedLambdaCount := FNestedLambdaCount;
// Parameters are never in a tail position.
FNextIsTail := False;
for param in Node.Parameters do
Accept(param);
// The body of a lambda is always in a tail position.
FNextIsTail := True;
Accept(Node.Body);
(Node as TLambdaExpressionNode).HasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
(Node as TLambdaExpressionNode).ScopeDescriptor := FCurrentDescriptor;
finally
ExitScope;
end;
finally
var upvalue := FUpvalueStack.Peek;
try
sortedPairs := upvalue.Map.ToArray;
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(sourceAddresses, Length(sortedPairs));
for var i := 0 to High(sortedPairs) do
sourceAddresses[i] := sortedPairs[i].Key;
(Node as TLambdaExpressionNode).Upvalues := sourceAddresses;
finally
FUpvalueStack.Pop;
end;
inc(FNestedLambdaCount);
end;
end;
function TAstBinder.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
// The condition is never in a tail position.
FNextIsTail := False;
Accept(Node.Condition);
// The branches are in a tail position if the ternary expression itself is.
FNextIsTail := FIsTailStack.Peek;
Accept(Node.ThenBranch);
Accept(Node.ElseBranch);
end;
function TAstBinder.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
FNextIsTail := False;
inherited;
Result := FCurrentDescriptor;
end;
function TAstBinder.IsValidIdentifier(const Name: string): Boolean;
var
i: Integer;
c: Char;
begin
if Name.IsEmpty then
exit(False);
// First character must be a letter or underscore.
c := Name[1];
if not (c.IsLetter or (c = '_')) then
exit(False);
// Subsequent characters can be letters, numbers, underscore, or hyphen.
for i := 2 to Length(Name) do
for c in Name do
begin
c := Name[i];
if not (c.IsLetterOrDigit or (c = '_') or (c = '-')) then
exit(False);
end;
Result := True;
end;
function TAstBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
function TAstBinder.TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode;
var
slotIndex: Integer;
depth, idx: Integer;
begin
// The initializer expression is never in a tail position.
FNextIsTail := False;
if Assigned(Node.Initializer) then
Accept(Node.Initializer);
if FCurrentDescriptor.FindSymbol(Node.Name, depth, idx) then
begin
if (depth > 0) and (FUpvalueStack.Count > 0) then
begin
var upvalue := FUpvalueStack.Peek;
dec(depth);
var originalAddress := TResolvedAddress.Create(akLocalOrParent, depth, idx);
// Reject identifiers that contain special characters or reserved operator characters.
var upvalueIndex: Integer;
if not upvalue.Map.TryGetValue(originalAddress, upvalueIndex) then
begin
upvalueIndex := upvalue.Map.Count;
upvalue.Map.Add(originalAddress, upvalueIndex);
end;
var address := TResolvedAddress.Create(akUpvalue, 0, upvalueIndex);
Result := TBoundIdentifierNode.Create(Node, address);
end
else
begin
var address := TResolvedAddress.Create(akLocalOrParent, depth, idx);
Result := TBoundIdentifierNode.Create(Node, address);
end
end
else
raise Exception.CreateFmt('Undefined identifier: "%s"', [Node.Name]);
end;
function TAstBinder.TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode;
var
initializer: IAstNode;
slotIndex: Integer;
address: TResolvedAddress;
boundIdentifier: IIdentifierNode;
begin
if not IsValidIdentifier(Node.Identifier.Name) then
raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]);
FNextIsTail := False;
if Node.Initializer <> nil then
initializer := Accept(Node.Initializer).AsIntf<IAstNode>;
slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name);
(Node.Identifier as TIdentifierNode).Address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
boundIdentifier := TBoundIdentifierNode.Create(Node.Identifier, address);
Result := TAst.VarDecl(boundIdentifier, initializer);
end;
function TAstBinder.TransformAssignment(const Node: IAssignmentNode): IAssignmentNode;
begin
FNextIsTail := False;
Result := inherited TransformAssignment(Node);
end;
function TAstBinder.TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode;
begin
FNextIsTail := False;
Result := inherited TransformBinaryExpression(Node);
end;
function TAstBinder.TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode;
begin
FNextIsTail := False;
Result := inherited TransformUnaryExpression(Node);
end;
function TAstBinder.TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode;
var
i: integer;
boundParams: TArray<IIdentifierNode>;
boundBody: IAstNode;
lambdaScope: IScopeDescriptor;
upvalues: TArray<TResolvedAddress>;
hasNestedLambdas: Boolean;
lastNestedLambdaCount: Integer;
begin
FUpvalueStack.Push(TUpvalueMapping.Create);
try
EnterScope;
try
FCurrentDescriptor.Define('<self>');
SetLength(boundParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
var paramNode := Node.Parameters[i];
var slotIndex := FCurrentDescriptor.Define(paramNode.Name);
var address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
boundParams[i] := TBoundIdentifierNode.Create(paramNode, address);
end;
lastNestedLambdaCount := FNestedLambdaCount;
FNextIsTail := True;
boundBody := Accept(Node.Body).AsIntf<IAstNode>;
hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
lambdaScope := FCurrentDescriptor;
finally
ExitScope;
end;
var upvalueMapping := FUpvalueStack.Peek;
var sortedPairs := upvalueMapping.Map.ToArray;
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;
finally
FUpvalueStack.Pop;
end;
inc(FNestedLambdaCount);
Result := TBoundLambdaExpressionNode.Create(Node, boundBody, boundParams, lambdaScope, upvalues, hasNestedLambdas);
end;
function TAstBinder.TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode;
var
isTailCall: Boolean;
callee: IAstNode;
args: TArray<IAstNode>;
begin
isTailCall := FIsTailStack.Peek;
FNextIsTail := False;
Accept(Node.Identifier);
callee := Accept(Node.Callee).AsIntf<IAstNode>;
args := TransformNodes<IAstNode>(Node.Arguments);
Result := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
end;
{ TScopeDescriptor }
constructor TScopeDescriptor.Create(const AParent: IScopeDescriptor);
function TAstBinder.TransformRecur(const Node: IRecurNode): IRecurNode;
begin
inherited Create;
FParent := AParent;
FSymbols := TDictionary<string, Integer>.Create;
if not FIsTailStack.Peek then
raise Exception.Create('''recur'' can only be used in a tail position.');
FNextIsTail := False;
Result := inherited TransformRecur(Node);
end;
destructor TScopeDescriptor.Destroy;
begin
FSymbols.Free;
inherited;
end;
function TScopeDescriptor.Define(const Name: string): Integer;
begin
Result := FSymbols.Count;
FSymbols.Add(Name, Result);
end;
function TScopeDescriptor.FindSymbol(const Name: string; out Depth, Index: Integer): Boolean;
function TAstBinder.TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode;
var
currentDescriptor: TScopeDescriptor;
exprs: TArray<IAstNode>;
i: Integer;
isContextTail: Boolean;
begin
Depth := 0;
currentDescriptor := Self;
while currentDescriptor <> nil do
isContextTail := FIsTailStack.Peek;
SetLength(exprs, Node.Expressions.Count);
for i := 0 to Node.Expressions.Count - 1 do
begin
if currentDescriptor.FSymbols.TryGetValue(Name, Index) then
exit(true);
inc(Depth);
currentDescriptor := currentDescriptor.FParent as TScopeDescriptor;
FNextIsTail := isContextTail and (i = Node.Expressions.Count - 1);
exprs[i] := Accept(Node.Expressions[i]).AsIntf<IAstNode>;
end;
Result := False;
Result := TAst.Block(exprs);
end;
function TScopeDescriptor.GetParent: IScopeDescriptor;
function TAstBinder.TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode;
var
isContextTail: Boolean;
condition, thenBranch, elseBranch: IAstNode;
begin
Result := FParent;
isContextTail := FIsTailStack.Peek;
FNextIsTail := False;
condition := Accept(Node.Condition).AsIntf<IAstNode>;
FNextIsTail := isContextTail;
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
Result := TAst.IfExpr(condition, thenBranch, elseBranch)
else
Result := Node;
end;
function TScopeDescriptor.GetSlotCount: Integer;
function TAstBinder.TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode;
var
isContextTail: Boolean;
condition, thenBranch, elseBranch: IAstNode;
begin
Result := FSymbols.Count;
end;
isContextTail := FIsTailStack.Peek;
function TScopeDescriptor.GetSymbols: TDictionary<string, Integer>;
begin
Result := FSymbols;
end;
FNextIsTail := False;
condition := Accept(Node.Condition).AsIntf<IAstNode>;
function TScopeDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope;
begin
Result := TExecutionScope.Create(Parent, Self, nil);
end;
FNextIsTail := isContextTail;
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
procedure TScopeDescriptor.PopulateFromScope(Scope: TExecutionScope);
begin
for var pair in Scope.NameToIndex do
begin
var name := Scope.NameStrings[pair.Key];
if not FSymbols.ContainsKey(name) then
FSymbols.Add(name, pair.Value);
end;
end;
constructor TAstBinder.TUpvalueMapping.Create;
begin
inherited Create;
// Use the custom equality comparer to ensure correct dictionary behavior.
Map := TDictionary<TResolvedAddress, Integer>.Create(TResolvedAddressComparer.Create);
Nodes := TList<IIdentifierNode>.Create();
end;
destructor TAstBinder.TUpvalueMapping.Destroy;
begin
Nodes.Free;
Map.Free;
inherited Destroy;
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
Result := TAst.TernaryExpr(condition, thenBranch, elseBranch)
else
Result := Node;
end;
end.
Src/AST/Myc.Ast.Debugger.pas
+1 -2
View File
@@ -52,8 +52,7 @@ type
implementation
uses
System.TypInfo,
Myc.Ast.Printer;
System.TypInfo;
{ TDebugEvaluatorVisitor }
Src/AST/Myc.Ast.Dumper.pas
+94 -61
View File
@@ -7,13 +7,18 @@ uses
System.Classes,
System.Generics.Collections,
Myc.Ast.Nodes,
Myc.Ast.Traverser,
Myc.Ast.Transformer, // Wird für TAstVisitor benötigt
Myc.Data.Value,
Myc.Data.Scalar;
type
// Dumps a bound AST into a human-readable format for debugging purposes.
TAstDumper = class(TAstTraverser)
// It inherits from the abstract TAstVisitor to implement the IAstVisitor interface.
IAstDumper = interface(IAstVisitor)
procedure Execute(const RootNode: IAstNode);
end;
TAstDumper = class(TAstVisitor)
private
FOutput: TStrings;
FIndent: Integer;
@@ -22,8 +27,6 @@ type
procedure Log(const Text: string); overload;
procedure LogFmt(const Fmt: string; const Args: array of const); overload;
function FormatAddress(const Addr: TResolvedAddress): string;
protected
function Accept(const Node: IAstNode): TDataValue; override;
public
// Creates a new instance of the AST dumper.
constructor Create(const AOutput: TStrings);
@@ -31,6 +34,9 @@ type
// Traverses the given root node and writes the structural information into the output.
class procedure Dump(const RootNode: IAstNode; const Output: TStrings);
procedure Execute(const RootNode: IAstNode);
// IAstVisitor implementation
function VisitConstant(const Node: IConstantNode): TDataValue; override;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
@@ -52,19 +58,22 @@ type
implementation
uses
Myc.Ast.Binding; // For TBound...Node classes
{ TAstDumper }
class procedure TAstDumper.Dump(const RootNode: IAstNode; const Output: TStrings);
var
dumper: TAstDumper;
begin
if not Assigned(Output) then
if (not Assigned(Output)) or (not Assigned(RootNode)) then
exit;
Output.Clear;
dumper := TAstDumper.Create(Output);
try
dumper.Accept(RootNode);
dumper.Execute(RootNode);
finally
dumper.Free;
end;
@@ -77,11 +86,10 @@ begin
FIndent := 0;
end;
function TAstDumper.Accept(const Node: IAstNode): TDataValue;
procedure TAstDumper.Execute(const RootNode: IAstNode);
begin
Result := TDataValue.Void;
if Assigned(Node) then
Result := inherited Accept(Node);
if Assigned(RootNode) then
RootNode.Accept(Self);
end;
procedure TAstDumper.Indent;
@@ -123,7 +131,10 @@ end;
function TAstDumper.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress(Node.Address)]);
if Node is TBoundIdentifierNode then
LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress((Node as TBoundIdentifierNode).Address)])
else
LogFmt('Identifier: %s (unbound)', [Node.Name]);
Result := TDataValue.Void;
end;
@@ -131,8 +142,8 @@ function TAstDumper.VisitBinaryExpression(const Node: IBinaryExpressionNode): TD
begin
LogFmt('BinaryExpression: %s', [Node.Operator.ToString]);
Indent;
Accept(Node.Left);
Accept(Node.Right);
Node.Left.Accept(Self);
Node.Right.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
@@ -141,7 +152,7 @@ function TAstDumper.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDat
begin
LogFmt('UnaryExpression: %s', [Node.Operator.ToString]);
Indent;
Accept(Node.Right);
Node.Right.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
@@ -151,13 +162,13 @@ begin
Log('IfExpression');
Indent;
Log('Condition:');
Accept(Node.Condition);
Node.Condition.Accept(Self);
Log('Then:');
Accept(Node.ThenBranch);
Node.ThenBranch.Accept(Self);
if Assigned(Node.ElseBranch) then
begin
Log('Else:');
Accept(Node.ElseBranch);
Node.ElseBranch.Accept(Self);
end;
Unindent;
Result := TDataValue.Void;
@@ -168,11 +179,11 @@ begin
Log('TernaryExpression');
Indent;
Log('Condition:');
Accept(Node.Condition);
Node.Condition.Accept(Self);
Log('Then:');
Accept(Node.ThenBranch);
Node.ThenBranch.Accept(Self);
Log('Else:');
Accept(Node.ElseBranch);
Node.ElseBranch.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
@@ -182,35 +193,53 @@ var
param: IIdentifierNode;
upvalueAddr: TResolvedAddress;
pair: TPair<string, Integer>;
boundNode: TBoundLambdaExpressionNode;
begin
LogFmt('LambdaExpression (HasNested: %s)', [Node.HasNestedLambdas.ToString(TUseBoolStrs.True)]);
Indent;
if Node is TBoundLambdaExpressionNode then
begin
boundNode := Node as TBoundLambdaExpressionNode;
LogFmt('LambdaExpression (HasNested: %s)', [boundNode.HasNestedLambdas.ToString(TUseBoolStrs.True)]);
Indent;
Log('Parameters:');
Indent;
for param in Node.Parameters do
Accept(param);
Unindent;
Log('Parameters:');
Indent;
for param in boundNode.Parameters do
param.Accept(Self);
Unindent;
LogFmt('Upvalues (%d):', [Length(Node.Upvalues)]);
Indent;
for upvalueAddr in Node.Upvalues do
Log(FormatAddress(upvalueAddr));
Unindent;
LogFmt('Upvalues (%d):', [Length(boundNode.Upvalues)]);
Indent;
for upvalueAddr in boundNode.Upvalues do
Log(FormatAddress(upvalueAddr));
Unindent;
Log('Scope Descriptor:');
Indent;
if Assigned(Node.ScopeDescriptor) then
for pair in Node.ScopeDescriptor.Symbols do
LogFmt('"%s" -> Slot %d', [pair.Key, pair.Value])
Log('Scope Descriptor:');
Indent;
if Assigned(boundNode.ScopeDescriptor) then
for pair in boundNode.ScopeDescriptor.Symbols do
LogFmt('"%s" -> Slot %d', [pair.Key, pair.Value])
else
Log('(none)');
Unindent;
Log('Body:');
boundNode.Body.Accept(Self);
Unindent;
end
else
Log('(none)');
Unindent;
Log('Body:');
Accept(Node.Body);
Unindent;
begin
Log('LambdaExpression (unbound)');
Indent;
Log('Parameters:');
Indent;
for param in Node.Parameters do
param.Accept(Self);
Unindent;
Log('Body:');
Node.Body.Accept(Self);
Unindent;
end;
Result := TDataValue.Void;
end;
@@ -218,14 +247,18 @@ function TAstDumper.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue
var
arg: IAstNode;
begin
LogFmt('FunctionCall (IsTailCall: %s)', [Node.IsTailCall.ToString(TUseBoolStrs.True)]);
if Node is TBoundFunctionCallNode then
LogFmt('FunctionCall (IsTailCall: %s)', [(Node as TBoundFunctionCallNode).IsTailCall.ToString(TUseBoolStrs.True)])
else
Log('FunctionCall (unbound)');
Indent;
Log('Callee:');
Accept(Node.Callee);
Node.Callee.Accept(Self);
LogFmt('Arguments (%d):', [Length(Node.Arguments)]);
Indent;
for arg in Node.Arguments do
Accept(arg);
arg.Accept(Self);
Unindent;
Unindent;
Result := TDataValue.Void;
@@ -240,7 +273,7 @@ begin
LogFmt('Arguments (%d):', [Length(Node.Arguments)]);
Indent;
for arg in Node.Arguments do
Accept(arg);
arg.Accept(Self);
Unindent;
Unindent;
Result := TDataValue.Void;
@@ -253,7 +286,7 @@ begin
Log('BlockExpression');
Indent;
for expr in Node.Expressions do
Accept(expr);
expr.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
@@ -262,11 +295,11 @@ function TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNod
begin
Log('VariableDeclaration');
Indent;
Accept(Node.Identifier);
Node.Identifier.Accept(Self);
if Assigned(Node.Initializer) then
begin
Log('Initializer:');
Accept(Node.Initializer);
Node.Initializer.Accept(Self);
end;
Unindent;
Result := TDataValue.Void;
@@ -276,9 +309,9 @@ function TAstDumper.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
Log('Assignment');
Indent;
Accept(Node.Identifier);
Node.Identifier.Accept(Self);
Log('Value:');
Accept(Node.Value);
Node.Value.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
@@ -288,9 +321,9 @@ begin
Log('Indexer');
Indent;
Log('Base:');
Accept(Node.Base);
Node.Base.Accept(Self);
Log('Index:');
Accept(Node.Index);
Node.Index.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
@@ -300,9 +333,9 @@ begin
Log('MemberAccess');
Indent;
Log('Base:');
Accept(Node.Base);
Node.Base.Accept(Self);
Log('Member:');
Accept(Node.Member);
Node.Member.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
@@ -318,13 +351,13 @@ begin
Log('AddSeriesItem');
Indent;
Log('Series:');
Accept(Node.Series);
Node.Series.Accept(Self);
Log('Value:');
Accept(Node.Value);
Node.Value.Accept(Self);
if Assigned(Node.Lookback) then
begin
Log('Lookback:');
Accept(Node.Lookback);
Node.Lookback.Accept(Self);
end;
Unindent;
Result := TDataValue.Void;
@@ -335,7 +368,7 @@ begin
Log('SeriesLength');
Indent;
Log('Series:');
Accept(Node.Series);
Node.Series.Accept(Self);
Unindent;
Result := TDataValue.Void;
end;
Src/AST/Myc.Ast.Evaluator.pas
+55 -51
View File
@@ -9,14 +9,20 @@ uses
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Transformer, // Neu
Myc.Ast.Binding,
Myc.Ast.Scope;
type
// A factory for creating visitors, primarily used by the debugger subsystem.
TVisitorFactory = reference to function(const Scope: IExecutionScope): IAstVisitor;
IEvaluatorVisitor = interface(IAstVisitor)
function Execute(const RootNode: IAstNode): TDataValue;
end;
// The standard AST evaluator for production use.
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor)
TEvaluatorVisitor = class(TAstVisitor, IEvaluatorVisitor)
private
FScope: IExecutionScope;
protected
@@ -34,23 +40,23 @@ type
// Executes an AST with proper TCO handling. This is the main entry point.
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual;
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 VisitFunctionCall(const Node: IFunctionCallNode): 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 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 VisitConstant(const Node: IConstantNode): TDataValue; override;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
end;
// Registers native Delphi functions into a scope.
@@ -161,30 +167,33 @@ end;
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
boundNode: TBoundLambdaExpressionNode;
capturedCells: TArray<IValueCell>;
i: Integer;
sourceAddresses: TArray<TResolvedAddress>;
closureScope: IExecutionScope;
visitorFactory: TVisitorFactory;
begin
sourceAddresses := Node.Upvalues;
// Cast to the bound node to access binder-specific information.
boundNode := Node as TBoundLambdaExpressionNode;
sourceAddresses := boundNode.Upvalues;
SetLength(capturedCells, Length(sourceAddresses));
for i := 0 to High(sourceAddresses) do
capturedCells[i] := FScope.Capture(sourceAddresses[i]);
if Node.HasNestedLambdas then
if boundNode.HasNestedLambdas then
closureScope := FScope
else
closureScope := nil;
// Get the appropriate factory via virtual dispatch.
visitorFactory := CreateVisitorFactory();
var scopeDescriptor := Node.ScopeDescriptor;
var params := Node.Parameters;
var scopeDescriptor := boundNode.ScopeDescriptor;
var params := boundNode.Parameters;
// declare closure as weak to break cyclic referencing when it is captured by itself
var [weak] closure: TDataValue.TFunc;
var cNode: ILambdaExpressionNode := Node;
closure :=
TDataValue.TFunc(
@@ -204,21 +213,19 @@ begin
adr.ScopeDepth := 0;
// Capture the closure itself in slot 0 for 'recur' to find it.
// The name 'Self' is no longer exposed to the user by the binder.
adr.SlotIndex := 0;
lambdaScope[adr] := TDataValue(closure);
// Populate the actual parameters.
for i := 0 to High(ArgValues) do
begin
adr.SlotIndex := params[i].Address.SlotIndex;
// Parameters in a bound lambda must be bound identifiers.
adr.SlotIndex := (params[i] as TBoundIdentifierNode).Address.SlotIndex;
lambdaScope[adr] := ArgValues[i];
end;
// Use the injected factory to create the visitor for the lambda's body.
bodyVisitor := visitorFactory(lambdaScope);
Result := Node.Body.Accept(bodyVisitor);
Result := cNode.Body.Accept(bodyVisitor);
end
);
@@ -229,6 +236,7 @@ function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDa
var
calleeValue: TDataValue;
argValues: TArray<TDataValue>;
boundNode: TBoundFunctionCallNode;
begin
calleeValue := Node.Callee.Accept(Self);
if calleeValue.Kind <> vkMethod then
@@ -239,19 +247,16 @@ begin
for var i := 0 to High(argNodes) do
argValues[i] := argNodes[i].Accept(Self);
if Node.IsTailCall then
boundNode := Node as TBoundFunctionCallNode;
if boundNode.IsTailCall then
begin
// This is a tail call. Return a thunk to be processed
// by an outer trampoline loop (either in Execute or a parent non-tail-call).
// This is a tail call. Return a thunk to be processed by the trampoline.
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues));
end
else
begin
// This is a non-tail call. It must execute the call and act as
// the trampoline for any subsequent tail calls it may trigger.
// This is a non-tail call. It must execute the call and act as the trampoline.
Result := (calleeValue.AsMethod)(argValues);
HandleTCO(Result);
end;
end;
@@ -263,23 +268,21 @@ var
calleeValue: TDataValue;
i: Integer;
begin
// The binder ensures this is only in a tail position.
if not Node.IsTailCall then
raise EInvalidOperation.Create('Recur has to be a tail call');
// Evaluate all arguments for the recursive call.
SetLength(argValues, Length(Node.Arguments));
for i := 0 to High(Node.Arguments) do
argValues[i] := Node.Arguments[i].Accept(Self);
// The callee is the current function, which is stored by the lambda
// expression visitor in slot 0 of the current scope.
// The callee is the current function, stored in slot 0 of the current scope.
calleeAddress.Kind := akLocalOrParent;
calleeAddress.ScopeDepth := 0;
calleeAddress.SlotIndex := 0;
calleeValue := FScope[calleeAddress];
// Recur must be in a tail position, so we always return a thunk.
// The binder is responsible for enforcing the tail position rule.
// Recur always returns a thunk for the trampoline.
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues));
end;
@@ -288,7 +291,7 @@ var
itemValue, lookbackValue, seriesVar: TDataValue;
lookback: Int64;
begin
seriesVar := FScope[Node.Series.Address];
seriesVar := FScope[(Node.Series as TBoundIdentifierNode).Address];
itemValue := Node.Value.Accept(Self);
lookback := -1;
@@ -297,7 +300,6 @@ begin
lookbackValue := Node.Lookback.Accept(Self);
if (lookbackValue.Kind <> vkScalar) or (lookbackValue.AsScalar.Kind <> TScalar.TKind.Ordinal) then
raise EArgumentException.Create('Lookback parameter must be an integer.');
lookback := lookbackValue.AsScalar.Value.AsInt64;
end;
@@ -321,7 +323,7 @@ end;
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
Result := Node.Value.Accept(Self);
FScope[Node.Identifier.Address] := Result;
FScope[(Node.Identifier as TBoundIdentifierNode).Address] := Result;
end;
function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
@@ -334,13 +336,11 @@ var
def: string;
begin
def := Node.Definition.Trim;
if def.StartsWith('[') then
begin
var recordDef := TRttiAstHelper.JsonToRecordDefinition(def);
if Length(recordDef.Fields) = 0 then
raise EArgumentException.Create('Failed to parse record definition from JSON array.');
var recordSeries := TScalarRecordSeries.Create(recordDef);
Result := TDataValue.FromRecordSeries(recordSeries);
end
@@ -353,7 +353,7 @@ end;
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
Result := FScope[Node.Address];
Result := FScope[(Node as TBoundIdentifierNode).Address];
end;
function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
@@ -411,9 +411,11 @@ end;
function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
if Assigned(Node.Initializer) then
Result := Node.Initializer.Accept(Self);
Result := Node.Initializer.Accept(Self)
else
Result := TDataValue.Void;
FScope[Node.Identifier.Address] := Result;
FScope[(Node.Identifier as TBoundIdentifierNode).Address] := Result;
end;
function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
@@ -457,7 +459,9 @@ begin
if IsTruthy(Node.Condition.Accept(Self)) then
Result := Node.ThenBranch.Accept(Self)
else if Assigned(Node.ElseBranch) then
Result := Node.ElseBranch.Accept(Self);
Result := Node.ElseBranch.Accept(Self)
else
Result := TDataValue.Void;
end;
function TEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
@@ -482,7 +486,7 @@ var
seriesValue: TDataValue;
len: Int64;
begin
seriesValue := FScope[Node.Series.Address];
seriesValue := FScope[(Node.Series as TBoundIdentifierNode).Address];
case seriesValue.Kind of
vkSeries: len := seriesValue.AsSeries.Count;
Src/AST/Myc.Ast.Nodes.pas
-12
View File
@@ -86,8 +86,6 @@ type
end;
IAstVisitor = interface
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
@@ -121,11 +119,9 @@ type
IIdentifierNode = interface(IAstNode)
{$region 'private'}
function GetAddress: TResolvedAddress;
function GetName: string;
{$endregion}
property Name: string read GetName;
property Address: TResolvedAddress read GetAddress;
end;
IBinaryExpressionNode = interface(IAstNode)
@@ -174,26 +170,18 @@ type
{$region 'private'}
function GetParameters: TArray<IIdentifierNode>;
function GetBody: IAstNode;
function GetScopeDescriptor: IScopeDescriptor;
function GetUpvalues: TArray<TResolvedAddress>;
function GetHasNestedLambdas: Boolean;
{$endregion}
property Parameters: TArray<IIdentifierNode> read GetParameters;
property Body: IAstNode read GetBody;
property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor;
property Upvalues: TArray<TResolvedAddress> read GetUpvalues;
property HasNestedLambdas: Boolean read GetHasNestedLambdas;
end;
IFunctionCallNode = interface(IAstNode)
{$region 'private'}
function GetCallee: IAstNode;
function GetArguments: TArray<IAstNode>;
function GetIsTailCall: Boolean;
{$endregion}
property Callee: IAstNode read GetCallee;
property Arguments: TArray<IAstNode> read GetArguments;
property IsTailCall: Boolean read GetIsTailCall;
end;
// A node representing a tail-recursive call.
Src/AST/Myc.Ast.Printer.pas
-327
View File
@@ -1,327 +0,0 @@
unit Myc.Ast.Printer;
interface
uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast;
type
// A visitor that converts an AST into a LISP-like (Clojure-style) string representation.
TPrettyPrintVisitor = class(TInterfacedObject, IAstVisitor)
private
FBuilder: TStringBuilder;
FIndentLevel: Integer;
procedure Indent;
procedure Unindent;
procedure Append(const S: string);
procedure NewLine;
public
constructor Create;
destructor Destroy; override;
function GetResult: string;
// IAstVisitor
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
function VisitAssignment(const Node: IAssignmentNode): TDataValue;
function VisitIndexer(const Node: IIndexerNode): TDataValue;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
function VisitRecurNode(const Node: IRecurNode): TDataValue;
end;
implementation
uses
Myc.Data.Scalar;
{ TPrettyPrintVisitor }
constructor TPrettyPrintVisitor.Create;
begin
inherited Create;
FBuilder := TStringBuilder.Create;
FIndentLevel := 0;
end;
destructor TPrettyPrintVisitor.Destroy;
begin
FBuilder.Free;
inherited Destroy;
end;
function TPrettyPrintVisitor.GetResult: string;
begin
Result := FBuilder.ToString;
end;
procedure TPrettyPrintVisitor.Indent;
begin
inc(FIndentLevel, 2);
end;
procedure TPrettyPrintVisitor.Unindent;
begin
dec(FIndentLevel, 2);
end;
procedure TPrettyPrintVisitor.Append(const S: string);
begin
FBuilder.Append(S);
end;
procedure TPrettyPrintVisitor.NewLine;
begin
FBuilder.AppendLine;
FBuilder.Append(''.PadLeft(FIndentLevel));
end;
function TPrettyPrintVisitor.Execute(const RootNode: IAstNode): TDataValue;
begin
if Assigned(RootNode) then
RootNode.Accept(Self);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
var
val: TDataValue;
begin
val := Node.Value;
if val.Kind = vkText then
Append('"' + val.AsText + '"')
else
Append(val.ToString);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
Append(Node.Name);
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
Append('(' + Node.Operator.ToString);
Append(' ');
Node.Left.Accept(Self);
Append(' ');
Node.Right.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
Append('(' + Node.Operator.ToString);
Append(' ');
Node.Right.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
Append('(if ');
Node.Condition.Accept(Self);
Indent;
NewLine;
Node.ThenBranch.Accept(Self);
if Assigned(Node.ElseBranch) then
begin
NewLine;
Node.ElseBranch.Accept(Self);
end;
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
Append('(if ');
Node.Condition.Accept(Self);
Indent;
NewLine;
Node.ThenBranch.Accept(Self);
NewLine;
Node.ElseBranch.Accept(Self);
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
param: IIdentifierNode;
sb: TStringBuilder;
begin
sb := TStringBuilder.Create;
try
for param in Node.Parameters do
sb.Append(param.Name + ' ');
if sb.Length > 0 then
sb.Remove(sb.Length - 1, 1);
Append('(fn [' + sb.ToString + ']');
finally
sb.Free;
end;
Indent;
NewLine;
Node.Body.Accept(Self);
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
arg: IAstNode;
begin
Append('(');
Node.Callee.Accept(Self);
Indent;
for arg in Node.Arguments do
begin
NewLine;
arg.Accept(Self);
end;
Unindent;
if Length(Node.Arguments) > 0 then
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue;
var
arg: IAstNode;
begin
Append('(recur');
Indent;
for arg in Node.Arguments do
begin
NewLine;
arg.Accept(Self);
end;
Unindent;
if Length(Node.Arguments) > 0 then
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
expr: IAstNode;
begin
Append('(do');
Indent;
for expr in Node.Expressions do
begin
NewLine;
expr.Accept(Self);
end;
Unindent;
NewLine;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
Append('(def ');
Node.Identifier.Accept(Self);
if Assigned(Node.Initializer) then
begin
Append(' ');
Node.Initializer.Accept(Self);
end;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
Append('(assign ');
Node.Identifier.Accept(Self);
Append(' ');
Node.Value.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
Append('(get ');
Node.Base.Accept(Self);
Append(' ');
Node.Index.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
Append('(.');
Node.Member.Accept(Self);
Append(' ');
Node.Base.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
begin
Append(Format('(new-series "%s")', [Node.Definition]));
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
Append('(add-item ');
Node.Series.Accept(Self);
Append(' ');
Node.Value.Accept(Self);
if Assigned(Node.Lookback) then
begin
Append(' ');
Node.Lookback.Accept(Self);
end;
Append(')');
Result := TDataValue.Void;
end;
function TPrettyPrintVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
Append('(count ');
Node.Series.Accept(Self);
Append(')');
Result := TDataValue.Void;
end;
end.
Src/AST/Myc.Ast.Scope.pas
+89
View File
@@ -60,6 +60,25 @@ type
property Parent: IExecutionScope read FParent;
end;
// Describes the layout of a scope: variable names and their slot indices.
// This is generated by the binder and used to create TExecutionScope instances at runtime.
TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor)
private
FParent: IScopeDescriptor;
FSymbols: TDictionary<string, Integer>;
function GetParent: IScopeDescriptor;
function GetSlotCount: Integer;
function GetSymbols: TDictionary<string, Integer>;
public
constructor Create(const AParent: IScopeDescriptor);
destructor Destroy; override;
function Define(const Name: string): Integer;
function FindSymbol(const Name: string; out Depth, Index: Integer): Boolean;
function CreateScope(const Parent: IExecutionScope): IExecutionScope;
procedure PopulateFromScope(Scope: TExecutionScope);
property Symbols: TDictionary<string, Integer> read FSymbols;
end;
implementation
uses
@@ -339,4 +358,74 @@ begin
FValues[FIdx] := AValue;
end;
{ TScopeDescriptor }
constructor TScopeDescriptor.Create(const AParent: IScopeDescriptor);
begin
inherited Create;
FParent := AParent;
FSymbols := TDictionary<string, Integer>.Create;
end;
destructor TScopeDescriptor.Destroy;
begin
FSymbols.Free;
inherited;
end;
function TScopeDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope;
begin
// Creates a runtime scope instance based on this descriptor's layout.
Result := TExecutionScope.Create(Parent, Self, nil);
end;
function TScopeDescriptor.Define(const Name: string): Integer;
begin
Result := FSymbols.Count;
FSymbols.Add(Name, Result);
end;
function TScopeDescriptor.FindSymbol(const Name: string; out Depth, Index: Integer): Boolean;
var
currentDescriptor: TScopeDescriptor;
begin
Depth := 0;
currentDescriptor := Self;
while currentDescriptor <> nil do
begin
if currentDescriptor.FSymbols.TryGetValue(Name, Index) then
exit(True);
inc(Depth);
currentDescriptor := currentDescriptor.FParent as TScopeDescriptor;
end;
Result := False;
end;
function TScopeDescriptor.GetParent: IScopeDescriptor;
begin
Result := FParent;
end;
function TScopeDescriptor.GetSlotCount: Integer;
begin
Result := FSymbols.Count;
end;
function TScopeDescriptor.GetSymbols: TDictionary<string, Integer>;
begin
Result := FSymbols;
end;
procedure TScopeDescriptor.PopulateFromScope(Scope: TExecutionScope);
begin
// This method is likely used to create a descriptor from an existing, dynamically populated scope.
// Note: This relies on internal details of TExecutionScope (NameToIndex, NameStrings).
for var pair in Scope.NameToIndex do
begin
var name := Scope.NameStrings[pair.Key];
if not FSymbols.ContainsKey(name) then
FSymbols.Add(name, pair.Value);
end;
end;
end.
Src/AST/Myc.Ast.Transformer.pas
+427
View File
@@ -0,0 +1,427 @@
unit Myc.Ast.Transformer;
interface
uses
System.SysUtils,
System.Generics.Collections,
Myc.Data.Value,
Myc.Ast,
Myc.Ast.Nodes;
type
// A fully abstract base class for any visitor of the AST.
TAstVisitor = class abstract(TInterfacedObject, IAstVisitor)
public
function VisitConstant(const Node: IConstantNode): TDataValue; virtual; abstract;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual; abstract;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual; abstract;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; virtual; abstract;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; virtual; abstract;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; virtual; abstract;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; virtual; abstract;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; virtual; abstract;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; virtual; abstract;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; virtual; abstract;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; virtual; abstract;
function VisitIndexer(const Node: IIndexerNode): TDataValue; virtual; abstract;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; virtual; abstract;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; virtual; abstract;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; virtual; abstract;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual; abstract;
function VisitRecurNode(const Node: IRecurNode): TDataValue; virtual; abstract;
end;
IAstTransformer = interface(IAstVisitor)
function Execute(const RootNode: IAstNode): IAstNode;
end;
// A base visitor that walks the AST and rebuilds it node by node.
// This class uses the Template Method pattern:
// - The Visit... methods are the template and should not be overridden.
// - The virtual Transform... methods are the hooks for derived classes to customize behavior.
TAstTransformer = class abstract(TAstVisitor, IAstTransformer)
private
FDone: Boolean;
protected
// Dispatch methods for each node type. Derived classes override these to change the transformation.
function TransformConstant(const Node: IConstantNode): IConstantNode; virtual;
function TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; virtual;
function TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode; virtual;
function TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode; virtual;
function TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode; virtual;
function TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode; virtual;
function TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; virtual;
function TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode; virtual;
function TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode; virtual;
function TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; virtual;
function TransformAssignment(const Node: IAssignmentNode): IAssignmentNode; virtual;
function TransformIndexer(const Node: IIndexerNode): IIndexerNode; virtual;
function TransformMemberAccess(const Node: IMemberAccessNode): IMemberAccessNode; virtual;
function TransformCreateSeries(const Node: ICreateSeriesNode): ICreateSeriesNode; virtual;
function TransformAddSeriesItem(const Node: IAddSeriesItemNode): IAddSeriesItemNode; virtual;
function TransformSeriesLength(const Node: ISeriesLengthNode): ISeriesLengthNode; virtual;
function TransformRecur(const Node: IRecurNode): IRecurNode; virtual;
// Helper to transform an array of nodes.
function TransformNodes<T: IAstNode>(const Nodes: TArray<T>): TArray<T>;
function Accept(const Node: IAstNode): TDataValue; virtual;
property Done: Boolean read FDone write FDone;
public
// This is the main entry point for the transformer, returning a transformed node.
function Execute(const RootNode: IAstNode): IAstNode;
// Final Visit methods - these should not be overridden. They call the virtual Transform methods.
function VisitConstant(const Node: IConstantNode): TDataValue; override; final;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; final;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override; final;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override; final;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override; final;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; final;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; final;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; final;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; final;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; final;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; final;
function VisitIndexer(const Node: IIndexerNode): TDataValue; override; final;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override; final;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override; final;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override; final;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override; final;
function VisitRecurNode(const Node: IRecurNode): TDataValue; override; final;
end;
// TAstTraverser simply inherits the identity-transform (cloning) behavior from TAstTransformer.
TAstTraverser = class(TAstTransformer);
// Generic traverser for managing state during AST walks.
TAstTraverser<T> = class(TAstTraverser)
private
FData: TStack<T>;
protected
function Accept(const Node: IAstNode): TDataValue; override;
// Called before a node is visited. The returned value is pushed onto the state stack.
function EnterNode(const Node: IAstNode): T; virtual; abstract;
// Called after a node has been visited.
procedure ExitNode(const Node: IAstNode; const Data: T); virtual;
property Data: TStack<T> read FData;
public
constructor Create;
destructor Destroy; override;
end;
implementation
{ TAstTransformer }
function TAstTransformer.Accept(const Node: IAstNode): TDataValue;
begin
if (not Assigned(Node)) or FDone then
exit;
Result := Node.Accept(Self);
end;
function TAstTransformer.Execute(const RootNode: IAstNode): IAstNode;
begin
Result := Accept(RootNode).AsIntf<IAstNode>;
end;
// --- Default implementations for Transform... methods (Identity Transformation / Cloning) ---
function TAstTransformer.TransformConstant(const Node: IConstantNode): IConstantNode;
begin
// The node itself is immutable, return it directly.
Result := Node;
end;
function TAstTransformer.TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode;
begin
Result := Node;
end;
function TAstTransformer.TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode;
begin
var left := Accept(Node.Left).AsIntf<IAstNode>;
var right := Accept(Node.Right).AsIntf<IAstNode>;
if (left = Node.Left) and (right = Node.Right) then
Result := Node
else
Result := TAst.BinaryExpr(left, Node.Operator, right);
end;
function TAstTransformer.TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode;
begin
var right := Accept(Node.Right).AsIntf<IAstNode>;
if right = Node.Right then
Result := Node
else
Result := TAst.UnaryExpr(Node.Operator, right);
end;
function TAstTransformer.TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode;
begin
var condition := Accept(Node.Condition).AsIntf<IAstNode>;
var thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
var elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
if (condition = Node.Condition) and (thenBranch = Node.ThenBranch) and (elseBranch = Node.ElseBranch) then
Result := Node
else
Result := TAst.IfExpr(condition, thenBranch, elseBranch);
end;
function TAstTransformer.TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode;
begin
var condition := Accept(Node.Condition).AsIntf<IAstNode>;
var thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
var elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
if (condition = Node.Condition) and (thenBranch = Node.ThenBranch) and (elseBranch = Node.ElseBranch) then
Result := Node
else
Result := TAst.TernaryExpr(condition, thenBranch, elseBranch);
end;
function TAstTransformer.TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode;
begin
var parameters := TransformNodes<IIdentifierNode>(Node.Parameters);
var body := Accept(Node.Body).AsIntf<IAstNode>;
if (parameters = Node.Parameters) and (body = Node.Body) then
Result := Node
else
Result := TAst.LambdaExpr(parameters, body);
end;
function TAstTransformer.TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode;
begin
var callee := Accept(Node.Callee).AsIntf<IAstNode>;
var args := TransformNodes<IAstNode>(Node.Arguments);
if (callee = Node.Callee) and (args = Node.Arguments) then
Result := Node
else
Result := TAst.FunctionCall(callee, args);
end;
function TAstTransformer.TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode;
begin
// TList is mutable, so we always transform.
var exprs: TArray<IAstNode>;
var i: Integer;
SetLength(exprs, Node.Expressions.Count);
for i := 0 to Node.Expressions.Count - 1 do
exprs[i] := Accept(Node.Expressions[i]).AsIntf<IAstNode>;
Result := TAst.Block(exprs);
end;
function TAstTransformer.TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode;
begin
var identifier := Accept(Node.Identifier).AsIntf<IIdentifierNode>;
var initializer := Accept(Node.Initializer).AsIntf<IAstNode>;
if (identifier = Node.Identifier) and (initializer = Node.Initializer) then
Result := Node
else
Result := TAst.VarDecl(identifier, initializer);
end;
function TAstTransformer.TransformAssignment(const Node: IAssignmentNode): IAssignmentNode;
begin
var identifier := Accept(Node.Identifier).AsIntf<IIdentifierNode>;
var value := Accept(Node.Value).AsIntf<IAstNode>;
if (identifier = Node.Identifier) and (value = Node.Value) then
Result := Node
else
Result := TAst.Assign(identifier, value);
end;
function TAstTransformer.TransformIndexer(const Node: IIndexerNode): IIndexerNode;
begin
var base := Accept(Node.Base).AsIntf<IAstNode>;
var index := Accept(Node.Index).AsIntf<IAstNode>;
if (base = Node.Base) and (index = Node.Index) then
Result := Node
else
Result := TAst.Indexer(base, index);
end;
function TAstTransformer.TransformMemberAccess(const Node: IMemberAccessNode): IMemberAccessNode;
begin
var base := Accept(Node.Base).AsIntf<IAstNode>;
var member := Node.Member;
if (base = Node.Base) and (member = Node.Member) then
Result := Node
else
Result := TAst.MemberAccess(base, member);
end;
function TAstTransformer.TransformCreateSeries(const Node: ICreateSeriesNode): ICreateSeriesNode;
begin
Result := Node;
end;
function TAstTransformer.TransformAddSeriesItem(const Node: IAddSeriesItemNode): IAddSeriesItemNode;
begin
var series := Accept(Node.Series).AsIntf<IIdentifierNode>;
var value := Accept(Node.Value).AsIntf<IAstNode>;
var lookback := Accept(Node.Lookback).AsIntf<IAstNode>;
if (series = Node.Series) and (value = Node.Value) and (lookback = Node.Lookback) then
Result := Node
else
Result := TAst.AddSeriesItem(series, value, lookback);
end;
function TAstTransformer.TransformSeriesLength(const Node: ISeriesLengthNode): ISeriesLengthNode;
begin
var series := Accept(Node.Series).AsIntf<IIdentifierNode>;
if series = Node.Series then
Result := Node
else
Result := TAst.SeriesLength(series);
end;
function TAstTransformer.TransformRecur(const Node: IRecurNode): IRecurNode;
begin
var args := TransformNodes<IAstNode>(Node.Arguments);
if args = Node.Arguments then
Result := Node
else
Result := TAst.Recur(args);
end;
function TAstTransformer.TransformNodes<T>(const Nodes: TArray<T>): TArray<T>;
var
i: Integer;
hasChanged: boolean;
begin
hasChanged := False;
SetLength(Result, Length(Nodes));
for i := 0 to High(Nodes) do
begin
Result[i] := Accept(Nodes[i]).AsIntf<T>;
if Result[i] <> Nodes[i] then
hasChanged := True;
end;
if not hasChanged then
Result := Nodes;
end;
function TAstTransformer.VisitConstant(const Node: IConstantNode): TDataValue;
begin
Result := TDataValue.FromIntf<IConstantNode>(TransformConstant(Node));
end;
function TAstTransformer.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
Result := TDataValue.FromIntf<IIdentifierNode>(TransformIdentifier(Node));
end;
function TAstTransformer.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
Result := TDataValue.FromIntf<IBinaryExpressionNode>(TransformBinaryExpression(Node));
end;
function TAstTransformer.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
Result := TDataValue.FromIntf<IUnaryExpressionNode>(TransformUnaryExpression(Node));
end;
function TAstTransformer.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
Result := TDataValue.FromIntf<IIfExpressionNode>(TransformIfExpression(Node));
end;
function TAstTransformer.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
Result := TDataValue.FromIntf<ITernaryExpressionNode>(TransformTernaryExpression(Node));
end;
function TAstTransformer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
begin
Result := TDataValue.FromIntf<ILambdaExpressionNode>(TransformLambdaExpression(Node));
end;
function TAstTransformer.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
begin
Result := TDataValue.FromIntf<IFunctionCallNode>(TransformFunctionCall(Node));
end;
function TAstTransformer.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
begin
Result := TDataValue.FromIntf<IBlockExpressionNode>(TransformBlockExpression(Node));
end;
function TAstTransformer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
Result := TDataValue.FromIntf<IVariableDeclarationNode>(TransformVariableDeclaration(Node));
end;
function TAstTransformer.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
Result := TDataValue.FromIntf<IAssignmentNode>(TransformAssignment(Node));
end;
function TAstTransformer.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
Result := TDataValue.FromIntf<IIndexerNode>(TransformIndexer(Node));
end;
function TAstTransformer.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
Result := TDataValue.FromIntf<IMemberAccessNode>(TransformMemberAccess(Node));
end;
function TAstTransformer.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
begin
Result := TDataValue.FromIntf<ICreateSeriesNode>(TransformCreateSeries(Node));
end;
function TAstTransformer.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
Result := TDataValue.FromIntf<IAddSeriesItemNode>(TransformAddSeriesItem(Node));
end;
function TAstTransformer.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
Result := TDataValue.FromIntf<ISeriesLengthNode>(TransformSeriesLength(Node));
end;
function TAstTransformer.VisitRecurNode(const Node: IRecurNode): TDataValue;
begin
Result := TDataValue.FromIntf<IRecurNode>(TransformRecur(Node));
end;
{ TAstTraverser<T> }
constructor TAstTraverser<T>.Create;
begin
inherited Create;
FData := TStack<T>.Create;
end;
destructor TAstTraverser<T>.Destroy;
begin
FData.Free;
inherited;
end;
function TAstTraverser<T>.Accept(const Node: IAstNode): TDataValue;
begin
if not Assigned(Node) then
exit;
FData.Push(EnterNode(Node));
try
// Call the inherited Accept, which will dispatch to the virtual Visit... methods
// in the base TAstTransformer, performing the transformation/cloning.
Result := inherited Accept(Node);
finally
var data := FData.Pop;
ExitNode(Node, data);
end;
end;
procedure TAstTraverser<T>.ExitNode(const Node: IAstNode; const Data: T);
begin
end;
end.
Src/AST/Myc.Ast.Traverser.pas
-233
View File
@@ -1,233 +0,0 @@
unit Myc.Ast.Traverser;
interface
uses
System.Classes,
System.Generics.Collections,
Myc.Data.Value,
Myc.Ast.Nodes;
type
// TAstTraverser provides a default AST traversal implementation.
TAstTraverser = class abstract(TInterfacedObject, IAstVisitor)
private
FDone: Boolean;
protected
function Accept(const Node: IAstNode): TDataValue; virtual;
property Done: Boolean read FDone write FDone;
public
function Execute(const RootNode: IAstNode): TDataValue;
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual;
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 VisitFunctionCall(const Node: IFunctionCallNode): 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 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;
end;
// Generic traverser for managing state during AST walks.
TAstTraverser<T> = class abstract(TAstTraverser)
private
FData: TStack<T>;
protected
function Accept(const Node: IAstNode): TDataValue; override;
// Called before a node is visited. The returned value is pushed onto the state stack.
function EnterNode(const Node: IAstNode): T; virtual; abstract;
// Called after a node has been visited.
procedure ExitNode(const Node: IAstNode; const Data: T); virtual;
property Data: TStack<T> read FData;
public
constructor Create;
destructor Destroy; override;
end;
implementation
{ TAstTraverser }
function TAstTraverser.Accept(const Node: IAstNode): TDataValue;
begin
if not Assigned(Node) or FDone then
exit;
Result := Node.Accept(Self);
end;
function TAstTraverser.Execute(const RootNode: IAstNode): TDataValue;
begin
Result := RootNode.Accept(Self);
end;
function TAstTraverser.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
Accept(Node.Series);
Accept(Node.Value);
if Assigned(Node.Lookback) then
Accept(Node.Lookback);
end;
function TAstTraverser.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
Accept(Node.Value);
Accept(Node.Identifier);
end;
function TAstTraverser.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
Accept(Node.Left);
Accept(Node.Right);
end;
function TAstTraverser.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
expr: IAstNode;
begin
for expr in Node.Expressions do
begin
if FDone then
break;
Accept(expr);
end;
end;
function TAstTraverser.VisitConstant(const Node: IConstantNode): TDataValue;
begin
end;
function TAstTraverser.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
begin
end;
function TAstTraverser.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
arg: IAstNode;
begin
Accept(Node.Callee);
for arg in Node.Arguments do
begin
if FDone then
break;
Accept(arg);
end;
end;
function TAstTraverser.VisitRecurNode(const Node: IRecurNode): TDataValue;
var
arg: IAstNode;
begin
for arg in Node.Arguments do
begin
if FDone then
break;
Accept(arg);
end;
end;
function TAstTraverser.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
end;
function TAstTraverser.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
Accept(Node.Condition);
Accept(Node.ThenBranch);
if Assigned(Node.ElseBranch) then
Accept(Node.ElseBranch);
end;
function TAstTraverser.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
Accept(Node.Base);
Accept(Node.Index);
end;
function TAstTraverser.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
param: IIdentifierNode;
begin
for param in Node.Parameters do
begin
if FDone then
break;
Accept(param);
end;
Accept(Node.Body);
end;
function TAstTraverser.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
// Do not visit the member identifier, as it's not a variable in the current scope.
Accept(Node.Base);
end;
function TAstTraverser.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
Accept(Node.Series);
end;
function TAstTraverser.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
Accept(Node.Condition);
Accept(Node.ThenBranch);
Accept(Node.ElseBranch);
end;
function TAstTraverser.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
Accept(Node.Right);
end;
function TAstTraverser.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
if Assigned(Node.Initializer) then
Accept(Node.Initializer);
Accept(Node.Identifier);
end;
{ TAstTraverser<T> }
constructor TAstTraverser<T>.Create;
begin
inherited Create;
FData := TStack<T>.Create;
end;
destructor TAstTraverser<T>.Destroy;
begin
FData.Free;
inherited;
end;
function TAstTraverser<T>.Accept(const Node: IAstNode): TDataValue;
begin
if not Assigned(Node) or Done then
exit;
FData.Push(EnterNode(Node));
try
Result := inherited Accept(Node);
finally
var data := FData.Pop;
ExitNode(Node, data);
end;
end;
procedure TAstTraverser<T>.ExitNode(const Node: IAstNode; const Data: T);
begin
end;
end.
Src/AST/Myc.Ast.pas
+5 -51
View File
@@ -27,7 +27,7 @@ type
class procedure RegisterLibrary(const AProc: TRegisterLibraryProc); static;
class function CreateScope(Parent: IExecutionScope; const Descriptor: IScopeDescriptor = nil): IExecutionScope; static;
// --- Existing factory functions ---
// --- Factory functions ---
class function Constant(const AValue: TDataValue): IConstantNode; overload; static;
class function Constant(const AValue: TScalar): IConstantNode; overload; static;
class function Constant(const AValue: String): IConstantNode; overload; static;
@@ -72,15 +72,11 @@ type
TIdentifierNode = class(TAstNode, IIdentifierNode)
private
FName: string;
// --- Annotation fields added for the binder ---
FResolvedAddress: TResolvedAddress;
function GetName: string;
function GetAddress: TResolvedAddress; inline;
public
constructor Create(AName: string);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property Name: string read FName;
property Address: TResolvedAddress read FResolvedAddress write FResolvedAddress;
end;
TBinaryExpressionNode = class(TAstNode, IBinaryExpressionNode)
@@ -137,46 +133,34 @@ type
private
FParameters: TArray<IIdentifierNode>;
FBody: IAstNode;
FScopeDescriptor: IScopeDescriptor;
FUpvalues: TArray<TResolvedAddress>;
FHasNestedLambdas: Boolean;
function GetParameters: TArray<IIdentifierNode>;
function GetBody: IAstNode;
function GetScopeDescriptor: IScopeDescriptor;
function GetUpvalues: TArray<TResolvedAddress>;
function GetHasNestedLambdas: Boolean;
public
constructor Create(const AParameters: TArray<IIdentifierNode>; const ABody: IAstNode);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property HasNestedLambdas: Boolean read FHasNestedLambdas write FHasNestedLambdas;
property ScopeDescriptor: IScopeDescriptor read FScopeDescriptor write FScopeDescriptor;
property Upvalues: TArray<TResolvedAddress> read FUpvalues write FUpvalues;
property Body: IAstNode read FBody;
property Parameters: TArray<IIdentifierNode> read FParameters;
end;
TFunctionCallNode = class(TAstNode, IFunctionCallNode)
private
FCallee: IAstNode;
FArguments: TArray<IAstNode>;
FIsTailCall: Boolean;
function GetCallee: IAstNode;
function GetArguments: TArray<IAstNode>;
function GetIsTailCall: Boolean;
public
constructor Create(const ACallee: IAstNode; const AArguments: TArray<IAstNode>);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property IsTailCall: Boolean read FIsTailCall write FIsTailCall;
end;
TRecurNode = class(TAstNode, IRecurNode)
private
FArguments: TArray<IAstNode>;
FIsTailCall: Boolean;
function GetArguments: TArray<IAstNode>;
function GetIsTailCall: Boolean;
public
constructor Create(const AArguments: TArray<IAstNode>);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property IsTailCall: Boolean read FIsTailCall write FIsTailCall;
end;
TBlockExpressionNode = class(TAstNode, IBlockExpressionNode)
@@ -266,9 +250,6 @@ type
implementation
uses
Myc.Ast.Traverser;
{ TConstantNode }
constructor TConstantNode.Create(const AValue: TDataValue);
@@ -308,11 +289,6 @@ begin
Result := FName;
end;
function TIdentifierNode.GetAddress: TResolvedAddress;
begin
Result := FResolvedAddress;
end;
{ TBinaryExpressionNode }
constructor TBinaryExpressionNode.Create(ALeft: IAstNode; AOperator: TScalar.TBinaryOp; ARight: IAstNode);
@@ -434,12 +410,6 @@ begin
inherited Create;
FBody := ABody;
FParameters := AParameters;
FScopeDescriptor := nil;
end;
function TLambdaExpressionNode.GetUpvalues: TArray<TResolvedAddress>;
begin
Result := FUpvalues;
end;
function TLambdaExpressionNode.Accept(const Visitor: IAstVisitor): TDataValue;
@@ -452,21 +422,11 @@ begin
Result := FBody;
end;
function TLambdaExpressionNode.GetHasNestedLambdas: Boolean;
begin
Result := FHasNestedLambdas;
end;
function TLambdaExpressionNode.GetParameters: TArray<IIdentifierNode>;
begin
Result := FParameters;
end;
function TLambdaExpressionNode.GetScopeDescriptor: IScopeDescriptor;
begin
Result := FScopeDescriptor;
end;
{ TFunctionCallNode }
constructor TFunctionCallNode.Create(const ACallee: IAstNode; const AArguments: TArray<IAstNode>);
@@ -474,7 +434,6 @@ begin
inherited Create;
FCallee := ACallee;
FArguments := AArguments;
FIsTailCall := False;
end;
function TFunctionCallNode.Accept(const Visitor: IAstVisitor): TDataValue;
@@ -492,18 +451,12 @@ begin
Result := FCallee;
end;
function TFunctionCallNode.GetIsTailCall: Boolean;
begin
Result := FIsTailCall;
end;
{ TRecurNode }
constructor TRecurNode.Create(const AArguments: TArray<IAstNode>);
begin
inherited Create;
FArguments := AArguments;
FIsTailCall := True;
end;
function TRecurNode.Accept(const Visitor: IAstVisitor): TDataValue;
@@ -518,7 +471,8 @@ end;
function TRecurNode.GetIsTailCall: Boolean;
begin
Result := FIsTailCall;
// 'recur' is always a tail call by definition.
Result := True;
end;
{ TBlockExpressionNode }
Src/Data/Myc.Data.Value.pas
+19 -1
View File
@@ -9,7 +9,7 @@ uses
Myc.Data.Series;
type
TDataValueKind = (vkVoid, vkScalar, vkText, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkGeneric);
TDataValueKind = (vkVoid, vkScalar, vkText, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric);
TDataValue = record
type
@@ -58,6 +58,9 @@ type
class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline;
class operator Implicit(const AValue: TObject): TDataValue; overload; inline;
class function FromIntf<T: IInterface>(const AValue: T): TDataValue; static;
function AsIntf<T: IInterface>: T; inline;
class function FromGeneric<T>(const [ref] AValue: T): TDataValue; static; inline;
function AsGeneric<T>: T; inline;
@@ -222,6 +225,15 @@ begin
Result := TVal<T>(FInterface).Value;
end;
function TDataValue.AsIntf<T>: T;
begin
if FKind = Ord(vkLazy) then
exit(AsLazy.Value.AsGeneric<T>);
if FKind <> Ord(vkInterface) then
raise EInvalidCast.Create('Cannot read value as interface.');
Result := T(FInterface);
end;
function TDataValue.AsObject: TObject;
begin
if FKind = Ord(vkLazy) then
@@ -296,6 +308,12 @@ begin
end;
end;
class function TDataValue.FromIntf<T>(const AValue: T): TDataValue;
begin
Result.FKind := Ord(vkInterface);
Result.FInterface := IInterface(AValue);
end;
class function TDataValue.FromGeneric<T>(const [ref] AValue: T): TDataValue;
begin
Result.FKind := Ord(vkGeneric);