diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr
index 3adea48..ebedc40 100644
--- a/ASTPlayground/ASTPlayground.dpr
+++ b/ASTPlayground/ASTPlayground.dpr
@@ -14,7 +14,9 @@ uses
Myc.Ast.Debugger in '..\Src\AST\Myc.Ast.Debugger.pas',
Myc.Fmx.AstEditor.Node in 'Myc.Fmx.AstEditor.Node.pas',
Myc.Fmx.AstEditor.Workspace in 'Myc.Fmx.AstEditor.Workspace.pas',
- Myc.Fmx.AstEditor.Text in 'Myc.Fmx.AstEditor.Text.pas';
+ Myc.Fmx.AstEditor.Text in 'Myc.Fmx.AstEditor.Text.pas',
+ Myc.Ast.Traverser in '..\Src\AST\Myc.Ast.Traverser.pas',
+ Myc.Ast.Binding in '..\Src\AST\Myc.Ast.Binding.pas';
{$R *.res}
diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj
index aced057..b620b06 100644
--- a/ASTPlayground/ASTPlayground.dproj
+++ b/ASTPlayground/ASTPlayground.dproj
@@ -4,7 +4,7 @@
20.3
FMX
True
- Debug
+ Release
Win64
ASTPlayground
2
@@ -146,6 +146,8 @@
+
+
Base
diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas
index 7c5015c..894de89 100644
--- a/ASTPlayground/MainForm.pas
+++ b/ASTPlayground/MainForm.pas
@@ -32,7 +32,6 @@ uses
Myc.Ast.Printer,
FMX.Layouts,
FMX.Objects,
- Myc.Ast.Scope,
Myc.Ast.Debugger;
type
@@ -103,6 +102,7 @@ implementation
uses
Myc.Data.Scalar.JSON,
Myc.Data.Decimal,
+ Myc.Ast.Binding,
System.Diagnostics, // For TStopwatch
Myc.Ast.Json; // For TAstJson serialization
@@ -114,7 +114,7 @@ begin
FWorkspace.Repaint;
// Create and prepare the global scope once
- FGScope := TExecutionScope.Create(nil);
+ FGScope := TAst.CreateScope(nil);
RegisterNativeFunctions(FGScope);
end;
@@ -122,7 +122,7 @@ function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecution
begin
// This helper function handles simple, one-off script executions.
// It binds the AST and then decides whether to run a debug session or a standard evaluation.
- var scriptScope := TAst.Bind(ANode, AParentScope);
+ var scriptScope := TAstBinder.Bind(ANode, AParentScope).CreateScope(AParentScope);
var visitor := CreateVisitor(scriptScope);
Result := ANode.Accept(visitor);
end;
@@ -258,7 +258,7 @@ begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Series Test ---');
- scope := TExecutionScope.Create(FGScope);
+ scope := TAst.CreateScope(FGScope);
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson);
series := TScalarRecordSeries.Create(recordDef);
for i := 0 to 4 do
@@ -381,7 +381,8 @@ begin
if FlowOnlyBox.IsChecked then
visu := TVisualizationMode.vmControlFlow;
- FWorkspace.BuildTree(FLastAst, TAst.Bind(FLastAst, FGScope), TPointF.Create(X, Y), visu);
+ var descr := TAstBinder.Bind(FLastAst, FGScope);
+ FWorkspace.BuildTree(FLastAst, descr.CreateScope(FGScope), TPointF.Create(X, Y), visu);
end;
end;
@@ -498,7 +499,7 @@ begin
FLastAst := setupAst;
// 1. Bind and execute the setup script.
- scope := TAst.Bind(setupAst, FGScope);
+ scope := TAstBinder.Bind(setupAst, FGScope).CreateScope(FGScope);
// This is a temporary visitor just for the setup execution.
var setupVisitor := CreateVisitor(scope);
@@ -510,7 +511,7 @@ begin
var callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]);
// 3. Re-bind the scope with the new AST. This creates the FINAL scope for the loop.
- scope := TAst.Bind(callAst, scope);
+ scope := TAstBinder.Bind(callAst, scope).CreateScope(scope);
var seriesAddress := currentSeriesIdent.Address;
var visitor := CreateVisitor(scope);
@@ -589,7 +590,7 @@ begin
]
);
- TriggerScope := TAst.Bind(blk, FGScope);
+ TriggerScope := TAstBinder.Bind(blk, FGScope).CreateScope(FGScope);
// This case is simple enough to just inline the logic from ExecuteAst
var visitor := CreateVisitor(TriggerScope);
@@ -642,7 +643,7 @@ begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Calling external Delphi function from AST ---');
- scope := TExecutionScope.Create(FGScope);
+ scope := TAst.CreateScope(FGScope);
scope.Define(
'delphiAdd',
diff --git a/ASTPlayground/Myc.Fmx.AstEditor.Workspace.pas b/ASTPlayground/Myc.Fmx.AstEditor.Workspace.pas
index 229989f..6a20c8a 100644
--- a/ASTPlayground/Myc.Fmx.AstEditor.Workspace.pas
+++ b/ASTPlayground/Myc.Fmx.AstEditor.Workspace.pas
@@ -14,7 +14,8 @@ uses
FMX.Graphics,
FMX.Objects,
Myc.Ast,
- Myc.Ast.Nodes;
+ Myc.Ast.Nodes,
+ Myc.Ast.Binding;
type
TPinConnection = record
@@ -119,7 +120,7 @@ begin
connections := TList.Create;
try
// Create the scope descriptor from the execution scope provided by the binder.
- rootDescriptor := TAst.CreateDescriptor(RootScope);
+ rootDescriptor := TAstBinder.CreateDescriptor(RootScope);
RootNode.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections, nil, AMode, nil, nil, rootDescriptor));
FConnections := FConnections + connections.ToArray;
finally
diff --git a/Src/AST/Myc.Ast.Binding.pas b/Src/AST/Myc.Ast.Binding.pas
new file mode 100644
index 0000000..f351573
--- /dev/null
+++ b/Src/AST/Myc.Ast.Binding.pas
@@ -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)
+ type
+ TUpvalueMapping = class
+ Map: TDictionary;
+ Nodes: TList;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ end;
+ private
+ FCurrentDescriptor: IScopeDescriptor;
+ FUpvalueStack: TStack;
+ 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)
+ 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;
+ function GetParent: IScopeDescriptor;
+ function GetSlotCount: Integer;
+ function GetSymbols: TDictionary;
+ 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 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.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;
+ sortedPairs: TArray>;
+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>(
+ sortedPairs,
+ TComparer>.Construct(
+ function(const Left, Right: TPair): 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.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;
+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.Create(TResolvedAddressComparer.Default);
+ Nodes := TList.Create();
+end;
+
+destructor TAstBinder.TUpvalueMapping.Destroy;
+begin
+ Nodes.Free;
+ Map.Free;
+ inherited Destroy;
+end;
+
+end.
diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas
index 8dd397b..f0c79c1 100644
--- a/Src/AST/Myc.Ast.Evaluator.pas
+++ b/Src/AST/Myc.Ast.Evaluator.pas
@@ -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.
diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas
index 8af6eb1..7dd5e9c 100644
--- a/Src/AST/Myc.Ast.Nodes.pas
+++ b/Src/AST/Myc.Ast.Nodes.pas
@@ -77,6 +77,7 @@ type
function GetSymbols: TDictionary;
{$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 read GetSymbols;
@@ -182,9 +183,11 @@ type
{$region 'private'}
function GetCallee: IAstNode;
function GetArguments: TArray;
+ function GetIsTailCall: Boolean;
{$endregion}
property Callee: IAstNode read GetCallee;
property Arguments: TArray read GetArguments;
+ property IsTailCall: Boolean read GetIsTailCall;
end;
IBlockExpressionNode = interface(IAstNode)
diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas
index b129a43..fdd5f46 100644
--- a/Src/AST/Myc.Ast.Scope.pas
+++ b/Src/AST/Myc.Ast.Scope.pas
@@ -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;
+ FIdx: Integer;
+ function GetValue: TDataValue;
+ procedure SetValue(const AValue: TDataValue);
+ public
+ constructor Create(const AValues: TArray; 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 = nil
- );
+ constructor Create(AParent: IExecutionScope; const ADescriptor: IScopeDescriptor; const ACapturedUpvalues: TArray);
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; 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.
diff --git a/Src/AST/Myc.Ast.Traverser.pas b/Src/AST/Myc.Ast.Traverser.pas
new file mode 100644
index 0000000..a958998
--- /dev/null
+++ b/Src/AST/Myc.Ast.Traverser.pas
@@ -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 = class abstract(TAstTraverser)
+ private
+ FData: TStack;
+ 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 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 }
+
+constructor TAstTraverser.Create;
+begin
+ inherited Create;
+ FData := TStack.Create;
+end;
+
+destructor TAstTraverser.Destroy;
+begin
+ FData.Free;
+ inherited;
+end;
+
+function TAstTraverser.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.ExitNode(const Node: IAstNode; const Data: T);
+begin
+
+end;
+
+end.
diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas
index b524b27..d2dc0fb 100644
--- a/Src/AST/Myc.Ast.pas
+++ b/Src/AST/Myc.Ast.pas
@@ -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;
- function GetParent: IScopeDescriptor;
- function GetSlotCount: Integer;
- function GetSymbols: TDictionary;
- 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 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;
@@ -191,22 +136,24 @@ type
constructor Create(const AParameters: TArray; 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 read FUpvalues write FUpvalues;
end;
- { TFunctionCallNode }
TFunctionCallNode = class(TAstNode, IFunctionCallNode)
private
FCallee: IAstNode;
FArguments: TArray;
+ FIsTailCall: Boolean;
function GetCallee: IAstNode;
function GetArguments: TArray;
+ function GetIsTailCall: Boolean;
public
constructor Create(const ACallee: IAstNode; const AArguments: TArray);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
+ property IsTailCall: Boolean read FIsTailCall write FIsTailCall;
end;
- { TBlockExpressionNode }
TBlockExpressionNode = class(TAstNode, IBlockExpressionNode)
private
FExpressions: TList;
@@ -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)
- 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>;
- FUpvalueNodesStack: TStack>;
- 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.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;
-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>.Create;
- FUpvalueNodesStack := TStack>.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;
- upvalueNodes: TList;
- 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;
- upvalueNodes: TList;
- sourceAddresses: TArray;
- sortedPairs: TArray>;
-begin
- FUpvalueMapStack.Push(TDictionary.Create(TResolvedAddressComparer.Default));
- FUpvalueNodesStack.Push(TList.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>(
- sortedPairs,
- TComparer>.Construct(
- function(const Left, Right: TPair): 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): 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.