unit Myc.Ast.Nodes; interface uses System.SysUtils, System.Generics.Collections, Myc.Data.POD; type // Operators and helpers TBinaryOperator = (boAdd, boSubtract, boMultiply, boDivide, boEqual, boNotEqual, boLess, boGreater, boLessOrEqual, boGreaterOrEqual); TUnaryOperator = (uoNegate, uoNot); TBinaryOperatorHelper = record helper for TBinaryOperator function ToString: string; end; TUnaryOperatorHelper = record helper for TUnaryOperator function ToString: string; end; // Added avkText to represent a string value. TAstValueKind = (avkUndefined, avkScalar, avkClosure, avkText); // --- Forward Declarations to break cycles --- IExecutionScope = interface; IAstVisitor = interface; IAstNode = interface; IExpressionNode = interface; IIdentifierNode = interface; IConstantNode = interface; IBinaryExpressionNode = interface; IUnaryExpressionNode = interface; IIfExpressionNode = interface; ILambdaExpressionNode = interface; IFunctionCallNode = interface; IBlockExpressionNode = interface; IVariableDeclarationNode = interface; IAssignmentNode = interface; IEvaluatorClosure = interface; // --- Concrete Type Definitions --- IEvaluatorClosure = interface(IInterface) {$region 'private'} function GetBody: IExpressionNode; function GetParameters: TArray; function GetClosureScope: IExecutionScope; {$endregion} property Body: IExpressionNode read GetBody; property Parameters: TArray read GetParameters; property ClosureScope: IExecutionScope read GetClosureScope; end; TAstValue = record private FKind: TAstValueKind; FScalar: TScalar; FInterface: IInterface; function GetKind: TAstValueKind; inline; function GetIsVoid: Boolean; inline; public class operator Initialize(out Dest: TAstValue); class function Void: TAstValue; static; class function FromScalar(const AValue: TScalar): TAstValue; static; class function FromClosure(const AValue: IEvaluatorClosure): TAstValue; static; class function FromText(const AValue: String): TAstValue; static; function AsScalar: TScalar; function AsClosure: IEvaluatorClosure; function AsText: String; function ToString: String; property IsVoid: Boolean read GetIsVoid; property Kind: TAstValueKind read GetKind; end; IExecutionScope = interface(IInterface) {$region 'private'} function GetParent: IExecutionScope; {$endregion} procedure Clear; function FindValue(const Name: string; out Value: TAstValue): Boolean; procedure SetValue(const Name: string; const Value: TAstValue); procedure AssignValue(const Name: string; const Value: TAstValue); function Dump: string; property Parent: IExecutionScope read GetParent; end; 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; function VisitAssignment(const Node: IAssignmentNode): TAstValue; end; IAstNode = interface(IInterface) function Accept(const Visitor: IAstVisitor): TAstValue; end; 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: TArray; function GetBody: IExpressionNode; {$endregion} property Parameters: TArray 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; IBlockExpressionNode = interface(IExpressionNode) {$region 'private'} function GetExpressions: TList; {$endregion} property Expressions: TList read GetExpressions; end; IVariableDeclarationNode = interface(IExpressionNode) {$region 'private'} function GetIdentifier: IIdentifierNode; function GetInitializer: IExpressionNode; {$endregion} property Identifier: IIdentifierNode read GetIdentifier; property Initializer: IExpressionNode read GetInitializer; end; IAssignmentNode = interface(IExpressionNode) {$region 'private'} function GetIdentifier: IIdentifierNode; function GetValue: IExpressionNode; {$endregion} property Identifier: IIdentifierNode read GetIdentifier; property Value: IExpressionNode read GetValue; end; implementation uses System.Classes; type // Private interface to encapsulate a non scalar value for reference counting. IAstValue = interface function GetValue: string; property Value: string read GetValue; end; // Implementation of the text value interface. TAstValue = class(TInterfacedObject, IAstValue) private FValue: string; function GetValue: string; public constructor Create(const AValue: string); end; { TAstValue } constructor TAstValue.Create(const AValue: string); begin inherited Create; FValue := AValue; end; function TAstValue.GetValue: string; begin Result := FValue; end; { TAstValue } class operator TAstValue.Initialize(out Dest: TAstValue); begin Dest.FKind := avkUndefined; Dest.FInterface := nil; end; function TAstValue.AsClosure: IEvaluatorClosure; begin if (FKind <> avkClosure) then raise EInvalidCast.Create('Cannot read value as a Closure.'); Result := IEvaluatorClosure(FInterface); end; function TAstValue.AsScalar: TScalar; begin if (FKind <> avkScalar) then raise EInvalidCast.Create('Cannot read value as a Scalar.'); Result := FScalar; end; function TAstValue.AsText: String; begin if (FKind <> avkText) then raise EInvalidCast.Create('Cannot read value as Text.'); Result := IAstValue(FInterface).Value; end; class function TAstValue.FromClosure(const AValue: IEvaluatorClosure): TAstValue; begin Result.FKind := avkClosure; Result.FInterface := AValue; Result.FScalar := Default(TScalar); end; class function TAstValue.FromScalar(const AValue: TScalar): TAstValue; begin Result.FKind := avkScalar; Result.FScalar := AValue; Result.FInterface := nil; end; class function TAstValue.FromText(const AValue: String): TAstValue; begin Result.FKind := avkText; Result.FInterface := TAstValue.Create(AValue); Result.FScalar := Default(TScalar); end; function TAstValue.GetIsVoid: 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 := ''; avkText: Result := AsText; avkUndefined: Result := ''; else Result := '[Unknown AstValue]'; end; end; class function TAstValue.Void: TAstValue; begin Result := Default(TAstValue); end; { TBinaryOperatorHelper } function TBinaryOperatorHelper.ToString: string; begin case Self of boAdd: Result := '+'; boSubtract: Result := '-'; boMultiply: Result := #$2A2F; 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; end.