unit Myc.Ast; interface uses System.SysUtils, System.Classes, System.Generics.Collections, Myc.Data.POD; 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; // 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; IIdentifierNode = interface; IConstantNode = interface; IBinaryExpressionNode = interface; IUnaryExpressionNode = interface; IIfExpressionNode = interface; ILambdaExpressionNode = interface; IFunctionCallNode = interface; IBlockExpressionNode = interface; IVariableDeclarationNode = interface; IEvaluatorClosure = interface; TExecutionScope = class; // --- Concrete Type Definitions --- // Represents a closure value for the TAstValue-based evaluator. IEvaluatorClosure = interface(IInterface) {$region 'private'} function GetBody: IExpressionNode; function GetParameters: TList; function GetClosureScope: TExecutionScope; {$endregion} property Body: IExpressionNode read GetBody; property Parameters: TList 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) function Accept(const Visitor: IAstVisitor): TAstValue; end; // Abstract interface for all nodes that evaluate to a value. IExpressionNode = interface(IAstNode) end; IConstantNode = interface(IExpressionNode) {$region 'private'} function GetValue: TScalar; {$endregion} property Value: TScalar 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; {$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 an undefined 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; // Record acting as a namespace for the factory functions. TAst = record class function Constant(AValue: TScalar): 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; // Manages the scope of execution, holding variables and their values. TExecutionScope = class private FParent: TExecutionScope; FVariables: TDictionary; 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; FBody: IExpressionNode; function GetParameters: TList; 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; function GetCallee: IExpressionNode; function GetArguments: TList; 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; function GetExpressions: TList; 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 := ''; avkUndefined: Result := ''; 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; 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; { TConstantNode } constructor TConstantNode.Create(AValue: TScalar); begin inherited Create; FValue := AValue; end; function TConstantNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitConstant(Self); end; function TConstantNode.GetValue: TScalar; begin Result := FValue; end; { TIdentifierNode } constructor TIdentifierNode.Create(AName: string); begin inherited Create; FName := AName; end; function TIdentifierNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitIdentifier(Self); end; function TIdentifierNode.GetName: string; begin Result := FName; end; { TBinaryExpressionNode } constructor TBinaryExpressionNode.Create(ALeft: IExpressionNode; AOperator: TBinaryOperator; ARight: IExpressionNode); begin inherited Create; FLeft := ALeft; FOperator := AOperator; FRight := ARight; end; function TBinaryExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitBinaryExpression(Self); end; function TBinaryExpressionNode.GetLeft: IExpressionNode; begin Result := FLeft; end; function TBinaryExpressionNode.GetOperator: TBinaryOperator; begin Result := FOperator; end; function TBinaryExpressionNode.GetRight: IExpressionNode; begin Result := FRight; end; { TUnaryExpressionNode } constructor TUnaryExpressionNode.Create(const AOperator: TUnaryOperator; const ARight: IExpressionNode); begin inherited Create; FOperator := AOperator; FRight := ARight; end; function TUnaryExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitUnaryExpression(Self); end; function TUnaryExpressionNode.GetOperator: TUnaryOperator; begin Result := FOperator; end; function TUnaryExpressionNode.GetRight: IExpressionNode; begin Result := FRight; end; { TIfExpressionNode } constructor TIfExpressionNode.Create(const ACondition, AThenBranch, AElseBranch: IExpressionNode); begin inherited Create; FCondition := ACondition; FThenBranch := AThenBranch; FElseBranch := AElseBranch; end; function TIfExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitIfExpression(Self); end; function TIfExpressionNode.GetCondition: IExpressionNode; begin Result := FCondition; end; function TIfExpressionNode.GetElseBranch: IExpressionNode; begin Result := FElseBranch; end; function TIfExpressionNode.GetThenBranch: IExpressionNode; begin Result := FThenBranch; end; { TLambdaExpressionNode } constructor TLambdaExpressionNode.Create(const AParameters: array of IIdentifierNode; const ABody: IExpressionNode); var param: IIdentifierNode; begin inherited Create; FBody := ABody; FParameters := TList.Create; for param in AParameters do FParameters.Add(param); end; destructor TLambdaExpressionNode.Destroy; begin FParameters.Free; inherited; end; function TLambdaExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitLambdaExpression(Self); end; function TLambdaExpressionNode.GetBody: IExpressionNode; begin Result := FBody; end; function TLambdaExpressionNode.GetParameters: TList; begin Result := FParameters; end; { TFunctionCallNode } constructor TFunctionCallNode.Create(const ACallee: IExpressionNode; const AArguments: array of IExpressionNode); var arg: IExpressionNode; begin inherited Create; FCallee := ACallee; FArguments := TList.Create; for arg in AArguments do FArguments.Add(arg); end; destructor TFunctionCallNode.Destroy; begin FArguments.Free; inherited; end; function TFunctionCallNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitFunctionCall(Self); end; function TFunctionCallNode.GetArguments: TList; begin Result := FArguments; end; function TFunctionCallNode.GetCallee: IExpressionNode; begin Result := FCallee; end; { TBlockExpressionNode } constructor TBlockExpressionNode.Create(const AExpressions: array of IExpressionNode); var expr: IExpressionNode; begin inherited Create; FExpressions := TList.Create; for expr in AExpressions do FExpressions.Add(expr); end; destructor TBlockExpressionNode.Destroy; begin FExpressions.Free; inherited; end; function TBlockExpressionNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitBlockExpression(Self); end; function TBlockExpressionNode.GetExpressions: TList; begin Result := FExpressions; end; { TVariableDeclarationNode } constructor TVariableDeclarationNode.Create(const AIdentifier: IIdentifierNode; AInitializer: IExpressionNode); begin inherited Create; FIdentifier := AIdentifier; FInitializer := AInitializer; end; function TVariableDeclarationNode.Accept(const Visitor: IAstVisitor): TAstValue; begin Result := Visitor.VisitVariableDeclaration(Self); end; function TVariableDeclarationNode.GetIdentifier: IIdentifierNode; begin Result := FIdentifier; end; 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.Create; end; destructor TExecutionScope.Destroy; begin FVariables.Free; inherited Destroy; end; procedure TExecutionScope.DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); var pair: TPair; 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.