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
+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.