From fa9328a183e6c62c1da6203b7352ccce2902796f Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Fri, 29 Aug 2025 09:44:17 +0200 Subject: [PATCH] AST refactoring --- ASTPlayground/ASTPlayground.dpr | 4 +- ASTPlayground/ASTPlayground.dproj | 2 + ASTPlayground/MainForm.fmx | 1 - ASTPlayground/MainForm.pas | 135 +++++----- Src/AST/Myc.Ast.Evaluator.pas | 52 ++-- Src/AST/Myc.Ast.Nodes.pas | 305 ++++++++++++++++++++++ Src/AST/Myc.Ast.Printer.pas | 1 + Src/AST/Myc.Ast.Scope.pas | 123 +++++++++ Src/AST/Myc.Ast.pas | 415 +----------------------------- 9 files changed, 524 insertions(+), 514 deletions(-) create mode 100644 Src/AST/Myc.Ast.Nodes.pas create mode 100644 Src/AST/Myc.Ast.Scope.pas diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr index 347f1c1..60bf9cf 100644 --- a/ASTPlayground/ASTPlayground.dpr +++ b/ASTPlayground/ASTPlayground.dpr @@ -5,7 +5,9 @@ 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.Printer in '..\Src\AST\Myc.Ast.Printer.pas', + Myc.Ast.Nodes in '..\Src\AST\Myc.Ast.Nodes.pas', + Myc.Ast.Scope in '..\Src\AST\Myc.Ast.Scope.pas'; {$R *.res} diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj index 650a013..9525b4b 100644 --- a/ASTPlayground/ASTPlayground.dproj +++ b/ASTPlayground/ASTPlayground.dproj @@ -137,6 +137,8 @@ + + Base diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index 2aae761..cdedafb 100644 --- a/ASTPlayground/MainForm.fmx +++ b/ASTPlayground/MainForm.fmx @@ -8,7 +8,6 @@ object Form1: TForm1 FormFactor.Height = 480 FormFactor.Devices = [Desktop] OnCreate = FormCreate - OnDestroy = FormDestroy DesignerMasterStyle = 0 object Panel1: TPanel Align = Left diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index 0fefc3b..42f9c60 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -19,6 +19,7 @@ uses FMX.Memo, FMX.Controls.Presentation, Myc.Data.POD, + Myc.Ast.Nodes, Myc.Ast, Myc.Ast.Evaluator, Myc.Ast.Printer; // Added for TExecutionScope @@ -37,7 +38,6 @@ type CrerateTriggerExampleButton: TButton; DoTriggerButton: TButton; DoTrigger2Button: TButton; - procedure FormDestroy(Sender: TObject); procedure FormCreate(Sender: TObject); procedure CrerateTriggerExampleButtonClick(Sender: TObject); procedure DebugButtonClick(Sender: TObject); @@ -51,7 +51,7 @@ type private // Stores the last AST generated by Test1 or Test2 button clicks. FLastAst: IAstNode; - FGScope: TExecutionScope; + FGScope: IExecutionScope; public { Public declarations } end; @@ -62,23 +62,19 @@ var implementation uses + Myc.Ast.Scope, System.Diagnostics; // For TStopwatch {$R *.fmx} -procedure TForm1.FormDestroy(Sender: TObject); -begin - FGScope.Free; -end; - procedure TForm1.FormCreate(Sender: TObject); begin - FGScope := TExecutionScope.Create(nil); + FGScope := T_ExecutionScope.Create(nil); end; procedure TForm1.DebugButtonClick(Sender: TObject); var - scope: TExecutionScope; + scope: IExecutionScope; visitor: IAstVisitor; result: TAstValue; sw: TStopwatch; @@ -90,26 +86,22 @@ begin exit; end; - scope := TExecutionScope.Create(FGScope); - try - Memo1.Lines.Clear; - Memo1.Lines.Add('--- Debug Evaluator Trace ---'); + scope := T_ExecutionScope.Create(FGScope); - visitor := TDebugEvaluatorVisitor.Create(scope, Memo1.Lines, ShowScopeBox.IsChecked, 0); + Memo1.Lines.Clear; + Memo1.Lines.Add('--- Debug Evaluator Trace ---'); - sw := TStopwatch.StartNew; - result := FLastAst.Accept(visitor); - sw.Stop; + visitor := TDebugEvaluatorVisitor.Create(scope, Memo1.Lines, ShowScopeBox.IsChecked, 0); - Memo1.Lines.Add('-----------------------------'); - 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.)'); + sw := TStopwatch.StartNew; + result := FLastAst.Accept(visitor); + sw.Stop; - finally - scope.Free; - end; + Memo1.Lines.Add('-----------------------------'); + 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.)'); end; procedure TForm1.FibonacciButtonClick(Sender: TObject); @@ -124,7 +116,7 @@ procedure TForm1.FibonacciButtonClick(Sender: TObject); end; var - scope: TExecutionScope; + scope: IExecutionScope; visitor: IAstVisitor; root: IExpressionNode; result: TAstValue; @@ -198,18 +190,15 @@ begin ); FLastAst := root; - scope := TExecutionScope.Create(nil); - try - visitor := TEvaluatorVisitor.Create(scope); - result := root.Accept(visitor); - sw.Stop; + scope := T_ExecutionScope.Create(nil); - 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; + visitor := TEvaluatorVisitor.Create(scope); + result := root.Accept(visitor); + 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.)'); end; procedure TForm1.PrettyPrintButtonClick(Sender: TObject); @@ -242,7 +231,7 @@ end; procedure TForm1.RecursionButtonClick(Sender: TObject); var - scope: TExecutionScope; + scope: IExecutionScope; visitor: IAstVisitor; root: IExpressionNode; result: TAstValue; @@ -281,24 +270,21 @@ begin ); FLastAst := root; - scope := TExecutionScope.Create(nil); - try - visitor := TEvaluatorVisitor.Create(scope); - result := root.Accept(visitor); - sw.Stop; + scope := T_ExecutionScope.Create(nil); - 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; + visitor := TEvaluatorVisitor.Create(scope); + result := root.Accept(visitor); + 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.)'); end; procedure TForm1.Test1ButtonClick(Sender: TObject); var root: IAstNode; - scope: TExecutionScope; + scope: IExecutionScope; visitor: IAstVisitor; result: TAstValue; sw: TStopwatch; @@ -320,26 +306,23 @@ begin ); FLastAst := root; - scope := TExecutionScope.Create(nil); - try - visitor := TEvaluatorVisitor.Create(scope); - result := root.Accept(visitor); - sw.Stop; + scope := T_ExecutionScope.Create(FGScope); - if not result.IsUndefined then - Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])) - else - Memo1.Lines.Add(Format(' (calculated in %d ms)', [sw.ElapsedMilliseconds])); - Memo1.Lines.Add(''); - Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)'); - finally - scope.Free; - end; + visitor := TEvaluatorVisitor.Create(scope); + result := root.Accept(visitor); + sw.Stop; + + if not result.IsUndefined then + Memo1.Lines.Add(Format('Result: %s (calculated in %d ms)', [result.ToString, sw.ElapsedMilliseconds])) + else + Memo1.Lines.Add(Format(' (calculated in %d ms)', [sw.ElapsedMilliseconds])); + Memo1.Lines.Add(''); + Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)'); end; procedure TForm1.Test2ButtonClick(Sender: TObject); var - scope: TExecutionScope; + scope: IExecutionScope; visitor: IAstVisitor; root: IExpressionNode; result: TAstValue; @@ -373,19 +356,17 @@ begin ); FLastAst := root; - scope := TExecutionScope.Create(nil); - try - visitor := TEvaluatorVisitor.Create(scope); - result := root.Accept(visitor); - sw.Stop; - Memo1.Lines.Add('The entire script has been executed.'); - 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; + scope := T_ExecutionScope.Create(FGScope); + + visitor := TEvaluatorVisitor.Create(scope); + result := root.Accept(visitor); + sw.Stop; + + Memo1.Lines.Add('The entire script has been executed.'); + 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.)'); end; procedure TForm1.CrerateTriggerExampleButtonClick(Sender: TObject); diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 06876a4..5386475 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -7,18 +7,19 @@ uses System.Classes, // For TStrings System.Generics.Collections, Myc.Data.POD, + Myc.Ast.Nodes, Myc.Ast; type // TEvaluatorVisitor is the base implementation for evaluating an AST. TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor) private - FScope: TExecutionScope; + FScope: IExecutionScope; protected function IsTruthy(const AValue: TAstValue): Boolean; - function CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; virtual; + function CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; virtual; public - constructor Create(AScope: TExecutionScope); + constructor Create(const AScope: IExecutionScope); function VisitConstant(const Node: IConstantNode): TAstValue; virtual; function VisitIdentifier(const Node: IIdentifierNode): TAstValue; virtual; function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; virtual; @@ -43,9 +44,9 @@ type procedure AppendMultiline(const S: string); procedure ShowScope; protected - function CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; override; + function CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; override; public - constructor Create(AScope: TExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0); + constructor Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0); function VisitConstant(const Node: IConstantNode): TAstValue; override; function VisitIdentifier(const Node: IIdentifierNode): TAstValue; override; function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; override; @@ -62,6 +63,7 @@ implementation uses Myc.Data.Decimal, + Myc.Ast.Scope, Myc.Ast.Printer; type @@ -70,17 +72,17 @@ type private FBody: IExpressionNode; FParameters: TArray; - FClosureScope: TExecutionScope; + FClosureScope: IExecutionScope; function GetBody: IExpressionNode; function GetParameters: TArray; - function GetClosureScope: TExecutionScope; + function GetClosureScope: IExecutionScope; public - constructor Create(ABody: IExpressionNode; const AParameters: TArray; AClosureScope: TExecutionScope); + constructor Create(ABody: IExpressionNode; const AParameters: TArray; const AClosureScope: IExecutionScope); end; { TClosureValue } -constructor TClosureValue.Create(ABody: IExpressionNode; const AParameters: TArray; AClosureScope: TExecutionScope); +constructor TClosureValue.Create(ABody: IExpressionNode; const AParameters: TArray; const AClosureScope: IExecutionScope); begin inherited Create; FBody := ABody; @@ -93,7 +95,7 @@ begin Result := FBody; end; -function TClosureValue.GetClosureScope: TExecutionScope; +function TClosureValue.GetClosureScope: IExecutionScope; begin Result := FClosureScope; end; @@ -105,14 +107,14 @@ end; { TEvaluatorVisitor } -constructor TEvaluatorVisitor.Create(AScope: TExecutionScope); +constructor TEvaluatorVisitor.Create(const AScope: IExecutionScope); begin inherited Create; Assert(Assigned(AScope)); FScope := AScope; end; -function TEvaluatorVisitor.CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; +function TEvaluatorVisitor.CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; begin Result := TEvaluatorVisitor.Create(AScope); end; @@ -192,7 +194,7 @@ var calleeValue: TAstValue; arguments: TList; closure: IEvaluatorClosure; - callScope: TExecutionScope; + callScope: IExecutionScope; innerVisitor: IAstVisitor; i: Integer; argValue: TAstValue; @@ -211,19 +213,16 @@ begin raise EArgumentException.CreateFmt('Argument count mismatch: expected %d, got %d', [Length(closure.Parameters), 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; + callScope := T_ExecutionScope.Create(closure.ClosureScope); - innerVisitor := Self.CreateVisitorForScope(callScope); - Result := closure.Body.Accept(innerVisitor); - finally - callScope.Free; + 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); end; function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAstValue; @@ -332,17 +331,18 @@ end; { TDebugEvaluatorVisitor } -constructor TDebugEvaluatorVisitor.Create(AScope: TExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer); +constructor TDebugEvaluatorVisitor.Create(const AScope: IExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0); begin inherited Create(AScope); Assert(Assigned(ALog)); FLog := ALog; FIndentLevel := AInitialIndent; FShowScope := AShowScope; + ShowScope; end; -function TDebugEvaluatorVisitor.CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; +function TDebugEvaluatorVisitor.CreateVisitorForScope(const AScope: IExecutionScope): IAstVisitor; begin Result := TDebugEvaluatorVisitor.Create(AScope, FLog, FShowScope, FIndentLevel); end; diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas new file mode 100644 index 0000000..a31e763 --- /dev/null +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -0,0 +1,305 @@ +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; + + TAstValueKind = (avkUndefined, avkScalar, avkClosure); + + // --- 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; + FClosure: IEvaluatorClosure; + function GetKind: TAstValueKind; inline; + function GetIsScalar: Boolean; inline; + function GetIsClosure: Boolean; inline; + function GetIsUndefined: Boolean; inline; + public + class operator Initialize(out Dest: TAstValue); + class function Undefined: TAstValue; static; + class function FromScalar(const AValue: TScalar): TAstValue; static; + class function FromClosure(const AValue: IEvaluatorClosure): TAstValue; static; + function AsScalar: TScalar; + function AsClosure: IEvaluatorClosure; + function ToString: String; + property Kind: TAstValueKind read GetKind; + property IsScalar: Boolean read GetIsScalar; + property IsClosure: Boolean read GetIsClosure; + property IsUndefined: Boolean read GetIsUndefined; + 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 + +{ TAstValue } + +class operator TAstValue.Initialize(out Dest: TAstValue); +begin + Dest.FKind := avkUndefined; + Dest.FClosure := nil; +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 + 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; + +end. diff --git a/Src/AST/Myc.Ast.Printer.pas b/Src/AST/Myc.Ast.Printer.pas index 525d15f..fde1f28 100644 --- a/Src/AST/Myc.Ast.Printer.pas +++ b/Src/AST/Myc.Ast.Printer.pas @@ -6,6 +6,7 @@ uses System.SysUtils, System.Classes, System.Generics.Collections, + Myc.Ast.Nodes, Myc.Ast; type diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas new file mode 100644 index 0000000..3eacf36 --- /dev/null +++ b/Src/AST/Myc.Ast.Scope.pas @@ -0,0 +1,123 @@ +unit Myc.Ast.Scope; + +interface + +uses + System.SysUtils, + System.Generics.Collections, + System.Classes, + Myc.Ast.Nodes; + +type + T_ExecutionScope = class(TInterfacedObject, IExecutionScope) + private + FParent: IExecutionScope; + FVariables: TDictionary; + procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); + protected + // IExecutionScope + function GetParent: IExecutionScope; + 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; + public + constructor Create(AParent: IExecutionScope = nil); + destructor Destroy; override; + end; + +implementation + +{ T_ExecutionScope } + +constructor T_ExecutionScope.Create(AParent: IExecutionScope); +begin + inherited Create; + FParent := AParent; + FVariables := TDictionary.Create; +end; + +destructor T_ExecutionScope.Destroy; +begin + FVariables.Free; + inherited Destroy; +end; + +function T_ExecutionScope.GetParent: IExecutionScope; +begin + Result := FParent; +end; + +procedure T_ExecutionScope.AssignValue(const Name: string; const Value: TAstValue); +begin + if FVariables.ContainsKey(Name) then + FVariables.AddOrSetValue(Name, Value) + else if Assigned(FParent) then + FParent.AssignValue(Name, Value) + else + raise Exception.CreateFmt('Cannot assign to undeclared variable "%s".', [Name]); +end; + +procedure T_ExecutionScope.Clear; +begin + FVariables.Clear; + if Assigned(FParent) then + FParent.Clear; +end; + +procedure T_ExecutionScope.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]'); + // As FParent is now an interface, we must cast it back to the class to call the private DumpScope. + // This indicates that DumpScope should perhaps be part of the interface or handled differently. + // For now, we use a cast to keep the functionality. + (FParent as T_ExecutionScope).DumpScope(ABuilder, AIndent + 2); + end; +end; + +function T_ExecutionScope.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 T_ExecutionScope.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 T_ExecutionScope.SetValue(const Name: string; const Value: TAstValue); +begin + FVariables.AddOrSetValue(Name, Value); +end; + +end. diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 745d1f1..6424c35 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -4,211 +4,10 @@ interface uses System.SysUtils, - System.Classes, - System.Generics.Collections, - Myc.Data.POD; + Myc.Data.POD, + Myc.Ast.Nodes; 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; - IAssignmentNode = interface; // Represents an assignment to an existing variable. - 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: TArray; - function GetClosureScope: TExecutionScope; - {$endregion} - property Body: IExpressionNode read GetBody; - property Parameters: TArray 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; - function VisitAssignment(const Node: IAssignmentNode): 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: 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; - - // 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; - - // An assignment expression that returns the assigned value. - IAssignmentNode = interface(IExpressionNode) - {$region 'private'} - function GetIdentifier: IIdentifierNode; - function GetValue: IExpressionNode; - {$endregion} - property Identifier: IIdentifierNode read GetIdentifier; - property Value: IExpressionNode read GetValue; - end; - // Record acting as a namespace for the factory functions. TAst = record class function Constant(AValue: TScalar): IConstantNode; static; @@ -230,26 +29,12 @@ type class function Assign(const AIdentifier: IIdentifierNode; const AValue: IExpressionNode): IAssignmentNode; 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; - procedure Clear; - function FindValue(const Name: string; out Value: TAstValue): Boolean; - // Sets or updates a value in the current scope. Used for declarations. - procedure SetValue(const Name: string; const Value: TAstValue); - // Finds an existing variable in the scope chain and updates its value. Used for assignments. - procedure AssignValue(const Name: string; const Value: TAstValue); - function Dump: string; - end; - implementation +uses + System.Classes, + System.Generics.Collections; + type { TAstNode } // Common base class for AST nodes to reduce boilerplate. @@ -378,111 +163,6 @@ type 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); @@ -789,87 +469,4 @@ 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.AssignValue(const Name: string; const Value: TAstValue); -begin - if FVariables.ContainsKey(Name) then - FVariables.AddOrSetValue(Name, Value) - else if Assigned(FParent) then - FParent.AssignValue(Name, Value) - else - raise Exception.CreateFmt('Cannot assign to undeclared variable "%s".', [Name]); -end; - -procedure TExecutionScope.Clear; -begin - FVariables.Clear; - if Assigned(FParent) then - FParent.Clear; -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.