Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

AST refactoring

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