-- | Module environment
module GHC.Unit.Module.Env
   ( -- * Module mappings
     ModuleEnv
   , elemModuleEnv, extendModuleEnv, extendModuleEnvList
   , extendModuleEnvList_C, plusModuleEnv_C
   , delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv
   , lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv
   , moduleEnvKeys, moduleEnvElts, moduleEnvToList
   , unitModuleEnv, isEmptyModuleEnv
   , extendModuleEnvWith, filterModuleEnv

     -- * ModuleName mappings
   , ModuleNameEnv, DModuleNameEnv

     -- * Sets of Modules
   , ModuleSet
   , emptyModuleSet, mkModuleSet, moduleSetElts
   , extendModuleSet, extendModuleSetList, delModuleSet
   , elemModuleSet, intersectModuleSet, minusModuleSet, unionModuleSet
   , unitModuleSet

     -- * InstalledModuleEnv
   , InstalledModuleEnv
   , emptyInstalledModuleEnv
   , lookupInstalledModuleEnv
   , extendInstalledModuleEnv
   , filterInstalledModuleEnv
   , delInstalledModuleEnv
   )
where

import GHC.Prelude

import GHC.Unit.Module.Name (ModuleName)
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
import GHC.Unit.Types
import GHC.Utils.Misc
import Data.List (sortBy, sort)
import Data.Ord

import Data.Coerce
import Data.Map (Map)
import Data.Set (Set)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified GHC.Data.FiniteMap as Map

-- | A map keyed off of 'Module's
newtype ModuleEnv elt = ModuleEnv (Map NDModule elt)

{-
Note [ModuleEnv performance and determinism]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
To prevent accidental reintroduction of nondeterminism the Ord instance
for Module was changed to not depend on Unique ordering and to use the
lexicographic order. This is potentially expensive, but when measured
there was no difference in performance.

To be on the safe side and not pessimize ModuleEnv uses nondeterministic
ordering on Module and normalizes by doing the lexicographic sort when
turning the env to a list.
See Note [Unique Determinism] for more information about the source of
nondeterminismand and Note [Deterministic UniqFM] for explanation of why
it matters for maps.
-}

newtype NDModule = NDModule { NDModule -> Module
unNDModule :: Module }
  deriving NDModule -> NDModule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NDModule -> NDModule -> Bool
$c/= :: NDModule -> NDModule -> Bool
== :: NDModule -> NDModule -> Bool
$c== :: NDModule -> NDModule -> Bool
Eq
  -- A wrapper for Module with faster nondeterministic Ord.
  -- Don't export, See [ModuleEnv performance and determinism]

instance Ord NDModule where
  compare :: NDModule -> NDModule -> Ordering
compare (NDModule (Module GenUnit UnitId
p1 ModuleName
n1)) (NDModule (Module GenUnit UnitId
p2 ModuleName
n2)) =
    (forall a. Uniquable a => a -> Unique
getUnique GenUnit UnitId
p1 Unique -> Unique -> Ordering
`nonDetCmpUnique` forall a. Uniquable a => a -> Unique
getUnique GenUnit UnitId
p2) Ordering -> Ordering -> Ordering
`thenCmp`
    (forall a. Uniquable a => a -> Unique
getUnique ModuleName
n1 Unique -> Unique -> Ordering
`nonDetCmpUnique` forall a. Uniquable a => a -> Unique
getUnique ModuleName
n2)

filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
filterModuleEnv :: forall a. (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
filterModuleEnv Module -> a -> Bool
f (ModuleEnv Map NDModule a
e) =
  forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (Module -> a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. NDModule -> Module
unNDModule) Map NDModule a
e)

elemModuleEnv :: Module -> ModuleEnv a -> Bool
elemModuleEnv :: forall a. Module -> ModuleEnv a -> Bool
elemModuleEnv Module
m (ModuleEnv Map NDModule a
e) = forall k a. Ord k => k -> Map k a -> Bool
Map.member (Module -> NDModule
NDModule Module
m) Map NDModule a
e

extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv :: forall a. ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv (ModuleEnv Map NDModule a
e) Module
m a
x = forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Module -> NDModule
NDModule Module
m) a
x Map NDModule a
e)

extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a
                    -> ModuleEnv a
extendModuleEnvWith :: forall a.
(a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnvWith a -> a -> a
f (ModuleEnv Map NDModule a
e) Module
m a
x =
  forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith a -> a -> a
f (Module -> NDModule
NDModule Module
m) a
x Map NDModule a
e)

extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
extendModuleEnvList :: forall a. ModuleEnv a -> [(Module, a)] -> ModuleEnv a
extendModuleEnvList (ModuleEnv Map NDModule a
e) [(Module, a)]
xs =
  forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (forall key elt.
Ord key =>
[(key, elt)] -> Map key elt -> Map key elt
Map.insertList [(Module -> NDModule
NDModule Module
k, a
v) | (Module
k,a
v) <- [(Module, a)]
xs] Map NDModule a
e)

extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
                      -> ModuleEnv a
extendModuleEnvList_C :: forall a.
(a -> a -> a) -> ModuleEnv a -> [(Module, a)] -> ModuleEnv a
extendModuleEnvList_C a -> a -> a
f (ModuleEnv Map NDModule a
e) [(Module, a)]
xs =
  forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (forall key elt.
Ord key =>
(elt -> elt -> elt) -> [(key, elt)] -> Map key elt -> Map key elt
Map.insertListWith a -> a -> a
f [(Module -> NDModule
NDModule Module
k, a
v) | (Module
k,a
v) <- [(Module, a)]
xs] Map NDModule a
e)

plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
plusModuleEnv_C :: forall a.
(a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
plusModuleEnv_C a -> a -> a
f (ModuleEnv Map NDModule a
e1) (ModuleEnv Map NDModule a
e2) =
  forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith a -> a -> a
f Map NDModule a
e1 Map NDModule a
e2)

delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
delModuleEnvList :: forall a. ModuleEnv a -> [Module] -> ModuleEnv a
delModuleEnvList (ModuleEnv Map NDModule a
e) [Module]
ms =
  forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (forall key elt. Ord key => [key] -> Map key elt -> Map key elt
Map.deleteList (forall a b. (a -> b) -> [a] -> [b]
map Module -> NDModule
NDModule [Module]
ms) Map NDModule a
e)

delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
delModuleEnv :: forall a. ModuleEnv a -> Module -> ModuleEnv a
delModuleEnv (ModuleEnv Map NDModule a
e) Module
m = forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (Module -> NDModule
NDModule Module
m) Map NDModule a
e)

plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
plusModuleEnv :: forall a. ModuleEnv a -> ModuleEnv a -> ModuleEnv a
plusModuleEnv (ModuleEnv Map NDModule a
e1) (ModuleEnv Map NDModule a
e2) = forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map NDModule a
e1 Map NDModule a
e2)

lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
lookupModuleEnv :: forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv (ModuleEnv Map NDModule a
e) Module
m = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Module -> NDModule
NDModule Module
m) Map NDModule a
e

lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
lookupWithDefaultModuleEnv :: forall a. ModuleEnv a -> a -> Module -> a
lookupWithDefaultModuleEnv (ModuleEnv Map NDModule a
e) a
x Module
m =
  forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault a
x (Module -> NDModule
NDModule Module
m) Map NDModule a
e

mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
mapModuleEnv :: forall a b. (a -> b) -> ModuleEnv a -> ModuleEnv b
mapModuleEnv a -> b
f (ModuleEnv Map NDModule a
e) = forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\NDModule
_ a
v -> a -> b
f a
v) Map NDModule a
e)

mkModuleEnv :: [(Module, a)] -> ModuleEnv a
mkModuleEnv :: forall a. [(Module, a)] -> ModuleEnv a
mkModuleEnv [(Module, a)]
xs = forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Module -> NDModule
NDModule Module
k, a
v) | (Module
k,a
v) <- [(Module, a)]
xs])

emptyModuleEnv :: ModuleEnv a
emptyModuleEnv :: forall a. ModuleEnv a
emptyModuleEnv = forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv forall k a. Map k a
Map.empty

moduleEnvKeys :: ModuleEnv a -> [Module]
moduleEnvKeys :: forall a. ModuleEnv a -> [Module]
moduleEnvKeys (ModuleEnv Map NDModule a
e) = forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map NDModule -> Module
unNDModule forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys Map NDModule a
e
  -- See Note [ModuleEnv performance and determinism]

moduleEnvElts :: ModuleEnv a -> [a]
moduleEnvElts :: forall a. ModuleEnv a -> [a]
moduleEnvElts ModuleEnv a
e = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. ModuleEnv a -> [(Module, a)]
moduleEnvToList ModuleEnv a
e
  -- See Note [ModuleEnv performance and determinism]

moduleEnvToList :: ModuleEnv a -> [(Module, a)]
moduleEnvToList :: forall a. ModuleEnv a -> [(Module, a)]
moduleEnvToList (ModuleEnv Map NDModule a
e) =
  forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst) [(Module
m, a
v) | (NDModule Module
m, a
v) <- forall k a. Map k a -> [(k, a)]
Map.toList Map NDModule a
e]
  -- See Note [ModuleEnv performance and determinism]

unitModuleEnv :: Module -> a -> ModuleEnv a
unitModuleEnv :: forall a. Module -> a -> ModuleEnv a
unitModuleEnv Module
m a
x = forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (forall k a. k -> a -> Map k a
Map.singleton (Module -> NDModule
NDModule Module
m) a
x)

isEmptyModuleEnv :: ModuleEnv a -> Bool
isEmptyModuleEnv :: forall a. ModuleEnv a -> Bool
isEmptyModuleEnv (ModuleEnv Map NDModule a
e) = forall k a. Map k a -> Bool
Map.null Map NDModule a
e

-- | A set of 'Module's
type ModuleSet = Set NDModule

mkModuleSet :: [Module] -> ModuleSet
mkModuleSet :: [Module] -> Set NDModule
mkModuleSet = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce

extendModuleSet :: ModuleSet -> Module -> ModuleSet
extendModuleSet :: Set NDModule -> Module -> Set NDModule
extendModuleSet Set NDModule
s Module
m = forall a. Ord a => a -> Set a -> Set a
Set.insert (Module -> NDModule
NDModule Module
m) Set NDModule
s

extendModuleSetList :: ModuleSet -> [Module] -> ModuleSet
extendModuleSetList :: Set NDModule -> [Module] -> Set NDModule
extendModuleSetList Set NDModule
s [Module]
ms = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Set a
Set.insert) Set NDModule
s [Module]
ms

emptyModuleSet :: ModuleSet
emptyModuleSet :: Set NDModule
emptyModuleSet = forall a. Set a
Set.empty

moduleSetElts :: ModuleSet -> [Module]
moduleSetElts :: Set NDModule -> [Module]
moduleSetElts = forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList

elemModuleSet :: Module -> ModuleSet -> Bool
elemModuleSet :: Module -> Set NDModule -> Bool
elemModuleSet = forall a. Ord a => a -> Set a -> Bool
Set.member forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce

intersectModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
intersectModuleSet :: Set NDModule -> Set NDModule -> Set NDModule
intersectModuleSet = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => Set a -> Set a -> Set a
Set.intersection

minusModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
minusModuleSet :: Set NDModule -> Set NDModule -> Set NDModule
minusModuleSet = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => Set a -> Set a -> Set a
Set.difference

delModuleSet :: ModuleSet -> Module -> ModuleSet
delModuleSet :: Set NDModule -> Module -> Set NDModule
delModuleSet = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Set a
Set.delete)

unionModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
unionModuleSet :: Set NDModule -> Set NDModule -> Set NDModule
unionModuleSet = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. Ord a => Set a -> Set a -> Set a
Set.union

unitModuleSet :: Module -> ModuleSet
unitModuleSet :: Module -> Set NDModule
unitModuleSet = coerce :: forall a b. Coercible a b => a -> b
coerce forall a. a -> Set a
Set.singleton

{-
A ModuleName has a Unique, so we can build mappings of these using
UniqFM.
-}

-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
type ModuleNameEnv elt = UniqFM ModuleName elt


-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
-- Has deterministic folds and can be deterministically converted to a list
type DModuleNameEnv elt = UniqDFM ModuleName elt


--------------------------------------------------------------------
-- InstalledModuleEnv
--------------------------------------------------------------------

-- | A map keyed off of 'InstalledModule'
newtype InstalledModuleEnv elt = InstalledModuleEnv (Map InstalledModule elt)

emptyInstalledModuleEnv :: InstalledModuleEnv a
emptyInstalledModuleEnv :: forall a. InstalledModuleEnv a
emptyInstalledModuleEnv = forall elt. Map InstalledModule elt -> InstalledModuleEnv elt
InstalledModuleEnv forall k a. Map k a
Map.empty

lookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a
lookupInstalledModuleEnv :: forall a. InstalledModuleEnv a -> InstalledModule -> Maybe a
lookupInstalledModuleEnv (InstalledModuleEnv Map InstalledModule a
e) InstalledModule
m = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup InstalledModule
m Map InstalledModule a
e

extendInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> a -> InstalledModuleEnv a
extendInstalledModuleEnv :: forall a.
InstalledModuleEnv a
-> InstalledModule -> a -> InstalledModuleEnv a
extendInstalledModuleEnv (InstalledModuleEnv Map InstalledModule a
e) InstalledModule
m a
x = forall elt. Map InstalledModule elt -> InstalledModuleEnv elt
InstalledModuleEnv (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert InstalledModule
m a
x Map InstalledModule a
e)

filterInstalledModuleEnv :: (InstalledModule -> a -> Bool) -> InstalledModuleEnv a -> InstalledModuleEnv a
filterInstalledModuleEnv :: forall a.
(InstalledModule -> a -> Bool)
-> InstalledModuleEnv a -> InstalledModuleEnv a
filterInstalledModuleEnv InstalledModule -> a -> Bool
f (InstalledModuleEnv Map InstalledModule a
e) =
  forall elt. Map InstalledModule elt -> InstalledModuleEnv elt
InstalledModuleEnv (forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey InstalledModule -> a -> Bool
f Map InstalledModule a
e)

delInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
delInstalledModuleEnv :: forall a.
InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
delInstalledModuleEnv (InstalledModuleEnv Map InstalledModule a
e) InstalledModule
m = forall elt. Map InstalledModule elt -> InstalledModuleEnv elt
InstalledModuleEnv (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete InstalledModule
m Map InstalledModule a
e)