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 17:33:10 +02:00
parent 9c90a92b04
commit faa447fd91
7 changed files with 411 additions and 378 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/MainForm.fmx
+11 -19
View File
@@ -39,21 +39,13 @@ object Form1: TForm1
TextSettings.Trimming = None
OnClick = PrettyPrintButtonClick
end
object DebugButton: TButton
Position.X = 24.000000000000000000
Position.Y = 411.000000000000000000
TabOrder = 4
Text = 'Debug'
TextSettings.Trimming = None
OnClick = DebugButtonClick
end
object RecursionButton: TButton
Position.X = 24.000000000000000000
Position.Y = 92.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 5
TabOrder = 4
Text = 'Recursion'
TextSettings.Trimming = None
OnClick = RecursionButtonClick
@@ -61,13 +53,13 @@ object Form1: TForm1
object ShowScopeBox: TCheckBox
Position.X = 24.000000000000000000
Position.Y = 441.000000000000000000
TabOrder = 6
TabOrder = 5
Text = 'Scope'
end
object FibonacciButton: TButton
Position.X = 24.000000000000000000
Position.Y = 122.000000000000000000
TabOrder = 8
TabOrder = 7
Text = 'Fibonacci'
TextSettings.Trimming = None
OnClick = FibonacciButtonClick
@@ -75,15 +67,15 @@ object Form1: TForm1
object CrerateTriggerExampleButton: TButton
Position.X = 24.000000000000000000
Position.Y = 168.000000000000000000
TabOrder = 9
TabOrder = 8
Text = 'TriggerTest'
TextSettings.Trimming = None
OnClick = CrerateTriggerExampleButtonClick
OnClick = CreateTriggerExampleButtonClick
end
object DoTriggerButton: TButton
Position.X = 24.000000000000000000
Position.Y = 198.000000000000000000
TabOrder = 10
TabOrder = 9
Text = 'Trigger!'
TextSettings.Trimming = None
OnClick = DoTriggerButtonClick
@@ -101,7 +93,7 @@ object Form1: TForm1
Size.Width = 80.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 11
TabOrder = 10
Text = 'Clear'
TextSettings.Trimming = None
OnClick = ClearButtonClick
@@ -109,7 +101,7 @@ object Form1: TForm1
object FlowOnlyBox: TCheckBox
Position.X = 24.000000000000000000
Position.Y = 8.000000000000000000
TabOrder = 12
TabOrder = 11
Text = 'Flow only'
OnChange = ClearButtonClick
end
@@ -119,7 +111,7 @@ object Form1: TForm1
Size.Width = 80.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 14
TabOrder = 13
Text = 'Series'
TextSettings.Trimming = None
OnClick = SeriesTestButtonClick
@@ -127,7 +119,7 @@ object Form1: TForm1
object OHLCButton: TButton
Position.X = 24.000000000000000000
Position.Y = 304.000000000000000000
TabOrder = 15
TabOrder = 14
Text = 'OHLC'
TextSettings.Trimming = None
OnClick = OHLCButtonClick
@@ -135,7 +127,7 @@ object Form1: TForm1
object DebugBox: TCheckBox
Position.X = 24.000000000000000000
Position.Y = 360.000000000000000000
TabOrder = 16
TabOrder = 15
Text = 'Debug'
end
end
ASTPlayground/MainForm.pas
+118 -188
View File
@@ -48,7 +48,6 @@ type
Test1Button: TButton;
Test2Button: TButton;
PrettyPrintButton: TButton;
DebugButton: TButton;
RecursionButton: TButton;
ShowScopeBox: TCheckBox;
FibonacciButton: TButton;
@@ -63,8 +62,7 @@ type
DebugBox: TCheckBox;
procedure ClearButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CrerateTriggerExampleButtonClick(Sender: TObject);
procedure DebugButtonClick(Sender: TObject);
procedure CreateTriggerExampleButtonClick(Sender: TObject);
procedure DoTrigger2ButtonClick(Sender: TObject);
procedure DoTriggerButtonClick(Sender: TObject);
procedure FibonacciButtonClick(Sender: TObject);
@@ -82,7 +80,7 @@ type
function CreateVisitor(const AScope: IExecutionScope): IAstVisitor;
procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
// New helper function to encapsulate the Bind -> Evaluate pattern
function ExecuteAst(const ANode: IExpressionNode; const AScope: IExecutionScope): TAstValue;
function ExecuteAst(const ANode: IExpressionNode; const AParentScope: IExecutionScope): TAstValue;
public
{ Public declarations }
end;
@@ -104,6 +102,10 @@ procedure TForm1.ClearButtonClick(Sender: TObject);
begin
FWorkspace.DeleteChildren;
FWorkspace.Repaint;
// Create and prepare the global scope once
FGScope := TExecutionScope.Create(nil);
RegisterNativeFunctions(FGScope);
end;
function TForm1.CreateVisitor(const AScope: IExecutionScope): IAstVisitor;
@@ -118,14 +120,19 @@ begin
Result := TEvaluatorVisitor.Create(AScope);
end;
function TForm1.ExecuteAst(const ANode: IExpressionNode; const AScope: IExecutionScope): TAstValue;
function TForm1.ExecuteAst(const ANode: IExpressionNode; const AParentScope: IExecutionScope): TAstValue;
var
scriptDescriptor: IScopeDescriptor;
scriptScope: IExecutionScope;
begin
// STEP 1: BIND
// The binder uses the provided scope to know about native functions etc.
TAst.Bind(ANode, AScope);
// STEP 1: BIND and get the descriptor for the script's local variables.
scriptDescriptor := TAst.Bind(ANode, AParentScope);
// STEP 2: EVALUATE
var visitor := CreateVisitor(AScope);
// STEP 2: CREATE the correctly-sized execution scope for the script.
scriptScope := scriptDescriptor.Instantiate(AParentScope);
// STEP 3: EVALUATE using the new, correctly-sized scope.
var visitor := CreateVisitor(scriptScope);
Result := ANode.Accept(visitor);
end;
@@ -138,41 +145,7 @@ begin
FWorkspace.OnMouseDown := WorkspaceMouseDown;
// Create and prepare the global scope once
FGScope := TExecutionScope.Create(nil);
RegisterNativeFunctions(FGScope);
end;
procedure TForm1.DebugButtonClick(Sender: TObject);
var
scope: IExecutionScope;
visitor: IAstVisitor;
result: TAstValue;
sw: TStopwatch;
begin
if not Assigned(FLastAst) then
begin
Memo1.Lines.Add('No AST has been generated yet.');
exit;
end;
scope := TExecutionScope.Create(FGScope);
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Debug Evaluator Trace ---');
// Manually bind and evaluate to use the debug visitor
TAst.Bind(FLastAst, scope);
visitor := TDebugEvaluatorVisitor.Create(scope, Memo1.Lines, ShowScopeBox.IsChecked, 0);
sw := TStopwatch.StartNew;
result := FLastAst.Accept(visitor);
sw.Stop;
Memo1.Lines.Add('-----------------------------');
Memo1.Lines.Add(Format('Final script result: %s', [result.ToString]));
Memo1.Lines.Add(Format('Execution time: %d ms', [sw.ElapsedMilliseconds]));
ClearButtonClick(Self);
end;
procedure TForm1.FibonacciButtonClick(Sender: TObject);
@@ -180,7 +153,6 @@ var
root: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
scope: IExecutionScope;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Recursive fib with AST---');
@@ -215,9 +187,8 @@ begin
);
FLastAst := root;
scope := TExecutionScope.Create(nil); // No global scope needed for this pure function
result := ExecuteAst(root, scope);
// Execute with nil as parent scope
result := ExecuteAst(root, nil);
sw.Stop;
Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
@@ -246,7 +217,6 @@ var
root: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
scope: IExecutionScope;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Recursive factorial(20) ---');
@@ -278,9 +248,8 @@ begin
);
FLastAst := root;
scope := TExecutionScope.Create(nil);
result := ExecuteAst(root, scope);
// Execute with nil as parent scope
result := ExecuteAst(root, nil);
sw.Stop;
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
@@ -300,7 +269,7 @@ begin
// 1. Arrange: Create a new scope and populate it with Delphi data
scope := TExecutionScope.Create(FGScope); // Inherits native functions
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV)));
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson<TOHLCV>);
series := TScalarRecordSeries.Create(recordDef);
for i := 0 to 4 do
begin
@@ -348,7 +317,6 @@ var
main, callAst: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
scope: IExecutionScope;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Simple AST Execution ---');
@@ -371,9 +339,8 @@ begin
FLastAst := main;
callAst := TAst.FunctionCall(main, []);
scope := TExecutionScope.Create(FGScope);
result := ExecuteAst(callAst, scope);
// Execute with FGScope as parent
result := ExecuteAst(callAst, FGScope);
sw.Stop;
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
@@ -384,7 +351,6 @@ var
root: IExpressionNode;
result: TAstValue;
sw: TStopwatch;
scope: IExecutionScope;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Factory Pattern Demo ---');
@@ -411,100 +377,13 @@ begin
);
FLastAst := root;
scope := TExecutionScope.Create(FGScope);
result := ExecuteAst(root, scope);
// Execute with FGScope as parent
result := ExecuteAst(root, FGScope);
sw.Stop;
Memo1.Lines.Add(Format('Result of the final expression: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
end;
procedure TForm1.CrerateTriggerExampleButtonClick(Sender: TObject);
var
blk: IExpressionNode;
begin
// This button now only creates the AST. The persistent scope is managed by FGScope.
FGScope.Clear;
RegisterNativeFunctions(FGScope); // Re-register natives after clearing
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Creating Trigger Blueprint ---');
blk :=
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(TScalar.FromInt64(0))),
TAst.VarDecl(
TAst.Identifier('tickHandler'),
TAst.LambdaExpr(
[TAst.Identifier('summand')],
TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), boAdd, TAst.Identifier('summand')))
)
)
]
);
// Bind and execute the setup block against the persistent global scope
ExecuteAst(blk, FGScope);
FLastAst := blk; // Store for visualization
Memo1.Lines.Add('Variable "X" and function "tickHandler" defined in persistent scope.');
Memo1.Lines.Add('Click "Do Trigger" to execute.');
end;
procedure TForm1.DoTriggerButtonClick(Sender: TObject);
var
callAst: IFunctionCallNode;
currentValue: TAstValue;
depth, index: Integer;
identAst: IIdentifierNode;
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(1))]);
FLastAst := callAst;
// Bind and execute the call against the persistent scope
ExecuteAst(callAst, FGScope);
// To get the value of 'X', we first need to bind an identifier for it
// so we know its location.
identAst := TAst.Identifier('X');
TAst.Bind(identAst, FGScope);
if identAst.Resolve(depth, index) then
begin
currentValue := FGScope.GetValue(depth, index);
Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [currentValue.ToString]));
end
else
Memo1.Lines.Add('Error: Variable "X" not found in scope.');
end;
procedure TForm1.DoTrigger2ButtonClick(Sender: TObject);
var
callAst: IFunctionCallNode;
currentValue: TAstValue;
depth, index: Integer;
identAst: IIdentifierNode;
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(2))]);
FLastAst := callAst;
// Bind and execute the call against the persistent scope
ExecuteAst(callAst, FGScope);
// Inspection requires binding an identifier for 'X'
identAst := TAst.Identifier('X');
TAst.Bind(identAst, FGScope);
if identAst.Resolve(depth, index) then
begin
currentValue := FGScope.GetValue(depth, index);
Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [currentValue.ToString]));
end
else
Memo1.Lines.Add('Error: Variable "X" not found in scope.');
end;
procedure TForm1.WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
if Button <> TMouseButton.mbMiddle then
@@ -525,28 +404,15 @@ const
lookback = 100;
smaSlowLength = 50;
smaFastLength = 20;
var
recordDef: TScalarRecordDefinition;
series: TScalarRecordSeries;
setupAst, callAst: IExpressionNode;
visitor: IAstVisitor;
i, depth, index: Integer;
lastClose: Double;
ohlcvRec: TOHLCV;
recordValue: TScalarRecord;
resultValue: TAstValue;
sw: TStopwatch;
currentSeriesIdent: IIdentifierNode;
begin
// 1. Setup
Memo1.Lines.Clear;
Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs]));
FGScope.Clear;
RegisterNativeFunctions(FGScope);
sw := TStopwatch.StartNew;
var sw := TStopwatch.StartNew;
// 2. Create the setup AST with the strategy logic
setupAst :=
var setupAst :=
TAst.Block(
[
TAst.VarDecl(
@@ -645,37 +511,35 @@ begin
]
);
FLastAst := setupAst;
// Bind and execute the setup script once.
ExecuteAst(setupAst, FGScope);
// 3. Prepare for the simulation loop
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson(TypeInfo(TOHLCV)));
series := TScalarRecordSeries.Create(recordDef);
visitor := CreateVisitor(FGScope);
var scope := TAst.Bind(setupAst, FGScope).Instantiate(FGScope);
setupAst.Accept(CreateVisitor(scope));
// Declare the series variable in the scope BEFORE binding the call AST
FGScope.Define('current_series', TAstValue.Void);
scope.Define('current_series', TAstValue.Void);
// Create the call AST that will be executed in the loop
currentSeriesIdent := TAst.Identifier('current_series');
callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]);
var currentSeriesIdent := TAst.Identifier('current_series');
var callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]);
// Bind the call AST once, before the loop.
TAst.Bind(callAst, FGScope);
// Get the resolved address of 'current_series' for fast updates
if not currentSeriesIdent.Resolve(depth, index) then
raise EInvalidOpException.Create('Could not resolve loop variable ''current_series''.');
scope := TAst.Bind(callAst, scope).Instantiate(scope);
var visitor := CreateVisitor(scope);
// 4. Simulation Loop
Memo1.Lines.Add('Starting simulation...');
Application.ProcessMessages;
lastClose := 1000.0;
var lastClose := 1000.0;
Randomize;
var recDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson<TOHLCV>);
var series := TAstValue.FromRecordSeries(TScalarRecordSeries.Create(recDef));
var seriesAddress := currentSeriesIdent.Resolve;
var nw := Now;
for i := 1 to numRecs do
var ohlcvRec: TOHLCV;
for var i := 1 to numRecs do
begin
ohlcvRec.Timestamp := nw + (i / (24 * 60));
ohlcvRec.Open := lastClose + (Random * 0.05);
@@ -685,9 +549,9 @@ begin
ohlcvRec.Volume := RandomRange(1000, 50000);
lastClose := ohlcvRec.Close;
recordValue :=
var recordValue :=
TScalarRecord.Create(
recordDef,
recDef,
[
TScalarValue.FromDateTime(ohlcvRec.Timestamp),
TScalarValue.FromDouble(ohlcvRec.Open),
@@ -698,18 +562,21 @@ begin
]
);
series.Add(recordValue, lookback);
series.AsRecordSeries.Value.Add(recordValue, lookback);
if series.TotalCount >= smaSlowLength then
if series.AsRecordSeries.Value.TotalCount >= smaSlowLength then
begin
// Update the 'current_series' value in the scope using the FAST index-based assignment
FGScope.AssignValue(depth, index, TAstValue.FromRecordSeries(series));
scope.AssignValue(seriesAddress, series);
// Execute the PRE-BOUND call AST
resultValue := callAst.Accept(visitor);
var resultValue := callAst.Accept(visitor);
// Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
// Application.ProcessMessages;
if i < smaSlowLength + 50 then
begin
Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
Application.ProcessMessages;
end;
end;
end;
@@ -718,4 +585,67 @@ begin
Memo1.Lines.Add(Format('Total time: %d ms', [sw.ElapsedMilliseconds]));
end;
var
TriggerScope: IExecutionScope;
procedure TForm1.CreateTriggerExampleButtonClick(Sender: TObject);
var
blk: IExpressionNode;
begin
// This is a setup script, so its goal is to create and populate FGScope.
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Creating Trigger Blueprint ---');
// Define the AST for the setup script.
blk :=
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(TScalar.FromInt64(0))),
TAst.VarDecl(
TAst.Identifier('tickHandler'),
TAst.LambdaExpr(
[TAst.Identifier('summand')],
TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), boAdd, TAst.Identifier('summand')))
)
)
]
);
TriggerScope := TAst.Bind(blk, FGScope).Instantiate(FGScope);
blk.Accept(CreateVisitor(TriggerScope));
FLastAst := blk; // Store for visualization
Memo1.Lines.Add('Variable "X" and function "tickHandler" defined in persistent scope.');
Memo1.Lines.Add('Click "Do Trigger" to execute.');
end;
procedure TForm1.DoTriggerButtonClick(Sender: TObject);
var
callAst: IFunctionCallNode;
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(1))]);
FLastAst := callAst;
// Bind and execute the call against the persistent scope
var X := ExecuteAst(callAst, TriggerScope);
Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [X.ToString]));
end;
procedure TForm1.DoTrigger2ButtonClick(Sender: TObject);
var
callAst: IFunctionCallNode;
currentValue: TAstValue;
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(TScalar.FromInt64(2))]);
FLastAst := callAst;
// Bind and execute the call against the persistent scope
var X := ExecuteAst(callAst, TriggerScope);
Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [X.ToString]));
end;
end.
Src/AST/Myc.Ast.Evaluator.pas
+34 -51
View File
@@ -8,6 +8,7 @@ uses
System.Generics.Collections,
Myc.Data.Scalar,
Myc.Ast.Nodes,
Myc.Ast.Scope,
Myc.Ast;
type
@@ -80,7 +81,6 @@ uses
System.TypInfo,
Myc.Data.Decimal,
Myc.Data.Series,
Myc.Ast.Scope,
Myc.Ast.Printer,
Myc.Data.Scalar.JSON;
@@ -92,13 +92,16 @@ type
TClosureValue = class(TInterfacedObject, IEvaluatorClosure)
private
FBody: IExpressionNode;
FParameters: TArray<IIdentifierNode>;
FClosureScope: IExecutionScope;
FLambdaNode: ILambdaExpressionNode;
function GetBody: IExpressionNode;
function GetParameters: TArray<IIdentifierNode>;
function GetClosureScope: IExecutionScope;
function GetLambdaNode: ILambdaExpressionNode;
public
constructor Create(ABody: IExpressionNode; const AParameters: TArray<IIdentifierNode>; const AClosureScope: IExecutionScope);
constructor Create(const ALambdaNode: ILambdaExpressionNode; const AClosureScope: IExecutionScope);
property ClosureScope: IExecutionScope read GetClosureScope;
property LambdaNode: ILambdaExpressionNode read GetLambdaNode;
end;
// Concrete implementation of IEvaluatorClosure for native Delphi functions.
@@ -203,11 +206,11 @@ end;
{ TClosureValue }
constructor TClosureValue.Create(ABody: IExpressionNode; const AParameters: TArray<IIdentifierNode>; const AClosureScope: IExecutionScope);
constructor TClosureValue.Create(const ALambdaNode: ILambdaExpressionNode; const AClosureScope: IExecutionScope);
begin
inherited Create;
FBody := ABody;
FParameters := AParameters;
FLambdaNode := ALambdaNode;
FBody := ALambdaNode.Body;
FClosureScope := AClosureScope;
end;
@@ -221,9 +224,14 @@ begin
Result := FClosureScope;
end;
function TClosureValue.GetLambdaNode: ILambdaExpressionNode;
begin
Result := FLambdaNode;
end;
function TClosureValue.GetParameters: TArray<IIdentifierNode>;
begin
Result := FParameters;
Result := FLambdaNode.Parameters;
end;
{ TNativeClosure }
@@ -284,14 +292,9 @@ function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): T
var
itemValue, lookbackValue, seriesVar: TAstValue;
lookback: Int64;
depth, index: Integer;
begin
// The target series must have been resolved by the binder.
if not Node.Series.Resolve(depth, index) then
raise EArgumentException
.CreateFmt('Identifier could not be resolved: "%s". This should have been caught by the binder.', [Node.Series.Name]);
seriesVar := FScope.GetValue(depth, index);
seriesVar := FScope.GetValue(Node.Series.Resolve);
itemValue := Node.Value.Accept(Self);
lookback := -1;
@@ -340,18 +343,9 @@ begin
end;
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TAstValue;
var
value: TAstValue;
depth, index: Integer;
begin
value := Node.Value.Accept(Self);
if not Node.Identifier.Resolve(depth, index) then
raise EArgumentException
.CreateFmt('Identifier could not be resolved: "%s". This should have been caught by the binder.', [Node.Identifier.Name]);
FScope.AssignValue(depth, index, value);
Result := value;
Result := Node.Value.Accept(Self);
FScope.AssignValue(Node.Identifier.Resolve, Result);
end;
function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TAstValue;
@@ -383,15 +377,8 @@ begin
end;
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
var
depth, index: Integer;
begin
if Node.Resolve(depth, index) then
Result := FScope.GetValue(depth, index)
else
// This should not happen if the binder ran successfully.
raise EArgumentException
.CreateFmt('Identifier could not be resolved: "%s". This should have been caught by the binder.', [Node.Name]);
Result := FScope.GetValue(Node.Resolve)
end;
function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TAstValue;
@@ -488,16 +475,14 @@ begin
else
value := TAstValue.Void;
FScope.Define(Node.Identifier.Name, value);
FScope.AssignValue(Node.Identifier.Resolve, value);
Result := value;
end;
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue;
var
closureImpl: IEvaluatorClosure;
begin
closureImpl := TClosureValue.Create(Node.Body, Node.Parameters, FScope);
Result := TAstValue.FromClosure(closureImpl);
Result := TAstValue.FromClosure(TClosureValue.Create(Node, FScope));
end;
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue;
@@ -505,9 +490,9 @@ var
calleeValue: TAstValue;
closure: IEvaluatorClosure;
i: Integer;
argValues: TArray<TAstValue>;
callScope: IExecutionScope;
innerVisitor: IAstVisitor;
descriptor: IScopeDescriptor;
begin
calleeValue := Node.Callee.Accept(Self);
@@ -518,11 +503,10 @@ begin
if closure is TNativeClosure then
begin
var argValues: TArray<TAstValue>;
SetLength(argValues, Node.Arguments.Count);
for i := 0 to Node.Arguments.Count - 1 do
begin
argValues[i] := Node.Arguments[i].Accept(Self);
end;
Result := (closure as TNativeClosure).Method(argValues);
end
else if closure is TClosureValue then
@@ -531,20 +515,17 @@ begin
raise EArgumentException
.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(closure.Parameters), Node.Arguments.Count]);
callScope := TExecutionScope.Create(closure.ClosureScope);
descriptor := (closure as TClosureValue).LambdaNode.ScopeDescriptor;
if not Assigned(descriptor) then
raise EParserError.Create('Lambda has no scope descriptor. Did the binder run?');
// The order of definitions must exactly match the binder's order.
callScope := descriptor.Instantiate(closure.ClosureScope);
callScope.SetValueByIndex(0, calleeValue);
// Define 'Self' first.
callScope.Define('Self', calleeValue);
// 2. Then, define the parameters.
for i := 0 to Node.Arguments.Count - 1 do
begin
var argValue := Node.Arguments[i].Accept(Self);
callScope.Define(closure.Parameters[i].Name, argValue);
end;
callScope.SetValueByIndex(closure.Parameters[i].Resolve.SlotIndex, Node.Arguments[i].Accept(Self));
// 3. Führe den Körper der Funktion im neuen Scope aus.
innerVisitor := Self.CreateVisitorForScope(callScope);
Result := closure.Body.Accept(innerVisitor);
end
@@ -914,6 +895,7 @@ begin
AppendMultiline((pp as TPrettyPrintVisitor).GetResult);
ShowScope;
Result := inherited VisitLambdaExpression(Node);
finally
Unindent;
@@ -926,6 +908,7 @@ begin
AppendLine('FunctionCall{');
Indent;
try
ShowScope;
Result := inherited VisitFunctionCall(Node);
finally
Unindent;
@@ -938,8 +921,8 @@ begin
AppendLine('Block{');
Indent;
try
ShowScope;
Result := inherited VisitBlockExpression(Node);
ShowScope;
finally
Unindent;
end;
Src/AST/Myc.Ast.Nodes.pas
+38 -16
View File
@@ -25,7 +25,6 @@ type
TAstValueKind = (avkUndefined, avkScalar, avkClosure, avkText, avkSeries, avkRecordSeries, avkRecord, avkMemberSeries);
// --- Forward Declarations to break cycles ---
IExecutionScope = interface;
IAstVisitor = interface;
IAstNode = interface;
IExpressionNode = interface;
@@ -46,18 +45,25 @@ type
IAddSeriesItemNode = interface;
ISeriesLengthNode = interface;
IEvaluatorClosure = interface;
IExecutionScope = interface;
IScopeDescriptor = interface;
// --- Concrete Type Definitions ---
IEvaluatorClosure = interface(IInterface)
TResolvedAddress = record
ScopeDepth: Integer;
SlotIndex: Integer;
end;
IEvaluatorClosure = interface
{$region 'private'}
function GetBody: IExpressionNode;
function GetParameters: TArray<IIdentifierNode>;
function GetClosureScope: IExecutionScope;
function GetParameters: TArray<IIdentifierNode>;
{$endregion}
property Body: IExpressionNode read GetBody;
property Parameters: TArray<IIdentifierNode> read GetParameters;
property ClosureScope: IExecutionScope read GetClosureScope;
property Parameters: TArray<IIdentifierNode> read GetParameters;
end;
TAstValue = record
@@ -96,29 +102,40 @@ type
property Kind: TAstValueKind read GetKind;
end;
IExecutionScope = interface(IInterface)
IExecutionScope = interface
{$region 'private'}
function GetParent: IExecutionScope;
{$endregion}
procedure Clear;
// --- Legacy name-based access (for pre-binder setup, e.g., native functions) ---
function FindValue(const Name: string; out Value: TAstValue): Boolean; deprecated 'Use index-based access after binding.';
procedure SetValue(const Name: string; const Value: TAstValue); deprecated 'Use Define for script variables.';
procedure AssignValue(const Name: string; const Value: TAstValue); overload; deprecated 'Use index-based assignment after binding.';
// --- 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 (for use by the evaluator after binding) ---
// Defines a new variable in the current scope.
// --- New index-based access ---
procedure Define(const Name: string; const Value: TAstValue);
// Gets a value from a scope at a specific depth and slot index.
function GetValue(Depth, Index: Integer): TAstValue;
// Assigns a new value to an existing variable at a specific depth and slot index.
procedure AssignValue(Depth, Index: Integer; const Value: TAstValue); overload;
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 Parent: IExecutionScope read GetParent;
end;
IScopeDescriptor = interface
{$region 'private'}
function GetParent: IScopeDescriptor;
function GetSlotCount: Integer;
function GetSymbols: TDictionary<string, Integer>;
{$endregion}
function Instantiate(const AParent: IExecutionScope): IExecutionScope;
procedure PopulateFromScope(const AScope: IExecutionScope);
property Parent: IScopeDescriptor read GetParent;
property SlotCount: Integer read GetSlotCount;
property Symbols: TDictionary<string, Integer> read GetSymbols;
end;
IAstVisitor = interface
function VisitConstant(const Node: IConstantNode): TAstValue;
function VisitIdentifier(const Node: IIdentifierNode): TAstValue;
@@ -154,9 +171,12 @@ type
IIdentifierNode = interface(IExpressionNode)
{$region 'private'}
function GetIsResolved: Boolean;
function GetName: string;
{$endregion}
function Resolve(out ScopeDepth: Integer; out SlotIndex: Integer): Boolean;
//TODO fasse ScopeDepth und SlotIndex in einem record zusammen
function Resolve: TResolvedAddress;
property IsResolved: Boolean read GetIsResolved;
property Name: string read GetName;
end;
@@ -208,9 +228,11 @@ type
{$region 'private'}
function GetParameters: TArray<IIdentifierNode>;
function GetBody: IExpressionNode;
function GetScopeDescriptor: IScopeDescriptor;
{$endregion}
property Parameters: TArray<IIdentifierNode> read GetParameters;
property Body: IExpressionNode read GetBody;
property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor;
end;
IFunctionCallNode = interface(IExpressionNode)
Src/AST/Myc.Ast.Scope.pas
+37 -24
View File
@@ -23,21 +23,23 @@ type
procedure SetValue(const Name: string; const Value: TAstValue);
procedure AssignValue(const Name: string; const Value: TAstValue); overload;
function Dump: string;
// --- New index-based access methods ---
procedure Define(const Name: string; const Value: TAstValue);
function GetValue(Depth, Index: Integer): TAstValue;
procedure AssignValue(Depth, Index: Integer; const Value: TAstValue); overload;
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);
destructor Destroy; override;
property NameToIndex: TDictionary<string, Integer> read FNameToIndex;
property Parent: IExecutionScope read FParent;
property Values: TArray<TAstValue> read FValues;
end;
implementation
uses
System.Generics.Defaults; // For TComparer
System.Generics.Defaults;
{ TExecutionScope }
@@ -49,6 +51,14 @@ begin
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);
end;
destructor TExecutionScope.Destroy;
begin
FNameToIndex.Free;
@@ -72,23 +82,23 @@ begin
raise Exception.CreateFmt('Cannot assign to undeclared variable "%s".', [Name]);
end;
procedure TExecutionScope.AssignValue(Depth, Index: Integer; const Value: TAstValue);
procedure TExecutionScope.AssignValue(const Address: TResolvedAddress; const Value: TAstValue);
var
targetScope: IExecutionScope;
i: Integer;
begin
targetScope := Self;
for i := 1 to Depth do
for i := 1 to Address.ScopeDepth do
begin
if Assigned(targetScope) then
targetScope := targetScope.Parent
else
// This should not happen if the binder works correctly.
raise EInvalidOpException.Create('Invalid scope depth during assignment.');
end;
// We must cast back to the implementation to modify the private array.
(targetScope as TExecutionScope).FValues[Index] := Value;
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;
@@ -101,7 +111,6 @@ procedure TExecutionScope.Define(const Name: string; const Value: TAstValue);
var
index: Integer;
begin
// A variable can only be defined once per scope.
if FNameToIndex.ContainsKey(Name) then
raise Exception.CreateFmt('Variable "%s" is already defined in this scope.', [Name]);
@@ -120,7 +129,6 @@ begin
indentStr := ''.PadLeft(AIndent);
if (FNameToIndex.Count > 0) then
begin
// Copy pairs to an array and sort it by index for consistent output
sortedPairs := FNameToIndex.ToArray;
TArray.Sort<TPair<string, Integer>>(
sortedPairs,
@@ -139,7 +147,6 @@ begin
if Assigned(FParent) then
begin
ABuilder.AppendLine(indentStr + '[Parent Scope]');
// This cast is necessary for this debug helper to access implementation details.
(FParent as TExecutionScope).DumpScope(ABuilder, AIndent + 2);
end;
end;
@@ -175,34 +182,40 @@ begin
Result := False;
end;
function TExecutionScope.GetValue(Depth, Index: Integer): TAstValue;
function TExecutionScope.GetValue(const Address: TResolvedAddress): TAstValue;
var
targetScope: IExecutionScope;
targetScope: TExecutionScope;
i: Integer;
begin
targetScope := Self;
for i := 1 to Depth do
for i := 0 to Address.ScopeDepth - 1 do
begin
if Assigned(targetScope) then
targetScope := targetScope.Parent
else
// This should not happen if the binder works correctly.
raise EInvalidOpException.Create('Invalid scope depth during value retrieval.');
targetScope := targetScope.Parent as TExecutionScope;
Assert(Assigned(targetScope), 'Invalid scope depth during value retrieval.');
end;
// We must cast back to the implementation to access the private array.
Result := (targetScope as TExecutionScope).FValues[Index];
Assert((Address.SlotIndex >= 0) and (Address.SlotIndex < Length(targetScope.Values)), 'Invalid scope index during value retrieval.');
Result := targetScope.Values[Address.SlotIndex];
end;
procedure TExecutionScope.SetValue(const Name: string; const Value: TAstValue);
var
index: Integer;
begin
// This method is for pre-binder setup (e.g. native functions) or initial definition.
if FNameToIndex.TryGetValue(Name, index) then
FValues[index] := Value
else
Define(Name, Value);
end;
procedure TExecutionScope.SetValueByIndex(Index: Integer; const Value: TAstValue);
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;
end;
end.
Src/AST/Myc.Ast.pas
+170 -77
View File
@@ -3,9 +3,12 @@ unit Myc.Ast;
interface
uses
System.Classes,
System.SysUtils,
System.Generics.Collections,
Myc.Data.Scalar,
Myc.Ast.Nodes;
Myc.Ast.Nodes,
Myc.Ast.Scope;
type
// Record acting as a namespace for the factory functions.
@@ -44,8 +47,10 @@ type
class function SeriesLength(const ASeries: IIdentifierNode): ISeriesLengthNode; static;
// --- Static method to run the binder ---
// Traverses the AST and resolves all identifiers. This must be called before evaluating the AST.
class procedure Bind(const ARootNode: IExpressionNode; const AScope: IExecutionScope); static;
// 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;
end;
// TAstTraverser provides a default AST traversal implementation.
@@ -71,12 +76,23 @@ type
implementation
uses
System.Classes,
System.Generics.Collections,
Myc.Ast.Scope; // Needed for the TExecutionScope cast
type
TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor)
private
FParent: IScopeDescriptor;
FSymbols: TDictionary<string, Integer>;
function GetParent: IScopeDescriptor;
function GetSlotCount: Integer;
function GetSymbols: TDictionary<string, Integer>;
public
constructor Create(AParent: IScopeDescriptor);
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;
procedure PopulateFromScope(const AScope: IExecutionScope);
end;
{ TAstNode }
// Common base class for AST nodes to reduce boilerplate.
TAstNode = class(TInterfacedObject, IExpressionNode)
@@ -100,15 +116,15 @@ type
private
FName: string;
// --- Annotation fields added for the binder ---
FIsResolved: Boolean;
FScopeDepth: Integer;
FSlotIndex: Integer;
FResolvedAddress: TResolvedAddress;
function GetName: string;
function GetIsResolved: Boolean; inline;
public
constructor Create(AName: string);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
function Resolve(out ScopeDepth: Integer; out SlotIndex: Integer): Boolean;
function Resolve: TResolvedAddress;
property IsResolved: Boolean read GetIsResolved;
property Name: string read FName;
end;
@@ -172,11 +188,14 @@ type
private
FParameters: TArray<IIdentifierNode>;
FBody: IExpressionNode;
FScopeDescriptor: IScopeDescriptor; // Backing field for the new property
function GetParameters: TArray<IIdentifierNode>;
function GetBody: IExpressionNode;
function GetScopeDescriptor: IScopeDescriptor;
public
constructor Create(const AParameters: TArray<IIdentifierNode>; const ABody: IExpressionNode);
function Accept(const Visitor: IAstVisitor): TAstValue; override;
property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor;
end;
{ TFunctionCallNode }
@@ -306,20 +325,86 @@ type
function Resolve(const Name: string; out Symbol: TSymbol; out Depth: Integer): Boolean;
end;
// TBinder inherits from the base traverser and overrides methods with specific binding logic.
TBinder = class(TAstTraverser)
private
FCurrentScope: TSymbolTable;
FCurrentDescriptor: IScopeDescriptor;
procedure EnterScope;
procedure ExitScope;
public
constructor Create(AInitialScope: IExecutionScope);
destructor Destroy; override;
constructor Create(const AInitialScope: IExecutionScope);
function VisitIdentifier(const Node: IIdentifierNode): TAstValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; override;
property CurrentDescriptor: IScopeDescriptor read FCurrentDescriptor;
end;
{ TScopeDescriptor }
constructor TScopeDescriptor.Create(AParent: IScopeDescriptor);
begin
inherited Create;
FParent := AParent;
FSymbols := TDictionary<string, Integer>.Create;
end;
destructor TScopeDescriptor.Destroy;
begin
FSymbols.Free;
inherited;
end;
function TScopeDescriptor.Define(const Name: string): Integer;
begin
Result := FSymbols.Count;
FSymbols.Add(Name, Result);
end;
function TScopeDescriptor.FindSymbol(const Name: string; out Index: Integer; out Depth: Integer): Boolean;
var
currentDescriptor: IScopeDescriptor;
begin
Depth := 0;
currentDescriptor := Self;
while Assigned(currentDescriptor) do
begin
if (currentDescriptor as TScopeDescriptor).FSymbols.TryGetValue(Name, Index) then
Exit(True);
inc(Depth);
currentDescriptor := currentDescriptor.Parent;
end;
Result := False;
end;
function TScopeDescriptor.GetParent: IScopeDescriptor;
begin
Result := FParent;
end;
function TScopeDescriptor.GetSlotCount: Integer;
begin
Result := FSymbols.Count;
end;
function TScopeDescriptor.GetSymbols: TDictionary<string, Integer>;
begin
Result := FSymbols;
end;
function TScopeDescriptor.Instantiate(const AParent: IExecutionScope): IExecutionScope;
begin
Result := TExecutionScope.CreateFromDescriptor(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);
end;
{ TConstantNode }
constructor TConstantNode.Create(AValue: TScalar);
@@ -344,9 +429,8 @@ constructor TIdentifierNode.Create(AName: string);
begin
inherited Create;
FName := AName;
FIsResolved := False;
FScopeDepth := -1;
FSlotIndex := -1;
FResolvedAddress.ScopeDepth := -1;
FResolvedAddress.SlotIndex := -1;
end;
function TIdentifierNode.Accept(const Visitor: IAstVisitor): TAstValue;
@@ -354,19 +438,22 @@ begin
Result := Visitor.VisitIdentifier(Self);
end;
function TIdentifierNode.GetIsResolved: Boolean;
begin
Result := FResolvedAddress.ScopeDepth >= 0;
end;
function TIdentifierNode.GetName: string;
begin
Result := FName;
end;
function TIdentifierNode.Resolve(out ScopeDepth: Integer; out SlotIndex: Integer): Boolean;
function TIdentifierNode.Resolve: TResolvedAddress;
begin
Result := FIsResolved;
if Result then
begin
ScopeDepth := FScopeDepth;
SlotIndex := FSlotIndex;
end;
if not IsResolved then
raise EInvalidOpException.Create('Identifier not bound');
Result := FResolvedAddress;
end;
{ TBinaryExpressionNode }
@@ -490,6 +577,7 @@ begin
inherited Create;
FBody := ABody;
FParameters := AParameters;
FScopeDescriptor := nil;
end;
function TLambdaExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue;
@@ -507,6 +595,11 @@ begin
Result := FParameters;
end;
function TLambdaExpressionNode.GetScopeDescriptor: IScopeDescriptor;
begin
Result := FScopeDescriptor;
end;
{ TFunctionCallNode }
constructor TFunctionCallNode.Create(const ACallee: IExpressionNode; const AArguments: array of IExpressionNode);
@@ -769,7 +862,6 @@ var
scopeImpl: TExecutionScope;
pair: TPair<string, Integer>;
begin
// ** THE FIX IS HERE **
// Iterate over the Key-Value pairs of the scope's dictionary to preserve the exact indices.
if not Assigned(AScope) then
Exit;
@@ -818,61 +910,37 @@ begin
Result.PopulateFromScope(AScope);
end;
constructor TBinder.Create(AInitialScope: IExecutionScope);
{ TBinder }
constructor TBinder.Create(const AInitialScope: IExecutionScope);
begin
inherited Create;
// Correctly and recursively build the symbol table hierarchy from the execution scope.
FCurrentScope := CreateSymbolTableFromScope(AInitialScope);
// If no initial scope was provided, create a single empty root scope.
if not Assigned(FCurrentScope) then
FCurrentScope := TSymbolTable.Create(nil);
end;
destructor TBinder.Destroy;
var
scopeToFree: TSymbolTable;
begin
// The previous Assert was incorrect for binders initialized with nested scopes.
// This new implementation robustly cleans up the entire symbol table chain.
while Assigned(FCurrentScope) do
begin
scopeToFree := FCurrentScope;
FCurrentScope := FCurrentScope.FParent;
scopeToFree.Free;
end;
inherited;
FCurrentDescriptor := TAst.CreateBinding(AInitialScope);
end;
procedure TBinder.EnterScope;
begin
FCurrentScope := TSymbolTable.Create(FCurrentScope);
FCurrentDescriptor := TScopeDescriptor.Create(FCurrentDescriptor);
end;
procedure TBinder.ExitScope;
var
oldScope: TSymbolTable;
begin
oldScope := FCurrentScope;
FCurrentScope := FCurrentScope.FParent;
oldScope.Free;
FCurrentDescriptor := FCurrentDescriptor.Parent;
end;
function TBinder.VisitIdentifier(const Node: IIdentifierNode): TAstValue;
var
symbol: TSymbol;
depth: Integer;
index, depth: Integer;
identNode: TIdentifierNode;
begin
identNode := Node as TIdentifierNode;
if identNode.FIsResolved then
if identNode.IsResolved then
Exit;
if FCurrentScope.Resolve(identNode.Name, symbol, depth) then
if (FCurrentDescriptor as TScopeDescriptor).FindSymbol(identNode.Name, index, depth) then
begin
identNode.FIsResolved := True;
identNode.FScopeDepth := depth;
identNode.FSlotIndex := symbol.SlotIndex;
identNode.FResolvedAddress.ScopeDepth := depth;
identNode.FResolvedAddress.SlotIndex := index;
end
else
raise Exception.CreateFmt('Undefined identifier: "%s"', [identNode.Name]);
@@ -884,16 +952,15 @@ var
begin
EnterScope;
try
// Reserve a slot for 'Self' first.
FCurrentScope.Define('Self');
(FCurrentDescriptor as TScopeDescriptor).Define('Self');
// 1. Define all parameters in the new scope.
for param in Node.Parameters do
FCurrentScope.Define(param.Name);
(FCurrentDescriptor as TScopeDescriptor).Define(param.Name);
// 2. Now visit the parameter identifiers to resolve them to their new definitions,
// and visit the body to resolve its identifiers.
inherited VisitLambdaExpression(Node);
// Annotate the lambda node with the completed scope descriptor.
(Node as TLambdaExpressionNode).FScopeDescriptor := FCurrentDescriptor;
finally
ExitScope;
end;
@@ -901,22 +968,32 @@ end;
function TBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue;
begin
// For recursive functions, we must define the name in the scope FIRST,
// so it can be resolved inside its own initializer (i.e., the lambda body).
FCurrentScope.Define(Node.Identifier.Name);
(FCurrentDescriptor as TScopeDescriptor).Define(Node.Identifier.Name);
inherited;
end;
{ TAst }
class procedure TAst.Bind(const ARootNode: IExpressionNode; const AScope: IExecutionScope);
class function TAst.Bind(const RootNode: IExpressionNode; const ParentScope: IExecutionScope): IScopeDescriptor;
var
binder: IAstVisitor;
binder: TBinder;
visitor: IAstVisitor;
begin
// Create a binder instance, pre-populating its symbol table with the given scope.
binder := TBinder.Create(AScope);
// Traverse the AST to resolve all identifiers.
ARootNode.Accept(binder);
// Create a binder, initialized with the parent scope (for globals etc.)
binder := TBinder.Create(ParentScope);
visitor := binder;
// Create a new scope descriptor for the script's local variables.
binder.EnterScope;
try
// 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;
finally
// Restore the binder's internal state.
binder.ExitScope;
end;
end;
class function TAst.AddSeriesItem(
@@ -958,6 +1035,22 @@ begin
Result := TBinaryExpressionNode.Create(ALeft, AOperator, ARight);
end;
class function TAst.CreateBinding(const Scope: IExecutionScope): IScopeDescriptor;
begin
if Assigned(Scope) then
begin
Result := CreateScopeDescriptor(CreateBinding(Scope.Parent));
Result.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);
Src/Data/Myc.Data.Scalar.JSON.pas
+3 -3
View File
@@ -15,7 +15,7 @@ type
class function TypeToScalarKind(AType: TRttiType): TScalarKind; static;
public
// Creates a JSON definition string from a record type info.
class function RecordDefinitionToJson(ATypeInfo: PTypeInfo): string; static;
class function RecordDefinitionToJson<T: record>: string; static;
// Creates a record definition from a JSON string.
class function JsonToRecordDefinition(const AJson: string): TScalarRecordDefinition; static;
end;
@@ -67,7 +67,7 @@ begin
end;
end;
class function TRttiAstHelper.RecordDefinitionToJson(ATypeInfo: PTypeInfo): string;
class function TRttiAstHelper.RecordDefinitionToJson<T>: string;
var
ctx: TRttiContext;
rttiType: TRttiType;
@@ -77,7 +77,7 @@ var
fieldObj: TJSONObject;
begin
ctx := TRttiContext.Create;
rttiType := ctx.GetType(ATypeInfo);
rttiType := ctx.GetType(TypeInfo(T));
if not (rttiType is TRttiRecordType) then
raise EArgumentException.Create('PTypeInfo provided is not a record type.');