diff --git a/.gitignore b/.gitignore index 14607af61e1..4ffea8681ab 100644 --- a/.gitignore +++ b/.gitignore @@ -49,6 +49,8 @@ stack.yaml.lock *.chi *.chs.h *.prof +*.hp +*.ps .liquid/ # Agda diff --git a/nix/outputs.nix b/nix/outputs.nix index 0af40f2377e..901b2ee6b01 100644 --- a/nix/outputs.nix +++ b/nix/outputs.nix @@ -32,8 +32,8 @@ let project = import ./project.nix { inherit inputs pkgs lib metatheory r-with-packages utils; }; - mkShell = ghc: import ./shell.nix - { inherit inputs pkgs lib project agda-tools metatheory r-with-packages ghc; }; + mkShell = project-variant: import ./shell.nix + { inherit inputs pkgs lib project agda-tools metatheory r-with-packages project-variant; }; exposed-haskell-packages = { plutus-core-test = project.flake'.packages."plutus-core:test:plutus-core-test"; @@ -113,7 +113,7 @@ let devShells = (non-profiled-shells) // - { profiled = mkShell project.projectVariants.ghc96-profiled; } // + { profiled = mkShell "ghc96-profiled"; } // { metatheory-jailbreak = metatheory-jailbreak-shell; }; full-nested-ci-jobs = { diff --git a/nix/shell.nix b/nix/shell.nix index d69223eeb11..2812a9f6183 100644 --- a/nix/shell.nix +++ b/nix/shell.nix @@ -1,17 +1,18 @@ # editorconfig-checker-disable-file -{ inputs, pkgs, lib, project, agda-tools, metatheory, r-with-packages, ghc }: +{ inputs, pkgs, lib, project, agda-tools, metatheory, r-with-packages, project-variant }: let # Toolchain versions used in dev shells. Consumed by `project.shellFor`. - all-tools = { + tools = rec { "ghc96".cabal = project.projectVariants.ghc96.tool "cabal" "3.12.1.0"; "ghc96".cabal-fmt = project.projectVariants.ghc96.tool "cabal-fmt" "latest"; "ghc96".haskell-language-server = project.projectVariants.ghc96.tool "haskell-language-server" "latest"; "ghc96".stylish-haskell = project.projectVariants.ghc96.tool "stylish-haskell" "latest"; "ghc96".fourmolu = project.projectVariants.ghc96.tool "fourmolu" "0.17.0.0"; # fourmolu 0.18.0.0 and hlint 3.10 require GHC >=9.8 "ghc96".hlint = project.projectVariants.ghc96.tool "hlint" "3.8"; + "ghc96".hp2ps = project.projectVariants.ghc96.tool "hp2ps" "latest"; "ghc912".cabal = project.projectVariants.ghc912.tool "cabal" "latest"; "ghc912".cabal-fmt = project.projectVariants.ghc96.tool "cabal-fmt" "latest"; # cabal-fmt not buildable with ghc9122 @@ -19,9 +20,11 @@ let "ghc912".stylish-haskell = project.projectVariants.ghc912.tool "stylish-haskell" "latest"; "ghc912".fourmolu = project.projectVariants.ghc912.tool "fourmolu" "latest"; "ghc912".hlint = project.projectVariants.ghc912.tool "hlint" "latest"; - }; + "ghc912".hp2ps = project.projectVariants.ghc912.tool "hp2ps" "latest"; + + "ghc96-profiled" = tools."ghc96"; - tools = all-tools.${ghc}; + }.${project-variant}; # Pre-commit hooks for the repo. Injects into shell via shellHook. pre-commit-check = inputs.pre-commit-hooks.lib.${pkgs.system}.run { @@ -129,8 +132,8 @@ let "export LOCALE_ARCHIVE=${pkgs.glibcLocales}/lib/locale/locale-archive"; # Full developer shell with many tools. - full-shell = project.projectVariants.${ghc}.shellFor { - name = "plutus-shell-${ghc}"; + full-shell = project.projectVariants.${project-variant}.shellFor { + name = "plutus-shell-${project-variant}"; buildInputs = lib.concatLists [ common-pkgs @@ -151,8 +154,8 @@ let # Lightweight shell with minimal tools. - quick-shell = project.projectVariants.${ghc}.shellFor { - name = "plutus-shell-${ghc}"; + quick-shell = project.projectVariants.${project-variant}.shellFor { + name = "plutus-shell-${project-variant}"; tools = { cabal = "latest"; }; shellHook = '' ${locale-archive-hook} @@ -165,10 +168,11 @@ let # Select shell by compiler used in the project variant. shell = { ghc96 = full-shell; + ghc96-profiled = full-shell; ghc98 = quick-shell; ghc910 = quick-shell; ghc912 = full-shell; - }.${ghc}; + }.${project-variant}; in diff --git a/plutus-tx-plugin-tests.ps b/plutus-tx-plugin-tests.ps new file mode 100644 index 00000000000..1c1284cff9a Binary files /dev/null and b/plutus-tx-plugin-tests.ps differ diff --git a/plutus-tx-plugin/plutus-tx-plugin-profile-test.hp b/plutus-tx-plugin/plutus-tx-plugin-profile-test.hp new file mode 100644 index 00000000000..8a1e32edb0d --- /dev/null +++ b/plutus-tx-plugin/plutus-tx-plugin-profile-test.hp @@ -0,0 +1,341 @@ +JOB "plutus-tx-plugin-profile-test +RTS -N -hc -p -i0.0001 -L5000 -S" +DATE "Thu Nov 20 13:30 2025" +SAMPLE_UNIT "seconds" +VALUE_UNIT "bytes" +BEGIN_SAMPLE 0.000000 +END_SAMPLE 0.000000 +BEGIN_SAMPLE 0.025472 +(1725)GHC.Event.Thread.CAF 248 +(1709)SYSTEM 33432 +MAIN 44536 +END_SAMPLE 0.025472 +BEGIN_SAMPLE 0.027722 +(1725)GHC.Event.Thread.CAF 248 +(1709)SYSTEM 33840 +MAIN 85568 +END_SAMPLE 0.027722 +BEGIN_SAMPLE 0.029778 +(1725)GHC.Event.Thread.CAF 248 +(1709)SYSTEM 34520 +MAIN 131128 +END_SAMPLE 0.029778 +BEGIN_SAMPLE -0.000876 +(3405)Main.CAF 16 +(1725)GHC.Event.Thread.CAF 360 +(1835)GHC.Conc.Signal.CAF 640 +(1812)GHC.IO.Encoding.Iconv.CAF 120 +(1814)GHC.IO.Encoding.CAF 952 +MAIN 133152 +(1709)SYSTEM 34656 +(3407)main 8464 +(1803)GHC.IO.Handle.FD.CAF 17072 +END_SAMPLE -0.000876 +BEGIN_SAMPLE 0.002071 +(3405)Main.CAF 16 +(1709)SYSTEM 34656 +(1725)GHC.Event.Thread.CAF 360 +(1835)GHC.Conc.Signal.CAF 640 +(1803)GHC.IO.Handle.FD.CAF 17072 +(1812)GHC.IO.Encoding.Iconv.CAF 120 +MAIN 133360 +(2107)GHC.Utils.Panic.CAF 48 +(3411)runGhc/GHC.CAF 104 +(1771)GHC.TopHandler.CAF 192 +(1805)GHC.IO.FD.CAF 16 +(1745)Data.Typeable.Internal.CAF 1712 +(2035)System.Posix.Signals.CAF 240 +(2275)GHC.SysTools.CAF 136 +(1814)GHC.IO.Encoding.CAF 1088 +(2768)GHC.Paths.CAF 2352 +(2351)GHC.Settings.IO.CAF 336 +(1783)GHC.Read.CAF 56 +(3410)runGhc/defaultErrorHandler/main 768 +(3407)main 8400 +(3408)defaultErrorHandler/main 120 +(3413)initHscEnv/initGhcMonad/runGhc/defaultErrorHandler/main 77120 +END_SAMPLE 0.002071 +BEGIN_SAMPLE 0.004420 +(3408)defaultErrorHandler/main 120 +(3407)main 8384 +(2768)GHC.Paths.CAF 2352 +(1805)GHC.IO.FD.CAF 16 +(2351)GHC.Settings.IO.CAF 336 +(1783)GHC.Read.CAF 56 +(1725)GHC.Event.Thread.CAF 360 +(1835)GHC.Conc.Signal.CAF 640 +(1803)GHC.IO.Handle.FD.CAF 17072 +(1812)GHC.IO.Encoding.Iconv.CAF 120 +(3411)runGhc/GHC.CAF 104 +(2107)GHC.Utils.Panic.CAF 48 +(1771)GHC.TopHandler.CAF 192 +(1745)Data.Typeable.Internal.CAF 1712 +(2035)System.Posix.Signals.CAF 240 +(2275)GHC.SysTools.CAF 176 +(1709)SYSTEM 34656 +MAIN 133072 +(3415)newHscEnv/initHscEnv/initGhcMonad/runGhc/defaultErrorHandler/main 48 +(3373)PlutusIR.Compiler.Types.CAF 208 +(3205)UntypedPlutusCore.Simplify.Opts.CAF 64 +(3276)PlutusCore.Normalize.Internal.CAF 16 +(3222)PlutusCore.Default.Universe.CAF 72 +(3410)runGhc/defaultErrorHandler/main 736 +(3459)markNonFresh/markNonFreshMax/markNonFreshType/normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 16 +(3458)markNonFreshMax/markNonFreshType/normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 16 +(3462)markNonFreshBelow/markNonFresh/markNonFreshMax/markNonFreshType/normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 40 +(3453)normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 744 +(3428)setupCompileContext/withCleanupSession/runGhc/defaultErrorHandler/main 368 +(1802)GHC.IO.Handle.Internals.CAF 24 +(1806)GHC.IO.Exception.CAF 48 +(3403)PlutusTx.Options.CAF 272 +(3263)PlutusCore.Version.CAF 32 +(3456)markNonFreshType/normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 48 +(1814)GHC.IO.Encoding.CAF 1224 +(2115)GHC.Utils.GlobalVars.CAF 96 +(2493)GHC.Driver.Session.CAF 192 +(3416)newHscEnvWithHUG/newHscEnv/initHscEnv/initGhcMonad/runGhc/defaultErrorHandler/main 912 +(3405)Main.CAF 2784 +(3432)runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 816 +(3429)runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 40 +(3431)runCompiler/withCleanupSession/runGhc/defaultErrorHandler/main 64 +(3477)<<$>>/normalizeTypeM/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 624 +(3463)markNonFreshBelow/markNonFresh/markNonFreshMax/markNonFreshType/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 336 +(3440)typeSchemeToType/withTypeSchemeOfBuiltinFunction/typeOfBuiltinFunction/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1248 +(3457)markNonFreshType/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 672 +(3460)markNonFreshMax/markNonFreshType/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 504 +(3473)normalizeTypeM/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 3840 +(3461)markNonFresh/markNonFreshMax/markNonFreshType/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 504 +(3455)through/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 504 +(3434)getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1192 +(3445)checkKindM/inferKindM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 2496 +(3442)inferKindM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 9360 +(3467)markNonFreshBelow/markNonFresh/markNonFreshMax/markNonFreshType/through/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1176 +(3435)builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 6440 +(3413)initHscEnv/initGhcMonad/runGhc/defaultErrorHandler/main 94928 +(3468)renameTypeM/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 2184 +(3444)inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 10944 +(3446)checkKindM/inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 21888 +(3476)<<*>>/normalizeTypeM/runNormalizeTypeT/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 14888 +(3479)<<$>>/<<*>>/normalizeTypeM/runNormalizeTypeT/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 3744 +(3454)normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 12208 +(3437)enumerate/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1920 +(3420)withCleanupSession/runGhc/defaultErrorHandler/main 4752 +(3436)tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 10240 +END_SAMPLE 0.004420 +BEGIN_SAMPLE 0.007433 +(3431)runCompiler/withCleanupSession/runGhc/defaultErrorHandler/main 64 +(3429)runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 40 +(3411)runGhc/GHC.CAF 104 +(2107)GHC.Utils.Panic.CAF 48 +(1745)Data.Typeable.Internal.CAF 1712 +(1771)GHC.TopHandler.CAF 192 +(2035)System.Posix.Signals.CAF 240 +(2275)GHC.SysTools.CAF 176 +(1805)GHC.IO.FD.CAF 16 +(2351)GHC.Settings.IO.CAF 336 +(1725)GHC.Event.Thread.CAF 360 +(1835)GHC.Conc.Signal.CAF 640 +(3373)PlutusIR.Compiler.Types.CAF 208 +(3205)UntypedPlutusCore.Simplify.Opts.CAF 64 +(3405)Main.CAF 2784 +(3276)PlutusCore.Normalize.Internal.CAF 16 +(1802)GHC.IO.Handle.Internals.CAF 24 +(1806)GHC.IO.Exception.CAF 48 +(2115)GHC.Utils.GlobalVars.CAF 96 +(3403)PlutusTx.Options.CAF 272 +(3263)PlutusCore.Version.CAF 32 +(1783)GHC.Read.CAF 56 +(2768)GHC.Paths.CAF 2352 +(3415)newHscEnv/initHscEnv/initGhcMonad/runGhc/defaultErrorHandler/main 48 +(3408)defaultErrorHandler/main 120 +(3432)runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 816 +(3459)markNonFresh/markNonFreshMax/markNonFreshType/normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 16 +(3462)markNonFreshBelow/markNonFresh/markNonFreshMax/markNonFreshType/normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 40 +(3524)typeUniquesDeep/markNonFreshType/normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 64 +(3458)markNonFreshMax/markNonFreshType/normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 16 +(3456)markNonFreshType/normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 24 +(3453)normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 824 +(3434)getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1168 +(3482)withTyVar/inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 352 +(2493)GHC.Driver.Session.CAF 192 +(3484)lookupTyVarM/inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1440 +(3493)insertNamed/withTyVar/inferKindM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 336 +(3505)insertByUnique/insertByName/insertNamed/withTyVar/inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 456 +(3410)runGhc/defaultErrorHandler/main 736 +(3420)withCleanupSession/runGhc/defaultErrorHandler/main 4776 +(3428)setupCompileContext/withCleanupSession/runGhc/defaultErrorHandler/main 368 +(3413)initHscEnv/initGhcMonad/runGhc/defaultErrorHandler/main 93280 +(3416)newHscEnvWithHUG/newHscEnv/initHscEnv/initGhcMonad/runGhc/defaultErrorHandler/main 912 +(3407)main 8384 +(1812)GHC.IO.Encoding.Iconv.CAF 120 +(1814)GHC.IO.Encoding.CAF 1224 +(3437)enumerate/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1392 +(3445)checkKindM/inferKindM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 6320 +(1803)GHC.IO.Handle.FD.CAF 17072 +MAIN 133136 +(1706)DONT_CARE 32 +(3222)PlutusCore.Default.Universe.CAF 152 +(3457)markNonFreshType/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 128 +(3460)markNonFreshMax/markNonFreshType/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 96 +(3461)markNonFresh/markNonFreshMax/markNonFreshType/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 96 +(3463)markNonFreshBelow/markNonFresh/markNonFreshMax/markNonFreshType/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 64 +(3475)normalizeTypeM/runNormalizeTypeT/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 304 +(3455)through/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 96 +(3490)lookupName/lookupTyVarM/PlutusCore.TypeCheck.Internal.CAF 176 +(3497)insertByName/insertNamed/withTyVar/PlutusCore.TypeCheck.Internal.CAF 176 +(3282)PlutusCore.Mark.CAF 272 +(3296)PlutusCore.Default.Builtins.CAF 336 +(3541)demoteKind/kindOfBuiltinType/inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 32 +(1708)GC 856 +(1709)SYSTEM 34832 +(3440)typeSchemeToType/withTypeSchemeOfBuiltinFunction/typeOfBuiltinFunction/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 4352 +(3479)<<$>>/<<*>>/normalizeTypeM/runNormalizeTypeT/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 7408 +(3476)<<*>>/normalizeTypeM/runNormalizeTypeT/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 21320 +(3468)renameTypeM/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 4856 +(3467)markNonFreshBelow/markNonFresh/markNonFreshMax/markNonFreshType/through/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1160 +(3442)inferKindM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 24912 +(3435)builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 12168 +(3436)tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 18576 +(3454)normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 19936 +(3452)demoteKind/kindOfBuiltinType/inferKindM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 448 +(3473)normalizeTypeM/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 6400 +(3512)renameNameM/withFreshenedName/renameTypeM/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 744 +(3477)<<$>>/normalizeTypeM/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1744 +(3485)lookupTyVarM/checkKindM/inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 6200 +(3478)<<$>>/normalizeTypeM/runNormalizeTypeT/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1744 +(3513)<<*>>/<<$>>/normalizeTypeM/runNormalizeTypeT/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 18528 +(3507)withFreshenedName/renameTypeM/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 19696 +(3444)inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 23896 +(3446)checkKindM/inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 58152 +END_SAMPLE 0.007433 +BEGIN_SAMPLE 0.009511 +(3403)PlutusTx.Options.CAF 272 +(3263)PlutusCore.Version.CAF 32 +(3373)PlutusIR.Compiler.Types.CAF 208 +(3205)UntypedPlutusCore.Simplify.Opts.CAF 64 +(3276)PlutusCore.Normalize.Internal.CAF 16 +(2115)GHC.Utils.GlobalVars.CAF 96 +(1783)GHC.Read.CAF 56 +(1802)GHC.IO.Handle.Internals.CAF 24 +(1806)GHC.IO.Exception.CAF 48 +(2035)System.Posix.Signals.CAF 240 +(2275)GHC.SysTools.CAF 176 +(2768)GHC.Paths.CAF 2352 +(1805)GHC.IO.FD.CAF 16 +(2351)GHC.Settings.IO.CAF 336 +(1708)GC 856 +(2493)GHC.Driver.Session.CAF 192 +(3490)lookupName/lookupTyVarM/PlutusCore.TypeCheck.Internal.CAF 176 +(3497)insertByName/insertNamed/withTyVar/PlutusCore.TypeCheck.Internal.CAF 176 +(1706)DONT_CARE 32 +(3282)PlutusCore.Mark.CAF 272 +(3415)newHscEnv/initHscEnv/initGhcMonad/runGhc/defaultErrorHandler/main 48 +(3416)newHscEnvWithHUG/newHscEnv/initHscEnv/initGhcMonad/runGhc/defaultErrorHandler/main 912 +(3428)setupCompileContext/withCleanupSession/runGhc/defaultErrorHandler/main 368 +(3485)lookupTyVarM/checkKindM/inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 6200 +(3407)main 8384 +(3524)typeUniquesDeep/markNonFreshType/normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 64 +(3441)inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 24 +(3437)enumerate/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 552 +(3452)demoteKind/kindOfBuiltinType/inferKindM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 704 +(3439)withTypeSchemeOfBuiltinFunction/typeOfBuiltinFunction/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 136 +(3413)initHscEnv/initGhcMonad/runGhc/defaultErrorHandler/main 93280 +(3512)renameNameM/withFreshenedName/renameTypeM/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 744 +(3478)<<$>>/normalizeTypeM/runNormalizeTypeT/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1744 +(3507)withFreshenedName/renameTypeM/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 19696 +(3462)markNonFreshBelow/markNonFresh/markNonFreshMax/markNonFreshType/normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 40 +(3456)markNonFreshType/normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 24 +(3493)insertNamed/withTyVar/inferKindM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 336 +(3459)markNonFresh/markNonFreshMax/markNonFreshType/normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 16 +(3453)normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 824 +(3458)markNonFreshMax/markNonFreshType/normalizeType/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 16 +(3505)insertByUnique/insertByName/insertNamed/withTyVar/inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 456 +(3482)withTyVar/inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 352 +(3484)lookupTyVarM/inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1440 +(3513)<<*>>/<<$>>/normalizeTypeM/runNormalizeTypeT/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 18528 +(1709)SYSTEM 34832 +(1725)GHC.Event.Thread.CAF 360 +(1835)GHC.Conc.Signal.CAF 640 +(3405)Main.CAF 2784 +(1812)GHC.IO.Encoding.Iconv.CAF 120 +(1814)GHC.IO.Encoding.CAF 1224 +(3411)runGhc/GHC.CAF 104 +(2107)GHC.Utils.Panic.CAF 48 +(1771)GHC.TopHandler.CAF 192 +(1745)Data.Typeable.Internal.CAF 1712 +(3408)defaultErrorHandler/main 120 +(3410)runGhc/defaultErrorHandler/main 736 +(3429)runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 40 +(3431)runCompiler/withCleanupSession/runGhc/defaultErrorHandler/main 64 +(3420)withCleanupSession/runGhc/defaultErrorHandler/main 4752 +(3432)runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 816 +(3434)getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1168 +(1803)GHC.IO.Handle.FD.CAF 17072 +MAIN 133136 +(3445)checkKindM/inferKindM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 10304 +(3442)inferKindM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 38800 +(3440)typeSchemeToType/withTypeSchemeOfBuiltinFunction/typeOfBuiltinFunction/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 6200 +(3541)demoteKind/kindOfBuiltinType/inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 96 +(3296)PlutusCore.Default.Builtins.CAF 400 +(3222)PlutusCore.Default.Universe.CAF 224 +(3457)markNonFreshType/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1216 +(3460)markNonFreshMax/markNonFreshType/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 912 +(3461)markNonFresh/markNonFreshMax/markNonFreshType/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 912 +(3463)markNonFreshBelow/markNonFresh/markNonFreshMax/markNonFreshType/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 608 +(3475)normalizeTypeM/runNormalizeTypeT/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 1088 +(3477)<<$>>/normalizeTypeM/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 2624 +(3473)normalizeTypeM/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 12064 +(3467)markNonFreshBelow/markNonFresh/markNonFreshMax/markNonFreshType/through/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 3064 +(3455)through/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 912 +(3468)renameTypeM/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 9496 +(3446)checkKindM/inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 94816 +(3479)<<$>>/<<*>>/normalizeTypeM/runNormalizeTypeT/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 12688 +(3454)normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 39576 +(3476)<<*>>/normalizeTypeM/runNormalizeTypeT/normalizeType/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 46464 +(3444)inferKindM/runTypeCheckM/inferKind/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 41720 +(3436)tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 29280 +(3435)builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 22248 +END_SAMPLE 0.009511 +BEGIN_SAMPLE 0.013191 +(2115)GHC.Utils.GlobalVars.CAF 96 +(3416)newHscEnvWithHUG/newHscEnv/initHscEnv/initGhcMonad/runGhc/defaultErrorHandler/main 48 +(3403)PlutusTx.Options.CAF 272 +(3263)PlutusCore.Version.CAF 32 +(3373)PlutusIR.Compiler.Types.CAF 208 +(2493)GHC.Driver.Session.CAF 192 +(3282)PlutusCore.Mark.CAF 272 +(3440)typeSchemeToType/withTypeSchemeOfBuiltinFunction/typeOfBuiltinFunction/tabulateArray/builtinMeaningsToTypes/getDefTypeCheckConfig/runCompiler/runQuoteT/withCleanupSession/runGhc/defaultErrorHandler/main 48 +(3205)UntypedPlutusCore.Simplify.Opts.CAF 64 +(3276)PlutusCore.Normalize.Internal.CAF 16 +(1706)DONT_CARE 32 +(3490)lookupName/lookupTyVarM/PlutusCore.TypeCheck.Internal.CAF 176 +(3497)insertByName/insertNamed/withTyVar/PlutusCore.TypeCheck.Internal.CAF 176 +(2275)GHC.SysTools.CAF 176 +(2768)GHC.Paths.CAF 2352 +(1805)GHC.IO.FD.CAF 16 +(2351)GHC.Settings.IO.CAF 336 +(1783)GHC.Read.CAF 56 +(1802)GHC.IO.Handle.Internals.CAF 24 +(1806)GHC.IO.Exception.CAF 48 +(3407)main 8360 +(3405)Main.CAF 3216 +(2107)GHC.Utils.Panic.CAF 48 +(1771)GHC.TopHandler.CAF 192 +(1745)Data.Typeable.Internal.CAF 1712 +(3413)initHscEnv/initGhcMonad/runGhc/defaultErrorHandler/main 84544 +(1709)SYSTEM 1768 +(1725)GHC.Event.Thread.CAF 360 +(1835)GHC.Conc.Signal.CAF 640 +(1812)GHC.IO.Encoding.Iconv.CAF 120 +(1814)GHC.IO.Encoding.CAF 1224 +(3411)runGhc/GHC.CAF 112 +(3410)runGhc/defaultErrorHandler/main 184 +MAIN 131880 +(1766)GHC.Weak.Finalize.CAF 560 +(3296)PlutusCore.Default.Builtins.CAF 528 +(3222)PlutusCore.Default.Universe.CAF 280 +(2035)System.Posix.Signals.CAF 288 +(1726)GHC.Event.Poll.CAF 24 +(1803)GHC.IO.Handle.FD.CAF 34144 +END_SAMPLE 0.013191 +BEGIN_SAMPLE 0.017976 +END_SAMPLE 0.017976 diff --git a/plutus-tx-plugin/plutus-tx-plugin.cabal b/plutus-tx-plugin/plutus-tx-plugin.cabal index 8fb0deab3ee..e29c95412bf 100644 --- a/plutus-tx-plugin/plutus-tx-plugin.cabal +++ b/plutus-tx-plugin/plutus-tx-plugin.cabal @@ -57,6 +57,7 @@ library PlutusTx.Compiler.Error PlutusTx.Options PlutusTx.Plugin + PlutusTx.Compiler.Types other-modules: PlutusTx.Compiler.Binders @@ -67,7 +68,6 @@ library PlutusTx.Compiler.Names PlutusTx.Compiler.Trace PlutusTx.Compiler.Type - PlutusTx.Compiler.Types PlutusTx.Compiler.Utils PlutusTx.PIRTypes PlutusTx.PLCTypes @@ -241,3 +241,28 @@ test-suite size ghc-options: -fno-strictness -fno-unbox-strict-fields -fno-unbox-small-strict-fields -fno-full-laziness + + +test-suite plutus-tx-plugin-profile-test + import: lang, ghc-version-support, os-support + type: exitcode-stdio-1.0 + main-is: ProfileTest.hs + hs-source-dirs: test/Plugin/Profiling + build-depends: + , base >=4.9 && <5 + , containers + , data-default + , ghc + , ghc-paths + , mtl + , plutus-core ^>=1.55 + , plutus-core:plutus-ir + , plutus-tx-plugin ^>=1.55 + + default-extensions: Strict + ghc-options: -threaded -rtsopts -with-rtsopts=-N + + -- See Note [-fno-full-laziness in Plutus Tx] + ghc-options: + -fno-strictness -fno-unbox-strict-fields + -fno-unbox-small-strict-fields -fno-full-laziness \ No newline at end of file diff --git a/plutus-tx-plugin/src/PlutusTx/Plugin.hs b/plutus-tx-plugin/src/PlutusTx/Plugin.hs index 6464ef65e06..2049bdde86b 100644 --- a/plutus-tx-plugin/src/PlutusTx/Plugin.hs +++ b/plutus-tx-plugin/src/PlutusTx/Plugin.hs @@ -10,7 +10,7 @@ -- For some reason this module is very slow to compile otherwise {-# OPTIONS_GHC -O0 #-} -module PlutusTx.Plugin (plugin, plc) where +module PlutusTx.Plugin (plugin, plc, runCompiler) where import PlutusPrelude import PlutusTx.AsData.Internal qualified @@ -610,23 +610,31 @@ runCompiler moduleName opts expr = do (opts ^. posPreserveLogging) -- GHC.Core -> Pir translation. - pirT <- original <$> (PIR.runDefT annMayInline $ compileExprWithDefs expr) + pirT <- + {-# SCC "plinth-plugin-core-to-pir-step" #-} + original <$> (PIR.runDefT annMayInline $ compileExprWithDefs expr) + let pirP = PIR.Program noProvenance plcVersion pirT when (opts ^. posDumpPir) . liftIO $ dumpFlat (void pirP) "initial PIR program" (moduleName ++ "_initial.pir-flat") -- Pir -> (Simplified) Pir pass. We can then dump/store a more legible PIR program. spirP <- + {-# SCC "plinth-plugin-pir-to-simp-step" #-} flip runReaderT pirCtx $ modifyError (NoContext . PIRError) $ PIR.compileToReadable pirP + when (opts ^. posDumpPir) . liftIO $ dumpFlat (void spirP) "simplified PIR program" (moduleName ++ "_simplified.pir-flat") -- (Simplified) Pir -> Plc translation. - plcP <- flip runReaderT pirCtx $ - modifyError (NoContext . PIRError) $ - PIR.compileReadableToPlc spirP + plcP <- + {-# SCC "plinth-plugin-simp-to-plc-step" #-} + flip runReaderT pirCtx $ + modifyError (NoContext . PIRError) $ + PIR.compileReadableToPlc spirP + when (opts ^. posDumpPlc) . liftIO $ dumpFlat (void plcP) "typed PLC program" (moduleName ++ ".tplc-flat") @@ -636,7 +644,11 @@ runCompiler moduleName opts expr = do modifyError PLC.TypeErrorE $ PLC.inferTypeOfProgram plcTcConfig (plcP $> annMayInline) - (uplcP, _) <- flip runReaderT plcOpts $ PLC.compileProgramWithTrace plcP + (uplcP, _) <- + {-# SCC "plinth-plugin-plc-to-uplc-step" #-} + flip runReaderT plcOpts $ PLC.compileProgramWithTrace plcP + + dbP <- liftExcept $ modifyError PLC.FreeVariableErrorE $ traverseOf UPLC.progTerm UPLC.deBruijnTerm uplcP when (opts ^. posDumpUPlc) . liftIO $ dumpFlat diff --git a/plutus-tx-plugin/test/Plugin/Profiling/ProfileTest.hs b/plutus-tx-plugin/test/Plugin/Profiling/ProfileTest.hs new file mode 100644 index 00000000000..bcced3cad46 --- /dev/null +++ b/plutus-tx-plugin/test/Plugin/Profiling/ProfileTest.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +-- | Standalone executable for profiling the plugin compilation functions. +-- +-- This test uses the exposed 'runCompiler' from Plugin.hs to compile a simple +-- Core expression. This allows profiling the plugin code at runtime, including +-- the SCC annotations in Plugin.hs. +-- +-- To run with profiling: +-- cabal build plutus-tx-plugin-profile-test --enable-profiling +-- cabal run plutus-tx-plugin-profile-test --enable-profiling -- +RTS -p -hc +module Main where + +import Data.Default +import Data.Foldable (fold) +import PlutusCore qualified as PLC +import PlutusCore.Quote +import PlutusCore.Version qualified as PLC +import PlutusIR.Compiler qualified as PIR +import PlutusIR.Compiler.Types qualified as PIR +import PlutusIR.Transform.RewriteRules +import PlutusIR.Transform.RewriteRules.RemoveTrace (rewriteRuleRemoveTrace) +import PlutusTx.Compiler.Types +import PlutusTx.Options (PluginOptions (..), defaultPluginOptions) +import PlutusTx.Plugin (runCompiler) + +import GHC qualified as GHC +import GHC.Core.FamInstEnv qualified as GHC +import GHC.Core.Opt.OccurAnal qualified as GHC +import GHC.Driver.Session qualified as GHC +import GHC.Paths as GHC +import GHC.Plugins qualified as GHC + +import Control.Monad.Except +import Control.Monad.Reader +import Control.Monad.State +import Control.Monad.Writer + +import Data.Map qualified as Map + +-- | Create a simple Core expression for testing (a literal integer) +createSimpleCoreExpr :: GHC.DynFlags -> GHC.CoreExpr +createSimpleCoreExpr _flags = + let lit = GHC.Lit (GHC.LitNumber GHC.LitNumInt 42) + in lit + +-- | Set up a minimal CompileContext for testing +setupCompileContext + :: GHC.DynFlags + -> GHC.FamInstEnvs + -> NameInfo + -> CompileContext PLC.DefaultUni PLC.DefaultFun +setupCompileContext flags famEnvs nameInfo = + let opts = defaultPluginOptions + coverage = CoverageOpts mempty + in CompileContext + { ccOpts = + CompileOptions + { coProfile = _posProfile opts + , coCoverage = coverage + , coDatatypeStyle = + if _posPlcTargetVersion opts < PLC.plcVersion110 + then PIR.ScottEncoding + else PIR._dcoStyle $ _posDatatypes opts + , coRemoveTrace = _posRemoveTrace opts + , coInlineFix = _posInlineFix opts + } + , ccFlags = flags + , ccFamInstEnvs = famEnvs + , ccNameInfo = nameInfo + , ccScope = initialScope + , ccBlackholed = mempty + , ccCurDef = Nothing + , ccModBreaks = Nothing + , ccBuiltinsInfo = def + , ccBuiltinCostModel = def + , ccDebugTraceOn = _posDumpCompilationTrace opts + , ccRewriteRules = makeRewriteRules opts + , ccSafeToInline = False + } + where + makeRewriteRules :: PluginOptions -> RewriteRules PLC.DefaultUni PLC.DefaultFun + makeRewriteRules options = + fold + [ mwhen (_posRemoveTrace options) rewriteRuleRemoveTrace + , defaultUniRewriteRules + ] + mwhen :: Monoid m => Bool -> m -> m + mwhen b m = if b then m else mempty + +-- | Create empty NameInfo (simplified - in real usage would need proper lookups) +createEmptyNameInfo :: NameInfo +createEmptyNameInfo = Map.empty + +main :: IO () +main = do + putStrLn "Setting up for plugin profiling test..." + + -- Use GHC's API to get DynFlags + GHC.defaultErrorHandler GHC.defaultFatalMessager GHC.defaultFlushOut $ do + -- Initialize GHC session to get DynFlags + GHC.runGhc (Just GHC.libdir) $ do + -- Get DynFlags + flags <- GHC.getSessionDynFlags + + -- Create a simple Core expression (literal integer) + let expr = createSimpleCoreExpr flags + + -- Set up minimal context + let famEnvs = (GHC.emptyFamInstEnv, GHC.emptyFamInstEnv) + nameInfo = createEmptyNameInfo + ctx = setupCompileContext flags famEnvs nameInfo + opts = defaultPluginOptions + st = CompileState 0 mempty + moduleNameStr = "ProfileTest" + -- Apply occurrence analysis like the plugin does + expr' = GHC.occurAnalyseExpr expr + + -- Call runCompiler - this is where the SCC annotations are! + _ <- + runExceptT . runWriterT . runQuoteT . flip runReaderT ctx . flip evalStateT st $ + runCompiler moduleNameStr opts expr' + + pure ()