From aff4cec7d56171b0686f0a0d425602cd9f5eca07 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Tue, 25 Nov 2025 19:41:26 +0100 Subject: [PATCH] AST Identities --- Src/AST/Myc.Ast.Compiler.Binder.pas | 79 +- Src/AST/Myc.Ast.Compiler.Macros.pas | 62 +- Src/AST/Myc.Ast.Compiler.Specializer.pas | 14 +- Src/AST/Myc.Ast.Compiler.TCO.pas | 21 +- Src/AST/Myc.Ast.Compiler.TypeChecker.pas | 135 +- Src/AST/Myc.Ast.Nodes.pas | 1492 ++++++++++++- Src/AST/Myc.Ast.Visitor.pas | 130 +- Src/AST/Myc.Ast.pas | 2413 ++++++---------------- Src/AST/Test.Myc.Ast.Compiler.Binder.pas | 138 +- 9 files changed, 2334 insertions(+), 2150 deletions(-) diff --git a/Src/AST/Myc.Ast.Compiler.Binder.pas b/Src/AST/Myc.Ast.Compiler.Binder.pas index f6ea453..a90c0b1 100644 --- a/Src/AST/Myc.Ast.Compiler.Binder.pas +++ b/Src/AST/Myc.Ast.Compiler.Binder.pas @@ -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>; upvaluesList: TArray; - 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; diff --git a/Src/AST/Myc.Ast.Compiler.Macros.pas b/Src/AST/Myc.Ast.Compiler.Macros.pas index 4fbfce4..d04b94c 100644 --- a/Src/AST/Myc.Ast.Compiler.Macros.pas +++ b/Src/AST/Myc.Ast.Compiler.Macros.pas @@ -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; 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(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; diff --git a/Src/AST/Myc.Ast.Compiler.Specializer.pas b/Src/AST/Myc.Ast.Compiler.Specializer.pas index 0f05206..8ce3fed 100644 --- a/Src/AST/Myc.Ast.Compiler.Specializer.pas +++ b/Src/AST/Myc.Ast.Compiler.Specializer.pas @@ -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): 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 } diff --git a/Src/AST/Myc.Ast.Compiler.TCO.pas b/Src/AST/Myc.Ast.Compiler.TCO.pas index ae184f7..c5e938b 100644 --- a/Src/AST/Myc.Ast.Compiler.TCO.pas +++ b/Src/AST/Myc.Ast.Compiler.TCO.pas @@ -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, diff --git a/Src/AST/Myc.Ast.Compiler.TypeChecker.pas b/Src/AST/Myc.Ast.Compiler.TypeChecker.pas index f6abaa5..0745424 100644 --- a/Src/AST/Myc.Ast.Compiler.TypeChecker.pas +++ b/Src/AST/Myc.Ast.Compiler.TypeChecker.pas @@ -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; 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 ) 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. diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index 52123ad..27976b1 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -9,45 +9,25 @@ uses Myc.Data.Value, Myc.Data.Keyword, Myc.Ast.Scope, - Myc.Ast.Types; + Myc.Ast.Types, + Myc.Ast.Identities; type // --- Forward Declarations --- IAstNode = interface; - // --- Identity & Provenance --- - - /// Represents the immutable identity or provenance of an AST node. - /// This allows tracking where a node came from (Parser, Generator, Macro, etc.) - /// without coupling the AST to specific source formats. - IAstIdentity = interface - ['{5C496755-721D-4793-9526-7E2E63357719}'] - function ToString: string; - end; - - /// Specific identity for nodes originating from source code text. - ISourceLocation = interface(IAstIdentity) - ['{98226687-F323-49B0-8D38-61803B225973}'] - function GetLine: Integer; - function GetCol: Integer; - property Line: Integer read GetLine; - property Col: Integer read GetCol; - end; - - // --- Error Handling Infrastructure --- - + // --- Error Handling --- TCompilerErrorLevel = (elHint, elWarning, elError); TCompilerError = record Level: TCompilerErrorLevel; Message: string; - Node: IAstNode; // Context node where the error occurred + Node: IAstNode; constructor Create(ALevel: TCompilerErrorLevel; const AMessage: string; const ANode: IAstNode = nil); function ToString: string; end; ICompilerLog = interface - ['{8E5F2C10-4B3A-49F1-9C2D-7A8B5E6F4D3C}'] procedure Add(ALevel: TCompilerErrorLevel; const AMessage: string; const ANode: IAstNode = nil); procedure AddError(const AMessage: string; const ANode: IAstNode = nil); procedure AddWarning(const AMessage: string; const ANode: IAstNode = nil); @@ -59,7 +39,6 @@ type property Entries: TArray read GetEntries; end; - // Standard implementation of the log TCompilerLog = class(TInterfacedObject, ICompilerLog) private FEntries: TList; @@ -74,10 +53,8 @@ type function GetEntries: TArray; end; - // Base class for all Compiler related exceptions. EAstException = class(Exception); - // The concrete exception thrown at the END of a compilation pass if errors occurred. ECompilationFailed = class(EAstException) private FErrors: TArray; @@ -90,9 +67,9 @@ type // --- AST Interfaces --- IAstVisitor = interface; - IFunctionDefinition = interface; - IIdentifierNode = interface; + IAstTypedNode = interface; IConstantNode = interface; + IIdentifierNode = interface; IKeywordNode = interface; IIfExpressionNode = interface; ITernaryExpressionNode = interface; @@ -114,9 +91,8 @@ type ISeriesLengthNode = interface; IRecurNode = interface; INopNode = interface; - IAstTypedNode = interface; - // Defines the concrete kinds of AST nodes + // Node Kinds & Helpers TAstNodeKind = ( akConstant, akIdentifier, @@ -148,39 +124,7 @@ type function ToString: string; end; - // --- Concrete Type Definitions --- - - TRecordFieldLiteral = record - Key: IKeywordNode; - Value: IAstNode; - constructor Create(const AKey: IKeywordNode; const AValue: IAstNode); - end; - - IAstVisitor = interface - function VisitConstant(const Node: IConstantNode): TDataValue; - function VisitIdentifier(const Node: IIdentifierNode): TDataValue; - function VisitKeyword(const Node: IKeywordNode): TDataValue; - function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; - function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; - function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; - function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; - function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; - function VisitAssignment(const Node: IAssignmentNode): TDataValue; - function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; - function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; - function VisitUnquote(const Node: IUnquoteNode): TDataValue; - function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; - function VisitIndexer(const Node: IIndexerNode): TDataValue; - function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; - function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; - function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; - function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; - function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; - function VisitRecurNode(const Node: IRecurNode): TDataValue; - function VisitNop(const Node: INopNode): TDataValue; - end; + // --- Base Interfaces --- IAstNode = interface {$region 'private'} @@ -190,6 +134,9 @@ type {$endregion} function Accept(const Visitor: IAstVisitor): TDataValue; + // Fluent Casts / Accessors (Interface based) + function AsTypedNode: IAstTypedNode; + function AsConstant: IConstantNode; function AsIdentifier: IIdentifierNode; function AsKeyword: IKeywordNode; @@ -214,8 +161,6 @@ type function AsRecur: IRecurNode; function AsNop: INopNode; - function AsTypedNode: IAstTypedNode; - property IsTyped: Boolean read GetIsTyped; property Kind: TAstNodeKind read GetKind; property Identity: IAstIdentity read GetIdentity; @@ -228,6 +173,9 @@ type property StaticType: IStaticType read GetStaticType; end; + // --- Node Interfaces (Definitions) --- + + // Function Definition (Lambda) IFunctionDefinition = interface(IAstTypedNode) {$region 'private'} function GetBody: IAstNode; @@ -289,15 +237,11 @@ type ILambdaExpressionNode = interface(IFunctionDefinition) {$region 'private'} - function GetParameters: TArray; - function GetBody: IAstNode; function GetLayout: IScopeLayout; function GetDescriptor: IScopeDescriptor; function GetUpvalues: TArray; function GetHasNestedLambdas: Boolean; {$endregion} - property Parameters: TArray read GetParameters; - property Body: IAstNode read GetBody; property Layout: IScopeLayout read GetLayout; property Descriptor: IScopeDescriptor read GetDescriptor; property Upvalues: TArray read GetUpvalues; @@ -412,6 +356,12 @@ type property Member: IKeywordNode read GetMember; end; + TRecordFieldLiteral = record + Key: IKeywordNode; + Value: IAstNode; + constructor Create(const AKey: IKeywordNode; const AValue: IAstNode); + end; + IRecordLiteralNode = interface(IAstTypedNode) {$region 'private'} function GetFields: TArray; @@ -448,12 +398,440 @@ type property Series: IIdentifierNode read GetSeries; end; + IAstVisitor = interface + function VisitConstant(const Node: IConstantNode): TDataValue; + function VisitIdentifier(const Node: IIdentifierNode): TDataValue; + function VisitKeyword(const Node: IKeywordNode): TDataValue; + function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; + function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; + function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; + function VisitMacroExpansionNode(const Node: IMacroExpansionNode): TDataValue; + function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; + function VisitAssignment(const Node: IAssignmentNode): TDataValue; + function VisitMacroDefinition(const Node: IMacroDefinitionNode): TDataValue; + function VisitQuasiquote(const Node: IQuasiquoteNode): TDataValue; + function VisitUnquote(const Node: IUnquoteNode): TDataValue; + function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): TDataValue; + function VisitIndexer(const Node: IIndexerNode): TDataValue; + function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; + function VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue; + function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; + function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; + function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; + function VisitRecurNode(const Node: IRecurNode): TDataValue; + function VisitNop(const Node: INopNode): TDataValue; + end; + IEvaluatorVisitor = interface(IAstVisitor) function Execute(const RootNode: IAstNode): TDataValue; end; TEvaluatorFactory = reference to function(const Scope: IExecutionScope): IEvaluatorVisitor; + TAstNode = class(TInterfacedObject, IAstNode) + private + FIdentity: IAstIdentity; + function GetKind: TAstNodeKind; virtual; abstract; + function GetIsTyped: Boolean; virtual; + function GetIdentity: IAstIdentity; + public + constructor Create(const AIdentity: IAstIdentity); + function Accept(const Visitor: IAstVisitor): TDataValue; virtual; abstract; + + function AsConstant: IConstantNode; virtual; + function AsIdentifier: IIdentifierNode; virtual; + function AsKeyword: IKeywordNode; virtual; + function AsIfExpression: IIfExpressionNode; virtual; + function AsTernaryExpression: ITernaryExpressionNode; virtual; + function AsLambdaExpression: ILambdaExpressionNode; virtual; + function AsFunctionCall: IFunctionCallNode; virtual; + function AsMacroExpansion: IMacroExpansionNode; virtual; + function AsBlockExpression: IBlockExpressionNode; virtual; + function AsVariableDeclaration: IVariableDeclarationNode; virtual; + function AsAssignment: IAssignmentNode; virtual; + function AsMacroDefinition: IMacroDefinitionNode; virtual; + function AsQuasiquote: IQuasiquoteNode; virtual; + function AsUnquote: IUnquoteNode; virtual; + function AsUnquoteSplicing: IUnquoteSplicingNode; virtual; + function AsIndexer: IIndexerNode; virtual; + function AsMemberAccess: IMemberAccessNode; virtual; + function AsRecordLiteral: IRecordLiteralNode; virtual; + function AsCreateSeries: ICreateSeriesNode; virtual; + function AsAddSeriesItem: IAddSeriesItemNode; virtual; + function AsSeriesLength: ISeriesLengthNode; virtual; + function AsRecur: IRecurNode; virtual; + function AsNop: INopNode; virtual; + + function AsTypedNode: IAstTypedNode; virtual; + + property IsTyped: Boolean read GetIsTyped; + property Kind: TAstNodeKind read GetKind; + property Identity: IAstIdentity read GetIdentity; + end; + + TAstTypedNode = class(TAstNode, IAstTypedNode) + private + FStaticType: IStaticType; + function GetStaticType: IStaticType; + function GetIsTyped: Boolean; override; + public + constructor Create(const AStaticType: IStaticType; const AIdentity: IAstIdentity); + function AsTypedNode: IAstTypedNode; override; + property StaticType: IStaticType read GetStaticType; + end; + + TConstantNode = class(TAstTypedNode, IConstantNode) + private + FConstIdentity: IConstantIdentity; // Typed reference for fast access + function GetValue: TDataValue; + function GetKind: TAstNodeKind; override; + public + constructor Create(const AIdentity: IConstantIdentity; const AStaticType: IStaticType); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsConstant: IConstantNode; override; + end; + + TIdentifierNode = class(TAstTypedNode, IIdentifierNode) + private + FNamedIdentity: INamedIdentity; // Typed reference for fast access + FAddress: TResolvedAddress; + function GetAddress: TResolvedAddress; + function GetName: string; + function GetKind: TAstNodeKind; override; + public + constructor Create(const AIdentity: INamedIdentity; const AAddress: TResolvedAddress; const AStaticType: IStaticType); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsIdentifier: IIdentifierNode; override; + end; + + TKeywordNode = class(TAstTypedNode, IKeywordNode) + private + FKeywordIdentity: IKeywordIdentity; + function GetValue: IKeyword; + function GetKind: TAstNodeKind; override; + public + constructor Create(const AIdentity: IKeywordIdentity); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsKeyword: IKeywordNode; override; + end; + + TCreateSeriesNode = class(TAstTypedNode, ICreateSeriesNode) + private + FDefIdentity: IDefinitionIdentity; + function GetDefinition: String; + function GetKind: TAstNodeKind; override; + public + constructor Create(const AIdentity: IDefinitionIdentity; const AStaticType: IStaticType); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsCreateSeries: ICreateSeriesNode; override; + end; + + // --- Structural Nodes (Identity only for location) --- + + TIfExpressionNode = class(TAstTypedNode, IIfExpressionNode) + private + FCondition, FThenBranch, FElseBranch: IAstNode; + function GetCondition: IAstNode; + function GetThenBranch: IAstNode; + function GetElseBranch: IAstNode; + function GetKind: TAstNodeKind; override; + public + constructor Create( + const ACondition, AThenBranch, AElseBranch: IAstNode; + const AStaticType: IStaticType; + const AIdentity: IAstIdentity + ); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsIfExpression: IIfExpressionNode; override; + end; + + TTernaryExpressionNode = class(TAstTypedNode, ITernaryExpressionNode) + private + FCondition, FThenBranch, FElseBranch: IAstNode; + function GetCondition: IAstNode; + function GetThenBranch: IAstNode; + function GetElseBranch: IAstNode; + function GetKind: TAstNodeKind; override; + public + constructor Create( + const ACondition, AThenBranch, AElseBranch: IAstNode; + const AStaticType: IStaticType; + const AIdentity: IAstIdentity + ); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsTernaryExpression: ITernaryExpressionNode; override; + end; + + TLambdaExpressionNode = class(TAstTypedNode, ILambdaExpressionNode, IFunctionDefinition) + private + FParameters: TArray; + FBody: IAstNode; + FLayout: IScopeLayout; + FDescriptor: IScopeDescriptor; + FUpvalues: TArray; + FHasNestedLambdas, FIsPure: Boolean; + function GetParameters: TArray; + function GetBody: IAstNode; + function GetLayout: IScopeLayout; + function GetDescriptor: IScopeDescriptor; + function GetUpvalues: TArray; + function GetHasNestedLambdas: Boolean; + function GetIsPure: Boolean; + function GetKind: TAstNodeKind; override; + public + constructor Create( + const AParameters: TArray; + const ABody: IAstNode; + const AStaticType: IStaticType; + const ALayout: IScopeLayout; + const ADescriptor: IScopeDescriptor; + const AUpvalues: TArray; + const AHasNestedLambdas, AIsPure: Boolean; + const AIdentity: IAstIdentity + ); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsLambdaExpression: ILambdaExpressionNode; override; + end; + + TFunctionCallNode = class(TAstTypedNode, IFunctionCallNode) + private + FCallee: IAstNode; + FArguments: TArray; + FIsTailCall: Boolean; + FStaticTarget: TDataValue.TFunc; + FIsTargetPure: Boolean; + function GetCallee: IAstNode; + function GetArguments: TArray; + function GetIsTailCall: Boolean; + function GetStaticTarget: TDataValue.TFunc; + function GetIsTargetPure: Boolean; + function GetKind: TAstNodeKind; override; + public + constructor Create( + const ACallee: IAstNode; + const AArguments: TArray; + const AStaticType: IStaticType; + const AIsTailCall: Boolean; + const AStaticTarget: TDataValue.TFunc; + const AIsTargetPure: Boolean; + const AIdentity: IAstIdentity + ); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsFunctionCall: IFunctionCallNode; override; + end; + + TMacroDefinitionNode = class(TAstTypedNode, IMacroDefinitionNode) + private + FName: IIdentifierNode; + FParameters: TArray; + FBody: IAstNode; + function GetName: IIdentifierNode; + function GetParameters: TArray; + function GetBody: IAstNode; + function GetKind: TAstNodeKind; override; + public + constructor Create( + const AName: IIdentifierNode; + const AParameters: TArray; + const ABody: IAstNode; + const AIdentity: IAstIdentity + ); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsMacroDefinition: IMacroDefinitionNode; override; + end; + + TMacroExpansionNode = class(TAstTypedNode, IMacroExpansionNode) + private + FCallNode: IFunctionCallNode; + FExpandedBody: IAstNode; + function GetCallNode: IFunctionCallNode; + function GetExpandedBody: IAstNode; + function GetKind: TAstNodeKind; override; + public + constructor Create(const ACallNode: IFunctionCallNode; const AExpandedBody: IAstNode; const AIdentity: IAstIdentity); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsMacroExpansion: IMacroExpansionNode; override; + end; + + TQuasiquoteNode = class(TAstNode, IQuasiquoteNode) + private + FExpression: IAstNode; + function GetExpression: IAstNode; + function GetKind: TAstNodeKind; override; + public + constructor Create(const AExpression: IAstNode; const AIdentity: IAstIdentity); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsQuasiquote: IQuasiquoteNode; override; + end; + + TUnquoteNode = class(TAstNode, IUnquoteNode) + private + FExpression: IAstNode; + function GetExpression: IAstNode; + function GetKind: TAstNodeKind; override; + public + constructor Create(const AExpression: IAstNode; const AIdentity: IAstIdentity); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsUnquote: IUnquoteNode; override; + end; + + TUnquoteSplicingNode = class(TAstNode, IUnquoteSplicingNode) + private + FExpression: IQuasiquoteNode; + function GetExpression: IQuasiquoteNode; + function GetKind: TAstNodeKind; override; + public + constructor Create(const AExpression: IQuasiquoteNode; const AIdentity: IAstIdentity); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsUnquoteSplicing: IUnquoteSplicingNode; override; + end; + + TRecurNode = class(TAstTypedNode, IRecurNode) + private + FArguments: TArray; + function GetArguments: TArray; + function GetKind: TAstNodeKind; override; + public + constructor Create(const AArguments: TArray; const AStaticType: IStaticType; const AIdentity: IAstIdentity); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsRecur: IRecurNode; override; + end; + + TBlockExpressionNode = class(TAstTypedNode, IBlockExpressionNode) + private + FExpressions: TArray; + function GetExpressions: TArray; + function GetKind: TAstNodeKind; override; + public + constructor Create(const AExpressions: array of IAstNode; const AStaticType: IStaticType; const AIdentity: IAstIdentity); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsBlockExpression: IBlockExpressionNode; override; + end; + + TVariableDeclarationNode = class(TAstTypedNode, IVariableDeclarationNode) + private + FTarget, FInitializer: IAstNode; + FIsBoxed: Boolean; + function GetTarget: IAstNode; + function GetInitializer: IAstNode; + function GetIsBoxed: Boolean; + function GetKind: TAstNodeKind; override; + public + constructor Create( + const ATarget: IAstNode; + AInitializer: IAstNode; + const AStaticType: IStaticType; + const AIsBoxed: Boolean; + const AIdentity: IAstIdentity + ); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsVariableDeclaration: IVariableDeclarationNode; override; + end; + + TAssignmentNode = class(TAstTypedNode, IAssignmentNode) + private + FTarget, FValue: IAstNode; + function GetTarget: IAstNode; + function GetValue: IAstNode; + function GetKind: TAstNodeKind; override; + public + constructor Create(const ATarget, AValue: IAstNode; const AStaticType: IStaticType; const AIdentity: IAstIdentity); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsAssignment: IAssignmentNode; override; + end; + + TIndexerNode = class(TAstTypedNode, IIndexerNode) + private + FBase, FIndex: IAstNode; + function GetBase: IAstNode; + function GetIndex: IAstNode; + function GetKind: TAstNodeKind; override; + public + constructor Create(const ABase, AIndex: IAstNode; const AStaticType: IStaticType; const AIdentity: IAstIdentity); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsIndexer: IIndexerNode; override; + end; + + TMemberAccessNode = class(TAstTypedNode, IMemberAccessNode) + private + FBase: IAstNode; + FMember: IKeywordNode; + function GetBase: IAstNode; + function GetMember: IKeywordNode; + function GetKind: TAstNodeKind; override; + public + constructor Create( + const ABase: IAstNode; + const AMember: IKeywordNode; + const AStaticType: IStaticType; + const AIdentity: IAstIdentity + ); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsMemberAccess: IMemberAccessNode; override; + end; + + TRecordLiteralNode = class(TAstTypedNode, IRecordLiteralNode) + private + FFields: TArray; + FScalarDef: IScalarRecordDefinition; + FGenericDef: IGenericRecordDefinition; + function GetFields: TArray; + function GetGenericDefinition: IGenericRecordDefinition; + function GetScalarDefinition: IScalarRecordDefinition; + function GetKind: TAstNodeKind; override; + public + constructor Create( + const AFields: TArray; + const AScalarDef: IScalarRecordDefinition; + const AGenericDef: IGenericRecordDefinition; + const AStaticType: IStaticType; + const AIdentity: IAstIdentity + ); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsRecordLiteral: IRecordLiteralNode; override; + end; + + TAddSeriesItemNode = class(TAstTypedNode, IAddSeriesItemNode) + private + FSeries: IIdentifierNode; + FValue, FLookback: IAstNode; + function GetSeries: IIdentifierNode; + function GetValue: IAstNode; + function GetLookback: IAstNode; + function GetKind: TAstNodeKind; override; + public + constructor Create( + const ASeries: IIdentifierNode; + const AValue, ALookback: IAstNode; + const AStaticType: IStaticType; + const AIdentity: IAstIdentity + ); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsAddSeriesItem: IAddSeriesItemNode; override; + end; + + TSeriesLengthNode = class(TAstTypedNode, ISeriesLengthNode) + private + FSeries: IIdentifierNode; + function GetSeries: IIdentifierNode; + function GetKind: TAstNodeKind; override; + public + constructor Create(const ASeries: IIdentifierNode; const AStaticType: IStaticType; const AIdentity: IAstIdentity); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsSeriesLength: ISeriesLengthNode; override; + end; + + TNopNode = class(TAstTypedNode, INopNode) + private + function GetKind: TAstNodeKind; override; + public + constructor Create(const AStaticType: IStaticType; const AIdentity: IAstIdentity); + function Accept(const Visitor: IAstVisitor): TDataValue; override; + function AsNop: INopNode; override; + end; + implementation uses @@ -490,26 +868,22 @@ end; function TCompilerError.ToString: string; var location: string; - loc: ISourceLocation; begin - // 1. Try to extract location from Node Identity location := ''; - if Assigned(Node) and Assigned(Node.Identity) then + if Assigned(Node) and Assigned(Node.Identity) and Assigned(Node.Identity.Location) then begin - if Supports(Node.Identity, ISourceLocation, loc) then - location := Format('[Line %d, Col %d] ', [loc.Line, loc.Col]) - else - location := Format('[%s] ', [Node.Identity.ToString]); + location := Node.Identity.Location.ToString + ' '; + end + else if Assigned(Node) and Assigned(Node.Identity) then + begin + location := '[' + Node.Identity.ToString + '] '; end; - // 2. Prefix with Level case Level of elHint: Result := '[Hint] '; elWarning: Result := '[Warning] '; elError: Result := '[Error] '; end; - - // 3. Assemble Result := Result + location + Message; end; @@ -595,4 +969,962 @@ begin end; end; +{ TAstNode } + +constructor TAstNode.Create(const AIdentity: IAstIdentity); +begin + inherited Create; + FIdentity := AIdentity; +end; + +function TAstNode.GetIdentity: IAstIdentity; +begin + Result := FIdentity; +end; + +function TAstNode.GetIsTyped: Boolean; +begin + Result := False; +end; + +// Default implementations for As... casting methods (Return nil) +function TAstNode.AsConstant: IConstantNode; +begin + Result := nil; +end; +function TAstNode.AsIdentifier: IIdentifierNode; +begin + Result := nil; +end; +function TAstNode.AsKeyword: IKeywordNode; +begin + Result := nil; +end; +function TAstNode.AsIfExpression: IIfExpressionNode; +begin + Result := nil; +end; +function TAstNode.AsTernaryExpression: ITernaryExpressionNode; +begin + Result := nil; +end; +function TAstNode.AsLambdaExpression: ILambdaExpressionNode; +begin + Result := nil; +end; +function TAstNode.AsFunctionCall: IFunctionCallNode; +begin + Result := nil; +end; +function TAstNode.AsMacroExpansion: IMacroExpansionNode; +begin + Result := nil; +end; +function TAstNode.AsBlockExpression: IBlockExpressionNode; +begin + Result := nil; +end; +function TAstNode.AsVariableDeclaration: IVariableDeclarationNode; +begin + Result := nil; +end; +function TAstNode.AsAssignment: IAssignmentNode; +begin + Result := nil; +end; +function TAstNode.AsMacroDefinition: IMacroDefinitionNode; +begin + Result := nil; +end; +function TAstNode.AsQuasiquote: IQuasiquoteNode; +begin + Result := nil; +end; +function TAstNode.AsUnquote: IUnquoteNode; +begin + Result := nil; +end; +function TAstNode.AsUnquoteSplicing: IUnquoteSplicingNode; +begin + Result := nil; +end; +function TAstNode.AsIndexer: IIndexerNode; +begin + Result := nil; +end; +function TAstNode.AsMemberAccess: IMemberAccessNode; +begin + Result := nil; +end; +function TAstNode.AsRecordLiteral: IRecordLiteralNode; +begin + Result := nil; +end; +function TAstNode.AsCreateSeries: ICreateSeriesNode; +begin + Result := nil; +end; +function TAstNode.AsAddSeriesItem: IAddSeriesItemNode; +begin + Result := nil; +end; +function TAstNode.AsSeriesLength: ISeriesLengthNode; +begin + Result := nil; +end; +function TAstNode.AsRecur: IRecurNode; +begin + Result := nil; +end; +function TAstNode.AsNop: INopNode; +begin + Result := nil; +end; +function TAstNode.AsTypedNode: IAstTypedNode; +begin + Result := nil; +end; + +{ TAstTypedNode } + +constructor TAstTypedNode.Create(const AStaticType: IStaticType; const AIdentity: IAstIdentity); +begin + inherited Create(AIdentity); + FStaticType := AStaticType; +end; + +function TAstTypedNode.GetStaticType: IStaticType; +begin + Result := FStaticType; +end; + +function TAstTypedNode.GetIsTyped: Boolean; +begin + Result := True; +end; + +function TAstTypedNode.AsTypedNode: IAstTypedNode; +begin + Result := Self; +end; + +{ TConstantNode } + +constructor TConstantNode.Create(const AIdentity: IConstantIdentity; const AStaticType: IStaticType); +begin + inherited Create(AStaticType, AIdentity); + FConstIdentity := AIdentity; +end; + +function TConstantNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitConstant(Self); +end; + +function TConstantNode.AsConstant: IConstantNode; +begin + Result := Self; +end; + +function TConstantNode.GetKind: TAstNodeKind; +begin + Result := akConstant; +end; + +function TConstantNode.GetValue: TDataValue; +begin + Result := FConstIdentity.Value; +end; + +{ TIdentifierNode } + +constructor TIdentifierNode.Create(const AIdentity: INamedIdentity; const AAddress: TResolvedAddress; const AStaticType: IStaticType); +begin + inherited Create(AStaticType, AIdentity); + FNamedIdentity := AIdentity; + FAddress := AAddress; +end; + +function TIdentifierNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitIdentifier(Self); +end; + +function TIdentifierNode.AsIdentifier: IIdentifierNode; +begin + Result := Self; +end; + +function TIdentifierNode.GetAddress: TResolvedAddress; +begin + Result := FAddress; +end; + +function TIdentifierNode.GetKind: TAstNodeKind; +begin + Result := akIdentifier; +end; + +function TIdentifierNode.GetName: string; +begin + Result := FNamedIdentity.Name; +end; + +{ TKeywordNode } + +constructor TKeywordNode.Create(const AIdentity: IKeywordIdentity); +begin + inherited Create(TTypes.Keyword, AIdentity); + FKeywordIdentity := AIdentity; +end; + +function TKeywordNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitKeyword(Self); +end; + +function TKeywordNode.AsKeyword: IKeywordNode; +begin + Result := Self; +end; + +function TKeywordNode.GetKind: TAstNodeKind; +begin + Result := akKeyword; +end; + +function TKeywordNode.GetValue: IKeyword; +begin + Result := FKeywordIdentity.Value; +end; + +{ TCreateSeriesNode } + +constructor TCreateSeriesNode.Create(const AIdentity: IDefinitionIdentity; const AStaticType: IStaticType); +begin + inherited Create(AStaticType, AIdentity); + FDefIdentity := AIdentity; +end; + +function TCreateSeriesNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitCreateSeries(Self); +end; + +function TCreateSeriesNode.AsCreateSeries: ICreateSeriesNode; +begin + Result := Self; +end; + +function TCreateSeriesNode.GetDefinition: String; +begin + Result := FDefIdentity.Definition; +end; + +function TCreateSeriesNode.GetKind: TAstNodeKind; +begin + Result := akCreateSeries; +end; + +{ TIfExpressionNode } + +constructor TIfExpressionNode.Create( + const ACondition, AThenBranch, AElseBranch: IAstNode; + const AStaticType: IStaticType; + const AIdentity: IAstIdentity +); +begin + inherited Create(AStaticType, AIdentity); + FCondition := ACondition; + FThenBranch := AThenBranch; + FElseBranch := AElseBranch; +end; + +function TIfExpressionNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitIfExpression(Self); +end; + +function TIfExpressionNode.AsIfExpression: IIfExpressionNode; +begin + Result := Self; +end; + +function TIfExpressionNode.GetCondition: IAstNode; +begin + Result := FCondition; +end; +function TIfExpressionNode.GetThenBranch: IAstNode; +begin + Result := FThenBranch; +end; +function TIfExpressionNode.GetElseBranch: IAstNode; +begin + Result := FElseBranch; +end; +function TIfExpressionNode.GetKind: TAstNodeKind; +begin + Result := akIfExpression; +end; + +{ TTernaryExpressionNode } + +constructor TTernaryExpressionNode.Create( + const ACondition, AThenBranch, AElseBranch: IAstNode; + const AStaticType: IStaticType; + const AIdentity: IAstIdentity +); +begin + inherited Create(AStaticType, AIdentity); + FCondition := ACondition; + FThenBranch := AThenBranch; + FElseBranch := AElseBranch; +end; + +function TTernaryExpressionNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitTernaryExpression(Self); +end; + +function TTernaryExpressionNode.AsTernaryExpression: ITernaryExpressionNode; +begin + Result := Self; +end; + +function TTernaryExpressionNode.GetCondition: IAstNode; +begin + Result := FCondition; +end; +function TTernaryExpressionNode.GetThenBranch: IAstNode; +begin + Result := FThenBranch; +end; +function TTernaryExpressionNode.GetElseBranch: IAstNode; +begin + Result := FElseBranch; +end; +function TTernaryExpressionNode.GetKind: TAstNodeKind; +begin + Result := akTernaryExpression; +end; + +{ TLambdaExpressionNode } + +constructor TLambdaExpressionNode.Create( + const AParameters: TArray; + const ABody: IAstNode; + const AStaticType: IStaticType; + const ALayout: IScopeLayout; + const ADescriptor: IScopeDescriptor; + const AUpvalues: TArray; + const AHasNestedLambdas, AIsPure: Boolean; + const AIdentity: IAstIdentity +); +begin + inherited Create(AStaticType, AIdentity); + FParameters := AParameters; + FBody := ABody; + FLayout := ALayout; + FDescriptor := ADescriptor; + FUpvalues := AUpvalues; + FHasNestedLambdas := AHasNestedLambdas; + FIsPure := AIsPure; +end; + +function TLambdaExpressionNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitLambdaExpression(Self); +end; + +function TLambdaExpressionNode.AsLambdaExpression: ILambdaExpressionNode; +begin + Result := Self; +end; + +function TLambdaExpressionNode.GetBody: IAstNode; +begin + Result := FBody; +end; +function TLambdaExpressionNode.GetParameters: TArray; +begin + Result := FParameters; +end; +function TLambdaExpressionNode.GetLayout: IScopeLayout; +begin + Result := FLayout; +end; +function TLambdaExpressionNode.GetDescriptor: IScopeDescriptor; +begin + Result := FDescriptor; +end; +function TLambdaExpressionNode.GetUpvalues: TArray; +begin + Result := FUpvalues; +end; +function TLambdaExpressionNode.GetHasNestedLambdas: Boolean; +begin + Result := FHasNestedLambdas; +end; +function TLambdaExpressionNode.GetIsPure: Boolean; +begin + Result := FIsPure; +end; +function TLambdaExpressionNode.GetKind: TAstNodeKind; +begin + Result := akLambdaExpression; +end; + +{ TFunctionCallNode } + +constructor TFunctionCallNode.Create( + const ACallee: IAstNode; + const AArguments: TArray; + const AStaticType: IStaticType; + const AIsTailCall: Boolean; + const AStaticTarget: TDataValue.TFunc; + const AIsTargetPure: Boolean; + const AIdentity: IAstIdentity +); +begin + inherited Create(AStaticType, AIdentity); + FCallee := ACallee; + FArguments := AArguments; + FIsTailCall := AIsTailCall; + FStaticTarget := AStaticTarget; + FIsTargetPure := AIsTargetPure; +end; + +function TFunctionCallNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitFunctionCall(Self); +end; + +function TFunctionCallNode.AsFunctionCall: IFunctionCallNode; +begin + Result := Self; +end; + +function TFunctionCallNode.GetCallee: IAstNode; +begin + Result := FCallee; +end; +function TFunctionCallNode.GetArguments: TArray; +begin + Result := FArguments; +end; +function TFunctionCallNode.GetIsTailCall: Boolean; +begin + Result := FIsTailCall; +end; +function TFunctionCallNode.GetStaticTarget: TDataValue.TFunc; +begin + Result := FStaticTarget; +end; +function TFunctionCallNode.GetIsTargetPure: Boolean; +begin + Result := FIsTargetPure; +end; +function TFunctionCallNode.GetKind: TAstNodeKind; +begin + Result := akFunctionCall; +end; + +{ TMacroDefinitionNode } + +constructor TMacroDefinitionNode.Create( + const AName: IIdentifierNode; + const AParameters: TArray; + const ABody: IAstNode; + const AIdentity: IAstIdentity +); +begin + inherited Create(TTypes.Void, AIdentity); + FName := AName; + FParameters := AParameters; + FBody := ABody; +end; + +function TMacroDefinitionNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitMacroDefinition(Self); +end; + +function TMacroDefinitionNode.AsMacroDefinition: IMacroDefinitionNode; +begin + Result := Self; +end; + +function TMacroDefinitionNode.GetName: IIdentifierNode; +begin + Result := FName; +end; +function TMacroDefinitionNode.GetParameters: TArray; +begin + Result := FParameters; +end; +function TMacroDefinitionNode.GetBody: IAstNode; +begin + Result := FBody; +end; +function TMacroDefinitionNode.GetKind: TAstNodeKind; +begin + Result := akMacroDefinition; +end; + +{ TMacroExpansionNode } + +constructor TMacroExpansionNode.Create(const ACallNode: IFunctionCallNode; const AExpandedBody: IAstNode; const AIdentity: IAstIdentity); +begin + if AExpandedBody.IsTyped then + inherited Create(AExpandedBody.AsTypedNode.StaticType, AIdentity) + else + inherited Create(TTypes.Unknown, AIdentity); + FCallNode := ACallNode; + FExpandedBody := AExpandedBody; +end; + +function TMacroExpansionNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitMacroExpansionNode(Self); +end; + +function TMacroExpansionNode.AsMacroExpansion: IMacroExpansionNode; +begin + Result := Self; +end; + +function TMacroExpansionNode.GetCallNode: IFunctionCallNode; +begin + Result := FCallNode; +end; +function TMacroExpansionNode.GetExpandedBody: IAstNode; +begin + Result := FExpandedBody; +end; +function TMacroExpansionNode.GetKind: TAstNodeKind; +begin + Result := akMacroExpansion; +end; + +{ TQuasiquoteNode } + +constructor TQuasiquoteNode.Create(const AExpression: IAstNode; const AIdentity: IAstIdentity); +begin + inherited Create(AIdentity); + FExpression := AExpression; +end; + +function TQuasiquoteNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitQuasiquote(Self); +end; + +function TQuasiquoteNode.AsQuasiquote: IQuasiquoteNode; +begin + Result := Self; +end; + +function TQuasiquoteNode.GetExpression: IAstNode; +begin + Result := FExpression; +end; +function TQuasiquoteNode.GetKind: TAstNodeKind; +begin + Result := akQuasiquote; +end; + +{ TUnquoteNode } + +constructor TUnquoteNode.Create(const AExpression: IAstNode; const AIdentity: IAstIdentity); +begin + inherited Create(AIdentity); + FExpression := AExpression; +end; + +function TUnquoteNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitUnquote(Self); +end; + +function TUnquoteNode.AsUnquote: IUnquoteNode; +begin + Result := Self; +end; + +function TUnquoteNode.GetExpression: IAstNode; +begin + Result := FExpression; +end; +function TUnquoteNode.GetKind: TAstNodeKind; +begin + Result := akUnquote; +end; + +{ TUnquoteSplicingNode } + +constructor TUnquoteSplicingNode.Create(const AExpression: IQuasiquoteNode; const AIdentity: IAstIdentity); +begin + inherited Create(AIdentity); + FExpression := AExpression; +end; + +function TUnquoteSplicingNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitUnquoteSplicing(Self); +end; + +function TUnquoteSplicingNode.AsUnquoteSplicing: IUnquoteSplicingNode; +begin + Result := Self; +end; + +function TUnquoteSplicingNode.GetExpression: IQuasiquoteNode; +begin + Result := FExpression; +end; +function TUnquoteSplicingNode.GetKind: TAstNodeKind; +begin + Result := akUnquoteSplicing; +end; + +{ TRecurNode } + +constructor TRecurNode.Create(const AArguments: TArray; const AStaticType: IStaticType; const AIdentity: IAstIdentity); +begin + inherited Create(AStaticType, AIdentity); + FArguments := AArguments; +end; + +function TRecurNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitRecurNode(Self); +end; + +function TRecurNode.AsRecur: IRecurNode; +begin + Result := Self; +end; + +function TRecurNode.GetArguments: TArray; +begin + Result := FArguments; +end; +function TRecurNode.GetKind: TAstNodeKind; +begin + Result := akRecur; +end; + +{ TBlockExpressionNode } + +constructor TBlockExpressionNode.Create( + const AExpressions: array of IAstNode; + const AStaticType: IStaticType; + const AIdentity: IAstIdentity +); +var + i: Integer; +begin + inherited Create(AStaticType, AIdentity); + SetLength(FExpressions, Length(AExpressions)); + for i := 0 to High(AExpressions) do + FExpressions[i] := AExpressions[i]; +end; + +function TBlockExpressionNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitBlockExpression(Self); +end; + +function TBlockExpressionNode.AsBlockExpression: IBlockExpressionNode; +begin + Result := Self; +end; + +function TBlockExpressionNode.GetExpressions: TArray; +begin + Result := FExpressions; +end; +function TBlockExpressionNode.GetKind: TAstNodeKind; +begin + Result := akBlockExpression; +end; + +{ TVariableDeclarationNode } + +constructor TVariableDeclarationNode.Create( + const ATarget: IAstNode; + AInitializer: IAstNode; + const AStaticType: IStaticType; + const AIsBoxed: Boolean; + const AIdentity: IAstIdentity +); +begin + inherited Create(AStaticType, AIdentity); + FTarget := ATarget; + FInitializer := AInitializer; + FIsBoxed := AIsBoxed; +end; + +function TVariableDeclarationNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitVariableDeclaration(Self); +end; + +function TVariableDeclarationNode.AsVariableDeclaration: IVariableDeclarationNode; +begin + Result := Self; +end; + +function TVariableDeclarationNode.GetTarget: IAstNode; +begin + Result := FTarget; +end; +function TVariableDeclarationNode.GetInitializer: IAstNode; +begin + Result := FInitializer; +end; +function TVariableDeclarationNode.GetIsBoxed: Boolean; +begin + Result := FIsBoxed; +end; +function TVariableDeclarationNode.GetKind: TAstNodeKind; +begin + Result := akVariableDeclaration; +end; + +{ TAssignmentNode } + +constructor TAssignmentNode.Create(const ATarget, AValue: IAstNode; const AStaticType: IStaticType; const AIdentity: IAstIdentity); +begin + inherited Create(AStaticType, AIdentity); + FTarget := ATarget; + FValue := AValue; +end; + +function TAssignmentNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitAssignment(Self); +end; + +function TAssignmentNode.AsAssignment: IAssignmentNode; +begin + Result := Self; +end; + +function TAssignmentNode.GetTarget: IAstNode; +begin + Result := FTarget; +end; +function TAssignmentNode.GetValue: IAstNode; +begin + Result := FValue; +end; +function TAssignmentNode.GetKind: TAstNodeKind; +begin + Result := akAssignment; +end; + +{ TIndexerNode } + +constructor TIndexerNode.Create(const ABase, AIndex: IAstNode; const AStaticType: IStaticType; const AIdentity: IAstIdentity); +begin + inherited Create(AStaticType, AIdentity); + FBase := ABase; + FIndex := AIndex; +end; + +function TIndexerNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitIndexer(Self); +end; + +function TIndexerNode.AsIndexer: IIndexerNode; +begin + Result := Self; +end; + +function TIndexerNode.GetBase: IAstNode; +begin + Result := FBase; +end; +function TIndexerNode.GetIndex: IAstNode; +begin + Result := FIndex; +end; +function TIndexerNode.GetKind: TAstNodeKind; +begin + Result := akIndexer; +end; + +{ TMemberAccessNode } + +constructor TMemberAccessNode.Create( + const ABase: IAstNode; + const AMember: IKeywordNode; + const AStaticType: IStaticType; + const AIdentity: IAstIdentity +); +begin + inherited Create(AStaticType, AIdentity); + FBase := ABase; + FMember := AMember; +end; + +function TMemberAccessNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitMemberAccess(Self); +end; + +function TMemberAccessNode.AsMemberAccess: IMemberAccessNode; +begin + Result := Self; +end; + +function TMemberAccessNode.GetBase: IAstNode; +begin + Result := FBase; +end; +function TMemberAccessNode.GetMember: IKeywordNode; +begin + Result := FMember; +end; +function TMemberAccessNode.GetKind: TAstNodeKind; +begin + Result := akMemberAccess; +end; + +{ TRecordLiteralNode } + +constructor TRecordLiteralNode.Create( + const AFields: TArray; + const AScalarDef: IScalarRecordDefinition; + const AGenericDef: IGenericRecordDefinition; + const AStaticType: IStaticType; + const AIdentity: IAstIdentity +); +begin + inherited Create(AStaticType, AIdentity); + FFields := AFields; + FScalarDef := AScalarDef; + FGenericDef := AGenericDef; +end; + +function TRecordLiteralNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitRecordLiteral(Self); +end; + +function TRecordLiteralNode.AsRecordLiteral: IRecordLiteralNode; +begin + Result := Self; +end; + +function TRecordLiteralNode.GetFields: TArray; +begin + Result := FFields; +end; +function TRecordLiteralNode.GetGenericDefinition: IGenericRecordDefinition; +begin + Result := FGenericDef; +end; +function TRecordLiteralNode.GetScalarDefinition: IScalarRecordDefinition; +begin + Result := FScalarDef; +end; +function TRecordLiteralNode.GetKind: TAstNodeKind; +begin + Result := akRecordLiteral; +end; + +{ TAddSeriesItemNode } + +constructor TAddSeriesItemNode.Create( + const ASeries: IIdentifierNode; + const AValue, ALookback: IAstNode; + const AStaticType: IStaticType; + const AIdentity: IAstIdentity +); +begin + inherited Create(AStaticType, AIdentity); + FSeries := ASeries; + FValue := AValue; + FLookback := ALookback; +end; + +function TAddSeriesItemNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitAddSeriesItem(Self); +end; + +function TAddSeriesItemNode.AsAddSeriesItem: IAddSeriesItemNode; +begin + Result := Self; +end; + +function TAddSeriesItemNode.GetSeries: IIdentifierNode; +begin + Result := FSeries; +end; +function TAddSeriesItemNode.GetValue: IAstNode; +begin + Result := FValue; +end; +function TAddSeriesItemNode.GetLookback: IAstNode; +begin + Result := FLookback; +end; +function TAddSeriesItemNode.GetKind: TAstNodeKind; +begin + Result := akAddSeriesItem; +end; + +{ TSeriesLengthNode } + +constructor TSeriesLengthNode.Create(const ASeries: IIdentifierNode; const AStaticType: IStaticType; const AIdentity: IAstIdentity); +begin + inherited Create(AStaticType, AIdentity); + FSeries := ASeries; +end; + +function TSeriesLengthNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitSeriesLength(Self); +end; + +function TSeriesLengthNode.AsSeriesLength: ISeriesLengthNode; +begin + Result := Self; +end; + +function TSeriesLengthNode.GetSeries: IIdentifierNode; +begin + Result := FSeries; +end; +function TSeriesLengthNode.GetKind: TAstNodeKind; +begin + Result := akSeriesLength; +end; + +{ TNopNode } + +constructor TNopNode.Create(const AStaticType: IStaticType; const AIdentity: IAstIdentity); +begin + inherited Create(AStaticType, AIdentity); +end; + +function TNopNode.Accept(const Visitor: IAstVisitor): TDataValue; +begin + Result := Visitor.VisitNop(Self); +end; + +function TNopNode.AsNop: INopNode; +begin + Result := Self; +end; + +function TNopNode.GetKind: TAstNodeKind; +begin + Result := akNop; +end; + end. diff --git a/Src/AST/Myc.Ast.Visitor.pas b/Src/AST/Myc.Ast.Visitor.pas index 3cedb7d..2f2f7d8 100644 --- a/Src/AST/Myc.Ast.Visitor.pas +++ b/Src/AST/Myc.Ast.Visitor.pas @@ -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 = 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) @@ -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.DoVisitNop(const Node: INopNode): TDataValue; begin - // Added Nop implementation Result := TDataValue.FromGeneric(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; var i: Integer; - newNode: IAstNode; // Changed from TDataValue - newList: TList; // Used if nodes are removed (e.g. defmacro) + newNode: IAstNode; + newList: TList; 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.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.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; 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 } diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 4f7cfcb..c3441dc 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -11,10 +11,10 @@ uses Myc.Data.Keyword, Myc.Ast.Nodes, Myc.Ast.Scope, - Myc.Ast.Types; + Myc.Ast.Types, + Myc.Ast.Identities; type - // Record acting as a namespace for the factory functions. TAst = record public type @@ -32,49 +32,98 @@ type ARegisterLibraries: Boolean = False ): IExecutionScope; static; - // A No-Operation node, used as a placeholder/stub. - class function Nop(const AStaticType: IStaticType = nil; const Identity: IAstIdentity = nil): IAstNode; static; + // ============================================================================= + // 1. NODES WITH DATA IDENTITIES (Identifier, Constant, Keyword, Definition) + // ============================================================================= - // --- Factory functions --- + // --- IDENTIFIERS --- - class function Constant( - const AValue: TDataValue; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil - ): IConstantNode; overload; static; - - class function Constant(const AValue: String; const Identity: IAstIdentity = nil): IConstantNode; overload; static; - - class function Keyword(const AName: string; const Identity: IAstIdentity = nil): IKeywordNode; static; + // [Creation] Raw Name -> New INamedIdentity + class function Identifier(const AName: string; const Loc: ISourceLocation = nil): IIdentifierNode; overload; static; + // [Transformation] Reuse INamedIdentity class function Identifier( - AName: string; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil - ): IIdentifierNode; overload; static; - - class function Identifier( - AName: string; + const Identity: INamedIdentity; const Address: TResolvedAddress; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil + const AStaticType: IStaticType = nil ): IIdentifierNode; overload; static; + // --- CONSTANTS --- + + // [Creation] Raw Value -> New IConstantIdentity + class function Constant(const AValue: TDataValue; const Loc: ISourceLocation = nil): IConstantNode; overload; static; + + class function Constant(const AValue: String; const Loc: ISourceLocation = nil): IConstantNode; overload; static; + + // [Transformation] Reuse IConstantIdentity + class function Constant(const Identity: IConstantIdentity; const AStaticType: IStaticType = nil): IConstantNode; overload; static; + + // --- KEYWORDS --- + + // [Creation] Raw Name -> New IKeywordIdentity + class function Keyword(const AName: string; const Loc: ISourceLocation = nil): IKeywordNode; overload; static; + + // [Transformation] Reuse IKeywordIdentity + class function Keyword(const Identity: IKeywordIdentity): IKeywordNode; overload; static; + + // --- DEFINITIONS (CreateSeries) --- + + // [Creation] Raw Definition String -> New IDefinitionIdentity + class function CreateSeries(const ADefinition: String; const Loc: ISourceLocation = nil): ICreateSeriesNode; overload; static; + + // [Transformation] Reuse IDefinitionIdentity + class function CreateSeries( + const Identity: IDefinitionIdentity; + const AStaticType: IStaticType = nil + ): ICreateSeriesNode; overload; static; + + // ============================================================================= + // 2. STRUCTURAL NODES (Identity is just Location / Marker) + // ============================================================================= + // Creation: Generates new TStructuralIdentity(Loc) + // Transformation: Reuses IAstIdentity passed as first param + + // --- NOP --- + class function Nop(const Loc: ISourceLocation = nil): IAstNode; overload; static; + class function Nop(const Identity: IAstIdentity; const AStaticType: IStaticType = nil): IAstNode; overload; static; + + // --- IF --- class function IfExpr( const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil - ): IIfExpressionNode; static; + const Loc: ISourceLocation = nil + ): IIfExpressionNode; overload; static; + class function IfExpr( + const Identity: IAstIdentity; + const ACondition: IAstNode; + const AThenBranch, AElseBranch: IAstNode; + const AStaticType: IStaticType = nil + ): IIfExpressionNode; overload; static; + + // --- TERNARY --- class function TernaryExpr( const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil - ): ITernaryExpressionNode; static; + const Loc: ISourceLocation = nil + ): ITernaryExpressionNode; overload; static; + + class function TernaryExpr( + const Identity: IAstIdentity; + const ACondition: IAstNode; + const AThenBranch, AElseBranch: IAstNode; + const AStaticType: IStaticType = nil + ): ITernaryExpressionNode; overload; static; + + // --- LAMBDA --- + class function LambdaExpr( + const AParameters: TArray; + const ABody: IAstNode; + const Loc: ISourceLocation = nil + ): ILambdaExpressionNode; overload; static; class function LambdaExpr( + const Identity: IAstIdentity; const AParameters: TArray; const ABody: IAstNode; const ALayout: IScopeLayout = nil; @@ -82,109 +131,186 @@ type const AUpvalues: TArray = nil; const AHasNestedLambdas: Boolean = False; const AIsPure: Boolean = False; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil - ): ILambdaExpressionNode; static; + const AStaticType: IStaticType = nil + ): ILambdaExpressionNode; overload; static; + // --- MACRO DEF --- class function MacroDef( const AName: IIdentifierNode; const AParameters: TArray; const ABody: IAstNode; - const Identity: IAstIdentity = nil - ): IMacroDefinitionNode; static; + const Loc: ISourceLocation = nil + ): IMacroDefinitionNode; overload; static; + + class function MacroDef( + const Identity: IAstIdentity; + const AName: IIdentifierNode; + const AParameters: TArray; + const ABody: IAstNode + ): IMacroDefinitionNode; overload; static; + + // --- QUOTES --- + class function Quasiquote(const AExpression: IAstNode; const Loc: ISourceLocation = nil): IQuasiquoteNode; overload; static; + class function Quasiquote(const Identity: IAstIdentity; const AExpression: IAstNode): IQuasiquoteNode; overload; static; + + class function Unquote(const AExpression: IAstNode; const Loc: ISourceLocation = nil): IUnquoteNode; overload; static; + class function Unquote(const Identity: IAstIdentity; const AExpression: IAstNode): IUnquoteNode; overload; static; - class function Quasiquote(const AExpression: IAstNode; const Identity: IAstIdentity = nil): IQuasiquoteNode; static; - class function Unquote(const AExpression: IAstNode; const Identity: IAstIdentity = nil): IUnquoteNode; static; class function UnquoteSplicing( const AExpression: IQuasiquoteNode; - const Identity: IAstIdentity = nil - ): IUnquoteSplicingNode; static; + const Loc: ISourceLocation = nil + ): IUnquoteSplicingNode; overload; static; + class function UnquoteSplicing( + const Identity: IAstIdentity; + const AExpression: IQuasiquoteNode + ): IUnquoteSplicingNode; overload; static; + + // --- CALL --- + class function FunctionCall( + const ACallee: IAstNode; + const AArguments: TArray; + const Loc: ISourceLocation = nil + ): IFunctionCallNode; overload; static; class function FunctionCall( + const Identity: IAstIdentity; const ACallee: IAstNode; const AArguments: TArray; const AStaticType: IStaticType = nil; const AIsTailCall: Boolean = False; const AStaticTarget: TDataValue.TFunc = nil; - const AIsTargetPure: Boolean = False; - const Identity: IAstIdentity = nil - ): IFunctionCallNode; static; + const AIsTargetPure: Boolean = False + ): IFunctionCallNode; overload; static; + // --- MACRO EXPANSION --- + // Note: MacroExpansion is usually created during transformation, but conceptually it's a new node wrapping the original call. class function MacroExpansionNode( const AOriginalCallNode: IFunctionCallNode; const AExpandedBody: IAstNode; - const Identity: IAstIdentity = nil - ): IMacroExpansionNode; static; + const Loc: ISourceLocation = nil + ): IMacroExpansionNode; overload; static; + + class function MacroExpansionNode( + const Identity: IAstIdentity; + const AOriginalCallNode: IFunctionCallNode; + const AExpandedBody: IAstNode + ): IMacroExpansionNode; overload; static; + + // --- RECUR --- + class function Recur(const AArguments: array of IAstNode; const Loc: ISourceLocation = nil): IRecurNode; overload; static; class function Recur( - const AArguments: array of IAstNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil - ): IRecurNode; static; + const Identity: IAstIdentity; + const AArguments: TArray; + const AStaticType: IStaticType = nil + ): IRecurNode; overload; static; + // --- BLOCK --- class function Block( const AExpressions: array of IAstNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil - ): IBlockExpressionNode; static; + const Loc: ISourceLocation = nil + ): IBlockExpressionNode; overload; static; + class function Block( + const Identity: IAstIdentity; + const AExpressions: TArray; + const AStaticType: IStaticType = nil + ): IBlockExpressionNode; overload; static; + + // --- VAR DECL --- class function VarDecl( const AIdentifier: IAstNode; AInitializer: IAstNode = nil; + const Loc: ISourceLocation = nil + ): IVariableDeclarationNode; overload; static; + + class function VarDecl( + const Identity: IAstIdentity; + const AIdentifier: IAstNode; + AInitializer: IAstNode; const AStaticType: IStaticType = nil; - const AIsBoxed: Boolean = False; - const Identity: IAstIdentity = nil - ): IVariableDeclarationNode; static; + const AIsBoxed: Boolean = False + ): IVariableDeclarationNode; overload; static; + + // --- ASSIGN --- + class function Assign(const ATarget, AValue: IAstNode; const Loc: ISourceLocation = nil): IAssignmentNode; overload; static; class function Assign( + const Identity: IAstIdentity; const ATarget, AValue: IAstNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil - ): IAssignmentNode; static; + const AStaticType: IStaticType = nil + ): IAssignmentNode; overload; static; - class function AssignResult(const AValue: IAstNode; const Identity: IAstIdentity = nil): IAssignmentNode; static; deprecated; + // --- ASSIGN RESULT (Helper) --- + // Special case: Creates implicit nodes. No explicit "Transformation" overload needed as it maps to Assign. + class function AssignResult(const AValue: IAstNode; const Loc: ISourceLocation = nil): IAssignmentNode; static; deprecated; + // --- INDEXER --- class function Indexer( const ABase: IAstNode; const AIndex: IAstNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil - ): IIndexerNode; static; + const Loc: ISourceLocation = nil + ): IIndexerNode; overload; static; + class function Indexer( + const Identity: IAstIdentity; + const ABase: IAstNode; + const AIndex: IAstNode; + const AStaticType: IStaticType = nil + ): IIndexerNode; overload; static; + + // --- MEMBER ACCESS --- class function MemberAccess( const ABase: IAstNode; const AMember: IKeywordNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil - ): IMemberAccessNode; static; + const Loc: ISourceLocation = nil + ): IMemberAccessNode; overload; static; + + class function MemberAccess( + const Identity: IAstIdentity; + const ABase: IAstNode; + const AMember: IKeywordNode; + const AStaticType: IStaticType = nil + ): IMemberAccessNode; overload; static; + + // --- RECORD LITERAL --- + class function RecordLiteral( + const AFields: TArray; + const Loc: ISourceLocation = nil + ): IRecordLiteralNode; overload; static; class function RecordLiteral( + const Identity: IAstIdentity; const AFields: TArray; const AScalarDefinition: IScalarRecordDefinition = nil; const AGenericDefinition: IGenericRecordDefinition = nil; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil - ): IRecordLiteralNode; static; + const AStaticType: IStaticType = nil + ): IRecordLiteralNode; overload; static; - class function CreateSeries( - const ADefinition: String; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil - ): ICreateSeriesNode; static; + // --- SERIES OPS --- class function AddSeriesItem( const ASeries: IIdentifierNode; const AValue: IAstNode; const ALookback: IAstNode = nil; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil - ): IAddSeriesItemNode; static; + const Loc: ISourceLocation = nil + ): IAddSeriesItemNode; overload; static; + + class function AddSeriesItem( + const Identity: IAstIdentity; + const ASeries: IIdentifierNode; + const AValue: IAstNode; + const ALookback: IAstNode; + const AStaticType: IStaticType = nil + ): IAddSeriesItemNode; overload; static; + + class function SeriesLength(const ASeries: IIdentifierNode; const Loc: ISourceLocation = nil): ISeriesLengthNode; overload; static; class function SeriesLength( + const Identity: IAstIdentity; const ASeries: IIdentifierNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil - ): ISeriesLengthNode; static; + const AStaticType: IStaticType = nil + ): ISeriesLengthNode; overload; static; end; @@ -193,465 +319,23 @@ implementation uses System.Generics.Defaults; -type - // --- Concrete Class Definitions --- - - TAstNode = class(TInterfacedObject, IAstNode) - private - FIdentity: IAstIdentity; - function GetKind: TAstNodeKind; virtual; abstract; - function GetIsTyped: Boolean; virtual; - function GetIdentity: IAstIdentity; - public - constructor Create(const AIdentity: IAstIdentity); - function Accept(const Visitor: IAstVisitor): TDataValue; virtual; abstract; - - // --- As... Accessors Implementation --- - function AsConstant: IConstantNode; virtual; - function AsIdentifier: IIdentifierNode; virtual; - function AsKeyword: IKeywordNode; virtual; - function AsIfExpression: IIfExpressionNode; virtual; - function AsTernaryExpression: ITernaryExpressionNode; virtual; - function AsLambdaExpression: ILambdaExpressionNode; virtual; - function AsFunctionCall: IFunctionCallNode; virtual; - function AsMacroExpansion: IMacroExpansionNode; virtual; - function AsBlockExpression: IBlockExpressionNode; virtual; - function AsVariableDeclaration: IVariableDeclarationNode; virtual; - function AsAssignment: IAssignmentNode; virtual; - function AsMacroDefinition: IMacroDefinitionNode; virtual; - function AsQuasiquote: IQuasiquoteNode; virtual; - function AsUnquote: IUnquoteNode; virtual; - function AsUnquoteSplicing: IUnquoteSplicingNode; virtual; - function AsIndexer: IIndexerNode; virtual; - function AsMemberAccess: IMemberAccessNode; virtual; - function AsRecordLiteral: IRecordLiteralNode; virtual; - function AsCreateSeries: ICreateSeriesNode; virtual; - function AsAddSeriesItem: IAddSeriesItemNode; virtual; - function AsSeriesLength: ISeriesLengthNode; virtual; - function AsRecur: IRecurNode; virtual; - function AsNop: INopNode; virtual; - - function AsTypedNode: IAstTypedNode; virtual; - - property IsTyped: Boolean read GetIsTyped; - property Kind: TAstNodeKind read GetKind; - property Identity: IAstIdentity read GetIdentity; - end; - - TAstTypedNode = class(TAstNode, IAstTypedNode) - private - FStaticType: IStaticType; - function GetStaticType: IStaticType; - function GetIsTyped: Boolean; override; - public - constructor Create(const AStaticType: IStaticType; const AIdentity: IAstIdentity); - function AsTypedNode: IAstTypedNode; override; - property StaticType: IStaticType read GetStaticType; - end; - - // Updated TLambdaExpressionNode - TLambdaExpressionNode = class(TAstTypedNode, ILambdaExpressionNode, IFunctionDefinition) - private - FParameters: TArray; - FBody: IAstNode; - FLayout: IScopeLayout; - FDescriptor: IScopeDescriptor; - FUpvalues: TArray; - FHasNestedLambdas: Boolean; - FIsPure: Boolean; - - function GetParameters: TArray; - function GetBody: IAstNode; - function GetLayout: IScopeLayout; - function GetDescriptor: IScopeDescriptor; - function GetUpvalues: TArray; - function GetHasNestedLambdas: Boolean; - function GetIsPure: Boolean; - function GetKind: TAstNodeKind; override; - public - constructor Create( - const AParameters: TArray; - const ABody: IAstNode; - const AStaticType: IStaticType; - const ALayout: IScopeLayout; - const ADescriptor: IScopeDescriptor; - const AUpvalues: TArray; - const AHasNestedLambdas: Boolean; - const AIsPure: Boolean; - const AIdentity: IAstIdentity - ); - destructor Destroy; override; - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsLambdaExpression: ILambdaExpressionNode; override; - end; - - TFunctionCallNode = class(TAstTypedNode, IFunctionCallNode) - private - FCallee: IAstNode; - FArguments: TArray; - FIsTailCall: Boolean; - FStaticTarget: TDataValue.TFunc; - FIsTargetPure: Boolean; - function GetCallee: IAstNode; - function GetArguments: TArray; - function GetIsTailCall: Boolean; - function GetStaticTarget: TDataValue.TFunc; - function GetIsTargetPure: Boolean; - function GetKind: TAstNodeKind; override; - public - constructor Create( - const ACallee: IAstNode; - const AArguments: TArray; - const AStaticType: IStaticType; - const AIsTailCall: Boolean; - const AStaticTarget: TDataValue.TFunc; - const AIsTargetPure: Boolean; - const AIdentity: IAstIdentity - ); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsFunctionCall: IFunctionCallNode; override; - end; - - TVariableDeclarationNode = class(TAstTypedNode, IVariableDeclarationNode) - private - FInitializer: IAstNode; - FTarget: IAstNode; - FIsBoxed: Boolean; - function GetTarget: IAstNode; - function GetInitializer: IAstNode; - function GetIsBoxed: Boolean; - function GetKind: TAstNodeKind; override; - public - constructor Create( - const ATarget: IAstNode; - AInitializer: IAstNode; - const AStaticType: IStaticType; - const AIsBoxed: Boolean; - const AIdentity: IAstIdentity - ); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsVariableDeclaration: IVariableDeclarationNode; override; - end; - - TConstantNode = class(TAstTypedNode, IConstantNode) - private - FValue: TDataValue; - function GetValue: TDataValue; - function GetKind: TAstNodeKind; override; - public - constructor Create(const AValue: TDataValue; const AStaticType: IStaticType; const AIdentity: IAstIdentity); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsConstant: IConstantNode; override; - property Value: TDataValue read GetValue; - end; - - TIdentifierNode = class(TAstTypedNode, IIdentifierNode) - private - FAddress: TResolvedAddress; - FName: string; - function GetAddress: TResolvedAddress; - function GetName: string; - function GetKind: TAstNodeKind; override; - public - constructor Create( - const AName: string; - const AAddress: TResolvedAddress; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity - ); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsIdentifier: IIdentifierNode; override; - property Address: TResolvedAddress read GetAddress; - property Name: string read FName; - end; - - TKeywordNode = class(TAstTypedNode, IKeywordNode) - private - FValue: IKeyword; - function GetValue: IKeyword; - function GetKind: TAstNodeKind; override; - public - constructor Create(const AValue: IKeyword; const AIdentity: IAstIdentity); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsKeyword: IKeywordNode; override; - property Value: IKeyword read FValue; - end; - - TMacroDefinitionNode = class(TAstTypedNode, IMacroDefinitionNode) - private - FName: IIdentifierNode; - FParameters: TArray; - FBody: IAstNode; - function GetName: IIdentifierNode; - function GetParameters: TArray; - function GetBody: IAstNode; - function GetKind: TAstNodeKind; override; - public - constructor Create( - const AName: IIdentifierNode; - const AParameters: TArray; - const ABody: IAstNode; - const AIdentity: IAstIdentity - ); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsMacroDefinition: IMacroDefinitionNode; override; - property Name: IIdentifierNode read GetName; - property Parameters: TArray read FParameters; - property Body: IAstNode read FBody; - end; - - TQuasiquoteNode = class(TAstNode, IQuasiquoteNode) - private - FExpression: IAstNode; - function GetExpression: IAstNode; - function GetKind: TAstNodeKind; override; - public - constructor Create(const AExpression: IAstNode; const AIdentity: IAstIdentity); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsQuasiquote: IQuasiquoteNode; override; - property Expression: IAstNode read GetExpression; - end; - - TUnquoteNode = class(TAstNode, IUnquoteNode) - private - FExpression: IAstNode; - function GetExpression: IAstNode; - function GetKind: TAstNodeKind; override; - public - constructor Create(const AExpression: IAstNode; const AIdentity: IAstIdentity); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsUnquote: IUnquoteNode; override; - property Expression: IAstNode read GetExpression; - end; - - TUnquoteSplicingNode = class(TAstNode, IUnquoteSplicingNode) - private - FExpression: IQuasiquoteNode; - function GetExpression: IQuasiquoteNode; - function GetKind: TAstNodeKind; override; - public - constructor Create(const AExpression: IQuasiquoteNode; const AIdentity: IAstIdentity); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsUnquoteSplicing: IUnquoteSplicingNode; override; - property Expression: IQuasiquoteNode read GetExpression; - end; - - TMacroExpansionNode = class(TAstTypedNode, IMacroExpansionNode) - private - FCallNode: IFunctionCallNode; - FExpandedBody: IAstNode; - function GetCallNode: IFunctionCallNode; - function GetExpandedBody: IAstNode; - function GetKind: TAstNodeKind; override; - public - constructor Create(const ACallNode: IFunctionCallNode; const AExpandedBody: IAstNode; const AIdentity: IAstIdentity); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsMacroExpansion: IMacroExpansionNode; override; - property CallNode: IFunctionCallNode read GetCallNode; - property ExpandedBody: IAstNode read FExpandedBody; - end; - - TRecurNode = class(TAstTypedNode, IRecurNode) - private - FArguments: TArray; - function GetArguments: TArray; - function GetKind: TAstNodeKind; override; - public - constructor Create(const AArguments: TArray; const AStaticType: IStaticType; const AIdentity: IAstIdentity); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsRecur: IRecurNode; override; - property Arguments: TArray read FArguments; - end; - - TBlockExpressionNode = class(TAstTypedNode, IBlockExpressionNode) - private - FExpressions: TArray; - function GetExpressions: TArray; - function GetKind: TAstNodeKind; override; - public - constructor Create(const AExpressions: array of IAstNode; const AStaticType: IStaticType; const AIdentity: IAstIdentity); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsBlockExpression: IBlockExpressionNode; override; - property Expressions: TArray read FExpressions; - end; - - TIfExpressionNode = class(TAstTypedNode, IIfExpressionNode) - private - FCondition: IAstNode; - FThenBranch: IAstNode; - FElseBranch: IAstNode; - function GetCondition: IAstNode; - function GetThenBranch: IAstNode; - function GetElseBranch: IAstNode; - function GetKind: TAstNodeKind; override; - public - constructor Create( - const ACondition, AThenBranch, AElseBranch: IAstNode; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity - ); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsIfExpression: IIfExpressionNode; override; - property Condition: IAstNode read FCondition; - property ThenBranch: IAstNode read FThenBranch; - property ElseBranch: IAstNode read FElseBranch; - end; - - TTernaryExpressionNode = class(TAstTypedNode, ITernaryExpressionNode) - private - FCondition: IAstNode; - FThenBranch: IAstNode; - FElseBranch: IAstNode; - function GetCondition: IAstNode; - function GetThenBranch: IAstNode; - function GetElseBranch: IAstNode; - function GetKind: TAstNodeKind; override; - public - constructor Create( - const ACondition, AThenBranch, AElseBranch: IAstNode; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity - ); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsTernaryExpression: ITernaryExpressionNode; override; - property Condition: IAstNode read FCondition; - property ThenBranch: IAstNode read FThenBranch; - property ElseBranch: IAstNode read FElseBranch; - end; - - TAssignmentNode = class(TAstTypedNode, IAssignmentNode) - private - FTarget: IAstNode; - FValue: IAstNode; - function GetTarget: IAstNode; - function GetValue: IAstNode; - function GetKind: TAstNodeKind; override; - public - constructor Create(const ATarget: IAstNode; const AValue: IAstNode; const AStaticType: IStaticType; const AIdentity: IAstIdentity); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsAssignment: IAssignmentNode; override; - property Target: IAstNode read FTarget; - property Value: IAstNode read FValue; - end; - - TIndexerNode = class(TAstTypedNode, IIndexerNode) - private - FBase: IAstNode; - FIndex: IAstNode; - function GetBase: IAstNode; - function GetIndex: IAstNode; - function GetKind: TAstNodeKind; override; - public - constructor Create(const ABase: IAstNode; const AIndex: IAstNode; const AStaticType: IStaticType; const AIdentity: IAstIdentity); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsIndexer: IIndexerNode; override; - property Base: IAstNode read FBase; - property Index: IAstNode read FIndex; - end; - - TMemberAccessNode = class(TAstTypedNode, IMemberAccessNode) - private - FBase: IAstNode; - FMember: IKeywordNode; - function GetBase: IAstNode; - function GetMember: IKeywordNode; - function GetKind: TAstNodeKind; override; - public - constructor Create( - const ABase: IAstNode; - const AMember: IKeywordNode; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity - ); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsMemberAccess: IMemberAccessNode; override; - property Base: IAstNode read FBase; - property Member: IKeywordNode read FMember; - end; - - TCreateSeriesNode = class(TAstTypedNode, ICreateSeriesNode) - private - FDefinition: String; - function GetDefinition: String; - function GetKind: TAstNodeKind; override; - public - constructor Create(const ADefinition: String; const AStaticType: IStaticType; const AIdentity: IAstIdentity); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsCreateSeries: ICreateSeriesNode; override; - property Definition: String read FDefinition; - end; - - TAddSeriesItemNode = class(TAstTypedNode, IAddSeriesItemNode) - private - FSeries: IIdentifierNode; - FValue: IAstNode; - FLookback: IAstNode; - function GetSeries: IIdentifierNode; - function GetValue: IAstNode; - function GetLookback: IAstNode; - function GetKind: TAstNodeKind; override; - public - constructor Create( - const ASeries: IIdentifierNode; - const AValue: IAstNode; - const ALookback: IAstNode; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity - ); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsAddSeriesItem: IAddSeriesItemNode; override; - property Series: IIdentifierNode read FSeries; - property Value: IAstNode read FValue; - property Lookback: IAstNode read FLookback; - end; - - TSeriesLengthNode = class(TAstTypedNode, ISeriesLengthNode) - private - FSeries: IIdentifierNode; - function GetSeries: IIdentifierNode; - function GetKind: TAstNodeKind; override; - public - constructor Create(const ASeries: IIdentifierNode; const AStaticType: IStaticType; const AIdentity: IAstIdentity); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsSeriesLength: ISeriesLengthNode; override; - property Series: IIdentifierNode read FSeries; - end; - - TRecordLiteralNode = class(TAstTypedNode, IRecordLiteralNode) - private - FFields: TArray; - FScalarDefinition: IScalarRecordDefinition; - FGenericDefinition: IGenericRecordDefinition; - function GetFields: TArray; - function GetGenericDefinition: IGenericRecordDefinition; - function GetKind: TAstNodeKind; override; - function GetScalarDefinition: IScalarRecordDefinition; - public - constructor Create( - const AFields: TArray; - const AScalarDefinition: IScalarRecordDefinition; - const AGenericDefinition: IGenericRecordDefinition; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity - ); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsRecordLiteral: IRecordLiteralNode; override; - property Fields: TArray read FFields; - property ScalarDefinition: IScalarRecordDefinition read GetScalarDefinition; - property GenericDefinition: IGenericRecordDefinition read GetGenericDefinition; - end; - - TNopNode = class(TAstTypedNode, INopNode) - private - function GetKind: TAstNodeKind; override; - public - constructor Create(const AStaticType: IStaticType; const AIdentity: IAstIdentity); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsNop: INopNode; override; - end; - { TAst } +class constructor TAst.Create; +begin + FLibraries := TList.Create; +end; + +class destructor TAst.Destroy; +begin + FLibraries.Free; +end; + +class procedure TAst.RegisterLibrary(const AProc: TRegisterLibraryProc); +begin + FLibraries.Add(AProc); +end; + class function TAst.CreateScope( Parent: IExecutionScope; const Descriptor: IScopeDescriptor = nil; @@ -670,188 +354,131 @@ begin end; end; -class function TAst.CreateSeries( - const ADefinition: String; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil -): ICreateSeriesNode; -begin - Result := - TCreateSeriesNode.Create( - ADefinition, - if AStaticType <> nil then AStaticType - else TTypes.Unknown, - Identity - ); -end; +// ============================================================================= +// IMPLEMENTATION: DATA NODES +// ============================================================================= -class function TAst.AddSeriesItem( - const ASeries: IIdentifierNode; - const AValue: IAstNode; - const ALookback: IAstNode = nil; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil -): IAddSeriesItemNode; -begin - Result := - TAddSeriesItemNode.Create( - ASeries, - AValue, - ALookback, - if AStaticType <> nil then AStaticType - else TTypes.Void, - Identity - ); -end; +// --- Identifier --- -class function TAst.SeriesLength( - const ASeries: IIdentifierNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil -): ISeriesLengthNode; +class function TAst.Identifier(const AName: string; const Loc: ISourceLocation): IIdentifierNode; begin - Result := - TSeriesLengthNode.Create( - ASeries, - if AStaticType <> nil then AStaticType - else TTypes.Ordinal, - Identity - ); -end; - -class function TAst.Assign( - const ATarget, AValue: IAstNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil -): IAssignmentNode; -begin - Result := - TAssignmentNode.Create( - ATarget, - AValue, - if AStaticType <> nil then AStaticType - else TTypes.Unknown, - Identity - ); -end; - -class function TAst.AssignResult(const AValue: IAstNode; const Identity: IAstIdentity = nil): IAssignmentNode; -begin - Result := TAssignmentNode.Create(TAst.Identifier('Result', nil, Identity), AValue, TTypes.Unknown, Identity); -end; - -class function TAst.Block( - const AExpressions: array of IAstNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil -): IBlockExpressionNode; -begin - Result := - TBlockExpressionNode.Create( - AExpressions, - if AStaticType <> nil then AStaticType - else TTypes.Unknown, - Identity - ); -end; - -class function TAst.Constant( - const AValue: TDataValue; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil -): IConstantNode; -begin - var constType := AStaticType; - if constType = nil then - begin - case AValue.Kind of - TDataValueKind.vkScalar: constType := TTypes.FromScalarKind(AValue.AsScalar.Kind); - TDataValueKind.vkText: constType := TTypes.Text; - TDataValueKind.vkVoid: constType := TTypes.Void; - else - constType := TTypes.Unknown; - end; - end; - Result := TConstantNode.Create(AValue, constType, Identity); -end; - -class function TAst.Constant(const AValue: String; const Identity: IAstIdentity = nil): IConstantNode; -begin - Result := TConstantNode.Create(AValue, TTypes.Text, Identity); -end; - -class constructor TAst.Create; -begin - FLibraries := TList.Create; -end; - -class destructor TAst.Destroy; -begin - FLibraries.Free; -end; - -class procedure TAst.RegisterLibrary(const AProc: TRegisterLibraryProc); -begin - FLibraries.Add(AProc); -end; - -class function TAst.FunctionCall( - const ACallee: IAstNode; - const AArguments: TArray; - const AStaticType: IStaticType = nil; - const AIsTailCall: Boolean = False; - const AStaticTarget: TDataValue.TFunc = nil; - const AIsTargetPure: Boolean = False; - const Identity: IAstIdentity = nil -): IFunctionCallNode; -begin - Result := - TFunctionCallNode.Create( - ACallee, - AArguments, - if AStaticType <> nil then AStaticType - else TTypes.Unknown, - AIsTailCall, - AStaticTarget, - AIsTargetPure, - Identity - ); -end; - -class function TAst.Identifier(AName: string; const AStaticType: IStaticType = nil; const Identity: IAstIdentity = nil): IIdentifierNode; -begin - Result := - TIdentifierNode.Create( - AName, - Default(TResolvedAddress), - if AStaticType <> nil then AStaticType - else TTypes.Unknown, - Identity - ); + var id := TIdentities.Identifier(AName, Loc); + Result := TIdentifierNode.Create(id, Default(TResolvedAddress), TTypes.Unknown); end; class function TAst.Identifier( - AName: string; + const Identity: INamedIdentity; const Address: TResolvedAddress; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil + const AStaticType: IStaticType ): IIdentifierNode; begin Result := TIdentifierNode.Create( - AName, + Identity, Address, + if AStaticType <> nil then AStaticType + else TTypes.Unknown + ); +end; + +// --- Constant --- + +class function TAst.Constant(const AValue: TDataValue; const Loc: ISourceLocation): IConstantNode; +begin + var constType: IStaticType; + case AValue.Kind of + TDataValueKind.vkScalar: constType := TTypes.FromScalarKind(AValue.AsScalar.Kind); + TDataValueKind.vkText: constType := TTypes.Text; + TDataValueKind.vkVoid: constType := TTypes.Void; + else + constType := TTypes.Unknown; + end; + + var id := TIdentities.Constant(AValue, Loc); + Result := TConstantNode.Create(id, constType); +end; + +class function TAst.Constant(const AValue: String; const Loc: ISourceLocation): IConstantNode; +begin + Result := TAst.Constant(TDataValue(AValue), Loc); +end; + +class function TAst.Constant(const Identity: IConstantIdentity; const AStaticType: IStaticType): IConstantNode; +begin + Result := + TConstantNode.Create( + Identity, + if AStaticType <> nil then AStaticType + else TTypes.Unknown + ); +end; + +// --- Keyword --- + +class function TAst.Keyword(const AName: string; const Loc: ISourceLocation): IKeywordNode; +begin + var val := TKeywordRegistry.Intern(AName); + var id := TIdentities.Keyword(val, Loc); + Result := TKeywordNode.Create(id); +end; + +class function TAst.Keyword(const Identity: IKeywordIdentity): IKeywordNode; +begin + Result := TKeywordNode.Create(Identity); +end; + +// --- CreateSeries --- + +class function TAst.CreateSeries(const ADefinition: String; const Loc: ISourceLocation): ICreateSeriesNode; +begin + var id := TIdentities.Definition(ADefinition, Loc); + Result := TCreateSeriesNode.Create(id, TTypes.Unknown); +end; + +class function TAst.CreateSeries(const Identity: IDefinitionIdentity; const AStaticType: IStaticType): ICreateSeriesNode; +begin + Result := + TCreateSeriesNode.Create( + Identity, + if AStaticType <> nil then AStaticType + else TTypes.Unknown + ); +end; + +// ============================================================================= +// IMPLEMENTATION: STRUCTURAL NODES +// ============================================================================= + +// --- NOP --- + +class function TAst.Nop(const Loc: ISourceLocation): IAstNode; +begin + var id := TIdentities.Structural(Loc); + Result := TNopNode.Create(TTypes.Unknown, id); +end; + +class function TAst.Nop(const Identity: IAstIdentity; const AStaticType: IStaticType): IAstNode; +begin + Result := + TNopNode.Create( if AStaticType <> nil then AStaticType else TTypes.Unknown, Identity ); end; +// --- IfExpr --- + +class function TAst.IfExpr(const ACondition, AThenBranch, AElseBranch: IAstNode; const Loc: ISourceLocation): IIfExpressionNode; +begin + var id := TIdentities.Structural(Loc); + Result := TIfExpressionNode.Create(ACondition, AThenBranch, AElseBranch, TTypes.Unknown, id); +end; + class function TAst.IfExpr( - const ACondition: IAstNode; - const AThenBranch, AElseBranch: IAstNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil + const Identity: IAstIdentity; + const ACondition, AThenBranch, AElseBranch: IAstNode; + const AStaticType: IStaticType ): IIfExpressionNode; begin Result := @@ -865,38 +492,52 @@ begin ); end; -class function TAst.Indexer( - const ABase: IAstNode; - const AIndex: IAstNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil -): IIndexerNode; +// --- TernaryExpr --- + +class function TAst.TernaryExpr(const ACondition, AThenBranch, AElseBranch: IAstNode; const Loc: ISourceLocation): ITernaryExpressionNode; +begin + var id := TIdentities.Structural(Loc); + Result := TTernaryExpressionNode.Create(ACondition, AThenBranch, AElseBranch, TTypes.Unknown, id); +end; + +class function TAst.TernaryExpr( + const Identity: IAstIdentity; + const ACondition, AThenBranch, AElseBranch: IAstNode; + const AStaticType: IStaticType +): ITernaryExpressionNode; begin Result := - TIndexerNode.Create( - ABase, - AIndex, + TTernaryExpressionNode.Create( + ACondition, + AThenBranch, + AElseBranch, if AStaticType <> nil then AStaticType else TTypes.Unknown, Identity ); end; -class function TAst.Keyword(const AName: string; const Identity: IAstIdentity = nil): IKeywordNode; -begin - Result := TKeywordNode.Create(TKeywordRegistry.Intern(AName), Identity); -end; +// --- LambdaExpr --- class function TAst.LambdaExpr( const AParameters: TArray; const ABody: IAstNode; - const ALayout: IScopeLayout = nil; - const ADescriptor: IScopeDescriptor = nil; - const AUpvalues: TArray = nil; - const AHasNestedLambdas: Boolean = False; - const AIsPure: Boolean = False; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil + const Loc: ISourceLocation +): ILambdaExpressionNode; +begin + var id := TIdentities.Structural(Loc); + Result := TLambdaExpressionNode.Create(AParameters, ABody, TTypes.Unknown, nil, nil, nil, False, False, id); +end; + +class function TAst.LambdaExpr( + const Identity: IAstIdentity; + const AParameters: TArray; + const ABody: IAstNode; + const ALayout: IScopeLayout; + const ADescriptor: IScopeDescriptor; + const AUpvalues: TArray; + const AHasNestedLambdas, AIsPure: Boolean; + const AStaticType: IStaticType ): ILambdaExpressionNode; begin Result := @@ -914,57 +555,123 @@ begin ); end; +// --- MacroDef --- + class function TAst.MacroDef( const AName: IIdentifierNode; const AParameters: TArray; const ABody: IAstNode; - const Identity: IAstIdentity = nil + const Loc: ISourceLocation +): IMacroDefinitionNode; +begin + var id := TIdentities.Structural(Loc); + Result := TMacroDefinitionNode.Create(AName, AParameters, ABody, id); +end; + +class function TAst.MacroDef( + const Identity: IAstIdentity; + const AName: IIdentifierNode; + const AParameters: TArray; + const ABody: IAstNode ): IMacroDefinitionNode; begin Result := TMacroDefinitionNode.Create(AName, AParameters, ABody, Identity); end; +// --- Quotes --- + +class function TAst.Quasiquote(const AExpression: IAstNode; const Loc: ISourceLocation): IQuasiquoteNode; +begin + var id := TIdentities.Structural(Loc); + Result := TQuasiquoteNode.Create(AExpression, id); +end; + +class function TAst.Quasiquote(const Identity: IAstIdentity; const AExpression: IAstNode): IQuasiquoteNode; +begin + Result := TQuasiquoteNode.Create(AExpression, Identity); +end; + +class function TAst.Unquote(const AExpression: IAstNode; const Loc: ISourceLocation): IUnquoteNode; +begin + var id := TIdentities.Structural(Loc); + Result := TUnquoteNode.Create(AExpression, id); +end; + +class function TAst.Unquote(const Identity: IAstIdentity; const AExpression: IAstNode): IUnquoteNode; +begin + Result := TUnquoteNode.Create(AExpression, Identity); +end; + +class function TAst.UnquoteSplicing(const AExpression: IQuasiquoteNode; const Loc: ISourceLocation): IUnquoteSplicingNode; +begin + var id := TIdentities.Structural(Loc); + Result := TUnquoteSplicingNode.Create(AExpression, id); +end; + +class function TAst.UnquoteSplicing(const Identity: IAstIdentity; const AExpression: IQuasiquoteNode): IUnquoteSplicingNode; +begin + Result := TUnquoteSplicingNode.Create(AExpression, Identity); +end; + +// --- FunctionCall --- + +class function TAst.FunctionCall( + const ACallee: IAstNode; + const AArguments: TArray; + const Loc: ISourceLocation +): IFunctionCallNode; +begin + var id := TIdentities.Structural(Loc); + Result := TFunctionCallNode.Create(ACallee, AArguments, TTypes.Unknown, False, nil, False, id); +end; + +class function TAst.FunctionCall( + const Identity: IAstIdentity; + const ACallee: IAstNode; + const AArguments: TArray; + const AStaticType: IStaticType; + const AIsTailCall: Boolean; + const AStaticTarget: TDataValue.TFunc; + const AIsTargetPure: Boolean +): IFunctionCallNode; +begin + Result := + TFunctionCallNode.Create( + ACallee, + AArguments, + if AStaticType <> nil then AStaticType + else TTypes.Unknown, + AIsTailCall, + AStaticTarget, + AIsTargetPure, + Identity + ); +end; + +// --- MacroExpansion --- + class function TAst.MacroExpansionNode( const AOriginalCallNode: IFunctionCallNode; const AExpandedBody: IAstNode; - const Identity: IAstIdentity = nil + const Loc: ISourceLocation +): IMacroExpansionNode; +begin + var id := TIdentities.Structural(Loc); + Result := TMacroExpansionNode.Create(AOriginalCallNode, AExpandedBody, id); +end; + +class function TAst.MacroExpansionNode( + const Identity: IAstIdentity; + const AOriginalCallNode: IFunctionCallNode; + const AExpandedBody: IAstNode ): IMacroExpansionNode; begin Result := TMacroExpansionNode.Create(AOriginalCallNode, AExpandedBody, Identity); end; -class function TAst.MemberAccess( - const ABase: IAstNode; - const AMember: IKeywordNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil -): IMemberAccessNode; -begin - Result := - TMemberAccessNode.Create( - ABase, - AMember, - if AStaticType <> nil then AStaticType - else TTypes.Unknown, - Identity - ); -end; +// --- Recur --- -class function TAst.Nop(const AStaticType: IStaticType = nil; const Identity: IAstIdentity = nil): IAstNode; -begin - Result := TNopNode.Create(TTypes.Unknown, Identity); -end; - -class function TAst.Quasiquote(const AExpression: IAstNode; const Identity: IAstIdentity = nil): IQuasiquoteNode; -begin - Result := TQuasiquoteNode.Create(AExpression, Identity); -end; - -class function TAst.Recur( - const AArguments: array of IAstNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil -): IRecurNode; +class function TAst.Recur(const AArguments: array of IAstNode; const Loc: ISourceLocation): IRecurNode; var args: TArray; i: Integer; @@ -972,68 +679,64 @@ begin SetLength(args, Length(AArguments)); for i := 0 to High(AArguments) do args[i] := AArguments[i]; + var id := TIdentities.Structural(Loc); + Result := TRecurNode.Create(args, TTypes.Void, id); +end; + +class function TAst.Recur(const Identity: IAstIdentity; const AArguments: TArray; const AStaticType: IStaticType): IRecurNode; +begin Result := TRecurNode.Create( - args, + AArguments, if AStaticType <> nil then AStaticType else TTypes.Void, Identity ); end; -class function TAst.RecordLiteral( - const AFields: TArray; - const AScalarDefinition: IScalarRecordDefinition = nil; - const AGenericDefinition: IGenericRecordDefinition = nil; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil -): IRecordLiteralNode; +// --- Block --- + +class function TAst.Block(const AExpressions: array of IAstNode; const Loc: ISourceLocation): IBlockExpressionNode; +var + exprs: TArray; + i: Integer; +begin + SetLength(exprs, Length(AExpressions)); + for i := 0 to High(AExpressions) do + exprs[i] := AExpressions[i]; + var id := TIdentities.Structural(Loc); + Result := TBlockExpressionNode.Create(exprs, TTypes.Unknown, id); +end; + +class function TAst.Block( + const Identity: IAstIdentity; + const AExpressions: TArray; + const AStaticType: IStaticType +): IBlockExpressionNode; begin Result := - TRecordLiteralNode.Create( - AFields, - AScalarDefinition, - AGenericDefinition, + TBlockExpressionNode.Create( + AExpressions, if AStaticType <> nil then AStaticType else TTypes.Unknown, Identity ); end; -class function TAst.TernaryExpr( - const ACondition: IAstNode; - const AThenBranch, AElseBranch: IAstNode; - const AStaticType: IStaticType = nil; - const Identity: IAstIdentity = nil -): ITernaryExpressionNode; -begin - Result := - TTernaryExpressionNode.Create( - ACondition, - AThenBranch, - AElseBranch, - if AStaticType <> nil then AStaticType - else TTypes.Unknown, - Identity - ); -end; +// --- VarDecl --- -class function TAst.Unquote(const AExpression: IAstNode; const Identity: IAstIdentity = nil): IUnquoteNode; +class function TAst.VarDecl(const AIdentifier: IAstNode; AInitializer: IAstNode; const Loc: ISourceLocation): IVariableDeclarationNode; begin - Result := TUnquoteNode.Create(AExpression, Identity); -end; - -class function TAst.UnquoteSplicing(const AExpression: IQuasiquoteNode; const Identity: IAstIdentity = nil): IUnquoteSplicingNode; -begin - Result := TUnquoteSplicingNode.Create(AExpression, Identity); + var id := TIdentities.Structural(Loc); + Result := TVariableDeclarationNode.Create(AIdentifier, AInitializer, TTypes.Unknown, False, id); end; class function TAst.VarDecl( + const Identity: IAstIdentity; const AIdentifier: IAstNode; - AInitializer: IAstNode = nil; - const AStaticType: IStaticType = nil; - const AIsBoxed: Boolean = False; - const Identity: IAstIdentity = nil + AInitializer: IAstNode; + const AStaticType: IStaticType; + const AIsBoxed: Boolean ): IVariableDeclarationNode; begin Result := @@ -1047,1080 +750,156 @@ begin ); end; -{ TNopNode } +// --- Assign --- -constructor TNopNode.Create(const AStaticType: IStaticType; const AIdentity: IAstIdentity); +class function TAst.Assign(const ATarget, AValue: IAstNode; const Loc: ISourceLocation): IAssignmentNode; begin - inherited Create(AStaticType, AIdentity); + var id := TIdentities.Structural(Loc); + Result := TAssignmentNode.Create(ATarget, AValue, TTypes.Unknown, id); end; -function TNopNode.Accept(const Visitor: IAstVisitor): TDataValue; +class function TAst.Assign(const Identity: IAstIdentity; const ATarget, AValue: IAstNode; const AStaticType: IStaticType): IAssignmentNode; begin - Result := Visitor.VisitNop(Self); + Result := + TAssignmentNode.Create( + ATarget, + AValue, + if AStaticType <> nil then AStaticType + else TTypes.Unknown, + Identity + ); end; -function TNopNode.AsNop: INopNode; +class function TAst.AssignResult(const AValue: IAstNode; const Loc: ISourceLocation): IAssignmentNode; begin - Result := Self; + // Helper: Creates an implicit Identifier "Result" with new Identity + var resultId := TAst.Identifier('Result', Loc); + Result := TAst.Assign(resultId, AValue, Loc); end; -function TNopNode.GetKind: TAstNodeKind; -begin - Result := akNop; -end; - -{ TAstNode } - -constructor TAstNode.Create(const AIdentity: IAstIdentity); -begin - inherited Create; - FIdentity := AIdentity; -end; - -function TAstNode.GetIdentity: IAstIdentity; -begin - Result := FIdentity; -end; - -function TAstNode.AsAddSeriesItem: IAddSeriesItemNode; -begin - Assert(False, 'Node is not an AddSeriesItem'); - Result := nil; -end; - -function TAstNode.AsAssignment: IAssignmentNode; -begin - Assert(False, 'Node is not an Assignment'); - Result := nil; -end; - -function TAstNode.AsBlockExpression: IBlockExpressionNode; -begin - Assert(False, 'Node is not a BlockExpression'); - Result := nil; -end; - -function TAstNode.AsConstant: IConstantNode; -begin - Assert(False, 'Node is not a Constant'); - Result := nil; -end; - -function TAstNode.AsCreateSeries: ICreateSeriesNode; -begin - Assert(False, 'Node is not a CreateSeries'); - Result := nil; -end; - -function TAstNode.AsFunctionCall: IFunctionCallNode; -begin - Assert(False, 'Node is not a FunctionCall'); - Result := nil; -end; - -function TAstNode.AsIdentifier: IIdentifierNode; -begin - Assert(False, 'Node is not an Identifier'); - Result := nil; -end; - -function TAstNode.AsIfExpression: IIfExpressionNode; -begin - Assert(False, 'Node is not an IfExpression'); - Result := nil; -end; - -function TAstNode.AsIndexer: IIndexerNode; -begin - Assert(False, 'Node is not an Indexer'); - Result := nil; -end; - -function TAstNode.AsKeyword: IKeywordNode; -begin - Assert(False, 'Node is not a Keyword'); - Result := nil; -end; - -function TAstNode.AsLambdaExpression: ILambdaExpressionNode; -begin - Assert(False, 'Node is not a LambdaExpression'); - Result := nil; -end; - -function TAstNode.AsMacroDefinition: IMacroDefinitionNode; -begin - Assert(False, 'Node is not a MacroDefinition'); - Result := nil; -end; - -function TAstNode.AsMacroExpansion: IMacroExpansionNode; -begin - Assert(False, 'Node is not a MacroExpansion'); - Result := nil; -end; - -function TAstNode.AsMemberAccess: IMemberAccessNode; -begin - Assert(False, 'Node is not a MemberAccess'); - Result := nil; -end; - -function TAstNode.AsNop: INopNode; -begin - Assert(False, 'Node is not a Nop'); - Result := nil; -end; - -function TAstNode.AsQuasiquote: IQuasiquoteNode; -begin - Assert(False, 'Node is not a Quasiquote'); - Result := nil; -end; - -function TAstNode.AsRecordLiteral: IRecordLiteralNode; -begin - Assert(False, 'Node is not a RecordLiteral'); - Result := nil; -end; - -function TAstNode.AsRecur: IRecurNode; -begin - Assert(False, 'Node is not a Recur'); - Result := nil; -end; - -function TAstNode.AsSeriesLength: ISeriesLengthNode; -begin - Assert(False, 'Node is not a SeriesLength'); - Result := nil; -end; - -function TAstNode.AsTernaryExpression: ITernaryExpressionNode; -begin - Assert(False, 'Node is not a TernaryExpression'); - Result := nil; -end; - -function TAstNode.AsTypedNode: IAstTypedNode; -begin - Assert(False, 'Node has no type'); - Result := nil; -end; - -function TAstNode.AsUnquote: IUnquoteNode; -begin - Assert(False, 'Node is not an Unquote'); - Result := nil; -end; - -function TAstNode.AsUnquoteSplicing: IUnquoteSplicingNode; -begin - Assert(False, 'Node is not an UnquoteSplicing'); - Result := nil; -end; - -function TAstNode.AsVariableDeclaration: IVariableDeclarationNode; -begin - Assert(False, 'Node is not a VariableDeclaration'); - Result := nil; -end; - -function TAstNode.GetIsTyped: Boolean; -begin - Result := false; -end; - -{ TAstTypedNode } - -constructor TAstTypedNode.Create(const AStaticType: IStaticType; const AIdentity: IAstIdentity); -begin - inherited Create(AIdentity); - FStaticType := AStaticType; - Assert(FStaticType <> nil); -end; - -function TAstTypedNode.AsTypedNode: IAstTypedNode; -begin - Result := Self; -end; - -function TAstTypedNode.GetIsTyped: Boolean; -begin - Result := true; -end; - -function TAstTypedNode.GetStaticType: IStaticType; -begin - Result := FStaticType; -end; - -{ TConstantNode } - -constructor TConstantNode.Create(const AValue: TDataValue; const AStaticType: IStaticType; const AIdentity: IAstIdentity); -begin - inherited Create(AStaticType, AIdentity); - FValue := AValue; -end; - -function TConstantNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitConstant(Self); -end; - -function TConstantNode.AsConstant: IConstantNode; -begin - Result := Self; -end; - -function TConstantNode.GetValue: TDataValue; -begin - Result := FValue; -end; - -function TConstantNode.GetKind: TAstNodeKind; -begin - Result := akConstant; -end; - -{ TIdentifierNode } - -constructor TIdentifierNode.Create( - const AName: string; - const AAddress: TResolvedAddress; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity -); -begin - inherited Create(AStaticType, AIdentity); - FName := AName; - FAddress := AAddress; -end; - -function TIdentifierNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitIdentifier(Self); -end; - -function TIdentifierNode.AsIdentifier: IIdentifierNode; -begin - Result := Self; -end; - -function TIdentifierNode.GetAddress: TResolvedAddress; -begin - Result := FAddress; -end; - -function TIdentifierNode.GetName: string; -begin - Result := FName; -end; - -function TIdentifierNode.GetKind: TAstNodeKind; -begin - Result := akIdentifier; -end; - -{ TKeywordNode } - -constructor TKeywordNode.Create(const AValue: IKeyword; const AIdentity: IAstIdentity); -begin - inherited Create(TTypes.Keyword, AIdentity); - FValue := AValue; -end; - -function TKeywordNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitKeyword(Self); -end; - -function TKeywordNode.AsKeyword: IKeywordNode; -begin - Result := Self; -end; - -function TKeywordNode.GetValue: IKeyword; -begin - Result := FValue; -end; - -function TKeywordNode.GetKind: TAstNodeKind; -begin - Result := akKeyword; -end; - -{ TIfExpressionNode } - -constructor TIfExpressionNode.Create( - const ACondition, AThenBranch, AElseBranch: IAstNode; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity -); -begin - inherited Create(AStaticType, AIdentity); - FCondition := ACondition; - FThenBranch := AThenBranch; - FElseBranch := AElseBranch; -end; - -function TIfExpressionNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitIfExpression(Self); -end; - -function TIfExpressionNode.AsIfExpression: IIfExpressionNode; -begin - Result := Self; -end; - -function TIfExpressionNode.GetCondition: IAstNode; -begin - Result := FCondition; -end; - -function TIfExpressionNode.GetElseBranch: IAstNode; -begin - Result := FElseBranch; -end; - -function TIfExpressionNode.GetThenBranch: IAstNode; -begin - Result := FThenBranch; -end; - -function TIfExpressionNode.GetKind: TAstNodeKind; -begin - Result := akIfExpression; -end; - -{ TTernaryExpressionNode } - -constructor TTernaryExpressionNode.Create( - const ACondition, AThenBranch, AElseBranch: IAstNode; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity -); -begin - inherited Create(AStaticType, AIdentity); - FCondition := ACondition; - FThenBranch := AThenBranch; - FElseBranch := AElseBranch; -end; - -function TTernaryExpressionNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitTernaryExpression(Self); -end; - -function TTernaryExpressionNode.AsTernaryExpression: ITernaryExpressionNode; -begin - Result := Self; -end; - -function TTernaryExpressionNode.GetCondition: IAstNode; -begin - Result := FCondition; -end; - -function TTernaryExpressionNode.GetElseBranch: IAstNode; -begin - Result := FElseBranch; -end; - -function TTernaryExpressionNode.GetThenBranch: IAstNode; -begin - Result := FThenBranch; -end; +// --- Indexer --- -function TTernaryExpressionNode.GetKind: TAstNodeKind; +class function TAst.Indexer(const ABase, AIndex: IAstNode; const Loc: ISourceLocation): IIndexerNode; begin - Result := akTernaryExpression; + var id := TIdentities.Structural(Loc); + Result := TIndexerNode.Create(ABase, AIndex, TTypes.Unknown, id); end; -{ TLambdaExpressionNode } - -constructor TLambdaExpressionNode.Create( - const AParameters: TArray; - const ABody: IAstNode; - const AStaticType: IStaticType; - const ALayout: IScopeLayout; - const ADescriptor: IScopeDescriptor; - const AUpvalues: TArray; - const AHasNestedLambdas: Boolean; - const AIsPure: Boolean; - const AIdentity: IAstIdentity -); -begin - inherited Create(AStaticType, AIdentity); - FParameters := AParameters; - FBody := ABody; - FLayout := ALayout; - FDescriptor := ADescriptor; - FUpvalues := AUpvalues; - FHasNestedLambdas := AHasNestedLambdas; - FIsPure := AIsPure; - - // Consistency Check - if Assigned(FDescriptor) and (FDescriptor.Layout <> FLayout) then - raise Exception.Create('Consistency Error: Lambda Descriptor does not match Layout.'); -end; - -destructor TLambdaExpressionNode.Destroy; -begin - inherited; -end; - -function TLambdaExpressionNode.Accept(const Visitor: IAstVisitor): TDataValue; +class function TAst.Indexer(const Identity: IAstIdentity; const ABase, AIndex: IAstNode; const AStaticType: IStaticType): IIndexerNode; begin - Result := Visitor.VisitLambdaExpression(Self); + Result := + TIndexerNode.Create( + ABase, + AIndex, + if AStaticType <> nil then AStaticType + else TTypes.Unknown, + Identity + ); end; -function TLambdaExpressionNode.AsLambdaExpression: ILambdaExpressionNode; -begin - Result := Self; -end; +// --- MemberAccess --- -function TLambdaExpressionNode.GetBody: IAstNode; +class function TAst.MemberAccess(const ABase: IAstNode; const AMember: IKeywordNode; const Loc: ISourceLocation): IMemberAccessNode; begin - Result := FBody; + var id := TIdentities.Structural(Loc); + Result := TMemberAccessNode.Create(ABase, AMember, TTypes.Unknown, id); end; -function TLambdaExpressionNode.GetParameters: TArray; -begin - Result := FParameters; -end; - -function TLambdaExpressionNode.GetLayout: IScopeLayout; -begin - Result := FLayout; -end; - -function TLambdaExpressionNode.GetDescriptor: IScopeDescriptor; -begin - Result := FDescriptor; -end; - -function TLambdaExpressionNode.GetUpvalues: TArray; -begin - Result := FUpvalues; -end; - -function TLambdaExpressionNode.GetHasNestedLambdas: Boolean; -begin - Result := FHasNestedLambdas; -end; - -function TLambdaExpressionNode.GetIsPure: Boolean; -begin - Result := FIsPure; -end; - -function TLambdaExpressionNode.GetKind: TAstNodeKind; -begin - Result := akLambdaExpression; -end; - -{ TMacroDefinitionNode } - -constructor TMacroDefinitionNode.Create( - const AName: IIdentifierNode; - const AParameters: TArray; - const ABody: IAstNode; - const AIdentity: IAstIdentity -); -begin - inherited Create(TTypes.Void, AIdentity); - FName := AName; - FParameters := AParameters; - FBody := ABody; -end; - -function TMacroDefinitionNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitMacroDefinition(Self); -end; - -function TMacroDefinitionNode.AsMacroDefinition: IMacroDefinitionNode; -begin - Result := Self; -end; - -function TMacroDefinitionNode.GetBody: IAstNode; -begin - Result := FBody; -end; - -function TMacroDefinitionNode.GetName: IIdentifierNode; -begin - Result := FName; -end; - -function TMacroDefinitionNode.GetParameters: TArray; -begin - Result := FParameters; -end; - -function TMacroDefinitionNode.GetKind: TAstNodeKind; -begin - Result := akMacroDefinition; -end; - -{ TQuasiquoteNode } - -constructor TQuasiquoteNode.Create(const AExpression: IAstNode; const AIdentity: IAstIdentity); -begin - inherited Create(AIdentity); - FExpression := AExpression; -end; - -function TQuasiquoteNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitQuasiquote(Self); -end; - -function TQuasiquoteNode.AsQuasiquote: IQuasiquoteNode; -begin - Result := Self; -end; - -function TQuasiquoteNode.GetExpression: IAstNode; -begin - Result := FExpression; -end; - -function TQuasiquoteNode.GetKind: TAstNodeKind; -begin - Result := akQuasiquote; -end; - -{ TUnquoteNode } - -constructor TUnquoteNode.Create(const AExpression: IAstNode; const AIdentity: IAstIdentity); -begin - inherited Create(AIdentity); - FExpression := AExpression; -end; - -function TUnquoteNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitUnquote(Self); -end; - -function TUnquoteNode.AsUnquote: IUnquoteNode; -begin - Result := Self; -end; - -function TUnquoteNode.GetExpression: IAstNode; -begin - Result := FExpression; -end; - -function TUnquoteNode.GetKind: TAstNodeKind; -begin - Result := akUnquote; -end; - -{ TUnquoteSplicingNode } - -constructor TUnquoteSplicingNode.Create(const AExpression: IQuasiquoteNode; const AIdentity: IAstIdentity); -begin - inherited Create(AIdentity); - FExpression := AExpression; -end; - -function TUnquoteSplicingNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitUnquoteSplicing(Self); -end; - -function TUnquoteSplicingNode.AsUnquoteSplicing: IUnquoteSplicingNode; -begin - Result := Self; -end; - -function TUnquoteSplicingNode.GetExpression: IQuasiquoteNode; -begin - Result := FExpression; -end; - -function TUnquoteSplicingNode.GetKind: TAstNodeKind; -begin - Result := akUnquoteSplicing; -end; - -{ TFunctionCallNode } - -constructor TFunctionCallNode.Create( - const ACallee: IAstNode; - const AArguments: TArray; - const AStaticType: IStaticType; - const AIsTailCall: Boolean; - const AStaticTarget: TDataValue.TFunc; - const AIsTargetPure: Boolean; - const AIdentity: IAstIdentity -); -begin - inherited Create(AStaticType, AIdentity); - FCallee := ACallee; - FArguments := AArguments; - FIsTailCall := AIsTailCall; - FStaticTarget := AStaticTarget; - FIsTargetPure := AIsTargetPure; -end; - -function TFunctionCallNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitFunctionCall(Self); -end; - -function TFunctionCallNode.AsFunctionCall: IFunctionCallNode; -begin - Result := Self; -end; - -function TFunctionCallNode.GetArguments: TArray; -begin - Result := FArguments; -end; - -function TFunctionCallNode.GetCallee: IAstNode; -begin - Result := FCallee; -end; - -function TFunctionCallNode.GetIsTailCall: Boolean; -begin - Result := FIsTailCall; -end; - -function TFunctionCallNode.GetKind: TAstNodeKind; -begin - Result := akFunctionCall; -end; - -function TFunctionCallNode.GetStaticTarget: TDataValue.TFunc; -begin - Result := FStaticTarget; -end; - -function TFunctionCallNode.GetIsTargetPure: Boolean; -begin - Result := FIsTargetPure; -end; - -{ TMacroExpansionNode } - -constructor TMacroExpansionNode.Create(const ACallNode: IFunctionCallNode; const AExpandedBody: IAstNode; const AIdentity: IAstIdentity); -begin - if AExpandedBody.IsTyped then - inherited Create(AExpandedBody.AsTypedNode.StaticType, AIdentity) - else - inherited Create(TTypes.Unknown, AIdentity); - - FExpandedBody := AExpandedBody; - FCallNode := ACallNode; -end; - -function TMacroExpansionNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitMacroExpansionNode(Self); -end; - -function TMacroExpansionNode.AsMacroExpansion: IMacroExpansionNode; -begin - Result := Self; -end; - -function TMacroExpansionNode.GetCallNode: IFunctionCallNode; -begin - Result := FCallNode; -end; - -function TMacroExpansionNode.GetExpandedBody: IAstNode; -begin - Result := FExpandedBody; -end; - -function TMacroExpansionNode.GetKind: TAstNodeKind; -begin - Result := akMacroExpansion; -end; - -{ TRecurNode } - -constructor TRecurNode.Create(const AArguments: TArray; const AStaticType: IStaticType; const AIdentity: IAstIdentity); -begin - inherited Create(AStaticType, AIdentity); - FArguments := AArguments; -end; - -function TRecurNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitRecurNode(Self); -end; - -function TRecurNode.AsRecur: IRecurNode; -begin - Result := Self; -end; - -function TRecurNode.GetArguments: TArray; -begin - Result := FArguments; -end; - -function TRecurNode.GetKind: TAstNodeKind; -begin - Result := akRecur; -end; - -{ TBlockExpressionNode } - -constructor TBlockExpressionNode.Create( - const AExpressions: array of IAstNode; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity -); -var - i: Integer; -begin - inherited Create(AStaticType, AIdentity); - SetLength(FExpressions, Length(AExpressions)); - for i := 0 to High(AExpressions) do - FExpressions[i] := AExpressions[i]; -end; - -function TBlockExpressionNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitBlockExpression(Self); -end; - -function TBlockExpressionNode.AsBlockExpression: IBlockExpressionNode; -begin - Result := Self; -end; - -function TBlockExpressionNode.GetExpressions: TArray; -begin - Result := FExpressions; -end; - -function TBlockExpressionNode.GetKind: TAstNodeKind; -begin - Result := akBlockExpression; -end; - -{ TVariableDeclarationNode } - -constructor TVariableDeclarationNode.Create( - const ATarget: IAstNode; - AInitializer: IAstNode; - const AStaticType: IStaticType; - const AIsBoxed: Boolean; - const AIdentity: IAstIdentity -); -begin - inherited Create(AStaticType, AIdentity); - FTarget := ATarget; - FInitializer := AInitializer; - FIsBoxed := AIsBoxed; -end; - -function TVariableDeclarationNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitVariableDeclaration(Self); -end; - -function TVariableDeclarationNode.AsVariableDeclaration: IVariableDeclarationNode; -begin - Result := Self; -end; - -function TVariableDeclarationNode.GetTarget: IAstNode; -begin - Result := FTarget; -end; - -function TVariableDeclarationNode.GetInitializer: IAstNode; -begin - Result := FInitializer; -end; - -function TVariableDeclarationNode.GetIsBoxed: Boolean; -begin - Result := FIsBoxed; -end; - -function TVariableDeclarationNode.GetKind: TAstNodeKind; -begin - Result := akVariableDeclaration; -end; - -{ TAssignmentNode } - -constructor TAssignmentNode.Create( - const ATarget: IAstNode; - const AValue: IAstNode; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity -); -begin - inherited Create(AStaticType, AIdentity); - FTarget := ATarget; - FValue := AValue; -end; - -function TAssignmentNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitAssignment(Self); -end; - -function TAssignmentNode.AsAssignment: IAssignmentNode; -begin - Result := Self; -end; - -function TAssignmentNode.GetTarget: IAstNode; -begin - Result := FTarget; -end; - -function TAssignmentNode.GetValue: IAstNode; -begin - Result := FValue; -end; - -function TAssignmentNode.GetKind: TAstNodeKind; -begin - Result := akAssignment; -end; - -{ TIndexerNode } - -constructor TIndexerNode.Create( - const ABase: IAstNode; - const AIndex: IAstNode; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity -); -begin - inherited Create(AStaticType, AIdentity); - FBase := ABase; - FIndex := AIndex; -end; - -function TIndexerNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitIndexer(Self); -end; - -function TIndexerNode.AsIndexer: IIndexerNode; -begin - Result := Self; -end; - -function TIndexerNode.GetBase: IAstNode; -begin - Result := FBase; -end; - -function TIndexerNode.GetIndex: IAstNode; -begin - Result := FIndex; -end; - -function TIndexerNode.GetKind: TAstNodeKind; -begin - Result := akIndexer; -end; - -{ TMemberAccessNode } - -constructor TMemberAccessNode.Create( +class function TAst.MemberAccess( + const Identity: IAstIdentity; const ABase: IAstNode; const AMember: IKeywordNode; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity -); + const AStaticType: IStaticType +): IMemberAccessNode; begin - inherited Create(AStaticType, AIdentity); - FBase := ABase; - FMember := AMember; + Result := + TMemberAccessNode.Create( + ABase, + AMember, + if AStaticType <> nil then AStaticType + else TTypes.Unknown, + Identity + ); end; -function TMemberAccessNode.Accept(const Visitor: IAstVisitor): TDataValue; +// --- RecordLiteral --- + +class function TAst.RecordLiteral(const AFields: TArray; const Loc: ISourceLocation): IRecordLiteralNode; begin - Result := Visitor.VisitMemberAccess(Self); + var id := TIdentities.Structural(Loc); + Result := TRecordLiteralNode.Create(AFields, nil, nil, TTypes.Unknown, id); end; -function TMemberAccessNode.AsMemberAccess: IMemberAccessNode; -begin - Result := Self; -end; - -function TMemberAccessNode.GetBase: IAstNode; -begin - Result := FBase; -end; - -function TMemberAccessNode.GetMember: IKeywordNode; -begin - Result := FMember; -end; - -function TMemberAccessNode.GetKind: TAstNodeKind; -begin - Result := akMemberAccess; -end; - -{ TRecordLiteralNode } - -constructor TRecordLiteralNode.Create( +class function TAst.RecordLiteral( + const Identity: IAstIdentity; const AFields: TArray; const AScalarDefinition: IScalarRecordDefinition; const AGenericDefinition: IGenericRecordDefinition; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity -); + const AStaticType: IStaticType +): IRecordLiteralNode; begin - inherited Create(AStaticType, AIdentity); - FFields := AFields; - FGenericDefinition := AGenericDefinition; - FScalarDefinition := AScalarDefinition; + Result := + TRecordLiteralNode.Create( + AFields, + AScalarDefinition, + AGenericDefinition, + if AStaticType <> nil then AStaticType + else TTypes.Unknown, + Identity + ); end; -function TRecordLiteralNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitRecordLiteral(Self); -end; +// --- AddSeriesItem --- -function TRecordLiteralNode.AsRecordLiteral: IRecordLiteralNode; -begin - Result := Self; -end; - -function TRecordLiteralNode.GetFields: TArray; -begin - Result := FFields; -end; - -function TRecordLiteralNode.GetGenericDefinition: IGenericRecordDefinition; -begin - Result := FGenericDefinition; -end; - -function TRecordLiteralNode.GetKind: TAstNodeKind; -begin - Result := akRecordLiteral; -end; - -function TRecordLiteralNode.GetScalarDefinition: IScalarRecordDefinition; -begin - Result := FScalarDefinition; -end; - -{ TCreateSeriesNode } - -constructor TCreateSeriesNode.Create(const ADefinition: String; const AStaticType: IStaticType; const AIdentity: IAstIdentity); -begin - inherited Create(AStaticType, AIdentity); - FDefinition := ADefinition; -end; - -function TCreateSeriesNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitCreateSeries(Self); -end; - -function TCreateSeriesNode.AsCreateSeries: ICreateSeriesNode; -begin - Result := Self; -end; - -function TCreateSeriesNode.GetDefinition: String; -begin - Result := FDefinition; -end; - -function TCreateSeriesNode.GetKind: TAstNodeKind; -begin - Result := akCreateSeries; -end; - -{ TAddSeriesItemNode } - -constructor TAddSeriesItemNode.Create( +class function TAst.AddSeriesItem( const ASeries: IIdentifierNode; - const AValue: IAstNode; - const ALookback: IAstNode; - const AStaticType: IStaticType; - const AIdentity: IAstIdentity -); + const AValue, ALookback: IAstNode; + const Loc: ISourceLocation +): IAddSeriesItemNode; begin - inherited Create(AStaticType, AIdentity); - FSeries := ASeries; - FValue := AValue; - FLookback := ALookback; + var id := TIdentities.Structural(Loc); + Result := TAddSeriesItemNode.Create(ASeries, AValue, ALookback, TTypes.Void, id); end; -function TAddSeriesItemNode.Accept(const Visitor: IAstVisitor): TDataValue; +class function TAst.AddSeriesItem( + const Identity: IAstIdentity; + const ASeries: IIdentifierNode; + const AValue, ALookback: IAstNode; + const AStaticType: IStaticType +): IAddSeriesItemNode; begin - Result := Visitor.VisitAddSeriesItem(Self); + Result := + TAddSeriesItemNode.Create( + ASeries, + AValue, + ALookback, + if AStaticType <> nil then AStaticType + else TTypes.Void, + Identity + ); end; -function TAddSeriesItemNode.AsAddSeriesItem: IAddSeriesItemNode; +// --- SeriesLength --- + +class function TAst.SeriesLength(const ASeries: IIdentifierNode; const Loc: ISourceLocation): ISeriesLengthNode; begin - Result := Self; + var id := TIdentities.Structural(Loc); + Result := TSeriesLengthNode.Create(ASeries, TTypes.Ordinal, id); end; -function TAddSeriesItemNode.GetLookback: IAstNode; +class function TAst.SeriesLength( + const Identity: IAstIdentity; + const ASeries: IIdentifierNode; + const AStaticType: IStaticType +): ISeriesLengthNode; begin - Result := FLookback; -end; - -function TAddSeriesItemNode.GetSeries: IIdentifierNode; -begin - Result := FSeries; -end; - -function TAddSeriesItemNode.GetValue: IAstNode; -begin - Result := FValue; -end; - -function TAddSeriesItemNode.GetKind: TAstNodeKind; -begin - Result := akAddSeriesItem; -end; - -{ TSeriesLengthNode } - -constructor TSeriesLengthNode.Create(const ASeries: IIdentifierNode; const AStaticType: IStaticType; const AIdentity: IAstIdentity); -begin - inherited Create(AStaticType, AIdentity); - FSeries := ASeries; -end; - -function TSeriesLengthNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitSeriesLength(Self); -end; - -function TSeriesLengthNode.AsSeriesLength: ISeriesLengthNode; -begin - Result := Self; -end; - -function TSeriesLengthNode.GetSeries: IIdentifierNode; -begin - Result := FSeries; -end; - -function TSeriesLengthNode.GetKind: TAstNodeKind; -begin - Result := akSeriesLength; + Result := + TSeriesLengthNode.Create( + ASeries, + if AStaticType <> nil then AStaticType + else TTypes.Ordinal, + Identity + ); end; end. diff --git a/Src/AST/Test.Myc.Ast.Compiler.Binder.pas b/Src/AST/Test.Myc.Ast.Compiler.Binder.pas index 079ec2c..5300846 100644 --- a/Src/AST/Test.Myc.Ast.Compiler.Binder.pas +++ b/Src/AST/Test.Myc.Ast.Compiler.Binder.pas @@ -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(0, initIdent.Address.SlotIndex, 'Initializer should resolve to "a" (Slot 0).'); Assert.AreEqual(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(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(1, innerUsage.Address.SlotIndex); // Parameter x + Assert.AreEqual(1, innerUsage.Address.SlotIndex); // Parameter x (Slot 1 because 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(1, lambda.Parameters[0].Address.SlotIndex); + Assert.AreEqual(1, lambda.Parameters[0].Address.SlotIndex); // Slot 0 is reserved for 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(1, lambda.Parameters[0].Address.SlotIndex); Assert.AreEqual(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(akUpvalue, bodyIdent.Address.Kind); - Assert.AreEqual(0, bodyIdent.Address.SlotIndex); + Assert.AreEqual(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(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('')); - bound := Unwrap(Bind(root, layout)); + bound := Unwrap(Bind(root, layout, log)); + + Assert.IsFalse(log.HasErrors); + lambda := bound.AsLambdaExpression; + // is always at Slot 0 (Local) + Assert.AreEqual(akLocalOrParent, lambda.Body.AsIdentifier.Address.Kind); Assert.AreEqual(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.