Files
MycLib/Src/AST/Myc.Ast.pas
T
Michael Schimmel a9cc9633a2 Beginning Editor
2025-09-08 18:59:04 +02:00

1184 lines
36 KiB
ObjectPascal

unit Myc.Ast;
interface
uses
System.Classes,
System.SysUtils,
System.Generics.Collections,
System.Generics.Defaults,
Myc.Data.Scalar,
Myc.Ast.Nodes,
Myc.Ast.Scope;
type
// Record acting as a namespace for the factory functions.
TAst = record
// --- Existing factory functions ---
class function Constant(AValue: TScalar): IConstantNode; static;
class function Identifier(AName: string): IIdentifierNode; static;
class function BinaryExpr(ALeft: IAstNode; AOperator: TBinaryOperator; ARight: IAstNode): IBinaryExpressionNode; static;
class function UnaryExpr(const AOperator: TUnaryOperator; const ARight: IAstNode): IUnaryExpressionNode; static;
class function IfExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): IIfExpressionNode; static;
class function TernaryExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): ITernaryExpressionNode; static;
class function LambdaExpr(const AParameters: TArray<IIdentifierNode>; const ABody: IAstNode): ILambdaExpressionNode; static;
class function FunctionCall(const ACallee: IAstNode; const AArguments: array of IAstNode): IFunctionCallNode; static;
class function Block(const AExpressions: array of IAstNode): IBlockExpressionNode; static;
class function VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IAstNode): IVariableDeclarationNode; static;
class function Assign(const AIdentifier: IIdentifierNode; const AValue: IAstNode): IAssignmentNode; static;
class function AssignResult(const AValue: IAstNode): IAssignmentNode; static; deprecated;
class function Indexer(const ABase: IAstNode; const AIndex: IAstNode): IIndexerNode; static;
class function MemberAccess(const ABase: IAstNode; const AMember: IIdentifierNode): IMemberAccessNode; static;
class function CreateSeries(const ADefinition: String): ICreateSeriesNode; static;
class function AddSeriesItem(
const ASeries: IIdentifierNode;
const AValue: IAstNode;
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)
public
function VisitConstant(const Node: IConstantNode): TAstValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): TAstValue; virtual;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; virtual;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; virtual;
function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; virtual;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue; virtual;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; virtual;
function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; virtual;
function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; virtual;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; virtual;
function VisitAssignment(const Node: IAssignmentNode): TAstValue; virtual;
function VisitIndexer(const Node: IIndexerNode): TAstValue; virtual;
function VisitMemberAccess(const Node: IMemberAccessNode): TAstValue; virtual;
function VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue; virtual;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue; virtual;
function VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue; 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): TAstValue; virtual; abstract;
end;
{ TConstantNode }
TConstantNode = class(TAstNode, IConstantNode)
private
FValue: TScalar;
function GetValue: TScalar;
public
constructor Create(AValue: TScalar);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TIdentifierNode }
// TIdentifierNode now includes fields for binder annotations.
TIdentifierNode = class(TAstNode, IIdentifierNode)
private
FName: string;
// --- Annotation fields added for the binder ---
FResolvedAddress: TResolvedAddress;
function GetName: string;
function GetIsResolved: Boolean; inline;
function GetAddress: TResolvedAddress; inline;
public
constructor Create(AName: string);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
property IsResolved: Boolean read GetIsResolved;
property Name: string read FName;
property Address: TResolvedAddress read GetAddress;
end;
{ TBinaryExpressionNode }
TBinaryExpressionNode = class(TAstNode, IBinaryExpressionNode)
private
FLeft: IAstNode;
FOperator: TBinaryOperator;
FRight: IAstNode;
function GetLeft: IAstNode;
function GetOperator: TBinaryOperator;
function GetRight: IAstNode;
public
constructor Create(ALeft: IAstNode; AOperator: TBinaryOperator; ARight: IAstNode);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TUnaryExpressionNode }
TUnaryExpressionNode = class(TAstNode, IUnaryExpressionNode)
private
FOperator: TUnaryOperator;
FRight: IAstNode;
function GetOperator: TUnaryOperator;
function GetRight: IAstNode;
public
constructor Create(const AOperator: TUnaryOperator; const ARight: IAstNode);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TIfExpressionNode }
TIfExpressionNode = class(TAstNode, IIfExpressionNode)
private
FCondition: IAstNode;
FThenBranch: IAstNode;
FElseBranch: IAstNode;
function GetCondition: IAstNode;
function GetThenBranch: IAstNode;
function GetElseBranch: IAstNode;
public
constructor Create(const ACondition, AThenBranch, AElseBranch: IAstNode);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TTernaryExpressionNode }
TTernaryExpressionNode = class(TAstNode, ITernaryExpressionNode)
private
FCondition: IAstNode;
FThenBranch: IAstNode;
FElseBranch: IAstNode;
function GetCondition: IAstNode;
function GetThenBranch: IAstNode;
function GetElseBranch: IAstNode;
public
constructor Create(const ACondition, AThenBranch, AElseBranch: IAstNode);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TLambdaExpressionNode }
TLambdaExpressionNode = class(TAstNode, ILambdaExpressionNode)
private
FParameters: TArray<IIdentifierNode>;
FBody: IAstNode;
FScopeDescriptor: IScopeDescriptor;
FUpvalues: TArray<TResolvedAddress>;
function GetParameters: TArray<IIdentifierNode>;
function GetBody: IAstNode;
function GetScopeDescriptor: IScopeDescriptor;
function GetUpvalues: TArray<TResolvedAddress>;
public
constructor Create(const AParameters: TArray<IIdentifierNode>; const ABody: IAstNode);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor;
end;
{ TFunctionCallNode }
TFunctionCallNode = class(TAstNode, IFunctionCallNode)
private
FCallee: IAstNode;
FArguments: TList<IAstNode>;
function GetCallee: IAstNode;
function GetArguments: TList<IAstNode>;
public
constructor Create(const ACallee: IAstNode; const AArguments: array of IAstNode);
destructor Destroy; override;
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TBlockExpressionNode }
TBlockExpressionNode = class(TAstNode, IBlockExpressionNode)
private
FExpressions: TList<IAstNode>;
function GetExpressions: TList<IAstNode>;
public
constructor Create(const AExpressions: array of IAstNode);
destructor Destroy; override;
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TVariableDeclarationNode }
TVariableDeclarationNode = class(TAstNode, IVariableDeclarationNode)
private
FIdentifier: IIdentifierNode;
FInitializer: IAstNode;
function GetIdentifier: IIdentifierNode;
function GetInitializer: IAstNode;
public
constructor Create(const AIdentifier: IIdentifierNode; AInitializer: IAstNode);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TAssignmentNode }
TAssignmentNode = class(TAstNode, IAssignmentNode)
private
FIdentifier: IIdentifierNode;
FValue: IAstNode;
function GetIdentifier: IIdentifierNode;
function GetValue: IAstNode;
public
constructor Create(const AIdentifier: IIdentifierNode; const AValue: IAstNode);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TIndexerNode }
TIndexerNode = class(TAstNode, IIndexerNode)
private
FBase: IAstNode;
FIndex: IAstNode;
function GetBase: IAstNode;
function GetIndex: IAstNode;
public
constructor Create(const ABase: IAstNode; const AIndex: IAstNode);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TMemberAccessNode }
TMemberAccessNode = class(TAstNode, IMemberAccessNode)
private
FBase: IAstNode;
FMember: IIdentifierNode;
function GetBase: IAstNode;
function GetMember: IIdentifierNode;
public
constructor Create(const ABase: IAstNode; const AMember: IIdentifierNode);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TCreateSeriesNode }
TCreateSeriesNode = class(TAstNode, ICreateSeriesNode)
private
FDefinition: String;
function GetDefinition: String;
public
constructor Create(const ADefinition: String);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TAddSeriesItemNode }
TAddSeriesItemNode = class(TAstNode, IAddSeriesItemNode)
private
FSeries: IIdentifierNode;
FValue: IAstNode;
FLookback: IAstNode;
function GetSeries: IIdentifierNode;
function GetValue: IAstNode;
function GetLookback: IAstNode;
public
constructor Create(const ASeries: IIdentifierNode; const AValue: IAstNode; const ALookback: IAstNode);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
{ TSeriesLengthNode }
TSeriesLengthNode = class(TAstNode, ISeriesLengthNode)
private
FSeries: IIdentifierNode;
function GetSeries: IIdentifierNode;
public
constructor Create(const ASeries: IIdentifierNode);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
end;
TResolvedAddressComparer = class(TEqualityComparer<TResolvedAddress>)
public
function Equals(const Left, Right: TResolvedAddress): Boolean; override;
function GetHashCode(const Value: TResolvedAddress): Integer; override;
end;
// --- Binder Implementation ---
TBinder = class(TAstTraverser)
private
FCurrentDescriptor: IScopeDescriptor;
FUpvalueMapStack: TStack<TDictionary<TResolvedAddress, Integer>>;
FUpvalueNodesStack: TStack<TList<IIdentifierNode>>;
procedure EnterScope;
procedure ExitScope;
public
constructor Create(const AInitialScope: IExecutionScope);
destructor Destroy; override;
function VisitIdentifier(const Node: IIdentifierNode): TAstValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; 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;
{ TConstantNode }
constructor TConstantNode.Create(AValue: TScalar);
begin
inherited Create;
FValue := AValue;
end;
function TConstantNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitConstant(Self);
end;
function TConstantNode.GetValue: TScalar;
begin
Result := FValue;
end;
{ TIdentifierNode }
constructor TIdentifierNode.Create(AName: string);
begin
inherited Create;
FName := AName;
end;
function TIdentifierNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitIdentifier(Self);
end;
function TIdentifierNode.GetIsResolved: Boolean;
begin
// An identifier is resolved if its kind is not unresolved anymore.
Result := FResolvedAddress.Kind <> akUnresolved;
end;
function TIdentifierNode.GetName: string;
begin
Result := FName;
end;
function TIdentifierNode.GetAddress: TResolvedAddress;
begin
if not IsResolved then
raise EInvalidOpException.Create('Identifier not bound');
Result := FResolvedAddress;
end;
{ TBinaryExpressionNode }
constructor TBinaryExpressionNode.Create(ALeft: IAstNode; AOperator: TBinaryOperator; ARight: IAstNode);
begin
inherited Create;
FLeft := ALeft;
FOperator := AOperator;
FRight := ARight;
end;
function TBinaryExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitBinaryExpression(Self);
end;
function TBinaryExpressionNode.GetLeft: IAstNode;
begin
Result := FLeft;
end;
function TBinaryExpressionNode.GetOperator: TBinaryOperator;
begin
Result := FOperator;
end;
function TBinaryExpressionNode.GetRight: IAstNode;
begin
Result := FRight;
end;
{ TUnaryExpressionNode }
constructor TUnaryExpressionNode.Create(const AOperator: TUnaryOperator; const ARight: IAstNode);
begin
inherited Create;
FOperator := AOperator;
FRight := ARight;
end;
function TUnaryExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitUnaryExpression(Self);
end;
function TUnaryExpressionNode.GetOperator: TUnaryOperator;
begin
Result := FOperator;
end;
function TUnaryExpressionNode.GetRight: IAstNode;
begin
Result := FRight;
end;
{ TIfExpressionNode }
constructor TIfExpressionNode.Create(const ACondition, AThenBranch, AElseBranch: IAstNode);
begin
inherited Create;
FCondition := ACondition;
FThenBranch := AThenBranch;
FElseBranch := AElseBranch;
end;
function TIfExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitIfExpression(Self);
end;
function TIfExpressionNode.GetCondition: IAstNode;
begin
Result := FCondition;
end;
function TIfExpressionNode.GetElseBranch: IAstNode;
begin
Result := FElseBranch;
end;
function TIfExpressionNode.GetThenBranch: IAstNode;
begin
Result := FThenBranch;
end;
{ TTernaryExpressionNode }
constructor TTernaryExpressionNode.Create(const ACondition, AThenBranch, AElseBranch: IAstNode);
begin
inherited Create;
FCondition := ACondition;
FThenBranch := AThenBranch;
FElseBranch := AElseBranch;
end;
function TTernaryExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitTernaryExpression(Self);
end;
function TTernaryExpressionNode.GetCondition: IAstNode;
begin
Result := FCondition;
end;
function TTernaryExpressionNode.GetElseBranch: IAstNode;
begin
Result := FElseBranch;
end;
function TTernaryExpressionNode.GetThenBranch: IAstNode;
begin
Result := FThenBranch;
end;
{ TLambdaExpressionNode }
constructor TLambdaExpressionNode.Create(const AParameters: TArray<IIdentifierNode>; const ABody: IAstNode);
begin
inherited Create;
FBody := ABody;
FParameters := AParameters;
FScopeDescriptor := nil;
end;
function TLambdaExpressionNode.GetUpvalues: TArray<TResolvedAddress>;
begin
Result := FUpvalues;
end;
function TLambdaExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitLambdaExpression(Self);
end;
function TLambdaExpressionNode.GetBody: IAstNode;
begin
Result := FBody;
end;
function TLambdaExpressionNode.GetParameters: TArray<IIdentifierNode>;
begin
Result := FParameters;
end;
function TLambdaExpressionNode.GetScopeDescriptor: IScopeDescriptor;
begin
Result := FScopeDescriptor;
end;
{ TFunctionCallNode }
constructor TFunctionCallNode.Create(const ACallee: IAstNode; const AArguments: array of IAstNode);
var
arg: IAstNode;
begin
inherited Create;
FCallee := ACallee;
FArguments := TList<IAstNode>.Create;
for arg in AArguments do
FArguments.Add(arg);
end;
destructor TFunctionCallNode.Destroy;
begin
FArguments.Free;
inherited;
end;
function TFunctionCallNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitFunctionCall(Self);
end;
function TFunctionCallNode.GetArguments: TList<IAstNode>;
begin
Result := FArguments;
end;
function TFunctionCallNode.GetCallee: IAstNode;
begin
Result := FCallee;
end;
{ TBlockExpressionNode }
constructor TBlockExpressionNode.Create(const AExpressions: array of IAstNode);
var
expr: IAstNode;
begin
inherited Create;
FExpressions := TList<IAstNode>.Create;
for expr in AExpressions do
FExpressions.Add(expr);
end;
destructor TBlockExpressionNode.Destroy;
begin
FExpressions.Free;
inherited;
end;
function TBlockExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitBlockExpression(Self);
end;
function TBlockExpressionNode.GetExpressions: TList<IAstNode>;
begin
Result := FExpressions;
end;
{ TVariableDeclarationNode }
constructor TVariableDeclarationNode.Create(const AIdentifier: IIdentifierNode; AInitializer: IAstNode);
begin
inherited Create;
FIdentifier := AIdentifier;
FInitializer := AInitializer;
end;
function TVariableDeclarationNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitVariableDeclaration(Self);
end;
function TVariableDeclarationNode.GetIdentifier: IIdentifierNode;
begin
Result := FIdentifier;
end;
function TVariableDeclarationNode.GetInitializer: IAstNode;
begin
Result := FInitializer;
end;
{ TAssignmentNode }
constructor TAssignmentNode.Create(const AIdentifier: IIdentifierNode; const AValue: IAstNode);
begin
inherited Create;
FIdentifier := AIdentifier;
FValue := AValue;
end;
function TAssignmentNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitAssignment(Self);
end;
function TAssignmentNode.GetIdentifier: IIdentifierNode;
begin
Result := FIdentifier;
end;
function TAssignmentNode.GetValue: IAstNode;
begin
Result := FValue;
end;
{ TIndexerNode }
constructor TIndexerNode.Create(const ABase, AIndex: IAstNode);
begin
inherited Create;
FBase := ABase;
FIndex := AIndex;
end;
function TIndexerNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitIndexer(Self);
end;
function TIndexerNode.GetBase: IAstNode;
begin
Result := FBase;
end;
function TIndexerNode.GetIndex: IAstNode;
begin
Result := FIndex;
end;
{ TMemberAccessNode }
constructor TMemberAccessNode.Create(const ABase: IAstNode; const AMember: IIdentifierNode);
begin
inherited Create;
FBase := ABase;
FMember := AMember;
end;
function TMemberAccessNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitMemberAccess(Self);
end;
function TMemberAccessNode.GetBase: IAstNode;
begin
Result := FBase;
end;
function TMemberAccessNode.GetMember: IIdentifierNode;
begin
Result := FMember;
end;
{ TCreateSeriesNode }
constructor TCreateSeriesNode.Create(const ADefinition: String);
begin
inherited Create;
FDefinition := ADefinition;
end;
function TCreateSeriesNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitCreateSeries(Self);
end;
function TCreateSeriesNode.GetDefinition: String;
begin
Result := FDefinition;
end;
{ TAddSeriesItemNode }
constructor TAddSeriesItemNode.Create(const ASeries: IIdentifierNode; const AValue, ALookback: IAstNode);
begin
inherited Create;
FSeries := ASeries;
FValue := AValue;
FLookback := ALookback;
end;
function TAddSeriesItemNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitAddSeriesItem(Self);
end;
function TAddSeriesItemNode.GetLookback: IAstNode;
begin
Result := FLookback;
end;
function TAddSeriesItemNode.GetSeries: IIdentifierNode;
begin
Result := FSeries;
end;
function TAddSeriesItemNode.GetValue: IAstNode;
begin
Result := FValue;
end;
{ TSeriesLengthNode }
constructor TSeriesLengthNode.Create(const ASeries: IIdentifierNode);
begin
inherited Create;
FSeries := ASeries;
end;
function TSeriesLengthNode.Accept(const Visitor: IAstVisitor): TAstValue;
begin
Result := Visitor.VisitSeriesLength(Self);
end;
function TSeriesLengthNode.GetSeries: IIdentifierNode;
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;
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): TAstValue;
var
depth, idx: Integer;
identNode: TIdentifierNode;
upvalueMap: TDictionary<TResolvedAddress, Integer>;
upvalueNodes: TList<IIdentifierNode>;
originalAddress: TResolvedAddress;
upvalueIndex: Integer;
begin
identNode := Node as TIdentifierNode;
if identNode.IsResolved 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): TAstValue;
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);
inherited VisitLambdaExpression(Node);
(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;
end;
end;
function TBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
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);
end;
class function TAst.Assign(const AIdentifier: IIdentifierNode; const AValue: IAstNode): IAssignmentNode;
begin
Result := TAssignmentNode.Create(AIdentifier, AValue);
end;
class function TAst.AssignResult(const AValue: IAstNode): IAssignmentNode;
begin
Result := Assign(TAst.Identifier('Result'), AValue);
end;
class function TAst.Block(const AExpressions: array of IAstNode): IBlockExpressionNode;
begin
Result := TBlockExpressionNode.Create(AExpressions);
end;
class function TAst.Constant(AValue: TScalar): IConstantNode;
begin
Result := TConstantNode.Create(AValue);
end;
class function TAst.CreateSeries(const ADefinition: String): ICreateSeriesNode;
begin
Result := TCreateSeriesNode.Create(ADefinition);
end;
class function TAst.BinaryExpr(ALeft: IAstNode; AOperator: TBinaryOperator; ARight: IAstNode): IBinaryExpressionNode;
begin
Result := TBinaryExpressionNode.Create(ALeft, AOperator, ARight);
end;
class function TAst.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;
class function TAst.FunctionCall(const ACallee: IAstNode; const AArguments: array of IAstNode): IFunctionCallNode;
begin
Result := TFunctionCallNode.Create(ACallee, AArguments);
end;
class function TAst.Identifier(AName: string): IIdentifierNode;
begin
Result := TIdentifierNode.Create(AName);
end;
class function TAst.IfExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): IIfExpressionNode;
begin
Result := TIfExpressionNode.Create(ACondition, AThenBranch, AElseBranch);
end;
class function TAst.Indexer(const ABase, AIndex: IAstNode): IIndexerNode;
begin
Result := TIndexerNode.Create(ABase, AIndex);
end;
class function TAst.MemberAccess(const ABase: IAstNode; const AMember: IIdentifierNode): IMemberAccessNode;
begin
Result := TMemberAccessNode.Create(ABase, AMember);
end;
class function TAst.SeriesLength(const ASeries: IIdentifierNode): ISeriesLengthNode;
begin
Result := TSeriesLengthNode.Create(ASeries);
end;
class function TAst.TernaryExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): ITernaryExpressionNode;
begin
Result := TTernaryExpressionNode.Create(ACondition, AThenBranch, AElseBranch);
end;
class function TAst.LambdaExpr(const AParameters: TArray<IIdentifierNode>; const ABody: IAstNode): ILambdaExpressionNode;
begin
Result := TLambdaExpressionNode.Create(AParameters, ABody);
end;
class function TAst.UnaryExpr(const AOperator: TUnaryOperator; const ARight: IAstNode): IUnaryExpressionNode;
begin
Result := TUnaryExpressionNode.Create(AOperator, ARight);
end;
class function TAst.VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IAstNode): IVariableDeclarationNode;
begin
Result := TVariableDeclarationNode.Create(AIdentifier, AInitializer);
end;
{ TAstTraverser }
function TAstTraverser.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TAstValue;
begin
Node.Series.Accept(Self);
Node.Value.Accept(Self);
if Assigned(Node.Lookback) then
Node.Lookback.Accept(Self);
end;
function TAstTraverser.VisitAssignment(const Node: IAssignmentNode): TAstValue;
begin
Node.Value.Accept(Self);
Node.Identifier.Accept(Self);
end;
function TAstTraverser.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue;
begin
Node.Left.Accept(Self);
Node.Right.Accept(Self);
end;
function TAstTraverser.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue;
var
expr: IAstNode;
begin
for expr in Node.Expressions do
expr.Accept(Self);
end;
function TAstTraverser.VisitConstant(const Node: IConstantNode): TAstValue;
begin
end;
function TAstTraverser.VisitCreateSeries(const Node: ICreateSeriesNode): TAstValue;
begin
end;
function TAstTraverser.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue;
var
arg: IAstNode;
begin
Node.Callee.Accept(Self);
for arg in Node.Arguments do
arg.Accept(Self);
end;
function TAstTraverser.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
begin
end;
function TAstTraverser.VisitIfExpression(const Node: IIfExpressionNode): TAstValue;
begin
Node.Condition.Accept(Self);
Node.ThenBranch.Accept(Self);
if Assigned(Node.ElseBranch) then
Node.ElseBranch.Accept(Self);
end;
function TAstTraverser.VisitIndexer(const Node: IIndexerNode): TAstValue;
begin
Node.Base.Accept(Self);
Node.Index.Accept(Self);
end;
function TAstTraverser.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue;
var
param: IIdentifierNode;
begin
for param in Node.Parameters do
param.Accept(Self);
Node.Body.Accept(Self);
end;
function TAstTraverser.VisitMemberAccess(const Node: IMemberAccessNode): TAstValue;
begin
// Do not visit the member identifier, as it's not a variable in the current scope.
Node.Base.Accept(Self);
end;
function TAstTraverser.VisitSeriesLength(const Node: ISeriesLengthNode): TAstValue;
begin
Node.Series.Accept(Self);
end;
function TAstTraverser.VisitTernaryExpression(const Node: ITernaryExpressionNode): TAstValue;
begin
Node.Condition.Accept(Self);
Node.ThenBranch.Accept(Self);
Node.ElseBranch.Accept(Self);
end;
function TAstTraverser.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue;
begin
Node.Right.Accept(Self);
end;
function TAstTraverser.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
begin
if Assigned(Node.Initializer) then
Node.Initializer.Accept(Self);
Node.Identifier.Accept(Self);
end;
end.