never executed always true always false
1 {-# LANGUAGE FlexibleInstances #-}
2 {-# LANGUAGE DeriveDataTypeable #-}
3 {-# LANGUAGE DeriveTraversable #-}
4 {-# LANGUAGE NamedFieldPuns #-}
5 {-# LANGUAGE DerivingStrategies #-}
6 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
7
8 -- | Unit & Module types
9 --
10 -- This module is used to resolve the loops between Unit and Module types
11 -- (Module references a Unit and vice-versa).
12 module GHC.Unit.Types
13 ( -- * Modules
14 GenModule (..)
15 , Module
16 , InstalledModule
17 , InstantiatedModule
18 , mkModule
19 , pprModule
20 , pprInstantiatedModule
21 , moduleFreeHoles
22
23 -- * Units
24 , IsUnitId
25 , GenUnit (..)
26 , Unit
27 , UnitId (..)
28 , UnitKey (..)
29 , GenInstantiatedUnit (..)
30 , InstantiatedUnit
31 , DefUnitId
32 , Instantiations
33 , GenInstantiations
34 , mkInstantiatedUnit
35 , mkInstantiatedUnitHash
36 , mkVirtUnit
37 , mapGenUnit
38 , mapInstantiations
39 , unitFreeModuleHoles
40 , fsToUnit
41 , unitFS
42 , unitString
43 , toUnitId
44 , virtualUnitId
45 , stringToUnit
46 , stableUnitCmp
47 , unitIsDefinite
48 , isHoleUnit
49
50 -- * Unit Ids
51 , unitIdString
52 , stringToUnitId
53
54 -- * Utils
55 , Definite (..)
56
57 -- * Wired-in units
58 , primUnitId
59 , bignumUnitId
60 , baseUnitId
61 , rtsUnitId
62 , thUnitId
63 , mainUnitId
64 , thisGhcUnitId
65 , interactiveUnitId
66
67 , primUnit
68 , bignumUnit
69 , baseUnit
70 , rtsUnit
71 , thUnit
72 , mainUnit
73 , thisGhcUnit
74 , interactiveUnit
75
76 , isInteractiveModule
77 , wiredInUnitIds
78
79 -- * Boot modules
80 , IsBootInterface (..)
81 , GenWithIsBoot (..)
82 , ModuleNameWithIsBoot
83 , ModuleWithIsBoot
84 )
85 where
86
87 import GHC.Prelude
88 import GHC.Types.Unique
89 import GHC.Types.Unique.DSet
90 import GHC.Unit.Module.Name
91 import GHC.Utils.Binary
92 import GHC.Utils.Outputable
93 import GHC.Data.FastString
94 import GHC.Utils.Encoding
95 import GHC.Utils.Fingerprint
96 import GHC.Utils.Misc
97
98 import Control.DeepSeq
99 import Data.Data
100 import Data.List (sortBy )
101 import Data.Function
102 import Data.Bifunctor
103 import qualified Data.ByteString as BS
104 import qualified Data.ByteString.Char8 as BS.Char8
105
106 ---------------------------------------------------------------------
107 -- MODULES
108 ---------------------------------------------------------------------
109
110 -- | A generic module is a pair of a unit identifier and a 'ModuleName'.
111 data GenModule unit = Module
112 { moduleUnit :: !unit -- ^ Unit the module belongs to
113 , moduleName :: !ModuleName -- ^ Module name (e.g. A.B.C)
114 }
115 deriving (Eq,Ord,Data,Functor)
116
117 -- | A Module is a pair of a 'Unit' and a 'ModuleName'.
118 type Module = GenModule Unit
119
120 -- | A 'InstalledModule' is a 'Module' whose unit is identified with an
121 -- 'UnitId'.
122 type InstalledModule = GenModule UnitId
123
124 -- | An `InstantiatedModule` is a 'Module' whose unit is identified with an `InstantiatedUnit`.
125 type InstantiatedModule = GenModule InstantiatedUnit
126
127
128 mkModule :: u -> ModuleName -> GenModule u
129 mkModule = Module
130
131 instance Uniquable Module where
132 getUnique (Module p n) = getUnique (unitFS p `appendFS` moduleNameFS n)
133
134 instance Binary a => Binary (GenModule a) where
135 put_ bh (Module p n) = put_ bh p >> put_ bh n
136 get bh = do p <- get bh; n <- get bh; return (Module p n)
137
138 instance NFData (GenModule a) where
139 rnf (Module unit name) = unit `seq` name `seq` ()
140
141 instance Outputable Module where
142 ppr = pprModule
143
144 instance Outputable InstalledModule where
145 ppr (Module p n) =
146 ppr p <> char ':' <> pprModuleName n
147
148 instance Outputable InstantiatedModule where
149 ppr = pprInstantiatedModule
150
151 instance Outputable InstantiatedUnit where
152 ppr uid =
153 -- getPprStyle $ \sty ->
154 ppr cid <>
155 (if not (null insts) -- pprIf
156 then
157 brackets (hcat
158 (punctuate comma $
159 [ ppr modname <> text "=" <> pprModule m
160 | (modname, m) <- insts]))
161 else empty)
162 where
163 cid = instUnitInstanceOf uid
164 insts = instUnitInsts uid
165
166 -- | Class for types that are used as unit identifiers (UnitKey, UnitId, Unit)
167 --
168 -- We need this class because we create new unit ids for virtual units (see
169 -- VirtUnit) and they have to to be made from units with different kinds of
170 -- identifiers.
171 class IsUnitId u where
172 unitFS :: u -> FastString
173
174 instance IsUnitId UnitKey where
175 unitFS (UnitKey fs) = fs
176
177 instance IsUnitId UnitId where
178 unitFS (UnitId fs) = fs
179
180 instance IsUnitId u => IsUnitId (GenUnit u) where
181 unitFS (VirtUnit x) = instUnitFS x
182 unitFS (RealUnit (Definite x)) = unitFS x
183 unitFS HoleUnit = holeFS
184
185 pprModule :: Module -> SDoc
186 pprModule mod@(Module p n) = getPprStyle doc
187 where
188 doc sty
189 | codeStyle sty =
190 (if p == mainUnit
191 then empty -- never qualify the main package in code
192 else ztext (zEncodeFS (unitFS p)) <> char '_')
193 <> pprModuleName n
194 | qualModule sty mod =
195 case p of
196 HoleUnit -> angleBrackets (pprModuleName n)
197 _ -> ppr (moduleUnit mod) <> char ':' <> pprModuleName n
198 | otherwise =
199 pprModuleName n
200
201
202 pprInstantiatedModule :: InstantiatedModule -> SDoc
203 pprInstantiatedModule (Module uid m) =
204 ppr uid <> char ':' <> ppr m
205
206 ---------------------------------------------------------------------
207 -- UNITS
208 ---------------------------------------------------------------------
209
210 -- | A unit key in the database
211 newtype UnitKey = UnitKey FastString
212
213 -- | A unit identifier identifies a (possibly partially) instantiated library.
214 -- It is primarily used as part of 'Module', which in turn is used in 'Name',
215 -- which is used to give names to entities when typechecking.
216 --
217 -- There are two possible forms for a 'Unit':
218 --
219 -- 1) It can be a 'RealUnit', in which case we just have a 'DefUnitId' that
220 -- uniquely identifies some fully compiled, installed library we have on disk.
221 --
222 -- 2) It can be an 'VirtUnit'. When we are typechecking a library with missing
223 -- holes, we may need to instantiate a library on the fly (in which case we
224 -- don't have any on-disk representation.) In that case, you have an
225 -- 'InstantiatedUnit', which explicitly records the instantiation, so that we
226 -- can substitute over it.
227 data GenUnit uid
228 = RealUnit !(Definite uid)
229 -- ^ Installed definite unit (either a fully instantiated unit or a closed unit)
230
231 | VirtUnit {-# UNPACK #-} !(GenInstantiatedUnit uid)
232 -- ^ Virtual unit instantiated on-the-fly. It may be definite if all the
233 -- holes are instantiated but we don't have code objects for it.
234
235 | HoleUnit
236 -- ^ Fake hole unit
237
238 -- | An instantiated unit.
239 --
240 -- It identifies an indefinite library (with holes) that has been instantiated.
241 --
242 -- This unit may be indefinite or not (i.e. with remaining holes or not). If it
243 -- is definite, we don't know if it has already been compiled and installed in a
244 -- database. Nevertheless, we have a mechanism called "improvement" to try to
245 -- match a fully instantiated unit with existing compiled and installed units:
246 -- see Note [VirtUnit to RealUnit improvement].
247 --
248 -- An indefinite unit identifier pretty-prints to something like
249 -- @p[H=<H>,A=aimpl:A>]@ (@p@ is the 'UnitId', and the
250 -- brackets enclose the module substitution).
251 data GenInstantiatedUnit unit
252 = InstantiatedUnit {
253 -- | A private, uniquely identifying representation of
254 -- an InstantiatedUnit. This string is completely private to GHC
255 -- and is just used to get a unique.
256 instUnitFS :: !FastString,
257 -- | Cached unique of 'unitFS'.
258 instUnitKey :: !Unique,
259 -- | The (indefinite) unit being instantiated.
260 instUnitInstanceOf :: !unit,
261 -- | The sorted (by 'ModuleName') instantiations of this unit.
262 instUnitInsts :: !(GenInstantiations unit),
263 -- | A cache of the free module holes of 'instUnitInsts'.
264 -- This lets us efficiently tell if a 'InstantiatedUnit' has been
265 -- fully instantiated (empty set of free module holes)
266 -- and whether or not a substitution can have any effect.
267 instUnitHoles :: UniqDSet ModuleName
268 }
269
270 type Unit = GenUnit UnitId
271 type InstantiatedUnit = GenInstantiatedUnit UnitId
272
273 type GenInstantiations unit = [(ModuleName,GenModule (GenUnit unit))]
274 type Instantiations = GenInstantiations UnitId
275
276 holeUnique :: Unique
277 holeUnique = getUnique holeFS
278
279 holeFS :: FastString
280 holeFS = fsLit "<hole>"
281
282 isHoleUnit :: GenUnit u -> Bool
283 isHoleUnit HoleUnit = True
284 isHoleUnit _ = False
285
286
287 instance Eq (GenInstantiatedUnit unit) where
288 u1 == u2 = instUnitKey u1 == instUnitKey u2
289
290 instance Ord (GenInstantiatedUnit unit) where
291 u1 `compare` u2 = instUnitFS u1 `lexicalCompareFS` instUnitFS u2
292
293 instance Binary InstantiatedUnit where
294 put_ bh indef = do
295 put_ bh (instUnitInstanceOf indef)
296 put_ bh (instUnitInsts indef)
297 get bh = do
298 cid <- get bh
299 insts <- get bh
300 let fs = mkInstantiatedUnitHash cid insts
301 return InstantiatedUnit {
302 instUnitInstanceOf = cid,
303 instUnitInsts = insts,
304 instUnitHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
305 instUnitFS = fs,
306 instUnitKey = getUnique fs
307 }
308
309 instance IsUnitId u => Eq (GenUnit u) where
310 uid1 == uid2 = unitUnique uid1 == unitUnique uid2
311
312 instance IsUnitId u => Uniquable (GenUnit u) where
313 getUnique = unitUnique
314
315 instance Ord Unit where
316 nm1 `compare` nm2 = stableUnitCmp nm1 nm2
317
318 instance Data Unit where
319 -- don't traverse?
320 toConstr _ = abstractConstr "Unit"
321 gunfold _ _ = error "gunfold"
322 dataTypeOf _ = mkNoRepType "Unit"
323
324 instance NFData Unit where
325 rnf x = x `seq` ()
326
327 -- | Compares unit ids lexically, rather than by their 'Unique's
328 stableUnitCmp :: Unit -> Unit -> Ordering
329 stableUnitCmp p1 p2 = unitFS p1 `lexicalCompareFS` unitFS p2
330
331 instance Outputable Unit where
332 ppr pk = pprUnit pk
333
334 pprUnit :: Unit -> SDoc
335 pprUnit (RealUnit uid) = ppr uid
336 pprUnit (VirtUnit uid) = ppr uid
337 pprUnit HoleUnit = ftext holeFS
338
339 instance Show Unit where
340 show = unitString
341
342 -- Performance: would prefer to have a NameCache like thing
343 instance Binary Unit where
344 put_ bh (RealUnit def_uid) = do
345 putByte bh 0
346 put_ bh def_uid
347 put_ bh (VirtUnit indef_uid) = do
348 putByte bh 1
349 put_ bh indef_uid
350 put_ bh HoleUnit =
351 putByte bh 2
352 get bh = do b <- getByte bh
353 case b of
354 0 -> fmap RealUnit (get bh)
355 1 -> fmap VirtUnit (get bh)
356 _ -> pure HoleUnit
357
358 -- | Retrieve the set of free module holes of a 'Unit'.
359 unitFreeModuleHoles :: GenUnit u -> UniqDSet ModuleName
360 unitFreeModuleHoles (VirtUnit x) = instUnitHoles x
361 unitFreeModuleHoles (RealUnit _) = emptyUniqDSet
362 unitFreeModuleHoles HoleUnit = emptyUniqDSet
363
364 -- | Calculate the free holes of a 'Module'. If this set is non-empty,
365 -- this module was defined in an indefinite library that had required
366 -- signatures.
367 --
368 -- If a module has free holes, that means that substitutions can operate on it;
369 -- if it has no free holes, substituting over a module has no effect.
370 moduleFreeHoles :: GenModule (GenUnit u) -> UniqDSet ModuleName
371 moduleFreeHoles (Module HoleUnit name) = unitUniqDSet name
372 moduleFreeHoles (Module u _ ) = unitFreeModuleHoles u
373
374
375 -- | Create a new 'GenInstantiatedUnit' given an explicit module substitution.
376 mkInstantiatedUnit :: IsUnitId u => u -> GenInstantiations u -> GenInstantiatedUnit u
377 mkInstantiatedUnit cid insts =
378 InstantiatedUnit {
379 instUnitInstanceOf = cid,
380 instUnitInsts = sorted_insts,
381 instUnitHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
382 instUnitFS = fs,
383 instUnitKey = getUnique fs
384 }
385 where
386 fs = mkInstantiatedUnitHash cid sorted_insts
387 sorted_insts = sortBy (stableModuleNameCmp `on` fst) insts
388
389
390 -- | Smart constructor for instantiated GenUnit
391 mkVirtUnit :: IsUnitId u => u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
392 mkVirtUnit uid [] = RealUnit $ Definite uid
393 mkVirtUnit uid insts = VirtUnit $ mkInstantiatedUnit uid insts
394
395 -- | Generate a uniquely identifying hash (internal unit-id) for an instantiated
396 -- unit.
397 --
398 -- This is a one-way function. If the indefinite unit has not been instantiated at all, we return its unit-id.
399 --
400 -- This hash is completely internal to GHC and is not used for symbol names or
401 -- file paths. It is different from the hash Cabal would produce for the same
402 -- instantiated unit.
403 mkInstantiatedUnitHash :: IsUnitId u => u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
404 mkInstantiatedUnitHash cid sorted_holes =
405 mkFastStringByteString
406 . fingerprintUnitId (bytesFS (unitFS cid))
407 $ hashInstantiations sorted_holes
408
409 -- | Generate a hash for a sorted module instantiation.
410 hashInstantiations :: IsUnitId u => [(ModuleName, GenModule (GenUnit u))] -> Fingerprint
411 hashInstantiations sorted_holes =
412 fingerprintByteString
413 . BS.concat $ do
414 (m, b) <- sorted_holes
415 [ bytesFS (moduleNameFS m), BS.Char8.singleton ' ',
416 bytesFS (unitFS (moduleUnit b)), BS.Char8.singleton ':',
417 bytesFS (moduleNameFS (moduleName b)), BS.Char8.singleton '\n']
418
419 fingerprintUnitId :: BS.ByteString -> Fingerprint -> BS.ByteString
420 fingerprintUnitId prefix (Fingerprint a b)
421 = BS.concat
422 $ [ prefix
423 , BS.Char8.singleton '-'
424 , BS.Char8.pack (toBase62Padded a)
425 , BS.Char8.pack (toBase62Padded b) ]
426
427 unitUnique :: IsUnitId u => GenUnit u -> Unique
428 unitUnique (VirtUnit x) = instUnitKey x
429 unitUnique (RealUnit (Definite x)) = getUnique (unitFS x)
430 unitUnique HoleUnit = holeUnique
431
432 -- | Create a new simple unit identifier from a 'FastString'. Internally,
433 -- this is primarily used to specify wired-in unit identifiers.
434 fsToUnit :: FastString -> Unit
435 fsToUnit = RealUnit . Definite . UnitId
436
437 unitString :: IsUnitId u => u -> String
438 unitString = unpackFS . unitFS
439
440 stringToUnit :: String -> Unit
441 stringToUnit = fsToUnit . mkFastString
442
443 -- | Map over the unit type of a 'GenUnit'
444 mapGenUnit :: IsUnitId v => (u -> v) -> GenUnit u -> GenUnit v
445 mapGenUnit f = go
446 where
447 go gu = case gu of
448 HoleUnit -> HoleUnit
449 RealUnit d -> RealUnit (fmap f d)
450 VirtUnit i ->
451 VirtUnit $ mkInstantiatedUnit
452 (f (instUnitInstanceOf i))
453 (fmap (second (fmap go)) (instUnitInsts i))
454
455 -- | Map over the unit identifier of unit instantiations.
456 mapInstantiations :: IsUnitId v => (u -> v) -> GenInstantiations u -> GenInstantiations v
457 mapInstantiations f = map (second (fmap (mapGenUnit f)))
458
459 -- | Return the UnitId of the Unit. For on-the-fly instantiated units, return
460 -- the UnitId of the indefinite unit this unit is an instance of.
461 toUnitId :: Unit -> UnitId
462 toUnitId (RealUnit (Definite iuid)) = iuid
463 toUnitId (VirtUnit indef) = instUnitInstanceOf indef
464 toUnitId HoleUnit = error "Hole unit"
465
466 -- | Return the virtual UnitId of an on-the-fly instantiated unit.
467 virtualUnitId :: InstantiatedUnit -> UnitId
468 virtualUnitId i = UnitId (instUnitFS i)
469
470 -- | A 'Unit' is definite if it has no free holes.
471 unitIsDefinite :: Unit -> Bool
472 unitIsDefinite = isEmptyUniqDSet . unitFreeModuleHoles
473
474 ---------------------------------------------------------------------
475 -- UNIT IDs
476 ---------------------------------------------------------------------
477
478 -- | A UnitId identifies a built library in a database and is used to generate
479 -- unique symbols, etc. It's usually of the form:
480 --
481 -- pkgname-1.2:libname+hash
482 --
483 -- These UnitId are provided to us via the @-this-unit-id@ flag.
484 --
485 -- The library in question may be definite or indefinite; if it is indefinite,
486 -- none of the holes have been filled (we never install partially instantiated
487 -- libraries as we can cheaply instantiate them on-the-fly, cf VirtUnit). Put
488 -- another way, an installed unit id is either fully instantiated, or not
489 -- instantiated at all.
490 newtype UnitId = UnitId
491 { unitIdFS :: FastString
492 -- ^ The full hashed unit identifier, including the component id
493 -- and the hash.
494 }
495 deriving (Data)
496
497 instance Binary UnitId where
498 put_ bh (UnitId fs) = put_ bh fs
499 get bh = do fs <- get bh; return (UnitId fs)
500
501 instance Eq UnitId where
502 uid1 == uid2 = getUnique uid1 == getUnique uid2
503
504 instance Ord UnitId where
505 -- we compare lexically to avoid non-deterministic output when sets of
506 -- unit-ids are printed (dependencies, etc.)
507 u1 `compare` u2 = unitIdFS u1 `lexicalCompareFS` unitIdFS u2
508
509 instance Uniquable UnitId where
510 getUnique = getUnique . unitIdFS
511
512 instance Outputable UnitId where
513 ppr (UnitId fs) = sdocOption sdocUnitIdForUser ($ fs) -- see Note [Pretty-printing UnitId]
514 -- in "GHC.Unit"
515
516 -- | A 'DefUnitId' is an 'UnitId' with the invariant that
517 -- it only refers to a definite library; i.e., one we have generated
518 -- code for.
519 type DefUnitId = Definite UnitId
520
521 unitIdString :: UnitId -> String
522 unitIdString = unpackFS . unitIdFS
523
524 stringToUnitId :: String -> UnitId
525 stringToUnitId = UnitId . mkFastString
526
527 ---------------------------------------------------------------------
528 -- UTILS
529 ---------------------------------------------------------------------
530
531 -- | A definite unit (i.e. without any free module hole)
532 newtype Definite unit = Definite { unDefinite :: unit }
533 deriving (Functor)
534 deriving newtype (Eq, Ord, Outputable, Binary, Uniquable, IsUnitId)
535
536 ---------------------------------------------------------------------
537 -- WIRED-IN UNITS
538 ---------------------------------------------------------------------
539
540 {-
541 Note [Wired-in units]
542 ~~~~~~~~~~~~~~~~~~~~~
543
544 Certain packages are known to the compiler, in that we know about certain
545 entities that reside in these packages, and the compiler needs to
546 declare static Modules and Names that refer to these packages. Hence
547 the wired-in packages can't include version numbers in their package UnitId,
548 since we don't want to bake the version numbers of these packages into GHC.
549
550 So here's the plan. Wired-in units are still versioned as
551 normal in the packages database, and you can still have multiple
552 versions of them installed. To the user, everything looks normal.
553
554 However, for each invocation of GHC, only a single instance of each wired-in
555 package will be recognised (the desired one is selected via
556 @-package@\/@-hide-package@), and GHC will internally pretend that it has the
557 *unversioned* 'UnitId', including in .hi files and object file symbols.
558
559 Unselected versions of wired-in packages will be ignored, as will any other
560 package that depends directly or indirectly on it (much as if you
561 had used @-ignore-package@).
562
563 The affected packages are compiled with, e.g., @-this-unit-id base@, so that
564 the symbols in the object files have the unversioned unit id in their name.
565
566 Make sure you change 'GHC.Unit.State.findWiredInUnits' if you add an entry here.
567
568 -}
569
570 bignumUnitId, primUnitId, baseUnitId, rtsUnitId,
571 thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId
572
573 bignumUnit, primUnit, baseUnit, rtsUnit,
574 thUnit, mainUnit, thisGhcUnit, interactiveUnit :: Unit
575
576 primUnitId = UnitId (fsLit "ghc-prim")
577 bignumUnitId = UnitId (fsLit "ghc-bignum")
578 baseUnitId = UnitId (fsLit "base")
579 rtsUnitId = UnitId (fsLit "rts")
580 thisGhcUnitId = UnitId (fsLit "ghc")
581 interactiveUnitId = UnitId (fsLit "interactive")
582 thUnitId = UnitId (fsLit "template-haskell")
583
584 thUnit = RealUnit (Definite thUnitId)
585 primUnit = RealUnit (Definite primUnitId)
586 bignumUnit = RealUnit (Definite bignumUnitId)
587 baseUnit = RealUnit (Definite baseUnitId)
588 rtsUnit = RealUnit (Definite rtsUnitId)
589 thisGhcUnit = RealUnit (Definite thisGhcUnitId)
590 interactiveUnit = RealUnit (Definite interactiveUnitId)
591
592 -- | This is the package Id for the current program. It is the default
593 -- package Id if you don't specify a package name. We don't add this prefix
594 -- to symbol names, since there can be only one main package per program.
595 mainUnitId = UnitId (fsLit "main")
596 mainUnit = RealUnit (Definite mainUnitId)
597
598 isInteractiveModule :: Module -> Bool
599 isInteractiveModule mod = moduleUnit mod == interactiveUnit
600
601 wiredInUnitIds :: [UnitId]
602 wiredInUnitIds =
603 [ primUnitId
604 , bignumUnitId
605 , baseUnitId
606 , rtsUnitId
607 , thUnitId
608 , thisGhcUnitId
609 ]
610
611 ---------------------------------------------------------------------
612 -- Boot Modules
613 ---------------------------------------------------------------------
614
615 -- Note [Boot Module Naming]
616 -- ~~~~~~~~~~~~~~~~~~~~~~~~~
617 -- Why is this section here? After all, these modules are supposed to be about
618 -- ways of referring to modules, not modules themselves. Well, the "bootness" of
619 -- a module is in a way part of its name, because 'import {-# SOURCE #-} Foo'
620 -- references the boot module in particular while 'import Foo' references the
621 -- regular module. Backpack signatures live in the normal module namespace (no
622 -- special import), so they don't matter here. When dealing with the modules
623 -- themselves, however, one should use not 'IsBoot' or conflate signatures and
624 -- modules in opposition to boot interfaces. Instead, one should use
625 -- 'DriverPhases.HscSource'. See Note [HscSource types].
626
627 -- | Indicates whether a module name is referring to a boot interface (hs-boot
628 -- file) or regular module (hs file). We need to treat boot modules specially
629 -- when building compilation graphs, since they break cycles. Regular source
630 -- files and signature files are treated equivalently.
631 data IsBootInterface = NotBoot | IsBoot
632 deriving (Eq, Ord, Show, Data)
633
634 instance Binary IsBootInterface where
635 put_ bh ib = put_ bh $
636 case ib of
637 NotBoot -> False
638 IsBoot -> True
639 get bh = do
640 b <- get bh
641 return $ case b of
642 False -> NotBoot
643 True -> IsBoot
644
645 -- | This data type just pairs a value 'mod' with an IsBootInterface flag. In
646 -- practice, 'mod' is usually a @Module@ or @ModuleName@'.
647 data GenWithIsBoot mod = GWIB
648 { gwib_mod :: mod
649 , gwib_isBoot :: IsBootInterface
650 } deriving ( Eq, Ord, Show
651 , Functor, Foldable, Traversable
652 )
653 -- the Ord instance must ensure that we first sort by Module and then by
654 -- IsBootInterface: this is assumed to perform filtering of non-boot modules,
655 -- e.g. in GHC.Driver.Env.hptModulesBelow
656
657 type ModuleNameWithIsBoot = GenWithIsBoot ModuleName
658
659 type ModuleWithIsBoot = GenWithIsBoot Module
660
661 instance Binary a => Binary (GenWithIsBoot a) where
662 put_ bh (GWIB { gwib_mod, gwib_isBoot }) = do
663 put_ bh gwib_mod
664 put_ bh gwib_isBoot
665 get bh = do
666 gwib_mod <- get bh
667 gwib_isBoot <- get bh
668 pure $ GWIB { gwib_mod, gwib_isBoot }
669
670 instance Outputable a => Outputable (GenWithIsBoot a) where
671 ppr (GWIB { gwib_mod, gwib_isBoot }) = hsep $ ppr gwib_mod : case gwib_isBoot of
672 IsBoot -> [ text "{-# SOURCE #-}" ]
673 NotBoot -> []