Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Optional types and null propagation

Browse Source
This commit is contained in:
Michael Schimmel
2025-12-21 15:20:59 +01:00
parent e7fdbc3312
commit ac96a105a5
10 changed files with 840 additions and 190 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Compiler.TypeChecker.pas
+159 -53
View File
@@ -17,7 +17,7 @@ uses
type
IAstTypeChecker = interface(IAstVisitor)
function Execute(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode;
function Execute(const RootNode: IAstNode): IAstNode;
end;
TTypeChecker = class(TAstTransformer, IAstTypeChecker)
@@ -30,7 +30,12 @@ type
FSlotTypes: TArray<IStaticType>;
FUpvalueTypes: TArray<IStaticType>;
public
constructor Create(AParent: TTypeContext; ALayout: IScopeLayout; const AUpvalueTypes: TArray<IStaticType>);
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;
@@ -39,9 +44,14 @@ type
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;
protected
function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override;
@@ -50,7 +60,7 @@ type
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 VisitCondExpression(const Node: ICondExpressionNode): IAstNode; override;
function VisitMemberAccess(const Node: IMemberAccessNode): IAstNode; override;
function VisitIndexer(const Node: IIndexerNode): IAstNode; override;
function VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; override;
@@ -64,12 +74,17 @@ type
function VisitKeyword(const Node: IKeywordNode): IAstNode; override;
public
constructor Create(const RootLayout: IScopeLayout; const ALog: ICompilerLog);
constructor Create(const RootLayout: IScopeLayout; const RootScope: IExecutionScope; const ALog: ICompilerLog);
destructor Destroy; override;
function Execute(const RootNode: IAstNode; const Layout: IScopeLayout): IAstNode;
function Execute(const RootNode: IAstNode): IAstNode;
class function CheckTypes(const RootNode: IAstNode; const Layout: IScopeLayout; const ALog: ICompilerLog): IAstNode; static;
class function CheckTypes(
const RootNode: IAstNode;
const Layout: IScopeLayout;
const RootScope: IExecutionScope;
const ALog: ICompilerLog
): IAstNode; static;
end;
implementation
@@ -80,7 +95,14 @@ uses
{ TTypeChecker.TTypeContext }
constructor TTypeChecker.TTypeContext.Create(AParent: TTypeContext; ALayout: IScopeLayout; const AUpvalueTypes: TArray<IStaticType>);
constructor TTypeChecker.TTypeContext.Create(
AParent: TTypeContext;
ALayout: IScopeLayout;
const AUpvalueTypes: TArray<IStaticType>;
ADescriptor: IScopeDescriptor
);
var
i: Integer;
begin
inherited Create;
FParent := AParent;
@@ -90,8 +112,19 @@ begin
if Assigned(FLayout) then
begin
SetLength(FSlotTypes, FLayout.SlotCount);
for var i := 0 to High(FSlotTypes) do
FSlotTypes[i] := TTypes.Unknown;
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;
@@ -142,21 +175,33 @@ end;
function TTypeChecker.CreateContextChain(L: IScopeLayout): TTypeContext;
var
p: TTypeContext;
desc: IScopeDescriptor;
begin
if L = nil then
exit(nil);
p := CreateContextChain(L.Parent);
Result := TTypeContext.Create(p, L, []);
desc := nil;
// Check if this layout is the root layout (has no parent).
// If so, attach the RootScope's descriptor to pull in RTL types (like +).
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 ALog: ICompilerLog);
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, []);
FCurrentContext := TTypeContext.Create(nil, nil, [], nil);
end;
destructor TTypeChecker.Destroy;
@@ -170,19 +215,56 @@ begin
inherited;
end;
class function TTypeChecker.CheckTypes(const RootNode: IAstNode; const Layout: IScopeLayout; const ALog: ICompilerLog): IAstNode;
class function TTypeChecker.CheckTypes(
const RootNode: IAstNode;
const Layout: IScopeLayout;
const RootScope: IExecutionScope;
const ALog: ICompilerLog
): IAstNode;
var
startLayout: IScopeLayout;
begin
var checker := TTypeChecker.Create(Layout, ALog) as IAstTypeChecker;
Result := checker.Execute(RootNode, Layout);
// Determine the starting scope for the TypeChecker.
// The 'Layout' parameter represents the *inner* scope of the script (the "Room").
// To correctly simulate entering this scope (via VisitLambdaExpression), the TypeChecker
// must start in the *surrounding* scope (the "Hallway"), which is Layout.Parent.
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; const Layout: IScopeLayout): IAstNode;
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: IConstantNode): IAstNode;
begin
Result := Node;
@@ -221,7 +303,6 @@ begin
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;
@@ -358,14 +439,40 @@ var
finalDescriptor: IScopeDescriptor;
paramIdent: IIdentifierNode;
paramIdentity: INamedIdentity;
lookupAddr: TResolvedAddress;
begin
// 1. Resolve Upvalue Types
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);
for i := 0 to High(upvalueAddrs) do
begin
lookupAddr := upvalueAddrs[i];
// CRITICAL: Scope Depth Adjustment
// The Binder calculated addresses relative to the *body* of this lambda (Internal View).
// FCurrentContext currently points to the *defining* scope (External View/Parent).
// Therefore, we must decrease the depth by 1 to look up the type in the current context.
if lookupAddr.Kind = akLocalOrParent then
begin
// Check > 0 to prevent crash if Binder somehow produced 0 (though logic says it shouldn't).
if lookupAddr.ScopeDepth > 0 then
Dec(lookupAddr.ScopeDepth)
else
begin
// Guard for Binder quirks or edge cases
if Assigned(FLog) then
FLog.AddWarning('Compiler integrity check warning: Upvalue Depth 0 encountered during type check.', Node);
end;
end;
upvalueTypes[i] := FCurrentContext.LookupType(lookupAddr);
end;
// 2. Enter New Scope (The "Room")
FCurrentContext := TTypeContext.Create(FCurrentContext, Node.Layout, upvalueTypes, nil);
try
// 3. Register Parameters
SetLength(newParams, Node.Parameters.Count);
SetLength(paramTypes, Node.Parameters.Count);
@@ -383,21 +490,22 @@ begin
newParams[i] := TAst.Identifier(paramIdentity, paramAdr, paramTypes[i]);
end;
// 4. Visit Body
newBody := Accept(Node.Body);
// 5. Determine Function Signature
bodyType := newBody.AsTypedNode.StaticType;
methodType := TTypes.CreateMethod(paramTypes, bodyType);
FCurrentContext.SetType(0, methodType);
finalDescriptor := TScope.CreateDescriptor(Node.Layout, FCurrentContext.Types);
finally
// 6. Leave Scope
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,
@@ -493,9 +601,7 @@ begin
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;
@@ -514,7 +620,6 @@ begin
else
blockType := TTypes.Void;
// Wrap in List
var exprList := TExpressionList.Create(newExprs, Node.Expressions.Identity);
Result := TAst.Block(Node.Identity, exprList, blockType);
end;
@@ -561,11 +666,10 @@ var
condType, branchType, resultType: IStaticType;
begin
SetLength(newPairs, Length(Node.Pairs));
resultType := nil; // Start with nothing
resultType := nil;
for i := 0 to High(Node.Pairs) do
begin
// 1. Visit Condition
var newCond := Accept(Node.Pairs[i].Condition);
condType := newCond.AsTypedNode.StaticType;
@@ -577,13 +681,11 @@ begin
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
@@ -603,9 +705,7 @@ begin
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
@@ -631,43 +731,44 @@ end;
function TTypeChecker.VisitMemberAccess(const Node: IMemberAccessNode): IAstNode;
var
baseType, elemType: IStaticType;
unwrappedBaseType, elemType: IStaticType;
fieldIndex: Integer;
newBase, newMember: IAstNode;
isOptionalAccess: Boolean;
begin
newBase := Accept(Node.Base);
newMember := Accept(Node.Member);
baseType := newBase.AsTypedNode.StaticType;
unwrappedBaseType := PrepareBaseType(newBase, isOptionalAccess);
elemType := TTypes.Unknown;
if (baseType.Kind <> TStaticTypeKind.stUnknown) then
if (unwrappedBaseType.Kind <> TStaticTypeKind.stUnknown) then
begin
if (baseType.Kind = TStaticTypeKind.stRecord) or (baseType.Kind = TStaticTypeKind.stRecordSeries) then
if (unwrappedBaseType.Kind = TStaticTypeKind.stRecord) or (unwrappedBaseType.Kind = TStaticTypeKind.stRecordSeries) then
begin
fieldIndex := baseType.Definition.IndexOf(Node.Member.Value);
fieldIndex := unwrappedBaseType.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);
FLog.AddError(Format('Member "%s" not found in type %s', [Node.Member.Value.Name, unwrappedBaseType.ToString]), Node);
end
else
begin
var fieldType := TTypes.FromScalarKind(baseType.Definition[fieldIndex].Value);
if baseType.Kind = TStaticTypeKind.stRecord then
var fieldType := TTypes.FromScalarKind(unwrappedBaseType.Definition[fieldIndex].Value);
if unwrappedBaseType.Kind = TStaticTypeKind.stRecord then
elemType := fieldType
else
elemType := TTypes.CreateSeries(fieldType);
end;
end
else if (baseType.Kind = TStaticTypeKind.stGenericRecord) then
else if (unwrappedBaseType.Kind = TStaticTypeKind.stGenericRecord) then
begin
var genDef := baseType.GenericDefinition;
var genDef := unwrappedBaseType.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);
FLog.AddError(Format('Member "%s" not found in type %s', [Node.Member.Value.Name, unwrappedBaseType.ToString]), Node);
end
else
elemType := genDef[fieldIndex].Value;
@@ -675,38 +776,42 @@ begin
else
begin
if Assigned(FLog) then
FLog.AddError(Format('Member access requires a record type, but got %s', [baseType.ToString]), Node);
FLog.AddError(Format('Member access requires a record type, but got %s', [unwrappedBaseType.ToString]), Node);
end;
end;
elemType := ApplyOptionality(elemType, isOptionalAccess);
Result := TAst.MemberAccess(Node.Identity, newBase, newMember.AsKeyword, elemType);
end;
function TTypeChecker.VisitIndexer(const Node: IIndexerNode): IAstNode;
var
baseType, indexType, elemType: IStaticType;
unwrappedBaseType, indexType, elemType: IStaticType;
newBase, newIndex: IAstNode;
isOptionalAccess: Boolean;
begin
newBase := Accept(Node.Base);
newIndex := Accept(Node.Index);
baseType := newBase.AsTypedNode.StaticType;
unwrappedBaseType := PrepareBaseType(newBase, isOptionalAccess);
indexType := newIndex.AsTypedNode.StaticType;
elemType := TTypes.Unknown;
if (baseType.Kind <> TStaticTypeKind.stUnknown) then
if (unwrappedBaseType.Kind <> TStaticTypeKind.stUnknown) then
begin
if (baseType.Kind <> TStaticTypeKind.stSeries) and (baseType.Kind <> TStaticTypeKind.stRecordSeries) then
if (unwrappedBaseType.Kind <> TStaticTypeKind.stSeries) and (unwrappedBaseType.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);
FLog.AddError(Format('Indexer `[]` can only be applied to series types, but got %s', [unwrappedBaseType.ToString]), Node);
end
else
begin
if baseType.Kind = TStaticTypeKind.stSeries then
elemType := baseType.ElementType
if unwrappedBaseType.Kind = TStaticTypeKind.stSeries then
elemType := unwrappedBaseType.ElementType
else
elemType := TTypes.CreateRecord(baseType.Definition);
elemType := TTypes.CreateRecord(unwrappedBaseType.Definition);
end;
end;
@@ -716,6 +821,8 @@ begin
FLog.AddError(Format('Indexer `[]` requires an Ordinal index, but got %s', [indexType.ToString]), Node);
end;
elemType := ApplyOptionality(elemType, isOptionalAccess);
Result := TAst.Indexer(Node.Identity, newBase, newIndex, elemType);
end;
@@ -770,7 +877,6 @@ begin
scalarDefFields[i] := TScalarRecordField.Create(newFields[i].Key.Value, scalarKind);
end;
// Wrap in List
var fieldList := TRecordFieldList.Create(newFields, Node.Fields.Identity);
if allScalar then