AST Types

This commit is contained in:
Michael Schimmel
2025-10-26 09:58:42 +01:00
parent 85f2e02893
commit e379e6694c
7 changed files with 523 additions and 91 deletions
+14 -9
View File
@@ -33,6 +33,9 @@ type
implementation
uses
Myc.Ast.Types; // Added for TTypes.Unknown
{ TUpvalueAnalyzer }
constructor TUpvalueAnalyzer.Create(const AParent: IScopeDescriptor);
@@ -71,17 +74,17 @@ end;
procedure TUpvalueAnalyzer.MarkDeclarationForBoxing(const AName: string);
var
address: TResolvedAddress;
symbol: TResolvedSymbol;
declarationScope: IScopeDescriptor;
i: Integer;
begin
address := FCurrentScope.FindSymbol(AName);
if address.Kind <> akLocalOrParent then
symbol := FCurrentScope.FindSymbol(AName);
if symbol.Address.Kind <> akLocalOrParent then
exit;
// Walk up the scope chain to find the scope where the variable was declared.
declarationScope := FCurrentScope;
for i := 1 to address.ScopeDepth do
for i := 1 to symbol.Address.ScopeDepth do
begin
if not Assigned(declarationScope.Parent) then
exit; // Should not happen in a correctly bound tree
@@ -100,13 +103,13 @@ end;
function TUpvalueAnalyzer.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
var
address: TResolvedAddress;
symbol: TResolvedSymbol;
begin
if Assigned(FCurrentScope) then
begin
address := FCurrentScope.FindSymbol(Node.Name);
symbol := FCurrentScope.FindSymbol(Node.Name);
if (address.Kind = akLocalOrParent) and (address.ScopeDepth > 0) then
if (symbol.Address.Kind = akLocalOrParent) and (symbol.Address.ScopeDepth > 0) then
begin
// This is an upvalue. Mark its original declaration for boxing.
MarkDeclarationForBoxing(Node.Name);
@@ -123,8 +126,9 @@ begin
FCurrentScope := TScope.CreateDescriptor(FCurrentScope);
try
// Define the lambda's parameters within its new scope.
// We use TTypes.Unknown as type inference hasn't run yet.
for var param in Node.Parameters do
FCurrentScope.Define(param.Name);
FCurrentScope.Define(param.Name, TTypes.Unknown);
// Traverse the lambda body within the new scope context.
Node.Body.Accept(Self);
@@ -147,7 +151,8 @@ begin
Node.Initializer.Accept(Self);
// After processing the initializer, define the variable in the current scope.
FCurrentScope.Define(Node.Identifier.Name);
// We use TTypes.Unknown as type inference hasn't run yet.
FCurrentScope.Define(Node.Identifier.Name, TTypes.Unknown);
// Map this declaration node to its scope and name for later lookup.
if not FDeclarationMap.TryGetValue(FCurrentScope, scopeDeclarations) then
+355 -41
View File
@@ -12,6 +12,7 @@ uses
Myc.Ast.Visitor,
Myc.Ast.Scope,
Myc.Ast.Analyzer,
Myc.Ast.Types, // Added
Myc.Ast;
type
@@ -64,6 +65,9 @@ type
procedure EnterScope;
procedure ExitScope;
function IsValidIdentifier(const Name: string): Boolean;
// Helper to set and return the static type of a node
function SetType(const Node: IAstNode; const AType: IStaticType): IAstNode; overload;
function SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue; overload;
protected
function Accept(const Node: IAstNode): TDataValue; override;
@@ -80,6 +84,13 @@ type
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
// Added for type inference
function VisitConstant(const Node: IConstantNode): TDataValue; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
public
constructor Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
@@ -216,16 +227,18 @@ function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): TDataValue;
var
value: TDataValue;
expr: IAstNode;
addr: TResolvedAddress;
symbol: TResolvedSymbol;
begin
expr := Node.Expression;
if (expr is TIdentifierNode) then
begin
addr := FMacroScope.CreateDescriptor.FindSymbol((expr as TIdentifierNode).Name);
if (addr.Kind = akLocalOrParent) and (addr.ScopeDepth = 0) then
// Use new FindSymbol
symbol := FMacroScope.CreateDescriptor.FindSymbol((expr as TIdentifierNode).Name);
if (symbol.Address.Kind = akLocalOrParent) and (symbol.Address.ScopeDepth = 0) then
begin
var argValue := FMacroScope.Values[addr];
// Use symbol.Address
var argValue := FMacroScope.Values[symbol.Address];
if argValue.Kind = vkInterface then
begin
Result := argValue;
@@ -374,6 +387,19 @@ begin
inherited;
end;
function TAstBinder.SetType(const Node: IAstNode; const AType: IStaticType): IAstNode;
begin
(Node as TAstNode).StaticType := AType;
Result := Node;
end;
function TAstBinder.SetType(const NodeData: TDataValue; const AType: IStaticType): TDataValue;
begin
if (not NodeData.IsVoid) and (NodeData.Kind = vkInterface) then
(NodeData.AsIntf<IAstNode> as TAstNode).StaticType := AType;
Result := NodeData;
end;
function TAstBinder.Accept(const Node: IAstNode): TDataValue;
begin
if (not Assigned(Node)) or Done then
@@ -404,6 +430,8 @@ begin
end;
function TAstBinder.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
var
rootType: IStaticType;
begin
FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode, FCurrentDescriptor.Parent);
try
@@ -411,9 +439,18 @@ begin
try
var transformedValue := Accept(RootNode);
if transformedValue.IsVoid then
Result := TAst.Block([])
begin
Result := TAst.Block([]);
rootType := TTypes.Void;
end
else
begin
Result := transformedValue.AsIntf<IAstNode>;
rootType := (Result as TAstNode).StaticType;
end;
// Set the type for the root node (which is often a block)
(Result as TAstNode).StaticType := rootType;
Descriptor := FCurrentDescriptor;
finally
ExitScope;
@@ -427,6 +464,8 @@ function TAstBinder.VisitMacroDefinition(const Node: IMacroDefinitionNode): TDat
begin
FCurrentDescriptor.DefineMacro(Node.Name.Name, Node);
Result := TDataValue.Void;
// Macros have no type at runtime
(Node as TAstNode).StaticType := TTypes.Void;
end;
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
@@ -435,6 +474,13 @@ var
binaryOp: TScalar.TBinaryOp;
unaryOp: TScalar.TUnaryOp;
macroDef: IMacroDefinitionNode;
left, right: IAstNode;
leftType, rightType, resultType: IStaticType;
boundCall: TBoundFunctionCallNode;
callee: IAstNode;
calleeType: IStaticType;
args: TArray<IAstNode>;
i: Integer;
begin
if (Node.Callee is TIdentifierNode) then
begin
@@ -448,9 +494,14 @@ begin
if FBinaryOperators.TryGetValue(calleeIdentifier.Name, binaryOp) then
begin
FNextIsTail := False;
var left := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
var right := Accept(Node.Arguments[1]).AsIntf<IAstNode>;
Result := TDataValue.FromIntf<IAstNode>(TAst.BinaryExpr(left, binaryOp, right));
left := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
right := Accept(Node.Arguments[1]).AsIntf<IAstNode>;
leftType := (left as TAstNode).StaticType;
rightType := (right as TAstNode).StaticType;
resultType := TTypeRules.ResolveBinaryOp(binaryOp, leftType, rightType);
var binExpr := TAst.BinaryExpr(left, binaryOp, right);
(binExpr as TAstNode).StaticType := resultType;
Result := TDataValue.FromIntf<IAstNode>(binExpr);
exit;
end;
end;
@@ -461,8 +512,12 @@ begin
if FUnaryOperators.TryGetValue(calleeIdentifier.Name, unaryOp) then
begin
FNextIsTail := False;
var right := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
Result := TDataValue.FromIntf<IAstNode>(TAst.UnaryExpr(unaryOp, right));
right := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
rightType := (right as TAstNode).StaticType;
resultType := TTypeRules.ResolveUnaryOp(unaryOp, rightType);
var unExpr := TAst.UnaryExpr(unaryOp, right);
(unExpr as TAstNode).StaticType := resultType;
Result := TDataValue.FromIntf<IAstNode>(unExpr);
exit;
end;
@@ -470,8 +525,12 @@ begin
if (calleeIdentifier.Name = '-') then
begin
FNextIsTail := False;
var right := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
Result := TDataValue.FromIntf<IAstNode>(TAst.UnaryExpr(TScalar.TUnaryOp.Negate, right));
right := Accept(Node.Arguments[0]).AsIntf<IAstNode>;
rightType := (right as TAstNode).StaticType;
resultType := TTypeRules.ResolveUnaryOp(TScalar.TUnaryOp.Negate, rightType);
var unExpr := TAst.UnaryExpr(TScalar.TUnaryOp.Negate, right);
(unExpr as TAstNode).StaticType := resultType;
Result := TDataValue.FromIntf<IAstNode>(unExpr);
exit;
end;
end;
@@ -488,7 +547,7 @@ begin
'Macro %s expects %d arguments, but got %d',
[calleeIdentifier.Name, Length(params), Length(Node.Arguments)]);
for var i := 0 to High(params) do
for i := 0 to High(params) do
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
// expand
@@ -514,6 +573,8 @@ begin
// wrap in new expansion node
var macroNode := TMacroExpansionNode.Create(Node, boundExpandedBody) as IMacroExpansionNode;
// The type of the macro node is the type of its expanded body
(macroNode as TAstNode).StaticType := (boundExpandedBody as TAstNode).StaticType;
// done
exit(TDataValue.FromIntf<IMacroExpansionNode>(macroNode));
@@ -523,10 +584,30 @@ begin
// --- Default: Bind as a standard function call ---
var isTailCall := FIsTailStack.Peek;
FNextIsTail := False;
var callee := Accept(Node.Callee).AsIntf<IAstNode>;
var args := TransformNodes<IAstNode>(Node.Arguments);
var boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
Result := TDataValue.FromIntf<IFunctionCallNode>(boundCall);
callee := Accept(Node.Callee).AsIntf<IAstNode>;
args := TransformNodes<IAstNode>(Node.Arguments);
var retType: IStaticType := TTypes.Unknown;
calleeType := (callee as TAstNode).StaticType;
if calleeType.Kind = TStaticTypeKind.stMethod then
begin
var signature := calleeType.Signature;
if Length(args) <> Length(signature.ParamTypes) then
raise ETypeException.CreateFmt('Function expects %d arguments, but got %d', [Length(signature.ParamTypes), Length(args)]);
retType := signature.ReturnType;
end;
// Check argument types (param types are not yet inferred, so skip check for now)
// for i := 0 to High(args) do
// begin
// var argType := (args[i] as TAstNode).StaticType;
// var paramType := signature.ParamTypes[i];
// if not TTypeRules.CanAssign(paramType, argType) then
// raise ETypeException.CreateFmt('Cannot assign argument %d (type %s) to parameter (type %s)', [i, argType.ToString, paramType.ToString]);
// end;
boundCall := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall);
Result := SetType(TDataValue.FromIntf<IFunctionCallNode>(boundCall), retType);
end;
function TAstBinder.VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue;
@@ -535,13 +616,16 @@ var
boundArgs: TArray<IAstNode>;
boundExpandedBody: IAstNode;
boundOriginalCall: IFunctionCallNode;
newMacroNode: IMacroExpansionNode;
begin
boundCallee := Accept(Node.Callee).AsIntf<IAstNode>;
boundArgs := TransformNodes<IAstNode>(Node.Arguments);
boundExpandedBody := Accept(Node.ExpandedBody).AsIntf<IAstNode>;
boundOriginalCall := TAst.FunctionCall(boundCallee, boundArgs);
var newMacroNode := TMacroExpansionNode.Create(boundOriginalCall, boundExpandedBody);
Result := TDataValue.FromIntf<IMacroExpansionNode>(newMacroNode);
newMacroNode := TMacroExpansionNode.Create(boundOriginalCall, boundExpandedBody);
// The type of the macro node is the type of its expanded body
Result := SetType(TDataValue.FromIntf<IMacroExpansionNode>(newMacroNode), (boundExpandedBody as TAstNode).StaticType);
end;
procedure TAstBinder.ExitScope;
@@ -567,15 +651,39 @@ begin
end;
function TAstBinder.VisitAssignment(const Node: IAssignmentNode): TDataValue;
var
boundIdentifier, boundValue: IAstNode;
targetType, sourceType: IStaticType;
boundNode: IAssignmentNode;
begin
FNextIsTail := False;
Result := inherited VisitAssignment(Node);
boundIdentifier := Accept(Node.Identifier).AsIntf<IAstNode>;
boundValue := Accept(Node.Value).AsIntf<IAstNode>;
targetType := (boundIdentifier as TAstNode).StaticType;
sourceType := (boundValue as TAstNode).StaticType;
if not TTypeRules.CanAssign(targetType, sourceType) then
raise ETypeException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]);
boundNode := TAst.Assign(boundIdentifier as TBoundIdentifierNode, boundValue);
Result := SetType(TDataValue.FromIntf<IAssignmentNode>(boundNode), targetType);
end;
function TAstBinder.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
var
left, right: IAstNode;
leftType, rightType, resultType: IStaticType;
boundNode: IBinaryExpressionNode;
begin
FNextIsTail := False;
Result := inherited VisitBinaryExpression(Node);
left := Accept(Node.Left).AsIntf<IAstNode>;
right := Accept(Node.Right).AsIntf<IAstNode>;
leftType := (left as TAstNode).StaticType;
rightType := (right as TAstNode).StaticType;
resultType := TTypeRules.ResolveBinaryOp(Node.Operator, leftType, rightType);
boundNode := TAst.BinaryExpr(left, Node.Operator, right);
Result := SetType(TDataValue.FromIntf<IBinaryExpressionNode>(boundNode), resultType);
end;
function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
@@ -585,6 +693,8 @@ var
isContextTail: Boolean;
transformedValue: TDataValue;
exprList: TList<IAstNode>;
blockType: IStaticType;
boundNode: IBlockExpressionNode;
begin
isContextTail := FIsTailStack.Peek;
exprList := TList<IAstNode>.Create;
@@ -612,18 +722,96 @@ begin
end;
if same then
begin
Result := TDataValue.FromIntf<IBlockExpressionNode>(Node);
exit;
end;
end;
boundNode := Node; // Use original node
end
else
boundNode := TAst.Block(exprs); // Create new node
end
else
boundNode := TAst.Block(exprs); // Create new node
Result := TDataValue.FromIntf<IBlockExpressionNode>(TAst.Block(exprs));
// Type of the block is the type of the last expression
if Length(exprs) > 0 then
blockType := (exprs[High(exprs)] as TAstNode).StaticType
else
blockType := TTypes.Void;
Result := SetType(TDataValue.FromIntf<IBlockExpressionNode>(boundNode), blockType);
end;
function TAstBinder.VisitConstant(const Node: IConstantNode): TDataValue;
begin
case Node.Value.Kind of
TDataValueKind.vkScalar:
Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.FromScalarKind(Node.Value.AsScalar.Kind));
TDataValueKind.vkText: Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Text);
TDataValueKind.vkVoid: Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Void);
else
// Handle other constant types if they become supported
Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Unknown);
end;
end;
function TAstBinder.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
var
elemType: IStaticType;
begin
try
elemType := TTypes.FromScalarKind(TScalar.StringToKind(Node.Definition));
except
on E: Exception do
raise ETypeException.CreateFmt('Invalid series type definition: "%s". %s', [Node.Definition, E.Message]);
end;
Result := SetType(TDataValue.FromIntf<ICreateSeriesNode>(Node), TTypes.CreateSeries(elemType));
end;
function TAstBinder.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
var
seriesNode, valueNode, lookbackNode: IAstNode;
seriesType, valueType: IStaticType;
begin
seriesNode := Accept(Node.Series).AsIntf<IAstNode>;
valueNode := Accept(Node.Value).AsIntf<IAstNode>;
if Node.Lookback <> nil then
lookbackNode := Accept(Node.Lookback).AsIntf<IAstNode>
else
lookbackNode := nil;
seriesType := (seriesNode as TAstNode).StaticType;
valueType := (valueNode as TAstNode).StaticType;
if seriesType.Kind <> TStaticTypeKind.stSeries then
raise ETypeException.CreateFmt('"add" requires a series as its first argument, but got %s', [seriesType.ToString]);
if not TTypeRules.CanAssign(seriesType.ElementType, valueType) then
raise ETypeException
.CreateFmt('Cannot add item of type %s to series of type %s', [valueType.ToString, seriesType.ElementType.ToString]);
if (lookbackNode <> nil) and not ((lookbackNode as TAstNode).StaticType.Kind = TStaticTypeKind.stOrdinal) then
raise ETypeException.Create('Lookback parameter for "add" must be an ordinal value.');
var boundNode := TAst.AddSeriesItem(seriesNode as TIdentifierNode, valueNode, lookbackNode);
Result := SetType(TDataValue.FromIntf<IAddSeriesItemNode>(boundNode), TTypes.Void);
end;
function TAstBinder.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
var
seriesNode: IAstNode;
seriesType: IStaticType;
begin
seriesNode := Accept(Node.Series).AsIntf<IAstNode>;
seriesType := (seriesNode as TAstNode).StaticType;
if (seriesType.Kind <> TStaticTypeKind.stSeries) and (seriesType.Kind <> TStaticTypeKind.stRecordSeries) then
raise ETypeException.CreateFmt('"length" requires a series, but got %s', [seriesType.ToString]);
Result := SetType(TDataValue.FromIntf<ISeriesLengthNode>(Node), TTypes.Ordinal);
end;
function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
var
isContextTail: Boolean;
condition, thenBranch, elseBranch: IAstNode;
conditionType, thenType, elseType, resultType: IStaticType;
boundNode: IIfExpressionNode;
begin
isContextTail := FIsTailStack.Peek;
FNextIsTail := False;
@@ -632,10 +820,81 @@ begin
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
conditionType := (condition as TAstNode).StaticType;
if not TTypeRules.CanAssign(TTypes.Ordinal, conditionType) then
raise ETypeException.CreateFmt('If condition must be Ordinal, but got %s', [conditionType.ToString]);
thenType := (thenBranch as TAstNode).StaticType;
elseType := (elseBranch as TAstNode).StaticType;
resultType := TTypeRules.Promote(thenType, elseType);
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
Result := TDataValue.FromIntf<IIfExpressionNode>(TAst.IfExpr(condition, thenBranch, elseBranch))
boundNode := TAst.IfExpr(condition, thenBranch, elseBranch)
else
Result := TDataValue.FromIntf<IIfExpressionNode>(Node);
boundNode := Node;
Result := SetType(TDataValue.FromIntf<IIfExpressionNode>(boundNode), resultType);
end;
function TAstBinder.VisitIndexer(const Node: IIndexerNode): TDataValue;
var
baseNode, indexNode: IAstNode;
baseType, indexType, elemType: IStaticType;
begin
baseNode := Accept(Node.Base).AsIntf<IAstNode>;
indexNode := Accept(Node.Index).AsIntf<IAstNode>;
baseType := (baseNode as TAstNode).StaticType;
indexType := (indexNode as TAstNode).StaticType;
elemType := TTypes.Unknown;
if (baseType.Kind <> TStaticTypeKind.stUnknown) then
begin
if (baseType.Kind <> TStaticTypeKind.stSeries) and (baseType.Kind <> TStaticTypeKind.stRecordSeries) then
raise ETypeException.CreateFmt('Indexer `[]` can only be applied to series types, but got %s', [baseType.ToString]);
if not TTypeRules.CanAssign(TTypes.Ordinal, indexType) then
raise ETypeException.CreateFmt('Indexer `[]` requires an Ordinal index, but got %s', [indexType.ToString]);
if baseType.Kind = TStaticTypeKind.stSeries then
elemType := baseType.ElementType
else // stRecordSeries
elemType := TTypes.CreateRecord(baseType.Definition);
end;
var boundNode := TAst.Indexer(baseNode, indexNode);
Result := SetType(TDataValue.FromIntf<IIndexerNode>(boundNode), elemType);
end;
function TAstBinder.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
var
baseNode: IAstNode;
baseType, elemType: IStaticType;
fieldIndex: Integer;
begin
baseNode := Accept(Node.Base).AsIntf<IAstNode>;
baseType := (baseNode as TAstNode).StaticType;
var memberName := Node.Member.Name;
elemType := TTypes.Unknown;
if (baseType.Kind <> TStaticTypeKind.stUnknown) then
begin
if (baseType.Kind <> TStaticTypeKind.stRecord) and (baseType.Kind <> TStaticTypeKind.stRecordSeries) then
raise ETypeException.CreateFmt('Member access `.` requires a record or record series, but got %s', [baseType.ToString]);
fieldIndex := baseType.Definition.IndexOf(memberName);
if fieldIndex < 0 then
raise ETypeException.CreateFmt('Member "%s" not found in type %s', [memberName, baseType.ToString]);
var fieldType := TTypes.FromScalarKind(baseType.Definition.Fields[fieldIndex].Kind);
if baseType.Kind = TStaticTypeKind.stRecord then
elemType := fieldType
else // stRecordSeries
elemType := TTypes.CreateSeries(fieldType);
end;
var boundNode := TAst.MemberAccess(baseNode, Node.Member);
Result := SetType(TDataValue.FromIntf<IMemberAccessNode>(boundNode), elemType);
end;
function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
@@ -648,19 +907,29 @@ var
hasNestedLambdas: Boolean;
lastNestedLambdaCount: Integer;
boundLambda: ILambdaExpressionNode;
bodyType, methodType: IStaticType;
paramTypes: TArray<IStaticType>;
selfSlot: Integer;
begin
FUpvalueStack.Push(TUpvalueMapping.Create);
try
EnterScope;
try
FCurrentDescriptor.Define('<self>');
// Define placeholder for <self> (rekursion)
selfSlot := FCurrentDescriptor.Define('<self>', TTypes.Unknown);
SetLength(boundParams, Length(Node.Parameters));
SetLength(paramTypes, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
var paramNode := Node.Parameters[i];
var slotIndex := FCurrentDescriptor.Define(paramNode.Name);
// Parameters are not typed yet, use Unknown
var paramType := TTypes.Unknown;
var slotIndex := FCurrentDescriptor.Define(paramNode.Name, paramType);
var address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
boundParams[i] := TBoundIdentifierNode.Create(paramNode, address);
(boundParams[i] as TAstNode).StaticType := paramType;
paramTypes[i] := paramType;
end;
lastNestedLambdaCount := FNestedLambdaCount;
@@ -668,6 +937,14 @@ begin
boundBody := Accept(Node.Body).AsIntf<IAstNode>;
hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
lambdaScope := FCurrentDescriptor;
// Now that body is bound, infer return type
bodyType := (boundBody as TAstNode).StaticType;
methodType := TTypes.CreateMethod(paramTypes, bodyType);
// Update the type for <self>
FCurrentDescriptor.UpdateType(selfSlot, methodType);
finally
ExitScope;
end;
@@ -689,7 +966,7 @@ begin
inc(FNestedLambdaCount);
boundLambda := TBoundLambdaExpressionNode.Create(Node, boundBody, boundParams, lambdaScope, upvalues, hasNestedLambdas);
Result := TDataValue.FromIntf<ILambdaExpressionNode>(boundLambda);
Result := SetType(TDataValue.FromIntf<ILambdaExpressionNode>(boundLambda), methodType);
end;
function TAstBinder.VisitRecurNode(const Node: IRecurNode): TDataValue;
@@ -697,13 +974,20 @@ begin
if not FIsTailStack.Peek then
raise Exception.Create('''recur'' can only be used in a tail position.');
FNextIsTail := False;
Result := inherited VisitRecurNode(Node);
// TODO: Check argument count and types against current lambda signature
// 'recur' itself doesn't evaluate to a value, it jumps.
// We set its type to Void.
var boundNode := TAst.Recur(TransformNodes<IAstNode>(Node.Arguments));
Result := SetType(TDataValue.FromIntf<IRecurNode>(boundNode), TTypes.Void);
end;
function TAstBinder.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
var
isContextTail: Boolean;
condition, thenBranch, elseBranch: IAstNode;
conditionType, thenType, elseType, resultType: IStaticType;
boundNode: ITernaryExpressionNode;
begin
isContextTail := FIsTailStack.Peek;
FNextIsTail := False;
@@ -712,30 +996,51 @@ begin
thenBranch := Accept(Node.ThenBranch).AsIntf<IAstNode>;
elseBranch := Accept(Node.ElseBranch).AsIntf<IAstNode>;
conditionType := (condition as TAstNode).StaticType;
if not TTypeRules.CanAssign(TTypes.Ordinal, conditionType) then
raise ETypeException.CreateFmt('Ternary condition must be Ordinal, but got %s', [conditionType.ToString]);
thenType := (thenBranch as TAstNode).StaticType;
elseType := (elseBranch as TAstNode).StaticType;
resultType := TTypeRules.Promote(thenType, elseType);
if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then
Result := TDataValue.FromIntf<ITernaryExpressionNode>(TAst.TernaryExpr(condition, thenBranch, elseBranch))
boundNode := TAst.TernaryExpr(condition, thenBranch, elseBranch)
else
Result := TDataValue.FromIntf<ITernaryExpressionNode>(Node);
boundNode := Node;
Result := SetType(TDataValue.FromIntf<ITernaryExpressionNode>(boundNode), resultType);
end;
function TAstBinder.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
var
right: IAstNode;
rightType, resultType: IStaticType;
boundNode: IUnaryExpressionNode;
begin
FNextIsTail := False;
Result := inherited VisitUnaryExpression(Node);
right := Accept(Node.Right).AsIntf<IAstNode>;
rightType := (right as TAstNode).StaticType;
resultType := TTypeRules.ResolveUnaryOp(Node.Operator, rightType);
boundNode := TAst.UnaryExpr(Node.Operator, right);
Result := SetType(TDataValue.FromIntf<IUnaryExpressionNode>(boundNode), resultType);
end;
function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
var
adr: TResolvedAddress;
symbol: TResolvedSymbol;
boundNode: IIdentifierNode;
adr: TResolvedAddress;
begin
adr := FCurrentDescriptor.FindSymbol(Node.Name);
symbol := FCurrentDescriptor.FindSymbol(Node.Name);
adr := symbol.Address;
if adr.Kind = akLocalOrParent then
begin
if (adr.ScopeDepth > 0) and (FUpvalueStack.Count > 0) then
begin
var upvalue := FUpvalueStack.Peek;
dec(adr.ScopeDepth);
dec(adr.ScopeDepth); // Adjust address to be relative to the lambda's parent
var upvalueIndex: Integer;
if not upvalue.Map.TryGetValue(adr, upvalueIndex) then
begin
@@ -746,7 +1051,8 @@ begin
end
else
boundNode := TBoundIdentifierNode.Create(Node, adr);
Result := TDataValue.FromIntf<IIdentifierNode>(boundNode);
Result := SetType(TDataValue.FromIntf<IIdentifierNode>(boundNode), symbol.StaticType);
end
else
raise Exception.CreateFmt('Undefined identifier: "%s"', [Node.Name]);
@@ -760,6 +1066,7 @@ var
boundIdentifier: IIdentifierNode;
isBoxed: Boolean;
boundDecl: IVariableDeclarationNode;
initType: IStaticType;
begin
if not IsValidIdentifier(Node.Identifier.Name) then
raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]);
@@ -767,14 +1074,21 @@ begin
FNextIsTail := False;
initializer := nil;
if Node.Initializer <> nil then
begin
initializer := Accept(Node.Initializer).AsIntf<IAstNode>;
initType := (initializer as TAstNode).StaticType;
end
else
initType := TTypes.Void; // Default type if no initializer
slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name);
slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name, initType);
address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex);
boundIdentifier := TBoundIdentifierNode.Create(Node.Identifier, address);
(boundIdentifier as TAstNode).StaticType := initType;
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
boundDecl := TBoundVariableDeclarationNode.Create(boundIdentifier, initializer, isBoxed);
Result := TDataValue.FromIntf<IVariableDeclarationNode>(boundDecl);
Result := SetType(TDataValue.FromIntf<IVariableDeclarationNode>(boundDecl), initType);
end;
end.
+75 -13
View File
@@ -7,12 +7,21 @@ uses
System.Generics.Collections,
System.Classes,
Myc.Data.Value,
Myc.Ast.Nodes;
Myc.Ast.Nodes,
Myc.Ast.Types;
type
IExecutionScope = interface;
IScopeDescriptor = interface;
// A resolved symbol, containing its runtime address and static type.
TResolvedSymbol = record
Address: TResolvedAddress;
StaticType: IStaticType;
constructor Create(const AAddress: TResolvedAddress; const AStaticType: IStaticType);
class operator Initialize(out Dest: TResolvedSymbol);
end;
IValueCell = interface
{$region 'private'}
function GetValue: TDataValue;
@@ -52,11 +61,16 @@ type
function GetParent: IScopeDescriptor;
function GetSlotCount: Integer;
function GetSymbols: TDictionary<string, Integer>;
function GetType(SlotIndex: Integer): IStaticType;
{$endregion}
function CreateScope(const AParent: IExecutionScope): IExecutionScope;
function Define(const Name: string): Integer;
// Defines a symbol, returns its slot index.
function Define(const Name: string; const AType: IStaticType): Integer;
// Updates the type of an already defined symbol (e.g., for lambda self-reference).
procedure UpdateType(SlotIndex: Integer; const AType: IStaticType);
procedure DefineMacro(const Name: string; const Node: IMacroDefinitionNode);
function FindSymbol(const Name: string): TResolvedAddress;
// Finds a symbol, returns its address and type.
function FindSymbol(const Name: string): TResolvedSymbol;
function FindMacro(const Name: string): IMacroDefinitionNode;
property Parent: IScopeDescriptor read GetParent;
property SlotCount: Integer read GetSlotCount;
@@ -129,6 +143,7 @@ type
property NameStrings: TList<string> read FNameStrings;
property NameToIndex: TDictionary<Integer, Integer> read GetNameToIndex;
property Parent: IExecutionScope read FParent;
property ValuesArray: TArray<TScopeItem> read FValues; // Expose FValues for PopulateFromScope
end;
TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor)
@@ -136,22 +151,39 @@ type
FParent: IScopeDescriptor;
FSymbols: TDictionary<string, Integer>;
FMacros: TDictionary<string, IMacroDefinitionNode>;
FSlotTypes: TArray<IStaticType>; // Stores types by SlotIndex
function GetParent: IScopeDescriptor;
function GetSlotCount: Integer;
function GetSymbols: TDictionary<string, Integer>;
function GetType(SlotIndex: Integer): IStaticType;
public
constructor Create(const AParent: IScopeDescriptor);
destructor Destroy; override;
class function CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor; static;
function Define(const Name: string): Integer;
function Define(const Name: string; const AType: IStaticType): Integer;
procedure UpdateType(SlotIndex: Integer; const AType: IStaticType);
procedure DefineMacro(const Name: string; const Node: IMacroDefinitionNode);
function FindSymbol(const Name: string): TResolvedAddress;
function FindSymbol(const Name: string): TResolvedSymbol;
function FindMacro(const Name: string): IMacroDefinitionNode;
function CreateScope(const Parent: IExecutionScope): IExecutionScope;
procedure PopulateFromScope(Scope: TExecutionScope);
property Symbols: TDictionary<string, Integer> read FSymbols;
end;
{ TResolvedSymbol }
constructor TResolvedSymbol.Create(const AAddress: TResolvedAddress; const AStaticType: IStaticType);
begin
Address := AAddress;
StaticType := AStaticType;
end;
class operator TResolvedSymbol.Initialize(out Dest: TResolvedSymbol);
begin
// TResolvedAddress has its own Initialize operator
Dest.StaticType := TTypes.Unknown;
end;
{ TExecutionScope.TValueCell }
constructor TExecutionScope.TValueCell.Create(const AValue: TDataValue);
@@ -460,10 +492,12 @@ begin
FParent := AParent;
FSymbols := TDictionary<string, Integer>.Create;
FMacros := TDictionary<string, IMacroDefinitionNode>.Create;
FSlotTypes := [];
end;
destructor TScopeDescriptor.Destroy;
begin
FSlotTypes := nil;
FMacros.Free;
FSymbols.Free;
inherited;
@@ -486,10 +520,19 @@ begin
Result := TExecutionScope.Create(Parent, Self, nil);
end;
function TScopeDescriptor.Define(const Name: string): Integer;
function TScopeDescriptor.Define(const Name: string; const AType: IStaticType): Integer;
begin
Result := FSymbols.Count;
FSymbols.Add(Name, Result);
SetLength(FSlotTypes, Result + 1);
FSlotTypes[Result] := AType;
end;
procedure TScopeDescriptor.UpdateType(SlotIndex: Integer; const AType: IStaticType);
begin
if (SlotIndex < 0) or (SlotIndex >= Length(FSlotTypes)) then
raise EArgumentOutOfRangeException.Create('Invalid SlotIndex in UpdateType.');
FSlotTypes[SlotIndex] := AType;
end;
procedure TScopeDescriptor.DefineMacro(const Name: string; const Node: IMacroDefinitionNode);
@@ -512,21 +555,25 @@ begin
end;
end;
function TScopeDescriptor.FindSymbol(const Name: string): TResolvedAddress;
function TScopeDescriptor.FindSymbol(const Name: string): TResolvedSymbol;
var
currentDescriptor: IScopeDescriptor;
slotIndex: Integer;
begin
Result.Kind := akUnresolved;
Result.ScopeDepth := 0;
Result.Address.Kind := akUnresolved;
Result.Address.ScopeDepth := 0;
Result.StaticType := TTypes.Unknown;
currentDescriptor := Self;
while Assigned(currentDescriptor) do
begin
if currentDescriptor.Symbols.TryGetValue(Name, Result.SlotIndex) then
if currentDescriptor.Symbols.TryGetValue(Name, slotIndex) then
begin
Result.Kind := akLocalOrParent;
Result.Address.Kind := akLocalOrParent;
Result.Address.SlotIndex := slotIndex;
Result.StaticType := currentDescriptor.GetType(slotIndex);
exit;
end;
inc(Result.ScopeDepth);
inc(Result.Address.ScopeDepth);
currentDescriptor := currentDescriptor.Parent;
end;
end;
@@ -546,11 +593,23 @@ begin
Result := FSymbols;
end;
function TScopeDescriptor.GetType(SlotIndex: Integer): IStaticType;
begin
if (SlotIndex < 0) or (SlotIndex >= Length(FSlotTypes)) then
raise EArgumentOutOfRangeException.Create('Invalid SlotIndex in GetType.');
Result := FSlotTypes[SlotIndex];
end;
procedure TScopeDescriptor.PopulateFromScope(Scope: TExecutionScope);
var
val: TDataValue;
i: Integer;
begin
// Recreate descriptor by iterating all defined symbols in the runtime scope.
SetLength(FSlotTypes, Length(Scope.ValuesArray)); // Size the array
for i := 0 to High(FSlotTypes) do
FSlotTypes[i] := TTypes.Unknown; // Fill with Unknown
for var pair in Scope.NameToIndex do
begin
var name := Scope.NameStrings[pair.Key];
@@ -560,8 +619,11 @@ begin
if not FSymbols.ContainsKey(name) then
FSymbols.Add(name, slotIndex);
// We cannot recover the static type from the runtime scope.
// FSlotTypes[slotIndex] remains TTypes.Unknown.
// Check if the symbol is also a macro and add it to the macro table.
val := Scope.FValues[slotIndex].Value;
val := Scope.ValuesArray[slotIndex].Value;
if (val.Kind = vkInterface) and (val.AsIntf<IAstNode> is TMacroDefinitionNode) then
begin
if not FMacros.ContainsKey(name) then
+68 -21
View File
@@ -97,9 +97,9 @@ type
// Defines the rules of the type system.
TTypeRules = record
private
class function Promote(const A, B: IStaticType): IStaticType; static;
public
class function Promote(const A, B: IStaticType): IStaticType; static;
// Checks if a value of type 'Source' can be assigned to 'Target'.
class function CanAssign(const Target, Source: IStaticType): Boolean; static;
// Determines the result type of a binary operation.
@@ -450,6 +450,10 @@ begin
if (not Assigned(Target)) or (not Assigned(Source)) then
exit(False);
// During inference, allow assignment involving Unknown
if (Target.Kind = stUnknown) or (Source.Kind = stUnknown) then
exit(True);
if Target.IsEqual(Source) then
exit(True);
@@ -457,6 +461,9 @@ begin
if (Target.Kind = stFloat) and (Source.Kind = stOrdinal) then
exit(True);
if (Target.Kind = stVoid) and (Source.Kind = stMethod) then
exit(True);
// TODO: Implement full assignment compatibility rules (e.g., for records/series)
Result := False;
@@ -464,7 +471,13 @@ end;
class function TTypeRules.Promote(const A, B: IStaticType): IStaticType;
begin
// Numeric promotion rule: Float wins
// Handle Unknown: If one is Unknown, the result is the other type.
if A.Kind = stUnknown then
exit(B);
if B.Kind = stUnknown then
exit(A);
// Standard Numeric promotion rule: Float wins
if (A.Kind = stFloat) and (B.Kind = stFloat) then
exit(TTypes.Float);
if (A.Kind = stFloat) and (B.Kind = stOrdinal) then
@@ -474,28 +487,54 @@ begin
if (A.Kind = stOrdinal) and (B.Kind = stOrdinal) then
exit(TTypes.Ordinal);
// If types are identical and not numeric, return that type (e.g. Text + Text might be valid later)
if A.IsEqual(B) then
exit(A);
// Cannot promote other combinations during basic inference
raise ETypeException.CreateFmt('Cannot promote types %s and %s', [A.ToString, B.ToString]);
end;
class function TTypeRules.ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType;
var
promotedType: IStaticType;
promotedKind: TStaticTypeKind;
begin
// 1. Determine the effective type after promotion, handling Unknown.
try
promotedType := Promote(Left, Right);
except
// If promotion fails (e.g., Text and Ordinal), the operation is invalid.
on E: ETypeException do
raise ETypeException.CreateFmt(
'Operator %s cannot be applied to %s and %s (promotion failed: %s)',
[Op.ToString, Left.ToString, Right.ToString, E.Message]);
end;
// If promotion results in Unknown, the result type is also Unknown for now.
if promotedType.Kind = stUnknown then
exit(TTypes.Unknown);
// 2. Check if the operator is valid for the promoted type.
promotedKind := promotedType.Kind;
case Op of
TScalar.TBinaryOp.Add, TScalar.TBinaryOp.Subtract, TScalar.TBinaryOp.Multiply:
begin
// Numeric operations: Promote and return
if (Left.Kind in [stOrdinal, stFloat]) and (Right.Kind in [stOrdinal, stFloat]) then
Result := Promote(Left, Right)
else
raise ETypeException.CreateFmt('Operator %s cannot be applied to %s and %s', [Op.ToString, Left.ToString, Right.ToString]);
// Numeric operations require Ordinal or Float
if not (promotedKind in [stOrdinal, stFloat]) then
raise ETypeException
.CreateFmt('Operator %s requires Ordinal or Float, but got %s after promotion', [Op.ToString, promotedType.ToString]);
Result := promotedType; // Result has the promoted type
end;
TScalar.TBinaryOp.Divide:
begin
// Division *always* results in Float, even Ordinal / Ordinal
if (Left.Kind in [stOrdinal, stFloat]) and (Right.Kind in [stOrdinal, stFloat]) then
Result := TTypes.Float
else
raise ETypeException.CreateFmt('Operator %s cannot be applied to %s and %s', [Op.ToString, Left.ToString, Right.ToString]);
// Division requires Ordinal or Float, but *always* results in Float
if not (promotedKind in [stOrdinal, stFloat]) then
raise ETypeException
.CreateFmt('Operator %s requires Ordinal or Float, but got %s after promotion', [Op.ToString, promotedType.ToString]);
Result := TTypes.Float;
end;
TScalar.TBinaryOp.Equal,
@@ -505,12 +544,12 @@ begin
TScalar.TBinaryOp.LessOrEqual,
TScalar.TBinaryOp.GreaterOrEqual:
begin
// Comparison operations: Check if promotion is possible, but always return Ordinal (boolean)
if (Left.Kind in [stOrdinal, stFloat]) and (Right.Kind in [stOrdinal, stFloat]) then
Result := TTypes.Ordinal
else
raise ETypeException
.CreateFmt('Comparison operator %s cannot be applied to %s and %s', [Op.ToString, Left.ToString, Right.ToString]);
// Comparison requires Ordinal or Float, but *always* results in Ordinal (boolean)
if not (promotedKind in [stOrdinal, stFloat]) then
raise ETypeException.CreateFmt(
'Comparison operator %s requires Ordinal or Float, but got %s after promotion',
[Op.ToString, promotedType.ToString]);
Result := TTypes.Ordinal;
end;
else
raise ETypeException.Create('Unknown binary operator for type resolution.');
@@ -518,18 +557,26 @@ begin
end;
class function TTypeRules.ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: IStaticType): IStaticType;
var
rightKind: TStaticTypeKind;
begin
rightKind := Right.Kind;
// If operand is Unknown, result is Unknown.
if rightKind = stUnknown then
exit(TTypes.Unknown);
case Op of
TScalar.TUnaryOp.Negate:
begin
if not (Right.Kind in [stOrdinal, stFloat]) then
if not (rightKind in [stOrdinal, stFloat]) then
raise ETypeException.CreateFmt('Unary negation cannot be applied to %s', [Right.ToString]);
Result := Right; // Negation preserves type
end;
TScalar.TUnaryOp.Not:
begin
if not (Right.Kind = stOrdinal) then
if not (rightKind = stOrdinal) then
raise ETypeException.CreateFmt('Logical not cannot be applied to %s', [Right.ToString]);
Result := TTypes.Ordinal;
end;