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

unit Myc.Ast.Scope;

interface

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

type
    TExecutionScope = class(TInterfacedObject, IExecutionScope)
    private
        FParent: IExecutionScope;
        FValues: TArray<TAstValue>;
        FNameToIndex: TDictionary<string, Integer>;
        procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
    protected
        // IExecutionScope
        function GetParent: IExecutionScope;
        procedure Clear;
        function FindValue(const Name: string; out Value: TAstValue): Boolean;
        procedure SetValue(const Name: string; const Value: TAstValue);
        procedure AssignValue(const Name: string; const Value: TAstValue); overload;
        function Dump: string;

        // --- New index-based access methods ---
        procedure Define(const Name: string; const Value: TAstValue);
        function GetValue(Depth, Index: Integer): TAstValue;
        procedure AssignValue(Depth, Index: Integer; const Value: TAstValue); overload;
    public
        constructor Create(AParent: IExecutionScope = nil);
        destructor Destroy; override;
        property NameToIndex: TDictionary<string, Integer> read FNameToIndex;
    end;

implementation

uses
    System.Generics.Defaults; // For TComparer

{ TExecutionScope }

constructor TExecutionScope.Create(AParent: IExecutionScope);
begin
    inherited Create;
    FParent := AParent;
    FValues := [];
    FNameToIndex := TDictionary<string, Integer>.Create;
end;

destructor TExecutionScope.Destroy;
begin
    FNameToIndex.Free;
    inherited Destroy;
end;

function TExecutionScope.GetParent: IExecutionScope;
begin
    Result := FParent;
end;

procedure TExecutionScope.AssignValue(const Name: string; const Value: TAstValue);
var
    index: Integer;
begin
    if FNameToIndex.TryGetValue(Name, index) then
        FValues[index] := Value
    else if Assigned(FParent) then
        FParent.AssignValue(Name, Value)
    else
        raise Exception.CreateFmt('Cannot assign to undeclared variable "%s".', [Name]);
end;

procedure TExecutionScope.AssignValue(Depth, Index: Integer; const Value: TAstValue);
var
    targetScope: IExecutionScope;
    i: Integer;
begin
    targetScope := Self;
    for i := 1 to Depth do
    begin
        if Assigned(targetScope) then
            targetScope := targetScope.Parent
        else
            // This should not happen if the binder works correctly.
            raise EInvalidOpException.Create('Invalid scope depth during assignment.');
    end;

    // We must cast back to the implementation to modify the private array.
    (targetScope as TExecutionScope).FValues[Index] := Value;
end;

procedure TExecutionScope.Clear;
begin
    FValues := [];
    FNameToIndex.Clear;
end;

procedure TExecutionScope.Define(const Name: string; const Value: TAstValue);
var
    index: Integer;
begin
    // A variable can only be defined once per scope.
    if FNameToIndex.ContainsKey(Name) then
        raise Exception.CreateFmt('Variable "%s" is already defined in this scope.', [Name]);

    index := Length(FValues);
    SetLength(FValues, index + 1);
    FValues[index] := Value;
    FNameToIndex.Add(Name, index);
end;

procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
var
    pair: TPair<string, Integer>;
    indentStr: string;
    sortedPairs: TArray<TPair<string, Integer>>;
begin
    indentStr := ''.PadLeft(AIndent);
    if (FNameToIndex.Count > 0) then
    begin
        // Copy pairs to an array and sort it by index for consistent output
        sortedPairs := FNameToIndex.ToArray;
        TArray.Sort<TPair<string, Integer>>(
            sortedPairs,
            TComparer<TPair<string, Integer>>
                .Construct(function(const Left, Right: TPair<string, Integer>): Integer begin Result := Left.Value - Right.Value; end)
        );

        for pair in sortedPairs do
            ABuilder.AppendLine(indentStr + Format('  [%d] %s: %s', [pair.Value, pair.Key, FValues[pair.Value].ToString]));
    end
    else
    begin
        ABuilder.AppendLine(indentStr + '  (empty)');
    end;

    if Assigned(FParent) then
    begin
        ABuilder.AppendLine(indentStr + '[Parent Scope]');
        // This cast is necessary for this debug helper to access implementation details.
        (FParent as TExecutionScope).DumpScope(ABuilder, AIndent + 2);
    end;
end;

function TExecutionScope.Dump: string;
var
    builder: TStringBuilder;
begin
    builder := TStringBuilder.Create;
    try
        builder.AppendLine('[Current Scope]');
        DumpScope(builder, 0);
        Result := builder.ToString.TrimRight;
    finally
        builder.Free;
    end;
end;

function TExecutionScope.FindValue(const Name: string; out Value: TAstValue): Boolean;
var
    index: Integer;
begin
    if FNameToIndex.TryGetValue(Name, index) then
    begin
        Value := FValues[index];
        Result := True;
        Exit;
    end;

    if Assigned(FParent) then
        Result := FParent.FindValue(Name, Value)
    else
        Result := False;
end;

function TExecutionScope.GetValue(Depth, Index: Integer): TAstValue;
var
    targetScope: IExecutionScope;
    i: Integer;
begin
    targetScope := Self;
    for i := 1 to Depth do
    begin
        if Assigned(targetScope) then
            targetScope := targetScope.Parent
        else
            // This should not happen if the binder works correctly.
            raise EInvalidOpException.Create('Invalid scope depth during value retrieval.');
    end;

    // We must cast back to the implementation to access the private array.
    Result := (targetScope as TExecutionScope).FValues[Index];
end;

procedure TExecutionScope.SetValue(const Name: string; const Value: TAstValue);
var
    index: Integer;
begin
    // This method is for pre-binder setup (e.g. native functions) or initial definition.
    if FNameToIndex.TryGetValue(Name, index) then
        FValues[index] := Value
    else
        Define(Name, Value);
end;

end.