Files
MycLib/Src/AST/Myc.Ast.Compiler.TypeChecker.pas
T
Michael Schimmel 242ec9a56e AST list refactoring
2026-01-04 22:41:44 +01:00

1034 lines
34 KiB
ObjectPascal

unit Myc.Ast.Compiler.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.Identities,
Myc.Ast;
type
IAstTypeChecker = interface(IAstVisitor)
function Execute(const RootNode: IAstNode): IAstNode;
end;
TTypeChecker = class(TAstTransformer, IAstTypeChecker)
private
type
TTypeContext = class
private
FParent: TTypeContext;
FLayout: IScopeLayout;
FSlotTypes: TArray<IStaticType>;
FUpvalueTypes: TArray<IStaticType>;
public
constructor Create(
AParent: TTypeContext;
ALayout: IScopeLayout;
const AUpvalueTypes: TArray<IStaticType>;
ADescriptor: IScopeDescriptor
);
function LookupType(const Address: TResolvedAddress): IStaticType;
procedure SetType(SlotIndex: Integer; AType: IStaticType);
property Types: TArray<IStaticType> read FSlotTypes;
end;
private
FCurrentContext: TTypeContext;
FLog: ICompilerLog;
FRootScope: IExecutionScope;
function CreateContextChain(L: IScopeLayout): TTypeContext;
// Helpers for Null Propagation
function PrepareBaseType(const BaseNode: IAstNode; out IsOptional: Boolean): IStaticType;
function ApplyOptionality(const AType: IStaticType; IsOptional: Boolean): IStaticType;
strict private
// Typed Handlers (non-virtual, IAstNode signature)
function VisitIdentifier(const Node: IAstNode): IAstNode;
function VisitVariableDeclaration(const Node: IAstNode): IAstNode;
function VisitAssignment(const Node: IAstNode): IAstNode;
function VisitLambdaExpression(const Node: IAstNode): IAstNode;
function VisitFunctionCall(const Node: IAstNode): IAstNode;
function VisitBlockExpression(const Node: IAstNode): IAstNode;
function VisitIfExpression(const Node: IAstNode): IAstNode;
function VisitMemberAccess(const Node: IAstNode): IAstNode;
function VisitIndexer(const Node: IAstNode): IAstNode;
function VisitCreateSeries(const Node: IAstNode): IAstNode;
function VisitSeriesLength(const Node: IAstNode): IAstNode;
function VisitRecurNode(const Node: IAstNode): IAstNode;
function VisitNop(const Node: IAstNode): IAstNode;
function VisitRecordLiteral(const Node: IAstNode): IAstNode;
function VisitConstant(const Node: IAstNode): IAstNode;
function VisitKeyword(const Node: IAstNode): IAstNode;
function VisitTuple(const Node: IAstNode): IAstNode;
// Pipe Support
function VisitPipeInput(const Node: IAstNode): IAstNode;
function VisitPipe(const Node: IAstNode): IAstNode;
protected
procedure SetupHandlers; override;
public
constructor Create(const RootLayout: IScopeLayout; const RootScope: IExecutionScope; const ALog: ICompilerLog);
destructor Destroy; override;
function Execute(const RootNode: IAstNode): IAstNode;
class function CheckTypes(
const RootNode: IAstNode;
const Layout: IScopeLayout;
const RootScope: IExecutionScope;
const ALog: ICompilerLog
): IAstNode; static;
end;
implementation
uses
System.Generics.Defaults,
Myc.Data.Keyword;
{ TTypeChecker.TTypeContext }
constructor TTypeChecker.TTypeContext.Create(
AParent: TTypeContext;
ALayout: IScopeLayout;
const AUpvalueTypes: TArray<IStaticType>;
ADescriptor: IScopeDescriptor
);
var
i: Integer;
begin
inherited Create;
FParent := AParent;
FLayout := ALayout;
FUpvalueTypes := AUpvalueTypes;
if Assigned(FLayout) then
begin
SetLength(FSlotTypes, FLayout.SlotCount);
if Assigned(ADescriptor) then
begin
// Load known types from descriptor (e.g. for Root Scope / RTL)
for i := 0 to High(FSlotTypes) do
FSlotTypes[i] := ADescriptor.GetSymbolType(i);
end
else
begin
// Initialize with Unknown for new scopes
for i := 0 to High(FSlotTypes) do
FSlotTypes[i] := TTypes.Unknown;
end;
end;
end;
function TTypeChecker.TTypeContext.LookupType(const Address: TResolvedAddress): IStaticType;
var
ctx: TTypeContext;
i: Integer;
begin
case Address.Kind of
akLocalOrParent:
begin
ctx := Self;
for i := 1 to Address.ScopeDepth do
begin
if not Assigned(ctx.FParent) then
begin
Result := TTypes.Unknown;
Exit;
end;
ctx := ctx.FParent;
end;
if (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(ctx.FSlotTypes)) then
Result := ctx.FSlotTypes[Address.SlotIndex]
else
Result := TTypes.Unknown;
end;
akUpvalue:
begin
if (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FUpvalueTypes)) then
Result := FUpvalueTypes[Address.SlotIndex]
else
Result := TTypes.Unknown;
end;
else
Result := TTypes.Unknown;
end;
end;
procedure TTypeChecker.TTypeContext.SetType(SlotIndex: Integer; AType: IStaticType);
begin
if (SlotIndex >= 0) and (SlotIndex < Length(FSlotTypes)) then
FSlotTypes[SlotIndex] := AType;
end;
{ TTypeChecker }
function TTypeChecker.CreateContextChain(L: IScopeLayout): TTypeContext;
var
p: TTypeContext;
desc: IScopeDescriptor;
begin
if L = nil then
exit(nil);
p := CreateContextChain(L.Parent);
desc := nil;
if (L.Parent = nil) and Assigned(FRootScope) then
begin
desc := FRootScope.Descriptor;
end;
Result := TTypeContext.Create(p, L, [], desc);
end;
constructor TTypeChecker.Create(const RootLayout: IScopeLayout; const RootScope: IExecutionScope; const ALog: ICompilerLog);
begin
inherited Create;
FLog := ALog;
FRootScope := RootScope;
FCurrentContext := CreateContextChain(RootLayout);
if FCurrentContext = nil then
FCurrentContext := TTypeContext.Create(nil, nil, [], nil);
end;
destructor TTypeChecker.Destroy;
begin
while Assigned(FCurrentContext) do
begin
var temp := FCurrentContext;
FCurrentContext := FCurrentContext.FParent;
temp.Free;
end;
inherited;
end;
procedure TTypeChecker.SetupHandlers;
begin
inherited SetupHandlers; // Load Defaults
Register(akIdentifier, VisitIdentifier);
Register(akVariableDeclaration, VisitVariableDeclaration);
Register(akAssignment, VisitAssignment);
Register(akLambdaExpression, VisitLambdaExpression);
Register(akFunctionCall, VisitFunctionCall);
Register(akBlockExpression, VisitBlockExpression);
Register(akIfExpression, VisitIfExpression);
Register(akMemberAccess, VisitMemberAccess);
Register(akIndexer, VisitIndexer);
Register(akCreateSeries, VisitCreateSeries);
Register(akSeriesLength, VisitSeriesLength);
Register(akRecur, VisitRecurNode);
Register(akNop, VisitNop);
Register(akRecordLiteral, VisitRecordLiteral);
Register(akConstant, VisitConstant);
Register(akKeyword, VisitKeyword);
Register(akTuple, VisitTuple);
// Pipe Support
Register(akPipeInput, VisitPipeInput);
Register(akPipe, VisitPipe);
end;
class function TTypeChecker.CheckTypes(
const RootNode: IAstNode;
const Layout: IScopeLayout;
const RootScope: IExecutionScope;
const ALog: ICompilerLog
): IAstNode;
var
startLayout: IScopeLayout;
begin
if Assigned(Layout) then
startLayout := Layout.Parent
else
startLayout := nil;
var checker := TTypeChecker.Create(startLayout, RootScope, ALog) as IAstTypeChecker;
Result := checker.Execute(RootNode);
end;
function TTypeChecker.Execute(const RootNode: IAstNode): IAstNode;
begin
Result := Accept(RootNode);
if not Assigned(Result) then
Result := TAst.Block([], nil);
end;
// --- Helper ---
function TTypeChecker.PrepareBaseType(const BaseNode: IAstNode; out IsOptional: Boolean): IStaticType;
var
baseType: IStaticType;
begin
baseType := BaseNode.AsTypedNode.StaticType;
IsOptional := baseType.IsOptional;
Result := TTypes.Unwrap(baseType);
end;
function TTypeChecker.ApplyOptionality(const AType: IStaticType; IsOptional: Boolean): IStaticType;
begin
if IsOptional and (AType.Kind <> stUnknown) then
Result := TTypes.MakeOptional(AType)
else
Result := AType;
end;
// --- Visits ---
function TTypeChecker.VisitConstant(const Node: IAstNode): IAstNode;
begin
Result := Node;
end;
function TTypeChecker.VisitKeyword(const Node: IAstNode): IAstNode;
begin
Result := Node;
end;
function TTypeChecker.VisitTuple(const Node: IAstNode): IAstNode;
var
T: ITupleNode;
newElements: TArray<IAstNode>;
elementTypes: TArray<IStaticType>;
i: Integer;
// Inference variables
firstType: IStaticType;
isHomogeneous: Boolean;
commonDim: TArray<Integer>;
newDim: TArray<Integer>;
finalType: IStaticType;
begin
T := Node.AsTuple;
var count := T.Count;
SetLength(newElements, count);
SetLength(elementTypes, count);
// 1. Visit Children
// Recursively type-check all elements first to determine their static types.
for i := 0 to count - 1 do
begin
newElements[i] := Accept(T.Items[i]);
// FIX: Ensure the node is typed before accessing StaticType.
// Structural nodes (like RecordField) are NOT typed and might crash or return garbage.
if newElements[i].IsTyped then
elementTypes[i] := newElements[i].AsTypedNode.StaticType
else
elementTypes[i] := TTypes.Unknown;
end;
// 2. Inference Logic: Tuple vs. Vector vs. Matrix
if count = 0 then
begin
// Empty Tuple -> stTuple (safest fallback, effectively Void)
finalType := TTypes.CreateTuple([]);
end
else
begin
firstType := elementTypes[0];
isHomogeneous := True;
// Check for Homogeneity (Exact type equality of all elements)
// Note: If any element is Unknown, we assume Heterogeneous (Tuple) unless all are unknown?
// For now, Unknown breaks homogeneity.
for i := 1 to count - 1 do
begin
if not firstType.IsEqual(elementTypes[i]) then
begin
isHomogeneous := False;
break;
end;
end;
if isHomogeneous and (firstType.Kind <> stUnknown) then
begin
// It is at least a Vector.
// Check if it should be promoted to a Matrix (i.e., elements are Vectors or Matrices).
if firstType.Kind = stVector then
begin
// Vector of Vectors -> Matrix (2D)
// New Dimensions = [OuterCount, InnerCount]
newDim := [count, firstType.AsVector.Count];
finalType := TTypes.CreateMatrix(firstType.AsVector.ElementType, newDim);
end
else if firstType.Kind = stMatrix then
begin
// Vector of Matrices -> Higher dimensional Matrix (N+1)
// New Dimensions = [OuterCount, Dim0, Dim1...]
commonDim := firstType.AsMatrix.Dimensions;
SetLength(newDim, Length(commonDim) + 1);
newDim[0] := count;
for i := 0 to High(commonDim) do
newDim[i + 1] := commonDim[i];
finalType := TTypes.CreateMatrix(firstType.AsMatrix.ElementType, newDim);
end
else
begin
// Base case: Homogeneous Scalars/Records -> Vector (1D)
finalType := TTypes.CreateVector(firstType, count);
end;
end
else
begin
// Heterogeneous types -> Standard Tuple
finalType := TTypes.CreateTuple(elementTypes);
end;
end;
// 3. Return the new node with the inferred type definition
Result := TAst.Tuple(Node.Identity, newElements, finalType);
end;
function TTypeChecker.VisitIdentifier(const Node: IAstNode): IAstNode;
var
I: IIdentifierNode;
typ: IStaticType;
adr: TResolvedAddress;
identity: INamedIdentity;
begin
I := Node.AsIdentifier;
adr := I.Address;
identity := I.Identity.AsNamed;
if adr.Kind = akUnresolved then
begin
Result := TAst.Identifier(identity, adr, TTypes.Unknown);
Exit;
end;
typ := FCurrentContext.LookupType(adr);
Result := TAst.Identifier(identity, adr, typ);
end;
function TTypeChecker.VisitRecurNode(const Node: IAstNode): IAstNode;
var
R: IRecurNode;
args: ITupleNode;
begin
R := Node.AsRecur;
args := Accept(R.Arguments).AsTuple;
Result := TAst.Recur(Node.Identity, args, TTypes.Void);
end;
function TTypeChecker.VisitVariableDeclaration(const Node: IAstNode): IAstNode;
var
V: IVariableDeclarationNode;
initType: IStaticType;
newInitializer, newIdent: IAstNode;
adr: TResolvedAddress;
identNode: IIdentifierNode;
begin
V := Node.AsVariableDeclaration;
identNode := V.Target.AsIdentifier;
adr := identNode.Address;
initType := TTypes.Unknown;
if adr.Kind = akUnresolved then
begin
if Assigned(V.Initializer) then
Accept(V.Initializer);
Result := Node;
Exit;
end;
if Assigned(V.Initializer) then
newInitializer := Accept(V.Initializer)
else
newInitializer := nil;
if Assigned(newInitializer) then
initType := newInitializer.AsTypedNode.StaticType;
if initType.Kind <> stUnknown then
FCurrentContext.SetType(adr.SlotIndex, initType);
newIdent := TAst.Identifier(identNode.Identity.AsNamed, adr, initType);
Result := TAst.VarDecl(Node.Identity, newIdent, newInitializer, initType, V.IsBoxed);
end;
function TTypeChecker.VisitAssignment(const Node: IAstNode): IAstNode;
var
A: IAssignmentNode;
targetType, sourceType: IStaticType;
newIdent, newValue: IAstNode;
adr: TResolvedAddress;
identNode: IIdentifierNode;
begin
A := Node.AsAssignment;
identNode := A.Target.AsIdentifier;
newIdent := Accept(A.Target);
targetType := newIdent.AsTypedNode.StaticType;
adr := identNode.Address;
if adr.Kind = akUnresolved then
begin
Accept(A.Value);
Result := Node;
Exit;
end;
newValue := Accept(A.Value);
sourceType := newValue.AsTypedNode.StaticType;
if (targetType.Kind <> stUnknown) and (sourceType.Kind <> stUnknown) then
begin
if not TTypeRules.CanAssign(targetType, sourceType) then
begin
if Assigned(FLog) then
FLog.AddError(Format('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]), Node);
end;
end;
if (targetType.Kind = stUnknown) and (sourceType.Kind <> stUnknown) then
begin
FCurrentContext.SetType(adr.SlotIndex, sourceType);
newIdent := TAst.Identifier(identNode.Identity.AsNamed, adr, sourceType);
targetType := sourceType;
end;
Result := TAst.Assign(Node.Identity, newIdent, newValue, targetType);
end;
function TTypeChecker.VisitBlockExpression(const Node: IAstNode): IAstNode;
var
newBlock: IBlockExpressionNode;
blockType: IStaticType;
exprs: ITupleNode;
i: Integer;
begin
// 1. Transform children via inherited logic
// This delegates to TAstTransformer.VisitBlockExpression, which calls Visit(B.Expressions).
// B.Expressions is a Tuple, so it routes to TTypeChecker.VisitTuple.
var transformedNode := inherited VisitBlockExpression(Node);
// Safety check: Did the transformer return a node?
if not Assigned(transformedNode) then
raise ECompilationFailed.Create([TCompilerError.Create(elError, 'Internal Error: Block transformation returned nil.', Node)]);
newBlock := transformedNode.AsBlockExpression;
exprs := newBlock.Expressions;
// 2. Validate expressions
if exprs.Count > 0 then
begin
// Check for NIL entries which indicate failed transformation of children
for i := 0 to exprs.Count - 1 do
begin
if exprs.Items[i] = nil then
raise ECompilationFailed.Create(
[TCompilerError.Create(elError, Format('Internal Error: Block expression #%d transformed to nil.', [i]), Node)]);
end;
// The type of the block is the type of the last expression
blockType := exprs.Items[exprs.Count - 1].AsTypedNode.StaticType;
end
else
begin
blockType := TTypes.Void;
end;
Result := TAst.Block(Node.Identity, exprs, blockType);
end;
function TTypeChecker.VisitLambdaExpression(const Node: IAstNode): IAstNode;
var
L: ILambdaExpressionNode;
newParams: TArray<IIdentifierNode>;
newBody: IAstNode;
bodyType, methodType: IStaticType;
paramTypes: TArray<IStaticType>;
upvalueTypes: TArray<IStaticType>;
i: Integer;
finalDescriptor: IScopeDescriptor;
paramIdent: IIdentifierNode;
injectedType: IStaticType;
paramsTuple: ITupleNode;
paramsAsNodes: TArray<IAstNode>;
begin
L := Node.AsLambdaExpression;
var upvalueAddrs := L.Upvalues;
SetLength(upvalueTypes, Length(upvalueAddrs));
for i := 0 to High(upvalueAddrs) do
begin
var lookupAddr := upvalueAddrs[i];
if lookupAddr.Kind = akLocalOrParent then
begin
if lookupAddr.ScopeDepth > 0 then
Dec(lookupAddr.ScopeDepth);
end;
upvalueTypes[i] := FCurrentContext.LookupType(lookupAddr);
end;
FCurrentContext := TTypeContext.Create(FCurrentContext, L.Layout, upvalueTypes, nil);
try
paramsTuple := L.Parameters;
SetLength(newParams, paramsTuple.Count);
SetLength(paramTypes, paramsTuple.Count);
for i := 0 to paramsTuple.Count - 1 do
begin
paramIdent := paramsTuple.Items[i].AsIdentifier;
injectedType := paramIdent.AsTypedNode.StaticType;
if injectedType.Kind = stUnknown then
paramTypes[i] := TTypes.Unknown
else
paramTypes[i] := injectedType;
if paramIdent.Address.Kind <> akUnresolved then
FCurrentContext.SetType(paramIdent.Address.SlotIndex, paramTypes[i]);
newParams[i] := TAst.Identifier(paramIdent.Identity.AsNamed, paramIdent.Address, paramTypes[i]);
end;
newBody := Accept(L.Body);
bodyType := newBody.AsTypedNode.StaticType;
methodType := TTypes.CreateMethod(paramTypes, bodyType);
finalDescriptor := TScope.CreateDescriptor(L.Layout, FCurrentContext.Types);
finally
var temp := FCurrentContext;
FCurrentContext := FCurrentContext.FParent;
temp.Free;
end;
SetLength(paramsAsNodes, Length(newParams));
for i := 0 to High(newParams) do
paramsAsNodes[i] := newParams[i];
var paramList := TAst.Tuple(L.Parameters.Identity, paramsAsNodes);
Result :=
TAst.LambdaExpr(Node.Identity, paramList, newBody, L.Layout, finalDescriptor, L.Upvalues, L.HasNestedLambdas, L.IsPure, methodType);
end;
function TTypeChecker.VisitFunctionCall(const Node: IAstNode): IAstNode;
var
newCall: IFunctionCallNode;
calleeType, retType: IStaticType;
i, j: Integer;
argTypes: TArray<IStaticType>;
hasUnknownArgs: Boolean;
bestSig: IMethodSignature;
match: Boolean;
newArgs: ITupleNode;
begin
newCall := inherited VisitFunctionCall(Node).AsFunctionCall;
var newCallee := newCall.Callee;
newArgs := newCall.Arguments;
SetLength(argTypes, newArgs.Count);
hasUnknownArgs := False;
for i := 0 to newArgs.Count - 1 do
begin
argTypes[i] := newArgs.Items[i].AsTypedNode.StaticType;
if argTypes[i].Kind = stUnknown then
hasUnknownArgs := True;
end;
calleeType := newCallee.AsTypedNode.StaticType;
retType := TTypes.Unknown;
if calleeType.Kind = stMethod then
begin
if not hasUnknownArgs then
begin
bestSig := nil;
for var sig in calleeType.AsMethod.Signatures do
begin
if Length(sig.ParamTypes) <> Length(argTypes) then
continue;
match := True;
for j := 0 to High(argTypes) do
if not TTypeRules.CanAssign(sig.ParamTypes[j], argTypes[j]) then
begin
match := False;
break;
end;
if match then
begin
bestSig := sig;
break;
end;
end;
if Assigned(bestSig) then
retType := bestSig.ReturnType
else if Assigned(FLog) then
FLog.AddError(Format('No matching signature found for method call on %s', [calleeType.ToString]), Node);
end;
end
else if calleeType.Kind <> stUnknown then
if Assigned(FLog) then
FLog.AddError(Format('Cannot invoke type %s as a function.', [calleeType.ToString]), Node);
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgs, retType, newCall.IsTailCall, nil, False);
end;
function TTypeChecker.VisitIfExpression(const Node: IAstNode): IAstNode;
var
newIf: IIfExpressionNode;
resType: IStaticType;
begin
newIf := inherited VisitIfExpression(Node).AsIfExpression;
if (newIf.ElseBranch <> nil) then
resType := TTypeRules.Promote(newIf.ThenBranch.AsTypedNode.StaticType, newIf.ElseBranch.AsTypedNode.StaticType)
else
resType := TTypes.MakeOptional(newIf.ThenBranch.AsTypedNode.StaticType);
Result := TAst.IfExpr(Node.Identity, newIf.Condition, newIf.ThenBranch, newIf.ElseBranch, resType);
end;
function TTypeChecker.VisitIndexer(const Node: IAstNode): IAstNode;
var
I: IIndexerNode;
newBase, newIndex: IAstNode;
baseType, elemType: IStaticType;
isOpt: Boolean;
begin
I := Node.AsIndexer;
newBase := Accept(I.Base);
newIndex := Accept(I.Index);
baseType := PrepareBaseType(newBase, isOpt);
elemType := TTypes.Unknown;
if baseType.Kind = stSeries then
elemType := baseType.AsSeries.ElementType
else if baseType.Kind = stRecordSeries then
elemType := TTypes.CreateRecord(baseType.AsRecord.Definition)
else if baseType.Kind = stTuple then
begin
// Tuple Indexing (requires constant index for strong typing!)
if (newIndex.Kind = akConstant) and (newIndex.AsConstant.Value.Kind = vkScalar) then
begin
var idx := newIndex.AsConstant.Value.AsScalar.Value.AsInt64;
var tpl := baseType.AsTuple;
if (idx >= 0) and (idx < tpl.Count) then
elemType := tpl.Elements[Integer(idx)];
end;
end;
elemType := ApplyOptionality(elemType, isOpt);
Result := TAst.Indexer(Node.Identity, newBase, newIndex, elemType);
end;
function TTypeChecker.VisitMemberAccess(const Node: IAstNode): IAstNode;
var
M: IMemberAccessNode;
newBase: IAstNode;
baseType, resType: IStaticType;
idx: Integer;
isOpt: Boolean;
begin
M := Node.AsMemberAccess;
newBase := Accept(M.Base);
baseType := PrepareBaseType(newBase, isOpt);
resType := TTypes.Unknown;
if (baseType.Kind = stRecord) or (baseType.Kind = stRecordSeries) then
begin
idx := baseType.AsRecord.Definition.IndexOf(M.Member.Value);
if idx >= 0 then
begin
var fieldType := TTypes.FromScalarKind(baseType.AsRecord.Definition[idx]);
if baseType.Kind = stRecordSeries then
resType := TTypes.CreateSeries(fieldType)
else
resType := fieldType;
end
else if Assigned(FLog) then
FLog.AddError('Member not found', Node);
end;
resType := ApplyOptionality(resType, isOpt);
Result := TAst.MemberAccess(Node.Identity, newBase, M.Member, resType);
end;
function TTypeChecker.VisitRecordLiteral(const Node: IAstNode): IAstNode;
var
R: IRecordLiteralNode;
i: Integer;
fieldTypes: TArray<TPair<IKeyword, IStaticType>>;
scalarFieldTypes: TArray<TPair<IKeyword, TScalar.TKind>>;
isScalar: Boolean;
valType: IStaticType;
key: IKeyword;
newFields: ITupleNode;
begin
R := Node.AsRecordLiteral;
// FIX: Do NOT use inherited VisitRecordLiteral() here, because it expects an IRecordLiteralNode
// but R.Fields is an ITupleNode. Using inherited would dispatch to VisitRecordLiteral with wrong type
// or trigger recursive confusion.
// Instead, directly visit the fields Tuple. This routes to TTypeChecker.VisitTuple.
newFields := Visit(R.Fields).AsTuple;
var count := newFields.Count;
SetLength(fieldTypes, count);
SetLength(scalarFieldTypes, count);
isScalar := True;
for i := 0 to count - 1 do
begin
// Note: Elements of the fields tuple are RecordFieldNodes.
// RecordFieldNodes are NOT Typed (IAstTypedNode), they are structural.
// So we cannot check .StaticType on the field itself.
// We must check the .Value of the field.
var field := newFields.Items[i].AsRecordField;
key := field.Key.Value;
valType := field.Value.AsTypedNode.StaticType;
if (valType.Kind in [stOrdinal, stFloat, stBoolean, stDateTime, stKeyword]) and (not valType.IsOptional) then
begin
var kind: TScalar.TKind;
case valType.Kind of
stOrdinal: kind := TScalar.TKind.Ordinal;
stFloat: kind := TScalar.TKind.Float;
stBoolean: kind := TScalar.TKind.Boolean;
stDateTime: kind := TScalar.TKind.DateTime;
stKeyword: kind := TScalar.TKind.Keyword;
else
kind := TScalar.TKind.Ordinal;
end;
scalarFieldTypes[i] := TPair<IKeyword, TScalar.TKind>.Create(key, kind);
end
else
begin
isScalar := False;
end;
fieldTypes[i] := TPair<IKeyword, IStaticType>.Create(key, valType);
end;
var scalarDef: IScalarRecordDefinition := nil;
var genericDef: IGenericRecordDefinition := nil;
var resultType: IStaticType;
if isScalar and (count > 0) then
begin
scalarDef := TKeywordMappingRegistry<TScalar.TKind>.Intern(scalarFieldTypes);
resultType := TTypes.CreateRecord(scalarDef);
end
else
begin
genericDef := TGenericRecordRegistry.Intern(fieldTypes);
resultType := TTypes.CreateGenericRecord(genericDef);
end;
Result := TAst.RecordLiteral(Node.Identity, newFields, scalarDef, genericDef, resultType);
end;
function TTypeChecker.VisitCreateSeries(const Node: IAstNode): IAstNode;
var
C: ICreateSeriesNode;
elemType: IStaticType;
def: string;
begin
C := Node.AsCreateSeries;
def := C.Definition;
if def.StartsWith('[') then
elemType := TTypes.CreateRecord(nil)
else
elemType := TTypes.FromScalarKind(TScalar.StringToKind(def));
Result := TAst.CreateSeries(Node.Identity.AsDefinition, TTypes.CreateSeries(elemType));
end;
function TTypeChecker.VisitSeriesLength(const Node: IAstNode): IAstNode;
begin
Result := TAst.SeriesLength(Node.Identity, Accept(Node.AsSeriesLength.Series).AsIdentifier, TTypes.Ordinal);
end;
function TTypeChecker.VisitNop(const Node: IAstNode): IAstNode;
begin
Result := TAst.Nop(Node.Identity, TTypes.Void);
end;
// =============================================================================
// PIPE IMPLEMENTATION (Type Checking)
// =============================================================================
function TTypeChecker.VisitPipeInput(const Node: IAstNode): IAstNode;
var
P: IPipeInputNode;
newSource: IIdentifierNode;
sourceType: IStaticType;
begin
P := Node.AsPipeInput;
newSource := Accept(P.StreamSource).AsIdentifier;
sourceType := newSource.AsTypedNode.StaticType;
if (sourceType.Kind <> stUnknown) then
begin
if not ((sourceType.Kind = stSeries) or (sourceType.Kind = stRecordSeries)) then
begin
if Assigned(FLog) then
FLog.AddError(
Format('Pipe input "%s" must be a Series or RecordSeries, but got %s.', [newSource.Name, sourceType.ToString]),
Node
);
end
else if (sourceType.Kind = stRecordSeries) then
begin
var def := sourceType.AsRecord.Definition;
for var sel in P.Selectors do
begin
if def.IndexOf(sel.Value) < 0 then
begin
if Assigned(FLog) then
FLog.AddError(Format('Field ":%s" not found in stream "%s".', [sel.Value.Name, newSource.Name]), sel);
end;
end;
end;
end;
Result := TAst.PipeInput(newSource, P.Selectors, Node.Identity.Location);
end;
function TTypeChecker.VisitPipe(const Node: IAstNode): IAstNode;
var
P: IPipeNode;
i, k: Integer;
inputNode: IPipeInputNode;
newInputs: TArray<IPipeInputNode>;
streamType: IStaticType;
paramTypes: TList<IStaticType>;
lambda: ILambdaExpressionNode;
newParams: TArray<IIdentifierNode>;
newParamsAsNodes: TArray<IAstNode>;
inferredType: IStaticType;
begin
P := Node.AsPipe;
SetLength(newInputs, P.Inputs.Count);
paramTypes := TList<IStaticType>.Create;
try
for i := 0 to P.Inputs.Count - 1 do
begin
inputNode := Accept(P.Inputs[i]).AsPipeInput;
newInputs[i] := inputNode;
streamType := inputNode.StreamSource.AsTypedNode.StaticType;
for var sel in inputNode.Selectors do
begin
inferredType := TTypes.Unknown;
if streamType.Kind = stRecordSeries then
begin
var def := streamType.AsRecord.Definition;
var idx := def.IndexOf(sel.Value);
if idx >= 0 then
inferredType := TTypes.FromScalarKind(def[idx]);
end
else if streamType.Kind = stSeries then
begin
if Assigned(streamType.AsSeries.ElementType) then
inferredType := streamType.AsSeries.ElementType
else
inferredType := TTypes.Ordinal;
end;
paramTypes.Add(inferredType);
end;
end;
lambda := P.Transformation;
if lambda.Parameters.Count <> paramTypes.Count then
begin
if Assigned(FLog) then
FLog.AddError(
Format(
'Pipe lambda expects %d parameters (one per selector), but got %d.',
[paramTypes.Count, lambda.Parameters.Count]
),
lambda
);
end;
SetLength(newParams, lambda.Parameters.Count);
for k := 0 to lambda.Parameters.Count - 1 do
begin
var oldP := lambda.Parameters.Items[k].AsIdentifier;
var typeToInject :=
if k < paramTypes.Count then paramTypes[k]
else TTypes.Unknown;
newParams[k] := TAst.Identifier(oldP.Identity.AsNamed, oldP.Address, typeToInject);
end;
// Convert for Tuple Factory
SetLength(newParamsAsNodes, Length(newParams));
for k := 0 to High(newParams) do
newParamsAsNodes[k] := newParams[k];
var preTypedLambda :=
TAst.LambdaExpr(
lambda.Identity,
TAst.Tuple(lambda.Parameters.Identity, newParamsAsNodes),
lambda.Body,
lambda.Layout,
lambda.Descriptor,
lambda.Upvalues,
lambda.HasNestedLambdas,
lambda.IsPure,
TTypes.Unknown
);
var typedLambda := Accept(preTypedLambda).AsLambdaExpression;
var lambdaRetType := typedLambda.AsTypedNode.StaticType.AsMethod.Signatures[0].ReturnType;
var pipeType: IStaticType;
if lambdaRetType.Kind = stRecord then
begin
pipeType := TTypes.CreateRecordSeries(lambdaRetType.AsRecord.Definition);
end
else
begin
if (lambdaRetType.Kind <> stUnknown) and (lambdaRetType.Kind <> stVoid) then
begin
if Assigned(FLog) then
FLog.AddError(
Format('Pipe function must return a Record (e.g. {:res ...}). Type "%s" is invalid.', [lambdaRetType.ToString]),
lambda
);
end;
pipeType := TTypes.Unknown;
end;
Result := TAst.Pipe(Node.Identity, TPipeInputList.Create(newInputs, P.Inputs.Identity), typedLambda, pipeType);
finally
paramTypes.Free;
end;
end;
end.