diff options
Diffstat (limited to 'compiler/GHC/Iface/Load.hs')
| -rw-r--r-- | compiler/GHC/Iface/Load.hs | 336 |
1 files changed, 309 insertions, 27 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 + |