diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr new file mode 100644 index 0000000..347f1c1 --- /dev/null +++ b/ASTPlayground/ASTPlayground.dpr @@ -0,0 +1,16 @@ +program ASTPlayground; + +uses + System.StartUpCopy, + 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'; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj new file mode 100644 index 0000000..41ba722 --- /dev/null +++ b/ASTPlayground/ASTPlayground.dproj @@ -0,0 +1,1150 @@ + + + {8B68383C-DDF8-4420-855E-98C3AA16D819} + 20.3 + FMX + True + Debug + Win32 + ASTPlayground + 3 + Application + ASTPlayground.dpr + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\delphi_PROJECTICNS.icns + ASTPlayground + T:\Myc\Src\Data;T:\Myc\Src\AST;$(DCC_UnitSearchPath) + 1031 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + + + vclwinx;fmx;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;FireDACCommonODBC;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;Skia.Package.RTL;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;FmxTeeUI;bindcompfmx;inetdb;FireDACSqliteDriver;DbxClientDriver;Tee;soapmidas;vclactnband;TeeUI;fmxFireDAC;dbexpress;DBXMySQLDriver;VclSmp;inet;vcltouch;fmxase;dbrtl;Skia.Package.FMX;fmxdae;TeeDB;FireDACMSAccDriver;CustomIPTransport;vcldsnap;DBXInterBaseDriver;IndySystem;Skia.Package.VCL;vcldb;vclFireDAC;bindcomp;FireDACCommon;inetstn;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;adortl;vclimg;FireDACPgDriver;FireDAC;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;fmxobj;bindcompvclsmp;FMXTee;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + vclwinx;fmx;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;FireDACCommonODBC;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;FmxTeeUI;bindcompfmx;inetdb;FireDACSqliteDriver;DbxClientDriver;Tee;soapmidas;vclactnband;TeeUI;fmxFireDAC;dbexpress;DBXMySQLDriver;VclSmp;inet;vcltouch;fmxase;dbrtl;fmxdae;TeeDB;FireDACMSAccDriver;CustomIPTransport;vcldsnap;DBXInterBaseDriver;IndySystem;Skia.Package.VCL;vcldb;vclFireDAC;bindcomp;FireDACCommon;inetstn;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;adortl;vclimg;FireDACPgDriver;FireDAC;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;fmxobj;bindcompvclsmp;FMXTee;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DEBUG;$(DCC_Define) + true + false + true + true + true + true + true + + + false + PerMonitorV2 + true + 1033 + + + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + PerMonitorV2 + + + PerMonitorV2 + + + + MainSource + + +
Form1
+ fmx +
+ + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + +
+ + Delphi.Personality.12 + Application + + + + ASTPlayground.dpr + + + Embarcadero C++Builder Office 2000 Servers Package + Embarcadero C++Builder Office XP Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + true + + + + + true + + + + + true + + + + + ASTPlayground.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\values-v35 + 1 + + + res\values-v35 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + True + True + + + 12 + + + + +
diff --git a/ASTPlayground/ASTPlayground.res b/ASTPlayground/ASTPlayground.res new file mode 100644 index 0000000..29a1295 Binary files /dev/null and b/ASTPlayground/ASTPlayground.res differ diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx new file mode 100644 index 0000000..c34c2f0 --- /dev/null +++ b/ASTPlayground/MainForm.fmx @@ -0,0 +1,88 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + Caption = 'Form1' + ClientHeight = 638 + ClientWidth = 925 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + DesignerMasterStyle = 0 + object Panel1: TPanel + Align = Left + Size.Width = 137.000000000000000000 + Size.Height = 638.000000000000000000 + Size.PlatformDefault = False + TabOrder = 1 + object Test1Button: TButton + Position.X = 24.000000000000000000 + Position.Y = 32.000000000000000000 + TabOrder = 1 + Text = 'Test 1' + TextSettings.Trimming = None + OnClick = Test1ButtonClick + end + object Test2Button: TButton + Position.X = 24.000000000000000000 + Position.Y = 62.000000000000000000 + TabOrder = 2 + Text = 'Test 2' + TextSettings.Trimming = None + OnClick = Test2ButtonClick + end + object PrettyPrintButton: TButton + Position.X = 24.000000000000000000 + Position.Y = 168.000000000000000000 + TabOrder = 3 + Text = 'Print' + TextSettings.Trimming = None + OnClick = PrettyPrintButtonClick + end + object DebugButton: TButton + Position.X = 24.000000000000000000 + Position.Y = 198.000000000000000000 + TabOrder = 4 + Text = 'Debug' + TextSettings.Trimming = None + OnClick = DebugButtonClick + end + object RecursionButton: TButton + Position.X = 24.000000000000000000 + Position.Y = 92.000000000000000000 + Size.Width = 80.000000000000000000 + Size.Height = 22.000000000000000000 + Size.PlatformDefault = False + TabOrder = 5 + Text = 'Recursion' + TextSettings.Trimming = None + OnClick = RecursionButtonClick + end + object ShowScopeBox: TCheckBox + Position.X = 32.000000000000000000 + Position.Y = 224.000000000000000000 + TabOrder = 6 + Text = 'Scope' + end + object FibonacciButton: TButton + Position.X = 24.000000000000000000 + Position.Y = 122.000000000000000000 + TabOrder = 8 + Text = 'Fibonacci' + TextSettings.Trimming = None + OnClick = FibonacciButtonClick + end + end + object Memo1: TMemo + Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] + DataDetectorTypes = [] + StyledSettings = [Size, Style, FontColor] + TextSettings.Font.Family = 'Consolas' + Align = Client + Size.Width = 788.000000000000000000 + Size.Height = 638.000000000000000000 + Size.PlatformDefault = False + TabOrder = 2 + Viewport.Width = 784.000000000000000000 + Viewport.Height = 634.000000000000000000 + end +end diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas new file mode 100644 index 0000000..b0f3b52 --- /dev/null +++ b/ASTPlayground/MainForm.pas @@ -0,0 +1,340 @@ +unit MainForm; + +interface + +uses + System.SysUtils, + System.Types, + System.UITypes, + System.Classes, + System.Variants, + FMX.Types, + FMX.Controls, + FMX.Forms, + FMX.Graphics, + FMX.Dialogs, + FMX.Memo.Types, + FMX.StdCtrls, + FMX.ScrollBox, + FMX.Memo, + FMX.Controls.Presentation, + Myc.Data.Types, + Myc.Ast, + Myc.Ast.Evaluator, + Myc.Ast.Printer; + +type + TForm1 = class(TForm) + Panel1: TPanel; + Memo1: TMemo; + Test1Button: TButton; + Test2Button: TButton; + PrettyPrintButton: TButton; + DebugButton: TButton; + RecursionButton: TButton; + ShowScopeBox: TCheckBox; + FibonacciButton: TButton; + procedure DebugButtonClick(Sender: TObject); + procedure FibonacciButtonClick(Sender: TObject); + procedure PrettyPrintButtonClick(Sender: TObject); + procedure RecursionButtonClick(Sender: TObject); + procedure Test1ButtonClick(Sender: TObject); + procedure Test2ButtonClick(Sender: TObject); + private + // Stores the last AST generated by Test1 or Test2 button clicks. + FLastAst: IAstNode; + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.fmx} + +procedure TForm1.DebugButtonClick(Sender: TObject); +var + scope: TExecutionScope; + visitor: IAstVisitor; + result: IDataValue; +begin + if not Assigned(FLastAst) then + begin + Memo1.Lines.Add('No AST has been generated yet.'); + Memo1.Lines.Add('Click "Test 1" or "Test 2" first.'); + exit; + end; + + scope := TExecutionScope.Create(nil); + try + Memo1.Lines.Clear; + Memo1.Lines.Add('--- Debug Evaluator Trace ---'); + + // Create the DEBUG visitor, passing the Memo's Lines as the log output + visitor := TDebugEvaluatorVisitor.Create(scope, Memo1.Lines, ShowScopeBox.IsChecked, 0); + + result := FLastAst.Accept(visitor); + + Memo1.Lines.Add('-----------------------------'); + Memo1.Lines.Add('Final script result: ' + result.AsString); + Memo1.Lines.Add(''); + Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)'); + + finally + scope.Free; + end; +end; + +procedure TForm1.FibonacciButtonClick(Sender: TObject); +var + scope: TExecutionScope; + visitor: IAstVisitor; + root: IExpressionNode; + result: IDataValue; +begin + // This test defines and calls a deeply recursive fibonacci function. + // var fib = func(n) { + // if (n < 2) then n else fib(n - 1) + fib(n - 2) + // }; + // fib(10); + root := + TAst.Block( + [ + TAst.VarDecl( + TAst.Identifier('fib'), + TAst.LambdaExpr( + [TAst.Identifier('n')], + TAst.IfExpr( + // Condition: n < 2 + TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TDataType.Ordinal.CreateValue(2))), + // Then branch: n + TAst.Identifier('n'), + // Else branch: fib(n - 1) + fib(n - 2) + TAst.BinaryExpr( + // fib(n - 1) + TAst.FunctionCall( + TAst.Identifier('fib'), + [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TDataType.Ordinal.CreateValue(1)))] + ), + boAdd, + // fib(n - 2) + TAst.FunctionCall( + TAst.Identifier('fib'), + [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TDataType.Ordinal.CreateValue(2)))] + ) + ) + ) + ) + ), + // Call the function + TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(TDataType.Ordinal.CreateValue(10))]) + ] + ); + + FLastAst := root; + + scope := TExecutionScope.Create(nil); + try + Memo1.Lines.Clear; + Memo1.Lines.Add('--- Recursive fib(10) ---'); + visitor := TEvaluatorVisitor.Create(scope); + result := root.Accept(visitor); + Memo1.Lines.Add('Result: ' + result.AsString); // Should be 55 + Memo1.Lines.Add(''); + Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" or "Debug" to view.)'); + + finally + scope.Free; + end; +end; + +procedure TForm1.PrettyPrintButtonClick(Sender: TObject); +var + visitor: TPrettyPrintVisitor; +begin + // This button now prints the AST that was stored in FLastAst. + Memo1.Lines.Clear; + Memo1.Lines.Add('--- AST Pretty Print ---'); + + if not Assigned(FLastAst) then + begin + Memo1.Lines.Add('No AST has been generated yet.'); + Memo1.Lines.Add('Click "Test 1" or "Test 2" first.'); + exit; + end; + + visitor := TPrettyPrintVisitor.Create; + try + FLastAst.Accept(visitor); + Memo1.Lines.Add(visitor.GetResult); + finally + // Visitor is an interfaced object and managed automatically. + end; +end; + +procedure TForm1.RecursionButtonClick(Sender: TObject); +var + scope: TExecutionScope; + visitor: IAstVisitor; + root: IExpressionNode; + result: IDataValue; +begin + // This test defines and calls a recursive factorial function. + // var factorial = func(n) { + // if (n < 2) then 1 else n * factorial(n - 1) + // }; + // factorial(5); + root := + TAst.Block( + [ + TAst.VarDecl( + TAst.Identifier('factorial'), + TAst.LambdaExpr( + [TAst.Identifier('n')], + TAst.IfExpr( + // Condition: n < 2 + TAst.BinaryExpr(TAst.Identifier('n'), boLess, TAst.Constant(TDataType.Ordinal.CreateValue(2))), + // Then branch: 1 + TAst.Constant(TDataType.Ordinal.CreateValue(1)), + // Else branch: n * factorial(n - 1) + TAst.BinaryExpr( + TAst.Identifier('n'), + boMultiply, + TAst.FunctionCall( + TAst.Identifier('factorial'), // Recursive call + [TAst.BinaryExpr(TAst.Identifier('n'), boSubtract, TAst.Constant(TDataType.Ordinal.CreateValue(1)))] + ) + ) + ) + ) + ), + // Call the function + TAst.FunctionCall(TAst.Identifier('factorial'), [TAst.Constant(TDataType.Ordinal.CreateValue(6))]) + ] + ); + + FLastAst := root; + + scope := TExecutionScope.Create(nil); + try + Memo1.Lines.Clear; + Memo1.Lines.Add('--- Recursive factorial(6) ---'); + visitor := TEvaluatorVisitor.Create(scope); + result := root.Accept(visitor); + Memo1.Lines.Add('Result: ' + result.AsString); + Memo1.Lines.Add(''); + Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" or "Debug" to view.)'); + + finally + scope.Free; + end; +end; + +procedure TForm1.Test1ButtonClick(Sender: TObject); +var + root: IAstNode; + scope: TExecutionScope; + visitor: IAstVisitor; + result: IDataValue; +begin + // With the new expression-oriented AST, the entire logic can be + // represented as a single block expression. The block itself + // evaluates to the value of its last expression. + root := + TAst.Block( + [ + // var a := 10; (this expression returns void) + TAst.VarDecl(TAst.Identifier('a'), TAst.Constant(TDataType.Ordinal.CreateValue(10))), + // var b := a * 2; (this expression also returns void) + TAst.VarDecl( + TAst.Identifier('b'), + TAst.BinaryExpr(TAst.Identifier('a'), boMultiply, TAst.Constant(TDataType.Ordinal.CreateValue(2))) + ), + // a + b; (this is the last expression, its value becomes the block's value) + TAst.BinaryExpr(TAst.Identifier('a'), boAdd, TAst.Identifier('b')) + ] + ); + + // Store the generated AST for the pretty printer. + FLastAst := root; + + // Evaluate the entire AST with a single call + scope := TExecutionScope.Create(nil); + try + visitor := TEvaluatorVisitor.Create(scope); + result := root.Accept(visitor); + + // Display the result + Memo1.Lines.Clear; + Memo1.Lines.Add('AST execution result:'); + if Assigned(result) then + Memo1.Lines.Add(result.AsString) + else + Memo1.Lines.Add(''); + Memo1.Lines.Add(''); + Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)'); + finally + scope.Free; + end; +end; + +procedure TForm1.Test2ButtonClick(Sender: TObject); +var + scope: TExecutionScope; + visitor: IAstVisitor; + root: IExpressionNode; + result: IDataValue; +begin + // The entire logic is now encapsulated in a single AST. + // This script defines a factory function, then calls it twice. + root := + TAst.Block( + [ + // 1. Define the factory and assign it to a variable 'createStrategyInstance' + TAst.VarDecl( + TAst.Identifier('createStrategyInstance'), + TAst.LambdaExpr( + [TAst.Identifier('offset')], // The factory parameter + TAst.Block( + [ + // The body of the factory defines the strategy logic + TAst.VarDecl(TAst.Identifier('baseValue'), TAst.Constant(TDataType.Ordinal.CreateValue(100))), + TAst.BinaryExpr(TAst.Identifier('baseValue'), boAdd, TAst.Identifier('offset')) + ] + ) + ) + ), + // 2. Call the factory with the first parameter set. + // The result of this expression (120) is calculated but discarded by the block. + TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(TDataType.Ordinal.CreateValue(20))]), + // 3. Call the factory with the second parameter set. + // As this is the last expression, its result (155) becomes the result of the entire block. + TAst.FunctionCall(TAst.Identifier('createStrategyInstance'), [TAst.Constant(TDataType.Ordinal.CreateValue(55))]) + ] + ); + + // Store the complete AST for the pretty printer. + FLastAst := root; + + // Evaluate the AST. + scope := TExecutionScope.Create(nil); + try + visitor := TEvaluatorVisitor.Create(scope); + Memo1.Lines.Clear; + Memo1.Lines.Add('Factory Pattern Demo (Single AST):'); + + result := root.Accept(visitor); + + Memo1.Lines.Add('The entire script has been executed.'); + Memo1.Lines.Add('Result of the final expression: ' + result.AsString); + Memo1.Lines.Add(''); + Memo1.Lines.Add('(AST structure stored. Click "Pretty Print" to view.)'); + + finally + scope.Free; + end; +end; + +end. diff --git a/IntfExtract/ExtractPascalInterfaces.dproj b/IntfExtract/ExtractPascalInterfaces.dproj index b58b1d0..5e351ae 100644 --- a/IntfExtract/ExtractPascalInterfaces.dproj +++ b/IntfExtract/ExtractPascalInterfaces.dproj @@ -91,7 +91,7 @@ false - -r -o T:\out.txt -dirs T:\Myc\dirs.txt -f "C:\Users\Brummel\Documents\cAlgo\DataExport\ChartDisplay\ChartDisplayMain.pas" + -r -o T:\out.txt -dirs T:\Myc\dirs.txt -f "T:\Myc\ASTPlayground\MainForm.pas" false diff --git a/IntfExtract/ExtractPascalInterfaces.res b/IntfExtract/ExtractPascalInterfaces.res index bf57230..08cdae7 100644 Binary files a/IntfExtract/ExtractPascalInterfaces.res and b/IntfExtract/ExtractPascalInterfaces.res differ diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas new file mode 100644 index 0000000..03c55ec --- /dev/null +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -0,0 +1,614 @@ +// https://g.co/gemini/share/f8965e72f968 + +unit Myc.Ast.Evaluator; + +interface + +uses + System.SysUtils, + System.Classes, // For TStrings + System.Generics.Collections, + Myc.Data.Types, + Myc.Ast; + +type + // Manages the scope of execution, holding variables and their values. + TExecutionScope = class + private + FParent: TExecutionScope; + FVariables: TDictionary; + // Added for recursive dumping + procedure DumpScope(const ABuilder: TStringBuilder; AIndent: Integer); + 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); + // Dumps the content of this scope and all parent scopes to a string. + function Dump: string; + end; + + // A closure is a specific kind of method value that is defined by the evaluator. + // It holds the AST body and its captured scope. + IDataClosureValue = interface(IDataMethodValue) + ['{2704586B-E4BD-47AA-B05D-FD441AE6D818}'] + {$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; + + // TEvaluatorVisitor is the base implementation for evaluating an AST. + TEvaluatorVisitor = class(TInterfacedObject, IAstVisitor) + protected // Changed to protected to be accessible by descendants + FScope: TExecutionScope; + function IsTruthy(const AValue: IDataValue): Boolean; + // Factory method to create a new visitor for a sub-scope (e.g., lambda body) + function CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; virtual; + public + constructor Create(AScope: TExecutionScope); + function VisitConstant(const Node: IConstantNode): IDataValue; virtual; + function VisitIdentifier(const Node: IIdentifierNode): IDataValue; virtual; + function VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue; virtual; + function VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue; virtual; + function VisitIfExpression(const Node: IIfExpressionNode): IDataValue; virtual; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue; virtual; + function VisitFunctionCall(const Node: IFunctionCallNode): IDataValue; virtual; + function VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue; virtual; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue; virtual; + end; + + // TDebugEvaluatorVisitor now overrides all visit methods for full tracing + TDebugEvaluatorVisitor = class(TEvaluatorVisitor) + private + FLog: TStrings; + FIndentLevel: Integer; + FShowScope: Boolean; + procedure Indent; + procedure Unindent; + procedure AppendLine(const S: string); + procedure ShowScope; + protected + // Override the factory method to create a debug visitor + function CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; override; + public + constructor Create(AScope: TExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0); + // Override all visit methods + function VisitConstant(const Node: IConstantNode): IDataValue; override; + function VisitIdentifier(const Node: IIdentifierNode): IDataValue; override; + function VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue; override; + function VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue; override; + function VisitIfExpression(const Node: IIfExpressionNode): IDataValue; override; + function VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue; override; + function VisitFunctionCall(const Node: IFunctionCallNode): IDataValue; override; + function VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue; override; + function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue; override; + end; + +implementation + +type + { TDataClosureValueImpl } + // Concrete implementation of the IDataClosureValue interface. + TDataClosureValueImpl = class(TInterfacedObject, IDataValue, IDataClosureValue) + private + FMethodType: IDataMethodType; + FBody: IExpressionNode; + FParameters: TList; + FClosureScope: TExecutionScope; + // IDataValue + function GetDataType: IDataType; + function GetAsString: string; + // IDataMethodValue + function GetValue: TDataMethodProc; + // IDataClosureValue + function GetBody: IExpressionNode; + function GetParameters: TList; + function GetClosureScope: TExecutionScope; + public + constructor Create( + AMethodType: IDataMethodType; + ABody: IExpressionNode; + AParameters: TList; + ACClosureScope: TExecutionScope + ); + end; + +constructor TDataClosureValueImpl.Create( + AMethodType: IDataMethodType; + ABody: IExpressionNode; + AParameters: TList; + ACClosureScope: TExecutionScope +); +begin + inherited Create; + FMethodType := AMethodType; + FBody := ABody; + FParameters := AParameters; // Note: We are taking ownership of the list reference + FClosureScope := ACClosureScope; +end; + +function TDataClosureValueImpl.GetAsString: string; +begin + Result := ''; +end; + +function TDataClosureValueImpl.GetBody: IExpressionNode; +begin + Result := FBody; +end; + +function TDataClosureValueImpl.GetClosureScope: TExecutionScope; +begin + Result := FClosureScope; +end; + +function TDataClosureValueImpl.GetDataType: IDataType; +begin + Result := FMethodType; +end; + +function TDataClosureValueImpl.GetParameters: TList; +begin + Result := FParameters; +end; + +function TDataClosureValueImpl.GetValue: TDataMethodProc; +begin + // This direct execution path is no longer used for closures. + raise ENotSupportedException.Create('Cannot get raw method proc from a closure object.'); +end; + +{ TExecutionScope } + +constructor TExecutionScope.Create(AParent: TExecutionScope = nil); +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.AsString])); + 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: 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.CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; +begin + // Base implementation creates a standard evaluator + Result := TEvaluatorVisitor.Create(AScope); +end; + +function TEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue; +var + methodType: IDataMethodType; +begin + // Instead of creating an anonymous method, we now create a data object + // that holds all information required to execute the lambda later. + methodType := TDataType.MethodOf(TDataType.Ordinal, TDataType.Ordinal); // TODO: Infer this + Result := TDataClosureValueImpl.Create(methodType, Node.Body, Node.Parameters, FScope); +end; + +function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IDataValue; +var + calleeValue: IDataValue; + arguments: TList; + closure: IDataClosureValue; + callScope: TExecutionScope; + innerVisitor: IAstVisitor; +begin + calleeValue := Node.Callee.Accept(Self); + arguments := Node.Arguments; + + if not Supports(calleeValue, IDataClosureValue, closure) then + raise EArgumentException.Create('Expression is not a callable closure.'); + + if (arguments.Count <> 1) then + raise EArgumentException.Create('This simple implementation only supports single-argument calls.'); + + // --- New execution logic is now inside the caller --- + // Create the new scope for the function call, parented by the closure's captured scope. + callScope := TExecutionScope.Create(closure.ClosureScope); + try + // Set argument value + var argValue := arguments[0].Accept(Self); + callScope.SetValue(closure.Parameters[0].Name, argValue); + + // Use the factory method to create the visitor with the correct context (and indent). + innerVisitor := Self.CreateVisitorForScope(callScope); + + // Execute the body with the new visitor. + Result := closure.Body.Accept(innerVisitor); + finally + callScope.Free; + end; +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; + comparisonResult: Boolean; +begin + leftValue := Node.Left.Accept(Self); + rightValue := Node.Right.Accept(Self); + + // Handle comparison operators separately as they can work on different types (for now) + // and always return an Ordinal (boolean). + case Node.Operator of + boEqual, boNotEqual, boLess, boGreater, boLessOrEqual, boGreaterOrEqual: + begin + // Basic comparison for Ordinals + if (leftValue.DataType.Kind = dkOrdinal) and (rightValue.DataType.Kind = dkOrdinal) then + begin + var leftVal := TDataType.TValue(leftValue).AsOrdinal.Value; + var rightVal := TDataType.TValue(rightValue).AsOrdinal.Value; + case Node.Operator of + boEqual: comparisonResult := (leftVal = rightVal); + boNotEqual: comparisonResult := (leftVal <> rightVal); + boLess: comparisonResult := (leftVal < rightVal); + boGreater: comparisonResult := (leftVal > rightVal); + boLessOrEqual: comparisonResult := (leftVal <= rightVal); + boGreaterOrEqual: comparisonResult := (leftVal >= rightVal); + end; + if comparisonResult then + Result := TDataType.Ordinal.CreateValue(1) + else + Result := TDataType.Ordinal.CreateValue(0); + exit; + end + else + raise ENotSupportedException.Create('Comparison is only supported for Ordinal types.'); + end; + end; + + 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.VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue; +var + expression: IExpressionNode; + lastValue: IDataValue; +begin + lastValue := TDataType.Void.Value; + for expression in Node.Expressions do + begin + lastValue := expression.Accept(Self); + end; + Result := lastValue; +end; + +function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue; +var + varName: string; + initValue: IDataValue; +begin + varName := Node.Identifier.Name; + + // 1. Declare the name in the scope first with a placeholder value (void). + // This makes the name available to the initializer (e.g., a lambda). + FScope.SetValue(varName, TDataType.Void.Value); + + // 2. Evaluate the initializer, which can now recursively reference its own name. + if Assigned(Node.Initializer) then + initValue := Node.Initializer.Accept(Self) + else + initValue := TDataType.Void.Value; + + // 3. Update the variable with the actual initialized value. + FScope.SetValue(varName, initValue); + + Result := TDataType.Void.Value; +end; + +{ TDebugEvaluatorVisitor } + +constructor TDebugEvaluatorVisitor.Create(AScope: TExecutionScope; ALog: TStrings; AShowScope: Boolean; AInitialIndent: Integer = 0); +begin + inherited Create(AScope); + Assert(Assigned(ALog)); + FLog := ALog; + FIndentLevel := AInitialIndent; + FShowScope := AShowScope; +end; + +function TDebugEvaluatorVisitor.CreateVisitorForScope(AScope: TExecutionScope): IAstVisitor; +begin + // Pass the current indent level to the new child visitor + Result := TDebugEvaluatorVisitor.Create(AScope, FLog, FShowScope, FIndentLevel); +end; + +procedure TDebugEvaluatorVisitor.Indent; +begin + inc(FIndentLevel); +end; + +procedure TDebugEvaluatorVisitor.Unindent; +begin + dec(FIndentLevel); +end; + +procedure TDebugEvaluatorVisitor.AppendLine(const S: string); +begin + var pad := ''; + for var i := 0 to FIndentLevel - 1 do + pad := pad + ':' + ''.PadLeft(3); + FLog.Add(pad + S); +end; + +procedure TDebugEvaluatorVisitor.ShowScope; +begin + if FShowScope then + begin + // Dump the scope content upon entering a block + AppendLine('-- Scope --'); + var scopeDump := FScope.Dump.Split([sLineBreak]); + for var line in scopeDump do + AppendLine(line); + AppendLine('-----------'); + end; +end; + +function TDebugEvaluatorVisitor.VisitConstant(const Node: IConstantNode): IDataValue; +begin + AppendLine(Format('Constant (%s)', [Node.Value.AsString])); + Result := inherited VisitConstant(Node); +end; + +function TDebugEvaluatorVisitor.VisitIdentifier(const Node: IIdentifierNode): IDataValue; +begin + Result := inherited VisitIdentifier(Node); + AppendLine(Format('Identifier "%s" -> %s', [Node.Name, Result.AsString])); +end; + +function TDebugEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue; +begin + AppendLine(Format('BinaryExpr "%s" {', [Node.Operator.ToString])); + Indent; + try + Result := inherited VisitBinaryExpression(Node); + finally + Unindent; + end; + AppendLine(Format('} -> %s', [Result.AsString])); +end; + +function TDebugEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue; +begin + AppendLine(Format('UnaryExpr "%s" {', [Node.Operator.ToString])); + Indent; + try + Result := inherited VisitUnaryExpression(Node); + finally + Unindent; + end; + AppendLine(Format('} -> %s', [Result.AsString])); +end; + +function TDebugEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): IDataValue; +begin + AppendLine('IfExpr{'); + Indent; + try + Result := inherited VisitIfExpression(Node); + finally + Unindent; + end; + AppendLine(Format('} -> %s', [Result.AsString])); +end; + +function TDebugEvaluatorVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue; +begin + AppendLine('LambdaExpr{'); + Indent; + try + Result := inherited VisitLambdaExpression(Node); + finally + Unindent; + end; + AppendLine(Format('} -> %s', [Result.AsString])); +end; + +function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IDataValue; +begin + AppendLine('FunctionCall{'); + Indent; + try + ShowScope; + Result := inherited VisitFunctionCall(Node); + finally + Unindent; + end; + AppendLine(Format('} -> %s', [Result.AsString])); +end; + +function TDebugEvaluatorVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue; +begin + AppendLine('Block{'); + Indent; + try + ShowScope; + Result := inherited VisitBlockExpression(Node); + finally + Unindent; + end; + AppendLine(Format('} -> %s', [Result.AsString])); +end; + +function TDebugEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue; +begin + AppendLine(Format('VarDecl %s :=', [Node.Identifier.Name])); + Indent; + try + Result := inherited VisitVariableDeclaration(Node); + finally + Unindent; + end; +end; + +end. diff --git a/Src/AST/Myc.Ast.Printer.pas b/Src/AST/Myc.Ast.Printer.pas new file mode 100644 index 0000000..045f82f --- /dev/null +++ b/Src/AST/Myc.Ast.Printer.pas @@ -0,0 +1,191 @@ +unit Myc.Ast.Printer; + +interface + +uses + System.SysUtils, + System.Classes, + System.Generics.Collections, + Myc.Data.Types, + Myc.Ast; + +type + TPrettyPrintVisitor = class(TInterfacedObject, IAstVisitor) + private + FBuilder: TStringBuilder; + FIndentLevel: Integer; + procedure Indent; + procedure Unindent; + procedure AppendLine(const S: string); + public + constructor Create; + destructor Destroy; override; + function GetResult: string; + // IAstVisitor + 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; + +implementation + +{ TPrettyPrintVisitor } + +constructor TPrettyPrintVisitor.Create; +begin + inherited Create; + FBuilder := TStringBuilder.Create; + FIndentLevel := 0; +end; + +destructor TPrettyPrintVisitor.Destroy; +begin + FBuilder.Free; + inherited Destroy; +end; + +function TPrettyPrintVisitor.GetResult: string; +begin + Result := FBuilder.ToString; +end; + +procedure TPrettyPrintVisitor.Indent; +begin + inc(FIndentLevel, 2); +end; + +procedure TPrettyPrintVisitor.Unindent; +begin + dec(FIndentLevel, 2); +end; + +procedure TPrettyPrintVisitor.AppendLine(const S: string); +begin + FBuilder.Append(''.PadLeft(FIndentLevel)); + FBuilder.AppendLine(S); +end; + +function TPrettyPrintVisitor.VisitConstant(const Node: IConstantNode): IDataValue; +begin + AppendLine(Format('Constant (%s)', [Node.Value.AsString])); + Result := TDataType.Void.Value; +end; + +function TPrettyPrintVisitor.VisitIdentifier(const Node: IIdentifierNode): IDataValue; +begin + AppendLine(Format('Identifier (%s)', [Node.Name])); + Result := TDataType.Void.Value; +end; + +function TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): IDataValue; +begin + AppendLine(Format('BinaryExpr (%s)', [Node.Operator.ToString])); + Indent; + Node.Left.Accept(Self); + Node.Right.Accept(Self); + Unindent; + Result := TDataType.Void.Value; +end; + +function TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): IDataValue; +begin + AppendLine(Format('UnaryExpr (%s)', [Node.Operator.ToString])); + Indent; + Node.Right.Accept(Self); + Unindent; + Result := TDataType.Void.Value; +end; + +function TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode): IDataValue; +begin + AppendLine('IfExpr'); + Indent; + AppendLine('Condition:'); + Indent; + Node.Condition.Accept(Self); + Unindent; + AppendLine('Then:'); + Indent; + Node.ThenBranch.Accept(Self); + Unindent; + AppendLine('Else:'); + Indent; + Node.ElseBranch.Accept(Self); + Unindent; + Unindent; + Result := TDataType.Void.Value; +end; + +function TPrettyPrintVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): IDataValue; +var + param: IIdentifierNode; + paramNames: TStringList; +begin + paramNames := TStringList.Create; + try + for param in Node.Parameters do + paramNames.Add(param.Name); + AppendLine(Format('Lambda (params: %s)', [paramNames.CommaText])); + finally + paramNames.Free; + end; + + Indent; + AppendLine('Body:'); + Indent; + Node.Body.Accept(Self); + Unindent; + Unindent; + Result := TDataType.Void.Value; +end; + +function TPrettyPrintVisitor.VisitFunctionCall(const Node: IFunctionCallNode): IDataValue; +var + arg: IExpressionNode; +begin + AppendLine('FunctionCall'); + Indent; + AppendLine('Callee:'); + Indent; + Node.Callee.Accept(Self); + Unindent; + AppendLine('Arguments:'); + Indent; + for arg in Node.Arguments do + arg.Accept(Self); + Unindent; + Unindent; + Result := TDataType.Void.Value; +end; + +function TPrettyPrintVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): IDataValue; +var + expr: IExpressionNode; +begin + AppendLine('Block'); + Indent; + for expr in Node.Expressions do + expr.Accept(Self); + Unindent; + Result := TDataType.Void.Value; +end; + +function TPrettyPrintVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): IDataValue; +begin + AppendLine(Format('VarDecl (%s)', [Node.Identifier.Name])); + if Assigned(Node.Initializer) then + begin + Indent; + Node.Initializer.Accept(Self); + Unindent; + end; + Result := TDataType.Void.Value; +end; + +end. diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 8274b5d..5b98f80 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -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; - function GetBody: IAstNode; // Can be an expression or a block statement + function GetBody: IExpressionNode; // Body is now always an expression {$endregion} property Parameters: TList read GetParameters; - property Body: IAstNode read GetBody; + property Body: IExpressionNode read GetBody; end; IFunctionCallNode = interface(IExpressionNode) @@ -109,16 +113,16 @@ type property Arguments: TList 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; + function GetExpressions: TList; {$endregion} - property Statements: TList read GetStatements; + property Expressions: TList 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; - 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; - FBody: IAstNode; + FBody: IExpressionNode; function GetParameters: TList; - function GetBody: IAstNode; + function GetBody: IExpressionNode; public - constructor Create(AParameters: TList; ABody: IAstNode); + constructor Create(AParameters: TList; 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; - function GetStatements: TList; + FExpressions: TList; + function GetExpressions: TList; public - constructor Create(AStatements: TList); + constructor Create(AExpressions: TList); 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; 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; - stmt: IStatementNode; + exprList: TList; + expr: IExpressionNode; begin - stmtList := TList.Create; - for stmt in AStatements do - stmtList.Add(stmt); - Result := TBlockStatementNodeImpl.Create(stmtList); + 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): 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; ABody: IAstNode); +constructor TLambdaExpressionNodeImpl.Create(AParameters: TList; 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); +constructor TBlockExpressionNodeImpl.Create(AExpressions: TList); 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; +function TBlockExpressionNodeImpl.GetExpressions: TList; 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.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; - 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; -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. diff --git a/Src/Data/Myc.Data.Types.pas b/Src/Data/Myc.Data.Types.pas index c67706d..42567e6 100644 --- a/Src/Data/Myc.Data.Types.pas +++ b/Src/Data/Myc.Data.Types.pas @@ -553,7 +553,7 @@ type class operator Implicit(const A: TDataType.TMethod): IDataMethodType; overload; inline; property ArgType: IDataType read GetArgType; property ResultType: IDataType read GetResultType; - function CreateValue(const Proc: TProc): TDataType.TMethod.TValue; inline; + function CreateValue(const Proc: TProc): TDataType.TMethod.TValue; end; // Helper to cast a generic TValue to a specific value helper. @@ -598,11 +598,11 @@ type class operator Implicit(const A: TDataType.TVector): TDataType; overload; inline; // Type factories - class function Void: TDataType.TVoid; static; inline; - class function Ordinal: TDataType.TOrdinal; static; inline; - class function Float: TDataType.TFloat; static; inline; - class function Text: TDataType.TText; static; inline; - class function Timestamp: TDataType.TTimestamp; static; inline; + class function Void: TDataType.TVoid; static; + class function Ordinal: TDataType.TOrdinal; static; + class function Float: TDataType.TFloat; static; + class function Text: TDataType.TText; static; + class function Timestamp: TDataType.TTimestamp; static; class function DecimalOf(const AScale: Integer): TDataType.TDecimal; static; class function TupleOf(const AItemTypes: array of IDataType): TDataType.TTuple; overload; static; class function TupleOf(const AItemValues: array of IDataValue): TDataType.TTuple.TValue; overload; static; diff --git a/dirs.txt b/dirs.txt index d60f15b..4a4515d 100644 --- a/dirs.txt +++ b/dirs.txt @@ -1,4 +1,4 @@ T:\Myc\Src T:\Myc\Src\Data +T:\Myc\Src\AST T:\Myc\Test -T:\Myc\AuraTrader \ No newline at end of file