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

unit Myc.Ast.Environment;

interface

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

type
    IMacroRegistry = interface; // Forward
    IEnvironment = interface; // Forward
    IExecutionStrategy = interface; // Forward

    // 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;

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

        procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);

        function ExpandMacros(const Node: IAstNode): IAstNode;
        function Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
        function Lower(const Node: IAstNode): IAstNode;

        function Compile(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc;

        function CreateEnvironment: IEnvironment;

        property RootScope: IExecutionScope read GetRootScope;
        property MacroRegistry: IMacroRegistry read GetMacroRegistry;
    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 operator Initialize(out Dest: TAstEnvironment);
        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 ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc;

        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
    Myc.Ast.RTL,
    Myc.Ast.Evaluator,
    Myc.Ast.Debugger,
    Myc.Ast.Compiler.Macros,
    Myc.Ast.Compiler.Binder,
    Myc.Ast.Compiler.TypeChecker,
    Myc.Ast.Compiler.Lowering,
    Myc.Ast.Compiler.TCO;

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;

    { TEnvironment }
    TEnvironment = class(TInterfacedObject, IEnvironment)
    private
        FRootScope: IExecutionScope;
        FMacroRegistry: IMacroRegistry;
        FExecutionStrategy: IExecutionStrategy;
        function GetRootScope: IExecutionScope;
        function GetMacroRegistry: IMacroRegistry;
    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): IAstNode;
        function Lower(const Node: IAstNode): IAstNode;

        function Compile(const Node: IAstNode; const Params: TArray<IIdentifierNode>): TDataValue.TFunc;
    end;

// --- Factory Implementations ---

{ TAstEnvironment }

class operator TAstEnvironment.Initialize(out Dest: TAstEnvironment);
begin
    Dest.FEnvironment :=
        TEnvironment.Create(TScope.CreateScope(nil, nil, nil), TMacroRegistryImpl.Create(nil), TStandardExecutionStrategy.Create);
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 ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc;
begin
    Result := FEnvironment.Compile(ANode, Params);
end;

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

procedure TAstEnvironment.Define(const Name: String; const AScript: IAstNode);
begin
    var exec := Compile(AScript);
    RootScope.Define(Name, exec([]));
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 exec := Compile(ANode, Params);
    Result := exec(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;

{ TEnvironment }

constructor TEnvironment.Create(
    const ARootScope: IExecutionScope;
    const AMacroRegistry: IMacroRegistry;
    const AExecutionStrategy: IExecutionStrategy
);
begin
    inherited Create;
    FRootScope := ARootScope;
    FMacroRegistry := AMacroRegistry;
    FExecutionStrategy := AExecutionStrategy;
end;

destructor TEnvironment.Destroy;
begin
    inherited Destroy;
end;

function TEnvironment.Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
begin
    var boundAst := TAstBinder.Bind(FRootScope.CreateDescriptor, Node, Descriptor);
    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
    Result := TEnvironment.Create(TScope.CreateScope(FRootScope, nil, nil), TMacroRegistryImpl.Create(FMacroRegistry), FExecutionStrategy);
end;

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

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

    var tcoOptimized := TAstTCO.Optimize(lowered);

    var visitor := FExecutionStrategy.CreateVisitor(desc.CreateScope(FRootScope));

    var func := tcoOptimized.Accept(visitor).AsMethod;

    Result :=
        function(const Args: TArray<TDataValue>): TDataValue
        begin
            Result := func(Args);
            TEvaluatorVisitor.HandleTCO(Result);
        end;
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.Lower(const Node: IAstNode): IAstNode;
begin
    Result := TAstLowerer.Lower(Node);
end;

end.