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