AST-Playground
This commit is contained in:
@@ -0,0 +1,16 @@
|
||||
program ASTPlayground;
|
||||
|
||||
uses
|
||||
System.StartUpCopy,
|
||||
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';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@@ -0,0 +1,88 @@
|
||||
object Form1: TForm1
|
||||
Left = 0
|
||||
Top = 0
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 638
|
||||
ClientWidth = 925
|
||||
FormFactor.Width = 320
|
||||
FormFactor.Height = 480
|
||||
FormFactor.Devices = [Desktop]
|
||||
DesignerMasterStyle = 0
|
||||
object Panel1: TPanel
|
||||
Align = Left
|
||||
Size.Width = 137.000000000000000000
|
||||
Size.Height = 638.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 1
|
||||
object Test1Button: TButton
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 32.000000000000000000
|
||||
TabOrder = 1
|
||||
Text = 'Test 1'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = Test1ButtonClick
|
||||
end
|
||||
object Test2Button: TButton
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 62.000000000000000000
|
||||
TabOrder = 2
|
||||
Text = 'Test 2'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = Test2ButtonClick
|
||||
end
|
||||
object PrettyPrintButton: TButton
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 168.000000000000000000
|
||||
TabOrder = 3
|
||||
Text = 'Print'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = PrettyPrintButtonClick
|
||||
end
|
||||
object DebugButton: TButton
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 198.000000000000000000
|
||||
TabOrder = 4
|
||||
Text = 'Debug'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = DebugButtonClick
|
||||
end
|
||||
object RecursionButton: TButton
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 92.000000000000000000
|
||||
Size.Width = 80.000000000000000000
|
||||
Size.Height = 22.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 5
|
||||
Text = 'Recursion'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = RecursionButtonClick
|
||||
end
|
||||
object ShowScopeBox: TCheckBox
|
||||
Position.X = 32.000000000000000000
|
||||
Position.Y = 224.000000000000000000
|
||||
TabOrder = 6
|
||||
Text = 'Scope'
|
||||
end
|
||||
object FibonacciButton: TButton
|
||||
Position.X = 24.000000000000000000
|
||||
Position.Y = 122.000000000000000000
|
||||
TabOrder = 8
|
||||
Text = 'Fibonacci'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = FibonacciButtonClick
|
||||
end
|
||||
end
|
||||
object Memo1: TMemo
|
||||
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
|
||||
DataDetectorTypes = []
|
||||
StyledSettings = [Size, Style, FontColor]
|
||||
TextSettings.Font.Family = 'Consolas'
|
||||
Align = Client
|
||||
Size.Width = 788.000000000000000000
|
||||
Size.Height = 638.000000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 2
|
||||
Viewport.Width = 784.000000000000000000
|
||||
Viewport.Height = 634.000000000000000000
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,340 @@
|
||||
unit MainForm;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Types,
|
||||
System.UITypes,
|
||||
System.Classes,
|
||||
System.Variants,
|
||||
FMX.Types,
|
||||
FMX.Controls,
|
||||
FMX.Forms,
|
||||
FMX.Graphics,
|
||||
FMX.Dialogs,
|
||||
FMX.Memo.Types,
|
||||
FMX.StdCtrls,
|
||||
FMX.ScrollBox,
|
||||
FMX.Memo,
|
||||
FMX.Controls.Presentation,
|
||||
Myc.Data.Types,
|
||||
Myc.Ast,
|
||||
Myc.Ast.Evaluator,
|
||||
Myc.Ast.Printer;
|
||||
|
||||
type
|
||||
TForm1 = class(TForm)
|
||||
Panel1: TPanel;
|
||||
Memo1: TMemo;
|
||||
Test1Button: TButton;
|
||||
Test2Button: TButton;
|
||||
PrettyPrintButton: TButton;
|
||||
DebugButton: TButton;
|
||||
RecursionButton: TButton;
|
||||
ShowScopeBox: TCheckBox;
|
||||
FibonacciButton: TButton;
|
||||
procedure DebugButtonClick(Sender: TObject);
|
||||
procedure FibonacciButtonClick(Sender: TObject);
|
||||
procedure PrettyPrintButtonClick(Sender: TObject);
|
||||
procedure RecursionButtonClick(Sender: TObject);
|
||||
procedure Test1ButtonClick(Sender: TObject);
|
||||
procedure Test2ButtonClick(Sender: TObject);
|
||||
private
|
||||
// Stores the last AST generated by Test1 or Test2 button clicks.
|
||||
FLastAst: IAstNode;
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.fmx}
|
||||
|
||||
procedure TForm1.DebugButtonClick(Sender: TObject);
|
||||
var
|
||||
scope: TExecutionScope;
|
||||
visitor: IAstVisitor;
|
||||
result: IDataValue;
|
||||
begin
|
||||
if not Assigned(FLastAst) then
|
||||
begin
|
||||
Memo1.Lines.Add('No AST has been generated yet.');
|
||||
Memo1.Lines.Add('Click "Test 1" or "Test 2" first.');
|
||||
exit;
|
||||
end;
|
||||
|
||||
scope := TExecutionScope.Create(nil);
|
||||
try
|
||||
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);
|
||||
|
||||
result := FLastAst.Accept(visitor);
|
||||
|
||||
Memo1.Lines.Add('-----------------------------');
|
||||
Memo1.Lines.Add('Final script result: ' + result.AsString);
|
||||
Memo1.Lines.Add('');
|
||||
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)');
|
||||
|
||||
finally
|
||||
scope.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.FibonacciButtonClick(Sender: TObject);
|
||||
var
|
||||
scope: TExecutionScope;
|
||||
visitor: IAstVisitor;
|
||||
root: IExpressionNode;
|
||||
result: IDataValue;
|
||||
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);
|
||||
root :=
|
||||
TAst.Block(
|
||||
[
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('fib'),
|
||||
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.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)))]
|
||||
),
|
||||
boAdd,
|
||||
// fib(n - 2)
|
||||
TAst.FunctionCall(
|
||||
TAst.Identifier('fib'),
|
||||
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TDataType.Ordinal.CreateValue(2)))]
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
// Call the function
|
||||
TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(TDataType.Ordinal.CreateValue(10))])
|
||||
]
|
||||
);
|
||||
|
||||
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
|
||||
Memo1.Lines.Add('');
|
||||
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" or "Debug" to view.)');
|
||||
|
||||
finally
|
||||
scope.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.PrettyPrintButtonClick(Sender: TObject);
|
||||
var
|
||||
visitor: TPrettyPrintVisitor;
|
||||
begin
|
||||
// This button now prints the AST that was stored in FLastAst.
|
||||
Memo1.Lines.Clear;
|
||||
Memo1.Lines.Add('--- AST Pretty Print ---');
|
||||
|
||||
if not Assigned(FLastAst) then
|
||||
begin
|
||||
Memo1.Lines.Add('No AST has been generated yet.');
|
||||
Memo1.Lines.Add('Click "Test 1" or "Test 2" first.');
|
||||
exit;
|
||||
end;
|
||||
|
||||
visitor := TPrettyPrintVisitor.Create;
|
||||
try
|
||||
FLastAst.Accept(visitor);
|
||||
Memo1.Lines.Add(visitor.GetResult);
|
||||
finally
|
||||
// Visitor is an interfaced object and managed automatically.
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.RecursionButtonClick(Sender: TObject);
|
||||
var
|
||||
scope: TExecutionScope;
|
||||
visitor: IAstVisitor;
|
||||
root: IExpressionNode;
|
||||
result: IDataValue;
|
||||
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);
|
||||
root :=
|
||||
TAst.Block(
|
||||
[
|
||||
TAst.VarDecl(
|
||||
TAst.Identifier('factorial'),
|
||||
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'),
|
||||
boMultiply,
|
||||
TAst.FunctionCall(
|
||||
TAst.Identifier('factorial'), // Recursive call
|
||||
[TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TDataType.Ordinal.CreateValue(1)))]
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
),
|
||||
// Call the function
|
||||
TAst.FunctionCall(TAst.Identifier('factorial'), [TAst.Constant(TDataType.Ordinal.CreateValue(6))])
|
||||
]
|
||||
);
|
||||
|
||||
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);
|
||||
Memo1.Lines.Add('');
|
||||
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" or "Debug" to view.)');
|
||||
|
||||
finally
|
||||
scope.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.Test1ButtonClick(Sender: TObject);
|
||||
var
|
||||
root: IAstNode;
|
||||
scope: TExecutionScope;
|
||||
visitor: IAstVisitor;
|
||||
result: IDataValue;
|
||||
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.
|
||||
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.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);
|
||||
|
||||
// Display the result
|
||||
Memo1.Lines.Clear;
|
||||
Memo1.Lines.Add('AST execution result:');
|
||||
if Assigned(result) then
|
||||
Memo1.Lines.Add(result.AsString)
|
||||
else
|
||||
Memo1.Lines.Add('<no result>');
|
||||
Memo1.Lines.Add('');
|
||||
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)');
|
||||
finally
|
||||
scope.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.Test2ButtonClick(Sender: TObject);
|
||||
var
|
||||
scope: TExecutionScope;
|
||||
visitor: IAstVisitor;
|
||||
root: IExpressionNode;
|
||||
result: IDataValue;
|
||||
begin
|
||||
// The entire logic is now encapsulated in a single AST.
|
||||
// This script defines a factory function, then calls it twice.
|
||||
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.Block(
|
||||
[
|
||||
// The body of the factory defines the strategy logic
|
||||
TAst.VarDecl(TAst.Identifier('baseValue'), TAst.Constant(TDataType.Ordinal.CreateValue(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))])
|
||||
]
|
||||
);
|
||||
|
||||
// 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);
|
||||
|
||||
Memo1.Lines.Add('The entire script has been executed.');
|
||||
Memo1.Lines.Add('Result of the final expression: ' + result.AsString);
|
||||
Memo1.Lines.Add('');
|
||||
Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)');
|
||||
|
||||
finally
|
||||
scope.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -91,7 +91,7 @@
|
||||
<DCC_RemoteDebug>false</DCC_RemoteDebug>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
|
||||
<Debugger_RunParams>-r -o T:\out.txt -dirs T:\Myc\dirs.txt -f "C:\Users\Brummel\Documents\cAlgo\DataExport\ChartDisplay\ChartDisplayMain.pas"</Debugger_RunParams>
|
||||
<Debugger_RunParams>-r -o T:\out.txt -dirs T:\Myc\dirs.txt -f "T:\Myc\ASTPlayground\MainForm.pas"</Debugger_RunParams>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
||||
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
||||
|
||||
Binary file not shown.
@@ -0,0 +1,614 @@
|
||||
// https://g.co/gemini/share/f8965e72f968
|
||||
|
||||
unit Myc.Ast.Evaluator;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes, // For TStrings
|
||||
System.Generics.Collections,
|
||||
Myc.Data.Types,
|
||||
Myc.Ast;
|
||||
|
||||
type
|
||||
// Manages the scope of execution, holding variables and their values.
|
||||
TExecutionScope = class
|
||||
private
|
||||
FParent: TExecutionScope;
|
||||
FVariables: TDictionary<string, IDataValue>;
|
||||
// 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;
|
||||
|
||||
// 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<IIdentifierNode>;
|
||||
function GetClosureScope: TExecutionScope;
|
||||
{$endregion}
|
||||
property Body: IExpressionNode read GetBody;
|
||||
property Parameters: TList<IIdentifierNode> read GetParameters;
|
||||
property ClosureScope: TExecutionScope read GetClosureScope;
|
||||
end;
|
||||
|
||||
// TEvaluatorVisitor is the base implementation for evaluating an AST.
|
||||
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor)
|
||||
protected // Changed to protected to be accessible by descendants
|
||||
FScope: TExecutionScope;
|
||||
function IsTruthy(const AValue: IDataValue): Boolean;
|
||||
// Factory method to create a new visitor for a sub-scope (e.g., lambda body)
|
||||
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;
|
||||
end;
|
||||
|
||||
// TDebugEvaluatorVisitor now overrides all visit methods for full tracing
|
||||
TDebugEvaluatorVisitor = class(TEvaluatorVisitor)
|
||||
private
|
||||
FLog: TStrings;
|
||||
FIndentLevel: Integer;
|
||||
FShowScope: Boolean;
|
||||
procedure Indent;
|
||||
procedure Unindent;
|
||||
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;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
{ TDataClosureValueImpl }
|
||||
// Concrete implementation of the IDataClosureValue interface.
|
||||
TDataClosureValueImpl = class(TInterfacedObject, IDataValue, IDataClosureValue)
|
||||
private
|
||||
FMethodType: IDataMethodType;
|
||||
FBody: IExpressionNode;
|
||||
FParameters: TList<IIdentifierNode>;
|
||||
FClosureScope: TExecutionScope;
|
||||
// IDataValue
|
||||
function GetDataType: IDataType;
|
||||
function GetAsString: string;
|
||||
// IDataMethodValue
|
||||
function GetValue: TDataMethodProc;
|
||||
// IDataClosureValue
|
||||
function GetBody: IExpressionNode;
|
||||
function GetParameters: TList<IIdentifierNode>;
|
||||
function GetClosureScope: TExecutionScope;
|
||||
public
|
||||
constructor Create(
|
||||
AMethodType: IDataMethodType;
|
||||
ABody: IExpressionNode;
|
||||
AParameters: TList<IIdentifierNode>;
|
||||
ACClosureScope: TExecutionScope
|
||||
);
|
||||
end;
|
||||
|
||||
constructor TDataClosureValueImpl.Create(
|
||||
AMethodType: IDataMethodType;
|
||||
ABody: IExpressionNode;
|
||||
AParameters: TList<IIdentifierNode>;
|
||||
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 := '<CLOSURE>';
|
||||
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<IIdentifierNode>;
|
||||
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;
|
||||
|
||||
{ TExecutionScope }
|
||||
|
||||
constructor TExecutionScope.Create(AParent: TExecutionScope = nil);
|
||||
begin
|
||||
inherited Create;
|
||||
FParent := AParent;
|
||||
FVariables := TDictionary<string, IDataValue>.Create;
|
||||
end;
|
||||
|
||||
destructor TExecutionScope.Destroy;
|
||||
begin
|
||||
FVariables.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer);
|
||||
var
|
||||
pair: TPair<string, IDataValue>;
|
||||
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;
|
||||
|
||||
{ TEvaluatorVisitor }
|
||||
|
||||
constructor TEvaluatorVisitor.Create(AScope: TExecutionScope);
|
||||
begin
|
||||
inherited Create;
|
||||
Assert(Assigned(AScope));
|
||||
FScope := AScope;
|
||||
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;
|
||||
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
|
||||
Result := TDataClosureValueImpl.Create(methodType, Node.Body, Node.Parameters, FScope);
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IDataValue;
|
||||
var
|
||||
calleeValue: IDataValue;
|
||||
arguments: TList<IExpressionNode>;
|
||||
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
|
||||
Exit(False);
|
||||
|
||||
case AValue.DataType.Kind of
|
||||
dkOrdinal: Result := (TDataType.TValue(AValue).AsOrdinal.Value <> 0);
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): IDataValue;
|
||||
begin
|
||||
Result := Node.Value;
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): IDataValue;
|
||||
var
|
||||
val: IDataValue;
|
||||
begin
|
||||
if FScope.FindValue(Node.Name, val) then
|
||||
Result := val
|
||||
else
|
||||
raise EArgumentException.CreateFmt('Identifier not found: "%s"', [Node.Name]);
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue;
|
||||
var
|
||||
leftValue, rightValue: IDataValue;
|
||||
comparisonResult: Boolean;
|
||||
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).
|
||||
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;
|
||||
else
|
||||
raise ENotSupportedException.CreateFmt('Binary operation not supported for type %s', [leftValue.DataType.Name]);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue;
|
||||
var
|
||||
rightValue: IDataValue;
|
||||
ordinalVal: IDataOrdinalValue;
|
||||
begin
|
||||
rightValue := Node.Right.Accept(Self);
|
||||
|
||||
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
|
||||
else
|
||||
raise ENotSupportedException.CreateFmt('Unary "-" not supported for type %s', [rightValue.DataType.Name]);
|
||||
end;
|
||||
uoNot: raise ENotImplemented.Create('Unary "not" operator is not yet implemented');
|
||||
else
|
||||
raise ENotSupportedException.Create('Unary operator not supported');
|
||||
end;
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): IDataValue;
|
||||
var
|
||||
conditionValue: IDataValue;
|
||||
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;
|
||||
var
|
||||
expression: IExpressionNode;
|
||||
lastValue: IDataValue;
|
||||
begin
|
||||
lastValue := TDataType.Void.Value;
|
||||
for expression in Node.Expressions do
|
||||
begin
|
||||
lastValue := expression.Accept(Self);
|
||||
end;
|
||||
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);
|
||||
begin
|
||||
inherited Create(AScope);
|
||||
Assert(Assigned(ALog));
|
||||
FLog := ALog;
|
||||
FIndentLevel := AInitialIndent;
|
||||
FShowScope := AShowScope;
|
||||
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;
|
||||
|
||||
procedure TDebugEvaluatorVisitor.Indent;
|
||||
begin
|
||||
inc(FIndentLevel);
|
||||
end;
|
||||
|
||||
procedure TDebugEvaluatorVisitor.Unindent;
|
||||
begin
|
||||
dec(FIndentLevel);
|
||||
end;
|
||||
|
||||
procedure TDebugEvaluatorVisitor.AppendLine(const S: string);
|
||||
begin
|
||||
var pad := '';
|
||||
for var i := 0 to FIndentLevel - 1 do
|
||||
pad := pad + ':' + ''.PadLeft(3);
|
||||
FLog.Add(pad + S);
|
||||
end;
|
||||
|
||||
procedure TDebugEvaluatorVisitor.ShowScope;
|
||||
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
|
||||
AppendLine(line);
|
||||
AppendLine('-----------');
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitConstant(const Node: IConstantNode): IDataValue;
|
||||
begin
|
||||
AppendLine(Format('Constant (%s)', [Node.Value.AsString]));
|
||||
Result := inherited VisitConstant(Node);
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): IDataValue;
|
||||
begin
|
||||
Result := inherited VisitIdentifier(Node);
|
||||
AppendLine(Format('Identifier "%s" -> %s', [Node.Name, Result.AsString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue;
|
||||
begin
|
||||
AppendLine(Format('BinaryExpr "%s" {', [Node.Operator.ToString]));
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitBinaryExpression(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.AsString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue;
|
||||
begin
|
||||
AppendLine(Format('UnaryExpr "%s" {', [Node.Operator.ToString]));
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitUnaryExpression(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.AsString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): IDataValue;
|
||||
begin
|
||||
AppendLine('IfExpr{');
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitIfExpression(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.AsString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue;
|
||||
begin
|
||||
AppendLine('LambdaExpr{');
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitLambdaExpression(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.AsString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IDataValue;
|
||||
begin
|
||||
AppendLine('FunctionCall{');
|
||||
Indent;
|
||||
try
|
||||
ShowScope;
|
||||
Result := inherited VisitFunctionCall(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.AsString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue;
|
||||
begin
|
||||
AppendLine('Block{');
|
||||
Indent;
|
||||
try
|
||||
ShowScope;
|
||||
Result := inherited VisitBlockExpression(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
AppendLine(Format('} -> %s', [Result.AsString]));
|
||||
end;
|
||||
|
||||
function TDebugEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue;
|
||||
begin
|
||||
AppendLine(Format('VarDecl %s :=', [Node.Identifier.Name]));
|
||||
Indent;
|
||||
try
|
||||
Result := inherited VisitVariableDeclaration(Node);
|
||||
finally
|
||||
Unindent;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,191 @@
|
||||
unit Myc.Ast.Printer;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
System.Generics.Collections,
|
||||
Myc.Data.Types,
|
||||
Myc.Ast;
|
||||
|
||||
type
|
||||
TPrettyPrintVisitor = class(TInterfacedObject, IAstVisitor)
|
||||
private
|
||||
FBuilder: TStringBuilder;
|
||||
FIndentLevel: Integer;
|
||||
procedure Indent;
|
||||
procedure Unindent;
|
||||
procedure AppendLine(const S: string);
|
||||
public
|
||||
constructor Create;
|
||||
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;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TPrettyPrintVisitor }
|
||||
|
||||
constructor TPrettyPrintVisitor.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FBuilder := TStringBuilder.Create;
|
||||
FIndentLevel := 0;
|
||||
end;
|
||||
|
||||
destructor TPrettyPrintVisitor.Destroy;
|
||||
begin
|
||||
FBuilder.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.GetResult: string;
|
||||
begin
|
||||
Result := FBuilder.ToString;
|
||||
end;
|
||||
|
||||
procedure TPrettyPrintVisitor.Indent;
|
||||
begin
|
||||
inc(FIndentLevel, 2);
|
||||
end;
|
||||
|
||||
procedure TPrettyPrintVisitor.Unindent;
|
||||
begin
|
||||
dec(FIndentLevel, 2);
|
||||
end;
|
||||
|
||||
procedure TPrettyPrintVisitor.AppendLine(const S: string);
|
||||
begin
|
||||
FBuilder.Append(''.PadLeft(FIndentLevel));
|
||||
FBuilder.AppendLine(S);
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): IDataValue;
|
||||
begin
|
||||
AppendLine(Format('Constant (%s)', [Node.Value.AsString]));
|
||||
Result := TDataType.Void.Value;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode): IDataValue;
|
||||
begin
|
||||
AppendLine(Format('Identifier (%s)', [Node.Name]));
|
||||
Result := TDataType.Void.Value;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue;
|
||||
begin
|
||||
AppendLine(Format('BinaryExpr (%s)', [Node.Operator.ToString]));
|
||||
Indent;
|
||||
Node.Left.Accept(Self);
|
||||
Node.Right.Accept(Self);
|
||||
Unindent;
|
||||
Result := TDataType.Void.Value;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue;
|
||||
begin
|
||||
AppendLine(Format('UnaryExpr (%s)', [Node.Operator.ToString]));
|
||||
Indent;
|
||||
Node.Right.Accept(Self);
|
||||
Unindent;
|
||||
Result := TDataType.Void.Value;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode): IDataValue;
|
||||
begin
|
||||
AppendLine('IfExpr');
|
||||
Indent;
|
||||
AppendLine('Condition:');
|
||||
Indent;
|
||||
Node.Condition.Accept(Self);
|
||||
Unindent;
|
||||
AppendLine('Then:');
|
||||
Indent;
|
||||
Node.ThenBranch.Accept(Self);
|
||||
Unindent;
|
||||
AppendLine('Else:');
|
||||
Indent;
|
||||
Node.ElseBranch.Accept(Self);
|
||||
Unindent;
|
||||
Unindent;
|
||||
Result := TDataType.Void.Value;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue;
|
||||
var
|
||||
param: IIdentifierNode;
|
||||
paramNames: TStringList;
|
||||
begin
|
||||
paramNames := TStringList.Create;
|
||||
try
|
||||
for param in Node.Parameters do
|
||||
paramNames.Add(param.Name);
|
||||
AppendLine(Format('Lambda (params: %s)', [paramNames.CommaText]));
|
||||
finally
|
||||
paramNames.Free;
|
||||
end;
|
||||
|
||||
Indent;
|
||||
AppendLine('Body:');
|
||||
Indent;
|
||||
Node.Body.Accept(Self);
|
||||
Unindent;
|
||||
Unindent;
|
||||
Result := TDataType.Void.Value;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IDataValue;
|
||||
var
|
||||
arg: IExpressionNode;
|
||||
begin
|
||||
AppendLine('FunctionCall');
|
||||
Indent;
|
||||
AppendLine('Callee:');
|
||||
Indent;
|
||||
Node.Callee.Accept(Self);
|
||||
Unindent;
|
||||
AppendLine('Arguments:');
|
||||
Indent;
|
||||
for arg in Node.Arguments do
|
||||
arg.Accept(Self);
|
||||
Unindent;
|
||||
Unindent;
|
||||
Result := TDataType.Void.Value;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue;
|
||||
var
|
||||
expr: IExpressionNode;
|
||||
begin
|
||||
AppendLine('Block');
|
||||
Indent;
|
||||
for expr in Node.Expressions do
|
||||
expr.Accept(Self);
|
||||
Unindent;
|
||||
Result := TDataType.Void.Value;
|
||||
end;
|
||||
|
||||
function TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue;
|
||||
begin
|
||||
AppendLine(Format('VarDecl (%s)', [Node.Identifier.Name]));
|
||||
if Assigned(Node.Initializer) then
|
||||
begin
|
||||
Indent;
|
||||
Node.Initializer.Accept(Self);
|
||||
Unindent;
|
||||
end;
|
||||
Result := TDataType.Void.Value;
|
||||
end;
|
||||
|
||||
end.
|
||||
+93
-385
@@ -9,14 +9,22 @@ uses
|
||||
|
||||
type
|
||||
// Operators are now type-safe enums
|
||||
TBinaryOperator = (boAdd, boSubtract, boMultiply, boDivide);
|
||||
TBinaryOperator = (boAdd, boSubtract, boMultiply, boDivide, boEqual, boNotEqual, boLess, boGreater, boLessOrEqual, boGreaterOrEqual);
|
||||
TUnaryOperator = (uoNegate, uoNot);
|
||||
|
||||
// Helper to convert operators to string
|
||||
TBinaryOperatorHelper = record helper for TBinaryOperator
|
||||
function ToString: string;
|
||||
end;
|
||||
|
||||
TUnaryOperatorHelper = record helper for TUnaryOperator
|
||||
function ToString: string;
|
||||
end;
|
||||
|
||||
// Forward declarations for interfaces
|
||||
IAstVisitor = interface;
|
||||
IAstNode = interface;
|
||||
IExpressionNode = interface;
|
||||
IStatementNode = interface;
|
||||
IConstantNode = interface;
|
||||
IIdentifierNode = interface;
|
||||
IBinaryExpressionNode = interface;
|
||||
@@ -24,9 +32,8 @@ type
|
||||
IIfExpressionNode = interface;
|
||||
ILambdaExpressionNode = interface;
|
||||
IFunctionCallNode = interface;
|
||||
IBlockStatementNode = interface;
|
||||
IVariableDeclarationStatementNode = interface;
|
||||
IExpressionStatementNode = interface;
|
||||
IBlockExpressionNode = interface;
|
||||
IVariableDeclarationNode = interface;
|
||||
|
||||
// --- Abstract Node Interfaces ---
|
||||
|
||||
@@ -37,13 +44,10 @@ type
|
||||
end;
|
||||
|
||||
// Abstract interface for all nodes that evaluate to a value.
|
||||
// In this paradigm, all nodes are expressions.
|
||||
IExpressionNode = interface(IAstNode)
|
||||
end;
|
||||
|
||||
// Abstract interface for all nodes that perform an action.
|
||||
IStatementNode = interface(IAstNode)
|
||||
end;
|
||||
|
||||
// --- Concrete Expression Node Interfaces ---
|
||||
|
||||
IConstantNode = interface(IExpressionNode)
|
||||
@@ -94,10 +98,10 @@ type
|
||||
ILambdaExpressionNode = interface(IExpressionNode)
|
||||
{$region 'private'}
|
||||
function GetParameters: TList<IIdentifierNode>;
|
||||
function GetBody: IAstNode; // Can be an expression or a block statement
|
||||
function GetBody: IExpressionNode; // Body is now always an expression
|
||||
{$endregion}
|
||||
property Parameters: TList<IIdentifierNode> read GetParameters;
|
||||
property Body: IAstNode read GetBody;
|
||||
property Body: IExpressionNode read GetBody;
|
||||
end;
|
||||
|
||||
IFunctionCallNode = interface(IExpressionNode)
|
||||
@@ -109,16 +113,16 @@ type
|
||||
property Arguments: TList<IExpressionNode> read GetArguments;
|
||||
end;
|
||||
|
||||
// --- Concrete Statement Node Interfaces ---
|
||||
|
||||
IBlockStatementNode = interface(IStatementNode)
|
||||
// A block is an expression that returns the value of its last expression.
|
||||
IBlockExpressionNode = interface(IExpressionNode)
|
||||
{$region 'private'}
|
||||
function GetStatements: TList<IStatementNode>;
|
||||
function GetExpressions: TList<IExpressionNode>;
|
||||
{$endregion}
|
||||
property Statements: TList<IStatementNode> read GetStatements;
|
||||
property Expressions: TList<IExpressionNode> read GetExpressions;
|
||||
end;
|
||||
|
||||
IVariableDeclarationStatementNode = interface(IStatementNode)
|
||||
// A variable declaration is an expression that returns a void value.
|
||||
IVariableDeclarationNode = interface(IExpressionNode)
|
||||
{$region 'private'}
|
||||
function GetIdentifier: IIdentifierNode;
|
||||
function GetInitializer: IExpressionNode; // Can be nil
|
||||
@@ -127,17 +131,9 @@ type
|
||||
property Initializer: IExpressionNode read GetInitializer;
|
||||
end;
|
||||
|
||||
IExpressionStatementNode = interface(IStatementNode)
|
||||
{$region 'private'}
|
||||
function GetExpression: IExpressionNode;
|
||||
{$endregion}
|
||||
property Expression: IExpressionNode read GetExpression;
|
||||
end;
|
||||
|
||||
// All visitor methods are functions returning a value.
|
||||
IAstVisitor = interface
|
||||
['{5F4110E9-0158-41E9-A512-E57A843E8A5A}']
|
||||
// Expression visitors
|
||||
function VisitConstant(const Node: IConstantNode): IDataValue;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): IDataValue;
|
||||
function VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue;
|
||||
@@ -145,16 +141,12 @@ type
|
||||
function VisitIfExpression(const Node: IIfExpressionNode): IDataValue;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): IDataValue;
|
||||
|
||||
// Statement visitors
|
||||
function VisitBlockStatement(const Node: IBlockStatementNode): IDataValue;
|
||||
function VisitVariableDeclarationStatement(const Node: IVariableDeclarationStatementNode): IDataValue;
|
||||
function VisitExpressionStatement(const Node: IExpressionStatementNode): 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
|
||||
// Expressions
|
||||
class function Constant(AValue: IDataValue): IConstantNode; static;
|
||||
class function Identifier(AName: string): IIdentifierNode; static;
|
||||
class function BinaryExpr(
|
||||
@@ -167,53 +159,46 @@ type
|
||||
const ACondition: IExpressionNode;
|
||||
const AThenBranch, AElseBranch: IExpressionNode
|
||||
): IIfExpressionNode; static;
|
||||
class function LambdaExpr(const AParameters: array of IIdentifierNode; const ABody: IAstNode): ILambdaExpressionNode; static;
|
||||
class function LambdaExpr(const AParameters: array of IIdentifierNode; const ABody: IExpressionNode): ILambdaExpressionNode; static;
|
||||
class function FunctionCall(const ACallee: IExpressionNode; const AArguments: array of IExpressionNode): IFunctionCallNode; static;
|
||||
// Statements
|
||||
class function Block(const AStatements: array of IStatementNode): IBlockStatementNode; static;
|
||||
class function VarDecl(
|
||||
const AIdentifier: IIdentifierNode;
|
||||
AInitializer: IExpressionNode
|
||||
): IVariableDeclarationStatementNode; static;
|
||||
class function ExprStmt(const AExpression: IExpressionNode): IExpressionStatementNode; static;
|
||||
end;
|
||||
|
||||
// Manages the scope of execution, holding variables and their values.
|
||||
TExecutionScope = class
|
||||
private
|
||||
FParent: TExecutionScope;
|
||||
FVariables: TDictionary<string, IDataValue>;
|
||||
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);
|
||||
end;
|
||||
|
||||
// TEvaluatorVisitor is stateless and thread-safe.
|
||||
TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor)
|
||||
private
|
||||
FScope: TExecutionScope;
|
||||
function IsTruthy(const AValue: IDataValue): Boolean;
|
||||
public
|
||||
constructor Create(AScope: TExecutionScope);
|
||||
// Expression visitors
|
||||
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;
|
||||
|
||||
// Statement visitors
|
||||
function VisitBlockStatement(const Node: IBlockStatementNode): IDataValue;
|
||||
function VisitVariableDeclarationStatement(const Node: IVariableDeclarationStatementNode): IDataValue;
|
||||
function VisitExpressionStatement(const Node: IExpressionStatementNode): IDataValue;
|
||||
class function Block(const AExpressions: array of IExpressionNode): IBlockExpressionNode; static;
|
||||
class function VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IExpressionNode): IVariableDeclarationNode; static;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TBinaryOperatorHelper }
|
||||
|
||||
function TBinaryOperatorHelper.ToString: string;
|
||||
begin
|
||||
case Self of
|
||||
boAdd: Result := '+';
|
||||
boSubtract: Result := '-';
|
||||
boMultiply: Result := '*';
|
||||
boDivide: Result := '/';
|
||||
boEqual: Result := '==';
|
||||
boNotEqual: Result := '!=';
|
||||
boLess: Result := '<';
|
||||
boGreater: Result := '>';
|
||||
boLessOrEqual: Result := '<=';
|
||||
boGreaterOrEqual: Result := '>=';
|
||||
else
|
||||
Result := '?';
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TUnaryOperatorHelper }
|
||||
|
||||
function TUnaryOperatorHelper.ToString: string;
|
||||
begin
|
||||
case Self of
|
||||
uoNegate: Result := '-';
|
||||
uoNot: Result := 'not';
|
||||
else
|
||||
Result := '?';
|
||||
end;
|
||||
end;
|
||||
|
||||
type
|
||||
TConstantNodeImpl = class(TInterfacedObject, IConstantNode)
|
||||
private
|
||||
@@ -273,11 +258,11 @@ type
|
||||
TLambdaExpressionNodeImpl = class(TInterfacedObject, ILambdaExpressionNode)
|
||||
private
|
||||
FParameters: TList<IIdentifierNode>;
|
||||
FBody: IAstNode;
|
||||
FBody: IExpressionNode;
|
||||
function GetParameters: TList<IIdentifierNode>;
|
||||
function GetBody: IAstNode;
|
||||
function GetBody: IExpressionNode;
|
||||
public
|
||||
constructor Create(AParameters: TList<IIdentifierNode>; ABody: IAstNode);
|
||||
constructor Create(AParameters: TList<IIdentifierNode>; ABody: IExpressionNode);
|
||||
destructor Destroy; override;
|
||||
function Accept(const Visitor: IAstVisitor): IDataValue;
|
||||
end;
|
||||
@@ -294,17 +279,17 @@ type
|
||||
function Accept(const Visitor: IAstVisitor): IDataValue;
|
||||
end;
|
||||
|
||||
TBlockStatementNodeImpl = class(TInterfacedObject, IBlockStatementNode)
|
||||
TBlockExpressionNodeImpl = class(TInterfacedObject, IBlockExpressionNode)
|
||||
private
|
||||
FStatements: TList<IStatementNode>;
|
||||
function GetStatements: TList<IStatementNode>;
|
||||
FExpressions: TList<IExpressionNode>;
|
||||
function GetExpressions: TList<IExpressionNode>;
|
||||
public
|
||||
constructor Create(AStatements: TList<IStatementNode>);
|
||||
constructor Create(AExpressions: TList<IExpressionNode>);
|
||||
destructor Destroy; override;
|
||||
function Accept(const Visitor: IAstVisitor): IDataValue;
|
||||
end;
|
||||
|
||||
TVariableDeclarationStatementNodeImpl = class(TInterfacedObject, IVariableDeclarationStatementNode)
|
||||
TVariableDeclarationNodeImpl = class(TInterfacedObject, IVariableDeclarationNode)
|
||||
private
|
||||
FIdentifier: IIdentifierNode;
|
||||
FInitializer: IExpressionNode;
|
||||
@@ -315,15 +300,6 @@ type
|
||||
function Accept(const Visitor: IAstVisitor): IDataValue;
|
||||
end;
|
||||
|
||||
TExpressionStatementNodeImpl = class(TInterfacedObject, IExpressionStatementNode)
|
||||
private
|
||||
FExpression: IExpressionNode;
|
||||
function GetExpression: IExpressionNode;
|
||||
public
|
||||
constructor Create(AExpression: IExpressionNode);
|
||||
function Accept(const Visitor: IAstVisitor): IDataValue;
|
||||
end;
|
||||
|
||||
{ TAst - Factory Function Implementations }
|
||||
|
||||
class function TAst.Constant(AValue: IDataValue): IConstantNode;
|
||||
@@ -351,7 +327,7 @@ begin
|
||||
Result := TIfExpressionNodeImpl.Create(ACondition, AThenBranch, AElseBranch);
|
||||
end;
|
||||
|
||||
class function TAst.LambdaExpr(const AParameters: array of IIdentifierNode; const ABody: IAstNode): ILambdaExpressionNode;
|
||||
class function TAst.LambdaExpr(const AParameters: array of IIdentifierNode; const ABody: IExpressionNode): ILambdaExpressionNode;
|
||||
var
|
||||
paramList: TList<IIdentifierNode>;
|
||||
param: IIdentifierNode;
|
||||
@@ -373,25 +349,20 @@ begin
|
||||
Result := TFunctionCallNodeImpl.Create(ACallee, argList);
|
||||
end;
|
||||
|
||||
class function TAst.Block(const AStatements: array of IStatementNode): IBlockStatementNode;
|
||||
class function TAst.Block(const AExpressions: array of IExpressionNode): IBlockExpressionNode;
|
||||
var
|
||||
stmtList: TList<IStatementNode>;
|
||||
stmt: IStatementNode;
|
||||
exprList: TList<IExpressionNode>;
|
||||
expr: IExpressionNode;
|
||||
begin
|
||||
stmtList := TList<IStatementNode>.Create;
|
||||
for stmt in AStatements do
|
||||
stmtList.Add(stmt);
|
||||
Result := TBlockStatementNodeImpl.Create(stmtList);
|
||||
exprList := TList<IExpressionNode>.Create;
|
||||
for expr in AExpressions do
|
||||
exprList.Add(expr);
|
||||
Result := TBlockExpressionNodeImpl.Create(exprList);
|
||||
end;
|
||||
|
||||
class function TAst.VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IExpressionNode): IVariableDeclarationStatementNode;
|
||||
class function TAst.VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IExpressionNode): IVariableDeclarationNode;
|
||||
begin
|
||||
Result := TVariableDeclarationStatementNodeImpl.Create(AIdentifier, AInitializer);
|
||||
end;
|
||||
|
||||
class function TAst.ExprStmt(const AExpression: IExpressionNode): IExpressionStatementNode;
|
||||
begin
|
||||
Result := TExpressionStatementNodeImpl.Create(AExpression);
|
||||
Result := TVariableDeclarationNodeImpl.Create(AIdentifier, AInitializer);
|
||||
end;
|
||||
|
||||
{ TConstantNodeImpl }
|
||||
@@ -516,7 +487,7 @@ end;
|
||||
|
||||
{ TLambdaExpressionNodeImpl }
|
||||
|
||||
constructor TLambdaExpressionNodeImpl.Create(AParameters: TList<IIdentifierNode>; ABody: IAstNode);
|
||||
constructor TLambdaExpressionNodeImpl.Create(AParameters: TList<IIdentifierNode>; ABody: IExpressionNode);
|
||||
begin
|
||||
inherited Create;
|
||||
FParameters := AParameters;
|
||||
@@ -534,7 +505,7 @@ begin
|
||||
Result := Visitor.VisitLambdaExpression(Self);
|
||||
end;
|
||||
|
||||
function TLambdaExpressionNodeImpl.GetBody: IAstNode;
|
||||
function TLambdaExpressionNodeImpl.GetBody: IExpressionNode;
|
||||
begin
|
||||
Result := FBody;
|
||||
end;
|
||||
@@ -574,315 +545,52 @@ begin
|
||||
Result := FCallee;
|
||||
end;
|
||||
|
||||
{ TBlockStatementNodeImpl }
|
||||
{ TBlockExpressionNodeImpl }
|
||||
|
||||
constructor TBlockStatementNodeImpl.Create(AStatements: TList<IStatementNode>);
|
||||
constructor TBlockExpressionNodeImpl.Create(AExpressions: TList<IExpressionNode>);
|
||||
begin
|
||||
inherited Create;
|
||||
FStatements := AStatements;
|
||||
FExpressions := AExpressions;
|
||||
end;
|
||||
|
||||
destructor TBlockStatementNodeImpl.Destroy;
|
||||
destructor TBlockExpressionNodeImpl.Destroy;
|
||||
begin
|
||||
FStatements.Free;
|
||||
FExpressions.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TBlockStatementNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue;
|
||||
function TBlockExpressionNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue;
|
||||
begin
|
||||
Result := Visitor.VisitBlockStatement(Self);
|
||||
Result := Visitor.VisitBlockExpression(Self);
|
||||
end;
|
||||
|
||||
function TBlockStatementNodeImpl.GetStatements: TList<IStatementNode>;
|
||||
function TBlockExpressionNodeImpl.GetExpressions: TList<IExpressionNode>;
|
||||
begin
|
||||
Result := FStatements;
|
||||
Result := FExpressions;
|
||||
end;
|
||||
|
||||
{ TVariableDeclarationStatementNodeImpl }
|
||||
{ TVariableDeclarationNodeImpl }
|
||||
|
||||
constructor TVariableDeclarationStatementNodeImpl.Create(AIdentifier: IIdentifierNode; AInitializer: IExpressionNode);
|
||||
constructor TVariableDeclarationNodeImpl.Create(AIdentifier: IIdentifierNode; AInitializer: IExpressionNode);
|
||||
begin
|
||||
inherited Create;
|
||||
FIdentifier := AIdentifier;
|
||||
FInitializer := AInitializer;
|
||||
end;
|
||||
|
||||
function TVariableDeclarationStatementNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue;
|
||||
function TVariableDeclarationNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue;
|
||||
begin
|
||||
Result := Visitor.VisitVariableDeclarationStatement(Self);
|
||||
Result := Visitor.VisitVariableDeclaration(Self);
|
||||
end;
|
||||
|
||||
function TVariableDeclarationStatementNodeImpl.GetIdentifier: IIdentifierNode;
|
||||
function TVariableDeclarationNodeImpl.GetIdentifier: IIdentifierNode;
|
||||
begin
|
||||
Result := FIdentifier;
|
||||
end;
|
||||
|
||||
function TVariableDeclarationStatementNodeImpl.GetInitializer: IExpressionNode;
|
||||
function TVariableDeclarationNodeImpl.GetInitializer: IExpressionNode;
|
||||
begin
|
||||
Result := FInitializer;
|
||||
end;
|
||||
|
||||
{ TExpressionStatementNodeImpl }
|
||||
|
||||
constructor TExpressionStatementNodeImpl.Create(AExpression: IExpressionNode);
|
||||
begin
|
||||
inherited Create;
|
||||
FExpression := AExpression;
|
||||
end;
|
||||
|
||||
function TExpressionStatementNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue;
|
||||
begin
|
||||
Result := Visitor.VisitExpressionStatement(Self);
|
||||
end;
|
||||
|
||||
function TExpressionStatementNodeImpl.GetExpression: IExpressionNode;
|
||||
begin
|
||||
Result := FExpression;
|
||||
end;
|
||||
|
||||
{ TExecutionScope }
|
||||
|
||||
constructor TExecutionScope.Create(AParent: TExecutionScope = nil);
|
||||
begin
|
||||
inherited Create;
|
||||
FParent := AParent;
|
||||
FVariables := TDictionary<string, IDataValue>.Create;
|
||||
end;
|
||||
|
||||
destructor TExecutionScope.Destroy;
|
||||
begin
|
||||
FVariables.Free;
|
||||
inherited Destroy;
|
||||
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;
|
||||
|
||||
{ TEvaluatorVisitor }
|
||||
|
||||
constructor TEvaluatorVisitor.Create(AScope: TExecutionScope);
|
||||
begin
|
||||
inherited Create;
|
||||
Assert(Assigned(AScope));
|
||||
FScope := AScope;
|
||||
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
|
||||
Exit(False);
|
||||
|
||||
case AValue.DataType.Kind of
|
||||
dkOrdinal: Result := (TDataType.TValue(AValue).AsOrdinal.Value <> 0);
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitConstant(const Node: IConstantNode): IDataValue;
|
||||
begin
|
||||
Result := Node.Value;
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): IDataValue;
|
||||
var
|
||||
val: IDataValue;
|
||||
begin
|
||||
if FScope.FindValue(Node.Name, val) then
|
||||
Result := val
|
||||
else
|
||||
raise EArgumentException.CreateFmt('Identifier not found: "%s"', [Node.Name]);
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue;
|
||||
var
|
||||
leftValue, rightValue: IDataValue;
|
||||
begin
|
||||
leftValue := Node.Left.Accept(Self);
|
||||
rightValue := Node.Right.Accept(Self);
|
||||
|
||||
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;
|
||||
else
|
||||
raise ENotSupportedException.CreateFmt('Binary operation not supported for type %s', [leftValue.DataType.Name]);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue;
|
||||
var
|
||||
rightValue: IDataValue;
|
||||
ordinalVal: IDataOrdinalValue;
|
||||
begin
|
||||
rightValue := Node.Right.Accept(Self);
|
||||
|
||||
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
|
||||
else
|
||||
raise ENotSupportedException.CreateFmt('Unary "-" not supported for type %s', [rightValue.DataType.Name]);
|
||||
end;
|
||||
uoNot: raise ENotImplemented.Create('Unary "not" operator is not yet implemented');
|
||||
else
|
||||
raise ENotSupportedException.Create('Unary operator not supported');
|
||||
end;
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): IDataValue;
|
||||
var
|
||||
conditionValue: IDataValue;
|
||||
begin
|
||||
conditionValue := Node.Condition.Accept(Self);
|
||||
|
||||
if IsTruthy(conditionValue) then
|
||||
Result := Node.ThenBranch.Accept(Self)
|
||||
else
|
||||
Result := Node.ElseBranch.Accept(Self);
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue;
|
||||
var
|
||||
lambdaBody: IAstNode;
|
||||
lambdaParams: TList<IIdentifierNode>;
|
||||
closureScope: TExecutionScope;
|
||||
methodType: IDataMethodType;
|
||||
begin
|
||||
closureScope := FScope;
|
||||
lambdaBody := Node.Body;
|
||||
lambdaParams := Node.Parameters;
|
||||
methodType := TDataType.MethodOf(TDataType.Ordinal, TDataType.Ordinal);
|
||||
|
||||
Result :=
|
||||
methodType.CreateValue(
|
||||
function(const AValue: IDataValue): IDataValue
|
||||
var
|
||||
callScope: TExecutionScope;
|
||||
innerVisitor: IAstVisitor;
|
||||
begin
|
||||
callScope := TExecutionScope.Create(closureScope);
|
||||
try
|
||||
if (lambdaParams.Count <> 1) then
|
||||
raise EArgumentException.Create('This simple implementation only supports single-parameter lambdas.');
|
||||
|
||||
callScope.SetValue(lambdaParams[0].Name, AValue);
|
||||
|
||||
innerVisitor := TEvaluatorVisitor.Create(callScope);
|
||||
Result := lambdaBody.Accept(innerVisitor);
|
||||
finally
|
||||
callScope.Free;
|
||||
end;
|
||||
end
|
||||
);
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IDataValue;
|
||||
var
|
||||
calleeValue, argValue: IDataValue;
|
||||
methodProc: TDataMethodProc;
|
||||
arguments: TList<IExpressionNode>;
|
||||
begin
|
||||
calleeValue := Node.Callee.Accept(Self);
|
||||
|
||||
if (calleeValue.DataType.Kind <> dkMethod) then
|
||||
raise EArgumentException.Create('Expression is not callable.');
|
||||
|
||||
arguments := Node.Arguments;
|
||||
if (arguments.Count <> 1) then
|
||||
raise EArgumentException.Create('This simple implementation only supports single-argument calls.');
|
||||
|
||||
argValue := arguments[0].Accept(Self);
|
||||
|
||||
methodProc := TDataType.TValue(calleeValue).AsMethod.Value;
|
||||
Result := methodProc(argValue);
|
||||
end;
|
||||
|
||||
// --- Statement Visitor Implementations ---
|
||||
|
||||
function TEvaluatorVisitor.VisitBlockStatement(const Node: IBlockStatementNode): IDataValue;
|
||||
var
|
||||
statement: IStatementNode;
|
||||
begin
|
||||
// Execute all statements in the block sequentially.
|
||||
for statement in Node.Statements do
|
||||
begin
|
||||
statement.Accept(Self); // The result is ignored.
|
||||
end;
|
||||
Result := TDataType.Void.Value;
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitVariableDeclarationStatement(const Node: IVariableDeclarationStatementNode): IDataValue;
|
||||
var
|
||||
varName: string;
|
||||
initValue: IDataValue;
|
||||
begin
|
||||
varName := Node.Identifier.Name;
|
||||
|
||||
// Evaluate the initializer expression, if it exists.
|
||||
if Assigned(Node.Initializer) then
|
||||
initValue := Node.Initializer.Accept(Self)
|
||||
else
|
||||
initValue := TDataType.Void.Value; // Default value if no initializer is provided.
|
||||
|
||||
// Define the variable in the current scope.
|
||||
FScope.SetValue(varName, initValue);
|
||||
|
||||
Result := TDataType.Void.Value;
|
||||
end;
|
||||
|
||||
function TEvaluatorVisitor.VisitExpressionStatement(const Node: IExpressionStatementNode): IDataValue;
|
||||
begin
|
||||
// Evaluate the expression for its side-effects and discard the result.
|
||||
Node.Expression.Accept(Self);
|
||||
Result := TDataType.Void.Value;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -553,7 +553,7 @@ type
|
||||
class operator Implicit(const A: TDataType.TMethod): IDataMethodType; overload; inline;
|
||||
property ArgType: IDataType read GetArgType;
|
||||
property ResultType: IDataType read GetResultType;
|
||||
function CreateValue(const Proc: TProc): TDataType.TMethod.TValue; inline;
|
||||
function CreateValue(const Proc: TProc): TDataType.TMethod.TValue;
|
||||
end;
|
||||
|
||||
// Helper to cast a generic TValue to a specific value helper.
|
||||
@@ -598,11 +598,11 @@ type
|
||||
class operator Implicit(const A: TDataType.TVector): TDataType; overload; inline;
|
||||
|
||||
// Type factories
|
||||
class function Void: TDataType.TVoid; static; inline;
|
||||
class function Ordinal: TDataType.TOrdinal; static; inline;
|
||||
class function Float: TDataType.TFloat; static; inline;
|
||||
class function Text: TDataType.TText; static; inline;
|
||||
class function Timestamp: TDataType.TTimestamp; static; inline;
|
||||
class function Void: TDataType.TVoid; static;
|
||||
class function Ordinal: TDataType.TOrdinal; static;
|
||||
class function Float: TDataType.TFloat; static;
|
||||
class function Text: TDataType.TText; static;
|
||||
class function Timestamp: TDataType.TTimestamp; static;
|
||||
class function DecimalOf(const AScale: Integer): TDataType.TDecimal; static;
|
||||
class function TupleOf(const AItemTypes: array of IDataType): TDataType.TTuple; overload; static;
|
||||
class function TupleOf(const AItemValues: array of IDataValue): TDataType.TTuple.TValue; overload; static;
|
||||
|
||||
Reference in New Issue
Block a user