Files
MycLib/Src/AST/Myc.Ast.TypeChecker.pas
T
2025-11-02 19:38:52 +01:00

549 lines
20 KiB
ObjectPascal

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;
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 Node: IAstNode; const AType: IStaticType): IAstNode;
protected
// Override all visit methods to perform type checking
function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override;
function VisitAssignment(const Node: IAssignmentNode): IAstNode; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override;
function VisitIfExpression(const Node: IIfExpressionNode): IAstNode; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode; override;
function VisitMemberAccess(const Node: IMemberAccessNode): IAstNode; override;
function VisitIndexer(const Node: IIndexerNode): IAstNode; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode; override;
function VisitRecurNode(const Node: IRecurNode): IAstNode; override;
// Base cases (types are already set by Binder)
function VisitConstant(const Node: IConstantNode): IAstNode; override;
function VisitKeyword(const Node: IKeywordNode): IAstNode; override;
// Compile-time nodes (should not be present)
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): IAstNode; override;
function VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode; 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;
Result := Accept(RootNode); // Use IAstNode-returning Accept
if not Assigned(Result) then
Result := TAst.Block([]);
// (Result as TAstNode).StaticType is set by the last Visit call
end;
function TTypeChecker.SetType(const Node: IAstNode; const AType: IStaticType): IAstNode;
begin
if Assigned(Node) then
(Node as TAstNode).StaticType := AType;
Result := Node;
end;
function TTypeChecker.VisitConstant(const Node: IConstantNode): IAstNode;
begin
// Type was set by Binder, just propagate it up.
Result := inherited VisitConstant(Node);
end;
function TTypeChecker.VisitKeyword(const Node: IKeywordNode): IAstNode;
begin
// Type was set by Binder, just propagate it up.
Result := inherited VisitKeyword(Node);
end;
function TTypeChecker.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
begin
// Type was set by Binder (read from scope), just propagate it up.
Result := inherited VisitIdentifier(Node);
end;
function TTypeChecker.VisitRecurNode(const Node: IRecurNode): IAstNode;
begin
// Type was set by Binder (TTypes.Void), just propagate it up.
Result := inherited VisitRecurNode(Node);
end;
function TTypeChecker.VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode;
begin
raise Exception.Create('TTypeChecker: MacroDefinition node encountered.');
end;
function TTypeChecker.VisitMacroExpansionNode(const Node: IMacroExpansionNode): IAstNode;
begin
// TypeChecker runs *after* expansion, so we just visit the body.
Result := Accept(Node.ExpandedBody);
end;
function TTypeChecker.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
var
initType: IStaticType;
boundIdent: TIdentifierNode;
adr: TResolvedAddress;
begin
// 1. Visit children first (Identifier is leaf, Initializer is traversed)
inherited;
// 2. Get initializer type
if Assigned(Node.Initializer) then
initType := (Node.Initializer as TAstNode).StaticType
else
initType := TTypes.Void;
// 3. Get the address from the bound identifier.
boundIdent := (Node.Identifier as TIdentifierNode);
adr := boundIdent.Address;
// 4. Update the type in the scope descriptor (which was set to Unknown by the binder).
FCurrentDescriptor.UpdateType(adr.SlotIndex, initType);
// 5. Update the static types of the nodes themselves.
(boundIdent as TAstNode).StaticType := initType;
Result := SetType(Node, initType);
end;
function TTypeChecker.VisitAssignment(const Node: IAssignmentNode): IAstNode;
var
targetType, sourceType: IStaticType;
begin
// 1. Visit children first (Identifier, Value)
inherited;
// 2. Get types
targetType := (Node.Identifier as TAstNode).StaticType;
sourceType := (Node.Value as TAstNode).StaticType;
// 3. Check assignment
if not TTypeRules.CanAssign(targetType, sourceType) then
raise ETypeException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]);
Result := SetType(Node, targetType);
end;
function TTypeChecker.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
var
boundNode: TLambdaExpressionNode;
bodyType, methodType: IStaticType;
paramTypes: TArray<IStaticType>;
i: Integer;
savedDescriptor: IScopeDescriptor;
begin
boundNode := (Node as TLambdaExpressionNode);
// 1. Enter the lambda's scope (which Binder already created)
savedDescriptor := FCurrentDescriptor;
FCurrentDescriptor := boundNode.ScopeDescriptor;
try
// 2. Parameters are leaves, so we don't try to evaluate them
// 3. Get 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
// 4. Visit the body to infer its return type
Accept(boundNode.Body);
bodyType := (boundNode.Body as TAstNode).StaticType;
// 5. Create the final method type
methodType := TTypes.CreateMethod(paramTypes, bodyType);
// 6. Update the type for <self> (Slot 0) in the descriptor
FCurrentDescriptor.UpdateType(0, methodType);
finally
// 7. Restore parent descriptor
FCurrentDescriptor := savedDescriptor;
end;
// 8. Set the type of the lambda node itself
Result := SetType(boundNode, methodType);
end;
function TTypeChecker.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
var
calleeType, retType: IStaticType;
i: Integer;
begin
// 1. Visit children first (bottom-up)
inherited;
// 2. Get callee type (now inferred)
calleeType := (Node.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(Node.Arguments) <> Length(signature.ParamTypes) then
raise ETypeException
.CreateFmt('Function expects %d arguments, but got %d', [Length(signature.ParamTypes), Length(Node.Arguments)]);
retType := signature.ReturnType;
// Check argument types
for i := 0 to High(Node.Arguments) do
begin
var argType := (Node.Arguments[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(Node, retType);
end;
function TTypeChecker.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
var
blockType: IStaticType;
begin
// 1. Visit children
inherited;
// 2. Type is type of last expression
if Length(Node.Expressions) > 0 then
blockType := (Node.Expressions[High(Node.Expressions)] as TAstNode).StaticType
else
blockType := TTypes.Void;
Result := SetType(Node, blockType);
end;
function TTypeChecker.VisitIfExpression(const Node: IIfExpressionNode): IAstNode;
var
conditionType, thenType, elseType, resultType: IStaticType;
begin
// 1. Visit children
inherited;
// 2. Check condition
conditionType := (Node.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]);
// 3. Promote branch types
thenType := (Node.ThenBranch as TAstNode).StaticType;
elseType :=
if Node.ElseBranch <> nil then (Node.ElseBranch as TAstNode).StaticType
else TTypes.Void;
resultType := TTypeRules.Promote(thenType, elseType);
Result := SetType(Node, resultType);
end;
function TTypeChecker.VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode;
var
conditionType, thenType, elseType, resultType: IStaticType;
begin
// 1. Visit children
inherited;
// 2. Check condition
conditionType := (Node.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]);
// 3. Promote branch types
thenType := (Node.ThenBranch as TAstNode).StaticType;
elseType := (Node.ElseBranch as TAstNode).StaticType;
resultType := TTypeRules.Promote(thenType, elseType);
Result := SetType(Node, resultType);
end;
function TTypeChecker.VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode;
var
leftType, rightType, resultType: IStaticType;
begin
// 1. Visit children
inherited;
// 2. Get types
leftType := (Node.Left as TAstNode).StaticType;
rightType := (Node.Right as TAstNode).StaticType;
// 3. Resolve
resultType := TTypeRules.ResolveBinaryOp(Node.Operator, leftType, rightType);
Result := SetType(Node, resultType);
end;
function TTypeChecker.VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode;
var
rightType, resultType: IStaticType;
begin
// 1. Visit children
inherited;
// 2. Get types
rightType := (Node.Right as TAstNode).StaticType;
// 3. Resolve
resultType := TTypeRules.ResolveUnaryOp(Node.Operator, rightType);
Result := SetType(Node, resultType);
end;
function TTypeChecker.VisitMemberAccess(const Node: IMemberAccessNode): IAstNode;
var
baseType, elemType: IStaticType;
fieldIndex: Integer;
begin
// 1. Visit children
inherited;
// 2. Get types
baseType := (Node.Base as TAstNode).StaticType;
elemType := TTypes.Unknown;
// 3. Resolve
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(Node, elemType);
end;
function TTypeChecker.VisitIndexer(const Node: IIndexerNode): IAstNode;
var
baseType, indexType, elemType: IStaticType;
begin
// 1. Visit children
inherited;
// 2. Get types
baseType := (Node.Base as TAstNode).StaticType;
indexType := (Node.Index as TAstNode).StaticType;
elemType := TTypes.Unknown;
// 3. Resolve
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(Node, elemType);
end;
function TTypeChecker.VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode;
var
i: Integer;
scalarDefFields: TArray<TScalarRecordField>;
def: IScalarRecordDefinition;
staticType: IStaticType;
valNode: IAstNode;
valType: IStaticType;
scalarKind: TScalar.TKind;
allScalar: Boolean;
N: TGenericRecordLiteralNode; // Parser creates this type
begin
// 1. Visit all child nodes first to infer their types
inherited;
N := (Node as TGenericRecordLiteralNode);
SetLength(scalarDefFields, Length(N.Fields));
allScalar := True;
// 2. Check if this record literal can be a TScalarRecord
for i := 0 to High(N.Fields) do
begin
valNode := N.Fields[i].Value;
valType := (valNode as TAstNode).StaticType;
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(N.Fields[i].Key.Value, scalarKind);
end;
// 3. Create the appropriate record type (Scalar or Generic) and mutate the node
if allScalar then
begin
def := TScalarRecordRegistry.Intern(scalarDefFields);
staticType := TTypes.CreateRecord(def);
N.Definition := def; // Mutate
N.GenericDefinition := nil; // Mutate
end
else
begin
var genDefFields: TArray<TPair<IKeyword, IStaticType>>;
SetLength(genDefFields, Length(N.Fields));
for i := 0 to High(N.Fields) do
genDefFields[i] := TPair<IKeyword, IStaticType>.Create(N.Fields[i].Key.Value, (N.Fields[i].Value as TAstNode).StaticType);
var genDef := TGenericRecordRegistry.Intern(genDefFields);
staticType := TTypes.CreateGenericRecord(genDef);
N.GenericDefinition := genDef; // Mutate
N.Definition := nil; // Mutate
end;
Result := SetType(N, staticType);
end;
function TTypeChecker.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode;
begin
// Type was set by Binder, just propagate it up.
Result := inherited VisitCreateSeries(Node);
end;
function TTypeChecker.VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode;
var
seriesType, valueType: IStaticType;
begin
// 1. Visit children
inherited;
// 2. Get types
seriesType := (Node.Series as TAstNode).StaticType;
valueType := (Node.Value as TAstNode).StaticType;
// 3. Check types
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 (Node.Lookback <> nil) then
begin
var lookbackType := (Node.Lookback 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(Node, TTypes.Void);
end;
function TTypeChecker.VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode;
var
seriesType: IStaticType;
begin
// 1. Visit children
inherited;
// 2. Get type
seriesType := (Node.Series as TAstNode).StaticType;
// 3. Check type
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(Node, TTypes.Ordinal);
end;
end.