Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Binder refactoring - extracted type checking

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-01 14:04:45 +01:00
parent 4687ecb9ca
commit 6826b75c19
6 changed files with 671 additions and 394 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/ASTPlayground.delphilsp.json
+1 -1
View File
File diff suppressed because one or more lines are too long
ASTPlayground/ASTPlayground.dpr
+2 -1
View File
@@ -23,7 +23,8 @@ uses
Myc.Ast.Types in '..\Src\AST\Myc.Ast.Types.pas',
Myc.Data.Keyword in '..\Src\Data\Myc.Data.Keyword.pas',
Myc.Ast.Binding.Nodes in '..\Src\AST\Myc.Ast.Binding.Nodes.pas',
Myc.Ast.MacroExpander in '..\Src\AST\Myc.Ast.MacroExpander.pas';
Myc.Ast.MacroExpander in '..\Src\AST\Myc.Ast.MacroExpander.pas',
Myc.Ast.TypeChecker in '..\Src\AST\Myc.Ast.TypeChecker.pas';
{$R *.res}
ASTPlayground/ASTPlayground.dproj
+1
View File
@@ -154,6 +154,7 @@
<DCCReference Include="..\Src\Data\Myc.Data.Keyword.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Binding.Nodes.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.MacroExpander.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.TypeChecker.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
Src/AST/Myc.Ast.Binding.Nodes.pas
+2 -2
View File
@@ -68,7 +68,7 @@ type
FDefinition: IScalarRecordDefinition;
public
constructor Create(const AFields: TArray<TRecordFieldLiteral>; const ADef: IScalarRecordDefinition);
property Definition: IScalarRecordDefinition read FDefinition;
property Definition: IScalarRecordDefinition read FDefinition write FDefinition;
end;
// Represents a bound record literal that maps to a generic (non-scalar) record
@@ -77,7 +77,7 @@ type
FDefinition: IGenericRecordDefinition;
public
constructor Create(const AFields: TArray<TRecordFieldLiteral>; const ADef: IGenericRecordDefinition);
property Definition: IGenericRecordDefinition read FDefinition;
property Definition: IGenericRecordDefinition read FDefinition write FDefinition;
end;
implementation
Src/AST/Myc.Ast.Binding.pas
+137 -390
View File
@@ -39,9 +39,6 @@ type
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;
@@ -73,7 +70,7 @@ type
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
public
constructor Create(const AInitialScope: IExecutionScope);
constructor Create(const AInitialScope: IExecutionScope); // Signature changed
destructor Destroy; override;
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
@@ -129,8 +126,6 @@ end;
{ TAstBinder }
constructor TAstBinder.Create(const AInitialScope: IExecutionScope);
var
op: TScalar.TBinaryOp;
begin
inherited Create;
Assert(Assigned(AInitialScope));
@@ -142,21 +137,10 @@ begin
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;
@@ -194,173 +178,6 @@ 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;
@@ -383,40 +200,107 @@ begin
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<IAstNode>;
// 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<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)]);
FNextIsTail := False;
var baseNode := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
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<IAstNode>;
args := AcceptNodes<IAstNode>(Node.Arguments);
boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
// Set type to Unknown. The TypeChecker will infer it.
Result := SetType(TDataValue.FromIntf<IFunctionCallNode>(boundCall), TTypes.Unknown);
end;
function TAstBinder.VisitAssignment(const Node: IAssignmentNode): TDataValue;
var
boundIdentifier, boundValue: IAstNode;
targetType, sourceType: IStaticType;
boundNode: IAssignmentNode;
begin
FNextIsTail := False;
// Bind children
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);
// Set type to Unknown. The TypeChecker will infer it from the identifier.
Result := SetType(TDataValue.FromIntf<IAssignmentNode>(boundNode), TTypes.Unknown);
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);
Result := SetType(TDataValue.FromIntf<IBinaryExpressionNode>(boundNode), TTypes.Unknown);
end;
function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
@@ -426,7 +310,6 @@ var
isContextTail: Boolean;
transformedValue: TDataValue;
exprList: TList<IAstNode>;
blockType: IStaticType;
boundNode: IBlockExpressionNode;
begin
isContextTail := FIsTailStack.Peek;
@@ -444,6 +327,7 @@ begin
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;
@@ -454,41 +338,33 @@ begin
break;
end;
if same then
begin
boundNode := Node; // Use original node
end
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 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);
// Type of the block is Unknown; TypeChecker will set it.
Result := SetType(TDataValue.FromIntf<IBlockExpressionNode>(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<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.
// Binder can set the literal type
Result := SetType(TDataValue.FromIntf<IKeywordNode>(Node), TTypes.Keyword);
end;
@@ -496,11 +372,13 @@ 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
raise ETypeException.CreateFmt('Invalid series type definition: "%s". %s', [Node.Definition, E.Message]);
// Error, but set to Unknown for now. TypeChecker can re-validate.
elemType := TTypes.Unknown;
end;
Result := SetType(TDataValue.FromIntf<ICreateSeriesNode>(Node), TTypes.CreateSeries(elemType));
end;
@@ -508,7 +386,6 @@ 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>;
@@ -517,32 +394,13 @@ begin
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]);
Accept(Node.Series);
Result := SetType(TDataValue.FromIntf<ISeriesLengthNode>(Node), TTypes.Ordinal);
end;
@@ -550,174 +408,85 @@ 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;
FNextIsTail := isContextTail; // Propagate tail position
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);
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), resultType);
Result := SetType(TDataValue.FromIntf<IIfExpressionNode>(boundNode), TTypes.Unknown);
end;
function TAstBinder.VisitIndexer(const Node: IIndexerNode): TDataValue;
var
baseNode, indexNode: IAstNode;
baseType, indexType, elemType: IStaticType;
boundNode: IIndexerNode;
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);
boundNode := TAst.Indexer(baseNode, indexNode);
Result := SetType(TDataValue.FromIntf<IIndexerNode>(boundNode), TTypes.Unknown);
end;
function TAstBinder.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
var
baseNode: IAstNode;
baseType, elemType: IStaticType;
fieldIndex: Integer;
boundNode: IMemberAccessNode;
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);
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>;
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>;
// 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;
// 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;
if not (valType.Kind in [stOrdinal, stFloat, stKeyword, stUnknown]) then
allScalar := False;
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
// Create the appropriate bound node, but without the definition.
// The TypeChecker will populate the definition.
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);
var boundNode := TBoundRecordLiteralNode.Create(boundFields, nil);
Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(boundNode), TTypes.Unknown);
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);
var genBoundNode := TBoundGenericRecordLiteralNode.Create(boundFields, nil);
Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(genBoundNode), TTypes.Unknown);
end;
end;
@@ -731,48 +500,34 @@ var
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);
// Define placeholder for <self>
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 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 := paramType;
paramTypes[i] := paramType;
(boundParams[i] as TAstNode).StaticType := TTypes.Unknown;
end;
lastNestedLambdaCount := FNestedLambdaCount;
FNextIsTail := True;
FNextIsTail := True; // The body of a lambda is a tail position
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;
// Upvalue mapping extraction remains the same
var upvalueMapping := FUpvalueStack.Peek;
var sortedPairs := upvalueMapping.Map.ToArray;
TArray.Sort<TPair<TResolvedAddress, Integer>>(
@@ -790,7 +545,9 @@ begin
inc(FNestedLambdaCount);
boundLambda := TBoundLambdaExpressionNode.Create(Node, boundBody, boundParams, lambdaScope, upvalues, hasNestedLambdas);
Result := SetType(TDataValue.FromIntf<ILambdaExpressionNode>(boundLambda), methodType);
// Set type to Unknown. The TypeChecker will infer it.
Result := SetType(TDataValue.FromIntf<ILambdaExpressionNode>(boundLambda), TTypes.Unknown);
end;
function TAstBinder.VisitRecurNode(const Node: IRecurNode): TDataValue;
@@ -798,10 +555,7 @@ 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;
@@ -810,44 +564,33 @@ function TAstBinder.VisitTernaryExpression(const Node: ITernaryExpressionNode):
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;
FNextIsTail := isContextTail; // Propagate tail position
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);
Result := SetType(TDataValue.FromIntf<ITernaryExpressionNode>(boundNode), TTypes.Unknown);
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);
Result := SetType(TDataValue.FromIntf<IUnaryExpressionNode>(boundNode), TTypes.Unknown);
end;
function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
@@ -863,6 +606,7 @@ begin
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;
@@ -874,8 +618,11 @@ begin
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<IIdentifierNode>(boundNode), symbol.StaticType);
end
else
@@ -890,7 +637,6 @@ var
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]);
@@ -900,19 +646,20 @@ begin
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
end;
slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name, initType);
// 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 := initType;
(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), initType);
// The declaration itself has the type of its initializer (which is currently Unknown)
Result := SetType(TDataValue.FromIntf<IVariableDeclarationNode>(boundDecl), TTypes.Unknown);
end;
end.
Src/AST/Myc.Ast.TypeChecker.pas
+528
View File
@@ -0,0 +1,528 @@
unit Myc.Ast.TypeChecker;
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.Types,
Myc.Ast,
Myc.Ast.Binding.Nodes;
type
IAstTypeChecker = interface(IAstVisitor)
function Execute(const RootNode: IAstNode; const ADecriptor: IScopeDescriptor): IAstNode;
end;
// This transformer runs *after* the TAstBinder.
// It takes the "Bound AST" (which has addresses but mostly TTypes.Unknown)
// and traverses it bottom-up to infer and check all static types.
// It modifies the node.StaticType property and updates the IScopeDescriptor.
TTypeChecker = class(TAstTransformer, IAstTypeChecker)
private
FCurrentDescriptor: IScopeDescriptor;
function SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue; overload;
protected
// Override all visit methods to perform type checking
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): 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 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;
function VisitRecurNode(const Node: IRecurNode): TDataValue; override;
// Base cases (types are already known from binder)
function VisitConstant(const Node: IConstantNode): TDataValue; override;
function VisitKeyword(const Node: IKeywordNode): TDataValue; override;
// Compile-time nodes (should not be present)
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; override;
function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; override;
public
constructor Create(const ADescriptor: IScopeDescriptor);
function Execute(const RootNode: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode;
class function CheckTypes(const RootNode: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode; static;
end;
implementation
uses
System.Generics.Defaults,
Myc.Data.Keyword;
{ TTypeChecker }
constructor TTypeChecker.Create(const ADescriptor: IScopeDescriptor);
begin
inherited Create;
Assert(Assigned(ADescriptor));
FCurrentDescriptor := ADescriptor;
end;
class function TTypeChecker.CheckTypes(const RootNode: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode;
begin
var checker := TTypeChecker.Create(ADescriptor) as IAstTypeChecker;
Result := checker.Execute(RootNode, ADescriptor);
end;
function TTypeChecker.Execute(const RootNode: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode;
begin
FCurrentDescriptor := ADescriptor;
var transformedValue := Accept(RootNode);
if transformedValue.IsVoid then
Result := TAst.Block([])
else
Result := transformedValue.AsIntf<IAstNode>;
(Result as TAstNode).StaticType := (Result as TAstNode).StaticType;
end;
function TTypeChecker.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 TTypeChecker.VisitConstant(const Node: IConstantNode): TDataValue;
begin
// Type was set by Binder, just propagate it up.
Result := TDataValue.FromIntf<IConstantNode>(Node);
end;
function TTypeChecker.VisitKeyword(const Node: IKeywordNode): TDataValue;
begin
// Type was set by Binder, just propagate it up.
Result := TDataValue.FromIntf<IKeywordNode>(Node);
end;
function TTypeChecker.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
// Type was set by Binder (read from scope), just propagate it up.
Result := TDataValue.FromIntf<IIdentifierNode>(Node);
end;
function TTypeChecker.VisitRecurNode(const Node: IRecurNode): TDataValue;
begin
// Type was set by Binder (TTypes.Void), just propagate it up.
Result := TDataValue.FromIntf<IRecurNode>(Node);
end;
function TTypeChecker.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue;
begin
raise Exception.Create('TTypeChecker: MacroDefinition node encountered.');
end;
function TTypeChecker.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
begin
raise Exception.Create('TTypeChecker: MacroExpansionNode node encountered.');
end;
function TTypeChecker.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
var
initNode: IAstNode;
initType: IStaticType;
boundIdent: TBoundIdentifierNode;
adr: TResolvedAddress;
begin
// 1. Visit the initializer (if it exists) to get its (now-inferred) type.
if Assigned(Node.Initializer) then
begin
initNode := Accept(Node.Initializer).AsIntf<IAstNode>;
initType := (initNode as TAstNode).StaticType;
end
else
initType := TTypes.Void;
// 2. Get the address from the bound identifier.
boundIdent := (Node.Identifier as TBoundIdentifierNode);
adr := boundIdent.Address;
// 3. Update the type in the scope descriptor (which was set to Unknown by the binder).
FCurrentDescriptor.UpdateType(adr.SlotIndex, initType);
// 4. Update the static types of the nodes themselves.
(boundIdent as TAstNode).StaticType := initType;
Result := SetType(TDataValue.FromIntf(Node), initType);
end;
function TTypeChecker.VisitAssignment(const Node: IAssignmentNode): TDataValue;
var
boundIdentifier, boundValue: IAstNode;
targetType, sourceType: IStaticType;
begin
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]);
Result := SetType(TDataValue.FromIntf<IAssignmentNode>(Node), targetType);
end;
function TTypeChecker.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
boundNode: TBoundLambdaExpressionNode;
boundBody: IAstNode;
bodyType, methodType: IStaticType;
paramTypes: TArray<IStaticType>;
i: Integer;
begin
boundNode := (Node as TBoundLambdaExpressionNode);
// 1. Enter the lambda's scope
FCurrentDescriptor := boundNode.ScopeDescriptor;
try
// 2. Set parameter types (currently Unknown, but required for signature)
SetLength(paramTypes, Length(boundNode.Parameters));
for i := 0 to High(boundNode.Parameters) do
paramTypes[i] := (boundNode.Parameters[i] as TAstNode).StaticType; // Propagates Unknown
// 3. Visit the body to infer its return type
boundBody := Accept(boundNode.Body).AsIntf<IAstNode>;
bodyType := (boundBody as TAstNode).StaticType;
// 4. Create the final method type
methodType := TTypes.CreateMethod(paramTypes, bodyType);
// 5. Update the type for <self> (Slot 0) in the descriptor
FCurrentDescriptor.UpdateType(0, methodType);
finally
// 6. Restore parent descriptor
FCurrentDescriptor := FCurrentDescriptor.Parent;
end;
// 7. Set the type of the lambda node itself
Result := SetType(TDataValue.FromIntf<ILambdaExpressionNode>(boundNode), methodType);
end;
function TTypeChecker.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
callee: IAstNode;
args: TArray<IAstNode>;
calleeType, retType: IStaticType;
i: Integer;
begin
// 1. Visit children first (bottom-up)
callee := Accept(Node.Callee).AsIntf<IAstNode>;
args := AcceptNodes<IAstNode>(Node.Arguments);
// 2. Get callee type (now inferred)
calleeType := (callee as TAstNode).StaticType;
retType := TTypes.Unknown; // Default if not a method
// 3. Perform type checking
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
else if calleeType.Kind <> TStaticTypeKind.stUnknown then
raise ETypeException.CreateFmt('Cannot invoke type %s as a function.', [calleeType.ToString]);
// 4. Set the type for this call node
Result := SetType(TDataValue.FromIntf<IFunctionCallNode>(Node), retType);
end;
function TTypeChecker.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
var
blockType: IStaticType;
exprs: TArray<IAstNode>;
begin
exprs := AcceptNodes<IAstNode>(Node.Expressions);
if Length(exprs) > 0 then
blockType := (exprs[High(exprs)] as TAstNode).StaticType
else
blockType := TTypes.Void;
Result := SetType(TDataValue.FromIntf<IBlockExpressionNode>(Node), blockType);
end;
function TTypeChecker.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
var
condition, thenBranch, elseBranch: IAstNode;
conditionType, thenType, elseType, resultType: IStaticType;
begin
condition := Accept(Node.Condition).AsIntf<IAstNode>;
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>; // Accept(nil) returns void
conditionType := (condition as TAstNode).StaticType;
if (conditionType.Kind <> stUnknown) and 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);
Result := SetType(TDataValue.FromIntf<IIfExpressionNode>(Node), resultType);
end;
function TTypeChecker.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
var
condition, thenBranch, elseBranch: IAstNode;
conditionType, thenType, elseType, resultType: IStaticType;
begin
condition := Accept(Node.Condition).AsIntf<IAstNode>;
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
conditionType := (condition as TAstNode).StaticType;
if (conditionType.Kind <> stUnknown) and 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);
Result := SetType(TDataValue.FromIntf<ITernaryExpressionNode>(Node), resultType);
end;
function TTypeChecker.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
var
left, right: IAstNode;
leftType, rightType, resultType: IStaticType;
begin
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);
Result := SetType(TDataValue.FromIntf<IBinaryExpressionNode>(Node), resultType);
end;
function TTypeChecker.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
var
right: IAstNode;
rightType, resultType: IStaticType;
begin
right := Accept(Node.Right).AsIntf<IAstNode>;
rightType := (right as TAstNode).StaticType;
resultType := TTypeRules.ResolveUnaryOp(Node.Operator, rightType);
Result := SetType(TDataValue.FromIntf<IUnaryExpressionNode>(Node), resultType);
end;
function TTypeChecker.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
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
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]);
elemType := genDef.Fields[fieldIndex].Value;
end
else
begin
raise ETypeException.CreateFmt('Member access requires a record type, but got %s', [baseType.ToString]);
end;
end;
Result := SetType(TDataValue.FromIntf<IMemberAccessNode>(Node), elemType);
end;
function TTypeChecker.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 (indexType.Kind <> stUnknown) and 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;
Result := SetType(TDataValue.FromIntf<IIndexerNode>(Node), elemType);
end;
function TTypeChecker.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
var
i: Integer;
boundFields: TArray<TRecordFieldLiteral>;
scalarDefFields: TArray<TScalarRecordField>;
def: IScalarRecordDefinition;
staticType: IStaticType;
valNode: IAstNode;
valType: IStaticType;
scalarKind: TScalar.TKind;
allScalar: Boolean;
begin
SetLength(boundFields, Length(Node.Fields));
SetLength(scalarDefFields, Length(Node.Fields));
allScalar := True;
// 1. Visit all child nodes first to infer their types
for i := 0 to High(Node.Fields) do
begin
valNode := Accept(Node.Fields[i].Value).AsIntf<IAstNode>;
valType := (valNode as TAstNode).StaticType;
boundFields[i] := TRecordFieldLiteral.Create(Node.Fields[i].Key, valNode);
// 2. 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;
scalarKind := TScalar.TKind.Ordinal; // Dummy
end;
if allScalar then
scalarDefFields[i] := TScalarRecordField.Create(Node.Fields[i].Key.Value, scalarKind);
end;
// 3. Create the appropriate record type (Scalar or Generic)
if allScalar then
begin
def := TScalarRecordRegistry.Intern(scalarDefFields);
staticType := TTypes.CreateRecord(def);
// We can re-use the TBoundRecordLiteralNode from the binder
(Node as TBoundRecordLiteralNode).Definition := def;
end
else
begin
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);
// Re-use the TBoundGenericRecordLiteralNode from the binder
(Node as TBoundGenericRecordLiteralNode).Definition := genDef;
end;
Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(Node), staticType);
end;
function TTypeChecker.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
begin
// Type was set by Binder, just propagate it up.
Result := TDataValue.FromIntf<ICreateSeriesNode>(Node);
end;
function TTypeChecker.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>;
lookbackNode := Accept(Node.Lookback).AsIntf<IAstNode>;
seriesType := (seriesNode as TAstNode).StaticType;
valueType := (valueNode as TAstNode).StaticType;
if (seriesType.Kind <> stUnknown) then
begin
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]);
end;
if (lookbackNode <> nil) then
begin
var lookbackType := (lookbackNode as TAstNode).StaticType;
if (lookbackType.Kind <> stUnknown) and not (lookbackType.Kind = TStaticTypeKind.stOrdinal) then
raise ETypeException.Create('Lookback parameter for "add" must be an ordinal value.');
end;
Result := SetType(TDataValue.FromIntf<IAddSeriesItemNode>(Node), TTypes.Void);
end;
function TTypeChecker.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 <> stUnknown)
and (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;
end.