From 138e7ac454b2974ad22b3e13e7fe3e1839549b27 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Wed, 19 Nov 2025 14:38:40 +0100 Subject: [PATCH] Static specialization WIP --- ASTPlayground/ASTPlayground.delphilsp.json | 2 +- ASTPlayground/ASTPlayground.dpr | 3 +- ASTPlayground/ASTPlayground.dproj | 1 + ASTPlayground/MainForm.fmx | 2 +- ASTPlayground/MainForm.pas | 150 ++-- ASTPlayground/Myc.Fmx.AstEditor.Node.pas | 117 ---- ASTPlayground/Myc.Fmx.AstEditor.Text.pas | 14 - Src/AST/Myc.Ast.Compiler.Binder.pas | 92 ++- Src/AST/Myc.Ast.Compiler.Lowering.pas | 57 -- Src/AST/Myc.Ast.Compiler.Macros.pas | 2 +- Src/AST/Myc.Ast.Compiler.Specializer.pas | 207 ++++++ Src/AST/Myc.Ast.Compiler.TCO.pas | 39 +- Src/AST/Myc.Ast.Compiler.TypeChecker.pas | 218 +++--- Src/AST/Myc.Ast.Debugger.pas | 33 +- Src/AST/Myc.Ast.Dumper.pas | 138 ++-- Src/AST/Myc.Ast.Environment.pas | 318 +++++++-- Src/AST/Myc.Ast.Evaluator.pas | 96 ++- Src/AST/Myc.Ast.JSON.pas | 69 -- Src/AST/Myc.Ast.Nodes.pas | 41 +- Src/AST/Myc.Ast.RTL.Core.pas | 435 +++++++++++- Src/AST/Myc.Ast.RTL.pas | 751 ++++++++++++++++++--- Src/AST/Myc.Ast.Scope.pas | 124 +++- Src/AST/Myc.Ast.Script.pas | 20 - Src/AST/Myc.Ast.Types.pas | 279 ++++++-- Src/AST/Myc.Ast.Visitor.pas | 61 -- Src/AST/Myc.Ast.pas | 190 +----- 26 files changed, 2349 insertions(+), 1110 deletions(-) create mode 100644 Src/AST/Myc.Ast.Compiler.Specializer.pas diff --git a/ASTPlayground/ASTPlayground.delphilsp.json b/ASTPlayground/ASTPlayground.delphilsp.json index 0d9ec2f..cb6f69c 100644 --- a/ASTPlayground/ASTPlayground.delphilsp.json +++ b/ASTPlayground/ASTPlayground.delphilsp.json @@ -1 +1 @@ -{ "settings": { "project": "file:///T%3A/Myc/ASTPlayground/ASTPlayground.dpr", "dllname": "dcc64370.dll", "dccOptions": "-$O- -$W+ --inline:off -$R+ -$Q+ --no-config -Q -TX.exe -AGenerics.Collections=System.Generics.Collections;Generics.Defaults=System.Generics.Defaults;WinTypes=Winapi.Windows;WinProcs=Winapi.Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE -DDEBUG;;FRAMEWORK_FMX -E.\\Win64\\Debug -I\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\\DE\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\\DE\";T:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -LEC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Bpl\\Win64 -LNC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64 -NU.\\Win64\\Debug -NSWinapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;System;Xml;Data;Datasnap;Web;Soap; -OT:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -R\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\\DE\";T:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -U\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\\DE\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\\DE\";T:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -V -VN -VR -NBC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64 -NHC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\hpp\\Win64 -NO.\\Win64\\Debug -LU" , "projectFiles":[ { "name": "MainForm", "file": "file:///T%3A/Myc/ASTPlayground/MainForm.pas" }, { "name": "Myc.Ast.Evaluator", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Evaluator.pas" }, { "name": "Myc.Ast.Nodes", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Nodes.pas" }, { "name": "Myc.Ast.Scope", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Scope.pas" }, { "name": "Myc.Data.Value", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Data.Value.pas" }, { "name": "Myc.Ast.Debugger", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Debugger.pas" }, { "name": "Myc.Ast.Visitor", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Visitor.pas" }, { "name": "Myc.Ast.RTL", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.RTL.pas" }, { "name": "Myc.Ast.Dumper", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Dumper.pas" }, { "name": "Myc.Ast.RTL.Core", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.RTL.Core.pas" }, { "name": "Myc.Fmx.AstEditor.Node", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Fmx.AstEditor.Node.pas" }, { "name": "Myc.Fmx.AstEditor.Workspace", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Fmx.AstEditor.Workspace.pas" }, { "name": "Myc.Fmx.AstEditor.Text", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Fmx.AstEditor.Text.pas" }, { "name": "Myc.Utils", "file": "file:///T%3A/Myc/Src/Myc.Utils.pas" }, { "name": "Myc.Ast.Script", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Script.pas" }, { "name": "Myc.Ast.Types", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Types.pas" }, { "name": "Myc.Data.Keyword", "file": "file:///T%3A/Myc/Src/Data/Myc.Data.Keyword.pas" }, { "name": "Myc.Ast.Compiler.TCO", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.TCO.pas" }, { "name": "Myc.Ast.Compiler.Binder", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Binder.pas" }, { "name": "Myc.Ast.Compiler.Lowering", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Lowering.pas" }, { "name": "Myc.Ast.Compiler.TypeChecker", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.TypeChecker.pas" }, { "name": "Myc.Ast.Compiler.Macros", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Macros.pas" }, { "name": "Myc.Ast.Environment", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Environment.pas" } ] , "includeDCUsInUsesCompletion": true, "enableKeyWordCompletion": false, "browsingPaths": [ "file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/OCX/Servers","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/VCL","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/common","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/RTL/SYS","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/win","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/win/winrt","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/ToolsAPI","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/IBX","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Internet","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/PROPERTY%20EDITORS","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/soap","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/XML","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Indy10/Core","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Indy10/System","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Indy10/Protocols","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/fmx","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/databinding/components","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/databinding/engine","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/databinding/graph","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/ado","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/cloud","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/datasnap","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/dbx","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/dsnap","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/vclctrls","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/datasnap/connectors","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/datasnap/proxygen","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DataExplorer","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/Common","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/Common/dunit","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/DelphiExperts/Common","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/DelphiExperts/DUnitProject","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/DelphiExperts/DUnitProject/dunit","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/src","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/tests","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Experts","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/indy/abstraction","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/indy/implementation","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/indyimpl","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Property%20Editors/Indy10","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/soap/wsdlimporter","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Visualizers","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/XMLReporting","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/XPGen","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/rest","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/firedac","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/tethering","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnitX","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/ems","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/net","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/FlatBox2D","file:///C%3A/Users/Public/Documents/Embarcadero/Studio/37.0/Dcp/%25PLATFORM%25","file:///%25TP%25/runtime/vcl","file:///S%3A/sc_famos_src/svn_vcl/cpxedits","file:///S%3A/sc_famos_src/svn_vcl/dzChart","file:///S%3A/sc_famos_src/svn_vcl/eaeditor","file:///S%3A/sc_famos_src/svn_vcl/FamosEvents","file:///S%3A/sc_famos_src/svn_vcl/HTML_Viewer/source","file:///S%3A/sc_famos_src/svn_vcl/Myc_ChartEdit","file:///S%3A/sc_famos_src/svn_vcl/Myc_HemiDrag","file:///S%3A/sc_famos_src/svn_vcl/Myc_SplitControl","file:///S%3A/sc_famos_src/svn_vcl/NiceChart","file:///S%3A/sc_famos_src/svn_vcl/plotter","file:///S%3A/sc_famos_src/svn_vcl/SimpleIPC","file:///S%3A/sc_famos_src/svn_vcl/SynEdit-master/Source","file:///S%3A/sc_famos_src/svn_vcl/ValEdits","file:///S%3A/sc_famos_src/svn_vcl/ZipMaster","file:///S%3A/sc_famos_src/svn_vcl/ZipMaster/zlib","file:///S%3A/sc_famos_src/svn_vcl/ZipMaster/zlib/win32","file:///S%3A/sc_famos_src/svn_vcl/Virtual-TreeView/Source","file:///S%3A/sc_famos_src/svn_common/caHelpSys","file:///S%3A/sc_famos_src/svn_common/Misc","file:///S%3A/sc_famos_src/svn_common/Myc_VecMath","file:///S%3A/sc_famos_src/svn_common/PascalScript/source","file:///S%3A/sc_famos_src/svn_common/TreeBase","file:///S%3A/sc_famos_src/svn_common/TreeBase/Medien","file:///S%3A/3rdParty/spring4d/Source","file:///S%3A/3rdParty/spring4d/Source/Base","file:///S%3A/3rdParty/spring4d/Source/Base/Collections","file:///S%3A/3rdParty/spring4d/Source/Base/Logging","file:///S%3A/3rdParty/spring4d/Source/Base/Patches","file:///S%3A/3rdParty/spring4d/Source/Core/Container","file:///S%3A/3rdParty/spring4d/Source/Core/Interception","file:///S%3A/3rdParty/spring4d/Source/Core/Logging","file:///S%3A/3rdParty/spring4d/Source/Core/Mocking","file:///S%3A/3rdParty/spring4d/Source/Core/Services","file:///S%3A/3rdParty/spring4d/Source/Extensions/Cryptography","file:///S%3A/3rdParty/spring4d/Source/Extensions/Utils","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressCore%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressCommon%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressGDI%2B%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressLibrary/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/XP%20Theme%20Manager/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressLayout%20Control/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressPageControl/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressEditors%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressDocking%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressBars/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressOfficeCore%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressMemData/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressDataController/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressNavBar/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressSkins%20Library/Sources","file:///T%3A/Myc/Src","file:///T%3A/Myc/Src/Data","file:///T%3A/Myc/Src/AST" ] , "CommonAppData": "file:///C%3A/Users/Brummel/AppData/Roaming/Embarcadero/BDS/37.0/" , "Templates": "file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/ObjRepos/" } } \ No newline at end of file +{ "settings": { "project": "file:///T%3A/Myc/ASTPlayground/ASTPlayground.dpr", "dllname": "dcc64370.dll", "dccOptions": "-$O- -$W+ --inline:off -$R+ -$Q+ --no-config -Q -TX.exe -AGenerics.Collections=System.Generics.Collections;Generics.Defaults=System.Generics.Defaults;WinTypes=Winapi.Windows;WinProcs=Winapi.Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE -DDEBUG;;FRAMEWORK_FMX -E.\\Win64\\Debug -I\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\\DE\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\\DE\";T:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -LEC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Bpl\\Win64 -LNC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64 -NU.\\Win64\\Debug -NSWinapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;System;Xml;Data;Datasnap;Web;Soap; -OT:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -R\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\\DE\";T:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -U\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\\DE\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\debug\";\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\\DE\";T:\\Myc\\Src\\Data;T:\\Myc\\Src\\AST;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\lib\\Win64\\release\";C:\\Users\\Brummel\\Documents\\Embarcadero\\Studio\\37.0\\Imports\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\Imports\";C:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\include\";S:\\sc_famos_src\\svn_vcl\\Virtual-TreeView\\Source;S:\\sc_famos_src\\svn_vcl\\cpxedits;S:\\sc_famos_src\\svn_vcl\\dzChart;S:\\sc_famos_src\\svn_vcl\\eaeditor;S:\\sc_famos_src\\svn_vcl\\FamosEvents;S:\\sc_famos_src\\svn_vcl\\HTML_Viewer\\source;S:\\sc_famos_src\\svn_vcl\\Myc_ChartEdit;S:\\sc_famos_src\\svn_vcl\\Myc_HemiDrag;S:\\sc_famos_src\\svn_vcl\\Myc_SplitControl;S:\\sc_famos_src\\svn_vcl\\plotter;S:\\sc_famos_src\\svn_vcl\\SimpleIPC;S:\\sc_famos_src\\svn_vcl\\SynEdit-master\\Source;S:\\sc_famos_src\\svn_vcl\\ValEdits;S:\\sc_famos_src\\svn_vcl\\ZipMaster;S:\\sc_famos_src\\svn_common\\Myc_VecMath;\"C:\\Program Files (x86)\\DevExpress VCL\\Library\\RS28\\Win64\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressCommon Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressGDI+ Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLibrary\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\XP Theme Manager\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressLayout Control\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressPageControl\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressEditors Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDocking Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressBars\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressOfficeCore Library\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressMemData\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressDataController\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressNavBar\\Sources\";\"C:\\Program Files (x86)\\DevExpress VCL\\ExpressSkins Library\\Sources\";S:\\3rdParty\\FastMM5;C:\\Users\\Brummel\\AppData\\Local\\Programs\\TestInsight\\Source;T:\\Myc\\Src;\"c:\\program files (x86)\\embarcadero\\studio\\37.0\\source\\DUnitX\" -V -VN -VR -NBC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\Dcp\\Win64 -NHC:\\Users\\Public\\Documents\\Embarcadero\\Studio\\37.0\\hpp\\Win64 -NO.\\Win64\\Debug -LU" , "projectFiles":[ { "name": "MainForm", "file": "file:///T%3A/Myc/ASTPlayground/MainForm.pas" }, { "name": "Myc.Ast.Evaluator", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Evaluator.pas" }, { "name": "Myc.Ast.Nodes", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Nodes.pas" }, { "name": "Myc.Ast.Scope", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Scope.pas" }, { "name": "Myc.Data.Value", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Data.Value.pas" }, { "name": "Myc.Ast.Debugger", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Debugger.pas" }, { "name": "Myc.Ast.Visitor", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Visitor.pas" }, { "name": "Myc.Ast.RTL", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.RTL.pas" }, { "name": "Myc.Ast.Dumper", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Dumper.pas" }, { "name": "Myc.Ast.RTL.Core", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.RTL.Core.pas" }, { "name": "Myc.Fmx.AstEditor.Node", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Fmx.AstEditor.Node.pas" }, { "name": "Myc.Fmx.AstEditor.Workspace", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Fmx.AstEditor.Workspace.pas" }, { "name": "Myc.Fmx.AstEditor.Text", "file": "file:///T%3A/Myc/ASTPlayground/Myc.Fmx.AstEditor.Text.pas" }, { "name": "Myc.Utils", "file": "file:///T%3A/Myc/Src/Myc.Utils.pas" }, { "name": "Myc.Ast.Script", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Script.pas" }, { "name": "Myc.Ast.Types", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Types.pas" }, { "name": "Myc.Data.Keyword", "file": "file:///T%3A/Myc/Src/Data/Myc.Data.Keyword.pas" }, { "name": "Myc.Ast.Compiler.TCO", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.TCO.pas" }, { "name": "Myc.Ast.Compiler.Binder", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Binder.pas" }, { "name": "Myc.Ast.Compiler.Lowering", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Lowering.pas" }, { "name": "Myc.Ast.Compiler.TypeChecker", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.TypeChecker.pas" }, { "name": "Myc.Ast.Compiler.Macros", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Macros.pas" }, { "name": "Myc.Ast.Environment", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Environment.pas" }, { "name": "Myc.Ast.Compiler.Specializer", "file": "file:///T%3A/Myc/Src/AST/Myc.Ast.Compiler.Specializer.pas" } ] , "includeDCUsInUsesCompletion": true, "enableKeyWordCompletion": false, "browsingPaths": [ "file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/OCX/Servers","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/VCL","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/common","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/RTL/SYS","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/win","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/win/winrt","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/ToolsAPI","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/IBX","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Internet","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/PROPERTY%20EDITORS","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/soap","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/SOURCE/XML","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Indy10/Core","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Indy10/System","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Indy10/Protocols","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/fmx","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/databinding/components","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/databinding/engine","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/databinding/graph","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/ado","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/cloud","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/datasnap","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/dbx","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/dsnap","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/vclctrls","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/datasnap/connectors","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/datasnap/proxygen","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DataExplorer","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/Common","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/Common/dunit","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/DelphiExperts/Common","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/DelphiExperts/DUnitProject","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/DUnitWizard/Source/DelphiExperts/DUnitProject/dunit","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/src","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/tests","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Experts","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/indy/abstraction","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/indy/implementation","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/indyimpl","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Property%20Editors/Indy10","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/soap/wsdlimporter","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/Visualizers","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/XMLReporting","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnit/Contrib/XPGen","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/rest","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/firedac","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/tethering","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/DUnitX","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/data/ems","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/rtl/net","file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/source/FlatBox2D","file:///C%3A/Users/Public/Documents/Embarcadero/Studio/37.0/Dcp/%25PLATFORM%25","file:///%25TP%25/runtime/vcl","file:///S%3A/sc_famos_src/svn_vcl/cpxedits","file:///S%3A/sc_famos_src/svn_vcl/dzChart","file:///S%3A/sc_famos_src/svn_vcl/eaeditor","file:///S%3A/sc_famos_src/svn_vcl/FamosEvents","file:///S%3A/sc_famos_src/svn_vcl/HTML_Viewer/source","file:///S%3A/sc_famos_src/svn_vcl/Myc_ChartEdit","file:///S%3A/sc_famos_src/svn_vcl/Myc_HemiDrag","file:///S%3A/sc_famos_src/svn_vcl/Myc_SplitControl","file:///S%3A/sc_famos_src/svn_vcl/NiceChart","file:///S%3A/sc_famos_src/svn_vcl/plotter","file:///S%3A/sc_famos_src/svn_vcl/SimpleIPC","file:///S%3A/sc_famos_src/svn_vcl/SynEdit-master/Source","file:///S%3A/sc_famos_src/svn_vcl/ValEdits","file:///S%3A/sc_famos_src/svn_vcl/ZipMaster","file:///S%3A/sc_famos_src/svn_vcl/ZipMaster/zlib","file:///S%3A/sc_famos_src/svn_vcl/ZipMaster/zlib/win32","file:///S%3A/sc_famos_src/svn_vcl/Virtual-TreeView/Source","file:///S%3A/sc_famos_src/svn_common/caHelpSys","file:///S%3A/sc_famos_src/svn_common/Misc","file:///S%3A/sc_famos_src/svn_common/Myc_VecMath","file:///S%3A/sc_famos_src/svn_common/PascalScript/source","file:///S%3A/sc_famos_src/svn_common/TreeBase","file:///S%3A/sc_famos_src/svn_common/TreeBase/Medien","file:///S%3A/3rdParty/spring4d/Source","file:///S%3A/3rdParty/spring4d/Source/Base","file:///S%3A/3rdParty/spring4d/Source/Base/Collections","file:///S%3A/3rdParty/spring4d/Source/Base/Logging","file:///S%3A/3rdParty/spring4d/Source/Base/Patches","file:///S%3A/3rdParty/spring4d/Source/Core/Container","file:///S%3A/3rdParty/spring4d/Source/Core/Interception","file:///S%3A/3rdParty/spring4d/Source/Core/Logging","file:///S%3A/3rdParty/spring4d/Source/Core/Mocking","file:///S%3A/3rdParty/spring4d/Source/Core/Services","file:///S%3A/3rdParty/spring4d/Source/Extensions/Cryptography","file:///S%3A/3rdParty/spring4d/Source/Extensions/Utils","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressCore%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressCommon%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressGDI%2B%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressLibrary/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/XP%20Theme%20Manager/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressLayout%20Control/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressPageControl/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressEditors%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressDocking%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressBars/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressOfficeCore%20Library/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressMemData/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressDataController/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressNavBar/Sources","file:///C%3A/Program%20Files%20%28x86%29/DevExpress%20VCL/ExpressSkins%20Library/Sources","file:///T%3A/Myc/Src","file:///T%3A/Myc/Src/Data","file:///T%3A/Myc/Src/AST" ] , "CommonAppData": "file:///C%3A/Users/Brummel/AppData/Roaming/Embarcadero/BDS/37.0/" , "Templates": "file:///c%3A/program%20files%20%28x86%29/embarcadero/studio/37.0/ObjRepos/" } } \ No newline at end of file diff --git a/ASTPlayground/ASTPlayground.dpr b/ASTPlayground/ASTPlayground.dpr index 05cc2b1..fa80f4e 100644 --- a/ASTPlayground/ASTPlayground.dpr +++ b/ASTPlayground/ASTPlayground.dpr @@ -26,7 +26,8 @@ uses Myc.Ast.Compiler.Lowering in '..\Src\AST\Myc.Ast.Compiler.Lowering.pas', Myc.Ast.Compiler.TypeChecker in '..\Src\AST\Myc.Ast.Compiler.TypeChecker.pas', Myc.Ast.Compiler.Macros in '..\Src\AST\Myc.Ast.Compiler.Macros.pas', - Myc.Ast.Environment in '..\Src\AST\Myc.Ast.Environment.pas'; + Myc.Ast.Environment in '..\Src\AST\Myc.Ast.Environment.pas', + Myc.Ast.Compiler.Specializer in '..\Src\AST\Myc.Ast.Compiler.Specializer.pas'; {$R *.res} diff --git a/ASTPlayground/ASTPlayground.dproj b/ASTPlayground/ASTPlayground.dproj index 891f971..fbf97dc 100644 --- a/ASTPlayground/ASTPlayground.dproj +++ b/ASTPlayground/ASTPlayground.dproj @@ -157,6 +157,7 @@ + Base diff --git a/ASTPlayground/MainForm.fmx b/ASTPlayground/MainForm.fmx index 1432378..b666098 100644 --- a/ASTPlayground/MainForm.fmx +++ b/ASTPlayground/MainForm.fmx @@ -196,7 +196,7 @@ object Form1: TForm1 'Unbound' 'Expanded' 'Bound' - 'Lowered') + 'Specialized') ItemIndex = 0 Position.X = 672.000000000000000000 Position.Y = 576.000000000000000000 diff --git a/ASTPlayground/MainForm.pas b/ASTPlayground/MainForm.pas index fd8c7ab..0c3726f 100644 --- a/ASTPlayground/MainForm.pas +++ b/ASTPlayground/MainForm.pas @@ -117,12 +117,12 @@ type FTriggerTest: TAstEnvironment; procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); - function CreateEnvironment: TAstEnvironment; // Helper function to encapsulate the Compile -> Evaluate pattern function ExecuteAst(const ANode: IAstNode): TDataValue; procedure UpdateScript; procedure ShowVizualization(X, Y: Single); procedure PrintScript(const Node: IAstNode); + function CompileAstStage: IAstNode; public { Public declarations } end; @@ -175,7 +175,11 @@ begin [], TAst.Assign( TAst.Identifier('x'), - TAst.BinaryExpr(TAst.Identifier('x'), TScalar.TBinaryOp.Add, TAst.Constant(5)) + // --- Ersetzt --- + TAst.FunctionCall( + TAst.Identifier('+'), + [TAst.Identifier('x'), TAst.Constant(5)] + ) ) ) ), @@ -206,19 +210,30 @@ begin FWorkspace.Repaint; end; +function TForm1.CompileAstStage: IAstNode; +begin + Result := FCurrUnboundAst; + + if CompilerStageBox.ItemIndex > 0 then + begin + Result := FEnvironment.Environment.ExpandMacros(Result); + + if CompilerStageBox.ItemIndex > 1 then + begin + var desc: IScopeDescriptor; + Result := FEnvironment.Environment.Bind(Result, desc); + + if CompilerStageBox.ItemIndex > 2 then + Result := FEnvironment.Environment.Specialize(Result, desc); + end; + end; +end; + procedure TForm1.CompilerStageBoxChange(Sender: TObject); begin ShowVizualization(14, 14); end; -function TForm1.CreateEnvironment: TAstEnvironment; -begin - if DebugBox.IsChecked then - Result.SetDebugMode(Memo1.Lines, ShowScopeBox.IsChecked) - else - Result.SetStandardMode; -end; - // Simplified ExecuteAst using TEnvironment function TForm1.ExecuteAst(const ANode: IAstNode): TDataValue; begin @@ -232,7 +247,8 @@ begin FEnvironment.SetStandardMode; try - FCurrExec := FEnvironment.Compile(ANode); + var funcDef := TAst.LambdaExpr([], ANode); + FCurrExec := FEnvironment.Compile(funcDef).Func; Result := FCurrExec([]); except @@ -247,7 +263,7 @@ end; procedure TForm1.FormCreate(Sender: TObject); begin - FEnvironment := CreateEnvironment; + FEnvironment := TAstEnvironment.Construct(TAst.CreateScope(nil)); FWorkspace := TAuraWorkspace.Create(Panel2); FWorkspace.Parent := Panel2; @@ -255,8 +271,6 @@ begin FWorkspace.ClipChildren := true; FWorkspace.OnMouseDown := WorkspaceMouseDown; - RegisterRtlFunctions(FEnvironment.RootScope); - // Register the SMA factory into the environment var RegFunc := procedure(const Scope: IExecutionScope) @@ -276,36 +290,45 @@ begin [ TAst.Assign( TAst.Identifier('sum'), - TAst.BinaryExpr(TAst.Identifier('sum'), TScalar.TBinaryOp.Add, TAst.Identifier('val')) + // --- Ersetzt --- + TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('sum'), TAst.Identifier('val')]) ), TAst.Assign( TAst.Identifier('count'), - TAst.BinaryExpr(TAst.Identifier('count'), TScalar.TBinaryOp.Add, TAst.Constant(1)) + // --- Ersetzt --- + TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('count'), TAst.Constant(1)]) ), TAst.Assign( TAst.Identifier('sum'), TAst.TernaryExpr( - TAst.BinaryExpr( - TAst.Identifier('count'), - TScalar.TBinaryOp.Greater, - TAst.Identifier('len') - ), - TAst.BinaryExpr( - TAst.Identifier('sum'), - TScalar.TBinaryOp.Subtract, - TAst.Indexer(TAst.Identifier('series'), TAst.Identifier('len')) + // --- Ersetzt --- + TAst.FunctionCall(TAst.Identifier('>'), [TAst.Identifier('count'), TAst.Identifier('len')]), + // --- Ersetzt --- + TAst.FunctionCall( + TAst.Identifier('-'), + [ + TAst.Identifier('sum'), + TAst.Indexer(TAst.Identifier('series'), TAst.Identifier('len')) + ] ), TAst.Identifier('sum') ) ), - TAst.BinaryExpr( - TAst.Identifier('sum'), - TScalar.TBinaryOp.Divide, - TAst.TernaryExpr( - TAst.BinaryExpr(TAst.Identifier('count'), TScalar.TBinaryOp.Less, TAst.Identifier('len')), - TAst.Identifier('count'), - TAst.Identifier('len') - ) + // --- Ersetzt --- + TAst.FunctionCall( + TAst.Identifier('/'), + [ + TAst.Identifier('sum'), + TAst.TernaryExpr( + // --- Ersetzt --- + TAst.FunctionCall( + TAst.Identifier('<'), + [TAst.Identifier('count'), TAst.Identifier('len')] + ), + TAst.Identifier('count'), + TAst.Identifier('len') + ) + ] ) ] ) @@ -590,10 +613,10 @@ begin raise EJSONParseException.Create('Invalid JSON format.'); try - var unboundAst := converter.Deserialize(jsonObj); + FCurrUnboundAst := converter.Deserialize(jsonObj); // Run the full pipeline - FCurrExec := FEnvironment.Compile(unboundAst); + FCurrExec := FEnvironment.Compile(FCurrUnboundAst).Func; Memo1.Lines.Add('AST deserialized and bound successfully from JSON.'); Memo1.Lines.Add('You can now visualize it (Middle Mouse Click) or pretty-print it.'); @@ -658,7 +681,7 @@ begin end; // Dump the compiled AST from the executable - TAstDumper.Dump(FCurrUnboundAst, Memo1.Lines); + TAstDumper.Dump(CompileAstStage, Memo1.Lines); end; procedure TForm1.FibonacciButtonClick(Sender: TObject); @@ -676,8 +699,8 @@ begin (def fib) (assign fib (fn [n] (? (< n 2) - n - (+ (fib (- n 1)) (fib (- n 2))) + n + (+ (fib (- n 1)) (fib (- n 2))) ) )) ) @@ -690,7 +713,7 @@ begin Memo1.Lines.Add('--- Naive recursive fib with AST---'); - var fibExec := TestEnv.Compile(TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)])); + var fibExec := TestEnv.Compile(TAst.FunctionCall(TAst.Identifier('fib'), [TAst.Constant(25)])).Func; sw := TStopwatch.StartNew; result := fibExec([]); @@ -705,7 +728,7 @@ begin memoizeTest.Define('fib', TAstScript.Parse('(Memoize fib)')); - var memoizeExec := memoizeTest.Compile(TAstScript.Parse('(fib 25)')); + var memoizeExec := memoizeTest.Compile(TAstScript.Parse('(fib 25)')).Func; sw := TStopwatch.StartNew; result := memoizeExec([]); @@ -738,12 +761,15 @@ begin TAst.LambdaExpr( [TAst.Identifier('n'), TAst.Identifier('acc')], TAst.TernaryExpr( - TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.LessOrEqual, TAst.Constant(1)), + // --- Ersetzt --- + TAst.FunctionCall(TAst.Identifier('<='), [TAst.Identifier('n'), TAst.Constant(1)]), TAst.Identifier('acc'), // Base case: return the accumulator TAst.Recur( // Tail-recursive step [ - TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1)), - TAst.BinaryExpr(TAst.Identifier('acc'), TScalar.TBinaryOp.Multiply, TAst.Identifier('n')) + // --- Ersetzt --- + TAst.FunctionCall(TAst.Identifier('-'), [TAst.Identifier('n'), TAst.Constant(1)]), + // --- Ersetzt --- + TAst.FunctionCall(TAst.Identifier('*'), [TAst.Identifier('acc'), TAst.Identifier('n')]) ] ) ) @@ -834,7 +860,7 @@ begin ''' ); - var fn := FEnvironment.Compile(FCurrUnboundAst, [TAst.Identifier('txt')]); + var fn := FEnvironment.Compile(FCurrUnboundAst, [TAst.Identifier('txt')]).Func; fn(['Hello World']); @@ -865,7 +891,8 @@ begin TAst.Block( [ TAst.VarDecl(TAst.Identifier('baseValue'), TAst.Constant(100)), - TAst.BinaryExpr(TAst.Identifier('baseValue'), TScalar.TBinaryOp.Add, TAst.Identifier('offset')) + // --- Ersetzt --- + TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('baseValue'), TAst.Identifier('offset')]) ] ) ) @@ -932,7 +959,7 @@ begin var seriesAddress := env.RootScope.Define('current_series', TDataValue.Void); - var callExec := env.Compile(TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [TAst.Identifier('current_series')])); + var callExec := env.Compile(TAst.FunctionCall(TAst.Identifier('maCrossStrategy'), [TAst.Identifier('current_series')])).Func; // Simulation Loop Memo1.Lines.Clear; @@ -1007,8 +1034,10 @@ begin TAst.LambdaExpr( [TAst.Identifier('n')], TAst.IfExpr( - TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Greater, TAst.Constant(0)), - TAst.Recur([TAst.BinaryExpr(TAst.Identifier('n'), TScalar.TBinaryOp.Subtract, TAst.Constant(1))]), + // --- Ersetzt --- + TAst.FunctionCall(TAst.Identifier('>'), [TAst.Identifier('n'), TAst.Constant(0)]), + // --- Ersetzt --- + TAst.Recur([TAst.FunctionCall(TAst.Identifier('-'), [TAst.Identifier('n'), TAst.Constant(1)])]), TAst.Constant(0) ) ) @@ -1041,7 +1070,8 @@ begin [TAst.Identifier('summand')], TAst.Assign( TAst.Identifier('X'), - TAst.BinaryExpr(TAst.Identifier('X'), TScalar.TBinaryOp.Add, TAst.Identifier('summand')) + // --- Ersetzt --- + TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('X'), TAst.Identifier('summand')]) ) ) ) @@ -1055,7 +1085,8 @@ begin 'tickHandler', TAst.LambdaExpr( [TAst.Identifier('summand')], - TAst.Assign(TAst.Identifier('X'), TAst.BinaryExpr(TAst.Identifier('X'), TScalar.TBinaryOp.Add, TAst.Identifier('summand'))) + // --- Ersetzt --- + TAst.Assign(TAst.Identifier('X'), TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('X'), TAst.Identifier('summand')])) ) ); @@ -1142,7 +1173,8 @@ begin [], // Inner closure that is returned TAst.Assign( TAst.Identifier('a'), - TAst.BinaryExpr(TAst.Identifier('a'), TScalar.TBinaryOp.Add, TAst.Constant(5)) + // --- Ersetzt --- + TAst.FunctionCall(TAst.Identifier('+'), [TAst.Identifier('a'), TAst.Constant(5)]) ) ) ) @@ -1285,21 +1317,7 @@ begin if FCurrUnboundAst = nil then exit; - var ast := FCurrUnboundAst; - - if CompilerStageBox.ItemIndex > 0 then - ast := FEnvironment.Environment.ExpandMacros(ast); - - if CompilerStageBox.ItemIndex > 1 then - begin - var desc: IScopeDescriptor; - ast := FEnvironment.Environment.Bind(ast, desc); - end; - - if CompilerStageBox.ItemIndex > 2 then - ast := FEnvironment.Environment.Lower(ast); - - FWorkspace.Build(ast, TPointF.Create(X, Y)); + FWorkspace.Build(CompileAstStage, TPointF.Create(X, Y)); // // if FCurrExec <> nil then // begin diff --git a/ASTPlayground/Myc.Fmx.AstEditor.Node.pas b/ASTPlayground/Myc.Fmx.AstEditor.Node.pas index 6b2f937..0ee80f4 100644 --- a/ASTPlayground/Myc.Fmx.AstEditor.Node.pas +++ b/ASTPlayground/Myc.Fmx.AstEditor.Node.pas @@ -80,8 +80,6 @@ type function VisitConstant(const Node: IConstantNode): TAuraNode; override; function VisitIdentifier(const Node: IIdentifierNode): TAuraNode; override; function VisitKeyword(const Node: IKeywordNode): TAuraNode; override; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TAuraNode; override; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TAuraNode; override; function VisitIfExpression(const Node: IIfExpressionNode): TAuraNode; override; function VisitTernaryExpression(const Node: ITernaryExpressionNode): TAuraNode; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TAuraNode; override; @@ -279,19 +277,6 @@ type function ReconstructAst(OwnerNode: TAuraNode): IAstNode; end; - { TAuraBinaryExpressionNode } - TBinaryExpressionNodeHandler = class(TInterfacedObject, IAuraNodeHandler) - private - FNode: IBinaryExpressionNode; - FLeftNode: TAuraNode; // Stores the visual child - FRightNode: TAuraNode; // Stores the visual child - function GetAstNode: IAstNode; - public - constructor Create(const ANode: IBinaryExpressionNode); - procedure BuildUI(OwnerNode: TAuraNode); - function ReconstructAst(OwnerNode: TAuraNode): IAstNode; - end; - { TAuraBlockExpressionNode } TBlockExpressionNodeHandler = class(TInterfacedObject, IAuraNodeHandler) private @@ -305,18 +290,6 @@ type function ReconstructAst(OwnerNode: TAuraNode): IAstNode; end; - { TAuraUnaryExpressionNode } - TUnaryExpressionNodeHandler = class(TInterfacedObject, IAuraNodeHandler) - private - FNode: IUnaryExpressionNode; - FChildNode: TAuraNode; // Stores the single child - function GetAstNode: IAstNode; - public - constructor Create(const ANode: IUnaryExpressionNode); - procedure BuildUI(OwnerNode: TAuraNode); - function ReconstructAst(OwnerNode: TAuraNode): IAstNode; - end; - { TAuraIfExpressionNode } TIfExpressionNodeHandler = class(TInterfacedObject, IAuraNodeHandler) private @@ -648,14 +621,6 @@ begin Result := TAuraNode.Create(Self, Handler); end; -function TAstVisualizer.VisitBinaryExpression(const Node: IBinaryExpressionNode): TAuraNode; -var - Handler: IAuraNodeHandler; -begin - Handler := TBinaryExpressionNodeHandler.Create(Node); - Result := TAuraNode.Create(Self, Handler); -end; - function TAstVisualizer.VisitBlockExpression(const Node: IBlockExpressionNode): TAuraNode; var Handler: IAuraNodeHandler; @@ -664,14 +629,6 @@ begin Result := TAuraNode.Create(Self, Handler); end; -function TAstVisualizer.VisitUnaryExpression(const Node: IUnaryExpressionNode): TAuraNode; -var - Handler: IAuraNodeHandler; -begin - Handler := TUnaryExpressionNodeHandler.Create(Node); - Result := TAuraNode.Create(Self, Handler); -end; - function TAstVisualizer.VisitIfExpression(const Node: IIfExpressionNode): TAuraNode; var Handler: IAuraNodeHandler; @@ -1404,44 +1361,6 @@ begin Result := FNode; // Keywords are literals end; -{ TBinaryExpressionNodeHandler } - -constructor TBinaryExpressionNodeHandler.Create(const ANode: IBinaryExpressionNode); -begin - inherited Create; - FNode := ANode; -end; - -function TBinaryExpressionNodeHandler.GetAstNode: IAstNode; -begin - Result := FNode; -end; - -procedure TBinaryExpressionNodeHandler.BuildUI(OwnerNode: TAuraNode); -var - visu: IAstVisualizer; -begin - visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1); - OwnerNode.BeginUpdate; - try - OwnerNode.Frameless := true; - OwnerNode.Orientation := loHorizontal; - - // Create and store visual children - FLeftNode := visu.CallAccept(FNode.Left); - OwnerNode.AddLabel(OwnerNode, FNode.Operator.ToString); - FRightNode := visu.CallAccept(FNode.Right); - finally - OwnerNode.EndUpdate; - end; -end; - -function TBinaryExpressionNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode; -begin - // Use the stored visual children to reconstruct the AST - Result := TAst.BinaryExpr(FLeftNode.CreateAst, FNode.Operator, FRightNode.CreateAst); -end; - { TBlockExpressionNodeHandler } constructor TBlockExpressionNodeHandler.Create(const ANode: IBlockExpressionNode); @@ -1521,42 +1440,6 @@ begin Result := TAst.Block(exprs); end; -{ TUnaryExpressionNodeHandler } - -constructor TUnaryExpressionNodeHandler.Create(const ANode: IUnaryExpressionNode); -begin - inherited Create; - FNode := ANode; -end; - -function TUnaryExpressionNodeHandler.GetAstNode: IAstNode; -begin - Result := FNode; -end; - -procedure TUnaryExpressionNodeHandler.BuildUI(OwnerNode: TAuraNode); -var - visu: IAstVisualizer; - titleLabel: TLabel; -begin - visu := OwnerNode.Visualizer.Clone(OwnerNode, OwnerNode.Visualizer.ExprDepth + 1); - OwnerNode.BeginUpdate; - try - OwnerNode.Frameless := False; - OwnerNode.Orientation := loVertical; - titleLabel := OwnerNode.AddLabel(OwnerNode, 'Unary Op: ' + FNode.Operator.ToString); - titleLabel.Font.Style := titleLabel.Font.Style + [TFontStyle.fsBold]; - FChildNode := visu.CallAccept(FNode.Right); - finally - OwnerNode.EndUpdate; - end; -end; - -function TUnaryExpressionNodeHandler.ReconstructAst(OwnerNode: TAuraNode): IAstNode; -begin - Result := TAst.UnaryExpr(FNode.Operator, FChildNode.CreateAst); -end; - { TIfExpressionNodeHandler } constructor TIfExpressionNodeHandler.Create(const ANode: IIfExpressionNode); diff --git a/ASTPlayground/Myc.Fmx.AstEditor.Text.pas b/ASTPlayground/Myc.Fmx.AstEditor.Text.pas index 9bf1514..40fcbf1 100644 --- a/ASTPlayground/Myc.Fmx.AstEditor.Text.pas +++ b/ASTPlayground/Myc.Fmx.AstEditor.Text.pas @@ -17,8 +17,6 @@ type function VisitConstant(const Node: IConstantNode): string; override; function VisitIdentifier(const Node: IIdentifierNode): string; override; function VisitKeyword(const Node: IKeywordNode): string; override; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): string; override; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): string; override; function VisitIfExpression(const Node: IIfExpressionNode): string; override; function VisitTernaryExpression(const Node: ITernaryExpressionNode): string; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): string; override; @@ -65,13 +63,6 @@ begin Result := Node.Identifier.Name + ' := ' + Accept(Node.Value); end; -function TAstToTextVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): string; -begin - var leftStr := Accept(Node.Left); - var rightStr := Accept(Node.Right); - Result := '(' + leftStr + ' ' + Node.Operator.ToString + ' ' + rightStr + ')'; -end; - function TAstToTextVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): string; begin Result := '{...}'; @@ -260,11 +251,6 @@ begin Result := Format('(%s ? %s : %s)', [condStr, thenStr, elseStr]); end; -function TAstToTextVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): string; -begin - Result := Node.Operator.ToString + ' ' + Accept(Node.Right); -end; - function TAstToTextVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): string; var initStr: string; diff --git a/Src/AST/Myc.Ast.Compiler.Binder.pas b/Src/AST/Myc.Ast.Compiler.Binder.pas index 054640b..e8fdba0 100644 --- a/Src/AST/Myc.Ast.Compiler.Binder.pas +++ b/Src/AST/Myc.Ast.Compiler.Binder.pas @@ -11,11 +11,14 @@ uses Myc.Ast.Nodes, Myc.Ast.Visitor, Myc.Ast.Scope, + Myc.Ast.Types, Myc.Ast.Compiler.Binder.Upvalues, - Myc.Ast; + Myc.Ast, + Myc.Ast.Environment; type IAstBinder = interface(IAstVisitor) + // AArgTypes is now passed to the implementation via its constructor function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; end; @@ -30,6 +33,8 @@ type FUpvalueStack: TStack; FNestedLambdaCount: Integer; FBoxedDeclarations: THashSet; + FArgTypes: TArray; + FFunctionRegistry: IFunctionDefinitionRegistry; procedure EnterScope; procedure ExitScope; @@ -39,6 +44,7 @@ type // --- Core Binding Logic (Mutators) --- function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override; function VisitVariableDeclaration(const Node: IVariableDeclarationNode): IAstNode; override; + function VisitAssignment(const Node: IAssignmentNode): IAstNode; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override; // --- Transformation Logic (Restored) --- @@ -49,14 +55,20 @@ type function VisitConstant(const Node: IConstantNode): IAstNode; override; function VisitCreateSeries(const Node: ICreateSeriesNode): IAstNode; override; public - constructor Create(const AInitialDescriptor: IScopeDescriptor); + constructor Create( + const AInitialDescriptor: IScopeDescriptor; + const AFunctionRegistry: IFunctionDefinitionRegistry; + const AArgTypes: TArray + ); destructor Destroy; override; function Execute(const RootNode: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; class function Bind( const InitialDescriptor: IScopeDescriptor; const RootNode: IAstNode; - out Descriptor: IScopeDescriptor + out Descriptor: IScopeDescriptor; + const AFunctionRegistry: IFunctionDefinitionRegistry = nil; + const AArgTypes: TArray = nil ): IAstNode; static; end; @@ -65,7 +77,6 @@ implementation uses System.Generics.Defaults, System.Character, - Myc.Ast.Types, // Added for TTypes.Unknown Myc.Data.Keyword; type @@ -91,12 +102,18 @@ end; { TAstBinder } -constructor TAstBinder.Create(const AInitialDescriptor: IScopeDescriptor); +constructor TAstBinder.Create( + const AInitialDescriptor: IScopeDescriptor; + const AFunctionRegistry: IFunctionDefinitionRegistry; + const AArgTypes: TArray +); begin inherited Create; Assert(Assigned(AInitialDescriptor)); FCurrentDescriptor := AInitialDescriptor; + FFunctionRegistry := AFunctionRegistry; + FArgTypes := AArgTypes; FUpvalueStack := TObjectStack.Create(True); // Use Comparer FNestedLambdaCount := 0; FBoxedDeclarations := nil; @@ -112,10 +129,12 @@ end; class function TAstBinder.Bind( const InitialDescriptor: IScopeDescriptor; const RootNode: IAstNode; - out Descriptor: IScopeDescriptor + out Descriptor: IScopeDescriptor; + const AFunctionRegistry: IFunctionDefinitionRegistry = nil; + const AArgTypes: TArray = nil ): IAstNode; begin - var binder := TAstBinder.Create(InitialDescriptor) as IAstBinder; + var binder := TAstBinder.Create(InitialDescriptor, AFunctionRegistry, AArgTypes) as IAstBinder; Result := binder.Execute(RootNode, Descriptor); end; @@ -228,6 +247,7 @@ var lastNestedLambdaCount: Integer; newParams: TArray; newBody: IAstNode; + paramType: IStaticType; begin // We do *not* call inherited, as we must manage the scope manually. @@ -236,18 +256,26 @@ begin EnterScope; try // Define (slot 0) - FCurrentDescriptor.Define(''); + FCurrentDescriptor.Define('', TTypes.Unknown); // Define parameters SetLength(newParams, Length(Node.Parameters)); for i := 0 to High(Node.Parameters) do begin var paramNode := Node.Parameters[i]; // This is a TIdentifierNode - var slotIndex := FCurrentDescriptor.Define(paramNode.Name); + + // Check if this is the root lambda (stack count = 1) + // and we have pre-defined types for it (from specialization) + paramType := TTypes.Unknown; + if (FUpvalueStack.Count = 1) and (FArgTypes <> nil) and (i < Length(FArgTypes)) then + paramType := FArgTypes[i]; // Use the specialized type + + // Define the symbol in the descriptor WITH the type + var slotIndex := FCurrentDescriptor.Define(paramNode.Name, paramType); adr := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex); - // Create a new TIdentifierNode - newParams[i] := TAst.Identifier(paramNode.Name, adr, TTypes.Unknown); + // Create a new TIdentifierNode, now with the correct type + newParams[i] := TAst.Identifier(paramNode.Name, adr, paramType); end; // Visit the body *within the new scope* @@ -326,7 +354,7 @@ begin // else: It was already an upvalue (e.g. nested lambda), adr is correct. // --- Replace Node --- - Result := TAst.Identifier(Node.Name, adr, TTypes.Unknown); // TypeChecker will set type + Result := TAst.Identifier(Node.Name, adr, symbol.StaticType); end else begin @@ -343,27 +371,51 @@ var newInitializer: IAstNode; newIdentifier: IIdentifierNode; begin + // 1. Validate name if not IsValidIdentifier(Node.Identifier.Name) then raise Exception.CreateFmt('Invalid identifier name: "%s".', [Node.Identifier.Name]); - // 1. Visit initializer *first* + // 2. Define the symbol in the scope *first*. + // This allows the initializer (e.g., a lambda) to recursively refer to this symbol. + slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name, TTypes.Unknown); + address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex); + + // 3. Visit the Initializer *after* the symbol is defined if Assigned(Node.Initializer) then newInitializer := Accept(Node.Initializer) else newInitializer := nil; - // 2. Define variable in *current* scope - slotIndex := FCurrentDescriptor.Define(Node.Identifier.Name); - address := TResolvedAddress.Create(akLocalOrParent, 0, slotIndex); - - // 3. Create the new bound identifier + // 4. Create the new (bound) identifier node + // The TypeChecker will set the final type newIdentifier := TAst.Identifier(Node.Identifier.Name, address, TTypes.Unknown); - // 4. Check if this declaration should be boxed + // 5. Check if this declaration needs boxing (from UpvalueAnalyzer pass) isBoxed := (FBoxedDeclarations <> nil) and FBoxedDeclarations.Contains(Node); - // 5. Create the new immutable node + // 6. Create the new VariableDeclaration node using the factory Result := TAst.VarDecl(newIdentifier, newInitializer, TTypes.Unknown, isBoxed); + + // 7. Store in registry *only if the registry was provided* + // (This must happen *after* visiting the initializer) + if Assigned(FFunctionRegistry) and (newInitializer <> nil) and (newInitializer.Kind = akLambdaExpression) then + FFunctionRegistry.Register(address, newInitializer.AsLambdaExpression); +end; + +function TAstBinder.VisitAssignment(const Node: IAssignmentNode): IAstNode; +var + newIdent: IIdentifierNode; + newValue: IAstNode; +begin + Result := inherited VisitAssignment(Node); + + newValue := Result.AsAssignment.Value; + newIdent := Result.AsAssignment.Identifier; + + if Assigned(FFunctionRegistry) and (newValue <> nil) and (newValue.Kind = akLambdaExpression) then + begin + FFunctionRegistry.Register(newIdent.Address, newValue.AsLambdaExpression); + end; end; end. diff --git a/Src/AST/Myc.Ast.Compiler.Lowering.pas b/Src/AST/Myc.Ast.Compiler.Lowering.pas index 342a978..3c9b951 100644 --- a/Src/AST/Myc.Ast.Compiler.Lowering.pas +++ b/Src/AST/Myc.Ast.Compiler.Lowering.pas @@ -27,8 +27,6 @@ type FBinaryOperators: TDictionary; FUnaryOperators: TDictionary; protected - // Override to find nodes to lower - function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override; public constructor Create; destructor Destroy; override; @@ -46,9 +44,6 @@ uses { TAstLowerer } constructor TAstLowerer.Create; -var - op: TScalar.TBinaryOp; - uOp: TScalar.TUnaryOp; begin inherited Create; @@ -91,56 +86,4 @@ begin Result := TAst.Block([]); end; -function TAstLowerer.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; -var - calleeIdentifier: IIdentifierNode; - binaryOp: TScalar.TBinaryOp; - unaryOp: TScalar.TUnaryOp; - left, right: IAstNode; - nodeType: IStaticType; -begin - // --- Optimization: Operator Folding --- - if Node.Callee.Kind = akIdentifier then - begin - calleeIdentifier := Node.Callee.AsIdentifier; - nodeType := Node.StaticType; // Get type from (un-lowered) node - - if (Length(Node.Arguments) = 2) then - begin - if FBinaryOperators.TryGetValue(calleeIdentifier.Name, binaryOp) then - begin - // Note: We MUST visit children *before* creating the new node - left := Accept(Node.Arguments[0]); - right := Accept(Node.Arguments[1]); - - // Call constructor directly, passing the inferred type - Result := TAst.BinaryExpr(left, binaryOp, right, nodeType); - exit; - end; - end; - - if (Length(Node.Arguments) = 1) then - begin - if FUnaryOperators.TryGetValue(calleeIdentifier.Name, unaryOp) then - begin - right := Accept(Node.Arguments[0]); - // Call constructor directly, passing the inferred type - Result := TAst.UnaryExpr(unaryOp, right, nodeType); - exit; - end; - - if (calleeIdentifier.Name = '-') then - begin - right := Accept(Node.Arguments[0]); - // Call constructor directly, passing the inferred type - Result := TAst.UnaryExpr(TScalar.TUnaryOp.Negate, right, nodeType); - exit; - end; - end; - end; - - // If no rewrite matched, continue traversal using the base implementation - Result := inherited VisitFunctionCall(Node); -end; - end. diff --git a/Src/AST/Myc.Ast.Compiler.Macros.pas b/Src/AST/Myc.Ast.Compiler.Macros.pas index 3258bf8..85b4c44 100644 --- a/Src/AST/Myc.Ast.Compiler.Macros.pas +++ b/Src/AST/Myc.Ast.Compiler.Macros.pas @@ -496,7 +496,7 @@ begin // 1. Create the temporary scope for the macro parameters // It must be parented to the *initial* scope to find other globals. - var expansionScope := TAst.CreateScope(FInitialScope); + var expansionScope := TScope.CreateScope(FInitialScope, nil, nil); var params := macroDef.Parameters; if Length(Node.Arguments) <> Length(params) then raise Exception diff --git a/Src/AST/Myc.Ast.Compiler.Specializer.pas b/Src/AST/Myc.Ast.Compiler.Specializer.pas new file mode 100644 index 0000000..df8d4e6 --- /dev/null +++ b/Src/AST/Myc.Ast.Compiler.Specializer.pas @@ -0,0 +1,207 @@ +unit Myc.Ast.Compiler.Specializer; + +interface + +uses + System.SysUtils, + System.Generics.Collections, + Myc.Data.Value, + Myc.Ast, + Myc.Ast.Types, + Myc.Ast.Nodes, + Myc.Ast.Visitor, + Myc.Ast.Scope, + Myc.Ast.Environment, + Myc.Ast.RTL; + +type + IAstSpecializer = interface(IAstVisitor) + function Execute(const RootNode: IAstNode): IAstNode; + end; + + // This transformer runs *after* TypeChecker + // It specializes all statically resolvable function calls (RTL and user-defined) + // by replacing them with nodes that have a direct StaticTarget. + TStaticSpecializer = class(TAstTransformer, IAstSpecializer) + private + FEnvironment: IEnvironment; + FMonomorphCache: TMonomorphCache; + FFunctionRegistry: IFunctionDefinitionRegistry; + + function GetStaticRtlFunction(const AName: string; const AArgTypes: TArray): TSpecializedMethod; + + protected + function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override; + + public + constructor Create(const AEnvironment: IEnvironment); + function Execute(const RootNode: IAstNode): IAstNode; + + class function Specialize( + const AEnvironment: IEnvironment; + const RootNode: IAstNode; + const ADescriptor: IScopeDescriptor + ): IAstNode; static; + end; + +implementation + +{ TStaticSpecializer } + +constructor TStaticSpecializer.Create(const AEnvironment: IEnvironment); +begin + inherited Create; + Assert(Assigned(AEnvironment)); + FEnvironment := AEnvironment; + FMonomorphCache := AEnvironment.MonomorphCache; + FFunctionRegistry := AEnvironment.FunctionRegistry; // Get registry + Assert(Assigned(FFunctionRegistry)); +end; + +class function TStaticSpecializer.Specialize( + const AEnvironment: IEnvironment; + const RootNode: IAstNode; + const ADescriptor: IScopeDescriptor +): IAstNode; +begin + // ADescriptor is no longer needed here, the environment has all it needs + var specializer := TStaticSpecializer.Create(AEnvironment) as IAstSpecializer; + Result := specializer.Execute(RootNode); +end; + +function TStaticSpecializer.Execute(const RootNode: IAstNode): IAstNode; +begin + Result := Accept(RootNode); + if not Assigned(Result) then + Result := TAst.Block([]); +end; + +function TStaticSpecializer.GetStaticRtlFunction(const AName: string; const AArgTypes: TArray): TSpecializedMethod; +begin + // Helper to query the RTL bootstrap cache + Result := TRtlRegistry.GetStaticSpecialization(AName, AArgTypes); +end; + +function TStaticSpecializer.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; +var + newCallee: IAstNode; + newArgs: TArray; + i: Integer; + calleeIdent: IIdentifierNode; + argTypes: TArray; + allTypesKnown: Boolean; + funcName: string; + key: TMonoCacheKey; + specializedMethod: TSpecializedMethod; + funcDef: IFunctionDefinition; +begin + // 1. Specialize children first (bottom-up) + newCallee := Accept(Node.Callee); + newArgs := AcceptNodes(Node.Arguments); + + // 2. Check if this call is a candidate for specialization + if newCallee.Kind <> akIdentifier then + begin + if (newCallee = Node.Callee) and (newArgs = Node.Arguments) then + Result := Node + else + Result := TAst.FunctionCall(newCallee, newArgs, Node.StaticType, Node.IsTailCall, nil); + exit; + end; + + calleeIdent := newCallee.AsIdentifier; + funcName := calleeIdent.Name; + + // 3. Check if all argument types are statically known + allTypesKnown := True; + SetLength(argTypes, Length(newArgs)); + for i := 0 to High(newArgs) do + begin + argTypes[i] := newArgs[i].AsTypedNode.StaticType; + if argTypes[i].Kind = stUnknown then + begin + allTypesKnown := False; + break; + end; + end; + + if not allTypesKnown then + begin + if (newCallee = Node.Callee) and (newArgs = Node.Arguments) then + Result := Node + else + Result := TAst.FunctionCall(newCallee, newArgs, Node.StaticType, Node.IsTailCall, nil); + exit; + end; + + // --- At this point, the call is statically resolvable --- + + // 4. Check the Environment (Instance) Cache + key := TMonoCacheKey.Create(calleeIdent.Address, argTypes); + + if FMonomorphCache.TryGetValue(key, specializedMethod) then + begin + // 4a. Cache Hit (Environment): Found user-defined or previously specialized fn + Result := + TAst.FunctionCall( + newCallee, + newArgs, + specializedMethod.ReturnType, // Use the type from the cache + Node.IsTailCall, + specializedMethod.Target // Use the TFunc from the cache + ); + exit; + end; + + // 5. Check the RTL (Global) Bootstrap Cache + specializedMethod := GetStaticRtlFunction(funcName, argTypes); + if Assigned(specializedMethod.Target) then + begin + // 5a. Cache Hit (RTL): Found a native, static RTL function + FMonomorphCache.Add(key, specializedMethod); + + Result := + TAst.FunctionCall( + newCallee, + newArgs, + specializedMethod.ReturnType, // Use the type from the cache + Node.IsTailCall, + specializedMethod.Target // Use the TFunc from the cache + ); + exit; + end; + + // 6. Cache Miss (User Code) + funcDef := FFunctionRegistry.Resolve(calleeIdent.Address); + + if (funcDef <> nil) then + begin + // 6a. Compile func with KNOWN TYPES + var compiled := FEnvironment.Compile(funcDef, argTypes); + + // 6b. Store in cache + // Get the return type from the *full function type* returned by Compile + var returnType := compiled.StaticType.Signatures[0].ReturnType; + specializedMethod := TSpecializedMethod.Create(compiled.Func, returnType); + FMonomorphCache.Add(key, specializedMethod); + + // 6e. Return the new node + Result := + TAst.FunctionCall( + newCallee, + newArgs, + returnType, // Use the extracted return type + Node.IsTailCall, + compiled.Func // Use the compiled TFunc + ); + exit; + end; + + // 7. Fallback: Not RTL, Not User-Code (oder AST nicht gefunden) -> Dynamic + if (newCallee = Node.Callee) and (newArgs = Node.Arguments) then + Result := Node + else + Result := TAst.FunctionCall(newCallee, newArgs, Node.StaticType, Node.IsTailCall, nil); +end; + +end. diff --git a/Src/AST/Myc.Ast.Compiler.TCO.pas b/Src/AST/Myc.Ast.Compiler.TCO.pas index eacc839..964e000 100644 --- a/Src/AST/Myc.Ast.Compiler.TCO.pas +++ b/Src/AST/Myc.Ast.Compiler.TCO.pas @@ -35,10 +35,6 @@ type function VisitRecurNode(const Node: IRecurNode): IAstNode; override; function VisitMacroExpansionNode(const Node: IMacroExpansionNode): IAstNode; override; - // Operands are never in tail position. - function VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode; override; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode; override; - // The core TCO logic function VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; override; public @@ -96,24 +92,6 @@ begin end; end; -function TAstTCO.VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode; -begin - // Operands are never in tail position. - FNextIsTail := False; - - // Call inherited, which will visit Left and Right with FNextIsTail = False - Result := inherited VisitBinaryExpression(Node); -end; - -function TAstTCO.VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode; -begin - // Operand is never in tail position. - FNextIsTail := False; - - // Call inherited, which will visit Right with FNextIsTail = False - Result := inherited VisitUnaryExpression(Node); -end; - function TAstTCO.VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; var isContextTail: Boolean; @@ -250,13 +228,22 @@ begin newArgs := AcceptNodes(Node.Arguments); // CoW check: Create a new node only if children changed OR IsTailCall needs update + // OR StaticTarget is missing (which it shouldn't be, but good to check) if (newCallee = Node.Callee) and (newArgs = Node.Arguments) and (isTailCall = Node.IsTailCall) then - Result := Node - else begin - // Use factory to create new node, passing the *new* TCO status - Result := TAst.FunctionCall(newCallee, newArgs, Node.StaticType, isTailCall); + Result := Node; + exit; end; + + // Use factory to create new node, passing the *new* TCO status + Result := + TAst.FunctionCall( + newCallee, + newArgs, + Node.StaticType, + isTailCall, + Node.StaticTarget // Preserve the static target + ); end; end. diff --git a/Src/AST/Myc.Ast.Compiler.TypeChecker.pas b/Src/AST/Myc.Ast.Compiler.TypeChecker.pas index 9c46100..b5340ee 100644 --- a/Src/AST/Myc.Ast.Compiler.TypeChecker.pas +++ b/Src/AST/Myc.Ast.Compiler.TypeChecker.pas @@ -36,8 +36,6 @@ type function VisitBlockExpression(const Node: IBlockExpressionNode): IAstNode; override; function VisitIfExpression(const Node: IIfExpressionNode): IAstNode; override; function VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode; override; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode; override; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode; override; function VisitMemberAccess(const Node: IMemberAccessNode): IAstNode; override; function VisitIndexer(const Node: IIndexerNode): IAstNode; override; function VisitRecordLiteral(const Node: IRecordLiteralNode): IAstNode; override; @@ -137,36 +135,60 @@ var initType: IStaticType; newInitializer, newIdent: IAstNode; adr: TResolvedAddress; + lambdaNode: ILambdaExpressionNode; + placeholderType: IStaticType; + i: Integer; begin - // 1. Visit Initializer first (if it exists) + // 1. Get the address from the bound identifier (Binder did this) + adr := Node.Identifier.Address; + initType := TTypes.Unknown; // Default + + // 2. Check for recursive lambda and bootstrap the type + placeholderType := nil; + if (Node.Initializer <> nil) and (Node.Initializer.Kind = akLambdaExpression) then + begin + lambdaNode := Node.Initializer.AsLambdaExpression; + + // Create a placeholder method type based on the *unvisited* lambda's parameter *count*. + var paramTypes: TArray; + SetLength(paramTypes, Length(lambdaNode.Parameters)); + for i := 0 to High(paramTypes) do + paramTypes[i] := TTypes.Unknown; + + // Create the placeholder (Return type is also Unknown for now) + placeholderType := TTypes.CreateMethod(paramTypes, TTypes.Unknown); + + // 3. *Update the descriptor* with the placeholder *before* visiting the initializer + FCurrentDescriptor.UpdateType(adr.SlotIndex, placeholderType); + initType := placeholderType; // Store this + end; + + // 4. Visit Initializer (if it exists) if Assigned(Node.Initializer) then newInitializer := Accept(Node.Initializer) else newInitializer := nil; - // 2. Get initializer type + // 5. Get the *final* inferred initializer type if Assigned(newInitializer) then initType := newInitializer.AsTypedNode.StaticType - else - initType := TTypes.Unknown; // (def fib) + else if not Assigned(placeholderType) then // only if not already set + initType := TTypes.Unknown; // (def f) - no initializer - // 3. Get the address from the bound identifier - adr := Node.Identifier.Address; - - // 4. Update the type in the scope descriptor (which was set to Unknown by the binder). + // 6. *Re-update* the type in the scope descriptor with the final, inferred type. if initType.Kind <> stUnknown then FCurrentDescriptor.UpdateType(adr.SlotIndex, initType); - // 5. Create the new (typed) identifier node + // 7. Create the new (typed) identifier node newIdent := TAst.Identifier(Node.Identifier.Name, adr, initType); - // 6. Create the new VariableDeclaration node using the factory + // 8. Create the new VariableDeclaration node using the factory Result := TAst.VarDecl( newIdent.AsIdentifier, newInitializer, initType, - Node.IsBoxed // 7. Copy runtime flags (IsBoxed) via interface + Node.IsBoxed // 9. Copy runtime flags ); end; @@ -175,32 +197,65 @@ var targetType, sourceType: IStaticType; newIdent, newValue: IAstNode; adr: TResolvedAddress; + lambdaNode: ILambdaExpressionNode; + placeholderType: IStaticType; + i: Integer; begin - // 1. Visit children first (Identifier, Value) - newValue := Accept(Node.Value); + // 1. Visit Identifier *first* to get its address and current type newIdent := Accept(Node.Identifier); - - // 2. Get types targetType := newIdent.AsTypedNode.StaticType; + adr := newIdent.AsIdentifier.Address; + + // 2. Check for recursive lambda assignment + placeholderType := nil; + if (Node.Value <> nil) and (Node.Value.Kind = akLambdaExpression) then + begin + lambdaNode := Node.Value.AsLambdaExpression; + + // Create a placeholder (only if the target is not already a method type) + if (targetType.Kind <> stMethod) then + begin + var paramTypes: TArray; + SetLength(paramTypes, Length(lambdaNode.Parameters)); + for i := 0 to High(paramTypes) do + paramTypes[i] := TTypes.Unknown; // We infer param types later + + placeholderType := TTypes.CreateMethod(paramTypes, TTypes.Unknown); + + // 3. *Update the descriptor* with the placeholder *before* visiting the value + FCurrentDescriptor.UpdateType(adr.SlotIndex, placeholderType); + targetType := placeholderType; + end; + end; + + // 4. Visit Value + newValue := Accept(Node.Value); sourceType := newValue.AsTypedNode.StaticType; - // 3. Check assignment + // 5. Check assignment if not TTypeRules.CanAssign(targetType, sourceType) then - raise ETypeException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]); - - // 4. If the target was 'Unknown' (from 'def'), update the descriptor - // with the new, inferred type. This enables recursion. - if (targetType.Kind = stUnknown) and (sourceType.Kind <> stUnknown) then begin - adr := newIdent.AsIdentifier.Address; - FCurrentDescriptor.UpdateType(adr.SlotIndex, sourceType); + // If target was unknown, try promoting + if (targetType.Kind = stUnknown) then + begin + if not TTypeRules.CanAssign(sourceType, targetType) then // Check reverse + raise ETypeException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]); + end + else + raise ETypeException.CreateFmt('Cannot assign type %s to %s', [sourceType.ToString, targetType.ToString]); + end; + // 6. If the target was 'Unknown' or a 'Placeholder', update the descriptor + // with the new, final inferred type. + if ((targetType.Kind = stUnknown) or Assigned(placeholderType)) and (sourceType.Kind <> stUnknown) then + begin + FCurrentDescriptor.UpdateType(adr.SlotIndex, sourceType); // Re-create the identifier node *with the new type* newIdent := TAst.Identifier(newIdent.AsIdentifier.Name, adr, sourceType); targetType := sourceType; end; - // 5. Create the new Assignment node + // 7. Create the new Assignment node Result := TAst.Assign(newIdent.AsIdentifier, newValue, targetType); end; @@ -255,15 +310,28 @@ end; function TTypeChecker.VisitFunctionCall(const Node: IFunctionCallNode): IAstNode; var calleeType, retType: IStaticType; - i: Integer; + i, j: Integer; newCallee: IAstNode; newArgs: TArray; + argTypes: TArray; + hasUnknownArgs: Boolean; + bestSig: IMethodSignature; + sig: IMethodSignature; + match: Boolean; begin // 1. Visit children first (bottom-up) newCallee := Accept(Node.Callee); SetLength(newArgs, Length(Node.Arguments)); + SetLength(argTypes, Length(Node.Arguments)); + + hasUnknownArgs := False; for i := 0 to High(Node.Arguments) do + begin newArgs[i] := Accept(Node.Arguments[i]); + argTypes[i] := newArgs[i].AsTypedNode.StaticType; + if argTypes[i].Kind = stUnknown then + hasUnknownArgs := True; + end; // 2. Get callee type (now inferred) calleeType := newCallee.AsTypedNode.StaticType; @@ -272,24 +340,58 @@ begin // 3. Perform type checking if calleeType.Kind = TStaticTypeKind.stMethod then begin - var signature := calleeType.Signature; - if Length(newArgs) <> Length(signature.ParamTypes) then - raise ETypeException.CreateFmt('Function expects %d arguments, but got %d', [Length(signature.ParamTypes), Length(newArgs)]); - - retType := signature.ReturnType; - - // Check argument types - for i := 0 to High(newArgs) do + // If any argument is Unknown, we cannot resolve overloads. + // The return type remains Unknown. + if not hasUnknownArgs then begin - var argType := newArgs[i].AsTypedNode.StaticType; - var paramType := signature.ParamTypes[i]; - if not TTypeRules.CanAssign(paramType, argType) then + bestSig := nil; + for sig in calleeType.Signatures do + begin + // Check 1: Argument count + if Length(sig.ParamTypes) <> Length(argTypes) then + continue; + + // Check 2: Argument types (CanAssign) + match := True; + for j := 0 to High(argTypes) do + begin + if not TTypeRules.CanAssign(sig.ParamTypes[j], argTypes[j]) then + begin + match := False; + break; // This signature doesn't match + end; + end; + + // Check 3: Found first match + if match then + begin + // This is the "dumb" checker logic: first match wins. + // A "smarter" checker would find the *best* match. + bestSig := sig; + break; + end; + end; // for sig + + // Check 4: Handle results + if Assigned(bestSig) then + begin + retType := bestSig.ReturnType; + end + else + begin + // No signature matched, even with known types. This is an error. + var argsStr: string := ''; + for i := 0 to High(argTypes) do + argsStr := argsStr + argTypes[i].ToString + ' '; raise ETypeException - .CreateFmt('Cannot assign argument %d (type %s) to parameter (type %s)', [i, argType.ToString, paramType.ToString]); + .CreateFmt('No matching signature for call with args (%s) found on method %s', [argsStr, calleeType.ToString]); + end; end; + // else: hasUnknownArgs is True, so retType remains Unknown (as set in step 2) end else if calleeType.Kind <> TStaticTypeKind.stUnknown then raise ETypeException.CreateFmt('Cannot invoke type %s as a function.', [calleeType.ToString]); + // else: calleeType is Unknown (e.g. recursive call or unbound symbol), retType remains Unknown. // 4. Create the new (typed) call node using the factory Result := @@ -374,44 +476,6 @@ begin Result := TAst.TernaryExpr(newCond, newThen, newElse, resultType); end; -function TTypeChecker.VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode; -var - leftType, rightType, resultType: IStaticType; - newLeft, newRight: IAstNode; -begin - // 1. Visit children - newLeft := Accept(Node.Left); - newRight := Accept(Node.Right); - - // 2. Get types - leftType := newLeft.AsTypedNode.StaticType; - rightType := newRight.AsTypedNode.StaticType; - - // 3. Resolve - resultType := TTypeRules.ResolveBinaryOp(Node.Operator, leftType, rightType); - - // 4. Create new node - Result := TAst.BinaryExpr(newLeft, Node.Operator, newRight, resultType); -end; - -function TTypeChecker.VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode; -var - rightType, resultType: IStaticType; - newRight: IAstNode; -begin - // 1. Visit children - newRight := Accept(Node.Right); - - // 2. Get types - rightType := newRight.AsTypedNode.StaticType; - - // 3. Resolve - resultType := TTypeRules.ResolveUnaryOp(Node.Operator, rightType); - - // 4. Create new node - Result := TAst.UnaryExpr(Node.Operator, newRight, resultType); -end; - function TTypeChecker.VisitMemberAccess(const Node: IMemberAccessNode): IAstNode; var baseType, elemType: IStaticType; diff --git a/Src/AST/Myc.Ast.Debugger.pas b/Src/AST/Myc.Ast.Debugger.pas index e8565fc..8b639b8 100644 --- a/Src/AST/Myc.Ast.Debugger.pas +++ b/Src/AST/Myc.Ast.Debugger.pas @@ -36,8 +36,6 @@ type function VisitConstant(const Node: IConstantNode): TDataValue; override; function VisitIdentifier(const Node: IIdentifierNode): TDataValue; override; function VisitKeyword(const Node: IKeywordNode): TDataValue; override; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; override; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; override; function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; override; function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; override; function VisitBlockExpression(const Node: IBlockExpressionNode): TDataValue; override; @@ -84,7 +82,12 @@ end; function TDebugEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDataValue; begin - AppendLine('FunctionCall{'); + AppendLine( + 'FunctionCall (' + + (if Assigned(Node.StaticTarget) then 'STATIC' + else 'DYNAMIC') + + ' PATH) {' + ); Indent; try ShowScope; @@ -187,30 +190,6 @@ begin AppendLine(Format('Identifier "%s" -> %s', [Node.Name, Result.ToString])); end; -function TDebugEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; -begin - AppendLine(Format('BinaryExpr "%s" {', [Node.Operator.ToString])); - Indent; - try - Result := inherited VisitBinaryExpression(Node); - finally - Unindent; - end; - AppendLine(Format('} -> %s', [Result.ToString])); -end; - -function TDebugEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; -begin - AppendLine(Format('UnaryExpr "%s" {', [Node.Operator.ToString])); - Indent; - try - Result := inherited VisitUnaryExpression(Node); - finally - Unindent; - end; - AppendLine(Format('} -> %s', [Result.ToString])); -end; - function TDebugEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; begin AppendLine('IfExpr{'); diff --git a/Src/AST/Myc.Ast.Dumper.pas b/Src/AST/Myc.Ast.Dumper.pas index ba7e1bf..99db514 100644 --- a/Src/AST/Myc.Ast.Dumper.pas +++ b/Src/AST/Myc.Ast.Dumper.pas @@ -27,8 +27,9 @@ type FIndent: Integer; procedure Indent; procedure Unindent; - procedure Log(const Text: string); overload; - procedure LogFmt(const Fmt: string; const Args: array of const); overload; + // Updated Log methods to include the node for type dumping + procedure Log(const Text: string; const Node: IAstNode = nil); overload; + procedure LogFmt(const Fmt: string; const Args: array of const; const Node: IAstNode = nil); overload; function FormatAddress(const Addr: TResolvedAddress): string; protected @@ -36,8 +37,6 @@ type procedure VisitConstant(const Node: IConstantNode); override; procedure VisitIdentifier(const Node: IIdentifierNode); override; procedure VisitKeyword(const Node: IKeywordNode); override; - procedure VisitBinaryExpression(const Node: IBinaryExpressionNode); override; - procedure VisitUnaryExpression(const Node: IUnaryExpressionNode); override; procedure VisitIfExpression(const Node: IIfExpressionNode); override; procedure VisitTernaryExpression(const Node: ITernaryExpressionNode); override; procedure VisitLambdaExpression(const Node: ILambdaExpressionNode); override; @@ -72,7 +71,8 @@ type implementation uses - Myc.Data.Keyword; + Myc.Data.Keyword, + Myc.Ast.Types; // Added for IStaticType.ToString { TAstDumper } @@ -115,14 +115,32 @@ begin dec(FIndent, 2); end; -procedure TAstDumper.Log(const Text: string); +procedure TAstDumper.Log(const Text: string; const Node: IAstNode = nil); +var + typeStr: string; + typedNode: IAstTypedNode; + staticType: IStaticType; begin - FOutput.Add(StringOfChar(' ', FIndent) + Text); + typeStr := ''; + // Check if the node is typed + if Assigned(Node) and Node.IsTyped then + begin + typedNode := Node.AsTypedNode; + + staticType := typedNode.StaticType; + if Assigned(staticType) then + // Append the static type information + typeStr := Format(' ', [staticType.ToString]) + else + typeStr := ' '; + end; + FOutput.Add(StringOfChar(' ', FIndent) + Text + typeStr); end; -procedure TAstDumper.LogFmt(const Fmt: string; const Args: array of const); +procedure TAstDumper.LogFmt(const Fmt: string; const Args: array of const; const Node: IAstNode = nil); begin - Log(Format(Fmt, Args)); + // Pass the node to the base Log method + Log(Format(Fmt, Args), Node); end; function TAstDumper.FormatAddress(const Addr: TResolvedAddress): string; @@ -138,7 +156,7 @@ end; procedure TAstDumper.VisitConstant(const Node: IConstantNode); begin - LogFmt('Constant: %s', [Node.Value.ToString]); + LogFmt('Constant: %s', [Node.Value.ToString], Node); end; procedure TAstDumper.VisitIdentifier(const Node: IIdentifierNode); @@ -148,36 +166,19 @@ begin adr := Node.Address; if adr.Kind <> akUnresolved then - LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress(adr)]) + LogFmt('Identifier: %s -> %s', [Node.Name, FormatAddress(adr)], Node) else - LogFmt('Identifier: %s (unbound)', [Node.Name]); + LogFmt('Identifier: %s (unbound)', [Node.Name], Node); end; procedure TAstDumper.VisitKeyword(const Node: IKeywordNode); begin - LogFmt('Keyword: :%s', [Node.Value.Name]); -end; - -procedure TAstDumper.VisitBinaryExpression(const Node: IBinaryExpressionNode); -begin - LogFmt('BinaryExpression: %s', [Node.Operator.ToString]); - Indent; - Node.Left.Accept(Self); - Node.Right.Accept(Self); - Unindent; -end; - -procedure TAstDumper.VisitUnaryExpression(const Node: IUnaryExpressionNode); -begin - LogFmt('UnaryExpression: %s', [Node.Operator.ToString]); - Indent; - Node.Right.Accept(Self); - Unindent; + LogFmt('Keyword: :%s', [Node.Value.Name], Node); end; procedure TAstDumper.VisitIfExpression(const Node: IIfExpressionNode); begin - Log('IfExpression'); + Log('IfExpression', Node); Indent; Log('Condition:'); Node.Condition.Accept(Self); @@ -193,7 +194,7 @@ end; procedure TAstDumper.VisitTernaryExpression(const Node: ITernaryExpressionNode); begin - Log('TernaryExpression'); + Log('TernaryExpression', Node); Indent; Log('Condition:'); Node.Condition.Accept(Self); @@ -211,7 +212,7 @@ var begin if Assigned(Node.ScopeDescriptor) then begin - LogFmt('LambdaExpression (HasNested: %s)', [Node.HasNestedLambdas.ToString(TUseBoolStrs.True)]); + LogFmt('LambdaExpression (HasNested: %s)', [Node.HasNestedLambdas.ToString(TUseBoolStrs.True)], Node); Indent; Log('Parameters:'); @@ -242,7 +243,7 @@ begin end else begin - Log('LambdaExpression (unbound)'); + Log('LambdaExpression (unbound)', Node); Indent; Log('Parameters:'); Indent; @@ -258,8 +259,43 @@ end; procedure TAstDumper.VisitFunctionCall(const Node: IFunctionCallNode); var arg: IAstNode; + staticStatus: string; + sigStr: string; // Added + argTypes: TArray; + i: Integer; begin - LogFmt('FunctionCall (IsTailCall: %s)', [Node.IsTailCall.ToString(TUseBoolStrs.True)]); + sigStr := ''; // Default to empty + if Assigned(Node.StaticTarget) then + begin + staticStatus := 'Assigned'; + + // Reconstruct the signature from the available data + SetLength(argTypes, Length(Node.Arguments)); + for i := 0 to High(Node.Arguments) do + begin + if Node.Arguments[i].IsTyped then + argTypes[i] := Node.Arguments[i].AsTypedNode.StaticType.ToString + else + argTypes[i] := 'Untyped'; + end; + + // Node.StaticType holds the return type set by the Specializer + sigStr := Format(' ', [string.Join(', ', argTypes), Node.StaticType.ToString]); + end + else + begin + staticStatus := 'nil'; + end; + + LogFmt( + 'FunctionCall (IsTailCall: %s, StaticTarget: %s%s)', + [ + Node.IsTailCall.ToString(TUseBoolStrs.True), + staticStatus, + sigStr // Added the signature string + ], + Node + ); // Pass Node to LogFmt to append the Indent; Log('Callee:'); @@ -276,7 +312,7 @@ procedure TAstDumper.VisitMacroExpansionNode(const Node: IMacroExpansionNode); var arg: IAstNode; begin - Log('MacroExpansion'); + Log('MacroExpansion', Node); Indent; Log('Original Call:'); @@ -303,7 +339,7 @@ var arg: IAstNode; begin // 'recur' must be a tail call, which is enforced by the binder. - Log('Recur'); + Log('Recur', Node); Indent; LogFmt('Arguments (%d):', [Length(Node.Arguments)]); Indent; @@ -317,7 +353,7 @@ procedure TAstDumper.VisitBlockExpression(const Node: IBlockExpressionNode); var expr: IAstNode; begin - Log('BlockExpression'); + Log('BlockExpression', Node); Indent; for expr in Node.Expressions do expr.Accept(Self); @@ -326,7 +362,7 @@ end; procedure TAstDumper.VisitVariableDeclaration(const Node: IVariableDeclarationNode); begin - LogFmt('VariableDeclaration (IsBoxed: %s)', [Node.IsBoxed.ToString(TUseBoolStrs.True)]); + LogFmt('VariableDeclaration (IsBoxed: %s)', [Node.IsBoxed.ToString(TUseBoolStrs.True)], Node); Indent; Node.Identifier.Accept(Self); @@ -340,7 +376,7 @@ end; procedure TAstDumper.VisitAssignment(const Node: IAssignmentNode); begin - Log('Assignment'); + Log('Assignment', Node); Indent; Node.Identifier.Accept(Self); Log('Value:'); @@ -350,7 +386,7 @@ end; procedure TAstDumper.VisitMacroDefinition(const Node: IMacroDefinitionNode); begin - Log('MacroDefinition'); + Log('MacroDefinition', Node); // Macros are not IAstTypedNode Indent; Log('Name:'); @@ -374,7 +410,7 @@ end; procedure TAstDumper.VisitQuasiquote(const Node: IQuasiquoteNode); begin - Log('Quasiquote'); + Log('Quasiquote', Node); // Not IAstTypedNode Indent; Node.Expression.Accept(Self); Unindent; @@ -382,7 +418,7 @@ end; procedure TAstDumper.VisitUnquote(const Node: IUnquoteNode); begin - Log('Unquote'); + Log('Unquote', Node); // Not IAstTypedNode Indent; Node.Expression.Accept(Self); Unindent; @@ -390,7 +426,7 @@ end; procedure TAstDumper.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode); begin - Log('UnquoteSplicing'); + Log('UnquoteSplicing', Node); // Not IAstTypedNode Indent; Node.Expression.Accept(Self); Unindent; @@ -398,7 +434,7 @@ end; procedure TAstDumper.VisitIndexer(const Node: IIndexerNode); begin - Log('Indexer'); + Log('Indexer', Node); Indent; Log('Base:'); Node.Base.Accept(Self); @@ -409,7 +445,7 @@ end; procedure TAstDumper.VisitMemberAccess(const Node: IMemberAccessNode); begin - Log('MemberAccess'); + Log('MemberAccess', Node); Indent; Log('Base:'); Node.Base.Accept(Self); @@ -422,7 +458,7 @@ procedure TAstDumper.VisitRecordLiteral(const Node: IRecordLiteralNode); var field: TRecordFieldLiteral; begin - LogFmt('RecordLiteral (%d fields)', [Length(Node.Fields)]); + LogFmt('RecordLiteral (%d fields)', [Length(Node.Fields)], Node); Indent; for field in Node.Fields do begin @@ -436,12 +472,12 @@ end; procedure TAstDumper.VisitCreateSeries(const Node: ICreateSeriesNode); begin - LogFmt('CreateSeries: %s', [Node.Definition]); + LogFmt('CreateSeries: %s', [Node.Definition], Node); end; procedure TAstDumper.VisitAddSeriesItem(const Node: IAddSeriesItemNode); begin - Log('AddSeriesItem'); + Log('AddSeriesItem', Node); Indent; Log('Series:'); Node.Series.Accept(Self); @@ -457,12 +493,12 @@ end; procedure TAstDumper.VisitNop(const Node: INopNode); begin - Log('Nop'); + Log('Nop', Node); end; procedure TAstDumper.VisitSeriesLength(const Node: ISeriesLengthNode); begin - Log('SeriesLength'); + Log('SeriesLength', Node); Indent; Log('Series:'); Node.Series.Accept(Self); diff --git a/Src/AST/Myc.Ast.Environment.pas b/Src/AST/Myc.Ast.Environment.pas index 50ffa9c..87ecab0 100644 --- a/Src/AST/Myc.Ast.Environment.pas +++ b/Src/AST/Myc.Ast.Environment.pas @@ -6,15 +6,49 @@ uses System.SysUtils, System.Classes, System.Generics.Collections, + System.Generics.Defaults, Myc.Data.Value, Myc.Ast, Myc.Ast.Nodes, - Myc.Ast.Scope; + Myc.Ast.Scope, + Myc.Ast.RTL, + Myc.Ast.Types; type - IMacroRegistry = interface; // Forward - IEnvironment = interface; // Forward - IExecutionStrategy = interface; // Forward + IMacroRegistry = interface; + IEnvironment = interface; + IExecutionStrategy = interface; + IFunctionDefinitionRegistry = interface; + + // --- Monomorphization Cache Definitions --- + + // The key for the specialization cache. + // (Function Address/ID, [Argument Types]) + TMonoCacheKey = record + public + Address: TResolvedAddress; + ArgTypes: TArray; + constructor Create(const AAddress: TResolvedAddress; const AArgTypes: TArray); + end; + + // Comparer for the cache key + TMonoCacheKeyComparer = class(TEqualityComparer) + public + function Equals(const Left, Right: TMonoCacheKey): Boolean; override; + function GetHashCode(const Value: TMonoCacheKey): Integer; override; // Updated + end; + + // The cache dictionary itself. + // Verwendet den generischen TSpecializedMethod-Record aus Myc.Ast.Types + TMonomorphCache = TDictionary; + + // This record holds the executable function and its inferred static type. + TCompiledFunction = record + public + Func: TDataValue.TFunc; + StaticType: IStaticType; // The full static type of the compiled function (e.g., Method(Ord):Method():Ord) + constructor Create(const AFunc: TDataValue.TFunc; const AStaticType: IStaticType); + end; // Defines the Strategy for creating an Evaluator. IExecutionStrategy = interface @@ -33,25 +67,39 @@ type property Parent: IMacroRegistry read GetParent; end; + IFunctionDefinitionRegistry = interface + procedure Register(const Address: TResolvedAddress; const ADef: IFunctionDefinition); + function Resolve(const Address: TResolvedAddress): IFunctionDefinition; + end; + // Defines the central environment for compilation and execution. IEnvironment = interface {$region 'private'} function GetRootScope: IExecutionScope; function GetMacroRegistry: IMacroRegistry; + function GetMonomorphCache: TMonomorphCache; + function GetFunctionRegistry: IFunctionDefinitionRegistry; {$endregion} procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy); function ExpandMacros(const Node: IAstNode): IAstNode; - function Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; - function Lower(const Node: IAstNode): IAstNode; + function Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor; const AArgTypes: TArray = []): IAstNode; + function Specialize(const Node: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode; - function Compile(const ANode: IAstNode; const Params: TArray = []): TDataValue.TFunc; + function Compile( + const ANode: IAstNode; + const Params: TArray = []; + const AArgTypes: TArray = [] + ): TCompiledFunction; overload; + function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray = []): TCompiledFunction; overload; function CreateEnvironment: IEnvironment; property RootScope: IExecutionScope read GetRootScope; property MacroRegistry: IMacroRegistry read GetMacroRegistry; + property MonomorphCache: TMonomorphCache read GetMonomorphCache; + property FunctionRegistry: IFunctionDefinitionRegistry read GetFunctionRegistry; end; // Interface Helper for IEnvironment @@ -63,7 +111,8 @@ type public constructor Create(const AEnvironment: IEnvironment); - class operator Initialize(out Dest: TAstEnvironment); + class function Construct(const Scope: IExecutionScope): TAstEnvironment; static; + class operator Implicit(const A: IEnvironment): TAstEnvironment; class operator Implicit(const A: TAstEnvironment): IEnvironment; @@ -73,7 +122,12 @@ type procedure SetDebugMode(ALog: TStrings; AShowScope: Boolean); function Run(const ANode: IAstNode; const Params: TArray = []; const Args: TArray = []): TDataValue; - function Compile(const ANode: IAstNode; const Params: TArray = []): TDataValue.TFunc; + function Compile( + const Node: IAstNode; + const Params: TArray = []; + const ArgTypes: TArray = [] + ): TCompiledFunction; overload; experimental; + function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray = []): TCompiledFunction; overload; procedure Define(const Name: String; const AScript: IAstNode); @@ -85,15 +139,83 @@ type implementation uses - Myc.Ast.RTL, + System.Hash, Myc.Ast.Evaluator, Myc.Ast.Debugger, Myc.Ast.Compiler.Macros, Myc.Ast.Compiler.Binder, Myc.Ast.Compiler.TypeChecker, - Myc.Ast.Compiler.Lowering, + Myc.Ast.Compiler.Specializer, Myc.Ast.Compiler.TCO; +{ TMonoCacheKey } + +constructor TMonoCacheKey.Create(const AAddress: TResolvedAddress; const AArgTypes: TArray); +begin + Address := AAddress; + ArgTypes := AArgTypes; +end; + +{ TMonoCacheKeyComparer } + +function TMonoCacheKeyComparer.Equals(const Left, Right: TMonoCacheKey): Boolean; +var + i: Integer; +begin + if not (Left.Address = Right.Address) then // Use operator = + exit(False); + + if Length(Left.ArgTypes) <> Length(Right.ArgTypes) then + exit(False); + + // Compare types + for i := 0 to High(Left.ArgTypes) do + begin + if not Left.ArgTypes[i].IsEqual(Right.ArgTypes[i]) then + exit(False); + end; + + Result := True; +end; + +function TMonoCacheKeyComparer.GetHashCode(const Value: TMonoCacheKey): Integer; +var + i: Integer; + hash: Integer; + typeHash: Integer; // Changed from ptrHash + adr: TResolvedAddress; +begin + adr := Value.Address; + + // 1. Hash the TResolvedAddress components + hash := THashBobJenkins.GetHashValue(adr.Kind, SizeOf(TAddressKind), 0); + hash := THashBobJenkins.GetHashValue(adr.ScopeDepth, SizeOf(Integer), hash); + hash := THashBobJenkins.GetHashValue(adr.SlotIndex, SizeOf(Integer), hash); + + // 2. Iteratively combine the hash of each argument type + for i := 0 to High(Value.ArgTypes) do + begin + // Get the hash code from the type itself (consistent with IsEqual) + if Assigned(Value.ArgTypes[i]) then + typeHash := Value.ArgTypes[i].GetHashCode + else + typeHash := 0; + + // Combine the new hash (typeHash) with the existing hash (hash) + hash := THashBobJenkins.GetHashValue(typeHash, SizeOf(Integer), hash); + end; + + Result := hash; +end; + +{ TCompiledFunction } + +constructor TCompiledFunction.Create(const AFunc: TDataValue.TFunc; const AStaticType: IStaticType); +begin + Func := AFunc; + StaticType := AStaticType; +end; + type { TStandardExecutionStrategy } TStandardExecutionStrategy = class(TInterfacedObject, IExecutionStrategy) @@ -125,14 +247,28 @@ type function CreateChildRegistry: IMacroRegistry; end; + TFunctionDefinitionRegistry = class(TInterfacedObject, IFunctionDefinitionRegistry) + private + FMap: TDictionary; + public + constructor Create; + destructor Destroy; override; + procedure Register(const Address: TResolvedAddress; const ADef: IFunctionDefinition); + function Resolve(const Address: TResolvedAddress): IFunctionDefinition; + end; + { TEnvironment } TEnvironment = class(TInterfacedObject, IEnvironment) private FRootScope: IExecutionScope; FMacroRegistry: IMacroRegistry; FExecutionStrategy: IExecutionStrategy; + FMonomorphCache: TMonomorphCache; + FFunctionRegistry: IFunctionDefinitionRegistry; function GetRootScope: IExecutionScope; function GetMacroRegistry: IMacroRegistry; + function GetMonomorphCache: TMonomorphCache; + function GetFunctionRegistry: IFunctionDefinitionRegistry; public constructor Create( const ARootScope: IExecutionScope; @@ -146,22 +282,17 @@ type procedure SetExecutionStrategy(const AStrategy: IExecutionStrategy); function ExpandMacros(const Node: IAstNode): IAstNode; - function Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; - function Lower(const Node: IAstNode): IAstNode; + function Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor; const ArgTypes: TArray): IAstNode; + function Specialize(const Node: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode; - function Compile(const Node: IAstNode; const Params: TArray): TDataValue.TFunc; + function Compile( + const Node: IAstNode; + const Params: TArray; + const ArgTypes: TArray + ): TCompiledFunction; overload; + function Compile(const Node: IFunctionDefinition; const ArgTypes: TArray): TCompiledFunction; overload; end; -// --- Factory Implementations --- - -{ TAstEnvironment } - -class operator TAstEnvironment.Initialize(out Dest: TAstEnvironment); -begin - Dest.FEnvironment := - TEnvironment.Create(TScope.CreateScope(nil, nil, nil), TMacroRegistryImpl.Create(nil), TStandardExecutionStrategy.Create); -end; - constructor TAstEnvironment.Create(const AEnvironment: IEnvironment); begin FEnvironment := AEnvironment; @@ -187,9 +318,36 @@ begin Result := A.FEnvironment; end; -function TAstEnvironment.Compile(const ANode: IAstNode; const Params: TArray = []): TDataValue.TFunc; +function TAstEnvironment.Compile( + const Node: IAstNode; + const Params: TArray = []; + const ArgTypes: TArray = [] +): TCompiledFunction; begin - Result := FEnvironment.Compile(ANode, Params); + Result := FEnvironment.Compile(Node, Params, ArgTypes); +end; + +function TAstEnvironment.Compile(const Node: IFunctionDefinition; const ArgTypes: TArray = []): TCompiledFunction; +begin + Result := FEnvironment.Compile(Node, ArgTypes); +end; + +class function TAstEnvironment.Construct(const Scope: IExecutionScope): TAstEnvironment; +var + RootScope: IExecutionScope; +begin + // When constructing the *very first* environment: + // 1. Create a root scope (parented to nil). + // 2. Explicitly request library registration (ARegisterLibraries = True). + RootScope := TAst.CreateScope(nil, nil, True); + + Result.Create( + TEnvironment.Create( + RootScope, // Use the new root scope + TMacroRegistryImpl.Create(nil), + TStandardExecutionStrategy.Create + ) + ); end; function TAstEnvironment.CreateEnvironment: TAstEnvironment; @@ -199,8 +357,8 @@ end; procedure TAstEnvironment.Define(const Name: String; const AScript: IAstNode); begin - var exec := Compile(AScript); - RootScope.Define(Name, exec([])); + var compiled := Compile(AScript); + RootScope.Define(Name, compiled.Func([])); end; function TAstEnvironment.GetRootScope: IExecutionScope; @@ -219,8 +377,8 @@ function TAstEnvironment.Run( const Args: TArray = [] ): TDataValue; begin - var exec := Compile(ANode, Params); - Result := exec(Args); + var compiled := Compile(ANode, Params); + Result := compiled.Func(Args); end; { TStandardExecutionStrategy } @@ -288,6 +446,31 @@ begin Result := TMacroRegistryImpl.Create(Self); end; +{ TFunctionDefinitionRegistry } + +constructor TFunctionDefinitionRegistry.Create; +begin + inherited Create; + // We can use the comparer from Myc.Ast.Scope + FMap := TDictionary.Create(TResolvedAddressComparer.Create); +end; + +destructor TFunctionDefinitionRegistry.Destroy; +begin + FMap.Free; + inherited Destroy; +end; + +procedure TFunctionDefinitionRegistry.Register(const Address: TResolvedAddress; const ADef: IFunctionDefinition); +begin + FMap.AddOrSetValue(Address, ADef); +end; + +function TFunctionDefinitionRegistry.Resolve(const Address: TResolvedAddress): IFunctionDefinition; +begin + FMap.TryGetValue(Address, Result); +end; + { TEnvironment } constructor TEnvironment.Create( @@ -300,16 +483,25 @@ begin FRootScope := ARootScope; FMacroRegistry := AMacroRegistry; FExecutionStrategy := AExecutionStrategy; + // Create the isolated, instance-specific cache + FMonomorphCache := TMonomorphCache.Create(TMonoCacheKeyComparer.Create); + FFunctionRegistry := TFunctionDefinitionRegistry.Create; end; destructor TEnvironment.Destroy; begin + FMonomorphCache.Free; inherited Destroy; end; -function TEnvironment.Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor): IAstNode; +function TEnvironment.GetMonomorphCache: TMonomorphCache; begin - var boundAst := TAstBinder.Bind(FRootScope.CreateDescriptor, Node, Descriptor); + Result := FMonomorphCache; +end; + +function TEnvironment.Bind(const Node: IAstNode; out Descriptor: IScopeDescriptor; const ArgTypes: TArray): IAstNode; +begin + var boundAst := TAstBinder.Bind(FRootScope.CreateDescriptor, Node, Descriptor, FFunctionRegistry, ArgTypes); var typedAst := TTypeChecker.CheckTypes(boundAst, Descriptor); Result := typedAst; @@ -332,31 +524,69 @@ end; function TEnvironment.CreateEnvironment: IEnvironment; begin - Result := TEnvironment.Create(TScope.CreateScope(FRootScope, nil, nil), TMacroRegistryImpl.Create(FMacroRegistry), FExecutionStrategy); + // Create a new child environment. It inherits the parent scope (FRootScope) and does *not* re-register the RTL. + Result := TEnvironment.Create(TAst.CreateScope(FRootScope), TMacroRegistryImpl.Create(FMacroRegistry), FExecutionStrategy); end; -function TEnvironment.Compile(const Node: IAstNode; const Params: TArray): TDataValue.TFunc; +function TEnvironment.Compile( + const Node: IAstNode; + const Params: TArray; + const ArgTypes: TArray +): TCompiledFunction; var desc: IScopeDescriptor; + funcType: IStaticType; + finalFunc: TDataValue.TFunc; begin var prg := TAst.LambdaExpr(Params, Node); var expanded := ExpandMacros(prg); - var bound := Bind(expanded, desc); - var lowered := Lower(bound); + var bound := Bind(expanded, desc, ArgTypes); - var tcoOptimized := TAstTCO.Optimize(lowered); + Assert(bound.IsTyped); + funcType := bound.AsTypedNode.StaticType; + + var specialized := Specialize(bound, desc); + var tcoOptimized := TAstTCO.Optimize(specialized); var visitor := FExecutionStrategy.CreateVisitor(desc.CreateScope(FRootScope)); - var func := tcoOptimized.Accept(visitor).AsMethod; - Result := + finalFunc := function(const Args: TArray): TDataValue begin Result := func(Args); TEvaluatorVisitor.HandleTCO(Result); end; + + Result := TCompiledFunction.Create(finalFunc, funcType); +end; + +function TEnvironment.Compile(const Node: IFunctionDefinition; const ArgTypes: TArray): TCompiledFunction; +var + desc: IScopeDescriptor; + funcType: IStaticType; + finalFunc: TDataValue.TFunc; +begin + var expanded := ExpandMacros(Node); + var bound := Bind(expanded, desc, ArgTypes); + + funcType := bound.AsTypedNode.StaticType; + + var specialized := Specialize(bound, desc); + var tcoOptimized := TAstTCO.Optimize(specialized); + + var visitor := FExecutionStrategy.CreateVisitor(desc.CreateScope(FRootScope)); + var func := tcoOptimized.Accept(visitor).AsMethod; + + finalFunc := + function(const Args: TArray): TDataValue + begin + Result := func(Args); + TEvaluatorVisitor.HandleTCO(Result); + end; + + Result := TCompiledFunction.Create(finalFunc, funcType); end; function TEnvironment.ExpandMacros(const Node: IAstNode): IAstNode; @@ -371,9 +601,15 @@ begin ); end; -function TEnvironment.Lower(const Node: IAstNode): IAstNode; +function TEnvironment.GetFunctionRegistry: IFunctionDefinitionRegistry; begin - Result := TAstLowerer.Lower(Node); + Result := FFunctionRegistry; +end; + +function TEnvironment.Specialize(const Node: IAstNode; const ADescriptor: IScopeDescriptor): IAstNode; +begin + // Call the new Specializer, passing the environment for cache access + Result := TStaticSpecializer.Specialize(Self, Node, ADescriptor); end; end. diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 6908fbc..1bb557e 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -25,8 +25,6 @@ type function VisitConstant(const Node: IConstantNode): TDataValue; virtual; function VisitIdentifier(const Node: IIdentifierNode): TDataValue; virtual; function VisitKeyword(const Node: IKeywordNode): TDataValue; virtual; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; virtual; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; virtual; function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; virtual; function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; virtual; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; virtual; @@ -270,27 +268,54 @@ function TEvaluatorVisitor.VisitFunctionCall(const Node: IFunctionCallNode): TDa var calleeValue: TDataValue; argValues: TArray; + i: Integer; + argNodes: TArray; begin - calleeValue := Node.Callee.Accept(Self); - if calleeValue.Kind <> vkMethod then - raise EArgumentException.Create('Expression is not invokable in this context.'); - - var argNodes := Node.Arguments; - SetLength(argValues, Length(argNodes)); - for var i := 0 to High(argNodes) do - argValues[i] := argNodes[i].Accept(Self); - - if Node.IsTailCall then + if Assigned(Node.StaticTarget) then begin - // This is a tail call. Return a thunk to be processed by the trampoline. - Result := TDataValue.FromGeneric(TThunk.Create(calleeValue, argValues, false)); + // --- Static Path (Optimized) --- + // 1. Evaluate arguments + argNodes := Node.Arguments; + SetLength(argValues, Length(argNodes)); + for i := 0 to High(argNodes) do + begin + Assert(argNodes[i].IsTyped and (argNodes[i].AsTypedNode.StaticType <> TTypes.Unknown), 'Static call argument is not typed.'); + argValues[i] := argNodes[i].Accept(Self); + end; + + // 2. Call the static target directly + // The target is a TDataValue.TFunc expecting TArray + Result := Node.StaticTarget(argValues); + + // 3. Handle TCO + // If the static target itself was a compiled lambda ending in 'recur', + // it will return a Thunk, which we must handle. + HandleTCO(Result); end else begin - // This is a non-tail call. It must execute the call and act as the trampoline. - Result := (calleeValue.AsMethod)(argValues); + // --- Dynamic Path (Default) --- + calleeValue := Node.Callee.Accept(Self); + if calleeValue.Kind <> vkMethod then + raise EArgumentException.Create('Expression is not invokable in this context.'); - HandleTCO(Result); + argNodes := Node.Arguments; + SetLength(argValues, Length(argNodes)); + for i := 0 to High(argNodes) do + argValues[i] := argNodes[i].Accept(Self); + + if Node.IsTailCall then + begin + // This is a tail call. Return a thunk to be processed by the trampoline. + Result := TDataValue.FromGeneric(TThunk.Create(calleeValue, argValues, false)); + end + else + begin + // This is a non-tail call. It must execute the call and act as the trampoline. + Result := (calleeValue.AsMethod)(argValues); + + HandleTCO(Result); + end; end; end; @@ -558,43 +583,6 @@ begin end; end; -function TEvaluatorVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; -var - leftValue, rightValue: TDataValue; - resScalar: TScalar; -begin - leftValue := Node.Left.Accept(Self); - rightValue := Node.Right.Accept(Self); - - // Standard scalar operations - if (leftValue.Kind <> vkScalar) or (rightValue.Kind <> vkScalar) then - raise ENotSupportedException.Create('Binary operations are only supported for scalar types.'); - - if not TScalar.TryBinaryOperation(Node.Operator, leftValue.AsScalar, rightValue.AsScalar, resScalar) then - raise ENotSupportedException.Create( - 'Binary operation not supported for scalar types ' - + leftValue.AsScalar.Kind.ToString - + ' and ' - + rightValue.AsScalar.Kind.ToString - + ' .'); - Result := TDataValue(resScalar); // Explicit cast -end; - -function TEvaluatorVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; -var - rightValue: TDataValue; -begin - rightValue := Node.Right.Accept(Self); - - if rightValue.Kind <> vkScalar then - raise ENotSupportedException.Create('Unary operations are only supported for scalar types.'); - - var res: TScalar; - if not TScalar.TryUnaryOperation(Node.Operator, rightValue.AsScalar, res) then - raise ENotSupportedException.Create('Unary operation not supported for scalar type' + rightValue.AsScalar.Kind.ToString + '.'); - Result := TDataValue(res); // Explicit cast -end; - function TEvaluatorVisitor.VisitIfExpression(const Node: IIfExpressionNode): TDataValue; begin if IsTruthy(Node.Condition.Accept(Self)) then diff --git a/Src/AST/Myc.Ast.JSON.pas b/Src/AST/Myc.Ast.JSON.pas index c6d2f46..ebb259f 100644 --- a/Src/AST/Myc.Ast.JSON.pas +++ b/Src/AST/Myc.Ast.JSON.pas @@ -30,8 +30,6 @@ type function JsonToConstantNode(const AObj: TJSONObject): IConstantNode; function JsonToIdentifierNode(const AObj: TJSONObject): IIdentifierNode; function JsonToKeywordNode(const AObj: TJSONObject): IKeywordNode; - function JsonToBinaryExprNode(const AObj: TJSONObject): IBinaryExpressionNode; - function JsonToUnaryExprNode(const AObj: TJSONObject): IUnaryExpressionNode; function JsonToIfExprNode(const AObj: TJSONObject): IIfExpressionNode; function JsonToTernaryExprNode(const AObj: TJSONObject): ITernaryExpressionNode; function JsonToLambdaExprNode(const AObj: TJSONObject): ILambdaExpressionNode; @@ -58,8 +56,6 @@ type function VisitConstant(const Node: IConstantNode): TJSONObject; override; function VisitIdentifier(const Node: IIdentifierNode): TJSONObject; override; function VisitKeyword(const Node: IKeywordNode): TJSONObject; override; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TJSONObject; override; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TJSONObject; override; function VisitIfExpression(const Node: IIfExpressionNode): TJSONObject; override; function VisitTernaryExpression(const Node: ITernaryExpressionNode): TJSONObject; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TJSONObject; override; @@ -162,32 +158,6 @@ begin Result.AddPair('Name', TJSONString.Create(Node.Value.Name)); end; -function TJsonAstConverter.VisitBinaryExpression(const Node: IBinaryExpressionNode): TJSONObject; -var - leftObj, rightObj: TJSONObject; -begin - leftObj := Accept(Node.Left); - rightObj := Accept(Node.Right); - - Result := TJSONObject.Create; - Result.AddPair('NodeType', TJSONString.Create('BinaryExpr')); - Result.AddPair('Operator', TJSONString.Create(Node.Operator.ToString)); - Result.AddPair('Left', leftObj); - Result.AddPair('Right', rightObj); -end; - -function TJsonAstConverter.VisitUnaryExpression(const Node: IUnaryExpressionNode): TJSONObject; -var - rightObj: TJSONObject; -begin - rightObj := Accept(Node.Right); - - Result := TJSONObject.Create; - Result.AddPair('NodeType', TJSONString.Create('UnaryExpr')); - Result.AddPair('Operator', TJSONString.Create(Node.Operator.ToString)); - Result.AddPair('Right', rightObj); -end; - function TJsonAstConverter.VisitIfExpression(const Node: IIfExpressionNode): TJSONObject; var condObj, thenObj, elseObj: TJSONObject; @@ -517,41 +487,6 @@ begin Result := TAst.Keyword(AObj.GetValue('Name')); end; -function TJsonAstConverter.JsonToBinaryExprNode(const AObj: TJSONObject): IBinaryExpressionNode; -var - opStr: string; - op: TScalar.TBinaryOp; - leftNode, rightNode: IAstNode; -begin - opStr := AObj.GetValue('Operator'); - for op := Low(TScalar.TBinaryOp) to High(TScalar.TBinaryOp) do - if SameText(op.ToString, opStr) then - begin - leftNode := JsonToNode(AObj.GetValue('Left')); - rightNode := JsonToNode(AObj.GetValue('Right')); - Result := TAst.BinaryExpr(leftNode, op, rightNode); - exit; - end; - raise EInvalidOpException.CreateFmt('Unknown binary operator "%s"', [opStr]); -end; - -function TJsonAstConverter.JsonToUnaryExprNode(const AObj: TJSONObject): IUnaryExpressionNode; -var - opStr: string; - op: TScalar.TUnaryOp; - rightNode: IAstNode; -begin - opStr := AObj.GetValue('Operator'); - for op := Low(TScalar.TUnaryOp) to High(TScalar.TUnaryOp) do - if SameText(op.ToString, opStr) then - begin - rightNode := JsonToNode(AObj.GetValue('Right')); - Result := TAst.UnaryExpr(op, rightNode); - exit; - end; - raise EInvalidOpException.CreateFmt('Unknown unary operator "%s"', [opStr]); -end; - function TJsonAstConverter.JsonToIfExprNode(const AObj: TJSONObject): IIfExpressionNode; var condNode, thenNode, elseNode: IAstNode; @@ -792,10 +727,6 @@ begin Result := JsonToIdentifierNode(obj) else if nodeType = 'Keyword' then Result := JsonToKeywordNode(obj) - else if nodeType = 'BinaryExpr' then - Result := JsonToBinaryExprNode(obj) - else if nodeType = 'UnaryExpr' then - Result := JsonToUnaryExprNode(obj) else if nodeType = 'IfExpr' then Result := JsonToIfExprNode(obj) else if nodeType = 'TernaryExpr' then diff --git a/Src/AST/Myc.Ast.Nodes.pas b/Src/AST/Myc.Ast.Nodes.pas index 36ad008..6fcbf1f 100644 --- a/Src/AST/Myc.Ast.Nodes.pas +++ b/Src/AST/Myc.Ast.Nodes.pas @@ -15,11 +15,10 @@ type // --- Forward Declarations to break cycles --- IAstVisitor = interface; IAstNode = interface; + IFunctionDefinition = interface; IIdentifierNode = interface; IConstantNode = interface; IKeywordNode = interface; - IBinaryExpressionNode = interface; - IUnaryExpressionNode = interface; IIfExpressionNode = interface; ITernaryExpressionNode = interface; ILambdaExpressionNode = interface; @@ -47,8 +46,6 @@ type akConstant, akIdentifier, akKeyword, - akBinaryExpression, - akUnaryExpression, akIfExpression, akTernaryExpression, akLambdaExpression, @@ -90,8 +87,6 @@ type function VisitConstant(const Node: IConstantNode): TDataValue; function VisitIdentifier(const Node: IIdentifierNode): TDataValue; function VisitKeyword(const Node: IKeywordNode): TDataValue; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; function VisitIfExpression(const Node: IIfExpressionNode): TDataValue; function VisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; function VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; @@ -124,8 +119,6 @@ type function AsConstant: IConstantNode; function AsIdentifier: IIdentifierNode; function AsKeyword: IKeywordNode; - function AsBinaryExpression: IBinaryExpressionNode; - function AsUnaryExpression: IUnaryExpressionNode; function AsIfExpression: IIfExpressionNode; function AsTernaryExpression: ITernaryExpressionNode; function AsLambdaExpression: ILambdaExpressionNode; @@ -160,6 +153,16 @@ type property StaticType: IStaticType read GetStaticType; end; + // The abstract definition of a callable function body + IFunctionDefinition = interface(IAstTypedNode) + {$region 'private'} + function GetBody: IAstNode; + function GetParameters: TArray; + {$endregion} + property Body: IAstNode read GetBody; + property Parameters: TArray read GetParameters; + end; + INopNode = interface(IAstTypedNode) // A placeholder node for the UI (e.g., drag target). end; @@ -190,26 +193,6 @@ type property Value: IKeyword read GetValue; end; - IBinaryExpressionNode = interface(IAstTypedNode) - {$region 'private'} - function GetLeft: IAstNode; - function GetOperator: TScalar.TBinaryOp; - function GetRight: IAstNode; - {$endregion} - property Left: IAstNode read GetLeft; - property Operator: TScalar.TBinaryOp read GetOperator; - property Right: IAstNode read GetRight; - end; - - IUnaryExpressionNode = interface(IAstTypedNode) - {$region 'private'} - function GetOperator: TScalar.TUnaryOp; - function GetRight: IAstNode; - {$endregion} - property Operator: TScalar.TUnaryOp read GetOperator; - property Right: IAstNode read GetRight; - end; - IIfExpressionNode = interface(IAstTypedNode) {$region 'private'} function GetCondition: IAstNode; @@ -232,7 +215,7 @@ type property ElseBranch: IAstNode read GetElseBranch; end; - ILambdaExpressionNode = interface(IAstTypedNode) + ILambdaExpressionNode = interface(IFunctionDefinition) {$region 'private'} function GetParameters: TArray; function GetBody: IAstNode; diff --git a/Src/AST/Myc.Ast.RTL.Core.pas b/Src/AST/Myc.Ast.RTL.Core.pas index 967fde9..4b0c577 100644 --- a/Src/AST/Myc.Ast.RTL.Core.pas +++ b/Src/AST/Myc.Ast.RTL.Core.pas @@ -12,68 +12,193 @@ type // Contains the "pure" native implementations. TRtlFunctions = record public - [TRtlFunction('+')] + // (* --- Dynamic Fallbacks --- *) + [TRtlExport('+')] class function Add(const Args: TArray): TDataValue; overload; static; - [TRtlFunction('-')] + [TRtlExport('-')] class function Subtract(const Args: TArray): TDataValue; static; - [TRtlFunction('*')] + [TRtlExport('*')] class function Multiply(const Args: TArray): TDataValue; static; - [TRtlFunction('/')] + [TRtlExport('/')] class function Divide(const Args: TArray): TDataValue; static; - [TRtlFunction('=')] + [TRtlExport('=')] class function Equal(const Args: TArray): TDataValue; static; - [TRtlFunction('<>')] + [TRtlExport('<>')] class function NotEqual(const Args: TArray): TDataValue; static; - [TRtlFunction('<')] + [TRtlExport('<')] class function LessThan(const Args: TArray): TDataValue; static; - [TRtlFunction('<=')] + [TRtlExport('<=')] class function LessThanOrEqual(const Args: TArray): TDataValue; static; - [TRtlFunction('>')] + [TRtlExport('>')] class function GreaterThan(const Args: TArray): TDataValue; static; - [TRtlFunction('>=')] + [TRtlExport('>=')] class function GreaterThanOrEqual(const Args: TArray): TDataValue; static; - [TRtlFunction('not')] + [TRtlExport('not')] class function LogicalNot(const Args: TArray): TDataValue; static; - [TRtlFunction('Abs')] + // (* Dynamic fallbacks for TScalar input *) + [TRtlExport('Abs')] class function Abs(const Arg: TScalar): TScalar; static; - [TRtlFunction('Trunc')] + [TRtlExport('Trunc')] class function Trunc(const Arg: TScalar): TScalar; static; - [TRtlFunction('Ceil')] + [TRtlExport('Ceil')] class function Ceil(const Arg: TScalar): TScalar; static; - [TRtlFunction('Floor')] + [TRtlExport('Floor')] class function Floor(const Arg: TScalar): TScalar; static; - [TRtlFunction('Sign')] + [TRtlExport('Sign')] class function Sign(const Arg: TScalar): TScalar; static; - [TRtlFunction('Memoize')] + // (* Other dynamic functions *) + [TRtlExport('Memoize')] class function Memoize(const Args: TArray): TDataValue; static; - [TRtlFunction('Map')] + [TRtlExport('Map')] class function Map(const Args: TArray): TDataValue; static; - [TRtlFunction('Reduce')] + [TRtlExport('Reduce')] class function Reduce(const Args: TArray): TDataValue; static; - [TRtlFunction('Where')] + [TRtlExport('Where')] class function Where(const Args: TArray): TDataValue; static; - [TRtlFunction('Any')] + [TRtlExport('Any')] class function Any(const Args: TArray): TDataValue; static; + + // (* --- Static Specializations (for Monomorphization) --- *) + // (* Schema: FunctionName_Arg1_ArgN_Return *) + + // Add + [TRtlExport('+', True)] + class function Add_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static; + [TRtlExport('+', True)] + class function Add_Float_Float_Float(A, B: Double): Double; static; + [TRtlExport('+', True)] + class function Add_Ordinal_Float_Float(A: Int64; B: Double): Double; static; + [TRtlExport('+', True)] + class function Add_Float_Ordinal_Float(A: Double; B: Int64): Double; static; + + // Subtract + [TRtlExport('-', True)] + class function Subtract_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static; + [TRtlExport('-', True)] + class function Subtract_Float_Float_Float(A, B: Double): Double; static; + [TRtlExport('-', True)] + class function Subtract_Ordinal_Float_Float(A: Int64; B: Double): Double; static; + [TRtlExport('-', True)] + class function Subtract_Float_Ordinal_Float(A: Double; B: Int64): Double; static; + + // Multiply + [TRtlExport('*', True)] + class function Multiply_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static; + [TRtlExport('*', True)] + class function Multiply_Float_Float_Float(A, B: Double): Double; static; + [TRtlExport('*', True)] + class function Multiply_Ordinal_Float_Float(A: Int64; B: Double): Double; static; + [TRtlExport('*', True)] + class function Multiply_Float_Ordinal_Float(A: Double; B: Int64): Double; static; + + // Divide (NOT pure due to DivByZero) + [TRtlExport('/')] + class function Divide_Ordinal_Ordinal_Float(A, B: Int64): Double; static; + [TRtlExport('/')] + class function Divide_Float_Float_Float(A, B: Double): Double; static; + [TRtlExport('/')] + class function Divide_Ordinal_Float_Float(A: Int64; B: Double): Double; static; + [TRtlExport('/')] + class function Divide_Float_Ordinal_Float(A: Double; B: Int64): Double; static; + + // Comparisons (Return Ordinal) + [TRtlExport('=', True)] + class function Equal_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static; + [TRtlExport('=', True)] + class function Equal_Float_Float_Ordinal(A, B: Double): Int64; static; + [TRtlExport('=', True)] + class function Equal_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static; + [TRtlExport('=', True)] + class function Equal_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static; + [TRtlExport('=', True)] + class function Equal_Keyword_Keyword_Ordinal(A, B: Int64): Int64; static; + + [TRtlExport('<>', True)] + class function NotEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static; + [TRtlExport('<>', True)] + class function NotEqual_Float_Float_Ordinal(A, B: Double): Int64; static; + [TRtlExport('<>', True)] + class function NotEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static; + [TRtlExport('<>', True)] + class function NotEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static; + [TRtlExport('<>', True)] + class function NotEqual_Keyword_Keyword_Ordinal(A, B: Int64): Int64; static; + + [TRtlExport('<', True)] + class function Less_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static; + [TRtlExport('<', True)] + class function Less_Float_Float_Ordinal(A, B: Double): Int64; static; + [TRtlExport('<', True)] + class function Less_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static; + [TRtlExport('<', True)] + class function Less_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static; + + [TRtlExport('<=', True)] + class function LessOrEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static; + [TRtlExport('<=', True)] + class function LessOrEqual_Float_Float_Ordinal(A, B: Double): Int64; static; + [TRtlExport('<=', True)] + class function LessOrEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static; + [TRtlExport('<=', True)] + class function LessOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static; + + [TRtlExport('>', True)] + class function Greater_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static; + [TRtlExport('>', True)] + class function Greater_Float_Float_Ordinal(A, B: Double): Int64; static; + [TRtlExport('>', True)] + class function Greater_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static; + [TRtlExport('>', True)] + class function Greater_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static; + + [TRtlExport('>=', True)] + class function GreaterOrEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static; + [TRtlExport('>=', True)] + class function GreaterOrEqual_Float_Float_Ordinal(A, B: Double): Int64; static; + [TRtlExport('>=', True)] + class function GreaterOrEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; static; + [TRtlExport('>=', True)] + class function GreaterOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static; + + // Unary + [TRtlExport('-', True)] + class function Negate_Ordinal_Ordinal(A: Int64): Int64; static; + [TRtlExport('-', True)] + class function Negate_Float_Float(A: Double): Double; static; + + [TRtlExport('not', True)] + class function Not_Ordinal_Ordinal(A: Int64): Int64; static; + + // Standard functions + [TRtlExport('Abs', True)] + class function Abs_Ordinal_Ordinal(A: Int64): Int64; static; + [TRtlExport('Abs', True)] + class function Abs_Float_Float(A: Double): Double; static; + + [TRtlExport('Trunc', True)] + class function Trunc_Ordinal_Ordinal(A: Int64): Int64; static; + [TRtlExport('Trunc', True)] + class function Trunc_Float_Ordinal(A: Double): Int64; static; end; implementation @@ -456,4 +581,272 @@ begin Result := TScalar.FromInt64(0); end; +{ TRtlFunctions - Static Specializations } + +// --- Add --- +class function TRtlFunctions.Add_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; +begin + Result := A + B; +end; + +class function TRtlFunctions.Add_Float_Float_Float(A, B: Double): Double; +begin + Result := A + B; +end; + +class function TRtlFunctions.Add_Ordinal_Float_Float(A: Int64; B: Double): Double; +begin + Result := A + B; +end; + +class function TRtlFunctions.Add_Float_Ordinal_Float(A: Double; B: Int64): Double; +begin + Result := A + B; +end; + +// --- Subtract --- +class function TRtlFunctions.Subtract_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; +begin + Result := A - B; +end; + +class function TRtlFunctions.Subtract_Float_Float_Float(A, B: Double): Double; +begin + Result := A - B; +end; + +class function TRtlFunctions.Subtract_Ordinal_Float_Float(A: Int64; B: Double): Double; +begin + Result := A - B; +end; + +class function TRtlFunctions.Subtract_Float_Ordinal_Float(A: Double; B: Int64): Double; +begin + Result := A - B; +end; + +// --- Multiply --- +class function TRtlFunctions.Multiply_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; +begin + Result := A * B; +end; + +class function TRtlFunctions.Multiply_Float_Float_Float(A, B: Double): Double; +begin + Result := A * B; +end; + +class function TRtlFunctions.Multiply_Ordinal_Float_Float(A: Int64; B: Double): Double; +begin + Result := A * B; +end; + +class function TRtlFunctions.Multiply_Float_Ordinal_Float(A: Double; B: Int64): Double; +begin + Result := A * B; +end; + +// --- Divide --- +class function TRtlFunctions.Divide_Ordinal_Ordinal_Float(A, B: Int64): Double; +begin + if B = 0 then + raise EDivByZero.Create('Division by zero.'); + Result := A / B; +end; + +class function TRtlFunctions.Divide_Float_Float_Float(A, B: Double): Double; +begin + if B = 0.0 then + raise EDivByZero.Create('Division by zero.'); + Result := A / B; +end; + +class function TRtlFunctions.Divide_Ordinal_Float_Float(A: Int64; B: Double): Double; +begin + if B = 0.0 then + raise EDivByZero.Create('Division by zero.'); + Result := A / B; +end; + +class function TRtlFunctions.Divide_Float_Ordinal_Float(A: Double; B: Int64): Double; +begin + if B = 0 then + raise EDivByZero.Create('Division by zero.'); + Result := A / B; +end; + +// --- Comparisons --- +(* Delphi bools: 0=False, 1=True. We return Int64 (0 or 1) *) + +class function TRtlFunctions.Equal_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; +begin + Result := Ord(A = B); +end; + +class function TRtlFunctions.Equal_Float_Float_Ordinal(A, B: Double): Int64; +begin + Result := Ord(A = B); // Note: Standard float comparison +end; + +class function TRtlFunctions.Equal_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; +begin + Result := Ord(A = B); +end; + +class function TRtlFunctions.Equal_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; +begin + Result := Ord(A = B); +end; + +class function TRtlFunctions.Equal_Keyword_Keyword_Ordinal(A, B: Int64): Int64; +begin + // Keywords are passed as their Int64 index + Result := Ord(A = B); +end; + +class function TRtlFunctions.NotEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; +begin + Result := Ord(A <> B); +end; + +class function TRtlFunctions.NotEqual_Float_Float_Ordinal(A, B: Double): Int64; +begin + Result := Ord(A <> B); +end; + +class function TRtlFunctions.NotEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; +begin + Result := Ord(A <> B); +end; + +class function TRtlFunctions.NotEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; +begin + Result := Ord(A <> B); +end; + +class function TRtlFunctions.NotEqual_Keyword_Keyword_Ordinal(A, B: Int64): Int64; +begin + Result := Ord(A <> B); +end; + +class function TRtlFunctions.Less_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; +begin + Result := Ord(A < B); +end; + +class function TRtlFunctions.Less_Float_Float_Ordinal(A, B: Double): Int64; +begin + Result := Ord(A < B); +end; + +class function TRtlFunctions.Less_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; +begin + Result := Ord(A < B); +end; + +class function TRtlFunctions.Less_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; +begin + Result := Ord(A < B); +end; + +class function TRtlFunctions.LessOrEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; +begin + Result := Ord(A <= B); +end; + +class function TRtlFunctions.LessOrEqual_Float_Float_Ordinal(A, B: Double): Int64; +begin + Result := Ord(A <= B); +end; + +class function TRtlFunctions.LessOrEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; +begin + Result := Ord(A <= B); +end; + +class function TRtlFunctions.LessOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; +begin + Result := Ord(A <= B); +end; + +class function TRtlFunctions.Greater_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; +begin + Result := Ord(A > B); +end; + +class function TRtlFunctions.Greater_Float_Float_Ordinal(A, B: Double): Int64; +begin + Result := Ord(A > B); +end; + +class function TRtlFunctions.Greater_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; +begin + Result := Ord(A > B); +end; + +class function TRtlFunctions.Greater_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; +begin + Result := Ord(A > B); +end; + +class function TRtlFunctions.GreaterOrEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; +begin + Result := Ord(A >= B); +end; + +class function TRtlFunctions.GreaterOrEqual_Float_Float_Ordinal(A, B: Double): Int64; +begin + Result := Ord(A >= B); +end; + +class function TRtlFunctions.GreaterOrEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64; +begin + Result := Ord(A >= B); +end; + +class function TRtlFunctions.GreaterOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; +begin + Result := Ord(A >= B); +end; + +// --- Unary --- + +class function TRtlFunctions.Negate_Ordinal_Ordinal(A: Int64): Int64; +begin + Result := -A; +end; + +class function TRtlFunctions.Negate_Float_Float(A: Double): Double; +begin + Result := -A; +end; + +class function TRtlFunctions.Not_Ordinal_Ordinal(A: Int64): Int64; +begin + // Lisp-style 'not': 0 -> 1, everything else -> 0 + Result := Ord(A = 0); +end; + +// --- Standard functions --- + +class function TRtlFunctions.Abs_Ordinal_Ordinal(A: Int64): Int64; +begin + Result := System.Abs(A); +end; + +class function TRtlFunctions.Abs_Float_Float(A: Double): Double; +begin + Result := System.Abs(A); +end; + +class function TRtlFunctions.Trunc_Ordinal_Ordinal(A: Int64): Int64; +begin + Result := A; // No-op +end; + +class function TRtlFunctions.Trunc_Float_Ordinal(A: Double): Int64; +begin + Result := System.Trunc(A); +end; + end. diff --git a/Src/AST/Myc.Ast.RTL.pas b/Src/AST/Myc.Ast.RTL.pas index 434bec3..68c4959 100644 --- a/Src/AST/Myc.Ast.RTL.pas +++ b/Src/AST/Myc.Ast.RTL.pas @@ -7,19 +7,128 @@ interface uses System.SysUtils, + System.Generics.Collections, + System.Generics.Defaults, + System.Rtti, Myc.Data.Scalar, Myc.Data.Value, Myc.Ast, Myc.Ast.Scope, - Myc.Ast.Nodes; + Myc.Ast.Nodes, + Myc.Ast.Types; type - // This attribute is used by the RTTI-based registry to identify - // and register native functions in the runtime scope. - TRtlFunctionAttribute = class(TCustomAttribute) + // Defines the export parameters for a native RTL function. + TRtlExportAttribute = class(TCustomAttribute) public Name: string; - constructor Create(const AName: string); + IsPure: Boolean; + constructor Create(const AName: string); overload; + constructor Create(const AName: string; AIsPure: Boolean); overload; + end; + +// Defines the key for the static bootstrap cache. +type + TStaticSignatureKey = record + public + Name: string; + ArgTypes: TArray; + constructor Create(const AName: string; const AArgTypes: TArray); + end; + + // Comparer for the static signature key + TStaticSignatureKeyComparer = class(TEqualityComparer) + public + function Equals(const Left, Right: TStaticSignatureKey): Boolean; override; + function GetHashCode(const Value: TStaticSignatureKey): Integer; override; + end; + + TSpecializedMethod = record + public + Target: TDataValue.TFunc; + ReturnType: IStaticType; + constructor Create(const ATarget: TDataValue.TFunc; const AReturnType: IStaticType); + end; + + // The cache holding TDataValue.TFunc wrappers for static native functions. + // Verwendet den generischen TSpecializedMethod-Record aus Myc.Ast.Types + TStaticBootstrapCache = TDictionary; + + TRtlFunctionInfo = class + public + DynamicWrapper: TDataValue.TFunc; + Signatures: TList; + constructor Create; + destructor Destroy; override; + end; + + TRtlFunctionMap = TDictionary; + + //-------------------------------------------------------------------------------------------------- + //== Library Registration (RTTI-based) + //-------------------------------------------------------------------------------------------------- + + // A helper record to encapsulate the RTTI-based registration logic. + TRtlRegistry = record + type + // --- Static Wrapper Signatures --- + TNativeFunc_O_O = function(A: Int64): Int64; + TNativeFunc_F_F = function(A: Double): Double; + TNativeFunc_F_O = function(A: Double): Int64; + + TNativeFunc_OO_O = function(A, B: Int64): Int64; + TNativeFunc_OO_F = function(A, B: Int64): Double; + TNativeFunc_FF_F = function(A, B: Double): Double; + TNativeFunc_FF_O = function(A, B: Double): Int64; + TNativeFunc_OF_F = function(A: Int64; B: Double): Double; + TNativeFunc_OF_O = function(A: Int64; B: Double): Int64; + TNativeFunc_FO_F = function(A: Double; B: Int64): Double; + TNativeFunc_FO_O = function(A: Double; B: Int64): Int64; + + private + class var + FStaticBootstrap: TStaticBootstrapCache; + class var + FStaticFuncMap: TRtlFunctionMap; + class constructor Create; + class destructor Destroy; + + // --- Wrapper Creation Helpers --- + class function CreateWrapper_O_O(CodeAddress: Pointer): TDataValue.TFunc; static; + class function CreateWrapper_F_F(CodeAddress: Pointer): TDataValue.TFunc; static; + class function CreateWrapper_F_O(CodeAddress: Pointer): TDataValue.TFunc; static; + class function CreateWrapper_OO_O(CodeAddress: Pointer): TDataValue.TFunc; static; + class function CreateWrapper_OO_F(CodeAddress: Pointer): TDataValue.TFunc; static; + class function CreateWrapper_FF_F(CodeAddress: Pointer): TDataValue.TFunc; static; + class function CreateWrapper_FF_O(CodeAddress: Pointer): TDataValue.TFunc; static; + class function CreateWrapper_OF_F(CodeAddress: Pointer): TDataValue.TFunc; static; + class function CreateWrapper_OF_O(CodeAddress: Pointer): TDataValue.TFunc; static; + class function CreateWrapper_FO_F(CodeAddress: Pointer): TDataValue.TFunc; static; + class function CreateWrapper_FO_O(CodeAddress: Pointer): TDataValue.TFunc; static; + class function CreateStaticWrapper( + method: TRttiMethod; + retType: IStaticType; + argTypes: TArray; + rttiParams: TArray + ): TDataValue.TFunc; static; + + // --- RTTI Helpers --- + class function RttiTypeToStaticType(const AType: TRttiType): IStaticType; static; + class function ParseStaticSuffix( + const AMethodName: string; + out AArgTypes: TArray; + out AReturnType: IStaticType + ): Boolean; static; + + public + class procedure RegisterAll(const AScope: IExecutionScope); static; + // Public accessor for the TStaticSpecializer + class function GetStaticSpecialization(const AName: string; const AArgTypes: TArray): TSpecializedMethod; static; + class procedure RegisterStaticSpecialization( + const AName: string; + const AArgTypes: TArray; + const AMethod: TSpecializedMethod + ); static; end; procedure RegisterRtlFunctions(const AScope: IExecutionScope); @@ -27,152 +136,600 @@ procedure RegisterRtlFunctions(const AScope: IExecutionScope); implementation uses - System.Rtti, System.TypInfo, + System.Hash, + System.StrUtils, Myc.Ast.RTL.Core; +type + TNativeDataValueFunc = function(const Args: TArray): TDataValue; + TNativeScalarFunc = function(Arg: TScalar): TScalar; + //-------------------------------------------------------------------------------------------------- //== Native Function Implementation (Core Logic) //-------------------------------------------------------------------------------------------------- -constructor TRtlFunctionAttribute.Create(const AName: string); +constructor TRtlExportAttribute.Create(const AName: string); begin inherited Create; Self.Name := AName; + Self.IsPure := False; // Default to impure end; -//-------------------------------------------------------------------------------------------------- -//== Library Registration (RTTI-based) -//-------------------------------------------------------------------------------------------------- +constructor TRtlExportAttribute.Create(const AName: string; AIsPure: Boolean); +begin + inherited Create; + Self.Name := AName; + Self.IsPure := AIsPure; +end; -type - // Defines a pointer to the static class function signature for scalar->scalar functions. - TNativeScalarFunc = function(Arg: TScalar): TScalar; +{ TStaticSignatureKey } - // A helper record to encapsulate the RTTI-based registration logic. - TRtlRegistry = record - private - class function GetSingleNumericArg( - const AName: string; - const AArgs: TArray; - out AArg: TScalar - ): Boolean; static; inline; - public - class procedure RegisterAll(const AScope: IExecutionScope); static; +constructor TStaticSignatureKey.Create(const AName: string; const AArgTypes: TArray); +begin + Name := AName; + ArgTypes := AArgTypes; +end; + +{ TStaticSignatureKeyComparer } + +function TStaticSignatureKeyComparer.Equals(const Left, Right: TStaticSignatureKey): Boolean; +var + i: Integer; +begin + if Left.Name <> Right.Name then + exit(False); + if Length(Left.ArgTypes) <> Length(Right.ArgTypes) then + exit(False); + + // Compare types + for i := 0 to High(Left.ArgTypes) do + begin + if not Left.ArgTypes[i].IsEqual(Right.ArgTypes[i]) then + exit(False); end; -{ TRtlRegistry } - -class function TRtlRegistry.GetSingleNumericArg(const AName: string; const AArgs: TArray; out AArg: TScalar): Boolean; -begin - // This is the validation logic used by the generated wrappers. - if Length(AArgs) <> 1 then - raise EArgumentException.CreateFmt('%s requires exactly one argument.', [AName]); - if AArgs[0].Kind <> vkScalar then - raise EArgumentException.CreateFmt('%s requires a scalar argument.', [AName]); - - AArg := AArgs[0].AsScalar; - // The check for specific numeric kinds is no longer necessary, - // as TScalar can only be Ordinal or Float. Result := True; end; -// Main registration method. Uses RTTI to find and register all functions from TRtlFunctions. -class procedure TRtlRegistry.RegisterAll(const AScope: IExecutionScope); -type - TNativeDataValueFunc1 = function(const Args: TArray): TDataValue; +function TStaticSignatureKeyComparer.GetHashCode(const Value: TStaticSignatureKey): Integer; +var + i: Integer; + hash: Integer; + ptrHash: Integer; +begin + // 1. Hash the function name to get the initial value + hash := THashBobJenkins.GetHashValue(Value.Name); + + // 2. Iteratively combine the hash of each argument type + for i := 0 to High(Value.ArgTypes) do + begin + if Assigned(Value.ArgTypes[i]) then + ptrHash := Value.ArgTypes[i].GetHashCode + else + ptrHash := 0; + + hash := THashBobJenkins.GetHashValue(ptrHash, SizeOf(Integer), hash); + end; + + Result := hash; +end; + +{ TRtlFunctionInfo } + +constructor TRtlFunctionInfo.Create; +begin + inherited Create; + Signatures := TList.Create; + DynamicWrapper := nil; +end; + +destructor TRtlFunctionInfo.Destroy; +begin + Signatures.Free; + inherited Destroy; +end; + +{ TRtlRegistry } + +class constructor TRtlRegistry.Create; var ctx: TRttiContext; rtlType: TRttiType; method: TRttiMethod; attribute: TCustomAttribute; - rtlAttribute: TRtlFunctionAttribute; - param: TRttiParameter; - wrapper: TDataValue.TFunc; + exportAttr: TRtlExportAttribute; + rtlName: string; + argTypes: TArray; + retType: IStaticType; + methodRecord: TSpecializedMethod; + funcInfo: TRtlFunctionInfo; + rttiParams: TArray; + isDynamic: Boolean; + i: Integer; begin + // 1. Create global caches + FStaticBootstrap := TStaticBootstrapCache.Create(TStaticSignatureKeyComparer.Create); + FStaticFuncMap := TRtlFunctionMap.Create; + + // 2. Perform RTTI Scan (formerly Pass 1 of RegisterAll) ctx := TRttiContext.Create; try rtlType := ctx.GetType(TypeInfo(TRtlFunctions)); + for method in rtlType.GetMethods do begin - // Find functions marked with our custom attribute + if method.MethodKind <> mkClassFunction then + continue; + + exportAttr := nil; for attribute in method.GetAttributes do begin - if not (attribute is TRtlFunctionAttribute) then - continue; - - if method.MethodKind <> mkClassFunction then - continue; - - rtlAttribute := attribute as TRtlFunctionAttribute; - wrapper := nil; - - // --- Signature Dispatcher --- - // Decide which wrapper to generate based on the method signature. - if (Length(method.GetParameters) = 1) and (method.ReturnType.Handle = TypeInfo(TScalar)) then + if attribute is TRtlExportAttribute then begin - param := method.GetParameters[0]; - if param.ParamType.Handle = TypeInfo(TScalar) then - begin - // Signature matches: class function(Arg: TScalar): TScalar; - // Build a factory that captures the method's name and CodeAddress. - var wrapperFactory := - function(AName: string; CodeAddress: Pointer): TDataValue.TFunc - begin - Result := - function(const Args: TArray): TDataValue - var - argScalar: TScalar; - begin - GetSingleNumericArg(AName, Args, argScalar); - Result := TDataValue(TNativeScalarFunc(CodeAddress)(argScalar)); - end; - end; + exportAttr := attribute as TRtlExportAttribute; + break; + end; + end; - wrapper := wrapperFactory(rtlAttribute.Name, method.CodeAddress); + if not Assigned(exportAttr) then + continue; + + rtlName := exportAttr.Name; + + if not FStaticFuncMap.TryGetValue(rtlName, funcInfo) then + begin + funcInfo := TRtlFunctionInfo.Create; + FStaticFuncMap.Add(rtlName, funcInfo); + end; + + // Check Signature Type (Dynamic vs Static) + rttiParams := method.GetParameters; + isDynamic := + (Length(rttiParams) = 1) + and (method.ReturnType.Handle = TypeInfo(TDataValue)) + and (rttiParams[0].ParamType.Handle = TypeInfo(TArray)); + + if isDynamic then + begin + if Assigned(funcInfo.DynamicWrapper) and Assigned(funcInfo.DynamicWrapper) then + raise EInvalidOpException.CreateFmt('Duplicate dynamic fallback defined for %s', [rtlName]); + + var wrapperFactory := + function(CodeAddress: Pointer): TDataValue.TFunc + begin + Result := + function(const Args: TArray): TDataValue + begin + Result := TNativeDataValueFunc(CodeAddress)(Args); + end; end; - end - else if (Length(method.GetParameters) = 1) and (method.ReturnType.Handle = TypeInfo(TDataValue)) then + funcInfo.DynamicWrapper := wrapperFactory(method.CodeAddress); + end + else + begin + // This is a STATIC SPECIALIZATION + if not ParseStaticSuffix(method.Name, argTypes, retType) then begin - param := method.GetParameters[0]; - if (pfConst in param.Flags) and (param.ParamType.Handle = TypeInfo(TArray)) then - begin - // Signature matches: class function(const Args: TArray): TDataValue; - // Build a factory that captures the method's CodeAddress. - var wrapperFactory := - function(CodeAddress: Pointer): TDataValue.TFunc - begin - Result := - function(const Args: TArray): TDataValue - begin - Result := TNativeDataValueFunc1(CodeAddress)(Args); - end; - end; - - // Create the wrapper - wrapper := wrapperFactory(method.CodeAddress); - end; + SetLength(argTypes, Length(rttiParams)); + for i := 0 to High(rttiParams) do + argTypes[i] := RttiTypeToStaticType(rttiParams[i].ParamType); + retType := RttiTypeToStaticType(method.ReturnType); end; + var sig := TMethodSignature.Create(argTypes, retType); + funcInfo.Signatures.Add(sig); + + var wrapper := CreateStaticWrapper(method, retType, argTypes, rttiParams); if Assigned(wrapper) then begin - AScope.Define(rtlAttribute.Name, TDataValue(wrapper)); - break; // Found our attribute, proceed to next method + methodRecord := TSpecializedMethod.Create(wrapper, retType); + // Use renamed static helper + RegisterStaticSpecialization(rtlName, argTypes, methodRecord); end else - raise ENotImplemented.CreateFmt('Native method wrapper for %s() not implemented', [method.Name]); + raise ENotImplemented.CreateFmt('Static native method wrapper for %s() not implemented', [method.Name]); end; end; + finally ctx.Free; end; end; +class destructor TRtlRegistry.Destroy; +var + funcInfo: TRtlFunctionInfo; +begin + for funcInfo in FStaticFuncMap.Values do + funcInfo.Free; + FStaticFuncMap.Free; + + FStaticBootstrap.Free; +end; + +class function TRtlRegistry.GetStaticSpecialization(const AName: string; const AArgTypes: TArray): TSpecializedMethod; +var + key: TStaticSignatureKey; +begin + key.Name := AName; + key.ArgTypes := AArgTypes; + FStaticBootstrap.TryGetValue(key, Result); +end; + +class procedure TRtlRegistry.RegisterStaticSpecialization( + const AName: string; + const AArgTypes: TArray; + const AMethod: TSpecializedMethod +); +var + key: TStaticSignatureKey; +begin + key := TStaticSignatureKey.Create(AName, AArgTypes); + // This allows multiple RTTI scans (e.g. in tests) without crashing, + // though only the class constructor should call this now. + FStaticBootstrap.AddOrSetValue(key, AMethod); +end; + +class function TRtlRegistry.RttiTypeToStaticType(const AType: TRttiType): IStaticType; +begin + if not Assigned(AType) then + exit(TTypes.Unknown); + + if AType.Handle = TypeInfo(Int64) then + Result := TTypes.Ordinal + else if AType.Handle = TypeInfo(Double) then + Result := TTypes.Float + else if AType.Handle = TypeInfo(string) then + Result := TTypes.Text + else if (AType.Handle = TypeInfo(TScalar)) or (AType.Handle = TypeInfo(TDataValue)) then + Result := TTypes.Unknown + else + Result := TTypes.Unknown; +end; + +class function TRtlRegistry.ParseStaticSuffix( + const AMethodName: string; + out AArgTypes: TArray; + out AReturnType: IStaticType +): Boolean; +var + parts: TArray; + i: Integer; + t: IStaticType; + + function ParseType(const S: string): IStaticType; + begin + if SameText(S, 'Ordinal') then + Result := TTypes.Ordinal + else if SameText(S, 'Float') then + Result := TTypes.Float + else if SameText(S, 'Keyword') then + Result := TTypes.Keyword + else + Result := TTypes.Unknown; + end; + +begin + Result := False; + AReturnType := TTypes.Unknown; + AArgTypes := nil; + + parts := AMethodName.Split(['_']); + + if Length(parts) < 2 then + exit; + + AReturnType := ParseType(parts[High(parts)]); + if AReturnType.Kind = stUnknown then + exit; + + SetLength(AArgTypes, Length(parts) - 2); + if Length(AArgTypes) = 0 then + begin + Result := True; + exit; + end; + + for i := 1 to High(parts) - 1 do + begin + t := ParseType(parts[i]); + if t.Kind = stUnknown then + begin + AArgTypes := nil; + AReturnType := TTypes.Unknown; + exit(False); + end; + AArgTypes[i - 1] := t; + end; + + Result := True; +end; + +class procedure TRtlRegistry.RegisterAll(const AScope: IExecutionScope); +var + rtlName: string; + funcInfo: TRtlFunctionInfo; + staticType: IStaticType; + pair: TPair; +begin + for pair in FStaticFuncMap do + begin + rtlName := pair.Key; + funcInfo := pair.Value; + + if funcInfo.Signatures.Count > 0 then + staticType := TTypes.CreateMethodSet(funcInfo.Signatures.ToArray) + else + staticType := nil; + + var wrapper := funcInfo.DynamicWrapper; // Default is Void + + AScope.Define(rtlName, wrapper, staticType); + end; +end; + +// --- Wrapper Generation --- + +class function TRtlRegistry.CreateWrapper_O_O(CodeAddress: Pointer): TDataValue.TFunc; +begin + Result := + function(const Args: TArray): TDataValue + var + A: Int64; + Res: Int64; + begin + A := Args[0].AsScalar.Value.AsInt64; + Res := TNativeFunc_O_O(CodeAddress)(A); + Result := TDataValue(TScalar.FromInt64(Res)); + end; +end; + +class function TRtlRegistry.CreateWrapper_F_F(CodeAddress: Pointer): TDataValue.TFunc; +begin + Result := + function(const Args: TArray): TDataValue + var + A: Double; + Res: Double; + begin + A := Args[0].AsScalar.Value.AsDouble; + Res := TNativeFunc_F_F(CodeAddress)(A); + Result := TDataValue(TScalar.FromDouble(Res)); + end; +end; + +class function TRtlRegistry.CreateWrapper_F_O(CodeAddress: Pointer): TDataValue.TFunc; +begin + Result := + function(const Args: TArray): TDataValue + var + A: Double; + Res: Int64; + begin + A := Args[0].AsScalar.Value.AsDouble; + Res := TNativeFunc_F_O(CodeAddress)(A); + Result := TDataValue(TScalar.FromInt64(Res)); + end; +end; + +class function TRtlRegistry.CreateWrapper_OO_O(CodeAddress: Pointer): TDataValue.TFunc; +begin + Result := + function(const Args: TArray): TDataValue + var + A, B, Res: Int64; + begin + A := Args[0].AsScalar.Value.AsInt64; + B := Args[1].AsScalar.Value.AsInt64; + Res := TNativeFunc_OO_O(CodeAddress)(A, B); + Result := TDataValue(TScalar.FromInt64(Res)); + end; +end; + +class function TRtlRegistry.CreateWrapper_OO_F(CodeAddress: Pointer): TDataValue.TFunc; +begin + Result := + function(const Args: TArray): TDataValue + var + A, B: Int64; + Res: Double; + begin + A := Args[0].AsScalar.Value.AsInt64; + B := Args[1].AsScalar.Value.AsInt64; + Res := TNativeFunc_OO_F(CodeAddress)(A, B); + Result := TDataValue(TScalar.FromDouble(Res)); + end; +end; + +class function TRtlRegistry.CreateWrapper_FF_F(CodeAddress: Pointer): TDataValue.TFunc; +begin + Result := + function(const Args: TArray): TDataValue + var + A, B, Res: Double; + begin + A := Args[0].AsScalar.Value.AsDouble; + B := Args[1].AsScalar.Value.AsDouble; + Res := TNativeFunc_FF_F(CodeAddress)(A, B); + Result := TDataValue(TScalar.FromDouble(Res)); + end; +end; + +class function TRtlRegistry.CreateWrapper_FF_O(CodeAddress: Pointer): TDataValue.TFunc; +begin + Result := + function(const Args: TArray): TDataValue + var + A, B: Double; + Res: Int64; + begin + A := Args[0].AsScalar.Value.AsDouble; + B := Args[1].AsScalar.Value.AsDouble; + Res := TNativeFunc_FF_O(CodeAddress)(A, B); + Result := TDataValue(TScalar.FromInt64(Res)); + end; +end; + +class function TRtlRegistry.CreateWrapper_OF_F(CodeAddress: Pointer): TDataValue.TFunc; +begin + Result := + function(const Args: TArray): TDataValue + var + A: Int64; + B: Double; + Res: Double; + begin + A := Args[0].AsScalar.Value.AsInt64; + B := Args[1].AsScalar.Value.AsDouble; + Res := TNativeFunc_OF_F(CodeAddress)(A, B); + Result := TDataValue(TScalar.FromDouble(Res)); + end; +end; + +class function TRtlRegistry.CreateWrapper_OF_O(CodeAddress: Pointer): TDataValue.TFunc; +begin + Result := + function(const Args: TArray): TDataValue + var + A: Int64; + B: Double; + Res: Int64; + begin + A := Args[0].AsScalar.Value.AsInt64; + B := Args[1].AsScalar.Value.AsDouble; + Res := TNativeFunc_OF_O(CodeAddress)(A, B); + Result := TDataValue(TScalar.FromInt64(Res)); + end; +end; + +class function TRtlRegistry.CreateWrapper_FO_F(CodeAddress: Pointer): TDataValue.TFunc; +begin + Result := + function(const Args: TArray): TDataValue + var + A: Double; + B: Int64; + Res: Double; + begin + A := Args[0].AsScalar.Value.AsDouble; + B := Args[1].AsScalar.Value.AsInt64; + Res := TNativeFunc_FO_F(CodeAddress)(A, B); + Result := TDataValue(TScalar.FromDouble(Res)); + end; +end; + +class function TRtlRegistry.CreateWrapper_FO_O(CodeAddress: Pointer): TDataValue.TFunc; +begin + Result := + function(const Args: TArray): TDataValue + var + A: Double; + B: Int64; + Res: Int64; + begin + A := Args[0].AsScalar.Value.AsDouble; + B := Args[1].AsScalar.Value.AsInt64; + Res := TNativeFunc_FO_O(CodeAddress)(A, B); + Result := TDataValue(TScalar.FromInt64(Res)); + end; +end; + +class function TRtlRegistry.CreateStaticWrapper( + method: TRttiMethod; + retType: IStaticType; + argTypes: TArray; + rttiParams: TArray +): TDataValue.TFunc; +var + ptr: Pointer; +begin + Result := nil; + ptr := method.CodeAddress; + + // --- 1-Argument Functions --- + if Length(argTypes) = 1 then + begin + if (argTypes[0].Kind = stOrdinal) and (retType.Kind = stOrdinal) then + Result := CreateWrapper_O_O(ptr) + else if (argTypes[0].Kind = stFloat) and (retType.Kind = stFloat) then + Result := CreateWrapper_F_F(ptr) + else if (argTypes[0].Kind = stFloat) and (retType.Kind = stOrdinal) then + Result := CreateWrapper_F_O(ptr) + else if (argTypes[0].Kind = stUnknown) and (rttiParams[0].ParamType.Handle = TypeInfo(TScalar)) then + begin + // This is the wrapper for: class function(Arg: TScalar): TScalar; + var wrapperFactory := + function(CodeAddress: Pointer): TDataValue.TFunc + begin + Result := + function(const Args: TArray): TDataValue + var + argScalar: TScalar; + begin + if (Length(Args) <> 1) or (Args[0].Kind <> vkScalar) then + raise EArgumentException.Create('Invalid argument for TScalar function.'); + argScalar := Args[0].AsScalar; + Result := TDataValue(TNativeScalarFunc(CodeAddress)(argScalar)); + end; + end; + Result := wrapperFactory(ptr); + end; + end + // --- 2-Argument Functions --- + else if Length(argTypes) = 2 then + begin + var k1 := argTypes[0].Kind; + var k2 := argTypes[1].Kind; + var rk := retType.Kind; + + if (k1 = stOrdinal) and (k2 = stOrdinal) then + begin + if rk = stOrdinal then + Result := CreateWrapper_OO_O(ptr) + else if rk = stFloat then + Result := CreateWrapper_OO_F(ptr); // Divide + end + else if (k1 = stFloat) and (k2 = stFloat) then + begin + if rk = stFloat then + Result := CreateWrapper_FF_F(ptr) + else if rk = stOrdinal then + Result := CreateWrapper_FF_O(ptr); // Comparisons + end + else if (k1 = stOrdinal) and (k2 = stFloat) then + begin + if rk = stFloat then + Result := CreateWrapper_OF_F(ptr) + else if rk = stOrdinal then + Result := CreateWrapper_OF_O(ptr); // Comparisons + end + else if (k1 = stFloat) and (k2 = stOrdinal) then + begin + if rk = stFloat then + Result := CreateWrapper_FO_F(ptr) + else if rk = stOrdinal then + Result := CreateWrapper_FO_O(ptr); // Comparisons + end + else if (k1 = stKeyword) and (k2 = stKeyword) and (rk = stOrdinal) then + begin + // Keywords are passed as Int64 (index) + Result := CreateWrapper_OO_O(ptr); // e.g. Equal_Keyword_Keyword + end; + end; +end; + procedure RegisterRtlFunctions(const AScope: IExecutionScope); begin TRtlRegistry.RegisterAll(AScope); end; +constructor TSpecializedMethod.Create(const ATarget: TDataValue.TFunc; const AReturnType: IStaticType); +begin + Target := ATarget; + ReturnType := AReturnType; +end; + initialization // Register this library's functions with the central AST factory. TAst.RegisterLibrary(RegisterRtlFunctions); diff --git a/Src/AST/Myc.Ast.Scope.pas b/Src/AST/Myc.Ast.Scope.pas index a9675a1..95414ac 100644 --- a/Src/AST/Myc.Ast.Scope.pas +++ b/Src/AST/Myc.Ast.Scope.pas @@ -5,6 +5,7 @@ interface uses System.SysUtils, System.Generics.Collections, + System.Generics.Defaults, System.Classes, Myc.Data.Value, Myc.Ast.Types; @@ -26,6 +27,12 @@ type class operator Equal(const A: TResolvedAddress; B: TResolvedAddress): Boolean; end; + TResolvedAddressComparer = class(TEqualityComparer) + public + function Equals(const Left, Right: TResolvedAddress): Boolean; override; + function GetHashCode(const Value: TResolvedAddress): Integer; override; + end; + // A resolved symbol, containing its runtime address and static type. TResolvedSymbol = record Address: TResolvedAddress; @@ -50,7 +57,7 @@ type {$endregion} // Defines a symbol and returns its runtime address - function Define(const Name: string; const Value: TDataValue): TResolvedAddress; + function Define(const Name: string; const Value: TDataValue; const AStaticType: IStaticType = nil): TResolvedAddress; // Defines a variable at a given address and stores it directly in a shared cell (boxing). procedure DefineBoxed(SlotIndex: Integer; const Value: TDataValue); @@ -104,7 +111,7 @@ type implementation uses - System.Generics.Defaults, + System.Hash, System.SyncObjs; type @@ -128,8 +135,8 @@ type private FParent: IExecutionScope; - FDescriptor: IScopeDescriptor; - FValues: TArray; + FDescriptor: IScopeDescriptor; // (* Will store static types *) + FValues: TArray; // (* Runtime values *) FCapturedUpvalues: TArray; FNames: TDictionary; FNameStrings: TList; @@ -148,7 +155,7 @@ type function GetNameID(const Name: String): Integer; function Resolve(const Name: string): TResolvedAddress; function Dump: string; - function Define(const Name: string; const Value: TDataValue): TResolvedAddress; + function Define(const Name: string; const Value: TDataValue; const AStaticType: IStaticType = nil): TResolvedAddress; procedure DefineBoxed(SlotIndex: Integer; const Value: TDataValue); function Capture(const Address: TResolvedAddress): IValueCell; function CreateDescriptor: IScopeDescriptor; @@ -163,7 +170,6 @@ type private FParent: IScopeDescriptor; FSymbols: TDictionary; - // FMacros: TDictionary; // Entfernt FSlotTypes: TArray; // Stores types by SlotIndex function GetParent: IScopeDescriptor; function GetSlotCount: Integer; @@ -175,14 +181,30 @@ type class function CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor; static; function Define(const Name: string; const AType: IStaticType): Integer; procedure UpdateType(SlotIndex: Integer; const AType: IStaticType = nil); - // procedure DefineMacro(const Name: string; const Node: IMacroDefinitionNode); // Entfernt function FindSymbol(const Name: string): TResolvedSymbol; - // function FindMacro(const Name: string): IMacroDefinitionNode; // Entfernt function CreateScope(const Parent: IExecutionScope): IExecutionScope; procedure PopulateFromScope(Scope: TExecutionScope); property Symbols: TDictionary read FSymbols; end; +{ TResolvedAddressComparer } + +function TResolvedAddressComparer.Equals(const Left, Right: TResolvedAddress): Boolean; +begin + Result := (Left = Right); // Use the record's operator +end; + +function TResolvedAddressComparer.GetHashCode(const Value: TResolvedAddress): Integer; +var + adr: TResolvedAddress; +begin + adr := Value; + // Use THashBobJenkins as requested + Result := THashBobJenkins.GetHashValue(adr.Kind, SizeOf(TAddressKind), 0); + Result := THashBobJenkins.GetHashValue(adr.ScopeDepth, SizeOf(Integer), Result); + Result := THashBobJenkins.GetHashValue(adr.SlotIndex, SizeOf(Integer), Result); +end; + { TResolvedAddress } constructor TResolvedAddress.Create(AKind: TAddressKind; AScopeDepth, ASlotIndex: Integer); @@ -246,7 +268,14 @@ constructor TExecutionScope.Create( begin inherited Create; FParent := AParent; - FDescriptor := ADescriptor; + + // Ensure FDescriptor is always assigned + if Assigned(ADescriptor) then + FDescriptor := ADescriptor + else if Assigned(AParent) then + FDescriptor := AParent.CreateDescriptor // Inherit descriptor if nil + else + FDescriptor := TScope.CreateDescriptor(nil); // Create new root descriptor FValues := []; FCapturedUpvalues := ACapturedUpvalues; @@ -262,7 +291,8 @@ begin FNameStrings := TList.Create; end; - if ADescriptor <> nil then + // Pre-allocate the runtime value array based on the compile-time descriptor's size. + if Assigned(ADescriptor) then SetLength(FValues, ADescriptor.SlotCount); end; @@ -337,25 +367,45 @@ end; function TExecutionScope.CreateDescriptor: IScopeDescriptor; begin + // We create a *copy* to prevent modification of the live descriptor + // TScopeDescriptor.CreateDescriptor(Self) will do this. Result := TScopeDescriptor.CreateDescriptor(Self); end; -function TExecutionScope.Define(const Name: string; const Value: TDataValue): TResolvedAddress; +// (* MODIFIED: Signature changed, logic added *) +function TExecutionScope.Define(const Name: string; const Value: TDataValue; const AStaticType: IStaticType = nil): TResolvedAddress; var id: Integer; index: Integer; + staticType: IStaticType; begin NeedNameToIndex; id := GetNameID(Name); if FNameToIndex.ContainsKey(id) then raise Exception.CreateFmt('Variable "%s" is already defined in this scope.', [Name]); + // 1. Determine the static type + if Assigned(AStaticType) then + staticType := AStaticType + else + staticType := TTypes.Unknown; // Default if not provided + + // 2. Define in the runtime storage (FValues) index := Length(FValues); SetLength(FValues, index + 1); FValues[index].Value := Value; FValues[index].IsBoxed := False; FNameToIndex.Add(id, index); + // 3. Define in the compile-time descriptor (FDescriptor) + // This stores the static type information for the Binder/TypeChecker. + // Note: This relies on FDescriptor being non-nil (ensured in constructor) + var descSlot := FDescriptor.Define(Name, staticType); + + // 4. Ensure runtime slot matches descriptor slot + // This is critical for root scope initialization. + Assert(descSlot = index, 'Scope descriptor slot mismatch during Define'); + // Return the address Result.Kind := akLocalOrParent; Result.ScopeDepth := 0; @@ -573,28 +623,36 @@ begin inherited Create; FParent := AParent; FSymbols := TDictionary.Create; - // FMacros := TDictionary.Create; // Entfernt FSlotTypes := []; end; destructor TScopeDescriptor.Destroy; begin FSlotTypes := nil; - // FMacros.Free; // Entfernt FSymbols.Free; inherited; end; class function TScopeDescriptor.CreateDescriptor(const Scope: IExecutionScope): IScopeDescriptor; begin - if Scope is TExecutionScope then + // Create a *copy* of the descriptor chain + if (Scope is TExecutionScope) and (Assigned(Scope.Parent)) then begin + // Recursively create parent descriptors var res := TScopeDescriptor.Create(CreateDescriptor(Scope.Parent)); + // Populate this descriptor level + res.PopulateFromScope(Scope as TExecutionScope); + Result := res; + end + else if (Scope is TExecutionScope) then + begin + // This is the root scope + var res := TScopeDescriptor.Create(nil); res.PopulateFromScope(Scope as TExecutionScope); Result := res; end else - Result := TScopeDescriptor.Create(nil); + Result := TScopeDescriptor.Create(nil); // Default empty descriptor end; function TScopeDescriptor.CreateScope(const Parent: IExecutionScope): IExecutionScope; @@ -626,9 +684,11 @@ var currentDescriptor: IScopeDescriptor; slotIndex: Integer; begin + // (* MODIFIED: Initialize StaticType *) + Result.StaticType := TTypes.Unknown; Result.Address.Kind := akUnresolved; Result.Address.ScopeDepth := 0; - Result.StaticType := TTypes.Unknown; + currentDescriptor := Self; while Assigned(currentDescriptor) do begin @@ -636,12 +696,13 @@ begin begin Result.Address.Kind := akLocalOrParent; Result.Address.SlotIndex := slotIndex; - Result.StaticType := currentDescriptor.GetType(slotIndex); + Result.StaticType := currentDescriptor.GetType(slotIndex); // (* Read type *) exit; end; inc(Result.Address.ScopeDepth); currentDescriptor := currentDescriptor.Parent; end; + // (* If not found, Result.StaticType remains TTypes.Unknown *) end; function TScopeDescriptor.GetParent: IScopeDescriptor; @@ -670,24 +731,23 @@ procedure TScopeDescriptor.PopulateFromScope(Scope: TExecutionScope); var i: Integer; begin - // Recreate descriptor by iterating all defined symbols in the runtime scope. - SetLength(FSlotTypes, Length(Scope.ValuesArray)); // Size the array - for i := 0 to High(FSlotTypes) do - FSlotTypes[i] := TTypes.Unknown; // Fill with Unknown + // (* MODIFIED: We are populating 'Self' from 'Scope's *internal* descriptor *) + // We must cast to access the descriptor implementation + if not (Scope.FDescriptor is TScopeDescriptor) then + exit; // Cannot populate from an unknown descriptor type - for var pair in Scope.NameToIndex do + var scopeDesc := (Scope.FDescriptor as TScopeDescriptor); + + // Recreate descriptor by copying all defined symbols and types. + SetLength(Self.FSlotTypes, Length(scopeDesc.FSlotTypes)); + for i := 0 to High(Self.FSlotTypes) do + Self.FSlotTypes[i] := scopeDesc.FSlotTypes[i]; // Copy static type + + for var pair in scopeDesc.FSymbols do begin - var name := Scope.NameStrings[pair.Key]; - var slotIndex := pair.Value; - // Add to variable symbol table. - if not FSymbols.ContainsKey(name) then - FSymbols.Add(name, slotIndex); - - // We cannot recover the static type from the runtime scope. - // FSlotTypes[slotIndex] remains TTypes.Unknown. - - // Makro-Logik hier entfernt + if not Self.FSymbols.ContainsKey(pair.Key) then + Self.FSymbols.Add(pair.Key, pair.Value); end; end; diff --git a/Src/AST/Myc.Ast.Script.pas b/Src/AST/Myc.Ast.Script.pas index 18f0a5a..9ba4b04 100644 --- a/Src/AST/Myc.Ast.Script.pas +++ b/Src/AST/Myc.Ast.Script.pas @@ -201,8 +201,6 @@ type procedure VisitConstant(const Node: IConstantNode); override; procedure VisitIdentifier(const Node: IIdentifierNode); override; procedure VisitKeyword(const Node: IKeywordNode); override; - procedure VisitBinaryExpression(const Node: IBinaryExpressionNode); override; - procedure VisitUnaryExpression(const Node: IUnaryExpressionNode); override; procedure VisitIfExpression(const Node: IIfExpressionNode); override; procedure VisitTernaryExpression(const Node: ITernaryExpressionNode); override; procedure VisitLambdaExpression(const Node: ILambdaExpressionNode); override; @@ -823,24 +821,6 @@ begin Append(':' + Node.Value.Name); end; -procedure TPrettyPrintVisitor.VisitBinaryExpression(const Node: IBinaryExpressionNode); -begin - Append('(' + Node.Operator.ToString); - Append(' '); - Node.Left.Accept(Self); - Append(' '); - Node.Right.Accept(Self); - Append(')'); -end; - -procedure TPrettyPrintVisitor.VisitUnaryExpression(const Node: IUnaryExpressionNode); -begin - Append('(' + Node.Operator.ToString); - Append(' '); - Node.Right.Accept(Self); - Append(')'); -end; - procedure TPrettyPrintVisitor.VisitIfExpression(const Node: IIfExpressionNode); begin Append('(if '); diff --git a/Src/AST/Myc.Ast.Types.pas b/Src/AST/Myc.Ast.Types.pas index 190bcac..08e20b7 100644 --- a/Src/AST/Myc.Ast.Types.pas +++ b/Src/AST/Myc.Ast.Types.pas @@ -39,6 +39,7 @@ type {$endregion} property ParamTypes: TArray read GetParamTypes; property ReturnType: IStaticType read GetReturnType; + function GetHashCode: Integer; end; // Defines a mapping for generic record fields (Key -> StaticType) @@ -50,7 +51,8 @@ type {$region 'private'} function GetKind: TStaticTypeKind; function GetElementType: IStaticType; - function GetSignature: IMethodSignature; + // function GetSignature: IMethodSignature; // (* REMOVED *) + function GetSignatures: TArray; // (* ADDED *) function GetDefinition: IScalarRecordDefinition; function GetGenericDefinition: IGenericRecordDefinition; {$endregion} @@ -59,8 +61,12 @@ type property Kind: TStaticTypeKind read GetKind; // The element type (if Kind = stSeries) property ElementType: IStaticType read GetElementType; - // The signature (if Kind = stMethod) - property Signature: IMethodSignature read GetSignature; + + // The signatures (if Kind = stMethod). + // This array contains one entry for simple methods, + // and multiple entries for overloaded functions (like RTL). + property Signatures: TArray read GetSignatures; + // The definition (if Kind = stRecord or stRecordSeries) property Definition: IScalarRecordDefinition read GetDefinition; // The definition (if Kind = stGenericRecord) @@ -69,6 +75,7 @@ type // Checks for type equality function IsEqual(const Other: IStaticType): Boolean; function ToString: string; + function GetHashCode: Integer; end; ETypeException = class(Exception); @@ -102,6 +109,7 @@ type // Factory functions for complex types class function CreateSeries(const AElementType: IStaticType): IStaticType; static; class function CreateMethod(const AParamTypes: TArray; const AReturnType: IStaticType): IStaticType; static; + class function CreateMethodSet(const ASignatures: TArray): IStaticType; static; class function CreateRecord(const ADef: IScalarRecordDefinition): IStaticType; static; class function CreateRecordSeries(const ADef: IScalarRecordDefinition): IStaticType; static; class function CreateGenericRecord(const ADef: IGenericRecordDefinition): IStaticType; static; @@ -123,10 +131,22 @@ type class function ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: IStaticType): IStaticType; static; end; + TMethodSignature = class(TInterfacedObject, IMethodSignature) + private + FParamTypes: TArray; + FReturnType: IStaticType; + function GetParamTypes: TArray; + function GetReturnType: IStaticType; + public + constructor Create(const AParamTypes: TArray; const AReturnType: IStaticType); + function GetHashCode: Integer; override; + end; + implementation uses - System.Generics.Defaults; + System.Generics.Defaults, + System.Hash; // Added for TStringBuilder in TMethodType.ToString { TStaticTypeKindHelper } @@ -157,10 +177,11 @@ type // IStaticType (default implementations for non-applicable properties) function GetKind: TStaticTypeKind; virtual; abstract; function GetElementType: IStaticType; virtual; - function GetSignature: IMethodSignature; virtual; + function GetSignatures: TArray; virtual; // (* CHANGED *) function GetDefinition: IScalarRecordDefinition; virtual; function GetGenericDefinition: IGenericRecordDefinition; virtual; function IsEqual(const Other: IStaticType): Boolean; virtual; + function GetHashCode: Integer; override; abstract; function ToString: string; override; end; @@ -169,9 +190,9 @@ begin Result := nil; end; -function TAbstractStaticType.GetSignature: IMethodSignature; +function TAbstractStaticType.GetSignatures: TArray; // (* CHANGED *) begin - Result := nil; + Result := nil; // (* CHANGED *) end; function TAbstractStaticType.GetDefinition: IScalarRecordDefinition; @@ -208,6 +229,7 @@ type public constructor Create(AKind: TStaticTypeKind); function GetKind: TStaticTypeKind; override; + function GetHashCode: Integer; override; end; constructor TSimpleStaticType.Create(AKind: TStaticTypeKind); @@ -221,6 +243,12 @@ begin Result := FKind; end; +function TSimpleStaticType.GetHashCode: Integer; +begin + // Simple types only hash their kind + Result := Ord(FKind); +end; + // --- Complex Type Implementations --- type @@ -232,6 +260,7 @@ type function GetKind: TStaticTypeKind; override; function GetElementType: IStaticType; override; function IsEqual(const Other: IStaticType): Boolean; override; + function GetHashCode: Integer; override; function ToString: string; override; end; @@ -256,22 +285,24 @@ begin Result := (Assigned(Other)) and (Other.Kind = stSeries) and (Self.FElementType.IsEqual(Other.ElementType)); end; +function TSeriesType.GetHashCode: Integer; +begin + // Consistent with IsEqual + Result := Ord(stSeries); + if Assigned(FElementType) then + begin + // Combine hash of stSeries with hash of element type + var hash := FElementType.GetHashCode; + Result := THashBobJenkins.GetHashValue(Hash, SizeOf(Integer), Result); + end; +end; + function TSeriesType.ToString: string; begin Result := 'Series<' + FElementType.ToString + '>'; end; -// --- -type - TMethodSignature = class(TInterfacedObject, IMethodSignature) - private - FParamTypes: TArray; - FReturnType: IStaticType; - function GetParamTypes: TArray; - function GetReturnType: IStaticType; - public - constructor Create(const AParamTypes: TArray; const AReturnType: IStaticType); - end; +{ TMethodSignature } constructor TMethodSignature.Create(const AParamTypes: TArray; const AReturnType: IStaticType); begin @@ -290,23 +321,46 @@ begin Result := FReturnType; end; +function TMethodSignature.GetHashCode: Integer; +var + i: Integer; +begin + // Consistent with TMethodType.IsEqual + Result := 0; + if Assigned(FReturnType) then + Result := FReturnType.GetHashCode; + + for i := 0 to High(FParamTypes) do + begin + if Assigned(FParamTypes[i]) then + begin + var hash := FParamTypes[i].GetHashCode; + Result := THashBobJenkins.GetHashValue(hash, SizeOf(Integer), Result); + end; + end; +end; + // --- type + // (* ENTIRE TMethodType IMPLEMENTATION REPLACED *) TMethodType = class(TAbstractStaticType) private - FSignature: IMethodSignature; + FSignatures: TArray; + function SignatureToString(const Sig: IMethodSignature): string; public - constructor Create(AParamTypes: TArray; AReturnType: IStaticType); + constructor Create(const ASignatures: TArray); function GetKind: TStaticTypeKind; override; - function GetSignature: IMethodSignature; override; + function GetSignatures: TArray; override; function IsEqual(const Other: IStaticType): Boolean; override; + function GetHashCode: Integer; override; function ToString: string; override; end; -constructor TMethodType.Create(AParamTypes: TArray; AReturnType: IStaticType); +constructor TMethodType.Create(const ASignatures: TArray); begin inherited Create; - FSignature := TMethodSignature.Create(AParamTypes, AReturnType); + Assert(Length(ASignatures) > 0, 'Cannot create a method type with zero signatures'); + FSignatures := ASignatures; end; function TMethodType.GetKind: TStaticTypeKind; @@ -314,47 +368,106 @@ begin Result := stMethod; end; -function TMethodType.GetSignature: IMethodSignature; +function TMethodType.GetSignatures: TArray; begin - Result := FSignature; + Result := FSignatures; end; -function TMethodType.IsEqual(const Other: IStaticType): Boolean; -var - i: Integer; -begin - if (not Assigned(Other)) or (Other.Kind <> stMethod) then - exit(False); - - var otherSig := Other.Signature; - if not Self.FSignature.ReturnType.IsEqual(otherSig.ReturnType) then - exit(False); - - if Length(Self.FSignature.ParamTypes) <> Length(otherSig.ParamTypes) then - exit(False); - - for i := 0 to High(Self.FSignature.ParamTypes) do - begin - if not Self.FSignature.ParamTypes[i].IsEqual(otherSig.ParamTypes[i]) then - exit(False); - end; - - Result := True; -end; - -function TMethodType.ToString: string; +function TMethodType.SignatureToString(const Sig: IMethodSignature): string; var i: Integer; paramStr: string; begin paramStr := ''; - for i := 0 to High(FSignature.ParamTypes) do + for i := 0 to High(Sig.ParamTypes) do begin - paramStr := paramStr + FSignature.ParamTypes[i].ToString; - if i < High(FSignature.ParamTypes) then + paramStr := paramStr + Sig.ParamTypes[i].ToString; + if i < High(Sig.ParamTypes) then paramStr := paramStr + ', '; end; - Result := Format('Method(%s): %s', [paramStr, FSignature.ReturnType.ToString]); + Result := Format('Method(%s): %s', [paramStr, Sig.ReturnType.ToString]); +end; + +function TMethodType.IsEqual(const Other: IStaticType): Boolean; +var + i, j: Integer; +begin + if (not Assigned(Other)) or (Other.Kind <> stMethod) then + exit(False); + + var otherSigs := Other.Signatures; + if Length(Self.FSignatures) <> Length(otherSigs) then + exit(False); + + // This is complex. For now, assume equality means identical sets, + // which requires comparing O(N^2) signatures if order doesn't matter. + // Let's assume order *does* matter for equality to keep this simple (O(N)). + // Note: A better IsEqual would compare hashes of signatures. + + for i := 0 to High(Self.FSignatures) do + begin + var sig1 := Self.FSignatures[i]; + var sig2 := otherSigs[i]; + + if not sig1.ReturnType.IsEqual(sig2.ReturnType) then + exit(False); + if Length(sig1.ParamTypes) <> Length(sig2.ParamTypes) then + exit(False); + + for j := 0 to High(sig1.ParamTypes) do + begin + if not sig1.ParamTypes[j].IsEqual(sig2.ParamTypes[j]) then + exit(False); + end; + end; + + Result := True; +end; + +function TMethodType.GetHashCode: Integer; +var + sig: IMethodSignature; +begin + // Consistent with IsEqual + Result := Ord(stMethod); + for sig in FSignatures do + begin + if Assigned(sig) then + begin + var hash := sig.GetHashCode; + Result := THashBobJenkins.GetHashValue(hash, SizeOf(Integer), Result); + end; + end; +end; + +function TMethodType.ToString: string; +var + sb: TStringBuilder; + sig: IMethodSignature; +begin + if Length(FSignatures) = 1 then + begin + Result := SignatureToString(FSignatures[0]); + end + else + begin + // Handle overloaded methods + sb := TStringBuilder.Create; + try + sb.Append('Method{'); + for sig in FSignatures do + begin + sb.Append('('); + sb.Append(SignatureToString(sig)); + sb.Append('), '); + end; + sb.Remove(sb.Length - 2, 2); // Remove last ', ' + sb.Append('}'); + Result := sb.ToString; + finally + sb.Free; + end; + end; end; // --- @@ -369,6 +482,7 @@ type function GetKind: TStaticTypeKind; override; function GetDefinition: IScalarRecordDefinition; override; function IsEqual(const Other: IStaticType): Boolean; override; + function GetHashCode: Integer; override; // Added function ToString: string; override; end; @@ -414,6 +528,26 @@ begin Result := True; end; +function TRecordType.GetHashCode: Integer; +var + field: TPair; +begin + // Consistent with IsEqual + Result := Ord(GetKind); + if Assigned(FDefinition) then + begin + for field in FDefinition.Fields do + begin + // Hash the Keyword pointer (fast, from flyweight) + var hash := TEqualityComparer.Default.GetHashCode(field.Key); + Result := THashBobJenkins.GetHashValue(hash, SizeOf(Pointer), Result); + // Hash the TScalar.TKind value + var data := Ord(field.Value); + Result := THashBobJenkins.GetHashValue(data, SizeOf(Byte), Result); + end; + end; +end; + function TRecordType.ToString: string; var i: Integer; @@ -441,6 +575,7 @@ type function GetKind: TStaticTypeKind; override; function GetGenericDefinition: IGenericRecordDefinition; override; function IsEqual(const Other: IStaticType): Boolean; override; + function GetHashCode: Integer; override; // Added function ToString: string; override; end; @@ -485,6 +620,29 @@ begin Result := True; end; +function TGenericRecordType.GetHashCode: Integer; +var + field: TPair; +begin + // Consistent with IsEqual + Result := Ord(stGenericRecord); + if Assigned(FDefinition) then + begin + for field in FDefinition.Fields do + begin + // Hash the Keyword pointer (fast, from flyweight) + var data := TEqualityComparer.Default.GetHashCode(field.Key); + Result := THashBobJenkins.GetHashValue(data, SizeOf(Pointer), Result); + // Hash the IStaticType value + if Assigned(field.Value) then + begin + var hash := field.Value.GetHashCode; + Result := THashBobJenkins.GetHashValue(hash, SizeOf(Integer), Result); + end; + end; + end; +end; + function TGenericRecordType.ToString: string; var i: Integer; @@ -516,8 +674,21 @@ begin end; class function TTypes.CreateMethod(const AParamTypes: TArray; const AReturnType: IStaticType): IStaticType; +var + sig: IMethodSignature; + sigs: TArray; begin - Result := TMethodType.Create(AParamTypes, AReturnType); + // This is now a convenience helper for CreateMethodSet + sig := TMethodSignature.Create(AParamTypes, AReturnType); + SetLength(sigs, 1); + sigs[0] := sig; + Result := TMethodType.Create(sigs); +end; + +class function TTypes.CreateMethodSet(const ASignatures: TArray): IStaticType; +begin + // This is the new primary factory for method types + Result := TMethodType.Create(ASignatures); end; class function TTypes.CreateRecord(const ADef: IScalarRecordDefinition): IStaticType; diff --git a/Src/AST/Myc.Ast.Visitor.pas b/Src/AST/Myc.Ast.Visitor.pas index 686c6a5..f5f1704 100644 --- a/Src/AST/Myc.Ast.Visitor.pas +++ b/Src/AST/Myc.Ast.Visitor.pas @@ -17,8 +17,6 @@ type function IAstVisitor.VisitConstant = DoVisitConstant; function IAstVisitor.VisitIdentifier = DoVisitIdentifier; function IAstVisitor.VisitKeyword = DoVisitKeyword; - function IAstVisitor.VisitBinaryExpression = DoVisitBinaryExpression; - function IAstVisitor.VisitUnaryExpression = DoVisitUnaryExpression; function IAstVisitor.VisitIfExpression = DoVisitIfExpression; function IAstVisitor.VisitTernaryExpression = DoVisitTernaryExpression; function IAstVisitor.VisitLambdaExpression = DoVisitLambdaExpression; @@ -44,8 +42,6 @@ type function DoVisitConstant(const Node: IConstantNode): TDataValue; function DoVisitIdentifier(const Node: IIdentifierNode): TDataValue; function DoVisitKeyword(const Node: IKeywordNode): TDataValue; - function DoVisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; - function DoVisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; function DoVisitIfExpression(const Node: IIfExpressionNode): TDataValue; function DoVisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; function DoVisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; @@ -74,8 +70,6 @@ type function VisitConstant(const Node: IConstantNode): T; virtual; abstract; function VisitIdentifier(const Node: IIdentifierNode): T; virtual; abstract; function VisitKeyword(const Node: IKeywordNode): T; virtual; abstract; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): T; virtual; abstract; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): T; virtual; abstract; function VisitIfExpression(const Node: IIfExpressionNode): T; virtual; abstract; function VisitTernaryExpression(const Node: ITernaryExpressionNode): T; virtual; abstract; function VisitLambdaExpression(const Node: ILambdaExpressionNode): T; virtual; abstract; @@ -106,8 +100,6 @@ type function VisitConstant(const Node: IConstantNode): IAstNode; override; function VisitIdentifier(const Node: IIdentifierNode): IAstNode; override; function VisitKeyword(const Node: IKeywordNode): IAstNode; override; - function VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode; override; - function VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode; override; function VisitIfExpression(const Node: IIfExpressionNode): IAstNode; override; function VisitTernaryExpression(const Node: ITernaryExpressionNode): IAstNode; override; function VisitLambdaExpression(const Node: ILambdaExpressionNode): IAstNode; override; @@ -136,8 +128,6 @@ type function IAstVisitor.VisitConstant = DoVisitConstant; function IAstVisitor.VisitIdentifier = DoVisitIdentifier; function IAstVisitor.VisitKeyword = DoVisitKeyword; - function IAstVisitor.VisitBinaryExpression = DoVisitBinaryExpression; - function IAstVisitor.VisitUnaryExpression = DoVisitUnaryExpression; function IAstVisitor.VisitIfExpression = DoVisitIfExpression; function IAstVisitor.VisitTernaryExpression = DoVisitTernaryExpression; function IAstVisitor.VisitLambdaExpression = DoVisitLambdaExpression; @@ -163,8 +153,6 @@ type function DoVisitConstant(const Node: IConstantNode): TDataValue; function DoVisitIdentifier(const Node: IIdentifierNode): TDataValue; function DoVisitKeyword(const Node: IKeywordNode): TDataValue; - function DoVisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; - function DoVisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; function DoVisitIfExpression(const Node: IIfExpressionNode): TDataValue; function DoVisitTernaryExpression(const Node: ITernaryExpressionNode): TDataValue; function DoVisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; @@ -191,8 +179,6 @@ type procedure VisitConstant(const Node: IConstantNode); virtual; abstract; procedure VisitIdentifier(const Node: IIdentifierNode); virtual; abstract; procedure VisitKeyword(const Node: IKeywordNode); virtual; abstract; - procedure VisitBinaryExpression(const Node: IBinaryExpressionNode); virtual; abstract; - procedure VisitUnaryExpression(const Node: IUnaryExpressionNode); virtual; abstract; procedure VisitIfExpression(const Node: IIfExpressionNode); virtual; abstract; procedure VisitTernaryExpression(const Node: ITernaryExpressionNode); virtual; abstract; procedure VisitLambdaExpression(const Node: ILambdaExpressionNode); virtual; abstract; @@ -244,16 +230,6 @@ begin Result := TDataValue.FromGeneric(VisitKeyword(Node)); end; -function TAstVisitor.DoVisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; -begin - Result := TDataValue.FromGeneric(VisitBinaryExpression(Node)); -end; - -function TAstVisitor.DoVisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; -begin - Result := TDataValue.FromGeneric(VisitUnaryExpression(Node)); -end; - function TAstVisitor.DoVisitIfExpression(const Node: IIfExpressionNode): TDataValue; begin Result := TDataValue.FromGeneric(VisitIfExpression(Node)); @@ -466,33 +442,6 @@ begin Result := Node; // Leaf node, immutable end; -function TAstTransformer.VisitBinaryExpression(const Node: IBinaryExpressionNode): IAstNode; -var - newLeft, newRight: IAstNode; -begin - newLeft := Accept(Node.Left); - newRight := Accept(Node.Right); - - if (newLeft = Node.Left) and (newRight = Node.Right) then - Result := Node - else - // Use TAst factory instead of concrete class constructor - Result := TAst.BinaryExpr(newLeft, Node.Operator, newRight, Node.StaticType); -end; - -function TAstTransformer.VisitUnaryExpression(const Node: IUnaryExpressionNode): IAstNode; -var - newRight: IAstNode; -begin - newRight := Accept(Node.Right); - - if newRight = Node.Right then - Result := Node - else - // Use TAst factory - Result := TAst.UnaryExpr(Node.Operator, newRight, Node.StaticType); -end; - function TAstTransformer.VisitIfExpression(const Node: IIfExpressionNode): IAstNode; var newCond, newThen, newElse: IAstNode; @@ -785,16 +734,6 @@ begin VisitKeyword(Node); end; -function TAstVisitor.DoVisitBinaryExpression(const Node: IBinaryExpressionNode): TDataValue; -begin - VisitBinaryExpression(Node); -end; - -function TAstVisitor.DoVisitUnaryExpression(const Node: IUnaryExpressionNode): TDataValue; -begin - VisitUnaryExpression(Node); -end; - function TAstVisitor.DoVisitIfExpression(const Node: IIfExpressionNode): TDataValue; begin VisitIfExpression(Node); diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 4dfee32..2b1d74c 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -26,7 +26,11 @@ type class destructor Destroy; public class procedure RegisterLibrary(const AProc: TRegisterLibraryProc); static; - class function CreateScope(Parent: IExecutionScope; const Descriptor: IScopeDescriptor = nil): IExecutionScope; static; + class function CreateScope( + Parent: IExecutionScope; + const Descriptor: IScopeDescriptor = nil; + ARegisterLibraries: Boolean = False + ): IExecutionScope; static; // A No-Operation node, used as a placeholder/stub (e.g., for UI drop targets). class function Nop(const AStaticType: IStaticType = nil): IAstNode; static; @@ -41,17 +45,6 @@ type const Address: TResolvedAddress; const AStaticType: IStaticType = nil ): IIdentifierNode; overload; static; - class function BinaryExpr( - ALeft: IAstNode; - AOperator: TScalar.TBinaryOp; - ARight: IAstNode; - const AStaticType: IStaticType = nil - ): IBinaryExpressionNode; static; - class function UnaryExpr( - const AOperator: TScalar.TUnaryOp; - const ARight: IAstNode; - const AStaticType: IStaticType = nil - ): IUnaryExpressionNode; static; class function IfExpr( const ACondition: IAstNode; const AThenBranch, AElseBranch: IAstNode; @@ -156,8 +149,6 @@ type function AsConstant: IConstantNode; virtual; function AsIdentifier: IIdentifierNode; virtual; function AsKeyword: IKeywordNode; virtual; - function AsBinaryExpression: IBinaryExpressionNode; virtual; - function AsUnaryExpression: IUnaryExpressionNode; virtual; function AsIfExpression: IIfExpressionNode; virtual; function AsTernaryExpression: ITernaryExpressionNode; virtual; function AsLambdaExpression: ILambdaExpressionNode; virtual; @@ -196,7 +187,7 @@ type property StaticType: IStaticType read GetStaticType; end; - TLambdaExpressionNode = class(TAstTypedNode, ILambdaExpressionNode) + TLambdaExpressionNode = class(TAstTypedNode, ILambdaExpressionNode, IFunctionDefinition) private FParameters: TArray; FBody: IAstNode; @@ -400,39 +391,6 @@ type property Expressions: TArray read FExpressions; end; - TBinaryExpressionNode = class(TAstTypedNode, IBinaryExpressionNode) - private - FLeft: IAstNode; - FOperator: TScalar.TBinaryOp; - FRight: IAstNode; - function GetLeft: IAstNode; - function GetOperator: TScalar.TBinaryOp; - function GetRight: IAstNode; - function GetKind: TAstNodeKind; override; - public - constructor Create(const ALeft: IAstNode; AOperator: TScalar.TBinaryOp; const ARight: IAstNode; const AStaticType: IStaticType); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsBinaryExpression: IBinaryExpressionNode; override; - property Left: IAstNode read FLeft; - property Operator: TScalar.TBinaryOp read FOperator; - property Right: IAstNode read FRight; - end; - - TUnaryExpressionNode = class(TAstTypedNode, IUnaryExpressionNode) - private - FOperator: TScalar.TUnaryOp; - FRight: IAstNode; - function GetOperator: TScalar.TUnaryOp; - function GetRight: IAstNode; - function GetKind: TAstNodeKind; override; - public - constructor Create(const AOperator: TScalar.TUnaryOp; const ARight: IAstNode; const AStaticType: IStaticType); - function Accept(const Visitor: IAstVisitor): TDataValue; override; - function AsUnaryExpression: IUnaryExpressionNode; override; - property Operator: TScalar.TUnaryOp read FOperator; - property Right: IAstNode read FRight; - end; - TIfExpressionNode = class(TAstTypedNode, IIfExpressionNode) private FCondition: IAstNode; @@ -597,16 +555,23 @@ type { TAst } -class function TAst.CreateScope(Parent: IExecutionScope; const Descriptor: IScopeDescriptor): IExecutionScope; +class function TAst.CreateScope( + Parent: IExecutionScope; + const Descriptor: IScopeDescriptor = nil; + ARegisterLibraries: Boolean = False +): IExecutionScope; begin if Assigned(Descriptor) then Result := Descriptor.CreateScope(Parent) else Result := TScope.CreateScope(Parent, nil, nil); - // Register libraries in the *new* scope - for var libProc in FLibraries do - libProc(Result); + // This should only be True when creating the *root* environment. + if ARegisterLibraries then + begin + for var libProc in FLibraries do + libProc(Result); + end; end; class function TAst.CreateSeries(const ADefinition: String; const AStaticType: IStaticType = nil): ICreateSeriesNode; @@ -668,23 +633,6 @@ begin Result := TAssignmentNode.Create(TAst.Identifier('Result'), AValue, TTypes.Unknown); end; -class function TAst.BinaryExpr( - ALeft: IAstNode; - AOperator: TScalar.TBinaryOp; - ARight: IAstNode; - const AStaticType: IStaticType = nil -): IBinaryExpressionNode; -begin - Result := - TBinaryExpressionNode.Create( - ALeft, - AOperator, - ARight, - if AStaticType <> nil then AStaticType - else TTypes.Unknown - ); -end; - class function TAst.Block(const AExpressions: array of IAstNode; const AStaticType: IStaticType = nil): IBlockExpressionNode; begin Result := @@ -922,21 +870,6 @@ begin ); end; -class function TAst.UnaryExpr( - const AOperator: TScalar.TUnaryOp; - const ARight: IAstNode; - const AStaticType: IStaticType = nil -): IUnaryExpressionNode; -begin - Result := - TUnaryExpressionNode.Create( - AOperator, - ARight, - if AStaticType <> nil then AStaticType - else TTypes.Unknown - ); -end; - class function TAst.Unquote(const AExpression: IAstNode): IUnquoteNode; begin Result := TUnquoteNode.Create(AExpression); @@ -1004,11 +937,6 @@ begin raise ETypeException.Create('Node is not an Assignment'); end; -function TAstNode.AsBinaryExpression: IBinaryExpressionNode; -begin - raise ETypeException.Create('Node is not a BinaryExpression'); -end; - function TAstNode.AsBlockExpression: IBlockExpressionNode; begin raise ETypeException.Create('Node is not a BlockExpression'); @@ -1105,11 +1033,6 @@ begin raise ETypeException.Create('Node has no type'); end; -function TAstNode.AsUnaryExpression: IUnaryExpressionNode; -begin - raise ETypeException.Create('Node is not an UnaryExpression'); -end; - function TAstNode.AsUnquote: IUnquoteNode; begin raise ETypeException.Create('Node is not an Unquote'); @@ -1244,85 +1167,6 @@ begin Result := akKeyword; end; -{ TBinaryExpressionNode } - -constructor TBinaryExpressionNode.Create( - const ALeft: IAstNode; - AOperator: TScalar.TBinaryOp; - const ARight: IAstNode; - const AStaticType: IStaticType -); -begin - inherited Create(AStaticType); - FLeft := ALeft; - FOperator := AOperator; - FRight := ARight; -end; - -function TBinaryExpressionNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitBinaryExpression(Self); -end; - -function TBinaryExpressionNode.AsBinaryExpression: IBinaryExpressionNode; -begin - Result := Self; -end; - -function TBinaryExpressionNode.GetLeft: IAstNode; -begin - Result := FLeft; -end; - -function TBinaryExpressionNode.GetOperator: TScalar.TBinaryOp; -begin - Result := FOperator; -end; - -function TBinaryExpressionNode.GetRight: IAstNode; -begin - Result := FRight; -end; - -function TBinaryExpressionNode.GetKind: TAstNodeKind; -begin - Result := akBinaryExpression; -end; - -{ TUnaryExpressionNode } - -constructor TUnaryExpressionNode.Create(const AOperator: TScalar.TUnaryOp; const ARight: IAstNode; const AStaticType: IStaticType); -begin - inherited Create(AStaticType); - FOperator := AOperator; - FRight := ARight; -end; - -function TUnaryExpressionNode.Accept(const Visitor: IAstVisitor): TDataValue; -begin - Result := Visitor.VisitUnaryExpression(Self); -end; - -function TUnaryExpressionNode.AsUnaryExpression: IUnaryExpressionNode; -begin - Result := Self; -end; - -function TUnaryExpressionNode.GetOperator: TScalar.TUnaryOp; -begin - Result := FOperator; -end; - -function TUnaryExpressionNode.GetRight: IAstNode; -begin - Result := FRight; -end; - -function TUnaryExpressionNode.GetKind: TAstNodeKind; -begin - Result := akUnaryExpression; -end; - { TIfExpressionNode } constructor TIfExpressionNode.Create(const ACondition, AThenBranch, AElseBranch: IAstNode; const AStaticType: IStaticType);