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 -> []