850 lines
26 KiB
ObjectPascal
850 lines
26 KiB
ObjectPascal
unit Myc.Ast.Scope;
|
|
|
|
interface
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Generics.Collections,
|
|
System.Generics.Defaults,
|
|
System.Classes,
|
|
Myc.Data.Value,
|
|
Myc.Ast.Types;
|
|
|
|
type
|
|
IExecutionScope = interface;
|
|
IScopeDescriptor = interface;
|
|
IScopeLayout = interface;
|
|
|
|
// --- Address & Symbol Types ---
|
|
|
|
TAddressKind = (akUnresolved, akLocalOrParent, akUpvalue);
|
|
|
|
TResolvedAddress = record
|
|
Kind: TAddressKind;
|
|
ScopeDepth: Integer;
|
|
SlotIndex: Integer;
|
|
constructor Create(AKind: TAddressKind; AScopeDepth, ASlotIndex: Integer);
|
|
class operator Initialize(out Dest: TResolvedAddress);
|
|
class operator Equal(const A: TResolvedAddress; B: TResolvedAddress): Boolean;
|
|
end;
|
|
|
|
TResolvedAddressComparer = class(TEqualityComparer<TResolvedAddress>)
|
|
public
|
|
function Equals(const Left, Right: TResolvedAddress): Boolean; override;
|
|
function GetHashCode(const Value: TResolvedAddress): Integer; override;
|
|
end;
|
|
|
|
TResolvedSymbol = record
|
|
Address: TResolvedAddress;
|
|
StaticType: IStaticType;
|
|
constructor Create(const AAddress: TResolvedAddress; const AStaticType: IStaticType);
|
|
class operator Initialize(out Dest: TResolvedSymbol);
|
|
end;
|
|
|
|
IValueCell = interface
|
|
{$region 'private'}
|
|
function GetValue: TDataValue;
|
|
procedure SetValue(const AValue: TDataValue);
|
|
{$endregion}
|
|
property Value: TDataValue read GetValue write SetValue;
|
|
end;
|
|
|
|
// --- SCOPE STRUCTURE (Compile Time) ---
|
|
|
|
// 1. The Product (Immutable).
|
|
IScopeLayout = interface
|
|
{$region 'private'}
|
|
function GetParent: IScopeLayout;
|
|
function GetSlotCount: Integer;
|
|
{$endregion}
|
|
|
|
function FindSlot(const Name: string): Integer;
|
|
|
|
// Returns all defined symbols in this layout (for debugging/reflection)
|
|
function GetSymbols: TArray<string>;
|
|
|
|
property Parent: IScopeLayout read GetParent;
|
|
property SlotCount: Integer read GetSlotCount;
|
|
end;
|
|
|
|
// 2. The Builder (Mutable).
|
|
IScopeBuilder = interface(IScopeLayout)
|
|
function Define(const Name: string): Integer;
|
|
function Build: IScopeLayout;
|
|
end;
|
|
|
|
// --- RUNTIME ARTIFACTS ---
|
|
|
|
// Describes the semantics of a scope: Layout + Types.
|
|
IScopeDescriptor = interface
|
|
{$region 'private'}
|
|
function GetLayout: IScopeLayout;
|
|
function GetSymbolType(SlotIndex: Integer): IStaticType;
|
|
{$endregion}
|
|
|
|
function CreateScope(const AParent: IExecutionScope): IExecutionScope;
|
|
|
|
property Layout: IScopeLayout read GetLayout;
|
|
end;
|
|
|
|
IExecutionScope = interface
|
|
{$region 'private'}
|
|
function GetParent: IExecutionScope;
|
|
function GetDescriptor: IScopeDescriptor;
|
|
function GetValues(const Address: TResolvedAddress): TDataValue;
|
|
procedure SetValues(const Address: TResolvedAddress; const Value: TDataValue);
|
|
{$endregion}
|
|
|
|
function Define(const Name: string; const Value: TDataValue; const AStaticType: IStaticType = nil): TResolvedAddress;
|
|
procedure DefineBoxed(SlotIndex: Integer; const Value: TDataValue);
|
|
function Capture(const Address: TResolvedAddress): IValueCell;
|
|
|
|
function GetNameID(const Name: String): Integer;
|
|
function Resolve(const Name: string): TResolvedAddress;
|
|
|
|
function Dump: string;
|
|
procedure Clear;
|
|
|
|
property Values[const Address: TResolvedAddress]: TDataValue read GetValues write SetValues; default;
|
|
property Parent: IExecutionScope read GetParent;
|
|
property Descriptor: IScopeDescriptor read GetDescriptor;
|
|
end;
|
|
|
|
TScope = record
|
|
class function CreateScope(
|
|
const Parent: IExecutionScope;
|
|
const Descriptor: IScopeDescriptor;
|
|
const CapturedUpvalues: TArray<IValueCell>
|
|
): IExecutionScope; static;
|
|
|
|
class function CreateBuilder(const ParentLayout: IScopeLayout): IScopeBuilder; static;
|
|
class function CreateDescriptor(const Layout: IScopeLayout; const Types: TArray<IStaticType>): IScopeDescriptor; static;
|
|
class function CreateRootLayout: IScopeLayout; static;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.Hash,
|
|
System.SyncObjs;
|
|
|
|
type
|
|
// --- Concrete Layout (Immutable) ---
|
|
TScopeLayout = class(TInterfacedObject, IScopeLayout)
|
|
private
|
|
FParent: IScopeLayout;
|
|
FMap: TDictionary<string, Integer>;
|
|
FSlotCount: Integer; // Explicit slot count
|
|
function GetParent: IScopeLayout;
|
|
function GetSlotCount: Integer;
|
|
public
|
|
constructor Create(const AParent: IScopeLayout; AMap: TDictionary<string, Integer>; ASlotCount: Integer);
|
|
destructor Destroy; override;
|
|
function FindSlot(const Name: string): Integer;
|
|
function GetSymbols: TArray<string>;
|
|
end;
|
|
|
|
// --- Concrete Builder (Mutable) ---
|
|
TScopeBuilder = class(TInterfacedObject, IScopeBuilder, IScopeLayout)
|
|
private
|
|
FParentLayout: IScopeLayout;
|
|
FMap: TDictionary<string, Integer>;
|
|
FNextSlot: Integer; // Counter for sequential slot allocation
|
|
function GetParent: IScopeLayout;
|
|
function GetSlotCount: Integer;
|
|
public
|
|
constructor Create(const AParentLayout: IScopeLayout);
|
|
destructor Destroy; override;
|
|
|
|
function Define(const Name: string): Integer;
|
|
function FindSlot(const Name: string): Integer;
|
|
function GetSymbols: TArray<string>;
|
|
function Build: IScopeLayout;
|
|
end;
|
|
|
|
// --- Descriptor Implementation ---
|
|
TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor)
|
|
private
|
|
FLayout: IScopeLayout;
|
|
FSlotTypes: TArray<IStaticType>;
|
|
function GetLayout: IScopeLayout;
|
|
function GetSymbolType(SlotIndex: Integer): IStaticType;
|
|
public
|
|
constructor Create(const ALayout: IScopeLayout; const ATypes: TArray<IStaticType>);
|
|
function CreateScope(const Parent: IExecutionScope): IExecutionScope;
|
|
end;
|
|
|
|
// --- Execution Scope ---
|
|
TExecutionScope = class(TInterfacedObject, IExecutionScope)
|
|
private
|
|
type
|
|
TValueCell = class(TInterfacedObject, IValueCell)
|
|
private
|
|
FValue: TDataValue;
|
|
function GetValue: TDataValue;
|
|
procedure SetValue(const AValue: TDataValue);
|
|
public
|
|
constructor Create(const AValue: TDataValue);
|
|
end;
|
|
|
|
TScopeItem = record
|
|
Value: TDataValue;
|
|
IsBoxed: Boolean;
|
|
function GetContent: TDataValue; inline;
|
|
end;
|
|
|
|
TDynamicLayout = class(TInterfacedObject, IScopeLayout)
|
|
private
|
|
[weak]
|
|
FOwner: TExecutionScope;
|
|
function GetParent: IScopeLayout;
|
|
function GetSlotCount: Integer;
|
|
public
|
|
constructor Create(AOwner: TExecutionScope);
|
|
function FindSlot(const Name: string): Integer;
|
|
function GetSymbols: TArray<string>;
|
|
end;
|
|
|
|
TDynamicDescriptor = class(TInterfacedObject, IScopeDescriptor)
|
|
private
|
|
[weak]
|
|
FOwner: TExecutionScope;
|
|
FLayout: IScopeLayout;
|
|
function GetLayout: IScopeLayout;
|
|
function GetSymbolType(SlotIndex: Integer): IStaticType;
|
|
public
|
|
constructor Create(AOwner: TExecutionScope);
|
|
function CreateScope(const Parent: IExecutionScope): IExecutionScope;
|
|
end;
|
|
|
|
private
|
|
FParent: IExecutionScope;
|
|
FStaticDescriptor: IScopeDescriptor;
|
|
FLayoutIntf: IScopeLayout;
|
|
FSlotTypes: TArray<IStaticType>;
|
|
FValues: TArray<TScopeItem>;
|
|
FCapturedUpvalues: TArray<IValueCell>;
|
|
FNames: TDictionary<string, Integer>;
|
|
FNameStrings: TList<string>;
|
|
FNameToIndex: TDictionary<Integer, Integer>;
|
|
|
|
procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
|
|
procedure NeedNameToIndex;
|
|
function GetParent: IExecutionScope;
|
|
function GetDescriptor: IScopeDescriptor;
|
|
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 GetNameID(const Name: String): Integer;
|
|
function Resolve(const Name: string): TResolvedAddress;
|
|
function Dump: string;
|
|
function Define(const Name: string; const Value: TDataValue; const AStaticType: IStaticType = nil): TResolvedAddress;
|
|
procedure DefineBoxed(SlotIndex: Integer; 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;
|
|
property ValuesArray: TArray<TScopeItem> read FValues;
|
|
end;
|
|
|
|
{ TResolvedAddress & Symbol }
|
|
|
|
function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean;
|
|
begin
|
|
Result := (Left = Right);
|
|
end;
|
|
|
|
function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer;
|
|
var
|
|
adr: TResolvedAddress;
|
|
begin
|
|
adr := Value;
|
|
Result := THashBobJenkins.GetHashValue(adr.Kind, SizeOf(TAddressKind), 0);
|
|
Result := THashBobJenkins.GetHashValue(adr.ScopeDepth, SizeOf(Integer), Result);
|
|
Result := THashBobJenkins.GetHashValue(adr.SlotIndex, SizeOf(Integer), Result);
|
|
end;
|
|
|
|
constructor TResolvedAddress.Create(AKind: TAddressKind; AScopeDepth, ASlotIndex: Integer);
|
|
begin
|
|
Kind := AKind;
|
|
ScopeDepth := AScopeDepth;
|
|
SlotIndex := ASlotIndex;
|
|
end;
|
|
|
|
class operator TResolvedAddress.Equal(const A: TResolvedAddress; B: TResolvedAddress): Boolean;
|
|
begin
|
|
Result := (A.Kind = B.Kind) and (A.ScopeDepth = B.ScopeDepth) and (A.SlotIndex = B.SlotIndex);
|
|
end;
|
|
|
|
class operator TResolvedAddress.Initialize(out Dest: TResolvedAddress);
|
|
begin
|
|
Dest.Kind := akUnresolved;
|
|
Dest.ScopeDepth := -1;
|
|
Dest.SlotIndex := -1;
|
|
end;
|
|
|
|
constructor TResolvedSymbol.Create(const AAddress: TResolvedAddress; const AStaticType: IStaticType);
|
|
begin
|
|
Address := AAddress;
|
|
StaticType := AStaticType;
|
|
end;
|
|
|
|
class operator TResolvedSymbol.Initialize(out Dest: TResolvedSymbol);
|
|
begin
|
|
Dest.StaticType := TTypes.Unknown;
|
|
end;
|
|
|
|
{ TScopeLayout }
|
|
|
|
constructor TScopeLayout.Create(const AParent: IScopeLayout; AMap: TDictionary<string, Integer>; ASlotCount: Integer);
|
|
begin
|
|
inherited Create;
|
|
FParent := AParent;
|
|
FMap := AMap;
|
|
FSlotCount := ASlotCount;
|
|
end;
|
|
|
|
destructor TScopeLayout.Destroy;
|
|
begin
|
|
FMap.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TScopeLayout.FindSlot(const Name: string): Integer;
|
|
begin
|
|
if not FMap.TryGetValue(Name, Result) then
|
|
Result := -1;
|
|
end;
|
|
|
|
function TScopeLayout.GetSymbols: TArray<string>;
|
|
begin
|
|
Result := FMap.Keys.ToArray;
|
|
end;
|
|
|
|
function TScopeLayout.GetParent: IScopeLayout;
|
|
begin
|
|
Result := FParent;
|
|
end;
|
|
|
|
function TScopeLayout.GetSlotCount: Integer;
|
|
begin
|
|
Result := FSlotCount;
|
|
end;
|
|
|
|
{ TScopeBuilder }
|
|
|
|
constructor TScopeBuilder.Create(const AParentLayout: IScopeLayout);
|
|
begin
|
|
inherited Create;
|
|
FParentLayout := AParentLayout;
|
|
FMap := TDictionary<string, Integer>.Create;
|
|
FNextSlot := 0;
|
|
end;
|
|
|
|
destructor TScopeBuilder.Destroy;
|
|
begin
|
|
FMap.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TScopeBuilder.Define(const Name: string): Integer;
|
|
begin
|
|
// Rule: Shadowing / Redefinition in the same scope is forbidden.
|
|
// The Client (Binder) must ensure this name is not already taken before calling Define.
|
|
Assert(not FMap.ContainsKey(Name), 'Scope Error: Variable "' + Name + '" is already defined in this scope builder.');
|
|
|
|
// Allocate a new slot
|
|
Result := FNextSlot;
|
|
Inc(FNextSlot);
|
|
|
|
FMap.Add(Name, Result);
|
|
end;
|
|
|
|
function TScopeBuilder.FindSlot(const Name: string): Integer;
|
|
begin
|
|
if not FMap.TryGetValue(Name, Result) then
|
|
Result := -1;
|
|
end;
|
|
|
|
function TScopeBuilder.GetSymbols: TArray<string>;
|
|
begin
|
|
Result := FMap.Keys.ToArray;
|
|
end;
|
|
|
|
function TScopeBuilder.Build: IScopeLayout;
|
|
begin
|
|
// Pass FNextSlot as the total slot count
|
|
Result := TScopeLayout.Create(FParentLayout, TDictionary<string, Integer>.Create(FMap), FNextSlot);
|
|
end;
|
|
|
|
function TScopeBuilder.GetParent: IScopeLayout;
|
|
begin
|
|
Result := FParentLayout;
|
|
end;
|
|
|
|
function TScopeBuilder.GetSlotCount: Integer;
|
|
begin
|
|
Result := FNextSlot;
|
|
end;
|
|
|
|
{ TScopeDescriptor }
|
|
|
|
constructor TScopeDescriptor.Create(const ALayout: IScopeLayout; const ATypes: TArray<IStaticType>);
|
|
begin
|
|
inherited Create;
|
|
FLayout := ALayout;
|
|
FSlotTypes := ATypes;
|
|
end;
|
|
|
|
function TScopeDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope;
|
|
begin
|
|
Result := TExecutionScope.Create(Parent, Self, nil);
|
|
end;
|
|
|
|
function TScopeDescriptor.GetLayout: IScopeLayout;
|
|
begin
|
|
Result := FLayout;
|
|
end;
|
|
|
|
function TScopeDescriptor.GetSymbolType(SlotIndex: Integer): IStaticType;
|
|
begin
|
|
if (SlotIndex >= 0) and (SlotIndex < Length(FSlotTypes)) then
|
|
Result := FSlotTypes[SlotIndex]
|
|
else
|
|
Result := TTypes.Unknown;
|
|
end;
|
|
|
|
{ TExecutionScope Proxies }
|
|
|
|
constructor TExecutionScope.TDynamicLayout.Create(AOwner: TExecutionScope);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
end;
|
|
|
|
function TExecutionScope.TDynamicLayout.FindSlot(const Name: string): Integer;
|
|
begin
|
|
if not FOwner.Names.TryGetValue(Name, Result) then
|
|
Result := -1
|
|
else if not FOwner.NameToIndex.TryGetValue(Result, Result) then
|
|
Result := -1;
|
|
end;
|
|
|
|
function TExecutionScope.TDynamicLayout.GetSymbols: TArray<string>;
|
|
begin
|
|
Result := FOwner.FNames.Keys.ToArray;
|
|
end;
|
|
|
|
function TExecutionScope.TDynamicLayout.GetParent: IScopeLayout;
|
|
begin
|
|
if Assigned(FOwner.Parent) then
|
|
Result := FOwner.Parent.Descriptor.Layout
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TExecutionScope.TDynamicLayout.GetSlotCount: Integer;
|
|
begin
|
|
Result := Length(FOwner.FValues);
|
|
end;
|
|
|
|
constructor TExecutionScope.TDynamicDescriptor.Create(AOwner: TExecutionScope);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
FLayout := TDynamicLayout.Create(AOwner);
|
|
end;
|
|
|
|
function TExecutionScope.TDynamicDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope;
|
|
begin
|
|
Result := TExecutionScope.Create(Parent, Self, nil);
|
|
end;
|
|
|
|
function TExecutionScope.TDynamicDescriptor.GetLayout: IScopeLayout;
|
|
begin
|
|
Result := FLayout;
|
|
end;
|
|
|
|
function TExecutionScope.TDynamicDescriptor.GetSymbolType(SlotIndex: Integer): IStaticType;
|
|
begin
|
|
if (SlotIndex >= 0) and (SlotIndex < Length(FOwner.FSlotTypes)) then
|
|
Result := FOwner.FSlotTypes[SlotIndex]
|
|
else
|
|
Result := TTypes.Unknown;
|
|
end;
|
|
|
|
{ TExecutionScope }
|
|
|
|
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;
|
|
|
|
constructor TExecutionScope.Create(
|
|
AParent: IExecutionScope;
|
|
const ADescriptor: IScopeDescriptor;
|
|
const ACapturedUpvalues: TArray<IValueCell>
|
|
);
|
|
begin
|
|
inherited Create;
|
|
FParent := AParent;
|
|
|
|
if Assigned(ADescriptor) then
|
|
begin
|
|
FStaticDescriptor := ADescriptor;
|
|
FLayoutIntf := ADescriptor.Layout;
|
|
end
|
|
else
|
|
begin
|
|
FStaticDescriptor := nil;
|
|
FLayoutIntf := nil;
|
|
FSlotTypes := [];
|
|
end;
|
|
|
|
FValues := [];
|
|
FCapturedUpvalues := ACapturedUpvalues;
|
|
|
|
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 Assigned(FLayoutIntf) then
|
|
SetLength(FValues, FLayoutIntf.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;
|
|
|
|
function TExecutionScope.GetDescriptor: IScopeDescriptor;
|
|
begin
|
|
if Assigned(FStaticDescriptor) then
|
|
Result := FStaticDescriptor
|
|
else
|
|
Result := TDynamicDescriptor.Create(Self);
|
|
end;
|
|
|
|
procedure TExecutionScope.Clear;
|
|
begin
|
|
FValues := [];
|
|
FreeAndNil(FNameToIndex);
|
|
end;
|
|
|
|
function TExecutionScope.Capture(const Address: TResolvedAddress): IValueCell;
|
|
var
|
|
targetScope: TExecutionScope;
|
|
i: Integer;
|
|
begin
|
|
Assert(Address.Kind <> akUnresolved, 'Scope Error: Cannot capture an unresolved address.');
|
|
|
|
case Address.Kind of
|
|
akUpvalue:
|
|
begin
|
|
Result := FCapturedUpvalues[Address.SlotIndex];
|
|
end;
|
|
akLocalOrParent:
|
|
begin
|
|
targetScope := Self;
|
|
for i := 1 to Address.ScopeDepth do
|
|
targetScope := targetScope.Parent as TExecutionScope;
|
|
|
|
TMonitor.Enter(targetScope);
|
|
try
|
|
var item := targetScope.FValues[Address.SlotIndex];
|
|
if item.IsBoxed then
|
|
Result := item.Value.AsIntf<IValueCell>
|
|
else
|
|
begin
|
|
Result := TValueCell.Create(item.Value);
|
|
targetScope.FValues[Address.SlotIndex].Value := TDataValue.FromIntf<IValueCell>(Result);
|
|
targetScope.FValues[Address.SlotIndex].IsBoxed := True;
|
|
end;
|
|
finally
|
|
TMonitor.Exit(targetScope);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TExecutionScope.Define(const Name: string; const Value: TDataValue; const AStaticType: IStaticType): TResolvedAddress;
|
|
var
|
|
id: Integer;
|
|
index: Integer;
|
|
begin
|
|
NeedNameToIndex;
|
|
id := GetNameID(Name);
|
|
|
|
// NOTE: Runtime redefinition is generally restricted in this dynamic Define.
|
|
// The Client must ensure uniqueness.
|
|
Assert(not FNameToIndex.ContainsKey(id), 'Scope Error: Variable "' + Name + '" is already defined in this execution scope.');
|
|
|
|
index := Length(FValues);
|
|
SetLength(FValues, index + 1);
|
|
FValues[index].Value := Value;
|
|
FValues[index].IsBoxed := False;
|
|
|
|
if FStaticDescriptor = nil then
|
|
begin
|
|
if index >= Length(FSlotTypes) then
|
|
SetLength(FSlotTypes, index + 1);
|
|
if Assigned(AStaticType) then
|
|
FSlotTypes[index] := AStaticType
|
|
else
|
|
FSlotTypes[index] := TTypes.Unknown;
|
|
end;
|
|
|
|
FNameToIndex.Add(id, index);
|
|
Result.Kind := akLocalOrParent;
|
|
Result.ScopeDepth := 0;
|
|
Result.SlotIndex := index;
|
|
end;
|
|
|
|
procedure TExecutionScope.DefineBoxed(SlotIndex: Integer; const Value: TDataValue);
|
|
begin
|
|
if SlotIndex >= Length(FValues) then
|
|
SetLength(FValues, SlotIndex + 1);
|
|
FValues[SlotIndex].Value := TDataValue.FromIntf<IValueCell>(TValueCell.Create(Value));
|
|
FValues[SlotIndex].IsBoxed := True;
|
|
end;
|
|
|
|
procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
|
|
var
|
|
pair: TPair<Integer, Integer>;
|
|
indentStr, boxedStr: string;
|
|
sortedPairs: TArray<TPair<Integer, Integer>>;
|
|
item: TScopeItem;
|
|
val: TDataValue;
|
|
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
|
|
begin
|
|
if pair.Value < Length(FValues) then
|
|
begin
|
|
item := FValues[pair.Value];
|
|
if item.IsBoxed then
|
|
begin
|
|
boxedStr := ' (Boxed)';
|
|
val := (item.Value.AsIntf<IValueCell>).Value;
|
|
end
|
|
else
|
|
begin
|
|
boxedStr := '';
|
|
val := item.Value;
|
|
end;
|
|
ABuilder.AppendLine(indentStr + Format(' [%d] %s: %s%s', [pair.Value, FNameStrings[pair.Key], val.ToString, boxedStr]));
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
ABuilder.AppendLine(indentStr + ' (empty)');
|
|
|
|
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;
|
|
var
|
|
item: TScopeItem;
|
|
begin
|
|
Assert(Address.Kind <> akUnresolved, 'Scope Error: Cannot get value for an unresolved address.');
|
|
|
|
case Address.Kind of
|
|
akUpvalue:
|
|
begin
|
|
Result := FCapturedUpvalues[Address.SlotIndex].Value;
|
|
end;
|
|
akLocalOrParent:
|
|
begin
|
|
var targetScope := Self;
|
|
for var i := 1 to Address.ScopeDepth do
|
|
targetScope := targetScope.Parent as TExecutionScope;
|
|
|
|
item := targetScope.FValues[Address.SlotIndex];
|
|
if item.IsBoxed then
|
|
Result := (item.Value.AsIntf<IValueCell>).Value
|
|
else
|
|
Result := item.Value;
|
|
end;
|
|
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 Assigned(FStaticDescriptor) and (FStaticDescriptor.Layout is TScopeLayout) then
|
|
begin
|
|
var map := (FStaticDescriptor.Layout as TScopeLayout).FMap;
|
|
for var item in map do
|
|
FNameToIndex.AddOrSetValue(GetNameId(item.Key), item.Value);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TExecutionScope.Resolve(const Name: string): TResolvedAddress;
|
|
var
|
|
nameID, slotIndex: Integer;
|
|
currentScope: IExecutionScope;
|
|
depth: Integer;
|
|
begin
|
|
currentScope := Self;
|
|
depth := 0;
|
|
nameID := GetNameID(Name);
|
|
|
|
while Assigned(currentScope) do
|
|
begin
|
|
var execScopeImpl := (currentScope as TExecutionScope);
|
|
if execScopeImpl.NameToIndex.TryGetValue(nameID, slotIndex) then
|
|
begin
|
|
Result.Kind := akLocalOrParent;
|
|
Result.ScopeDepth := depth;
|
|
Result.SlotIndex := slotIndex;
|
|
exit;
|
|
end;
|
|
Inc(depth);
|
|
currentScope := currentScope.Parent;
|
|
end;
|
|
Result := Default(TResolvedAddress);
|
|
end;
|
|
|
|
procedure TExecutionScope.SetValues(const Address: TResolvedAddress; const Value: TDataValue);
|
|
var
|
|
targetScope: TExecutionScope;
|
|
i: Integer;
|
|
begin
|
|
Assert(Address.Kind <> akUnresolved, 'Scope Error: Cannot set value for an unresolved address.');
|
|
|
|
case Address.Kind of
|
|
akUpvalue:
|
|
begin
|
|
FCapturedUpvalues[Address.SlotIndex].Value := Value;
|
|
end;
|
|
akLocalOrParent:
|
|
begin
|
|
targetScope := Self;
|
|
for i := 1 to Address.ScopeDepth do
|
|
targetScope := targetScope.Parent as TExecutionScope;
|
|
|
|
var pItem: ^TScopeItem := @targetScope.FValues[Address.SlotIndex];
|
|
if pItem.IsBoxed then
|
|
(pItem.Value.AsIntf<IValueCell>).Value := Value
|
|
else
|
|
pItem.Value := Value;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TExecutionScope.TScopeItem.GetContent: TDataValue;
|
|
begin
|
|
Result := Value;
|
|
if IsBoxed then
|
|
Result := Result.AsIntf<IValueCell>.Value;
|
|
end;
|
|
|
|
{ TScope }
|
|
|
|
class function TScope.CreateBuilder(const ParentLayout: IScopeLayout): IScopeBuilder;
|
|
begin
|
|
Result := TScopeBuilder.Create(ParentLayout);
|
|
end;
|
|
|
|
class function TScope.CreateDescriptor(const Layout: IScopeLayout; const Types: TArray<IStaticType>): IScopeDescriptor;
|
|
begin
|
|
Result := TScopeDescriptor.Create(Layout, Types);
|
|
end;
|
|
|
|
class function TScope.CreateScope(
|
|
const Parent: IExecutionScope;
|
|
const Descriptor: IScopeDescriptor;
|
|
const CapturedUpvalues: TArray<IValueCell>
|
|
): IExecutionScope;
|
|
begin
|
|
Result := TExecutionScope.Create(Parent, Descriptor, CapturedUpvalues);
|
|
end;
|
|
|
|
class function TScope.CreateRootLayout: IScopeLayout;
|
|
begin
|
|
Result := TScopeLayout.Create(nil, TDictionary<string, Integer>.Create, 0);
|
|
end;
|
|
|
|
end.
|