AST-Playground

This commit is contained in:
Michael Schimmel
2025-08-28 00:56:20 +02:00
parent 3268748c03
commit bb0e2fd5af
12 changed files with 2500 additions and 393 deletions
+16
View File
@@ -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.
+88
View File
@@ -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
+340
View File
@@ -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.
+1 -1
View File
@@ -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 &quot;C:\Users\Brummel\Documents\cAlgo\DataExport\ChartDisplay\ChartDisplayMain.pas&quot;</Debugger_RunParams>
<Debugger_RunParams>-r -o T:\out.txt -dirs T:\Myc\dirs.txt -f &quot;T:\Myc\ASTPlayground\MainForm.pas&quot;</Debugger_RunParams>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
Binary file not shown.
+614
View File
@@ -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.
+191
View File
@@ -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
View File
@@ -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.
+6 -6
View File
@@ -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;
+1 -1
View File
@@ -1,4 +1,4 @@
T:\Myc\Src
T:\Myc\Src\Data
T:\Myc\Src\AST
T:\Myc\Test
T:\Myc\AuraTrader