| ... |
... |
@@ -63,7 +63,7 @@ import GHC.Driver.Session hiding (verbosity) |
|
63
|
63
|
import GHC.Driver.Phases
|
|
64
|
64
|
import GHC.Driver.Pipeline (compileFile)
|
|
65
|
65
|
import GHC.HsToCore.Docs (getMainDeclBinder)
|
|
66
|
|
-import GHC.Iface.Load (loadSysInterface)
|
|
|
66
|
+import GHC.Iface.Load (findAndReadIface)
|
|
67
|
67
|
import GHC.IfaceToCore (tcIfaceInst, tcIfaceFamInst)
|
|
68
|
68
|
import GHC.Tc.Utils.Monad (initIfaceLoad, initIfaceLcl)
|
|
69
|
69
|
import GHC.Tc.Utils.Env (lookupGlobal_maybe)
|
| ... |
... |
@@ -72,6 +72,7 @@ import GHC.Types.Name.Occurrence (emptyOccEnv) |
|
72
|
72
|
import GHC.Unit.Finder (findImportedModule, ModuleLookupScope(..), FindResult(Found))
|
|
73
|
73
|
import GHC.Unit.Home.ModInfo
|
|
74
|
74
|
import GHC.Unit.Home.PackageTable
|
|
|
75
|
+import GHC.Unit.Module (getModuleInstantiation)
|
|
75
|
76
|
import GHC.Unit.Module.Graph (ModuleGraphNode (..), ModuleNodeInfo(..))
|
|
76
|
77
|
import GHC.Unit.Module.ModDetails
|
|
77
|
78
|
import GHC.Unit.Module.ModIface (RetainedModIface, shrinkModIface, mi_semantic_module, mi_boot)
|
| ... |
... |
@@ -254,19 +255,20 @@ dropErr :: MaybeErr e a -> Maybe a |
|
254
|
255
|
dropErr (Succeeded a) = Just a
|
|
255
|
256
|
dropErr (Failed _) = Nothing
|
|
256
|
257
|
|
|
257
|
|
-loadHiFile :: HscEnv -> Outputable.SDoc -> Module -> IO (RetainedModIface, ([ClsInst], [FamInst]))
|
|
258
|
|
-loadHiFile hsc_env doc theModule = initIfaceLoad hsc_env $ do
|
|
259
|
|
-
|
|
260
|
|
- mod_iface <- loadSysInterface doc theModule
|
|
261
|
|
-
|
|
262
|
|
- insts <- initIfaceLcl (mi_semantic_module mod_iface) doc (mi_boot mod_iface) $ do
|
|
263
|
|
-
|
|
264
|
|
- new_eps_insts <- mapM tcIfaceInst (mi_insts mod_iface)
|
|
265
|
|
- new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts mod_iface)
|
|
266
|
|
-
|
|
267
|
|
- pure (new_eps_insts, new_eps_fam_insts)
|
|
268
|
|
-
|
|
269
|
|
- pure (mod_iface, insts)
|
|
|
258
|
+loadHiFile :: Verbosity -> HscEnv -> Outputable.SDoc -> Module -> IO (RetainedModIface, ([ClsInst], [FamInst]))
|
|
|
259
|
+loadHiFile verbosity hsc_env doc requested = initIfaceLoad hsc_env $ do
|
|
|
260
|
+ let installed = fst (getModuleInstantiation requested)
|
|
|
261
|
+ iface_fetch_result <- liftIO $ findAndReadIface hsc_env doc installed requested NotBoot
|
|
|
262
|
+ case iface_fetch_result of
|
|
|
263
|
+ Failed _ -> do
|
|
|
264
|
+ out verbosity normal "Interface fetching failed"
|
|
|
265
|
+ liftIO exitFailure
|
|
|
266
|
+ Succeeded (mod_iface, _) -> do
|
|
|
267
|
+ insts <- initIfaceLcl (mi_semantic_module mod_iface) doc (mi_boot mod_iface) $ do
|
|
|
268
|
+ new_eps_insts <- mapM tcIfaceInst (mi_insts mod_iface)
|
|
|
269
|
+ new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts mod_iface)
|
|
|
270
|
+ pure (new_eps_insts, new_eps_fam_insts)
|
|
|
271
|
+ pure (shrinkModIface mod_iface, insts)
|
|
270
|
272
|
|
|
271
|
273
|
processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -> WarningMap -> Ghc (Maybe Interface)
|
|
272
|
274
|
processModule verbosity modSummary flags ifaceMap instIfaceMap warningMap = do
|
| ... |
... |
@@ -279,7 +281,7 @@ processModule verbosity modSummary flags ifaceMap instIfaceMap warningMap = do |
|
279
|
281
|
unit_state = hsc_units hsc_env
|
|
280
|
282
|
|
|
281
|
283
|
(mod_iface, insts) <- if Flag_NoCompilation `elem` flags
|
|
282
|
|
- then liftIO $ loadHiFile hsc_env doc $ ms_mod modSummary
|
|
|
284
|
+ then liftIO $ loadHiFile verbosity hsc_env doc $ ms_mod modSummary
|
|
283
|
285
|
else do
|
|
284
|
286
|
hmi <- liftIO $ lookupHpt (hsc_HPT hsc_env) (moduleName $ ms_mod modSummary) >>= \case
|
|
285
|
287
|
Nothing -> error "processModule: All modules should be loaded into the HPT by this point"
|
| ... |
... |
@@ -374,7 +376,7 @@ createOneShotIface verbosity flags instIfaceMap moduleNameStr = do |
|
374
|
376
|
modifySession $ hscSetFlags dflags
|
|
375
|
377
|
hsc_env <- getSession
|
|
376
|
378
|
|
|
377
|
|
- (iface, insts) <- liftIO $ loadHiFile hsc_env doc $ mkMainModule_ moduleNm
|
|
|
379
|
+ (iface, insts) <- liftIO $ loadHiFile verbosity hsc_env doc $ mkMainModule_ moduleNm
|
|
378
|
380
|
|
|
379
|
381
|
-- Update the DynFlags with the extensions from the source file (as stored in the interface file)
|
|
380
|
382
|
-- This is instead of ms_hspp_opts from ModSummary, which is not available in one-shot mode.
|