From 9a5f2c1b1d17940ff035bd848219381af1291564 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Thu, 28 Aug 2025 16:26:48 +0200 Subject: [PATCH] AST refactoring --- ASTPlayground/ASTPlayground.dpr | 5 +- ASTPlayground/ASTPlayground.dproj | 5 +- ASTPlayground/MainForm.fmx | 6 +- ASTPlayground/MainForm.pas | 202 +++++---- Src/AST/Myc.Ast.Closure.pas | 124 ------ Src/AST/Myc.Ast.Evaluator.pas | 442 ++++++++++--------- Src/AST/Myc.Ast.Printer.pas | 61 +-- Src/AST/Myc.Ast.Scope.pas | 97 ---- Src/AST/Myc.Ast.pas | 711 +++++++++++++++++++----------- Src/Data/Myc.Data.POD.pas | 23 + 10 files changed, 866 insertions(+), 810 deletions(-) delete mode 100644 Src/AST/Myc.Ast.Closure.pas delete mode 100644 Src/AST/Myc.Ast.Scope.pas diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr index f118608..347f1c1 100644 --- a/ASTPlayground/ASTPlayground.dpr +++ b/ASTPlayground/ASTPlayground.dpr @@ -5,10 +5,7 @@ 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.Types in '..\Src\AST\Myc.Ast.Types.pas', - Myc.Ast.Scope in '..\Src\AST\Myc.Ast.Scope.pas', - Myc.Ast.Closure in '..\Src\AST\Myc.Ast.Closure.pas'; + Myc.Ast.Printer in '..\Src\AST\Myc.Ast.Printer.pas'; {$R *.res} diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj index 1eff804..ef8ced3 100644 --- a/ASTPlayground/ASTPlayground.dproj +++ b/ASTPlayground/ASTPlayground.dproj @@ -4,7 +4,7 @@ 20.3 FMX True - Debug + Release Win32 ASTPlayground 3 @@ -137,9 +137,6 @@ - - - Base diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index c34c2f0..ac48db6 100644 --- a/ASTPlayground/MainForm.fmx +++ b/ASTPlayground/MainForm.fmx @@ -32,7 +32,7 @@ object Form1: TForm1 end object PrettyPrintButton: TButton Position.X = 24.000000000000000000 - Position.Y = 168.000000000000000000 + Position.Y = 200.000000000000000000 TabOrder = 3 Text = 'Print' TextSettings.Trimming = None @@ -40,7 +40,7 @@ object Form1: TForm1 end object DebugButton: TButton Position.X = 24.000000000000000000 - Position.Y = 198.000000000000000000 + Position.Y = 230.000000000000000000 TabOrder = 4 Text = 'Debug' TextSettings.Trimming = None @@ -59,7 +59,7 @@ object Form1: TForm1 end object ShowScopeBox: TCheckBox Position.X = 32.000000000000000000 - Position.Y = 224.000000000000000000 + Position.Y = 256.000000000000000000 TabOrder = 6 Text = 'Scope' end diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 6d19a6b..69b7c05 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -18,11 +18,10 @@ uses FMX.ScrollBox, FMX.Memo, FMX.Controls.Presentation, - Myc.Data.Types, + Myc.Data.POD, Myc.Ast, - Myc.Ast.Scope, Myc.Ast.Evaluator, - Myc.Ast.Printer; + Myc.Ast.Printer; // Added for TExecutionScope type TForm1 = class(TForm) @@ -53,13 +52,17 @@ var implementation +uses + System.Diagnostics; // For TStopwatch + {$R *.fmx} procedure TForm1.DebugButtonClick(Sender: TObject); var scope: TExecutionScope; visitor: IAstVisitor; - result: IDataValue; + result: TAstValue; + sw: TStopwatch; begin if not Assigned(FLastAst) then begin @@ -73,13 +76,15 @@ begin Memo1.Lines.Clear; Memo1.Lines.Add('--- Debug Evaluator Trace ---'); - // Create the DEBUG visitor, passing the Memo's Lines as the log output visitor := TDebugEvaluatorVisitor.Create(scope, Memo1.Lines, ShowScopeBox.IsChecked, 0); + sw := TStopwatch.StartNew; result := FLastAst.Accept(visitor); + sw.Stop; Memo1.Lines.Add('-----------------------------'); - Memo1.Lines.Add('Final script result: ' + result.AsString); + Memo1.Lines.Add(Format('Final script result: %s', [result.ToString])); + Memo1.Lines.Add(Format('Execution time: %d ms', [sw.ElapsedMilliseconds])); Memo1.Lines.Add(''); Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)'); @@ -89,17 +94,59 @@ begin end; procedure TForm1.FibonacciButtonClick(Sender: TObject); + + function NativeFib(n: Integer): Int64; + begin + // The identical, naive recursive algorithm in native Delphi code. + if (n < 2) then + Result := n + else + Result := NativeFib(n - 1) + NativeFib(n - 2); + end; + var scope: TExecutionScope; visitor: IAstVisitor; root: IExpressionNode; - result: IDataValue; + result: TAstValue; + sw: TStopwatch; + result20, result30, result40: Int64; + time20, time30, time40: Int64; begin - // This test defines and calls a deeply recursive fibonacci function. - // var fib = func(n) { - // if (n < 2) then n else fib(n - 1) + fib(n - 2) - // }; - // fib(10); + Memo1.Lines.Clear; + Memo1.Lines.Add('--- Native Delphi Fibonacci Performance ---'); + Memo1.Lines.Add('Calculating fib(30) and fib(40)...'); + Application.ProcessMessages; // Update UI before blocking + + // --- Calculate fib(30) --- + sw := TStopwatch.StartNew; + result20 := NativeFib(20); + sw.Stop; + time20 := sw.ElapsedMilliseconds; + + // --- Calculate fib(30) --- + sw := TStopwatch.StartNew; + result30 := NativeFib(30); + sw.Stop; + time30 := sw.ElapsedMilliseconds; + + // --- Calculate fib(40) --- + sw.Reset; + sw.Start; + result40 := NativeFib(40); + sw.Stop; + time40 := sw.ElapsedMilliseconds; + sw.Reset; + + Memo1.Lines.Add(''); + Memo1.Lines.Add(Format('fib(20) = %d (calculated in %d ms)', [result20, time20])); + Memo1.Lines.Add(Format('fib(30) = %d (calculated in %d ms)', [result30, time30])); + Memo1.Lines.Add(Format('fib(40) = %d (calculated in %d ms)', [result40, time40])); + Memo1.Lines.Add(''); + Memo1.Lines.Add(''); + Memo1.Lines.Add('--- Recursive fib with AST---'); + + sw.Start; root := TAst.Block( [ @@ -108,44 +155,36 @@ begin TAst.LambdaExpr( [TAst.Identifier('n')], TAst.IfExpr( - // Condition: n < 2 - TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TDataType.Ordinal.CreateValue(2))), - // Then branch: n + TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))), TAst.Identifier('n'), - // Else branch: fib(n - 1) + fib(n - 2) TAst.BinaryExpr( - // fib(n - 1) TAst.FunctionCall( TAst.Identifier('fib'), - [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TDataType.Ordinal.CreateValue(1)))] + [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))] ), boAdd, - // fib(n - 2) TAst.FunctionCall( TAst.Identifier('fib'), - [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TDataType.Ordinal.CreateValue(2)))] + [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(2)))] ) ) ) ) ), - // Call the function - TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(TDataType.Ordinal.CreateValue(10))]) + TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(TScalar.FromInt64(30))]) ] ); FLastAst := root; - scope := TExecutionScope.Create(nil); try - Memo1.Lines.Clear; - Memo1.Lines.Add('--- Recursive fib(10) ---'); visitor := TEvaluatorVisitor.Create(scope); result := root.Accept(visitor); - Memo1.Lines.Add('Result: ' + result.AsString); // Should be 55 + sw.Stop; + + Memo1.Lines.Add(Format('Result: fib(30) %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); Memo1.Lines.Add(''); Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" or "Debug" to view.)'); - finally scope.Free; end; @@ -154,8 +193,8 @@ end; procedure TForm1.PrettyPrintButtonClick(Sender: TObject); var visitor: TPrettyPrintVisitor; + sw: TStopwatch; begin - // This button now prints the AST that was stored in FLastAst. Memo1.Lines.Clear; Memo1.Lines.Add('--- AST Pretty Print ---'); @@ -168,8 +207,12 @@ begin visitor := TPrettyPrintVisitor.Create; try + sw := TStopwatch.StartNew; FLastAst.Accept(visitor); + sw.Stop; + Memo1.Lines.Add(visitor.GetResult); + Memo1.Lines.Add(Format('(AST rendered in %d ms)', [sw.ElapsedMilliseconds])); finally // Visitor is an interfaced object and managed automatically. end; @@ -180,13 +223,14 @@ var scope: TExecutionScope; visitor: IAstVisitor; root: IExpressionNode; - result: IDataValue; + result: TAstValue; + sw: TStopwatch; begin - // This test defines and calls a recursive factorial function. - // var factorial = func(n) { - // if (n < 2) then 1 else n * factorial(n - 1) - // }; - // factorial(5); + sw := TStopwatch.Create; + Memo1.Lines.Clear; + Memo1.Lines.Add('--- Recursive factorial(20) ---'); + + sw.Start; root := TAst.Block( [ @@ -195,39 +239,33 @@ begin TAst.LambdaExpr( [TAst.Identifier('n')], TAst.IfExpr( - // Condition: n < 2 - TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TDataType.Ordinal.CreateValue(2))), - // Then branch: 1 - TAst.Constant(TDataType.Ordinal.CreateValue(1)), - // Else branch: n * factorial(n - 1) + TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TScalar.FromInt64(2))), + TAst.Constant(TScalar.FromInt64(1)), TAst.BinaryExpr( TAst.Identifier('n'), boMultiply, TAst.FunctionCall( - TAst.Identifier('factorial'), // Recursive call - [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TDataType.Ordinal.CreateValue(1)))] + TAst.Identifier('factorial'), + [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TScalar.FromInt64(1)))] ) ) ) ) ), - // Call the function - TAst.FunctionCall(TAst.Identifier('factorial'), [TAst.Constant(TDataType.Ordinal.CreateValue(6))]) + TAst.FunctionCall(TAst.Identifier('factorial'), [TAst.Constant(TScalar.FromInt64(20))]) ] ); FLastAst := root; - scope := TExecutionScope.Create(nil); try - Memo1.Lines.Clear; - Memo1.Lines.Add('--- Recursive factorial(6) ---'); visitor := TEvaluatorVisitor.Create(scope); result := root.Accept(visitor); - Memo1.Lines.Add('Result: ' + result.AsString); + sw.Stop; + + Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); Memo1.Lines.Add(''); Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" or "Debug" to view.)'); - finally scope.Free; end; @@ -238,42 +276,34 @@ var root: IAstNode; scope: TExecutionScope; visitor: IAstVisitor; - result: IDataValue; + result: TAstValue; + sw: TStopwatch; begin - // With the new expression-oriented AST, the entire logic can be - // represented as a single block expression. The block itself - // evaluates to the value of its last expression. + sw := TStopwatch.Create; + Memo1.Lines.Clear; + Memo1.Lines.Add('--- Simple AST Execution ---'); + + sw.Start; root := TAst.Block( [ - // var a := 10; (this expression returns void) - TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(TDataType.Ordinal.CreateValue(10))), - // var b := a * 2; (this expression also returns void) - TAst.VarDecl( - TAst.Identifier('b'), - TAst.BinaryExpr(TAst.Identifier('a'), boMultiply, TAst.Constant(TDataType.Ordinal.CreateValue(2))) - ), - // a + b; (this is the last expression, its value becomes the block's value) + TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(TScalar.FromInt64(10))), + TAst.VarDecl(TAst.Identifier('b'), TAst.BinaryExpr(TAst.Identifier('a'), boMultiply, TAst.Constant(TScalar.FromInt64(2)))), TAst.BinaryExpr(TAst.Identifier('a'), boAdd, TAst.Identifier('b')) ] ); - // Store the generated AST for the pretty printer. FLastAst := root; - - // Evaluate the entire AST with a single call scope := TExecutionScope.Create(nil); try visitor := TEvaluatorVisitor.Create(scope); result := root.Accept(visitor); + sw.Stop; - // Display the result - Memo1.Lines.Clear; - Memo1.Lines.Add('AST execution result:'); - if Assigned(result) then - Memo1.Lines.Add(result.AsString) + if not result.IsUndefined then + Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])) else - Memo1.Lines.Add(''); + Memo1.Lines.Add(Format(' (calculated in %d ms)', [sw.ElapsedMilliseconds])); Memo1.Lines.Add(''); Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)'); finally @@ -286,53 +316,45 @@ var scope: TExecutionScope; visitor: IAstVisitor; root: IExpressionNode; - result: IDataValue; + result: TAstValue; + sw: TStopwatch; begin - // The entire logic is now encapsulated in a single AST. - // This script defines a factory function, then calls it twice. + sw := TStopwatch.Create; + Memo1.Lines.Clear; + Memo1.Lines.Add('--- Factory Pattern Demo ---'); + + sw.Start; root := TAst.Block( [ - // 1. Define the factory and assign it to a variable 'createStrategyInstance' TAst.VarDecl( TAst.Identifier('createStrategyInstance'), TAst.LambdaExpr( - [TAst.Identifier('offset')], // The factory parameter + [TAst.Identifier('offset')], TAst.Block( [ - // The body of the factory defines the strategy logic - TAst.VarDecl(TAst.Identifier('baseValue'), TAst.Constant(TDataType.Ordinal.CreateValue(100))), + TAst.VarDecl(TAst.Identifier('baseValue'), TAst.Constant(TScalar.FromInt64(100))), TAst.BinaryExpr(TAst.Identifier('baseValue'), boAdd, TAst.Identifier('offset')) ] ) ) ), - // 2. Call the factory with the first parameter set. - // The result of this expression (120) is calculated but discarded by the block. - TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(TDataType.Ordinal.CreateValue(20))]), - // 3. Call the factory with the second parameter set. - // As this is the last expression, its result (155) becomes the result of the entire block. - TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(TDataType.Ordinal.CreateValue(55))]) + TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(TScalar.FromInt64(20))]), + TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(TScalar.FromInt64(55))]) ] ); - // Store the complete AST for the pretty printer. FLastAst := root; - - // Evaluate the AST. scope := TExecutionScope.Create(nil); try visitor := TEvaluatorVisitor.Create(scope); - Memo1.Lines.Clear; - Memo1.Lines.Add('Factory Pattern Demo (Single AST):'); - result := root.Accept(visitor); + sw.Stop; Memo1.Lines.Add('The entire script has been executed.'); - Memo1.Lines.Add('Result of the final expression: ' + result.AsString); + Memo1.Lines.Add(Format('Result of the final expression: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])); Memo1.Lines.Add(''); Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)'); - finally scope.Free; end; diff --git a/Src/AST/Myc.Ast.Closure.pas b/Src/AST/Myc.Ast.Closure.pas deleted file mode 100644 index b60b947..0000000 --- a/Src/AST/Myc.Ast.Closure.pas +++ /dev/null @@ -1,124 +0,0 @@ -unit Myc.Ast.Closure; - -interface - -uses - System.Classes, - System.Generics.Collections, - Myc.Data.Types, - Myc.Ast, - Myc.Ast.Scope; - -type - // A closure is a specific kind of method value that is defined by the evaluator. - // It holds the AST body and its captured scope. - IDataClosureValue = interface(IDataMethodValue) - ['{2704586B-E4BD-47AA-B05D-FD441AE6D818}'] - {$region 'private'} - function GetBody: IExpressionNode; - function GetParameters: TList; - function GetClosureScope: TExecutionScope; - {$endregion} - property Body: IExpressionNode read GetBody; - property Parameters: TList read GetParameters; - property ClosureScope: TExecutionScope read GetClosureScope; - end; - -// Factory function to create a new closure value. -function CreateDataClosureValue( - AMethodType: IDataMethodType; - ABody: IExpressionNode; - AParameters: TList; - AClosureScope: TExecutionScope -): IDataClosureValue; - -implementation - -uses - System.SysUtils; - -type - { TDataClosureValueImpl } - // Concrete implementation of the IDataClosureValue interface. - TDataClosureValueImpl = class(TInterfacedObject, IDataValue, IDataClosureValue) - private - FMethodType: IDataMethodType; - FBody: IExpressionNode; - FParameters: TList; - FClosureScope: TExecutionScope; - // IDataValue - function GetDataType: IDataType; - function GetAsString: string; - // IDataMethodValue - function GetValue: TDataMethodProc; - // IDataClosureValue - function GetBody: IExpressionNode; - function GetParameters: TList; - function GetClosureScope: TExecutionScope; - public - constructor Create( - AMethodType: IDataMethodType; - ABody: IExpressionNode; - AParameters: TList; - ACClosureScope: TExecutionScope - ); - end; - -function CreateDataClosureValue( - AMethodType: IDataMethodType; - ABody: IExpressionNode; - AParameters: TList; - AClosureScope: TExecutionScope -): IDataClosureValue; -begin - Result := TDataClosureValueImpl.Create(AMethodType, ABody, AParameters, AClosureScope); -end; - -{ TDataClosureValueImpl } - -constructor TDataClosureValueImpl.Create( - AMethodType: IDataMethodType; - ABody: IExpressionNode; - AParameters: TList; - ACClosureScope: TExecutionScope -); -begin - inherited Create; - FMethodType := AMethodType; - FBody := ABody; - FParameters := AParameters; // Note: We are taking ownership of the list reference - FClosureScope := ACClosureScope; -end; - -function TDataClosureValueImpl.GetAsString: string; -begin - Result := ''; -end; - -function TDataClosureValueImpl.GetBody: IExpressionNode; -begin - Result := FBody; -end; - -function TDataClosureValueImpl.GetClosureScope: TExecutionScope; -begin - Result := FClosureScope; -end; - -function TDataClosureValueImpl.GetDataType: IDataType; -begin - Result := FMethodType; -end; - -function TDataClosureValueImpl.GetParameters: TList; -begin - Result := FParameters; -end; - -function TDataClosureValueImpl.GetValue: TDataMethodProc; -begin - // This direct execution path is no longer used for closures. - raise ENotSupportedException.Create('Cannot get raw method proc from a closure object.'); -end; - -end. diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 87c8858..0ca3c76 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -6,30 +6,27 @@ uses System.SysUtils, System.Classes, // For TStrings System.Generics.Collections, - Myc.Data.Types, - Myc.Ast, - Myc.Ast.Scope, - Myc.Ast.Closure; + Myc.Data.POD, + Myc.Ast; type // TEvaluatorVisitor is the base implementation for evaluating an AST. TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor) - protected // Changed to protected to be accessible by descendants + protected FScope: TExecutionScope; - function IsTruthy(const AValue: IDataValue): Boolean; - // Factory method to create a new visitor for a sub-scope (e.g., lambda body) + function IsTruthy(const AValue: TAstValue): Boolean; function CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; virtual; public constructor Create(AScope: TExecutionScope); - function VisitConstant(const Node: IConstantNode): IDataValue; virtual; - function VisitIdentifier(const Node: IIdentifierNode): IDataValue; virtual; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue; virtual; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue; virtual; - function VisitIfExpression(const Node: IIfExpressionNode): IDataValue; virtual; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue; virtual; - function VisitFunctionCall(const Node: IFunctionCallNode): IDataValue; virtual; - function VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue; virtual; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue; virtual; + function VisitConstant(const Node: IConstantNode): TAstValue; virtual; + function VisitIdentifier(const Node: IIdentifierNode): TAstValue; virtual; + function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; virtual; + function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; virtual; + function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; virtual; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; virtual; + function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; virtual; + function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; virtual; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; virtual; end; // TDebugEvaluatorVisitor now overrides all visit methods for full tracing @@ -43,24 +40,64 @@ type procedure AppendLine(const S: string); procedure ShowScope; protected - // Override the factory method to create a debug visitor function CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; override; public constructor Create(AScope: TExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0); - // Override all visit methods - function VisitConstant(const Node: IConstantNode): IDataValue; override; - function VisitIdentifier(const Node: IIdentifierNode): IDataValue; override; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue; override; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue; override; - function VisitIfExpression(const Node: IIfExpressionNode): IDataValue; override; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue; override; - function VisitFunctionCall(const Node: IFunctionCallNode): IDataValue; override; - function VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue; override; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue; override; + function VisitConstant(const Node: IConstantNode): TAstValue; override; + function VisitIdentifier(const Node: IIdentifierNode): TAstValue; override; + function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; override; + function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; override; + function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; override; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; override; + function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; override; + function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; override; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; override; end; implementation +uses + Myc.Data.Decimal; + +type + // Concrete implementation of the IEvaluatorClosure interface, private to this unit. + TClosureValue = class(TInterfacedObject, IEvaluatorClosure) + private + FBody: IExpressionNode; + FParameters: TList; + FClosureScope: TExecutionScope; + function GetBody: IExpressionNode; + function GetParameters: TList; + function GetClosureScope: TExecutionScope; + public + constructor Create(ABody: IExpressionNode; AParameters: TList; AClosureScope: TExecutionScope); + end; + +{ TClosureValue } + +constructor TClosureValue.Create(ABody: IExpressionNode; AParameters: TList; AClosureScope: TExecutionScope); +begin + inherited Create; + FBody := ABody; + FParameters := AParameters; // Taking ownership of the list reference + FClosureScope := AClosureScope; +end; + +function TClosureValue.GetBody: IExpressionNode; +begin + Result := FBody; +end; + +function TClosureValue.GetClosureScope: TExecutionScope; +begin + Result := FClosureScope; +end; + +function TClosureValue.GetParameters: TList; +begin + Result := FParameters; +end; + { TEvaluatorVisitor } constructor TEvaluatorVisitor.Create(AScope: TExecutionScope); @@ -72,78 +109,34 @@ end; function TEvaluatorVisitor.CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; begin - // Base implementation creates a standard evaluator Result := TEvaluatorVisitor.Create(AScope); end; -function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue; -var - methodType: IDataMethodType; +function TEvaluatorVisitor.IsTruthy(const AValue: TAstValue): Boolean; begin - // Instead of creating an anonymous method, we now create a data object - // that holds all information required to execute the lambda later. - methodType := TDataType.MethodOf(TDataType.Ordinal, TDataType.Ordinal); // TODO: Infer this - // Use the factory function from the Myc.Ast.Closure unit. - Result := CreateDataClosureValue(methodType, Node.Body, Node.Parameters, FScope); -end; - -function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IDataValue; -var - calleeValue: IDataValue; - arguments: TList; - closure: IDataClosureValue; - callScope: TExecutionScope; - innerVisitor: IAstVisitor; -begin - calleeValue := Node.Callee.Accept(Self); - arguments := Node.Arguments; - - if not Supports(calleeValue, IDataClosureValue, closure) then - raise EArgumentException.Create('Expression is not a callable closure.'); - - if (arguments.Count <> 1) then - raise EArgumentException.Create('This simple implementation only supports single-argument calls.'); - - // --- New execution logic is now inside the caller --- - // Create the new scope for the function call, parented by the closure's captured scope. - callScope := TExecutionScope.Create(closure.ClosureScope); - try - // Set argument value - var argValue := arguments[0].Accept(Self); - callScope.SetValue(closure.Parameters[0].Name, argValue); - - // Use the factory method to create the visitor with the correct context (and indent). - innerVisitor := Self.CreateVisitorForScope(callScope); - - // Execute the body with the new visitor. - Result := closure.Body.Accept(innerVisitor); - finally - callScope.Free; - end; -end; - -function TEvaluatorVisitor.IsTruthy(const AValue: IDataValue): Boolean; -begin - // Defines the language's concept of "truthiness". - // For now, only ordinals can be conditions. 0 is false, everything else is true. - if not Assigned(AValue) then + if (AValue.Kind <> avkScalar) then + begin Exit(False); + end; - case AValue.DataType.Kind of - dkOrdinal: Result := (TDataType.TValue(AValue).AsOrdinal.Value <> 0); + case AValue.AsScalar.Kind of + skInteger: Result := (AValue.AsScalar.Value.AsInteger <> 0); + skInt64: Result := (AValue.AsScalar.Value.AsInt64 <> 0); + skUInt64: Result := (AValue.AsScalar.Value.AsUInt64 <> 0); + skBoolean: Result := AValue.AsScalar.Value.AsBoolean; else Result := False; end; end; -function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): IDataValue; +function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TAstValue; begin - Result := Node.Value; + Result := TAstValue.FromScalar(Node.Value); end; -function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): IDataValue; +function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue; var - val: IDataValue; + val: TAstValue; begin if FScope.FindValue(Node.Name, val) then Result := val @@ -151,98 +144,141 @@ begin raise EArgumentException.CreateFmt('Identifier not found: "%s"', [Node.Name]); end; -function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue; +function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; var - leftValue, rightValue: IDataValue; - comparisonResult: Boolean; + varName: string; + initValue: TAstValue; +begin + varName := Node.Identifier.Name; + FScope.SetValue(varName, TAstValue.Undefined); + if Assigned(Node.Initializer) then + initValue := Node.Initializer.Accept(Self) + else + initValue := TAstValue.Undefined; + FScope.SetValue(varName, initValue); + Result := TAstValue.Undefined; +end; + +function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; +var + closureImpl: IEvaluatorClosure; +begin + closureImpl := TClosureValue.Create(Node.Body, Node.Parameters, FScope); + Result := TAstValue.FromClosure(closureImpl); +end; + +function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; +var + calleeValue: TAstValue; + arguments: TList; + closure: IEvaluatorClosure; + callScope: TExecutionScope; + innerVisitor: IAstVisitor; + i: Integer; + argValue: TAstValue; +begin + calleeValue := Node.Callee.Accept(Self); + arguments := Node.Arguments; + + if not calleeValue.IsClosure then + begin + raise EArgumentException.Create('Expression is not a callable closure.'); + end; + closure := calleeValue.AsClosure; + + if (arguments.Count <> closure.Parameters.Count) then + begin + raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [closure.Parameters.Count, arguments.Count]); + end; + + callScope := TExecutionScope.Create(closure.ClosureScope); + try + for i := 0 to arguments.Count - 1 do + begin + argValue := arguments[i].Accept(Self); + callScope.SetValue(closure.Parameters[i].Name, argValue); + end; + + innerVisitor := Self.CreateVisitorForScope(callScope); + Result := closure.Body.Accept(innerVisitor); + finally + callScope.Free; + end; +end; + +function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; +var + leftValue, rightValue: TAstValue; + leftScalar, rightScalar: TScalar; + leftVal, rightVal: Int64; + boolResult: Boolean; + intResult: Int64; begin leftValue := Node.Left.Accept(Self); rightValue := Node.Right.Accept(Self); - // Handle comparison operators separately as they can work on different types (for now) - // and always return an Ordinal (boolean). + if not leftValue.IsScalar or not rightValue.IsScalar then + begin + raise ENotSupportedException.Create('Binary operations are only supported for scalar types.'); + end; + + leftScalar := leftValue.AsScalar; + rightScalar := rightValue.AsScalar; + + if (leftScalar.Kind <> skInt64) or (rightScalar.Kind <> skInt64) then + begin + raise ENotSupportedException.Create('Binary operations currently only support Int64.'); + end; + + leftVal := leftScalar.Value.AsInt64; + rightVal := rightScalar.Value.AsInt64; + case Node.Operator of - boEqual, boNotEqual, boLess, boGreater, boLessOrEqual, boGreaterOrEqual: - begin - // Basic comparison for Ordinals - if (leftValue.DataType.Kind = dkOrdinal) and (rightValue.DataType.Kind = dkOrdinal) then - begin - var leftVal := TDataType.TValue(leftValue).AsOrdinal.Value; - var rightVal := TDataType.TValue(rightValue).AsOrdinal.Value; - case Node.Operator of - boEqual: comparisonResult := (leftVal = rightVal); - boNotEqual: comparisonResult := (leftVal <> rightVal); - boLess: comparisonResult := (leftVal < rightVal); - boGreater: comparisonResult := (leftVal > rightVal); - boLessOrEqual: comparisonResult := (leftVal <= rightVal); - boGreaterOrEqual: comparisonResult := (leftVal >= rightVal); - end; - if comparisonResult then - Result := TDataType.Ordinal.CreateValue(1) - else - Result := TDataType.Ordinal.CreateValue(0); - exit; - end - else - raise ENotSupportedException.Create('Comparison is only supported for Ordinal types.'); - end; - end; - - if (leftValue.DataType.Kind <> rightValue.DataType.Kind) then - raise ENotSupportedException.CreateFmt( - 'Binary operations on different types (%s and %s) are not supported', - [leftValue.DataType.Name, rightValue.DataType.Name]); - - case leftValue.DataType.Kind of - dkOrdinal: - begin - var leftOrdinal := TDataType.TValue(leftValue).AsOrdinal; - var rightOrdinal := TDataType.TValue(rightValue).AsOrdinal; - var resultVal: Int64; - - case Node.Operator of - boAdd: resultVal := leftOrdinal.Value + rightOrdinal.Value; - boSubtract: resultVal := leftOrdinal.Value - rightOrdinal.Value; - boMultiply: resultVal := leftOrdinal.Value * rightOrdinal.Value; - boDivide: resultVal := leftOrdinal.Value div rightOrdinal.Value; - else - raise ENotSupportedException.Create('Operator not supported for Ordinal type'); - end; - Result := TDataType.Ordinal.CreateValue(resultVal); - end; - dkText: - begin - if (Node.Operator = boAdd) then - begin - var leftText := TDataType.TValue(leftValue).AsText; - var rightText := TDataType.TValue(rightValue).AsText; - Result := TDataType.Text.CreateValue(leftText.Value + rightText.Value); - end - else - raise ENotSupportedException.Create('Operator not supported for Text type'); - end; + boEqual: boolResult := (leftVal = rightVal); + boNotEqual: boolResult := (leftVal <> rightVal); + boLess: boolResult := (leftVal < rightVal); + boGreater: boolResult := (leftVal > rightVal); + boLessOrEqual: boolResult := (leftVal <= rightVal); + boGreaterOrEqual: boolResult := (leftVal >= rightVal); else - raise ENotSupportedException.CreateFmt('Binary operation not supported for type %s', [leftValue.DataType.Name]); + case Node.Operator of + boAdd: intResult := leftVal + rightVal; + boSubtract: intResult := leftVal - rightVal; + boMultiply: intResult := leftVal * rightVal; + boDivide: intResult := leftVal div rightVal; + else + raise ENotSupportedException.Create('Operator not supported.'); + end; + Result := TAstValue.FromScalar(TScalar.FromInt64(intResult)); + exit; end; + + if boolResult then + Result := TAstValue.FromScalar(TScalar.FromInt64(1)) + else + Result := TAstValue.FromScalar(TScalar.FromInt64(0)); end; -function TEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue; +function TEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; var - rightValue: IDataValue; - ordinalVal: IDataOrdinalValue; + rightValue: TAstValue; + rightScalar: TScalar; begin rightValue := Node.Right.Accept(Self); + if not rightValue.IsScalar then + begin + raise ENotSupportedException.Create('Unary operations are only supported for scalar types.'); + end; + + rightScalar := rightValue.AsScalar; case Node.Operator of uoNegate: begin - if (rightValue.DataType.Kind = dkOrdinal) then - begin - ordinalVal := TDataType.TValue(rightValue).AsOrdinal; - Result := TDataType.Ordinal.CreateValue(-ordinalVal.Value); - end + if (rightScalar.Kind = skInt64) then + Result := TAstValue.FromScalar(TScalar.FromInt64(-rightScalar.Value.AsInt64)) else - raise ENotSupportedException.CreateFmt('Unary "-" not supported for type %s', [rightValue.DataType.Name]); + raise ENotSupportedException.Create('Unary "-" not supported for this scalar type.'); end; uoNot: raise ENotImplemented.Create('Unary "not" operator is not yet implemented'); else @@ -250,24 +286,23 @@ begin end; end; -function TEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): IDataValue; +function TEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TAstValue; var - conditionValue: IDataValue; + conditionValue: TAstValue; begin conditionValue := Node.Condition.Accept(Self); - if IsTruthy(conditionValue) then Result := Node.ThenBranch.Accept(Self) else Result := Node.ElseBranch.Accept(Self); end; -function TEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue; +function TEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; var expression: IExpressionNode; - lastValue: IDataValue; + lastValue: TAstValue; begin - lastValue := TDataType.Void.Value; + lastValue := TAstValue.Undefined; for expression in Node.Expressions do begin lastValue := expression.Accept(Self); @@ -275,32 +310,9 @@ begin Result := lastValue; end; -function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue; -var - varName: string; - initValue: IDataValue; -begin - varName := Node.Identifier.Name; - - // 1. Declare the name in the scope first with a placeholder value (void). - // This makes the name available to the initializer (e.g., a lambda). - FScope.SetValue(varName, TDataType.Void.Value); - - // 2. Evaluate the initializer, which can now recursively reference its own name. - if Assigned(Node.Initializer) then - initValue := Node.Initializer.Accept(Self) - else - initValue := TDataType.Void.Value; - - // 3. Update the variable with the actual initialized value. - FScope.SetValue(varName, initValue); - - Result := TDataType.Void.Value; -end; - { TDebugEvaluatorVisitor } -constructor TDebugEvaluatorVisitor.Create(AScope: TExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0); +constructor TDebugEvaluatorVisitor.Create(AScope: TExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer); begin inherited Create(AScope); Assert(Assigned(ALog)); @@ -311,7 +323,6 @@ end; function TDebugEvaluatorVisitor.CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; begin - // Pass the current indent level to the new child visitor Result := TDebugEvaluatorVisitor.Create(AScope, FLog, FShowScope, FIndentLevel); end; @@ -326,39 +337,48 @@ begin end; procedure TDebugEvaluatorVisitor.AppendLine(const S: string); +var + pad: string; + i: Integer; begin - var pad := ''; - for var i := 0 to FIndentLevel - 1 do + pad := ''; + for i := 0 to FIndentLevel - 1 do + begin pad := pad + ':' + ''.PadLeft(3); + end; FLog.Add(pad + S); end; procedure TDebugEvaluatorVisitor.ShowScope; +var + scopeDump: TArray; + line: string; begin if FShowScope then begin - // Dump the scope content upon entering a block AppendLine('-- Scope --'); - var scopeDump := FScope.Dump.Split([sLineBreak]); - for var line in scopeDump do + scopeDump := FScope.Dump.Split([sLineBreak]); + for line in scopeDump do + begin AppendLine(line); + end; AppendLine('-----------'); end; end; -function TDebugEvaluatorVisitor.VisitConstant(const Node: IConstantNode): IDataValue; +function TDebugEvaluatorVisitor.VisitConstant(const Node: IConstantNode): TAstValue; begin - AppendLine(Format('Constant (%s)', [Node.Value.AsString])); + AppendLine(Format('Constant (%s)', [Node.Value.ToString])); Result := inherited VisitConstant(Node); end; -function TDebugEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): IDataValue; +function TDebugEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue; begin Result := inherited VisitIdentifier(Node); - AppendLine(Format('Identifier "%s" -> %s', [Node.Name, Result.AsString])); + AppendLine(Format('Identifier "%s" -> %s', [Node.Name, Result.ToString])); end; -function TDebugEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue; +function TDebugEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; begin AppendLine(Format('BinaryExpr "%s" {', [Node.Operator.ToString])); Indent; @@ -367,10 +387,10 @@ begin finally Unindent; end; - AppendLine(Format('} -> %s', [Result.AsString])); + AppendLine(Format('} -> %s', [Result.ToString])); end; -function TDebugEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue; +function TDebugEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; begin AppendLine(Format('UnaryExpr "%s" {', [Node.Operator.ToString])); Indent; @@ -379,10 +399,10 @@ begin finally Unindent; end; - AppendLine(Format('} -> %s', [Result.AsString])); + AppendLine(Format('} -> %s', [Result.ToString])); end; -function TDebugEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): IDataValue; +function TDebugEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TAstValue; begin AppendLine('IfExpr{'); Indent; @@ -391,10 +411,10 @@ begin finally Unindent; end; - AppendLine(Format('} -> %s', [Result.AsString])); + AppendLine(Format('} -> %s', [Result.ToString])); end; -function TDebugEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue; +function TDebugEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; begin AppendLine('LambdaExpr{'); Indent; @@ -403,10 +423,10 @@ begin finally Unindent; end; - AppendLine(Format('} -> %s', [Result.AsString])); + AppendLine(Format('} -> %s', [Result.ToString])); end; -function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IDataValue; +function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; begin AppendLine('FunctionCall{'); Indent; @@ -416,10 +436,10 @@ begin finally Unindent; end; - AppendLine(Format('} -> %s', [Result.AsString])); + AppendLine(Format('} -> %s', [Result.ToString])); end; -function TDebugEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue; +function TDebugEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; begin AppendLine('Block{'); Indent; @@ -429,10 +449,10 @@ begin finally Unindent; end; - AppendLine(Format('} -> %s', [Result.AsString])); + AppendLine(Format('} -> %s', [Result.ToString])); end; -function TDebugEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue; +function TDebugEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; begin AppendLine(Format('VarDecl %s :=', [Node.Identifier.Name])); Indent; diff --git a/Src/AST/Myc.Ast.Printer.pas b/Src/AST/Myc.Ast.Printer.pas index 045f82f..226a7c4 100644 --- a/Src/AST/Myc.Ast.Printer.pas +++ b/Src/AST/Myc.Ast.Printer.pas @@ -6,7 +6,6 @@ uses System.SysUtils, System.Classes, System.Generics.Collections, - Myc.Data.Types, Myc.Ast; type @@ -22,19 +21,23 @@ type destructor Destroy; override; function GetResult: string; // IAstVisitor - function VisitConstant(const Node: IConstantNode): IDataValue; - function VisitIdentifier(const Node: IIdentifierNode): IDataValue; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue; - function VisitIfExpression(const Node: IIfExpressionNode): IDataValue; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue; - function VisitFunctionCall(const Node: IFunctionCallNode): IDataValue; - function VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue; + function VisitConstant(const Node: IConstantNode): TAstValue; + function VisitIdentifier(const Node: IIdentifierNode): TAstValue; + function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; + function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; + function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; + function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; + function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; end; implementation +uses + Myc.Data.POD, + Myc.Data.Decimal; + { TPrettyPrintVisitor } constructor TPrettyPrintVisitor.Create; @@ -71,38 +74,38 @@ begin FBuilder.AppendLine(S); end; -function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): IDataValue; +function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): TAstValue; begin - AppendLine(Format('Constant (%s)', [Node.Value.AsString])); - Result := TDataType.Void.Value; + AppendLine(Format('Constant (%s)', [Node.Value.ToString])); + Result := TAstValue.Undefined; end; -function TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode): IDataValue; +function TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode): TAstValue; begin AppendLine(Format('Identifier (%s)', [Node.Name])); - Result := TDataType.Void.Value; + Result := TAstValue.Undefined; end; -function TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue; +function TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; begin AppendLine(Format('BinaryExpr (%s)', [Node.Operator.ToString])); Indent; Node.Left.Accept(Self); Node.Right.Accept(Self); Unindent; - Result := TDataType.Void.Value; + Result := TAstValue.Undefined; end; -function TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue; +function TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; begin AppendLine(Format('UnaryExpr (%s)', [Node.Operator.ToString])); Indent; Node.Right.Accept(Self); Unindent; - Result := TDataType.Void.Value; + Result := TAstValue.Undefined; end; -function TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode): IDataValue; +function TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode): TAstValue; begin AppendLine('IfExpr'); Indent; @@ -119,10 +122,10 @@ begin Node.ElseBranch.Accept(Self); Unindent; Unindent; - Result := TDataType.Void.Value; + Result := TAstValue.Undefined; end; -function TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue; +function TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; var param: IIdentifierNode; paramNames: TStringList; @@ -142,10 +145,10 @@ begin Node.Body.Accept(Self); Unindent; Unindent; - Result := TDataType.Void.Value; + Result := TAstValue.Undefined; end; -function TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IDataValue; +function TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; var arg: IExpressionNode; begin @@ -161,10 +164,10 @@ begin arg.Accept(Self); Unindent; Unindent; - Result := TDataType.Void.Value; + Result := TAstValue.Undefined; end; -function TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue; +function TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; var expr: IExpressionNode; begin @@ -173,10 +176,10 @@ begin for expr in Node.Expressions do expr.Accept(Self); Unindent; - Result := TDataType.Void.Value; + Result := TAstValue.Undefined; end; -function TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue; +function TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; begin AppendLine(Format('VarDecl (%s)', [Node.Identifier.Name])); if Assigned(Node.Initializer) then @@ -185,7 +188,7 @@ begin Node.Initializer.Accept(Self); Unindent; end; - Result := TDataType.Void.Value; + Result := TAstValue.Undefined; end; end. diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas deleted file mode 100644 index b06ac59..0000000 --- a/Src/AST/Myc.Ast.Scope.pas +++ /dev/null @@ -1,97 +0,0 @@ -unit Myc.Ast.Scope; - -interface - -uses - System.SysUtils, - System.Classes, - System.Generics.Collections, - Myc.Data.Types; - -type - // Manages the scope of execution, holding variables and their values. - TExecutionScope = class - private - FParent: TExecutionScope; - FVariables: TDictionary; - // Added for recursive dumping - procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); - public - constructor Create(AParent: TExecutionScope = nil); - destructor Destroy; override; - function FindValue(const Name: string; out Value: IDataValue): Boolean; - procedure SetValue(const Name: string; const Value: IDataValue); - // Dumps the content of this scope and all parent scopes to a string. - function Dump: string; - end; - -implementation - -{ TExecutionScope } - -constructor TExecutionScope.Create(AParent: TExecutionScope = nil); -begin - inherited Create; - FParent := AParent; - FVariables := TDictionary.Create; -end; - -destructor TExecutionScope.Destroy; -begin - FVariables.Free; - inherited Destroy; -end; - -procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); -var - pair: TPair; - indentStr: string; -begin - indentStr := ''.PadLeft(AIndent); - if (FVariables.Count > 0) then - begin - for pair in FVariables do - ABuilder.AppendLine(indentStr + Format(' %s: %s', [pair.Key, pair.Value.AsString])); - end - else - begin - ABuilder.AppendLine(indentStr + ' (empty)'); - end; - - if Assigned(FParent) then - begin - ABuilder.AppendLine(indentStr + '[Parent Scope]'); - FParent.DumpScope(ABuilder, AIndent + 2); - end; -end; - -function TExecutionScope.Dump: string; -var - builder: TStringBuilder; -begin - builder := TStringBuilder.Create; - try - builder.AppendLine('[Current Scope]'); - DumpScope(builder, 0); - Result := builder.ToString.TrimRight; - finally - builder.Free; - end; -end; - -function TExecutionScope.FindValue(const Name: string; out Value: IDataValue): Boolean; -begin - Result := FVariables.TryGetValue(Name, Value); - if not Result and Assigned(FParent) then - begin - Result := FParent.FindValue(Name, Value); - end; -end; - -procedure TExecutionScope.SetValue(const Name: string; const Value: IDataValue); -begin - // This defines a variable in the current scope. It can shadow a parent variable. - FVariables.AddOrSetValue(Name, Value); -end; - -end. diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 5b98f80..6bf2cd9 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -4,8 +4,9 @@ interface uses System.SysUtils, + System.Classes, System.Generics.Collections, - Myc.Data.Types; + Myc.Data.POD; type // Operators are now type-safe enums @@ -21,12 +22,19 @@ type function ToString: string; end; - // Forward declarations for interfaces + // Defines the kind of value stored in a TAstValue record. + TAstValueKind = ( + avkUndefined, // Represents a void, null or uninitialized value. + avkScalar, // The value is a POD scalar (TScalar). + avkClosure // The value is a managed closure (IEvaluatorClosure). + ); + + // --- Forward Declarations to break cycles --- IAstVisitor = interface; IAstNode = interface; IExpressionNode = interface; - IConstantNode = interface; IIdentifierNode = interface; + IConstantNode = interface; IBinaryExpressionNode = interface; IUnaryExpressionNode = interface; IIfExpressionNode = interface; @@ -34,27 +42,85 @@ type IFunctionCallNode = interface; IBlockExpressionNode = interface; IVariableDeclarationNode = interface; + IEvaluatorClosure = interface; + TExecutionScope = class; - // --- Abstract Node Interfaces --- + // --- Concrete Type Definitions --- - // Base interface for all AST nodes + // Represents a closure value for the TAstValue-based evaluator. + IEvaluatorClosure = interface(IInterface) + {$region 'private'} + function GetBody: IExpressionNode; + function GetParameters: TList; + function GetClosureScope: TExecutionScope; + {$endregion} + property Body: IExpressionNode read GetBody; + property Parameters: TList read GetParameters; + property ClosureScope: TExecutionScope read GetClosureScope; + end; + + // A universal value container for the AST evaluator. + TAstValue = record + private + FKind: TAstValueKind; + FScalar: TScalar; + FClosure: IEvaluatorClosure; + + function GetKind: TAstValueKind; inline; + function GetIsScalar: Boolean; inline; + function GetIsClosure: Boolean; inline; + function GetIsUndefined: Boolean; inline; + public + // Managed record operators to handle the lifetime of FObject. + class operator Initialize(out Dest: TAstValue); + // Factory methods for clean creation. + class function Undefined: TAstValue; static; + class function FromScalar(const AValue: TScalar): TAstValue; static; + class function FromClosure(const AValue: IEvaluatorClosure): TAstValue; static; + + // Accessors for the stored values. + function AsScalar: TScalar; + function AsClosure: IEvaluatorClosure; + + function ToString: String; + + // Properties for convenient access and type checking. + property Kind: TAstValueKind read GetKind; + property IsScalar: Boolean read GetIsScalar; + property IsClosure: Boolean read GetIsClosure; + property IsUndefined: Boolean read GetIsUndefined; + end; + + // The visitor pattern interface for traversing the AST. + IAstVisitor = interface + ['{A58B0A8E-F438-4217-A964-6E35624A9A4A}'] + function VisitConstant(const Node: IConstantNode): TAstValue; + function VisitIdentifier(const Node: IIdentifierNode): TAstValue; + function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; + function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAstValue; + function VisitIfExpression(const Node: IIfExpressionNode): TAstValue; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAstValue; + function VisitFunctionCall(const Node: IFunctionCallNode): TAstValue; + function VisitBlockExpression(const Node: IBlockExpressionNode): TAstValue; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): TAstValue; + end; + + // --- AST Node Interfaces (now using TAstValue) --- + + // Base interface for all AST nodes. IAstNode = interface(IInterface) - // Accept is a function that returns the result of the visit. - function Accept(const Visitor: IAstVisitor): IDataValue; + function Accept(const Visitor: IAstVisitor): TAstValue; end; // Abstract interface for all nodes that evaluate to a value. - // In this paradigm, all nodes are expressions. IExpressionNode = interface(IAstNode) end; - // --- Concrete Expression Node Interfaces --- - IConstantNode = interface(IExpressionNode) {$region 'private'} - function GetValue: IDataValue; + function GetValue: TScalar; {$endregion} - property Value: IDataValue read GetValue; + property Value: TScalar read GetValue; end; IIdentifierNode = interface(IExpressionNode) @@ -98,7 +164,7 @@ type ILambdaExpressionNode = interface(IExpressionNode) {$region 'private'} function GetParameters: TList; - function GetBody: IExpressionNode; // Body is now always an expression + function GetBody: IExpressionNode; {$endregion} property Parameters: TList read GetParameters; property Body: IExpressionNode read GetBody; @@ -121,7 +187,7 @@ type property Expressions: TList read GetExpressions; end; - // A variable declaration is an expression that returns a void value. + // A variable declaration is an expression that returns an undefined value. IVariableDeclarationNode = interface(IExpressionNode) {$region 'private'} function GetIdentifier: IIdentifierNode; @@ -131,23 +197,9 @@ type property Initializer: IExpressionNode read GetInitializer; end; - // All visitor methods are functions returning a value. - IAstVisitor = interface - ['{5F4110E9-0158-41E9-A512-E57A843E8A5A}'] - function VisitConstant(const Node: IConstantNode): IDataValue; - function VisitIdentifier(const Node: IIdentifierNode): IDataValue; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue; - function VisitIfExpression(const Node: IIfExpressionNode): IDataValue; - function VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue; - function VisitFunctionCall(const Node: IFunctionCallNode): IDataValue; - function VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue; - function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue; - end; - // Record acting as a namespace for the factory functions. TAst = record - class function Constant(AValue: IDataValue): IConstantNode; static; + class function Constant(AValue: TScalar): IConstantNode; static; class function Identifier(AName: string): IIdentifierNode; static; class function BinaryExpr( ALeft: IExpressionNode; @@ -165,8 +217,212 @@ type class function VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IExpressionNode): IVariableDeclarationNode; static; end; + // Manages the scope of execution, holding variables and their values. + TExecutionScope = class + private + FParent: TExecutionScope; + FVariables: TDictionary; + procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); + public + constructor Create(AParent: TExecutionScope = nil); + destructor Destroy; override; + function FindValue(const Name: string; out Value: TAstValue): Boolean; + procedure SetValue(const Name: string; const Value: TAstValue); + function Dump: string; + end; + implementation +type + { TAstNode } + // Common base class for AST nodes to reduce boilerplate. + TAstNode = class(TInterfacedObject, IExpressionNode) + public + function Accept(const Visitor: IAstVisitor): TAstValue; virtual; abstract; + end; + + { TConstantNode } + TConstantNode = class(TAstNode, IConstantNode) + private + FValue: TScalar; + function GetValue: TScalar; + public + constructor Create(AValue: TScalar); + function Accept(const Visitor: IAstVisitor): TAstValue; override; + end; + + { TIdentifierNode } + TIdentifierNode = class(TAstNode, IIdentifierNode) + private + FName: string; + function GetName: string; + public + constructor Create(AName: string); + function Accept(const Visitor: IAstVisitor): TAstValue; override; + end; + + { TBinaryExpressionNode } + TBinaryExpressionNode = class(TAstNode, IBinaryExpressionNode) + private + FLeft: IExpressionNode; + FOperator: TBinaryOperator; + FRight: IExpressionNode; + function GetLeft: IExpressionNode; + function GetOperator: TBinaryOperator; + function GetRight: IExpressionNode; + public + constructor Create(ALeft: IExpressionNode; AOperator: TBinaryOperator; ARight: IExpressionNode); + function Accept(const Visitor: IAstVisitor): TAstValue; override; + end; + + { TUnaryExpressionNode } + TUnaryExpressionNode = class(TAstNode, IUnaryExpressionNode) + private + FOperator: TUnaryOperator; + FRight: IExpressionNode; + function GetOperator: TUnaryOperator; + function GetRight: IExpressionNode; + public + constructor Create(const AOperator: TUnaryOperator; const ARight: IExpressionNode); + function Accept(const Visitor: IAstVisitor): TAstValue; override; + end; + + { TIfExpressionNode } + TIfExpressionNode = class(TAstNode, IIfExpressionNode) + private + FCondition: IExpressionNode; + FThenBranch: IExpressionNode; + FElseBranch: IExpressionNode; + function GetCondition: IExpressionNode; + function GetThenBranch: IExpressionNode; + function GetElseBranch: IExpressionNode; + public + constructor Create(const ACondition, AThenBranch, AElseBranch: IExpressionNode); + function Accept(const Visitor: IAstVisitor): TAstValue; override; + end; + + { TLambdaExpressionNode } + TLambdaExpressionNode = class(TAstNode, ILambdaExpressionNode) + private + FParameters: TList; + FBody: IExpressionNode; + function GetParameters: TList; + function GetBody: IExpressionNode; + public + constructor Create(const AParameters: array of IIdentifierNode; const ABody: IExpressionNode); + destructor Destroy; override; + function Accept(const Visitor: IAstVisitor): TAstValue; override; + end; + + { TFunctionCallNode } + TFunctionCallNode = class(TAstNode, IFunctionCallNode) + private + FCallee: IExpressionNode; + FArguments: TList; + function GetCallee: IExpressionNode; + function GetArguments: TList; + public + constructor Create(const ACallee: IExpressionNode; const AArguments: array of IExpressionNode); + destructor Destroy; override; + function Accept(const Visitor: IAstVisitor): TAstValue; override; + end; + + { TBlockExpressionNode } + TBlockExpressionNode = class(TAstNode, IBlockExpressionNode) + private + FExpressions: TList; + function GetExpressions: TList; + public + constructor Create(const AExpressions: array of IExpressionNode); + destructor Destroy; override; + function Accept(const Visitor: IAstVisitor): TAstValue; override; + end; + + { TVariableDeclarationNode } + TVariableDeclarationNode = class(TAstNode, IVariableDeclarationNode) + private + FIdentifier: IIdentifierNode; + FInitializer: IExpressionNode; + function GetIdentifier: IIdentifierNode; + function GetInitializer: IExpressionNode; + public + constructor Create(const AIdentifier: IIdentifierNode; AInitializer: IExpressionNode); + function Accept(const Visitor: IAstVisitor): TAstValue; override; + end; + +{ TAstValue } + +class operator TAstValue.Initialize(out Dest: TAstValue); +begin + // Ensures the record is in a clean state when created. + Dest.FKind := avkUndefined; +end; + +function TAstValue.AsClosure: IEvaluatorClosure; +begin + if (FKind <> avkClosure) then + raise EInvalidCast.Create('Cannot read value as a Closure.'); + Result := FClosure; +end; + +function TAstValue.AsScalar: TScalar; +begin + if (FKind <> avkScalar) then + raise EInvalidCast.Create('Cannot read value as a Scalar.'); + Result := FScalar; +end; + +class function TAstValue.FromClosure(const AValue: IEvaluatorClosure): TAstValue; +begin + Result.FKind := avkClosure; + Result.FClosure := AValue; + Result.FScalar := Default(TScalar); +end; + +class function TAstValue.FromScalar(const AValue: TScalar): TAstValue; +begin + Result.FKind := avkScalar; + Result.FScalar := AValue; + Result.FClosure := nil; +end; + +function TAstValue.GetIsClosure: Boolean; +begin + Result := FKind = avkClosure; +end; + +function TAstValue.GetIsScalar: Boolean; +begin + Result := FKind = avkScalar; +end; + +function TAstValue.GetIsUndefined: Boolean; +begin + Result := FKind = avkUndefined; +end; + +function TAstValue.GetKind: TAstValueKind; +begin + Result := FKind; +end; + +function TAstValue.ToString: String; +begin + case FKind of + avkScalar: Result := FScalar.ToString; + avkClosure: Result := ''; + avkUndefined: Result := ''; + else + Result := '[Unknown AstValue]'; + end; +end; + +class function TAstValue.Undefined: TAstValue; +begin + // Returns a default-initialized record, which is avkUndefined. + Result := Default(TAstValue); +end; + { TBinaryOperatorHelper } function TBinaryOperatorHelper.ToString: string; @@ -199,211 +455,45 @@ begin end; end; -type - TConstantNodeImpl = class(TInterfacedObject, IConstantNode) - private - FValue: IDataValue; - function GetValue: IDataValue; - public - constructor Create(AValue: IDataValue); - function Accept(const Visitor: IAstVisitor): IDataValue; - end; +{ TConstantNode } - TIdentifierNodeImpl = class(TInterfacedObject, IIdentifierNode) - private - FName: string; - function GetName: string; - public - constructor Create(AName: string); - function Accept(const Visitor: IAstVisitor): IDataValue; - end; - - TBinaryExpressionNodeImpl = class(TInterfacedObject, IBinaryExpressionNode) - private - FLeft: IExpressionNode; - FOperator: TBinaryOperator; - FRight: IExpressionNode; - function GetLeft: IExpressionNode; - function GetOperator: TBinaryOperator; - function GetRight: IExpressionNode; - public - constructor Create(ALeft: IExpressionNode; AOperator: TBinaryOperator; ARight: IExpressionNode); - function Accept(const Visitor: IAstVisitor): IDataValue; - end; - - TUnaryExpressionNodeImpl = class(TInterfacedObject, IUnaryExpressionNode) - private - FOperator: TUnaryOperator; - FRight: IExpressionNode; - function GetOperator: TUnaryOperator; - function GetRight: IExpressionNode; - public - constructor Create(AOperator: TUnaryOperator; ARight: IExpressionNode); - function Accept(const Visitor: IAstVisitor): IDataValue; - end; - - TIfExpressionNodeImpl = class(TInterfacedObject, IIfExpressionNode) - private - FCondition: IExpressionNode; - FThenBranch: IExpressionNode; - FElseBranch: IExpressionNode; - function GetCondition: IExpressionNode; - function GetThenBranch: IExpressionNode; - function GetElseBranch: IExpressionNode; - public - constructor Create(ACondition, AThenBranch, AElseBranch: IExpressionNode); - function Accept(const Visitor: IAstVisitor): IDataValue; - end; - - TLambdaExpressionNodeImpl = class(TInterfacedObject, ILambdaExpressionNode) - private - FParameters: TList; - FBody: IExpressionNode; - function GetParameters: TList; - function GetBody: IExpressionNode; - public - constructor Create(AParameters: TList; ABody: IExpressionNode); - destructor Destroy; override; - function Accept(const Visitor: IAstVisitor): IDataValue; - end; - - TFunctionCallNodeImpl = class(TInterfacedObject, IFunctionCallNode) - private - FCallee: IExpressionNode; - FArguments: TList; - function GetCallee: IExpressionNode; - function GetArguments: TList; - public - constructor Create(ACallee: IExpressionNode; AArguments: TList); - destructor Destroy; override; - function Accept(const Visitor: IAstVisitor): IDataValue; - end; - - TBlockExpressionNodeImpl = class(TInterfacedObject, IBlockExpressionNode) - private - FExpressions: TList; - function GetExpressions: TList; - public - constructor Create(AExpressions: TList); - destructor Destroy; override; - function Accept(const Visitor: IAstVisitor): IDataValue; - end; - - TVariableDeclarationNodeImpl = class(TInterfacedObject, IVariableDeclarationNode) - private - FIdentifier: IIdentifierNode; - FInitializer: IExpressionNode; - function GetIdentifier: IIdentifierNode; - function GetInitializer: IExpressionNode; - public - constructor Create(AIdentifier: IIdentifierNode; AInitializer: IExpressionNode); - function Accept(const Visitor: IAstVisitor): IDataValue; - end; - -{ TAst - Factory Function Implementations } - -class function TAst.Constant(AValue: IDataValue): IConstantNode; -begin - Result := TConstantNodeImpl.Create(AValue); -end; - -class function TAst.Identifier(AName: string): IIdentifierNode; -begin - Result := TIdentifierNodeImpl.Create(AName); -end; - -class function TAst.BinaryExpr(ALeft: IExpressionNode; AOperator: TBinaryOperator; ARight: IExpressionNode): IBinaryExpressionNode; -begin - Result := TBinaryExpressionNodeImpl.Create(ALeft, AOperator, ARight); -end; - -class function TAst.UnaryExpr(const AOperator: TUnaryOperator; const ARight: IExpressionNode): IUnaryExpressionNode; -begin - Result := TUnaryExpressionNodeImpl.Create(AOperator, ARight); -end; - -class function TAst.IfExpr(const ACondition: IExpressionNode; const AThenBranch, AElseBranch: IExpressionNode): IIfExpressionNode; -begin - Result := TIfExpressionNodeImpl.Create(ACondition, AThenBranch, AElseBranch); -end; - -class function TAst.LambdaExpr(const AParameters: array of IIdentifierNode; const ABody: IExpressionNode): ILambdaExpressionNode; -var - paramList: TList; - param: IIdentifierNode; -begin - paramList := TList.Create; - for param in AParameters do - paramList.Add(param); - Result := TLambdaExpressionNodeImpl.Create(paramList, ABody); -end; - -class function TAst.FunctionCall(const ACallee: IExpressionNode; const AArguments: array of IExpressionNode): IFunctionCallNode; -var - argList: TList; - arg: IExpressionNode; -begin - argList := TList.Create; - for arg in AArguments do - argList.Add(arg); - Result := TFunctionCallNodeImpl.Create(ACallee, argList); -end; - -class function TAst.Block(const AExpressions: array of IExpressionNode): IBlockExpressionNode; -var - exprList: TList; - expr: IExpressionNode; -begin - exprList := TList.Create; - for expr in AExpressions do - exprList.Add(expr); - Result := TBlockExpressionNodeImpl.Create(exprList); -end; - -class function TAst.VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IExpressionNode): IVariableDeclarationNode; -begin - Result := TVariableDeclarationNodeImpl.Create(AIdentifier, AInitializer); -end; - -{ TConstantNodeImpl } - -constructor TConstantNodeImpl.Create(AValue: IDataValue); +constructor TConstantNode.Create(AValue: TScalar); begin inherited Create; FValue := AValue; end; -function TConstantNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; +function TConstantNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitConstant(Self); end; -function TConstantNodeImpl.GetValue: IDataValue; +function TConstantNode.GetValue: TScalar; begin Result := FValue; end; -{ TIdentifierNodeImpl } +{ TIdentifierNode } -constructor TIdentifierNodeImpl.Create(AName: string); +constructor TIdentifierNode.Create(AName: string); begin inherited Create; FName := AName; end; -function TIdentifierNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; +function TIdentifierNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitIdentifier(Self); end; -function TIdentifierNodeImpl.GetName: string; +function TIdentifierNode.GetName: string; begin Result := FName; end; -{ TBinaryExpressionNodeImpl } +{ TBinaryExpressionNode } -constructor TBinaryExpressionNodeImpl.Create(ALeft: IExpressionNode; AOperator: TBinaryOperator; ARight: IExpressionNode); +constructor TBinaryExpressionNode.Create(ALeft: IExpressionNode; AOperator: TBinaryOperator; ARight: IExpressionNode); begin inherited Create; FLeft := ALeft; @@ -411,53 +501,53 @@ begin FRight := ARight; end; -function TBinaryExpressionNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; +function TBinaryExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitBinaryExpression(Self); end; -function TBinaryExpressionNodeImpl.GetLeft: IExpressionNode; +function TBinaryExpressionNode.GetLeft: IExpressionNode; begin Result := FLeft; end; -function TBinaryExpressionNodeImpl.GetOperator: TBinaryOperator; +function TBinaryExpressionNode.GetOperator: TBinaryOperator; begin Result := FOperator; end; -function TBinaryExpressionNodeImpl.GetRight: IExpressionNode; +function TBinaryExpressionNode.GetRight: IExpressionNode; begin Result := FRight; end; -{ TUnaryExpressionNodeImpl } +{ TUnaryExpressionNode } -constructor TUnaryExpressionNodeImpl.Create(AOperator: TUnaryOperator; ARight: IExpressionNode); +constructor TUnaryExpressionNode.Create(const AOperator: TUnaryOperator; const ARight: IExpressionNode); begin inherited Create; FOperator := AOperator; FRight := ARight; end; -function TUnaryExpressionNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; +function TUnaryExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitUnaryExpression(Self); end; -function TUnaryExpressionNodeImpl.GetOperator: TUnaryOperator; +function TUnaryExpressionNode.GetOperator: TUnaryOperator; begin Result := FOperator; end; -function TUnaryExpressionNodeImpl.GetRight: IExpressionNode; +function TUnaryExpressionNode.GetRight: IExpressionNode; begin Result := FRight; end; -{ TIfExpressionNodeImpl } +{ TIfExpressionNode } -constructor TIfExpressionNodeImpl.Create(ACondition, AThenBranch, AElseBranch: IExpressionNode); +constructor TIfExpressionNode.Create(const ACondition, AThenBranch, AElseBranch: IExpressionNode); begin inherited Create; FCondition := ACondition; @@ -465,132 +555,257 @@ begin FElseBranch := AElseBranch; end; -function TIfExpressionNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; +function TIfExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitIfExpression(Self); end; -function TIfExpressionNodeImpl.GetCondition: IExpressionNode; +function TIfExpressionNode.GetCondition: IExpressionNode; begin Result := FCondition; end; -function TIfExpressionNodeImpl.GetElseBranch: IExpressionNode; +function TIfExpressionNode.GetElseBranch: IExpressionNode; begin Result := FElseBranch; end; -function TIfExpressionNodeImpl.GetThenBranch: IExpressionNode; +function TIfExpressionNode.GetThenBranch: IExpressionNode; begin Result := FThenBranch; end; -{ TLambdaExpressionNodeImpl } +{ TLambdaExpressionNode } -constructor TLambdaExpressionNodeImpl.Create(AParameters: TList; ABody: IExpressionNode); +constructor TLambdaExpressionNode.Create(const AParameters: array of IIdentifierNode; const ABody: IExpressionNode); +var + param: IIdentifierNode; begin inherited Create; - FParameters := AParameters; FBody := ABody; + FParameters := TList.Create; + for param in AParameters do + FParameters.Add(param); end; -destructor TLambdaExpressionNodeImpl.Destroy; +destructor TLambdaExpressionNode.Destroy; begin FParameters.Free; - inherited Destroy; + inherited; end; -function TLambdaExpressionNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; +function TLambdaExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitLambdaExpression(Self); end; -function TLambdaExpressionNodeImpl.GetBody: IExpressionNode; +function TLambdaExpressionNode.GetBody: IExpressionNode; begin Result := FBody; end; -function TLambdaExpressionNodeImpl.GetParameters: TList; +function TLambdaExpressionNode.GetParameters: TList; begin Result := FParameters; end; -{ TFunctionCallNodeImpl } +{ TFunctionCallNode } -constructor TFunctionCallNodeImpl.Create(ACallee: IExpressionNode; AArguments: TList); +constructor TFunctionCallNode.Create(const ACallee: IExpressionNode; const AArguments: array of IExpressionNode); +var + arg: IExpressionNode; begin inherited Create; FCallee := ACallee; - FArguments := AArguments; + FArguments := TList.Create; + for arg in AArguments do + FArguments.Add(arg); end; -destructor TFunctionCallNodeImpl.Destroy; +destructor TFunctionCallNode.Destroy; begin FArguments.Free; - inherited Destroy; + inherited; end; -function TFunctionCallNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; +function TFunctionCallNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitFunctionCall(Self); end; -function TFunctionCallNodeImpl.GetArguments: TList; +function TFunctionCallNode.GetArguments: TList; begin Result := FArguments; end; -function TFunctionCallNodeImpl.GetCallee: IExpressionNode; +function TFunctionCallNode.GetCallee: IExpressionNode; begin Result := FCallee; end; -{ TBlockExpressionNodeImpl } +{ TBlockExpressionNode } -constructor TBlockExpressionNodeImpl.Create(AExpressions: TList); +constructor TBlockExpressionNode.Create(const AExpressions: array of IExpressionNode); +var + expr: IExpressionNode; begin inherited Create; - FExpressions := AExpressions; + FExpressions := TList.Create; + for expr in AExpressions do + FExpressions.Add(expr); end; -destructor TBlockExpressionNodeImpl.Destroy; +destructor TBlockExpressionNode.Destroy; begin FExpressions.Free; - inherited Destroy; + inherited; end; -function TBlockExpressionNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; +function TBlockExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitBlockExpression(Self); end; -function TBlockExpressionNodeImpl.GetExpressions: TList; +function TBlockExpressionNode.GetExpressions: TList; begin Result := FExpressions; end; -{ TVariableDeclarationNodeImpl } +{ TVariableDeclarationNode } -constructor TVariableDeclarationNodeImpl.Create(AIdentifier: IIdentifierNode; AInitializer: IExpressionNode); +constructor TVariableDeclarationNode.Create(const AIdentifier: IIdentifierNode; AInitializer: IExpressionNode); begin inherited Create; FIdentifier := AIdentifier; FInitializer := AInitializer; end; -function TVariableDeclarationNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; +function TVariableDeclarationNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitVariableDeclaration(Self); end; -function TVariableDeclarationNodeImpl.GetIdentifier: IIdentifierNode; +function TVariableDeclarationNode.GetIdentifier: IIdentifierNode; begin Result := FIdentifier; end; -function TVariableDeclarationNodeImpl.GetInitializer: IExpressionNode; +function TVariableDeclarationNode.GetInitializer: IExpressionNode; begin Result := FInitializer; end; +{ TAst } + +class function TAst.Block(const AExpressions: array of IExpressionNode): IBlockExpressionNode; +begin + Result := TBlockExpressionNode.Create(AExpressions); +end; + +class function TAst.Constant(AValue: TScalar): IConstantNode; +begin + Result := TConstantNode.Create(AValue); +end; + +class function TAst.BinaryExpr(ALeft: IExpressionNode; AOperator: TBinaryOperator; ARight: IExpressionNode): IBinaryExpressionNode; +begin + Result := TBinaryExpressionNode.Create(ALeft, AOperator, ARight); +end; + +class function TAst.FunctionCall(const ACallee: IExpressionNode; const AArguments: array of IExpressionNode): IFunctionCallNode; +begin + Result := TFunctionCallNode.Create(ACallee, AArguments); +end; + +class function TAst.Identifier(AName: string): IIdentifierNode; +begin + Result := TIdentifierNode.Create(AName); +end; + +class function TAst.IfExpr(const ACondition: IExpressionNode; const AThenBranch, AElseBranch: IExpressionNode): IIfExpressionNode; +begin + Result := TIfExpressionNode.Create(ACondition, AThenBranch, AElseBranch); +end; + +class function TAst.LambdaExpr(const AParameters: array of IIdentifierNode; const ABody: IExpressionNode): ILambdaExpressionNode; +begin + Result := TLambdaExpressionNode.Create(AParameters, ABody); +end; + +class function TAst.UnaryExpr(const AOperator: TUnaryOperator; const ARight: IExpressionNode): IUnaryExpressionNode; +begin + Result := TUnaryExpressionNode.Create(AOperator, ARight); +end; + +class function TAst.VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IExpressionNode): IVariableDeclarationNode; +begin + Result := TVariableDeclarationNode.Create(AIdentifier, AInitializer); +end; + +{ TExecutionScope } + +constructor TExecutionScope.Create(AParent: TExecutionScope); +begin + inherited Create; + FParent := AParent; + FVariables := TDictionary.Create; +end; + +destructor TExecutionScope.Destroy; +begin + FVariables.Free; + inherited Destroy; +end; + +procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); +var + pair: TPair; + indentStr: string; +begin + indentStr := ''.PadLeft(AIndent); + if (FVariables.Count > 0) then + begin + for pair in FVariables do + ABuilder.AppendLine(indentStr + Format(' %s: %s', [pair.Key, pair.Value.ToString])); + end + else + begin + ABuilder.AppendLine(indentStr + ' (empty)'); + end; + + if Assigned(FParent) then + begin + ABuilder.AppendLine(indentStr + '[Parent Scope]'); + FParent.DumpScope(ABuilder, AIndent + 2); + end; +end; + +function TExecutionScope.Dump: string; +var + builder: TStringBuilder; +begin + builder := TStringBuilder.Create; + try + builder.AppendLine('[Current Scope]'); + DumpScope(builder, 0); + Result := builder.ToString.TrimRight; + finally + builder.Free; + end; +end; + +function TExecutionScope.FindValue(const Name: string; out Value: TAstValue): Boolean; +begin + Result := FVariables.TryGetValue(Name, Value); + if not Result and Assigned(FParent) then + begin + Result := FParent.FindValue(Name, Value); + end; +end; + +procedure TExecutionScope.SetValue(const Name: string; const Value: TAstValue); +begin + FVariables.AddOrSetValue(Name, Value); +end; + end. diff --git a/Src/Data/Myc.Data.POD.pas b/Src/Data/Myc.Data.POD.pas index 931c864..67cbda0 100644 --- a/Src/Data/Myc.Data.POD.pas +++ b/Src/Data/Myc.Data.POD.pas @@ -118,6 +118,8 @@ type function GetKind: TScalarKind; inline; function GetValue: TScalarValue; inline; + function ToString: String; + property Kind: TScalarKind read GetKind; property Value: TScalarValue read GetValue; @@ -463,6 +465,27 @@ begin Result := FValue; end; +function TScalar.ToString: String; +begin + case FKind of + skInteger: Result := IntToStr(FValue.AsInteger); + skInt64: Result := IntToStr(FValue.AsInt64); + skUInt64: Result := UIntToStr(FValue.AsUInt64); + skSingle: Result := FloatToStr(FValue.AsSingle); + skDouble: Result := FloatToStr(FValue.AsDouble); + skDateTime: Result := DateTimeToStr(FValue.AsDateTime); + skTimestamp: Result := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', TimeStampToDateTime(FValue.AsTimestamp)); + skBoolean: Result := BoolToStr(FValue.AsBoolean, True); + skChar: Result := '''' + FValue.AsChar + ''''; + skPChar: Result := FValue.AsPChar; // Already null-terminated + skString: Result := '''' + string(FValue.AsString) + ''''; + skBytes: Result := '(Bytes)'; + skDecimal: Result := FloatToStr(Double(FValue.AsDecimal)); + else + Result := '[Unknown Scalar]'; + end; +end; + { TScalarArray } constructor TScalarArray.Create(AKind: TScalarKind; const AItems: TArray);