Michael Schimmel
885 lines
30 KiB
ObjectPascal
885 lines
30 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; const Layout: IScopeLayout): 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>);
|
|
function LookupType(const Address: TResolvedAddress): IStaticType;
|
|
procedure SetType(SlotIndex: Integer; AType: IStaticType);
|
|
property Types: TArray<IStaticType> read FSlotTypes;
|
|
end;
|
|
|
|
private
|
|
FCurrentContext: TTypeContext;
|
|
FLog: ICompilerLog;
|
|
|
|
function CreateContextChain(L: IScopeLayout): TTypeContext;
|
|
|
|
protected
|
|
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 VisitCondExpression(const Node: ICondExpressionNode): IAstNode; override; // Replaced Ternary
|
|
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;
|
|
function VisitNop(const Node: INopNode): IAstNode; override;
|
|
|
|
function VisitConstant(const Node: IConstantNode): IAstNode; override;
|
|
function VisitKeyword(const Node: IKeywordNode): IAstNode; override;
|
|
|
|
public
|
|
constructor Create(const RootLayout: IScopeLayout; const ALog: ICompilerLog);
|
|
destructor Destroy; override;
|
|
|
|
function Execute(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode;
|
|
|
|
class function CheckTypes(const RootNode: IAstNode; const Layout: IScopeLayout; 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>);
|
|
begin
|
|
inherited Create;
|
|
FParent := AParent;
|
|
FLayout := ALayout;
|
|
FUpvalueTypes := AUpvalueTypes;
|
|
|
|
if Assigned(FLayout) then
|
|
begin
|
|
SetLength(FSlotTypes, FLayout.SlotCount);
|
|
for var i := 0 to High(FSlotTypes) do
|
|
FSlotTypes[i] := TTypes.Unknown;
|
|
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;
|
|
begin
|
|
if L = nil then
|
|
exit(nil);
|
|
|
|
p := CreateContextChain(L.Parent);
|
|
Result := TTypeContext.Create(p, L, []);
|
|
end;
|
|
|
|
constructor TTypeChecker.Create(const RootLayout: IScopeLayout; const ALog: ICompilerLog);
|
|
begin
|
|
inherited Create;
|
|
FLog := ALog;
|
|
FCurrentContext := CreateContextChain(RootLayout);
|
|
if FCurrentContext = nil then
|
|
FCurrentContext := TTypeContext.Create(nil, nil, []);
|
|
end;
|
|
|
|
destructor TTypeChecker.Destroy;
|
|
begin
|
|
while Assigned(FCurrentContext) do
|
|
begin
|
|
var temp := FCurrentContext;
|
|
FCurrentContext := FCurrentContext.FParent;
|
|
temp.Free;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
class function TTypeChecker.CheckTypes(const RootNode: IAstNode; const Layout: IScopeLayout; const ALog: ICompilerLog): IAstNode;
|
|
begin
|
|
var checker := TTypeChecker.Create(Layout, ALog) as IAstTypeChecker;
|
|
Result := checker.Execute(RootNode, Layout);
|
|
end;
|
|
|
|
function TTypeChecker.Execute(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode;
|
|
begin
|
|
Result := Accept(RootNode);
|
|
if not Assigned(Result) then
|
|
Result := TAst.Block([], nil);
|
|
end;
|
|
|
|
function TTypeChecker.VisitConstant(const Node: IConstantNode): IAstNode;
|
|
begin
|
|
Result := Node;
|
|
end;
|
|
|
|
function TTypeChecker.VisitKeyword(const Node: IKeywordNode): IAstNode;
|
|
begin
|
|
Result := Node;
|
|
end;
|
|
|
|
function TTypeChecker.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
|
|
var
|
|
typ: IStaticType;
|
|
adr: TResolvedAddress;
|
|
identity: INamedIdentity;
|
|
begin
|
|
adr := Node.Address;
|
|
identity := Node.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: IRecurNode): IAstNode;
|
|
var
|
|
newArgs: TArray<IAstNode>;
|
|
i: Integer;
|
|
begin
|
|
SetLength(newArgs, Node.Arguments.Count);
|
|
for i := 0 to Node.Arguments.Count - 1 do
|
|
newArgs[i] := Accept(Node.Arguments[i]);
|
|
|
|
// Wrap in List
|
|
var argList := TArgumentList.Create(newArgs, Node.Arguments.Identity);
|
|
Result := TAst.Recur(Node.Identity, argList, TTypes.Void);
|
|
end;
|
|
|
|
function TTypeChecker.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
|
|
var
|
|
initType: IStaticType;
|
|
newInitializer, newIdent: IAstNode;
|
|
adr: TResolvedAddress;
|
|
lambdaNode: ILambdaExpressionNode;
|
|
placeholderType: IStaticType;
|
|
i: Integer;
|
|
identNode: IIdentifierNode;
|
|
identIdentity: INamedIdentity;
|
|
begin
|
|
identNode := Node.Target.AsIdentifier;
|
|
identIdentity := identNode.Identity.AsNamed;
|
|
adr := identNode.Address;
|
|
initType := TTypes.Unknown;
|
|
|
|
if adr.Kind = akUnresolved then
|
|
begin
|
|
if Assigned(Node.Initializer) then
|
|
Accept(Node.Initializer);
|
|
Result := Node;
|
|
Exit;
|
|
end;
|
|
|
|
placeholderType := nil;
|
|
if (Node.Initializer <> nil) and (Node.Initializer.Kind = akLambdaExpression) then
|
|
begin
|
|
lambdaNode := Node.Initializer.AsLambdaExpression;
|
|
var paramTypes: TArray<IStaticType>;
|
|
SetLength(paramTypes, lambdaNode.Parameters.Count);
|
|
for i := 0 to High(paramTypes) do
|
|
paramTypes[i] := TTypes.Unknown;
|
|
|
|
placeholderType := TTypes.CreateMethod(paramTypes, TTypes.Unknown);
|
|
FCurrentContext.SetType(adr.SlotIndex, placeholderType);
|
|
initType := placeholderType;
|
|
end;
|
|
|
|
if Assigned(Node.Initializer) then
|
|
newInitializer := Accept(Node.Initializer)
|
|
else
|
|
newInitializer := nil;
|
|
|
|
if Assigned(newInitializer) then
|
|
initType := newInitializer.AsTypedNode.StaticType
|
|
else if not Assigned(placeholderType) then
|
|
initType := TTypes.Unknown;
|
|
|
|
if initType.Kind <> stUnknown then
|
|
FCurrentContext.SetType(adr.SlotIndex, initType);
|
|
|
|
newIdent := TAst.Identifier(identIdentity, adr, initType);
|
|
|
|
Result := TAst.VarDecl(Node.Identity, newIdent, newInitializer, initType, Node.IsBoxed);
|
|
end;
|
|
|
|
function TTypeChecker.VisitAssignment(const Node: IAssignmentNode): IAstNode;
|
|
var
|
|
targetType, sourceType: IStaticType;
|
|
newIdent, newValue: IAstNode;
|
|
adr: TResolvedAddress;
|
|
lambdaNode: ILambdaExpressionNode;
|
|
placeholderType: IStaticType;
|
|
i: Integer;
|
|
identNode: IIdentifierNode;
|
|
identIdentity: INamedIdentity;
|
|
begin
|
|
identNode := Node.Target.AsIdentifier;
|
|
identIdentity := identNode.Identity.AsNamed;
|
|
|
|
newIdent := Accept(Node.Target);
|
|
targetType := newIdent.AsTypedNode.StaticType;
|
|
adr := identNode.Address;
|
|
|
|
if adr.Kind = akUnresolved then
|
|
begin
|
|
Accept(Node.Value);
|
|
Result := Node;
|
|
Exit;
|
|
end;
|
|
|
|
placeholderType := nil;
|
|
if (Node.Value <> nil) and (Node.Value.Kind = akLambdaExpression) then
|
|
begin
|
|
lambdaNode := Node.Value.AsLambdaExpression;
|
|
if (targetType.Kind <> stMethod) then
|
|
begin
|
|
var paramTypes: TArray<IStaticType>;
|
|
SetLength(paramTypes, lambdaNode.Parameters.Count);
|
|
for i := 0 to High(paramTypes) do
|
|
paramTypes[i] := TTypes.Unknown;
|
|
|
|
placeholderType := TTypes.CreateMethod(paramTypes, TTypes.Unknown);
|
|
FCurrentContext.SetType(adr.SlotIndex, placeholderType);
|
|
targetType := placeholderType;
|
|
end;
|
|
end;
|
|
|
|
newValue := Accept(Node.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) or Assigned(placeholderType)) and (sourceType.Kind <> stUnknown) then
|
|
begin
|
|
FCurrentContext.SetType(adr.SlotIndex, sourceType);
|
|
newIdent := TAst.Identifier(identIdentity, adr, sourceType);
|
|
targetType := sourceType;
|
|
end;
|
|
|
|
Result := TAst.Assign(Node.Identity, newIdent, newValue, targetType);
|
|
end;
|
|
|
|
function TTypeChecker.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
|
|
var
|
|
newParams: TArray<IIdentifierNode>;
|
|
newBody: IAstNode;
|
|
bodyType, methodType: IStaticType;
|
|
paramTypes: TArray<IStaticType>;
|
|
upvalueTypes: TArray<IStaticType>;
|
|
upvalueAddrs: TArray<TResolvedAddress>;
|
|
i: Integer;
|
|
finalDescriptor: IScopeDescriptor;
|
|
paramIdent: IIdentifierNode;
|
|
paramIdentity: INamedIdentity;
|
|
begin
|
|
upvalueAddrs := Node.Upvalues;
|
|
SetLength(upvalueTypes, Length(upvalueAddrs));
|
|
for i := 0 to High(upvalueAddrs) do
|
|
upvalueTypes[i] := FCurrentContext.LookupType(upvalueAddrs[i]);
|
|
|
|
FCurrentContext := TTypeContext.Create(FCurrentContext, Node.Layout, upvalueTypes);
|
|
try
|
|
SetLength(newParams, Node.Parameters.Count);
|
|
SetLength(paramTypes, Node.Parameters.Count);
|
|
|
|
for i := 0 to Node.Parameters.Count - 1 do
|
|
begin
|
|
paramIdent := Node.Parameters[i];
|
|
paramIdentity := paramIdent.Identity.AsNamed;
|
|
var paramAdr := paramIdent.Address;
|
|
|
|
paramTypes[i] := TTypes.Unknown;
|
|
|
|
if paramAdr.Kind <> akUnresolved then
|
|
FCurrentContext.SetType(paramAdr.SlotIndex, paramTypes[i]);
|
|
|
|
newParams[i] := TAst.Identifier(paramIdentity, paramAdr, paramTypes[i]);
|
|
end;
|
|
|
|
newBody := Accept(Node.Body);
|
|
bodyType := newBody.AsTypedNode.StaticType;
|
|
methodType := TTypes.CreateMethod(paramTypes, bodyType);
|
|
|
|
FCurrentContext.SetType(0, methodType);
|
|
finalDescriptor := TScope.CreateDescriptor(Node.Layout, FCurrentContext.Types);
|
|
finally
|
|
var temp := FCurrentContext;
|
|
FCurrentContext := FCurrentContext.FParent;
|
|
temp.Free;
|
|
end;
|
|
|
|
// Wrap in List
|
|
var paramList := TParameterList.Create(newParams, Node.Parameters.Identity);
|
|
|
|
Result :=
|
|
TAst.LambdaExpr(
|
|
Node.Identity,
|
|
paramList,
|
|
newBody,
|
|
Node.Layout,
|
|
finalDescriptor,
|
|
Node.Upvalues,
|
|
Node.HasNestedLambdas,
|
|
Node.IsPure,
|
|
methodType
|
|
);
|
|
end;
|
|
|
|
function TTypeChecker.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
|
|
var
|
|
calleeType, retType: IStaticType;
|
|
i, j: Integer;
|
|
newCallee: IAstNode;
|
|
newArgs: TArray<IAstNode>;
|
|
argTypes: TArray<IStaticType>;
|
|
hasUnknownArgs: Boolean;
|
|
bestSig: IMethodSignature;
|
|
sig: IMethodSignature;
|
|
match: Boolean;
|
|
argsStr: string;
|
|
begin
|
|
newCallee := Accept(Node.Callee);
|
|
SetLength(newArgs, Node.Arguments.Count);
|
|
SetLength(argTypes, Node.Arguments.Count);
|
|
|
|
hasUnknownArgs := False;
|
|
for i := 0 to Node.Arguments.Count - 1 do
|
|
begin
|
|
newArgs[i] := Accept(Node.Arguments[i]);
|
|
argTypes[i] := newArgs[i].AsTypedNode.StaticType;
|
|
if argTypes[i].Kind = stUnknown then
|
|
hasUnknownArgs := True;
|
|
end;
|
|
|
|
calleeType := newCallee.AsTypedNode.StaticType;
|
|
retType := TTypes.Unknown;
|
|
|
|
if calleeType.Kind = TStaticTypeKind.stMethod then
|
|
begin
|
|
if not hasUnknownArgs then
|
|
begin
|
|
bestSig := nil;
|
|
for sig in calleeType.Signatures do
|
|
begin
|
|
if Length(sig.ParamTypes) <> Length(argTypes) then
|
|
continue;
|
|
|
|
match := True;
|
|
for j := 0 to High(argTypes) do
|
|
begin
|
|
if not TTypeRules.CanAssign(sig.ParamTypes[j], argTypes[j]) then
|
|
begin
|
|
match := False;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
if match then
|
|
begin
|
|
bestSig := sig;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
if Assigned(bestSig) then
|
|
retType := bestSig.ReturnType
|
|
else
|
|
begin
|
|
if Assigned(FLog) then
|
|
begin
|
|
argsStr := '';
|
|
for i := 0 to High(argTypes) do
|
|
argsStr := argsStr + argTypes[i].ToString + ' ';
|
|
FLog.AddError(
|
|
Format('No matching signature for call with args (%s) found on method %s', [argsStr, calleeType.ToString]),
|
|
Node
|
|
);
|
|
end;
|
|
retType := TTypes.Unknown;
|
|
end;
|
|
end;
|
|
end
|
|
else if calleeType.Kind <> TStaticTypeKind.stUnknown then
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(Format('Cannot invoke type %s as a function.', [calleeType.ToString]), Node);
|
|
retType := TTypes.Unknown;
|
|
end;
|
|
|
|
// Wrap in List
|
|
var argList := TArgumentList.Create(newArgs, Node.Arguments.Identity);
|
|
|
|
Result := TAst.FunctionCall(Node.Identity, newCallee, argList, retType, Node.IsTailCall, nil, False);
|
|
end;
|
|
|
|
function TTypeChecker.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
|
|
var
|
|
blockType: IStaticType;
|
|
newExprs: TArray<IAstNode>;
|
|
i: Integer;
|
|
begin
|
|
SetLength(newExprs, Node.Expressions.Count);
|
|
for i := 0 to Node.Expressions.Count - 1 do
|
|
newExprs[i] := Accept(Node.Expressions[i]);
|
|
|
|
if Length(newExprs) > 0 then
|
|
blockType := newExprs[High(newExprs)].AsTypedNode.StaticType
|
|
else
|
|
blockType := TTypes.Void;
|
|
|
|
// Wrap in List
|
|
var exprList := TExpressionList.Create(newExprs, Node.Expressions.Identity);
|
|
Result := TAst.Block(Node.Identity, exprList, blockType);
|
|
end;
|
|
|
|
function TTypeChecker.VisitIfExpression(const Node: IIfExpressionNode): IAstNode;
|
|
var
|
|
conditionType, thenType, elseType, resultType: IStaticType;
|
|
newCond, newThen, newElse: IAstNode;
|
|
begin
|
|
newCond := Accept(Node.Condition);
|
|
newThen := Accept(Node.ThenBranch);
|
|
newElse := Accept(Node.ElseBranch);
|
|
|
|
conditionType := newCond.AsTypedNode.StaticType;
|
|
if (conditionType.Kind <> stUnknown)
|
|
and not TTypeRules.CanAssign(TTypes.Ordinal, conditionType)
|
|
and not TTypeRules.CanAssign(TTypes.Boolean, conditionType) then
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(Format('If condition must be Boolean or Ordinal, but got %s', [conditionType.ToString]), Node);
|
|
end;
|
|
|
|
thenType := newThen.AsTypedNode.StaticType;
|
|
elseType :=
|
|
if newElse <> nil then newElse.AsTypedNode.StaticType
|
|
else TTypes.Void;
|
|
|
|
resultType := TTypeRules.Promote(thenType, elseType);
|
|
if resultType = nil then
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(Format('Cannot promote types %s and %s in If-Expression', [thenType.ToString, elseType.ToString]), Node);
|
|
resultType := TTypes.Unknown;
|
|
end;
|
|
|
|
Result := TAst.IfExpr(Node.Identity, newCond, newThen, newElse, resultType);
|
|
end;
|
|
|
|
function TTypeChecker.VisitCondExpression(const Node: ICondExpressionNode): IAstNode;
|
|
var
|
|
i: Integer;
|
|
newPairs: TArray<TCondPair>;
|
|
newElse: IAstNode;
|
|
condType, branchType, resultType: IStaticType;
|
|
begin
|
|
SetLength(newPairs, Length(Node.Pairs));
|
|
resultType := nil; // Start with nothing
|
|
|
|
for i := 0 to High(Node.Pairs) do
|
|
begin
|
|
// 1. Visit Condition
|
|
var newCond := Accept(Node.Pairs[i].Condition);
|
|
condType := newCond.AsTypedNode.StaticType;
|
|
|
|
if (condType.Kind <> stUnknown)
|
|
and not TTypeRules.CanAssign(TTypes.Ordinal, condType)
|
|
and not TTypeRules.CanAssign(TTypes.Boolean, condType) then
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(Format('Cond condition must be Boolean or Ordinal, but got %s', [condType.ToString]), Node);
|
|
end;
|
|
|
|
// 2. Visit Branch
|
|
var newBranch := Accept(Node.Pairs[i].Branch);
|
|
branchType := newBranch.AsTypedNode.StaticType;
|
|
|
|
newPairs[i] := TCondPair.Create(newCond, newBranch);
|
|
|
|
// 3. Promote Result Type
|
|
if resultType = nil then
|
|
resultType := branchType
|
|
else
|
|
begin
|
|
var promoted := TTypeRules.Promote(resultType, branchType);
|
|
if promoted = nil then
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(
|
|
Format('Incompatible types in Cond branches: %s and %s', [resultType.ToString, branchType.ToString]),
|
|
Node
|
|
);
|
|
resultType := TTypes.Unknown;
|
|
end
|
|
else
|
|
resultType := promoted;
|
|
end;
|
|
end;
|
|
|
|
// 4. Visit Else
|
|
newElse := Accept(Node.ElseBranch);
|
|
// Else branch is mandatory in our new AST structure (can be Nop/Void, but is present)
|
|
var elseType := newElse.AsTypedNode.StaticType;
|
|
|
|
if resultType = nil then
|
|
resultType := elseType
|
|
else
|
|
begin
|
|
var promoted := TTypeRules.Promote(resultType, elseType);
|
|
if promoted = nil then
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(
|
|
Format('Incompatible types in Cond branches (Else): %s and %s', [resultType.ToString, elseType.ToString]),
|
|
Node
|
|
);
|
|
resultType := TTypes.Unknown;
|
|
end
|
|
else
|
|
resultType := promoted;
|
|
end;
|
|
|
|
Result := TAst.CondExpr(Node.Identity, newPairs, newElse, resultType);
|
|
end;
|
|
|
|
function TTypeChecker.VisitMemberAccess(const Node: IMemberAccessNode): IAstNode;
|
|
var
|
|
baseType, elemType: IStaticType;
|
|
fieldIndex: Integer;
|
|
newBase, newMember: IAstNode;
|
|
begin
|
|
newBase := Accept(Node.Base);
|
|
newMember := Accept(Node.Member);
|
|
|
|
baseType := newBase.AsTypedNode.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
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(Format('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]), Node);
|
|
end
|
|
else
|
|
begin
|
|
var fieldType := TTypes.FromScalarKind(baseType.Definition[fieldIndex].Value);
|
|
if baseType.Kind = TStaticTypeKind.stRecord then
|
|
elemType := fieldType
|
|
else
|
|
elemType := TTypes.CreateSeries(fieldType);
|
|
end;
|
|
end
|
|
else if (baseType.Kind = TStaticTypeKind.stGenericRecord) then
|
|
begin
|
|
var genDef := baseType.GenericDefinition;
|
|
fieldIndex := genDef.IndexOf(Node.Member.Value);
|
|
if fieldIndex < 0 then
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(Format('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]), Node);
|
|
end
|
|
else
|
|
elemType := genDef[fieldIndex].Value;
|
|
end
|
|
else
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(Format('Member access requires a record type, but got %s', [baseType.ToString]), Node);
|
|
end;
|
|
end;
|
|
|
|
Result := TAst.MemberAccess(Node.Identity, newBase, newMember.AsKeyword, elemType);
|
|
end;
|
|
|
|
function TTypeChecker.VisitIndexer(const Node: IIndexerNode): IAstNode;
|
|
var
|
|
baseType, indexType, elemType: IStaticType;
|
|
newBase, newIndex: IAstNode;
|
|
begin
|
|
newBase := Accept(Node.Base);
|
|
newIndex := Accept(Node.Index);
|
|
|
|
baseType := newBase.AsTypedNode.StaticType;
|
|
indexType := newIndex.AsTypedNode.StaticType;
|
|
elemType := TTypes.Unknown;
|
|
|
|
if (baseType.Kind <> TStaticTypeKind.stUnknown) then
|
|
begin
|
|
if (baseType.Kind <> TStaticTypeKind.stSeries) and (baseType.Kind <> TStaticTypeKind.stRecordSeries) then
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(Format('Indexer `[]` can only be applied to series types, but got %s', [baseType.ToString]), Node);
|
|
end
|
|
else
|
|
begin
|
|
if baseType.Kind = TStaticTypeKind.stSeries then
|
|
elemType := baseType.ElementType
|
|
else
|
|
elemType := TTypes.CreateRecord(baseType.Definition);
|
|
end;
|
|
end;
|
|
|
|
if (indexType.Kind <> stUnknown) and not TTypeRules.CanAssign(TTypes.Ordinal, indexType) then
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(Format('Indexer `[]` requires an Ordinal index, but got %s', [indexType.ToString]), Node);
|
|
end;
|
|
|
|
Result := TAst.Indexer(Node.Identity, newBase, newIndex, elemType);
|
|
end;
|
|
|
|
function TTypeChecker.VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode;
|
|
var
|
|
i: Integer;
|
|
scalarDefFields: TArray<TScalarRecordField>;
|
|
def: IScalarRecordDefinition;
|
|
staticType: IStaticType;
|
|
valType: IStaticType;
|
|
scalarKind: TScalar.TKind;
|
|
allScalar: Boolean;
|
|
newFields: TArray<IRecordFieldNode>;
|
|
begin
|
|
SetLength(newFields, Node.Fields.Count);
|
|
for i := 0 to Node.Fields.Count - 1 do
|
|
begin
|
|
var field := Node.Fields[i];
|
|
var newKey := Accept(field.Key).AsKeyword;
|
|
var newValue := Accept(field.Value);
|
|
|
|
if (newKey = field.Key) and (newValue = field.Value) then
|
|
newFields[i] := field
|
|
else
|
|
newFields[i] := TAst.RecordField(field.Identity, newKey, newValue);
|
|
end;
|
|
|
|
SetLength(scalarDefFields, Length(newFields));
|
|
allScalar := True;
|
|
|
|
for i := 0 to High(newFields) do
|
|
begin
|
|
valType := newFields[i].Value.AsTypedNode.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 if (valType.Kind = stBoolean) then
|
|
scalarKind := TScalar.TKind.Boolean
|
|
else if (valType.Kind = stDateTime) then
|
|
scalarKind := TScalar.TKind.DateTime
|
|
else
|
|
begin
|
|
allScalar := False;
|
|
scalarKind := TScalar.TKind.Ordinal;
|
|
end;
|
|
|
|
if allScalar then
|
|
scalarDefFields[i] := TScalarRecordField.Create(newFields[i].Key.Value, scalarKind);
|
|
end;
|
|
|
|
// Wrap in List
|
|
var fieldList := TRecordFieldList.Create(newFields, Node.Fields.Identity);
|
|
|
|
if allScalar then
|
|
begin
|
|
def := TScalarRecordRegistry.Intern(scalarDefFields);
|
|
staticType := TTypes.CreateRecord(def);
|
|
Result := TAst.RecordLiteral(Node.Identity, fieldList, def, nil, staticType);
|
|
end
|
|
else
|
|
begin
|
|
var genDefFields: TArray<TPair<IKeyword, IStaticType>>;
|
|
SetLength(genDefFields, Length(newFields));
|
|
for i := 0 to High(newFields) do
|
|
genDefFields[i] := TPair<IKeyword, IStaticType>.Create(newFields[i].Key.Value, newFields[i].Value.AsTypedNode.StaticType);
|
|
|
|
var genDef := TGenericRecordRegistry.Intern(genDefFields);
|
|
staticType := TTypes.CreateGenericRecord(genDef);
|
|
Result := TAst.RecordLiteral(Node.Identity, fieldList, nil, genDef, staticType);
|
|
end;
|
|
end;
|
|
|
|
function TTypeChecker.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode;
|
|
var
|
|
elemType: IStaticType;
|
|
defIdentity: IDefinitionIdentity;
|
|
begin
|
|
try
|
|
defIdentity := Node.Identity.AsDefinition;
|
|
elemType := TTypes.FromScalarKind(TScalar.StringToKind(defIdentity.Definition));
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(Format('Invalid type definition "%s" in new-series: %s', [Node.Definition, E.Message]), Node);
|
|
elemType := TTypes.Unknown;
|
|
end;
|
|
end;
|
|
|
|
Result := TAst.CreateSeries(defIdentity, TTypes.CreateSeries(elemType));
|
|
end;
|
|
|
|
function TTypeChecker.VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode;
|
|
var
|
|
seriesType, valueType: IStaticType;
|
|
newSeries, newValue, newLookback: IAstNode;
|
|
begin
|
|
newSeries := Accept(Node.Series);
|
|
newValue := Accept(Node.Value);
|
|
newLookback := Accept(Node.Lookback);
|
|
|
|
seriesType := newSeries.AsTypedNode.StaticType;
|
|
valueType := newValue.AsTypedNode.StaticType;
|
|
|
|
if (seriesType.Kind <> stUnknown) then
|
|
begin
|
|
if (seriesType.Kind <> TStaticTypeKind.stSeries) then
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(Format('"add" requires a series as its first argument, but got %s', [seriesType.ToString]), Node);
|
|
end
|
|
else
|
|
begin
|
|
if (valueType.Kind <> stUnknown) and not TTypeRules.CanAssign(seriesType.ElementType, valueType) then
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(
|
|
Format('Cannot add item of type %s to series of type %s', [valueType.ToString, seriesType.ElementType.ToString]),
|
|
Node
|
|
);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if (newLookback <> nil) then
|
|
begin
|
|
var lookbackType := newLookback.AsTypedNode.StaticType;
|
|
if (lookbackType.Kind <> stUnknown) and not (lookbackType.Kind = TStaticTypeKind.stOrdinal) then
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError('Lookback parameter for "add" must be an ordinal value.', Node);
|
|
end;
|
|
end;
|
|
|
|
Result := TAst.AddSeriesItem(Node.Identity, newSeries.AsIdentifier, newValue, newLookback, TTypes.Void);
|
|
end;
|
|
|
|
function TTypeChecker.VisitNop(const Node: INopNode): IAstNode;
|
|
begin
|
|
Result := TAst.Nop(Node.Identity, TTypes.Void);
|
|
end;
|
|
|
|
function TTypeChecker.VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode;
|
|
var
|
|
seriesType: IStaticType;
|
|
newSeries: IAstNode;
|
|
begin
|
|
newSeries := Accept(Node.Series);
|
|
seriesType := newSeries.AsTypedNode.StaticType;
|
|
|
|
if (seriesType.Kind <> stUnknown)
|
|
and (seriesType.Kind <> TStaticTypeKind.stSeries)
|
|
and (seriesType.Kind <> TStaticTypeKind.stRecordSeries) then
|
|
begin
|
|
if Assigned(FLog) then
|
|
FLog.AddError(Format('"length" requires a series, but got %s', [seriesType.ToString]), Node);
|
|
end;
|
|
|
|
Result := TAst.SeriesLength(Node.Identity, newSeries.AsIdentifier, TTypes.Ordinal);
|
|
end;
|
|
|
|
end.
|