Driver: substitute virtual Prim module in --make mode too

When we build ghc-internal with --make (e.g. with cabal-install), we
need to be careful to substitute the virtual interface file for
GHC.Internal.Prim:
- after code generation (we generate code for an empty module, so we get
  an empty interface)
- when we try to reload its .hi file

Author: hsyl20

compiler/GHC/Driver/Downsweep.hs

@@ -519,7 +519,7 @@ loopFixedModule key loc done = do
         -- part of the compiler.
         lookupIfaceByModuleHsc hsc_env (mnkToModule key) >>= \case
           Just iface -> return (M.Succeeded iface)
-          Nothing -> readIface (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
+          Nothing -> readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule key) (ml_hi_file loc)
       case read_result of
         M.Succeeded iface -> do
           -- Computer information about this node

compiler/GHC/Driver/Main.hs

@@ -1299,7 +1299,7 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h
           -- when compiling gHC_PRIM without generating code (e.g. with
           -- Haddock), we still want the virtual interface in the cache
           if ms_mod summary == gHC_PRIM
-            then return $ HscUpdate (getGhcPrimIface hsc_env)
+            then return $ HscUpdate (getGhcPrimIface (hsc_hooks hsc_env))
             else return $ HscUpdate iface
 
 
@@ -1314,7 +1314,7 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h
         -- when compiling gHC_PRIM without generating code (e.g. with
         -- Haddock), we still want the virtual interface in the cache
         if ms_mod summary == gHC_PRIM
-          then return $ HscUpdate (getGhcPrimIface hsc_env)
+          then return $ HscUpdate (getGhcPrimIface (hsc_hooks hsc_env))
           else return $ HscUpdate iface
 
 {-

compiler/GHC/Driver/Make.hs

@@ -1616,7 +1616,7 @@ executeCompileNode k n !old_hmi hug mrehydrate_mods mni = do
     executeCompileNodeFixed hsc_env MakeEnv{diag_wrapper, env_messager} mod loc =
       wrapAction diag_wrapper hsc_env $ do
         forM_ env_messager $ \hscMessage -> hscMessage hsc_env (k, n) UpToDate (ModuleNode [] (ModuleNodeFixed mod loc))
-        read_result <- readIface (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule mod) (ml_hi_file loc)
+        read_result <- readIface (hsc_hooks hsc_env) (hsc_logger hsc_env) (hsc_dflags hsc_env) (hsc_NC hsc_env) (mnkToModule mod) (ml_hi_file loc)
         case read_result of
           M.Failed interface_err ->
             let mn = mnkModuleName mod

compiler/GHC/Driver/Pipeline.hs

@@ -44,6 +44,7 @@ module GHC.Driver.Pipeline (
 
 
 import GHC.Prelude
+import GHC.Builtin.Names
 
 import GHC.Platform
 
@@ -91,6 +92,7 @@ import GHC.Data.StringBuffer   ( hPutStringBuffer )
 import GHC.Data.Maybe          ( expectJust )
 
 import GHC.Iface.Make          ( mkFullIface )
+import GHC.Iface.Load          ( getGhcPrimIface )
 import GHC.Runtime.Loader      ( initializePlugins )
 
 
@@ -819,7 +821,13 @@ hscGenBackendPipeline pipe_env hsc_env mod_sum result = do
         let !linkable = Linkable part_time (ms_mod mod_sum) (NE.singleton (DotO final_object ModuleObject))
         -- Add the object linkable to the potential bytecode linkable which was generated in HscBackend.
         return (mlinkable { homeMod_object = Just linkable })
-  return (miface, final_linkable)
+
+  -- when building ghc-internal with --make (e.g. with cabal-install), we want
+  -- the virtual interface for gHC_PRIM in the cache, not the empty one.
+  let miface_final
+        | ms_mod mod_sum == gHC_PRIM = getGhcPrimIface (hsc_hooks hsc_env)
+        | otherwise                  = miface
+  return (miface_final, final_linkable)
 
 asPipeline :: P m => Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe ObjFile)
 asPipeline use_cpp pipe_env hsc_env location input_fn =

compiler/GHC/Iface/Load.hs

@@ -895,6 +895,7 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
       mhome_unit  = hsc_home_unit_maybe hsc_env
       dflags     = hsc_dflags hsc_env
       logger     = hsc_logger hsc_env
+      hooks      = hsc_hooks hsc_env
 
 
   trace_if logger (sep [hsep [text "Reading",
@@ -905,59 +906,51 @@ findAndReadIface hsc_env doc_str mod wanted_mod hi_boot_file = do
                            ppr mod <> semi],
                      nest 4 (text "reason:" <+> doc_str)])
 
-  -- Check for GHC.Prim, and return its static interface
-  -- See Note [GHC.Prim] in primops.txt.pp.
-  -- TODO: make this check a function
-  if mod `installedModuleEq` gHC_PRIM
-      then do
-          let iface = getGhcPrimIface hsc_env
-          return (Succeeded (iface, panic "GHC.Prim ModLocation (findAndReadIface)"))
-      else do
-          -- Look for the file
-          mb_found <- liftIO (findExactModule hsc_env mod hi_boot_file)
-          case mb_found of
-              InstalledFound loc -> do
-                  -- See Note [Home module load error]
-                  if HUG.memberHugUnitId (moduleUnit mod) (hsc_HUG hsc_env)
-                      && not (isOneShot (ghcMode dflags))
-                    then return (Failed (HomeModError mod loc))
-                    else do
-                        r <- read_file logger name_cache unit_state dflags wanted_mod (ml_hi_file loc)
-                        case r of
-                          Failed err
-                            -> return (Failed $ BadIfaceFile err)
-                          Succeeded (iface,_fp)
-                            -> do
-                                r2 <- load_dynamic_too_maybe logger name_cache unit_state
-                                                         (setDynamicNow dflags) wanted_mod
-                                                         iface loc
-                                case r2 of
-                                  Failed sdoc -> return (Failed sdoc)
-                                  Succeeded {} -> return $ Succeeded (iface, loc)
-              err -> do
-                  trace_if logger (text "...not found")
-                  return $ Failed $ cannotFindInterface
-                                      unit_state
-                                      mhome_unit
-                                      profile
-                                      (moduleName mod)
-                                      err
+  -- Look for the file
+  mb_found <- liftIO (findExactModule hsc_env mod hi_boot_file)
+  case mb_found of
+    InstalledFound loc -> do
+        -- See Note [Home module load error]
+        if HUG.memberHugUnitId (moduleUnit mod) (hsc_HUG hsc_env)
+            && not (isOneShot (ghcMode dflags))
+          then return (Failed (HomeModError mod loc))
+          else do
+              r <- read_file hooks logger name_cache unit_state dflags wanted_mod (ml_hi_file loc)
+              case r of
+                Failed err
+                  -> return (Failed $ BadIfaceFile err)
+                Succeeded (iface,_fp)
+                  -> do
+                      r2 <- load_dynamic_too_maybe hooks logger name_cache unit_state
+                                               (setDynamicNow dflags) wanted_mod
+                                               iface loc
+                      case r2 of
+                        Failed sdoc -> return (Failed sdoc)
+                        Succeeded {} -> return $ Succeeded (iface, loc)
+    err -> do
+        trace_if logger (text "...not found")
+        return $ Failed $ cannotFindInterface
+                            unit_state
+                            mhome_unit
+                            profile
+                            (moduleName mod)
+                            err
 
 -- | Check if we need to try the dynamic interface for -dynamic-too
-load_dynamic_too_maybe :: Logger -> NameCache -> UnitState -> DynFlags
+load_dynamic_too_maybe :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags
                        -> Module -> ModIface -> ModLocation
                        -> IO (MaybeErr MissingInterfaceError ())
-load_dynamic_too_maybe logger name_cache unit_state dflags wanted_mod iface loc
+load_dynamic_too_maybe hooks logger name_cache unit_state dflags wanted_mod iface loc
   -- Indefinite interfaces are ALWAYS non-dynamic.
   | not (moduleIsDefinite (mi_module iface)) = return (Succeeded ())
-  | gopt Opt_BuildDynamicToo dflags = load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc
+  | gopt Opt_BuildDynamicToo dflags = load_dynamic_too hooks logger name_cache unit_state dflags wanted_mod iface loc
   | otherwise = return (Succeeded ())
 
-load_dynamic_too :: Logger -> NameCache -> UnitState -> DynFlags
+load_dynamic_too :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags
                  -> Module -> ModIface -> ModLocation
                  -> IO (MaybeErr MissingInterfaceError ())
-load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do
-  read_file logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case
+load_dynamic_too hooks logger name_cache unit_state dflags wanted_mod iface loc = do
+  read_file hooks logger name_cache unit_state dflags wanted_mod (ml_dyn_hi_file loc) >>= \case
     Succeeded (dynIface, _)
      | mi_mod_hash iface == mi_mod_hash dynIface
      -> return (Succeeded ())
@@ -971,10 +964,10 @@ load_dynamic_too logger name_cache unit_state dflags wanted_mod iface loc = do
 
 
 
-read_file :: Logger -> NameCache -> UnitState -> DynFlags
+read_file :: Hooks -> Logger -> NameCache -> UnitState -> DynFlags
           -> Module -> FilePath
           -> IO (MaybeErr ReadInterfaceError (ModIface, FilePath))
-read_file logger name_cache unit_state dflags wanted_mod file_path = do
+read_file hooks logger name_cache unit_state dflags wanted_mod file_path = do
 
   -- Figure out what is recorded in mi_module.  If this is
   -- a fully definite interface, it'll match exactly, but
@@ -985,7 +978,7 @@ read_file logger name_cache unit_state dflags wanted_mod file_path = do
             (_, Just indef_mod) ->
               instModuleToModule unit_state
                 (uninstantiateInstantiatedModule indef_mod)
-  read_result <- readIface logger dflags name_cache wanted_mod' file_path
+  read_result <- readIface hooks logger dflags name_cache wanted_mod' file_path
   case read_result of
     Failed err      -> return (Failed err)
     Succeeded iface -> return (Succeeded (iface, file_path))
@@ -1012,29 +1005,37 @@ flagsToIfCompression dflags
 -- Failed err    <=> file not found, or unreadable, or illegible
 -- Succeeded iface <=> successfully found and parsed
 readIface
-  :: Logger
+  :: Hooks
+  -> Logger
   -> DynFlags
   -> NameCache
   -> Module
   -> FilePath
   -> IO (MaybeErr ReadInterfaceError ModIface)
-readIface logger dflags name_cache wanted_mod file_path = do
+readIface hooks logger dflags name_cache wanted_mod file_path = do
   trace_if logger (text "readIFace" <+> text file_path)
-  let profile = targetProfile dflags
-  res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path
-  case res of
-    Right iface
-        -- NB: This check is NOT just a sanity check, it is
-        -- critical for correctness of recompilation checking
-        -- (it lets us tell when -this-unit-id has changed.)
-        | wanted_mod == actual_mod
-                        -> return (Succeeded iface)
-        | otherwise     -> return (Failed err)
-        where
-          actual_mod = mi_module iface
-          err = HiModuleNameMismatchWarn file_path wanted_mod actual_mod
-
-    Left exn    -> return (Failed (ExceptionOccurred file_path exn))
+  -- Check for GHC.Prim, and return its static interface
+  -- See Note [GHC.Prim] in primops.txt.pp.
+  if wanted_mod == gHC_PRIM
+    then do
+      -- TODO: should we check for the existence of the file?
+      return (Succeeded (getGhcPrimIface hooks))
+    else do
+      let profile = targetProfile dflags
+      res <- tryMost $ readBinIface profile name_cache CheckHiWay QuietBinIFace file_path
+      case res of
+        Right iface
+            -- NB: This check is NOT just a sanity check, it is
+            -- critical for correctness of recompilation checking
+            -- (it lets us tell when -this-unit-id has changed.)
+            | wanted_mod == actual_mod
+                            -> return (Succeeded iface)
+            | otherwise     -> return (Failed err)
+            where
+              actual_mod = mi_module iface
+              err = HiModuleNameMismatchWarn file_path wanted_mod actual_mod
+
+        Left exn    -> return (Failed (ExceptionOccurred file_path exn))
 
 {-
 *********************************************************
@@ -1245,8 +1246,8 @@ instance Outputable WhereFrom where
 -- This is a helper function that takes into account the hook allowing ghc-prim
 -- interface to be extended via the ghc-api. Afaik it was introduced for GHCJS
 -- so that it can add its own primitive types.
-getGhcPrimIface :: HscEnv -> ModIface
-getGhcPrimIface hsc_env =
-  case ghcPrimIfaceHook (hsc_hooks hsc_env) of
+getGhcPrimIface :: Hooks -> ModIface
+getGhcPrimIface hooks =
+  case ghcPrimIfaceHook hooks of
     Nothing -> ghcPrimIface
     Just h  -> h

compiler/GHC/Iface/Make.hs

@@ -156,7 +156,7 @@ mkFullIface hsc_env partial_iface mb_stg_infos mb_cmm_infos stubs foreign_files
     putDumpFileMaybe (hsc_logger hsc_env) Opt_D_dump_hi "FINAL INTERFACE" FormatText
       (pprModIface unit_state full_iface)
     final_iface <- shareIface (hsc_NC hsc_env) (flagsToIfCompression $ hsc_dflags hsc_env) full_iface
-    return final_iface
+    return $ final_iface
 
 -- | Compress an 'ModIface' and share as many values as possible, depending on the 'CompressionIFace' level.
 -- See Note [Sharing of ModIface].

compiler/GHC/Iface/Recomp.hs

@@ -304,7 +304,7 @@ check_old_iface hsc_env mod_summary maybe_iface
 
         loadIface read_dflags iface_path = do
              let ncu        = hsc_NC hsc_env
-             read_result <- readIface logger read_dflags ncu (ms_mod mod_summary) iface_path
+             read_result <- readIface (hsc_hooks hsc_env) logger read_dflags ncu (ms_mod mod_summary) iface_path
              case read_result of
                  Failed err -> do
                      let msg = readInterfaceErrorDiagnostic err

compiler/GHC/Unit/Module/ModIface.hs

@@ -43,6 +43,7 @@ module GHC.Unit.Module.ModIface
       , mi_hash_fn
       )
    , pattern ModIface
+   , get_mi_mod_info
    , set_mi_mod_info
    , set_mi_module
    , set_mi_sig_of
@@ -978,6 +979,9 @@ completePublicModIface decls abi_hashes cache partial = partial
   , mi_caches_ = cache
   }
 
+get_mi_mod_info :: ModIface_ phase -> IfaceModInfo
+get_mi_mod_info iface = mi_mod_info_ iface
+
 set_mi_mod_info :: IfaceModInfo -> ModIface_ phase -> ModIface_ phase
 set_mi_mod_info val iface = clear_mi_hi_bytes $ iface { mi_mod_info_ = val }
 
@@ -1083,8 +1087,6 @@ set_mi_mod_info_field :: (IfaceModInfo -> IfaceModInfo) -> ModIface_ phase -> Mo
 set_mi_mod_info_field f iface = clear_mi_hi_bytes $ iface { mi_mod_info_ = f (mi_mod_info_ iface) }
 
 
-
-
 -- | Invalidate any byte array buffer we might have.
 clear_mi_hi_bytes :: ModIface_ phase -> ModIface_ phase
 clear_mi_hi_bytes iface = iface