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

Ast environment refactoring

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-08 15:57:12 +01:00
parent c16f47c6d5
commit 93dc19497c
5 changed files with 109 additions and 166 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/MainForm.pas
+31 -45
View File
@@ -109,7 +109,7 @@ type
procedure RTLListViewChange(Sender: TObject);
private
FCurrUnboundAst: IAstNode;
FCurrExec: IExecutable; // Replaced FCurrAst and FCurrDesc
FCurrExec: TDataValue.TFunc;
FEnvironment: TAstEnvironment;
FWorkspace: TAuraWorkspace;
FScriptUpdate: Boolean;
@@ -226,12 +226,8 @@ begin
FEnvironment.SetStandardMode;
try
// 2. Compile (Pipeline is inside Environment)
// We store the executable artifact in the form
FCurrExec := FEnvironment.Compile(ANode);
// 3. Execute
Result := FEnvironment.Execute(FCurrExec);
Result := FCurrExec([]);
except
on E: Exception do
@@ -260,7 +256,6 @@ begin
procedure(const Scope: IExecutionScope)
var
smaAst: IAstNode;
smaExec: IExecutable;
begin
smaAst :=
TAst.LambdaExpr(
@@ -313,13 +308,7 @@ begin
)
);
// Compile the SMA factory using the environment itself
// Note: We pass FEnvironment.RootScope as the parent scope
smaExec := FEnvironment.Compile(smaAst);
// 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);
var smaFactory := FEnvironment.Run(smaAst);
Scope.Define('CreateSMA', smaFactory); // Define the factory
@@ -641,7 +630,7 @@ begin
try
converter := TJsonAstConverter.Create;
jsonObj := converter.Serialize(FCurrExec.CompiledAst);
jsonObj := converter.Serialize(FCurrUnboundAst);
try
Memo1.Lines.Text := jsonObj.Format(4);
finally
@@ -668,7 +657,7 @@ begin
end;
// Dump the compiled AST from the executable
TAstDumper.Dump(FCurrExec.CompiledAst, Memo1.Lines);
TAstDumper.Dump(FCurrUnboundAst, Memo1.Lines);
end;
procedure TForm1.FibonacciButtonClick(Sender: TObject);
@@ -703,7 +692,7 @@ begin
var fibExec := TestEnv.Compile(TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]));
sw := TStopwatch.StartNew;
result := TestEnv.Execute(fibExec);
result := fibExec([]);
sw.Stop;
Memo1.Lines.Add(Format('Result: fib(25) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
@@ -718,11 +707,11 @@ begin
var memoizeExec := memoizeTest.Compile(TAstScript.Parse('(fib 25)'));
sw := TStopwatch.StartNew;
result := memoizeTest.Execute(memoizeExec);
result := memoizeExec([]);
sw.Stop;
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);
result := memoizeExec([]);
sw.Stop;
Memo1.Lines.Add(Format('Result 2nd call: fib(25) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds]));
@@ -741,7 +730,7 @@ begin
exit;
end;
Memo1.Lines.Add(TAstScript.Print(FCurrExec.CompiledAst));
Memo1.Lines.Add(TAstScript.Print(FCurrUnboundAst));
end;
procedure TForm1.RecursionButtonClick(Sender: TObject);
@@ -797,7 +786,7 @@ end;
procedure TForm1.SeriesTestButtonClick(Sender: TObject);
var
ast, callAst: IAstNode;
ast: IAstNode;
resultValue: TDataValue;
series: TScalarRecordSeries;
recordDef: IScalarRecordDefinition;
@@ -840,9 +829,9 @@ begin
)
);
callAst := TAst.FunctionCall(ast, []);
var callAst := TAst.FunctionCall(ast, []);
resultValue := testEnv.CompileAndExecute(callAst);
resultValue := testEnv.Run(callAst);
Memo1.Lines.Add(Format('Result of script: %s', [resultValue.ToString]));
UpdateScript;
@@ -851,24 +840,20 @@ end;
procedure TForm1.Test1ButtonClick(Sender: TObject);
begin
FCurrUnboundAst :=
TAst.Block(
[
TAst.LambdaExpr(
[],
TAst.Block(
[
TAst.VarDecl(TAst.Identifier('a'), TAst.Nop),
TAst.VarDecl(
TAst.Identifier('b'),
TAst.BinaryExpr(TAst.Identifier('a'), TScalar.TBinaryOp.Multiply, TAst.Constant(2))
),
TAst.BinaryExpr(TAst.Identifier('a'), TScalar.TBinaryOp.Add, TAst.Identifier('b'))
]
)
)
]
TAstScript.Parse(
'''
(do
(print txt)
)
'''
);
var fn := FEnvironment.Compile(FCurrUnboundAst, [TAst.Identifier('txt')]);
fn(['Hello World']);
FEnvironment.RootScope.Define('fn', fn);
UpdateScript;
end;
@@ -879,12 +864,14 @@ var
sw: TStopwatch;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('--- Factory Pattern Demo ---');
sw := TStopwatch.StartNew;
root :=
TAst.Block(
[
TAst.FunctionCall(TAst.Identifier('fn'), [TAst.Constant('xyz')]),
TAst.VarDecl(
TAst.Identifier('createStrategyInstance'),
TAst.LambdaExpr(
@@ -926,7 +913,6 @@ var
values: TArray<TScalar.TValue>;
recordValue: TScalarRecord;
setupAst: IAstNode;
callExec: IExecutable;
begin
Memo1.Lines.Clear;
Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs]));
@@ -960,7 +946,7 @@ begin
var seriesAddress := env.RootScope.Define('current_series', TDataValue.Void);
callExec := env.Compile(TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [TAst.Identifier('current_series')]));
var callExec := env.Compile(TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [TAst.Identifier('current_series')]));
// Simulation Loop
Memo1.Lines.Clear;
@@ -998,7 +984,7 @@ begin
begin
env.RootScope[seriesAddress] := series;
var resultValue := env.Execute(callExec);
var resultValue := callExec([]);
if i mod 50 = 0 then
begin
@@ -1078,7 +1064,7 @@ begin
FTriggerTest := FEnvironment.CreateEnvironment;
FTriggerTest.Define('X', TAst.VarDecl(TAst.Identifier('X'), TAst.Constant(0)));
FTriggerTest.Define('X', TAst.Constant(0));
FTriggerTest.Define(
'tickHandler',
TAst.LambdaExpr(
@@ -1106,7 +1092,7 @@ var
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(1)]);
var X := FTriggerTest.CompileAndExecute(callAst);
var X := FTriggerTest.Run(callAst);
Memo1.Lines.Add(Format('Tick(1)! New value of X: %s', [X.ToString]));
UpdateScript;
@@ -1118,7 +1104,7 @@ var
begin
callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(2)]);
var X := FTriggerTest.CompileAndExecute(callAst);
var X := FTriggerTest.Run(callAst);
Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [X.ToString]));
UpdateScript;
Src/AST/Myc.Ast.Compiler.Lowering.pas
+15 -7
View File
@@ -48,19 +48,27 @@ uses
constructor TAstLowerer.Create;
var
op: TScalar.TBinaryOp;
uOp: TScalar.TUnaryOp; // Added for unary
uOp: TScalar.TUnaryOp;
begin
inherited Create;
// Operator folding maps
FBinaryOperators := TDictionary<string, TScalar.TBinaryOp>.Create;
for op := Low(TScalar.TBinaryOp) to High(TScalar.TBinaryOp) do
FBinaryOperators.Add(op.ToString, op);
FBinaryOperators.Add('+', TScalar.TBinaryOp.Add);
FBinaryOperators.Add('-', TScalar.TBinaryOp.Subtract);
FBinaryOperators.Add('*', TScalar.TBinaryOp.Multiply);
FBinaryOperators.Add('/', TScalar.TBinaryOp.Divide);
FBinaryOperators.Add('=', TScalar.TBinaryOp.Equal);
FBinaryOperators.Add('<>', TScalar.TBinaryOp.NotEqual);
FBinaryOperators.Add('<', TScalar.TBinaryOp.Less);
FBinaryOperators.Add('<=', TScalar.TBinaryOp.LessOrEqual);
FBinaryOperators.Add('>', TScalar.TBinaryOp.Greater);
FBinaryOperators.Add('>=', TScalar.TBinaryOp.GreaterOrEqual);
FUnaryOperators := TDictionary<string, TScalar.TUnaryOp>.Create;
for uOp := Low(TScalar.TUnaryOp) to High(TScalar.TUnaryOp) do // Changed
FUnaryOperators.Add(uOp.ToString, uOp);
// Note: '-' is handled as a special case in VisitFunctionCall
FUnaryOperators.Add('not', TScalar.TUnaryOp.Not);
end;
destructor TAstLowerer.Destroy;
@@ -95,7 +103,7 @@ begin
if Node.Callee.Kind = akIdentifier then
begin
calleeIdentifier := Node.Callee.AsIdentifier;
nodeType := Node.StaticType;
nodeType := Node.StaticType; // Get type from (un-lowered) node
if (Length(Node.Arguments) = 2) then
begin
Src/AST/Myc.Ast.Compiler.Macros.pas
-1
View File
@@ -371,7 +371,6 @@ begin
boundSubAst: IAstNode;
begin
// This is the compile-time evaluation (Binder + Evaluator)
// 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
Src/AST/Myc.Ast.Environment.pas
+61 -111
View File
@@ -15,7 +15,6 @@ type
IMacroRegistry = interface; // Forward
IEnvironment = interface; // Forward
IExecutionStrategy = interface; // Forward
IExecutable = interface; // Forward
// Defines the Strategy for creating an Evaluator.
IExecutionStrategy = interface
@@ -34,20 +33,6 @@ type
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'}
@@ -57,11 +42,7 @@ type
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 Compile(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc;
function CreateEnvironment: IEnvironment;
@@ -87,10 +68,8 @@ type
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;
function Run(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []; const Args: TArray<TDataValue> = []): TDataValue;
function Compile(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc;
procedure Define(const Name: String; const AScript: IAstNode);
@@ -141,17 +120,6 @@ type
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
@@ -172,8 +140,8 @@ type
procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy);
function Compile(const ANode: IAstNode): IExecutable;
function Execute(const AScript: IExecutable): TDataValue;
function Compile(const ANode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; overload;
function Compile(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc; overload;
end;
// --- Factory Implementations ---
@@ -211,14 +179,9 @@ begin
Result := A.FEnvironment;
end;
function TAstEnvironment.Compile(const ANode: IAstNode): IExecutable;
function TAstEnvironment.Compile(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc;
begin
Result := FEnvironment.Compile(ANode);
end;
function TAstEnvironment.CompileAndExecute(const AScript: IAstNode): TDataValue;
begin
Result := Execute(Compile(AScript));
Result := FEnvironment.Compile(ANode, Params);
end;
function TAstEnvironment.CreateEnvironment: TAstEnvironment;
@@ -228,12 +191,8 @@ 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);
var exec := Compile(AScript);
RootScope.Define(Name, exec([]));
end;
function TAstEnvironment.GetRootScope: IExecutionScope;
@@ -246,6 +205,16 @@ begin
Result := FEnvironment.GetMacroRegistry;
end;
function TAstEnvironment.Run(
const ANode: IAstNode;
const Params: TArray<IIdentifierNode> = [];
const Args: TArray<TDataValue> = []
): TDataValue;
begin
var exec := Compile(ANode, Params);
Result := exec(Args);
end;
{ TStandardExecutionStrategy }
function TStandardExecutionStrategy.CreateVisitor(const AScope: IExecutionScope): IEvaluatorVisitor;
@@ -311,25 +280,6 @@ 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(
@@ -364,56 +314,56 @@ 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;
function TEnvironment.Compile(const ANode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode;
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);
// Step 1: Expand macros
var cExecutionStrategy := FExecutionStrategy;
var expandedAst :=
TMacroExpander.ExpandMacros(
FMacroRegistry,
FRootScope,
ANode,
function(const Scope: IExecutionScope): IEvaluatorVisitor begin Result := cExecutionStrategy.CreateVisitor(Scope); end
);
// 2. Use the strategy to create the final evaluator
visitor := FExecutionStrategy.CreateVisitor(evalScope);
// Step 2: Bind names
var boundAst := TAstBinder.Bind(FRootScope.CreateDescriptor, expandedAst, Descriptor);
// 3. Execute the compiled AST
Result := visitor.Execute(AScript.CompiledAst);
// Step 3: Check types
var typedAst := TTypeChecker.CheckTypes(boundAst, Descriptor);
// Step 4: Lowering
var loweredAst := TAstLowerer.Lower(typedAst);
// Step 5: TCO
var compiledAst := TAstTCO.Optimize(loweredAst);
Result := compiledAst;
end;
function TEnvironment.Compile(const ANode: IAstNode; const Params: TArray<IIdentifierNode> = []): TDataValue.TFunc;
var
desc: IScopeDescriptor;
begin
var prg := TAst.LambdaExpr(Params, ANode);
var compiled := Compile(prg, desc);
var visitor := FExecutionStrategy.CreateVisitor(desc.CreateScope(FRootScope));
var func := compiled.Accept(visitor).AsMethod;
Result :=
function(const Args: TArray<TDataValue>): TDataValue
begin
Result := func(Args);
TEvaluatorVisitor.HandleTCO(Result);
end;
end;
end.
Src/AST/Myc.Ast.Evaluator.pas
+2 -2
View File
@@ -19,7 +19,6 @@ type
private
FScope: IExecutionScope;
class var
procedure HandleTCO(var ResultValue: TDataValue);
protected
// IAstVisitor methods made virtual for TDebugEvaluatorVisitor to override
@@ -60,6 +59,7 @@ type
// Executes an AST with proper TCO handling. This is the main entry point.
function Execute(const RootNode: IAstNode): TDataValue;
class procedure HandleTCO(var ResultValue: TDataValue); static;
end;
implementation
@@ -149,7 +149,7 @@ begin
Result := function(const AScope: IExecutionScope): IEvaluatorVisitor begin Result := TEvaluatorVisitor.Create(AScope); end;
end;
procedure TEvaluatorVisitor.HandleTCO(var ResultValue: TDataValue);
class procedure TEvaluatorVisitor.HandleTCO(var ResultValue: TDataValue);
begin
// This is the central trampoline loop for Tail Call Optimization.
// It runs as long as the evaluation returns a thunk.