diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr index e71782c..47c82db 100644 --- a/ASTPlayground/ASTPlayground.dpr +++ b/ASTPlayground/ASTPlayground.dpr @@ -5,13 +5,12 @@ uses FMX.Forms, MainForm in 'MainForm.pas' {Form1}, Myc.Ast.Evaluator in '..\Src\AST\Myc.Ast.Evaluator.pas', - Myc.Ast.Printer in '..\Src\AST\Myc.Ast.Printer.pas', Myc.Ast.Nodes in '..\Src\AST\Myc.Ast.Nodes.pas', Myc.Ast.Scope in '..\Src\AST\Myc.Ast.Scope.pas', Myc.Fmx.AstEditor in 'Myc.Fmx.AstEditor.pas', Myc.Data.Value in 'Myc.Data.Value.pas', Myc.Ast.Debugger in '..\Src\AST\Myc.Ast.Debugger.pas', - Myc.Ast.Traverser in '..\Src\AST\Myc.Ast.Traverser.pas', + Myc.Ast.Transformer in '..\Src\AST\Myc.Ast.Transformer.pas', Myc.Ast.Binding in '..\Src\AST\Myc.Ast.Binding.pas', Myc.Ast.RTL in '..\Src\AST\Myc.Ast.RTL.pas', Myc.Ast.Dumper in '..\Src\AST\Myc.Ast.Dumper.pas', diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj index a77672b..c3b857c 100644 --- a/ASTPlayground/ASTPlayground.dproj +++ b/ASTPlayground/ASTPlayground.dproj @@ -136,13 +136,12 @@ fmx - - + diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index ff590db..af1fe16 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -26,7 +26,6 @@ uses Myc.Ast.Nodes, Myc.Ast, Myc.Ast.Evaluator, - Myc.Ast.Printer, Myc.Ast.Dumper, Myc.Data.Decimal, Myc.Ast.Binding, @@ -100,14 +99,14 @@ type procedure TailCallButtenClick(Sender: TObject); procedure ToJSONButtonClick(Sender: TObject); private - // Stores the last AST generated by Test1 or Test2 button clicks. - FLastAst: IAstNode; + FCurrAst: IAstNode; + FCurrDesc: IScopeDescriptor; FGScope: IExecutionScope; FWorkspace: TAuraWorkspace; FTriggerScope: IExecutionScope; FScriptUpdate: Boolean; procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); - function CreateVisitor(Scope: IExecutionScope): IAstVisitor; + function CreateEvaluator(Scope: IExecutionScope): IEvaluatorVisitor; // Helper function to encapsulate the Bind -> Evaluate pattern function ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue; procedure UpdateScript; @@ -131,65 +130,50 @@ uses procedure TForm1.InnerLambdaButtonClick(Sender: TObject); var - // Only the root node is needed as a local variable. mainBlock: IAstNode; - - // Execution and result variables resultValue: TDataValue; begin - // Build the entire AST inline to ensure no node instances are shared. mainBlock := TAst.Block( [ - // var outer = lambda() { ... }; TAst.VarDecl( TAst.Identifier('outer'), TAst.LambdaExpr( [], TAst.Block( [ - // var x = 10; TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(10)), - // var inner = lambda() { ... }; TAst.VarDecl( TAst.Identifier('inner'), TAst.LambdaExpr( [], TAst.Block( [ - // var innermost = lambda() { ... }; TAst.VarDecl( TAst.Identifier('innermost'), TAst.LambdaExpr( [], - // x = x + 5; TAst.Assign( TAst.Identifier('x'), TAst.BinaryExpr(TAst.Identifier('x'), TScalar.TBinaryOp.Add, TAst.Constant(5)) ) ) ), - // innermost(); TAst.FunctionCall(TAst.Identifier('innermost'), []) ] ) ) ), - // inner(); TAst.FunctionCall(TAst.Identifier('inner'), []), - // return x; TAst.Identifier('x') ] ) ) ), - // var finalResult = outer(); TAst.VarDecl(TAst.Identifier('finalResult'), TAst.FunctionCall(TAst.Identifier('outer'), [])) ] ); - FLastAst := mainBlock; - resultValue := ExecuteAst(mainBlock, FGScope); Assert(TScalar.FromInt64(15) = resultValue.AsScalar, 'The final result should be 15, but is ' + resultValue.AsScalar.ToString); @@ -201,18 +185,22 @@ begin FWorkspace.DeleteChildren; FWorkspace.Repaint; - // Create and prepare the global scope once FGScope := TAst.CreateScope(nil); RegisterNativeFunctions(FGScope); end; function TForm1.ExecuteAst(const ANode: IAstNode; const AParentScope: IExecutionScope): TDataValue; +var + binder: IAstBinder; + scriptScope: IExecutionScope; + visitor: IEvaluatorVisitor; begin - // This helper function handles simple, one-off script executions. - // It binds the AST and then decides whether to run a debug session or a standard evaluation. - var scriptScope := TAstBinder.Bind(ANode, AParentScope).CreateScope(AParentScope); - var visitor := CreateVisitor(scriptScope); - Result := visitor.Execute(ANode); + binder := TAstBinder.Create(AParentScope); + FCurrAst := binder.Execute(ANode, FCurrDesc); + + scriptScope := FCurrDesc.CreateScope(AParentScope); + visitor := CreateEvaluator(scriptScope); + Result := visitor.Execute(FCurrAst); end; procedure TForm1.FormCreate(Sender: TObject); @@ -221,13 +209,18 @@ begin FWorkspace.Parent := Panel2; FWorkspace.Align := TAlignLayout.Client; FWorkspace.ClipChildren := true; - FWorkspace.OnMouseDown := WorkspaceMouseDown; Tast.RegisterLibrary( procedure(const Scope: IExecutionScope) + var + smaAst, boundSmaAst: IAstNode; + binder: IAstBinder; + smaDescriptor: IScopeDescriptor; + smaScope: IExecutionScope; + smaVisitor: IEvaluatorVisitor; begin - var smaAst := + smaAst := TAst.LambdaExpr( [TAst.Identifier('len')], TAst.Block( @@ -278,28 +271,32 @@ begin ) ); - Scope.Define('CreateSMA', CreateVisitor(TAstBinder.Bind(smaAst, FGScope).CreateScope(FGScope)).Execute(smaAst)); + binder := TAstBinder.Create(FGScope); + boundSmaAst := binder.Execute(smaAst, smaDescriptor); + + smaScope := smaDescriptor.CreateScope(FGScope); + smaVisitor := CreateEvaluator(smaScope); + + Scope.Define('CreateSMA', smaVisitor.Execute(boundSmaAst)); end ); - // Setup global scope ClearButtonClick(Self); end; procedure TForm1.FibonacciButtonClick(Sender: TObject); var - root: IAstNode; + root, fibAst, boundFibAst: IAstNode; result: TDataValue; sw: TStopwatch; + fibScope: IExecutionScope; + visitor: IEvaluatorVisitor; + binder: IAstBinder; begin - // This script defines a naive, slow recursive 'fib' function (on purpose!). - // The lambda captures its own name ('fib') from the parent scope to perform recursion. - var fibAst := + fibAst := TAst.Block( [ - // 1. var fib; (Declare the name so it can be captured by the lambda) TAst.VarDecl(TAst.Identifier('fib')), - // 2. fib = lambda(n) { ... fib(n-1) + fib(n-2) ... }; TAst.Assign( TAst.Identifier('fib'), TAst.LambdaExpr( @@ -308,13 +305,11 @@ begin TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Less, TAst.Constant(2)), TAst.Identifier('n'), TAst.BinaryExpr( - // Naive recursive call using the variable name 'fib' TAst.FunctionCall( TAst.Identifier('fib'), [TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1))] ), TScalar.TBinaryOp.Add, - // Second naive recursive call TAst.FunctionCall( TAst.Identifier('fib'), [TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(2))] @@ -326,25 +321,22 @@ begin ] ); - // Create a new scope and define the 'fib' function within it. - var fibScope := TAstBinder.Bind(fibAst, FGScope).CreateScope(FGScope); - var visitor := CreateVisitor(fibScope); - visitor.Execute(fibAst); + binder := TAstBinder.Create(FGScope); + var desc: IScopeDescriptor; + boundFibAst := binder.Execute(fibAst, desc); + fibScope := desc.CreateScope(FGScope); + + visitor := CreateEvaluator(fibScope); + visitor.Execute(boundFibAst); Memo1.Lines.Clear; Memo1.Lines.Add('--- Naive recursive fib with AST---'); sw := TStopwatch.StartNew; - // The script to execute is just the call to the function. root := TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]); - - FLastAst := root; - - // Execute within the scope where 'fib' is defined. result := ExecuteAst(root, fibScope); - sw.Stop; - Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); + 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)---'); @@ -353,37 +345,29 @@ begin root := TAst.Block( [ - // Create a memoized version by calling the RTL function on 'fib' TAst.Assign(TAst.Identifier('fib'), TAst.FunctionCall(TAst.Identifier('Memoize'), [TAst.Identifier('fib')])), - // Call the new, memoized function TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)]) ] ); - FLastAst := root; result := ExecuteAst(root, fibScope); - sw.Stop; - Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); + Memo1.Lines.Add(Format('Result: fib(25) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); UpdateScript; end; procedure TForm1.PrettyPrintButtonClick(Sender: TObject); -var - visitor: TPrettyPrintVisitor; begin Memo1.Lines.Clear; Memo1.Lines.Add('--- AST Pretty Print ---'); - if not Assigned(FLastAst) then + if not Assigned(FCurrAst) then begin Memo1.Lines.Add('No AST has been generated yet.'); exit; end; - visitor := TPrettyPrintVisitor.Create; - visitor.Execute(FLastAst); - Memo1.Lines.Add(visitor.GetResult); + Memo1.Lines.Add(TAstScript.Print(FCurrAst)); end; procedure TForm1.RecursionButtonClick(Sender: TObject); @@ -430,7 +414,6 @@ begin ] ); - FLastAst := root; // Execute with FGScope as parent. result := ExecuteAst(root, FGScope); @@ -459,14 +442,12 @@ begin for i := 0 to 4 do begin - // TScalar can no longer hold TDateTime, convert to Int64 for the test. values[0].AsInt64 := Round((Now + i) * 24 * 60 * 60 * 1000); values[1].AsDouble := 100.0 + i; values[2].AsDouble := 105.0 + i; values[3].AsDouble := 98.0 + i; values[4].AsDouble := 102.0 + i; values[5].AsInt64 := 10000 * (i + 1); - series.Add(TScalarRecord.Create(recordDef, values)); end; scope.Define('ohlcvSeries', TDataValue.FromRecordSeries(series)); @@ -485,7 +466,6 @@ begin ) ); - FLastAst := ast; callAst := TAst.FunctionCall(ast, []); resultValue := ExecuteAst(callAst, scope); @@ -515,7 +495,6 @@ begin ) ); - FLastAst := main; callAst := TAst.FunctionCall(main, []); result := ExecuteAst(callAst, FGScope); @@ -554,7 +533,6 @@ begin ] ); - FLastAst := root; result := ExecuteAst(root, FGScope); sw.Stop; @@ -566,7 +544,6 @@ procedure TForm1.WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift begin if Button <> TMouseButton.mbMiddle then exit; - ShowVizualization(X, Y); end; @@ -580,11 +557,15 @@ var scope: IExecutionScope; values: TArray; recordValue: TScalarRecord; + binder: IAstBinder; + setupAst, boundSetupAst, callAst, boundCallAst: IAstNode; + setupDescriptor, callDescriptor: IScopeDescriptor; + seriesAddress: TResolvedAddress; begin Memo1.Lines.Clear; Memo1.Lines.Add(Format('--- Simulating O(1) SMA Crossover Strategy for %d ticks ---', [numRecs])); var sw := TStopwatch.StartNew; - var setupAst := + setupAst := TAst.Block( [ TAst.VarDecl(TAst.Identifier('smaFast'), TAst.FunctionCall(TAst.Identifier('CreateSMA'), [TAst.Constant(smaFastLength)])), @@ -633,27 +614,34 @@ begin ] ); - FLastAst := setupAst; - // 1. Bind and execute the setup script. - scope := TAstBinder.Bind(setupAst, FGScope).CreateScope(FGScope); + binder := TAstBinder.Create(FGScope); + boundSetupAst := binder.Execute(setupAst, setupDescriptor); - // This is a temporary visitor just for the setup execution. - var setupVisitor := CreateVisitor(scope); - setupVisitor.Execute(setupAst); + scope := setupDescriptor.CreateScope(FGScope); + var setupVisitor := CreateEvaluator(scope); + setupVisitor.Execute(boundSetupAst); - // 2. Prepare for the simulation loop by modifying the now-populated scope. + // 2. Prepare for the simulation loop scope.Define('current_series', TDataValue.Void); var currentSeriesIdent := TAst.Identifier('current_series'); - var callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]); + callAst := TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [currentSeriesIdent]); - // 3. Re-bind the scope with the new AST. This creates the FINAL scope for the loop. - scope := TAstBinder.Bind(callAst, scope).CreateScope(scope); - var seriesAddress := currentSeriesIdent.Address; + // 3. Re-bind the call AST within the now-populated scope to resolve the new variable. + binder := TAstBinder.Create(scope); + boundCallAst := binder.Execute(callAst, callDescriptor); - var visitor := CreateVisitor(scope); + // 4. Get the address of 'current_series' from the new descriptor. + var depth, index: Integer; + if not callDescriptor.FindSymbol('current_series', depth, index) then + raise Exception.Create('Could not resolve current_series address.'); + seriesAddress := TResolvedAddress.Create(akLocalOrParent, depth, index); - // 5. Simulation Loop + // 5. Create the final scope and visitor for the simulation loop. + var loopScope := callDescriptor.CreateScope(scope); + var visitor := CreateEvaluator(loopScope); + + // 6. Simulation Loop Memo1.Lines.Add('Starting simulation...'); Application.ProcessMessages; @@ -686,8 +674,8 @@ begin if series.AsRecordSeries.TotalCount >= smaSlowLength then begin - scope[seriesAddress] := series; - var resultValue := visitor.Execute(callAst); + loopScope[seriesAddress] := series; + var resultValue := visitor.Execute(boundCallAst); if i mod 50 = 0 then begin Memo1.Lines.Add(Format('Tick %d/%d: Close = %.2f, Signal = %s', [i, numRecs, ohlcvRec.Close, resultValue.ToString])); @@ -704,7 +692,6 @@ end; procedure TForm1.TailCallButtenClick(Sender: TObject); const - // A large number to prove TCO prevents stack overflow RecursionDepth = 1000000; var root: IAstNode; @@ -719,27 +706,21 @@ begin root := TAst.Block( [ - // var countDown = lambda(n) { ... }; TAst.VarDecl( TAst.Identifier('countDown'), TAst.LambdaExpr( [TAst.Identifier('n')], - // if (n > 0) then recur(n-1) else 0 TAst.IfExpr( TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Greater, TAst.Constant(0)), - // This is the tail call position, now using recur. TAst.Recur([TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1))]), - // Base case of the recursion returns 0 TAst.Constant(0) ) ) ), - // Initial call to start the recursion TAst.FunctionCall(TAst.Identifier('countDown'), [TAst.Constant(RecursionDepth)]) ] ); - FLastAst := root; result := ExecuteAst(root, FGScope); sw.Stop; @@ -751,6 +732,8 @@ end; procedure TForm1.CreateTriggerExampleButtonClick(Sender: TObject); var blk: IAstNode; + binder: IAstBinder; + visitor: IEvaluatorVisitor; begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Creating Trigger Blueprint ---'); @@ -771,20 +754,19 @@ begin ] ); - FTriggerScope := TAstBinder.Bind(blk, FGScope).CreateScope(FGScope); + binder := TAstBinder.Create(FGScope); + FCurrAst := binder.Execute(blk, FCurrDesc); + FTriggerScope := FCurrDesc.CreateScope(FGScope); - // This case is simple enough to just inline the logic from ExecuteAst - var visitor := CreateVisitor(FTriggerScope); - visitor.Execute(blk); - - FLastAst := blk; + visitor := CreateEvaluator(FTriggerScope); + visitor.Execute(FCurrAst); Memo1.Lines.Add('Variable "X" and function "tickHandler" defined in persistent scope.'); Memo1.Lines.Add('Click "Do Trigger" to execute.'); UpdateScript; end; -function TForm1.CreateVisitor(Scope: IExecutionScope): IAstVisitor; +function TForm1.CreateEvaluator(Scope: IExecutionScope): IEvaluatorVisitor; begin if DebugBox.IsChecked then Result := TDebugEvaluatorVisitor.Create(Scope, Memo1.Lines, ShowScopeBox.IsChecked) @@ -797,7 +779,6 @@ var callAst: IFunctionCallNode; begin callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(1)]); - FLastAst := callAst; var X := ExecuteAst(callAst, FTriggerScope); @@ -810,7 +791,6 @@ var callAst: IFunctionCallNode; begin callAst := TAst.FunctionCall(TAst.Identifier('tickHandler'), [TAst.Constant(2)]); - FLastAst := callAst; var X := ExecuteAst(callAst, FTriggerScope); @@ -819,18 +799,21 @@ begin end; procedure TForm1.DumpButtonClick(Sender: TObject); +var + binder: IAstBinder; + boundNode: IAstNode; begin - // Call the dumper for the last AST. Memo1.Lines.Clear; Memo1.Lines.Add('--- AST Dump ---'); - if not Assigned(FLastAst) then + if not Assigned(FCurrAst) then begin Memo1.Lines.Add('No AST has been generated yet. Click a test button first.'); exit; end; - TAstDumper.Dump(FLastAst, Memo1.Lines); + boundNode := binder.Execute(FCurrAst, FCurrDesc); + TAstDumper.Dump(boundNode, Memo1.Lines); end; procedure TForm1.ExternalFuncButtonClick(Sender: TObject); @@ -860,7 +843,6 @@ begin callAst := TAst.FunctionCall(TAst.Identifier('delphiAdd'), [TAst.Constant(100), TAst.Constant(123)]); - FLastAst := callAst; resultValue := ExecuteAst(callAst, scope); Memo1.Lines.Add(Format('Result from delphiAdd(100, 123): %s', [resultValue.ToString])); UpdateScript; @@ -874,10 +856,7 @@ begin mainBlock := TAst.Block( [ - // 1. Define the shared variable. TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(10)), - // 2. Define a function that returns a closure that MODIFIES 'a'. - // This creates the multi-level capture scenario. TAst.VarDecl( TAst.Identifier('modifier'), TAst.LambdaExpr( @@ -891,34 +870,23 @@ begin ) ) ), - // 3. Define a simple closure that READS 'a'. TAst.VarDecl(TAst.Identifier('reader'), TAst.LambdaExpr([], TAst.Identifier('a'))), - // --- Execute the test --- - // 4. Get the inner modifier closure. TAst.VarDecl(TAst.Identifier('innermost_closure'), TAst.FunctionCall(TAst.Identifier('modifier'), [])), - // 5. Call the inner closure to modify 'a'. TAst.FunctionCall(TAst.Identifier('innermost_closure'), []), - // 6. Call the reader to get the final value. TAst.FunctionCall(TAst.Identifier('reader'), []) ] ); - FLastAst := mainBlock; Memo1.Lines.Clear; Memo1.Lines.Add('--- Executing Corrected Upvalue Test ---'); resultValue := ExecuteAst(mainBlock, FGScope); - // With a correct binder and evaluator, the result must be 15. var res := resultValue.AsScalar.Value.AsInt64; if res = 15 then - begin - Memo1.Lines.Add('SUCCESS: The result is 15.'); - end + Memo1.Lines.Add('SUCCESS: The result is 15.') else - begin Memo1.Lines.Add(Format('FAILURE: Expected 15, but got %s.', [resultValue.ToString])); - end; Assert(TScalar.FromInt64(15) = resultValue.AsScalar, 'The final result should be 15.'); Memo1.Lines.Add('Please check the new dump.'); @@ -946,13 +914,15 @@ begin end; try - FLastAst := TAstJson.Deserialize(jsonString); + var binder := TAstBinder.Create(FGScope); + FCurrAst := binder.Execute(TAstJson.Deserialize(jsonString), FCurrDesc); Memo1.Lines.Add('AST deserialized successfully from JSON.'); Memo1.Lines.Add('You can now visualize it (Middle Mouse Click) or pretty-print it.'); except on E: Exception do begin - FLastAst := nil; + FCurrAst := nil; + FCurrDesc := nil; Memo1.Lines.Add('Error deserializing AST from JSON:'); Memo1.Lines.Add(E.Message); Memo1.Lines.Add('--- Original JSON ---'); @@ -970,7 +940,10 @@ begin try FScriptUpdate := true; try - ScriptMemo.Lines.Text := ScriptMemo.Lines.Text + #10#13 + TAstScript.Print(Node); + if Assigned(Node) then + ScriptMemo.Lines.Text := TAstScript.Print(Node) + else + ScriptMemo.Lines.Clear; finally FScriptUpdate := false; end; @@ -987,7 +960,8 @@ begin Memo1.Lines.Clear; try - FLastAst := TAstScript.Parse(ScriptMemo.Lines.Text); + var binder := TAstBinder.Create(FGScope); + FCurrAst := binder.Execute(TAstScript.Parse(ScriptMemo.Lines.Text), FCurrDesc); FWorkspace.DeleteChildren; ShowVizualization(14, 14); @@ -1003,14 +977,14 @@ var begin Memo1.Lines.Clear; - if not Assigned(FLastAst) then + if not Assigned(FCurrAst) then begin Memo1.Lines.Add('No AST available to serialize. Please generate one first.'); exit; end; try - jsonString := TAstJson.Serialize(FLastAst); + jsonString := TAstJson.Serialize(FCurrAst); Memo1.Lines.Text := jsonString; except on E: Exception do @@ -1023,8 +997,7 @@ end; procedure TForm1.UpdateScript; begin - Memo1.Lines.Clear; - PrintScript(FLastAst); + PrintScript(FCurrAst); FWorkspace.DeleteChildren; ShowVizualization(14, 14); @@ -1032,14 +1005,13 @@ end; procedure TForm1.ShowVizualization(X, Y: Single); begin - if FLastAst <> nil then + if FCurrAst <> nil then begin var visu := TVisualizationMode.vmDetailed; if FlowOnlyBox.IsChecked then visu := TVisualizationMode.vmControlFlow; - var descr := TAstBinder.Bind(FLastAst, FGScope); - FWorkspace.BuildTree(FLastAst, descr.CreateScope(FGScope), TPointF.Create(X, Y), visu); + FWorkspace.BuildTree(FCurrAst, FCurrDesc, TPointF.Create(X, Y), visu); end; end; diff --git a/ASTPlayground/Myc.Fmx.AstEditor.Text.pas b/ASTPlayground/Myc.Fmx.AstEditor.Text.pas index 5341a07..b784072 100644 --- a/ASTPlayground/Myc.Fmx.AstEditor.Text.pas +++ b/ASTPlayground/Myc.Fmx.AstEditor.Text.pas @@ -6,40 +6,34 @@ uses System.SysUtils, Myc.Data.Value, Myc.Data.Scalar, + Myc.Ast.Transformer, Myc.Ast.Nodes; type // This visitor converts an AST expression subtree into a single string. - TAstToTextVisitor = class(TInterfacedObject, IAstVisitor) + TAstToTextVisitor = class(TAstVisitor) public - { IAstVisitor } - function Execute(const RootNode: IAstNode): TDataValue; - function VisitConstant(const Node: IConstantNode): TDataValue; - function VisitIdentifier(const Node: IIdentifierNode): TDataValue; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; - function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; - function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; - function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; - function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; - function VisitAssignment(const Node: IAssignmentNode): TDataValue; - function VisitIndexer(const Node: IIndexerNode): TDataValue; - function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; - function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; - function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; - function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; - function VisitRecurNode(const Node: IRecurNode): TDataValue; + function VisitConstant(const Node: IConstantNode): TDataValue; override; + function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; + function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override; + function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override; + function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override; + function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; + function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; + function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; + function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; + function VisitIndexer(const Node: IIndexerNode): TDataValue; override; + function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override; + function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override; + function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override; + function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override; + function VisitRecurNode(const Node: IRecurNode): TDataValue; override; end; implementation -function TAstToTextVisitor.Execute(const RootNode: IAstNode): TDataValue; -begin - Result := RootNode.Accept(Self); -end; - { TAstToTextVisitor } function TAstToTextVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; diff --git a/ASTPlayground/Myc.Fmx.AstEditor.Workspace.pas b/ASTPlayground/Myc.Fmx.AstEditor.Workspace.pas index 6a20c8a..1253e37 100644 --- a/ASTPlayground/Myc.Fmx.AstEditor.Workspace.pas +++ b/ASTPlayground/Myc.Fmx.AstEditor.Workspace.pas @@ -44,7 +44,12 @@ type procedure DblClick; override; public constructor Create(AOwner: TComponent); override; - procedure BuildTree(const RootNode: IAstNode; const RootScope: IExecutionScope; const Position: TPointF; AMode: TVisualizationMode); + procedure BuildTree( + const RootNode: IAstNode; + const RootDescriptor: IScopeDescriptor; + const Position: TPointF; + AMode: TVisualizationMode + ); function GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boolean): Boolean; override; function Zoom(Factor: Single): Boolean; @@ -109,19 +114,17 @@ end; procedure TAuraWorkspace.BuildTree( const RootNode: IAstNode; - const RootScope: IExecutionScope; + const RootDescriptor: IScopeDescriptor; const Position: TPointF; AMode: TVisualizationMode ); var connections: TList; - rootDescriptor: IScopeDescriptor; begin connections := TList.Create; try // Create the scope descriptor from the execution scope provided by the binder. - rootDescriptor := TAstBinder.CreateDescriptor(RootScope); - RootNode.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections, nil, AMode, nil, nil, rootDescriptor)); + RootNode.Accept(TAstToAuraNodeVisitor.Create(Self, Self, Position, connections, nil, AMode, nil, nil, RootDescriptor)); FConnections := FConnections + connections.ToArray; finally connections.Free; diff --git a/ASTPlayground/Myc.Fmx.AstEditor.pas b/ASTPlayground/Myc.Fmx.AstEditor.pas index 152e73d..edb9499 100644 --- a/ASTPlayground/Myc.Fmx.AstEditor.pas +++ b/ASTPlayground/Myc.Fmx.AstEditor.pas @@ -17,6 +17,7 @@ uses Myc.Data.Value, Myc.Ast.Nodes, Myc.Ast.Scope, + Myc.Ast.Transformer, // Für TAstVisitor Myc.Fmx.AstEditor.Node, Myc.Fmx.AstEditor.Workspace; @@ -30,7 +31,7 @@ type TPinShape = (psCircle, psTriangle); TPinAlignment = (paLeft, paRight); - TAstToAuraNodeVisitor = class(TInterfacedObject, IAstVisitor) + TAstToAuraNodeVisitor = class(TAstVisitor) public type TAuraNodeResult = record @@ -101,24 +102,24 @@ type property Connections: TList read FConnections; { IAstVisitor } - function Execute(const RootNode: IAstNode): TDataValue; - function VisitConstant(const Node: IConstantNode): TDataValue; - function VisitIdentifier(const Node: IIdentifierNode): TDataValue; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; - function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; - function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; - function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; - function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; - function VisitAssignment(const Node: IAssignmentNode): TDataValue; - function VisitIndexer(const Node: IIndexerNode): TDataValue; - function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; - function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; - function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; - function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; - function VisitRecurNode(const Node: IRecurNode): TDataValue; + procedure Execute(const RootNode: IAstNode); + function VisitConstant(const Node: IConstantNode): TDataValue; override; + function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; + function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override; + function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override; + function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override; + function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; + function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; + function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; + function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; + function VisitIndexer(const Node: IIndexerNode): TDataValue; override; + function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override; + function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override; + function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override; + function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override; + function VisitRecurNode(const Node: IRecurNode): TDataValue; override; end; implementation @@ -128,6 +129,7 @@ uses System.StrUtils, FMX.Platform, Myc.Data.Scalar, + Myc.Ast.Binding, // For TBound...Node classes Myc.Fmx.AstEditor.Text; { TAstToAuraNodeVisitor } @@ -339,9 +341,9 @@ begin Result.TagString := Tag; end; -function TAstToAuraNodeVisitor.Execute(const RootNode: IAstNode): TDataValue; +procedure TAstToAuraNodeVisitor.Execute(const RootNode: IAstNode); begin - Result := RootNode.Accept(Self); + RootNode.Accept(Self) end; function TAstToAuraNodeVisitor.TryGetDescr(const Node: IAstNode; out Text: String): Boolean; @@ -349,8 +351,7 @@ begin if FMode <> vmControlFlow then exit(false); - var textVisitor: IAstVisitor := TAstToTextVisitor.Create; - Text := Node.Accept(textVisitor).AsText; + Text := Node.Accept(TAstToTextVisitor.Create).AsText; Result := Pos('{', Text) = 0; end; @@ -612,11 +613,13 @@ function TAstToAuraNodeVisitor.VisitIdentifier(const Node: IIdentifierNode): TDa var existingResult: TAuraNodeResult; identifierNode: TAuraNode; + boundNode: TBoundIdentifierNode; begin - if Node.Address.Kind <> akUnresolved then + if Node is TBoundIdentifierNode then begin - // FindNodeForAddress now handles all cases: local cache, on-demand parameter creation, and recursive parent/upvalue lookup. - if FindNodeForAddress(Node.Address, existingResult) then + boundNode := Node as TBoundIdentifierNode; + // FindNodeForAddress handles all cases: local cache, on-demand parameter creation, and recursive parent/upvalue lookup. + if FindNodeForAddress(boundNode.Address, existingResult) then begin FLastResult := existingResult; end @@ -632,7 +635,7 @@ begin end else begin - identifierNode := CreateNodeControl('Identifier', Node.Name); + identifierNode := CreateNodeControl('Identifier (unbound)', Node.Name); FLastResult.LayoutNode := identifierNode; FLastResult.OutputPin := CreateOutput(identifierNode); FinalizeNodeLayout(identifierNode); @@ -756,12 +759,14 @@ var originalAddress: TResolvedAddress; targetVisitor: TAstToAuraNodeVisitor; i: Integer; + boundLambda: TBoundLambdaExpressionNode; begin - if (Address.Kind = akUpvalue) and Assigned(FCurrentLambda) then + if (Address.Kind = akUpvalue) and Assigned(FCurrentLambda) and (FCurrentLambda is TBoundLambdaExpressionNode) then begin - if Address.SlotIndex < Length(FCurrentLambda.Upvalues) then + boundLambda := FCurrentLambda as TBoundLambdaExpressionNode; + if Address.SlotIndex < Length(boundLambda.Upvalues) then begin - originalAddress := FCurrentLambda.Upvalues[Address.SlotIndex]; + originalAddress := boundLambda.Upvalues[Address.SlotIndex]; if Assigned(FParentVisitor) then exit(FParentVisitor.FindNodeForAddress(originalAddress, NodeResult)); end; @@ -799,14 +804,26 @@ var control: TControl; childLastResult: TAuraNodeResult; entryNode, exitNode: TAuraNode; + boundNode: TBoundLambdaExpressionNode; begin + // This visitor must operate on a bound AST. + if not (Node is TBoundLambdaExpressionNode) then + begin + lambdaNode := CreateNodeControl(#$03BB, '(unbound)'); + FinalizeNodeLayout(lambdaNode); + FLastResult.LayoutNode := lambdaNode; + FLastResult.OutputPin := CreateOutput(lambdaNode); + exit(TDataValue.Void); + end; + boundNode := Node as TBoundLambdaExpressionNode; + // Parameter string for the title paramStr := '('; - if Length(Node.Parameters) > 0 then + if Length(boundNode.Parameters) > 0 then begin - paramStr := paramStr + Node.Parameters[0].Name; - for i := 1 to High(Node.Parameters) do - paramStr := paramStr + ', ' + Node.Parameters[i].Name; + paramStr := paramStr + boundNode.Parameters[0].Name; + for i := 1 to High(boundNode.Parameters) do + paramStr := paramStr + ', ' + boundNode.Parameters[i].Name; end; paramStr := paramStr + ')'; @@ -822,8 +839,6 @@ begin entryNode.Parent := lambdaNode; entryNode.Position.Point := TPointF.Create(0, 0); entryNode.Height := pinNodeHeight; - // A lambda expression is a value, it doesn't connect to the parent execution flow. - // Its internal flow starts with the exit of the 'call' node. var internalExec: TArray := [CreateExit(entryNode, '')]; FinalizeNodeLayout(entryNode); @@ -831,24 +846,25 @@ begin childStartPos := TPointF.Create(FSpacing.X, FSpacing.Y + pinNodeHeight); childVisitor := TAstToAuraNodeVisitor - .Create(FWorkspace, lambdaNode, childStartPos, FConnections, internalExec, FMode, Self, Node, Node.ScopeDescriptor); + .Create(FWorkspace, lambdaNode, childStartPos, FConnections, internalExec, FMode, Self, Node, boundNode.ScopeDescriptor); FCurrentExec.Clear; // 4. Let the child visitor create parameter nodes and visit the lambda body. - for var param in Node.Parameters do + for var param in boundNode.Parameters do begin - if param.Address.Kind <> akUnresolved then - begin - var paramNode := childVisitor.CreateNodeControl('Parameter', param.Name); - var paramResult: TAuraNodeResult; - paramResult.LayoutNode := paramNode; - paramResult.OutputPin := childVisitor.CreateOutput(paramNode); - childVisitor.FinalizeNodeLayout(paramNode); - childVisitor.FSlotCache[param.Address.SlotIndex] := paramResult; - end; + if param is TBoundIdentifierNode then + with (param as TBoundIdentifierNode) do + begin + var paramNode := childVisitor.CreateNodeControl('Parameter', Name); + var paramResult: TAuraNodeResult; + paramResult.LayoutNode := paramNode; + paramResult.OutputPin := childVisitor.CreateOutput(paramNode); + childVisitor.FinalizeNodeLayout(paramNode); + childVisitor.FSlotCache[Address.SlotIndex] := paramResult; + end; end; - Node.Body.Accept(childVisitor); + boundNode.Body.Accept(childVisitor); childLastResult := childVisitor.FLastResult; // 5. Resize container to fit all internally generated nodes. @@ -1138,6 +1154,7 @@ var oldParentControl: TControl; oldPos: TPointF; control: TControl; + boundIdentifier: TBoundIdentifierNode; begin if (FMode = vmControlFlow) and TryGetDescr(Node, details) then begin @@ -1194,8 +1211,11 @@ begin FCurrentPos.Y := varDeclNode.Position.Y + varDeclNode.Height + FSpacing.Y; // 8. Die neue Variable im Cache des aktuellen Scopes registrieren. - if Node.Identifier.Address.Kind <> akUnresolved then - FSlotCache[Node.Identifier.Address.SlotIndex] := FLastResult; + if Node.Identifier is TBoundIdentifierNode then + begin + boundIdentifier := Node.Identifier as TBoundIdentifierNode; + FSlotCache[boundIdentifier.Address.SlotIndex] := FLastResult; + end; end; Result := TDataValue.Void; end; diff --git a/Src/AST/Myc.Ast.Binding.pas b/Src/AST/Myc.Ast.Binding.pas index 79ee1ed..3a1bac6 100644 --- a/Src/AST/Myc.Ast.Binding.pas +++ b/Src/AST/Myc.Ast.Binding.pas @@ -8,16 +8,25 @@ uses System.Generics.Collections, Myc.Data.Value, Myc.Ast.Nodes, - Myc.Ast.Traverser, - Myc.Ast.Scope; + Myc.Ast.Transformer, + Myc.Ast.Scope, + Myc.Ast; type - TAstBinder = class(TAstTraverser) + // The binder is a transformer that enriches the AST with semantic information + // like resolved addresses, scopes, and tail-call annotations. + IAstBinder = interface(IAstVisitor) + function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; + end; + + TAstBinder = class(TAstTransformer, IAstBinder) + private type + // Helper class to track upvalues for a lambda expression. TUpvalueMapping = class + public Map: TDictionary; Nodes: TList; - public constructor Create; destructor Destroy; override; end; @@ -27,60 +36,87 @@ type FNestedLambdaCount: Integer; FIsTailStack: TStack; FNextIsTail: Boolean; + procedure EnterScope; procedure ExitScope; - - protected - function Accept(const Node: IAstNode): TDataValue; override; + function GetCurrentDescriptor: IScopeDescriptor; function IsValidIdentifier(const Name: string): Boolean; + protected + // Stack management for tail-call state is centralized here. + function Accept(const Node: IAstNode): TDataValue; override; public constructor Create(const AInitialScope: IExecutionScope); destructor Destroy; override; - class function Bind(const RootNode: IAstNode; const ParentScope: IExecutionScope): IScopeDescriptor; + function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; + class function CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor; static; - function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; - function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; - function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override; - function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; - function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; - function VisitRecurNode(const Node: IRecurNode): TDataValue; override; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override; - function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; + // The binder overrides specific transform methods to enrich the AST. + function TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; override; + function TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; override; + function TransformAssignment(const Node: IAssignmentNode): IAssignmentNode; override; + function TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; override; + function TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode; override; + function TransformRecur(const Node: IRecurNode): IRecurNode; override; + function TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode; override; + function TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode; override; + function TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode; override; + function TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode; override; + function TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode; override; - property CurrentDescriptor: IScopeDescriptor read FCurrentDescriptor; + property CurrentDescriptor: IScopeDescriptor read GetCurrentDescriptor; + end; + + TBoundIdentifierNode = class(TIdentifierNode) + private + FAddress: TResolvedAddress; + public + constructor Create(const AUnboundNode: IIdentifierNode; const AAddress: TResolvedAddress); + property Address: TResolvedAddress read FAddress; + end; + + TBoundLambdaExpressionNode = class(TLambdaExpressionNode) + private + FScopeDescriptor: IScopeDescriptor; + FUpvalues: TArray; + FHasNestedLambdas: Boolean; + public + constructor Create( + const AUnboundNode: ILambdaExpressionNode; + const ABody: IAstNode; + const AParameters: TArray; + const AScopeDescriptor: IScopeDescriptor; + const AUpvalues: TArray; + AHasNestedLambdas: Boolean + ); + + property ScopeDescriptor: IScopeDescriptor read FScopeDescriptor; + property Upvalues: TArray read FUpvalues; + property HasNestedLambdas: Boolean read FHasNestedLambdas; + end; + + TBoundFunctionCallNode = class(TFunctionCallNode) + private + FIsTailCall: Boolean; + public + constructor Create( + const AUnboundNode: IFunctionCallNode; + const ACallee: IAstNode; + const AArguments: TArray; + AIsTailCall: Boolean + ); + property IsTailCall: Boolean read FIsTailCall; end; implementation uses System.Generics.Defaults, - System.Character, - Myc.Ast; + System.Character; type - TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor) - private - FParent: IScopeDescriptor; - FSymbols: TDictionary; - function GetParent: IScopeDescriptor; - function GetSlotCount: Integer; - function GetSymbols: TDictionary; - public - constructor Create(const AParent: IScopeDescriptor); - destructor Destroy; override; - function Define(const Name: string): Integer; - function FindSymbol(const Name: string; out Depth, Index: Integer): Boolean; - function CreateScope(const Parent: IExecutionScope): IExecutionScope; - procedure PopulateFromScope(Scope: TExecutionScope); - property Symbols: TDictionary read FSymbols; - end; - // A custom equality comparer for TResolvedAddress to ensure correct behavior in TDictionary. TResolvedAddressComparer = class(TEqualityComparer) public @@ -88,73 +124,68 @@ type function GetHashCode(const Value: TResolvedAddress): Integer; override; end; -{ TResolvedAddressComparer } +{ TBoundIdentifierNode } +constructor TBoundIdentifierNode.Create(const AUnboundNode: IIdentifierNode; const AAddress: TResolvedAddress); +begin + inherited Create(AUnboundNode.Name); + FAddress := AAddress; +end; +{ TBoundLambdaExpressionNode } +constructor TBoundLambdaExpressionNode.Create( + const AUnboundNode: ILambdaExpressionNode; + const ABody: IAstNode; + const AParameters: TArray; + const AScopeDescriptor: IScopeDescriptor; + const AUpvalues: TArray; + AHasNestedLambdas: Boolean +); +begin + inherited Create(AParameters, ABody); + FScopeDescriptor := AScopeDescriptor; + FUpvalues := AUpvalues; + FHasNestedLambdas := AHasNestedLambdas; +end; + +{ TBoundFunctionCallNode } +constructor TBoundFunctionCallNode.Create( + const AUnboundNode: IFunctionCallNode; + const ACallee: IAstNode; + const AArguments: TArray; + AIsTailCall: Boolean +); +begin + inherited Create(ACallee, AArguments); + FIsTailCall := AIsTailCall; +end; + +{ TResolvedAddressComparer } function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean; begin - // Use the existing equality operator for the record. Result := (Left = Right); end; function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer; begin - // Classic hash combining algorithm using prime numbers. Result := 17; Result := Result * 23 + Ord(Value.Kind); Result := Result * 23 + Value.ScopeDepth; Result := Result * 23 + Value.SlotIndex; end; -{ TAstBinder } - -constructor TAstBinder.Create(const AInitialScope: IExecutionScope); +{ TAstBinder.TUpvalueMapping } +constructor TAstBinder.TUpvalueMapping.Create; begin inherited Create; - FCurrentDescriptor := CreateDescriptor(AInitialScope); - FUpvalueStack := TObjectStack.Create(true); - FNestedLambdaCount := 0; - FIsTailStack := TStack.Create; - // The content of the root node is in a tail position. - FNextIsTail := true; + Map := TDictionary.Create(TResolvedAddressComparer.Create); + Nodes := TList.Create(); end; -destructor TAstBinder.Destroy; +destructor TAstBinder.TUpvalueMapping.Destroy; begin - FIsTailStack.Free; - FUpvalueStack.Free; - inherited; -end; - -function TAstBinder.Accept(const Node: IAstNode): TDataValue; -begin - if not Assigned(Node) or Done then - exit; - - FIsTailStack.Push(FNextIsTail); - try - Result := inherited Accept(Node); - finally - FNextIsTail := FIsTailStack.Pop; - end; -end; - -class function TAstBinder.Bind(const RootNode: IAstNode; const ParentScope: IExecutionScope): IScopeDescriptor; -var - binder: TAstBinder; -begin - binder := TAstBinder.Create(ParentScope); - try - binder.EnterScope; - try - // Start the traversal - binder.Accept(RootNode); - Result := binder.CurrentDescriptor; - finally - binder.ExitScope; - end; - finally - binder.Free; - end; + Nodes.Free; + Map.Free; + inherited Destroy; end; class function TAstBinder.CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor; @@ -169,318 +200,288 @@ begin Result := TScopeDescriptor.Create(nil); end; +constructor TAstBinder.Create(const AInitialScope: IExecutionScope); +begin + inherited Create; + FCurrentDescriptor := CreateDescriptor(AInitialScope); + FUpvalueStack := TObjectStack.Create(True); + FNestedLambdaCount := 0; + FIsTailStack := TStack.Create; + FNextIsTail := True; +end; + +destructor TAstBinder.Destroy; +begin + FIsTailStack.Free; + FUpvalueStack.Free; + inherited; +end; + +function TAstBinder.Accept(const Node: IAstNode): TDataValue; +begin + if (not Assigned(Node)) or Done then + exit; + + FIsTailStack.Push(FNextIsTail); + try + Result := inherited Accept(Node); + finally + FNextIsTail := FIsTailStack.Pop; + end; +end; + procedure TAstBinder.EnterScope; begin FCurrentDescriptor := TScopeDescriptor.Create(FCurrentDescriptor); end; +function TAstBinder.Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; +begin + EnterScope; + try + Result := Accept(RootNode).AsIntf; + Descriptor := FCurrentDescriptor; + finally + ExitScope; + end; +end; + procedure TAstBinder.ExitScope; begin FCurrentDescriptor := FCurrentDescriptor.Parent; end; -function TAstBinder.VisitAssignment(const Node: IAssignmentNode): TDataValue; +function TAstBinder.GetCurrentDescriptor: IScopeDescriptor; begin - FNextIsTail := False; - inherited; -end; - -function TAstBinder.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; -begin - FNextIsTail := False; - inherited; -end; - -function TAstBinder.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; -begin - FNextIsTail := False; - - var n := Node.Expressions.Count - 1; - for var i := 0 to n do - begin - // The last expression is in a tail position IF the block itself is. - if i = n then - FNextIsTail := FIsTailStack.Peek; - - Accept(Node.Expressions[i]); - end; -end; - -function TAstBinder.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; -begin - // Annotate this node based on its context, which is on top of the stack. - (Node as TFunctionCallNode).IsTailCall := FIsTailStack.Peek; - - // Let the default traverser visit children (callee, args), but ensure - // their context is non-tail. - FNextIsTail := False; - inherited; -end; - -function TAstBinder.VisitRecurNode(const Node: IRecurNode): TDataValue; -begin - // Check if the current context is a tail position. - if not FIsTailStack.Peek then - raise Exception.Create('''recur'' can only be used in a tail position.'); - - // Arguments to recur are not in a tail position. - FNextIsTail := False; - inherited; -end; - -function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue; -var - depth, idx: Integer; - identNode: TIdentifierNode; - upvalue: TUpvalueMapping; - originalAddress: TResolvedAddress; - upvalueIndex: Integer; -begin - identNode := Node as TIdentifierNode; - if identNode.Address.Kind <> akUnresolved then - exit; - - if FCurrentDescriptor.FindSymbol(identNode.Name, depth, idx) then - begin - if (depth > 0) and (FUpvalueStack.Count > 0) then - begin - upvalue := FUpvalueStack.Peek; - - // Address is relative to the lambda's parent scope. - dec(depth); - originalAddress := TResolvedAddress.Create(akLocalOrParent, depth, idx); - - if not upvalue.Map.TryGetValue(originalAddress, upvalueIndex) then - begin - upvalueIndex := upvalue.Map.Count; - upvalue.Map.Add(originalAddress, upvalueIndex); - end; - - (Node as TIdentifierNode).Address := TResolvedAddress.Create(akUpvalue, 0, upvalueIndex); - end - else - begin - // 1. case: depth=0 - this is a local var - // 2. case: UpvalueStack is empty - there is no surrounding lambda, we need to reference (and capture) the whole parent scope - (Node as TIdentifierNode).Address := TResolvedAddress.Create(akLocalOrParent, depth, idx); - end; - end - else - raise Exception.CreateFmt('Undefined identifier: "%s"', [identNode.Name]); -end; - -function TAstBinder.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; -begin - // The condition is never in a tail position. - FNextIsTail := False; - Accept(Node.Condition); - - // The branches are in a tail position if the if-expression itself is. - FNextIsTail := FIsTailStack.Peek; - Accept(Node.ThenBranch); - if Assigned(Node.ElseBranch) then - Accept(Node.ElseBranch); -end; - -function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; -var - param: IIdentifierNode; - sourceAddresses: TArray; - sortedPairs: TArray>; -begin - FUpvalueStack.Push(TUpvalueMapping.Create); - try - EnterScope; - try - // Reserve slot 0 for the closure itself (for 'recur'), - // using a name that cannot be accessed from source code. - FCurrentDescriptor.Define(''); - - for param in Node.Parameters do - FCurrentDescriptor.Define(param.Name); - - var lastNestedLambdaCount := FNestedLambdaCount; - - // Parameters are never in a tail position. - FNextIsTail := False; - for param in Node.Parameters do - Accept(param); - - // The body of a lambda is always in a tail position. - FNextIsTail := True; - Accept(Node.Body); - - (Node as TLambdaExpressionNode).HasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount; - (Node as TLambdaExpressionNode).ScopeDescriptor := FCurrentDescriptor; - finally - ExitScope; - end; - finally - var upvalue := FUpvalueStack.Peek; - try - sortedPairs := upvalue.Map.ToArray; - TArray.Sort>( - sortedPairs, - TComparer>.Construct( - function(const Left, Right: TPair): Integer begin Result := Left.Value - Right.Value; end - ) - ); - - SetLength(sourceAddresses, Length(sortedPairs)); - for var i := 0 to High(sortedPairs) do - sourceAddresses[i] := sortedPairs[i].Key; - - (Node as TLambdaExpressionNode).Upvalues := sourceAddresses; - finally - FUpvalueStack.Pop; - end; - - inc(FNestedLambdaCount); - end; -end; - -function TAstBinder.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; -begin - // The condition is never in a tail position. - FNextIsTail := False; - Accept(Node.Condition); - - // The branches are in a tail position if the ternary expression itself is. - FNextIsTail := FIsTailStack.Peek; - Accept(Node.ThenBranch); - Accept(Node.ElseBranch); -end; - -function TAstBinder.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; -begin - FNextIsTail := False; - inherited; + Result := FCurrentDescriptor; end; function TAstBinder.IsValidIdentifier(const Name: string): Boolean; var - i: Integer; c: Char; begin if Name.IsEmpty then exit(False); - // First character must be a letter or underscore. c := Name[1]; if not (c.IsLetter or (c = '_')) then exit(False); - // Subsequent characters can be letters, numbers, underscore, or hyphen. - for i := 2 to Length(Name) do + for c in Name do begin - c := Name[i]; if not (c.IsLetterOrDigit or (c = '_') or (c = '-')) then exit(False); end; - Result := True; end; -function TAstBinder.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; +function TAstBinder.TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; var - slotIndex: Integer; + depth, idx: Integer; begin - // The initializer expression is never in a tail position. - FNextIsTail := False; - if Assigned(Node.Initializer) then - Accept(Node.Initializer); + if FCurrentDescriptor.FindSymbol(Node.Name, depth, idx) then + begin + if (depth > 0) and (FUpvalueStack.Count > 0) then + begin + var upvalue := FUpvalueStack.Peek; + dec(depth); + var originalAddress := TResolvedAddress.Create(akLocalOrParent, depth, idx); - // Reject identifiers that contain special characters or reserved operator characters. + var upvalueIndex: Integer; + if not upvalue.Map.TryGetValue(originalAddress, upvalueIndex) then + begin + upvalueIndex := upvalue.Map.Count; + upvalue.Map.Add(originalAddress, upvalueIndex); + end; + var address := TResolvedAddress.Create(akUpvalue, 0, upvalueIndex); + Result := TBoundIdentifierNode.Create(Node, address); + end + else + begin + var address := TResolvedAddress.Create(akLocalOrParent, depth, idx); + Result := TBoundIdentifierNode.Create(Node, address); + end + end + else + raise Exception.CreateFmt('Undefined identifier: "%s"', [Node.Name]); +end; + +function TAstBinder.TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; +var + initializer: IAstNode; + slotIndex: Integer; + address: TResolvedAddress; + boundIdentifier: IIdentifierNode; +begin if not IsValidIdentifier(Node.Identifier.Name) then raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]); + FNextIsTail := False; + if Node.Initializer <> nil then + initializer := Accept(Node.Initializer).AsIntf; + slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name); - (Node.Identifier as TIdentifierNode).Address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex); + address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex); + + boundIdentifier := TBoundIdentifierNode.Create(Node.Identifier, address); + + Result := TAst.VarDecl(boundIdentifier, initializer); +end; + +function TAstBinder.TransformAssignment(const Node: IAssignmentNode): IAssignmentNode; +begin + FNextIsTail := False; + Result := inherited TransformAssignment(Node); +end; + +function TAstBinder.TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode; +begin + FNextIsTail := False; + Result := inherited TransformBinaryExpression(Node); +end; + +function TAstBinder.TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode; +begin + FNextIsTail := False; + Result := inherited TransformUnaryExpression(Node); +end; + +function TAstBinder.TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; +var + i: integer; + boundParams: TArray; + boundBody: IAstNode; + lambdaScope: IScopeDescriptor; + upvalues: TArray; + hasNestedLambdas: Boolean; + lastNestedLambdaCount: Integer; +begin + FUpvalueStack.Push(TUpvalueMapping.Create); + try + EnterScope; + try + FCurrentDescriptor.Define(''); + + SetLength(boundParams, Length(Node.Parameters)); + for i := 0 to High(Node.Parameters) do + begin + var paramNode := Node.Parameters[i]; + var slotIndex := FCurrentDescriptor.Define(paramNode.Name); + var address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex); + boundParams[i] := TBoundIdentifierNode.Create(paramNode, address); + end; + + lastNestedLambdaCount := FNestedLambdaCount; + + FNextIsTail := True; + boundBody := Accept(Node.Body).AsIntf; + + hasNestedLambdas := FNestedLambdaCount > lastNestedLambdaCount; + lambdaScope := FCurrentDescriptor; + finally + ExitScope; + end; + + var upvalueMapping := FUpvalueStack.Peek; + var sortedPairs := upvalueMapping.Map.ToArray; + TArray.Sort>( + sortedPairs, + TComparer>.Construct( + function(const Left, Right: TPair): Integer begin Result := Left.Value - Right.Value; end + ) + ); + + SetLength(upvalues, Length(sortedPairs)); + for i := 0 to High(sortedPairs) do + upvalues[i] := sortedPairs[i].Key; + + finally + FUpvalueStack.Pop; + end; + + inc(FNestedLambdaCount); + Result := TBoundLambdaExpressionNode.Create(Node, boundBody, boundParams, lambdaScope, upvalues, hasNestedLambdas); +end; + +function TAstBinder.TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode; +var + isTailCall: Boolean; + callee: IAstNode; + args: TArray; +begin + isTailCall := FIsTailStack.Peek; FNextIsTail := False; - Accept(Node.Identifier); + callee := Accept(Node.Callee).AsIntf; + args := TransformNodes(Node.Arguments); + + Result := TBoundFunctionCallNode.Create(Node, callee, args, isTailCall); end; -{ TScopeDescriptor } - -constructor TScopeDescriptor.Create(const AParent: IScopeDescriptor); +function TAstBinder.TransformRecur(const Node: IRecurNode): IRecurNode; begin - inherited Create; - FParent := AParent; - FSymbols := TDictionary.Create; + if not FIsTailStack.Peek then + raise Exception.Create('''recur'' can only be used in a tail position.'); + + FNextIsTail := False; + Result := inherited TransformRecur(Node); end; -destructor TScopeDescriptor.Destroy; -begin - FSymbols.Free; - inherited; -end; - -function TScopeDescriptor.Define(const Name: string): Integer; -begin - Result := FSymbols.Count; - FSymbols.Add(Name, Result); -end; - -function TScopeDescriptor.FindSymbol(const Name: string; out Depth, Index: Integer): Boolean; +function TAstBinder.TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode; var - currentDescriptor: TScopeDescriptor; + exprs: TArray; + i: Integer; + isContextTail: Boolean; begin - Depth := 0; - currentDescriptor := Self; - while currentDescriptor <> nil do + isContextTail := FIsTailStack.Peek; + + SetLength(exprs, Node.Expressions.Count); + for i := 0 to Node.Expressions.Count - 1 do begin - if currentDescriptor.FSymbols.TryGetValue(Name, Index) then - exit(true); - inc(Depth); - currentDescriptor := currentDescriptor.FParent as TScopeDescriptor; + FNextIsTail := isContextTail and (i = Node.Expressions.Count - 1); + exprs[i] := Accept(Node.Expressions[i]).AsIntf; end; - Result := False; + Result := TAst.Block(exprs); end; -function TScopeDescriptor.GetParent: IScopeDescriptor; +function TAstBinder.TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode; +var + isContextTail: Boolean; + condition, thenBranch, elseBranch: IAstNode; begin - Result := FParent; + isContextTail := FIsTailStack.Peek; + + FNextIsTail := False; + condition := Accept(Node.Condition).AsIntf; + + FNextIsTail := isContextTail; + thenBranch := Accept(Node.ThenBranch).AsIntf; + elseBranch := Accept(Node.ElseBranch).AsIntf; + + if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then + Result := TAst.IfExpr(condition, thenBranch, elseBranch) + else + Result := Node; end; -function TScopeDescriptor.GetSlotCount: Integer; +function TAstBinder.TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode; +var + isContextTail: Boolean; + condition, thenBranch, elseBranch: IAstNode; begin - Result := FSymbols.Count; -end; + isContextTail := FIsTailStack.Peek; -function TScopeDescriptor.GetSymbols: TDictionary; -begin - Result := FSymbols; -end; + FNextIsTail := False; + condition := Accept(Node.Condition).AsIntf; -function TScopeDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope; -begin - Result := TExecutionScope.Create(Parent, Self, nil); -end; + FNextIsTail := isContextTail; + thenBranch := Accept(Node.ThenBranch).AsIntf; + elseBranch := Accept(Node.ElseBranch).AsIntf; -procedure TScopeDescriptor.PopulateFromScope(Scope: TExecutionScope); -begin - for var pair in Scope.NameToIndex do - begin - var name := Scope.NameStrings[pair.Key]; - if not FSymbols.ContainsKey(name) then - FSymbols.Add(name, pair.Value); - end; -end; - -constructor TAstBinder.TUpvalueMapping.Create; -begin - inherited Create; - // Use the custom equality comparer to ensure correct dictionary behavior. - Map := TDictionary.Create(TResolvedAddressComparer.Create); - Nodes := TList.Create(); -end; - -destructor TAstBinder.TUpvalueMapping.Destroy; -begin - Nodes.Free; - Map.Free; - inherited Destroy; + if (condition <> Node.Condition) or (thenBranch <> Node.ThenBranch) or (elseBranch <> Node.ElseBranch) then + Result := TAst.TernaryExpr(condition, thenBranch, elseBranch) + else + Result := Node; end; end. diff --git a/Src/AST/Myc.Ast.Debugger.pas b/Src/AST/Myc.Ast.Debugger.pas index e48667b..a9450af 100644 --- a/Src/AST/Myc.Ast.Debugger.pas +++ b/Src/AST/Myc.Ast.Debugger.pas @@ -52,8 +52,7 @@ type implementation uses - System.TypInfo, - Myc.Ast.Printer; + System.TypInfo; { TDebugEvaluatorVisitor } diff --git a/Src/AST/Myc.Ast.Dumper.pas b/Src/AST/Myc.Ast.Dumper.pas index a55636b..284e385 100644 --- a/Src/AST/Myc.Ast.Dumper.pas +++ b/Src/AST/Myc.Ast.Dumper.pas @@ -7,13 +7,18 @@ uses System.Classes, System.Generics.Collections, Myc.Ast.Nodes, - Myc.Ast.Traverser, + Myc.Ast.Transformer, // Wird für TAstVisitor benötigt Myc.Data.Value, Myc.Data.Scalar; type // Dumps a bound AST into a human-readable format for debugging purposes. - TAstDumper = class(TAstTraverser) + // It inherits from the abstract TAstVisitor to implement the IAstVisitor interface. + IAstDumper = interface(IAstVisitor) + procedure Execute(const RootNode: IAstNode); + end; + + TAstDumper = class(TAstVisitor) private FOutput: TStrings; FIndent: Integer; @@ -22,8 +27,6 @@ type procedure Log(const Text: string); overload; procedure LogFmt(const Fmt: string; const Args: array of const); overload; function FormatAddress(const Addr: TResolvedAddress): string; - protected - function Accept(const Node: IAstNode): TDataValue; override; public // Creates a new instance of the AST dumper. constructor Create(const AOutput: TStrings); @@ -31,6 +34,9 @@ type // Traverses the given root node and writes the structural information into the output. class procedure Dump(const RootNode: IAstNode; const Output: TStrings); + procedure Execute(const RootNode: IAstNode); + + // IAstVisitor implementation function VisitConstant(const Node: IConstantNode): TDataValue; override; function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override; @@ -52,19 +58,22 @@ type implementation +uses + Myc.Ast.Binding; // For TBound...Node classes + { TAstDumper } class procedure TAstDumper.Dump(const RootNode: IAstNode; const Output: TStrings); var dumper: TAstDumper; begin - if not Assigned(Output) then + if (not Assigned(Output)) or (not Assigned(RootNode)) then exit; Output.Clear; dumper := TAstDumper.Create(Output); try - dumper.Accept(RootNode); + dumper.Execute(RootNode); finally dumper.Free; end; @@ -77,11 +86,10 @@ begin FIndent := 0; end; -function TAstDumper.Accept(const Node: IAstNode): TDataValue; +procedure TAstDumper.Execute(const RootNode: IAstNode); begin - Result := TDataValue.Void; - if Assigned(Node) then - Result := inherited Accept(Node); + if Assigned(RootNode) then + RootNode.Accept(Self); end; procedure TAstDumper.Indent; @@ -123,7 +131,10 @@ end; function TAstDumper.VisitIdentifier(const Node: IIdentifierNode): TDataValue; begin - LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress(Node.Address)]); + if Node is TBoundIdentifierNode then + LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress((Node as TBoundIdentifierNode).Address)]) + else + LogFmt('Identifier: %s (unbound)', [Node.Name]); Result := TDataValue.Void; end; @@ -131,8 +142,8 @@ function TAstDumper.VisitBinaryExpression(const Node: IBinaryExpressionNode): TD begin LogFmt('BinaryExpression: %s', [Node.Operator.ToString]); Indent; - Accept(Node.Left); - Accept(Node.Right); + Node.Left.Accept(Self); + Node.Right.Accept(Self); Unindent; Result := TDataValue.Void; end; @@ -141,7 +152,7 @@ function TAstDumper.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDat begin LogFmt('UnaryExpression: %s', [Node.Operator.ToString]); Indent; - Accept(Node.Right); + Node.Right.Accept(Self); Unindent; Result := TDataValue.Void; end; @@ -151,13 +162,13 @@ begin Log('IfExpression'); Indent; Log('Condition:'); - Accept(Node.Condition); + Node.Condition.Accept(Self); Log('Then:'); - Accept(Node.ThenBranch); + Node.ThenBranch.Accept(Self); if Assigned(Node.ElseBranch) then begin Log('Else:'); - Accept(Node.ElseBranch); + Node.ElseBranch.Accept(Self); end; Unindent; Result := TDataValue.Void; @@ -168,11 +179,11 @@ begin Log('TernaryExpression'); Indent; Log('Condition:'); - Accept(Node.Condition); + Node.Condition.Accept(Self); Log('Then:'); - Accept(Node.ThenBranch); + Node.ThenBranch.Accept(Self); Log('Else:'); - Accept(Node.ElseBranch); + Node.ElseBranch.Accept(Self); Unindent; Result := TDataValue.Void; end; @@ -182,35 +193,53 @@ var param: IIdentifierNode; upvalueAddr: TResolvedAddress; pair: TPair; + boundNode: TBoundLambdaExpressionNode; begin - LogFmt('LambdaExpression (HasNested: %s)', [Node.HasNestedLambdas.ToString(TUseBoolStrs.True)]); - Indent; + if Node is TBoundLambdaExpressionNode then + begin + boundNode := Node as TBoundLambdaExpressionNode; + LogFmt('LambdaExpression (HasNested: %s)', [boundNode.HasNestedLambdas.ToString(TUseBoolStrs.True)]); + Indent; - Log('Parameters:'); - Indent; - for param in Node.Parameters do - Accept(param); - Unindent; + Log('Parameters:'); + Indent; + for param in boundNode.Parameters do + param.Accept(Self); + Unindent; - LogFmt('Upvalues (%d):', [Length(Node.Upvalues)]); - Indent; - for upvalueAddr in Node.Upvalues do - Log(FormatAddress(upvalueAddr)); - Unindent; + LogFmt('Upvalues (%d):', [Length(boundNode.Upvalues)]); + Indent; + for upvalueAddr in boundNode.Upvalues do + Log(FormatAddress(upvalueAddr)); + Unindent; - Log('Scope Descriptor:'); - Indent; - if Assigned(Node.ScopeDescriptor) then - for pair in Node.ScopeDescriptor.Symbols do - LogFmt('"%s" -> Slot %d', [pair.Key, pair.Value]) + Log('Scope Descriptor:'); + Indent; + if Assigned(boundNode.ScopeDescriptor) then + for pair in boundNode.ScopeDescriptor.Symbols do + LogFmt('"%s" -> Slot %d', [pair.Key, pair.Value]) + else + Log('(none)'); + Unindent; + + Log('Body:'); + boundNode.Body.Accept(Self); + + Unindent; + end else - Log('(none)'); - Unindent; - - Log('Body:'); - Accept(Node.Body); - - Unindent; + begin + Log('LambdaExpression (unbound)'); + Indent; + Log('Parameters:'); + Indent; + for param in Node.Parameters do + param.Accept(Self); + Unindent; + Log('Body:'); + Node.Body.Accept(Self); + Unindent; + end; Result := TDataValue.Void; end; @@ -218,14 +247,18 @@ function TAstDumper.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue var arg: IAstNode; begin - LogFmt('FunctionCall (IsTailCall: %s)', [Node.IsTailCall.ToString(TUseBoolStrs.True)]); + if Node is TBoundFunctionCallNode then + LogFmt('FunctionCall (IsTailCall: %s)', [(Node as TBoundFunctionCallNode).IsTailCall.ToString(TUseBoolStrs.True)]) + else + Log('FunctionCall (unbound)'); + Indent; Log('Callee:'); - Accept(Node.Callee); + Node.Callee.Accept(Self); LogFmt('Arguments (%d):', [Length(Node.Arguments)]); Indent; for arg in Node.Arguments do - Accept(arg); + arg.Accept(Self); Unindent; Unindent; Result := TDataValue.Void; @@ -240,7 +273,7 @@ begin LogFmt('Arguments (%d):', [Length(Node.Arguments)]); Indent; for arg in Node.Arguments do - Accept(arg); + arg.Accept(Self); Unindent; Unindent; Result := TDataValue.Void; @@ -253,7 +286,7 @@ begin Log('BlockExpression'); Indent; for expr in Node.Expressions do - Accept(expr); + expr.Accept(Self); Unindent; Result := TDataValue.Void; end; @@ -262,11 +295,11 @@ function TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNod begin Log('VariableDeclaration'); Indent; - Accept(Node.Identifier); + Node.Identifier.Accept(Self); if Assigned(Node.Initializer) then begin Log('Initializer:'); - Accept(Node.Initializer); + Node.Initializer.Accept(Self); end; Unindent; Result := TDataValue.Void; @@ -276,9 +309,9 @@ function TAstDumper.VisitAssignment(const Node: IAssignmentNode): TDataValue; begin Log('Assignment'); Indent; - Accept(Node.Identifier); + Node.Identifier.Accept(Self); Log('Value:'); - Accept(Node.Value); + Node.Value.Accept(Self); Unindent; Result := TDataValue.Void; end; @@ -288,9 +321,9 @@ begin Log('Indexer'); Indent; Log('Base:'); - Accept(Node.Base); + Node.Base.Accept(Self); Log('Index:'); - Accept(Node.Index); + Node.Index.Accept(Self); Unindent; Result := TDataValue.Void; end; @@ -300,9 +333,9 @@ begin Log('MemberAccess'); Indent; Log('Base:'); - Accept(Node.Base); + Node.Base.Accept(Self); Log('Member:'); - Accept(Node.Member); + Node.Member.Accept(Self); Unindent; Result := TDataValue.Void; end; @@ -318,13 +351,13 @@ begin Log('AddSeriesItem'); Indent; Log('Series:'); - Accept(Node.Series); + Node.Series.Accept(Self); Log('Value:'); - Accept(Node.Value); + Node.Value.Accept(Self); if Assigned(Node.Lookback) then begin Log('Lookback:'); - Accept(Node.Lookback); + Node.Lookback.Accept(Self); end; Unindent; Result := TDataValue.Void; @@ -335,7 +368,7 @@ begin Log('SeriesLength'); Indent; Log('Series:'); - Accept(Node.Series); + Node.Series.Accept(Self); Unindent; Result := TDataValue.Void; end; diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index bd1da95..c0958c7 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -9,14 +9,20 @@ uses Myc.Data.Scalar, Myc.Data.Value, Myc.Ast.Nodes, + Myc.Ast.Transformer, // Neu + Myc.Ast.Binding, Myc.Ast.Scope; type // A factory for creating visitors, primarily used by the debugger subsystem. TVisitorFactory = reference to function(const Scope: IExecutionScope): IAstVisitor; + IEvaluatorVisitor = interface(IAstVisitor) + function Execute(const RootNode: IAstNode): TDataValue; + end; + // The standard AST evaluator for production use. - TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor) + TEvaluatorVisitor = class(TAstVisitor, IEvaluatorVisitor) private FScope: IExecutionScope; protected @@ -34,23 +40,23 @@ type // Executes an AST with proper TCO handling. This is the main entry point. function Execute(const RootNode: IAstNode): TDataValue; - function VisitConstant(const Node: IConstantNode): TDataValue; virtual; - function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; virtual; - function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; virtual; - function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; virtual; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; virtual; - function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; virtual; - function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; virtual; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; virtual; - function VisitAssignment(const Node: IAssignmentNode): TDataValue; virtual; - function VisitIndexer(const Node: IIndexerNode): TDataValue; virtual; - function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; virtual; - function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; virtual; - function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; virtual; - function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual; - function VisitRecurNode(const Node: IRecurNode): TDataValue; virtual; + function VisitConstant(const Node: IConstantNode): TDataValue; override; + function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; + function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override; + function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override; + function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override; + function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; + function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; + function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; + function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; + function VisitIndexer(const Node: IIndexerNode): TDataValue; override; + function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override; + function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override; + function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override; + function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override; + function VisitRecurNode(const Node: IRecurNode): TDataValue; override; end; // Registers native Delphi functions into a scope. @@ -161,30 +167,33 @@ end; function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; var + boundNode: TBoundLambdaExpressionNode; capturedCells: TArray; i: Integer; sourceAddresses: TArray; closureScope: IExecutionScope; visitorFactory: TVisitorFactory; begin - sourceAddresses := Node.Upvalues; + // Cast to the bound node to access binder-specific information. + boundNode := Node as TBoundLambdaExpressionNode; + + sourceAddresses := boundNode.Upvalues; SetLength(capturedCells, Length(sourceAddresses)); for i := 0 to High(sourceAddresses) do capturedCells[i] := FScope.Capture(sourceAddresses[i]); - if Node.HasNestedLambdas then + if boundNode.HasNestedLambdas then closureScope := FScope else closureScope := nil; - // Get the appropriate factory via virtual dispatch. visitorFactory := CreateVisitorFactory(); - var scopeDescriptor := Node.ScopeDescriptor; - var params := Node.Parameters; + var scopeDescriptor := boundNode.ScopeDescriptor; + var params := boundNode.Parameters; - // declare closure as weak to break cyclic referencing when it is captured by itself var [weak] closure: TDataValue.TFunc; + var cNode: ILambdaExpressionNode := Node; closure := TDataValue.TFunc( @@ -204,21 +213,19 @@ begin adr.ScopeDepth := 0; // Capture the closure itself in slot 0 for 'recur' to find it. - // The name 'Self' is no longer exposed to the user by the binder. adr.SlotIndex := 0; lambdaScope[adr] := TDataValue(closure); // Populate the actual parameters. for i := 0 to High(ArgValues) do begin - adr.SlotIndex := params[i].Address.SlotIndex; + // Parameters in a bound lambda must be bound identifiers. + adr.SlotIndex := (params[i] as TBoundIdentifierNode).Address.SlotIndex; lambdaScope[adr] := ArgValues[i]; end; - // Use the injected factory to create the visitor for the lambda's body. bodyVisitor := visitorFactory(lambdaScope); - - Result := Node.Body.Accept(bodyVisitor); + Result := cNode.Body.Accept(bodyVisitor); end ); @@ -229,6 +236,7 @@ function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDa var calleeValue: TDataValue; argValues: TArray; + boundNode: TBoundFunctionCallNode; begin calleeValue := Node.Callee.Accept(Self); if calleeValue.Kind <> vkMethod then @@ -239,19 +247,16 @@ begin for var i := 0 to High(argNodes) do argValues[i] := argNodes[i].Accept(Self); - if Node.IsTailCall then + boundNode := Node as TBoundFunctionCallNode; + if boundNode.IsTailCall then begin - // This is a tail call. Return a thunk to be processed - // by an outer trampoline loop (either in Execute or a parent non-tail-call). + // This is a tail call. Return a thunk to be processed by the trampoline. Result := TDataValue.FromGeneric(TThunk.Create(calleeValue, argValues)); end else begin - // This is a non-tail call. It must execute the call and act as - // the trampoline for any subsequent tail calls it may trigger. - + // This is a non-tail call. It must execute the call and act as the trampoline. Result := (calleeValue.AsMethod)(argValues); - HandleTCO(Result); end; end; @@ -263,23 +268,21 @@ var calleeValue: TDataValue; i: Integer; begin + // The binder ensures this is only in a tail position. if not Node.IsTailCall then raise EInvalidOperation.Create('Recur has to be a tail call'); - // Evaluate all arguments for the recursive call. SetLength(argValues, Length(Node.Arguments)); for i := 0 to High(Node.Arguments) do argValues[i] := Node.Arguments[i].Accept(Self); - // The callee is the current function, which is stored by the lambda - // expression visitor in slot 0 of the current scope. + // The callee is the current function, stored in slot 0 of the current scope. calleeAddress.Kind := akLocalOrParent; calleeAddress.ScopeDepth := 0; calleeAddress.SlotIndex := 0; calleeValue := FScope[calleeAddress]; - // Recur must be in a tail position, so we always return a thunk. - // The binder is responsible for enforcing the tail position rule. + // Recur always returns a thunk for the trampoline. Result := TDataValue.FromGeneric(TThunk.Create(calleeValue, argValues)); end; @@ -288,7 +291,7 @@ var itemValue, lookbackValue, seriesVar: TDataValue; lookback: Int64; begin - seriesVar := FScope[Node.Series.Address]; + seriesVar := FScope[(Node.Series as TBoundIdentifierNode).Address]; itemValue := Node.Value.Accept(Self); lookback := -1; @@ -297,7 +300,6 @@ begin lookbackValue := Node.Lookback.Accept(Self); if (lookbackValue.Kind <> vkScalar) or (lookbackValue.AsScalar.Kind <> TScalar.TKind.Ordinal) then raise EArgumentException.Create('Lookback parameter must be an integer.'); - lookback := lookbackValue.AsScalar.Value.AsInt64; end; @@ -321,7 +323,7 @@ end; function TEvaluatorVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue; begin Result := Node.Value.Accept(Self); - FScope[Node.Identifier.Address] := Result; + FScope[(Node.Identifier as TBoundIdentifierNode).Address] := Result; end; function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TDataValue; @@ -334,13 +336,11 @@ var def: string; begin def := Node.Definition.Trim; - if def.StartsWith('[') then begin var recordDef := TRttiAstHelper.JsonToRecordDefinition(def); if Length(recordDef.Fields) = 0 then raise EArgumentException.Create('Failed to parse record definition from JSON array.'); - var recordSeries := TScalarRecordSeries.Create(recordDef); Result := TDataValue.FromRecordSeries(recordSeries); end @@ -353,7 +353,7 @@ end; function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue; begin - Result := FScope[Node.Address]; + Result := FScope[(Node as TBoundIdentifierNode).Address]; end; function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue; @@ -411,9 +411,11 @@ end; function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; begin if Assigned(Node.Initializer) then - Result := Node.Initializer.Accept(Self); + Result := Node.Initializer.Accept(Self) + else + Result := TDataValue.Void; - FScope[Node.Identifier.Address] := Result; + FScope[(Node.Identifier as TBoundIdentifierNode).Address] := Result; end; function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; @@ -457,7 +459,9 @@ begin if IsTruthy(Node.Condition.Accept(Self)) then Result := Node.ThenBranch.Accept(Self) else if Assigned(Node.ElseBranch) then - Result := Node.ElseBranch.Accept(Self); + Result := Node.ElseBranch.Accept(Self) + else + Result := TDataValue.Void; end; function TEvaluatorVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; @@ -482,7 +486,7 @@ var seriesValue: TDataValue; len: Int64; begin - seriesValue := FScope[Node.Series.Address]; + seriesValue := FScope[(Node.Series as TBoundIdentifierNode).Address]; case seriesValue.Kind of vkSeries: len := seriesValue.AsSeries.Count; diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index 6fec5cd..bb39b75 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -86,8 +86,6 @@ type end; IAstVisitor = interface - function Execute(const RootNode: IAstNode): TDataValue; - function VisitConstant(const Node: IConstantNode): TDataValue; function VisitIdentifier(const Node: IIdentifierNode): TDataValue; function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; @@ -121,11 +119,9 @@ type IIdentifierNode = interface(IAstNode) {$region 'private'} - function GetAddress: TResolvedAddress; function GetName: string; {$endregion} property Name: string read GetName; - property Address: TResolvedAddress read GetAddress; end; IBinaryExpressionNode = interface(IAstNode) @@ -174,26 +170,18 @@ type {$region 'private'} function GetParameters: TArray; function GetBody: IAstNode; - function GetScopeDescriptor: IScopeDescriptor; - function GetUpvalues: TArray; - function GetHasNestedLambdas: Boolean; {$endregion} property Parameters: TArray read GetParameters; property Body: IAstNode read GetBody; - property ScopeDescriptor: IScopeDescriptor read GetScopeDescriptor; - property Upvalues: TArray read GetUpvalues; - property HasNestedLambdas: Boolean read GetHasNestedLambdas; end; IFunctionCallNode = interface(IAstNode) {$region 'private'} function GetCallee: IAstNode; function GetArguments: TArray; - function GetIsTailCall: Boolean; {$endregion} property Callee: IAstNode read GetCallee; property Arguments: TArray read GetArguments; - property IsTailCall: Boolean read GetIsTailCall; end; // A node representing a tail-recursive call. diff --git a/Src/AST/Myc.Ast.Printer.pas b/Src/AST/Myc.Ast.Printer.pas deleted file mode 100644 index 0fe51bc..0000000 --- a/Src/AST/Myc.Ast.Printer.pas +++ /dev/null @@ -1,327 +0,0 @@ -unit Myc.Ast.Printer; - -interface - -uses - System.SysUtils, - System.Classes, - System.Generics.Collections, - Myc.Data.Value, - Myc.Ast.Nodes, - Myc.Ast; - -type - // A visitor that converts an AST into a LISP-like (Clojure-style) string representation. - TPrettyPrintVisitor = class(TInterfacedObject, IAstVisitor) - private - FBuilder: TStringBuilder; - FIndentLevel: Integer; - procedure Indent; - procedure Unindent; - procedure Append(const S: string); - procedure NewLine; - public - constructor Create; - destructor Destroy; override; - function GetResult: string; - // IAstVisitor - function Execute(const RootNode: IAstNode): TDataValue; - function VisitConstant(const Node: IConstantNode): TDataValue; - function VisitIdentifier(const Node: IIdentifierNode): TDataValue; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; - function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; - function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; - function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; - function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; - function VisitAssignment(const Node: IAssignmentNode): TDataValue; - function VisitIndexer(const Node: IIndexerNode): TDataValue; - function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; - function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; - function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; - function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; - function VisitRecurNode(const Node: IRecurNode): TDataValue; - end; - -implementation - -uses - Myc.Data.Scalar; - -{ TPrettyPrintVisitor } - -constructor TPrettyPrintVisitor.Create; -begin - inherited Create; - FBuilder := TStringBuilder.Create; - FIndentLevel := 0; -end; - -destructor TPrettyPrintVisitor.Destroy; -begin - FBuilder.Free; - inherited Destroy; -end; - -function TPrettyPrintVisitor.GetResult: string; -begin - Result := FBuilder.ToString; -end; - -procedure TPrettyPrintVisitor.Indent; -begin - inc(FIndentLevel, 2); -end; - -procedure TPrettyPrintVisitor.Unindent; -begin - dec(FIndentLevel, 2); -end; - -procedure TPrettyPrintVisitor.Append(const S: string); -begin - FBuilder.Append(S); -end; - -procedure TPrettyPrintVisitor.NewLine; -begin - FBuilder.AppendLine; - FBuilder.Append(''.PadLeft(FIndentLevel)); -end; - -function TPrettyPrintVisitor.Execute(const RootNode: IAstNode): TDataValue; -begin - if Assigned(RootNode) then - RootNode.Accept(Self); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): TDataValue; -var - val: TDataValue; -begin - val := Node.Value; - if val.Kind = vkText then - Append('"' + val.AsText + '"') - else - Append(val.ToString); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode): TDataValue; -begin - Append(Node.Name); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; -begin - Append('(' + Node.Operator.ToString); - Append(' '); - Node.Left.Accept(Self); - Append(' '); - Node.Right.Accept(Self); - Append(')'); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; -begin - Append('(' + Node.Operator.ToString); - Append(' '); - Node.Right.Accept(Self); - Append(')'); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; -begin - Append('(if '); - Node.Condition.Accept(Self); - Indent; - NewLine; - Node.ThenBranch.Accept(Self); - if Assigned(Node.ElseBranch) then - begin - NewLine; - Node.ElseBranch.Accept(Self); - end; - Unindent; - NewLine; - Append(')'); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; -begin - Append('(if '); - Node.Condition.Accept(Self); - Indent; - NewLine; - Node.ThenBranch.Accept(Self); - NewLine; - Node.ElseBranch.Accept(Self); - Unindent; - NewLine; - Append(')'); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; -var - param: IIdentifierNode; - sb: TStringBuilder; -begin - sb := TStringBuilder.Create; - try - for param in Node.Parameters do - sb.Append(param.Name + ' '); - if sb.Length > 0 then - sb.Remove(sb.Length - 1, 1); - - Append('(fn [' + sb.ToString + ']'); - finally - sb.Free; - end; - - Indent; - NewLine; - Node.Body.Accept(Self); - Unindent; - NewLine; - Append(')'); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; -var - arg: IAstNode; -begin - Append('('); - Node.Callee.Accept(Self); - - Indent; - for arg in Node.Arguments do - begin - NewLine; - arg.Accept(Self); - end; - Unindent; - - if Length(Node.Arguments) > 0 then - NewLine; - - Append(')'); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitRecurNode(const Node: IRecurNode): TDataValue; -var - arg: IAstNode; -begin - Append('(recur'); - Indent; - for arg in Node.Arguments do - begin - NewLine; - arg.Accept(Self); - end; - Unindent; - if Length(Node.Arguments) > 0 then - NewLine; - Append(')'); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; -var - expr: IAstNode; -begin - Append('(do'); - Indent; - for expr in Node.Expressions do - begin - NewLine; - expr.Accept(Self); - end; - Unindent; - NewLine; - Append(')'); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; -begin - Append('(def '); - Node.Identifier.Accept(Self); - if Assigned(Node.Initializer) then - begin - Append(' '); - Node.Initializer.Accept(Self); - end; - Append(')'); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitAssignment(const Node: IAssignmentNode): TDataValue; -begin - Append('(assign '); - Node.Identifier.Accept(Self); - Append(' '); - Node.Value.Accept(Self); - Append(')'); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue; -begin - Append('(get '); - Node.Base.Accept(Self); - Append(' '); - Node.Index.Accept(Self); - Append(')'); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; -begin - Append('(.'); - Node.Member.Accept(Self); - Append(' '); - Node.Base.Accept(Self); - Append(')'); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; -begin - Append(Format('(new-series "%s")', [Node.Definition])); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; -begin - Append('(add-item '); - Node.Series.Accept(Self); - Append(' '); - Node.Value.Accept(Self); - if Assigned(Node.Lookback) then - begin - Append(' '); - Node.Lookback.Accept(Self); - end; - Append(')'); - Result := TDataValue.Void; -end; - -function TPrettyPrintVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; -begin - Append('(count '); - Node.Series.Accept(Self); - Append(')'); - Result := TDataValue.Void; -end; - -end. diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas index d6020ff..9cd2e86 100644 --- a/Src/AST/Myc.Ast.Scope.pas +++ b/Src/AST/Myc.Ast.Scope.pas @@ -60,6 +60,25 @@ type property Parent: IExecutionScope read FParent; end; + // Describes the layout of a scope: variable names and their slot indices. + // This is generated by the binder and used to create TExecutionScope instances at runtime. + TScopeDescriptor = class(TInterfacedObject, IScopeDescriptor) + private + FParent: IScopeDescriptor; + FSymbols: TDictionary; + function GetParent: IScopeDescriptor; + function GetSlotCount: Integer; + function GetSymbols: TDictionary; + public + constructor Create(const AParent: IScopeDescriptor); + destructor Destroy; override; + function Define(const Name: string): Integer; + function FindSymbol(const Name: string; out Depth, Index: Integer): Boolean; + function CreateScope(const Parent: IExecutionScope): IExecutionScope; + procedure PopulateFromScope(Scope: TExecutionScope); + property Symbols: TDictionary read FSymbols; + end; + implementation uses @@ -339,4 +358,74 @@ begin FValues[FIdx] := AValue; end; +{ TScopeDescriptor } + +constructor TScopeDescriptor.Create(const AParent: IScopeDescriptor); +begin + inherited Create; + FParent := AParent; + FSymbols := TDictionary.Create; +end; + +destructor TScopeDescriptor.Destroy; +begin + FSymbols.Free; + inherited; +end; + +function TScopeDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope; +begin + // Creates a runtime scope instance based on this descriptor's layout. + Result := TExecutionScope.Create(Parent, Self, nil); +end; + +function TScopeDescriptor.Define(const Name: string): Integer; +begin + Result := FSymbols.Count; + FSymbols.Add(Name, Result); +end; + +function TScopeDescriptor.FindSymbol(const Name: string; out Depth, Index: Integer): Boolean; +var + currentDescriptor: TScopeDescriptor; +begin + Depth := 0; + currentDescriptor := Self; + while currentDescriptor <> nil do + begin + if currentDescriptor.FSymbols.TryGetValue(Name, Index) then + exit(True); + inc(Depth); + currentDescriptor := currentDescriptor.FParent as TScopeDescriptor; + end; + Result := False; +end; + +function TScopeDescriptor.GetParent: IScopeDescriptor; +begin + Result := FParent; +end; + +function TScopeDescriptor.GetSlotCount: Integer; +begin + Result := FSymbols.Count; +end; + +function TScopeDescriptor.GetSymbols: TDictionary; +begin + Result := FSymbols; +end; + +procedure TScopeDescriptor.PopulateFromScope(Scope: TExecutionScope); +begin + // This method is likely used to create a descriptor from an existing, dynamically populated scope. + // Note: This relies on internal details of TExecutionScope (NameToIndex, NameStrings). + for var pair in Scope.NameToIndex do + begin + var name := Scope.NameStrings[pair.Key]; + if not FSymbols.ContainsKey(name) then + FSymbols.Add(name, pair.Value); + end; +end; + end. diff --git a/Src/AST/Myc.Ast.Transformer.pas b/Src/AST/Myc.Ast.Transformer.pas new file mode 100644 index 0000000..c365bbd --- /dev/null +++ b/Src/AST/Myc.Ast.Transformer.pas @@ -0,0 +1,427 @@ +unit Myc.Ast.Transformer; + +interface + +uses + System.SysUtils, + System.Generics.Collections, + Myc.Data.Value, + Myc.Ast, + Myc.Ast.Nodes; + +type + // A fully abstract base class for any visitor of the AST. + TAstVisitor = class abstract(TInterfacedObject, IAstVisitor) + public + function VisitConstant(const Node: IConstantNode): TDataValue; virtual; abstract; + function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual; abstract; + function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual; abstract; + function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; virtual; abstract; + function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; virtual; abstract; + function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; virtual; abstract; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; virtual; abstract; + function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; virtual; abstract; + function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; virtual; abstract; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; virtual; abstract; + function VisitAssignment(const Node: IAssignmentNode): TDataValue; virtual; abstract; + function VisitIndexer(const Node: IIndexerNode): TDataValue; virtual; abstract; + function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; virtual; abstract; + function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; virtual; abstract; + function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; virtual; abstract; + function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual; abstract; + function VisitRecurNode(const Node: IRecurNode): TDataValue; virtual; abstract; + end; + + IAstTransformer = interface(IAstVisitor) + function Execute(const RootNode: IAstNode): IAstNode; + end; + + // A base visitor that walks the AST and rebuilds it node by node. + // This class uses the Template Method pattern: + // - The Visit... methods are the template and should not be overridden. + // - The virtual Transform... methods are the hooks for derived classes to customize behavior. + TAstTransformer = class abstract(TAstVisitor, IAstTransformer) + private + FDone: Boolean; + + protected + // Dispatch methods for each node type. Derived classes override these to change the transformation. + function TransformConstant(const Node: IConstantNode): IConstantNode; virtual; + function TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; virtual; + function TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode; virtual; + function TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode; virtual; + function TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode; virtual; + function TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode; virtual; + function TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; virtual; + function TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode; virtual; + function TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode; virtual; + function TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; virtual; + function TransformAssignment(const Node: IAssignmentNode): IAssignmentNode; virtual; + function TransformIndexer(const Node: IIndexerNode): IIndexerNode; virtual; + function TransformMemberAccess(const Node: IMemberAccessNode): IMemberAccessNode; virtual; + function TransformCreateSeries(const Node: ICreateSeriesNode): ICreateSeriesNode; virtual; + function TransformAddSeriesItem(const Node: IAddSeriesItemNode): IAddSeriesItemNode; virtual; + function TransformSeriesLength(const Node: ISeriesLengthNode): ISeriesLengthNode; virtual; + function TransformRecur(const Node: IRecurNode): IRecurNode; virtual; + + // Helper to transform an array of nodes. + function TransformNodes(const Nodes: TArray): TArray; + + function Accept(const Node: IAstNode): TDataValue; virtual; + + property Done: Boolean read FDone write FDone; + public + // This is the main entry point for the transformer, returning a transformed node. + function Execute(const RootNode: IAstNode): IAstNode; + + // Final Visit methods - these should not be overridden. They call the virtual Transform methods. + function VisitConstant(const Node: IConstantNode): TDataValue; override; final; + function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; final; + function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override; final; + function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override; final; + function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override; final; + function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; final; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; override; final; + function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; override; final; + function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; final; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; override; final; + function VisitAssignment(const Node: IAssignmentNode): TDataValue; override; final; + function VisitIndexer(const Node: IIndexerNode): TDataValue; override; final; + function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; override; final; + function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; override; final; + function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; override; final; + function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; override; final; + function VisitRecurNode(const Node: IRecurNode): TDataValue; override; final; + end; + + // TAstTraverser simply inherits the identity-transform (cloning) behavior from TAstTransformer. + TAstTraverser = class(TAstTransformer); + + // Generic traverser for managing state during AST walks. + TAstTraverser = class(TAstTraverser) + private + FData: TStack; + protected + function Accept(const Node: IAstNode): TDataValue; override; + // Called before a node is visited. The returned value is pushed onto the state stack. + function EnterNode(const Node: IAstNode): T; virtual; abstract; + // Called after a node has been visited. + procedure ExitNode(const Node: IAstNode; const Data: T); virtual; + property Data: TStack read FData; + public + constructor Create; + destructor Destroy; override; + end; + +implementation + +{ TAstTransformer } + +function TAstTransformer.Accept(const Node: IAstNode): TDataValue; +begin + if (not Assigned(Node)) or FDone then + exit; + Result := Node.Accept(Self); +end; + +function TAstTransformer.Execute(const RootNode: IAstNode): IAstNode; +begin + Result := Accept(RootNode).AsIntf; +end; + +// --- Default implementations for Transform... methods (Identity Transformation / Cloning) --- + +function TAstTransformer.TransformConstant(const Node: IConstantNode): IConstantNode; +begin + // The node itself is immutable, return it directly. + Result := Node; +end; + +function TAstTransformer.TransformIdentifier(const Node: IIdentifierNode): IIdentifierNode; +begin + Result := Node; +end; + +function TAstTransformer.TransformBinaryExpression(const Node: IBinaryExpressionNode): IBinaryExpressionNode; +begin + var left := Accept(Node.Left).AsIntf; + var right := Accept(Node.Right).AsIntf; + if (left = Node.Left) and (right = Node.Right) then + Result := Node + else + Result := TAst.BinaryExpr(left, Node.Operator, right); +end; + +function TAstTransformer.TransformUnaryExpression(const Node: IUnaryExpressionNode): IUnaryExpressionNode; +begin + var right := Accept(Node.Right).AsIntf; + if right = Node.Right then + Result := Node + else + Result := TAst.UnaryExpr(Node.Operator, right); +end; + +function TAstTransformer.TransformIfExpression(const Node: IIfExpressionNode): IIfExpressionNode; +begin + var condition := Accept(Node.Condition).AsIntf; + var thenBranch := Accept(Node.ThenBranch).AsIntf; + var elseBranch := Accept(Node.ElseBranch).AsIntf; + if (condition = Node.Condition) and (thenBranch = Node.ThenBranch) and (elseBranch = Node.ElseBranch) then + Result := Node + else + Result := TAst.IfExpr(condition, thenBranch, elseBranch); +end; + +function TAstTransformer.TransformTernaryExpression(const Node: ITernaryExpressionNode): ITernaryExpressionNode; +begin + var condition := Accept(Node.Condition).AsIntf; + var thenBranch := Accept(Node.ThenBranch).AsIntf; + var elseBranch := Accept(Node.ElseBranch).AsIntf; + if (condition = Node.Condition) and (thenBranch = Node.ThenBranch) and (elseBranch = Node.ElseBranch) then + Result := Node + else + Result := TAst.TernaryExpr(condition, thenBranch, elseBranch); +end; + +function TAstTransformer.TransformLambdaExpression(const Node: ILambdaExpressionNode): ILambdaExpressionNode; +begin + var parameters := TransformNodes(Node.Parameters); + var body := Accept(Node.Body).AsIntf; + if (parameters = Node.Parameters) and (body = Node.Body) then + Result := Node + else + Result := TAst.LambdaExpr(parameters, body); +end; + +function TAstTransformer.TransformFunctionCall(const Node: IFunctionCallNode): IFunctionCallNode; +begin + var callee := Accept(Node.Callee).AsIntf; + var args := TransformNodes(Node.Arguments); + if (callee = Node.Callee) and (args = Node.Arguments) then + Result := Node + else + Result := TAst.FunctionCall(callee, args); +end; + +function TAstTransformer.TransformBlockExpression(const Node: IBlockExpressionNode): IBlockExpressionNode; +begin + // TList is mutable, so we always transform. + var exprs: TArray; + var i: Integer; + SetLength(exprs, Node.Expressions.Count); + for i := 0 to Node.Expressions.Count - 1 do + exprs[i] := Accept(Node.Expressions[i]).AsIntf; + Result := TAst.Block(exprs); +end; + +function TAstTransformer.TransformVariableDeclaration(const Node: IVariableDeclarationNode): IVariableDeclarationNode; +begin + var identifier := Accept(Node.Identifier).AsIntf; + var initializer := Accept(Node.Initializer).AsIntf; + if (identifier = Node.Identifier) and (initializer = Node.Initializer) then + Result := Node + else + Result := TAst.VarDecl(identifier, initializer); +end; + +function TAstTransformer.TransformAssignment(const Node: IAssignmentNode): IAssignmentNode; +begin + var identifier := Accept(Node.Identifier).AsIntf; + var value := Accept(Node.Value).AsIntf; + if (identifier = Node.Identifier) and (value = Node.Value) then + Result := Node + else + Result := TAst.Assign(identifier, value); +end; + +function TAstTransformer.TransformIndexer(const Node: IIndexerNode): IIndexerNode; +begin + var base := Accept(Node.Base).AsIntf; + var index := Accept(Node.Index).AsIntf; + if (base = Node.Base) and (index = Node.Index) then + Result := Node + else + Result := TAst.Indexer(base, index); +end; + +function TAstTransformer.TransformMemberAccess(const Node: IMemberAccessNode): IMemberAccessNode; +begin + var base := Accept(Node.Base).AsIntf; + var member := Node.Member; + if (base = Node.Base) and (member = Node.Member) then + Result := Node + else + Result := TAst.MemberAccess(base, member); +end; + +function TAstTransformer.TransformCreateSeries(const Node: ICreateSeriesNode): ICreateSeriesNode; +begin + Result := Node; +end; + +function TAstTransformer.TransformAddSeriesItem(const Node: IAddSeriesItemNode): IAddSeriesItemNode; +begin + var series := Accept(Node.Series).AsIntf; + var value := Accept(Node.Value).AsIntf; + var lookback := Accept(Node.Lookback).AsIntf; + if (series = Node.Series) and (value = Node.Value) and (lookback = Node.Lookback) then + Result := Node + else + Result := TAst.AddSeriesItem(series, value, lookback); +end; + +function TAstTransformer.TransformSeriesLength(const Node: ISeriesLengthNode): ISeriesLengthNode; +begin + var series := Accept(Node.Series).AsIntf; + if series = Node.Series then + Result := Node + else + Result := TAst.SeriesLength(series); +end; + +function TAstTransformer.TransformRecur(const Node: IRecurNode): IRecurNode; +begin + var args := TransformNodes(Node.Arguments); + if args = Node.Arguments then + Result := Node + else + Result := TAst.Recur(args); +end; + +function TAstTransformer.TransformNodes(const Nodes: TArray): TArray; +var + i: Integer; + hasChanged: boolean; +begin + hasChanged := False; + SetLength(Result, Length(Nodes)); + for i := 0 to High(Nodes) do + begin + Result[i] := Accept(Nodes[i]).AsIntf; + if Result[i] <> Nodes[i] then + hasChanged := True; + end; + if not hasChanged then + Result := Nodes; +end; + +function TAstTransformer.VisitConstant(const Node: IConstantNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformConstant(Node)); +end; + +function TAstTransformer.VisitIdentifier(const Node: IIdentifierNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformIdentifier(Node)); +end; + +function TAstTransformer.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformBinaryExpression(Node)); +end; + +function TAstTransformer.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformUnaryExpression(Node)); +end; + +function TAstTransformer.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformIfExpression(Node)); +end; + +function TAstTransformer.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformTernaryExpression(Node)); +end; + +function TAstTransformer.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformLambdaExpression(Node)); +end; + +function TAstTransformer.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformFunctionCall(Node)); +end; + +function TAstTransformer.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformBlockExpression(Node)); +end; + +function TAstTransformer.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformVariableDeclaration(Node)); +end; + +function TAstTransformer.VisitAssignment(const Node: IAssignmentNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformAssignment(Node)); +end; + +function TAstTransformer.VisitIndexer(const Node: IIndexerNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformIndexer(Node)); +end; + +function TAstTransformer.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformMemberAccess(Node)); +end; + +function TAstTransformer.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformCreateSeries(Node)); +end; + +function TAstTransformer.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformAddSeriesItem(Node)); +end; + +function TAstTransformer.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformSeriesLength(Node)); +end; + +function TAstTransformer.VisitRecurNode(const Node: IRecurNode): TDataValue; +begin + Result := TDataValue.FromIntf(TransformRecur(Node)); +end; + +{ TAstTraverser } + +constructor TAstTraverser.Create; +begin + inherited Create; + FData := TStack.Create; +end; + +destructor TAstTraverser.Destroy; +begin + FData.Free; + inherited; +end; + +function TAstTraverser.Accept(const Node: IAstNode): TDataValue; +begin + if not Assigned(Node) then + exit; + + FData.Push(EnterNode(Node)); + try + // Call the inherited Accept, which will dispatch to the virtual Visit... methods + // in the base TAstTransformer, performing the transformation/cloning. + Result := inherited Accept(Node); + finally + var data := FData.Pop; + ExitNode(Node, data); + end; +end; + +procedure TAstTraverser.ExitNode(const Node: IAstNode; const Data: T); +begin +end; + +end. diff --git a/Src/AST/Myc.Ast.Traverser.pas b/Src/AST/Myc.Ast.Traverser.pas deleted file mode 100644 index 2b668cc..0000000 --- a/Src/AST/Myc.Ast.Traverser.pas +++ /dev/null @@ -1,233 +0,0 @@ -unit Myc.Ast.Traverser; - -interface - -uses - System.Classes, - System.Generics.Collections, - Myc.Data.Value, - Myc.Ast.Nodes; - -type - // TAstTraverser provides a default AST traversal implementation. - TAstTraverser = class abstract(TInterfacedObject, IAstVisitor) - private - FDone: Boolean; - protected - function Accept(const Node: IAstNode): TDataValue; virtual; - property Done: Boolean read FDone write FDone; - public - function Execute(const RootNode: IAstNode): TDataValue; - - function VisitConstant(const Node: IConstantNode): TDataValue; virtual; - function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; virtual; - function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; virtual; - function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; virtual; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; virtual; - function VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; virtual; - function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; virtual; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; virtual; - function VisitAssignment(const Node: IAssignmentNode): TDataValue; virtual; - function VisitIndexer(const Node: IIndexerNode): TDataValue; virtual; - function VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; virtual; - function VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; virtual; - function VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; virtual; - function VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; virtual; - function VisitRecurNode(const Node: IRecurNode): TDataValue; virtual; - end; - - // Generic traverser for managing state during AST walks. - TAstTraverser = class abstract(TAstTraverser) - private - FData: TStack; - protected - function Accept(const Node: IAstNode): TDataValue; override; - // Called before a node is visited. The returned value is pushed onto the state stack. - function EnterNode(const Node: IAstNode): T; virtual; abstract; - // Called after a node has been visited. - procedure ExitNode(const Node: IAstNode; const Data: T); virtual; - property Data: TStack read FData; - public - constructor Create; - destructor Destroy; override; - end; - -implementation - -{ TAstTraverser } - -function TAstTraverser.Accept(const Node: IAstNode): TDataValue; -begin - if not Assigned(Node) or FDone then - exit; - Result := Node.Accept(Self); -end; - -function TAstTraverser.Execute(const RootNode: IAstNode): TDataValue; -begin - Result := RootNode.Accept(Self); -end; - -function TAstTraverser.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; -begin - Accept(Node.Series); - Accept(Node.Value); - if Assigned(Node.Lookback) then - Accept(Node.Lookback); -end; - -function TAstTraverser.VisitAssignment(const Node: IAssignmentNode): TDataValue; -begin - Accept(Node.Value); - Accept(Node.Identifier); -end; - -function TAstTraverser.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; -begin - Accept(Node.Left); - Accept(Node.Right); -end; - -function TAstTraverser.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; -var - expr: IAstNode; -begin - for expr in Node.Expressions do - begin - if FDone then - break; - Accept(expr); - end; -end; - -function TAstTraverser.VisitConstant(const Node: IConstantNode): TDataValue; -begin -end; - -function TAstTraverser.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; -begin -end; - -function TAstTraverser.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; -var - arg: IAstNode; -begin - Accept(Node.Callee); - - for arg in Node.Arguments do - begin - if FDone then - break; - Accept(arg); - end; -end; - -function TAstTraverser.VisitRecurNode(const Node: IRecurNode): TDataValue; -var - arg: IAstNode; -begin - for arg in Node.Arguments do - begin - if FDone then - break; - Accept(arg); - end; -end; - -function TAstTraverser.VisitIdentifier(const Node: IIdentifierNode): TDataValue; -begin -end; - -function TAstTraverser.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; -begin - Accept(Node.Condition); - Accept(Node.ThenBranch); - if Assigned(Node.ElseBranch) then - Accept(Node.ElseBranch); -end; - -function TAstTraverser.VisitIndexer(const Node: IIndexerNode): TDataValue; -begin - Accept(Node.Base); - Accept(Node.Index); -end; - -function TAstTraverser.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; -var - param: IIdentifierNode; -begin - for param in Node.Parameters do - begin - if FDone then - break; - Accept(param); - end; - Accept(Node.Body); -end; - -function TAstTraverser.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; -begin - // Do not visit the member identifier, as it's not a variable in the current scope. - Accept(Node.Base); -end; - -function TAstTraverser.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; -begin - Accept(Node.Series); -end; - -function TAstTraverser.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; -begin - Accept(Node.Condition); - Accept(Node.ThenBranch); - Accept(Node.ElseBranch); -end; - -function TAstTraverser.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; -begin - Accept(Node.Right); -end; - -function TAstTraverser.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; -begin - if Assigned(Node.Initializer) then - Accept(Node.Initializer); - Accept(Node.Identifier); -end; - -{ TAstTraverser } - -constructor TAstTraverser.Create; -begin - inherited Create; - FData := TStack.Create; -end; - -destructor TAstTraverser.Destroy; -begin - FData.Free; - inherited; -end; - -function TAstTraverser.Accept(const Node: IAstNode): TDataValue; -begin - if not Assigned(Node) or Done then - exit; - - FData.Push(EnterNode(Node)); - try - Result := inherited Accept(Node); - finally - var data := FData.Pop; - ExitNode(Node, data); - end; -end; - -procedure TAstTraverser.ExitNode(const Node: IAstNode; const Data: T); -begin - -end; - -end. diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index d958402..38dc0e5 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -27,7 +27,7 @@ type class procedure RegisterLibrary(const AProc: TRegisterLibraryProc); static; class function CreateScope(Parent: IExecutionScope; const Descriptor: IScopeDescriptor = nil): IExecutionScope; static; - // --- Existing factory functions --- + // --- Factory functions --- class function Constant(const AValue: TDataValue): IConstantNode; overload; static; class function Constant(const AValue: TScalar): IConstantNode; overload; static; class function Constant(const AValue: String): IConstantNode; overload; static; @@ -72,15 +72,11 @@ type TIdentifierNode = class(TAstNode, IIdentifierNode) private FName: string; - // --- Annotation fields added for the binder --- - FResolvedAddress: TResolvedAddress; function GetName: string; - function GetAddress: TResolvedAddress; inline; public constructor Create(AName: string); function Accept(const Visitor: IAstVisitor): TDataValue; override; property Name: string read FName; - property Address: TResolvedAddress read FResolvedAddress write FResolvedAddress; end; TBinaryExpressionNode = class(TAstNode, IBinaryExpressionNode) @@ -137,46 +133,34 @@ type private FParameters: TArray; FBody: IAstNode; - FScopeDescriptor: IScopeDescriptor; - FUpvalues: TArray; - FHasNestedLambdas: Boolean; function GetParameters: TArray; function GetBody: IAstNode; - function GetScopeDescriptor: IScopeDescriptor; - function GetUpvalues: TArray; - function GetHasNestedLambdas: Boolean; public constructor Create(const AParameters: TArray; const ABody: IAstNode); function Accept(const Visitor: IAstVisitor): TDataValue; override; - property HasNestedLambdas: Boolean read FHasNestedLambdas write FHasNestedLambdas; - property ScopeDescriptor: IScopeDescriptor read FScopeDescriptor write FScopeDescriptor; - property Upvalues: TArray read FUpvalues write FUpvalues; + property Body: IAstNode read FBody; + property Parameters: TArray read FParameters; end; TFunctionCallNode = class(TAstNode, IFunctionCallNode) private FCallee: IAstNode; FArguments: TArray; - FIsTailCall: Boolean; function GetCallee: IAstNode; function GetArguments: TArray; - function GetIsTailCall: Boolean; public constructor Create(const ACallee: IAstNode; const AArguments: TArray); function Accept(const Visitor: IAstVisitor): TDataValue; override; - property IsTailCall: Boolean read FIsTailCall write FIsTailCall; end; TRecurNode = class(TAstNode, IRecurNode) private FArguments: TArray; - FIsTailCall: Boolean; function GetArguments: TArray; function GetIsTailCall: Boolean; public constructor Create(const AArguments: TArray); function Accept(const Visitor: IAstVisitor): TDataValue; override; - property IsTailCall: Boolean read FIsTailCall write FIsTailCall; end; TBlockExpressionNode = class(TAstNode, IBlockExpressionNode) @@ -266,9 +250,6 @@ type implementation -uses - Myc.Ast.Traverser; - { TConstantNode } constructor TConstantNode.Create(const AValue: TDataValue); @@ -308,11 +289,6 @@ begin Result := FName; end; -function TIdentifierNode.GetAddress: TResolvedAddress; -begin - Result := FResolvedAddress; -end; - { TBinaryExpressionNode } constructor TBinaryExpressionNode.Create(ALeft: IAstNode; AOperator: TScalar.TBinaryOp; ARight: IAstNode); @@ -434,12 +410,6 @@ begin inherited Create; FBody := ABody; FParameters := AParameters; - FScopeDescriptor := nil; -end; - -function TLambdaExpressionNode.GetUpvalues: TArray; -begin - Result := FUpvalues; end; function TLambdaExpressionNode.Accept(const Visitor: IAstVisitor): TDataValue; @@ -452,21 +422,11 @@ begin Result := FBody; end; -function TLambdaExpressionNode.GetHasNestedLambdas: Boolean; -begin - Result := FHasNestedLambdas; -end; - function TLambdaExpressionNode.GetParameters: TArray; begin Result := FParameters; end; -function TLambdaExpressionNode.GetScopeDescriptor: IScopeDescriptor; -begin - Result := FScopeDescriptor; -end; - { TFunctionCallNode } constructor TFunctionCallNode.Create(const ACallee: IAstNode; const AArguments: TArray); @@ -474,7 +434,6 @@ begin inherited Create; FCallee := ACallee; FArguments := AArguments; - FIsTailCall := False; end; function TFunctionCallNode.Accept(const Visitor: IAstVisitor): TDataValue; @@ -492,18 +451,12 @@ begin Result := FCallee; end; -function TFunctionCallNode.GetIsTailCall: Boolean; -begin - Result := FIsTailCall; -end; - { TRecurNode } constructor TRecurNode.Create(const AArguments: TArray); begin inherited Create; FArguments := AArguments; - FIsTailCall := True; end; function TRecurNode.Accept(const Visitor: IAstVisitor): TDataValue; @@ -518,7 +471,8 @@ end; function TRecurNode.GetIsTailCall: Boolean; begin - Result := FIsTailCall; + // 'recur' is always a tail call by definition. + Result := True; end; { TBlockExpressionNode } diff --git a/Src/Data/Myc.Data.Value.pas b/Src/Data/Myc.Data.Value.pas index 9b4717a..810bf11 100644 --- a/Src/Data/Myc.Data.Value.pas +++ b/Src/Data/Myc.Data.Value.pas @@ -9,7 +9,7 @@ uses Myc.Data.Series; type - TDataValueKind = (vkVoid, vkScalar, vkText, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkGeneric); + TDataValueKind = (vkVoid, vkScalar, vkText, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric); TDataValue = record type @@ -58,6 +58,9 @@ type class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline; class operator Implicit(const AValue: TObject): TDataValue; overload; inline; + class function FromIntf(const AValue: T): TDataValue; static; + function AsIntf: T; inline; + class function FromGeneric(const [ref] AValue: T): TDataValue; static; inline; function AsGeneric: T; inline; @@ -222,6 +225,15 @@ begin Result := TVal(FInterface).Value; end; +function TDataValue.AsIntf: T; +begin + if FKind = Ord(vkLazy) then + exit(AsLazy.Value.AsGeneric); + if FKind <> Ord(vkInterface) then + raise EInvalidCast.Create('Cannot read value as interface.'); + Result := T(FInterface); +end; + function TDataValue.AsObject: TObject; begin if FKind = Ord(vkLazy) then @@ -296,6 +308,12 @@ begin end; end; +class function TDataValue.FromIntf(const AValue: T): TDataValue; +begin + Result.FKind := Ord(vkInterface); + Result.FInterface := IInterface(AValue); +end; + class function TDataValue.FromGeneric(const [ref] AValue: T): TDataValue; begin Result.FKind := Ord(vkGeneric);