From 93dc19497cfe5fcdf1916478934c1ab2d9eb8616 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Sat, 8 Nov 2025 15:57:12 +0100 Subject: [PATCH] Ast environment refactoring --- ASTPlayground/MainForm.pas | 76 +++++------- Src/AST/Myc.Ast.Compiler.Lowering.pas | 22 ++-- Src/AST/Myc.Ast.Compiler.Macros.pas | 1 - Src/AST/Myc.Ast.Environment.pas | 172 +++++++++----------------- Src/AST/Myc.Ast.Evaluator.pas | 4 +- 5 files changed, 109 insertions(+), 166 deletions(-) diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 8db26ca..47bdc24 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -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; 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; diff --git a/Src/AST/Myc.Ast.Compiler.Lowering.pas b/Src/AST/Myc.Ast.Compiler.Lowering.pas index 4005ae3..342a978 100644 --- a/Src/AST/Myc.Ast.Compiler.Lowering.pas +++ b/Src/AST/Myc.Ast.Compiler.Lowering.pas @@ -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.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.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 diff --git a/Src/AST/Myc.Ast.Compiler.Macros.pas b/Src/AST/Myc.Ast.Compiler.Macros.pas index 78308d8..dee9efa 100644 --- a/Src/AST/Myc.Ast.Compiler.Macros.pas +++ b/Src/AST/Myc.Ast.Compiler.Macros.pas @@ -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 diff --git a/Src/AST/Myc.Ast.Environment.pas b/Src/AST/Myc.Ast.Environment.pas index fe4fafb..f6d3097 100644 --- a/Src/AST/Myc.Ast.Environment.pas +++ b/Src/AST/Myc.Ast.Environment.pas @@ -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 = []): 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 = []; const Args: TArray = []): TDataValue; + function Compile(const ANode: IAstNode; const Params: TArray = []): 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 = []): 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 = []): 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 = []; + const Args: TArray = [] +): 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 = []): 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 + begin + Result := func(Args); + TEvaluatorVisitor.HandleTCO(Result); + end; end; end. diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index e22814f..293805c 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -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.