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

AST Refactoring

Browse Source
This commit is contained in:
Michael Schimmel
2025-09-12 22:45:29 +02:00
parent a36ca2c7e3
commit be6665ad6e
11 changed files with 428 additions and 633 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/ASTPlayground.dpr
+2 -1
View File
@@ -10,7 +10,8 @@ uses
Myc.Ast.Scope in '..\Src\AST\Myc.Ast.Scope.pas',
Myc.Ast.Visualizer in 'Myc.Ast.Visualizer.pas',
Myc.Ast.ViewModel in '..\Src\AST\Myc.Ast.ViewModel.pas',
Myc.Data.Value in 'Myc.Data.Value.pas';
Myc.Data.Value in 'Myc.Data.Value.pas',
Myc.Ast.Debugger in '..\Src\AST\Myc.Ast.Debugger.pas';
{$R *.res}
ASTPlayground/ASTPlayground.dproj
+2 -7
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>
@@ -142,6 +142,7 @@
<DCCReference Include="Myc.Ast.Visualizer.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.ViewModel.pas"/>
<DCCReference Include="Myc.Data.Value.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Debugger.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
@@ -197,12 +198,6 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win64\Debug\ASTPlayground.rsm" Configuration="Debug" Class="DebugSymbols">
<Platform Name="Win64">
<RemoteName>ASTPlayground.rsm</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win64\Release\ASTPlayground.exe" Configuration="Release" Class="ProjectOutput">
<Platform Name="Win64">
<RemoteName>ASTPlayground.exe</RemoteName>
ASTPlayground/MainForm.fmx
+14 -6
View File
@@ -33,7 +33,7 @@ object Form1: TForm1
end
object PrettyPrintButton: TButton
Position.X = 24.000000000000000000
Position.Y = 381.000000000000000000
Position.Y = 405.000000000000000000
TabOrder = 3
Text = 'Print'
TextSettings.Trimming = None
@@ -52,7 +52,7 @@ object Form1: TForm1
end
object ShowScopeBox: TCheckBox
Position.X = 24.000000000000000000
Position.Y = 441.000000000000000000
Position.Y = 465.000000000000000000
TabOrder = 5
Text = 'Scope'
end
@@ -89,7 +89,7 @@ object Form1: TForm1
end
object ClearButton: TButton
Position.X = 24.000000000000000000
Position.Y = 472.000000000000000000
Position.Y = 496.000000000000000000
Size.Width = 80.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
@@ -126,13 +126,13 @@ object Form1: TForm1
end
object DebugBox: TCheckBox
Position.X = 24.000000000000000000
Position.Y = 360.000000000000000000
Position.Y = 384.000000000000000000
TabOrder = 15
Text = 'Debug'
end
object FromJSONButton: TButton
Position.X = 24.000000000000000000
Position.Y = 520.000000000000000000
Position.Y = 544.000000000000000000
TabOrder = 16
Text = 'From JSON'
TextSettings.Trimming = None
@@ -140,12 +140,20 @@ object Form1: TForm1
end
object ToJSONButton: TButton
Position.X = 24.000000000000000000
Position.Y = 550.000000000000000000
Position.Y = 574.000000000000000000
TabOrder = 17
Text = 'To JSON'
TextSettings.Trimming = None
OnClick = ToJSONButtonClick
end
object ExternalFuncButton: TButton
Position.X = 24.000000000000000000
Position.Y = 336.000000000000000000
TabOrder = 18
Text = 'External Func'
TextSettings.Trimming = None
OnClick = ExternalFuncButtonClick
end
end
object Panel2: TPanel
Align = Client
ASTPlayground/MainForm.pas
+173 -97
View File
@@ -23,14 +23,15 @@ uses
FMX.Controls.Presentation,
Myc.Ast.Visualizer,
Myc.Data.Scalar,
Myc.Data.Value, // Added
Myc.Data.Value,
Myc.Ast.Nodes,
Myc.Ast,
Myc.Ast.Evaluator,
Myc.Ast.Printer,
FMX.Layouts,
FMX.Objects,
Myc.Ast.Scope;
Myc.Ast.Scope,
Myc.Ast.Debugger; // Added for TDebugSession
type
// A test record
@@ -63,11 +64,13 @@ type
DebugBox: TCheckBox;
FromJSONButton: TButton;
ToJSONButton: TButton;
ExternalFuncButton: TButton;
procedure ClearButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CreateTriggerExampleButtonClick(Sender: TObject);
procedure DoTrigger2ButtonClick(Sender: TObject);
procedure DoTriggerButtonClick(Sender: TObject);
procedure ExternalFuncButtonClick(Sender: TObject);
procedure FibonacciButtonClick(Sender: TObject);
procedure OHLCButtonClick(Sender: TObject);
procedure PrettyPrintButtonClick(Sender: TObject);
@@ -82,9 +85,8 @@ type
FLastAst: IAstNode;
FGScope: IExecutionScope;
FWorkspace: TAuraWorkspace;
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
// Helper function to encapsulate the Bind -> Evaluate pattern
function ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
public
{ Public declarations }
@@ -113,26 +115,32 @@ begin
RegisterNativeFunctions(FGScope);
end;
function TForm1.CreateVisitor(const AScope: IExecutionScope): IAstVisitor;
begin
// Conditionally create a debug visitor if the checkbox is checked.
if DebugBox.IsChecked then
begin
Memo1.Lines.Add('--- Creating DEBUG visitor ---');
Result := TDebugEvaluatorVisitor.Create(AScope, Memo1.Lines, ShowScopeBox.IsChecked);
end
else
Result := TEvaluatorVisitor.Create(AScope);
end;
function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
var
scriptScope: IExecutionScope;
begin
// This helper function handles simple, one-off script executions.
// It binds the AST and then decides whether to run a debug session or a standard evaluation.
scriptScope := TAst.Bind(ANode, AParentScope);
var visitor := CreateVisitor(scriptScope);
Result := ANode.Accept(visitor);
if DebugBox.IsChecked then
begin
// Debug path: Create, run, and destroy a debug session.
var session := TDebugSession.Create(ShowScopeBox.IsChecked);
try
Result := session.Execute(ANode, scriptScope);
Memo1.Lines.Add('--- DEBUG LOG ---');
Memo1.Lines.AddStrings(session.Log);
finally
session.Free;
end;
end
else
begin
// Production path: Create and use the standard evaluator.
var visitor := TEvaluatorVisitor.Create(scriptScope);
Result := ANode.Accept(visitor);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
@@ -186,8 +194,8 @@ begin
);
FLastAst := root;
// Execute with nil as parent scope
result := ExecuteAst(root, nil);
// Execute with FGScope as parent. The helper function handles debug/prod switching.
result := ExecuteAst(root, FGScope);
sw.Stop;
Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
@@ -247,8 +255,8 @@ begin
);
FLastAst := root;
// Execute with nil as parent scope
result := ExecuteAst(root, nil);
// Execute with FGScope as parent.
result := ExecuteAst(root, FGScope);
sw.Stop;
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
@@ -256,18 +264,17 @@ end;
procedure TForm1.SeriesTestButtonClick(Sender: TObject);
var
scope: IExecutionScope;
ast, callAst: IAstNode;
resultValue: TDataValue;
series: TScalarRecordSeries;
recordDef: TScalarRecordDefinition;
i: Integer;
scope: IExecutionScope;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Series Test ---');
// 1. Arrange: Create a new scope and populate it with Delphi data
scope := TExecutionScope.Create(FGScope); // Inherits native functions
scope := TExecutionScope.Create(FGScope);
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson<TOHLCV>);
series := TScalarRecordSeries.Create(recordDef);
for i := 0 to 4 do
@@ -288,7 +295,6 @@ begin
end;
scope.Define('ohlcvSeries', TDataValue.FromRecordSeries(series));
// 2. Act: Define and execute the script AST
ast :=
TAst.LambdaExpr(
[],
@@ -307,7 +313,6 @@ begin
callAst := TAst.FunctionCall(ast, []);
resultValue := ExecuteAst(callAst, scope);
// 3. Assert (logging only)
Memo1.Lines.Add(Format('Result of script: %s', [resultValue.ToString]));
end;
@@ -338,7 +343,6 @@ begin
FLastAst := main;
callAst := TAst.FunctionCall(main, []);
// Execute with FGScope as parent
result := ExecuteAst(callAst, FGScope);
sw.Stop;
@@ -376,7 +380,6 @@ begin
);
FLastAst := root;
// Execute with FGScope as parent
result := ExecuteAst(root, FGScope);
sw.Stop;
@@ -403,14 +406,14 @@ const
lookback = 50;
smaSlowLength = 20;
smaFastLength = 10;
var
visitor: IAstVisitor;
scope: IExecutionScope;
session: TDebugSession;
begin
// 1. Setup
Memo1.Lines.Clear;
Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs]));
var sw := TStopwatch.StartNew;
// 2. Create the setup AST with the strategy logic
var setupAst :=
TAst.Block(
[
@@ -511,77 +514,106 @@ begin
);
FLastAst := setupAst;
var scope := TAst.Bind(setupAst, FGScope);
setupAst.Accept(CreateVisitor(scope));
// 1. Bind and execute the setup script.
scope := TAst.Bind(setupAst, FGScope);
// Declare the series variable in the scope BEFORE binding the call AST
// This is a temporary visitor just for the setup execution.
var setupVisitor: IAstVisitor;
if DebugBox.IsChecked then
begin
session := TDebugSession.Create(ShowScopeBox.IsChecked);
try
// Execute setup script within a temporary session.
session.Execute(setupAst, scope);
Memo1.Lines.Add('--- DEBUG LOG (Setup) ---');
Memo1.Lines.AddStrings(session.Log);
session.Log.Clear; // Clear log for the next phase
finally
session.Free;
end;
end
else
begin
setupVisitor := TEvaluatorVisitor.Create(scope);
setupAst.Accept(setupVisitor);
end;
// 2. Prepare for the simulation loop by modifying the now-populated scope.
scope.Define('current_series', TDataValue.Void);
// Create the call AST that will be executed in the loop
var currentSeriesIdent := TAst.Identifier('current_series');
var callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]);
// Bind the call AST once, before the loop.
// 3. Re-bind the scope with the new AST. This creates the FINAL scope for the loop.
scope := TAst.Bind(callAst, scope);
var visitor := CreateVisitor(scope);
// 4. Simulation Loop
Memo1.Lines.Add('Starting simulation...');
Application.ProcessMessages;
var lastClose := 1000.0;
Randomize;
var recDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson<TOHLCV>);
var series := TDataValue.FromRecordSeries(TScalarRecordSeries.Create(recDef));
var seriesAddress := currentSeriesIdent.Address;
var nw := Now;
var ohlcvRec: TOHLCV;
for var i := 1 to numRecs do
begin
ohlcvRec.Timestamp := nw + (i / (24 * 60));
ohlcvRec.Open := lastClose + (Random * 0.05);
ohlcvRec.Close := lastClose + (Random - 0.49) * 2;
ohlcvRec.High := Max(ohlcvRec.Open, ohlcvRec.Close) + Random;
ohlcvRec.Low := Min(ohlcvRec.Open, ohlcvRec.Close) - Random;
ohlcvRec.Volume := RandomRange(1000, 50000);
lastClose := ohlcvRec.Close;
var recordValue :=
TScalarRecord.Create(
recDef,
[
TScalarValue.FromDateTime(ohlcvRec.Timestamp),
TScalarValue.FromDouble(ohlcvRec.Open),
TScalarValue.FromDouble(ohlcvRec.High),
TScalarValue.FromDouble(ohlcvRec.Low),
TScalarValue.FromDouble(ohlcvRec.Close),
TScalarValue.FromInt64(ohlcvRec.Volume)
]
);
series.AsRecordSeries.Value.Add(recordValue, lookback);
if series.AsRecordSeries.Value.TotalCount >= smaSlowLength then
// 4. NOW create the visitor for the simulation loop, using the final scope.
session := nil;
try
if DebugBox.IsChecked then
begin
// Update the 'current_series' value in the scope using the FAST index-based assignment
scope[seriesAddress].Value := series;
// Create a new session that will live for the duration of the loop.
session := TDebugSession.Create(ShowScopeBox.IsChecked);
visitor := TDebugEvaluatorVisitor.Create(scope, session.Log, ShowScopeBox.IsChecked, 1);
end
else
begin
visitor := TEvaluatorVisitor.Create(scope);
end;
// Execute the PRE-BOUND call AST
var resultValue := callAst.Accept(visitor);
// 5. Simulation Loop
Memo1.Lines.Add('Starting simulation...');
Application.ProcessMessages;
if i mod 50 = 0 then
var lastClose := 1000.0;
Randomize;
var recDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson<TOHLCV>);
var series := TDataValue.FromRecordSeries(TScalarRecordSeries.Create(recDef));
var nw := Now;
var ohlcvRec: TOHLCV;
for var i := 1 to numRecs do
begin
// ... (simulation logic is unchanged) ...
ohlcvRec.Timestamp := nw + (i / (24 * 60));
ohlcvRec.Open := lastClose + (Random * 0.05);
ohlcvRec.Close := lastClose + (Random - 0.49) * 2;
ohlcvRec.High := Max(ohlcvRec.Open, ohlcvRec.Close) + Random;
ohlcvRec.Low := Min(ohlcvRec.Open, ohlcvRec.Close) - Random;
ohlcvRec.Volume := RandomRange(1000, 50000);
lastClose := ohlcvRec.Close;
var recordValue :=
TScalarRecord.Create(
recDef,
[
TScalarValue.FromDateTime(ohlcvRec.Timestamp),
TScalarValue.FromDouble(ohlcvRec.Open),
TScalarValue.FromDouble(ohlcvRec.High),
TScalarValue.FromDouble(ohlcvRec.Low),
TScalarValue.FromDouble(ohlcvRec.Close),
TScalarValue.FromInt64(ohlcvRec.Volume)
]
);
series.AsRecordSeries.Value.Add(recordValue, lookback);
if series.AsRecordSeries.Value.TotalCount >= smaSlowLength then
begin
Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
Application.ProcessMessages;
scope[seriesAddress].Value := series;
var resultValue := callAst.Accept(visitor);
if i mod 50 = 0 then
begin
Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
Application.ProcessMessages;
end;
end;
end;
end;
sw.Stop;
Memo1.Lines.Add('--- Simulation Finished ---');
Memo1.Lines.Add(Format('Total time: %d ms', [sw.ElapsedMilliseconds]));
sw.Stop;
Memo1.Lines.Add('--- Simulation Finished ---');
Memo1.Lines.Add(Format('Total time: %d ms', [sw.ElapsedMilliseconds]));
finally
if Assigned(session) then
session.Free;
end;
end;
var
@@ -590,12 +622,10 @@ var
procedure TForm1.CreateTriggerExampleButtonClick(Sender: TObject);
var
blk: IAstNode;
visitor: IAstVisitor;
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(
[
@@ -612,9 +642,25 @@ begin
TriggerScope := TAst.Bind(blk, FGScope);
blk.Accept(CreateVisitor(TriggerScope));
// This case is simple enough to just inline the logic from ExecuteAst
if DebugBox.IsChecked then
begin
var session := TDebugSession.Create(ShowScopeBox.IsChecked);
try
session.Execute(blk, TriggerScope);
Memo1.Lines.Add('--- DEBUG LOG ---');
Memo1.Lines.AddStrings(session.Log);
finally
session.Free;
end;
end
else
begin
visitor := TEvaluatorVisitor.Create(TriggerScope);
blk.Accept(visitor);
end;
FLastAst := blk; // Store for visualization
FLastAst := blk;
Memo1.Lines.Add('Variable "X" and function "tickHandler" defined in persistent scope.');
Memo1.Lines.Add('Click "Do Trigger" to execute.');
@@ -644,11 +690,43 @@ begin
Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [X.ToString]));
end;
procedure TForm1.ExternalFuncButtonClick(Sender: TObject);
var
scope: IExecutionScope;
callAst: IAstNode;
resultValue: TDataValue;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Calling external Delphi function from AST ---');
scope := TExecutionScope.Create(FGScope);
scope.Define(
'delphiAdd',
function(const ArgNodes: TArray<TDataValue>): TDataValue
var
val1, val2: Int64;
begin
if Length(ArgNodes) <> 2 then
raise Exception.Create('delphiAdd requires exactly 2 arguments.');
val1 := ArgNodes[0].AsScalar.Value.AsInt64;
val2 := ArgNodes[1].AsScalar.Value.AsInt64;
Result := TScalar.FromInt64(val1 + val2);
end
);
callAst :=
TAst.FunctionCall(TAst.Identifier('delphiAdd'), [TAst.Constant(TScalar.FromInt64(100)), TAst.Constant(TScalar.FromInt64(23))]);
FLastAst := callAst;
resultValue := ExecuteAst(callAst, scope);
Memo1.Lines.Add(Format('Result from delphiAdd(100, 23): %s', [resultValue.ToString]));
end;
procedure TForm1.FromJSONButtonClick(Sender: TObject);
var
jsonString: string;
begin
// Implemented TODO: Reads an AST JSON string from the memo and deserializes it into FLastAst.
Memo1.Lines.BeginUpdate;
try
jsonString := Memo1.Lines.Text;
@@ -670,7 +748,6 @@ begin
FLastAst := nil;
Memo1.Lines.Add('Error deserializing AST from JSON:');
Memo1.Lines.Add(E.Message);
// Restore original text for correction
Memo1.Lines.Add('--- Original JSON ---');
Memo1.Lines.Text := Memo1.Lines.Text + sLineBreak + jsonString;
end;
@@ -684,7 +761,6 @@ procedure TForm1.ToJSONButtonClick(Sender: TObject);
var
jsonString: string;
begin
// Implemented TODO: Serializes the current FLastAst to a JSON string and displays it in the memo.
Memo1.Lines.Clear;
if not Assigned(FLastAst) then
ASTPlayground/Myc.Ast.Visualizer.pas
+7 -7
View File
@@ -365,10 +365,10 @@ begin
try
sb.Append(calleeStr);
sb.Append('(');
for i := 0 to Node.Arguments.Count - 1 do
for i := 0 to High(Node.Arguments) do
begin
sb.Append(Node.Arguments[i].Accept(Self).AsText);
if i < Node.Arguments.Count - 1 then
if i < High(Node.Arguments) then
sb.Append(', ');
end;
sb.Append(')');
@@ -1405,9 +1405,9 @@ begin
end
else
begin
SetLength(inputExpressions, 1 + Node.Arguments.Count);
SetLength(inputExpressions, 1 + Length(Node.Arguments));
inputExpressions[0] := Node.Callee;
for var i := 0 to Node.Arguments.Count - 1 do
for var i := 0 to High(Node.Arguments) do
inputExpressions[i + 1] := Node.Arguments[i];
VisitOperatorNode(
@@ -1425,8 +1425,8 @@ begin
CreateEntry(funcCallNode);
calleePin := CreateInput(funcCallNode, 'Callee');
SetLength(argPin, Node.Arguments.Count);
for i := 0 to Node.Arguments.Count - 1 do
SetLength(argPin, Length(Node.Arguments));
for i := 0 to High(argPin) do
argPin[i] := CreateInput(funcCallNode, 'Arg' + i.ToString);
CreateExit(funcCallNode, '');
@@ -1434,7 +1434,7 @@ begin
if Assigned(InputResults[0].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[0].OutputPin, calleePin));
for i := 0 to Node.Arguments.Count - 1 do
for i := 0 to High(Node.Arguments) do
if Assigned(InputResults[i + 1].OutputPin) then
FConnections.Add(TPinConnection.Create(InputResults[i + 1].OutputPin, argPin[i]));
Src/AST/Myc.Ast.Evaluator.pas
+111 -454
View File
@@ -13,14 +13,29 @@ uses
Myc.Ast;
type
// A factory for creating visitors, primarily used by the debugger subsystem.
TVisitorFactory = reference to function(const Scope: IExecutionScope): IAstVisitor;
// The standard AST evaluator for production use.
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor)
private
FScope: IExecutionScope;
protected
function IsTruthy(const AValue: TDataValue): Boolean;
function CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; virtual;
// Returns a closure that can create the correct type of visitor for a lambda's body.
function GetVisitorFactory: 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);
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual;
@@ -39,38 +54,7 @@ type
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual;
end;
TDebugEvaluatorVisitor = class(TEvaluatorVisitor)
private
FLog: TStrings;
FIndentLevel: Integer;
FShowScope: Boolean;
procedure Indent;
procedure Unindent;
procedure AppendLine(const S: string);
procedure AppendMultiline(const S: string);
procedure ShowScope;
protected
function CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; override;
public
constructor Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0);
function VisitConstant(const Node: IConstantNode): TDataValue; override;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override;
function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override;
function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override;
function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override;
function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override;
function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override;
function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override;
function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override;
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override;
function VisitAssignment(const Node: IAssignmentNode): TDataValue; override;
function VisitIndexer(const Node: IIndexerNode): TDataValue; override;
function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override;
function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override;
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override;
function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override;
end;
// Registers native Delphi functions into a scope.
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
implementation
@@ -80,46 +64,8 @@ uses
System.Generics.Defaults,
Myc.Data.Decimal,
Myc.Data.Series,
Myc.Ast.Printer,
Myc.Data.Scalar.JSON;
type
TNativeFunction = function(const Args: TArray<TDataValue>): TDataValue;
TClosure = class(TInterfacedObject)
function GetArity: Integer; virtual; abstract;
function Invoke(
const AVisitor: IAstVisitor;
const ASelf: TDataValue;
const AArgNodes: TList<IAstNode>
): TDataValue; virtual; abstract;
end;
TClosureValue = class(TClosure)
private
FLambdaNode: ILambdaExpressionNode;
FClosureScope: IExecutionScope;
FUpvalues: TArray<IValueCell>;
public
constructor Create(
const ALambdaNode: ILambdaExpressionNode;
const AClosureScope: IExecutionScope;
const AUpvalues: TArray<IValueCell>
);
function GetArity: Integer; override;
function Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): TDataValue; override;
end;
TNativeClosure = class(TClosure)
private
FMethod: TNativeFunction;
FArity: Integer;
public
constructor Create(const AMethod: TNativeFunction; AArity: Integer);
function GetArity: Integer; override;
function Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): TDataValue; override;
end;
// --- Native Functions Implementation ---
function NativeCreateRecordSeries(const Args: TArray<TDataValue>): TDataValue;
@@ -128,9 +74,8 @@ var
recordDef: TScalarRecordDefinition;
series: TScalarRecordSeries;
begin
// Arity check is now done by the caller (TNativeClosure.Invoke)
if Args[0].Kind <> vkText then
raise EArgumentException.Create('CreateRecordSeries requires a string argument.');
if (Length(Args) <> 1) or (Args[0].Kind <> vkText) then
raise EArgumentException.Create('CreateRecordSeries requires one string argument.');
jsonDef := Args[0].AsText;
recordDef := TRttiAstHelper.JsonToRecordDefinition(jsonDef);
@@ -146,88 +91,7 @@ end;
procedure RegisterNativeFunctions(const AScope: IExecutionScope);
begin
// Use 'Define' to clearly state that we are adding a new variable
// to the global scope before the binder runs.
AScope.Define('CreateRecordSeries', TNativeClosure.Create(NativeCreateRecordSeries, 1));
end;
{ TClosureValue }
constructor TClosureValue.Create(
const ALambdaNode: ILambdaExpressionNode;
const AClosureScope: IExecutionScope;
const AUpvalues: TArray<IValueCell>
);
begin
inherited Create;
FLambdaNode := ALambdaNode;
FClosureScope := AClosureScope;
FUpvalues := AUpvalues;
end;
function TClosureValue.GetArity: Integer;
begin
Result := Length(FLambdaNode.Parameters);
end;
function TClosureValue.Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): TDataValue;
var
i: Integer;
descriptor: IScopeDescriptor;
callScope: IExecutionScope;
adr: TResolvedAddress;
begin
if (AArgNodes.Count <> GetArity) then
raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [GetArity, AArgNodes.Count]);
descriptor := FLambdaNode.ScopeDescriptor;
if not Assigned(descriptor) then
raise EParserError.Create('Lambda has no scope descriptor. Did the binder run?');
callScope := TExecutionScope.Create(FClosureScope, descriptor, FUpvalues);
adr.Kind := akLocalOrParent;
adr.ScopeDepth := 0;
adr.SlotIndex := 0;
callScope[adr].Value := ASelf;
for i := 0 to AArgNodes.Count - 1 do
begin
adr.SlotIndex := FLambdaNode.Parameters[i].Address.SlotIndex;
callScope[adr].Value := AArgNodes[i].Accept(AVisitor);
end;
Result := FLambdaNode.Body.Accept((AVisitor as TEvaluatorVisitor).CreateVisitorForScope(callScope));
end;
{ TNativeClosure }
constructor TNativeClosure.Create(const AMethod: TNativeFunction; AArity: Integer);
begin
inherited Create;
FMethod := AMethod;
FArity := AArity;
end;
function TNativeClosure.GetArity: Integer;
begin
Result := FArity;
end;
function TNativeClosure.Invoke(const AVisitor: IAstVisitor; const ASelf: TDataValue; const AArgNodes: TList<IAstNode>): TDataValue;
var
argValues: TArray<TDataValue>;
i: Integer;
begin
if (FArity <> -1) and (AArgNodes.Count <> FArity) then
raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [FArity, AArgNodes.Count]);
// Evaluate argument nodes to get values for the native function
SetLength(argValues, AArgNodes.Count);
for i := 0 to AArgNodes.Count - 1 do
argValues[i] := AArgNodes[i].Accept(AVisitor);
Result := FMethod(argValues);
AScope.Define('CreateRecordSeries', TDataValue(NativeCreateRecordSeries));
end;
{ TEvaluatorVisitor }
@@ -239,16 +103,18 @@ begin
FScope := AScope;
end;
function TEvaluatorVisitor.CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor;
function TEvaluatorVisitor.GetVisitorFactory: TVisitorFactory;
begin
Result := TEvaluatorVisitor.Create(AScope);
// The production visitor returns a factory that creates another production visitor.
Result := function(const AScope: IExecutionScope): IAstVisitor begin Result := TEvaluatorVisitor.Create(AScope); end;
end;
function TEvaluatorVisitor.IsTruthy(const AValue: TDataValue): Boolean;
begin
if (AValue.Kind <> vkScalar) then
begin
Exit(False);
Result := False;
exit;
end;
case AValue.AsScalar.Kind of
@@ -261,26 +127,102 @@ 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 := GetVisitorFactory();
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>;
i: Integer;
sourceAddresses: TArray<TResolvedAddress>;
closureScope: IExecutionScope;
begin
sourceAddresses := Node.Upvalues;
SetLength(capturedCells, Length(sourceAddresses));
for i := 0 to High(sourceAddresses) do
capturedCells[i] := FScope.GetCell(sourceAddresses[i]);
if Node.HasNestedLambdas then
closureScope := FScope
else
closureScope := nil;
Result := CreateLambdaClosure(Node, capturedCells, closureScope);
end;
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
var
calleeValue: TDataValue;
argValues: TArray<TDataValue>;
i: Integer;
begin
calleeValue := Node.Callee.Accept(Self);
// Check if the value holds an interface and if that interface supports our invocation contract.
if (calleeValue.Kind <> vkInterface) or not (calleeValue.AsInterface is TClosure) then
raise EArgumentException.Create('Expression is not invokable in this context.');
var argNodes := Node.Arguments;
SetLength(argValues, Length(argNodes));
for i := 0 to High(argNodes) do
argValues[i] := argNodes[i].Accept(Self);
// "Tell, Don't Ask": Simply tell the object to invoke itself.
Result := (calleeValue.AsInterface as TClosure).Invoke(Self, calleeValue, Node.Arguments);
if (calleeValue.Kind = vkMethod) then
Result := (calleeValue.AsMethod)(argValues)
else
raise EArgumentException.Create('Expression is not invokable in this context.');
end;
// ... The rest of the Visit... methods are unchanged and remain as they were ...
function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
var
itemValue, lookbackValue, seriesVar: TDataValue;
lookback: Int64;
begin
// The target series must have been resolved by the binder.
seriesVar := FScope[Node.Series.Address].Value;
itemValue := Node.Value.Accept(Self);
lookback := -1;
@@ -297,7 +239,6 @@ begin
lookback := lookbackValue.AsScalar.Value.AsInt64;
end;
// Dispatch based on series type
case seriesVar.Kind of
vkSeries:
begin
@@ -309,7 +250,6 @@ begin
if (itemValue.AsScalar.Kind <> Kind) then
raise EArgumentException
.CreateFmt('Type mismatch: Cannot add %s to a series of %s.', [itemValue.AsScalar.Kind.ToString, Kind.ToString]);
Items.Add(itemValue.AsScalar.Value, lookback);
end;
end;
@@ -326,7 +266,7 @@ begin
else
raise EArgumentException.Create('"add" operation is only supported for series types.');
end;
Result := TDataValue.Void; // 'add' is a procedure, returns void
Result := TDataValue.Void;
end;
function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
@@ -395,7 +335,6 @@ begin
begin
if (index < 0) or (index >= Items.TotalCount) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, Items.TotalCount]);
Result := TScalar.Create(Kind, Items[Integer(index)]);
end;
end;
@@ -404,7 +343,6 @@ begin
var series := baseValue.AsRecordSeries.Value;
if (index < 0) or (index >= series.TotalCount) then
raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, series.TotalCount]);
var recordValue := series.Items[Integer(index)];
Result := TDataValue.FromRecord(recordValue);
end;
@@ -414,7 +352,6 @@ begin
if (index < 0) or (index >= memberSeries.Count) then
raise EArgumentException
.CreateFmt('Index %d is out of bounds for member series with %d elements.', [index, memberSeries.Count]);
Result := memberSeries.Items[Integer(index)];
end;
else
@@ -466,22 +403,6 @@ begin
Result := value;
end;
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
var
capturedCells: TArray<IValueCell>;
i: Integer;
sourceAddresses: TArray<TResolvedAddress>;
begin
// The binder has identified the upvalues. Capture the cells from the current scope
// using the original source addresses provided by the binder.
sourceAddresses := Node.Upvalues;
SetLength(capturedCells, Length(sourceAddresses));
for i := 0 to High(sourceAddresses) do
capturedCells[i] := FScope.GetCell(sourceAddresses[i]);
Result := TClosureValue.Create(Node, FScope, capturedCells) as IInterface;
end;
function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
var
leftValue, rightValue: TDataValue;
@@ -499,18 +420,12 @@ begin
if (leftScalar.Kind <> rightScalar.Kind) then
begin
if (leftScalar.Kind = skInt64) and (rightScalar.Kind = skDouble) then
begin
leftScalar := TScalar.FromDouble(leftScalar.Value.AsInt64);
end
leftScalar := TScalar.FromDouble(leftScalar.Value.AsInt64)
else if (leftScalar.Kind = skDouble) and (rightScalar.Kind = skInt64) then
begin
rightScalar := TScalar.FromDouble(rightScalar.Value.AsInt64);
end
rightScalar := TScalar.FromDouble(rightScalar.Value.AsInt64)
else
begin
raise ENotSupportedException.Create(
'Binary operations are only supported for compatible types. ' + leftScalar.ToString + ' ' + rightScalar.ToString);
end;
end;
case leftScalar.Kind of
@@ -617,7 +532,6 @@ function TEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode
var
expression: IAstNode;
begin
// The result of a block is the result of its last expression.
Result := TDataValue.Void;
for expression in Node.Expressions do
begin
@@ -630,7 +544,7 @@ var
seriesValue: TDataValue;
len: Int64;
begin
seriesValue := Node.Series.Accept(Self);
seriesValue := FScope[Node.Series.Address].Value;
case seriesValue.Kind of
vkSeries: len := seriesValue.AsSeries.Value.Items.Count;
@@ -643,261 +557,4 @@ begin
Result := TScalar.FromInt64(len);
end;
{ TDebugEvaluatorVisitor }
constructor TDebugEvaluatorVisitor.Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer);
begin
inherited Create(AScope);
Assert(Assigned(ALog));
FLog := ALog;
FIndentLevel := AInitialIndent;
FShowScope := AShowScope;
ShowScope;
end;
function TDebugEvaluatorVisitor.CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor;
begin
Result := TDebugEvaluatorVisitor.Create(AScope, FLog, FShowScope, FIndentLevel);
end;
procedure TDebugEvaluatorVisitor.Indent;
begin
inc(FIndentLevel);
end;
procedure TDebugEvaluatorVisitor.Unindent;
begin
dec(FIndentLevel);
end;
procedure TDebugEvaluatorVisitor.AppendLine(const S: string);
var
pad: string;
i: Integer;
begin
pad := '';
for i := 0 to FIndentLevel - 1 do
begin
pad := pad + ':' + ''.PadLeft(3);
end;
FLog.Add(pad + S);
end;
procedure TDebugEvaluatorVisitor.AppendMultiline(const S: string);
begin
var Str := TStringList.Create;
try
Str.Text := s;
for var i := 0 to Str.Count - 1 do
AppendLine(Str[i]);
finally
Str.Free;
end;
end;
procedure TDebugEvaluatorVisitor.ShowScope;
var
scopeDump: TArray<string>;
line: string;
begin
if FShowScope then
begin
AppendLine('-- Scope --');
scopeDump := FScope.Dump.Split([sLineBreak]);
for line in scopeDump do
begin
AppendLine(line);
end;
AppendLine('-----------');
end;
end;
function TDebugEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
AppendLine('AddSeriesItem {');
Indent;
try
Result := inherited VisitAddSeriesItem(Node);
finally
Unindent;
end;
AppendLine('} -> (void)');
end;
function TDebugEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
AppendLine(Format('Assignment to "%s" {', [Node.Identifier.Name]));
Indent;
try
Result := inherited VisitAssignment(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue;
begin
AppendLine(Format('Constant (%s)', [Node.Value.ToString]));
Result := inherited VisitConstant(Node);
end;
function TDebugEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue;
begin
AppendLine('CreateSeries {');
Indent;
try
Result := inherited VisitCreateSeries(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
begin
Result := inherited VisitIdentifier(Node);
AppendLine(Format('Identifier "%s" -> %s', [Node.Name, Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
AppendLine(Format('BinaryExpr "%s" {', [Node.Operator.ToString]));
Indent;
try
Result := inherited VisitBinaryExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
AppendLine(Format('UnaryExpr "%s" {', [Node.Operator.ToString]));
Indent;
try
Result := inherited VisitUnaryExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
AppendLine('IfExpr{');
Indent;
try
Result := inherited VisitIfExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
AppendLine('Indexer {');
Indent;
try
Result := inherited VisitIndexer(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
AppendLine(Format('MemberAccess (Member: %s) {', [Node.Member.Name]));
Indent;
try
Result := inherited VisitMemberAccess(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
AppendLine('TernaryExpr{');
Indent;
try
Result := inherited VisitTernaryExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
begin
AppendLine('LambdaExpr{');
Indent;
try
var pp: IAstVisitor := TPrettyPrintVisitor.Create(0);
pp.VisitLambdaExpression(Node);
AppendMultiline((pp as TPrettyPrintVisitor).GetResult);
ShowScope;
Result := inherited VisitLambdaExpression(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue;
begin
AppendLine('FunctionCall{');
Indent;
try
ShowScope;
Result := inherited VisitFunctionCall(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
begin
AppendLine('Block{');
Indent;
try
Result := inherited VisitBlockExpression(Node);
ShowScope;
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
function TDebugEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
AppendLine(Format('VarDecl %s :=', [Node.Identifier.Name]));
Indent;
try
Result := inherited VisitVariableDeclaration(Node);
finally
Unindent;
end;
end;
function TDebugEvaluatorVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
AppendLine('SeriesLength {');
Indent;
try
Result := inherited VisitSeriesLength(Node);
finally
Unindent;
end;
AppendLine(Format('} -> %s', [Result.ToString]));
end;
end.
Src/AST/Myc.Ast.JSON.pas
+1 -1
View File
@@ -297,7 +297,7 @@ begin
for arg in Node.Arguments do
arg.Accept(Self);
SetLength(tempArgs, Node.Arguments.Count);
SetLength(tempArgs, Length(Node.Arguments));
for i := High(tempArgs) downto 0 do
tempArgs[i] := FJsonObjectStack.Pop;
Src/AST/Myc.Ast.Nodes.pas
+4 -2
View File
@@ -182,20 +182,22 @@ type
function GetBody: IAstNode;
function GetScopeDescriptor: IScopeDescriptor;
function GetUpvalues: TArray<TResolvedAddress>;
function GetHasNestedLambdas: Boolean;
{$endregion}
property Parameters: TArray<IIdentifierNode> read GetParameters;
property Body: IAstNode read GetBody;
property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor;
property Upvalues: TArray<TResolvedAddress> read GetUpvalues;
property HasNestedLambdas: Boolean read GetHasNestedLambdas;
end;
IFunctionCallNode = interface(IAstNode)
{$region 'private'}
function GetCallee: IAstNode;
function GetArguments: TList<IAstNode>;
function GetArguments: TArray<IAstNode>;
{$endregion}
property Callee: IAstNode read GetCallee;
property Arguments: TList<IAstNode> read GetArguments;
property Arguments: TArray<IAstNode> read GetArguments;
end;
IBlockExpressionNode = interface(IAstNode)
Src/AST/Myc.Ast.Scope.pas
+3 -3
View File
@@ -43,9 +43,9 @@ uses
type
TValueCell = class(TInterfacedObject, IValueCell)
private
FValue: TDataValue; // <-- Changed from TAstValue
function GetValue: TDataValue; // <-- Changed from TAstValue
procedure SetValue(const AValue: TDataValue); // <-- Changed from TAstValue
FValue: TDataValue;
function GetValue: TDataValue;
procedure SetValue(const AValue: TDataValue);
end;
{ TValueCell }
Src/AST/Myc.Ast.pas
+83 -41
View File
@@ -23,7 +23,7 @@ type
class function IfExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): IIfExpressionNode; static;
class function TernaryExpr(const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode): ITernaryExpressionNode; static;
class function LambdaExpr(const AParameters: TArray<IIdentifierNode>; const ABody: IAstNode): ILambdaExpressionNode; static;
class function FunctionCall(const ACallee: IAstNode; const AArguments: array of IAstNode): IFunctionCallNode; static;
class function FunctionCall(const ACallee: IAstNode; const AArguments: TArray<IAstNode>): IFunctionCallNode; static;
class function Block(const AExpressions: array of IAstNode): IBlockExpressionNode; static;
class function VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IAstNode): IVariableDeclarationNode; static;
class function Assign(const AIdentifier: IIdentifierNode; const AValue: IAstNode): IAssignmentNode; static;
@@ -44,6 +44,10 @@ type
// TAstTraverser provides a default AST traversal implementation.
TAstTraverser = class abstract(TInterfacedObject, IAstVisitor)
private
FDone: Boolean;
protected
property Done: Boolean read FDone write FDone;
public
function VisitConstant(const Node: IConstantNode): TDataValue; virtual;
function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual;
@@ -179,13 +183,16 @@ type
FBody: IAstNode;
FScopeDescriptor: IScopeDescriptor;
FUpvalues: TArray<TResolvedAddress>;
FHasNestedLambdas: Boolean;
function GetParameters: TArray<IIdentifierNode>;
function GetBody: IAstNode;
function GetScopeDescriptor: IScopeDescriptor;
function GetUpvalues: TArray<TResolvedAddress>;
function GetHasNestedLambdas: Boolean;
public
constructor Create(const AParameters: TArray<IIdentifierNode>; const ABody: IAstNode);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
property HasNestedLambdas: Boolean read FHasNestedLambdas write FHasNestedLambdas;
property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor;
end;
@@ -193,12 +200,11 @@ type
TFunctionCallNode = class(TAstNode, IFunctionCallNode)
private
FCallee: IAstNode;
FArguments: TList<IAstNode>;
FArguments: TArray<IAstNode>;
function GetCallee: IAstNode;
function GetArguments: TList<IAstNode>;
function GetArguments: TArray<IAstNode>;
public
constructor Create(const ACallee: IAstNode; const AArguments: array of IAstNode);
destructor Destroy; override;
constructor Create(const ACallee: IAstNode; const AArguments: TArray<IAstNode>);
function Accept(const Visitor: IAstVisitor): TDataValue; override;
end;
@@ -308,6 +314,7 @@ type
FCurrentDescriptor: IScopeDescriptor;
FUpvalueMapStack: TStack<TDictionary<TResolvedAddress, Integer>>;
FUpvalueNodesStack: TStack<TList<IIdentifierNode>>;
FNestedLambdaCount: Integer;
procedure EnterScope;
procedure ExitScope;
public
@@ -587,6 +594,11 @@ begin
Result := FBody;
end;
function TLambdaExpressionNode.GetHasNestedLambdas: Boolean;
begin
Result := FHasNestedLambdas;
end;
function TLambdaExpressionNode.GetParameters: TArray<IIdentifierNode>;
begin
Result := FParameters;
@@ -599,21 +611,11 @@ end;
{ TFunctionCallNode }
constructor TFunctionCallNode.Create(const ACallee: IAstNode; const AArguments: array of IAstNode);
var
arg: IAstNode;
constructor TFunctionCallNode.Create(const ACallee: IAstNode; const AArguments: TArray<IAstNode>);
begin
inherited Create;
FCallee := ACallee;
FArguments := TList<IAstNode>.Create;
for arg in AArguments do
FArguments.Add(arg);
end;
destructor TFunctionCallNode.Destroy;
begin
FArguments.Free;
inherited;
FArguments := AArguments;
end;
function TFunctionCallNode.Accept(const Visitor: IAstVisitor): TDataValue;
@@ -621,7 +623,7 @@ begin
Result := Visitor.VisitFunctionCall(Self);
end;
function TFunctionCallNode.GetArguments: TList<IAstNode>;
function TFunctionCallNode.GetArguments: TArray<IAstNode>;
begin
Result := FArguments;
end;
@@ -829,6 +831,7 @@ begin
FCurrentDescriptor := TAst.CreateDescriptor(AInitialScope);
FUpvalueMapStack := TStack<TDictionary<TResolvedAddress, Integer>>.Create;
FUpvalueNodesStack := TStack<TList<IIdentifierNode>>.Create;
FNestedLambdaCount := 0;
end;
destructor TBinder.Destroy;
@@ -913,8 +916,11 @@ begin
for param in Node.Parameters do
(FCurrentDescriptor as TScopeDescriptor).Define(param.Name);
var lastNestedLambdaCount := FNestedLambdaCount;
inherited VisitLambdaExpression(Node);
(Node as TLambdaExpressionNode).HasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount;
(Node as TLambdaExpressionNode).FScopeDescriptor := FCurrentDescriptor;
finally
ExitScope;
@@ -941,6 +947,8 @@ begin
upvalueMap.Free;
upvalueNodes.Free;
inc(FNestedLambdaCount);
end;
end;
@@ -1027,7 +1035,7 @@ begin
Result := TScopeDescriptor.Create(nil);
end;
class function TAst.FunctionCall(const ACallee: IAstNode; const AArguments: array of IAstNode): IFunctionCallNode;
class function TAst.FunctionCall(const ACallee: IAstNode; const AArguments: TArray<IAstNode>): IFunctionCallNode;
begin
Result := TFunctionCallNode.Create(ACallee, AArguments);
end;
@@ -1081,22 +1089,29 @@ end;
function TAstTraverser.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
begin
Node.Series.Accept(Self);
Node.Value.Accept(Self);
if not FDone then
Node.Series.Accept(Self);
if not FDone then
Node.Value.Accept(Self);
if Assigned(Node.Lookback) then
Node.Lookback.Accept(Self);
if not FDone then
Node.Lookback.Accept(Self);
end;
function TAstTraverser.VisitAssignment(const Node: IAssignmentNode): TDataValue;
begin
Node.Value.Accept(Self);
Node.Identifier.Accept(Self);
if not FDone then
Node.Value.Accept(Self);
if not FDone then
Node.Identifier.Accept(Self);
end;
function TAstTraverser.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue;
begin
Node.Left.Accept(Self);
Node.Right.Accept(Self);
if not FDone then
Node.Left.Accept(Self);
if not FDone then
Node.Right.Accept(Self);
end;
function TAstTraverser.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue;
@@ -1104,7 +1119,11 @@ var
expr: IAstNode;
begin
for expr in Node.Expressions do
begin
if FDone then
break;
expr.Accept(Self);
end;
end;
function TAstTraverser.VisitConstant(const Node: IConstantNode): TDataValue;
@@ -1119,9 +1138,14 @@ function TAstTraverser.VisitFunctionCall(const Node: IFunctionCallNode): TDataVa
var
arg: IAstNode;
begin
Node.Callee.Accept(Self);
if not FDone then
Node.Callee.Accept(Self);
for arg in Node.Arguments do
begin
if FDone then
break;
arg.Accept(Self);
end;
end;
function TAstTraverser.VisitIdentifier(const Node: IIdentifierNode): TDataValue;
@@ -1130,16 +1154,21 @@ end;
function TAstTraverser.VisitIfExpression(const Node: IIfExpressionNode): TDataValue;
begin
Node.Condition.Accept(Self);
Node.ThenBranch.Accept(Self);
if not FDone then
Node.Condition.Accept(Self);
if not FDone then
Node.ThenBranch.Accept(Self);
if Assigned(Node.ElseBranch) then
Node.ElseBranch.Accept(Self);
if not FDone then
Node.ElseBranch.Accept(Self);
end;
function TAstTraverser.VisitIndexer(const Node: IIndexerNode): TDataValue;
begin
Node.Base.Accept(Self);
Node.Index.Accept(Self);
if not FDone then
Node.Base.Accept(Self);
if not FDone then
Node.Index.Accept(Self);
end;
function TAstTraverser.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
@@ -1147,38 +1176,51 @@ var
param: IIdentifierNode;
begin
for param in Node.Parameters do
begin
if FDone then
break;
param.Accept(Self);
Node.Body.Accept(Self);
end;
if not FDone then
Node.Body.Accept(Self);
end;
function TAstTraverser.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue;
begin
// Do not visit the member identifier, as it's not a variable in the current scope.
Node.Base.Accept(Self);
if not FDone then
Node.Base.Accept(Self);
end;
function TAstTraverser.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue;
begin
Node.Series.Accept(Self);
if not FDone then
Node.Series.Accept(Self);
end;
function TAstTraverser.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue;
begin
Node.Condition.Accept(Self);
Node.ThenBranch.Accept(Self);
Node.ElseBranch.Accept(Self);
if not FDone then
Node.Condition.Accept(Self);
if not FDone then
Node.ThenBranch.Accept(Self);
if not FDone then
Node.ElseBranch.Accept(Self);
end;
function TAstTraverser.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue;
begin
Node.Right.Accept(Self);
if not FDone then
Node.Right.Accept(Self);
end;
function TAstTraverser.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
begin
if Assigned(Node.Initializer) then
Node.Initializer.Accept(Self);
Node.Identifier.Accept(Self);
if not FDone then
Node.Initializer.Accept(Self);
if not FDone then
Node.Identifier.Accept(Self);
end;
end.
Src/Data/Myc.Data.Value.pas
+28 -14
View File
@@ -8,7 +8,7 @@ uses
Myc.Data.Series;
type
TDataValueKind = (vkVoid, vkScalar, vkInterface, vkText, vkSeries, vkRecordSeries, vkRecord, vkMemberSeries, vkGeneric);
TDataValueKind = (vkVoid, vkScalar, vkInterface, vkText, vkSeries, vkRecordSeries, vkRecord, vkMemberSeries, vkGeneric, vkMethod);
TDataValue = record
public
@@ -17,6 +17,9 @@ type
Value: T;
constructor Create(const AValue: T);
end;
TFunc = reference to function(const ArgNodes: TArray<TDataValue>): TDataValue;
private
var
FKind: TDataValueKind;
@@ -30,7 +33,7 @@ type
class operator Implicit(const AValue: TScalar): TDataValue; overload; inline;
class operator Implicit(const AValue: String): TDataValue; overload; inline;
class operator Implicit(const AValue: IInterface): TDataValue; overload; inline;
class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline;
class function From<T: record>(const [ref] AValue: T): TDataValue; static; inline;
function AsVal<T: record>: TVal<T>; inline;
@@ -39,9 +42,11 @@ type
class function FromRecordSeries(const [ref] AValue: TScalarRecordSeries): TDataValue; static; inline;
class function FromRecord(const [ref] AValue: TScalarRecord): TDataValue; static; inline;
class function FromMemberSeries(const [ref] AValue: TScalarMemberSeries): TDataValue; static; inline;
class function FromInterface(const [ref] AValue: IInterface): TDataValue; static; inline;
function AsScalar: TScalar; inline;
function AsInterface: IInterface; inline;
function AsMethod: TFunc; inline;
function AsText: String; inline;
function AsRecordSeries: TVal<TScalarRecordSeries>; inline;
function AsRecord: TVal<TScalarRecord>; inline;
@@ -90,6 +95,13 @@ begin
Result := TVal<TScalarMemberSeries>(FInterface);
end;
function TDataValue.AsMethod: TFunc;
begin
if (FKind <> vkMethod) then
raise EInvalidCast.Create('Cannot read value as a method.');
Result := TFunc(FInterface);
end;
function TDataValue.AsVal<T>: TVal<T>;
begin
if (FKind <> vkGeneric) then
@@ -138,39 +150,34 @@ begin
Result.FInterface := TVal<T>.Create(AValue);
end;
class function TDataValue.FromInterface(const [ref] AValue: IInterface): TDataValue;
begin
Result.FKind := vkInterface;
Result.FInterface := AValue;
end;
class function TDataValue.FromMemberSeries(const [ref] AValue: TScalarMemberSeries): TDataValue;
begin
Result.FKind := vkMemberSeries;
Result.FInterface := TVal<TScalarMemberSeries>.Create(AValue);
Result.FScalar := Default(TScalar);
end;
class function TDataValue.FromRecord(const [ref] AValue: TScalarRecord): TDataValue;
begin
Result.FKind := vkRecord;
Result.FInterface := TVal<TScalarRecord>.Create(AValue);
Result.FScalar := Default(TScalar);
end;
class function TDataValue.FromRecordSeries(const [ref] AValue: TScalarRecordSeries): TDataValue;
begin
Result.FKind := vkRecordSeries;
Result.FInterface := TVal<TScalarRecordSeries>.Create(AValue);
Result.FScalar := Default(TScalar);
end;
class function TDataValue.FromSeries(const [ref] AValue: TScalarSeries): TDataValue;
begin
Result.FKind := vkSeries;
Result.FInterface := TVal<TScalarSeries>.Create(AValue);
Result.FScalar := Default(TScalar);
end;
class operator TDataValue.Implicit(const AValue: IInterface): TDataValue;
begin
Result.FKind := vkInterface;
Result.FInterface := AValue;
Result.FScalar := Default(TScalar);
end;
class operator TDataValue.Implicit(const AValue: TScalar): TDataValue;
@@ -184,7 +191,6 @@ class operator TDataValue.Implicit(const AValue: String): TDataValue;
begin
Result.FKind := vkText;
Result.FInterface := TVal<String>.Create(AValue);
Result.FScalar := Default(TScalar);
end;
function TDataValue.GetIsVoid: Boolean;
@@ -214,6 +220,8 @@ begin
vkRecord: Result := '<record>';
vkMemberSeries: Result := '<member_series>';
vkVoid: Result := '<void>';
vkMethod: Result := '<method>';
vkGeneric: Result := '<generic>';
else
Result := '[Unknown DataValue]';
end;
@@ -224,4 +232,10 @@ begin
Result := Default(TDataValue);
end;
class operator TDataValue.Implicit(const AValue: TDataValue.TFunc): TDataValue;
begin
Result.FKind := vkMethod;
TFunc(Result.FInterface) := AValue;
end;
end.