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