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/Myc.Ast.Compiler.Binder.pas
+43 -36
View File
@@ -13,6 +13,7 @@ uses
Myc.Ast.Scope,
Myc.Ast.Types,
Myc.Ast.Compiler.Binder.Upvalues,
Myc.Ast.Identities, // Wichtig für AsNamed
Myc.Ast;
type
@@ -156,7 +157,7 @@ begin
Result := Accept(RootNode);
if not Assigned(Result) then
Result := TAst.Block([]);
Result := TAst.Block([], nil);
Layout := FCurrentBuilder.Build;
end;
@@ -168,12 +169,10 @@ begin
if Name.IsEmpty then
exit(False);
// Support standard identifiers and hygienic macro names (e.g. loop#1)
for c in Name do
if not (c.IsLetterOrDigit or (c = '_') or (c = '-') or (c = '#')) then
exit(False);
// First char check (cannot be digit unless it's a pure number which is tokenized differently)
c := Name[1];
if not (c.IsLetter or (c = '_') or (c = '#')) then
exit(False);
@@ -187,7 +186,6 @@ var
depth: Integer;
slot: Integer;
begin
// Start search in current builder
layout := FCurrentBuilder;
depth := 0;
@@ -238,12 +236,14 @@ function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
var
physAddr: TResolvedAddress;
upvalueIndex: Integer;
identity: INamedIdentity;
begin
identity := Node.Identity.AsNamed; // Type-safe extraction of identity
if Node.Address.Kind = akUnresolved then
begin
if not ResolveSymbol(Node.Name, physAddr) then
begin
// Log error but don't crash. Return unresolved node (Poison Pill).
if Assigned(FLog) then
FLog.AddError(Format('Undefined identifier: "%s"', [Node.Name]), Node);
Result := Node;
@@ -252,13 +252,12 @@ begin
if physAddr.ScopeDepth > 0 then
begin
// It's an upvalue (from a parent scope). Capture it.
upvalueIndex := CaptureUpvalue(physAddr);
Result := TAst.Identifier(Node.Name, TResolvedAddress.Create(akUpvalue, 0, upvalueIndex), TTypes.Unknown);
// Recreate identifier using the SAME identity but new address
Result := TAst.Identifier(identity, TResolvedAddress.Create(akUpvalue, 0, upvalueIndex), TTypes.Unknown);
end
else
// It's local.
Result := TAst.Identifier(Node.Name, physAddr, TTypes.Unknown);
Result := TAst.Identifier(identity, physAddr, TTypes.Unknown);
end
else
Result := Node;
@@ -271,24 +270,23 @@ var
newInit: IAstNode;
newIdent: IIdentifierNode;
isBoxed: Boolean;
identifier: IIdentifierNode;
identIdentity: INamedIdentity;
begin
var identifier := Node.Target.AsIdentifier;
identifier := Node.Target.AsIdentifier;
identIdentity := identifier.Identity.AsNamed;
if not IsValidIdentifier(identifier.Name) then
begin
if Assigned(FLog) then
FLog.AddError(Format('Invalid identifier name: "%s".', [identifier.Name]), Node);
// Continue to try processing the initializer
end;
// Check for duplicates before defining
if FCurrentBuilder.FindSlot(identifier.Name) >= 0 then
begin
if Assigned(FLog) then
FLog.AddError(Format('Variable "%s" is already defined in this scope.', [identifier.Name]), Node);
// Do NOT define the slot to avoid scope corruption.
// Visit initializer to catch errors there, then return original node or dummy.
if Assigned(Node.Initializer) then
Accept(Node.Initializer);
@@ -304,10 +302,13 @@ begin
else
newInit := nil;
newIdent := TAst.Identifier(identifier.Name, addr, TTypes.Unknown);
// Recreate identifier with bound address using original identity
newIdent := TAst.Identifier(identIdentity, addr, TTypes.Unknown);
isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node);
Result := TAst.VarDecl(newIdent, newInit, TTypes.Unknown, isBoxed);
// Recreate variable decl using original identity
Result := TAst.VarDecl(Node.Identity, newIdent, newInit, TTypes.Unknown, isBoxed);
if Assigned(FFunctionRegistry) and (newInit <> nil) and (newInit.Kind = akLambdaExpression) then
FFunctionRegistry.Register(addr, newInit.AsLambdaExpression);
@@ -321,11 +322,10 @@ begin
newIdent := Accept(Node.Target);
newValue := Accept(Node.Value);
Result := TAst.Assign(newIdent.AsIdentifier, newValue, TTypes.Unknown);
Result := TAst.Assign(Node.Identity, newIdent, newValue, TTypes.Unknown);
if Assigned(FFunctionRegistry) and (newValue <> nil) and (newValue.Kind = akLambdaExpression) then
begin
// Only register if it resolved correctly
if newIdent.AsIdentifier.Address.Kind = akLocalOrParent then
FFunctionRegistry.Register(newIdent.AsIdentifier.Address, newValue.AsLambdaExpression);
end;
@@ -343,15 +343,13 @@ var
capturedMap: TUpvalueMap;
sortedPairs: TArray<TPair<TResolvedAddress, Integer>>;
upvaluesList: TArray<TResolvedAddress>;
startCount: Integer;
hasNested: Boolean;
paramIdentity: INamedIdentity;
begin
// 1. Count logic to determine if this lambda has nested lambdas
startCount := FLambdaCounter;
Inc(FLambdaCounter); // Count myself
Inc(FLambdaCounter);
// 2. Push Scope
parentBuilder := FCurrentBuilder;
FCurrentBuilder := TScope.CreateBuilder(parentBuilder);
@@ -364,25 +362,21 @@ begin
SetLength(newParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
var paramName := Node.Parameters[i].Name;
var paramNode := Node.Parameters[i];
var paramName := paramNode.Name;
paramIdentity := paramNode.Identity.AsNamed;
// Check duplicate parameters
if FCurrentBuilder.FindSlot(paramName) >= 0 then
begin
if Assigned(FLog) then
FLog.AddError(Format('Duplicate parameter name "%s".', [paramName]), Node);
// Skip defining this parameter to avoid scope crash, but create a dummy binding
// so index alignment isn't completely broken if we were to continue harder.
// Here we just skip definition.
end
else
FCurrentBuilder.Define(paramName);
// Note: We still create a valid (or attempted) identifier node mapping
// even if definition failed, to keep AST shape consistent.
slot := FCurrentBuilder.FindSlot(paramName); // might return <0 or previous slot if duplicate
slot := FCurrentBuilder.FindSlot(paramName);
if slot < 0 then
slot := 0; // Fallback for duplicates
slot := 0;
addr := TResolvedAddress.Create(akLocalOrParent, 0, slot);
@@ -390,7 +384,8 @@ begin
if (parentBuilder.Parent = nil) and (FArgTypes <> nil) and (i < Length(FArgTypes)) then
paramType := FArgTypes[i];
newParams[i] := TAst.Identifier(paramName, addr, paramType);
// Rebind parameter identifier using original identity
newParams[i] := TAst.Identifier(paramIdentity, addr, paramType);
end;
newBody := Accept(Node.Body);
@@ -421,18 +416,30 @@ begin
FUpvalueStack.Pop;
end;
// 3. Calculate hasNested
// If FLambdaCounter increased by more than just 1 (myself), children were visited.
hasNested := FLambdaCounter > (startCount + 1);
Result := TAst.LambdaExpr(newParams, newBody, finalLayout, nil, upvaluesList, hasNested, Node.IsPure);
// Rebuild Lambda using original identity
Result :=
TAst.LambdaExpr(
Node.Identity,
newParams,
newBody,
finalLayout,
nil, // Descriptor is created in TypeChecker
upvaluesList,
hasNested,
Node.IsPure
);
end;
function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
begin
if Node.Callee.Kind = akKeyword then
begin
var memberAccess := TAst.MemberAccess(Accept(Node.Arguments[0]), Node.Callee.AsKeyword);
// Transform keyword call (:key obj) into member access (.key obj)
// Note: The new MemberAccess node gets the identity of the original FunctionCall
// The member keyword retains its own identity.
var memberAccess := TAst.MemberAccess(Node.Identity, Accept(Node.Arguments[0]), Node.Callee.AsKeyword);
Result := memberAccess;
exit;
end;
Src/AST/Myc.Ast.Compiler.Macros.pas
+19 -43
View File
@@ -23,7 +23,6 @@ type
end;
// Callback used by TMacroExpander to request full compilation and execution of macro arguments.
// This abstracts away the specific Binder, TypeChecker, and Evaluator implementations.
TMacroEvaluatorProc = reference to function(const Scope: IExecutionScope; const Node: IAstNode): TDataValue;
// Handles the expansion of the macro body template (Quasiquotes/Unquotes).
@@ -146,8 +145,6 @@ end;
function TExpansionVisitor.Gensym(const ABaseName: string): string;
begin
// Hygienic macros: Generate unique names for identifiers introduced by the macro
// that were not captured from the arguments.
if not FRenameMap.TryGetValue(ABaseName, Result) then
begin
var count := TInterlocked.Add(FGensymCounter, 1);
@@ -187,7 +184,6 @@ begin
var spliceExpr := node.AsUnquoteSplicing.Expression;
var evaluatedSpliceValue: TDataValue;
// GUARDED EVALUATION
try
evaluatedSpliceValue := FMacroEvaluator(FMacroScope, spliceExpr);
except
@@ -207,7 +203,8 @@ begin
end
else if (not evaluatedSpliceValue.IsVoid) then
begin
newList.Add(TAst.Constant(evaluatedSpliceValue));
// Use Splice Node Identity for the new Constant
newList.Add(TAst.Constant(evaluatedSpliceValue, node.Identity.Location));
end;
end
else
@@ -230,7 +227,8 @@ begin
// Apply hygienic renaming
if FRenameMap.TryGetValue(Node.Name, newName) then
begin
Result := TAst.Identifier(newName, TTypes.Unknown);
// Create new Identifier with new Name but preserve Location from original Node
Result := TAst.Identifier(newName, Node.Identity.Location);
exit;
end;
Result := Node;
@@ -243,19 +241,18 @@ var
begin
newInit := Accept(Node.Initializer);
// Check if target is identifier before trying to rename
if Node.Target.Kind = akIdentifier then
begin
newName := Gensym(Node.Target.AsIdentifier.Name);
newTarget := TAst.Identifier(newName, TTypes.Unknown);
// Use location from original target
newTarget := TAst.Identifier(newName, Node.Target.Identity.Location);
end
else
begin
// Recursively expand unquotes in target position (advanced usage)
newTarget := Accept(Node.Target);
end;
Result := TAst.VarDecl(newTarget, newInit, TTypes.Unknown);
Result := TAst.VarDecl(Node.Identity, newTarget, newInit, TTypes.Unknown, False);
end;
function TExpansionVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
@@ -265,17 +262,18 @@ var
newName: string;
i: Integer;
begin
// Parameters in a macro body must also be renamed hygienically
SetLength(newParams, Length(Node.Parameters));
for i := 0 to High(Node.Parameters) do
begin
newName := Gensym(Node.Parameters[i].Name);
newParams[i] := TAst.Identifier(newName, TTypes.Unknown);
// Use location from original param
newParams[i] := TAst.Identifier(newName, Node.Parameters[i].Identity.Location);
end;
newBody := Accept(Node.Body);
Result := TAst.LambdaExpr(newParams, newBody, nil, nil, nil, False, Node.IsPure, TTypes.Unknown);
// Rebuild structural lambda
Result := TAst.LambdaExpr(Node.Identity, newParams, newBody);
end;
function TExpansionVisitor.VisitUnquote(const Node: IUnquoteNode): IAstNode;
@@ -300,8 +298,6 @@ begin
end;
end;
// Evaluate the expression at compile time.
// This executes user code! It must be guarded.
try
value := FMacroEvaluator(FMacroScope, expr);
except
@@ -318,14 +314,14 @@ begin
end;
if value.Kind in [vkScalar, vkText, vkVoid] then
Result := TAst.Constant(value)
// Create Constant node, inheriting location from the Unquote node
Result := TAst.Constant(value, Node.Identity.Location)
else
raise EMacroException.CreateFmt('Cannot unquote complex runtime value of type %s at compile time.', [value.Kind.ToString]);
end;
function TExpansionVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode;
begin
// ~@ can only be handled within a list context (TransformAndSpliceNodes)
raise EMacroException.Create('Unquote-splicing (`~@`) can only appear inside a list form.');
end;
@@ -335,23 +331,20 @@ var
transformedCallee: IAstNode;
begin
transformedCallee := Self.Accept(Node.Callee);
// Use special splicing logic for argument lists
newArgs := TransformAndSpliceNodes(Node.Arguments);
Result := TAst.FunctionCall(transformedCallee, newArgs);
Result := TAst.FunctionCall(Node.Identity, transformedCallee, newArgs);
end;
function TExpansionVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
var
newExprs: TArray<IAstNode>;
begin
// Use special splicing logic for block expressions
newExprs := TransformAndSpliceNodes(Node.Expressions);
Result := TAst.Block(newExprs);
Result := TAst.Block(Node.Identity, newExprs);
end;
function TExpansionVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode;
begin
// Standard recursion for records
Result := inherited VisitRecordLiteral(Node);
end;
@@ -366,7 +359,6 @@ begin
inherited Create;
FInitialScope := AInitialScope;
FMacroEvaluator := AMacroEvaluator;
// Create a local child registry to handle scoped macro definitions (defmacro inside do)
FCurrentMacroRegistry := ARootRegistry.CreateChildRegistry;
end;
@@ -400,12 +392,11 @@ function TMacroExpander.Execute(const RootNode: IAstNode): IAstNode;
begin
Result := Accept(RootNode);
if not Assigned(Result) then
Result := TAst.Block([]);
Result := TAst.Block([], nil);
end;
function TMacroExpander.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
begin
// Macros defined inside a block should only be visible within that block
EnterMacroScope;
try
Result := inherited VisitBlockExpression(Node);
@@ -426,11 +417,7 @@ end;
function TMacroExpander.VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode;
begin
// Register the macro in the current scope
FCurrentMacroRegistry.Define(Node);
// Remove the definition from the runtime AST (it's compile-time only)
// However, for now we return the node so it can be serialized/inspected,
// but the Evaluator usually ignores it (returns Void).
Result := Node;
end;
@@ -440,7 +427,6 @@ var
macroDef: IMacroDefinitionNode;
i: Integer;
begin
// Check if it is a macro call
if Node.Callee.Kind <> akIdentifier then
exit(inherited VisitFunctionCall(Node));
@@ -449,41 +435,31 @@ begin
if macroDef = nil then
exit(inherited VisitFunctionCall(Node));
// --- Macro Expansion Logic ---
// 1. Create temporary scope for macro arguments (parented to Initial/Global Scope)
// This ensures macro execution is hygienic regarding the environment it runs in.
var expansionScope := TScope.CreateScope(FInitialScope, nil, nil);
var params := macroDef.Parameters;
if Length(Node.Arguments) <> Length(params) then
raise EMacroException.CreateFmt('Macro %s expects %d arguments.', [calleeIdentifier.Name, Length(params)]);
// 2. Populate scope with UN-EVALUATED AST nodes (Code as Data)
for i := 0 to High(params) do
expansionScope.Define(params[i].Name, TDataValue.FromIntf<IAstNode>(Node.Arguments[i]));
// 4. Expand the Macro Body
// We assume the macro body is a Quasiquote. We expand it using the visitor.
var expandedBody := TExpansionVisitor.Expand(expansionScope, macroDef.Body.AsQuasiquote.Expression, FMacroEvaluator);
// 5. Create a MacroExpansionNode to preserve source mapping
var macroNode := TAst.MacroExpansionNode(Node, expandedBody);
// The MacroExpansionNode wraps the expansion, preserving the original call's identity (Source Location)
// for better error reporting.
var macroNode := TAst.MacroExpansionNode(Node.Identity, Node, expandedBody);
// 6. Recursively expand the result (the output of a macro might contain more macro calls)
Result := Self.Accept(macroNode);
end;
function TMacroExpander.VisitQuasiquote(const Node: IQuasiquoteNode): IAstNode;
begin
// Quasiquotes in user code are not expanded by the MacroExpander,
// they are literals.
Result := Node;
end;
function TMacroExpander.VisitUnquote(const Node: IUnquoteNode): IAstNode;
begin
// Unquotes outside of a macro definition/expansion phase are invalid syntax
raise EMacroException.Create('Unquote (`~`) can only be used inside a quasiquote.');
end;
Src/AST/Myc.Ast.Compiler.Specializer.pas
+8 -6
View File
@@ -119,7 +119,7 @@ function TStaticSpecializer.Execute(const RootNode: IAstNode): IAstNode;
begin
Result := Accept(RootNode);
if not Assigned(Result) then
Result := TAst.Block([]);
Result := TAst.Block([], nil);
end;
function TStaticSpecializer.GetStaticRtlFunction(const AName: string; const AArgTypes: TArray<IStaticType>): TSpecializedMethod;
@@ -150,7 +150,7 @@ begin
if (newCallee = Node.Callee) and (newArgs = Node.Arguments) then
Result := Node
else
Result := TAst.FunctionCall(newCallee, newArgs, Node.StaticType, Node.IsTailCall, nil);
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgs, Node.StaticType, Node.IsTailCall, nil);
exit;
end;
@@ -175,7 +175,7 @@ begin
if (newCallee = Node.Callee) and (newArgs = Node.Arguments) then
Result := Node
else
Result := TAst.FunctionCall(newCallee, newArgs, Node.StaticType, Node.IsTailCall, nil);
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgs, Node.StaticType, Node.IsTailCall, nil);
exit;
end;
@@ -189,6 +189,7 @@ begin
// 4a. Cache Hit (Environment)
Result :=
TAst.FunctionCall(
Node.Identity,
newCallee,
newArgs,
specializedMethod.ReturnType,
@@ -208,6 +209,7 @@ begin
Result :=
TAst.FunctionCall(
Node.Identity,
newCallee,
newArgs,
specializedMethod.ReturnType,
@@ -229,7 +231,7 @@ begin
var lambdaDef := funcDef.AsLambdaExpression;
if (Length(lambdaDef.Upvalues) > 0) or (lambdaDef.HasNestedLambdas) then
begin
Result := TAst.FunctionCall(newCallee, newArgs, Node.StaticType, Node.IsTailCall, nil);
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgs, Node.StaticType, Node.IsTailCall, nil);
exit;
end;
end;
@@ -250,7 +252,7 @@ begin
FMonomorphCache.Add(key, specializedMethod);
// 6c. Return the new node
Result := TAst.FunctionCall(newCallee, newArgs, returnType, Node.IsTailCall, compiled.Func, compiled.IsPure);
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgs, returnType, Node.IsTailCall, compiled.Func, compiled.IsPure);
exit;
end;
@@ -258,7 +260,7 @@ begin
if (newCallee = Node.Callee) and (newArgs = Node.Arguments) then
Result := Node
else
Result := TAst.FunctionCall(newCallee, newArgs, Node.StaticType, Node.IsTailCall, nil);
Result := TAst.FunctionCall(Node.Identity, newCallee, newArgs, Node.StaticType, Node.IsTailCall, nil);
end;
{ TMonoCacheKey }
Src/AST/Myc.Ast.Compiler.TCO.pas
+15 -6
View File
@@ -75,7 +75,7 @@ function TAstTCO.Execute(const RootNode: IAstNode): IAstNode;
begin
Result := Accept(RootNode);
if not Assigned(Result) then
Result := TAst.Block([]);
Result := TAst.Block([], nil);
end;
function TAstTCO.Accept(const Node: IAstNode): IAstNode;
@@ -117,7 +117,8 @@ begin
if newExprs = Node.Expressions then
Result := Node
else
Result := TAst.Block(newExprs, Node.StaticType);
// CoW: Reuse Identity
Result := TAst.Block(Node.Identity, newExprs, Node.StaticType);
end;
function TAstTCO.VisitIfExpression(const Node: IIfExpressionNode): IAstNode;
@@ -139,7 +140,8 @@ begin
if (newCond = Node.Condition) and (newThen = Node.ThenBranch) and (newElse = Node.ElseBranch) then
Result := Node
else
Result := TAst.IfExpr(newCond, newThen, newElse, Node.StaticType);
// CoW: Reuse Identity
Result := TAst.IfExpr(Node.Identity, newCond, newThen, newElse, Node.StaticType);
end;
function TAstTCO.VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode;
@@ -161,7 +163,8 @@ begin
if (newCond = Node.Condition) and (newThen = Node.ThenBranch) and (newElse = Node.ElseBranch) then
Result := Node
else
Result := TAst.TernaryExpr(newCond, newThen, newElse, Node.StaticType);
// CoW: Reuse Identity
Result := TAst.TernaryExpr(Node.Identity, newCond, newThen, newElse, Node.StaticType);
end;
function TAstTCO.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
@@ -183,8 +186,10 @@ begin
begin
// Rebuild using factory.
// IMPORTANT: Pass Layout AND Descriptor (TCO runs after TypeChecker).
// CoW: Reuse Identity
Result :=
TAst.LambdaExpr(
Node.Identity,
newParams,
newBody,
Node.Layout,
@@ -211,7 +216,8 @@ begin
if newArgs = Node.Arguments then
Result := Node
else
Result := TAst.Recur(newArgs, Node.StaticType);
// CoW: Reuse Identity
Result := TAst.Recur(Node.Identity, newArgs, Node.StaticType);
end;
function TAstTCO.VisitMacroExpansionNode(const Node: IMacroExpansionNode): IAstNode;
@@ -225,7 +231,8 @@ begin
if newBody = Node.ExpandedBody then
Result := Node
else
Result := TAst.MacroExpansionNode(Node.CallNode, newBody);
// CoW: Reuse Identity
Result := TAst.MacroExpansionNode(Node.Identity, Node.CallNode, newBody);
end;
function TAstTCO.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
@@ -249,8 +256,10 @@ begin
end;
// Use factory to create new node, passing the *new* TCO status
// CoW: Reuse Identity
Result :=
TAst.FunctionCall(
Node.Identity,
newCallee,
newArgs,
Node.StaticType,
Src/AST/Myc.Ast.Compiler.TypeChecker.pas
+87 -48
View File
@@ -12,6 +12,7 @@ uses
Myc.Ast.Visitor,
Myc.Ast.Scope,
Myc.Ast.Types,
Myc.Ast.Identities, // Wichtig für Casts (AsNamed etc.)
Myc.Ast;
type
@@ -107,7 +108,6 @@ begin
begin
if not Assigned(ctx.FParent) then
begin
// Should technically not happen if Binder did its job, but safe guard it.
Result := TTypes.Unknown;
Exit;
end;
@@ -180,7 +180,7 @@ function TTypeChecker.Execute(const RootNode: IAstNode; const Layout: IScopeLayo
begin
Result := Accept(RootNode);
if not Assigned(Result) then
Result := TAst.Block([]);
Result := TAst.Block([], nil);
end;
function TTypeChecker.VisitConstant(const Node: IConstantNode): IAstNode;
@@ -197,18 +197,21 @@ function TTypeChecker.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
var
typ: IStaticType;
adr: TResolvedAddress;
identity: INamedIdentity;
begin
adr := Node.Address;
identity := Node.Identity.AsNamed; // Extract specific identity
// If binder failed to resolve, we propagate Unknown type to prevent cascading errors.
if adr.Kind = akUnresolved then
begin
Result := TAst.Identifier(Node.Name, adr, TTypes.Unknown);
// Propagate identity, set type to Unknown
Result := TAst.Identifier(identity, adr, TTypes.Unknown);
Exit;
end;
typ := FCurrentContext.LookupType(adr);
Result := TAst.Identifier(Node.Name, adr, typ);
// CoW: Reuse Identity
Result := TAst.Identifier(identity, adr, typ);
end;
function TTypeChecker.VisitRecurNode(const Node: IRecurNode): IAstNode;
@@ -220,7 +223,8 @@ begin
for i := 0 to High(Node.Arguments) do
newArgs[i] := Accept(Node.Arguments[i]);
Result := TAst.Recur(newArgs, TTypes.Void);
// CoW: Reuse Identity
Result := TAst.Recur(Node.Identity, newArgs, TTypes.Void);
end;
function TTypeChecker.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
@@ -231,11 +235,14 @@ var
lambdaNode: ILambdaExpressionNode;
placeholderType: IStaticType;
i: Integer;
identNode: IIdentifierNode;
identIdentity: INamedIdentity;
begin
adr := Node.Target.AsIdentifier.Address;
identNode := Node.Target.AsIdentifier;
identIdentity := identNode.Identity.AsNamed;
adr := identNode.Address;
initType := TTypes.Unknown;
// If address is unresolved (binder error), we just process the initializer and return.
if adr.Kind = akUnresolved then
begin
if Assigned(Node.Initializer) then
@@ -271,8 +278,11 @@ begin
if initType.Kind <> stUnknown then
FCurrentContext.SetType(adr.SlotIndex, initType);
newIdent := TAst.Identifier(Node.Target.AsIdentifier.Name, adr, initType);
Result := TAst.VarDecl(newIdent.AsIdentifier, newInitializer, initType, Node.IsBoxed);
// Reuse Identity for Identifier
newIdent := TAst.Identifier(identIdentity, adr, initType);
// Reuse Identity for VarDecl
Result := TAst.VarDecl(Node.Identity, newIdent, newInitializer, initType, Node.IsBoxed);
end;
function TTypeChecker.VisitAssignment(const Node: IAssignmentNode): IAstNode;
@@ -283,12 +293,17 @@ var
lambdaNode: ILambdaExpressionNode;
placeholderType: IStaticType;
i: Integer;
identNode: IIdentifierNode;
identIdentity: INamedIdentity;
begin
newIdent := Accept(Node.Target);
targetType := newIdent.AsTypedNode.StaticType;
adr := newIdent.AsIdentifier.Address;
// Rebuild Identifier with potential type info updates
identNode := Node.Target.AsIdentifier;
identIdentity := identNode.Identity.AsNamed;
newIdent := Accept(Node.Target); // This visits identifier and might update type from context
targetType := newIdent.AsTypedNode.StaticType;
adr := identNode.Address;
// If binder failed, address is unresolved. We still check the value but skip assignment logic.
if adr.Kind = akUnresolved then
begin
Accept(Node.Value);
@@ -316,26 +331,25 @@ begin
newValue := Accept(Node.Value);
sourceType := newValue.AsTypedNode.StaticType;
// Only check assignment if both types are known to avoid cascading error reports
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);
// We continue, effectively ignoring the assignment type-wise (variable keeps old type).
end;
end;
// Type Inference for 'Unknown' targets
if ((targetType.Kind = stUnknown) or Assigned(placeholderType)) and (sourceType.Kind <> stUnknown) then
begin
FCurrentContext.SetType(adr.SlotIndex, sourceType);
newIdent := TAst.Identifier(newIdent.AsIdentifier.Name, adr, sourceType);
// Recreate Identifier with new type and original identity
newIdent := TAst.Identifier(identIdentity, adr, sourceType);
targetType := sourceType;
end;
Result := TAst.Assign(newIdent.AsIdentifier, newValue, targetType);
// CoW: Reuse Assignment Identity
Result := TAst.Assign(Node.Identity, newIdent, newValue, targetType);
end;
function TTypeChecker.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
@@ -348,6 +362,8 @@ var
upvalueAddrs: TArray<TResolvedAddress>;
i: Integer;
finalDescriptor: IScopeDescriptor;
paramIdent: IIdentifierNode;
paramIdentity: INamedIdentity;
begin
upvalueAddrs := Node.Upvalues;
SetLength(upvalueTypes, Length(upvalueAddrs));
@@ -361,23 +377,24 @@ begin
for i := 0 to High(Node.Parameters) do
begin
var paramIdent := Node.Parameters[i];
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(paramIdent.Name, paramAdr, paramTypes[i]);
// CoW: Reuse Parameter Identity
newParams[i] := TAst.Identifier(paramIdentity, paramAdr, paramTypes[i]);
end;
newBody := Accept(Node.Body);
bodyType := newBody.AsTypedNode.StaticType;
methodType := TTypes.CreateMethod(paramTypes, bodyType);
// Set self-reference type (slot 0 is <self>)
FCurrentContext.SetType(0, methodType);
finalDescriptor := TScope.CreateDescriptor(Node.Layout, FCurrentContext.Types);
finally
var temp := FCurrentContext;
@@ -385,8 +402,19 @@ begin
temp.Free;
end;
// CoW: Reuse Lambda Identity
Result :=
TAst.LambdaExpr(newParams, newBody, Node.Layout, finalDescriptor, Node.Upvalues, Node.HasNestedLambdas, Node.IsPure, methodType);
TAst.LambdaExpr(
Node.Identity,
newParams,
newBody,
Node.Layout,
finalDescriptor,
Node.Upvalues,
Node.HasNestedLambdas,
Node.IsPure,
methodType
);
end;
function TTypeChecker.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode;
@@ -449,7 +477,6 @@ begin
retType := bestSig.ReturnType
else
begin
// Log error, but don't crash
if Assigned(FLog) then
begin
argsStr := '';
@@ -460,15 +487,8 @@ begin
Node
);
end;
retType := TTypes.Unknown; // Poison result
retType := TTypes.Unknown;
end;
end
else
begin
// We have unknown arguments (probably due to upstream errors).
// We cannot resolve the signature, so the result is Unknown.
// We do NOT log an error here to avoid spam.
retType := TTypes.Unknown;
end;
end
else if calleeType.Kind <> TStaticTypeKind.stUnknown then
@@ -478,7 +498,17 @@ begin
retType := TTypes.Unknown;
end;
Result := TAst.FunctionCall(newCallee, newArgs, retType, Node.IsTailCall);
// CoW: Reuse Call Identity
Result :=
TAst.FunctionCall(
Node.Identity,
newCallee,
newArgs,
retType,
Node.IsTailCall,
nil, // StaticTarget set by Specializer
False // IsTargetPure set by Specializer
);
end;
function TTypeChecker.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
@@ -496,7 +526,8 @@ begin
else
blockType := TTypes.Void;
Result := TAst.Block(newExprs, blockType);
// CoW: Reuse Block Identity
Result := TAst.Block(Node.Identity, newExprs, blockType);
end;
function TTypeChecker.VisitIfExpression(const Node: IIfExpressionNode): IAstNode;
@@ -509,7 +540,6 @@ begin
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
@@ -531,7 +561,8 @@ begin
resultType := TTypes.Unknown;
end;
Result := TAst.IfExpr(newCond, newThen, newElse, resultType);
// CoW: Reuse If Identity
Result := TAst.IfExpr(Node.Identity, newCond, newThen, newElse, resultType);
end;
function TTypeChecker.VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode;
@@ -563,7 +594,8 @@ begin
resultType := TTypes.Unknown;
end;
Result := TAst.TernaryExpr(newCond, newThen, newElse, resultType);
// CoW: Reuse Ternary Identity
Result := TAst.TernaryExpr(Node.Identity, newCond, newThen, newElse, resultType);
end;
function TTypeChecker.VisitMemberAccess(const Node: IMemberAccessNode): IAstNode;
@@ -616,7 +648,8 @@ begin
end;
end;
Result := TAst.MemberAccess(newBase, newMember.AsKeyword, elemType);
// CoW: Reuse MemberAccess Identity
Result := TAst.MemberAccess(Node.Identity, newBase, newMember.AsKeyword, elemType);
end;
function TTypeChecker.VisitIndexer(const Node: IIndexerNode): IAstNode;
@@ -653,7 +686,8 @@ begin
FLog.AddError(Format('Indexer `[]` requires an Ordinal index, but got %s', [indexType.ToString]), Node);
end;
Result := TAst.Indexer(newBase, newIndex, elemType);
// CoW: Reuse Indexer Identity
Result := TAst.Indexer(Node.Identity, newBase, newIndex, elemType);
end;
function TTypeChecker.VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode;
@@ -705,7 +739,7 @@ begin
begin
def := TScalarRecordRegistry.Intern(scalarDefFields);
staticType := TTypes.CreateRecord(def);
Result := TAst.RecordLiteral(newFields, def, nil, staticType);
Result := TAst.RecordLiteral(Node.Identity, newFields, def, nil, staticType);
end
else
begin
@@ -716,16 +750,19 @@ begin
var genDef := TGenericRecordRegistry.Intern(genDefFields);
staticType := TTypes.CreateGenericRecord(genDef);
Result := TAst.RecordLiteral(newFields, nil, genDef, staticType);
Result := TAst.RecordLiteral(Node.Identity, newFields, nil, genDef, staticType);
end;
end;
function TTypeChecker.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode;
var
elemType: IStaticType;
defIdentity: IDefinitionIdentity;
begin
try
elemType := TTypes.FromScalarKind(TScalar.StringToKind(Node.Definition));
// Use definition from Identity to ensure SSOT
defIdentity := Node.Identity.AsDefinition;
elemType := TTypes.FromScalarKind(TScalar.StringToKind(defIdentity.Definition));
except
on E: Exception do
begin
@@ -735,7 +772,8 @@ begin
end;
end;
Result := TAst.CreateSeries(Node.Definition, TTypes.CreateSeries(elemType));
// CoW: Reuse Definition Identity
Result := TAst.CreateSeries(defIdentity, TTypes.CreateSeries(elemType));
end;
function TTypeChecker.VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode;
@@ -759,7 +797,6 @@ begin
end
else
begin
// Only check assignment compatibility if value type is known
if (valueType.Kind <> stUnknown) and not TTypeRules.CanAssign(seriesType.ElementType, valueType) then
begin
if Assigned(FLog) then
@@ -781,12 +818,13 @@ begin
end;
end;
Result := TAst.AddSeriesItem(newSeries.AsIdentifier, newValue, newLookback, TTypes.Void);
// CoW: Reuse Add Identity
Result := TAst.AddSeriesItem(Node.Identity, newSeries.AsIdentifier, newValue, newLookback, TTypes.Void);
end;
function TTypeChecker.VisitNop(const Node: INopNode): IAstNode;
begin
Result := TAst.Nop(TTypes.Void);
Result := TAst.Nop(Node.Identity, TTypes.Void);
end;
function TTypeChecker.VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode;
@@ -805,7 +843,8 @@ begin
FLog.AddError(Format('"length" requires a series, but got %s', [seriesType.ToString]), Node);
end;
Result := TAst.SeriesLength(newSeries.AsIdentifier, TTypes.Ordinal);
// CoW: Reuse SeriesLength Identity
Result := TAst.SeriesLength(Node.Identity, newSeries.AsIdentifier, TTypes.Ordinal);
end;
end.
Src/AST/Myc.Ast.Nodes.pas
+1412 -80
View File
File diff suppressed because it is too large Load Diff
Src/AST/Myc.Ast.Visitor.pas
+55 -75
View File
@@ -8,7 +8,8 @@ uses
Myc.Data.Value,
Myc.Ast,
Myc.Ast.Types,
Myc.Ast.Nodes;
Myc.Ast.Nodes,
Myc.Ast.Identities; // Needed for identity casting
type
TAstVisitor<T> = class abstract(TInterfacedObject, IAstVisitor)
@@ -36,7 +37,7 @@ type
function IAstVisitor.VisitAddSeriesItem = DoVisitAddSeriesItem;
function IAstVisitor.VisitSeriesLength = DoVisitSeriesLength;
function IAstVisitor.VisitRecurNode = DoVisitRecurNode;
function IAstVisitor.VisitNop = DoVisitNop; // Added Nop
function IAstVisitor.VisitNop = DoVisitNop;
// Private bridge method implementations
function DoVisitConstant(const Node: IConstantNode): TDataValue;
@@ -61,7 +62,7 @@ type
function DoVisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
function DoVisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
function DoVisitRecurNode(const Node: IRecurNode): TDataValue;
function DoVisitNop(const Node: INopNode): TDataValue; // Added Nop
function DoVisitNop(const Node: INopNode): TDataValue;
protected
// Visit a node.
@@ -89,7 +90,7 @@ type
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): T; virtual; abstract;
function VisitSeriesLength(const Node: ISeriesLengthNode): T; virtual; abstract;
function VisitRecurNode(const Node: IRecurNode): T; virtual; abstract;
function VisitNop(const Node: INopNode): T; virtual; abstract; // Added Nop
function VisitNop(const Node: INopNode): T; virtual; abstract;
end;
TAstTransformer = class abstract(TAstVisitor<IAstNode>)
@@ -119,7 +120,7 @@ type
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; // Added Nop
function VisitNop(const Node: INopNode): IAstNode; override;
end;
TAstVisitor = class abstract(TInterfacedObject, IAstVisitor)
@@ -147,7 +148,7 @@ type
function IAstVisitor.VisitAddSeriesItem = DoVisitAddSeriesItem;
function IAstVisitor.VisitSeriesLength = DoVisitSeriesLength;
function IAstVisitor.VisitRecurNode = DoVisitRecurNode;
function IAstVisitor.VisitNop = DoVisitNop; // Added Nop
function IAstVisitor.VisitNop = DoVisitNop;
// Private bridge method implementations
function DoVisitConstant(const Node: IConstantNode): TDataValue;
@@ -172,7 +173,7 @@ type
function DoVisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
function DoVisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
function DoVisitRecurNode(const Node: IRecurNode): TDataValue;
function DoVisitNop(const Node: INopNode): TDataValue; // Added Nop
function DoVisitNop(const Node: INopNode): TDataValue;
protected
// Virtual procedures for descendants (Interpreters/Side-effects) to override
@@ -198,7 +199,7 @@ type
procedure VisitAddSeriesItem(const Node: IAddSeriesItemNode); virtual; abstract;
procedure VisitSeriesLength(const Node: ISeriesLengthNode); virtual; abstract;
procedure VisitRecurNode(const Node: IRecurNode); virtual; abstract;
procedure VisitNop(const Node: INopNode); virtual; abstract; // Added Nop
procedure VisitNop(const Node: INopNode); virtual; abstract;
end;
implementation
@@ -327,7 +328,6 @@ end;
function TAstVisitor<T>.DoVisitNop(const Node: INopNode): TDataValue;
begin
// Added Nop implementation
Result := TDataValue.FromGeneric<T>(VisitNop(Node));
end;
@@ -337,7 +337,6 @@ var
hasChanged: Boolean;
newNode: IIdentifierNode;
begin
// Implement Copy-on-Write for parameter arrays
hasChanged := False;
SetLength(Result, Length(Nodes));
@@ -350,7 +349,7 @@ begin
end;
if not hasChanged then
Result := Nodes; // Return original array if no changes
Result := Nodes;
end;
function TAstTransformer.AcceptNodes(
@@ -359,12 +358,10 @@ function TAstTransformer.AcceptNodes(
): TArray<IAstNode>;
var
i: Integer;
newNode: IAstNode; // Changed from TDataValue
newList: TList<IAstNode>; // Used if nodes are removed (e.g. defmacro)
newNode: IAstNode;
newList: TList<IAstNode>;
hasChanged: Boolean;
begin
// This implementation already supports CoW and node removal (nil)
// We just need to track if the array reference itself needs to change.
hasChanged := False;
newList := nil;
@@ -373,25 +370,24 @@ begin
if Assigned(AcceptProc) then
newNode := AcceptProc(i, Nodes[i])
else
newNode := Accept(Nodes[i]); // Calls new Accept, returns IAstNode (or nil)
newNode := Accept(Nodes[i]);
if not Assigned(newNode) then // Node was removed
if not Assigned(newNode) then
begin
hasChanged := True;
if newList = nil then // First change
if newList = nil then
begin
newList := TList<IAstNode>.Create;
for var j := 0 to i - 1 do
newList.Add(Nodes[j]);
end;
// else: just skip adding it
end
else
begin
if newNode <> Nodes[i] then // Node was replaced
if newNode <> Nodes[i] then
begin
hasChanged := True;
if newList = nil then // First change
if newList = nil then
begin
newList := TList<IAstNode>.Create;
for var j := 0 to i - 1 do
@@ -401,45 +397,43 @@ begin
end
else
begin
if newList <> nil then // No change, but we are already copying
if newList <> nil then
newList.Add(Nodes[i]);
end;
end;
end;
if not hasChanged then
Result := Nodes // Return original array
Result := Nodes
else if newList <> nil then
begin
Result := newList.ToArray;
newList.Free;
end
else
Result := []; // All nodes were removed
Result := [];
end;
// --- Base Virtual Implementations (IAstNode-based) ---
// --- Now fully implementing Copy-on-Write (CoW) ---
// --- Base Virtual Implementations ---
function TAstTransformer.VisitConstant(const Node: IConstantNode): IAstNode;
begin
Result := Node; // Leaf node, immutable
Result := Node;
end;
function TAstTransformer.VisitIdentifier(const Node: IIdentifierNode): IAstNode;
begin
Result := Node; // Leaf node, immutable (will be replaced by Binder)
Result := Node;
end;
function TAstTransformer.VisitKeyword(const Node: IKeywordNode): IAstNode;
begin
Result := Node; // Leaf node, immutable
Result := Node;
end;
function TAstTransformer.VisitNop(const Node: INopNode): IAstNode;
begin
// Added Nop implementation
Result := Node; // Leaf node, immutable
Result := Node;
end;
function TAstTransformer.VisitIfExpression(const Node: IIfExpressionNode): IAstNode;
@@ -448,13 +442,12 @@ var
begin
newCond := Accept(Node.Condition);
newThen := Accept(Node.ThenBranch);
newElse := Accept(Node.ElseBranch); // Accept handles nil
newElse := Accept(Node.ElseBranch);
if (newCond = Node.Condition) and (newThen = Node.ThenBranch) and (newElse = Node.ElseBranch) then
Result := Node
else
// Use TAst factory
Result := TAst.IfExpr(newCond, newThen, newElse, Node.StaticType);
Result := TAst.IfExpr(Node.Identity, newCond, newThen, newElse, Node.StaticType);
end;
function TAstTransformer.VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode;
@@ -468,8 +461,7 @@ begin
if (newCond = Node.Condition) and (newThen = Node.ThenBranch) and (newElse = Node.ElseBranch) then
Result := Node
else
// Use TAst factory
Result := TAst.TernaryExpr(newCond, newThen, newElse, Node.StaticType);
Result := TAst.TernaryExpr(Node.Identity, newCond, newThen, newElse, Node.StaticType);
end;
function TAstTransformer.VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode;
@@ -477,7 +469,6 @@ var
newParams: TArray<IIdentifierNode>;
newBody: IAstNode;
begin
// No longer cast to concrete class, use interface
newParams := AcceptParameters(Node.Parameters);
newBody := Accept(Node.Body);
@@ -485,9 +476,9 @@ begin
Result := Node
else
begin
// Use TAst factory and copy properties via interface getters
Result :=
TAst.LambdaExpr(
Node.Identity,
newParams,
newBody,
Node.Layout,
@@ -512,8 +503,8 @@ begin
Result := Node
else
begin
// Use TAst factory and copy properties via interface getters
Result := TAst.FunctionCall(newCallee, newArgs, Node.StaticType, Node.IsTailCall, Node.StaticTarget);
Result :=
TAst.FunctionCall(Node.Identity, newCallee, newArgs, Node.StaticType, Node.IsTailCall, Node.StaticTarget, Node.IsTargetPure);
end;
end;
@@ -521,13 +512,12 @@ function TAstTransformer.VisitMacroExpansionNode(const Node: IMacroExpansionNode
var
newBody: IAstNode;
begin
// Visit the body and check if it changed
newBody := Accept(Node.ExpandedBody);
if newBody = Node.ExpandedBody then
exit(Node);
// The body changed. Create a NEW wrapper node.
Result := TAst.MacroExpansionNode(Node.CallNode, newBody);
// Macro Expansion Nodes are structural, reuse identity
Result := TAst.MacroExpansionNode(Node.Identity, Node.CallNode, newBody);
end;
function TAstTransformer.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode;
@@ -539,8 +529,7 @@ begin
if newExprs = Node.Expressions then
Result := Node
else
// Use TAst factory
Result := TAst.Block(newExprs, Node.StaticType);
Result := TAst.Block(Node.Identity, newExprs, Node.StaticType);
end;
function TAstTransformer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode;
@@ -555,7 +544,7 @@ begin
Result := Node
else
begin
Result := TAst.VarDecl(newTarget, newInit, Node.StaticType, Node.IsBoxed);
Result := TAst.VarDecl(Node.Identity, newTarget, newInit, Node.StaticType, Node.IsBoxed);
end;
end;
@@ -570,17 +559,13 @@ begin
if (newTarget = Node.Target) and (newValue = Node.Value) then
Result := Node
else
Result := TAst.Assign(newTarget, newValue, Node.StaticType);
Result := TAst.Assign(Node.Identity, newTarget, newValue, Node.StaticType);
end;
function TAstTransformer.VisitMacroDefinition(const Node: IMacroDefinitionNode): IAstNode;
begin
// A macro definition is a compile-time construct.
// Transformers (Binder, TypeChecker, Lowerer) should not traverse its
// children (Name, Parameters, Body) as they are not part of the
// standard execution AST.
// Serializers (TAstDumper/TJsonAstConverter), which need to traverse,
// provide their own override.
// Macro definitions are usually stripped/ignored in transformers,
// but we return them as-is to support partial pipelines.
Result := Node;
end;
@@ -588,37 +573,38 @@ function TAstTransformer.VisitQuasiquote(const Node: IQuasiquoteNode): IAstNode;
var
newExpr: IAstNode;
begin
// Rebuild instead of mutate (Copy-on-Write)
newExpr := Accept(Node.Expression);
if newExpr = Node.Expression then
Result := Node
else
Result := TAst.Quasiquote(newExpr);
Result := TAst.Quasiquote(Node.Identity, newExpr);
end;
function TAstTransformer.VisitUnquote(const Node: IUnquoteNode): IAstNode;
var
newExpr: IAstNode;
begin
// Rebuild instead of mutate (Copy-on-Write)
newExpr := Accept(Node.Expression);
if newExpr = Node.Expression then
Result := Node
else
Result := TAst.Unquote(newExpr);
Result := TAst.Unquote(Node.Identity, newExpr);
end;
function TAstTransformer.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): IAstNode;
var
newExpr: IAstNode;
begin
// Rebuild instead of mutate (Copy-on-Write)
// Note: Accept expects IAstNode, IQuasiquoteNode inherits from it.
newExpr := Accept(Node.Expression);
if (newExpr = Node.Expression) then
Result := Node
else
Result := TAst.UnquoteSplicing(newExpr.AsQuasiquote);
// We need to ensure the transformed expression is still a Quasiquote,
// or we have to assume the transformer knows what it's doing.
// For safety, we cast back. If transformation changed type, this will fail fast.
Result := TAst.UnquoteSplicing(Node.Identity, newExpr.AsQuasiquote);
end;
function TAstTransformer.VisitIndexer(const Node: IIndexerNode): IAstNode;
@@ -631,8 +617,7 @@ begin
if (newBase = Node.Base) and (newIndex = Node.Index) then
Result := Node
else
// Use TAst factory
Result := TAst.Indexer(newBase, newIndex, Node.StaticType);
Result := TAst.Indexer(Node.Identity, newBase, newIndex, Node.StaticType);
end;
function TAstTransformer.VisitMemberAccess(const Node: IMemberAccessNode): IAstNode;
@@ -641,13 +626,12 @@ var
newMember: IKeywordNode;
begin
newBase := Accept(Node.Base);
newMember := Accept(Node.Member).AsKeyword; // Keyword ist Blattknoten
newMember := Accept(Node.Member).AsKeyword;
if (newBase = Node.Base) and (newMember = Node.Member) then
Result := Node
else
// Use TAst factory
Result := TAst.MemberAccess(newBase, newMember, Node.StaticType);
Result := TAst.MemberAccess(Node.Identity, newBase, newMember, Node.StaticType);
end;
function TAstTransformer.VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode;
@@ -661,6 +645,7 @@ begin
for i := 0 to High(Node.Fields) do
begin
// Keys are typically static, but we visit them anyway
newFields[i].Key := Accept(Node.Fields[i].Key).AsKeyword;
newFields[i].Value := Accept(Node.Fields[i].Value);
if (newFields[i].Key <> Node.Fields[i].Key) or (newFields[i].Value <> Node.Fields[i].Value) then
@@ -671,15 +656,13 @@ begin
Result := Node
else
begin
// Rebuild the node, preserving its specific type and definitions
// Use TAst factory
Result := TAst.RecordLiteral(newFields, Node.ScalarDefinition, Node.GenericDefinition, Node.StaticType);
Result := TAst.RecordLiteral(Node.Identity, newFields, Node.ScalarDefinition, Node.GenericDefinition, Node.StaticType);
end;
end;
function TAstTransformer.VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode;
begin
Result := Node; // Leaf node, immutable
Result := Node;
end;
function TAstTransformer.VisitAddSeriesItem(const Node: IAddSeriesItemNode): IAstNode;
@@ -689,13 +672,12 @@ var
begin
newSeries := Accept(Node.Series).AsIdentifier;
newValue := Accept(Node.Value);
newLookback := Accept(Node.Lookback); // Accept handles nil
newLookback := Accept(Node.Lookback);
if (newSeries = Node.Series) and (newValue = Node.Value) and (newLookback = Node.Lookback) then
Result := Node
else
// Use TAst factory
Result := TAst.AddSeriesItem(newSeries, newValue, newLookback, Node.StaticType);
Result := TAst.AddSeriesItem(Node.Identity, newSeries, newValue, newLookback, Node.StaticType);
end;
function TAstTransformer.VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode;
@@ -707,8 +689,7 @@ begin
if newSeries = Node.Series then
Result := Node
else
// Use TAst factory
Result := TAst.SeriesLength(newSeries, Node.StaticType);
Result := TAst.SeriesLength(Node.Identity, newSeries, Node.StaticType);
end;
function TAstTransformer.VisitRecurNode(const Node: IRecurNode): IAstNode;
@@ -720,8 +701,7 @@ begin
if newArgs = Node.Arguments then
Result := Node
else
// Use TAst factory
Result := TAst.Recur(newArgs, Node.StaticType);
Result := TAst.Recur(Node.Identity, newArgs, Node.StaticType);
end;
{ TAstVisitor }
Src/AST/Myc.Ast.pas
+596 -1817
View File
File diff suppressed because it is too large Load Diff
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.