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

Scope Index optimized

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-15 10:39:39 +02:00
parent d731048b41
commit c913f9dbc5
4 changed files with 35 additions and 69 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/ASTPlayground.dproj
+1 -1
View File
@@ -4,7 +4,7 @@
<ProjectVersion>20.3</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Config Condition="'$(Config)'==''">Release</Config>
<Platform Condition="'$(Platform)'==''">Win64</Platform>
<ProjectName Condition="'$(ProjectName)'==''">ASTPlayground</ProjectName>
<TargetedPlatforms>2</TargetedPlatforms>
Src/AST/Myc.Ast.Debugger.pas
+1
View File
@@ -22,6 +22,7 @@ type
procedure Unindent;
procedure AppendLine(const S: string);
procedure ShowScope;
protected
// Overridden to provide the debug-specific visitor factory.
function CreateVisitorFactory: TVisitorFactory; override;
Src/AST/Myc.Ast.Evaluator.pas
+1 -59
View File
@@ -21,18 +21,11 @@ type
private
FScope: IExecutionScope;
protected
function IsTruthy(const AValue: TDataValue): Boolean;
function IsTruthy(const AValue: TDataValue): Boolean; inline;
// Returns a closure that can create the correct type of visitor for a lambda's body.
function CreateVisitorFactory: TVisitorFactory; virtual;
// Creates the callable closure for a lambda expression. No longer virtual.
function CreateLambdaClosure(
const Node: ILambdaExpressionNode;
const ACapturedCells: TArray<IValueCell>;
const AClosureScope: IExecutionScope
): TDataValue;
property Scope: IExecutionScope read FScope;
public
constructor Create(const AScope: IExecutionScope);
@@ -128,57 +121,6 @@ begin
end;
end;
function TEvaluatorVisitor.CreateLambdaClosure(
const Node: ILambdaExpressionNode;
const ACapturedCells: TArray<IValueCell>;
const AClosureScope: IExecutionScope
): TDataValue;
var
closureValue: TDataValue;
visitorFactory: TVisitorFactory;
begin
// Get the appropriate factory via virtual dispatch.
visitorFactory := CreateVisitorFactory();
closureValue :=
TDataValue.TFunc(
function(const ArgValues: TArray<TDataValue>): TDataValue
var
lambdaScope: IExecutionScope;
bodyVisitor: IAstVisitor;
i: Integer;
adr: TResolvedAddress;
begin
if (Length(ArgValues) <> Length(Node.Parameters)) then
raise EArgumentException
.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(Node.Parameters), Length(ArgValues)]);
lambdaScope := TExecutionScope.Create(AClosureScope, Node.ScopeDescriptor, ACapturedCells);
adr.Kind := akLocalOrParent;
adr.ScopeDepth := 0;
// Set 'Self' (slot 0) to the captured closureValue for recursion.
adr.SlotIndex := 0;
lambdaScope.Cell[adr].Value := closureValue;
// Populate the actual parameters.
for i := 0 to High(ArgValues) do
begin
adr.SlotIndex := Node.Parameters[i].Address.SlotIndex;
lambdaScope.Cell[adr].Value := ArgValues[i];
end;
// Use the injected factory to create the visitor for the lambda's body.
bodyVisitor := visitorFactory(lambdaScope);
Result := Node.Body.Accept(bodyVisitor);
end
);
Result := closureValue;
end;
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
capturedCells: TArray<IValueCell>;
Src/AST/Myc.Ast.Scope.pas
+32 -9
View File
@@ -13,13 +13,16 @@ type
TExecutionScope = class(TInterfacedObject, IExecutionScope)
private
FParent: IExecutionScope;
FDescriptor: IScopeDescriptor;
FValues: TArray<IValueCell>;
// Stores references to the value cells captured by a closure.
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>;
public
constructor Create(
AParent: IExecutionScope = nil;
@@ -30,7 +33,7 @@ type
procedure Clear;
function Dump: string;
procedure Define(const Name: string; const Value: TDataValue);
property NameToIndex: TDictionary<string, Integer> read FNameToIndex;
property NameToIndex: TDictionary<string, Integer> read GetNameToIndex;
property Parent: IExecutionScope read FParent;
property Values: TArray<IValueCell> read FValues;
end;
@@ -73,15 +76,12 @@ var
begin
inherited Create;
FParent := AParent;
FDescriptor := ADescriptor;
FValues := [];
FNameToIndex := TDictionary<string, Integer>.Create;
FCapturedUpvalues := ACapturedUpvalues; // Store upvalues
if ADescriptor <> nil then
begin
for var item in ADescriptor.Symbols do
FNameToIndex.AddOrSetValue(item.Key, item.Value);
slotCount := ADescriptor.SlotCount;
SetLength(FValues, slotCount);
for i := 0 to slotCount - 1 do
@@ -91,7 +91,7 @@ end;
destructor TExecutionScope.Destroy;
begin
FNameToIndex.Free;
Clear;
inherited Destroy;
end;
@@ -134,13 +134,15 @@ end;
procedure TExecutionScope.Clear;
begin
FValues := [];
FNameToIndex.Clear;
FreeAndNil(FNameToIndex);
end;
procedure TExecutionScope.Define(const Name: string; const Value: TDataValue); // <-- Changed from TAstValue
procedure TExecutionScope.Define(const Name: string; const Value: TDataValue);
var
index: Integer;
begin
NeedNameToIndex;
if FNameToIndex.ContainsKey(Name) then
raise Exception.CreateFmt('Variable "%s" is already defined in this scope.', [Name]);
@@ -157,8 +159,10 @@ var
indentStr: string;
sortedPairs: TArray<TPair<string, Integer>>;
begin
NeedNameToIndex;
indentStr := ''.PadLeft(AIndent);
if (FNameToIndex.Count > 0) then
if FNameToIndex.Count > 0 then
begin
sortedPairs := FNameToIndex.ToArray;
TArray.Sort<TPair<string, Integer>>(
@@ -197,4 +201,23 @@ begin
end;
end;
function TExecutionScope.GetNameToIndex: TDictionary<string, Integer>;
begin
NeedNameToIndex;
Result := FNameToIndex;
end;
procedure TExecutionScope.NeedNameToIndex;
begin
if FNameToIndex = nil then
begin
FNameToIndex := TDictionary<string, Integer>.Create;
if FDescriptor <> nil then
begin
for var item in FDescriptor.Symbols do
FNameToIndex.AddOrSetValue(item.Key, item.Value);
end;
end;
end;
end.