TcInteract: Ensure that tycons have representations before solving for Typeable
[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
555 unitIdFS :: UnitId -> FastString
556 unitIdFS (IndefiniteUnitId x) = indefUnitIdFS x
557 unitIdFS (DefiniteUnitId (DefUnitId x)) = installedUnitIdFS x
558
559 unitIdKey :: UnitId -> Unique
560 unitIdKey (IndefiniteUnitId x) = indefUnitIdKey x
561 unitIdKey (DefiniteUnitId (DefUnitId x)) = installedUnitIdKey x
562
563 -- | A unit identifier which identifies an indefinite
564 -- library (with holes) that has been *on-the-fly* instantiated
565 -- with a substitution 'indefUnitIdInsts'. In fact, an indefinite
566 -- unit identifier could have no holes, but we haven't gotten
567 -- around to compiling the actual library yet.
568 --
569 -- An indefinite unit identifier pretty-prints to something like
570 -- @p[H=<H>,A=aimpl:A>]@ (@p@ is the 'ComponentId', and the
571 -- brackets enclose the module substitution).
572 data IndefUnitId
573 = IndefUnitId {
574 -- | A private, uniquely identifying representation of
575 -- a UnitId. This string is completely private to GHC
576 -- and is just used to get a unique; in particular, we don't use it for
577 -- symbols (indefinite libraries are not compiled).
578 indefUnitIdFS :: FastString,
579 -- | Cached unique of 'unitIdFS'.
580 indefUnitIdKey :: Unique,
581 -- | The component identity of the indefinite library that
582 -- is being instantiated.
583 indefUnitIdComponentId :: !ComponentId,
584 -- | The sorted (by 'ModuleName') instantiations of this library.
585 indefUnitIdInsts :: ![(ModuleName, Module)],
586 -- | A cache of the free module variables of 'unitIdInsts'.
587 -- This lets us efficiently tell if a 'UnitId' has been
588 -- fully instantiated (free module variables are empty)
589 -- and whether or not a substitution can have any effect.
590 indefUnitIdFreeHoles :: UniqDSet ModuleName
591 }
592
593 instance Eq IndefUnitId where
594 u1 == u2 = indefUnitIdKey u1 == indefUnitIdKey u2
595
596 instance Ord IndefUnitId where
597 u1 `compare` u2 = indefUnitIdFS u1 `compare` indefUnitIdFS u2
598
599 instance Binary IndefUnitId where
600 put_ bh indef = do
601 put_ bh (indefUnitIdComponentId indef)
602 put_ bh (indefUnitIdInsts indef)
603 get bh = do
604 cid <- get bh
605 insts <- get bh
606 let fs = hashUnitId cid insts
607 return IndefUnitId {
608 indefUnitIdComponentId = cid,
609 indefUnitIdInsts = insts,
610 indefUnitIdFreeHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
611 indefUnitIdFS = fs,
612 indefUnitIdKey = getUnique fs
613 }
614
615 -- | Create a new 'IndefUnitId' given an explicit module substitution.
616 newIndefUnitId :: ComponentId -> [(ModuleName, Module)] -> IndefUnitId
617 newIndefUnitId cid insts =
618 IndefUnitId {
619 indefUnitIdComponentId = cid,
620 indefUnitIdInsts = sorted_insts,
621 indefUnitIdFreeHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
622 indefUnitIdFS = fs,
623 indefUnitIdKey = getUnique fs
624 }
625 where
626 fs = hashUnitId cid sorted_insts
627 sorted_insts = sortBy (stableModuleNameCmp `on` fst) insts
628
629 -- | Injects an 'IndefUnitId' (indefinite library which
630 -- was on-the-fly instantiated) to a 'UnitId' (either
631 -- an indefinite or definite library).
632 indefUnitIdToUnitId :: DynFlags -> IndefUnitId -> UnitId
633 indefUnitIdToUnitId dflags iuid =
634 -- NB: suppose that we want to compare the indefinite
635 -- unit id p[H=impl:H] against p+abcd (where p+abcd
636 -- happens to be the existing, installed version of
637 -- p[H=impl:H]. If we *only* wrap in p[H=impl:H]
638 -- IndefiniteUnitId, they won't compare equal; only
639 -- after improvement will the equality hold.
640 improveUnitId (getPackageConfigMap dflags) $
641 IndefiniteUnitId iuid
642
643 data IndefModule = IndefModule {
644 indefModuleUnitId :: IndefUnitId,
645 indefModuleName :: ModuleName
646 } deriving (Eq, Ord)
647
648 instance Outputable IndefModule where
649 ppr (IndefModule uid m) =
650 ppr uid <> char ':' <> ppr m
651
652 -- | Injects an 'IndefModule' to 'Module' (see also
653 -- 'indefUnitIdToUnitId'.
654 indefModuleToModule :: DynFlags -> IndefModule -> Module
655 indefModuleToModule dflags (IndefModule iuid mod_name) =
656 mkModule (indefUnitIdToUnitId dflags iuid) mod_name
657
658 -- | An installed unit identifier identifies a library which has
659 -- been installed to the package database. These strings are
660 -- provided to us via the @-this-unit-id@ flag. The library
661 -- in question may be definite or indefinite; if it is indefinite,
662 -- none of the holes have been filled (we never install partially
663 -- instantiated libraries.) Put another way, an installed unit id
664 -- is either fully instantiated, or not instantiated at all.
665 --
666 -- Installed unit identifiers look something like @p+af23SAj2dZ219@,
667 -- or maybe just @p@ if they don't use Backpack.
668 newtype InstalledUnitId =
669 InstalledUnitId {
670 -- | The full hashed unit identifier, including the component id
671 -- and the hash.
672 installedUnitIdFS :: FastString
673 }
674
675 instance Binary InstalledUnitId where
676 put_ bh (InstalledUnitId fs) = put_ bh fs
677 get bh = do fs <- get bh; return (InstalledUnitId fs)
678
679 instance BinaryStringRep InstalledUnitId where
680 fromStringRep bs = InstalledUnitId (mkFastStringByteString bs)
681 -- GHC doesn't write to database
682 toStringRep = error "BinaryStringRep InstalledUnitId: not implemented"
683
684 instance Eq InstalledUnitId where
685 uid1 == uid2 = installedUnitIdKey uid1 == installedUnitIdKey uid2
686
687 instance Ord InstalledUnitId where
688 u1 `compare` u2 = installedUnitIdFS u1 `compare` installedUnitIdFS u2
689
690 instance Uniquable InstalledUnitId where
691 getUnique = installedUnitIdKey
692
693 instance Outputable InstalledUnitId where
694 ppr uid@(InstalledUnitId fs) =
695 getPprStyle $ \sty ->
696 sdocWithDynFlags $ \dflags ->
697 case displayInstalledUnitId dflags uid of
698 Just str | not (debugStyle sty) -> text str
699 _ -> ftext fs
700
701 installedUnitIdKey :: InstalledUnitId -> Unique
702 installedUnitIdKey = getUnique . installedUnitIdFS
703
704 -- | Lossy conversion to the on-disk 'InstalledUnitId' for a component.
705 toInstalledUnitId :: UnitId -> InstalledUnitId
706 toInstalledUnitId (DefiniteUnitId (DefUnitId iuid)) = iuid
707 toInstalledUnitId (IndefiniteUnitId indef) =
708 componentIdToInstalledUnitId (indefUnitIdComponentId indef)
709
710 installedUnitIdString :: InstalledUnitId -> String
711 installedUnitIdString = unpackFS . installedUnitIdFS
712
713 instance Outputable IndefUnitId where
714 ppr uid =
715 -- getPprStyle $ \sty ->
716 ppr cid <>
717 (if not (null insts) -- pprIf
718 then
719 brackets (hcat
720 (punctuate comma $
721 [ ppr modname <> text "=" <> ppr m
722 | (modname, m) <- insts]))
723 else empty)
724 where
725 cid = indefUnitIdComponentId uid
726 insts = indefUnitIdInsts uid
727
728 -- | A 'InstalledModule' is a 'Module' which contains a 'InstalledUnitId'.
729 data InstalledModule = InstalledModule {
730 installedModuleUnitId :: !InstalledUnitId,
731 installedModuleName :: !ModuleName
732 }
733 deriving (Eq, Ord)
734
735 instance Outputable InstalledModule where
736 ppr (InstalledModule p n) =
737 ppr p <> char ':' <> pprModuleName n
738
739 fsToInstalledUnitId :: FastString -> InstalledUnitId
740 fsToInstalledUnitId fs = InstalledUnitId fs
741
742 componentIdToInstalledUnitId :: ComponentId -> InstalledUnitId
743 componentIdToInstalledUnitId (ComponentId fs) = fsToInstalledUnitId fs
744
745 stringToInstalledUnitId :: String -> InstalledUnitId
746 stringToInstalledUnitId = fsToInstalledUnitId . mkFastString
747
748 -- | Test if a 'Module' corresponds to a given 'InstalledModule',
749 -- modulo instantiation.
750 installedModuleEq :: InstalledModule -> Module -> Bool
751 installedModuleEq imod mod =
752 fst (splitModuleInsts mod) == imod
753
754 -- | Test if a 'UnitId' corresponds to a given 'InstalledUnitId',
755 -- modulo instantiation.
756 installedUnitIdEq :: InstalledUnitId -> UnitId -> Bool
757 installedUnitIdEq iuid uid =
758 fst (splitUnitIdInsts uid) == iuid
759
760 -- | A 'DefUnitId' is an 'InstalledUnitId' with the invariant that
761 -- it only refers to a definite library; i.e., one we have generated
762 -- code for.
763 newtype DefUnitId = DefUnitId { unDefUnitId :: InstalledUnitId }
764 deriving (Eq, Ord)
765
766 instance Outputable DefUnitId where
767 ppr (DefUnitId uid) = ppr uid
768
769 instance Binary DefUnitId where
770 put_ bh (DefUnitId uid) = put_ bh uid
771 get bh = do uid <- get bh; return (DefUnitId uid)
772
773 -- | A map keyed off of 'InstalledModule'
774 newtype InstalledModuleEnv elt = InstalledModuleEnv (Map InstalledModule elt)
775
776 emptyInstalledModuleEnv :: InstalledModuleEnv a
777 emptyInstalledModuleEnv = InstalledModuleEnv Map.empty
778
779 lookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a
780 lookupInstalledModuleEnv (InstalledModuleEnv e) m = Map.lookup m e
781
782 extendInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> a -> InstalledModuleEnv a
783 extendInstalledModuleEnv (InstalledModuleEnv e) m x = InstalledModuleEnv (Map.insert m x e)
784
785 filterInstalledModuleEnv :: (InstalledModule -> a -> Bool) -> InstalledModuleEnv a -> InstalledModuleEnv a
786 filterInstalledModuleEnv f (InstalledModuleEnv e) =
787 InstalledModuleEnv (Map.filterWithKey f e)
788
789 delInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
790 delInstalledModuleEnv (InstalledModuleEnv e) m = InstalledModuleEnv (Map.delete m e)
791
792 -- Note [UnitId to InstalledUnitId improvement]
793 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
794 -- Just because a UnitId is definite (has no holes) doesn't
795 -- mean it's necessarily a InstalledUnitId; it could just be
796 -- that over the course of renaming UnitIds on the fly
797 -- while typechecking an indefinite library, we
798 -- ended up with a fully instantiated unit id with no hash,
799 -- since we haven't built it yet. This is fine.
800 --
801 -- However, if there is a hashed unit id for this instantiation
802 -- in the package database, we *better use it*, because
803 -- that hashed unit id may be lurking in another interface,
804 -- and chaos will ensue if we attempt to compare the two
805 -- (the unitIdFS for a UnitId never corresponds to a Cabal-provided
806 -- hash of a compiled instantiated library).
807 --
808 -- There is one last niggle: improvement based on the package database means
809 -- that we might end up developing on a package that is not transitively
810 -- depended upon by the packages the user specified directly via command line
811 -- flags. This could lead to strange and difficult to understand bugs if those
812 -- instantiations are out of date. The solution is to only improve a
813 -- unit id if the new unit id is part of the 'preloadClosure'; i.e., the
814 -- closure of all the packages which were explicitly specified.
815
816 -- | Retrieve the set of free holes of a 'UnitId'.
817 unitIdFreeHoles :: UnitId -> UniqDSet ModuleName
818 unitIdFreeHoles (IndefiniteUnitId x) = indefUnitIdFreeHoles x
819 -- Hashed unit ids are always fully instantiated
820 unitIdFreeHoles (DefiniteUnitId _) = emptyUniqDSet
821
822 instance Show UnitId where
823 show = unitIdString
824
825 -- | A 'UnitId' is definite if it has no free holes.
826 unitIdIsDefinite :: UnitId -> Bool
827 unitIdIsDefinite = isEmptyUniqDSet . unitIdFreeHoles
828
829 -- | Generate a uniquely identifying 'FastString' for a unit
830 -- identifier. This is a one-way function. You can rely on one special
831 -- property: if a unit identifier is in most general form, its 'FastString'
832 -- coincides with its 'ComponentId'. This hash is completely internal
833 -- to GHC and is not used for symbol names or file paths.
834 hashUnitId :: ComponentId -> [(ModuleName, Module)] -> FastString
835 hashUnitId cid sorted_holes =
836 mkFastStringByteString
837 . fingerprintUnitId (toStringRep cid)
838 $ rawHashUnitId sorted_holes
839
840 -- | Generate a hash for a sorted module substitution.
841 rawHashUnitId :: [(ModuleName, Module)] -> Fingerprint
842 rawHashUnitId sorted_holes =
843 fingerprintByteString
844 . BS.concat $ do
845 (m, b) <- sorted_holes
846 [ toStringRep m, BS.Char8.singleton ' ',
847 fastStringToByteString (unitIdFS (moduleUnitId b)), BS.Char8.singleton ':',
848 toStringRep (moduleName b), BS.Char8.singleton '\n']
849
850 fingerprintByteString :: BS.ByteString -> Fingerprint
851 fingerprintByteString bs = unsafePerformIO
852 . BS.unsafeUseAsCStringLen bs
853 $ \(p,l) -> fingerprintData (castPtr p) l
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 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 -- $wired_in_packages
1057 -- Certain packages are known to the compiler, in that we know about certain
1058 -- entities that reside in these packages, and the compiler needs to
1059 -- declare static Modules and Names that refer to these packages. Hence
1060 -- the wired-in packages can't include version numbers, since we don't want
1061 -- to bake the version numbers of these packages into GHC.
1062 --
1063 -- So here's the plan. Wired-in packages are still versioned as
1064 -- normal in the packages database, and you can still have multiple
1065 -- versions of them installed. However, for each invocation of GHC,
1066 -- only a single instance of each wired-in package will be recognised
1067 -- (the desired one is selected via @-package@\/@-hide-package@), and GHC
1068 -- will use the unversioned 'UnitId' below when referring to it,
1069 -- including in .hi files and object file symbols. Unselected
1070 -- versions of wired-in packages will be ignored, as will any other
1071 -- package that depends directly or indirectly on it (much as if you
1072 -- had used @-ignore-package@).
1073
1074 -- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
1075
1076 integerUnitId, primUnitId,
1077 baseUnitId, rtsUnitId,
1078 thUnitId, dphSeqUnitId, dphParUnitId,
1079 mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId
1080 primUnitId = fsToUnitId (fsLit "ghc-prim")
1081 integerUnitId = fsToUnitId (fsLit n)
1082 where
1083 n = case cIntegerLibraryType of
1084 IntegerGMP -> "integer-gmp"
1085 IntegerSimple -> "integer-simple"
1086 baseUnitId = fsToUnitId (fsLit "base")
1087 rtsUnitId = fsToUnitId (fsLit "rts")
1088 thUnitId = fsToUnitId (fsLit "template-haskell")
1089 dphSeqUnitId = fsToUnitId (fsLit "dph-seq")
1090 dphParUnitId = fsToUnitId (fsLit "dph-par")
1091 thisGhcUnitId = fsToUnitId (fsLit "ghc")
1092 interactiveUnitId = fsToUnitId (fsLit "interactive")
1093
1094 -- | This is the package Id for the current program. It is the default
1095 -- package Id if you don't specify a package name. We don't add this prefix
1096 -- to symbol names, since there can be only one main package per program.
1097 mainUnitId = fsToUnitId (fsLit "main")
1098
1099 -- | This is a fake package id used to provide identities to any un-implemented
1100 -- signatures. The set of hole identities is global over an entire compilation.
1101 -- Don't use this directly: use 'mkHoleModule' or 'isHoleModule' instead.
1102 -- See Note [Representation of module/name variables]
1103 holeUnitId :: UnitId
1104 holeUnitId = fsToUnitId (fsLit "hole")
1105
1106 isInteractiveModule :: Module -> Bool
1107 isInteractiveModule mod = moduleUnitId mod == interactiveUnitId
1108
1109 -- Note [Representation of module/name variables]
1110 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1111 -- In our ICFP'16, we use <A> to represent module holes, and {A.T} to represent
1112 -- name holes. This could have been represented by adding some new cases
1113 -- to the core data types, but this would have made the existing 'nameModule'
1114 -- and 'moduleUnitId' partial, which would have required a lot of modifications
1115 -- to existing code.
1116 --
1117 -- Instead, we adopted the following encoding scheme:
1118 --
1119 -- <A> ===> hole:A
1120 -- {A.T} ===> hole:A.T
1121 --
1122 -- This encoding is quite convenient, but it is also a bit dangerous too,
1123 -- because if you have a 'hole:A' you need to know if it's actually a
1124 -- 'Module' or just a module stored in a 'Name'; these two cases must be
1125 -- treated differently when doing substitutions. 'renameHoleModule'
1126 -- and 'renameHoleUnitId' assume they are NOT operating on a
1127 -- 'Name'; 'NameShape' handles name substitutions exclusively.
1128
1129 isHoleModule :: Module -> Bool
1130 isHoleModule mod = moduleUnitId mod == holeUnitId
1131
1132 wiredInUnitIds :: [UnitId]
1133 wiredInUnitIds = [ primUnitId,
1134 integerUnitId,
1135 baseUnitId,
1136 rtsUnitId,
1137 thUnitId,
1138 thisGhcUnitId,
1139 dphSeqUnitId,
1140 dphParUnitId ]
1141
1142 {-
1143 ************************************************************************
1144 * *
1145 \subsection{@ModuleEnv@s}
1146 * *
1147 ************************************************************************
1148 -}
1149
1150 -- | A map keyed off of 'Module's
1151 newtype ModuleEnv elt = ModuleEnv (Map NDModule elt)
1152
1153 {-
1154 Note [ModuleEnv performance and determinism]
1155 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1156 To prevent accidental reintroduction of nondeterminism the Ord instance
1157 for Module was changed to not depend on Unique ordering and to use the
1158 lexicographic order. This is potentially expensive, but when measured
1159 there was no difference in performance.
1160
1161 To be on the safe side and not pessimize ModuleEnv uses nondeterministic
1162 ordering on Module and normalizes by doing the lexicographic sort when
1163 turning the env to a list.
1164 See Note [Unique Determinism] for more information about the source of
1165 nondeterminismand and Note [Deterministic UniqFM] for explanation of why
1166 it matters for maps.
1167 -}
1168
1169 newtype NDModule = NDModule { unNDModule :: Module }
1170 deriving Eq
1171 -- A wrapper for Module with faster nondeterministic Ord.
1172 -- Don't export, See [ModuleEnv performance and determinism]
1173
1174 instance Ord NDModule where
1175 compare (NDModule (Module p1 n1)) (NDModule (Module p2 n2)) =
1176 (getUnique p1 `nonDetCmpUnique` getUnique p2) `thenCmp`
1177 (getUnique n1 `nonDetCmpUnique` getUnique n2)
1178
1179 filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
1180 filterModuleEnv f (ModuleEnv e) =
1181 ModuleEnv (Map.filterWithKey (f . unNDModule) e)
1182
1183 elemModuleEnv :: Module -> ModuleEnv a -> Bool
1184 elemModuleEnv m (ModuleEnv e) = Map.member (NDModule m) e
1185
1186 extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
1187 extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert (NDModule m) x e)
1188
1189 extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a
1190 -> ModuleEnv a
1191 extendModuleEnvWith f (ModuleEnv e) m x =
1192 ModuleEnv (Map.insertWith f (NDModule m) x e)
1193
1194 extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
1195 extendModuleEnvList (ModuleEnv e) xs =
1196 ModuleEnv (Map.insertList [(NDModule k, v) | (k,v) <- xs] e)
1197
1198 extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
1199 -> ModuleEnv a
1200 extendModuleEnvList_C f (ModuleEnv e) xs =
1201 ModuleEnv (Map.insertListWith f [(NDModule k, v) | (k,v) <- xs] e)
1202
1203 plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
1204 plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) =
1205 ModuleEnv (Map.unionWith f e1 e2)
1206
1207 delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
1208 delModuleEnvList (ModuleEnv e) ms =
1209 ModuleEnv (Map.deleteList (map NDModule ms) e)
1210
1211 delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
1212 delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete (NDModule m) e)
1213
1214 plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
1215 plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
1216
1217 lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
1218 lookupModuleEnv (ModuleEnv e) m = Map.lookup (NDModule m) e
1219
1220 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
1221 lookupWithDefaultModuleEnv (ModuleEnv e) x m =
1222 Map.findWithDefault x (NDModule m) e
1223
1224 mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
1225 mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
1226
1227 mkModuleEnv :: [(Module, a)] -> ModuleEnv a
1228 mkModuleEnv xs = ModuleEnv (Map.fromList [(NDModule k, v) | (k,v) <- xs])
1229
1230 emptyModuleEnv :: ModuleEnv a
1231 emptyModuleEnv = ModuleEnv Map.empty
1232
1233 moduleEnvKeys :: ModuleEnv a -> [Module]
1234 moduleEnvKeys (ModuleEnv e) = sort $ map unNDModule $ Map.keys e
1235 -- See Note [ModuleEnv performance and determinism]
1236
1237 moduleEnvElts :: ModuleEnv a -> [a]
1238 moduleEnvElts e = map snd $ moduleEnvToList e
1239 -- See Note [ModuleEnv performance and determinism]
1240
1241 moduleEnvToList :: ModuleEnv a -> [(Module, a)]
1242 moduleEnvToList (ModuleEnv e) =
1243 sortBy (comparing fst) [(m, v) | (NDModule m, v) <- Map.toList e]
1244 -- See Note [ModuleEnv performance and determinism]
1245
1246 unitModuleEnv :: Module -> a -> ModuleEnv a
1247 unitModuleEnv m x = ModuleEnv (Map.singleton (NDModule m) x)
1248
1249 isEmptyModuleEnv :: ModuleEnv a -> Bool
1250 isEmptyModuleEnv (ModuleEnv e) = Map.null e
1251
1252 -- | A set of 'Module's
1253 type ModuleSet = Set NDModule
1254
1255 mkModuleSet :: [Module] -> ModuleSet
1256 mkModuleSet = Set.fromList . coerce
1257
1258 extendModuleSet :: ModuleSet -> Module -> ModuleSet
1259 extendModuleSet s m = Set.insert (NDModule m) s
1260
1261 extendModuleSetList :: ModuleSet -> [Module] -> ModuleSet
1262 extendModuleSetList s ms = foldl' (coerce . flip Set.insert) s ms
1263
1264 emptyModuleSet :: ModuleSet
1265 emptyModuleSet = Set.empty
1266
1267 moduleSetElts :: ModuleSet -> [Module]
1268 moduleSetElts = sort . coerce . Set.toList
1269
1270 elemModuleSet :: Module -> ModuleSet -> Bool
1271 elemModuleSet = Set.member . coerce
1272
1273 intersectModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
1274 intersectModuleSet = coerce Set.intersection
1275
1276 minusModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
1277 minusModuleSet = coerce Set.difference
1278
1279 delModuleSet :: ModuleSet -> Module -> ModuleSet
1280 delModuleSet = coerce (flip Set.delete)
1281
1282 unionModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
1283 unionModuleSet = coerce Set.union
1284
1285 unitModuleSet :: Module -> ModuleSet
1286 unitModuleSet = coerce Set.singleton
1287
1288 {-
1289 A ModuleName has a Unique, so we can build mappings of these using
1290 UniqFM.
1291 -}
1292
1293 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
1294 type ModuleNameEnv elt = UniqFM elt
1295
1296
1297 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
1298 -- Has deterministic folds and can be deterministically converted to a list
1299 type DModuleNameEnv elt = UniqDFM elt