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

Refactoring Binder

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-17 13:34:48 +02:00
parent b972b05a07
commit ea5879520a
10 changed files with 713 additions and 507 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.pas
+20 -484
View File
@@ -15,6 +15,8 @@ uses
type
// Record acting as a namespace for the factory functions.
TAst = record
class function CreateScope(Parent: IExecutionScope; const Descriptor: IScopeDescriptor = nil): IExecutionScope; static;
// --- Existing factory functions ---
class function Constant(AValue: TScalar): IConstantNode; static;
class function Identifier(AName: string): IIdentifierNode; static;
@@ -37,64 +39,14 @@ type
const ALookback: IAstNode = nil
): IAddSeriesItemNode; static;
class function SeriesLength(const ASeries: IIdentifierNode): ISeriesLengthNode; static;
class function CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor; static;
class function Bind(const RootNode: IAstNode; const ParentScope: IExecutionScope): IExecutionScope; static;
end;
// TAstTraverser provides a default AST traversal implementation.
TAstTraverser = class abstract(TInterfacedObject, IAstVisitor)
private
FDone: Boolean;
protected
property Done: Boolean read FDone write FDone;
public
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
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;
end;
implementation
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(AParent: IScopeDescriptor);
destructor Destroy; override;
function Define(const Name: string): Integer;
function FindSymbol(const Name: string; out Depth, Index: Integer): Boolean;
function CreateScope(const AParent: IExecutionScope): IExecutionScope;
procedure PopulateFromScope(const AScope: IExecutionScope);
property Symbols: TDictionary<string, Integer> read FSymbols;
end;
{ TAstNode }
// Common base class for AST nodes to reduce boilerplate.
TAstNode = class(TInterfacedObject, IAstNode)
public
function Accept(const Visitor: IAstVisitor): TDataValue; virtual; abstract;
end;
{ TConstantNode }
TConstantNode = class(TAstNode, IConstantNode)
private
FValue: TScalar;
@@ -104,8 +56,6 @@ type
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
{ TIdentifierNode }
// TIdentifierNode now includes fields for binder annotations.
TIdentifierNode = class(TAstNode, IIdentifierNode)
private
FName: string;
@@ -117,10 +67,9 @@ type
constructor Create(AName: string);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property Name: string read FName;
property Address: TResolvedAddress read GetAddress;
property Address: TResolvedAddress read FResolvedAddress write FResolvedAddress;
end;
{ TBinaryExpressionNode }
TBinaryExpressionNode = class(TAstNode, IBinaryExpressionNode)
private
FLeft: IAstNode;
@@ -134,7 +83,6 @@ type
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
{ TUnaryExpressionNode }
TUnaryExpressionNode = class(TAstNode, IUnaryExpressionNode)
private
FOperator: TUnaryOperator;
@@ -146,7 +94,6 @@ type
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
{ TIfExpressionNode }
TIfExpressionNode = class(TAstNode, IIfExpressionNode)
private
FCondition: IAstNode;
@@ -160,7 +107,6 @@ type
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
{ TTernaryExpressionNode }
TTernaryExpressionNode = class(TAstNode, ITernaryExpressionNode)
private
FCondition: IAstNode;
@@ -174,7 +120,6 @@ type
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
{ TLambdaExpressionNode }
TLambdaExpressionNode = class(TAstNode, ILambdaExpressionNode)
private
FParameters: TArray<IIdentifierNode>;
@@ -191,22 +136,24 @@ type
constructor Create(const AParameters: TArray<IIdentifierNode>; const ABody: IAstNode);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property HasNestedLambdas: Boolean read FHasNestedLambdas write FHasNestedLambdas;
property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor;
property ScopeDescriptor: IScopeDescriptor read FScopeDescriptor write FScopeDescriptor;
property Upvalues: TArray<TResolvedAddress> read FUpvalues write FUpvalues;
end;
{ TFunctionCallNode }
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;
{ TBlockExpressionNode }
TBlockExpressionNode = class(TAstNode, IBlockExpressionNode)
private
FExpressions: TList<IAstNode>;
@@ -217,7 +164,6 @@ type
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
{ TVariableDeclarationNode }
TVariableDeclarationNode = class(TAstNode, IVariableDeclarationNode)
private
FIdentifier: IIdentifierNode;
@@ -229,7 +175,6 @@ type
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
{ TAssignmentNode }
TAssignmentNode = class(TAstNode, IAssignmentNode)
private
FIdentifier: IIdentifierNode;
@@ -241,7 +186,6 @@ type
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
{ TIndexerNode }
TIndexerNode = class(TAstNode, IIndexerNode)
private
FBase: IAstNode;
@@ -253,7 +197,6 @@ type
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
{ TMemberAccessNode }
TMemberAccessNode = class(TAstNode, IMemberAccessNode)
private
FBase: IAstNode;
@@ -265,7 +208,6 @@ type
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
{ TCreateSeriesNode }
TCreateSeriesNode = class(TAstNode, ICreateSeriesNode)
private
FDefinition: String;
@@ -275,7 +217,6 @@ type
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
{ TAddSeriesItemNode }
TAddSeriesItemNode = class(TAstNode, IAddSeriesItemNode)
private
FSeries: IIdentifierNode;
@@ -289,7 +230,6 @@ type
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
{ TSeriesLengthNode }
TSeriesLengthNode = class(TAstNode, ISeriesLengthNode)
private
FSeries: IIdentifierNode;
@@ -299,110 +239,10 @@ type
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
TResolvedAddressComparer = class(TEqualityComparer<TResolvedAddress>)
public
function Equals(const Left, Right: TResolvedAddress): Boolean; override;
function GetHashCode(const Value: TResolvedAddress): Integer; override;
end;
implementation
// --- Binder Implementation ---
TBinder = class(TAstTraverser)
private
FCurrentDescriptor: IScopeDescriptor;
FUpvalueMapStack: TStack<TDictionary<TResolvedAddress, Integer>>;
FUpvalueNodesStack: TStack<TList<IIdentifierNode>>;
FNestedLambdaCount: Integer;
procedure EnterScope;
procedure ExitScope;
public
constructor Create(const AInitialScope: IExecutionScope);
destructor Destroy; override;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
property CurrentDescriptor: IScopeDescriptor read FCurrentDescriptor;
end;
{ TResolvedAddressComparer }
function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean;
begin
Result := (Left.Kind = Right.Kind) and (Left.ScopeDepth = Right.ScopeDepth) and (Left.SlotIndex = Right.SlotIndex);
end;
function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer;
begin
// Simple combining hash function
Result := 17;
Result := Result * 23 + Ord(Value.Kind);
Result := Result * 23 + Value.ScopeDepth;
Result := Result * 23 + Value.SlotIndex;
end;
{ TScopeDescriptor }
constructor TScopeDescriptor.Create(AParent: IScopeDescriptor);
begin
inherited Create;
FParent := AParent;
FSymbols := TDictionary<string, Integer>.Create;
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;
var
currentDescriptor: IScopeDescriptor;
begin
Depth := 0;
currentDescriptor := Self;
while Assigned(currentDescriptor) do
begin
if (currentDescriptor as TScopeDescriptor).FSymbols.TryGetValue(Name, Index) then
Exit(True);
inc(Depth);
currentDescriptor := currentDescriptor.Parent;
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;
function TScopeDescriptor.CreateScope(const AParent: IExecutionScope): IExecutionScope;
begin
Result := TExecutionScope.Create(AParent, Self);
end;
procedure TScopeDescriptor.PopulateFromScope(const AScope: IExecutionScope);
begin
for var pair in (AScope as TExecutionScope).NameToIndex do
if not FSymbols.ContainsKey(pair.Key) then
FSymbols.Add(pair.Key, pair.Value);
end;
uses
Myc.Ast.Traverser;
{ TConstantNode }
@@ -606,6 +446,7 @@ begin
inherited Create;
FCallee := ACallee;
FArguments := AArguments;
FIsTailCall := False;
end;
function TFunctionCallNode.Accept(const Visitor: IAstVisitor): TDataValue;
@@ -623,6 +464,11 @@ begin
Result := FCallee;
end;
function TFunctionCallNode.GetIsTailCall: Boolean;
begin
Result := FIsTailCall;
end;
{ TBlockExpressionNode }
constructor TBlockExpressionNode.Create(const AExpressions: array of IAstNode);
@@ -813,172 +659,6 @@ begin
Result := FSeries;
end;
{ TBinder }
constructor TBinder.Create(const AInitialScope: IExecutionScope);
begin
inherited Create;
FCurrentDescriptor := TAst.CreateDescriptor(AInitialScope);
FUpvalueMapStack := TStack<TDictionary<TResolvedAddress, Integer>>.Create;
FUpvalueNodesStack := TStack<TList<IIdentifierNode>>.Create;
FNestedLambdaCount := 0;
end;
destructor TBinder.Destroy;
begin
while FUpvalueMapStack.Count > 0 do
FUpvalueMapStack.Pop.Free;
FUpvalueMapStack.Free;
while FUpvalueNodesStack.Count > 0 do
FUpvalueNodesStack.Pop.Free;
FUpvalueNodesStack.Free;
inherited;
end;
procedure TBinder.EnterScope;
begin
FCurrentDescriptor := TScopeDescriptor.Create(FCurrentDescriptor);
end;
procedure TBinder.ExitScope;
begin
FCurrentDescriptor := FCurrentDescriptor.Parent;
end;
function TBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
var
depth, idx: Integer;
identNode: TIdentifierNode;
upvalueMap: TDictionary<TResolvedAddress, Integer>;
upvalueNodes: TList<IIdentifierNode>;
originalAddress: TResolvedAddress;
upvalueIndex: Integer;
begin
identNode := Node as TIdentifierNode;
if identNode.Address.Kind <> akUnresolved then
Exit;
if (FCurrentDescriptor as TScopeDescriptor).FindSymbol(identNode.Name, depth, idx) then
begin
if (depth > 0) and (FUpvalueMapStack.Count > 0) then
begin
upvalueMap := FUpvalueMapStack.Peek;
upvalueNodes := FUpvalueNodesStack.Peek;
// Imortant: we are now in the lambda's inner scope, so decrease depth by one to point to the outer scope.
dec(depth);
originalAddress.Create(akLocalOrParent, depth, idx);
if not upvalueMap.TryGetValue(originalAddress, upvalueIndex) then
begin
upvalueIndex := upvalueNodes.Count;
upvalueMap.Add(originalAddress, upvalueIndex);
upvalueNodes.Add(identNode);
end;
identNode.FResolvedAddress.Create(akUpvalue, 0, upvalueIndex);
end
else
identNode.FResolvedAddress.Create(akLocalOrParent, depth, idx);
end
else
raise Exception.CreateFmt('Undefined identifier: "%s"', [identNode.Name]);
end;
function TBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
param: IIdentifierNode;
upvalueMap: TDictionary<TResolvedAddress, Integer>;
upvalueNodes: TList<IIdentifierNode>;
sourceAddresses: TArray<TResolvedAddress>;
sortedPairs: TArray<TPair<TResolvedAddress, Integer>>;
begin
FUpvalueMapStack.Push(TDictionary<TResolvedAddress, Integer>.Create(TResolvedAddressComparer.Default));
FUpvalueNodesStack.Push(TList<IIdentifierNode>.Create);
try
EnterScope;
try
(FCurrentDescriptor as TScopeDescriptor).Define('Self');
for param in Node.Parameters do
(FCurrentDescriptor as TScopeDescriptor).Define(param.Name);
var lastNestedLambdaCount := FNestedLambdaCount;
inherited VisitLambdaExpression(Node);
(Node as TLambdaExpressionNode).HasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
(Node as TLambdaExpressionNode).FScopeDescriptor := FCurrentDescriptor;
finally
ExitScope;
end;
finally
upvalueMap := FUpvalueMapStack.Pop;
upvalueNodes := FUpvalueNodesStack.Pop;
// The map's keys are the source addresses, and values are the indices.
// We need to sort by index to get the addresses in the correct order.
sortedPairs := upvalueMap.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).FUpvalues := sourceAddresses;
upvalueMap.Free;
upvalueNodes.Free;
inc(FNestedLambdaCount);
end;
end;
function TBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
var
slotIndex: Integer;
identNode: TIdentifierNode;
begin
identNode := Node.Identifier as TIdentifierNode;
Node.Initializer.Accept(Self);
slotIndex := (FCurrentDescriptor as TScopeDescriptor).Define(Node.Identifier.Name);
identNode.FResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
end;
{ TAst }
class function TAst.Bind(const RootNode: IAstNode; const ParentScope: IExecutionScope): IExecutionScope;
var
binder: TBinder;
visitor: IAstVisitor;
begin
// Create a binder, initialized with the parent scope (for globals etc.)
binder := TBinder.Create(ParentScope);
visitor := binder;
// Create a new scope descriptor for the script's local variables.
binder.EnterScope;
try
// Traverse the AST. This annotates all nodes AND populates the new descriptor.
RootNode.Accept(visitor);
// Return the completed descriptor for the script's scope.
Result := binder.CurrentDescriptor.CreateScope(ParentScope);
finally
// Restore the binder's internal state.
binder.ExitScope;
end;
end;
class function TAst.AddSeriesItem(const ASeries: IIdentifierNode; const AValue: IAstNode; const ALookback: IAstNode): IAddSeriesItemNode;
begin
Result := TAddSeriesItemNode.Create(ASeries, AValue, ALookback);
@@ -1014,15 +694,9 @@ begin
Result := TBinaryExpressionNode.Create(ALeft, AOperator, ARight);
end;
class function TAst.CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor;
class function TAst.CreateScope(Parent: IExecutionScope; const Descriptor: IScopeDescriptor = nil): IExecutionScope;
begin
if Scope is TExecutionScope then
begin
Result := TScopeDescriptor.Create(CreateDescriptor(Scope.Parent));
(Result as TScopeDescriptor).PopulateFromScope(Scope);
end
else
Result := TScopeDescriptor.Create(nil);
Result := TExecutionScope.Create(Parent, Descriptor, nil);
end;
class function TAst.FunctionCall(const ACallee: IAstNode; const AArguments: TArray<IAstNode>): IFunctionCallNode;
@@ -1040,7 +714,7 @@ begin
Result := TIfExpressionNode.Create(ACondition, AThenBranch, AElseBranch);
end;
class function TAst.Indexer(const ABase, AIndex: IAstNode): IIndexerNode;
class function TAst.Indexer(const ABase: IAstNode; const AIndex: IAstNode): IIndexerNode;
begin
Result := TIndexerNode.Create(ABase, AIndex);
end;
@@ -1075,142 +749,4 @@ begin
Result := TVariableDeclarationNode.Create(AIdentifier, AInitializer);
end;
{ TAstTraverser }
function TAstTraverser.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
if not FDone then
Node.Series.Accept(Self);
if not FDone then
Node.Value.Accept(Self);
if Assigned(Node.Lookback) then
if not FDone then
Node.Lookback.Accept(Self);
end;
function TAstTraverser.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
if not FDone then
Node.Value.Accept(Self);
if not FDone then
Node.Identifier.Accept(Self);
end;
function TAstTraverser.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
if not FDone then
Node.Left.Accept(Self);
if not FDone then
Node.Right.Accept(Self);
end;
function TAstTraverser.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
expr: IAstNode;
begin
for expr in Node.Expressions do
begin
if FDone then
break;
expr.Accept(Self);
end;
end;
function TAstTraverser.VisitConstant(const Node: IConstantNode): TDataValue;
begin
end;
function TAstTraverser.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
begin
end;
function TAstTraverser.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
arg: IAstNode;
begin
if not FDone then
Node.Callee.Accept(Self);
for arg in Node.Arguments do
begin
if FDone then
break;
arg.Accept(Self);
end;
end;
function TAstTraverser.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
end;
function TAstTraverser.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
if not FDone then
Node.Condition.Accept(Self);
if not FDone then
Node.ThenBranch.Accept(Self);
if Assigned(Node.ElseBranch) then
if not FDone then
Node.ElseBranch.Accept(Self);
end;
function TAstTraverser.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
if not FDone then
Node.Base.Accept(Self);
if not FDone then
Node.Index.Accept(Self);
end;
function TAstTraverser.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
param: IIdentifierNode;
begin
for param in Node.Parameters do
begin
if FDone then
break;
param.Accept(Self);
end;
if not FDone then
Node.Body.Accept(Self);
end;
function TAstTraverser.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
// Do not visit the member identifier, as it's not a variable in the current scope.
if not FDone then
Node.Base.Accept(Self);
end;
function TAstTraverser.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
if not FDone then
Node.Series.Accept(Self);
end;
function TAstTraverser.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
if not FDone then
Node.Condition.Accept(Self);
if not FDone then
Node.ThenBranch.Accept(Self);
if not FDone then
Node.ElseBranch.Accept(Self);
end;
function TAstTraverser.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
if not FDone then
Node.Right.Accept(Self);
end;
function TAstTraverser.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
if Assigned(Node.Initializer) then
if not FDone then
Node.Initializer.Accept(Self);
if not FDone then
Node.Identifier.Accept(Self);
end;
end.