Unit compiler namespaces
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,633 @@
|
||||
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;
|
||||
|
||||
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 *replaces* all IAstTypedNodes with new nodes containing the correct type.
|
||||
TTypeChecker = class(TAstTransformer, IAstTypeChecker)
|
||||
private
|
||||
FCurrentDescriptor: IScopeDescriptor;
|
||||
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 now set here)
|
||||
function VisitConstant(const Node: IConstantNode): IAstNode; override;
|
||||
function VisitKeyword(const Node: IKeywordNode): 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([]);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitConstant(const Node: IConstantNode): IAstNode;
|
||||
begin
|
||||
// This is a leaf node.
|
||||
// If the constructor couldn't set the type, nobody can
|
||||
Assert(Node.StaticType.Kind <> stUnknown);
|
||||
Result := Node;
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitKeyword(const Node: IKeywordNode): IAstNode;
|
||||
begin
|
||||
// This is a leaf node.
|
||||
// The TKeywordNode constructor *forces* the type to be TTypes.Keyword.
|
||||
Assert(Node.StaticType.Kind = stKeyword);
|
||||
Result := Node;
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
|
||||
var
|
||||
symbol: TResolvedSymbol;
|
||||
adr: TResolvedAddress;
|
||||
begin
|
||||
// This is a leaf node (guaranteed to be IBoundIdentifierNode by Binder)
|
||||
|
||||
// Get the type from the descriptor (which was populated by Binder/RTL)
|
||||
symbol := FCurrentDescriptor.FindSymbol(Node.Name);
|
||||
adr := Node.Address;
|
||||
|
||||
// Create a new node, copying the address and assigning the inferred type
|
||||
Result := TAst.Identifier(Node.Name, adr, symbol.StaticType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitRecurNode(const Node: IRecurNode): IAstNode;
|
||||
var
|
||||
newArgs: TArray<IAstNode>;
|
||||
i: Integer;
|
||||
begin
|
||||
// 1. Visit children
|
||||
SetLength(newArgs, Length(Node.Arguments));
|
||||
for i := 0 to High(Node.Arguments) do
|
||||
newArgs[i] := Accept(Node.Arguments[i]);
|
||||
|
||||
// 2. Create new node with inferred type
|
||||
Result := TAst.Recur(newArgs, TTypes.Void);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
|
||||
var
|
||||
initType: IStaticType;
|
||||
newInitializer, newIdent: IAstNode;
|
||||
adr: TResolvedAddress;
|
||||
begin
|
||||
// 1. Visit Initializer first (if it exists)
|
||||
if Assigned(Node.Initializer) then
|
||||
newInitializer := Accept(Node.Initializer)
|
||||
else
|
||||
newInitializer := nil;
|
||||
|
||||
// 2. Get initializer type
|
||||
if Assigned(newInitializer) then
|
||||
initType := newInitializer.AsTypedNode.StaticType
|
||||
else
|
||||
initType := TTypes.Unknown; // (def fib)
|
||||
|
||||
// 3. Get the address from the bound identifier
|
||||
adr := Node.Identifier.Address;
|
||||
|
||||
// 4. Update the type in the scope descriptor (which was set to Unknown by the binder).
|
||||
if initType.Kind <> stUnknown then
|
||||
FCurrentDescriptor.UpdateType(adr.SlotIndex, initType);
|
||||
|
||||
// 5. Create the new (typed) identifier node
|
||||
newIdent := TAst.Identifier(Node.Identifier.Name, adr, initType);
|
||||
|
||||
// 6. Create the new VariableDeclaration node using the factory
|
||||
Result :=
|
||||
TAst.VarDecl(
|
||||
newIdent.AsIdentifier,
|
||||
newInitializer,
|
||||
initType,
|
||||
Node.IsBoxed // 7. Copy runtime flags (IsBoxed) via interface
|
||||
);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitAssignment(const Node: IAssignmentNode): IAstNode;
|
||||
var
|
||||
targetType, sourceType: IStaticType;
|
||||
newIdent, newValue: IAstNode;
|
||||
adr: TResolvedAddress;
|
||||
begin
|
||||
// 1. Visit children first (Identifier, Value)
|
||||
newValue := Accept(Node.Value);
|
||||
newIdent := Accept(Node.Identifier);
|
||||
|
||||
// 2. Get types
|
||||
targetType := newIdent.AsTypedNode.StaticType;
|
||||
sourceType := newValue.AsTypedNode.StaticType;
|
||||
|
||||
// 3. Check assignment
|
||||
if not TTypeRules.CanAssign(targetType, sourceType) then
|
||||
raise ETypeException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]);
|
||||
|
||||
// 4. If the target was 'Unknown' (from 'def'), update the descriptor
|
||||
// with the new, inferred type. This enables recursion.
|
||||
if (targetType.Kind = stUnknown) and (sourceType.Kind <> stUnknown) then
|
||||
begin
|
||||
adr := newIdent.AsIdentifier.Address;
|
||||
FCurrentDescriptor.UpdateType(adr.SlotIndex, sourceType);
|
||||
|
||||
// Re-create the identifier node *with the new type*
|
||||
newIdent := TAst.Identifier(newIdent.AsIdentifier.Name, adr, sourceType);
|
||||
targetType := sourceType;
|
||||
end;
|
||||
|
||||
// 5. Create the new Assignment node
|
||||
Result := TAst.Assign(newIdent.AsIdentifier, newValue, targetType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
|
||||
var
|
||||
newParams: TArray<IIdentifierNode>;
|
||||
newBody: IAstNode;
|
||||
bodyType, methodType: IStaticType;
|
||||
paramTypes: TArray<IStaticType>;
|
||||
i: Integer;
|
||||
savedDescriptor: IScopeDescriptor;
|
||||
begin
|
||||
// 1. Enter the lambda's scope (which Binder already created)
|
||||
savedDescriptor := FCurrentDescriptor;
|
||||
FCurrentDescriptor := Node.ScopeDescriptor;
|
||||
try
|
||||
// 2. Visit parameters (they are already bound, just need typing)
|
||||
SetLength(newParams, Length(Node.Parameters));
|
||||
SetLength(paramTypes, Length(Node.Parameters));
|
||||
|
||||
for i := 0 to High(Node.Parameters) do
|
||||
begin
|
||||
// Parameters are leaves, but we must *replace* them with typed versions
|
||||
// (even if they are just TTypes.Unknown for now, for type inference placeholders)
|
||||
var paramIdent := Node.Parameters[i];
|
||||
var paramAdr := paramIdent.Address;
|
||||
var newParam := TAst.Identifier(paramIdent.Name, paramAdr);
|
||||
|
||||
newParams[i] := newParam;
|
||||
paramTypes[i] := TTypes.Unknown;
|
||||
end;
|
||||
|
||||
// 3. Visit the body to infer its return type
|
||||
newBody := Accept(Node.Body);
|
||||
bodyType := newBody.AsTypedNode.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 := savedDescriptor;
|
||||
end;
|
||||
|
||||
// 7. Create the new (typed) lambda node using the factory
|
||||
Result := TAst.LambdaExpr(newParams, newBody, Node.ScopeDescriptor, Node.Upvalues, Node.HasNestedLambdas, methodType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
|
||||
var
|
||||
calleeType, retType: IStaticType;
|
||||
i: Integer;
|
||||
newCallee: IAstNode;
|
||||
newArgs: TArray<IAstNode>;
|
||||
begin
|
||||
// 1. Visit children first (bottom-up)
|
||||
newCallee := Accept(Node.Callee);
|
||||
SetLength(newArgs, Length(Node.Arguments));
|
||||
for i := 0 to High(Node.Arguments) do
|
||||
newArgs[i] := Accept(Node.Arguments[i]);
|
||||
|
||||
// 2. Get callee type (now inferred)
|
||||
calleeType := newCallee.AsTypedNode.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(newArgs) <> Length(signature.ParamTypes) then
|
||||
raise ETypeException.CreateFmt('Function expects %d arguments, but got %d', [Length(signature.ParamTypes), Length(newArgs)]);
|
||||
|
||||
retType := signature.ReturnType;
|
||||
|
||||
// Check argument types
|
||||
for i := 0 to High(newArgs) do
|
||||
begin
|
||||
var argType := newArgs[i].AsTypedNode.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. Create the new (typed) call node using the factory
|
||||
Result :=
|
||||
TAst.FunctionCall(
|
||||
newCallee,
|
||||
newArgs,
|
||||
retType,
|
||||
Node.IsTailCall // 5. Copy runtime properties
|
||||
);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
|
||||
var
|
||||
blockType: IStaticType;
|
||||
newExprs: TArray<IAstNode>;
|
||||
i: Integer;
|
||||
begin
|
||||
// 1. Visit children
|
||||
SetLength(newExprs, Length(Node.Expressions));
|
||||
for i := 0 to High(Node.Expressions) do
|
||||
newExprs[i] := Accept(Node.Expressions[i]);
|
||||
|
||||
// 2. Type is type of last expression
|
||||
if Length(newExprs) > 0 then
|
||||
blockType := newExprs[High(newExprs)].AsTypedNode.StaticType
|
||||
else
|
||||
blockType := TTypes.Void;
|
||||
|
||||
// 3. Create new node
|
||||
Result := TAst.Block(newExprs, blockType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitIfExpression(const Node: IIfExpressionNode): IAstNode;
|
||||
var
|
||||
conditionType, thenType, elseType, resultType: IStaticType;
|
||||
newCond, newThen, newElse: IAstNode;
|
||||
begin
|
||||
// 1. Visit children
|
||||
newCond := Accept(Node.Condition);
|
||||
newThen := Accept(Node.ThenBranch);
|
||||
newElse := Accept(Node.ElseBranch); // Accept handles nil
|
||||
|
||||
// 2. Check condition
|
||||
conditionType := newCond.AsTypedNode.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 := newThen.AsTypedNode.StaticType;
|
||||
elseType :=
|
||||
if newElse <> nil then newElse.AsTypedNode.StaticType
|
||||
else TTypes.Void;
|
||||
|
||||
resultType := TTypeRules.Promote(thenType, elseType);
|
||||
|
||||
// 4. Create new node
|
||||
Result := TAst.IfExpr(newCond, newThen, newElse, resultType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode;
|
||||
var
|
||||
conditionType, thenType, elseType, resultType: IStaticType;
|
||||
newCond, newThen, newElse: IAstNode;
|
||||
begin
|
||||
// 1. Visit children
|
||||
newCond := Accept(Node.Condition);
|
||||
newThen := Accept(Node.ThenBranch);
|
||||
newElse := Accept(Node.ElseBranch);
|
||||
|
||||
// 2. Check condition
|
||||
conditionType := newCond.AsTypedNode.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 := newThen.AsTypedNode.StaticType;
|
||||
elseType := newElse.AsTypedNode.StaticType;
|
||||
|
||||
resultType := TTypeRules.Promote(thenType, elseType);
|
||||
|
||||
// 4. Create new node
|
||||
Result := TAst.TernaryExpr(newCond, newThen, newElse, resultType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode;
|
||||
var
|
||||
leftType, rightType, resultType: IStaticType;
|
||||
newLeft, newRight: IAstNode;
|
||||
begin
|
||||
// 1. Visit children
|
||||
newLeft := Accept(Node.Left);
|
||||
newRight := Accept(Node.Right);
|
||||
|
||||
// 2. Get types
|
||||
leftType := newLeft.AsTypedNode.StaticType;
|
||||
rightType := newRight.AsTypedNode.StaticType;
|
||||
|
||||
// 3. Resolve
|
||||
resultType := TTypeRules.ResolveBinaryOp(Node.Operator, leftType, rightType);
|
||||
|
||||
// 4. Create new node
|
||||
Result := TAst.BinaryExpr(newLeft, Node.Operator, newRight, resultType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode;
|
||||
var
|
||||
rightType, resultType: IStaticType;
|
||||
newRight: IAstNode;
|
||||
begin
|
||||
// 1. Visit children
|
||||
newRight := Accept(Node.Right);
|
||||
|
||||
// 2. Get types
|
||||
rightType := newRight.AsTypedNode.StaticType;
|
||||
|
||||
// 3. Resolve
|
||||
resultType := TTypeRules.ResolveUnaryOp(Node.Operator, rightType);
|
||||
|
||||
// 4. Create new node
|
||||
Result := TAst.UnaryExpr(Node.Operator, newRight, resultType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitMemberAccess(const Node: IMemberAccessNode): IAstNode;
|
||||
var
|
||||
baseType, elemType: IStaticType;
|
||||
fieldIndex: Integer;
|
||||
newBase, newMember: IAstNode;
|
||||
begin
|
||||
// 1. Visit children
|
||||
newBase := Accept(Node.Base);
|
||||
newMember := Accept(Node.Member); // Visits the TKeywordNode
|
||||
|
||||
// 2. Get types
|
||||
baseType := newBase.AsTypedNode.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;
|
||||
|
||||
// 4. Create new node
|
||||
Result := TAst.MemberAccess(newBase, newMember.AsKeyword, elemType);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitIndexer(const Node: IIndexerNode): IAstNode;
|
||||
var
|
||||
baseType, indexType, elemType: IStaticType;
|
||||
newBase, newIndex: IAstNode;
|
||||
begin
|
||||
// 1. Visit children
|
||||
newBase := Accept(Node.Base);
|
||||
newIndex := Accept(Node.Index);
|
||||
|
||||
// 2. Get types
|
||||
baseType := newBase.AsTypedNode.StaticType;
|
||||
indexType := newIndex.AsTypedNode.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;
|
||||
|
||||
// 4. Create new node
|
||||
Result := TAst.Indexer(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<TRecordFieldLiteral>;
|
||||
begin
|
||||
// 1. Visit all child nodes first to infer their types
|
||||
SetLength(newFields, Length(Node.Fields));
|
||||
for i := 0 to High(Node.Fields) do
|
||||
begin
|
||||
newFields[i].Key := Accept(Node.Fields[i].Key).AsKeyword;
|
||||
newFields[i].Value := Accept(Node.Fields[i].Value);
|
||||
end;
|
||||
|
||||
SetLength(scalarDefFields, Length(newFields));
|
||||
allScalar := True;
|
||||
|
||||
// 2. Check if this record literal can be a TScalarRecord
|
||||
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
|
||||
begin
|
||||
allScalar := False;
|
||||
scalarKind := TScalar.TKind.Ordinal; // Dummy
|
||||
end;
|
||||
|
||||
if allScalar then
|
||||
scalarDefFields[i] := TScalarRecordField.Create(newFields[i].Key.Value, scalarKind);
|
||||
end;
|
||||
|
||||
// 3. Create the new node and set its type/definitions
|
||||
if allScalar then
|
||||
begin
|
||||
def := TScalarRecordRegistry.Intern(scalarDefFields);
|
||||
staticType := TTypes.CreateRecord(def);
|
||||
Result := TAst.RecordLiteral(newFields, 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(newFields, nil, genDef, staticType);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode;
|
||||
var
|
||||
elemType: IStaticType;
|
||||
begin
|
||||
// This is a leaf node
|
||||
|
||||
// Assign the type
|
||||
try
|
||||
elemType := TTypes.FromScalarKind(TScalar.StringToKind(Node.Definition));
|
||||
except
|
||||
on E: Exception do
|
||||
elemType := TTypes.Unknown;
|
||||
end;
|
||||
|
||||
// Create new node
|
||||
Result := TAst.CreateSeries(Node.Definition, TTypes.CreateSeries(elemType));
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode;
|
||||
var
|
||||
seriesType, valueType: IStaticType;
|
||||
newSeries, newValue, newLookback: IAstNode;
|
||||
begin
|
||||
// 1. Visit children
|
||||
newSeries := Accept(Node.Series);
|
||||
newValue := Accept(Node.Value);
|
||||
newLookback := Accept(Node.Lookback); // Handles nil
|
||||
|
||||
// 2. Get types
|
||||
seriesType := newSeries.AsTypedNode.StaticType;
|
||||
valueType := newValue.AsTypedNode.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 (newLookback <> nil) then
|
||||
begin
|
||||
var lookbackType := newLookback.AsTypedNode.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;
|
||||
|
||||
// 4. Create new node
|
||||
Result := TAst.AddSeriesItem(newSeries.AsIdentifier, newValue, newLookback, TTypes.Void);
|
||||
end;
|
||||
|
||||
function TTypeChecker.VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode;
|
||||
var
|
||||
seriesType: IStaticType;
|
||||
newSeries: IAstNode;
|
||||
begin
|
||||
// 1. Visit children
|
||||
newSeries := Accept(Node.Series);
|
||||
|
||||
// 2. Get type
|
||||
seriesType := newSeries.AsTypedNode.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]);
|
||||
|
||||
// 4. Create new node
|
||||
Result := TAst.SeriesLength(newSeries.AsIdentifier, TTypes.Ordinal);
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user