module GHC.Unit.External.Providers (
ModuleNameProvidersMap,
pprModuleMap,
mkModuleNameProvidersMap,
mkUnusableModuleNameProvidersMap,
) where
import GHC.Prelude
import GHC.Data.Maybe
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Unique.Map
import GHC.Unit.External.ModuleOrigin
import GHC.Unit.External.Query
import GHC.Unit.External.Validate
import GHC.Unit.External.Visibility
import GHC.Unit.Info
import GHC.Unit.Module
import GHC.Utils.Error
import GHC.Utils.Logger
import GHC.Utils.Outputable
import GHC.Utils.Panic
type ModuleNameProvidersMap =
UniqMap ModuleName (UniqMap Module ModuleOrigin)
pprModuleMap :: ModuleNameProvidersMap -> SDoc
pprModuleMap :: ModuleNameProvidersMap -> SDoc
pprModuleMap ModuleNameProvidersMap
mod_map =
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (((ModuleName, UniqMap Module ModuleOrigin) -> SDoc)
-> [(ModuleName, UniqMap Module ModuleOrigin)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, UniqMap Module ModuleOrigin) -> SDoc
forall {a}. Outputable a => (ModuleName, UniqMap Module a) -> SDoc
pprLine (ModuleNameProvidersMap
-> [(ModuleName, UniqMap Module ModuleOrigin)]
forall k a. UniqMap k a -> [(k, a)]
nonDetUniqMapToList ModuleNameProvidersMap
mod_map))
where
pprLine :: (ModuleName, UniqMap Module a) -> SDoc
pprLine (ModuleName
m,UniqMap Module a
e) = ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
50 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (((Module, a) -> SDoc) -> [(Module, a)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName -> (Module, a) -> SDoc
forall a. Outputable a => ModuleName -> (Module, a) -> SDoc
pprEntry ModuleName
m) (UniqMap Module a -> [(Module, a)]
forall k a. UniqMap k a -> [(k, a)]
nonDetUniqMapToList UniqMap Module a
e)))
pprEntry :: Outputable a => ModuleName -> (Module, a) -> SDoc
pprEntry :: forall a. Outputable a => ModuleName -> (Module, a) -> SDoc
pprEntry ModuleName
m (Module
m',a
o)
| ModuleName
m ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
m' = Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
m') SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
o)
| Bool
otherwise = Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
o)
mkModuleNameProvidersMap
:: Logger
-> Bool
-> UnitInfoMap
-> VisibilityMap
-> ModuleNameProvidersMap
mkModuleNameProvidersMap :: Logger
-> Bool -> UnitInfoMap -> VisibilityMap -> ModuleNameProvidersMap
mkModuleNameProvidersMap Logger
logger Bool
allowVirtualUnits UnitInfoMap
pkg_map VisibilityMap
vis_map =
((Unit, UnitVisibility)
-> ModuleNameProvidersMap -> ModuleNameProvidersMap)
-> ModuleNameProvidersMap
-> VisibilityMap
-> ModuleNameProvidersMap
forall k a b. ((k, a) -> b -> b) -> b -> UniqMap k a -> b
nonDetFoldUniqMap (Unit, UnitVisibility)
-> ModuleNameProvidersMap -> ModuleNameProvidersMap
extend_modmap ModuleNameProvidersMap
forall {k} {a}. UniqMap k a
emptyMap VisibilityMap
vis_map_extended
where
vis_map_extended :: VisibilityMap
vis_map_extended = VisibilityMap
default_vis VisibilityMap -> VisibilityMap -> VisibilityMap
forall k a. UniqMap k a -> UniqMap k a -> UniqMap k a
`plusUniqMap` VisibilityMap
vis_map
default_vis :: VisibilityMap
default_vis = [(Unit, UnitVisibility)] -> VisibilityMap
forall k a. Uniquable k => [(k, a)] -> UniqMap k a
listToUniqMap
[ (UnitInfo -> Unit
mkUnit UnitInfo
pkg, UnitVisibility
forall a. Monoid a => a
mempty)
| (UnitId
_, UnitInfo
pkg) <- UnitInfoMap -> [(UnitId, UnitInfo)]
forall k a. UniqMap k a -> [(k, a)]
nonDetUniqMapToList UnitInfoMap
pkg_map
, UnitInfo -> Bool
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
unitIsIndefinite UnitInfo
pkg Bool -> Bool -> Bool
|| [(ModuleName, Module)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (UnitInfo -> [(ModuleName, Module)]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [(modulename, mod)]
unitInstantiations UnitInfo
pkg)
]
emptyMap :: UniqMap k a
emptyMap = UniqMap k a
forall {k} {a}. UniqMap k a
emptyUniqMap
setOrigins :: f a -> b -> f b
setOrigins f a
m b
os = (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> a -> b
forall a b. a -> b -> a
const b
os) f a
m
extend_modmap :: (Unit, UnitVisibility)
-> ModuleNameProvidersMap -> ModuleNameProvidersMap
extend_modmap (Unit
uid, UnitVisibility { uv_expose_all :: UnitVisibility -> Bool
uv_expose_all = Bool
b, uv_renamings :: UnitVisibility -> [(ModuleName, ModuleName)]
uv_renamings = [(ModuleName, ModuleName)]
rns }) ModuleNameProvidersMap
modmap
= ModuleNameProvidersMap
-> [(ModuleName, UniqMap Module ModuleOrigin)]
-> ModuleNameProvidersMap
forall a k1 k2.
(Monoid a, Ord k1, Ord k2, Uniquable k1, Uniquable k2) =>
UniqMap k1 (UniqMap k2 a)
-> [(k1, UniqMap k2 a)] -> UniqMap k1 (UniqMap k2 a)
addListTo ModuleNameProvidersMap
modmap [(ModuleName, UniqMap Module ModuleOrigin)]
theBindings
where
pkg :: UnitInfo
pkg = Unit -> UnitInfo
unit_lookup Unit
uid
theBindings :: [(ModuleName, UniqMap Module ModuleOrigin)]
theBindings :: [(ModuleName, UniqMap Module ModuleOrigin)]
theBindings = Bool
-> [(ModuleName, ModuleName)]
-> [(ModuleName, UniqMap Module ModuleOrigin)]
newBindings Bool
b [(ModuleName, ModuleName)]
rns
newBindings :: Bool
-> [(ModuleName, ModuleName)]
-> [(ModuleName, UniqMap Module ModuleOrigin)]
newBindings :: Bool
-> [(ModuleName, ModuleName)]
-> [(ModuleName, UniqMap Module ModuleOrigin)]
newBindings Bool
e [(ModuleName, ModuleName)]
rns = Bool -> [(ModuleName, UniqMap Module ModuleOrigin)]
es Bool
e [(ModuleName, UniqMap Module ModuleOrigin)]
-> [(ModuleName, UniqMap Module ModuleOrigin)]
-> [(ModuleName, UniqMap Module ModuleOrigin)]
forall a. [a] -> [a] -> [a]
++ [(ModuleName, UniqMap Module ModuleOrigin)]
hiddens [(ModuleName, UniqMap Module ModuleOrigin)]
-> [(ModuleName, UniqMap Module ModuleOrigin)]
-> [(ModuleName, UniqMap Module ModuleOrigin)]
forall a. [a] -> [a] -> [a]
++ ((ModuleName, ModuleName)
-> (ModuleName, UniqMap Module ModuleOrigin))
-> [(ModuleName, ModuleName)]
-> [(ModuleName, UniqMap Module ModuleOrigin)]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, ModuleName)
-> (ModuleName, UniqMap Module ModuleOrigin)
rnBinding [(ModuleName, ModuleName)]
rns
rnBinding :: (ModuleName, ModuleName)
-> (ModuleName, UniqMap Module ModuleOrigin)
rnBinding :: (ModuleName, ModuleName)
-> (ModuleName, UniqMap Module ModuleOrigin)
rnBinding (ModuleName
orig, ModuleName
new) = (ModuleName
new, UniqMap Module ModuleOrigin
-> ModuleOrigin -> UniqMap Module ModuleOrigin
forall {f :: * -> *} {a} {b}. Functor f => f a -> b -> f b
setOrigins UniqMap Module ModuleOrigin
origEntry ModuleOrigin
fromFlag)
where origEntry :: UniqMap Module ModuleOrigin
origEntry = case UniqFM ModuleName (UniqMap Module ModuleOrigin)
-> ModuleName -> Maybe (UniqMap Module ModuleOrigin)
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM ModuleName (UniqMap Module ModuleOrigin)
esmap ModuleName
orig of
Just UniqMap Module ModuleOrigin
r -> UniqMap Module ModuleOrigin
r
Maybe (UniqMap Module ModuleOrigin)
Nothing -> GhcException -> UniqMap Module ModuleOrigin
forall a. HasCallStack => GhcException -> a
throwGhcException (String -> GhcException
CmdLineError (SDocContext -> SDoc -> String
renderWithContext
(LogFlags -> SDocContext
log_default_user_context (Logger -> LogFlags
logFlags Logger
logger))
(String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"package flag: could not find module name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
orig SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in package" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unit
pk)))
es :: Bool -> [(ModuleName, UniqMap Module ModuleOrigin)]
es :: Bool -> [(ModuleName, UniqMap Module ModuleOrigin)]
es Bool
e = do
(m, exposedReexport) <- [(ModuleName, Maybe Module)]
exposed_mods
let (pk', m', origin') =
case exposedReexport of
Maybe Module
Nothing -> (Unit
pk, ModuleName
m, Bool -> ModuleOrigin
fromExposedModules Bool
e)
Just (Module Unit
pk' ModuleName
m') ->
(Unit
pk', ModuleName
m', Bool -> UnitInfo -> ModuleOrigin
fromReexportedModules Bool
e UnitInfo
pkg)
return (m, mkModMap pk' m' origin')
esmap :: UniqFM ModuleName (UniqMap Module ModuleOrigin)
esmap :: UniqFM ModuleName (UniqMap Module ModuleOrigin)
esmap = [(ModuleName, UniqMap Module ModuleOrigin)]
-> UniqFM ModuleName (UniqMap Module ModuleOrigin)
forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
listToUFM (Bool -> [(ModuleName, UniqMap Module ModuleOrigin)]
es Bool
False)
hiddens :: [(ModuleName, UniqMap Module ModuleOrigin)]
hiddens = [(ModuleName
m, Unit -> ModuleName -> ModuleOrigin -> UniqMap Module ModuleOrigin
mkModMap Unit
pk ModuleName
m ModuleOrigin
ModHidden) | ModuleName
m <- [ModuleName]
hidden_mods]
pk :: Unit
pk = UnitInfo -> Unit
mkUnit UnitInfo
pkg
unit_lookup :: Unit -> UnitInfo
unit_lookup Unit
uid = Bool -> UnitInfoMap -> Unit -> Maybe UnitInfo
lookupUnit' Bool
allowVirtualUnits UnitInfoMap
pkg_map Unit
uid
Maybe UnitInfo -> UnitInfo -> UnitInfo
forall a. Maybe a -> a -> a
`orElse` String -> SDoc -> UnitInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"unit_lookup" (Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unit
uid)
exposed_mods :: [(ModuleName, Maybe Module)]
exposed_mods = UnitInfo -> [(ModuleName, Maybe Module)]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [(modulename, Maybe mod)]
unitExposedModules UnitInfo
pkg
hidden_mods :: [ModuleName]
hidden_mods = UnitInfo -> [ModuleName]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [modulename]
unitHiddenModules UnitInfo
pkg
mkUnusableModuleNameProvidersMap :: UnusableUnits -> ModuleNameProvidersMap
mkUnusableModuleNameProvidersMap :: UnusableUnits -> ModuleNameProvidersMap
mkUnusableModuleNameProvidersMap UnusableUnits
unusables =
((UnitId, (UnitInfo, UnusableUnitReason))
-> ModuleNameProvidersMap -> ModuleNameProvidersMap)
-> ModuleNameProvidersMap
-> UnusableUnits
-> ModuleNameProvidersMap
forall k a b. ((k, a) -> b -> b) -> b -> UniqMap k a -> b
nonDetFoldUniqMap (UnitId, (UnitInfo, UnusableUnitReason))
-> ModuleNameProvidersMap -> ModuleNameProvidersMap
forall {a}.
(a, (UnitInfo, UnusableUnitReason))
-> ModuleNameProvidersMap -> ModuleNameProvidersMap
extend_modmap ModuleNameProvidersMap
forall {k} {a}. UniqMap k a
emptyUniqMap UnusableUnits
unusables
where
extend_modmap :: (a, (UnitInfo, UnusableUnitReason))
-> ModuleNameProvidersMap -> ModuleNameProvidersMap
extend_modmap (a
_uid, (UnitInfo
unit_info, UnusableUnitReason
reason)) ModuleNameProvidersMap
modmap = ModuleNameProvidersMap
-> [(ModuleName, UniqMap Module ModuleOrigin)]
-> ModuleNameProvidersMap
forall a k1 k2.
(Monoid a, Ord k1, Ord k2, Uniquable k1, Uniquable k2) =>
UniqMap k1 (UniqMap k2 a)
-> [(k1, UniqMap k2 a)] -> UniqMap k1 (UniqMap k2 a)
addListTo ModuleNameProvidersMap
modmap [(ModuleName, UniqMap Module ModuleOrigin)]
bindings
where bindings :: [(ModuleName, UniqMap Module ModuleOrigin)]
bindings :: [(ModuleName, UniqMap Module ModuleOrigin)]
bindings = [(ModuleName, UniqMap Module ModuleOrigin)]
exposed [(ModuleName, UniqMap Module ModuleOrigin)]
-> [(ModuleName, UniqMap Module ModuleOrigin)]
-> [(ModuleName, UniqMap Module ModuleOrigin)]
forall a. [a] -> [a] -> [a]
++ [(ModuleName, UniqMap Module ModuleOrigin)]
hidden
origin_reexport :: ModuleOrigin
origin_reexport = UnusableUnit -> ModuleOrigin
ModUnusable (Unit -> UnusableUnitReason -> Bool -> UnusableUnit
UnusableUnit Unit
unit UnusableUnitReason
reason Bool
True)
origin_normal :: ModuleOrigin
origin_normal = UnusableUnit -> ModuleOrigin
ModUnusable (Unit -> UnusableUnitReason -> Bool -> UnusableUnit
UnusableUnit Unit
unit UnusableUnitReason
reason Bool
False)
unit :: Unit
unit = UnitInfo -> Unit
mkUnit UnitInfo
unit_info
exposed :: [(ModuleName, UniqMap Module ModuleOrigin)]
exposed = ((ModuleName, Maybe Module)
-> (ModuleName, UniqMap Module ModuleOrigin))
-> [(ModuleName, Maybe Module)]
-> [(ModuleName, UniqMap Module ModuleOrigin)]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, Maybe Module)
-> (ModuleName, UniqMap Module ModuleOrigin)
get_exposed [(ModuleName, Maybe Module)]
exposed_mods
hidden :: [(ModuleName, UniqMap Module ModuleOrigin)]
hidden = [(ModuleName
m, Unit -> ModuleName -> ModuleOrigin -> UniqMap Module ModuleOrigin
mkModMap Unit
unit ModuleName
m ModuleOrigin
origin_normal) | ModuleName
m <- [ModuleName]
hidden_mods]
get_exposed :: (ModuleName, Maybe Module)
-> (ModuleName, UniqMap Module ModuleOrigin)
get_exposed (ModuleName
mod, Just Module
_) = (ModuleName
mod, Unit -> ModuleName -> ModuleOrigin -> UniqMap Module ModuleOrigin
mkModMap Unit
unit ModuleName
mod ModuleOrigin
origin_reexport)
get_exposed (ModuleName
mod, Maybe Module
_) = (ModuleName
mod, Unit -> ModuleName -> ModuleOrigin -> UniqMap Module ModuleOrigin
mkModMap Unit
unit ModuleName
mod ModuleOrigin
origin_normal)
exposed_mods :: [(ModuleName, Maybe Module)]
exposed_mods = UnitInfo -> [(ModuleName, Maybe Module)]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [(modulename, Maybe mod)]
unitExposedModules UnitInfo
unit_info
hidden_mods :: [ModuleName]
hidden_mods = UnitInfo -> [ModuleName]
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> [modulename]
unitHiddenModules UnitInfo
unit_info
addListTo :: (Monoid a, Ord k1, Ord k2, Uniquable k1, Uniquable k2)
=> UniqMap k1 (UniqMap k2 a)
-> [(k1, UniqMap k2 a)]
-> UniqMap k1 (UniqMap k2 a)
addListTo :: forall a k1 k2.
(Monoid a, Ord k1, Ord k2, Uniquable k1, Uniquable k2) =>
UniqMap k1 (UniqMap k2 a)
-> [(k1, UniqMap k2 a)] -> UniqMap k1 (UniqMap k2 a)
addListTo = (UniqMap k1 (UniqMap k2 a)
-> (k1, UniqMap k2 a) -> UniqMap k1 (UniqMap k2 a))
-> UniqMap k1 (UniqMap k2 a)
-> [(k1, UniqMap k2 a)]
-> UniqMap k1 (UniqMap k2 a)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' UniqMap k1 (UniqMap k2 a)
-> (k1, UniqMap k2 a) -> UniqMap k1 (UniqMap k2 a)
forall {k} {a} {k}.
(Uniquable k, Monoid a) =>
UniqMap k (UniqMap k a)
-> (k, UniqMap k a) -> UniqMap k (UniqMap k a)
merge
where merge :: UniqMap k (UniqMap k a)
-> (k, UniqMap k a) -> UniqMap k (UniqMap k a)
merge UniqMap k (UniqMap k a)
m (k
k, UniqMap k a
v) = (UniqMap k a -> UniqMap k a -> UniqMap k a)
-> UniqMap k (UniqMap k a)
-> k
-> UniqMap k a
-> UniqMap k (UniqMap k a)
forall k a.
Uniquable k =>
(a -> a -> a) -> UniqMap k a -> k -> a -> UniqMap k a
addToUniqMap_C ((a -> a -> a) -> UniqMap k a -> UniqMap k a -> UniqMap k a
forall a k.
(a -> a -> a) -> UniqMap k a -> UniqMap k a -> UniqMap k a
plusUniqMap_C a -> a -> a
forall a. Monoid a => a -> a -> a
mappend) UniqMap k (UniqMap k a)
m k
k UniqMap k a
v
mkModMap :: Unit -> ModuleName -> ModuleOrigin -> UniqMap Module ModuleOrigin
mkModMap :: Unit -> ModuleName -> ModuleOrigin -> UniqMap Module ModuleOrigin
mkModMap Unit
pkg ModuleName
mod = Module -> ModuleOrigin -> UniqMap Module ModuleOrigin
forall k a. Uniquable k => k -> a -> UniqMap k a
unitUniqMap (Unit -> ModuleName -> Module
forall u. u -> ModuleName -> GenModule u
mkModule Unit
pkg ModuleName
mod)