never executed always true always false
1 -- | Module environment
2 module GHC.Unit.Module.Env
3 ( -- * Module mappings
4 ModuleEnv
5 , elemModuleEnv, extendModuleEnv, extendModuleEnvList
6 , extendModuleEnvList_C, plusModuleEnv_C
7 , delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv
8 , lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv
9 , moduleEnvKeys, moduleEnvElts, moduleEnvToList
10 , unitModuleEnv, isEmptyModuleEnv
11 , extendModuleEnvWith, filterModuleEnv
12
13 -- * ModuleName mappings
14 , ModuleNameEnv, DModuleNameEnv
15
16 -- * Sets of Modules
17 , ModuleSet
18 , emptyModuleSet, mkModuleSet, moduleSetElts
19 , extendModuleSet, extendModuleSetList, delModuleSet
20 , elemModuleSet, intersectModuleSet, minusModuleSet, unionModuleSet
21 , unitModuleSet
22
23 -- * InstalledModuleEnv
24 , InstalledModuleEnv
25 , emptyInstalledModuleEnv
26 , lookupInstalledModuleEnv
27 , extendInstalledModuleEnv
28 , filterInstalledModuleEnv
29 , delInstalledModuleEnv
30 )
31 where
32
33 import GHC.Prelude
34
35 import GHC.Unit.Module.Name (ModuleName)
36 import GHC.Types.Unique
37 import GHC.Types.Unique.FM
38 import GHC.Types.Unique.DFM
39 import GHC.Unit.Types
40 import GHC.Utils.Misc
41 import Data.List (sortBy, sort)
42 import Data.Ord
43
44 import Data.Coerce
45 import Data.Map (Map)
46 import Data.Set (Set)
47 import qualified Data.Map as Map
48 import qualified Data.Set as Set
49 import qualified GHC.Data.FiniteMap as Map
50
51 -- | A map keyed off of 'Module's
52 newtype ModuleEnv elt = ModuleEnv (Map NDModule elt)
53
54 {-
55 Note [ModuleEnv performance and determinism]
56 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
57 To prevent accidental reintroduction of nondeterminism the Ord instance
58 for Module was changed to not depend on Unique ordering and to use the
59 lexicographic order. This is potentially expensive, but when measured
60 there was no difference in performance.
61
62 To be on the safe side and not pessimize ModuleEnv uses nondeterministic
63 ordering on Module and normalizes by doing the lexicographic sort when
64 turning the env to a list.
65 See Note [Unique Determinism] for more information about the source of
66 nondeterminismand and Note [Deterministic UniqFM] for explanation of why
67 it matters for maps.
68 -}
69
70 newtype NDModule = NDModule { unNDModule :: Module }
71 deriving Eq
72 -- A wrapper for Module with faster nondeterministic Ord.
73 -- Don't export, See [ModuleEnv performance and determinism]
74
75 instance Ord NDModule where
76 compare (NDModule (Module p1 n1)) (NDModule (Module p2 n2)) =
77 (getUnique p1 `nonDetCmpUnique` getUnique p2) `thenCmp`
78 (getUnique n1 `nonDetCmpUnique` getUnique n2)
79
80 filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
81 filterModuleEnv f (ModuleEnv e) =
82 ModuleEnv (Map.filterWithKey (f . unNDModule) e)
83
84 elemModuleEnv :: Module -> ModuleEnv a -> Bool
85 elemModuleEnv m (ModuleEnv e) = Map.member (NDModule m) e
86
87 extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
88 extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert (NDModule m) x e)
89
90 extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a
91 -> ModuleEnv a
92 extendModuleEnvWith f (ModuleEnv e) m x =
93 ModuleEnv (Map.insertWith f (NDModule m) x e)
94
95 extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
96 extendModuleEnvList (ModuleEnv e) xs =
97 ModuleEnv (Map.insertList [(NDModule k, v) | (k,v) <- xs] e)
98
99 extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
100 -> ModuleEnv a
101 extendModuleEnvList_C f (ModuleEnv e) xs =
102 ModuleEnv (Map.insertListWith f [(NDModule k, v) | (k,v) <- xs] e)
103
104 plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
105 plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) =
106 ModuleEnv (Map.unionWith f e1 e2)
107
108 delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
109 delModuleEnvList (ModuleEnv e) ms =
110 ModuleEnv (Map.deleteList (map NDModule ms) e)
111
112 delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
113 delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete (NDModule m) e)
114
115 plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
116 plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
117
118 lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
119 lookupModuleEnv (ModuleEnv e) m = Map.lookup (NDModule m) e
120
121 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
122 lookupWithDefaultModuleEnv (ModuleEnv e) x m =
123 Map.findWithDefault x (NDModule m) e
124
125 mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
126 mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
127
128 mkModuleEnv :: [(Module, a)] -> ModuleEnv a
129 mkModuleEnv xs = ModuleEnv (Map.fromList [(NDModule k, v) | (k,v) <- xs])
130
131 emptyModuleEnv :: ModuleEnv a
132 emptyModuleEnv = ModuleEnv Map.empty
133
134 moduleEnvKeys :: ModuleEnv a -> [Module]
135 moduleEnvKeys (ModuleEnv e) = sort $ map unNDModule $ Map.keys e
136 -- See Note [ModuleEnv performance and determinism]
137
138 moduleEnvElts :: ModuleEnv a -> [a]
139 moduleEnvElts e = map snd $ moduleEnvToList e
140 -- See Note [ModuleEnv performance and determinism]
141
142 moduleEnvToList :: ModuleEnv a -> [(Module, a)]
143 moduleEnvToList (ModuleEnv e) =
144 sortBy (comparing fst) [(m, v) | (NDModule m, v) <- Map.toList e]
145 -- See Note [ModuleEnv performance and determinism]
146
147 unitModuleEnv :: Module -> a -> ModuleEnv a
148 unitModuleEnv m x = ModuleEnv (Map.singleton (NDModule m) x)
149
150 isEmptyModuleEnv :: ModuleEnv a -> Bool
151 isEmptyModuleEnv (ModuleEnv e) = Map.null e
152
153 -- | A set of 'Module's
154 type ModuleSet = Set NDModule
155
156 mkModuleSet :: [Module] -> ModuleSet
157 mkModuleSet = Set.fromList . coerce
158
159 extendModuleSet :: ModuleSet -> Module -> ModuleSet
160 extendModuleSet s m = Set.insert (NDModule m) s
161
162 extendModuleSetList :: ModuleSet -> [Module] -> ModuleSet
163 extendModuleSetList s ms = foldl' (coerce . flip Set.insert) s ms
164
165 emptyModuleSet :: ModuleSet
166 emptyModuleSet = Set.empty
167
168 moduleSetElts :: ModuleSet -> [Module]
169 moduleSetElts = sort . coerce . Set.toList
170
171 elemModuleSet :: Module -> ModuleSet -> Bool
172 elemModuleSet = Set.member . coerce
173
174 intersectModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
175 intersectModuleSet = coerce Set.intersection
176
177 minusModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
178 minusModuleSet = coerce Set.difference
179
180 delModuleSet :: ModuleSet -> Module -> ModuleSet
181 delModuleSet = coerce (flip Set.delete)
182
183 unionModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
184 unionModuleSet = coerce Set.union
185
186 unitModuleSet :: Module -> ModuleSet
187 unitModuleSet = coerce Set.singleton
188
189 {-
190 A ModuleName has a Unique, so we can build mappings of these using
191 UniqFM.
192 -}
193
194 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
195 type ModuleNameEnv elt = UniqFM ModuleName elt
196
197
198 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
199 -- Has deterministic folds and can be deterministically converted to a list
200 type DModuleNameEnv elt = UniqDFM ModuleName elt
201
202
203 --------------------------------------------------------------------
204 -- InstalledModuleEnv
205 --------------------------------------------------------------------
206
207 -- | A map keyed off of 'InstalledModule'
208 newtype InstalledModuleEnv elt = InstalledModuleEnv (Map InstalledModule elt)
209
210 emptyInstalledModuleEnv :: InstalledModuleEnv a
211 emptyInstalledModuleEnv = InstalledModuleEnv Map.empty
212
213 lookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a
214 lookupInstalledModuleEnv (InstalledModuleEnv e) m = Map.lookup m e
215
216 extendInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> a -> InstalledModuleEnv a
217 extendInstalledModuleEnv (InstalledModuleEnv e) m x = InstalledModuleEnv (Map.insert m x e)
218
219 filterInstalledModuleEnv :: (InstalledModule -> a -> Bool) -> InstalledModuleEnv a -> InstalledModuleEnv a
220 filterInstalledModuleEnv f (InstalledModuleEnv e) =
221 InstalledModuleEnv (Map.filterWithKey f e)
222
223 delInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
224 delInstalledModuleEnv (InstalledModuleEnv e) m = InstalledModuleEnv (Map.delete m e)
225