From c567b168f6990f40c88c49fe2a6273dccbbbfdb1 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 9 Sep 2025 12:45:22 +0900 Subject: [PATCH] genprimopcode: add --wrappers/--prim-module --- compiler/GHC/Builtin/PrimOps.hs | 10 +++++++++- compiler/Setup.hs | 2 ++ ghc/GHC/Driver/Session/Mode.hs | 8 +++++++- ghc/Main.hs | 4 ++++ hadrian/src/Rules/Generate.hs | 2 ++ hadrian/src/Settings/Builders/GenPrimopCode.hs | 2 ++ utils/genprimopcode/Main.hs | 16 +++++++++++++++- utils/genprimopcode/genprimopcode.cabal | 5 +++++ 8 files changed, 46 insertions(+), 3 deletions(-) diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs index d4d982427597..2273d34f9c3d 100644 --- a/compiler/GHC/Builtin/PrimOps.hs +++ b/compiler/GHC/Builtin/PrimOps.hs @@ -25,7 +25,9 @@ module GHC.Builtin.PrimOps ( getPrimOpResultInfo, isComparisonPrimOp, PrimOpResultInfo(..), - PrimCall(..) + PrimCall(..), + + primOpPrimModule, primOpWrappersModule ) where import GHC.Prelude @@ -171,6 +173,12 @@ primOpDocs :: [(FastString, String)] primOpDeprecations :: [(OccName, FastString)] #include "primop-deprecations.hs-incl" +primOpPrimModule :: String +#include "primop-prim-module.hs-incl" + +primOpWrappersModule :: String +#include "primop-wrappers-module.hs-incl" + {- ************************************************************************ * * diff --git a/compiler/Setup.hs b/compiler/Setup.hs index c112aaba549d..2388601f98b4 100644 --- a/compiler/Setup.hs +++ b/compiler/Setup.hs @@ -54,6 +54,8 @@ primopIncls = , ("primop-vector-tycons.hs-incl" , "--primop-vector-tycons") , ("primop-docs.hs-incl" , "--wired-in-docs") , ("primop-deprecations.hs-incl" , "--wired-in-deprecations") + , ("primop-prim-module.hs-incl" , "--prim-module") + , ("primop-wrappers-module.hs-incl" , "--wrappers-module") ] ghcAutogen :: Verbosity -> LocalBuildInfo -> IO () diff --git a/ghc/GHC/Driver/Session/Mode.hs b/ghc/GHC/Driver/Session/Mode.hs index e2d9c28e935b..33850aab89f9 100644 --- a/ghc/GHC/Driver/Session/Mode.hs +++ b/ghc/GHC/Driver/Session/Mode.hs @@ -32,12 +32,16 @@ data PreStartupMode | ShowNumVersion -- ghc --numeric-version | ShowSupportedExtensions -- ghc --supported-extensions | ShowOptions Bool {- isInteractive -} -- ghc --show-options + | PrintPrimModule -- ghc --print-prim-module + | PrintPrimWrappersModule -- ghc --print-prim-wrappers-module -showVersionMode, showNumVersionMode, showSupportedExtensionsMode, showOptionsMode :: Mode +showVersionMode, showNumVersionMode, showSupportedExtensionsMode, showOptionsMode, printPrimModule, printPrimWrappersModule :: Mode showVersionMode = mkPreStartupMode ShowVersion showNumVersionMode = mkPreStartupMode ShowNumVersion showSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions showOptionsMode = mkPreStartupMode (ShowOptions False) +printPrimModule = mkPreStartupMode PrintPrimModule +printPrimWrappersModule = mkPreStartupMode PrintPrimWrappersModule mkPreStartupMode :: PreStartupMode -> Mode mkPreStartupMode = Left @@ -203,6 +207,8 @@ mode_flags = , defFlag "-numeric-version" (PassFlag (setMode showNumVersionMode)) , defFlag "-info" (PassFlag (setMode showInfoMode)) , defFlag "-show-options" (PassFlag (setMode showOptionsMode)) + , defFlag "-print-prim-module" (PassFlag (setMode printPrimModule)) + , defFlag "-print-prim-wrappers-module" (PassFlag (setMode printPrimWrappersModule)) , defFlag "-supported-languages" (PassFlag (setMode showSupportedExtensionsMode)) , defFlag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode)) , defFlag "-show-packages" (PassFlag (setMode showUnitsMode)) diff --git a/ghc/Main.hs b/ghc/Main.hs index 259678550f7b..f3a78249dcc8 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -37,6 +37,8 @@ import GHC.Driver.Config.Diagnostic import GHC.Platform import GHC.Platform.Host +import GHC.Builtin.PrimOps (primOpPrimModule, primOpWrappersModule) + #if defined(HAVE_INTERNAL_INTERPRETER) import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings ) #endif @@ -138,6 +140,8 @@ main = do ShowVersion -> showVersion ShowNumVersion -> putStrLn cProjectVersion ShowOptions isInteractive -> showOptions isInteractive + PrintPrimModule -> liftIO $ putStrLn primOpPrimModule + PrintPrimWrappersModule -> liftIO $ putStrLn primOpWrappersModule Right postStartupMode -> -- start our GHC session GHC.runGhc mbMinusB $ do diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs index 883b8bb53a3c..bf54e83b10c3 100644 --- a/hadrian/src/Rules/Generate.hs +++ b/hadrian/src/Rules/Generate.hs @@ -102,6 +102,8 @@ compilerDependencies = do , "primop-vector-uniques.hs-incl" , "primop-docs.hs-incl" , "primop-deprecations.hs-incl" + , "primop-prim-module.hs-incl" + , "primop-wrappers-module.hs-incl" , "GHC/Platform/Constants.hs" , "GHC/Settings/Config.hs" ] diff --git a/hadrian/src/Settings/Builders/GenPrimopCode.hs b/hadrian/src/Settings/Builders/GenPrimopCode.hs index d38dcf303853..625fadeba5b6 100644 --- a/hadrian/src/Settings/Builders/GenPrimopCode.hs +++ b/hadrian/src/Settings/Builders/GenPrimopCode.hs @@ -24,4 +24,6 @@ genPrimopCodeBuilderArgs = builder GenPrimopCode ? mconcat , output "//primop-vector-tycons.hs-incl" ? arg "--primop-vector-tycons" , output "//primop-docs.hs-incl" ? arg "--wired-in-docs" , output "//primop-deprecations.hs-incl" ? arg "--wired-in-deprecations" + , output "//primop-prim-module.hs-incl" ? arg "--prim-module" + , output "//primop-wrappers-module.hs-incl" ? arg "--wrappers-module" , output "//primop-usage.hs-incl" ? arg "--usage" ] diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 266ea639e11e..7502875154fb 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -216,6 +216,12 @@ main = getArgs >>= \args -> "--foundation-tests" -> putStr (gen_foundation_tests p_o_specs) + "--wrappers-module" + -> putStr (gen_wrappers_module p_o_specs) + + "--prim-module" + -> putStr (gen_hs_source_module p_o_specs) + _ -> error "Should not happen, known_args out of sync?" ) @@ -242,13 +248,18 @@ known_args "--make-latex-doc", "--wired-in-docs", "--wired-in-deprecations", - "--foundation-tests" + "--foundation-tests", + "--wrappers-module", + "--prim-module" ] ------------------------------------------------------------------ -- Code generators ----------------------------------------------- ------------------------------------------------------------------ +gen_hs_source_module :: Info -> String +gen_hs_source_module info = "primOpPrimModule = " ++ show (gen_hs_source info) + gen_hs_source :: Info -> String gen_hs_source (Info defaults entries) = "{-\n" @@ -475,6 +486,9 @@ In PrimopWrappers we set some crucial GHC options a very simple module and there is no optimisation to be done -} +gen_wrappers_module :: Info -> String +gen_wrappers_module info = "primOpWrappersModule = " ++ show (gen_wrappers info) + gen_wrappers :: Info -> String gen_wrappers (Info _ entries) = "-- | Users should not import this module. It is GHC internal only.\n" diff --git a/utils/genprimopcode/genprimopcode.cabal b/utils/genprimopcode/genprimopcode.cabal index 8db8827e1594..6626217ec336 100644 --- a/utils/genprimopcode/genprimopcode.cabal +++ b/utils/genprimopcode/genprimopcode.cabal @@ -31,5 +31,10 @@ Executable genprimopcode AccessOps Build-Depends: base >= 4 && < 5, array + + -- Happy generated unboxed sums without the necessary pragma. + default-extensions: + UnboxedSums + if flag(build-tool-depends) build-tool-depends: alex:alex >= 3.2.6, happy:happy >= 1.20.0