diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr index 6b9472e..776c3c1 100644 --- a/ASTPlayground/ASTPlayground.dpr +++ b/ASTPlayground/ASTPlayground.dpr @@ -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} diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj index 39eece6..40c6112 100644 --- a/ASTPlayground/ASTPlayground.dproj +++ b/ASTPlayground/ASTPlayground.dproj @@ -149,6 +149,7 @@ + Base diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index a3ced39..0b78642 100644 --- a/ASTPlayground/MainForm.fmx +++ b/ASTPlayground/MainForm.fmx @@ -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 diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 387e503..2d6bd21 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -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; diff --git a/Src/AST/Myc.Ast.Binding.pas b/Src/AST/Myc.Ast.Binding.pas index 0bc09fb..da6aad0 100644 --- a/Src/AST/Myc.Ast.Binding.pas +++ b/Src/AST/Myc.Ast.Binding.pas @@ -78,6 +78,30 @@ type property Symbols: TDictionary read FSymbols; end; + // A custom equality comparer for TResolvedAddress to ensure correct behavior in TDictionary. + TResolvedAddressComparer = class(TEqualityComparer) + public + function Equals(const Left, Right: TResolvedAddress): Boolean; override; + function GetHashCode(const Value: TResolvedAddress): Integer; override; + 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); @@ -190,6 +214,44 @@ begin 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 + (Node as TIdentifierNode).Address := TResolvedAddress.Create(akLocalOrParent, depth, idx); + end + else + raise Exception.CreateFmt('Undefined identifier: "%s"', [identNode.Name]); +end; + +(* function TAstBinder.VisitIdentifier(const Node: IIdentifierNode): TDataValue; var depth, idx: Integer; @@ -227,7 +289,7 @@ begin 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. @@ -400,7 +462,8 @@ end; constructor TAstBinder.TUpvalueMapping.Create; begin inherited Create; - Map := TDictionary.Create; + // Use the custom equality comparer to ensure correct dictionary behavior. + Map := TDictionary.Create(TResolvedAddressComparer.Create); Nodes := TList.Create(); end; diff --git a/Src/AST/Myc.Ast.Dumper.pas b/Src/AST/Myc.Ast.Dumper.pas new file mode 100644 index 0000000..ae84805 --- /dev/null +++ b/Src/AST/Myc.Ast.Dumper.pas @@ -0,0 +1,327 @@ +unit Myc.Ast.Dumper; + +interface + +uses + System.SysUtils, + System.Classes, + System.Generics.Collections, + Myc.Ast.Nodes, + Myc.Ast.Traverser, + Myc.Data.Value, + Myc.Data.Scalar; + +type + // Dumps a bound AST into a human-readable format for debugging purposes. + TAstDumper = class(TAstTraverser) + private + FOutput: TStrings; + FIndent: Integer; + procedure Indent; + procedure Unindent; + 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); + + // Traverses the given root node and writes the structural information into the output. + class procedure Dump(const RootNode: IAstNode; const Output: TStrings); + + 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; + end; + +implementation + +{ TAstDumper } + +class procedure TAstDumper.Dump(const RootNode: IAstNode; const Output: TStrings); +var + dumper: TAstDumper; +begin + if not Assigned(Output) then + exit; + + Output.Clear; + dumper := TAstDumper.Create(Output); + try + dumper.Accept(RootNode); + finally + dumper.Free; + end; +end; + +constructor TAstDumper.Create(const AOutput: TStrings); +begin + inherited Create; + FOutput := AOutput; + FIndent := 0; +end; + +function TAstDumper.Accept(const Node: IAstNode): TDataValue; +begin + Result := TDataValue.Void; + if Assigned(Node) then + Result := inherited Accept(Node); +end; + +procedure TAstDumper.Indent; +begin + inc(FIndent, 2); +end; + +procedure TAstDumper.Unindent; +begin + dec(FIndent, 2); +end; + +procedure TAstDumper.Log(const Text: string); +begin + FOutput.Add(StringOfChar(' ', FIndent) + Text); +end; + +procedure TAstDumper.LogFmt(const Fmt: string; const Args: array of const); +begin + Log(Format(Fmt, Args)); +end; + +function TAstDumper.FormatAddress(const Addr: TResolvedAddress): string; +begin + case Addr.Kind of + akUnresolved: Result := '!! UNRESOLVED !!'; + akLocalOrParent: Result := Format('LocalOrParent (Depth: %d, Slot: %d)', [Addr.ScopeDepth, Addr.SlotIndex]); + akUpvalue: Result := Format('Upvalue (Index: %d)', [Addr.SlotIndex]); + else + Result := 'Unknown Address Kind'; + end; +end; + +function TAstDumper.VisitConstant(const Node: IConstantNode): TDataValue; +begin + LogFmt('Constant: %s', [Node.Value.ToString]); + Result := TDataValue.Void; +end; + +function TAstDumper.VisitIdentifier(const Node: IIdentifierNode): TDataValue; +begin + LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress(Node.Address)]); + Result := TDataValue.Void; +end; + +function TAstDumper.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; +begin + LogFmt('BinaryExpression: %s', [Node.Operator.ToString]); + Indent; + Accept(Node.Left); + Accept(Node.Right); + Unindent; + Result := TDataValue.Void; +end; + +function TAstDumper.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; +begin + LogFmt('UnaryExpression: %s', [Node.Operator.ToString]); + Indent; + Accept(Node.Right); + Unindent; + Result := TDataValue.Void; +end; + +function TAstDumper.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; +begin + Log('IfExpression'); + Indent; + Log('Condition:'); + Accept(Node.Condition); + Log('Then:'); + Accept(Node.ThenBranch); + if Assigned(Node.ElseBranch) then + begin + Log('Else:'); + Accept(Node.ElseBranch); + end; + Unindent; + Result := TDataValue.Void; +end; + +function TAstDumper.VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; +begin + Log('TernaryExpression'); + Indent; + Log('Condition:'); + Accept(Node.Condition); + Log('Then:'); + Accept(Node.ThenBranch); + Log('Else:'); + Accept(Node.ElseBranch); + Unindent; + Result := TDataValue.Void; +end; + +function TAstDumper.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; +var + param: IIdentifierNode; + upvalueAddr: TResolvedAddress; + pair: TPair; +begin + LogFmt('LambdaExpression (HasNested: %s)', [Node.HasNestedLambdas.ToString]); + Indent; + + Log('Parameters:'); + Indent; + for param in Node.Parameters do + Accept(param); + Unindent; + + LogFmt('Upvalues (%d):', [Length(Node.Upvalues)]); + Indent; + for upvalueAddr in Node.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]) + else + Log('(none)'); + Unindent; + + Log('Body:'); + Accept(Node.Body); + + Unindent; + Result := TDataValue.Void; +end; + +function TAstDumper.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; +var + arg: IAstNode; +begin + LogFmt('FunctionCall (IsTailCall: %s)', [Node.IsTailCall.ToString]); + Indent; + Log('Callee:'); + Accept(Node.Callee); + LogFmt('Arguments (%d):', [Length(Node.Arguments)]); + Indent; + for arg in Node.Arguments do + Accept(arg); + Unindent; + Unindent; + Result := TDataValue.Void; +end; + +function TAstDumper.VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; +var + expr: IAstNode; +begin + Log('BlockExpression'); + Indent; + for expr in Node.Expressions do + Accept(expr); + Unindent; + Result := TDataValue.Void; +end; + +function TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue; +begin + Log('VariableDeclaration'); + Indent; + Accept(Node.Identifier); + if Assigned(Node.Initializer) then + begin + Log('Initializer:'); + Accept(Node.Initializer); + end; + Unindent; + Result := TDataValue.Void; +end; + +function TAstDumper.VisitAssignment(const Node: IAssignmentNode): TDataValue; +begin + Log('Assignment'); + Indent; + Accept(Node.Identifier); + Log('Value:'); + Accept(Node.Value); + Unindent; + Result := TDataValue.Void; +end; + +function TAstDumper.VisitIndexer(const Node: IIndexerNode): TDataValue; +begin + Log('Indexer'); + Indent; + Log('Base:'); + Accept(Node.Base); + Log('Index:'); + Accept(Node.Index); + Unindent; + Result := TDataValue.Void; +end; + +function TAstDumper.VisitMemberAccess(const Node: IMemberAccessNode): TDataValue; +begin + Log('MemberAccess'); + Indent; + Log('Base:'); + Accept(Node.Base); + Log('Member:'); + Accept(Node.Member); + Unindent; + Result := TDataValue.Void; +end; + +function TAstDumper.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; +begin + LogFmt('CreateSeries: %s', [Node.Definition]); + Result := TDataValue.Void; +end; + +function TAstDumper.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue; +begin + Log('AddSeriesItem'); + Indent; + Log('Series:'); + Accept(Node.Series); + Log('Value:'); + Accept(Node.Value); + if Assigned(Node.Lookback) then + begin + Log('Lookback:'); + Accept(Node.Lookback); + end; + Unindent; + Result := TDataValue.Void; +end; + +function TAstDumper.VisitSeriesLength(const Node: ISeriesLengthNode): TDataValue; +begin + Log('SeriesLength'); + Indent; + Log('Series:'); + Accept(Node.Series); + Unindent; + Result := TDataValue.Void; +end; + +end. diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 1c7db9a..3918af0 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -65,7 +65,7 @@ function NativeCreateRecordSeries(const Args: TArray): TDataValue; var jsonDef: string; recordDef: TScalarRecordDefinition; - series: TScalarRecordSeries; + series: IRecordSeries; begin if (Length(Args) <> 1) or (Args[0].Kind <> vkText) then raise EArgumentException.Create('CreateRecordSeries requires one string argument.'); @@ -162,7 +162,7 @@ begin adr.Kind := akLocalOrParent; adr.ScopeDepth := 0; - // Capture 'Self' (slot 0) for recursion. + // Capture 'Self' (slot 0) for recursion using the captured variable. adr.SlotIndex := 0; lambdaScope[adr] := closureValue; @@ -279,8 +279,7 @@ begin else begin var scalarKind := TScalar.StringToKind(def); - var scalarSeries := TScalarSeries.Create(scalarKind); - Result := TDataValue.FromSeries(scalarSeries); + Result := TDataValue.FromSeries(TScalarSeries.Create(scalarKind)); end; end; diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas index ceafa01..6f88862 100644 --- a/Src/AST/Myc.Ast.Scope.pas +++ b/Src/AST/Myc.Ast.Scope.pas @@ -140,7 +140,7 @@ begin case Address.Kind of akUpvalue: begin - // TODO Dieser Pfad wir nie erreicht! + // TODO Dieser Pfad wird nie erreicht! Assert(Assigned(FCapturedUpvalues), 'Attempt to access an upvalue in a scope with no closure context.'); Assert( (Address.SlotIndex >= 0) and (Address.SlotIndex < Length(FCapturedUpvalues)), diff --git a/Test/MycTests.dpr b/Test/MycTests.dpr index fc38ed3..bb7fe9d 100644 --- a/Test/MycTests.dpr +++ b/Test/MycTests.dpr @@ -40,7 +40,8 @@ uses Myc.Data.POD in '..\Src\Data\Myc.Data.Scalar.pas', Myc.Data.Decimal in '..\Src\Data\Myc.Data.Decimal.pas', TestDataDecimal in 'TestDataDecimal.pas', - TestDataPOD in 'TestDataPOD.pas'; + TestDataPOD in 'TestDataPOD.pas', + Test.Ast.Interpreter.Scope in 'Test.Ast.Interpreter.Scope.pas'; { keep comment here to protect the following conditional from being removed by the IDE when adding a unit } {$IFNDEF TESTINSIGHT} diff --git a/Test/MycTests.dproj b/Test/MycTests.dproj index ff213a7..f6d8b1b 100644 --- a/Test/MycTests.dproj +++ b/Test/MycTests.dproj @@ -144,6 +144,7 @@ $(PreBuildEvent)]]> + Base @@ -187,12 +188,6 @@ $(PreBuildEvent)]]> true - - - .\ - true - - MycTests.exe diff --git a/Test/Test.Ast.Interpreter.Scope.pas b/Test/Test.Ast.Interpreter.Scope.pas new file mode 100644 index 0000000..3fb4055 --- /dev/null +++ b/Test/Test.Ast.Interpreter.Scope.pas @@ -0,0 +1,234 @@ +unit Test.Ast.Interpreter.Scope; + +interface + +uses + Myc.Ast, + Myc.Ast.Nodes, + Myc.Ast.Binding, + Myc.Ast.Evaluator, + Myc.Ast.Scope, + Myc.Data.Scalar, + Myc.Data.Value, + DUnitX.TestFramework; + +type + [TestFixture] + TInterpreterScopeTests = class(TObject) + private + FGlobalScope: IExecutionScope; + function Execute(const ANode: IAstNode): TDataValue; + public + [Setup] + procedure Setup; + [TearDown] + procedure TearDown; + + [Test] + procedure Test_DeeplyNestedLambda_ModifiesUpvalue; + + [Test] + procedure Test_SeparateClosures_ShareSameUpvalue; + + [Test] + procedure Test_NestedLambda_CapturesParameter; + + [Test] + procedure Test_VariableShadowing_DoesNotAffectUpvalue; + + [Test] + procedure Test_CaptureFromGlobalScope; + end; + +implementation + +{ TInterpreterScopeTests } + +function TInterpreterScopeTests.Execute(const ANode: IAstNode): TDataValue; +var + boundScope: IExecutionScope; + visitor: IAstVisitor; +begin + // Helper to encapsulate the Bind -> CreateScope -> Evaluate pattern. + boundScope := TAstBinder.Bind(ANode, FGlobalScope).CreateScope(FGlobalScope); + visitor := TEvaluatorVisitor.Create(boundScope); + Result := ANode.Accept(visitor); +end; + +procedure TInterpreterScopeTests.Setup; +begin + FGlobalScope := TAst.CreateScope(nil); +end; + +procedure TInterpreterScopeTests.TearDown; +begin + FGlobalScope := nil; +end; + +procedure TInterpreterScopeTests.Test_DeeplyNestedLambda_ModifiesUpvalue; +var + mainBlock: IAstNode; + resultValue: TDataValue; +begin + // This is our original, simple test case with three nested lambdas. + mainBlock := + TAst.Block( + [ + TAst.VarDecl( + TAst.Identifier('outer'), + TAst.LambdaExpr( + [], + TAst.Block( + [ + TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(TScalar.FromInt64(10))), + TAst.VarDecl( + TAst.Identifier('inner'), + TAst.LambdaExpr( + [], + TAst.Block( + [ + TAst.VarDecl( + TAst.Identifier('innermost'), + TAst.LambdaExpr( + [], + TAst.Assign( + TAst.Identifier('x'), + TAst.BinaryExpr( + TAst.Identifier('x'), + boAdd, + TAst.Constant(TScalar.FromInt64(5)) + ) + ) + ) + ), + TAst.FunctionCall(TAst.Identifier('innermost'), []) + ] + ) + ) + ), + TAst.FunctionCall(TAst.Identifier('inner'), []), + TAst.Identifier('x') + ] + ) + ) + ), + TAst.VarDecl(TAst.Identifier('finalResult'), TAst.FunctionCall(TAst.Identifier('outer'), [])) + ] + ); + + resultValue := Execute(mainBlock); + Assert.AreEqual(15, resultValue.AsScalar.Value.AsInt64, 'The final result should be 15.'); +end; + +procedure TInterpreterScopeTests.Test_SeparateClosures_ShareSameUpvalue; +var + mainBlock: IAstNode; + resultValue: TDataValue; +begin + // This is our more complex "modifier/reader" test case. + mainBlock := + TAst.Block( + [ + TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(TScalar.FromInt64(10))), + 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))) + ) + ) + ) + ), + TAst.VarDecl(TAst.Identifier('reader'), TAst.LambdaExpr([], TAst.Identifier('a'))), + TAst.VarDecl(TAst.Identifier('innermost_closure'), TAst.FunctionCall(TAst.Identifier('modifier'), [])), + TAst.FunctionCall(TAst.Identifier('innermost_closure'), []), + TAst.FunctionCall(TAst.Identifier('reader'), []) + ] + ); + + resultValue := Execute(mainBlock); + Assert.AreEqual(15, resultValue.AsScalar.Value.AsInt64, 'The final result should be 15.'); +end; + +procedure TInterpreterScopeTests.Test_NestedLambda_CapturesParameter; +var + mainBlock: IAstNode; + resultValue: TDataValue; +begin + // Tests if a nested lambda can correctly capture a PARAMETER of its parent lambda. + mainBlock := + TAst.Block( + [ + TAst.VarDecl( + TAst.Identifier('factory'), + TAst.LambdaExpr( + [TAst.Identifier('p')], // Parameter 'p' + TAst.LambdaExpr( + [], // Returned lambda captures 'p' + TAst.BinaryExpr(TAst.Identifier('p'), boMultiply, TAst.Constant(TScalar.FromInt64(2))) + ) + ) + ), + TAst.VarDecl( + TAst.Identifier('multiplier'), + TAst.FunctionCall(TAst.Identifier('factory'), [TAst.Constant(TScalar.FromInt64(21))]) + ), + TAst.FunctionCall(TAst.Identifier('multiplier'), []) + ] + ); + + resultValue := Execute(mainBlock); + Assert.AreEqual(42, resultValue.AsScalar.Value.AsInt64, 'The result of 21 * 2 should be 42.'); +end; + +procedure TInterpreterScopeTests.Test_VariableShadowing_DoesNotAffectUpvalue; +var + mainBlock: IAstNode; + resultValue: TDataValue; +begin + // Tests that a local variable 'x' correctly "shadows" a parent's variable 'x'. + // The modification of the inner 'x' must not affect the outer 'x'. + mainBlock := + TAst.Block( + [ + TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(TScalar.FromInt64(10))), + TAst.FunctionCall( + TAst.LambdaExpr( + [], + TAst.Block( + [ + // This 'x' should shadow the outer 'x'. + TAst.VarDecl(TAst.Identifier('x'), TAst.Constant(TScalar.FromInt64(50))), + TAst.Assign(TAst.Identifier('x'), TAst.Constant(TScalar.FromInt64(99))) + ] + ) + ), + [] + ), + // This final expression should return the value of the original, outer 'x'. + TAst.Identifier('x') + ] + ); + + resultValue := Execute(mainBlock); + Assert.AreEqual(10, resultValue.AsScalar.Value.AsInt64, 'The outer "x" should remain unchanged.'); +end; + +procedure TInterpreterScopeTests.Test_CaptureFromGlobalScope; +var + mainBlock: IAstNode; + resultValue: TDataValue; +begin + // Defines a variable in the global scope and ensures a simple script can access it. + FGlobalScope.Define('g', TScalar.FromInt64(99)); + mainBlock := TAst.BinaryExpr(TAst.Identifier('g'), boAdd, TAst.Constant(TScalar.FromInt64(1))); + + resultValue := Execute(mainBlock); + Assert.AreEqual(100, resultValue.AsScalar.Value.AsInt64, 'Should be able to access variables from the parent scope.'); +end; + +end. diff --git a/Test/TestDataPOD.pas b/Test/TestDataPOD.pas index 831858f..22c83fc 100644 --- a/Test/TestDataPOD.pas +++ b/Test/TestDataPOD.pas @@ -48,11 +48,6 @@ type procedure TestScalarTuple; [Test] procedure TestScalarRecordAndDefinition; - [Test] - procedure TestScalarSeries; - - [Test] - procedure TestScalarRecordSeries; end; implementation @@ -254,73 +249,6 @@ begin ); end; -procedure TTestPOD.TestScalarSeries; -var - seriesData: TArray; - series: TSeries; - scalarSeries: TScalarSeries; -begin - seriesData := - [ - TScalar.FromDouble(101.5).Value, - TScalar.FromDouble(102.0).Value, - TScalar.FromDouble(101.8).Value, - TScalar.FromDouble(103.2).Value - ]; - - series := TSeries.CreateFromArray(seriesData, -1); - scalarSeries := TScalarSeries.Create(skDouble, series); - - Assert.AreEqual(skDouble, scalarSeries.Kind, 'Series kind mismatch'); - Assert.AreEqual(4, scalarSeries.Items.Count, 'Series count mismatch'); - Assert.AreEqual(Int64(4), scalarSeries.Items.TotalCount, 'Series total count mismatch'); - - // TSeries index is reversed: 0 is the last item - Assert.AreEqual(103.2, scalarSeries.Items[0].AsDouble, 1E-12, 'Series item [0] mismatch'); - Assert.AreEqual(101.5, scalarSeries.Items[3].AsDouble, 1E-12, 'Series item [3] mismatch'); -end; - -procedure TTestPOD.TestScalarRecordSeries; -var - recDef: TScalarRecordDefinition; - series: TScalarRecordSeries; - rec1, rec2, rec3: TScalarRecord; - retrievedRec: TScalarRecord; -begin - // 1. Define the structure of the records in the series - recDef := TScalarRecordDefinition.Create([TScalarRecordField.Create('ID', skInt64), TScalarRecordField.Create('Price', skDecimal)]); - - // 2. Create the series with the definition - series := TScalarRecordSeries.Create(recDef); - Assert.AreEqual(Int64(0), series.TotalCount, 'Initial series should be empty'); - - // 3. Create some records - rec1 := TScalarRecord.Create(recDef, [TScalarValue.FromInt64(1), TScalarValue.FromDecimal(TDecimal.Create(100, 2))]); - rec2 := TScalarRecord.Create(recDef, [TScalarValue.FromInt64(2), TScalarValue.FromDecimal(TDecimal.Create(101, 2))]); - rec3 := TScalarRecord.Create(recDef, [TScalarValue.FromInt64(3), TScalarValue.FromDecimal(TDecimal.Create(102, 2))]); - - // 4. Add records to the series - series.Add(rec1); - series.Add(rec2); - series.Add(rec3); - - // 5. Verify the state of the series - Assert.AreEqual(Int64(3), series.TotalCount, 'Series total count mismatch after adding items'); - - // 6. Check items. Index 0 is the last added item. - retrievedRec := series.Items[0]; // Should be rec3 - Assert.AreEqual(skInt64, retrievedRec['ID'].Kind, 'Item[0] ID kind mismatch'); - Assert.AreEqual(Int64(3), retrievedRec['ID'].Value.AsInt64, 'Item[0] ID value mismatch'); - Assert.AreEqual(TDecimal.Create(102, 2), retrievedRec['Price'].Value.AsDecimal, 'Item[0] Price value mismatch'); - - retrievedRec := series.Items[1]; // Should be rec2 - Assert.AreEqual(Int64(2), retrievedRec.Items['ID'].Value.AsInt64, 'Item[1] ID value mismatch'); - - retrievedRec := series.Items[2]; // Should be rec1 - Assert.AreEqual(Int64(1), retrievedRec.Items['ID'].Value.AsInt64, 'Item[2] ID value mismatch'); - Assert.AreEqual(TDecimal.Create(100, 2), retrievedRec.Items['Price'].Value.AsDecimal, 'Item[2] Price value mismatch'); -end; - initialization FormatSettings.DecimalSeparator := '.'; TDUnitX.RegisterTestFixture(TTestPOD);