summaryrefslogtreecommitdiff
path: root/compiler/GHC/Unit/State.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Unit/State.hs')
-rw-r--r--compiler/GHC/Unit/State.hs40
1 files changed, 23 insertions, 17 deletions
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index e7ddf779f5..55855da61f 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -90,6 +90,7 @@ import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
import GHC.Types.Unique.Set
import GHC.Types.Unique.DSet
+import GHC.Types.PkgQual
import GHC.Utils.Misc
import GHC.Utils.Panic
@@ -1794,7 +1795,7 @@ lookupModuleInAllUnits :: UnitState
-> ModuleName
-> [(Module, UnitInfo)]
lookupModuleInAllUnits pkgs m
- = case lookupModuleWithSuggestions pkgs m Nothing of
+ = case lookupModuleWithSuggestions pkgs m NoPkgQual of
LookupFound a b -> [(a,fst b)]
LookupMultiple rs -> map f rs
where f (m,_) = (m, expectJust "lookupModule" (lookupUnit pkgs
@@ -1822,7 +1823,7 @@ data ModuleSuggestion = SuggestVisible ModuleName Module ModuleOrigin
lookupModuleWithSuggestions :: UnitState
-> ModuleName
- -> Maybe FastString
+ -> PkgQual
-> LookupResult
lookupModuleWithSuggestions pkgs
= lookupModuleWithSuggestions' pkgs (moduleNameProvidersMap pkgs)
@@ -1830,7 +1831,7 @@ lookupModuleWithSuggestions pkgs
-- | The package which the module **appears** to come from, this could be
-- the one which reexports the module from it's original package. This function
-- is currently only used for -Wunused-packages
-lookupModulePackage :: UnitState -> ModuleName -> Maybe FastString -> Maybe [UnitInfo]
+lookupModulePackage :: UnitState -> ModuleName -> PkgQual -> Maybe [UnitInfo]
lookupModulePackage pkgs mn mfs =
case lookupModuleWithSuggestions' pkgs (moduleNameProvidersMap pkgs) mn mfs of
LookupFound _ (orig_unit, origin) ->
@@ -1849,7 +1850,7 @@ lookupModulePackage pkgs mn mfs =
lookupPluginModuleWithSuggestions :: UnitState
-> ModuleName
- -> Maybe FastString
+ -> PkgQual
-> LookupResult
lookupPluginModuleWithSuggestions pkgs
= lookupModuleWithSuggestions' pkgs (pluginModuleNameProvidersMap pkgs)
@@ -1857,7 +1858,7 @@ lookupPluginModuleWithSuggestions pkgs
lookupModuleWithSuggestions' :: UnitState
-> ModuleNameProvidersMap
-> ModuleName
- -> Maybe FastString
+ -> PkgQual
-> LookupResult
lookupModuleWithSuggestions' pkgs mod_map m mb_pn
= case Map.lookup m mod_map of
@@ -1892,24 +1893,29 @@ lookupModuleWithSuggestions' pkgs mod_map m mb_pn
-- Filters out origins which are not associated with the given package
-- qualifier. No-op if there is no package qualifier. Test if this
-- excluded all origins with 'originEmpty'.
- filterOrigin :: Maybe FastString
+ filterOrigin :: PkgQual
-> UnitInfo
-> ModuleOrigin
-> ModuleOrigin
- filterOrigin Nothing _ o = o
- filterOrigin (Just pn) pkg o =
- case o of
- ModHidden -> if go pkg then ModHidden else mempty
- (ModUnusable _) -> if go pkg then o else mempty
+ filterOrigin NoPkgQual _ o = o
+ filterOrigin (ThisPkg _) _ o = o
+ filterOrigin (OtherPkg u) pkg o =
+ let match_pkg p = u == unitId p
+ in case o of
+ ModHidden
+ | match_pkg pkg -> ModHidden
+ | otherwise -> mempty
+ ModUnusable _
+ | match_pkg pkg -> o
+ | otherwise -> mempty
ModOrigin { fromOrigUnit = e, fromExposedReexport = res,
fromHiddenReexport = rhs }
- -> ModOrigin {
- fromOrigUnit = if go pkg then e else Nothing
- , fromExposedReexport = filter go res
- , fromHiddenReexport = filter go rhs
- , fromPackageFlag = False -- always excluded
+ -> ModOrigin
+ { fromOrigUnit = if match_pkg pkg then e else Nothing
+ , fromExposedReexport = filter match_pkg res
+ , fromHiddenReexport = filter match_pkg rhs
+ , fromPackageFlag = False -- always excluded
}
- where go pkg = pn == fsPackageName pkg
suggestions = fuzzyLookup (moduleNameString m) all_mods