Allow GHC to dump primop modules

This patch adds two commands to GHC:
- --print-prim-module: prints the contents of GHC.Internal.Prim
- --print-prim-wrappers-module: prints the contents of GHC.Internal.PrimopWrappers

These two commands can be used in ghc-internal's Setup.hs to generate
these modules. This ensures that ghc-internal's primop code is always in
sync with the GHC that builds it. It also avoids having to share code
(primops.txt.pp and friends) between ghc-internal and ghc.

Author: hsyl20

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"
+
 {-
 ************************************************************************
 *                                                                      *

compiler/Setup.hs

@@ -53,6 +53,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 ()

ghc/Main.hs

@@ -38,6 +38,8 @@ import GHC.Platform
 import GHC.Platform.Ways
 import GHC.Platform.Host
 
+import GHC.Builtin.PrimOps (primOpPrimModule, primOpWrappersModule)
+
 #if defined(HAVE_INTERNAL_INTERPRETER)
 import GHCi.UI              ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )
 #endif
@@ -147,6 +149,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
@@ -451,12 +455,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
@@ -622,6 +630,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))

hadrian/src/Rules/Generate.hs

@@ -101,6 +101,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"
                   ]

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" ]

utils/genprimopcode/Main.hs

@@ -198,6 +198,12 @@ main = getArgs >>= \args ->
                       "--make-haskell-source"
                          -> putStr (gen_hs_source p_o_specs)
 
+                      "--wrappers-module"
+                         -> putStr (gen_wrappers_module p_o_specs)
+
+                      "--prim-module"
+                         -> putStr (gen_hs_source_module p_o_specs)
+
                       "--wired-in-docs"
                          -> putStr (gen_wired_in_docs p_o_specs)
 
@@ -229,13 +235,18 @@ known_args
        "--make-haskell-source",
        "--make-latex-doc",
        "--wired-in-docs",
-       "--wired-in-deprecations"
+       "--wired-in-deprecations",
+       "--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"
@@ -461,6 +472,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"