MycLib/Src/AST/Myc.Ast.Environment.pas

unit Myc.Ast.Environment;

interface

uses
    System.SysUtils,
    System.Classes,
    System.Generics.Collections,
    System.Generics.Defaults,
    Myc.Data.Value,
    Myc.Ast,
    Myc.Ast.Nodes,
    Myc.Ast.Scope,
    Myc.Ast.RTL,
    Myc.Ast.Types;

type
    IMacroRegistry = interface;
    IEnvironment = interface;
    IExecutionStrategy = interface;
    IFunctionDefinitionRegistry = interface;

    // --- Monomorphization Cache Definitions ---

    // The key for the specialization cache.
    // (Function Address/ID, [Argument Types])
    TMonoCacheKey = record
    public
        Address: TResolvedAddress;
        ArgTypes: TArray<IStaticType>;
        constructor Create(const AAddress: TResolvedAddress; const AArgTypes: TArray<IStaticType>);
    end;

    // Comparer for the cache key
    TMonoCacheKeyComparer = class(TEqualityComparer<TMonoCacheKey>)
    public
        function Equals(const Left, Right: TMonoCacheKey): Boolean; override;
        function GetHashCode(const Value: TMonoCacheKey): Integer; override; // Updated
    end;

    // The cache dictionary itself.
    // Verwendet den generischen TSpecializedMethod-Record aus Myc.Ast.Types
    TMonomorphCache = TDictionary<TMonoCacheKey, TSpecializedMethod>;

    // This record holds the executable function and its inferred static type.
    TCompiledFunction = record
    public
        Func: TDataValue.TFunc;
        StaticType: IStaticType; // The full static type of the compiled function (e.g., Method(Ord):Method():Ord)
        constructor Create(const AFunc: TDataValue.TFunc; const AStaticType: IStaticType);
    end;

    // Defines the Strategy for creating an Evaluator.
    IExecutionStrategy = interface
        function CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
    end;

    // Defines the compile-time macro storage.
    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;

    // Defines the central environment for compilation and execution.
    IEnvironment = interface
        {$region 'private'}
        function GetRootScope: IExecutionScope;
        function GetMacroRegistry: IMacroRegistry;
        function GetMonomorphCache: TMonomorphCache;
        function GetFunctionRegistry: IFunctionDefinitionRegistry;
        {$endregion}

        procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);

        function ExpandMacros(const Node: IAstNode): IAstNode;
        function Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor; const AArgTypes: TArray<IStaticType> = []): IAstNode;
        function Specialize(const Node: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode;

        function Compile(
            const ANode: IAstNode;
            const Params: TArray<IIdentifierNode> = [];
            const AArgTypes: TArray<IStaticType> = []
        ): TCompiledFunction; overload;
        function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType> = []): TCompiledFunction; overload;

        function CreateEnvironment: IEnvironment;

        property RootScope: IExecutionScope read GetRootScope;
        property MacroRegistry: IMacroRegistry read GetMacroRegistry;
        property MonomorphCache: TMonomorphCache read GetMonomorphCache;
        property FunctionRegistry: IFunctionDefinitionRegistry read GetFunctionRegistry;
    end;

    // Interface Helper for IEnvironment
    TAstEnvironment = record
    private
        FEnvironment: IEnvironment;
        function GetRootScope: IExecutionScope; inline;
        function GetMacroRegistry: IMacroRegistry; inline;
    public
        constructor Create(const AEnvironment: IEnvironment);

        class function Construct(const Scope: IExecutionScope): TAstEnvironment; static;

        class operator Implicit(const A: IEnvironment): TAstEnvironment;
        class operator Implicit(const A: TAstEnvironment): IEnvironment;

        function CreateEnvironment: TAstEnvironment;

        procedure SetStandardMode;
        procedure SetDebugMode(ALog: TStrings; AShowScope: Boolean);

        function Run(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []; const Args: TArray<TDataValue> = []): TDataValue;
        function Compile(
            const Node: IAstNode;
            const Params: TArray<IIdentifierNode> = [];
            const ArgTypes: TArray<IStaticType> = []
        ): TCompiledFunction; overload; experimental;
        function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType> = []): TCompiledFunction; overload;

        procedure Define(const Name: String; const AScript: IAstNode);

        property Environment: IEnvironment read FEnvironment;
        property RootScope: IExecutionScope read GetRootScope;
        property MacroRegistry: IMacroRegistry read GetMacroRegistry;
    end;

implementation

uses
    System.Hash,
    Myc.Ast.Evaluator,
    Myc.Ast.Debugger,
    Myc.Ast.Compiler.Macros,
    Myc.Ast.Compiler.Binder,
    Myc.Ast.Compiler.TypeChecker,
    Myc.Ast.Compiler.Specializer,
    Myc.Ast.Compiler.TCO;

{ 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 // Use operator =
        exit(False);

    if Length(Left.ArgTypes) <> Length(Right.ArgTypes) then
        exit(False);

    // Compare types
    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; // Changed from ptrHash
    adr: TResolvedAddress;
begin
    adr := Value.Address;

    // 1. Hash the TResolvedAddress components
    hash := THashBobJenkins.GetHashValue(adr.Kind, SizeOf(TAddressKind), 0);
    hash := THashBobJenkins.GetHashValue(adr.ScopeDepth, SizeOf(Integer), hash);
    hash := THashBobJenkins.GetHashValue(adr.SlotIndex, SizeOf(Integer), hash);

    // 2. Iteratively combine the hash of each argument type
    for i := 0 to High(Value.ArgTypes) do
    begin
        // Get the hash code from the type itself (consistent with IsEqual)
        if Assigned(Value.ArgTypes[i]) then
            typeHash := Value.ArgTypes[i].GetHashCode
        else
            typeHash := 0;

        // Combine the new hash (typeHash) with the existing hash (hash)
        hash := THashBobJenkins.GetHashValue(typeHash, SizeOf(Integer), hash);
    end;

    Result := hash;
end;

{ TCompiledFunction }

constructor TCompiledFunction.Create(const AFunc: TDataValue.TFunc; const AStaticType: IStaticType);
begin
    Func := AFunc;
    StaticType := AStaticType;
end;

type
    { TStandardExecutionStrategy }
    TStandardExecutionStrategy = class(TInterfacedObject, IExecutionStrategy)
    public
        function CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
    end;

    { TDebugExecutionStrategy }
    TDebugExecutionStrategy = class(TInterfacedObject, IExecutionStrategy)
    private
        FLog: TStrings;
        FShowScope: Boolean;
    public
        constructor Create(ALog: TStrings; AShowScope: Boolean);
        function CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
    end;

    { TMacroRegistryImpl }
    TMacroRegistryImpl = class(TInterfacedObject, IMacroRegistry)
    private
        FParent: IMacroRegistry;
        FMacros: TDictionary<string, IMacroDefinitionNode>;
        function GetParent: IMacroRegistry;
    public
        constructor Create(AParent: IMacroRegistry);
        destructor Destroy; override;
        procedure Define(const Node: IMacroDefinitionNode);
        function Find(const Name: string): IMacroDefinitionNode;
        function CreateChildRegistry: IMacroRegistry;
    end;

    TFunctionDefinitionRegistry = class(TInterfacedObject, IFunctionDefinitionRegistry)
    private
        FMap: TDictionary<TResolvedAddress, IFunctionDefinition>;
    public
        constructor Create;
        destructor Destroy; override;
        procedure Register(const Address: TResolvedAddress; const ADef: IFunctionDefinition);
        function Resolve(const Address: TResolvedAddress): IFunctionDefinition;
    end;

    { TEnvironment }
    TEnvironment = class(TInterfacedObject, IEnvironment)
    private
        FRootScope: IExecutionScope;
        FMacroRegistry: IMacroRegistry;
        FExecutionStrategy: IExecutionStrategy;
        FMonomorphCache: TMonomorphCache;
        FFunctionRegistry: IFunctionDefinitionRegistry;
        function GetRootScope: IExecutionScope;
        function GetMacroRegistry: IMacroRegistry;
        function GetMonomorphCache: TMonomorphCache;
        function GetFunctionRegistry: IFunctionDefinitionRegistry;
    public
        constructor Create(
            const ARootScope: IExecutionScope;
            const AMacroRegistry: IMacroRegistry;
            const AExecutionStrategy: IExecutionStrategy
        );
        destructor Destroy; override;

        function CreateEnvironment: IEnvironment;

        procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);

        function ExpandMacros(const Node: IAstNode): IAstNode;
        function Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor; const ArgTypes: TArray<IStaticType>): IAstNode;
        function Specialize(const Node: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode;

        function Compile(
            const Node: IAstNode;
            const Params: TArray<IIdentifierNode>;
            const ArgTypes: TArray<IStaticType>
        ): TCompiledFunction; overload;
        function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction; overload;
    end;

constructor TAstEnvironment.Create(const AEnvironment: IEnvironment);
begin
    FEnvironment := AEnvironment;
end;

procedure TAstEnvironment.SetStandardMode;
begin
    FEnvironment.SetExecutionStrategy(TStandardExecutionStrategy.Create);
end;

procedure TAstEnvironment.SetDebugMode(ALog: TStrings; AShowScope: Boolean);
begin
    FEnvironment.SetExecutionStrategy(TDebugExecutionStrategy.Create(ALog, AShowScope));
end;

class operator TAstEnvironment.Implicit(const A: IEnvironment): TAstEnvironment;
begin
    Result.FEnvironment := A;
end;

class operator TAstEnvironment.Implicit(const A: TAstEnvironment): IEnvironment;
begin
    Result := A.FEnvironment;
end;

function TAstEnvironment.Compile(
    const Node: IAstNode;
    const Params: TArray<IIdentifierNode> = [];
    const ArgTypes: TArray<IStaticType> = []
): TCompiledFunction;
begin
    Result := FEnvironment.Compile(Node, Params, ArgTypes);
end;

function TAstEnvironment.Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType> = []): TCompiledFunction;
begin
    Result := FEnvironment.Compile(Node, ArgTypes);
end;

class function TAstEnvironment.Construct(const Scope: IExecutionScope): TAstEnvironment;
var
    RootScope: IExecutionScope;
begin
    // When constructing the *very first* environment:
    // 1. Create a root scope (parented to nil).
    // 2. Explicitly request library registration (ARegisterLibraries = True).
    RootScope := TAst.CreateScope(nil, nil, True);

    Result.Create(
        TEnvironment.Create(
            RootScope, // Use the new root scope
            TMacroRegistryImpl.Create(nil),
            TStandardExecutionStrategy.Create
        )
    );
end;

function TAstEnvironment.CreateEnvironment: TAstEnvironment;
begin
    Result := FEnvironment.CreateEnvironment;
end;

procedure TAstEnvironment.Define(const Name: String; const AScript: IAstNode);
begin
    var compiled := Compile(AScript);
    RootScope.Define(Name, compiled.Func([]));
end;

function TAstEnvironment.GetRootScope: IExecutionScope;
begin
    Result := FEnvironment.GetRootScope;
end;

function TAstEnvironment.GetMacroRegistry: IMacroRegistry;
begin
    Result := FEnvironment.GetMacroRegistry;
end;

function TAstEnvironment.Run(
    const ANode: IAstNode;
    const Params: TArray<IIdentifierNode> = [];
    const Args: TArray<TDataValue> = []
): TDataValue;
begin
    var compiled := Compile(ANode, Params);
    Result := compiled.Func(Args);
end;

{ TStandardExecutionStrategy }

function TStandardExecutionStrategy.CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
begin
    Result := TEvaluatorVisitor.Create(AScope);
end;

{ TDebugExecutionStrategy }

constructor TDebugExecutionStrategy.Create(ALog: TStrings; AShowScope: Boolean);
begin
    inherited Create;
    FLog := ALog;
    FShowScope := AShowScope;
end;

function TDebugExecutionStrategy.CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
begin
    Result := TDebugEvaluatorVisitor.Create(AScope, FLog, FShowScope, 0);
end;

{ TMacroRegistryImpl }

constructor TMacroRegistryImpl.Create(AParent: IMacroRegistry);
begin
    inherited Create;
    FParent := AParent;
    FMacros := TDictionary<string, IMacroDefinitionNode>.Create;
end;

destructor TMacroRegistryImpl.Destroy;
begin
    FMacros.Free;
    inherited Destroy;
end;

function TMacroRegistryImpl.GetParent: IMacroRegistry;
begin
    Result := FParent;
end;

procedure TMacroRegistryImpl.Define(const Node: IMacroDefinitionNode);
begin
    FMacros.AddOrSetValue(Node.Name.Name, Node);
end;

function TMacroRegistryImpl.Find(const Name: string): IMacroDefinitionNode;
var
    current: IMacroRegistry;
begin
    current := Self;
    while Assigned(current) do
    begin
        if (current as TMacroRegistryImpl).FMacros.TryGetValue(Name, Result) then
            exit;
        current := current.Parent;
    end;
    Result := nil;
end;

function TMacroRegistryImpl.CreateChildRegistry: IMacroRegistry;
begin
    Result := TMacroRegistryImpl.Create(Self);
end;

{ TFunctionDefinitionRegistry }

constructor TFunctionDefinitionRegistry.Create;
begin
    inherited Create;
    // We can use the comparer from Myc.Ast.Scope
    FMap := TDictionary<TResolvedAddress, IFunctionDefinition>.Create(TResolvedAddressComparer.Create);
end;

destructor TFunctionDefinitionRegistry.Destroy;
begin
    FMap.Free;
    inherited Destroy;
end;

procedure TFunctionDefinitionRegistry.Register(const Address: TResolvedAddress; const ADef: IFunctionDefinition);
begin
    FMap.AddOrSetValue(Address, ADef);
end;

function TFunctionDefinitionRegistry.Resolve(const Address: TResolvedAddress): IFunctionDefinition;
begin
    FMap.TryGetValue(Address, Result);
end;

{ TEnvironment }

constructor TEnvironment.Create(
    const ARootScope: IExecutionScope;
    const AMacroRegistry: IMacroRegistry;
    const AExecutionStrategy: IExecutionStrategy
);
begin
    inherited Create;
    FRootScope := ARootScope;
    FMacroRegistry := AMacroRegistry;
    FExecutionStrategy := AExecutionStrategy;
    // Create the isolated, instance-specific cache
    FMonomorphCache := TMonomorphCache.Create(TMonoCacheKeyComparer.Create);
    FFunctionRegistry := TFunctionDefinitionRegistry.Create;
end;

destructor TEnvironment.Destroy;
begin
    FMonomorphCache.Free;
    inherited Destroy;
end;

function TEnvironment.GetMonomorphCache: TMonomorphCache;
begin
    Result := FMonomorphCache;
end;

function TEnvironment.Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor; const ArgTypes: TArray<IStaticType>): IAstNode;
begin
    var boundAst := TAstBinder.Bind(FRootScope.CreateDescriptor, Node, Descriptor, FFunctionRegistry, ArgTypes);
    var typedAst := TTypeChecker.CheckTypes(boundAst, Descriptor);

    Result := typedAst;
end;

function TEnvironment.GetMacroRegistry: IMacroRegistry;
begin
    Result := FMacroRegistry;
end;

function TEnvironment.GetRootScope: IExecutionScope;
begin
    Result := FRootScope;
end;

procedure TEnvironment.SetExecutionStrategy(const AStrategy: IExecutionStrategy);
begin
    FExecutionStrategy := AStrategy;
end;

function TEnvironment.CreateEnvironment: IEnvironment;
begin
    // Create a new child environment. It inherits the parent scope (FRootScope) and does *not* re-register the RTL.
    Result := TEnvironment.Create(TAst.CreateScope(FRootScope), TMacroRegistryImpl.Create(FMacroRegistry), FExecutionStrategy);
end;

function TEnvironment.Compile(
    const Node: IAstNode;
    const Params: TArray<IIdentifierNode>;
    const ArgTypes: TArray<IStaticType>
): TCompiledFunction;
var
    desc: IScopeDescriptor;
    funcType: IStaticType;
    finalFunc: TDataValue.TFunc;
begin
    var prg := TAst.LambdaExpr(Params, Node);

    var expanded := ExpandMacros(prg);
    var bound := Bind(expanded, desc, ArgTypes);

    Assert(bound.IsTyped);
    funcType := bound.AsTypedNode.StaticType;

    var specialized := Specialize(bound, desc);
    var tcoOptimized := TAstTCO.Optimize(specialized);

    var visitor := FExecutionStrategy.CreateVisitor(desc.CreateScope(FRootScope));
    var func := tcoOptimized.Accept(visitor).AsMethod;

    finalFunc :=
        function(const Args: TArray<TDataValue>): TDataValue
        begin
            Result := func(Args);
            TEvaluatorVisitor.HandleTCO(Result);
        end;

    Result := TCompiledFunction.Create(finalFunc, funcType);
end;

function TEnvironment.Compile(const Node: IFunctionDefinition; const ArgTypes: TArray<IStaticType>): TCompiledFunction;
var
    desc: IScopeDescriptor;
    funcType: IStaticType;
    finalFunc: TDataValue.TFunc;
begin
    var expanded := ExpandMacros(Node);
    var bound := Bind(expanded, desc, ArgTypes);

    funcType := bound.AsTypedNode.StaticType;

    var specialized := Specialize(bound, desc);
    var tcoOptimized := TAstTCO.Optimize(specialized);

    var visitor := FExecutionStrategy.CreateVisitor(desc.CreateScope(FRootScope));
    var func := tcoOptimized.Accept(visitor).AsMethod;

    finalFunc :=
        function(const Args: TArray<TDataValue>): TDataValue
        begin
            Result := func(Args);
            TEvaluatorVisitor.HandleTCO(Result);
        end;

    Result := TCompiledFunction.Create(finalFunc, funcType);
end;

function TEnvironment.ExpandMacros(const Node: IAstNode): IAstNode;
begin
    var cExecutionStrategy := FExecutionStrategy;
    Result :=
        TMacroExpander.ExpandMacros(
            FMacroRegistry,
            FRootScope,
            Node,
            function(const Scope: IExecutionScope): IEvaluatorVisitor begin Result := cExecutionStrategy.CreateVisitor(Scope); end
        );
end;

function TEnvironment.GetFunctionRegistry: IFunctionDefinitionRegistry;
begin
    Result := FFunctionRegistry;
end;

function TEnvironment.Specialize(const Node: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode;
begin
    // Call the new Specializer, passing the environment for cache access
    Result := TStaticSpecializer.Specialize(Self, Node, ADescriptor);
end;

end.