unit Myc.Ast; interface uses System.SysUtils, System.Generics.Collections, Myc.Data.Types; type // Operators are now type-safe enums 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; IConstantNode = interface; IIdentifierNode = interface; IBinaryExpressionNode = interface; IUnaryExpressionNode = interface; IIfExpressionNode = interface; ILambdaExpressionNode = interface; IFunctionCallNode = interface; IBlockExpressionNode = interface; IVariableDeclarationNode = interface; // --- Abstract Node Interfaces --- // 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; 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; {$endregion} property Value: IDataValue read GetValue; end; IIdentifierNode = interface(IExpressionNode) {$region 'private'} function GetName: string; {$endregion} property Name: string read GetName; end; IBinaryExpressionNode = interface(IExpressionNode) {$region 'private'} function GetLeft: IExpressionNode; function GetOperator: TBinaryOperator; function GetRight: IExpressionNode; {$endregion} property Left: IExpressionNode read GetLeft; property Operator: TBinaryOperator read GetOperator; property Right: IExpressionNode read GetRight; end; IUnaryExpressionNode = interface(IExpressionNode) {$region 'private'} function GetOperator: TUnaryOperator; function GetRight: IExpressionNode; {$endregion} property Operator: TUnaryOperator read GetOperator; property Right: IExpressionNode read GetRight; end; IIfExpressionNode = interface(IExpressionNode) {$region 'private'} function GetCondition: IExpressionNode; function GetThenBranch: IExpressionNode; function GetElseBranch: IExpressionNode; {$endregion} property Condition: IExpressionNode read GetCondition; property ThenBranch: IExpressionNode read GetThenBranch; property ElseBranch: IExpressionNode read GetElseBranch; end; ILambdaExpressionNode = interface(IExpressionNode) {$region 'private'} function GetParameters: TList; function GetBody: IExpressionNode; // Body is now always an expression {$endregion} property Parameters: TList read GetParameters; property Body: IExpressionNode read GetBody; end; IFunctionCallNode = interface(IExpressionNode) {$region 'private'} function GetCallee: IExpressionNode; function GetArguments: TList; {$endregion} property Callee: IExpressionNode read GetCallee; property Arguments: TList read GetArguments; end; // A block is an expression that returns the value of its last expression. IBlockExpressionNode = interface(IExpressionNode) {$region 'private'} function GetExpressions: TList; {$endregion} property Expressions: TList read GetExpressions; end; // 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 {$endregion} property Identifier: IIdentifierNode read GetIdentifier; 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 Identifier(AName: string): IIdentifierNode; static; class function BinaryExpr( ALeft: IExpressionNode; AOperator: TBinaryOperator; ARight: IExpressionNode ): IBinaryExpressionNode; static; class function UnaryExpr(const AOperator: TUnaryOperator; const ARight: IExpressionNode): IUnaryExpressionNode; static; class function IfExpr( const ACondition: IExpressionNode; const AThenBranch, AElseBranch: IExpressionNode ): IIfExpressionNode; 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; 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 FValue: IDataValue; function GetValue: IDataValue; public constructor Create(AValue: IDataValue); function Accept(const Visitor: IAstVisitor): IDataValue; end; TIdentifierNodeImpl = class(TInterfacedObject, IIdentifierNode) private FName: string; function GetName: string; public constructor Create(AName: string); function Accept(const Visitor: IAstVisitor): IDataValue; end; TBinaryExpressionNodeImpl = class(TInterfacedObject, IBinaryExpressionNode) private FLeft: IExpressionNode; FOperator: TBinaryOperator; FRight: IExpressionNode; function GetLeft: IExpressionNode; function GetOperator: TBinaryOperator; function GetRight: IExpressionNode; public constructor Create(ALeft: IExpressionNode; AOperator: TBinaryOperator; ARight: IExpressionNode); function Accept(const Visitor: IAstVisitor): IDataValue; end; TUnaryExpressionNodeImpl = class(TInterfacedObject, IUnaryExpressionNode) private FOperator: TUnaryOperator; FRight: IExpressionNode; function GetOperator: TUnaryOperator; function GetRight: IExpressionNode; public constructor Create(AOperator: TUnaryOperator; ARight: IExpressionNode); function Accept(const Visitor: IAstVisitor): IDataValue; end; TIfExpressionNodeImpl = class(TInterfacedObject, IIfExpressionNode) private FCondition: IExpressionNode; FThenBranch: IExpressionNode; FElseBranch: IExpressionNode; function GetCondition: IExpressionNode; function GetThenBranch: IExpressionNode; function GetElseBranch: IExpressionNode; public constructor Create(ACondition, AThenBranch, AElseBranch: IExpressionNode); function Accept(const Visitor: IAstVisitor): IDataValue; end; TLambdaExpressionNodeImpl = class(TInterfacedObject, ILambdaExpressionNode) private FParameters: TList; FBody: IExpressionNode; function GetParameters: TList; function GetBody: IExpressionNode; public constructor Create(AParameters: TList; ABody: IExpressionNode); destructor Destroy; override; function Accept(const Visitor: IAstVisitor): IDataValue; end; TFunctionCallNodeImpl = class(TInterfacedObject, IFunctionCallNode) private FCallee: IExpressionNode; FArguments: TList; function GetCallee: IExpressionNode; function GetArguments: TList; public constructor Create(ACallee: IExpressionNode; AArguments: TList); destructor Destroy; override; function Accept(const Visitor: IAstVisitor): IDataValue; end; TBlockExpressionNodeImpl = class(TInterfacedObject, IBlockExpressionNode) private FExpressions: TList; function GetExpressions: TList; public constructor Create(AExpressions: TList); destructor Destroy; override; function Accept(const Visitor: IAstVisitor): IDataValue; end; TVariableDeclarationNodeImpl = class(TInterfacedObject, IVariableDeclarationNode) private FIdentifier: IIdentifierNode; FInitializer: IExpressionNode; function GetIdentifier: IIdentifierNode; function GetInitializer: IExpressionNode; public constructor Create(AIdentifier: IIdentifierNode; AInitializer: IExpressionNode); function Accept(const Visitor: IAstVisitor): IDataValue; end; { TAst - Factory Function Implementations } class function TAst.Constant(AValue: IDataValue): IConstantNode; begin Result := TConstantNodeImpl.Create(AValue); end; class function TAst.Identifier(AName: string): IIdentifierNode; begin Result := TIdentifierNodeImpl.Create(AName); end; class function TAst.BinaryExpr(ALeft: IExpressionNode; AOperator: TBinaryOperator; ARight: IExpressionNode): IBinaryExpressionNode; begin Result := TBinaryExpressionNodeImpl.Create(ALeft, AOperator, ARight); end; class function TAst.UnaryExpr(const AOperator: TUnaryOperator; const ARight: IExpressionNode): IUnaryExpressionNode; begin Result := TUnaryExpressionNodeImpl.Create(AOperator, ARight); end; class function TAst.IfExpr(const ACondition: IExpressionNode; const AThenBranch, AElseBranch: IExpressionNode): IIfExpressionNode; begin Result := TIfExpressionNodeImpl.Create(ACondition, AThenBranch, AElseBranch); end; class function TAst.LambdaExpr(const AParameters: array of IIdentifierNode; const ABody: IExpressionNode): ILambdaExpressionNode; var paramList: TList; param: IIdentifierNode; begin paramList := TList.Create; for param in AParameters do paramList.Add(param); Result := TLambdaExpressionNodeImpl.Create(paramList, ABody); end; class function TAst.FunctionCall(const ACallee: IExpressionNode; const AArguments: array of IExpressionNode): IFunctionCallNode; var argList: TList; arg: IExpressionNode; begin argList := TList.Create; for arg in AArguments do argList.Add(arg); Result := TFunctionCallNodeImpl.Create(ACallee, argList); end; class function TAst.Block(const AExpressions: array of IExpressionNode): IBlockExpressionNode; var exprList: TList; expr: IExpressionNode; begin exprList := TList.Create; for expr in AExpressions do exprList.Add(expr); Result := TBlockExpressionNodeImpl.Create(exprList); end; class function TAst.VarDecl(const AIdentifier: IIdentifierNode; AInitializer: IExpressionNode): IVariableDeclarationNode; begin Result := TVariableDeclarationNodeImpl.Create(AIdentifier, AInitializer); end; { TConstantNodeImpl } constructor TConstantNodeImpl.Create(AValue: IDataValue); begin inherited Create; FValue := AValue; end; function TConstantNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; begin Result := Visitor.VisitConstant(Self); end; function TConstantNodeImpl.GetValue: IDataValue; begin Result := FValue; end; { TIdentifierNodeImpl } constructor TIdentifierNodeImpl.Create(AName: string); begin inherited Create; FName := AName; end; function TIdentifierNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; begin Result := Visitor.VisitIdentifier(Self); end; function TIdentifierNodeImpl.GetName: string; begin Result := FName; end; { TBinaryExpressionNodeImpl } constructor TBinaryExpressionNodeImpl.Create(ALeft: IExpressionNode; AOperator: TBinaryOperator; ARight: IExpressionNode); begin inherited Create; FLeft := ALeft; FOperator := AOperator; FRight := ARight; end; function TBinaryExpressionNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; begin Result := Visitor.VisitBinaryExpression(Self); end; function TBinaryExpressionNodeImpl.GetLeft: IExpressionNode; begin Result := FLeft; end; function TBinaryExpressionNodeImpl.GetOperator: TBinaryOperator; begin Result := FOperator; end; function TBinaryExpressionNodeImpl.GetRight: IExpressionNode; begin Result := FRight; end; { TUnaryExpressionNodeImpl } constructor TUnaryExpressionNodeImpl.Create(AOperator: TUnaryOperator; ARight: IExpressionNode); begin inherited Create; FOperator := AOperator; FRight := ARight; end; function TUnaryExpressionNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; begin Result := Visitor.VisitUnaryExpression(Self); end; function TUnaryExpressionNodeImpl.GetOperator: TUnaryOperator; begin Result := FOperator; end; function TUnaryExpressionNodeImpl.GetRight: IExpressionNode; begin Result := FRight; end; { TIfExpressionNodeImpl } constructor TIfExpressionNodeImpl.Create(ACondition, AThenBranch, AElseBranch: IExpressionNode); begin inherited Create; FCondition := ACondition; FThenBranch := AThenBranch; FElseBranch := AElseBranch; end; function TIfExpressionNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; begin Result := Visitor.VisitIfExpression(Self); end; function TIfExpressionNodeImpl.GetCondition: IExpressionNode; begin Result := FCondition; end; function TIfExpressionNodeImpl.GetElseBranch: IExpressionNode; begin Result := FElseBranch; end; function TIfExpressionNodeImpl.GetThenBranch: IExpressionNode; begin Result := FThenBranch; end; { TLambdaExpressionNodeImpl } constructor TLambdaExpressionNodeImpl.Create(AParameters: TList; ABody: IExpressionNode); begin inherited Create; FParameters := AParameters; FBody := ABody; end; destructor TLambdaExpressionNodeImpl.Destroy; begin FParameters.Free; inherited Destroy; end; function TLambdaExpressionNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; begin Result := Visitor.VisitLambdaExpression(Self); end; function TLambdaExpressionNodeImpl.GetBody: IExpressionNode; begin Result := FBody; end; function TLambdaExpressionNodeImpl.GetParameters: TList; begin Result := FParameters; end; { TFunctionCallNodeImpl } constructor TFunctionCallNodeImpl.Create(ACallee: IExpressionNode; AArguments: TList); begin inherited Create; FCallee := ACallee; FArguments := AArguments; end; destructor TFunctionCallNodeImpl.Destroy; begin FArguments.Free; inherited Destroy; end; function TFunctionCallNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; begin Result := Visitor.VisitFunctionCall(Self); end; function TFunctionCallNodeImpl.GetArguments: TList; begin Result := FArguments; end; function TFunctionCallNodeImpl.GetCallee: IExpressionNode; begin Result := FCallee; end; { TBlockExpressionNodeImpl } constructor TBlockExpressionNodeImpl.Create(AExpressions: TList); begin inherited Create; FExpressions := AExpressions; end; destructor TBlockExpressionNodeImpl.Destroy; begin FExpressions.Free; inherited Destroy; end; function TBlockExpressionNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; begin Result := Visitor.VisitBlockExpression(Self); end; function TBlockExpressionNodeImpl.GetExpressions: TList; begin Result := FExpressions; end; { TVariableDeclarationNodeImpl } constructor TVariableDeclarationNodeImpl.Create(AIdentifier: IIdentifierNode; AInitializer: IExpressionNode); begin inherited Create; FIdentifier := AIdentifier; FInitializer := AInitializer; end; function TVariableDeclarationNodeImpl.Accept(const Visitor: IAstVisitor): IDataValue; begin Result := Visitor.VisitVariableDeclaration(Self); end; function TVariableDeclarationNodeImpl.GetIdentifier: IIdentifierNode; begin Result := FIdentifier; end; function TVariableDeclarationNodeImpl.GetInitializer: IExpressionNode; begin Result := FInitializer; end; end.