diff --git a/Doc/Zustandsmodell.md b/Doc/Zustandsmodell.md new file mode 100644 index 0000000..c100fc5 --- /dev/null +++ b/Doc/Zustandsmodell.md @@ -0,0 +1,32 @@ +Absolut. Hier ist der Projektplan, der unsere Ergebnisse zusammenfasst. + +*** + +### Projektplan: Thread-sicheres Zustandsmodell + +* **Datum:** 30. September 2025 +* **Uhrzeit:** 13:09 + +#### Motivation + +Ziel ist eine einfache, visuell darstellbare und inhärent threadsichere Skriptsprache. Eine rein funktionale Herangehensweise erwies sich als unpraktisch. Stattdessen wird ein pragmatischer Ansatz nach dem Vorbild von Clojure verfolgt: Daten sind standardmäßig immutable, aber es gibt explizite, sichere Werkzeuge zur Verwaltung von veränderlichem Zustand. + +#### Ziel + +Die Sprache soll eine klare Trennung zwischen unveränderlichen **Werten** und veränderlichen **Identitäten** (Variablen) haben. Jede Zustandsänderung muss explizit und atomar sein, um Race Conditions per Design auszuschließen. Die Implementierung soll dabei möglichst einfach und performant (lock-free) sein. + +#### Ergebnis + +Wir haben eine elegante, lock-freie Lösung erarbeitet, die auf einer zentralen Regel basiert: Der Typ (`FKind`) einer `TDataValue` ist nach der Initialisierung **immutable**. + +1. **Atomarität in `TDataValue`:** Die atomaren Operationen (`Reset`, `CompareAndSet`) werden direkt als Instanzmethoden auf dem `TDataValue`-Record implementiert. Dies ist möglich, weil die `FKind`-Immutabilität die TOCTOU-Race-Condition verhindert, die eine solche Implementierung sonst unsicher machen würde. +2. **Selektives Capturing bleibt:** Der `IValueCell`-Mechanismus in der `Scope`-Unit wird beibehalten. Seine entscheidende Rolle ist nicht die Atomarität, sondern die Speicheroptimierung, indem Closures nur die Referenzen auf die Upvalues halten, die sie wirklich benötigen, und nicht den gesamten Parent-Scope. +3. **Separation of Concerns:** `TDataValue` weiß, *wie* man seinen Zustand atomar ändert. `IValueCell` ist die notwendige Indirektion, um Closures und Speichermanagement korrekt abzubilden. + +#### Todo + +* [ ] Die atomaren Instanzmethoden (`Reset`, `CompareAndSet`) in `Myc.Data.Value` finalisieren. +* [ ] Die `IValueCell`-Implementierung in `Myc.Ast.Scope` so anpassen, dass sie die neuen atomaren Instanzmethoden von `TDataValue` aufruft. +* [ ] Neue RTL-Funktionen `reset!`, `compare-and-set!` und das abgeleitete `swap!` erstellen, die im Evaluator auf den `IValueCell`-Instanzen operieren. +* [ ] Das alte `assign`-Schlüsselwort aus Parser, Binder und Evaluator entfernen. +* [ ] Bestehende Tests (`CreateSMA`, `FailingUpvalueButtonClick` etc.) auf die Verwendung von `reset!` oder `swap!` anstelle von `assign` umstellen. \ No newline at end of file diff --git a/Src/AST/Myc.Ast.Analyzer.pas b/Src/AST/Myc.Ast.Analyzer.pas new file mode 100644 index 0000000..ba5adcc --- /dev/null +++ b/Src/AST/Myc.Ast.Analyzer.pas @@ -0,0 +1,155 @@ +unit Myc.Ast.Analyzer; + +interface + +uses + System.SysUtils, + System.Classes, + System.Generics.Collections, + Myc.Ast.Nodes, + Myc.Ast.Visitor, + Myc.Ast.Scope; + +type + // This visitor analyzes the AST to find all variables that need to be "lifted" or "boxed" + // because they are captured by a nested lambda. + TUpvalueAnalyzer = class(TAstTraverser) + private + FBoxedDeclarations: THashSet; + FCurrentScope: IScopeDescriptor; + FDeclarationMap: TDictionary>; + procedure MarkDeclarationForBoxing(const AName: string); + protected + function TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; override; + function TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; override; + function TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; override; + public + constructor Create(const AParent: IScopeDescriptor); + destructor Destroy; override; + class function Analyze(const ARootNode: IAstNode; const AParent: IScopeDescriptor): THashSet; static; + end; + +implementation + +{ TUpvalueAnalyzer } + +constructor TUpvalueAnalyzer.Create(const AParent: IScopeDescriptor); +begin + inherited Create; + FBoxedDeclarations := THashSet.Create; + FDeclarationMap := TDictionary>.Create; + FCurrentScope := TScope.CreateDescriptor(AParent); +end; + +destructor TUpvalueAnalyzer.Destroy; +begin + FBoxedDeclarations.Free; + for var dict in FDeclarationMap.Values do + dict.Free; + FDeclarationMap.Free; + inherited Destroy; +end; + +class function TUpvalueAnalyzer.Analyze(const ARootNode: IAstNode; const AParent: IScopeDescriptor): THashSet; +var + analyzer: TUpvalueAnalyzer; +begin + if not Assigned(ARootNode) then + exit(THashSet.Create); + + analyzer := TUpvalueAnalyzer.Create(AParent); + try + analyzer.Execute(ARootNode); + Result := analyzer.FBoxedDeclarations; + analyzer.FBoxedDeclarations := nil; // Transfer ownership + finally + analyzer.Free; + end; +end; + +procedure TUpvalueAnalyzer.MarkDeclarationForBoxing(const AName: string); +var + address: TResolvedAddress; + declarationScope: IScopeDescriptor; + i: Integer; +begin + address := FCurrentScope.FindSymbol(AName); + if address.Kind <> akLocalOrParent then + exit; + + // Walk up the scope chain to find the scope where the variable was declared. + declarationScope := FCurrentScope; + for i := 1 to address.ScopeDepth do + begin + if not Assigned(declarationScope.Parent) then + exit; // Should not happen in a correctly bound tree + declarationScope := declarationScope.Parent; + end; + + // Find the declaration node in our map and add it to the set. + var dict: TDictionary; + if FDeclarationMap.TryGetValue(declarationScope, dict) then + begin + var declNode: IVariableDeclarationNode; + if dict.TryGetValue(AName, declNode) then + FBoxedDeclarations.Add(declNode); + end; +end; + +function TUpvalueAnalyzer.TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; +var + address: TResolvedAddress; +begin + Result := Node; + if not Assigned(FCurrentScope) then + exit; + + address := FCurrentScope.FindSymbol(Node.Name); + + if (address.Kind = akLocalOrParent) and (address.ScopeDepth > 0) then + begin + // This is an upvalue. Mark its original declaration for boxing. + MarkDeclarationForBoxing(Node.Name); + end; +end; + +function TUpvalueAnalyzer.TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; +begin + // A lambda creates a new lexical scope, inheriting from the current one. + FCurrentScope := TScope.CreateDescriptor(FCurrentScope); + try + // Define the lambda's parameters within its new scope. + for var param in Node.Parameters do + FCurrentScope.Define(param.Name); + + // Traverse the lambda body within the new scope context. + Node.Body.Accept(Self); + Result := Node; // We do not transform, just analyze. + finally + // Restore the parent scope after leaving the lambda. + FCurrentScope := FCurrentScope.Parent; + end; +end; + +function TUpvalueAnalyzer.TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; +var + scopeDeclarations: TDictionary; +begin + Result := Node; + + if Assigned(Node.Initializer) then + Node.Initializer.Accept(Self); + + // After processing the initializer, define the variable in the current scope. + FCurrentScope.Define(Node.Identifier.Name); + + // Map this declaration node to its scope and name for later lookup. + if not FDeclarationMap.TryGetValue(FCurrentScope, scopeDeclarations) then + begin + scopeDeclarations := TDictionary.Create; + FDeclarationMap.Add(FCurrentScope, scopeDeclarations); + end; + scopeDeclarations.Add(Node.Identifier.Name, Node); +end; + +end. diff --git a/Src/AST/Myc.Ast.Binding.pas b/Src/AST/Myc.Ast.Binding.pas index 25effd6..f0cc7eb 100644 --- a/Src/AST/Myc.Ast.Binding.pas +++ b/Src/AST/Myc.Ast.Binding.pas @@ -10,8 +10,14 @@ uses Myc.Ast.Nodes, Myc.Ast.Visitor, Myc.Ast.Scope, + Myc.Ast.Analyzer, Myc.Ast; +//TODO Es gibt hier einen fundamentalen Fehler. Der Binder ist ist in einem Durchlauf nicht in der Lage, Upvalues zu erkennen. +// Wenn in TransformVariableDeclaration eine Variable definiert wird, ist sie grundsätzlich lokal, obwohl sie in einer nested lambda als upvalue benutzt werden könnte. +// Deshalb muss eigentlich zunächst ermittelt werden, wleche variablen später zur upvalue werden. +// Dafür ist Myc.Ast.Analyzer möglicherweise nützlich. + type // The binder is a transformer that enriches the AST with semantic information // like resolved addresses, scopes, and tail-call annotations. @@ -36,6 +42,9 @@ type FNestedLambdaCount: Integer; FIsTailStack: TStack; FNextIsTail: Boolean; + // Contains all variable declarations that are captured by a closure. + // This is populated by a pre-pass before the transformation begins. + FBoxedDeclarations: THashSet; procedure EnterScope; procedure ExitScope; @@ -73,6 +82,15 @@ type property Address: TResolvedAddress read FAddress; end; + // A bound variable declaration node that includes whether the variable is captured (boxed). + TBoundVariableDeclarationNode = class(TVariableDeclarationNode) + private + FIsBoxed: Boolean; + public + constructor Create(const AIdentifier: IIdentifierNode; AInitializer: IAstNode; AIsBoxed: Boolean); + property IsBoxed: Boolean read FIsBoxed; + end; + TBoundLambdaExpressionNode = class(TLambdaExpressionNode) private FScopeDescriptor: IScopeDescriptor; @@ -127,6 +145,13 @@ begin FAddress := AAddress; end; +{ TBoundVariableDeclarationNode } +constructor TBoundVariableDeclarationNode.Create(const AIdentifier: IIdentifierNode; AInitializer: IAstNode; AIsBoxed: Boolean); +begin + inherited Create(AIdentifier, AInitializer); + FIsBoxed := AIsBoxed; +end; + { TBoundLambdaExpressionNode } constructor TBoundLambdaExpressionNode.Create( const AUnboundNode: ILambdaExpressionNode; @@ -192,12 +217,14 @@ begin FNestedLambdaCount := 0; FIsTailStack := TStack.Create; FNextIsTail := True; + FBoxedDeclarations := nil; end; destructor TAstBinder.Destroy; begin FIsTailStack.Free; FUpvalueStack.Free; + FBoxedDeclarations.Free; inherited; end; @@ -221,12 +248,20 @@ end; function TAstBinder.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; begin - EnterScope; + // First pass: Analyze the entire AST to find all variable declarations + // that are captured by closures (upvalues). + FBoxedDeclarations := TUpvalueAnalyzer.Analyze(RootNode, FCurrentDescriptor.Parent); try - Result := Accept(RootNode).AsIntf; - Descriptor := FCurrentDescriptor; + // Second pass: Transform the tree, using the information from the analysis pass. + EnterScope; + try + Result := Accept(RootNode).AsIntf; + Descriptor := FCurrentDescriptor; + finally + ExitScope; + end; finally - ExitScope; + // The binder now owns the hash set, which will be freed in the destructor. end; end; @@ -290,11 +325,13 @@ var slotIndex: Integer; address: TResolvedAddress; boundIdentifier: IIdentifierNode; + isBoxed: Boolean; begin if not IsValidIdentifier(Node.Identifier.Name) then raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]); FNextIsTail := False; + initializer := nil; if Node.Initializer <> nil then initializer := Accept(Node.Initializer).AsIntf; @@ -303,7 +340,11 @@ begin boundIdentifier := TBoundIdentifierNode.Create(Node.Identifier, address); - Result := TAst.VarDecl(boundIdentifier, initializer); + // Check if the analysis pass marked this declaration as being captured by a closure. + isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node); + + // Always create a bound declaration node, passing the IsBoxed flag. + Result := TBoundVariableDeclarationNode.Create(boundIdentifier, initializer, isBoxed); end; function TAstBinder.TransformAssignment(const Node: IAssignmentNode): IAssignmentNode; diff --git a/Src/AST/Myc.Ast.Dumper.pas b/Src/AST/Myc.Ast.Dumper.pas index 6052401..4e94a7f 100644 --- a/Src/AST/Myc.Ast.Dumper.pas +++ b/Src/AST/Myc.Ast.Dumper.pas @@ -295,7 +295,11 @@ end; function TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; begin - Log('VariableDeclaration'); + if Node is TBoundVariableDeclarationNode then + LogFmt('VariableDeclaration (IsBoxed: %s)', [(Node as TBoundVariableDeclarationNode).IsBoxed.ToString(TUseBoolStrs.True)]) + else + Log('VariableDeclaration (unbound)'); + Indent; Node.Identifier.Accept(Self); if Assigned(Node.Initializer) then diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 9e24580..e3c081f 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -319,7 +319,9 @@ end; function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue; begin + // Evaluate the new value. Result := Node.Value.Accept(Self); + // Assign it. The scope's SetValues implementation now handles boxing correctly. FScope[(Node.Identifier as TBoundIdentifierNode).Address] := Result; end; @@ -350,6 +352,7 @@ end; function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue; begin + // The scope's GetValues implementation now handles unboxing automatically. Result := FScope[(Node as TBoundIdentifierNode).Address]; end; @@ -406,13 +409,31 @@ begin end; function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; +var + address: TResolvedAddress; + boundNode: TBoundVariableDeclarationNode; begin + // First, evaluate the initializer to get the variable's initial value. if Assigned(Node.Initializer) then Result := Node.Initializer.Accept(Self) else Result := TDataValue.Void; - FScope[(Node.Identifier as TBoundIdentifierNode).Address] := Result; + // After binding, all declaration nodes are TBoundVariableDeclarationNode + boundNode := Node as TBoundVariableDeclarationNode; + address := (boundNode.Identifier as TBoundIdentifierNode).Address; + + // Check the IsBoxed flag set by the binder. + if boundNode.IsBoxed then + begin + // This is a captured variable. Use the clean scope method to create the box. + FScope.DefineBoxed(address, Result); + end + else + begin + // This is a standard local variable. Store the raw value directly. + FScope[address] := Result; + end; end; function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas index 7259177..5898cde 100644 --- a/Src/AST/Myc.Ast.Scope.pas +++ b/Src/AST/Myc.Ast.Scope.pas @@ -29,6 +29,8 @@ type {$endregion} procedure Define(const Name: string; const Value: TDataValue); + // Defines a variable at a given address and stores it directly in a shared cell (boxing). + procedure DefineBoxed(const Address: TResolvedAddress; const Value: TDataValue); function Dump: string; procedure Clear; function Capture(const Address: TResolvedAddress): IValueCell; @@ -67,10 +69,12 @@ type implementation uses - System.Generics.Defaults; + System.Generics.Defaults, + System.SyncObjs; type TExecutionScope = class(TInterfacedObject, IExecutionScope) + private type TValueCell = class(TInterfacedObject, IValueCell) private @@ -81,21 +85,15 @@ type constructor Create(const AValue: TDataValue); end; - // Corrected TValueRef: Holds a stable reference to the scope and address, not the raw array. - TValueRef = class(TInterfacedObject, IValueCell) - private - FScope: IExecutionScope; - FAddress: TResolvedAddress; - function GetValue: TDataValue; - procedure SetValue(const AValue: TDataValue); - public - constructor Create(const AScope: IExecutionScope; const AAddress: TResolvedAddress); + TScopeItem = record + Value: TDataValue; + IsBoxed: Boolean; end; private FParent: IExecutionScope; FDescriptor: IScopeDescriptor; - FValues: TArray; + FValues: TArray; FCapturedUpvalues: TArray; FNames: TDictionary; FNameStrings: TList; @@ -114,6 +112,7 @@ type procedure Clear; function Dump: string; procedure Define(const Name: string; const Value: TDataValue); + procedure DefineBoxed(const Address: TResolvedAddress; const Value: TDataValue); function Capture(const Address: TResolvedAddress): IValueCell; function CreateDescriptor: IScopeDescriptor; property Names: TDictionary read FNames; @@ -158,27 +157,6 @@ begin FValue := AValue; end; -{ TExecutionScope.TValueRef } - -constructor TExecutionScope.TValueRef.Create(const AScope: IExecutionScope; const AAddress: TResolvedAddress); -begin - inherited Create; - FScope := AScope; - FAddress := AAddress; -end; - -function TExecutionScope.TValueRef.GetValue: TDataValue; -begin - // Delegate the call to the scope, which correctly handles parent traversal. - Result := FScope[FAddress]; -end; - -procedure TExecutionScope.TValueRef.SetValue(const AValue: TDataValue); -begin - // Delegate the call to the scope. - FScope[FAddress] := AValue; -end; - { TExecutionScope } constructor TExecutionScope.Create( @@ -192,7 +170,7 @@ begin FDescriptor := ADescriptor; FValues := []; - FCapturedUpvalues := ACapturedUpvalues; // Store upvalues + FCapturedUpvalues := ACapturedUpvalues; if FParent is TExecutionScope then begin @@ -232,26 +210,49 @@ begin end; function TExecutionScope.Capture(const Address: TResolvedAddress): IValueCell; +var + targetScope: TExecutionScope; + i: Integer; 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.' - ); + Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)), 'Invalid upvalue index.'); Result := FCapturedUpvalues[Address.SlotIndex]; end; akLocalOrParent: begin - // Corrected Implementation: Create a TValueRef that holds the current scope - // and the full address. The scope's indexer will handle the parent traversal correctly - // and is robust against array reallocations. - Result := TValueRef.Create(Self, Address); + targetScope := Self; + for i := 1 to Address.ScopeDepth do + begin + targetScope := targetScope.Parent as TExecutionScope; + Assert(Assigned(targetScope), 'Invalid scope depth during capture.'); + end; + Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), 'Invalid slot index during capture.'); + + // The check-and-update for JIT-boxing must be atomic. + TMonitor.Enter(targetScope); + try + var item := targetScope.FValues[Address.SlotIndex]; + if item.IsBoxed then + begin + // The variable is already boxed, so just return its cell. + Result := item.Value.AsIntf; + end + else + begin + // This is an unboxed variable. Box it "just-in-time" and update the scope. + Result := TValueCell.Create(item.Value); + targetScope.FValues[Address.SlotIndex].Value := TDataValue.FromIntf(Result); + targetScope.FValues[Address.SlotIndex].IsBoxed := True; + end; + finally + TMonitor.Exit(targetScope); + end; end; else - raise EInvalidOpException.Create('Cannot get value for an unresolved address.'); + raise EInvalidOpException.Create('Cannot capture an unresolved address.'); end; end; @@ -266,26 +267,41 @@ var 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; + FValues[index].Value := Value; + FValues[index].IsBoxed := False; FNameToIndex.Add(id, index); end; +procedure TExecutionScope.DefineBoxed(const Address: TResolvedAddress; const Value: TDataValue); +var + targetScope: TExecutionScope; + i: Integer; +begin + // This method is only for local variables (ScopeDepth=0). + Assert(Address.ScopeDepth = 0, 'DefineBoxed can only be used on the current scope.'); + targetScope := Self; + + Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), 'Invalid slot index during DefineBoxed.'); + + targetScope.FValues[Address.SlotIndex].Value := TDataValue.FromIntf(TValueCell.Create(Value)); + targetScope.FValues[Address.SlotIndex].IsBoxed := True; +end; + procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); var pair: TPair; - indentStr: string; + indentStr, boxedStr: string; sortedPairs: TArray>; + item: TScopeItem; + val: TDataValue; begin NeedNameToIndex; - indentStr := ''.PadLeft(AIndent); if FNameToIndex.Count > 0 then begin @@ -297,13 +313,23 @@ begin ); 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])); + begin + item := FValues[pair.Value]; + if item.IsBoxed then + begin + boxedStr := ' (Boxed)'; + val := (item.Value.AsIntf).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 else - begin ABuilder.AppendLine(indentStr + ' (empty)'); - end; if Assigned(FParent) then begin @@ -333,15 +359,14 @@ begin end; function TExecutionScope.GetValues(const Address: TResolvedAddress): TDataValue; +var + item: TScopeItem; 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.' - ); + Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)), 'Invalid upvalue index.'); Result := FCapturedUpvalues[Address.SlotIndex].Value; end; akLocalOrParent: @@ -350,13 +375,15 @@ begin for var i := 1 to Address.ScopeDepth do begin targetScope := targetScope.Parent as TExecutionScope; - Assert(Assigned(targetScope), 'Invalid scope depth during value retrieval.'); + Assert(Assigned(targetScope), 'Invalid scope depth for GetValues.'); end; - Assert( - (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), - 'Invalid scope index during value retrieval.' - ); - Result := targetScope.FValues[Address.SlotIndex]; + Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), 'Invalid slot index for GetValues.'); + + item := targetScope.FValues[Address.SlotIndex]; + if item.IsBoxed then + Result := (item.Value.AsIntf).Value + else + Result := item.Value; end; else raise EInvalidOpException.Create('Cannot get value for an unresolved address.'); @@ -386,38 +413,41 @@ begin end; procedure TExecutionScope.SetValues(const Address: TResolvedAddress; const Value: TDataValue); +var + targetScope: TExecutionScope; + i: Integer; 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.' - ); + Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)), 'Invalid upvalue index.'); FCapturedUpvalues[Address.SlotIndex].Value := Value; end; akLocalOrParent: begin - var targetScope := Self; - for var i := 1 to Address.ScopeDepth do + targetScope := Self; + for i := 1 to Address.ScopeDepth do begin targetScope := targetScope.Parent as TExecutionScope; - Assert(Assigned(targetScope), 'Invalid scope depth during value retrieval.'); + Assert(Assigned(targetScope), 'Invalid scope depth for SetValues.'); end; - Assert( - (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), - 'Invalid scope index during value retrieval.' - ); - targetScope.FValues[Address.SlotIndex] := Value; + Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)), 'Invalid slot index for SetValues.'); + + // Use a reference/pointer to modify the array element in place + var pItem: ^TScopeItem := @targetScope.FValues[Address.SlotIndex]; + if pItem.IsBoxed then + (pItem.Value.AsIntf).Value := Value + else + pItem.Value := Value; end; else - raise EInvalidOpException.Create('Cannot get value for an unresolved address.'); + raise EInvalidOpException.Create('Cannot set value for an unresolved address.'); end; end; { TScopeDescriptor } - +// ... (Implementation unchanged and correct) ... constructor TScopeDescriptor.Create(const AParent: IScopeDescriptor); begin inherited Create; @@ -445,7 +475,6 @@ 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; @@ -491,8 +520,6 @@ 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];