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

AST Identities

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-25 19:41:26 +01:00
parent 0b7a60e338
commit aff4cec7d5
9 changed files with 2334 additions and 2150 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Test.Myc.Ast.Compiler.Binder.pas
+99 -39
View File
@@ -18,7 +18,8 @@ type
private
FRootLayout: IScopeLayout;
function Bind(const Node: IAstNode; out Layout: IScopeLayout): IAstNode;
// Updated Bind helper: Returns log to allow assertions on errors
function Bind(const Node: IAstNode; out Layout: IScopeLayout; out Log: ICompilerLog): IAstNode;
function Unwrap(const Node: IAstNode): IAstNode;
public
[Setup]
@@ -72,14 +73,14 @@ type
[TestCase('Invalid_StartDigit', '1var')]
[TestCase('Invalid_Symbol', 'var$name')]
[TestCase('Invalid_DotStart', '.var')]
procedure Test_IdentifierValidation_InvalidNames_RaisesException(const Name: string);
procedure Test_IdentifierValidation_InvalidNames_LogsError(const Name: string);
[Test]
procedure Test_UnresolvedIdentifier_RaisesException;
procedure Test_UnresolvedIdentifier_LogsError;
[Test]
[IgnoreMemoryLeaks]
procedure Test_RedefinitionInSameScope_RaisesException;
procedure Test_RedefinitionInSameScope_LogsError;
end;
implementation
@@ -94,9 +95,11 @@ begin
FRootLayout := TScope.CreateRootLayout;
end;
function TTestAstBinder.Bind(const Node: IAstNode; out Layout: IScopeLayout): IAstNode;
function TTestAstBinder.Bind(const Node: IAstNode; out Layout: IScopeLayout; out Log: ICompilerLog): IAstNode;
begin
Result := TAstBinder.Bind(FRootLayout, Node, Layout);
Log := TCompilerLog.Create;
// TAstBinder.Bind now takes Log instead of raising exceptions
Result := TAstBinder.Bind(FRootLayout, Node, Layout, Log);
end;
function TTestAstBinder.Unwrap(const Node: IAstNode): IAstNode;
@@ -107,8 +110,6 @@ begin
Result := Node;
end;
// ... (Previous tests for Basic Scope, Parameters, Upvalues remain identical to previous post)
// ------------------------------------------------------------------------------------------------
// Fixed Test: Initializer Visibility
// ------------------------------------------------------------------------------------------------
@@ -120,15 +121,14 @@ var
block: IBlockExpressionNode;
decl: IVariableDeclarationNode;
initIdent: IIdentifierNode;
log: ICompilerLog;
begin
// (do
// (def a 10)
// (def b a) <-- CHANGED: 'b' initializes from 'a'.
// 'def a a' is forbidden in same scope (no shadowing).
// )
// (do (def a 10) (def b a))
root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(10)), TAst.VarDecl(TAst.Identifier('b'), TAst.Identifier('a'))]);
bound := Bind(root, layout);
bound := Bind(root, layout, log);
Assert.IsFalse(log.HasErrors, 'Binding should succeed without errors.');
block := bound.AsBlockExpression;
// Check definition of 'b'
@@ -136,8 +136,6 @@ begin
initIdent := decl.Initializer.AsIdentifier;
// 'a' is Slot 0. 'b' is Slot 1.
// The initializer 'a' must point to Slot 0.
Assert.AreEqual<Integer>(0, initIdent.Address.SlotIndex, 'Initializer should resolve to "a" (Slot 0).');
Assert.AreEqual<Integer>(1, decl.Target.AsIdentifier.Address.SlotIndex, 'Target "b" should be at Slot 1.');
end;
@@ -146,21 +144,23 @@ end;
// Rule Verification: No Redefinition
// ------------------------------------------------------------------------------------------------
procedure TTestAstBinder.Test_RedefinitionInSameScope_RaisesException;
procedure TTestAstBinder.Test_RedefinitionInSameScope_LogsError;
var
root: IAstNode;
layout: IScopeLayout;
log: ICompilerLog;
begin
// (do (def a 1) (def a 2)) - Forbidden!
root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(1)), TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(2))]);
Assert.WillRaise(procedure begin Bind(root, layout); end, EBinderException, 'Binder must forbid redefinition in the same scope.');
Bind(root, layout, log);
Assert.IsTrue(log.HasErrors, 'Binder must log error for redefinition.');
Assert.AreEqual('Variable "a" is already defined in this scope.', log.GetEntries[0].Message);
end;
// ... (Rest of validation tests remain identical)
// ------------------------------------------------------------------------------------------------
// Boilerplate for the rest of the tests (copying here for completeness of the unit block)
// Basic Scope & Definitions
// ------------------------------------------------------------------------------------------------
procedure TTestAstBinder.Test_DefineAndResolve_LocalVariable;
@@ -169,9 +169,13 @@ var
layout: IScopeLayout;
block: IBlockExpressionNode;
ident: IIdentifierNode;
log: ICompilerLog;
begin
root := TAst.Block([TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(42)), TAst.Identifier('a')]);
bound := Bind(root, layout);
bound := Bind(root, layout, log);
Assert.IsFalse(log.HasErrors);
block := bound.AsBlockExpression;
ident := block.Expressions[1].AsIdentifier;
Assert.AreEqual<TAddressKind>(akLocalOrParent, ident.Address.Kind);
@@ -186,37 +190,53 @@ var
block: IBlockExpressionNode;
innerLambda: ILambdaExpressionNode;
innerUsage: IIdentifierNode;
log: ICompilerLog;
begin
// This is technically shadowing across *nested* scopes (Lambda vs Outer Block).
// If you forbid this too, this test needs to fail. Currently assuming strictly "Same Scope" check.
root :=
TAst.Block([TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(1)), TAst.LambdaExpr([TAst.Identifier('x')], TAst.Identifier('x'))]);
bound := Bind(root, layout);
bound := Bind(root, layout, log);
Assert.IsFalse(log.HasErrors);
block := bound.AsBlockExpression;
innerLambda := block.Expressions[1].AsLambdaExpression;
innerUsage := innerLambda.Body.AsIdentifier;
Assert.AreEqual<Integer>(1, innerUsage.Address.SlotIndex); // Parameter x
Assert.AreEqual<Integer>(1, innerUsage.Address.SlotIndex); // Parameter x (Slot 1 because <self> is Slot 0)
end;
procedure TTestAstBinder.Test_ScopeIsolation_SiblingScopesCannotSeeEachOther;
var
root: IAstNode;
layout: IScopeLayout;
log: ICompilerLog;
begin
// (do (fn [] (def a 1)) a) -> 'a' is inside lambda, not visible outside
root := TAst.Block([TAst.LambdaExpr([], TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(1))), TAst.Identifier('a')]);
Assert.WillRaise(procedure begin Bind(root, layout); end);
Bind(root, layout, log);
Assert.IsTrue(log.HasErrors, 'Sibling scope access should fail.');
Assert.IsTrue(log.GetEntries[0].Message.Contains('Undefined identifier'), 'Expected undefined identifier error.');
end;
// ------------------------------------------------------------------------------------------------
// Parameters
// ------------------------------------------------------------------------------------------------
procedure TTestAstBinder.Test_LambdaParameters_AreBoundToSlotsStartingAtOne;
var
root, bound: IAstNode;
layout: IScopeLayout;
lambda: ILambdaExpressionNode;
log: ICompilerLog;
begin
root := TAst.LambdaExpr([TAst.Identifier('p1')], TAst.Nop);
bound := Unwrap(Bind(root, layout));
bound := Unwrap(Bind(root, layout, log));
Assert.IsFalse(log.HasErrors);
lambda := bound.AsLambdaExpression;
Assert.AreEqual<Integer>(1, lambda.Parameters[0].Address.SlotIndex);
Assert.AreEqual<Integer>(1, lambda.Parameters[0].Address.SlotIndex); // Slot 0 is reserved for <self>
end;
procedure TTestAstBinder.Test_MultipleParameters_AreBoundCorrectly;
@@ -224,14 +244,22 @@ var
root, bound: IAstNode;
layout: IScopeLayout;
lambda: ILambdaExpressionNode;
log: ICompilerLog;
begin
root := TAst.LambdaExpr([TAst.Identifier('a'), TAst.Identifier('b')], TAst.Nop);
bound := Unwrap(Bind(root, layout));
bound := Unwrap(Bind(root, layout, log));
Assert.IsFalse(log.HasErrors);
lambda := bound.AsLambdaExpression;
Assert.AreEqual<Integer>(1, lambda.Parameters[0].Address.SlotIndex);
Assert.AreEqual<Integer>(2, lambda.Parameters[1].Address.SlotIndex);
end;
// ------------------------------------------------------------------------------------------------
// Upvalues / Closures
// ------------------------------------------------------------------------------------------------
procedure TTestAstBinder.Test_Capture_ImmediateParent;
var
root, bound: IAstNode;
@@ -239,14 +267,20 @@ var
block: IBlockExpressionNode;
lambda: ILambdaExpressionNode;
bodyIdent: IIdentifierNode;
log: ICompilerLog;
begin
root := TAst.Block([TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(99)), TAst.LambdaExpr([], TAst.Identifier('x'))]);
bound := Bind(root, layout);
bound := Bind(root, layout, log);
Assert.IsFalse(log.HasErrors);
block := bound.AsBlockExpression;
lambda := block.Expressions[1].AsLambdaExpression;
bodyIdent := lambda.Body.AsIdentifier;
// Inside the lambda, 'x' is accessed via an Upvalue
Assert.AreEqual<TAddressKind>(akUpvalue, bodyIdent.Address.Kind);
Assert.AreEqual<Integer>(0, bodyIdent.Address.SlotIndex);
Assert.AreEqual<Integer>(0, bodyIdent.Address.SlotIndex); // First captured value
end;
procedure TTestAstBinder.Test_Capture_GrandParent_PropagatesThroughIntermediateScope;
@@ -255,15 +289,21 @@ var
layout: IScopeLayout;
outerBlock: IBlockExpressionNode;
midLambda, innerLambda: ILambdaExpressionNode;
log: ICompilerLog;
begin
root :=
TAst.Block(
[TAst.VarDecl(TAst.Identifier('top'), TAst.Constant(100)), TAst.LambdaExpr([], TAst.LambdaExpr([], TAst.Identifier('top')))]
);
bound := Bind(root, layout);
bound := Bind(root, layout, log);
Assert.IsFalse(log.HasErrors);
outerBlock := bound.AsBlockExpression;
midLambda := outerBlock.Expressions[1].AsLambdaExpression;
innerLambda := midLambda.Body.AsLambdaExpression;
// Inner lambda accesses 'top' via upvalue
Assert.AreEqual<TAddressKind>(akUpvalue, innerLambda.Body.AsIdentifier.Address.Kind);
end;
@@ -272,38 +312,58 @@ var
root, bound: IAstNode;
layout: IScopeLayout;
lambda: ILambdaExpressionNode;
log: ICompilerLog;
begin
root := TAst.LambdaExpr([], TAst.Identifier('<self>'));
bound := Unwrap(Bind(root, layout));
bound := Unwrap(Bind(root, layout, log));
Assert.IsFalse(log.HasErrors);
lambda := bound.AsLambdaExpression;
// <self> is always at Slot 0 (Local)
Assert.AreEqual<TAddressKind>(akLocalOrParent, lambda.Body.AsIdentifier.Address.Kind);
Assert.AreEqual<Integer>(0, lambda.Body.AsIdentifier.Address.SlotIndex);
end;
// ------------------------------------------------------------------------------------------------
// Validation Tests
// ------------------------------------------------------------------------------------------------
procedure TTestAstBinder.Test_IdentifierValidation_ValidNames(const Name: string);
var
root: IAstNode;
layout: IScopeLayout;
log: ICompilerLog;
begin
root := TAst.VarDecl(TAst.Identifier(Name), nil);
Assert.WillNotRaise(procedure begin Bind(root, layout); end);
Bind(root, layout, log);
Assert.IsFalse(log.HasErrors, 'Valid name should not produce errors.');
end;
procedure TTestAstBinder.Test_IdentifierValidation_InvalidNames_RaisesException(const Name: string);
procedure TTestAstBinder.Test_IdentifierValidation_InvalidNames_LogsError(const Name: string);
var
root: IAstNode;
layout: IScopeLayout;
log: ICompilerLog;
begin
root := TAst.VarDecl(TAst.Identifier(Name), nil);
Assert.WillRaise(procedure begin Bind(root, layout); end);
Bind(root, layout, log);
Assert.IsTrue(log.HasErrors, 'Invalid name should produce error.');
Assert.IsTrue(log.GetEntries[0].Message.Contains('Invalid identifier name'));
end;
procedure TTestAstBinder.Test_UnresolvedIdentifier_RaisesException;
procedure TTestAstBinder.Test_UnresolvedIdentifier_LogsError;
var
root: IAstNode;
layout: IScopeLayout;
log: ICompilerLog;
begin
root := TAst.Identifier('z');
Assert.WillRaise(procedure begin Bind(root, layout); end);
Bind(root, layout, log);
Assert.IsTrue(log.HasErrors, 'Unresolved identifier should produce error.');
Assert.IsTrue(log.GetEntries[0].Message.Contains('Undefined identifier'));
end;
end.