Fix in Upvalue-Logic
This commit is contained in:
Michael Schimmel
@@ -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;
|
||||
|
||||
Reference in New Issue
Block a user