Files
MycLib/Src/AST/Myc.Ast.Binding.pas
T
2025-11-01 14:56:38 +01:00

569 lines
20 KiB
ObjectPascal

unit Myc.Ast.Binding;
interface
uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast.Visitor,
Myc.Ast.Scope,
Myc.Ast.Analyzer,
Myc.Ast.Types,
Myc.Ast;
type
IAstBinder = interface(IAstVisitor)
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
end;
TAstBinder = class; // Forward declaration
TAstBinder = class(TAstTransformer, IAstBinder)
private
type
TUpvalueMapping = TDictionary<TResolvedAddress, Integer>;
private
FInitialScope: IExecutionScope;
FCurrentDescriptor: IScopeDescriptor;
FUpvalueStack: TStack<TUpvalueMapping>;
FNestedLambdaCount: Integer;
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
procedure EnterScope;
procedure ExitScope;
function IsValidIdentifier(const Name: string): Boolean;
function SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue; overload;
protected
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitKeyword(const Node: IKeywordNode): TDataValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override;
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
function VisitConstant(const Node: IConstantNode): TDataValue; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
public
constructor Create(const AInitialScope: IExecutionScope);
destructor Destroy; override;
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
class function Bind(
const InitialScope: IExecutionScope;
const RootNode: IAstNode;
out Descriptor: IScopeDescriptor
): IAstNode; static;
end;
implementation
uses
System.Generics.Defaults,
System.Character,
Myc.Data.Keyword,
Myc.Ast.Binding.Nodes;
type
TResolvedAddressComparer = class(TEqualityComparer<TResolvedAddress>)
public
function Equals(const Left, Right: TResolvedAddress): Boolean; override;
function GetHashCode(const Value: TResolvedAddress): Integer; override;
end;
{ TResolvedAddressComparer }
function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean;
begin
Result := (Left = Right);
end;
function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer;
begin
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;
Assert(Assigned(AInitialScope));
FInitialScope := AInitialScope;
FCurrentDescriptor := AInitialScope.CreateDescriptor;
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(True);
FNestedLambdaCount := 0;
FBoxedDeclarations := nil;
end;
destructor TAstBinder.Destroy;
begin
FUpvalueStack.Free;
FBoxedDeclarations.Free;
inherited;
end;
function TAstBinder.SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue;
begin
if (not NodeData.IsVoid) and (NodeData.Kind = vkInterface) then
(NodeData.AsIntf<IAstNode> as TAstNode).StaticType := AType;
Result := NodeData;
end;
class function TAstBinder.Bind(const InitialScope: IExecutionScope; const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
begin
var binder := TAstBinder.Create(InitialScope) as IAstBinder;
Result := binder.Execute(RootNode, Descriptor);
end;
procedure TAstBinder.EnterScope;
begin
FCurrentDescriptor := TScope.CreateDescriptor(FCurrentDescriptor);
end;
procedure TAstBinder.ExitScope;
begin
FCurrentDescriptor := FCurrentDescriptor.Parent;
end;
function TAstBinder.IsValidIdentifier(const Name: string): Boolean;
var
c: Char;
begin
if Name.IsEmpty then
exit(False);
c := Name[1];
if not (c.IsLetter or (c = '_')) then
exit(False);
for c in Name do
begin
if not (c.IsLetterOrDigit or (c = '_') or (c = '-')) then
exit(False);
end;
Result := True;
end;
function TAstBinder.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
begin
FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode, FCurrentDescriptor.Parent);
try
EnterScope;
try
var transformedValue := Accept(RootNode);
if transformedValue.IsVoid then
Result := TAst.Block([])
else
Result := transformedValue.AsIntf<IAstNode>;
(Result as TAstNode).StaticType := TTypes.Unknown;
Descriptor := FCurrentDescriptor;
finally
ExitScope;
end;
finally
end;
end;
function TAstBinder.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
begin
raise Exception.Create('TMyAstBinder: MacroDefinition node encountered.');
end;
function TAstBinder.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
begin
Result := Accept(Node.ExpandedBody);
end;
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
boundCall: TBoundFunctionCallNode;
callee: IAstNode;
args: TArray<IAstNode>;
begin
// --- Transformation: Keyword-as-Function ---
if (Node.Callee is TKeywordNode) then
begin
var keywordNode := (Node.Callee as TKeywordNode);
if Length(Node.Arguments) <> 1 then
raise ETypeException.CreateFmt(
'Keyword :%s expects exactly one argument (the record/map), but got %d',
[keywordNode.Value.Name, Length(Node.Arguments)]);
var baseNode := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
var memberAccessNode := TAst.MemberAccess(baseNode, keywordNode);
Result := Accept(memberAccessNode);
exit;
end;
// --- Default: Bind as a standard function call ---
callee := Accept(Node.Callee).AsIntf<IAstNode>;
args := AcceptNodes<IAstNode>(Node.Arguments);
// Create the node, always marking IsTailCall as false.
// The Lowerer (Phase 4) will set this flag correctly.
boundCall := TBoundFunctionCallNode.Create(Node, callee, args, False);
Result := SetType(TDataValue.FromIntf<IFunctionCallNode>(boundCall), TTypes.Unknown);
end;
function TAstBinder.VisitAssignment(const Node: IAssignmentNode): TDataValue;
var
boundIdentifier, boundValue: IAstNode;
boundNode: IAssignmentNode;
begin
boundIdentifier := Accept(Node.Identifier).AsIntf<IAstNode>;
boundValue := Accept(Node.Value).AsIntf<IAstNode>;
boundNode := TAst.Assign(boundIdentifier as TBoundIdentifierNode, boundValue);
Result := SetType(TDataValue.FromIntf<IAssignmentNode>(boundNode), TTypes.Unknown);
end;
function TAstBinder.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
var
left, right: IAstNode;
boundNode: IBinaryExpressionNode;
begin
left := Accept(Node.Left).AsIntf<IAstNode>;
right := Accept(Node.Right).AsIntf<IAstNode>;
boundNode := TAst.BinaryExpr(left, Node.Operator, right);
Result := SetType(TDataValue.FromIntf<IBinaryExpressionNode>(boundNode), TTypes.Unknown);
end;
function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
exprs: TArray<IAstNode>;
i: Integer;
transformedValue: TDataValue;
exprList: TList<IAstNode>;
boundNode: IBlockExpressionNode;
begin
exprList := TList<IAstNode>.Create;
try
for i := 0 to High(Node.Expressions) do
begin
transformedValue := Accept(Node.Expressions[i]);
if not transformedValue.IsVoid then
exprList.Add(transformedValue.AsIntf<IAstNode>);
end;
exprs := exprList.ToArray;
finally
exprList.Free;
end;
if (Length(exprs) = Length(Node.Expressions)) then
begin
var same := True;
for i := 0 to High(exprs) do
if exprs[i] <> Node.Expressions[i] then
begin
same := False;
break;
end;
if same then
boundNode := Node
else
boundNode := TAst.Block(exprs);
end
else
boundNode := TAst.Block(exprs);
Result := SetType(TDataValue.FromIntf<IBlockExpressionNode>(boundNode), TTypes.Unknown);
end;
function TAstBinder.VisitConstant(const Node: IConstantNode): TDataValue;
begin
case Node.Value.Kind of
TDataValueKind.vkScalar:
Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.FromScalarKind(Node.Value.AsScalar.Kind));
TDataValueKind.vkText: Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Text);
TDataValueKind.vkVoid: Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Void);
else
Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Unknown);
end;
end;
function TAstBinder.VisitKeyword(const Node: IKeywordNode): TDataValue;
begin
Result := SetType(TDataValue.FromIntf<IKeywordNode>(Node), TTypes.Keyword);
end;
function TAstBinder.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
var
elemType: IStaticType;
begin
try
elemType := TTypes.FromScalarKind(TScalar.StringToKind(Node.Definition));
except
on E: Exception do
elemType := TTypes.Unknown;
end;
Result := SetType(TDataValue.FromIntf<ICreateSeriesNode>(Node), TTypes.CreateSeries(elemType));
end;
function TAstBinder.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
var
seriesNode, valueNode, lookbackNode: IAstNode;
begin
seriesNode := Accept(Node.Series).AsIntf<IAstNode>;
valueNode := Accept(Node.Value).AsIntf<IAstNode>;
if Node.Lookback <> nil then
lookbackNode := Accept(Node.Lookback).AsIntf<IAstNode>
else
lookbackNode := nil;
var boundNode := TAst.AddSeriesItem(seriesNode as TIdentifierNode, valueNode, lookbackNode);
Result := SetType(TDataValue.FromIntf<IAddSeriesItemNode>(boundNode), TTypes.Void);
end;
function TAstBinder.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
Accept(Node.Series);
Result := SetType(TDataValue.FromIntf<ISeriesLengthNode>(Node), TTypes.Ordinal);
end;
function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
var
condition, thenBranch, elseBranch: IAstNode;
boundNode: IIfExpressionNode;
begin
condition := Accept(Node.Condition).AsIntf<IAstNode>;
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
if Assigned(Node.ElseBranch) then
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>
else
elseBranch := nil;
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
boundNode := TAst.IfExpr(condition, thenBranch, elseBranch)
else
boundNode := Node;
Result := SetType(TDataValue.FromIntf<IIfExpressionNode>(boundNode), TTypes.Unknown);
end;
function TAstBinder.VisitIndexer(const Node: IIndexerNode): TDataValue;
var
baseNode, indexNode: IAstNode;
boundNode: IIndexerNode;
begin
baseNode := Accept(Node.Base).AsIntf<IAstNode>;
indexNode := Accept(Node.Index).AsIntf<IAstNode>;
boundNode := TAst.Indexer(baseNode, indexNode);
Result := SetType(TDataValue.FromIntf<IIndexerNode>(boundNode), TTypes.Unknown);
end;
function TAstBinder.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
var
baseNode: IAstNode;
boundNode: IMemberAccessNode;
begin
baseNode := Accept(Node.Base).AsIntf<IAstNode>;
boundNode := TAst.MemberAccess(baseNode, Node.Member);
Result := SetType(TDataValue.FromIntf<IMemberAccessNode>(boundNode), TTypes.Unknown);
end;
function TAstBinder.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
var
i: Integer;
boundFields: TArray<TRecordFieldLiteral>;
valNode: IAstNode;
valType: IStaticType;
allScalar: Boolean;
begin
SetLength(boundFields, Length(Node.Fields));
allScalar := True;
for i := 0 to High(Node.Fields) do
begin
valNode := Accept(Node.Fields[i].Value).AsIntf<IAstNode>;
valType := (valNode as TAstNode).StaticType;
if not (valType.Kind in [stOrdinal, stFloat, stKeyword, stUnknown]) then
allScalar := False;
boundFields[i] := TRecordFieldLiteral.Create(Node.Fields[i].Key, valNode);
end;
if allScalar then
begin
var boundNode := TBoundRecordLiteralNode.Create(boundFields, nil);
Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(boundNode), TTypes.Unknown);
end
else
begin
var genBoundNode := TBoundGenericRecordLiteralNode.Create(boundFields, nil);
Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(genBoundNode), TTypes.Unknown);
end;
end;
function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
i: integer;
boundParams: TArray<IIdentifierNode>;
boundBody: IAstNode;
lambdaScope: IScopeDescriptor;
upvalues: TArray<TResolvedAddress>;
hasNestedLambdas: Boolean;
lastNestedLambdaCount: Integer;
boundLambda: ILambdaExpressionNode;
begin
FUpvalueStack.Push(TUpvalueMapping.Create(TResolvedAddressComparer.Create));
try
EnterScope;
try
FCurrentDescriptor.Define('<self>', TTypes.Unknown);
SetLength(boundParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
var paramNode := Node.Parameters[i];
var slotIndex := FCurrentDescriptor.Define(paramNode.Name, TTypes.Unknown);
var address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
boundParams[i] := TBoundIdentifierNode.Create(paramNode, address);
(boundParams[i] as TAstNode).StaticType := TTypes.Unknown;
end;
lastNestedLambdaCount := FNestedLambdaCount;
boundBody := Accept(Node.Body).AsIntf<IAstNode>;
hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
lambdaScope := FCurrentDescriptor;
finally
ExitScope;
end;
var upvalueMapping := FUpvalueStack.Peek;
var sortedPairs := upvalueMapping.ToArray;
TArray.Sort<TPair<TResolvedAddress, Integer>>(
sortedPairs,
TComparer<TPair<TResolvedAddress, Integer>>.Construct(
function(const Left, Right: TPair<TResolvedAddress, Integer>): Integer begin Result := Left.Value - Right.Value; end
)
);
SetLength(upvalues, Length(sortedPairs));
for i := 0 to High(sortedPairs) do
upvalues[i] := sortedPairs[i].Key;
finally
FUpvalueStack.Pop;
end;
inc(FNestedLambdaCount);
boundLambda := TBoundLambdaExpressionNode.Create(Node, boundBody, boundParams, lambdaScope, upvalues, hasNestedLambdas);
Result := SetType(TDataValue.FromIntf<ILambdaExpressionNode>(boundLambda), TTypes.Unknown);
end;
function TAstBinder.VisitRecurNode(const Node: IRecurNode): TDataValue;
begin
var boundNode := TAst.Recur(AcceptNodes<IAstNode>(Node.Arguments));
Result := SetType(TDataValue.FromIntf<IRecurNode>(boundNode), TTypes.Void);
end;
function TAstBinder.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
var
condition, thenBranch, elseBranch: IAstNode;
boundNode: ITernaryExpressionNode;
begin
condition := Accept(Node.Condition).AsIntf<IAstNode>;
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
boundNode := TAst.TernaryExpr(condition, thenBranch, elseBranch)
else
boundNode := Node;
Result := SetType(TDataValue.FromIntf<ITernaryExpressionNode>(boundNode), TTypes.Unknown);
end;
function TAstBinder.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
var
right: IAstNode;
boundNode: IUnaryExpressionNode;
begin
right := Accept(Node.Right).AsIntf<IAstNode>;
boundNode := TAst.UnaryExpr(Node.Operator, right);
Result := SetType(TDataValue.FromIntf<IUnaryExpressionNode>(boundNode), TTypes.Unknown);
end;
function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
var
symbol: TResolvedSymbol;
boundNode: IIdentifierNode;
adr: TResolvedAddress;
begin
symbol := FCurrentDescriptor.FindSymbol(Node.Name);
adr := symbol.Address;
if adr.Kind = akLocalOrParent then
begin
if (adr.ScopeDepth > 0) and (FUpvalueStack.Count > 0) then
begin
// Handle Upvalue
var upvalue := FUpvalueStack.Peek;
dec(adr.ScopeDepth);
var upvalueIndex: Integer;
if not upvalue.TryGetValue(adr, upvalueIndex) then
begin
upvalueIndex := upvalue.Count;
upvalue.Add(adr, upvalueIndex);
end;
boundNode := TBoundIdentifierNode.Create(Node, TResolvedAddress.Create(akUpvalue, 0, upvalueIndex));
end
else
// Handle LocalOrParent
boundNode := TBoundIdentifierNode.Create(Node, adr);
Result := SetType(TDataValue.FromIntf<IIdentifierNode>(boundNode), symbol.StaticType);
end
else
raise Exception.CreateFmt('Undefined identifier: "%s"', [Node.Name]);
end;
function TAstBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
var
initializer: IAstNode;
slotIndex: Integer;
address: TResolvedAddress;
boundIdentifier: IIdentifierNode;
isBoxed: Boolean;
boundDecl: IVariableDeclarationNode;
begin
if not IsValidIdentifier(Node.Identifier.Name) then
raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]);
initializer := nil;
if Node.Initializer <> nil then
initializer := Accept(Node.Initializer).AsIntf<IAstNode>;
slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name, TTypes.Unknown);
address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
boundIdentifier := TBoundIdentifierNode.Create(Node.Identifier, address);
(boundIdentifier as TAstNode).StaticType := TTypes.Unknown;
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
boundDecl := TBoundVariableDeclarationNode.Create(boundIdentifier, initializer, isBoxed);
Result := SetType(TDataValue.FromIntf<IVariableDeclarationNode>(boundDecl), TTypes.Unknown);
end;
end.