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

Binding

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-04 21:17:23 +02:00
parent bb74d408da
commit 4a8075fecf
5 changed files with 76 additions and 155 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Evaluator.pas
+15 -23
View File
@@ -88,8 +88,8 @@ type
// The signature for a native Delphi function callable from the script.
TNativeFunction = function(const Args: TArray<TAstValue>): TAstValue;
// Concrete implementation of the IEvaluatorClosure interface for script-defined functions.
TClosureValue = class(TInterfacedObject, IEvaluatorClosure)
// Concrete implementation of the TAstValue.IClosure interface for script-defined functions.
TClosureValue = class(TInterfacedObject, TAstValue.IClosure)
private
FBody: IExpressionNode;
FClosureScope: IExecutionScope;
@@ -97,15 +97,14 @@ type
function GetBody: IExpressionNode;
function GetParameters: TArray<IIdentifierNode>;
function GetClosureScope: IExecutionScope;
function GetLambdaNode: ILambdaExpressionNode;
public
constructor Create(const ALambdaNode: ILambdaExpressionNode; const AClosureScope: IExecutionScope);
property ClosureScope: IExecutionScope read GetClosureScope;
property LambdaNode: ILambdaExpressionNode read GetLambdaNode;
property LambdaNode: ILambdaExpressionNode read FLambdaNode;
end;
// Concrete implementation of IEvaluatorClosure for native Delphi functions.
TNativeClosure = class(TInterfacedObject, IEvaluatorClosure)
// Concrete implementation of TAstValue.IClosure for native Delphi functions.
TNativeClosure = class(TInterfacedObject, TAstValue.IClosure)
private
FMethod: TNativeFunction;
function GetBody: IExpressionNode;
@@ -196,7 +195,7 @@ end;
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
var
closure: IEvaluatorClosure;
closure: TAstValue.IClosure;
begin
// Use 'Define' to clearly state that we are adding a new variable
// to the global scope before the binder runs.
@@ -224,11 +223,6 @@ begin
Result := FClosureScope;
end;
function TClosureValue.GetLambdaNode: ILambdaExpressionNode;
begin
Result := FLambdaNode;
end;
function TClosureValue.GetParameters: TArray<IIdentifierNode>;
begin
Result := FLambdaNode.Parameters;
@@ -294,7 +288,7 @@ var
lookback: Int64;
begin
// The target series must have been resolved by the binder.
seriesVar := FScope[Node.Series.Resolve];
seriesVar := FScope[Node.Series.Address];
itemValue := Node.Value.Accept(Self);
lookback := -1;
@@ -345,7 +339,7 @@ end;
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue;
begin
Result := Node.Value.Accept(Self);
FScope[Node.Identifier.Resolve] := Result;
FScope[Node.Identifier.Address] := Result;
end;
function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TAstValue;
@@ -378,7 +372,7 @@ end;
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
begin
Result := FScope[Node.Resolve];
Result := FScope[Node.Address];
end;
function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue;
@@ -475,7 +469,7 @@ begin
else
value := TAstValue.Void;
FScope[Node.Identifier.Resolve] := value;
FScope[Node.Identifier.Address] := value;
Result := value;
end;
@@ -488,10 +482,8 @@ end;
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue;
var
calleeValue: TAstValue;
closure: IEvaluatorClosure;
closure: TAstValue.IClosure;
i: Integer;
callScope: IExecutionScope;
descriptor: IScopeDescriptor;
begin
calleeValue := Node.Callee.Accept(Self);
@@ -514,20 +506,20 @@ begin
raise EArgumentException
.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(closure.Parameters), Node.Arguments.Count]);
descriptor := (closure as TClosureValue).LambdaNode.ScopeDescriptor;
var descriptor := (closure as TClosureValue).LambdaNode.ScopeDescriptor;
if not Assigned(descriptor) then
raise EParserError.Create('Lambda has no scope descriptor. Did the binder run?');
var callScope := descriptor.CreateScope(closure.ClosureScope);
var adr: TResolvedAddress;
adr.ScopeDepth := 0;
adr.SlotIndex := 0;
callScope := descriptor.Instantiate(closure.ClosureScope);
callScope[adr] := calleeValue;
for i := 0 to Node.Arguments.Count - 1 do
begin
adr.SlotIndex := closure.Parameters[i].Resolve.SlotIndex;
adr.SlotIndex := closure.Parameters[i].Address.SlotIndex;
callScope[adr] := Node.Arguments[i].Accept(Self);
end;
Src/AST/Myc.Ast.Nodes.pas
+30 -37
View File
@@ -44,36 +44,30 @@ type
ICreateSeriesNode = interface;
IAddSeriesItemNode = interface;
ISeriesLengthNode = interface;
IEvaluatorClosure = interface;
IExecutionScope = interface;
IScopeDescriptor = interface;
// --- Concrete Type Definitions ---
TResolvedAddress = record
ScopeDepth: Integer;
SlotIndex: Integer;
end;
IEvaluatorClosure = interface
{$region 'private'}
function GetBody: IExpressionNode;
function GetClosureScope: IExecutionScope;
function GetParameters: TArray<IIdentifierNode>;
{$endregion}
property Body: IExpressionNode read GetBody;
property ClosureScope: IExecutionScope read GetClosureScope;
property Parameters: TArray<IIdentifierNode> read GetParameters;
end;
TAstValue = record
private
type
IClosure = interface
{$region 'private'}
function GetBody: IExpressionNode;
function GetClosureScope: IExecutionScope;
function GetParameters: TArray<IIdentifierNode>;
{$endregion}
property Body: IExpressionNode read GetBody;
property ClosureScope: IExecutionScope read GetClosureScope;
property Parameters: TArray<IIdentifierNode> read GetParameters;
end;
TVal<T> = class(TInterfacedObject)
Value: T;
constructor Create(const AValue: T);
end;
private
var
FKind: TAstValueKind;
FScalar: TScalar;
@@ -84,14 +78,14 @@ type
class operator Initialize(out Dest: TAstValue);
class function Void: TAstValue; inline; static;
class function FromScalar(const AValue: TScalar): TAstValue; inline; static;
class function FromClosure(const AValue: IEvaluatorClosure): TAstValue; inline; static;
class function FromClosure(const AValue: TAstValue.IClosure): TAstValue; inline; static;
class function FromText(const AValue: String): TAstValue; inline; static;
class function FromSeries(const [ref] AValue: TScalarSeries): TAstValue; static; inline;
class function FromRecordSeries(const [ref] AValue: TScalarRecordSeries): TAstValue; static; inline;
class function FromRecord(const [ref] AValue: TScalarRecord): TAstValue; static; inline;
class function FromMemberSeries(const [ref] AValue: TScalarMemberSeries): TAstValue; static; inline;
function AsScalar: TScalar; inline;
function AsClosure: IEvaluatorClosure; inline;
function AsClosure: TAstValue.IClosure; inline;
function AsText: String; inline;
function AsRecordSeries: TVal<TScalarRecordSeries>; inline;
function AsRecord: TScalarRecord; inline;
@@ -102,25 +96,24 @@ type
property Kind: TAstValueKind read GetKind;
end;
TResolvedAddress = record
ScopeDepth: Integer;
SlotIndex: Integer;
end;
IExecutionScope = interface
{$region 'private'}
function GetParent: IExecutionScope;
function GetValues(const Address: TResolvedAddress): TAstValue;
procedure SetValues(const Address: TResolvedAddress; const Value: TAstValue);
{$endregion}
procedure Define(const Name: string; const Value: TAstValue);
function Dump: string;
procedure Clear;
// --- Legacy name-based access ---
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;
// --- New index-based access ---
procedure Define(const Name: string; const Value: TAstValue);
function Dump: string;
property Values[const Address: TResolvedAddress]: TAstValue read GetValues write SetValues; default;
property Parent: IExecutionScope read GetParent;
end;
@@ -130,8 +123,7 @@ type
function GetSlotCount: Integer;
function GetSymbols: TDictionary<string, Integer>;
{$endregion}
function Instantiate(const AParent: IExecutionScope): IExecutionScope;
procedure PopulateFromScope(const AScope: IExecutionScope);
function CreateScope(const AParent: IExecutionScope): IExecutionScope;
property Parent: IScopeDescriptor read GetParent;
property SlotCount: Integer read GetSlotCount;
property Symbols: TDictionary<string, Integer> read GetSymbols;
@@ -173,11 +165,12 @@ type
IIdentifierNode = interface(IExpressionNode)
{$region 'private'}
function GetIsResolved: Boolean;
function GetAddress: TResolvedAddress;
function GetName: string;
{$endregion}
function Resolve: TResolvedAddress;
property IsResolved: Boolean read GetIsResolved;
property Name: string read GetName;
property IsResolved: Boolean read GetIsResolved;
property Address: TResolvedAddress read GetAddress;
end;
IBinaryExpressionNode = interface(IExpressionNode)
@@ -337,11 +330,11 @@ begin
Dest.FInterface := nil;
end;
function TAstValue.AsClosure: IEvaluatorClosure;
function TAstValue.AsClosure: TAstValue.IClosure;
begin
if (FKind <> avkClosure) then
raise EInvalidCast.Create('Cannot read value as a Closure.');
Result := IEvaluatorClosure(FInterface);
Result := TAstValue.IClosure(FInterface);
end;
function TAstValue.AsMemberSeries: TVal<TScalarMemberSeries>;
@@ -388,7 +381,7 @@ begin
Result := (FInterface as TVal<String>).Value;
end;
class function TAstValue.FromClosure(const AValue: IEvaluatorClosure): TAstValue;
class function TAstValue.FromClosure(const AValue: TAstValue.IClosure): TAstValue;
begin
Result.FKind := avkClosure;
Result.FInterface := AValue;
Src/AST/Myc.Ast.Scope.pas
+10 -57
View File
@@ -17,19 +17,13 @@ type
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;
public
constructor Create(AParent: IExecutionScope = nil; const ADescriptor: IScopeDescriptor = nil);
destructor Destroy; override;
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<string, Integer> read FNameToIndex;
property Parent: IExecutionScope read FParent;
property Values: TArray<TAstValue> read FValues;
@@ -42,20 +36,18 @@ uses
{ TExecutionScope }
constructor TExecutionScope.Create(AParent: IExecutionScope);
constructor TExecutionScope.Create(AParent: IExecutionScope = nil; const ADescriptor: IScopeDescriptor = nil);
begin
inherited Create;
FParent := AParent;
FValues := [];
FNameToIndex := TDictionary<string, Integer>.Create;
end;
constructor TExecutionScope.CreateFromDescriptor(const AParent: IExecutionScope; const ADescriptor: IScopeDescriptor);
begin
inherited Create;
FParent := AParent;
FNameToIndex := TDictionary<string, Integer>.Create(ADescriptor.Symbols);
SetLength(FValues, ADescriptor.SlotCount);
if ADescriptor <> nil then
begin
for var item in ADescriptor.Symbols do
FNameToIndex.AddOrSetValue(item.Key, item.Value);
SetLength(FValues, ADescriptor.SlotCount);
end;
end;
destructor TExecutionScope.Destroy;
@@ -69,18 +61,6 @@ 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 := [];
@@ -145,23 +125,6 @@ begin
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;
@@ -179,16 +142,6 @@ begin
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;
Src/AST/Myc.Ast.pas
+16 -25
View File
@@ -46,11 +46,8 @@ type
): IAddSeriesItemNode; static;
class function SeriesLength(const ASeries: IIdentifierNode): ISeriesLengthNode; static;
// --- Static method to run the binder ---
// Traverses the AST and resolves all identifiers. Returns a scope descriptor for the script's top-level variables.
class function CreateScopeDescriptor(const Parent: IScopeDescriptor): IScopeDescriptor; static;
class function CreateBinding(const Scope: IExecutionScope): IScopeDescriptor; static;
class function Bind(const RootNode: IExpressionNode; const ParentScope: IExecutionScope): IScopeDescriptor; static;
class function CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor; static;
class function Bind(const RootNode: IExpressionNode; const ParentScope: IExecutionScope): IExecutionScope; static;
end;
// TAstTraverser provides a default AST traversal implementation.
@@ -89,8 +86,9 @@ type
destructor Destroy; override;
function Define(const Name: string): Integer;
function FindSymbol(const Name: string; out Index: Integer; out Depth: Integer): Boolean;
function Instantiate(const AParent: IExecutionScope): IExecutionScope;
function CreateScope(const AParent: IExecutionScope): IExecutionScope;
procedure PopulateFromScope(const AScope: IExecutionScope);
property Symbols: TDictionary<string, Integer> read FSymbols;
end;
{ TAstNode }
@@ -119,14 +117,15 @@ type
FResolvedAddress: TResolvedAddress;
function GetName: string;
function GetIsResolved: Boolean; inline;
function GetAddress: TResolvedAddress; inline;
public
constructor Create(AName: string);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
function Resolve: TResolvedAddress;
property IsResolved: Boolean read GetIsResolved;
property Name: string read FName;
property Address: TResolvedAddress read GetAddress;
end;
{ TBinaryExpressionNode }
@@ -371,16 +370,13 @@ begin
Result := FSymbols;
end;
function TScopeDescriptor.Instantiate(const AParent: IExecutionScope): IExecutionScope;
function TScopeDescriptor.CreateScope(const AParent: IExecutionScope): IExecutionScope;
begin
Result := TExecutionScope.CreateFromDescriptor(AParent, Self);
Result := TExecutionScope.Create(AParent, Self);
end;
procedure TScopeDescriptor.PopulateFromScope(const AScope: IExecutionScope);
begin
if not Assigned(AScope) then
Exit;
for var pair in (AScope as TExecutionScope).NameToIndex do
if not FSymbols.ContainsKey(pair.Key) then
FSymbols.Add(pair.Key, pair.Value);
@@ -429,7 +425,7 @@ begin
Result := FName;
end;
function TIdentifierNode.Resolve: TResolvedAddress;
function TIdentifierNode.GetAddress: TResolvedAddress;
begin
if not IsResolved then
raise EInvalidOpException.Create('Identifier not bound');
@@ -810,7 +806,7 @@ end;
constructor TBinder.Create(const AInitialScope: IExecutionScope);
begin
inherited Create;
FCurrentDescriptor := TAst.CreateBinding(AInitialScope);
FCurrentDescriptor := TAst.CreateDescriptor(AInitialScope);
end;
procedure TBinder.EnterScope;
@@ -869,7 +865,7 @@ end;
{ TAst }
class function TAst.Bind(const RootNode: IExpressionNode; const ParentScope: IExecutionScope): IScopeDescriptor;
class function TAst.Bind(const RootNode: IExpressionNode; const ParentScope: IExecutionScope): IExecutionScope;
var
binder: TBinder;
visitor: IAstVisitor;
@@ -884,7 +880,7 @@ begin
// Traverse the AST. This annotates all nodes AND populates the new descriptor.
RootNode.Accept(visitor);
// Return the completed descriptor for the script's scope.
Result := binder.FCurrentDescriptor;
Result := binder.CurrentDescriptor.CreateScope(ParentScope);
finally
// Restore the binder's internal state.
binder.ExitScope;
@@ -930,22 +926,17 @@ begin
Result := TBinaryExpressionNode.Create(ALeft, AOperator, ARight);
end;
class function TAst.CreateBinding(const Scope: IExecutionScope): IScopeDescriptor;
class function TAst.CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor;
begin
if Assigned(Scope) then
if Scope is TExecutionScope then
begin
Result := CreateScopeDescriptor(CreateBinding(Scope.Parent));
Result.PopulateFromScope(Scope);
Result := TScopeDescriptor.Create(CreateDescriptor(Scope.Parent));
(Result as TScopeDescriptor).PopulateFromScope(Scope);
end
else
Result := TScopeDescriptor.Create(nil);
end;
class function TAst.CreateScopeDescriptor(const Parent: IScopeDescriptor): IScopeDescriptor;
begin
Result := TScopeDescriptor.Create(Parent);
end;
class function TAst.FunctionCall(const ACallee: IExpressionNode; const AArguments: array of IExpressionNode): IFunctionCallNode;
begin
Result := TFunctionCallNode.Create(ACallee, AArguments);