Refactoring Binder
This commit is contained in:
@@ -0,0 +1,425 @@
|
||||
unit Myc.Ast.Binding;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
System.Generics.Collections,
|
||||
Myc.Data.Value,
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast.Traverser,
|
||||
Myc.Ast.Scope;
|
||||
|
||||
type
|
||||
TAstBinder = class(TAstTraverser<Boolean>)
|
||||
type
|
||||
TUpvalueMapping = class
|
||||
Map: TDictionary<TResolvedAddress, Integer>;
|
||||
Nodes: TList<IIdentifierNode>;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
private
|
||||
FCurrentDescriptor: IScopeDescriptor;
|
||||
FUpvalueStack: TStack<TUpvalueMapping>;
|
||||
FNestedLambdaCount: Integer;
|
||||
FNextIsTail: Boolean;
|
||||
procedure EnterScope;
|
||||
procedure ExitScope;
|
||||
|
||||
protected
|
||||
function EnterNode(const Node: IAstNode): Boolean; override;
|
||||
|
||||
public
|
||||
constructor Create(const AInitialScope: IExecutionScope);
|
||||
destructor Destroy; override;
|
||||
|
||||
class function Bind(const RootNode: IAstNode; const ParentScope: IExecutionScope): IScopeDescriptor;
|
||||
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 VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
|
||||
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
|
||||
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
|
||||
|
||||
property CurrentDescriptor: IScopeDescriptor read FCurrentDescriptor;
|
||||
property NextIsTail: Boolean write FNextIsTail;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Generics.Defaults,
|
||||
Myc.Ast;
|
||||
|
||||
type
|
||||
TResolvedAddressComparer = class(TEqualityComparer<TResolvedAddress>)
|
||||
public
|
||||
function Equals(const Left, Right: TResolvedAddress): Boolean; override;
|
||||
function GetHashCode(const Value: TResolvedAddress): Integer; override;
|
||||
end;
|
||||
|
||||
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;
|
||||
|
||||
{ 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;
|
||||
|
||||
{ TAstBinder }
|
||||
|
||||
constructor TAstBinder.Create(const AInitialScope: IExecutionScope);
|
||||
begin
|
||||
inherited Create;
|
||||
FCurrentDescriptor := CreateDescriptor(AInitialScope);
|
||||
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(true);
|
||||
FNestedLambdaCount := 0;
|
||||
FNextIsTail := False;
|
||||
end;
|
||||
|
||||
destructor TAstBinder.Destroy;
|
||||
begin
|
||||
FUpvalueStack.Free;
|
||||
inherited;
|
||||
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. The content of the root node is in a tail position.
|
||||
binder.Accept(RootNode);
|
||||
Result := binder.CurrentDescriptor;
|
||||
finally
|
||||
binder.ExitScope;
|
||||
end;
|
||||
finally
|
||||
binder.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TAstBinder.CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor;
|
||||
begin
|
||||
if Scope is TExecutionScope then
|
||||
begin
|
||||
Result := TScopeDescriptor.Create(CreateDescriptor(Scope.Parent));
|
||||
(Result as TScopeDescriptor).PopulateFromScope(Scope);
|
||||
end
|
||||
else
|
||||
Result := TScopeDescriptor.Create(nil);
|
||||
end;
|
||||
|
||||
procedure TAstBinder.EnterScope;
|
||||
begin
|
||||
FCurrentDescriptor := TScopeDescriptor.Create(FCurrentDescriptor);
|
||||
end;
|
||||
|
||||
procedure TAstBinder.ExitScope;
|
||||
begin
|
||||
FCurrentDescriptor := FCurrentDescriptor.Parent;
|
||||
end;
|
||||
|
||||
function TAstBinder.EnterNode(const Node: IAstNode): Boolean;
|
||||
begin
|
||||
// The context for the current node is whatever the parent Visit... method prepared.
|
||||
Result := FNextIsTail;
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
||||
begin
|
||||
FNextIsTail := False;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
||||
begin
|
||||
FNextIsTail := False;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to Node.Expressions.Count - 2 do
|
||||
begin
|
||||
FNextIsTail := False;
|
||||
Accept(Node.Expressions[i]);
|
||||
end;
|
||||
|
||||
if Node.Expressions.Count > 0 then
|
||||
begin
|
||||
// The last expression is in a tail position IF the block itself is.
|
||||
FNextIsTail := Data.Peek;
|
||||
Accept(Node.Expressions.Last);
|
||||
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 := Data.Peek;
|
||||
|
||||
// Let the default traverser visit children (callee, args), but ensure
|
||||
// their context is non-tail.
|
||||
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 as TScopeDescriptor).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.Create(akLocalOrParent, depth, idx);
|
||||
|
||||
if not upvalue.Map.TryGetValue(originalAddress, upvalueIndex) then
|
||||
begin
|
||||
upvalueIndex := upvalue.Nodes.Count;
|
||||
upvalue.Map.Add(originalAddress, upvalueIndex);
|
||||
upvalue.Nodes.Add(identNode);
|
||||
end;
|
||||
|
||||
(Node as TIdentifierNode).Address.Create(akUpvalue, 0, upvalueIndex);
|
||||
end
|
||||
else
|
||||
(Node as TIdentifierNode).Address.Create(akLocalOrParent, depth, idx);
|
||||
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 := Data.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
|
||||
(FCurrentDescriptor as TScopeDescriptor).Define('Self');
|
||||
|
||||
for param in Node.Parameters do
|
||||
(FCurrentDescriptor as TScopeDescriptor).Define(param.Name);
|
||||
|
||||
var lastNestedLambdaCount := FNestedLambdaCount;
|
||||
|
||||
// Manually traverse children since we can't call 'inherited' from the simple traverser.
|
||||
// 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;
|
||||
|
||||
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;
|
||||
|
||||
FUpvalueStack.Pop;
|
||||
|
||||
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 := Data.Peek;
|
||||
Accept(Node.ThenBranch);
|
||||
Accept(Node.ElseBranch);
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
||||
begin
|
||||
FNextIsTail := False;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TAstBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
|
||||
var
|
||||
slotIndex: Integer;
|
||||
begin
|
||||
// The initializer expression is never in a tail position.
|
||||
FNextIsTail := False;
|
||||
if Assigned(Node.Initializer) then
|
||||
Accept(Node.Initializer);
|
||||
|
||||
slotIndex := (FCurrentDescriptor as TScopeDescriptor).Define(Node.Identifier.Name);
|
||||
(Node.Identifier as TIdentifierNode).Address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
|
||||
|
||||
FNextIsTail := False;
|
||||
Accept(Node.Identifier);
|
||||
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, nil);
|
||||
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;
|
||||
|
||||
constructor TAstBinder.TUpvalueMapping.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Map := TDictionary<TResolvedAddress, Integer>.Create(TResolvedAddressComparer.Default);
|
||||
Nodes := TList<IIdentifierNode>.Create();
|
||||
end;
|
||||
|
||||
destructor TAstBinder.TUpvalueMapping.Destroy;
|
||||
begin
|
||||
Nodes.Free;
|
||||
Map.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -9,8 +9,7 @@ uses
|
||||
Myc.Data.Scalar,
|
||||
Myc.Data.Value,
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast.Scope,
|
||||
Myc.Ast;
|
||||
Myc.Ast.Scope;
|
||||
|
||||
type
|
||||
// A factory for creating visitors, primarily used by the debugger subsystem.
|
||||
|
||||
@@ -77,6 +77,7 @@ type
|
||||
function GetSymbols: TDictionary<string, Integer>;
|
||||
{$endregion}
|
||||
function CreateScope(const AParent: IExecutionScope): IExecutionScope;
|
||||
function Define(const Name: string): Integer;
|
||||
property Parent: IScopeDescriptor read GetParent;
|
||||
property SlotCount: Integer read GetSlotCount;
|
||||
property Symbols: TDictionary<string, Integer> read GetSymbols;
|
||||
@@ -182,9 +183,11 @@ type
|
||||
{$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;
|
||||
|
||||
IBlockExpressionNode = interface(IAstNode)
|
||||
|
||||
@@ -15,12 +15,22 @@ type
|
||||
TValueCell = class(TInterfacedObject, IValueCell)
|
||||
private
|
||||
FValue: TDataValue;
|
||||
function GetValue: TDataValue; inline;
|
||||
procedure SetValue(const AValue: TDataValue); inline;
|
||||
function GetValue: TDataValue;
|
||||
procedure SetValue(const AValue: TDataValue);
|
||||
public
|
||||
constructor Create(const AValue: TDataValue);
|
||||
end;
|
||||
|
||||
TValueRef = class(TInterfacedObject, IValueCell)
|
||||
private
|
||||
FValues: TArray<TDataValue>;
|
||||
FIdx: Integer;
|
||||
function GetValue: TDataValue;
|
||||
procedure SetValue(const AValue: TDataValue);
|
||||
public
|
||||
constructor Create(const AValues: TArray<TDataValue>; AIdx: Integer);
|
||||
end;
|
||||
|
||||
private
|
||||
FParent: IExecutionScope;
|
||||
FDescriptor: IScopeDescriptor;
|
||||
@@ -34,11 +44,7 @@ type
|
||||
function GetValues(const Address: TResolvedAddress): TDataValue;
|
||||
procedure SetValues(const Address: TResolvedAddress; const Value: TDataValue);
|
||||
public
|
||||
constructor Create(
|
||||
AParent: IExecutionScope = nil;
|
||||
const ADescriptor: IScopeDescriptor = nil;
|
||||
const ACapturedUpvalues: TArray<IValueCell> = nil
|
||||
);
|
||||
constructor Create(AParent: IExecutionScope; const ADescriptor: IScopeDescriptor; const ACapturedUpvalues: TArray<IValueCell>);
|
||||
destructor Destroy; override;
|
||||
procedure Clear;
|
||||
function Dump: string;
|
||||
@@ -111,6 +117,7 @@ begin
|
||||
case Address.Kind of
|
||||
akUpvalue:
|
||||
begin
|
||||
// TODO Dieser Pfad wir nie erreicht!
|
||||
Assert(Assigned(FCapturedUpvalues), 'Attempt to access an upvalue in a scope with no closure context.');
|
||||
Assert(
|
||||
(Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)),
|
||||
@@ -130,7 +137,7 @@ begin
|
||||
(Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)),
|
||||
'Invalid scope index during value retrieval.'
|
||||
);
|
||||
Result := TValueCell.Create(targetScope.FValues[Address.SlotIndex]);
|
||||
Result := TValueRef.Create(targetScope.FValues, Address.SlotIndex);
|
||||
end;
|
||||
else
|
||||
raise EInvalidOpException.Create('Cannot get value for an unresolved address.');
|
||||
@@ -281,4 +288,21 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TExecutionScope.TValueRef.Create(const AValues: TArray<TDataValue>; AIdx: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
FValues := AValues;
|
||||
FIdx := AIdx;
|
||||
end;
|
||||
|
||||
function TExecutionScope.TValueRef.GetValue: TDataValue;
|
||||
begin
|
||||
Result := FValues[FIdx];
|
||||
end;
|
||||
|
||||
procedure TExecutionScope.TValueRef.SetValue(const AValue: TDataValue);
|
||||
begin
|
||||
FValues[FIdx] := AValue;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,213 @@
|
||||
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 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;
|
||||
|
||||
// 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.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.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.
|
||||
+20
-484
@@ -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.
|
||||
|
||||
Reference in New Issue
Block a user