diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2021-08-06 18:35:06 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-11-20 05:35:42 -0500 |
commit | bdeea37efc76bc22a0d2e17f66dbf2ae8ad556fc (patch) | |
tree | ed1e62d7f2d34e4c77ff650828de872fb8daeb7a /compiler/GHC/Driver | |
parent | 3d6b78dbd19f9061387c60e553638f9c26839d50 (diff) | |
download | haskell-bdeea37efc76bc22a0d2e17f66dbf2ae8ad556fc.tar.gz |
More support for optional home-unit
This is a preliminary refactoring for #14335 (supporting plugins in
cross-compilers). In many places the home-unit must be optional because
there won't be one available in the plugin environment (we won't be
compiling anything in this environment). Hence we replace "HomeUnit"
with "Maybe HomeUnit" in a few places and we avoid the use of
"hsc_home_unit" (which is partial) in some few others.
Diffstat (limited to 'compiler/GHC/Driver')
-rw-r--r-- | compiler/GHC/Driver/Make.hs | 28 | ||||
-rw-r--r-- | compiler/GHC/Driver/MakeFile.hs | 13 |
2 files changed, 22 insertions, 19 deletions
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index 2c86b3c22b..4aa38ff0f6 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -111,6 +111,7 @@ import GHC.Types.Name.Env import GHC.Types.PkgQual import GHC.Unit +import GHC.Unit.Env import GHC.Unit.Finder import GHC.Unit.Module.ModSummary import GHC.Unit.Module.ModIface @@ -1815,11 +1816,11 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) | otherwise = find_it where - dflags = hsc_dflags hsc_env - fopts = initFinderOpts dflags - home_unit = hsc_home_unit hsc_env - fc = hsc_FC hsc_env - units = hsc_units hsc_env + dflags = hsc_dflags hsc_env + fopts = initFinderOpts dflags + mhome_unit = ue_home_unit (hsc_unit_env hsc_env) + fc = hsc_FC hsc_env + units = hsc_units hsc_env check_hash old_summary location src_fn = checkSummaryHash @@ -1828,7 +1829,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) old_summary location find_it = do - found <- findImportedModule fc fopts units home_unit wanted_mod NoPkgQual + found <- findImportedModule fc fopts units mhome_unit wanted_mod NoPkgQual case found of Found location mod | isJust (ml_hs_file location) -> @@ -1876,10 +1877,10 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc $ DriverFileModuleNameMismatch pi_mod_name wanted_mod - when (hsc_src == HsigFile && isNothing (lookup pi_mod_name (homeUnitInstantiations home_unit))) $ - let instantiations = homeUnitInstantiations home_unit - in throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc - $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations + let instantiations = fromMaybe [] (homeUnitInstantiations <$> mhome_unit) + when (hsc_src == HsigFile && isNothing (lookup pi_mod_name instantiations)) $ + throwE $ singleMessage $ mkPlainErrorMsgEnvelope pi_mod_name_loc + $ DriverUnexpectedSignature pi_mod_name (checkBuildingCabalPackage dflags) instantiations liftIO $ makeNewModSummary hsc_env $ MakeNewModSummary { nms_src_fn = src_fn @@ -2186,12 +2187,13 @@ executeCompileNode :: Int executeCompileNode k n !old_hmi wait_deps mknot_var mod = do MakeEnv{..} <- ask let mk_mod = case ms_hsc_src mod of - HsigFile -> + HsigFile -> do -- MP: It is probably a bit of a misimplementation in backpack that -- compiling a signature requires an knot_var for that unit. -- If you remove this then a lot of backpack tests fail. - let mod_name = homeModuleInstantiation (hsc_home_unit hsc_env) (ms_mod mod) - in mkModuleEnv . (:[]) . (mod_name,) <$> newIORef emptyTypeEnv + let unit_env = hsc_unit_env hsc_env + let mod_name = homeModuleInstantiation (ue_home_unit unit_env) (ms_mod mod) + mkModuleEnv . (:[]) . (mod_name,) <$> newIORef emptyTypeEnv _ -> return emptyModuleEnv knot_var <- liftIO $ maybe mk_mod return mknot_var deps <- wait_deps diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs index 9cf23af831..ffe5a73399 100644 --- a/compiler/GHC/Driver/MakeFile.hs +++ b/compiler/GHC/Driver/MakeFile.hs @@ -36,6 +36,7 @@ import GHC.Utils.TmpFs import GHC.Iface.Load (cannotFindModule) +import GHC.Unit.Env import GHC.Unit.Module import GHC.Unit.Module.ModSummary import GHC.Unit.Module.Graph @@ -290,14 +291,14 @@ findDependency :: HscEnv -> Bool -- Record dependency on package modules -> IO (Maybe FilePath) -- Interface file findDependency hsc_env srcloc pkg imp is_boot include_pkg_deps = do - let fc = hsc_FC hsc_env - let home_unit = hsc_home_unit hsc_env - let units = hsc_units hsc_env - let dflags = hsc_dflags hsc_env - let fopts = initFinderOpts dflags + let fc = hsc_FC hsc_env + let mhome_unit = ue_home_unit (hsc_unit_env hsc_env) + let units = hsc_units hsc_env + let dflags = hsc_dflags hsc_env + let fopts = initFinderOpts dflags -- Find the module; this will be fast because -- we've done it once during downsweep - r <- findImportedModule fc fopts units home_unit imp pkg + r <- findImportedModule fc fopts units mhome_unit imp pkg case r of Found loc _ -- Home package: just depend on the .hi or hi-boot file |