Revert "Don't inline functions with RULES too early"
[ghc.git] / compiler / basicTypes / Module.hs
1 {-
2 (c) The University of Glasgow, 2004-2006
3
4
5 Module
6 ~~~~~~~~~~
7 Simply the name of a module, represented as a FastString.
8 These are Uniquable, hence we can build Maps with Modules as
9 the keys.
10 -}
11
12 {-# LANGUAGE RecordWildCards #-}
13 {-# LANGUAGE MultiParamTypeClasses #-}
14
15 module Module
16 (
17 -- * The ModuleName type
18 ModuleName,
19 pprModuleName,
20 moduleNameFS,
21 moduleNameString,
22 moduleNameSlashes, moduleNameColons,
23 moduleStableString,
24 moduleFreeHoles,
25 moduleIsDefinite,
26 mkModuleName,
27 mkModuleNameFS,
28 stableModuleNameCmp,
29
30 -- * The UnitId type
31 ComponentId(..),
32 UnitId(..),
33 unitIdFS,
34 unitIdKey,
35 IndefUnitId(..),
36 IndefModule(..),
37 indefUnitIdToUnitId,
38 indefModuleToModule,
39 InstalledUnitId(..),
40 toInstalledUnitId,
41 ShHoleSubst,
42
43 unitIdIsDefinite,
44 unitIdString,
45 unitIdFreeHoles,
46
47 newUnitId,
48 newIndefUnitId,
49 newSimpleUnitId,
50 hashUnitId,
51 fsToUnitId,
52 stringToUnitId,
53 stableUnitIdCmp,
54
55 -- * HOLE renaming
56 renameHoleUnitId,
57 renameHoleModule,
58 renameHoleUnitId',
59 renameHoleModule',
60
61 -- * Generalization
62 splitModuleInsts,
63 splitUnitIdInsts,
64 generalizeIndefUnitId,
65 generalizeIndefModule,
66
67 -- * Parsers
68 parseModuleName,
69 parseUnitId,
70 parseComponentId,
71 parseModuleId,
72 parseModSubst,
73
74 -- * Wired-in UnitIds
75 -- $wired_in_packages
76 primUnitId,
77 integerUnitId,
78 baseUnitId,
79 rtsUnitId,
80 thUnitId,
81 mainUnitId,
82 thisGhcUnitId,
83 isHoleModule,
84 interactiveUnitId, isInteractiveModule,
85 wiredInUnitIds,
86
87 -- * The Module type
88 Module(Module),
89 moduleUnitId, moduleName,
90 pprModule,
91 mkModule,
92 mkHoleModule,
93 stableModuleCmp,
94 HasModule(..),
95 ContainsModule(..),
96
97 -- * Installed unit ids and modules
98 InstalledModule(..),
99 InstalledModuleEnv,
100 installedModuleEq,
101 installedUnitIdEq,
102 installedUnitIdString,
103 fsToInstalledUnitId,
104 componentIdToInstalledUnitId,
105 stringToInstalledUnitId,
106 emptyInstalledModuleEnv,
107 lookupInstalledModuleEnv,
108 extendInstalledModuleEnv,
109 filterInstalledModuleEnv,
110 delInstalledModuleEnv,
111 DefUnitId(..),
112
113 -- * The ModuleLocation type
114 ModLocation(..),
115 addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,
116
117 -- * Module mappings
118 ModuleEnv,
119 elemModuleEnv, extendModuleEnv, extendModuleEnvList,
120 extendModuleEnvList_C, plusModuleEnv_C,
121 delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
122 lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
123 moduleEnvKeys, moduleEnvElts, moduleEnvToList,
124 unitModuleEnv, isEmptyModuleEnv,
125 extendModuleEnvWith, filterModuleEnv,
126
127 -- * ModuleName mappings
128 ModuleNameEnv, DModuleNameEnv,
129
130 -- * Sets of Modules
131 ModuleSet,
132 emptyModuleSet, mkModuleSet, moduleSetElts,
133 extendModuleSet, extendModuleSetList, delModuleSet,
134 elemModuleSet, intersectModuleSet, minusModuleSet, unionModuleSet,
135 unitModuleSet
136 ) where
137
138 import GhcPrelude
139
140 import Config
141 import Outputable
142 import Unique
143 import UniqFM
144 import UniqDFM
145 import UniqDSet
146 import FastString
147 import Binary
148 import Util
149 import Data.List
150 import Data.Ord
151 import GHC.PackageDb (BinaryStringRep(..), DbUnitIdModuleRep(..), DbModule(..), DbUnitId(..))
152 import Fingerprint
153
154 import qualified Data.ByteString as BS
155 import qualified Data.ByteString.Char8 as BS.Char8
156 import Encoding
157
158 import qualified Text.ParserCombinators.ReadP as Parse
159 import Text.ParserCombinators.ReadP (ReadP, (<++))
160 import Data.Char (isAlphaNum)
161 import Control.DeepSeq
162 import Data.Coerce
163 import Data.Data
164 import Data.Function
165 import Data.Map (Map)
166 import Data.Set (Set)
167 import qualified Data.Map as Map
168 import qualified Data.Set as Set
169 import qualified FiniteMap as Map
170 import System.FilePath
171
172 import {-# SOURCE #-} DynFlags (DynFlags)
173 import {-# SOURCE #-} Packages (componentIdString, improveUnitId, PackageConfigMap, getPackageConfigMap, displayInstalledUnitId)
174
175 -- Note [The identifier lexicon]
176 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
177 -- Unit IDs, installed package IDs, ABI hashes, package names,
178 -- versions, there are a *lot* of different identifiers for closely
179 -- related things. What do they all mean? Here's what. (See also
180 -- https://ghc.haskell.org/trac/ghc/wiki/Commentary/Packages/Concepts )
181 --
182 -- THE IMPORTANT ONES
183 --
184 -- ComponentId: An opaque identifier provided by Cabal, which should
185 -- uniquely identify such things as the package name, the package
186 -- version, the name of the component, the hash of the source code
187 -- tarball, the selected Cabal flags, GHC flags, direct dependencies of
188 -- the component. These are very similar to InstalledPackageId, but
189 -- an 'InstalledPackageId' implies that it identifies a package, while
190 -- a package may install multiple components with different
191 -- 'ComponentId's.
192 -- - Same as Distribution.Package.ComponentId
193 --
194 -- UnitId/InstalledUnitId: A ComponentId + a mapping from hole names
195 -- (ModuleName) to Modules. This is how the compiler identifies instantiated
196 -- components, and also is the main identifier by which GHC identifies things.
197 -- - When Backpack is not being used, UnitId = ComponentId.
198 -- this means a useful fiction for end-users is that there are
199 -- only ever ComponentIds, and some ComponentIds happen to have
200 -- more information (UnitIds).
201 -- - Same as Language.Haskell.TH.Syntax:PkgName, see
202 -- https://ghc.haskell.org/trac/ghc/ticket/10279
203 -- - The same as PackageKey in GHC 7.10 (we renamed it because
204 -- they don't necessarily identify packages anymore.)
205 -- - Same as -this-package-key/-package-name flags
206 -- - An InstalledUnitId corresponds to an actual package which
207 -- we have installed on disk. It could be definite or indefinite,
208 -- but if it's indefinite, it has nothing instantiated (we
209 -- never install partially instantiated units.)
210 --
211 -- Module/InstalledModule: A UnitId/InstalledUnitId + ModuleName. This is how
212 -- the compiler identifies modules (e.g. a Name is a Module + OccName)
213 -- - Same as Language.Haskell.TH.Syntax:Module
214 --
215 -- THE LESS IMPORTANT ONES
216 --
217 -- PackageName: The "name" field in a Cabal file, something like "lens".
218 -- - Same as Distribution.Package.PackageName
219 -- - DIFFERENT FROM Language.Haskell.TH.Syntax:PkgName, see
220 -- https://ghc.haskell.org/trac/ghc/ticket/10279
221 -- - DIFFERENT FROM -package-name flag
222 -- - DIFFERENT FROM the 'name' field in an installed package
223 -- information. This field could more accurately be described
224 -- as a munged package name: when it's for the main library
225 -- it is the same as the package name, but if it's an internal
226 -- library it's a munged combination of the package name and
227 -- the component name.
228 --
229 -- LEGACY ONES
230 --
231 -- InstalledPackageId: This is what we used to call ComponentId.
232 -- It's a still pretty useful concept for packages that have only
233 -- one library; in that case the logical InstalledPackageId =
234 -- ComponentId. Also, the Cabal nix-local-build continues to
235 -- compute an InstalledPackageId which is then forcibly used
236 -- for all components in a package. This means that if a dependency
237 -- from one component in a package changes, the InstalledPackageId
238 -- changes: you don't get as fine-grained dependency tracking,
239 -- but it means your builds are hermetic. Eventually, Cabal will
240 -- deal completely in components and we can get rid of this.
241 --
242 -- PackageKey: This is what we used to call UnitId. We ditched
243 -- "Package" from the name when we realized that you might want to
244 -- assign different "PackageKeys" to components from the same package.
245 -- (For a brief, non-released period of time, we also called these
246 -- UnitKeys).
247
248 {-
249 ************************************************************************
250 * *
251 \subsection{Module locations}
252 * *
253 ************************************************************************
254 -}
255
256 -- | Module Location
257 --
258 -- Where a module lives on the file system: the actual locations
259 -- of the .hs, .hi and .o files, if we have them
260 data ModLocation
261 = ModLocation {
262 ml_hs_file :: Maybe FilePath,
263 -- The source file, if we have one. Package modules
264 -- probably don't have source files.
265
266 ml_hi_file :: FilePath,
267 -- Where the .hi file is, whether or not it exists
268 -- yet. Always of form foo.hi, even if there is an
269 -- hi-boot file (we add the -boot suffix later)
270
271 ml_obj_file :: FilePath
272 -- Where the .o file is, whether or not it exists yet.
273 -- (might not exist either because the module hasn't
274 -- been compiled yet, or because it is part of a
275 -- package with a .a file)
276 } deriving Show
277
278 instance Outputable ModLocation where
279 ppr = text . show
280
281 {-
282 For a module in another package, the hs_file and obj_file
283 components of ModLocation are undefined.
284
285 The locations specified by a ModLocation may or may not
286 correspond to actual files yet: for example, even if the object
287 file doesn't exist, the ModLocation still contains the path to
288 where the object file will reside if/when it is created.
289 -}
290
291 addBootSuffix :: FilePath -> FilePath
292 -- ^ Add the @-boot@ suffix to .hs, .hi and .o files
293 addBootSuffix path = path ++ "-boot"
294
295 addBootSuffix_maybe :: Bool -> FilePath -> FilePath
296 -- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@
297 addBootSuffix_maybe is_boot path
298 | is_boot = addBootSuffix path
299 | otherwise = path
300
301 addBootSuffixLocn :: ModLocation -> ModLocation
302 -- ^ Add the @-boot@ suffix to all file paths associated with the module
303 addBootSuffixLocn locn
304 = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn)
305 , ml_hi_file = addBootSuffix (ml_hi_file locn)
306 , ml_obj_file = addBootSuffix (ml_obj_file locn) }
307
308 {-
309 ************************************************************************
310 * *
311 \subsection{The name of a module}
312 * *
313 ************************************************************************
314 -}
315
316 -- | A ModuleName is essentially a simple string, e.g. @Data.List@.
317 newtype ModuleName = ModuleName FastString
318
319 instance Uniquable ModuleName where
320 getUnique (ModuleName nm) = getUnique nm
321
322 instance Eq ModuleName where
323 nm1 == nm2 = getUnique nm1 == getUnique nm2
324
325 instance Ord ModuleName where
326 nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2
327
328 instance Outputable ModuleName where
329 ppr = pprModuleName
330
331 instance Binary ModuleName where
332 put_ bh (ModuleName fs) = put_ bh fs
333 get bh = do fs <- get bh; return (ModuleName fs)
334
335 instance BinaryStringRep ModuleName where
336 fromStringRep = mkModuleNameFS . mkFastStringByteString
337 toStringRep = fastStringToByteString . moduleNameFS
338
339 instance Data ModuleName where
340 -- don't traverse?
341 toConstr _ = abstractConstr "ModuleName"
342 gunfold _ _ = error "gunfold"
343 dataTypeOf _ = mkNoRepType "ModuleName"
344
345 instance NFData ModuleName where
346 rnf x = x `seq` ()
347
348 stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
349 -- ^ Compares module names lexically, rather than by their 'Unique's
350 stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
351
352 pprModuleName :: ModuleName -> SDoc
353 pprModuleName (ModuleName nm) =
354 getPprStyle $ \ sty ->
355 if codeStyle sty
356 then ztext (zEncodeFS nm)
357 else ftext nm
358
359 moduleNameFS :: ModuleName -> FastString
360 moduleNameFS (ModuleName mod) = mod
361
362 moduleNameString :: ModuleName -> String
363 moduleNameString (ModuleName mod) = unpackFS mod
364
365 -- | Get a string representation of a 'Module' that's unique and stable
366 -- across recompilations.
367 -- eg. "$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal"
368 moduleStableString :: Module -> String
369 moduleStableString Module{..} =
370 "$" ++ unitIdString moduleUnitId ++ "$" ++ moduleNameString moduleName
371
372 mkModuleName :: String -> ModuleName
373 mkModuleName s = ModuleName (mkFastString s)
374
375 mkModuleNameFS :: FastString -> ModuleName
376 mkModuleNameFS s = ModuleName s
377
378 -- |Returns the string version of the module name, with dots replaced by slashes.
379 --
380 moduleNameSlashes :: ModuleName -> String
381 moduleNameSlashes = dots_to_slashes . moduleNameString
382 where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
383
384 -- |Returns the string version of the module name, with dots replaced by colons.
385 --
386 moduleNameColons :: ModuleName -> String
387 moduleNameColons = dots_to_colons . moduleNameString
388 where dots_to_colons = map (\c -> if c == '.' then ':' else c)
389
390 {-
391 ************************************************************************
392 * *
393 \subsection{A fully qualified module}
394 * *
395 ************************************************************************
396 -}
397
398 -- | A Module is a pair of a 'UnitId' and a 'ModuleName'.
399 --
400 -- Module variables (i.e. @<H>@) which can be instantiated to a
401 -- specific module at some later point in time are represented
402 -- with 'moduleUnitId' set to 'holeUnitId' (this allows us to
403 -- avoid having to make 'moduleUnitId' a partial operation.)
404 --
405 data Module = Module {
406 moduleUnitId :: !UnitId, -- pkg-1.0
407 moduleName :: !ModuleName -- A.B.C
408 }
409 deriving (Eq, Ord)
410
411 -- | Calculate the free holes of a 'Module'. If this set is non-empty,
412 -- this module was defined in an indefinite library that had required
413 -- signatures.
414 --
415 -- If a module has free holes, that means that substitutions can operate on it;
416 -- if it has no free holes, substituting over a module has no effect.
417 moduleFreeHoles :: Module -> UniqDSet ModuleName
418 moduleFreeHoles m
419 | isHoleModule m = unitUniqDSet (moduleName m)
420 | otherwise = unitIdFreeHoles (moduleUnitId m)
421
422 -- | A 'Module' is definite if it has no free holes.
423 moduleIsDefinite :: Module -> Bool
424 moduleIsDefinite = isEmptyUniqDSet . moduleFreeHoles
425
426 -- | Create a module variable at some 'ModuleName'.
427 -- See Note [Representation of module/name variables]
428 mkHoleModule :: ModuleName -> Module
429 mkHoleModule = mkModule holeUnitId
430
431 instance Uniquable Module where
432 getUnique (Module p n) = getUnique (unitIdFS p `appendFS` moduleNameFS n)
433
434 instance Outputable Module where
435 ppr = pprModule
436
437 instance Binary Module where
438 put_ bh (Module p n) = put_ bh p >> put_ bh n
439 get bh = do p <- get bh; n <- get bh; return (Module p n)
440
441 instance Data Module where
442 -- don't traverse?
443 toConstr _ = abstractConstr "Module"
444 gunfold _ _ = error "gunfold"
445 dataTypeOf _ = mkNoRepType "Module"
446
447 instance NFData Module where
448 rnf x = x `seq` ()
449
450 -- | This gives a stable ordering, as opposed to the Ord instance which
451 -- gives an ordering based on the 'Unique's of the components, which may
452 -- not be stable from run to run of the compiler.
453 stableModuleCmp :: Module -> Module -> Ordering
454 stableModuleCmp (Module p1 n1) (Module p2 n2)
455 = (p1 `stableUnitIdCmp` p2) `thenCmp`
456 (n1 `stableModuleNameCmp` n2)
457
458 mkModule :: UnitId -> ModuleName -> Module
459 mkModule = Module
460
461 pprModule :: Module -> SDoc
462 pprModule mod@(Module p n) = getPprStyle doc
463 where
464 doc sty
465 | codeStyle sty =
466 (if p == mainUnitId
467 then empty -- never qualify the main package in code
468 else ztext (zEncodeFS (unitIdFS p)) <> char '_')
469 <> pprModuleName n
470 | qualModule sty mod =
471 if isHoleModule mod
472 then angleBrackets (pprModuleName n)
473 else ppr (moduleUnitId mod) <> char ':' <> pprModuleName n
474 | otherwise =
475 pprModuleName n
476
477 class ContainsModule t where
478 extractModule :: t -> Module
479
480 class HasModule m where
481 getModule :: m Module
482
483 instance DbUnitIdModuleRep InstalledUnitId ComponentId UnitId ModuleName Module where
484 fromDbModule (DbModule uid mod_name) = mkModule uid mod_name
485 fromDbModule (DbModuleVar mod_name) = mkHoleModule mod_name
486 fromDbUnitId (DbUnitId cid insts) = newUnitId cid insts
487 fromDbUnitId (DbInstalledUnitId iuid) = DefiniteUnitId (DefUnitId iuid)
488 -- GHC never writes to the database, so it's not needed
489 toDbModule = error "toDbModule: not implemented"
490 toDbUnitId = error "toDbUnitId: not implemented"
491
492 {-
493 ************************************************************************
494 * *
495 \subsection{ComponentId}
496 * *
497 ************************************************************************
498 -}
499
500 -- | A 'ComponentId' consists of the package name, package version, component
501 -- ID, the transitive dependencies of the component, and other information to
502 -- uniquely identify the source code and build configuration of a component.
503 --
504 -- This used to be known as an 'InstalledPackageId', but a package can contain
505 -- multiple components and a 'ComponentId' uniquely identifies a component
506 -- within a package. When a package only has one component, the 'ComponentId'
507 -- coincides with the 'InstalledPackageId'
508 newtype ComponentId = ComponentId FastString deriving (Eq, Ord)
509
510 instance BinaryStringRep ComponentId where
511 fromStringRep = ComponentId . mkFastStringByteString
512 toStringRep (ComponentId s) = fastStringToByteString s
513
514 instance Uniquable ComponentId where
515 getUnique (ComponentId n) = getUnique n
516
517 instance Outputable ComponentId where
518 ppr cid@(ComponentId fs) =
519 getPprStyle $ \sty ->
520 sdocWithDynFlags $ \dflags ->
521 case componentIdString dflags cid of
522 Just str | not (debugStyle sty) -> text str
523 _ -> ftext fs
524
525 {-
526 ************************************************************************
527 * *
528 \subsection{UnitId}
529 * *
530 ************************************************************************
531 -}
532
533 -- | A unit identifier identifies a (possibly partially) instantiated
534 -- library. It is primarily used as part of 'Module', which in turn
535 -- is used in 'Name', which is used to give names to entities when
536 -- typechecking.
537 --
538 -- There are two possible forms for a 'UnitId'. It can be a
539 -- 'DefiniteUnitId', in which case we just have a string that uniquely
540 -- identifies some fully compiled, installed library we have on disk.
541 -- However, when we are typechecking a library with missing holes,
542 -- we may need to instantiate a library on the fly (in which case
543 -- we don't have any on-disk representation.) In that case, you
544 -- have an 'IndefiniteUnitId', which explicitly records the
545 -- instantiation, so that we can substitute over it.
546 data UnitId
547 = IndefiniteUnitId {-# UNPACK #-} !IndefUnitId
548 | DefiniteUnitId {-# UNPACK #-} !DefUnitId
549
550 unitIdFS :: UnitId -> FastString
551 unitIdFS (IndefiniteUnitId x) = indefUnitIdFS x
552 unitIdFS (DefiniteUnitId (DefUnitId x)) = installedUnitIdFS x
553
554 unitIdKey :: UnitId -> Unique
555 unitIdKey (IndefiniteUnitId x) = indefUnitIdKey x
556 unitIdKey (DefiniteUnitId (DefUnitId x)) = installedUnitIdKey x
557
558 -- | A unit identifier which identifies an indefinite
559 -- library (with holes) that has been *on-the-fly* instantiated
560 -- with a substitution 'indefUnitIdInsts'. In fact, an indefinite
561 -- unit identifier could have no holes, but we haven't gotten
562 -- around to compiling the actual library yet.
563 --
564 -- An indefinite unit identifier pretty-prints to something like
565 -- @p[H=<H>,A=aimpl:A>]@ (@p@ is the 'ComponentId', and the
566 -- brackets enclose the module substitution).
567 data IndefUnitId
568 = IndefUnitId {
569 -- | A private, uniquely identifying representation of
570 -- a UnitId. This string is completely private to GHC
571 -- and is just used to get a unique; in particular, we don't use it for
572 -- symbols (indefinite libraries are not compiled).
573 indefUnitIdFS :: FastString,
574 -- | Cached unique of 'unitIdFS'.
575 indefUnitIdKey :: Unique,
576 -- | The component identity of the indefinite library that
577 -- is being instantiated.
578 indefUnitIdComponentId :: !ComponentId,
579 -- | The sorted (by 'ModuleName') instantiations of this library.
580 indefUnitIdInsts :: ![(ModuleName, Module)],
581 -- | A cache of the free module variables of 'unitIdInsts'.
582 -- This lets us efficiently tell if a 'UnitId' has been
583 -- fully instantiated (free module variables are empty)
584 -- and whether or not a substitution can have any effect.
585 indefUnitIdFreeHoles :: UniqDSet ModuleName
586 }
587
588 instance Eq IndefUnitId where
589 u1 == u2 = indefUnitIdKey u1 == indefUnitIdKey u2
590
591 instance Ord IndefUnitId where
592 u1 `compare` u2 = indefUnitIdFS u1 `compare` indefUnitIdFS u2
593
594 instance Binary IndefUnitId where
595 put_ bh indef = do
596 put_ bh (indefUnitIdComponentId indef)
597 put_ bh (indefUnitIdInsts indef)
598 get bh = do
599 cid <- get bh
600 insts <- get bh
601 let fs = hashUnitId cid insts
602 return IndefUnitId {
603 indefUnitIdComponentId = cid,
604 indefUnitIdInsts = insts,
605 indefUnitIdFreeHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
606 indefUnitIdFS = fs,
607 indefUnitIdKey = getUnique fs
608 }
609
610 -- | Create a new 'IndefUnitId' given an explicit module substitution.
611 newIndefUnitId :: ComponentId -> [(ModuleName, Module)] -> IndefUnitId
612 newIndefUnitId cid insts =
613 IndefUnitId {
614 indefUnitIdComponentId = cid,
615 indefUnitIdInsts = sorted_insts,
616 indefUnitIdFreeHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
617 indefUnitIdFS = fs,
618 indefUnitIdKey = getUnique fs
619 }
620 where
621 fs = hashUnitId cid sorted_insts
622 sorted_insts = sortBy (stableModuleNameCmp `on` fst) insts
623
624 -- | Injects an 'IndefUnitId' (indefinite library which
625 -- was on-the-fly instantiated) to a 'UnitId' (either
626 -- an indefinite or definite library).
627 indefUnitIdToUnitId :: DynFlags -> IndefUnitId -> UnitId
628 indefUnitIdToUnitId dflags iuid =
629 -- NB: suppose that we want to compare the indefinite
630 -- unit id p[H=impl:H] against p+abcd (where p+abcd
631 -- happens to be the existing, installed version of
632 -- p[H=impl:H]. If we *only* wrap in p[H=impl:H]
633 -- IndefiniteUnitId, they won't compare equal; only
634 -- after improvement will the equality hold.
635 improveUnitId (getPackageConfigMap dflags) $
636 IndefiniteUnitId iuid
637
638 data IndefModule = IndefModule {
639 indefModuleUnitId :: IndefUnitId,
640 indefModuleName :: ModuleName
641 } deriving (Eq, Ord)
642
643 instance Outputable IndefModule where
644 ppr (IndefModule uid m) =
645 ppr uid <> char ':' <> ppr m
646
647 -- | Injects an 'IndefModule' to 'Module' (see also
648 -- 'indefUnitIdToUnitId'.
649 indefModuleToModule :: DynFlags -> IndefModule -> Module
650 indefModuleToModule dflags (IndefModule iuid mod_name) =
651 mkModule (indefUnitIdToUnitId dflags iuid) mod_name
652
653 -- | An installed unit identifier identifies a library which has
654 -- been installed to the package database. These strings are
655 -- provided to us via the @-this-unit-id@ flag. The library
656 -- in question may be definite or indefinite; if it is indefinite,
657 -- none of the holes have been filled (we never install partially
658 -- instantiated libraries.) Put another way, an installed unit id
659 -- is either fully instantiated, or not instantiated at all.
660 --
661 -- Installed unit identifiers look something like @p+af23SAj2dZ219@,
662 -- or maybe just @p@ if they don't use Backpack.
663 newtype InstalledUnitId =
664 InstalledUnitId {
665 -- | The full hashed unit identifier, including the component id
666 -- and the hash.
667 installedUnitIdFS :: FastString
668 }
669
670 instance Binary InstalledUnitId where
671 put_ bh (InstalledUnitId fs) = put_ bh fs
672 get bh = do fs <- get bh; return (InstalledUnitId fs)
673
674 instance BinaryStringRep InstalledUnitId where
675 fromStringRep bs = InstalledUnitId (mkFastStringByteString bs)
676 -- GHC doesn't write to database
677 toStringRep = error "BinaryStringRep InstalledUnitId: not implemented"
678
679 instance Eq InstalledUnitId where
680 uid1 == uid2 = installedUnitIdKey uid1 == installedUnitIdKey uid2
681
682 instance Ord InstalledUnitId where
683 u1 `compare` u2 = installedUnitIdFS u1 `compare` installedUnitIdFS u2
684
685 instance Uniquable InstalledUnitId where
686 getUnique = installedUnitIdKey
687
688 instance Outputable InstalledUnitId where
689 ppr uid@(InstalledUnitId fs) =
690 getPprStyle $ \sty ->
691 sdocWithDynFlags $ \dflags ->
692 case displayInstalledUnitId dflags uid of
693 Just str | not (debugStyle sty) -> text str
694 _ -> ftext fs
695
696 installedUnitIdKey :: InstalledUnitId -> Unique
697 installedUnitIdKey = getUnique . installedUnitIdFS
698
699 -- | Lossy conversion to the on-disk 'InstalledUnitId' for a component.
700 toInstalledUnitId :: UnitId -> InstalledUnitId
701 toInstalledUnitId (DefiniteUnitId (DefUnitId iuid)) = iuid
702 toInstalledUnitId (IndefiniteUnitId indef) =
703 componentIdToInstalledUnitId (indefUnitIdComponentId indef)
704
705 installedUnitIdString :: InstalledUnitId -> String
706 installedUnitIdString = unpackFS . installedUnitIdFS
707
708 instance Outputable IndefUnitId where
709 ppr uid =
710 -- getPprStyle $ \sty ->
711 ppr cid <>
712 (if not (null insts) -- pprIf
713 then
714 brackets (hcat
715 (punctuate comma $
716 [ ppr modname <> text "=" <> ppr m
717 | (modname, m) <- insts]))
718 else empty)
719 where
720 cid = indefUnitIdComponentId uid
721 insts = indefUnitIdInsts uid
722
723 -- | A 'InstalledModule' is a 'Module' which contains a 'InstalledUnitId'.
724 data InstalledModule = InstalledModule {
725 installedModuleUnitId :: !InstalledUnitId,
726 installedModuleName :: !ModuleName
727 }
728 deriving (Eq, Ord)
729
730 instance Outputable InstalledModule where
731 ppr (InstalledModule p n) =
732 ppr p <> char ':' <> pprModuleName n
733
734 fsToInstalledUnitId :: FastString -> InstalledUnitId
735 fsToInstalledUnitId fs = InstalledUnitId fs
736
737 componentIdToInstalledUnitId :: ComponentId -> InstalledUnitId
738 componentIdToInstalledUnitId (ComponentId fs) = fsToInstalledUnitId fs
739
740 stringToInstalledUnitId :: String -> InstalledUnitId
741 stringToInstalledUnitId = fsToInstalledUnitId . mkFastString
742
743 -- | Test if a 'Module' corresponds to a given 'InstalledModule',
744 -- modulo instantiation.
745 installedModuleEq :: InstalledModule -> Module -> Bool
746 installedModuleEq imod mod =
747 fst (splitModuleInsts mod) == imod
748
749 -- | Test if a 'UnitId' corresponds to a given 'InstalledUnitId',
750 -- modulo instantiation.
751 installedUnitIdEq :: InstalledUnitId -> UnitId -> Bool
752 installedUnitIdEq iuid uid =
753 fst (splitUnitIdInsts uid) == iuid
754
755 -- | A 'DefUnitId' is an 'InstalledUnitId' with the invariant that
756 -- it only refers to a definite library; i.e., one we have generated
757 -- code for.
758 newtype DefUnitId = DefUnitId { unDefUnitId :: InstalledUnitId }
759 deriving (Eq, Ord)
760
761 instance Outputable DefUnitId where
762 ppr (DefUnitId uid) = ppr uid
763
764 instance Binary DefUnitId where
765 put_ bh (DefUnitId uid) = put_ bh uid
766 get bh = do uid <- get bh; return (DefUnitId uid)
767
768 -- | A map keyed off of 'InstalledModule'
769 newtype InstalledModuleEnv elt = InstalledModuleEnv (Map InstalledModule elt)
770
771 emptyInstalledModuleEnv :: InstalledModuleEnv a
772 emptyInstalledModuleEnv = InstalledModuleEnv Map.empty
773
774 lookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a
775 lookupInstalledModuleEnv (InstalledModuleEnv e) m = Map.lookup m e
776
777 extendInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> a -> InstalledModuleEnv a
778 extendInstalledModuleEnv (InstalledModuleEnv e) m x = InstalledModuleEnv (Map.insert m x e)
779
780 filterInstalledModuleEnv :: (InstalledModule -> a -> Bool) -> InstalledModuleEnv a -> InstalledModuleEnv a
781 filterInstalledModuleEnv f (InstalledModuleEnv e) =
782 InstalledModuleEnv (Map.filterWithKey f e)
783
784 delInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
785 delInstalledModuleEnv (InstalledModuleEnv e) m = InstalledModuleEnv (Map.delete m e)
786
787 -- Note [UnitId to InstalledUnitId improvement]
788 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
789 -- Just because a UnitId is definite (has no holes) doesn't
790 -- mean it's necessarily a InstalledUnitId; it could just be
791 -- that over the course of renaming UnitIds on the fly
792 -- while typechecking an indefinite library, we
793 -- ended up with a fully instantiated unit id with no hash,
794 -- since we haven't built it yet. This is fine.
795 --
796 -- However, if there is a hashed unit id for this instantiation
797 -- in the package database, we *better use it*, because
798 -- that hashed unit id may be lurking in another interface,
799 -- and chaos will ensue if we attempt to compare the two
800 -- (the unitIdFS for a UnitId never corresponds to a Cabal-provided
801 -- hash of a compiled instantiated library).
802 --
803 -- There is one last niggle: improvement based on the package database means
804 -- that we might end up developing on a package that is not transitively
805 -- depended upon by the packages the user specified directly via command line
806 -- flags. This could lead to strange and difficult to understand bugs if those
807 -- instantiations are out of date. The solution is to only improve a
808 -- unit id if the new unit id is part of the 'preloadClosure'; i.e., the
809 -- closure of all the packages which were explicitly specified.
810
811 -- | Retrieve the set of free holes of a 'UnitId'.
812 unitIdFreeHoles :: UnitId -> UniqDSet ModuleName
813 unitIdFreeHoles (IndefiniteUnitId x) = indefUnitIdFreeHoles x
814 -- Hashed unit ids are always fully instantiated
815 unitIdFreeHoles (DefiniteUnitId _) = emptyUniqDSet
816
817 instance Show UnitId where
818 show = unitIdString
819
820 -- | A 'UnitId' is definite if it has no free holes.
821 unitIdIsDefinite :: UnitId -> Bool
822 unitIdIsDefinite = isEmptyUniqDSet . unitIdFreeHoles
823
824 -- | Generate a uniquely identifying 'FastString' for a unit
825 -- identifier. This is a one-way function. You can rely on one special
826 -- property: if a unit identifier is in most general form, its 'FastString'
827 -- coincides with its 'ComponentId'. This hash is completely internal
828 -- to GHC and is not used for symbol names or file paths.
829 hashUnitId :: ComponentId -> [(ModuleName, Module)] -> FastString
830 hashUnitId cid sorted_holes =
831 mkFastStringByteString
832 . fingerprintUnitId (toStringRep cid)
833 $ rawHashUnitId sorted_holes
834
835 -- | Generate a hash for a sorted module substitution.
836 rawHashUnitId :: [(ModuleName, Module)] -> Fingerprint
837 rawHashUnitId sorted_holes =
838 fingerprintByteString
839 . BS.concat $ do
840 (m, b) <- sorted_holes
841 [ toStringRep m, BS.Char8.singleton ' ',
842 fastStringToByteString (unitIdFS (moduleUnitId b)), BS.Char8.singleton ':',
843 toStringRep (moduleName b), BS.Char8.singleton '\n']
844
845 fingerprintUnitId :: BS.ByteString -> Fingerprint -> BS.ByteString
846 fingerprintUnitId prefix (Fingerprint a b)
847 = BS.concat
848 $ [ prefix
849 , BS.Char8.singleton '-'
850 , BS.Char8.pack (toBase62Padded a)
851 , BS.Char8.pack (toBase62Padded b) ]
852
853 -- | Create a new, un-hashed unit identifier.
854 newUnitId :: ComponentId -> [(ModuleName, Module)] -> UnitId
855 newUnitId cid [] = newSimpleUnitId cid -- TODO: this indicates some latent bug...
856 newUnitId cid insts = IndefiniteUnitId $ newIndefUnitId cid insts
857
858 pprUnitId :: UnitId -> SDoc
859 pprUnitId (DefiniteUnitId uid) = ppr uid
860 pprUnitId (IndefiniteUnitId uid) = ppr uid
861
862 instance Eq UnitId where
863 uid1 == uid2 = unitIdKey uid1 == unitIdKey uid2
864
865 instance Uniquable UnitId where
866 getUnique = unitIdKey
867
868 instance Ord UnitId where
869 nm1 `compare` nm2 = stableUnitIdCmp nm1 nm2
870
871 instance Data UnitId where
872 -- don't traverse?
873 toConstr _ = abstractConstr "UnitId"
874 gunfold _ _ = error "gunfold"
875 dataTypeOf _ = mkNoRepType "UnitId"
876
877 instance NFData UnitId where
878 rnf x = x `seq` ()
879
880 stableUnitIdCmp :: UnitId -> UnitId -> Ordering
881 -- ^ Compares package ids lexically, rather than by their 'Unique's
882 stableUnitIdCmp p1 p2 = unitIdFS p1 `compare` unitIdFS p2
883
884 instance Outputable UnitId where
885 ppr pk = pprUnitId pk
886
887 -- Performance: would prefer to have a NameCache like thing
888 instance Binary UnitId where
889 put_ bh (DefiniteUnitId def_uid) = do
890 putByte bh 0
891 put_ bh def_uid
892 put_ bh (IndefiniteUnitId indef_uid) = do
893 putByte bh 1
894 put_ bh indef_uid
895 get bh = do b <- getByte bh
896 case b of
897 0 -> fmap DefiniteUnitId (get bh)
898 _ -> fmap IndefiniteUnitId (get bh)
899
900 instance Binary ComponentId where
901 put_ bh (ComponentId fs) = put_ bh fs
902 get bh = do { fs <- get bh; return (ComponentId fs) }
903
904 -- | Create a new simple unit identifier (no holes) from a 'ComponentId'.
905 newSimpleUnitId :: ComponentId -> UnitId
906 newSimpleUnitId (ComponentId fs) = fsToUnitId fs
907
908 -- | Create a new simple unit identifier from a 'FastString'. Internally,
909 -- this is primarily used to specify wired-in unit identifiers.
910 fsToUnitId :: FastString -> UnitId
911 fsToUnitId = DefiniteUnitId . DefUnitId . InstalledUnitId
912
913 stringToUnitId :: String -> UnitId
914 stringToUnitId = fsToUnitId . mkFastString
915
916 unitIdString :: UnitId -> String
917 unitIdString = unpackFS . unitIdFS
918
919 {-
920 ************************************************************************
921 * *
922 Hole substitutions
923 * *
924 ************************************************************************
925 -}
926
927 -- | Substitution on module variables, mapping module names to module
928 -- identifiers.
929 type ShHoleSubst = ModuleNameEnv Module
930
931 -- | Substitutes holes in a 'Module'. NOT suitable for being called
932 -- directly on a 'nameModule', see Note [Representation of module/name variable].
933 -- @p[A=<A>]:B@ maps to @p[A=q():A]:B@ with @A=q():A@;
934 -- similarly, @<A>@ maps to @q():A@.
935 renameHoleModule :: DynFlags -> ShHoleSubst -> Module -> Module
936 renameHoleModule dflags = renameHoleModule' (getPackageConfigMap dflags)
937
938 -- | Substitutes holes in a 'UnitId', suitable for renaming when
939 -- an include occurs; see Note [Representation of module/name variable].
940 --
941 -- @p[A=<A>]@ maps to @p[A=<B>]@ with @A=<B>@.
942 renameHoleUnitId :: DynFlags -> ShHoleSubst -> UnitId -> UnitId
943 renameHoleUnitId dflags = renameHoleUnitId' (getPackageConfigMap dflags)
944
945 -- | Like 'renameHoleModule', but requires only 'PackageConfigMap'
946 -- so it can be used by "Packages".
947 renameHoleModule' :: PackageConfigMap -> ShHoleSubst -> Module -> Module
948 renameHoleModule' pkg_map env m
949 | not (isHoleModule m) =
950 let uid = renameHoleUnitId' pkg_map env (moduleUnitId m)
951 in mkModule uid (moduleName m)
952 | Just m' <- lookupUFM env (moduleName m) = m'
953 -- NB m = <Blah>, that's what's in scope.
954 | otherwise = m
955
956 -- | Like 'renameHoleUnitId, but requires only 'PackageConfigMap'
957 -- so it can be used by "Packages".
958 renameHoleUnitId' :: PackageConfigMap -> ShHoleSubst -> UnitId -> UnitId
959 renameHoleUnitId' pkg_map env uid =
960 case uid of
961 (IndefiniteUnitId
962 IndefUnitId{ indefUnitIdComponentId = cid
963 , indefUnitIdInsts = insts
964 , indefUnitIdFreeHoles = fh })
965 -> if isNullUFM (intersectUFM_C const (udfmToUfm fh) env)
966 then uid
967 -- Functorially apply the substitution to the instantiation,
968 -- then check the 'PackageConfigMap' to see if there is
969 -- a compiled version of this 'UnitId' we can improve to.
970 -- See Note [UnitId to InstalledUnitId] improvement
971 else improveUnitId pkg_map $
972 newUnitId cid
973 (map (\(k,v) -> (k, renameHoleModule' pkg_map env v)) insts)
974 _ -> uid
975
976 -- | Given a possibly on-the-fly instantiated module, split it into
977 -- a 'Module' that we definitely can find on-disk, as well as an
978 -- instantiation if we need to instantiate it on the fly. If the
979 -- instantiation is @Nothing@ no on-the-fly renaming is needed.
980 splitModuleInsts :: Module -> (InstalledModule, Maybe IndefModule)
981 splitModuleInsts m =
982 let (uid, mb_iuid) = splitUnitIdInsts (moduleUnitId m)
983 in (InstalledModule uid (moduleName m),
984 fmap (\iuid -> IndefModule iuid (moduleName m)) mb_iuid)
985
986 -- | See 'splitModuleInsts'.
987 splitUnitIdInsts :: UnitId -> (InstalledUnitId, Maybe IndefUnitId)
988 splitUnitIdInsts (IndefiniteUnitId iuid) =
989 (componentIdToInstalledUnitId (indefUnitIdComponentId iuid), Just iuid)
990 splitUnitIdInsts (DefiniteUnitId (DefUnitId uid)) = (uid, Nothing)
991
992 generalizeIndefUnitId :: IndefUnitId -> IndefUnitId
993 generalizeIndefUnitId IndefUnitId{ indefUnitIdComponentId = cid
994 , indefUnitIdInsts = insts } =
995 newIndefUnitId cid (map (\(m,_) -> (m, mkHoleModule m)) insts)
996
997 generalizeIndefModule :: IndefModule -> IndefModule
998 generalizeIndefModule (IndefModule uid n) = IndefModule (generalizeIndefUnitId uid) n
999
1000 parseModuleName :: ReadP ModuleName
1001 parseModuleName = fmap mkModuleName
1002 $ Parse.munch1 (\c -> isAlphaNum c || c `elem` "_.")
1003
1004 parseUnitId :: ReadP UnitId
1005 parseUnitId = parseFullUnitId <++ parseDefiniteUnitId <++ parseSimpleUnitId
1006 where
1007 parseFullUnitId = do
1008 cid <- parseComponentId
1009 insts <- parseModSubst
1010 return (newUnitId cid insts)
1011 parseDefiniteUnitId = do
1012 s <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "-_.+")
1013 return (stringToUnitId s)
1014 parseSimpleUnitId = do
1015 cid <- parseComponentId
1016 return (newSimpleUnitId cid)
1017
1018 parseComponentId :: ReadP ComponentId
1019 parseComponentId = (ComponentId . mkFastString) `fmap` Parse.munch1 abi_char
1020 where abi_char c = isAlphaNum c || c `elem` "-_."
1021
1022 parseModuleId :: ReadP Module
1023 parseModuleId = parseModuleVar <++ parseModule
1024 where
1025 parseModuleVar = do
1026 _ <- Parse.char '<'
1027 modname <- parseModuleName
1028 _ <- Parse.char '>'
1029 return (mkHoleModule modname)
1030 parseModule = do
1031 uid <- parseUnitId
1032 _ <- Parse.char ':'
1033 modname <- parseModuleName
1034 return (mkModule uid modname)
1035
1036 parseModSubst :: ReadP [(ModuleName, Module)]
1037 parseModSubst = Parse.between (Parse.char '[') (Parse.char ']')
1038 . flip Parse.sepBy (Parse.char ',')
1039 $ do k <- parseModuleName
1040 _ <- Parse.char '='
1041 v <- parseModuleId
1042 return (k, v)
1043
1044
1045 -- -----------------------------------------------------------------------------
1046 -- $wired_in_packages
1047 -- Certain packages are known to the compiler, in that we know about certain
1048 -- entities that reside in these packages, and the compiler needs to
1049 -- declare static Modules and Names that refer to these packages. Hence
1050 -- the wired-in packages can't include version numbers, since we don't want
1051 -- to bake the version numbers of these packages into GHC.
1052 --
1053 -- So here's the plan. Wired-in packages are still versioned as
1054 -- normal in the packages database, and you can still have multiple
1055 -- versions of them installed. However, for each invocation of GHC,
1056 -- only a single instance of each wired-in package will be recognised
1057 -- (the desired one is selected via @-package@\/@-hide-package@), and GHC
1058 -- will use the unversioned 'UnitId' below when referring to it,
1059 -- including in .hi files and object file symbols. Unselected
1060 -- versions of wired-in packages will be ignored, as will any other
1061 -- package that depends directly or indirectly on it (much as if you
1062 -- had used @-ignore-package@).
1063
1064 -- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
1065
1066 integerUnitId, primUnitId,
1067 baseUnitId, rtsUnitId,
1068 thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId
1069 primUnitId = fsToUnitId (fsLit "ghc-prim")
1070 integerUnitId = fsToUnitId (fsLit n)
1071 where
1072 n = case cIntegerLibraryType of
1073 IntegerGMP -> "integer-gmp"
1074 IntegerSimple -> "integer-simple"
1075 baseUnitId = fsToUnitId (fsLit "base")
1076 rtsUnitId = fsToUnitId (fsLit "rts")
1077 thUnitId = fsToUnitId (fsLit "template-haskell")
1078 thisGhcUnitId = fsToUnitId (fsLit "ghc")
1079 interactiveUnitId = fsToUnitId (fsLit "interactive")
1080
1081 -- | This is the package Id for the current program. It is the default
1082 -- package Id if you don't specify a package name. We don't add this prefix
1083 -- to symbol names, since there can be only one main package per program.
1084 mainUnitId = fsToUnitId (fsLit "main")
1085
1086 -- | This is a fake package id used to provide identities to any un-implemented
1087 -- signatures. The set of hole identities is global over an entire compilation.
1088 -- Don't use this directly: use 'mkHoleModule' or 'isHoleModule' instead.
1089 -- See Note [Representation of module/name variables]
1090 holeUnitId :: UnitId
1091 holeUnitId = fsToUnitId (fsLit "hole")
1092
1093 isInteractiveModule :: Module -> Bool
1094 isInteractiveModule mod = moduleUnitId mod == interactiveUnitId
1095
1096 -- Note [Representation of module/name variables]
1097 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1098 -- In our ICFP'16, we use <A> to represent module holes, and {A.T} to represent
1099 -- name holes. This could have been represented by adding some new cases
1100 -- to the core data types, but this would have made the existing 'nameModule'
1101 -- and 'moduleUnitId' partial, which would have required a lot of modifications
1102 -- to existing code.
1103 --
1104 -- Instead, we adopted the following encoding scheme:
1105 --
1106 -- <A> ===> hole:A
1107 -- {A.T} ===> hole:A.T
1108 --
1109 -- This encoding is quite convenient, but it is also a bit dangerous too,
1110 -- because if you have a 'hole:A' you need to know if it's actually a
1111 -- 'Module' or just a module stored in a 'Name'; these two cases must be
1112 -- treated differently when doing substitutions. 'renameHoleModule'
1113 -- and 'renameHoleUnitId' assume they are NOT operating on a
1114 -- 'Name'; 'NameShape' handles name substitutions exclusively.
1115
1116 isHoleModule :: Module -> Bool
1117 isHoleModule mod = moduleUnitId mod == holeUnitId
1118
1119 wiredInUnitIds :: [UnitId]
1120 wiredInUnitIds = [ primUnitId,
1121 integerUnitId,
1122 baseUnitId,
1123 rtsUnitId,
1124 thUnitId,
1125 thisGhcUnitId ]
1126
1127 {-
1128 ************************************************************************
1129 * *
1130 \subsection{@ModuleEnv@s}
1131 * *
1132 ************************************************************************
1133 -}
1134
1135 -- | A map keyed off of 'Module's
1136 newtype ModuleEnv elt = ModuleEnv (Map NDModule elt)
1137
1138 {-
1139 Note [ModuleEnv performance and determinism]
1140 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1141 To prevent accidental reintroduction of nondeterminism the Ord instance
1142 for Module was changed to not depend on Unique ordering and to use the
1143 lexicographic order. This is potentially expensive, but when measured
1144 there was no difference in performance.
1145
1146 To be on the safe side and not pessimize ModuleEnv uses nondeterministic
1147 ordering on Module and normalizes by doing the lexicographic sort when
1148 turning the env to a list.
1149 See Note [Unique Determinism] for more information about the source of
1150 nondeterminismand and Note [Deterministic UniqFM] for explanation of why
1151 it matters for maps.
1152 -}
1153
1154 newtype NDModule = NDModule { unNDModule :: Module }
1155 deriving Eq
1156 -- A wrapper for Module with faster nondeterministic Ord.
1157 -- Don't export, See [ModuleEnv performance and determinism]
1158
1159 instance Ord NDModule where
1160 compare (NDModule (Module p1 n1)) (NDModule (Module p2 n2)) =
1161 (getUnique p1 `nonDetCmpUnique` getUnique p2) `thenCmp`
1162 (getUnique n1 `nonDetCmpUnique` getUnique n2)
1163
1164 filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
1165 filterModuleEnv f (ModuleEnv e) =
1166 ModuleEnv (Map.filterWithKey (f . unNDModule) e)
1167
1168 elemModuleEnv :: Module -> ModuleEnv a -> Bool
1169 elemModuleEnv m (ModuleEnv e) = Map.member (NDModule m) e
1170
1171 extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
1172 extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert (NDModule m) x e)
1173
1174 extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a
1175 -> ModuleEnv a
1176 extendModuleEnvWith f (ModuleEnv e) m x =
1177 ModuleEnv (Map.insertWith f (NDModule m) x e)
1178
1179 extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
1180 extendModuleEnvList (ModuleEnv e) xs =
1181 ModuleEnv (Map.insertList [(NDModule k, v) | (k,v) <- xs] e)
1182
1183 extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
1184 -> ModuleEnv a
1185 extendModuleEnvList_C f (ModuleEnv e) xs =
1186 ModuleEnv (Map.insertListWith f [(NDModule k, v) | (k,v) <- xs] e)
1187
1188 plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
1189 plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) =
1190 ModuleEnv (Map.unionWith f e1 e2)
1191
1192 delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
1193 delModuleEnvList (ModuleEnv e) ms =
1194 ModuleEnv (Map.deleteList (map NDModule ms) e)
1195
1196 delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
1197 delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete (NDModule m) e)
1198
1199 plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
1200 plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
1201
1202 lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
1203 lookupModuleEnv (ModuleEnv e) m = Map.lookup (NDModule m) e
1204
1205 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
1206 lookupWithDefaultModuleEnv (ModuleEnv e) x m =
1207 Map.findWithDefault x (NDModule m) e
1208
1209 mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
1210 mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
1211
1212 mkModuleEnv :: [(Module, a)] -> ModuleEnv a
1213 mkModuleEnv xs = ModuleEnv (Map.fromList [(NDModule k, v) | (k,v) <- xs])
1214
1215 emptyModuleEnv :: ModuleEnv a
1216 emptyModuleEnv = ModuleEnv Map.empty
1217
1218 moduleEnvKeys :: ModuleEnv a -> [Module]
1219 moduleEnvKeys (ModuleEnv e) = sort $ map unNDModule $ Map.keys e
1220 -- See Note [ModuleEnv performance and determinism]
1221
1222 moduleEnvElts :: ModuleEnv a -> [a]
1223 moduleEnvElts e = map snd $ moduleEnvToList e
1224 -- See Note [ModuleEnv performance and determinism]
1225
1226 moduleEnvToList :: ModuleEnv a -> [(Module, a)]
1227 moduleEnvToList (ModuleEnv e) =
1228 sortBy (comparing fst) [(m, v) | (NDModule m, v) <- Map.toList e]
1229 -- See Note [ModuleEnv performance and determinism]
1230
1231 unitModuleEnv :: Module -> a -> ModuleEnv a
1232 unitModuleEnv m x = ModuleEnv (Map.singleton (NDModule m) x)
1233
1234 isEmptyModuleEnv :: ModuleEnv a -> Bool
1235 isEmptyModuleEnv (ModuleEnv e) = Map.null e
1236
1237 -- | A set of 'Module's
1238 type ModuleSet = Set NDModule
1239
1240 mkModuleSet :: [Module] -> ModuleSet
1241 mkModuleSet = Set.fromList . coerce
1242
1243 extendModuleSet :: ModuleSet -> Module -> ModuleSet
1244 extendModuleSet s m = Set.insert (NDModule m) s
1245
1246 extendModuleSetList :: ModuleSet -> [Module] -> ModuleSet
1247 extendModuleSetList s ms = foldl' (coerce . flip Set.insert) s ms
1248
1249 emptyModuleSet :: ModuleSet
1250 emptyModuleSet = Set.empty
1251
1252 moduleSetElts :: ModuleSet -> [Module]
1253 moduleSetElts = sort . coerce . Set.toList
1254
1255 elemModuleSet :: Module -> ModuleSet -> Bool
1256 elemModuleSet = Set.member . coerce
1257
1258 intersectModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
1259 intersectModuleSet = coerce Set.intersection
1260
1261 minusModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
1262 minusModuleSet = coerce Set.difference
1263
1264 delModuleSet :: ModuleSet -> Module -> ModuleSet
1265 delModuleSet = coerce (flip Set.delete)
1266
1267 unionModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
1268 unionModuleSet = coerce Set.union
1269
1270 unitModuleSet :: Module -> ModuleSet
1271 unitModuleSet = coerce Set.singleton
1272
1273 {-
1274 A ModuleName has a Unique, so we can build mappings of these using
1275 UniqFM.
1276 -}
1277
1278 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
1279 type ModuleNameEnv elt = UniqFM elt
1280
1281
1282 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
1283 -- Has deterministic folds and can be deterministically converted to a list
1284 type DModuleNameEnv elt = UniqDFM elt