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 = class public Map: TDictionary; constructor Create; destructor Destroy; override; end; private FInitialScope: IExecutionScope; FCurrentDescriptor: IScopeDescriptor; FUpvalueStack: TStack; FNestedLambdaCount: Integer; FIsTailStack: TStack; FNextIsTail: Boolean; FBoxedDeclarations: THashSet; procedure EnterScope; procedure ExitScope; function IsValidIdentifier(const Name: string): Boolean; function SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue; overload; protected function Accept(const Node: IAstNode): TDataValue; override; 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); // Signature changed 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) 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.TUpvalueMapping } constructor TAstBinder.TUpvalueMapping.Create; begin inherited Create; Map := TDictionary.Create(TResolvedAddressComparer.Create); end; destructor TAstBinder.TUpvalueMapping.Destroy; begin Map.Free; inherited Destroy; end; { TAstBinder } constructor TAstBinder.Create(const AInitialScope: IExecutionScope); begin inherited Create; Assert(Assigned(AInitialScope)); FInitialScope := AInitialScope; FCurrentDescriptor := AInitialScope.CreateDescriptor; FUpvalueStack := TObjectStack.Create(True); FNestedLambdaCount := 0; FIsTailStack := TStack.Create; FNextIsTail := True; FBoxedDeclarations := nil; end; destructor TAstBinder.Destroy; begin FIsTailStack.Free; 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 as TAstNode).StaticType := AType; Result := NodeData; end; function TAstBinder.Accept(const Node: IAstNode): TDataValue; begin if (not Assigned(Node)) or Done then exit; FIsTailStack.Push(FNextIsTail); try Result := inherited Accept(Node); finally FNextIsTail := FIsTailStack.Pop; end; 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 // Pre-pass: Find all variables that need boxing. FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode, FCurrentDescriptor.Parent); try EnterScope; try var transformedValue := Accept(RootNode); if transformedValue.IsVoid then Result := TAst.Block([]) else Result := transformedValue.AsIntf; // The binder no longer knows the root type. // It sets Unknown, and the TypeChecker will find the true type. (Result as TAstNode).StaticType := TTypes.Unknown; Descriptor := FCurrentDescriptor; finally ExitScope; end; finally // The binder owns the hash set, which will be freed in the destructor. end; end; function TAstBinder.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; begin // This node should have been consumed by the MacroExpander. raise Exception.Create('TMyAstBinder: MacroDefinition node encountered.'); end; function TAstBinder.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; begin // This node is just a wrapper for debugging/tracing. // We bind its contents (the expanded body). Result := Accept(Node.ExpandedBody); end; function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; var boundCall: TBoundFunctionCallNode; callee: IAstNode; args: TArray; 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)]); FNextIsTail := False; var baseNode := Accept(Node.Arguments[0]).AsIntf; var memberAccessNode := TAst.MemberAccess(baseNode, keywordNode); // Re-bind the synthetic node by calling Accept (which dispatches to VisitMemberAccess) Result := Accept(memberAccessNode); exit; end; // --- Default: Bind as a standard function call --- var isTailCall := FIsTailStack.Peek; FNextIsTail := False; callee := Accept(Node.Callee).AsIntf; args := AcceptNodes(Node.Arguments); boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall); // Set type to Unknown. The TypeChecker will infer it. Result := SetType(TDataValue.FromIntf(boundCall), TTypes.Unknown); end; function TAstBinder.VisitAssignment(const Node: IAssignmentNode): TDataValue; var boundIdentifier, boundValue: IAstNode; boundNode: IAssignmentNode; begin FNextIsTail := False; // Bind children boundIdentifier := Accept(Node.Identifier).AsIntf; boundValue := Accept(Node.Value).AsIntf; boundNode := TAst.Assign(boundIdentifier as TBoundIdentifierNode, boundValue); // Set type to Unknown. The TypeChecker will infer it from the identifier. Result := SetType(TDataValue.FromIntf(boundNode), TTypes.Unknown); end; function TAstBinder.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; var left, right: IAstNode; boundNode: IBinaryExpressionNode; begin FNextIsTail := False; left := Accept(Node.Left).AsIntf; right := Accept(Node.Right).AsIntf; boundNode := TAst.BinaryExpr(left, Node.Operator, right); Result := SetType(TDataValue.FromIntf(boundNode), TTypes.Unknown); end; function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; var exprs: TArray; i: Integer; isContextTail: Boolean; transformedValue: TDataValue; exprList: TList; boundNode: IBlockExpressionNode; begin isContextTail := FIsTailStack.Peek; exprList := TList.Create; try for i := 0 to High(Node.Expressions) do begin FNextIsTail := isContextTail and (i = High(Node.Expressions)); transformedValue := Accept(Node.Expressions[i]); if not transformedValue.IsVoid then exprList.Add(transformedValue.AsIntf); end; exprs := exprList.ToArray; finally exprList.Free; end; // Check if the node was modified (e.g. by macro removal) 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 // Use original node else boundNode := TAst.Block(exprs); // Create new node end else boundNode := TAst.Block(exprs); // Create new node // Type of the block is Unknown; TypeChecker will set it. Result := SetType(TDataValue.FromIntf(boundNode), TTypes.Unknown); end; function TAstBinder.VisitConstant(const Node: IConstantNode): TDataValue; begin // Binder can set the literal type case Node.Value.Kind of TDataValueKind.vkScalar: Result := SetType(TDataValue.FromIntf(Node), TTypes.FromScalarKind(Node.Value.AsScalar.Kind)); TDataValueKind.vkText: Result := SetType(TDataValue.FromIntf(Node), TTypes.Text); TDataValueKind.vkVoid: Result := SetType(TDataValue.FromIntf(Node), TTypes.Void); else Result := SetType(TDataValue.FromIntf(Node), TTypes.Unknown); end; end; function TAstBinder.VisitKeyword(const Node: IKeywordNode): TDataValue; begin // Binder can set the literal type Result := SetType(TDataValue.FromIntf(Node), TTypes.Keyword); end; function TAstBinder.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; var elemType: IStaticType; begin // Binder can set the literal type try elemType := TTypes.FromScalarKind(TScalar.StringToKind(Node.Definition)); except on E: Exception do // Error, but set to Unknown for now. TypeChecker can re-validate. elemType := TTypes.Unknown; end; Result := SetType(TDataValue.FromIntf(Node), TTypes.CreateSeries(elemType)); end; function TAstBinder.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; var seriesNode, valueNode, lookbackNode: IAstNode; begin seriesNode := Accept(Node.Series).AsIntf; valueNode := Accept(Node.Value).AsIntf; if Node.Lookback <> nil then lookbackNode := Accept(Node.Lookback).AsIntf else lookbackNode := nil; var boundNode := TAst.AddSeriesItem(seriesNode as TIdentifierNode, valueNode, lookbackNode); Result := SetType(TDataValue.FromIntf(boundNode), TTypes.Void); end; function TAstBinder.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; begin Accept(Node.Series); Result := SetType(TDataValue.FromIntf(Node), TTypes.Ordinal); end; function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; var isContextTail: Boolean; condition, thenBranch, elseBranch: IAstNode; boundNode: IIfExpressionNode; begin isContextTail := FIsTailStack.Peek; FNextIsTail := False; condition := Accept(Node.Condition).AsIntf; FNextIsTail := isContextTail; // Propagate tail position thenBranch := Accept(Node.ThenBranch).AsIntf; if Assigned(Node.ElseBranch) then elseBranch := Accept(Node.ElseBranch).AsIntf 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(boundNode), TTypes.Unknown); end; function TAstBinder.VisitIndexer(const Node: IIndexerNode): TDataValue; var baseNode, indexNode: IAstNode; boundNode: IIndexerNode; begin baseNode := Accept(Node.Base).AsIntf; indexNode := Accept(Node.Index).AsIntf; boundNode := TAst.Indexer(baseNode, indexNode); Result := SetType(TDataValue.FromIntf(boundNode), TTypes.Unknown); end; function TAstBinder.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; var baseNode: IAstNode; boundNode: IMemberAccessNode; begin baseNode := Accept(Node.Base).AsIntf; boundNode := TAst.MemberAccess(baseNode, Node.Member); Result := SetType(TDataValue.FromIntf(boundNode), TTypes.Unknown); end; function TAstBinder.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; var i: Integer; boundFields: TArray; valNode: IAstNode; valType: IStaticType; allScalar: Boolean; begin FNextIsTail := False; SetLength(boundFields, Length(Node.Fields)); allScalar := True; for i := 0 to High(Node.Fields) do begin valNode := Accept(Node.Fields[i].Value).AsIntf; // We peek at the *literal* type. If it's not a scalar literal, // we *assume* it *could* be generic. The TypeChecker will verify. 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; // Create the appropriate bound node, but without the definition. // The TypeChecker will populate the definition. if allScalar then begin var boundNode := TBoundRecordLiteralNode.Create(boundFields, nil); Result := SetType(TDataValue.FromIntf(boundNode), TTypes.Unknown); end else begin var genBoundNode := TBoundGenericRecordLiteralNode.Create(boundFields, nil); Result := SetType(TDataValue.FromIntf(genBoundNode), TTypes.Unknown); end; end; function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; var i: integer; boundParams: TArray; boundBody: IAstNode; lambdaScope: IScopeDescriptor; upvalues: TArray; hasNestedLambdas: Boolean; lastNestedLambdaCount: Integer; boundLambda: ILambdaExpressionNode; begin FUpvalueStack.Push(TUpvalueMapping.Create); try EnterScope; try // Define placeholder for FCurrentDescriptor.Define('', 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; FNextIsTail := True; // The body of a lambda is a tail position boundBody := Accept(Node.Body).AsIntf; hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount; lambdaScope := FCurrentDescriptor; finally ExitScope; end; // Upvalue mapping extraction remains the same var upvalueMapping := FUpvalueStack.Peek; var sortedPairs := upvalueMapping.Map.ToArray; TArray.Sort>( sortedPairs, TComparer>.Construct( function(const Left, Right: TPair): 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); // Set type to Unknown. The TypeChecker will infer it. Result := SetType(TDataValue.FromIntf(boundLambda), TTypes.Unknown); end; function TAstBinder.VisitRecurNode(const Node: IRecurNode): TDataValue; begin if not FIsTailStack.Peek then raise Exception.Create('''recur'' can only be used in a tail position.'); FNextIsTail := False; var boundNode := TAst.Recur(AcceptNodes(Node.Arguments)); Result := SetType(TDataValue.FromIntf(boundNode), TTypes.Void); end; function TAstBinder.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; var isContextTail: Boolean; condition, thenBranch, elseBranch: IAstNode; boundNode: ITernaryExpressionNode; begin isContextTail := FIsTailStack.Peek; FNextIsTail := False; condition := Accept(Node.Condition).AsIntf; FNextIsTail := isContextTail; // Propagate tail position thenBranch := Accept(Node.ThenBranch).AsIntf; elseBranch := Accept(Node.ElseBranch).AsIntf; 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(boundNode), TTypes.Unknown); end; function TAstBinder.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; var right: IAstNode; boundNode: IUnaryExpressionNode; begin FNextIsTail := False; right := Accept(Node.Right).AsIntf; boundNode := TAst.UnaryExpr(Node.Operator, right); Result := SetType(TDataValue.FromIntf(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); // Adjust address to be relative to the lambda's parent var upvalueIndex: Integer; if not upvalue.Map.TryGetValue(adr, upvalueIndex) then begin upvalueIndex := upvalue.Map.Count; upvalue.Map.Add(adr, upvalueIndex); end; boundNode := TBoundIdentifierNode.Create(Node, TResolvedAddress.Create(akUpvalue, 0, upvalueIndex)); end else // Handle LocalOrParent boundNode := TBoundIdentifierNode.Create(Node, adr); // Set the type *known at this stage*. The TypeChecker will update it // for definitions (e.g. in VarDecl). Result := SetType(TDataValue.FromIntf(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]); FNextIsTail := False; initializer := nil; if Node.Initializer <> nil then begin initializer := Accept(Node.Initializer).AsIntf; end; // Define the variable with TTypes.Unknown. // The TypeChecker will update this in its pass. 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); // The declaration itself has the type of its initializer (which is currently Unknown) Result := SetType(TDataValue.FromIntf(boundDecl), TTypes.Unknown); end; end.