Ast environments
This commit is contained in:
File diff suppressed because one or more lines are too long
@@ -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}
|
||||
|
||||
|
||||
@@ -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>
|
||||
|
||||
@@ -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
|
||||
|
||||
+178
-239
@@ -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,8 +352,12 @@ begin
|
||||
Result := TStopwatch.GetTimeStamp div TTimeSpan.TicksPerMillisecond;
|
||||
end
|
||||
);
|
||||
end;
|
||||
|
||||
TMacroExpander.GlobalMacroRegistry.Define(
|
||||
RegFunc(FEnvironment.RootScope);
|
||||
|
||||
// Register the 'stopwatch' macro into the global registry
|
||||
FEnvironment.MacroRegistry.Define(
|
||||
TAstScript
|
||||
.Parse(
|
||||
'''
|
||||
@@ -369,14 +365,12 @@ begin
|
||||
`(do
|
||||
(def start-time (timestamp))
|
||||
(def result ~body)
|
||||
(print "Stopwatch: " (- (timestamp) start-time) "ms" )
|
||||
(print "(calculated in " (- (timestamp) start-time) " ms)" )
|
||||
result
|
||||
))
|
||||
''')
|
||||
.AsMacroDefinition
|
||||
);
|
||||
end
|
||||
);
|
||||
|
||||
ClearButtonClick(Self);
|
||||
end;
|
||||
@@ -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,9 +1311,9 @@ begin
|
||||
|
||||
FWorkspace.Build(FCurrUnboundAst, TPointF.Create(X, Y));
|
||||
//
|
||||
// if FCurrAst <> nil then
|
||||
// if FCurrExec <> nil then
|
||||
// begin
|
||||
// FWorkspace.Build(FCurrAst, TPointF.Create(X, Y));
|
||||
// FWorkspace.Build(FCurrExec.CompiledAst, TPointF.Create(X, Y));
|
||||
// end
|
||||
// else if FCurrUnboundAst <> nil then
|
||||
// begin
|
||||
|
||||
@@ -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([]);
|
||||
|
||||
@@ -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);
|
||||
|
||||
@@ -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.
|
||||
@@ -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
|
||||
|
||||
@@ -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;
|
||||
|
||||
//--------------------------------------------------------------------------------------------------
|
||||
|
||||
@@ -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;
|
||||
|
||||
Reference in New Issue
Block a user