This commit is contained in:
Michael Schimmel
2025-09-04 19:50:05 +02:00
parent c6a71aa8be
commit bb74d408da
6 changed files with 39 additions and 149 deletions
+1 -1
View File
@@ -4,7 +4,7 @@
<ProjectVersion>20.3</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Release</Config>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win64</Platform>
<ProjectName Condition="'$(ProjectName)'==''">ASTPlayground</ProjectName>
<TargetedPlatforms>2</TargetedPlatforms>
+1 -1
View File
@@ -567,7 +567,7 @@ begin
if series.AsRecordSeries.Value.TotalCount >= smaSlowLength then
begin
// Update the 'current_series' value in the scope using the FAST index-based assignment
scope.AssignValue(seriesAddress, series);
scope[seriesAddress] := series;
// Execute the PRE-BOUND call AST
var resultValue := callAst.Accept(visitor);
+14 -10
View File
@@ -294,7 +294,7 @@ var
lookback: Int64;
begin
// The target series must have been resolved by the binder.
seriesVar := FScope.GetValue(Node.Series.Resolve);
seriesVar := FScope[Node.Series.Resolve];
itemValue := Node.Value.Accept(Self);
lookback := -1;
@@ -345,7 +345,7 @@ end;
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue;
begin
Result := Node.Value.Accept(Self);
FScope.AssignValue(Node.Identifier.Resolve, Result);
FScope[Node.Identifier.Resolve] := Result;
end;
function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TAstValue;
@@ -378,7 +378,7 @@ end;
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
begin
Result := FScope.GetValue(Node.Resolve)
Result := FScope[Node.Resolve];
end;
function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue;
@@ -475,7 +475,7 @@ begin
else
value := TAstValue.Void;
FScope.AssignValue(Node.Identifier.Resolve, value);
FScope[Node.Identifier.Resolve] := value;
Result := value;
end;
@@ -491,7 +491,6 @@ var
closure: IEvaluatorClosure;
i: Integer;
callScope: IExecutionScope;
innerVisitor: IAstVisitor;
descriptor: IScopeDescriptor;
begin
calleeValue := Node.Callee.Accept(Self);
@@ -519,15 +518,20 @@ begin
if not Assigned(descriptor) then
raise EParserError.Create('Lambda has no scope descriptor. Did the binder run?');
var adr: TResolvedAddress;
adr.ScopeDepth := 0;
adr.SlotIndex := 0;
callScope := descriptor.Instantiate(closure.ClosureScope);
callScope.SetValueByIndex(0, calleeValue);
callScope[adr] := calleeValue;
for i := 0 to Node.Arguments.Count - 1 do
callScope.SetValueByIndex(closure.Parameters[i].Resolve.SlotIndex, Node.Arguments[i].Accept(Self));
begin
adr.SlotIndex := closure.Parameters[i].Resolve.SlotIndex;
callScope[adr] := Node.Arguments[i].Accept(Self);
end;
// 3. Führe den Körper der Funktion im neuen Scope aus.
innerVisitor := Self.CreateVisitorForScope(callScope);
Result := closure.Body.Accept(innerVisitor);
Result := closure.Body.Accept(CreateVisitorForScope(callScope));
end
else
raise EArgumentException.Create('Unknown closure implementation type.');
+4 -3
View File
@@ -105,6 +105,8 @@ type
IExecutionScope = interface
{$region 'private'}
function GetParent: IExecutionScope;
function GetValues(const Address: TResolvedAddress): TAstValue;
procedure SetValues(const Address: TResolvedAddress; const Value: TAstValue);
{$endregion}
procedure Clear;
@@ -115,11 +117,10 @@ type
// --- New index-based access ---
procedure Define(const Name: string; const Value: TAstValue);
function GetValue(const Address: TResolvedAddress): TAstValue;
procedure AssignValue(const Address: TResolvedAddress; const Value: TAstValue); overload;
procedure SetValueByIndex(Index: Integer; const Value: TAstValue);
function Dump: string;
property Values[const Address: TResolvedAddress]: TAstValue read GetValues write SetValues; default;
property Parent: IExecutionScope read GetParent;
end;
+19 -29
View File
@@ -15,6 +15,8 @@ type
FValues: TArray<TAstValue>;
FNameToIndex: TDictionary<string, Integer>;
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;
@@ -24,9 +26,6 @@ type
procedure AssignValue(const Name: string; const Value: TAstValue); overload;
function Dump: string;
procedure Define(const Name: string; const Value: TAstValue);
function GetValue(const Address: TResolvedAddress): TAstValue;
procedure AssignValue(const Address: TResolvedAddress; const Value: TAstValue); overload;
procedure SetValueByIndex(Index: Integer; const Value: TAstValue); // <-- NEU
public
constructor Create(AParent: IExecutionScope = nil);
constructor CreateFromDescriptor(const AParent: IExecutionScope; const ADescriptor: IScopeDescriptor);
@@ -82,25 +81,6 @@ begin
raise Exception.CreateFmt('Cannot assign to undeclared variable "%s".', [Name]);
end;
procedure TExecutionScope.AssignValue(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;
procedure TExecutionScope.Clear;
begin
FValues := [];
@@ -182,7 +162,7 @@ begin
Result := False;
end;
function TExecutionScope.GetValue(const Address: TResolvedAddress): TAstValue;
function TExecutionScope.GetValues(const Address: TResolvedAddress): TAstValue;
var
targetScope: TExecutionScope;
i: Integer;
@@ -209,13 +189,23 @@ begin
Define(Name, Value);
end;
procedure TExecutionScope.SetValueByIndex(Index: Integer; const Value: TAstValue);
procedure TExecutionScope.SetValues(const Address: TResolvedAddress; const Value: TAstValue);
var
targetScope: IExecutionScope;
i: Integer;
begin
// This is a direct write to a slot in the current scope's value array.
// It's used for setting up a function call frame.
if (Index < 0) or (Index >= Length(FValues)) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for scope with %d slots.', [Index, Length(FValues)]);
FValues[Index] := Value;
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.
-105
View File
@@ -306,25 +306,6 @@ type
// --- Binder Implementation ---
TSymbol = record
Name: string;
SlotIndex: Integer;
end;
TSymbolTable = class
private
FParent: TSymbolTable;
FSymbols: TDictionary<string, TSymbol>;
FNextSlotIndex: Integer;
procedure DefinePreResolved(const Name: string; Index: Integer);
public
constructor Create(AParent: TSymbolTable);
destructor Destroy; override;
procedure PopulateFromScope(const AScope: IExecutionScope);
function Define(const Name: string): TSymbol;
function Resolve(const Name: string; out Symbol: TSymbol; out Depth: Integer): Boolean;
end;
TBinder = class(TAstTraverser)
private
FCurrentDescriptor: IScopeDescriptor;
@@ -824,92 +805,6 @@ begin
Result := FSeries;
end;
{ TSymbolTable }
constructor TSymbolTable.Create(AParent: TSymbolTable);
begin
inherited Create;
FParent := AParent;
FSymbols := TDictionary<string, TSymbol>.Create;
FNextSlotIndex := 0;
end;
destructor TSymbolTable.Destroy;
begin
FSymbols.Free;
inherited;
end;
procedure TSymbolTable.DefinePreResolved(const Name: string; Index: Integer);
var
symbol: TSymbol;
begin
// Defines a symbol with a specific, pre-determined index.
if not FSymbols.ContainsKey(Name) then
begin
symbol.Name := Name;
symbol.SlotIndex := Index;
FSymbols.Add(Name, symbol);
// Ensure the next automatically assigned index is correct.
if (Index >= FNextSlotIndex) then
FNextSlotIndex := Index + 1;
end;
end;
procedure TSymbolTable.PopulateFromScope(const AScope: IExecutionScope);
var
scopeImpl: TExecutionScope;
pair: TPair<string, Integer>;
begin
// Iterate over the Key-Value pairs of the scope's dictionary to preserve the exact indices.
if not Assigned(AScope) then
Exit;
scopeImpl := (AScope as TExecutionScope);
for pair in scopeImpl.NameToIndex do
DefinePreResolved(pair.Key, pair.Value);
end;
function TSymbolTable.Define(const Name: string): TSymbol;
begin
Result.Name := Name;
Result.SlotIndex := FNextSlotIndex;
inc(FNextSlotIndex);
FSymbols.Add(Name, Result);
end;
function TSymbolTable.Resolve(const Name: string; out Symbol: TSymbol; out Depth: Integer): Boolean;
var
currentScope: TSymbolTable;
begin
Depth := 0;
currentScope := Self;
while Assigned(currentScope) do
begin
if currentScope.FSymbols.TryGetValue(Name, Symbol) then
Exit(True);
inc(Depth);
currentScope := currentScope.FParent;
end;
Result := False;
end;
{ TBinder }
// Helper function to recursively build the symbol table hierarchy
function CreateSymbolTableFromScope(AScope: IExecutionScope): TSymbolTable;
begin
if not Assigned(AScope) then
Exit(nil);
// Recursively create the parent symbol table first
Result := TSymbolTable.Create(CreateSymbolTableFromScope(AScope.Parent));
// Then populate the current level
Result.PopulateFromScope(AScope);
end;
{ TBinder }
constructor TBinder.Create(const AInitialScope: IExecutionScope);