1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
|
-- | 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.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 { unNDModule :: Module }
deriving Eq
-- A wrapper for Module with faster nondeterministic Ord.
-- Don't export, See [ModuleEnv performance and determinism]
instance Ord NDModule where
compare (NDModule (Module p1 n1)) (NDModule (Module p2 n2)) =
(getUnique p1 `nonDetCmpUnique` getUnique p2) `thenCmp`
(getUnique n1 `nonDetCmpUnique` getUnique n2)
filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
filterModuleEnv f (ModuleEnv e) =
ModuleEnv (Map.filterWithKey (f . unNDModule) e)
elemModuleEnv :: Module -> ModuleEnv a -> Bool
elemModuleEnv m (ModuleEnv e) = Map.member (NDModule m) e
extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert (NDModule m) x e)
extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a
-> ModuleEnv a
extendModuleEnvWith f (ModuleEnv e) m x =
ModuleEnv (Map.insertWith f (NDModule m) x e)
extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
extendModuleEnvList (ModuleEnv e) xs =
ModuleEnv (Map.insertList [(NDModule k, v) | (k,v) <- xs] e)
extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
-> ModuleEnv a
extendModuleEnvList_C f (ModuleEnv e) xs =
ModuleEnv (Map.insertListWith f [(NDModule k, v) | (k,v) <- xs] e)
plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) =
ModuleEnv (Map.unionWith f e1 e2)
delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
delModuleEnvList (ModuleEnv e) ms =
ModuleEnv (Map.deleteList (map NDModule ms) e)
delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete (NDModule m) e)
plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
lookupModuleEnv (ModuleEnv e) m = Map.lookup (NDModule m) e
lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
lookupWithDefaultModuleEnv (ModuleEnv e) x m =
Map.findWithDefault x (NDModule m) e
mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
mkModuleEnv :: [(Module, a)] -> ModuleEnv a
mkModuleEnv xs = ModuleEnv (Map.fromList [(NDModule k, v) | (k,v) <- xs])
emptyModuleEnv :: ModuleEnv a
emptyModuleEnv = ModuleEnv Map.empty
moduleEnvKeys :: ModuleEnv a -> [Module]
moduleEnvKeys (ModuleEnv e) = sort $ map unNDModule $ Map.keys e
-- See Note [ModuleEnv performance and determinism]
moduleEnvElts :: ModuleEnv a -> [a]
moduleEnvElts e = map snd $ moduleEnvToList e
-- See Note [ModuleEnv performance and determinism]
moduleEnvToList :: ModuleEnv a -> [(Module, a)]
moduleEnvToList (ModuleEnv e) =
sortBy (comparing fst) [(m, v) | (NDModule m, v) <- Map.toList e]
-- See Note [ModuleEnv performance and determinism]
unitModuleEnv :: Module -> a -> ModuleEnv a
unitModuleEnv m x = ModuleEnv (Map.singleton (NDModule m) x)
isEmptyModuleEnv :: ModuleEnv a -> Bool
isEmptyModuleEnv (ModuleEnv e) = Map.null e
-- | A set of 'Module's
type ModuleSet = Set NDModule
mkModuleSet :: [Module] -> ModuleSet
mkModuleSet = Set.fromList . coerce
extendModuleSet :: ModuleSet -> Module -> ModuleSet
extendModuleSet s m = Set.insert (NDModule m) s
extendModuleSetList :: ModuleSet -> [Module] -> ModuleSet
extendModuleSetList s ms = foldl' (coerce . flip Set.insert) s ms
emptyModuleSet :: ModuleSet
emptyModuleSet = Set.empty
moduleSetElts :: ModuleSet -> [Module]
moduleSetElts = sort . coerce . Set.toList
elemModuleSet :: Module -> ModuleSet -> Bool
elemModuleSet = Set.member . coerce
intersectModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
intersectModuleSet = coerce Set.intersection
minusModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
minusModuleSet = coerce Set.difference
delModuleSet :: ModuleSet -> Module -> ModuleSet
delModuleSet = coerce (flip Set.delete)
unionModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
unionModuleSet = coerce Set.union
unitModuleSet :: Module -> ModuleSet
unitModuleSet = coerce 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 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 elt
--------------------------------------------------------------------
-- InstalledModuleEnv
--------------------------------------------------------------------
-- | A map keyed off of 'InstalledModule'
newtype InstalledModuleEnv elt = InstalledModuleEnv (Map InstalledModule elt)
emptyInstalledModuleEnv :: InstalledModuleEnv a
emptyInstalledModuleEnv = InstalledModuleEnv Map.empty
lookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a
lookupInstalledModuleEnv (InstalledModuleEnv e) m = Map.lookup m e
extendInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> a -> InstalledModuleEnv a
extendInstalledModuleEnv (InstalledModuleEnv e) m x = InstalledModuleEnv (Map.insert m x e)
filterInstalledModuleEnv :: (InstalledModule -> a -> Bool) -> InstalledModuleEnv a -> InstalledModuleEnv a
filterInstalledModuleEnv f (InstalledModuleEnv e) =
InstalledModuleEnv (Map.filterWithKey f e)
delInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
delInstalledModuleEnv (InstalledModuleEnv e) m = InstalledModuleEnv (Map.delete m e)
|
