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