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; FNameToIndex: TDictionary; procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); function GetValues(const Address: TResolvedAddress): TAstValue; procedure SetValues(const Address: TResolvedAddress; const Value: TAstValue); function GetParent: IExecutionScope; public constructor Create(AParent: IExecutionScope = nil; const ADescriptor: IScopeDescriptor = nil); destructor Destroy; override; procedure Clear; function Dump: string; procedure Define(const Name: string; const Value: TAstValue); property NameToIndex: TDictionary read FNameToIndex; property Parent: IExecutionScope read FParent; property Values: TArray read FValues; end; implementation uses System.Generics.Defaults; { TExecutionScope } constructor TExecutionScope.Create(AParent: IExecutionScope = nil; const ADescriptor: IScopeDescriptor = nil); begin inherited Create; FParent := AParent; FValues := []; FNameToIndex := TDictionary.Create; if ADescriptor <> nil then begin for var item in ADescriptor.Symbols do FNameToIndex.AddOrSetValue(item.Key, item.Value); SetLength(FValues, ADescriptor.SlotCount); end; end; destructor TExecutionScope.Destroy; begin FNameToIndex.Free; inherited Destroy; end; function TExecutionScope.GetParent: IExecutionScope; begin Result := FParent; 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; indentStr: string; sortedPairs: TArray>; begin indentStr := ''.PadLeft(AIndent); if (FNameToIndex.Count > 0) then begin sortedPairs := FNameToIndex.ToArray; TArray.Sort>( sortedPairs, TComparer> .Construct(function(const Left, Right: TPair): 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.GetValues(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.SetValues(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; end.