Resolved cyclic dependencies between environment and compiler stages

ASTPlayground/MainForm.pas

@@ -39,6 +39,7 @@ uses
     FMX.ListView.Appearances,
     FMX.ListView.Adapters.Base,
     FMX.ListView,
+    Myc.Ast.Compiler.Specializer,
     Myc.Ast.Environment,
     FMX.ListBox; // Added Environment
 

Src/AST/Myc.Ast.Compiler.Binder.pas

@@ -13,14 +13,18 @@ uses
     Myc.Ast.Scope,
     Myc.Ast.Types,
     Myc.Ast.Compiler.Binder.Upvalues,
-    Myc.Ast,
+    Myc.Ast;
-    Myc.Ast.Environment;
 
 type
     IAstBinder = interface(IAstVisitor)
         function Execute(const RootNode: IAstNode; out Layout: IScopeLayout): IAstNode;
     end;
 
+    IFunctionDefinitionRegistry = interface
+        procedure Register(const Address: TResolvedAddress; const ADef: IFunctionDefinition);
+        function Resolve(const Address: TResolvedAddress): IFunctionDefinition;
+    end;
+
     TAstBinder = class(TAstTransformer, IAstBinder)
     private
         type

Src/AST/Myc.Ast.Compiler.Macros.pas

@@ -12,8 +12,7 @@ uses
     Myc.Ast.Visitor,
     Myc.Ast.Scope,
     Myc.Ast.Types,
-    Myc.Ast,
+    Myc.Ast;
-    Myc.Ast.Environment;
 
 type
     IAstMacroExpander = interface(IAstVisitor)
@@ -56,6 +55,16 @@ type
         ): IAstNode;
     end;
 
+    IMacroRegistry = interface
+        {$region 'private'}
+        function GetParent: IMacroRegistry;
+        {$endregion}
+        procedure Define(const Node: IMacroDefinitionNode);
+        function Find(const Name: string): IMacroDefinitionNode;
+        function CreateChildRegistry: IMacroRegistry;
+        property Parent: IMacroRegistry read GetParent;
+    end;
+
     // Handles the expansion of macro calls within the AST.
     TMacroExpander = class(TAstTransformer, IAstMacroExpander)
     private

Src/AST/Myc.Ast.Compiler.Specializer.pas

@@ -5,27 +5,55 @@ interface
 uses
     System.SysUtils,
     System.Generics.Collections,
+    System.Generics.Defaults,
     Myc.Data.Value,
     Myc.Ast,
     Myc.Ast.Types,
     Myc.Ast.Nodes,
     Myc.Ast.Visitor,
     Myc.Ast.Scope,
-    Myc.Ast.Environment,
+    Myc.Ast.RTL,
-    Myc.Ast.RTL;
+    Myc.Ast.Compiler.Binder;
 
 type
     IAstSpecializer = interface(IAstVisitor)
         function Execute(const RootNode: IAstNode): IAstNode;
     end;
 
+    // --- Monomorphization Cache Definitions ---
+
+    TMonoCacheKey = record
+    public
+        Address: TResolvedAddress;
+        ArgTypes: TArray<IStaticType>;
+        Func: TDataValue.TFunc;
+        constructor Create(const AAddress: TResolvedAddress; const AArgTypes: TArray<IStaticType>);
+    end;
+
+    IMonomorphCache = interface
+        function TryGetFunction(const Key: TMonoCacheKey; out Func: TSpecializedMethod): Boolean;
+        procedure Add(const Key: TMonoCacheKey; const Func: TSpecializedMethod);
+    end;
+
+    TCompiledFunction = record
+    public
+        Func: TDataValue.TFunc;
+        StaticType: IStaticType;
+        IsPure: Boolean;
+        constructor Create(const AFunc: TDataValue.TFunc; const AStaticType: IStaticType; AIsPure: Boolean);
+    end;
+
     // This transformer runs *after* TypeChecker.
     // It specializes all statically resolvable function calls (RTL and user-defined)
     // by replacing them with nodes that have a direct StaticTarget.
     // It propagates Purity information but does NOT perform Constant Folding yet.
     TStaticSpecializer = class(TAstTransformer, IAstSpecializer)
+        type
+            TCompileFunc = reference to function(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction;
     private
-        FEnvironment: IEnvironment;
+        FMonomorphCache: IMonomorphCache;
+        FFunctionRegistry: IFunctionDefinitionRegistry;
+        FCompileFunc: TCompileFunc;
 
         function GetStaticRtlFunction(const AName: string; const AArgTypes: TArray<IStaticType>): TSpecializedMethod;
 
@@ -33,26 +61,48 @@ type
         function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override;
 
     public
-        constructor Create(const AEnvironment: IEnvironment);
+        constructor Create(
+            const AMonomorphCache: IMonomorphCache;
+            const AFunctionRegistry: IFunctionDefinitionRegistry;
+            const ACompileFunc: TCompileFunc
+        );
         function Execute(const RootNode: IAstNode): IAstNode;
 
-        class function Specialize(const AEnvironment: IEnvironment; const RootNode: IAstNode): IAstNode; static;
+        class function Specialize(
+            const RootNode: IAstNode;
+            const AMonomorphCache: IMonomorphCache;
+            const AFunctionRegistry: IFunctionDefinitionRegistry;
+            const ACompileFunc: TCompileFunc
+        ): IAstNode; static;
     end;
 
 implementation
 
+uses
+    System.Hash;
+
 { TStaticSpecializer }
 
-constructor TStaticSpecializer.Create(const AEnvironment: IEnvironment);
+constructor TStaticSpecializer.Create(
+    const AMonomorphCache: IMonomorphCache;
+    const AFunctionRegistry: IFunctionDefinitionRegistry;
+    const ACompileFunc: TCompileFunc
+);
 begin
     inherited Create;
-    Assert(Assigned(AEnvironment));
+    FMonomorphCache := AMonomorphCache;
-    FEnvironment := AEnvironment;
+    FFunctionRegistry := AFunctionRegistry;
+    FCompileFunc := ACompileFunc;
 end;
 
-class function TStaticSpecializer.Specialize(const AEnvironment: IEnvironment; const RootNode: IAstNode): IAstNode;
+class function TStaticSpecializer.Specialize(
+    const RootNode: IAstNode;
+    const AMonomorphCache: IMonomorphCache;
+    const AFunctionRegistry: IFunctionDefinitionRegistry;
+    const ACompileFunc: TCompileFunc
+): IAstNode;
 begin
-    var specializer := TStaticSpecializer.Create(AEnvironment) as IAstSpecializer;
+    var specializer := TStaticSpecializer.Create(AMonomorphCache, AFunctionRegistry, ACompileFunc) as IAstSpecializer;
     Result := specializer.Execute(RootNode);
 end;
 
@@ -125,7 +175,7 @@ begin
     // 4. Check the Environment (Instance) Cache
     key := TMonoCacheKey.Create(calleeIdent.Address, argTypes);
 
-    if FEnvironment.MonomorphCache.TryGetValue(key, specializedMethod) then
+    if FMonomorphCache.TryGetFunction(key, specializedMethod) then
     begin
         // 4a. Cache Hit (Environment)
         // Propagate IsPure flag from cache to AST node
@@ -146,7 +196,7 @@ begin
     if Assigned(specializedMethod.Target) then
     begin
         // 5a. Cache Hit (RTL)
-        FEnvironment.MonomorphCache.Add(key, specializedMethod);
+        FMonomorphCache.Add(key, specializedMethod);
 
         // Propagate IsPure flag from RTL definition to AST node
         Result :=
@@ -162,7 +212,7 @@ begin
     end;
 
     // 6. Cache Miss (User Code)
-    funcDef := FEnvironment.FunctionRegistry.Resolve(calleeIdent.Address);
+    funcDef := FFunctionRegistry.Resolve(calleeIdent.Address);
 
     if (funcDef <> nil) then
     begin
@@ -179,13 +229,13 @@ begin
 
         // 6a. Compile func with KNOWN TYPES
         // This recursively triggers Bind -> Check -> Specialize -> Purity Inference for the callee body!
-        var compiled := FEnvironment.Compile(funcDef, argTypes);
+        var compiled := FCompileFunc(funcDef, argTypes);
 
         // 6b. Store in cache
         // Get the return type from the *full function type* returned by Compile
         var returnType := compiled.StaticType.Signatures[0].ReturnType;
         specializedMethod := TSpecializedMethod.Create(compiled.Func, returnType, compiled.IsPure);
-        FEnvironment.MonomorphCache.Add(key, specializedMethod);
+        FMonomorphCache.Add(key, specializedMethod);
 
         // 6c. Return the new node
         // Propagate the inferred IsPure flag to the AST node
@@ -200,4 +250,21 @@ begin
         Result := TAst.FunctionCall(newCallee, newArgs, Node.StaticType, Node.IsTailCall, nil);
 end;
 
+{ TMonoCacheKey }
+
+constructor TMonoCacheKey.Create(const AAddress: TResolvedAddress; const AArgTypes: TArray<IStaticType>);
+begin
+    Address := AAddress;
+    ArgTypes := AArgTypes;
+end;
+
+{ TCompiledFunction }
+
+constructor TCompiledFunction.Create(const AFunc: TDataValue.TFunc; const AStaticType: IStaticType; AIsPure: Boolean);
+begin
+    Func := AFunc;
+    StaticType := AStaticType;
+    IsPure := AIsPure;
+end;
+
 end.

Src/AST/Myc.Ast.Environment.pas

@@ -12,63 +12,27 @@ uses
     Myc.Ast.Nodes,
     Myc.Ast.Scope,
     Myc.Ast.RTL,
-    Myc.Ast.Types;
+    Myc.Ast.Types,
+    Myc.Ast.Compiler.Macros,
+    Myc.Ast.Compiler.Binder,
+    Myc.Ast.Compiler.TypeChecker,
+    Myc.Ast.Compiler.Specializer,
+    Myc.Ast.Compiler.TCO,
+    Myc.Ast.Analysis.Purity;
 
 type
-    IMacroRegistry = interface;
     IEnvironment = interface;
     IExecutionStrategy = interface;
-    IFunctionDefinitionRegistry = interface;
-
-    // --- Monomorphization Cache Definitions ---
-
-    TMonoCacheKey = record
-    public
-        Address: TResolvedAddress;
-        ArgTypes: TArray<IStaticType>;
-        constructor Create(const AAddress: TResolvedAddress; const AArgTypes: TArray<IStaticType>);
-    end;
-
-    TMonoCacheKeyComparer = class(TEqualityComparer<TMonoCacheKey>)
-    public
-        function Equals(const Left, Right: TMonoCacheKey): Boolean; override;
-        function GetHashCode(const Value: TMonoCacheKey): Integer; override;
-    end;
-
-    TMonomorphCache = TDictionary<TMonoCacheKey, TSpecializedMethod>;
-
-    TCompiledFunction = record
-    public
-        Func: TDataValue.TFunc;
-        StaticType: IStaticType;
-        IsPure: Boolean;
-        constructor Create(const AFunc: TDataValue.TFunc; const AStaticType: IStaticType; AIsPure: Boolean);
-    end;
 
     IExecutionStrategy = interface
         function CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
     end;
 
-    IMacroRegistry = interface
-        {$region 'private'}
-        function GetParent: IMacroRegistry;
-        {$endregion}
-        procedure Define(const Node: IMacroDefinitionNode);
-        function Find(const Name: string): IMacroDefinitionNode;
-        function CreateChildRegistry: IMacroRegistry;
-        property Parent: IMacroRegistry read GetParent;
-    end;
-
-    IFunctionDefinitionRegistry = interface
-        procedure Register(const Address: TResolvedAddress; const ADef: IFunctionDefinition);
-        function Resolve(const Address: TResolvedAddress): IFunctionDefinition;
-    end;
-
     IEnvironment = interface
         {$region 'private'}
         function GetRootScope: IExecutionScope;
         function GetMacroRegistry: IMacroRegistry;
-        function GetMonomorphCache: TMonomorphCache;
+        function GetMonomorphCache: IMonomorphCache;
         function GetFunctionRegistry: IFunctionDefinitionRegistry;
         {$endregion}
 
@@ -94,7 +58,7 @@ type
 
         property RootScope: IExecutionScope read GetRootScope;
         property MacroRegistry: IMacroRegistry read GetMacroRegistry;
-        property MonomorphCache: TMonomorphCache read GetMonomorphCache;
+        property MonomorphCache: IMonomorphCache read GetMonomorphCache;
         property FunctionRegistry: IFunctionDefinitionRegistry read GetFunctionRegistry;
     end;
 
@@ -139,79 +103,25 @@ implementation
 uses
     System.Hash,
     Myc.Ast.Evaluator,
-    Myc.Ast.Debugger,
+    Myc.Ast.Debugger;
-    Myc.Ast.Compiler.Macros,
-    Myc.Ast.Compiler.Binder,
-    Myc.Ast.Compiler.TypeChecker,
-    Myc.Ast.Compiler.Specializer,
-    Myc.Ast.Compiler.TCO,
-    Myc.Ast.Analysis.Purity;
-
-{ TMonoCacheKey }
-
-constructor TMonoCacheKey.Create(const AAddress: TResolvedAddress; const AArgTypes: TArray<IStaticType>);
-begin
-    Address := AAddress;
-    ArgTypes := AArgTypes;
-end;
-
-{ TMonoCacheKeyComparer }
-
-function TMonoCacheKeyComparer.Equals(const Left, Right: TMonoCacheKey): Boolean;
-var
-    i: Integer;
-begin
-    if not (Left.Address = Right.Address) then
-        exit(False);
-
-    if Length(Left.ArgTypes) <> Length(Right.ArgTypes) then
-        exit(False);
-
-    for i := 0 to High(Left.ArgTypes) do
-    begin
-        if not Left.ArgTypes[i].IsEqual(Right.ArgTypes[i]) then
-            exit(False);
-    end;
-
-    Result := True;
-end;
-
-function TMonoCacheKeyComparer.GetHashCode(const Value: TMonoCacheKey): Integer;
-var
-    i: Integer;
-    hash: Integer;
-    typeHash: Integer;
-    adr: TResolvedAddress;
-begin
-    adr := Value.Address;
-
-    hash := THashBobJenkins.GetHashValue(adr.Kind, SizeOf(TAddressKind), 0);
-    hash := THashBobJenkins.GetHashValue(adr.ScopeDepth, SizeOf(Integer), hash);
-    hash := THashBobJenkins.GetHashValue(adr.SlotIndex, SizeOf(Integer), hash);
-
-    for i := 0 to High(Value.ArgTypes) do
-    begin
-        if Assigned(Value.ArgTypes[i]) then
-            typeHash := Value.ArgTypes[i].GetHashCode
-        else
-            typeHash := 0;
-
-        hash := THashBobJenkins.GetHashValue(typeHash, SizeOf(Integer), hash);
-    end;
-
-    Result := hash;
-end;
-
-{ TCompiledFunction }
-
-constructor TCompiledFunction.Create(const AFunc: TDataValue.TFunc; const AStaticType: IStaticType; AIsPure: Boolean);
-begin
-    Func := AFunc;
-    StaticType := AStaticType;
-    IsPure := AIsPure;
-end;
 
 type
+    TMonoCacheKeyComparer = class(TEqualityComparer<TMonoCacheKey>)
+    public
+        function Equals(const Left, Right: TMonoCacheKey): Boolean; override;
+        function GetHashCode(const Value: TMonoCacheKey): Integer; override;
+    end;
+
+    TMonomorphCache = class(TInterfacedObject, IMonomorphCache)
+    private
+        FMonomorphCache: TDictionary<TMonoCacheKey, TSpecializedMethod>;
+    public
+        constructor Create;
+        destructor Destroy; override;
+        function TryGetFunction(const Key: TMonoCacheKey; out Func: TSpecializedMethod): Boolean;
+        procedure Add(const Key: TMonoCacheKey; const Func: TSpecializedMethod);
+    end;
+
     { TStandardExecutionStrategy }
     TStandardExecutionStrategy = class(TInterfacedObject, IExecutionStrategy)
     public
@@ -244,11 +154,11 @@ type
         FRootScope: IExecutionScope;
         FMacroRegistry: IMacroRegistry;
         FExecutionStrategy: IExecutionStrategy;
-        FMonomorphCache: TMonomorphCache;
+        FMonomorphCache: IMonomorphCache;
         FFunctionRegistry: IFunctionDefinitionRegistry;
         function GetRootScope: IExecutionScope;
         function GetMacroRegistry: IMacroRegistry;
-        function GetMonomorphCache: TMonomorphCache;
+        function GetMonomorphCache: IMonomorphCache;
         function GetFunctionRegistry: IFunctionDefinitionRegistry;
     public
         constructor Create(
@@ -256,8 +166,6 @@ type
             const AMacroRegistry: IMacroRegistry;
             const AExecutionStrategy: IExecutionStrategy
         );
-        destructor Destroy; override;
-
         function CreateEnvironment: IEnvironment;
 
         procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
@@ -415,17 +323,11 @@ begin
     FRootScope := ARootScope;
     FMacroRegistry := AMacroRegistry;
     FExecutionStrategy := AExecutionStrategy;
-    FMonomorphCache := TMonomorphCache.Create(TMonoCacheKeyComparer.Create);
+    FMonomorphCache := TMonomorphCache.Create;
     FFunctionRegistry := TFunctionDefinitionRegistry.Create;
 end;
 
-destructor TEnvironment.Destroy;
+function TEnvironment.GetMonomorphCache: IMonomorphCache;
-begin
-    FMonomorphCache.Free;
-    inherited Destroy;
-end;
-
-function TEnvironment.GetMonomorphCache: TMonomorphCache;
 begin
     Result := FMonomorphCache;
 end;
@@ -464,60 +366,9 @@ function TEnvironment.Compile(
     const Params: TArray<IIdentifierNode>;
     const ArgTypes: TArray<IStaticType>
 ): TCompiledFunction;
-var
-    layout: IScopeLayout;
-    descriptor: IScopeDescriptor;
-    funcType: IStaticType;
-    finalFunc: TDataValue.TFunc;
-
-    typedNode: IAstNode;
-    specialized: IAstNode;
-    tcoOptimized: IAstNode;
-    isPure: Boolean;
 begin
-    // 0. Wrap in Lambda to create an isolatable compilation unit (scope)
+    // Wrap in Lambda to create an isolatable compilation unit (scope)
-    var prg := TAst.LambdaExpr(Params, Node);
+    Result := Compile(TAst.LambdaExpr(Params, Node).AsLambdaExpression, ArgTypes);
-
-    // 1. Expand Macros
-    var expanded := ExpandMacros(prg);
-
-    // 2. Bind & Check Types
-    typedNode := Bind(expanded, layout, ArgTypes);
-
-    // Retrieve the descriptor from the typed lambda node
-    // (The TypeChecker baked it into the new LambdaExpressionNode)
-    descriptor := typedNode.AsLambdaExpression.Descriptor;
-    Assert(Assigned(descriptor), 'Compiler Logic Error: Descriptor missing after type checking.');
-
-    funcType := typedNode.AsTypedNode.StaticType;
-
-    // 3. Specialize
-    specialized := Specialize(typedNode);
-
-    // 4. Optimize (TCO)
-    tcoOptimized := TAstTCO.Optimize(specialized);
-
-    // 5. Purity Inference
-    // Check the body of the optimized lambda for purity.
-    // Note: tcoOptimized is a LambdaExpressionNode. Its body is what we check.
-    isPure := TPurityAnalyzer.IsPure(tcoOptimized.AsLambdaExpression.Body);
-
-    // 6. Create Evaluator
-    var visitor := FExecutionStrategy.CreateVisitor(descriptor.CreateScope(FRootScope));
-
-    // Execute the AST to get the TFunc (Closure)
-    var closure := tcoOptimized.Accept(visitor).AsMethod();
-
-    // Wrap TCO handling for the final result
-    finalFunc :=
-        function(const Args: TArray<TDataValue>): TDataValue
-        begin
-            Result := closure(Args);
-            TEvaluatorVisitor.HandleTCO(Result);
-        end;
-
-    // Pass IsPure flag to the compiled function record
-    Result := TCompiledFunction.Create(finalFunc, funcType, isPure);
 end;
 
 function TEnvironment.Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction;
@@ -600,7 +451,85 @@ end;
 
 function TEnvironment.Specialize(const Node: IAstNode): IAstNode;
 begin
-    Result := TStaticSpecializer.Specialize(Self, Node);
+    Result :=
+        TStaticSpecializer.Specialize(
+            Node,
+            FMonomorphCache,
+            FFunctionRegistry,
+            function(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction
+            begin
+                Result := Compile(Node, ArgTypes);
+            end
+        );
+end;
+
+{ TMonoCacheKeyComparer }
+
+function TMonoCacheKeyComparer.Equals(const Left, Right: TMonoCacheKey): Boolean;
+var
+    i: Integer;
+begin
+    if not (Left.Address = Right.Address) then
+        exit(False);
+
+    if Length(Left.ArgTypes) <> Length(Right.ArgTypes) then
+        exit(False);
+
+    for i := 0 to High(Left.ArgTypes) do
+    begin
+        if not Left.ArgTypes[i].IsEqual(Right.ArgTypes[i]) then
+            exit(False);
+    end;
+
+    Result := True;
+end;
+
+function TMonoCacheKeyComparer.GetHashCode(const Value: TMonoCacheKey): Integer;
+var
+    i: Integer;
+    hash: Integer;
+    typeHash: Integer;
+    adr: TResolvedAddress;
+begin
+    adr := Value.Address;
+
+    hash := THashBobJenkins.GetHashValue(adr.Kind, SizeOf(TAddressKind), 0);
+    hash := THashBobJenkins.GetHashValue(adr.ScopeDepth, SizeOf(Integer), hash);
+    hash := THashBobJenkins.GetHashValue(adr.SlotIndex, SizeOf(Integer), hash);
+
+    for i := 0 to High(Value.ArgTypes) do
+    begin
+        if Assigned(Value.ArgTypes[i]) then
+            typeHash := Value.ArgTypes[i].GetHashCode
+        else
+            typeHash := 0;
+
+        hash := THashBobJenkins.GetHashValue(typeHash, SizeOf(Integer), hash);
+    end;
+
+    Result := hash;
+end;
+
+constructor TMonomorphCache.Create;
+begin
+    inherited Create;
+    FMonomorphCache := TDictionary<TMonoCacheKey, TSpecializedMethod>.Create(TMonoCacheKeyComparer.Create);
+end;
+
+destructor TMonomorphCache.Destroy;
+begin
+    FMonomorphCache.Free;
+    inherited Destroy;
+end;
+
+procedure TMonomorphCache.Add(const Key: TMonoCacheKey; const Func: TSpecializedMethod);
+begin
+    FMonomorphCache.Add(Key, Func);
+end;
+
+function TMonomorphCache.TryGetFunction(const Key: TMonoCacheKey; out Func: TSpecializedMethod): Boolean;
+begin
+    Result := FMonomorphCache.TryGetValue(Key, Func);
 end;
 
 end.