Fix in Upvalue-Logic

2025-09-18 20:11:12 +02:00
parent 5f110e4408
commit d12c6c966c
12 changed files with 819 additions and 96 deletions
@@ -17,7 +17,8 @@ uses
    Myc.Fmx.AstEditor.Text in 'Myc.Fmx.AstEditor.Text.pas',
    Myc.Ast.Traverser in '..\Src\AST\Myc.Ast.Traverser.pas',
    Myc.Ast.Binding in '..\Src\AST\Myc.Ast.Binding.pas',
-    Myc.Ast.RTL in '..\Src\AST\Myc.Ast.RTL.pas';
+    Myc.Ast.RTL in '..\Src\AST\Myc.Ast.RTL.pas',
+    Myc.Ast.Dumper in '..\Src\AST\Myc.Ast.Dumper.pas';

 {$R *.res}

@@ -149,6 +149,7 @@
        <DCCReference Include="..\Src\AST\Myc.Ast.Traverser.pas"/>
        <DCCReference Include="..\Src\AST\Myc.Ast.Binding.pas"/>
        <DCCReference Include="..\Src\AST\Myc.Ast.RTL.pas"/>
+        <DCCReference Include="..\Src\AST\Myc.Ast.Dumper.pas"/>
        <BuildConfiguration Include="Base">
            <Key>Base</Key>
        </BuildConfiguration>
@@ -33,7 +33,7 @@ object Form1: TForm1
    end
    object PrettyPrintButton: TButton
      Position.X = 24.000000000000000000
-      Position.Y = 405.000000000000000000
+      Position.Y = 463.000000000000000000
      TabOrder = 3
      Text = 'Print'
      TextSettings.Trimming = None
@@ -52,7 +52,7 @@ object Form1: TForm1
    end
    object ShowScopeBox: TCheckBox
      Position.X = 24.000000000000000000
-      Position.Y = 465.000000000000000000
+      Position.Y = 436.000000000000000000
      TabOrder = 5
      Text = 'Scope'
    end
@@ -89,7 +89,7 @@ object Form1: TForm1
    end
    object ClearButton: TButton
      Position.X = 24.000000000000000000
-      Position.Y = 496.000000000000000000
+      Position.Y = 538.000000000000000000
      Size.Width = 80.000000000000000000
      Size.Height = 22.000000000000000000
      Size.PlatformDefault = False
@@ -107,7 +107,7 @@ object Form1: TForm1
    end
    object SeriesTestButton: TButton
      Position.X = 24.000000000000000000
-      Position.Y = 274.000000000000000000
+      Position.Y = 258.000000000000000000
      Size.Width = 80.000000000000000000
      Size.Height = 22.000000000000000000
      Size.PlatformDefault = False
@@ -118,7 +118,7 @@ object Form1: TForm1
    end
    object OHLCButton: TButton
      Position.X = 24.000000000000000000
-      Position.Y = 304.000000000000000000
+      Position.Y = 288.000000000000000000
      TabOrder = 14
      Text = 'OHLC'
      TextSettings.Trimming = None
@@ -126,13 +126,13 @@ object Form1: TForm1
    end
    object DebugBox: TCheckBox
      Position.X = 24.000000000000000000
-      Position.Y = 384.000000000000000000
+      Position.Y = 423.000000000000000000
      TabOrder = 15
      Text = 'Debug'
    end
    object FromJSONButton: TButton
      Position.X = 24.000000000000000000
-      Position.Y = 544.000000000000000000
+      Position.Y = 586.000000000000000000
      TabOrder = 16
      Text = 'From JSON'
      TextSettings.Trimming = None
@@ -140,7 +140,7 @@ object Form1: TForm1
    end
    object ToJSONButton: TButton
      Position.X = 24.000000000000000000
-      Position.Y = 574.000000000000000000
+      Position.Y = 616.000000000000000000
      TabOrder = 17
      Text = 'To JSON'
      TextSettings.Trimming = None
@@ -148,12 +148,36 @@ object Form1: TForm1
    end
    object ExternalFuncButton: TButton
      Position.X = 24.000000000000000000
-      Position.Y = 336.000000000000000000
+      Position.Y = 318.000000000000000000
      TabOrder = 18
      Text = 'External Func'
      TextSettings.Trimming = None
      OnClick = ExternalFuncButtonClick
    end
+    object InnerLambdaButton: TButton
+      Position.X = 24.000000000000000000
+      Position.Y = 348.000000000000000000
+      TabOrder = 19
+      Text = 'Inner Lambda'
+      TextSettings.Trimming = None
+      OnClick = InnerLambdaButtonClick
+    end
+    object DumpButton: TButton
+      Position.X = 24.000000000000000000
+      Position.Y = 493.000000000000000000
+      TabOrder = 20
+      Text = 'Dump'
+      TextSettings.Trimming = None
+      OnClick = DumpButtonClick
+    end
+    object FailingUpvalueButton: TButton
+      Position.X = 24.000000000000000000
+      Position.Y = 378.000000000000000000
+      TabOrder = 22
+      Text = 'Upvalue'
+      TextSettings.Trimming = None
+      OnClick = FailingUpvalueButtonClick
+    end
  end
  object Panel2: TPanel
    Align = Client
@@ -30,6 +30,7 @@ uses
    Myc.Ast,
    Myc.Ast.Evaluator,
    Myc.Ast.Printer,
+    Myc.Ast.Dumper,
    FMX.Layouts,
    FMX.Objects,
    Myc.Ast.Debugger;
@@ -66,12 +67,18 @@ type
        FromJSONButton: TButton;
        ToJSONButton: TButton;
        ExternalFuncButton: TButton;
+        InnerLambdaButton: TButton;
+        DumpButton: TButton;
+        FailingUpvalueButton: TButton;
+        procedure InnerLambdaButtonClick(Sender: TObject);
        procedure ClearButtonClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure CreateTriggerExampleButtonClick(Sender: TObject);
        procedure DoTrigger2ButtonClick(Sender: TObject);
        procedure DoTriggerButtonClick(Sender: TObject);
+        procedure DumpButtonClick(Sender: TObject);
        procedure ExternalFuncButtonClick(Sender: TObject);
+        procedure FailingUpvalueButtonClick(Sender: TObject);
        procedure FibonacciButtonClick(Sender: TObject);
        procedure OHLCButtonClick(Sender: TObject);
        procedure PrettyPrintButtonClick(Sender: TObject);
@@ -108,6 +115,76 @@ uses

 {$R *.fmx}

+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(TScalar.FromInteger(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'),
+                                                                boAdd,
+                                                                TAst.Constant(TScalar.FromInteger(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.FromInteger(15) = resultValue.AsScalar, 'The final result should be 15.');
+end;
+
 procedure TForm1.ClearButtonClick(Sender: TObject);
 begin
    FWorkspace.DeleteChildren;
@@ -689,6 +766,21 @@ begin
    Memo1.Lines.Add(Format('Tick(2)! New value of X: %s', [X.ToString]));
 end;

+procedure TForm1.DumpButtonClick(Sender: TObject);
+begin
+    // Call the dumper for the last AST.
+    Memo1.Lines.Clear;
+    Memo1.Lines.Add('--- AST Dump ---');
+
+    if not Assigned(FLastAst) then
+    begin
+        Memo1.Lines.Add('No AST has been generated yet. Click a test button first.');
+        exit;
+    end;
+
+    TAstDumper.Dump(FLastAst, Memo1.Lines);
+end;
+
 procedure TForm1.ExternalFuncButtonClick(Sender: TObject);
 var
    scope: IExecutionScope;
@@ -722,6 +814,64 @@ begin
    Memo1.Lines.Add(Format('Result from delphiAdd(100, 23): %s', [resultValue.ToString]));
 end;

+procedure TForm1.FailingUpvalueButtonClick(Sender: TObject);
+var
+    mainBlock: IAstNode;
+    resultValue: TDataValue;
+begin
+    mainBlock :=
+        TAst.Block(
+            [
+                // 1. Define the shared variable.
+                TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(TScalar.FromInt64(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(
+                        [], // Outer modifier shell
+                        TAst.LambdaExpr(
+                            [], // Inner closure that is returned
+                            TAst.Assign(
+                                TAst.Identifier('a'),
+                                TAst.BinaryExpr(TAst.Identifier('a'), boAdd, TAst.Constant(TScalar.FromInt64(5)))
+                            )
+                        )
+                    )
+                ),
+                // 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
+    else
+    begin
+        Memo1.Lines.Add(Format('FAILURE: Expected 15, but got %s.', [resultValue.ToString]));
+    end;
+
+    Assert(TScalar.FromInteger(15) = resultValue.AsScalar, 'The final result should be 15.');
+    Memo1.Lines.Add('Please check the new dump.');
+end;
+
 procedure TForm1.FromJSONButtonClick(Sender: TObject);
 var
    jsonString: string;