Ast environments

This commit is contained in:
Michael Schimmel
2025-11-07 19:40:35 +01:00
parent 4ccf3bb5fd
commit c0f871ce02
12 changed files with 722 additions and 364 deletions
File diff suppressed because one or more lines are too long
+2 -1
View File
@@ -25,7 +25,8 @@ uses
Myc.Ast.Compiler.Binder in '..\Src\AST\Myc.Ast.Compiler.Binder.pas',
Myc.Ast.Compiler.Lowering in '..\Src\AST\Myc.Ast.Compiler.Lowering.pas',
Myc.Ast.Compiler.TypeChecker in '..\Src\AST\Myc.Ast.Compiler.TypeChecker.pas',
Myc.Ast.Compiler.Macros in '..\Src\AST\Myc.Ast.Compiler.Macros.pas';
Myc.Ast.Compiler.Macros in '..\Src\AST\Myc.Ast.Compiler.Macros.pas',
Myc.Ast.Environment in '..\Src\AST\Myc.Ast.Environment.pas';
{$R *.res}
+1
View File
@@ -156,6 +156,7 @@
<DCCReference Include="..\Src\AST\Myc.Ast.Compiler.Lowering.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Compiler.TypeChecker.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Compiler.Macros.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Environment.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
+1
View File
@@ -111,6 +111,7 @@ object Form1: TForm1
Position.Y = 439.000000000000000000
TabOrder = 14
Text = 'Debug'
OnChange = DebugBoxChange
end
object FromJSONButton: TButton
Position.X = 24.000000000000000000
+199 -260
View File
@@ -28,26 +28,18 @@ uses
Myc.Ast.Scope,
Myc.Ast,
Myc.Ast.Visitor,
Myc.Ast.Evaluator,
Myc.Ast.Dumper,
Myc.Data.Decimal,
Myc.Ast.RTL,
Myc.Ast.Script,
FMX.Layouts,
FMX.Objects,
Myc.Ast.Debugger,
Myc.Fmx.AstEditor.Node,
Myc.Fmx.AstEditor.Workspace,
Myc.Ast.Compiler.Macros,
Myc.Ast.Compiler.Binder,
Myc.Ast.Compiler.TypeChecker,
Myc.Ast.Compiler.Lowering,
Myc.Ast.Compiler.TCO,
FMX.DialogService,
FMX.ListView.Types,
FMX.ListView.Appearances,
FMX.ListView.Adapters.Base,
FMX.ListView;
FMX.ListView,
Myc.Ast.Environment; // Added Environment
type
// A test record
@@ -94,6 +86,7 @@ type
procedure ClearButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CreateTriggerExampleButtonClick(Sender: TObject);
procedure DebugBoxChange(Sender: TObject);
procedure DoTrigger2ButtonClick(Sender: TObject);
procedure DoTriggerButtonClick(Sender: TObject);
procedure DumpButtonClick(Sender: TObject);
@@ -116,18 +109,16 @@ type
procedure RTLListViewChange(Sender: TObject);
private
FCurrUnboundAst: IAstNode;
FCurrAst: IAstNode;
FCurrDesc: IScopeDescriptor;
FGScope: IExecutionScope;
FCurrExec: IExecutable; // Replaced FCurrAst and FCurrDesc
FEnvironment: TAstEnvironment;
FWorkspace: TAuraWorkspace;
FTriggerScope: IExecutionScope;
FScriptUpdate: Boolean;
FTriggerTest: TAstEnvironment;
procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
function CreateEvaluator(const Scope: IExecutionScope): IEvaluatorVisitor;
// Helper function to encapsulate the compilation pipeline
function CompileAst(const ANode: IAstNode; const AParentScope: IExecutionScope; out ADescriptor: IScopeDescriptor): IAstNode;
function CreateEnvironment: TAstEnvironment;
// Helper function to encapsulate the Compile -> Evaluate pattern
function ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
function ExecuteAst(const ANode: IAstNode): TDataValue;
procedure UpdateScript;
procedure ShowVizualization(X, Y: Single);
procedure PrintScript(const Node: IAstNode);
@@ -149,7 +140,10 @@ uses
System.TimeSpan,
Myc.Ast.Json, // For TAstJson serialization
Myc.Ast.Types, // Needed for TTypeRules
System.IOUtils; // For TFile
System.IOUtils, // For TFile
Myc.Ast.Dumper, // Needed for DumpButtonClick
Myc.Ast.RTL,
Myc.Ast.Compiler.Macros; // Needed for MacroRegistry access
{$R *.fmx}
@@ -199,7 +193,7 @@ begin
]
);
resultValue := ExecuteAst(mainBlock, FGScope);
resultValue := ExecuteAst(mainBlock);
Assert(TScalar.FromInt64(15) = resultValue.AsScalar, 'The final result should be 15, but is ' + resultValue.AsScalar.ToString);
UpdateScript;
@@ -209,67 +203,64 @@ procedure TForm1.ClearButtonClick(Sender: TObject);
begin
FWorkspace.DeleteChildren;
FWorkspace.Repaint;
FGScope := TAst.CreateScope(nil);
end;
function TForm1.CompileAst(const ANode: IAstNode; const AParentScope: IExecutionScope; out ADescriptor: IScopeDescriptor): IAstNode;
var
expandedAst, boundAst, typedAst, loweredAst: IAstNode;
function TForm1.CreateEnvironment: TAstEnvironment;
begin
// Step 1: Expand macros (Phase 1)
expandedAst := TMacroExpander.ExpandMacros(AParentScope, ANode, CreateEvaluator);
// Step 2: Bind names and addresses (Phase 2)
boundAst := TAstBinder.Bind(AParentScope, expandedAst, ADescriptor);
// Step 3: Check and infer types (Phase 3)
typedAst := TTypeChecker.CheckTypes(boundAst, ADescriptor);
// Step 4: Lowering / Canonicalization (Phase 4)
loweredAst := TAstLowerer.Lower(typedAst);
// Step 5: Tail Call Optimization (Phase 5)
Result := TAstTCO.Optimize(loweredAst);
if DebugBox.IsChecked then
Result.SetDebugMode(Memo1.Lines, ShowScopeBox.IsChecked)
else
Result.SetStandardMode;
end;
function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue;
var
descriptor: IScopeDescriptor;
evalScope: IExecutionScope;
visitor: IEvaluatorVisitor;
compiledAst: IAstNode;
// Simplified ExecuteAst using TEnvironment
function TForm1.ExecuteAst(const ANode: IAstNode): TDataValue;
begin
FCurrUnboundAst := ANode;
FCurrExec := nil; // Clear previous
// Call the helper function for the full 4-stage pipeline
compiledAst := CompileAst(ANode, AParentScope, descriptor);
// 1. Set strategy based on UI
if DebugBox.IsChecked then
FEnvironment.SetDebugMode(Memo1.Lines, ShowScopeBox.IsChecked)
else
FEnvironment.SetStandardMode;
// Store the final bound AST for visualization and debugging.
FCurrAst := compiledAst; // <-- Store the fully compiled AST
FCurrDesc := descriptor;
try
// 2. Compile (Pipeline is inside Environment)
// We store the executable artifact in the form
FCurrExec := FEnvironment.Compile(ANode);
// Create the final scope and evaluator for runtime execution.
evalScope := descriptor.CreateScope(AParentScope);
visitor := CreateEvaluator(evalScope);
Result := visitor.Execute(compiledAst);
// 3. Execute
Result := FEnvironment.Execute(FCurrExec);
except
on E: Exception do
begin
Memo1.Lines.Add('--- ERROR ---');
Memo1.Lines.Add(E.ClassName + ': ' + E.Message);
Result := TDataValue.Void;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FEnvironment := CreateEnvironment;
FWorkspace := TAuraWorkspace.Create(Panel2);
FWorkspace.Parent := Panel2;
FWorkspace.Align := TAlignLayout.Client;
FWorkspace.ClipChildren := true;
FWorkspace.OnMouseDown := WorkspaceMouseDown;
TAst.RegisterLibrary(
RegisterRtlFunctions(FEnvironment.RootScope);
// Register the SMA factory into the environment
var RegFunc :=
procedure(const Scope: IExecutionScope)
var
smaAst, typedAst: IAstNode;
smaDescriptor: IScopeDescriptor;
smaScope: IExecutionScope;
smaVisitor: IEvaluatorVisitor;
smaAst: IAstNode;
smaExec: IExecutable;
begin
smaAst :=
TAst.LambdaExpr(
@@ -322,14 +313,15 @@ begin
)
);
// Run the full pipeline
typedAst := CompileAst(smaAst, Scope, smaDescriptor);
// Compile the SMA factory using the environment itself
// Note: We pass FEnvironment.RootScope as the parent scope
smaExec := FEnvironment.Compile(smaAst);
smaScope := smaDescriptor.CreateScope(Scope);
smaVisitor := CreateEvaluator(smaScope);
// Execute the compiled AST to define the 'CreateSMA' function in the target scope
// We must use the *target* scope (Scope) as the parent for execution.
var smaFactory := FEnvironment.Execute(smaExec);
// Execute the typed AST to define the function
smaVisitor.Execute(typedAst);
Scope.Define('CreateSMA', smaFactory); // Define the factory
Scope.Define(
'print',
@@ -360,22 +352,24 @@ begin
Result := TStopwatch.GetTimeStamp div TTimeSpan.TicksPerMillisecond;
end
);
end;
TMacroExpander.GlobalMacroRegistry.Define(
TAstScript
.Parse(
'''
(defmacro stopwatch [body]
`(do
(def start-time (timestamp))
(def result ~body)
(print "Stopwatch: " (- (timestamp) start-time) "ms" )
result
))
''')
.AsMacroDefinition
);
end
RegFunc(FEnvironment.RootScope);
// Register the 'stopwatch' macro into the global registry
FEnvironment.MacroRegistry.Define(
TAstScript
.Parse(
'''
(defmacro stopwatch [body]
`(do
(def start-time (timestamp))
(def result ~body)
(print "(calculated in " (- (timestamp) start-time) " ms)" )
result
))
''')
.AsMacroDefinition
);
ClearButtonClick(Self);
@@ -406,7 +400,7 @@ begin
try
Memo1.Lines.Add(Format('--- Loading User Library from %s ---', [ExtractFileName(UserLibName)]));
var scopeDescr := FGScope.CreateDescriptor;
var scopeDescr := FEnvironment.RootScope.CreateDescriptor;
// Populate the list view with loaded functions and macros.
RTLListView.Items.BeginUpdate;
try
@@ -424,15 +418,15 @@ begin
// Distinguish between loading a macro and loading a function.
if funcAst.Kind = akMacroDefinition then
begin
// Macros are stored as raw AST nodes in the scope.
FGScope.Define(pair.JsonString.Value, TDataValue.FromIntf<IAstNode>(funcAst));
// Macros are stored in the *global compile-time registry*.
FEnvironment.MacroRegistry.Define(funcAst.AsMacroDefinition);
Memo1.Lines.Add(Format('Defined macro "%s"', [pair.JsonString.Value]));
end
else
begin
// Functions (lambdas) must be executed to create a callable closure.
funcValue := ExecuteAst(funcAst, FGScope);
FGScope.Define(pair.JsonString.Value, funcValue);
funcValue := ExecuteAst(funcAst);
FEnvironment.RootScope.Define(pair.JsonString.Value, funcValue);
Memo1.Lines.Add(Format('Defined function "%s"', [pair.JsonString.Value]));
end;
end
@@ -602,8 +596,14 @@ begin
try
var unboundAst := converter.Deserialize(jsonObj);
// Set strategy based on UI
if DebugBox.IsChecked then
FEnvironment.SetDebugMode(Memo1.Lines, ShowScopeBox.IsChecked)
else
FEnvironment.SetStandardMode;
// Run the full pipeline
FCurrAst := CompileAst(unboundAst, FGScope, FCurrDesc);
FCurrExec := FEnvironment.Compile(unboundAst);
Memo1.Lines.Add('AST deserialized and bound successfully from JSON.');
Memo1.Lines.Add('You can now visualize it (Middle Mouse Click) or pretty-print it.');
@@ -613,8 +613,7 @@ begin
except
on E: Exception do
begin
FCurrAst := nil;
FCurrDesc := nil;
FCurrExec := nil;
Memo1.Lines.Add('Error deserializing AST from JSON:');
Memo1.Lines.Add(E.Message);
Memo1.Lines.Add('--- Original JSON ---');
@@ -634,7 +633,7 @@ var
begin
Memo1.Lines.Clear;
if not Assigned(FCurrAst) then
if not Assigned(FCurrExec) then
begin
Memo1.Lines.Add('No AST available to serialize. Please generate one first.');
exit;
@@ -642,7 +641,7 @@ begin
try
converter := TJsonAstConverter.Create;
jsonObj := converter.Serialize(FCurrAst);
jsonObj := converter.Serialize(FCurrExec.CompiledAst);
try
Memo1.Lines.Text := jsonObj.Format(4);
finally
@@ -658,92 +657,74 @@ begin
end;
procedure TForm1.DumpButtonClick(Sender: TObject);
var
typedNode: IAstNode;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- AST Dump ---');
if not Assigned(FCurrUnboundAst) then
if not Assigned(FCurrExec) then // Check FCurrExec
begin
Memo1.Lines.Add('No AST has been generated yet. Click a test button first.');
Memo1.Lines.Add('No *compiled* AST has been generated yet. Click a test button first.');
exit;
end;
// Re-run the full pipeline for the dump
typedNode := CompileAst(FCurrUnboundAst, FGScope, FCurrDesc);
TAstDumper.Dump(typedNode, Memo1.Lines);
// Dump the compiled AST from the executable
TAstDumper.Dump(FCurrExec.CompiledAst, Memo1.Lines);
end;
procedure TForm1.FibonacciButtonClick(Sender: TObject);
var
root, fibAst, typedAst: IAstNode;
result: TDataValue;
sw: TStopwatch;
fibScope: IExecutionScope;
visitor: IEvaluatorVisitor;
desc: IScopeDescriptor;
fibDataValue: TDataValue;
begin
fibAst :=
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('fib')),
TAst.Assign(
TAst.Identifier('fib'),
TAst.LambdaExpr(
[TAst.Identifier('n')],
TAst.TernaryExpr(
TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Less, TAst.Constant(2)),
TAst.Identifier('n'),
TAst.BinaryExpr(
TAst.FunctionCall(
TAst.Identifier('fib'),
[TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1))]
),
TScalar.TBinaryOp.Add,
TAst.FunctionCall(
TAst.Identifier('fib'),
[TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(2))]
)
)
)
)
)
]
Memo1.Lines.Clear;
FCurrUnboundAst :=
TAstScript.Parse(
'''
(do
(def fib)
(assign fib (fn [n]
(? (< n 2)
n
(+ (fib (- n 1)) (fib (- n 2)))
)
))
)
'''
);
// Run the full pipeline
typedAst := CompileAst(fibAst, FGScope, desc);
fibScope := desc.CreateScope(FGScope);
var TestEnv := FEnvironment.CreateEnvironment;
visitor := CreateEvaluator(fibScope);
visitor.Execute(typedAst);
TestEnv.Define('fib', TAst.Block(FCurrUnboundAst));
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Naive recursive fib with AST---');
sw := TStopwatch.StartNew;
root := TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]);
result := ExecuteAst(root, fibScope);
var fibExec := TestEnv.Compile(TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]));
sw := TStopwatch.StartNew;
result := TestEnv.Execute(fibExec);
sw.Stop;
Memo1.Lines.Add(Format('Result: fib(25) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
Memo1.Lines.Add('');
Memo1.Lines.Add('--- Memoized naive fib with AST (using global fib)---');
var memoizeTest := TestEnv.CreateEnvironment;
memoizeTest.Define('fib', TAstScript.Parse('(Memoize fib)'));
var memoizeExec := memoizeTest.Compile(TAstScript.Parse('(fib 25)'));
sw := TStopwatch.StartNew;
root :=
TAst.Block(
[
TAst.Assign(TAst.Identifier('fib'), TAst.FunctionCall(TAst.Identifier('Memoize'), [TAst.Identifier('fib')])),
TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)])
]
);
result := ExecuteAst(root, fibScope);
result := memoizeTest.Execute(memoizeExec);
sw.Stop;
Memo1.Lines.Add(Format('Result: fib(25) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
Memo1.Lines.Add(Format('Result 1st call: fib(25) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
sw := TStopwatch.StartNew;
result := memoizeTest.Execute(memoizeExec);
sw.Stop;
Memo1.Lines.Add(Format('Result 2nd call: fib(25) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
UpdateScript;
end;
@@ -753,13 +734,14 @@ begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- AST Pretty Print ---');
if not Assigned(FCurrAst) then
// We print the *compiled* AST
if not Assigned(FCurrExec) then
begin
Memo1.Lines.Add('No AST has been generated yet.');
exit;
end;
Memo1.Lines.Add(TAstScript.Print(FCurrAst));
Memo1.Lines.Add(TAstScript.Print(FCurrExec.CompiledAst));
end;
procedure TForm1.RecursionButtonClick(Sender: TObject);
@@ -772,7 +754,6 @@ begin
Memo1.Lines.Add('--- Tail-Recursive factorial(20) ---');
sw := TStopwatch.StartNew;
// Rewritten to be tail-recursive to use 'recur'
root :=
TAst.Block(
[
@@ -806,8 +787,8 @@ begin
]
);
// Execute with FGScope as parent.
result := ExecuteAst(root, FGScope);
// Execute with RootScope as parent.
result := ExecuteAst(root);
sw.Stop;
Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
@@ -821,13 +802,11 @@ var
series: TScalarRecordSeries;
recordDef: IScalarRecordDefinition;
i: Integer;
scope: IExecutionScope;
values: TArray<TScalar.TValue>;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Series Test ---');
scope := TAst.CreateScope(FGScope);
recordDef := TRttiAstHelper.JsonToRecordDefinition(TRttiAstHelper.RecordDefinitionToJson<TOHLCV>);
series := TScalarRecordSeries.Create(recordDef);
SetLength(values, 6);
@@ -842,7 +821,10 @@ begin
values[5].AsInt64 := 10000 * (i + 1);
series.Add(TScalarRecord.Create(recordDef, values));
end;
scope.Define('ohlcvSeries', TDataValue.FromRecordSeries(series));
var testEnv := FEnvironment.CreateEnvironment;
testEnv.RootScope.Define('ohlcvSeries', TDataValue.FromRecordSeries(series));
ast :=
TAst.LambdaExpr(
@@ -852,7 +834,6 @@ begin
TAst.VarDecl(
TAst.Identifier('closeColumn'),
TAst.FunctionCall(TAst.Keyword('Close'), [TAst.Identifier('ohlcvSeries')])
// TAst.MemberAccess(TAst.Identifier('ohlcvSeries'), TAst.Identifier('Close'))
),
TAst.Indexer(TAst.Identifier('closeColumn'), TAst.Constant(1))
]
@@ -860,7 +841,8 @@ begin
);
callAst := TAst.FunctionCall(ast, []);
resultValue := ExecuteAst(callAst, scope);
resultValue := testEnv.CompileAndExecute(callAst);
Memo1.Lines.Add(Format('Result of script: %s', [resultValue.ToString]));
UpdateScript;
@@ -920,7 +902,7 @@ begin
]
);
result := ExecuteAst(root, FGScope);
result := ExecuteAst(root);
sw.Stop;
Memo1.Lines.Add(Format('Result of the final expression: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
@@ -941,90 +923,46 @@ const
smaSlowLength = 20;
smaFastLength = 10;
var
scope: IExecutionScope;
values: TArray<TScalar.TValue>;
recordValue: TScalarRecord;
setupAst, boundCallAst, callAst, typedAst: IAstNode;
setupDescriptor, callDescriptor: IScopeDescriptor;
seriesAddress: TResolvedSymbol; // Use TResolvedSymbol
setupAst: IAstNode;
callExec: IExecutable;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs]));
var sw := TStopwatch.StartNew;
setupAst :=
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('smaFast'), TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(smaFastLength)])),
TAst.VarDecl(TAst.Identifier('smaSlow'), TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(smaSlowLength)])),
TAst.VarDecl(
TAst.Identifier('maCrossStrategy'),
TAst.LambdaExpr(
[TAst.Identifier('ohlcv')],
TAst.Block(
[
TAst.VarDecl(
TAst.Identifier('closeSeries'),
TAst.MemberAccess(TAst.Identifier('ohlcv'), TAst.Keyword('Close'))
),
TAst.VarDecl(
TAst.Identifier('currentClose'),
TAst.Indexer(TAst.Identifier('closeSeries'), TAst.Constant(0))
),
TAst.VarDecl(
TAst.Identifier('valSmaFast'),
TAst.FunctionCall(
TAst.Identifier('smaFast'),
[TAst.Identifier('closeSeries'), TAst.Identifier('currentClose')]
)
),
TAst.VarDecl(
TAst.Identifier('valSmaSlow'),
TAst.FunctionCall(
TAst.Identifier('smaSlow'),
[TAst.Identifier('closeSeries'), TAst.Identifier('currentClose')]
)
),
TAst.TernaryExpr(
TAst.BinaryExpr(
TAst.Identifier('valSmaFast'),
TScalar.TBinaryOp.Greater,
TAst.Identifier('valSmaSlow')
),
TAst.Constant(1),
TAst.Constant(-1)
)
]
)
)
TAstScript.Parse(
'''
(do
(def smaFast (CreateSMA 10))
(def smaSlow (CreateSMA 20))
(fn [ohlcv]
(do
(def closeSeries (:Close ohlcv))
(def currentClose (get closeSeries 0))
(def valSmaFast (smaFast closeSeries currentClose))
(def valSmaSlow (smaSlow closeSeries currentClose))
(? (> valSmaFast valSmaSlow) 1 -1)
)
]
)
)
'''
);
// 1. Compile and execute the setup script.
typedAst := CompileAst(setupAst, FGScope, setupDescriptor);
scope := setupDescriptor.CreateScope(FGScope);
var setupVisitor := CreateEvaluator(scope);
setupVisitor.Execute(typedAst);
FCurrUnboundAst := setupAst;
UpdateScript;
Application.ProcessMessages;
// 2. Prepare for the simulation loop
scope.Define('current_series', TDataValue.Void);
var currentSeriesIdent := TAst.Identifier('current_series');
callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]);
var env := FEnvironment.CreateEnvironment;
// 3. Re-compile the call AST within the now-populated scope to resolve the new variable.
boundCallAst := CompileAst(callAst, scope, callDescriptor);
env.Define('maCrossStrategy', setupAst);
// 4. Get the address of 'current_series' from the new descriptor.
seriesAddress := callDescriptor.FindSymbol('current_series');
// Check seriesAddress.Address.Kind instead of seriesAddress.Kind
if seriesAddress.Address.Kind = akUnresolved then
raise Exception.Create('Could not resolve current_series address.');
var seriesAddress := env.RootScope.Define('current_series', TDataValue.Void);
// 5. Create the final scope and visitor for the simulation loop.
var loopScope := callDescriptor.CreateScope(scope);
var visitor := CreateEvaluator(loopScope);
callExec := env.Compile(TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [TAst.Identifier('current_series')]));
// 6. Simulation Loop
// Simulation Loop
Memo1.Lines.Clear;
Memo1.Lines.Add('Starting simulation...');
Application.ProcessMessages;
@@ -1058,9 +996,10 @@ begin
if series.AsRecordSeries.TotalCount >= smaSlowLength then
begin
// Use seriesAddress.Address instead of seriesAddress
loopScope[seriesAddress.Address] := series;
var resultValue := visitor.Execute(boundCallAst);
env.RootScope[seriesAddress] := series;
var resultValue := env.Execute(callExec);
if i mod 50 = 0 then
begin
Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString]));
@@ -1106,7 +1045,7 @@ begin
]
);
result := ExecuteAst(root, FGScope);
result := ExecuteAst(root);
sw.Stop;
Memo1.Lines.Add(Format('Result: %s', [result.ToString]));
@@ -1117,7 +1056,6 @@ end;
procedure TForm1.CreateTriggerExampleButtonClick(Sender: TObject);
var
blk: IAstNode;
visitor: IEvaluatorVisitor;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Creating Trigger Blueprint ---');
@@ -1138,33 +1076,37 @@ begin
]
);
// Run the pipeline
FCurrAst := CompileAst(blk, FGScope, FCurrDesc);
FTriggerScope := FCurrDesc.CreateScope(FGScope);
FTriggerTest := FEnvironment.CreateEnvironment;
visitor := CreateEvaluator(FTriggerScope);
visitor.Execute(FCurrAst);
FTriggerTest.Define('X', TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(0)));
FTriggerTest.Define(
'tickHandler',
TAst.LambdaExpr(
[TAst.Identifier('summand')],
TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), TScalar.TBinaryOp.Add, TAst.Identifier('summand')))
)
);
Memo1.Lines.Add('Variable "X" and function "tickHandler" defined in persistent scope.');
Memo1.Lines.Add('Click "Do Trigger" to execute.');
UpdateScript;
end;
function TForm1.CreateEvaluator(const Scope: IExecutionScope): IEvaluatorVisitor;
procedure TForm1.DebugBoxChange(Sender: TObject);
begin
if DebugBox.IsChecked then
Result := TDebugEvaluatorVisitor.Create(Scope, Memo1.Lines, ShowScopeBox.IsChecked)
FEnvironment.SetDebugMode(Memo1.Lines, ShowScopeBox.IsChecked)
else
Result := TEvaluatorVisitor.Create(Scope);
FEnvironment.SetStandardMode;
end;
procedure TForm1.DoTriggerButtonClick(Sender: TObject);
var
callAst: IFunctionCallNode;
callAst: IAstNode;
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(1)]);
var X := ExecuteAst(callAst, FTriggerScope);
var X := FTriggerTest.CompileAndExecute(callAst);
Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [X.ToString]));
UpdateScript;
@@ -1172,11 +1114,11 @@ end;
procedure TForm1.DoTrigger2ButtonClick(Sender: TObject);
var
callAst: IFunctionCallNode;
callAst: IAstNode;
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(2)]);
var X := ExecuteAst(callAst, FTriggerScope);
var X := FTriggerTest.CompileAndExecute(callAst);
Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [X.ToString]));
UpdateScript;
@@ -1184,16 +1126,13 @@ 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 := TAst.CreateScope(FGScope);
scope.Define(
FEnvironment.RootScope.Define(
'delphiAdd',
function(const ArgNodes: TArray<TDataValue>): TDataValue
var
@@ -1209,7 +1148,7 @@ begin
callAst := TAst.FunctionCall(TAst.Identifier('delphiAdd'), [TAst.Constant(100), TAst.Constant(123)]);
resultValue := ExecuteAst(callAst, scope);
resultValue := ExecuteAst(callAst);
Memo1.Lines.Add(Format('Result from delphiAdd(100, 123): %s', [resultValue.ToString]));
UpdateScript;
end;
@@ -1246,7 +1185,7 @@ begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Executing Corrected Upvalue Test ---');
resultValue := ExecuteAst(mainBlock, FGScope);
resultValue := ExecuteAst(mainBlock);
var res := resultValue.AsScalar.Value.AsInt64;
if res = 15 then
@@ -1347,7 +1286,7 @@ begin
try
try
// Execute the entire script block when it changes
var result := ExecuteAst(TAstScript.Parse(ScriptMemo.Lines.Text), FGScope);
var result := ExecuteAst(TAstScript.Parse(ScriptMemo.Lines.Text));
Memo1.Lines.Add(Format('Script executed. Final result: %s', [result.ToString]));
finally
ShowVizualization(14, 14);
@@ -1372,14 +1311,14 @@ begin
FWorkspace.Build(FCurrUnboundAst, TPointF.Create(X, Y));
//
// if FCurrAst <> nil then
// begin
// FWorkspace.Build(FCurrAst, TPointF.Create(X, Y));
// end
// else if FCurrUnboundAst <> nil then
// begin
// FWorkspace.Build(FCurrUnboundAst, TPointF.Create(X, Y));
// end;
// if FCurrExec <> nil then
// begin
// FWorkspace.Build(FCurrExec.CompiledAst, TPointF.Create(X, Y));
// end
// else if FCurrUnboundAst <> nil then
// begin
// FWorkspace.Build(FCurrUnboundAst, TPointF.Create(X, Y));
// end;
end;
end.
View File
+11 -10
View File
@@ -26,7 +26,6 @@ type
type
TUpvalueMapping = TDictionary<TResolvedAddress, Integer>;
private
FInitialScope: IExecutionScope;
FCurrentDescriptor: IScopeDescriptor;
FUpvalueStack: TStack<TUpvalueMapping>;
FNestedLambdaCount: Integer;
@@ -54,12 +53,12 @@ type
function VisitSeriesLength(const Node: ISeriesLengthNode): IAstNode; override;
public
constructor Create(const AInitialScope: IExecutionScope);
constructor Create(const AInitialDescriptor: IScopeDescriptor);
destructor Destroy; override;
function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
class function Bind(
const InitialScope: IExecutionScope;
const InitialDescriptor: IScopeDescriptor;
const RootNode: IAstNode;
out Descriptor: IScopeDescriptor
): IAstNode; static;
@@ -96,13 +95,12 @@ end;
{ TAstBinder }
constructor TAstBinder.Create(const AInitialScope: IExecutionScope);
constructor TAstBinder.Create(const AInitialDescriptor: IScopeDescriptor);
begin
inherited Create;
Assert(Assigned(AInitialScope));
Assert(Assigned(AInitialDescriptor));
FInitialScope := AInitialScope;
FCurrentDescriptor := AInitialScope.CreateDescriptor;
FCurrentDescriptor := AInitialDescriptor;
FUpvalueStack := TObjectStack<TUpvalueMapping>.Create(True); // Use Comparer
FNestedLambdaCount := 0;
FBoxedDeclarations := nil;
@@ -115,9 +113,13 @@ begin
inherited;
end;
class function TAstBinder.Bind(const InitialScope: IExecutionScope; const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
class function TAstBinder.Bind(
const InitialDescriptor: IScopeDescriptor;
const RootNode: IAstNode;
out Descriptor: IScopeDescriptor
): IAstNode;
begin
var binder := TAstBinder.Create(InitialScope) as IAstBinder;
var binder := TAstBinder.Create(InitialDescriptor) as IAstBinder;
Result := binder.Execute(RootNode, Descriptor);
end;
@@ -155,7 +157,6 @@ begin
try
EnterScope;
try
// Main pass: Run the mutator
Result := Accept(RootNode); // Accept returns IAstNode
if not Assigned(Result) then
Result := TAst.Block([]);
+36 -87
View File
@@ -12,11 +12,12 @@ uses
Myc.Ast.Visitor,
Myc.Ast.Scope,
Myc.Ast.Types,
Myc.Ast;
Myc.Ast,
Myc.Ast.Environment; // Added for IMacroRegistry
type
IAstMacroExpander = interface(IAstVisitor)
// Signatur geändert: Descriptor wird nicht mehr zurückgegeben
// Signatur geaendert: Descriptor wird nicht mehr zurueckgegeben
function Execute(const RootNode: IAstNode): IAstNode;
end;
@@ -46,28 +47,10 @@ type
// This transformer traverses the entire AST *before* the binder,
// to find and expand macros.
TMacroExpander = class(TAstTransformer, IAstMacroExpander)
type
TMacroRegistry = class
private
FParent: TMacroRegistry;
FMacros: TDictionary<string, IMacroDefinitionNode>;
public
constructor Create(AParent: TMacroRegistry);
destructor Destroy; override;
procedure Define(const Node: IMacroDefinitionNode);
function Find(const Name: string): IMacroDefinitionNode;
end;
strict private
class var
FGlobalMacroRegistry: TMacroRegistry;
class constructor CreateClass;
class destructor DestroyClass;
private
FInitialScope: IExecutionScope;
FCurrentMacroRegistry: TMacroRegistry;
FCurrentMacroRegistry: IMacroRegistry; // Changed from TMacroRegistry
FEvaluatorFactory: TEvaluatorFactory;
@@ -87,18 +70,23 @@ type
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override;
public
constructor Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
destructor Destroy; override;
// Updated Constructor
constructor Create(
const ARootRegistry: IMacroRegistry;
const AInitialScope: IExecutionScope;
const AEvaluatorFactory: TEvaluatorFactory
);
destructor Destroy; override; // Modified
function Execute(const RootNode: IAstNode): IAstNode;
// Updated static helper
class function ExpandMacros(
const InitialScope: IExecutionScope;
const ARootRegistry: IMacroRegistry; // Added
const AInitialScope: IExecutionScope;
const RootNode: IAstNode;
const EvaluatorFactory: TEvaluatorFactory
): IAstNode; static;
class property GlobalMacroRegistry: TMacroRegistry read FGlobalMacroRegistry;
end;
implementation
@@ -109,40 +97,6 @@ uses
Myc.Ast.Evaluator, // Required for TEvaluatorVisitor.Execute
Myc.Data.Keyword;
{ TMacroRegistry }
constructor TMacroExpander.TMacroRegistry.Create(AParent: TMacroRegistry);
begin
inherited Create;
FParent := AParent;
FMacros := TDictionary<string, IMacroDefinitionNode>.Create;
end;
destructor TMacroExpander.TMacroRegistry.Destroy;
begin
FMacros.Free;
inherited Destroy;
end;
procedure TMacroExpander.TMacroRegistry.Define(const Node: IMacroDefinitionNode);
begin
FMacros.AddOrSetValue(Node.Name.Name, Node);
end;
function TMacroExpander.TMacroRegistry.Find(const Name: string): IMacroDefinitionNode;
var
current: TMacroRegistry;
begin
current := Self;
while Assigned(current) do
begin
if current.FMacros.TryGetValue(Name, Result) then
exit;
current := current.FParent;
end;
Result := nil;
end;
{ TExpansionVisitor }
constructor TExpansionVisitor.Create(const AMacroScope: IExecutionScope; const AEvaluate: TEvaluateProc);
@@ -288,57 +242,52 @@ end;
{ TMacroExpander }
constructor TMacroExpander.Create(const AInitialScope: IExecutionScope; const AEvaluatorFactory: TEvaluatorFactory);
constructor TMacroExpander.Create(
const ARootRegistry: IMacroRegistry;
const AInitialScope: IExecutionScope;
const AEvaluatorFactory: TEvaluatorFactory
);
begin
inherited Create;
Assert(Assigned(ARootRegistry));
Assert(Assigned(AInitialScope));
Assert(Assigned(AEvaluatorFactory));
FInitialScope := AInitialScope;
FEvaluatorFactory := AEvaluatorFactory;
// Erzeugt die Root-Registry für Makros
FCurrentMacroRegistry := TMacroRegistry.Create(FGlobalMacroRegistry);
end;
class constructor TMacroExpander.CreateClass;
begin
FGlobalMacroRegistry := TMacroRegistry.Create(nil);
// Creates the root registry for this specific compilation run,
// parented to the global registry from the environment.
FCurrentMacroRegistry := ARootRegistry.CreateChildRegistry;
end;
destructor TMacroExpander.Destroy;
begin
FCurrentMacroRegistry.Free;
// FCurrentMacroRegistry is an interface, managed by ARC
inherited Destroy;
end;
class destructor TMacroExpander.DestroyClass;
begin
FGlobalMacroRegistry.Free;
end;
procedure TMacroExpander.EnterMacroScope;
begin
// Erstellt eine neue Registry mit der aktuellen als Parent
FCurrentMacroRegistry := TMacroRegistry.Create(FCurrentMacroRegistry);
// Creates a new registry with the current as Parent
FCurrentMacroRegistry := FCurrentMacroRegistry.CreateChildRegistry;
end;
procedure TMacroExpander.ExitMacroScope;
var
oldRegistry: TMacroRegistry;
begin
oldRegistry := FCurrentMacroRegistry;
FCurrentMacroRegistry := oldRegistry.FParent;
oldRegistry.Free;
// Revert to parent registry. ARC will free the old child.
FCurrentMacroRegistry := FCurrentMacroRegistry.Parent;
end;
class function TMacroExpander.ExpandMacros(
const InitialScope: IExecutionScope;
const ARootRegistry: IMacroRegistry;
const AInitialScope: IExecutionScope;
const RootNode: IAstNode;
const EvaluatorFactory: TEvaluatorFactory
): IAstNode;
begin
// IAstMacroExpander.Execute gibt keinen Descriptor mehr zurück
var expander := TMacroExpander.Create(InitialScope, EvaluatorFactory) as IAstMacroExpander;
// IAstMacroExpander.Execute gibt keinen Descriptor mehr zurueck
var expander := TMacroExpander.Create(ARootRegistry, AInitialScope, EvaluatorFactory) as IAstMacroExpander;
Result := expander.Execute(RootNode);
end;
@@ -400,7 +349,7 @@ begin
// --- It is a macro, expand it ---
// 1. Create the temporary scope for the macro parameters
// It must be parented to the *initial* scope to find other macros/globals.
// It must be parented to the *initial* scope to find other globals.
var expansionScope := TAst.CreateScope(FInitialScope);
var params := macroDef.Parameters;
if Length(Node.Arguments) <> Length(params) then
@@ -422,8 +371,8 @@ begin
boundSubAst: IAstNode;
begin
// This is the compile-time evaluation (Binder + Evaluator)
// Es wird der 'expansionScope' verwendet, der die AST-Argumente enthält
boundSubAst := TAstBinder.Bind(expansionScope, ANodeToEvaluate, subDescriptor);
// Es wird der 'expansionScope' verwendet, der die AST-Argumente enthaelt
boundSubAst := TAstBinder.Bind(expansionScope.CreateDescriptor, ANodeToEvaluate, subDescriptor);
// Create eval scope from the new descriptor, parented to the expansion scope
evalScope := subDescriptor.CreateScope(expansionScope);
+419
View File
@@ -0,0 +1,419 @@
unit Myc.Ast.Environment;
interface
uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
Myc.Data.Value,
Myc.Ast,
Myc.Ast.Nodes,
Myc.Ast.Scope;
type
IMacroRegistry = interface; // Forward
IEnvironment = interface; // Forward
IExecutionStrategy = interface; // Forward
IExecutable = interface; // Forward
// Defines the Strategy for creating an Evaluator.
IExecutionStrategy = interface
function CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
end;
// Defines the compile-time macro storage.
IMacroRegistry = interface
{$region 'private'}
function GetParent: IMacroRegistry;
{$endregion}
procedure Define(const Node: IMacroDefinitionNode);
function Find(const Name: string): IMacroDefinitionNode;
function CreateChildRegistry: IMacroRegistry;
property Parent: IMacroRegistry read GetParent;
end;
// Represents a compiled, ready-to-run script.
// This encapsulates the compiled AST and its internal layout (Descriptor).
IExecutable = interface
{$region 'private'}
function GetCompiledAst: IAstNode;
function GetDescriptor: IScopeDescriptor;
{$endregion}
// The final, compiled AST (for debugging, serialization, etc.)
property CompiledAst: IAstNode read GetCompiledAst;
// The internal layout (hidden from TForm1, used by IEnvironment.Execute)
property Descriptor: IScopeDescriptor read GetDescriptor;
end;
// Defines the central environment for compilation and execution.
IEnvironment = interface
{$region 'private'}
function GetRootScope: IExecutionScope;
function GetMacroRegistry: IMacroRegistry;
{$endregion}
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
// Compiles source AST into a runnable script.
function Compile(const ANode: IAstNode): IExecutable; // Changed return type
// Executes a previously compiled script.
function Execute(const AScript: IExecutable): TDataValue;
function CreateEnvironment: IEnvironment;
property RootScope: IExecutionScope read GetRootScope;
property MacroRegistry: IMacroRegistry read GetMacroRegistry;
end;
// Interface Helper for IEnvironment
TAstEnvironment = record
private
FEnvironment: IEnvironment;
function GetRootScope: IExecutionScope; inline;
function GetMacroRegistry: IMacroRegistry; inline;
public
constructor Create(const AEnvironment: IEnvironment);
class operator Initialize(out Dest: TAstEnvironment);
class operator Implicit(const A: IEnvironment): TAstEnvironment;
class operator Implicit(const A: TAstEnvironment): IEnvironment;
function CreateEnvironment: TAstEnvironment;
procedure SetStandardMode;
procedure SetDebugMode(ALog: TStrings; AShowScope: Boolean);
function Compile(const ANode: IAstNode): IExecutable;
function Execute(const AScript: IExecutable): TDataValue;
function CompileAndExecute(const AScript: IAstNode): TDataValue;
procedure Define(const Name: String; const AScript: IAstNode);
property RootScope: IExecutionScope read GetRootScope;
property MacroRegistry: IMacroRegistry read GetMacroRegistry;
end;
implementation
uses
Myc.Ast.RTL,
Myc.Ast.Evaluator,
Myc.Ast.Debugger,
Myc.Ast.Compiler.Macros,
Myc.Ast.Compiler.Binder,
Myc.Ast.Compiler.TypeChecker,
Myc.Ast.Compiler.Lowering,
Myc.Ast.Compiler.TCO;
type
{ TStandardExecutionStrategy }
TStandardExecutionStrategy = class(TInterfacedObject, IExecutionStrategy)
public
function CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
end;
{ TDebugExecutionStrategy }
TDebugExecutionStrategy = class(TInterfacedObject, IExecutionStrategy)
private
FLog: TStrings;
FShowScope: Boolean;
public
constructor Create(ALog: TStrings; AShowScope: Boolean);
function CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
end;
{ TMacroRegistryImpl }
TMacroRegistryImpl = class(TInterfacedObject, IMacroRegistry)
private
FParent: IMacroRegistry;
FMacros: TDictionary<string, IMacroDefinitionNode>;
function GetParent: IMacroRegistry;
public
constructor Create(AParent: IMacroRegistry);
destructor Destroy; override;
procedure Define(const Node: IMacroDefinitionNode);
function Find(const Name: string): IMacroDefinitionNode;
function CreateChildRegistry: IMacroRegistry;
end;
{ TExecutable }
TExecutable = class(TInterfacedObject, IExecutable)
private
FCompiledAst: IAstNode;
FDescriptor: IScopeDescriptor;
function GetCompiledAst: IAstNode;
function GetDescriptor: IScopeDescriptor;
public
constructor Create(ACompiledAst: IAstNode; ADescriptor: IScopeDescriptor);
end;
{ TEnvironment }
TEnvironment = class(TInterfacedObject, IEnvironment)
private
FRootScope: IExecutionScope;
FMacroRegistry: IMacroRegistry;
FExecutionStrategy: IExecutionStrategy;
function GetRootScope: IExecutionScope;
function GetMacroRegistry: IMacroRegistry;
public
constructor Create(
const ARootScope: IExecutionScope;
const AMacroRegistry: IMacroRegistry;
const AExecutionStrategy: IExecutionStrategy
);
destructor Destroy; override;
function CreateEnvironment: IEnvironment;
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
function Compile(const ANode: IAstNode): IExecutable;
function Execute(const AScript: IExecutable): TDataValue;
end;
// --- Factory Implementations ---
{ TAstEnvironment }
class operator TAstEnvironment.Initialize(out Dest: TAstEnvironment);
begin
Dest.FEnvironment :=
TEnvironment.Create(TScope.CreateScope(nil, nil, nil), TMacroRegistryImpl.Create(nil), TStandardExecutionStrategy.Create);
end;
constructor TAstEnvironment.Create(const AEnvironment: IEnvironment);
begin
FEnvironment := AEnvironment;
end;
procedure TAstEnvironment.SetStandardMode;
begin
FEnvironment.SetExecutionStrategy(TStandardExecutionStrategy.Create);
end;
procedure TAstEnvironment.SetDebugMode(ALog: TStrings; AShowScope: Boolean);
begin
FEnvironment.SetExecutionStrategy(TDebugExecutionStrategy.Create(ALog, AShowScope));
end;
class operator TAstEnvironment.Implicit(const A: IEnvironment): TAstEnvironment;
begin
Result.FEnvironment := A;
end;
class operator TAstEnvironment.Implicit(const A: TAstEnvironment): IEnvironment;
begin
Result := A.FEnvironment;
end;
function TAstEnvironment.Compile(const ANode: IAstNode): IExecutable;
begin
Result := FEnvironment.Compile(ANode);
end;
function TAstEnvironment.CompileAndExecute(const AScript: IAstNode): TDataValue;
begin
Result := Execute(Compile(AScript));
end;
function TAstEnvironment.CreateEnvironment: TAstEnvironment;
begin
Result := FEnvironment.CreateEnvironment;
end;
procedure TAstEnvironment.Define(const Name: String; const AScript: IAstNode);
begin
RootScope.Define(Name, CompileAndExecute(AScript));
end;
function TAstEnvironment.Execute(const AScript: IExecutable): TDataValue;
begin
Result := FEnvironment.Execute(AScript);
end;
function TAstEnvironment.GetRootScope: IExecutionScope;
begin
Result := FEnvironment.GetRootScope;
end;
function TAstEnvironment.GetMacroRegistry: IMacroRegistry;
begin
Result := FEnvironment.GetMacroRegistry;
end;
{ TStandardExecutionStrategy }
function TStandardExecutionStrategy.CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
begin
Result := TEvaluatorVisitor.Create(AScope);
end;
{ TDebugExecutionStrategy }
constructor TDebugExecutionStrategy.Create(ALog: TStrings; AShowScope: Boolean);
begin
inherited Create;
FLog := ALog;
FShowScope := AShowScope;
end;
function TDebugExecutionStrategy.CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
begin
Result := TDebugEvaluatorVisitor.Create(AScope, FLog, FShowScope, 0);
end;
{ TMacroRegistryImpl }
constructor TMacroRegistryImpl.Create(AParent: IMacroRegistry);
begin
inherited Create;
FParent := AParent;
FMacros := TDictionary<string, IMacroDefinitionNode>.Create;
end;
destructor TMacroRegistryImpl.Destroy;
begin
FMacros.Free;
inherited Destroy;
end;
function TMacroRegistryImpl.GetParent: IMacroRegistry;
begin
Result := FParent;
end;
procedure TMacroRegistryImpl.Define(const Node: IMacroDefinitionNode);
begin
FMacros.AddOrSetValue(Node.Name.Name, Node);
end;
function TMacroRegistryImpl.Find(const Name: string): IMacroDefinitionNode;
var
current: IMacroRegistry;
begin
current := Self;
while Assigned(current) do
begin
if (current as TMacroRegistryImpl).FMacros.TryGetValue(Name, Result) then
exit;
current := current.Parent;
end;
Result := nil;
end;
function TMacroRegistryImpl.CreateChildRegistry: IMacroRegistry;
begin
Result := TMacroRegistryImpl.Create(Self);
end;
{ TExecutable }
constructor TExecutable.Create(ACompiledAst: IAstNode; ADescriptor: IScopeDescriptor);
begin
inherited Create;
FCompiledAst := ACompiledAst;
FDescriptor := ADescriptor;
end;
function TExecutable.GetCompiledAst: IAstNode;
begin
Result := FCompiledAst;
end;
function TExecutable.GetDescriptor: IScopeDescriptor;
begin
Result := FDescriptor;
end;
{ TEnvironment }
constructor TEnvironment.Create(
const ARootScope: IExecutionScope;
const AMacroRegistry: IMacroRegistry;
const AExecutionStrategy: IExecutionStrategy
);
begin
inherited Create;
FRootScope := ARootScope;
FMacroRegistry := AMacroRegistry;
FExecutionStrategy := AExecutionStrategy;
end;
destructor TEnvironment.Destroy;
begin
inherited Destroy;
end;
function TEnvironment.GetMacroRegistry: IMacroRegistry;
begin
Result := FMacroRegistry;
end;
function TEnvironment.GetRootScope: IExecutionScope;
begin
Result := FRootScope;
end;
procedure TEnvironment.SetExecutionStrategy(const AStrategy: IExecutionStrategy);
begin
FExecutionStrategy := AStrategy;
end;
function TEnvironment.Compile(const ANode: IAstNode): IExecutable;
var
expandedAst, boundAst, typedAst, loweredAst: IAstNode;
descriptor: IScopeDescriptor;
begin
// Step 1: Expand macros
expandedAst :=
TMacroExpander.ExpandMacros(
FMacroRegistry,
FRootScope,
ANode,
function(const Scope: IExecutionScope): IEvaluatorVisitor begin Result := FExecutionStrategy.CreateVisitor(Scope); end
);
// Step 2: Bind names
boundAst := TAstBinder.Bind(FRootScope.CreateDescriptor, expandedAst, descriptor);
// Step 3: Check types
typedAst := TTypeChecker.CheckTypes(boundAst, descriptor);
// Step 4: Lowering
loweredAst := TAstLowerer.Lower(typedAst);
// Step 5: TCO
var compiledAst := TAstTCO.Optimize(loweredAst);
// Step 6: Create the executable package
Result := TExecutable.Create(compiledAst, descriptor);
end;
function TEnvironment.CreateEnvironment: IEnvironment;
begin
Result := TEnvironment.Create(TScope.CreateScope(FRootScope, nil, nil), TMacroRegistryImpl.Create(FMacroRegistry), FExecutionStrategy);
end;
function TEnvironment.Execute(const AScript: IExecutable): TDataValue;
var
evalScope: IExecutionScope;
visitor: IEvaluatorVisitor;
begin
// 1. Create the runtime scope *directly from the descriptor*.
// This creates the raw scope with the correct slot count for local variables,
// parented to FRootScope.
evalScope := AScript.Descriptor.CreateScope(FRootScope);
// 2. Use the strategy to create the final evaluator
visitor := FExecutionStrategy.CreateVisitor(evalScope);
// 3. Execute the compiled AST
Result := visitor.Execute(AScript.CompiledAst);
end;
end.
+1 -1
View File
@@ -399,7 +399,7 @@ type
function Execute(const RootNode: IAstNode): TDataValue;
end;
// A factory for creating visitors, primarily used by the debugger subsystem.
// A factory for creating visitors
TEvaluatorFactory = reference to function(const Scope: IExecutionScope): IEvaluatorVisitor;
implementation
+3 -1
View File
@@ -10,6 +10,7 @@ uses
Myc.Data.Scalar,
Myc.Data.Value,
Myc.Ast,
Myc.Ast.Scope,
Myc.Ast.Nodes;
type
@@ -21,12 +22,13 @@ type
constructor Create(const AName: string);
end;
procedure RegisterRtlFunctions(const AScope: IExecutionScope);
implementation
uses
System.Rtti,
System.TypInfo,
Myc.Ast.Scope,
Myc.Ast.RTL.Core;
//--------------------------------------------------------------------------------------------------
+48 -3
View File
@@ -49,7 +49,8 @@ type
procedure SetValues(const Address: TResolvedAddress; const Value: TDataValue);
{$endregion}
procedure Define(const Name: string; const Value: TDataValue);
// Defines a symbol and returns its runtime address
function Define(const Name: string; const Value: TDataValue): TResolvedAddress;
// Defines a variable at a given address and stores it directly in a shared cell (boxing).
procedure DefineBoxed(SlotIndex: Integer; const Value: TDataValue);
@@ -59,6 +60,8 @@ type
function Capture(const Address: TResolvedAddress): IValueCell;
function GetNameID(const Name: String): Integer;
// Resolves a name to an address by searching the runtime scope chain.
function Resolve(const Name: string): TResolvedAddress;
function CreateDescriptor: IScopeDescriptor;
@@ -143,8 +146,9 @@ type
destructor Destroy; override;
procedure Clear;
function GetNameID(const Name: String): Integer;
function Resolve(const Name: string): TResolvedAddress;
function Dump: string;
procedure Define(const Name: string; const Value: TDataValue);
function Define(const Name: string; const Value: TDataValue): TResolvedAddress;
procedure DefineBoxed(SlotIndex: Integer; const Value: TDataValue);
function Capture(const Address: TResolvedAddress): IValueCell;
function CreateDescriptor: IScopeDescriptor;
@@ -336,7 +340,7 @@ begin
Result := TScopeDescriptor.CreateDescriptor(Self);
end;
procedure TExecutionScope.Define(const Name: string; const Value: TDataValue);
function TExecutionScope.Define(const Name: string; const Value: TDataValue): TResolvedAddress;
var
id: Integer;
index: Integer;
@@ -351,6 +355,11 @@ begin
FValues[index].Value := Value;
FValues[index].IsBoxed := False;
FNameToIndex.Add(id, index);
// Return the address
Result.Kind := akLocalOrParent;
Result.ScopeDepth := 0;
Result.SlotIndex := index;
end;
procedure TExecutionScope.DefineBoxed(SlotIndex: Integer; const Value: TDataValue);
@@ -480,6 +489,42 @@ begin
end;
end;
function TExecutionScope.Resolve(const Name: string): TResolvedAddress;
var
nameID: Integer;
slotIndex: Integer;
currentScope: IExecutionScope;
depth: Integer;
begin
currentScope := Self;
depth := 0;
// GetNameID is shared (or recreated) across the scope chain
nameID := GetNameID(Name);
while Assigned(currentScope) do
begin
// We must cast to the implementation class to access 'NameToIndex'
var execScopeImpl := (currentScope as TExecutionScope);
// Accessing .NameToIndex property ensures NeedNameToIndex is called
if execScopeImpl.NameToIndex.TryGetValue(nameID, slotIndex) then
begin
// Found in this scope
Result.Kind := akLocalOrParent;
Result.ScopeDepth := depth;
Result.SlotIndex := slotIndex;
exit;
end;
// Not found, go to parent
inc(depth);
currentScope := currentScope.Parent;
end;
// Not found in the entire chain
Result := Default(TResolvedAddress); // Kind = akUnresolved
end;
procedure TExecutionScope.SetValues(const Address: TResolvedAddress; const Value: TDataValue);
var
targetScope: TExecutionScope;