diff options
Diffstat (limited to 'compiler/GHC/Unit/Finder.hs')
| -rw-r--r-- | compiler/GHC/Unit/Finder.hs | 253 |
1 files changed, 5 insertions, 248 deletions
diff --git a/compiler/GHC/Unit/Finder.hs b/compiler/GHC/Unit/Finder.hs index 36193fce94..130994b74b 100644 --- a/compiler/GHC/Unit/Finder.hs +++ b/compiler/GHC/Unit/Finder.hs @@ -29,9 +29,6 @@ module GHC.Unit.Finder ( findObjectLinkableMaybe, findObjectLinkable, - cannotFindModule, - cannotFindInterface, - ) where #include "HsVersions.h" @@ -198,14 +195,14 @@ findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString findExposedPackageModule hsc_env mod_name mb_pkg = findLookupResult hsc_env $ lookupModuleWithSuggestions - (unitState (hsc_dflags hsc_env)) mod_name mb_pkg + (hsc_units hsc_env) mod_name mb_pkg findExposedPluginPackageModule :: HscEnv -> ModuleName -> IO FindResult findExposedPluginPackageModule hsc_env mod_name = findLookupResult hsc_env $ lookupPluginModuleWithSuggestions - (unitState (hsc_dflags hsc_env)) mod_name Nothing + (hsc_units hsc_env) mod_name Nothing findLookupResult :: HscEnv -> LookupResult -> IO FindResult findLookupResult hsc_env r = case r of @@ -354,14 +351,10 @@ findInstalledHomeModule hsc_env mod_name = -- | Search for a module in external packages only. findPackageModule :: HscEnv -> InstalledModule -> IO InstalledFindResult findPackageModule hsc_env mod = do - let - dflags = hsc_dflags hsc_env - pkg_id = moduleUnit mod - pkgstate = unitState dflags - -- - case lookupUnitId pkgstate pkg_id of + let pkg_id = moduleUnit mod + case lookupUnitId (hsc_units hsc_env) pkg_id of Nothing -> return (InstalledNoPackage pkg_id) - Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf + Just u -> findPackageModule_ hsc_env mod u -- | Look up the interface file associated with module @mod@. This function -- requires a few invariants to be upheld: (1) the 'Module' in question must @@ -617,239 +610,3 @@ findObjectLinkable mod obj_fn obj_time = return (LM obj_time mod [DotO obj_fn]) -- We used to look for _stub.o files here, but that was a bug (#706) -- Now GHC merges the stub.o into the main .o (#3687) --- ----------------------------------------------------------------------------- --- Error messages - -cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc -cannotFindModule dflags mod res = pprWithUnitState unit_state $ - cantFindErr (sLit cannotFindMsg) - (sLit "Ambiguous module name") - dflags mod res - where - unit_state = unitState dflags - 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" - -cannotFindInterface :: DynFlags -> ModuleName -> InstalledFindResult -> SDoc -cannotFindInterface = cantFindInstalledErr (sLit "Failed to load interface for") - (sLit "Ambiguous interface for") - -cantFindErr :: PtrString -> PtrString -> DynFlags -> 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 cannot_find _ dflags mod_name find_result - = ptext cannot_find <+> quotes (ppr mod_name) - $$ more_info - where - pkgs = unitState dflags - home_unit = mkHomeUnitFromFlags dflags - 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 dflags - - | 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 dflags - - _ -> panic "cantFindErr" - - build_tag = waysBuildTag (ways dflags) - - 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 dflags - - | otherwise - = text "There are files missing in the " <> quotes (ppr pkg) <> - text " package," $$ - text "try running 'ghc-pkg check'." $$ - tried_these files dflags - - 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 - | gopt Opt_BuildingCabalPackage dflags - = let pkg = expectJust "pkg_hidden" (lookupUnit pkgs uid) - in text "Perhaps you need to add" <+> - quotes (ppr (unitPackageName pkg)) <+> - text "to the build-depends in your .cabal file." - | Just pkg <- lookupUnit pkgs 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 - -cantFindInstalledErr :: PtrString -> PtrString -> DynFlags -> ModuleName - -> InstalledFindResult -> SDoc -cantFindInstalledErr cannot_find _ dflags mod_name find_result - = ptext cannot_find <+> quotes (ppr mod_name) - $$ more_info - where - home_unit = mkHomeUnitFromFlags dflags - unit_state = unitState dflags - build_tag = waysBuildTag (ways dflags) - - 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 dflags - - _ -> 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 dflags - - | otherwise - = text "There are files missing in the " <> quotes (ppr pkg) <> - text " package," $$ - text "try running 'ghc-pkg check'." $$ - tried_these files dflags - -tried_these :: [FilePath] -> DynFlags -> SDoc -tried_these files dflags - | 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) |