Michael Schimmel
919 lines
36 KiB
ObjectPascal
919 lines
36 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 = class
|
|
public
|
|
Map: TDictionary<TResolvedAddress, Integer>;
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
end;
|
|
private
|
|
FInitialScope: IExecutionScope;
|
|
FCurrentDescriptor: IScopeDescriptor;
|
|
FUpvalueStack: TStack<TUpvalueMapping>;
|
|
FNestedLambdaCount: Integer;
|
|
FIsTailStack: TStack<Boolean>;
|
|
FNextIsTail: Boolean;
|
|
FBoxedDeclarations: THashSet<IVariableDeclarationNode>;
|
|
// Operator folding maps
|
|
FBinaryOperators: TDictionary<string, TScalar.TBinaryOp>;
|
|
FUnaryOperators: TDictionary<string, TScalar.TUnaryOp>;
|
|
|
|
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);
|
|
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.TUpvalueMapping }
|
|
constructor TAstBinder.TUpvalueMapping.Create;
|
|
begin
|
|
inherited Create;
|
|
Map := TDictionary<TResolvedAddress, Integer>.Create(TResolvedAddressComparer.Create);
|
|
end;
|
|
|
|
destructor TAstBinder.TUpvalueMapping.Destroy;
|
|
begin
|
|
Map.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TAstBinder }
|
|
|
|
constructor TAstBinder.Create(const AInitialScope: IExecutionScope);
|
|
var
|
|
op: TScalar.TBinaryOp;
|
|
begin
|
|
inherited Create;
|
|
Assert(Assigned(AInitialScope));
|
|
|
|
FInitialScope := AInitialScope;
|
|
FCurrentDescriptor := AInitialScope.CreateDescriptor;
|
|
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(True);
|
|
FNestedLambdaCount := 0;
|
|
FIsTailStack := TStack<Boolean>.Create;
|
|
FNextIsTail := True;
|
|
FBoxedDeclarations := nil;
|
|
|
|
// Initialize operator folding maps
|
|
FBinaryOperators := TDictionary<string, TScalar.TBinaryOp>.Create;
|
|
for op := Low(TScalar.TBinaryOp) to High(TScalar.TBinaryOp) do
|
|
FBinaryOperators.Add(op.ToString, op);
|
|
|
|
FUnaryOperators := TDictionary<string, TScalar.TUnaryOp>.Create;
|
|
FUnaryOperators.Add('not', TScalar.TUnaryOp.Not);
|
|
// Note: '-' is handled as a special case in VisitFunctionCall
|
|
end;
|
|
|
|
destructor TAstBinder.Destroy;
|
|
begin
|
|
FUnaryOperators.Free;
|
|
FBinaryOperators.Free;
|
|
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<IAstNode> 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;
|
|
|
|
function TAstBinder.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
|
|
var
|
|
rootType: IStaticType;
|
|
begin
|
|
FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode, FCurrentDescriptor.Parent);
|
|
try
|
|
EnterScope;
|
|
try
|
|
var transformedValue := Accept(RootNode);
|
|
if transformedValue.IsVoid then
|
|
begin
|
|
Result := TAst.Block([]);
|
|
rootType := TTypes.Void;
|
|
end
|
|
else
|
|
begin
|
|
Result := transformedValue.AsIntf<IAstNode>;
|
|
rootType := (Result as TAstNode).StaticType;
|
|
end;
|
|
|
|
// Set the type for the root node (which is often a block)
|
|
(Result as TAstNode).StaticType := rootType;
|
|
Descriptor := FCurrentDescriptor;
|
|
finally
|
|
ExitScope;
|
|
end;
|
|
finally
|
|
// The binder now owns the hash set, which will be freed in the destructor.
|
|
end;
|
|
end;
|
|
|
|
function TAstBinder.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
|
|
begin
|
|
FCurrentDescriptor.DefineMacro(Node.Name.Name, Node);
|
|
Result := TDataValue.Void;
|
|
// Macros have no type at runtime
|
|
(Node as TAstNode).StaticType := TTypes.Void;
|
|
end;
|
|
|
|
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
|
|
var
|
|
calleeIdentifier: TIdentifierNode;
|
|
binaryOp: TScalar.TBinaryOp;
|
|
unaryOp: TScalar.TUnaryOp;
|
|
left, right: IAstNode;
|
|
leftType, rightType, resultType: IStaticType;
|
|
boundCall: TBoundFunctionCallNode;
|
|
callee: IAstNode;
|
|
calleeType: IStaticType;
|
|
args: TArray<IAstNode>;
|
|
i: Integer;
|
|
begin
|
|
// --- Transformation: Keyword-as-Function ---
|
|
// Check if the callee is a keyword literal
|
|
if (Node.Callee is TKeywordNode) then
|
|
begin
|
|
var keywordNode := (Node.Callee as TKeywordNode);
|
|
var keywordName := keywordNode.Value.Name;
|
|
|
|
// 1. Validate argument count
|
|
if Length(Node.Arguments) <> 1 then
|
|
raise ETypeException
|
|
.CreateFmt('Keyword :%s expects exactly one argument (the record/map), but got %d', [keywordName, Length(Node.Arguments)]);
|
|
|
|
// 2. Bind the base (the record/map)
|
|
FNextIsTail := False; // Accessing a member is not a tail call
|
|
var baseNode := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
|
|
|
|
// 3. Create a synthetic IMemberAccessNode
|
|
var memberAccessNode := TAst.MemberAccess(baseNode, TAst.Keyword(keywordName));
|
|
|
|
// 4. Re-bind the synthetic node by calling Accept (which dispatches to VisitMemberAccess)
|
|
// This ensures type checking and type inference for member access is centralized.
|
|
Result := Accept(memberAccessNode);
|
|
exit;
|
|
end;
|
|
|
|
if (Node.Callee is TIdentifierNode) then
|
|
begin
|
|
calleeIdentifier := Node.Callee as TIdentifierNode;
|
|
|
|
// --- Optimization: Operator Folding ---
|
|
|
|
// Try to fold binary operators
|
|
if Length(Node.Arguments) = 2 then
|
|
begin
|
|
if FBinaryOperators.TryGetValue(calleeIdentifier.Name, binaryOp) then
|
|
begin
|
|
FNextIsTail := False;
|
|
left := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
|
|
right := Accept(Node.Arguments[1]).AsIntf<IAstNode>;
|
|
leftType := (left as TAstNode).StaticType;
|
|
rightType := (right as TAstNode).StaticType;
|
|
resultType := TTypeRules.ResolveBinaryOp(binaryOp, leftType, rightType);
|
|
var binExpr := TAst.BinaryExpr(left, binaryOp, right);
|
|
(binExpr as TAstNode).StaticType := resultType;
|
|
Result := TDataValue.FromIntf<IAstNode>(binExpr);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
// Try to fold unary operators
|
|
if Length(Node.Arguments) = 1 then
|
|
begin
|
|
if FUnaryOperators.TryGetValue(calleeIdentifier.Name, unaryOp) then
|
|
begin
|
|
FNextIsTail := False;
|
|
right := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
|
|
rightType := (right as TAstNode).StaticType;
|
|
resultType := TTypeRules.ResolveUnaryOp(unaryOp, rightType);
|
|
var unExpr := TAst.UnaryExpr(unaryOp, right);
|
|
(unExpr as TAstNode).StaticType := resultType;
|
|
Result := TDataValue.FromIntf<IAstNode>(unExpr);
|
|
exit;
|
|
end;
|
|
|
|
// Special case for negation '-'
|
|
if (calleeIdentifier.Name = '-') then
|
|
begin
|
|
FNextIsTail := False;
|
|
right := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
|
|
rightType := (right as TAstNode).StaticType;
|
|
resultType := TTypeRules.ResolveUnaryOp(TScalar.TUnaryOp.Negate, rightType);
|
|
var unExpr := TAst.UnaryExpr(TScalar.TUnaryOp.Negate, right);
|
|
(unExpr as TAstNode).StaticType := resultType;
|
|
Result := TDataValue.FromIntf<IAstNode>(unExpr);
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// --- Default: Bind as a standard function call ---
|
|
var isTailCall := FIsTailStack.Peek;
|
|
FNextIsTail := False;
|
|
callee := Accept(Node.Callee).AsIntf<IAstNode>;
|
|
args := AcceptNodes<IAstNode>(Node.Arguments);
|
|
|
|
var retType: IStaticType := TTypes.Unknown;
|
|
calleeType := (callee as TAstNode).StaticType;
|
|
if calleeType.Kind = TStaticTypeKind.stMethod then
|
|
begin
|
|
var signature := calleeType.Signature;
|
|
if Length(args) <> Length(signature.ParamTypes) then
|
|
raise ETypeException.CreateFmt('Function expects %d arguments, but got %d', [Length(signature.ParamTypes), Length(args)]);
|
|
retType := signature.ReturnType;
|
|
|
|
// Check argument types
|
|
for i := 0 to High(args) do
|
|
begin
|
|
var argType := (args[i] as TAstNode).StaticType;
|
|
var paramType := signature.ParamTypes[i];
|
|
if not TTypeRules.CanAssign(paramType, argType) then
|
|
raise ETypeException
|
|
.CreateFmt('Cannot assign argument %d (type %s) to parameter (type %s)', [i, argType.ToString, paramType.ToString]);
|
|
end;
|
|
end;
|
|
|
|
boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
|
|
Result := SetType(TDataValue.FromIntf<IFunctionCallNode>(boundCall), retType);
|
|
end;
|
|
|
|
function TAstBinder.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
|
|
begin
|
|
// Macro expansion nodes should not exist by this stage.
|
|
raise Exception.Create('MacroExpansionNode is not expected in the binding pass.');
|
|
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.VisitAssignment(const Node: IAssignmentNode): TDataValue;
|
|
var
|
|
boundIdentifier, boundValue: IAstNode;
|
|
targetType, sourceType: IStaticType;
|
|
boundNode: IAssignmentNode;
|
|
begin
|
|
FNextIsTail := False;
|
|
boundIdentifier := Accept(Node.Identifier).AsIntf<IAstNode>;
|
|
boundValue := Accept(Node.Value).AsIntf<IAstNode>;
|
|
|
|
targetType := (boundIdentifier as TAstNode).StaticType;
|
|
sourceType := (boundValue as TAstNode).StaticType;
|
|
|
|
if not TTypeRules.CanAssign(targetType, sourceType) then
|
|
raise ETypeException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]);
|
|
|
|
boundNode := TAst.Assign(boundIdentifier as TBoundIdentifierNode, boundValue);
|
|
Result := SetType(TDataValue.FromIntf<IAssignmentNode>(boundNode), targetType);
|
|
end;
|
|
|
|
function TAstBinder.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
|
|
var
|
|
left, right: IAstNode;
|
|
leftType, rightType, resultType: IStaticType;
|
|
boundNode: IBinaryExpressionNode;
|
|
begin
|
|
FNextIsTail := False;
|
|
left := Accept(Node.Left).AsIntf<IAstNode>;
|
|
right := Accept(Node.Right).AsIntf<IAstNode>;
|
|
leftType := (left as TAstNode).StaticType;
|
|
rightType := (right as TAstNode).StaticType;
|
|
resultType := TTypeRules.ResolveBinaryOp(Node.Operator, leftType, rightType);
|
|
boundNode := TAst.BinaryExpr(left, Node.Operator, right);
|
|
Result := SetType(TDataValue.FromIntf<IBinaryExpressionNode>(boundNode), resultType);
|
|
end;
|
|
|
|
function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
|
|
var
|
|
exprs: TArray<IAstNode>;
|
|
i: Integer;
|
|
isContextTail: Boolean;
|
|
transformedValue: TDataValue;
|
|
exprList: TList<IAstNode>;
|
|
blockType: IStaticType;
|
|
boundNode: IBlockExpressionNode;
|
|
begin
|
|
isContextTail := FIsTailStack.Peek;
|
|
exprList := TList<IAstNode>.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<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
|
|
begin
|
|
boundNode := Node; // Use original node
|
|
end
|
|
else
|
|
boundNode := TAst.Block(exprs); // Create new node
|
|
end
|
|
else
|
|
boundNode := TAst.Block(exprs); // Create new node
|
|
|
|
// Type of the block is the type of the last expression
|
|
if Length(exprs) > 0 then
|
|
blockType := (exprs[High(exprs)] as TAstNode).StaticType
|
|
else
|
|
blockType := TTypes.Void;
|
|
|
|
Result := SetType(TDataValue.FromIntf<IBlockExpressionNode>(boundNode), blockType);
|
|
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
|
|
// Handle other constant types if they become supported
|
|
Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Unknown);
|
|
end;
|
|
end;
|
|
|
|
function TAstBinder.VisitKeyword(const Node: IKeywordNode): TDataValue;
|
|
begin
|
|
// Keywords are literals. Their type is set in TKeywordNode.Create.
|
|
// We also set the static type on the node itself during binding.
|
|
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
|
|
raise ETypeException.CreateFmt('Invalid series type definition: "%s". %s', [Node.Definition, E.Message]);
|
|
end;
|
|
Result := SetType(TDataValue.FromIntf<ICreateSeriesNode>(Node), TTypes.CreateSeries(elemType));
|
|
end;
|
|
|
|
function TAstBinder.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
|
|
var
|
|
seriesNode, valueNode, lookbackNode: IAstNode;
|
|
seriesType, valueType: IStaticType;
|
|
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;
|
|
|
|
seriesType := (seriesNode as TAstNode).StaticType;
|
|
valueType := (valueNode as TAstNode).StaticType;
|
|
|
|
if seriesType.Kind <> TStaticTypeKind.stSeries then
|
|
raise ETypeException.CreateFmt('"add" requires a series as its first argument, but got %s', [seriesType.ToString]);
|
|
|
|
if not TTypeRules.CanAssign(seriesType.ElementType, valueType) then
|
|
raise ETypeException
|
|
.CreateFmt('Cannot add item of type %s to series of type %s', [valueType.ToString, seriesType.ElementType.ToString]);
|
|
|
|
if (lookbackNode <> nil) and not ((lookbackNode as TAstNode).StaticType.Kind = TStaticTypeKind.stOrdinal) then
|
|
raise ETypeException.Create('Lookback parameter for "add" must be an ordinal value.');
|
|
|
|
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;
|
|
var
|
|
seriesNode: IAstNode;
|
|
seriesType: IStaticType;
|
|
begin
|
|
seriesNode := Accept(Node.Series).AsIntf<IAstNode>;
|
|
seriesType := (seriesNode as TAstNode).StaticType;
|
|
if (seriesType.Kind <> TStaticTypeKind.stSeries) and (seriesType.Kind <> TStaticTypeKind.stRecordSeries) then
|
|
raise ETypeException.CreateFmt('"length" requires a series, but got %s', [seriesType.ToString]);
|
|
Result := SetType(TDataValue.FromIntf<ISeriesLengthNode>(Node), TTypes.Ordinal);
|
|
end;
|
|
|
|
function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
|
|
var
|
|
isContextTail: Boolean;
|
|
condition, thenBranch, elseBranch: IAstNode;
|
|
conditionType, thenType, elseType, resultType: IStaticType;
|
|
boundNode: IIfExpressionNode;
|
|
begin
|
|
isContextTail := FIsTailStack.Peek;
|
|
FNextIsTail := False;
|
|
condition := Accept(Node.Condition).AsIntf<IAstNode>;
|
|
FNextIsTail := isContextTail;
|
|
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
|
|
if Assigned(Node.ElseBranch) then
|
|
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
|
|
|
|
conditionType := (condition as TAstNode).StaticType;
|
|
if not TTypeRules.CanAssign(TTypes.Ordinal, conditionType) then
|
|
raise ETypeException.CreateFmt('If condition must be Ordinal, but got %s', [conditionType.ToString]);
|
|
|
|
thenType := (thenBranch as TAstNode).StaticType;
|
|
elseType :=
|
|
if elseBranch <> nil then (elseBranch as TAstNode).StaticType
|
|
else TTypes.Void;
|
|
resultType := TTypeRules.Promote(thenType, elseType);
|
|
|
|
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), resultType);
|
|
end;
|
|
|
|
function TAstBinder.VisitIndexer(const Node: IIndexerNode): TDataValue;
|
|
var
|
|
baseNode, indexNode: IAstNode;
|
|
baseType, indexType, elemType: IStaticType;
|
|
begin
|
|
baseNode := Accept(Node.Base).AsIntf<IAstNode>;
|
|
indexNode := Accept(Node.Index).AsIntf<IAstNode>;
|
|
baseType := (baseNode as TAstNode).StaticType;
|
|
indexType := (indexNode as TAstNode).StaticType;
|
|
|
|
elemType := TTypes.Unknown;
|
|
if (baseType.Kind <> TStaticTypeKind.stUnknown) then
|
|
begin
|
|
if (baseType.Kind <> TStaticTypeKind.stSeries) and (baseType.Kind <> TStaticTypeKind.stRecordSeries) then
|
|
raise ETypeException.CreateFmt('Indexer `[]` can only be applied to series types, but got %s', [baseType.ToString]);
|
|
|
|
if not TTypeRules.CanAssign(TTypes.Ordinal, indexType) then
|
|
raise ETypeException.CreateFmt('Indexer `[]` requires an Ordinal index, but got %s', [indexType.ToString]);
|
|
|
|
if baseType.Kind = TStaticTypeKind.stSeries then
|
|
elemType := baseType.ElementType
|
|
else // stRecordSeries
|
|
elemType := TTypes.CreateRecord(baseType.Definition);
|
|
end;
|
|
|
|
var boundNode := TAst.Indexer(baseNode, indexNode);
|
|
Result := SetType(TDataValue.FromIntf<IIndexerNode>(boundNode), elemType);
|
|
end;
|
|
|
|
function TAstBinder.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
|
|
var
|
|
baseNode: IAstNode;
|
|
baseType, elemType: IStaticType;
|
|
fieldIndex: Integer;
|
|
begin
|
|
baseNode := Accept(Node.Base).AsIntf<IAstNode>;
|
|
baseType := (baseNode as TAstNode).StaticType;
|
|
|
|
elemType := TTypes.Unknown;
|
|
if (baseType.Kind <> TStaticTypeKind.stUnknown) then
|
|
begin
|
|
if (baseType.Kind = TStaticTypeKind.stRecord) or (baseType.Kind = TStaticTypeKind.stRecordSeries) then
|
|
begin
|
|
// --- SALAR PATH ---
|
|
fieldIndex := baseType.Definition.IndexOf(Node.Member.Value);
|
|
if fieldIndex < 0 then
|
|
raise ETypeException.CreateFmt('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]);
|
|
|
|
var fieldType := TTypes.FromScalarKind(baseType.Definition.Fields[fieldIndex].Value);
|
|
|
|
if baseType.Kind = TStaticTypeKind.stRecord then
|
|
elemType := fieldType
|
|
else // stRecordSeries
|
|
elemType := TTypes.CreateSeries(fieldType);
|
|
end
|
|
else if (baseType.Kind = TStaticTypeKind.stGenericRecord) then
|
|
begin
|
|
// --- GENERIC PATH ---
|
|
var genDef := baseType.GenericDefinition;
|
|
fieldIndex := genDef.IndexOf(Node.Member.Value);
|
|
if fieldIndex < 0 then
|
|
raise ETypeException.CreateFmt('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]);
|
|
|
|
// Type is stored directly in the generic definition
|
|
elemType := genDef.Fields[fieldIndex].Value;
|
|
end
|
|
else
|
|
begin
|
|
raise ETypeException.CreateFmt('Member access requires a record type, but got %s', [baseType.ToString]);
|
|
end;
|
|
end;
|
|
|
|
var boundNode := TAst.MemberAccess(baseNode, Node.Member);
|
|
Result := SetType(TDataValue.FromIntf<IMemberAccessNode>(boundNode), elemType);
|
|
end;
|
|
|
|
function TAstBinder.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
|
|
var
|
|
i: Integer;
|
|
boundFields: TArray<TRecordFieldLiteral>;
|
|
scalarDefFields: TArray<TScalarRecordField>; // Renamed
|
|
def: IScalarRecordDefinition;
|
|
staticType: IStaticType;
|
|
valNode: IAstNode;
|
|
valType: IStaticType;
|
|
scalarKind: TScalar.TKind;
|
|
allScalar: Boolean;
|
|
begin
|
|
FNextIsTail := False;
|
|
SetLength(boundFields, Length(Node.Fields));
|
|
SetLength(scalarDefFields, Length(Node.Fields)); // Renamed
|
|
allScalar := True;
|
|
|
|
for i := 0 to High(Node.Fields) do
|
|
begin
|
|
valNode := Accept(Node.Fields[i].Value).AsIntf<IAstNode>;
|
|
valType := (valNode as TAstNode).StaticType;
|
|
|
|
// Check if this field fits the scalar path
|
|
if (valType.Kind = stOrdinal) then
|
|
scalarKind := TScalar.TKind.Ordinal
|
|
else if (valType.Kind = stFloat) then
|
|
scalarKind := TScalar.TKind.Float
|
|
else if (valType.Kind = stKeyword) then
|
|
scalarKind := TScalar.TKind.Keyword
|
|
else
|
|
begin
|
|
allScalar := False; // It's a generic record
|
|
scalarKind := TScalar.TKind.Ordinal; // Dummy value, won't be used
|
|
end;
|
|
|
|
boundFields[i] := TRecordFieldLiteral.Create(Node.Fields[i].Key, valNode);
|
|
|
|
// Conditionally fill the scalar definition array
|
|
if allScalar then
|
|
scalarDefFields[i] := TScalarRecordField.Create(Node.Fields[i].Key.Value, scalarKind);
|
|
end;
|
|
|
|
// Now, create the correct bound node based on the flag
|
|
if allScalar then
|
|
begin
|
|
// --- EXISTING SCALAR PATH ---
|
|
def := TScalarRecordRegistry.Intern(scalarDefFields);
|
|
staticType := TTypes.CreateRecord(def);
|
|
var boundNode := TBoundRecordLiteralNode.Create(boundFields, def); // Old bound node
|
|
Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(boundNode), staticType);
|
|
end
|
|
else
|
|
begin
|
|
// --- NEW GENERIC PATH ---
|
|
var genDefFields: TArray<TPair<IKeyword, IStaticType>>;
|
|
SetLength(genDefFields, Length(boundFields));
|
|
for i := 0 to High(boundFields) do
|
|
genDefFields[i] := TPair<IKeyword, IStaticType>.Create(boundFields[i].Key.Value, (boundFields[i].Value as TAstNode).StaticType);
|
|
|
|
var genDef := TGenericRecordRegistry.Intern(genDefFields);
|
|
staticType := TTypes.CreateGenericRecord(genDef);
|
|
var genBoundNode := TBoundGenericRecordLiteralNode.Create(boundFields, genDef);
|
|
Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(genBoundNode), staticType);
|
|
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;
|
|
bodyType, methodType: IStaticType;
|
|
paramTypes: TArray<IStaticType>;
|
|
selfSlot: Integer;
|
|
begin
|
|
FUpvalueStack.Push(TUpvalueMapping.Create);
|
|
try
|
|
EnterScope;
|
|
try
|
|
// Define placeholder for <self> (rekursion)
|
|
selfSlot := FCurrentDescriptor.Define('<self>', TTypes.Unknown);
|
|
|
|
SetLength(boundParams, Length(Node.Parameters));
|
|
SetLength(paramTypes, Length(Node.Parameters));
|
|
for i := 0 to High(Node.Parameters) do
|
|
begin
|
|
var paramNode := Node.Parameters[i];
|
|
// Parameters are not typed yet, use Unknown
|
|
var paramType := TTypes.Unknown;
|
|
var slotIndex := FCurrentDescriptor.Define(paramNode.Name, paramType);
|
|
var address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
|
|
boundParams[i] := TBoundIdentifierNode.Create(paramNode, address);
|
|
(boundParams[i] as TAstNode).StaticType := paramType;
|
|
paramTypes[i] := paramType;
|
|
end;
|
|
|
|
lastNestedLambdaCount := FNestedLambdaCount;
|
|
FNextIsTail := True;
|
|
boundBody := Accept(Node.Body).AsIntf<IAstNode>;
|
|
hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
|
|
lambdaScope := FCurrentDescriptor;
|
|
|
|
// Now that body is bound, infer return type
|
|
bodyType := (boundBody as TAstNode).StaticType;
|
|
methodType := TTypes.CreateMethod(paramTypes, bodyType);
|
|
|
|
// Update the type for <self>
|
|
FCurrentDescriptor.UpdateType(selfSlot, methodType);
|
|
|
|
finally
|
|
ExitScope;
|
|
end;
|
|
|
|
var upvalueMapping := FUpvalueStack.Peek;
|
|
var sortedPairs := upvalueMapping.Map.ToArray;
|
|
TArray.Sort<TPair<TResolvedAddress, Integer>>(
|
|
sortedPairs,
|
|
TComparer<TPair<TResolvedAddress, Integer>>.Construct(
|
|
function(const Left, Right: TPair<TResolvedAddress, Integer>): Integer begin Result := Left.Value - Right.Value; end
|
|
)
|
|
);
|
|
SetLength(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), methodType);
|
|
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;
|
|
// TODO: Check argument count and types against current lambda signature
|
|
|
|
// 'recur' itself doesn't evaluate to a value, it jumps.
|
|
// We set its type to Void.
|
|
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
|
|
isContextTail: Boolean;
|
|
condition, thenBranch, elseBranch: IAstNode;
|
|
conditionType, thenType, elseType, resultType: IStaticType;
|
|
boundNode: ITernaryExpressionNode;
|
|
begin
|
|
isContextTail := FIsTailStack.Peek;
|
|
FNextIsTail := False;
|
|
condition := Accept(Node.Condition).AsIntf<IAstNode>;
|
|
FNextIsTail := isContextTail;
|
|
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
|
|
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
|
|
|
|
conditionType := (condition as TAstNode).StaticType;
|
|
if not TTypeRules.CanAssign(TTypes.Ordinal, conditionType) then
|
|
raise ETypeException.CreateFmt('Ternary condition must be Ordinal, but got %s', [conditionType.ToString]);
|
|
|
|
thenType := (thenBranch as TAstNode).StaticType;
|
|
elseType := (elseBranch as TAstNode).StaticType;
|
|
resultType := TTypeRules.Promote(thenType, elseType);
|
|
|
|
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), resultType);
|
|
end;
|
|
|
|
function TAstBinder.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
|
|
var
|
|
right: IAstNode;
|
|
rightType, resultType: IStaticType;
|
|
boundNode: IUnaryExpressionNode;
|
|
begin
|
|
FNextIsTail := False;
|
|
right := Accept(Node.Right).AsIntf<IAstNode>;
|
|
rightType := (right as TAstNode).StaticType;
|
|
resultType := TTypeRules.ResolveUnaryOp(Node.Operator, rightType);
|
|
boundNode := TAst.UnaryExpr(Node.Operator, right);
|
|
Result := SetType(TDataValue.FromIntf<IUnaryExpressionNode>(boundNode), resultType);
|
|
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
|
|
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
|
|
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;
|
|
initType: IStaticType;
|
|
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<IAstNode>;
|
|
initType := (initializer as TAstNode).StaticType;
|
|
end
|
|
else
|
|
initType := TTypes.Void; // Default type if no initializer
|
|
|
|
slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name, initType);
|
|
address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
|
|
boundIdentifier := TBoundIdentifierNode.Create(Node.Identifier, address);
|
|
(boundIdentifier as TAstNode).StaticType := initType;
|
|
|
|
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
|
|
boundDecl := TBoundVariableDeclarationNode.Create(boundIdentifier, initializer, isBoxed);
|
|
Result := SetType(TDataValue.FromIntf<IVariableDeclarationNode>(boundDecl), initType);
|
|
end;
|
|
|
|
end.
|