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

unit Myc.Ast.Scope;

interface

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

type
    TExecutionScope = class(TInterfacedObject, IExecutionScope)
        type
            TValueCell = class(TInterfacedObject, IValueCell)
            private
                FValue: TDataValue;
                function GetValue: TDataValue;
                procedure SetValue(const AValue: TDataValue);
            public
                constructor Create(const AValue: TDataValue);
            end;

            TValueRef = class(TInterfacedObject, IValueCell)
            private
                FValues: TArray<TDataValue>;
                FIdx: Integer;
                function GetValue: TDataValue;
                procedure SetValue(const AValue: TDataValue);
            public
                constructor Create(const AValues: TArray<TDataValue>; AIdx: Integer);
            end;

    private
        FParent: IExecutionScope;
        FDescriptor: IScopeDescriptor;
        FValues: TArray<TDataValue>;
        FCapturedUpvalues: TArray<IValueCell>;
        FNames: TDictionary<string, Integer>;
        FNameStrings: TList<string>;
        FNameToIndex: TDictionary<Integer, Integer>;

        procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
        procedure NeedNameToIndex;
        function GetNameID(const Name: String): Integer;
        function GetParent: IExecutionScope;
        function GetNameToIndex: TDictionary<Integer, Integer>;
        function GetValues(const Address: TResolvedAddress): TDataValue;
        procedure SetValues(const Address: TResolvedAddress; const Value: TDataValue);
    public
        constructor Create(AParent: IExecutionScope; const ADescriptor: IScopeDescriptor; const ACapturedUpvalues: TArray<IValueCell>);
        destructor Destroy; override;
        procedure Clear;
        function Dump: string;
        procedure Define(const Name: string; const Value: TDataValue);
        function Capture(const Address: TResolvedAddress): IValueCell;
        property Names: TDictionary<string, Integer> read FNames;
        property NameStrings: TList<string> read FNameStrings;
        property NameToIndex: TDictionary<Integer, Integer> read GetNameToIndex;
        property Parent: IExecutionScope read FParent;
    end;

    // Describes the layout of a scope: variable names and their slot indices.
    // This is generated by the binder and used to create TExecutionScope instances at runtime.
    TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor)
    private
        FParent: IScopeDescriptor;
        FSymbols: TDictionary<string, Integer>;
        function GetParent: IScopeDescriptor;
        function GetSlotCount: Integer;
        function GetSymbols: TDictionary<string, Integer>;
    public
        constructor Create(const AParent: IScopeDescriptor);
        destructor Destroy; override;
        function Define(const Name: string): Integer;
        function FindSymbol(const Name: string; out Depth, Index: Integer): Boolean;
        function CreateScope(const Parent: IExecutionScope): IExecutionScope;
        procedure PopulateFromScope(Scope: TExecutionScope);
        property Symbols: TDictionary<string, Integer> read FSymbols;
    end;

implementation

uses
    System.Generics.Defaults;

{ TValueCell }

constructor TExecutionScope.TValueCell.Create(const AValue: TDataValue);
begin
    inherited Create;
    FValue := AValue;
end;

function TExecutionScope.TValueCell.GetValue: TDataValue;
begin
    Result := FValue;
end;

procedure TExecutionScope.TValueCell.SetValue(const AValue: TDataValue);
begin
    FValue := AValue;
end;

{ TExecutionScope }

constructor TExecutionScope.Create(
    AParent: IExecutionScope;
    const ADescriptor: IScopeDescriptor;
    const ACapturedUpvalues: TArray<IValueCell>
);
begin
    inherited Create;
    FParent := AParent;
    FDescriptor := ADescriptor;

    FValues := [];
    FCapturedUpvalues := ACapturedUpvalues; // Store upvalues

    if FParent is TExecutionScope then
    begin
        FNames := (FParent as TExecutionScope).FNames;
        FNameStrings := (FParent as TExecutionScope).FNameStrings;
    end
    else
    begin
        FNames := TDictionary<string, Integer>.Create;
        FNameStrings := TList<string>.Create;
    end;

    if ADescriptor <> nil then
        SetLength(FValues, ADescriptor.SlotCount);
end;

destructor TExecutionScope.Destroy;
begin
    Clear;
    if not (FParent is TExecutionScope) then
    begin
        FNameStrings.Free;
        FNames.Free;
    end;
    inherited Destroy;
end;

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

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

function TExecutionScope.Capture(const Address: TResolvedAddress): IValueCell;
begin
    case Address.Kind of
        akUpvalue:
        begin
            Assert(Assigned(FCapturedUpvalues), 'Attempt to access an upvalue in a scope with no closure context.');
            Assert(
                (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)),
                'Invalid upvalue index during value retrieval.'
            );
            Result := FCapturedUpvalues[Address.SlotIndex];
        end;
        akLocalOrParent:
        begin
            var targetScope := Self;
            for var i := 1 to Address.ScopeDepth 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.FValues)),
                'Invalid scope index during value retrieval.'
            );
            Result := TValueRef.Create(targetScope.FValues, Address.SlotIndex);
        end;
    else
        raise EInvalidOpException.Create('Cannot get value for an unresolved address.');
    end;
end;

procedure TExecutionScope.Define(const Name: string; const Value: TDataValue);
var
    id: Integer;
    index: Integer;
begin
    NeedNameToIndex;

    id := GetNameID(Name);

    if FNameToIndex.ContainsKey(id) 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(id, index);
end;

procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
var
    pair: TPair<Integer, Integer>;
    indentStr: string;
    sortedPairs: TArray<TPair<Integer, Integer>>;
begin
    NeedNameToIndex;

    indentStr := ''.PadLeft(AIndent);
    if FNameToIndex.Count > 0 then
    begin
        sortedPairs := FNameToIndex.ToArray;
        TArray.Sort<TPair<Integer, Integer>>(
            sortedPairs,
            TComparer<TPair<Integer, Integer>>
                .Construct(function(const Left, Right: TPair<Integer, Integer>): Integer begin Result := Left.Value - Right.Value; end)
        );

        for pair in sortedPairs do
            // Access the value inside the cell for printing.
            ABuilder.AppendLine(indentStr + Format('  [%d] %s: %s', [pair.Value, FNameStrings[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.GetNameToIndex: TDictionary<Integer, Integer>;
begin
    NeedNameToIndex;
    Result := FNameToIndex;
end;

function TExecutionScope.GetValues(const Address: TResolvedAddress): TDataValue;
begin
    case Address.Kind of
        akUpvalue:
        begin
            Assert(Assigned(FCapturedUpvalues), 'Attempt to access an upvalue in a scope with no closure context.');
            Assert(
                (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)),
                'Invalid upvalue index during value retrieval.'
            );
            Result := FCapturedUpvalues[Address.SlotIndex].Value;
        end;
        akLocalOrParent:
        begin
            var targetScope := Self;
            for var i := 1 to Address.ScopeDepth 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.FValues)),
                'Invalid scope index during value retrieval.'
            );
            Result := targetScope.FValues[Address.SlotIndex];
        end;
    else
        raise EInvalidOpException.Create('Cannot get value for an unresolved address.');
    end;
end;

function TExecutionScope.GetNameID(const Name: String): Integer;
begin
    if not FNames.TryGetValue(Name, Result) then
    begin
        Result := FNameStrings.Add(Name);
        FNames.Add(Name, Result);
    end;
end;

procedure TExecutionScope.NeedNameToIndex;
begin
    if FNameToIndex = nil then
    begin
        FNameToIndex := TDictionary<Integer, Integer>.Create;
        if FDescriptor <> nil then
        begin
            for var item in FDescriptor.Symbols do
                FNameToIndex.AddOrSetValue(GetNameId(item.Key), item.Value);
        end;
    end;
end;

procedure TExecutionScope.SetValues(const Address: TResolvedAddress; const Value: TDataValue);
begin
    case Address.Kind of
        akUpvalue:
        begin
            Assert(Assigned(FCapturedUpvalues), 'Attempt to access an upvalue in a scope with no closure context.');
            Assert(
                (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)),
                'Invalid upvalue index during value retrieval.'
            );
            FCapturedUpvalues[Address.SlotIndex].Value := Value;
        end;
        akLocalOrParent:
        begin
            var targetScope := Self;
            for var i := 1 to Address.ScopeDepth 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.FValues)),
                'Invalid scope index during value retrieval.'
            );
            targetScope.FValues[Address.SlotIndex] := Value;
        end;
    else
        raise EInvalidOpException.Create('Cannot get value for an unresolved address.');
    end;
end;

constructor TExecutionScope.TValueRef.Create(const AValues: TArray<TDataValue>; AIdx: Integer);
begin
    inherited Create;
    FValues := AValues;
    FIdx := AIdx;
end;

function TExecutionScope.TValueRef.GetValue: TDataValue;
begin
    Result := FValues[FIdx];
end;

procedure TExecutionScope.TValueRef.SetValue(const AValue: TDataValue);
begin
    FValues[FIdx] := AValue;
end;

{ TScopeDescriptor }

constructor TScopeDescriptor.Create(const AParent: IScopeDescriptor);
begin
    inherited Create;
    FParent := AParent;
    FSymbols := TDictionary<string, Integer>.Create;
end;

destructor TScopeDescriptor.Destroy;
begin
    FSymbols.Free;
    inherited;
end;

function TScopeDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope;
begin
    // Creates a runtime scope instance based on this descriptor's layout.
    Result := TExecutionScope.Create(Parent, Self, nil);
end;

function TScopeDescriptor.Define(const Name: string): Integer;
begin
    Result := FSymbols.Count;
    FSymbols.Add(Name, Result);
end;

function TScopeDescriptor.FindSymbol(const Name: string; out Depth, Index: Integer): Boolean;
var
    currentDescriptor: TScopeDescriptor;
begin
    Depth := 0;
    currentDescriptor := Self;
    while currentDescriptor <> nil do
    begin
        if currentDescriptor.FSymbols.TryGetValue(Name, Index) then
            exit(True);
        inc(Depth);
        currentDescriptor := currentDescriptor.FParent as TScopeDescriptor;
    end;
    Result := False;
end;

function TScopeDescriptor.GetParent: IScopeDescriptor;
begin
    Result := FParent;
end;

function TScopeDescriptor.GetSlotCount: Integer;
begin
    Result := FSymbols.Count;
end;

function TScopeDescriptor.GetSymbols: TDictionary<string, Integer>;
begin
    Result := FSymbols;
end;

procedure TScopeDescriptor.PopulateFromScope(Scope: TExecutionScope);
begin
    // This method is likely used to create a descriptor from an existing, dynamically populated scope.
    // Note: This relies on internal details of TExecutionScope (NameToIndex, NameStrings).
    for var pair in Scope.NameToIndex do
    begin
        var name := Scope.NameStrings[pair.Key];
        if not FSymbols.ContainsKey(name) then
            FSymbols.Add(name, pair.Value);
    end;
end;

end.