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;
        procedure Define(const Name: string; const Value: TAstValue);
        function GetValue(const Address: TResolvedAddress): TAstValue;
        procedure AssignValue(const Address: TResolvedAddress; const Value: TAstValue); overload;
        procedure SetValueByIndex(Index: Integer; const Value: TAstValue); // <-- NEU
    public
        constructor Create(AParent: IExecutionScope = nil);
        constructor CreateFromDescriptor(const AParent: IExecutionScope; const ADescriptor: IScopeDescriptor);
        destructor Destroy; override;
        property NameToIndex: TDictionary<string, Integer> read FNameToIndex;
        property Parent: IExecutionScope read FParent;
        property Values: TArray<TAstValue> read FValues;
    end;

implementation

uses
    System.Generics.Defaults;

{ TExecutionScope }

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

constructor TExecutionScope.CreateFromDescriptor(const AParent: IExecutionScope; const ADescriptor: IScopeDescriptor);
begin
    inherited Create;
    FParent := AParent;
    FNameToIndex := TDictionary<string, Integer>.Create(ADescriptor.Symbols);
    SetLength(FValues, ADescriptor.SlotCount);
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(const Address: TResolvedAddress; const Value: TAstValue);
var
    targetScope: IExecutionScope;
    i: Integer;
begin
    targetScope := Self;
    for i := 1 to Address.ScopeDepth do
    begin
        if Assigned(targetScope) then
            targetScope := targetScope.Parent
        else
            raise EInvalidOpException.Create('Invalid scope depth during assignment.');
    end;

    if Address.SlotIndex >= Length((targetScope as TExecutionScope).FValues) then
        raise EInvalidOpException.Create('Invalid scope index during assignment.');
    (targetScope as TExecutionScope).FValues[Address.SlotIndex] := Value;
end;

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

procedure TExecutionScope.Define(const Name: string; const Value: TAstValue);
var
    index: Integer;
begin
    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
        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]');
        (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(const Address: TResolvedAddress): TAstValue;
var
    targetScope: TExecutionScope;
    i: Integer;
begin
    targetScope := Self;

    for i := 0 to Address.ScopeDepth - 1 do
    begin
        targetScope := targetScope.Parent as TExecutionScope;
        Assert(Assigned(targetScope), 'Invalid scope depth during value retrieval.');
    end;

    Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.Values)), 'Invalid scope index during value retrieval.');
    Result := targetScope.Values[Address.SlotIndex];
end;

procedure TExecutionScope.SetValue(const Name: string; const Value: TAstValue);
var
    index: Integer;
begin
    if FNameToIndex.TryGetValue(Name, index) then
        FValues[index] := Value
    else
        Define(Name, Value);
end;

procedure TExecutionScope.SetValueByIndex(Index: Integer; const Value: TAstValue);
begin
    // This is a direct write to a slot in the current scope's value array.
    // It's used for setting up a function call frame.
    if (Index < 0) or (Index >= Length(FValues)) then
        raise EArgumentException.CreateFmt('Index %d is out of bounds for scope with %d slots.', [Index, Length(FValues)]);
    FValues[Index] := Value;
end;

end.