Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Optimizing captures in Scope

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-15 12:12:23 +02:00
parent c913f9dbc5
commit e78ef0a3ea
4 changed files with 123 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/MainForm.pas
+1 -1
View File
@@ -548,7 +548,7 @@ begin
if series.AsRecordSeries.Value.TotalCount >= smaSlowLength then
begin
scope[seriesAddress].Value := series;
scope[seriesAddress] := series;
var resultValue := callAst.Accept(visitor);
if i mod 50 = 0 then
begin
Src/AST/Myc.Ast.Evaluator.pas
+10 -12
View File
@@ -133,7 +133,7 @@ begin
sourceAddresses := Node.Upvalues;
SetLength(capturedCells, Length(sourceAddresses));
for i := 0 to High(sourceAddresses) do
capturedCells[i] := FScope.GetCell(sourceAddresses[i]);
capturedCells[i] := FScope.Capture(sourceAddresses[i]);
if Node.HasNestedLambdas then
closureScope := FScope
@@ -163,15 +163,15 @@ begin
adr.Kind := akLocalOrParent;
adr.ScopeDepth := 0;
// Set 'Self' (slot 0) to the captured closureValue for recursion.
// Capture 'Self' (slot 0) for recursion.
adr.SlotIndex := 0;
lambdaScope.Cell[adr].Value := closureValue;
lambdaScope[adr] := closureValue;
// Populate the actual parameters.
for i := 0 to High(ArgValues) do
begin
adr.SlotIndex := params[i].Address.SlotIndex;
lambdaScope.Cell[adr].Value := ArgValues[i];
lambdaScope[adr] := ArgValues[i];
end;
// Use the injected factory to create the visitor for the lambda's body.
@@ -218,7 +218,7 @@ var
itemValue, lookbackValue, seriesVar: TDataValue;
lookback: Int64;
begin
seriesVar := FScope[Node.Series.Address].Value;
seriesVar := FScope[Node.Series.Address];
itemValue := Node.Value.Accept(Self);
lookback := -1;
@@ -267,7 +267,7 @@ end;
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
Result := Node.Value.Accept(Self);
FScope[Node.Identifier.Address].Value := Result;
FScope[Node.Identifier.Address] := Result;
end;
function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
@@ -300,7 +300,7 @@ end;
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
Result := FScope[Node.Address].Value;
Result := FScope[Node.Address];
end;
function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
@@ -389,11 +389,9 @@ var
value: TDataValue;
begin
if Assigned(Node.Initializer) then
value := Node.Initializer.Accept(Self)
else
value := TDataValue.Void;
value := Node.Initializer.Accept(Self);
FScope[Node.Identifier.Address].Value := value;
FScope[Node.Identifier.Address] := value;
Result := value;
end;
@@ -539,7 +537,7 @@ var
seriesValue: TDataValue;
len: Int64;
begin
seriesValue := FScope[Node.Series.Address].Value;
seriesValue := FScope[Node.Series.Address];
case seriesValue.Kind of
vkSeries: len := seriesValue.AsSeries.Value.Items.Count;
Src/AST/Myc.Ast.Nodes.pas
+12 -13
View File
@@ -42,20 +42,9 @@ type
ISeriesLengthNode = interface;
IExecutionScope = interface;
IScopeDescriptor = interface;
IValueCell = interface;
// --- Concrete Type Definitions ---
// A managed, reference-counted cell that holds a TDataValue,
// allowing it to be shared by reference between scopes (for closures).
IValueCell = interface
{$region 'private'}
function GetValue: TDataValue;
procedure SetValue(const AValue: TDataValue);
{$endregion}
property Value: TDataValue read GetValue write SetValue;
end;
// Defines how an identifier's address was resolved.
TAddressKind = (akUnresolved, akLocalOrParent, akUpvalue);
@@ -67,17 +56,27 @@ type
class operator Initialize(out Dest: TResolvedAddress);
end;
IValueCell = interface
{$region 'private'}
function GetValue: TDataValue;
procedure SetValue(const AValue: TDataValue);
{$endregion}
property Value: TDataValue read GetValue write SetValue;
end;
IExecutionScope = interface
{$region 'private'}
function GetParent: IExecutionScope;
function GetCell(const Address: TResolvedAddress): IValueCell;
function GetValues(const Address: TResolvedAddress): TDataValue;
procedure SetValues(const Address: TResolvedAddress; const Value: TDataValue);
{$endregion}
procedure Define(const Name: string; const Value: TDataValue);
function Dump: string;
procedure Clear;
function Capture(const Address: TResolvedAddress): IValueCell;
property Cell[const Address: TResolvedAddress]: IValueCell read GetCell; default;
property Values[const Address: TResolvedAddress]: TDataValue read GetValues write SetValues; default;
property Parent: IExecutionScope read GetParent;
end;
Src/AST/Myc.Ast.Scope.pas
+100 -33
View File
@@ -11,18 +11,28 @@ uses
type
TExecutionScope = class(TInterfacedObject, IExecutionScope)
type
TValueCell = class(TInterfacedObject, IValueCell)
private
FValue: TDataValue;
function GetValue: TDataValue; inline;
procedure SetValue(const AValue: TDataValue); inline;
public
constructor Create(const AValue: TDataValue);
end;
private
FParent: IExecutionScope;
FDescriptor: IScopeDescriptor;
FValues: TArray<IValueCell>;
// Stores references to the value cells captured by a closure.
FValues: TArray<TDataValue>;
FCapturedUpvalues: TArray<IValueCell>;
FNameToIndex: TDictionary<string, Integer>;
procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
procedure NeedNameToIndex;
function GetParent: IExecutionScope;
function GetCell(const Address: TResolvedAddress): IValueCell;
function GetNameToIndex: TDictionary<string, Integer>;
function GetValues(const Address: TResolvedAddress): TDataValue;
procedure SetValues(const Address: TResolvedAddress; const Value: TDataValue);
public
constructor Create(
AParent: IExecutionScope = nil;
@@ -33,9 +43,9 @@ type
procedure Clear;
function Dump: string;
procedure Define(const Name: string; const Value: TDataValue);
function Capture(const Address: TResolvedAddress): IValueCell;
property NameToIndex: TDictionary<string, Integer> read GetNameToIndex;
property Parent: IExecutionScope read FParent;
property Values: TArray<IValueCell> read FValues;
end;
implementation
@@ -43,22 +53,20 @@ implementation
uses
System.Generics.Defaults;
type
TValueCell = class(TInterfacedObject, IValueCell)
private
FValue: TDataValue;
function GetValue: TDataValue;
procedure SetValue(const AValue: TDataValue);
end;
{ TValueCell }
function TValueCell.GetValue: TDataValue;
constructor TExecutionScope.TValueCell.Create(const AValue: TDataValue);
begin
inherited Create;
FValue := AValue;
end;
function TExecutionScope.TValueCell.GetValue: TDataValue;
begin
Result := FValue;
end;
procedure TValueCell.SetValue(const AValue: TDataValue);
procedure TExecutionScope.TValueCell.SetValue(const AValue: TDataValue);
begin
FValue := AValue;
end;
@@ -84,8 +92,6 @@ begin
begin
slotCount := ADescriptor.SlotCount;
SetLength(FValues, slotCount);
for i := 0 to slotCount - 1 do
FValues[i] := TValueCell.Create as IValueCell;
end;
end;
@@ -95,7 +101,18 @@ begin
inherited Destroy;
end;
function TExecutionScope.GetCell(const Address: TResolvedAddress): IValueCell;
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:
@@ -116,27 +133,16 @@ begin
Assert(Assigned(targetScope), 'Invalid scope depth during value retrieval.');
end;
Assert(
(Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.Values)),
(Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.FValues)),
'Invalid scope index during value retrieval.'
);
Result := targetScope.Values[Address.SlotIndex];
Result := TValueCell.Create(targetScope.FValues[Address.SlotIndex]);
end;
else
raise EInvalidOpException.Create('Cannot get value for an unresolved address.');
end;
end;
function TExecutionScope.GetParent: IExecutionScope;
begin
Result := FParent;
end;
procedure TExecutionScope.Clear;
begin
FValues := [];
FreeAndNil(FNameToIndex);
end;
procedure TExecutionScope.Define(const Name: string; const Value: TDataValue);
var
index: Integer;
@@ -148,8 +154,7 @@ begin
index := Length(FValues);
SetLength(FValues, index + 1);
FValues[index] := TValueCell.Create as IValueCell;
FValues[index].Value := Value;
FValues[index] := Value;
FNameToIndex.Add(Name, index);
end;
@@ -173,7 +178,7 @@ begin
for pair in sortedPairs do
// Access the value inside the cell for printing.
ABuilder.AppendLine(indentStr + Format(' [%d] %s: %s', [pair.Value, pair.Key, FValues[pair.Value].Value.ToString]));
ABuilder.AppendLine(indentStr + Format(' [%d] %s: %s', [pair.Value, pair.Key, FValues[pair.Value].ToString]));
end
else
begin
@@ -207,6 +212,37 @@ begin
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;
procedure TExecutionScope.NeedNameToIndex;
begin
if FNameToIndex = nil then
@@ -220,4 +256,35 @@ begin
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;
end.