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); 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); public constructor Create(AParent: IExecutionScope = nil); constructor CreateFromDescriptor(const AParent: IExecutionScope; const ADescriptor: IScopeDescriptor); destructor Destroy; override; 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); begin inherited Create; FParent := AParent; FValues := []; FNameToIndex := TDictionary.Create; end; constructor TExecutionScope.CreateFromDescriptor(const AParent: IExecutionScope; const ADescriptor: IScopeDescriptor); begin inherited Create; FParent := AParent; FNameToIndex := TDictionary.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.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.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.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.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.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.