diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-11-12 10:36:58 +0100 |
---|---|---|
committer | Sylvain Henry <sylvain@haskus.fr> | 2020-12-14 19:45:13 +0100 |
commit | d0e8c10d587e4b9984526d0dfcfcb258b75733b8 (patch) | |
tree | e0993719d76f87a0f4f8eccef089526217bf5bb4 /compiler/GHC/Iface | |
parent | 92377c27e1a48d0d3776f65c7074dfeb122b46db (diff) | |
download | haskell-d0e8c10d587e4b9984526d0dfcfcb258b75733b8.tar.gz |
Move Unit related fields from DynFlags to HscEnv
The unit database cache, the home unit and the unit state were stored in
DynFlags while they ought to be stored in the compiler session state
(HscEnv). This patch fixes this.
It introduces a new UnitEnv type that should be used in the future to
handle separate unit environments (especially host vs target units).
Related to #17957
Bump haddock submodule
Diffstat (limited to 'compiler/GHC/Iface')
-rw-r--r-- | compiler/GHC/Iface/Load.hs | 336 | ||||
-rw-r--r-- | compiler/GHC/Iface/Make.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Iface/Recomp.hs | 10 | ||||
-rw-r--r-- | compiler/GHC/Iface/Recomp/Flags.hs | 11 | ||||
-rw-r--r-- | compiler/GHC/Iface/Rename.hs | 22 | ||||
-rw-r--r-- | compiler/GHC/Iface/Tidy.hs | 5 |
6 files changed, 334 insertions, 54 deletions
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs index 4fb775db53..e7833d8145 100644 --- a/compiler/GHC/Iface/Load.hs +++ b/compiler/GHC/Iface/Load.hs @@ -7,6 +7,7 @@ {-# LANGUAGE CPP, BangPatterns, RecordWildCards, NondecreasingIndentation #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -30,12 +31,16 @@ module GHC.Iface.Load ( needWiredInHomeIface, loadWiredInHomeIface, pprModIfaceSimple, - ifaceStats, pprModIface, showIface + ifaceStats, pprModIface, showIface, + + cannotFindModule ) where #include "HsVersions.h" import GHC.Prelude +import GHC.Platform.Ways +import GHC.Platform.Profile import {-# SOURCE #-} GHC.IfaceToCore ( tcIfaceDecls, tcIfaceRules, tcIfaceInst, tcIfaceFamInst @@ -99,6 +104,7 @@ import GHC.Unit.State import GHC.Unit.Home import GHC.Unit.Home.ModInfo import GHC.Unit.Finder +import GHC.Unit.Env import GHC.Data.Maybe import GHC.Data.FastString @@ -310,7 +316,7 @@ loadSrcInterface_maybe doc mod want_boot maybe_pkg ; case res of Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot) -- TODO: Make sure this error message is good - err -> return (Failed (cannotFindModule (hsc_dflags hsc_env) mod err)) } + err -> return (Failed (cannotFindModule hsc_env mod err)) } -- | Load interface directly for a fully qualified 'Module'. (This is a fairly -- rare operation, but in particular it is used to load orphan modules @@ -839,7 +845,7 @@ findAndReadIface doc_str mod wanted_mod_with_insts hi_boot_file -- Look for the file hsc_env <- getTopEnv mb_found <- liftIO (findExactModule hsc_env mod) - let home_unit = hsc_home_unit hsc_env + let home_unit = hsc_home_unit hsc_env case mb_found of InstalledFound loc mod -> do -- Found file, so read it @@ -855,20 +861,25 @@ findAndReadIface doc_str mod wanted_mod_with_insts hi_boot_file return r err -> do traceIf (text "...not found") - dflags <- getDynFlags - return (Failed (cannotFindInterface dflags - (moduleName mod) err)) + hsc_env <- getTopEnv + let profile = Profile (targetPlatform dflags) (ways dflags) + return $ Failed $ cannotFindInterface + (hsc_unit_env hsc_env) + profile + (may_show_locations (hsc_dflags hsc_env)) + (moduleName mod) + err where read_file file_path = do traceIf (text "readIFace" <+> text file_path) -- Figure out what is recorded in mi_module. If this is -- a fully definite interface, it'll match exactly, but -- if it's indefinite, the inside will be uninstantiated! - dflags <- getDynFlags + unit_state <- hsc_units <$> getTopEnv let wanted_mod = case getModuleInstantiation wanted_mod_with_insts of (_, Nothing) -> wanted_mod_with_insts (_, Just indef_mod) -> - instModuleToModule (unitState dflags) + instModuleToModule unit_state (uninstantiateInstantiatedModule indef_mod) read_result <- readIface wanted_mod file_path case read_result of @@ -946,8 +957,8 @@ readIface wanted_mod file_path ********************************************************* -} -initExternalPackageState :: HomeUnit -> ExternalPackageState -initExternalPackageState home_unit +initExternalPackageState :: UnitId -> ExternalPackageState +initExternalPackageState home_unit_id = EPS { eps_is_boot = emptyUFM, eps_PIT = emptyPackageIfaceTable, @@ -966,9 +977,9 @@ initExternalPackageState home_unit } where enableBignumRules - | isHomeUnitInstanceOf home_unit primUnitId = EnableBignumRules False - | isHomeUnitInstanceOf home_unit bignumUnitId = EnableBignumRules False - | otherwise = EnableBignumRules True + | home_unit_id == primUnitId = EnableBignumRules False + | home_unit_id == bignumUnitId = EnableBignumRules False + | otherwise = EnableBignumRules True builtinRules' = builtinRules enableBignumRules {- @@ -1042,7 +1053,7 @@ For some background on this choice see trac #15269. showIface :: HscEnv -> FilePath -> IO () showIface hsc_env filename = do let dflags = hsc_dflags hsc_env - unit_state = unitState dflags + unit_state = hsc_units hsc_env printer = putLogMsg dflags NoReason SevOutput noSrcSpan . withPprStyle defaultDumpStyle -- skip the hi way check; we don't want to worry about profiled vs. @@ -1059,17 +1070,21 @@ showIface hsc_env filename = do neverQualifyPackages putLogMsg dflags NoReason SevDump noSrcSpan $ withPprStyle (mkDumpStyle print_unqual) - $ pprWithUnitState unit_state - $ pprModIface iface + $ pprModIface unit_state iface --- Show a ModIface but don't display details; suitable for ModIfaces stored in +-- | Show a ModIface but don't display details; suitable for ModIfaces stored in -- the EPT. -pprModIfaceSimple :: ModIface -> SDoc -pprModIfaceSimple iface = ppr (mi_module iface) $$ pprDeps (mi_deps iface) $$ nest 2 (vcat (map pprExport (mi_exports iface))) +pprModIfaceSimple :: UnitState -> ModIface -> SDoc +pprModIfaceSimple unit_state iface = + ppr (mi_module iface) + $$ pprDeps unit_state (mi_deps iface) + $$ nest 2 (vcat (map pprExport (mi_exports iface))) -pprModIface :: ModIface -> SDoc --- Show a ModIface -pprModIface iface@ModIface{ mi_final_exts = exts } +-- | Show a ModIface +-- +-- The UnitState is used to pretty-print units +pprModIface :: UnitState -> ModIface -> SDoc +pprModIface unit_state iface@ModIface{ mi_final_exts = exts } = vcat [ text "interface" <+> ppr (mi_module iface) <+> pp_hsc_src (mi_hsc_src iface) <+> (if mi_orphan exts then text "[orphan module]" else Outputable.empty) @@ -1089,7 +1104,7 @@ pprModIface iface@ModIface{ mi_final_exts = exts } , nest 2 (text "where") , text "exports:" , nest 2 (vcat (map pprExport (mi_exports iface))) - , pprDeps (mi_deps iface) + , pprDeps unit_state (mi_deps iface) , vcat (map pprUsage (mi_usages iface)) , vcat (map pprIfaceAnnotation (mi_anns iface)) , pprFixities (mi_fixities iface) @@ -1153,10 +1168,12 @@ pprUsageImport usage usg_mod' safe | usg_safe usage = text "safe" | otherwise = text " -/ " -pprDeps :: Dependencies -> SDoc -pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs, - dep_finsts = finsts }) - = vcat [text "module dependencies:" <+> fsep (map ppr_mod mods), +-- | Pretty-print unit dependencies +pprDeps :: UnitState -> Dependencies -> SDoc +pprDeps unit_state (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs, + dep_finsts = finsts }) + = pprWithUnitState unit_state $ + vcat [text "module dependencies:" <+> fsep (map ppr_mod mods), text "package dependencies:" <+> fsep (map ppr_pkg pkgs), text "orphans:" <+> fsep (map ppr orphs), text "family instance modules:" <+> fsep (map ppr finsts) @@ -1242,3 +1259,268 @@ homeModError mod location Just file -> space <> parens (text file) Nothing -> Outputable.empty) <+> text "which is not loaded" + + +-- ----------------------------------------------------------------------------- +-- Error messages + +cannotFindInterface :: UnitEnv -> Profile -> ([FilePath] -> SDoc) -> ModuleName -> InstalledFindResult -> SDoc +cannotFindInterface = cantFindInstalledErr (sLit "Failed to load interface for") + (sLit "Ambiguous interface for") + +cantFindInstalledErr + :: PtrString + -> PtrString + -> UnitEnv + -> Profile + -> ([FilePath] -> SDoc) + -> ModuleName + -> InstalledFindResult + -> SDoc +cantFindInstalledErr cannot_find _ unit_env profile tried_these mod_name find_result + = ptext cannot_find <+> quotes (ppr mod_name) + $$ more_info + where + home_unit = ue_home_unit unit_env + unit_state = ue_units unit_env + build_tag = waysBuildTag (profileWays profile) + + more_info + = case find_result of + InstalledNoPackage pkg + -> text "no unit id matching" <+> quotes (ppr pkg) <+> + text "was found" $$ looks_like_srcpkgid pkg + + InstalledNotFound files mb_pkg + | Just pkg <- mb_pkg, not (isHomeUnitId home_unit pkg) + -> not_found_in_package pkg files + + | null files + -> text "It is not a module in the current program, or in any known package." + + | otherwise + -> tried_these files + + _ -> panic "cantFindInstalledErr" + + looks_like_srcpkgid :: UnitId -> SDoc + looks_like_srcpkgid pk + -- Unsafely coerce a unit id (i.e. an installed package component + -- identifier) into a PackageId and see if it means anything. + | (pkg:pkgs) <- searchPackageId unit_state (PackageId (unitIdFS pk)) + = parens (text "This unit ID looks like the source package ID;" $$ + text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$ + (if null pkgs then Outputable.empty + else text "and" <+> int (length pkgs) <+> text "other candidates")) + -- Todo: also check if it looks like a package name! + | otherwise = Outputable.empty + + not_found_in_package pkg files + | build_tag /= "" + = let + build = if build_tag == "p" then "profiling" + else "\"" ++ build_tag ++ "\"" + in + text "Perhaps you haven't installed the " <> text build <> + text " libraries for package " <> quotes (ppr pkg) <> char '?' $$ + tried_these files + + | otherwise + = text "There are files missing in the " <> quotes (ppr pkg) <> + text " package," $$ + text "try running 'ghc-pkg check'." $$ + tried_these files + +may_show_locations :: DynFlags -> [FilePath] -> SDoc +may_show_locations dflags files + | null files = Outputable.empty + | verbosity dflags < 3 = + text "Use -v (or `:set -v` in ghci) " <> + text "to see a list of the files searched for." + | otherwise = + hang (text "Locations searched:") 2 $ vcat (map text files) + +cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc +cannotFindModule hsc_env = cannotFindModule' + (hsc_dflags hsc_env) + (hsc_unit_env hsc_env) + (targetProfile (hsc_dflags hsc_env)) + + +cannotFindModule' :: DynFlags -> UnitEnv -> Profile -> ModuleName -> FindResult -> SDoc +cannotFindModule' dflags unit_env profile mod res = pprWithUnitState (ue_units unit_env) $ + cantFindErr (gopt Opt_BuildingCabalPackage dflags) + (sLit cannotFindMsg) + (sLit "Ambiguous module name") + unit_env + profile + (may_show_locations dflags) + mod + res + where + cannotFindMsg = + case res of + NotFound { fr_mods_hidden = hidden_mods + , fr_pkgs_hidden = hidden_pkgs + , fr_unusables = unusables } + | not (null hidden_mods && null hidden_pkgs && null unusables) + -> "Could not load module" + _ -> "Could not find module" + +cantFindErr + :: Bool -- ^ Using Cabal? + -> PtrString + -> PtrString + -> UnitEnv + -> Profile + -> ([FilePath] -> SDoc) + -> ModuleName + -> FindResult + -> SDoc +cantFindErr _ _ multiple_found _ _ _ mod_name (FoundMultiple mods) + | Just pkgs <- unambiguousPackages + = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 ( + sep [text "it was found in multiple packages:", + hsep (map ppr pkgs) ] + ) + | otherwise + = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 ( + vcat (map pprMod mods) + ) + where + unambiguousPackages = foldl' unambiguousPackage (Just []) mods + unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _) + = Just (moduleUnit m : xs) + unambiguousPackage _ _ = Nothing + + pprMod (m, o) = text "it is bound as" <+> ppr m <+> + text "by" <+> pprOrigin m o + pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden" + pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable" + pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma ( + if e == Just True + then [text "package" <+> ppr (moduleUnit m)] + else [] ++ + map ((text "a reexport in package" <+>) + .ppr.mkUnit) res ++ + if f then [text "a package flag"] else [] + ) + +cantFindErr using_cabal cannot_find _ unit_env profile tried_these mod_name find_result + = ptext cannot_find <+> quotes (ppr mod_name) + $$ more_info + where + home_unit = ue_home_unit unit_env + more_info + = case find_result of + NoPackage pkg + -> text "no unit id matching" <+> quotes (ppr pkg) <+> + text "was found" + + NotFound { fr_paths = files, fr_pkg = mb_pkg + , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens + , fr_unusables = unusables, fr_suggestions = suggest } + | Just pkg <- mb_pkg, not (isHomeUnit home_unit pkg) + -> not_found_in_package pkg files + + | not (null suggest) + -> pp_suggestions suggest $$ tried_these files + + | null files && null mod_hiddens && + null pkg_hiddens && null unusables + -> text "It is not a module in the current program, or in any known package." + + | otherwise + -> vcat (map pkg_hidden pkg_hiddens) $$ + vcat (map mod_hidden mod_hiddens) $$ + vcat (map unusable unusables) $$ + tried_these files + + _ -> panic "cantFindErr" + + build_tag = waysBuildTag (profileWays profile) + + not_found_in_package pkg files + | build_tag /= "" + = let + build = if build_tag == "p" then "profiling" + else "\"" ++ build_tag ++ "\"" + in + text "Perhaps you haven't installed the " <> text build <> + text " libraries for package " <> quotes (ppr pkg) <> char '?' $$ + tried_these files + + | otherwise + = text "There are files missing in the " <> quotes (ppr pkg) <> + text " package," $$ + text "try running 'ghc-pkg check'." $$ + tried_these files + + pkg_hidden :: Unit -> SDoc + pkg_hidden uid = + text "It is a member of the hidden package" + <+> quotes (ppr uid) + --FIXME: we don't really want to show the unit id here we should + -- show the source package id or installed package id if it's ambiguous + <> dot $$ pkg_hidden_hint uid + + pkg_hidden_hint uid + | using_cabal + = let pkg = expectJust "pkg_hidden" (lookupUnit (ue_units unit_env) uid) + in text "Perhaps you need to add" <+> + quotes (ppr (unitPackageName pkg)) <+> + text "to the build-depends in your .cabal file." + | Just pkg <- lookupUnit (ue_units unit_env) uid + = text "You can run" <+> + quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+> + text "to expose it." $$ + text "(Note: this unloads all the modules in the current scope.)" + | otherwise = Outputable.empty + + mod_hidden pkg = + text "it is a hidden module in the package" <+> quotes (ppr pkg) + + unusable (pkg, reason) + = text "It is a member of the package" + <+> quotes (ppr pkg) + $$ pprReason (text "which is") reason + + pp_suggestions :: [ModuleSuggestion] -> SDoc + pp_suggestions sugs + | null sugs = Outputable.empty + | otherwise = hang (text "Perhaps you meant") + 2 (vcat (map pp_sugg sugs)) + + -- NB: Prefer the *original* location, and then reexports, and then + -- package flags when making suggestions. ToDo: if the original package + -- also has a reexport, prefer that one + pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o + where provenance ModHidden = Outputable.empty + provenance (ModUnusable _) = Outputable.empty + provenance (ModOrigin{ fromOrigUnit = e, + fromExposedReexport = res, + fromPackageFlag = f }) + | Just True <- e + = parens (text "from" <+> ppr (moduleUnit mod)) + | f && moduleName mod == m + = parens (text "from" <+> ppr (moduleUnit mod)) + | (pkg:_) <- res + = parens (text "from" <+> ppr (mkUnit pkg) + <> comma <+> text "reexporting" <+> ppr mod) + | f + = parens (text "defined via package flags to be" + <+> ppr mod) + | otherwise = Outputable.empty + pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o + where provenance ModHidden = Outputable.empty + provenance (ModUnusable _) = Outputable.empty + provenance (ModOrigin{ fromOrigUnit = e, + fromHiddenReexport = rhs }) + | Just False <- e + = parens (text "needs flag -package-id" + <+> ppr (moduleUnit mod)) + | (pkg:_) <- rhs + = parens (text "needs flag -package-id" + <+> ppr (mkUnit pkg)) + | otherwise = Outputable.empty + diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs index f333525e4b..a37ce7516a 100644 --- a/compiler/GHC/Iface/Make.hs +++ b/compiler/GHC/Iface/Make.hs @@ -146,9 +146,9 @@ mkFullIface hsc_env partial_iface mb_cg_infos = do addFingerprints hsc_env partial_iface{ mi_decls = decls } -- Debug printing - let unit_state = unitState (hsc_dflags hsc_env) + let unit_state = hsc_units hsc_env dumpIfSet_dyn (hsc_dflags hsc_env) Opt_D_dump_hi "FINAL INTERFACE" FormatText - (pprWithUnitState unit_state $ pprModIface full_iface) + (pprModIface unit_state full_iface) return full_iface diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs index fe0f4439f5..4c529cde83 100644 --- a/compiler/GHC/Iface/Recomp.hs +++ b/compiler/GHC/Iface/Recomp.hs @@ -377,7 +377,7 @@ checkHie mod_summary = do checkFlagHash :: HscEnv -> ModIface -> IfG RecompileRequired checkFlagHash hsc_env iface = do let old_hash = mi_flag_hash (mi_final_exts iface) - new_hash <- liftIO $ fingerprintDynFlags (hsc_dflags hsc_env) + new_hash <- liftIO $ fingerprintDynFlags hsc_env (mi_module iface) putNameLiterally case old_hash == new_hash of @@ -420,12 +420,12 @@ checkHpcHash hsc_env iface = do -- If the -unit-id flags change, this can change too. checkMergedSignatures :: ModSummary -> ModIface -> IfG RecompileRequired checkMergedSignatures mod_summary iface = do - dflags <- getDynFlags + unit_state <- hsc_units <$> getTopEnv let old_merged = sort [ mod | UsageMergedRequirement{ usg_mod = mod } <- mi_usages iface ] new_merged = case Map.lookup (ms_mod_name mod_summary) - (requirementContext (unitState dflags)) of + (requirementContext unit_state) of Nothing -> [] - Just r -> sort $ map (instModuleToModule (unitState dflags)) r + Just r -> sort $ map (instModuleToModule unit_state) r if old_merged == new_merged then up_to_date (text "signatures to merge in unchanged" $$ ppr new_merged) else return (RecompBecause "signatures to merge in changed") @@ -1061,7 +1061,7 @@ addFingerprints hsc_env iface0 -- - (some of) dflags -- it returns two hashes, one that shouldn't change -- the abi hash and one that should - flag_hash <- fingerprintDynFlags dflags this_mod putNameLiterally + flag_hash <- fingerprintDynFlags hsc_env this_mod putNameLiterally opt_hash <- fingerprintOptFlags dflags putNameLiterally diff --git a/compiler/GHC/Iface/Recomp/Flags.hs b/compiler/GHC/Iface/Recomp/Flags.hs index 1c52f4e326..4e9003944d 100644 --- a/compiler/GHC/Iface/Recomp/Flags.hs +++ b/compiler/GHC/Iface/Recomp/Flags.hs @@ -10,8 +10,10 @@ module GHC.Iface.Recomp.Flags ( import GHC.Prelude -import GHC.Utils.Binary import GHC.Driver.Session +import GHC.Driver.Env + +import GHC.Utils.Binary import GHC.Unit.Module import GHC.Types.Name import GHC.Types.SafeHaskell @@ -29,12 +31,13 @@ import System.FilePath (normalise) -- NB: The 'Module' parameter is the 'Module' recorded by the -- *interface* file, not the actual 'Module' according to our -- 'DynFlags'. -fingerprintDynFlags :: DynFlags -> Module +fingerprintDynFlags :: HscEnv -> Module -> (BinHandle -> Name -> IO ()) -> IO Fingerprint -fingerprintDynFlags dflags@DynFlags{..} this_mod nameio = - let mainis = if mainModIs dflags == this_mod then Just mainFunIs else Nothing +fingerprintDynFlags hsc_env this_mod nameio = + let dflags@DynFlags{..} = hsc_dflags hsc_env + mainis = if mainModIs hsc_env == this_mod then Just mainFunIs else Nothing -- see #5878 -- pkgopts = (homeUnit home_unit, sort $ packageFlags dflags) safeHs = setSafeMode safeHaskell diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs index 4bd9867617..66a8b477f1 100644 --- a/compiler/GHC/Iface/Rename.hs +++ b/compiler/GHC/Iface/Rename.hs @@ -145,7 +145,6 @@ rnDepModules sel deps = do -- because ModIface will never contain module reference for itself -- in these dependencies. fmap (nubSort . concat) . T.forM (sel deps) $ \mod -> do - dflags <- getDynFlags -- For holes, its necessary to "see through" the instantiation -- of the hole to get accurate family instance dependencies. -- For example, if B imports <A>, and <A> is instantiated with @@ -170,7 +169,7 @@ rnDepModules sel deps = do -- not to do it in this case either...) -- -- This mistake was bug #15594. - let mod' = renameHoleModule (unitState dflags) hmap mod + let mod' = renameHoleModule (hsc_units hsc_env) hmap mod if isHoleModule mod then do iface <- liftIO . initIfaceCheck (text "rnDepModule") hsc_env $ loadSysInterface (text "rnDepModule") mod' @@ -190,9 +189,8 @@ initRnIface :: HscEnv -> ModIface -> [(ModuleName, Module)] -> Maybe NameShape -> ShIfM a -> IO (Either ErrorMessages a) initRnIface hsc_env iface insts nsubst do_this = do errs_var <- newIORef emptyBag - let dflags = hsc_dflags hsc_env - hsubst = listToUFM insts - rn_mod = renameHoleModule (unitState dflags) hsubst + let hsubst = listToUFM insts + rn_mod = renameHoleModule (hsc_units hsc_env) hsubst env = ShIfEnv { sh_if_module = rn_mod (mi_module iface), sh_if_semantic_module = rn_mod (mi_semantic_module iface), @@ -238,8 +236,8 @@ type Rename a = a -> ShIfM a rnModule :: Rename Module rnModule mod = do hmap <- getHoleSubst - dflags <- getDynFlags - return (renameHoleModule (unitState dflags) hmap mod) + unit_state <- hsc_units <$> getTopEnv + return (renameHoleModule unit_state hmap mod) rnAvailInfo :: Rename AvailInfo rnAvailInfo (Avail n) = Avail <$> rnIfaceGlobal n @@ -303,13 +301,13 @@ rnFieldLabel (FieldLabel l b sel) = do rnIfaceGlobal :: Name -> ShIfM Name rnIfaceGlobal n = do hsc_env <- getTopEnv - let dflags = hsc_dflags hsc_env - home_unit = hsc_home_unit hsc_env + let unit_state = hsc_units hsc_env + home_unit = hsc_home_unit hsc_env iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv mb_nsubst <- fmap sh_if_shape getGblEnv hmap <- getHoleSubst let m = nameModule n - m' = renameHoleModule (unitState dflags) hmap m + m' = renameHoleModule unit_state hmap m case () of -- Did we encounter {A.T} while renaming p[A=<B>]:A? If so, -- do NOT assume B.hi is available. @@ -368,9 +366,9 @@ rnIfaceGlobal n = do rnIfaceNeverExported :: Name -> ShIfM Name rnIfaceNeverExported name = do hmap <- getHoleSubst - dflags <- getDynFlags + unit_state <- hsc_units <$> getTopEnv iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv - let m = renameHoleModule (unitState dflags) hmap $ nameModule name + let m = renameHoleModule unit_state hmap $ nameModule name -- Doublecheck that this DFun/coercion axiom was, indeed, locally defined. MASSERT2( iface_semantic_mod == m, ppr iface_semantic_mod <+> ppr m ) setNameModule (Just m) name diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs index 10d0eb1d04..7283f78666 100644 --- a/compiler/GHC/Iface/Tidy.hs +++ b/compiler/GHC/Iface/Tidy.hs @@ -384,10 +384,7 @@ tidyProgram hsc_env (ModGuts { mg_module = mod (const ()) $ do { let { omit_prags = gopt Opt_OmitInterfacePragmas dflags ; expose_all = gopt Opt_ExposeAllUnfoldings dflags - ; print_unqual = mkPrintUnqualified - (unitState dflags) - (hsc_home_unit hsc_env) - rdr_env + ; print_unqual = mkPrintUnqualified (hsc_unit_env hsc_env) rdr_env ; implicit_binds = concatMap getImplicitBinds tcs } |