{-# OPTIONS_GHC -Wno-orphans #-} -- instance Binary IsBootInterface

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Unit & Module types
--
-- This module is used to resolve the loops between Unit and Module types
-- (Module references a Unit and vice-versa).
module GHC.Unit.Types
   ( -- * Modules
     GenModule (..)
   , Module
   , InstalledModule
   , HomeUnitModule
   , InstantiatedModule
   , mkModule
   , moduleUnitId
   , pprModule
   , pprInstantiatedModule
   , moduleFreeHoles

     -- * Units
   , IsUnitId
   , GenUnit (..)
   , Unit
   , UnitId (..)
   , UnitKey (..)
   , GenInstantiatedUnit (..)
   , InstantiatedUnit
   , DefUnitId
   , Instantiations
   , GenInstantiations
   , mkInstantiatedUnit
   , mkInstantiatedUnitHash
   , mkVirtUnit
   , mapGenUnit
   , mapInstantiations
   , unitFreeModuleHoles
   , fsToUnit
   , unitFS
   , unitString
   , toUnitId
   , virtualUnitId
   , stringToUnit
   , stableUnitCmp
   , unitIsDefinite
   , isHoleUnit
   , pprUnit

     -- * Unit Ids
   , unitIdString
   , stringToUnitId

     -- * Utils
   , Definite (..)

     -- * Wired-in units
   , primUnitId
   , bignumUnitId
   , ghcInternalUnitId
   , rtsUnitId
   , mainUnitId
   , thisGhcUnitId
   , interactiveUnitId

   , primUnit
   , bignumUnit
   , ghcInternalUnit
   , rtsUnit
   , mainUnit
   , thisGhcUnit
   , interactiveUnit

   , isInteractiveModule
   , wiredInUnitIds

     -- * Boot modules
   , IsBootInterface (..)
   , GenWithIsBoot (..)
   , ModuleNameWithIsBoot
   , ModuleWithIsBoot
   , InstalledModuleWithIsBoot
   , notBoot
   )
where

import GHC.Prelude

import GHC.Types.Unique
import GHC.Types.Unique.DSet
import GHC.Utils.Binary
import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Utils.Encoding
import GHC.Utils.Fingerprint
import GHC.Utils.Misc
import GHC.Settings.Config (cProjectUnitId)

import Control.DeepSeq (NFData(..))
import Data.Data
import Data.List (sortBy)
import Data.Function
import Data.Bifunctor
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS.Char8

import Language.Haskell.Syntax.Module.Name
import {-# SOURCE #-} Language.Haskell.Syntax.ImpExp (IsBootInterface(..))

---------------------------------------------------------------------
-- MODULES
---------------------------------------------------------------------

-- | A generic module is a pair of a unit identifier and a 'ModuleName'.
data GenModule unit = Module
   { forall unit. GenModule unit -> unit
moduleUnit :: !unit       -- ^ Unit the module belongs to
   , forall unit. GenModule unit -> ModuleName
moduleName :: !ModuleName -- ^ Module name (e.g. A.B.C)
   }
   deriving (GenModule unit -> GenModule unit -> Bool
(GenModule unit -> GenModule unit -> Bool)
-> (GenModule unit -> GenModule unit -> Bool)
-> Eq (GenModule unit)
forall unit. Eq unit => GenModule unit -> GenModule unit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall unit. Eq unit => GenModule unit -> GenModule unit -> Bool
== :: GenModule unit -> GenModule unit -> Bool
$c/= :: forall unit. Eq unit => GenModule unit -> GenModule unit -> Bool
/= :: GenModule unit -> GenModule unit -> Bool
Eq,Eq (GenModule unit)
Eq (GenModule unit) =>
(GenModule unit -> GenModule unit -> Ordering)
-> (GenModule unit -> GenModule unit -> Bool)
-> (GenModule unit -> GenModule unit -> Bool)
-> (GenModule unit -> GenModule unit -> Bool)
-> (GenModule unit -> GenModule unit -> Bool)
-> (GenModule unit -> GenModule unit -> GenModule unit)
-> (GenModule unit -> GenModule unit -> GenModule unit)
-> Ord (GenModule unit)
GenModule unit -> GenModule unit -> Bool
GenModule unit -> GenModule unit -> Ordering
GenModule unit -> GenModule unit -> GenModule unit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall unit. Ord unit => Eq (GenModule unit)
forall unit. Ord unit => GenModule unit -> GenModule unit -> Bool
forall unit.
Ord unit =>
GenModule unit -> GenModule unit -> Ordering
forall unit.
Ord unit =>
GenModule unit -> GenModule unit -> GenModule unit
$ccompare :: forall unit.
Ord unit =>
GenModule unit -> GenModule unit -> Ordering
compare :: GenModule unit -> GenModule unit -> Ordering
$c< :: forall unit. Ord unit => GenModule unit -> GenModule unit -> Bool
< :: GenModule unit -> GenModule unit -> Bool
$c<= :: forall unit. Ord unit => GenModule unit -> GenModule unit -> Bool
<= :: GenModule unit -> GenModule unit -> Bool
$c> :: forall unit. Ord unit => GenModule unit -> GenModule unit -> Bool
> :: GenModule unit -> GenModule unit -> Bool
$c>= :: forall unit. Ord unit => GenModule unit -> GenModule unit -> Bool
>= :: GenModule unit -> GenModule unit -> Bool
$cmax :: forall unit.
Ord unit =>
GenModule unit -> GenModule unit -> GenModule unit
max :: GenModule unit -> GenModule unit -> GenModule unit
$cmin :: forall unit.
Ord unit =>
GenModule unit -> GenModule unit -> GenModule unit
min :: GenModule unit -> GenModule unit -> GenModule unit
Ord,Typeable (GenModule unit)
Typeable (GenModule unit) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> GenModule unit -> c (GenModule unit))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (GenModule unit))
-> (GenModule unit -> Constr)
-> (GenModule unit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (GenModule unit)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (GenModule unit)))
-> ((forall b. Data b => b -> b)
    -> GenModule unit -> GenModule unit)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GenModule unit -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GenModule unit -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> GenModule unit -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GenModule unit -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> GenModule unit -> m (GenModule unit))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> GenModule unit -> m (GenModule unit))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> GenModule unit -> m (GenModule unit))
-> Data (GenModule unit)
GenModule unit -> Constr
GenModule unit -> DataType
(forall b. Data b => b -> b) -> GenModule unit -> GenModule unit
forall unit. Data unit => Typeable (GenModule unit)
forall unit. Data unit => GenModule unit -> Constr
forall unit. Data unit => GenModule unit -> DataType
forall unit.
Data unit =>
(forall b. Data b => b -> b) -> GenModule unit -> GenModule unit
forall unit u.
Data unit =>
Int -> (forall d. Data d => d -> u) -> GenModule unit -> u
forall unit u.
Data unit =>
(forall d. Data d => d -> u) -> GenModule unit -> [u]
forall unit r r'.
Data unit =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenModule unit -> r
forall unit r r'.
Data unit =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenModule unit -> r
forall unit (m :: * -> *).
(Data unit, Monad m) =>
(forall d. Data d => d -> m d)
-> GenModule unit -> m (GenModule unit)
forall unit (m :: * -> *).
(Data unit, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> GenModule unit -> m (GenModule unit)
forall unit (c :: * -> *).
Data unit =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GenModule unit)
forall unit (c :: * -> *).
Data unit =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenModule unit -> c (GenModule unit)
forall unit (t :: * -> *) (c :: * -> *).
(Data unit, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (GenModule unit))
forall unit (t :: * -> * -> *) (c :: * -> *).
(Data unit, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GenModule unit))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> GenModule unit -> u
forall u. (forall d. Data d => d -> u) -> GenModule unit -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenModule unit -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenModule unit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GenModule unit -> m (GenModule unit)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenModule unit -> m (GenModule unit)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GenModule unit)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenModule unit -> c (GenModule unit)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (GenModule unit))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GenModule unit))
$cgfoldl :: forall unit (c :: * -> *).
Data unit =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenModule unit -> c (GenModule unit)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenModule unit -> c (GenModule unit)
$cgunfold :: forall unit (c :: * -> *).
Data unit =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GenModule unit)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GenModule unit)
$ctoConstr :: forall unit. Data unit => GenModule unit -> Constr
toConstr :: GenModule unit -> Constr
$cdataTypeOf :: forall unit. Data unit => GenModule unit -> DataType
dataTypeOf :: GenModule unit -> DataType
$cdataCast1 :: forall unit (t :: * -> *) (c :: * -> *).
(Data unit, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (GenModule unit))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (GenModule unit))
$cdataCast2 :: forall unit (t :: * -> * -> *) (c :: * -> *).
(Data unit, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GenModule unit))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (GenModule unit))
$cgmapT :: forall unit.
Data unit =>
(forall b. Data b => b -> b) -> GenModule unit -> GenModule unit
gmapT :: (forall b. Data b => b -> b) -> GenModule unit -> GenModule unit
$cgmapQl :: forall unit r r'.
Data unit =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenModule unit -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenModule unit -> r
$cgmapQr :: forall unit r r'.
Data unit =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenModule unit -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenModule unit -> r
$cgmapQ :: forall unit u.
Data unit =>
(forall d. Data d => d -> u) -> GenModule unit -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> GenModule unit -> [u]
$cgmapQi :: forall unit u.
Data unit =>
Int -> (forall d. Data d => d -> u) -> GenModule unit -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> GenModule unit -> u
$cgmapM :: forall unit (m :: * -> *).
(Data unit, Monad m) =>
(forall d. Data d => d -> m d)
-> GenModule unit -> m (GenModule unit)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GenModule unit -> m (GenModule unit)
$cgmapMp :: forall unit (m :: * -> *).
(Data unit, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> GenModule unit -> m (GenModule unit)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenModule unit -> m (GenModule unit)
$cgmapMo :: forall unit (m :: * -> *).
(Data unit, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> GenModule unit -> m (GenModule unit)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenModule unit -> m (GenModule unit)
Data,(forall a b. (a -> b) -> GenModule a -> GenModule b)
-> (forall a b. a -> GenModule b -> GenModule a)
-> Functor GenModule
forall a b. a -> GenModule b -> GenModule a
forall a b. (a -> b) -> GenModule a -> GenModule b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GenModule a -> GenModule b
fmap :: forall a b. (a -> b) -> GenModule a -> GenModule b
$c<$ :: forall a b. a -> GenModule b -> GenModule a
<$ :: forall a b. a -> GenModule b -> GenModule a
Functor)

instance Data ModuleName where
  -- don't traverse?
  toConstr :: ModuleName -> Constr
toConstr ModuleName
_   = String -> Constr
abstractConstr String
"ModuleName"
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleName
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c ModuleName
forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: ModuleName -> DataType
dataTypeOf ModuleName
_ = String -> DataType
mkNoRepType String
"ModuleName"

-- | A Module is a pair of a 'Unit' and a 'ModuleName'.
type Module = GenModule Unit

moduleUnitId :: Module -> UnitId
moduleUnitId :: Module -> UnitId
moduleUnitId = Unit -> UnitId
toUnitId (Unit -> UnitId) -> (Module -> Unit) -> Module -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit

-- | A 'InstalledModule' is a 'Module' whose unit is identified with an
-- 'UnitId'.
type InstalledModule = GenModule UnitId

-- | A 'HomeUnitModule' is like an 'InstalledModule' but we expect to find it in
-- one of the home units rather than the package database.
type HomeUnitModule  = GenModule UnitId

-- | An `InstantiatedModule` is a 'Module' whose unit is identified with an `InstantiatedUnit`.
type InstantiatedModule = GenModule InstantiatedUnit


mkModule :: u -> ModuleName -> GenModule u
mkModule :: forall u. u -> ModuleName -> GenModule u
mkModule = u -> ModuleName -> GenModule u
forall u. u -> ModuleName -> GenModule u
Module

instance Uniquable Module where
  getUnique :: Module -> Unique
getUnique (Module Unit
p ModuleName
n) = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (Unit -> FastString
forall u. IsUnitId u => u -> FastString
unitFS Unit
p FastString -> FastString -> FastString
`appendFS` ModuleName -> FastString
moduleNameFS ModuleName
n)

instance Binary a => Binary (GenModule a) where
  put_ :: WriteBinHandle -> GenModule a -> IO ()
put_ WriteBinHandle
bh (Module a
p ModuleName
n) = WriteBinHandle -> a -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh a
p IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> ModuleName -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh ModuleName
n
  -- Module has strict fields, so use $! in order not to allocate a thunk
  get :: ReadBinHandle -> IO (GenModule a)
get ReadBinHandle
bh = do p <- ReadBinHandle -> IO a
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh; n <- get bh; return $! Module p n

instance NFData (GenModule a) where
  rnf :: GenModule a -> ()
rnf (Module a
unit ModuleName
name) = a
unit a -> () -> ()
forall a b. a -> b -> b
`seq` ModuleName
name ModuleName -> () -> ()
forall a b. a -> b -> b
`seq` ()

instance Outputable Module where
  ppr :: Module -> SDoc
ppr = Module -> SDoc
forall doc. IsLine doc => Module -> doc
pprModule

instance Outputable InstalledModule where
  ppr :: InstalledModule -> SDoc
ppr (Module UnitId
p ModuleName
n) =
    UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnitId
p SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
':' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ModuleName -> SDoc
forall doc. IsLine doc => ModuleName -> doc
pprModuleName ModuleName
n

instance Outputable InstantiatedModule where
  ppr :: InstantiatedModule -> SDoc
ppr = InstantiatedModule -> SDoc
pprInstantiatedModule

instance Outputable InstantiatedUnit where
  ppr :: InstantiatedUnit -> SDoc
ppr = InstantiatedUnit -> SDoc
pprInstantiatedUnit

pprInstantiatedUnit :: InstantiatedUnit -> SDoc
pprInstantiatedUnit :: InstantiatedUnit -> SDoc
pprInstantiatedUnit InstantiatedUnit
uid =
      -- getPprStyle $ \sty ->
      UnitId -> SDoc
pprUnitId UnitId
cid SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
        (if Bool -> Bool
not ([(ModuleName, Module)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, Module)]
insts) -- pprIf
          then
            SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat
                (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$
                    [ ModuleName -> SDoc
forall doc. IsLine doc => ModuleName -> doc
pprModuleName ModuleName
modname SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Module -> SDoc
forall doc. IsLine doc => Module -> doc
pprModule Module
m
                    | (ModuleName
modname, Module
m) <- [(ModuleName, Module)]
insts]))
          else SDoc
forall doc. IsOutput doc => doc
empty)
     where
      cid :: UnitId
cid   = InstantiatedUnit -> UnitId
forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf InstantiatedUnit
uid
      insts :: [(ModuleName, Module)]
insts = InstantiatedUnit -> [(ModuleName, Module)]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts InstantiatedUnit
uid

-- | Class for types that are used as unit identifiers (UnitKey, UnitId, Unit)
--
-- We need this class because we create new unit ids for virtual units (see
-- VirtUnit) and they have to to be made from units with different kinds of
-- identifiers.
class IsUnitId u where
   unitFS :: u -> FastString

instance IsUnitId UnitKey where
   unitFS :: UnitKey -> FastString
unitFS (UnitKey FastString
fs) = FastString
fs

instance IsUnitId UnitId where
   unitFS :: UnitId -> FastString
unitFS (UnitId FastString
fs) = FastString
fs

instance IsUnitId u => IsUnitId (GenUnit u) where
   unitFS :: GenUnit u -> FastString
unitFS (VirtUnit GenInstantiatedUnit u
x)            = GenInstantiatedUnit u -> FastString
forall unit. GenInstantiatedUnit unit -> FastString
instUnitFS GenInstantiatedUnit u
x
   unitFS (RealUnit (Definite u
x)) = u -> FastString
forall u. IsUnitId u => u -> FastString
unitFS u
x
   unitFS GenUnit u
HoleUnit                = FastString
holeFS

pprModule :: IsLine doc => Module -> doc
pprModule :: forall doc. IsLine doc => Module -> doc
pprModule mod :: Module
mod@(Module Unit
p ModuleName
n) = doc -> (PprStyle -> SDoc) -> doc
forall doc. IsOutput doc => doc -> (PprStyle -> SDoc) -> doc
docWithStyle doc
code PprStyle -> SDoc
doc
 where
  code :: doc
code = (if Unit
p Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Unit
mainUnit
                then doc
forall doc. IsOutput doc => doc
empty -- never qualify the main package in code
                else FastZString -> doc
forall doc. IsLine doc => FastZString -> doc
ztext (FastString -> FastZString
zEncodeFS (Unit -> FastString
forall u. IsUnitId u => u -> FastString
unitFS Unit
p)) doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'_')
            doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> ModuleName -> doc
forall doc. IsLine doc => ModuleName -> doc
pprModuleName ModuleName
n
  doc :: PprStyle -> SDoc
doc PprStyle
sty
    | PprStyle -> QueryQualifyModule
qualModule PprStyle
sty Module
mod =
        case Unit
p of
          Unit
HoleUnit -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
angleBrackets (ModuleName -> SDoc
forall doc. IsLine doc => ModuleName -> doc
pprModuleName ModuleName
n)
          Unit
_        -> Unit -> SDoc
pprUnit Unit
p SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
':' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ModuleName -> SDoc
forall doc. IsLine doc => ModuleName -> doc
pprModuleName ModuleName
n
    | Bool
otherwise =
        ModuleName -> SDoc
forall doc. IsLine doc => ModuleName -> doc
pprModuleName ModuleName
n
{-# SPECIALIZE pprModule :: Module -> SDoc #-}
{-# SPECIALIZE pprModule :: Module -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

pprInstantiatedModule :: InstantiatedModule -> SDoc
pprInstantiatedModule :: InstantiatedModule -> SDoc
pprInstantiatedModule (Module InstantiatedUnit
uid ModuleName
m) =
    InstantiatedUnit -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstantiatedUnit
uid SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
':' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m

---------------------------------------------------------------------
-- UNITS
---------------------------------------------------------------------

-- | A unit key in the database
newtype UnitKey = UnitKey FastString

-- | A unit identifier identifies a (possibly partially) instantiated library.
-- It is primarily used as part of 'Module', which in turn is used in 'Name',
-- which is used to give names to entities when typechecking.
--
-- There are two possible forms for a 'Unit':
--
-- 1) It can be a 'RealUnit', in which case we just have a 'DefUnitId' that
-- uniquely identifies some fully compiled, installed library we have on disk.
--
-- 2) It can be an 'VirtUnit'. When we are typechecking a library with missing
-- holes, we may need to instantiate a library on the fly (in which case we
-- don't have any on-disk representation.)  In that case, you have an
-- 'InstantiatedUnit', which explicitly records the instantiation, so that we
-- can substitute over it.
data GenUnit uid
    = RealUnit !(Definite uid)
      -- ^ Installed definite unit (either a fully instantiated unit or a closed unit)

    | VirtUnit {-# UNPACK #-} !(GenInstantiatedUnit uid)
      -- ^ Virtual unit instantiated on-the-fly. It may be definite if all the
      -- holes are instantiated but we don't have code objects for it.

    | HoleUnit
      -- ^ Fake hole unit

-- | An instantiated unit.
--
-- It identifies an indefinite library (with holes) that has been instantiated.
--
-- This unit may be indefinite or not (i.e. with remaining holes or not). If it
-- is definite, we don't know if it has already been compiled and installed in a
-- database. Nevertheless, we have a mechanism called "improvement" to try to
-- match a fully instantiated unit with existing compiled and installed units:
-- see Note [VirtUnit to RealUnit improvement].
--
-- An indefinite unit identifier pretty-prints to something like
-- @p[H=<H>,A=aimpl:A>]@ (@p@ is the 'UnitId', and the
-- brackets enclose the module substitution).
data GenInstantiatedUnit unit
    = InstantiatedUnit {
        -- | A private, uniquely identifying representation of
        -- an InstantiatedUnit. This string is completely private to GHC
        -- and is just used to get a unique.
        forall unit. GenInstantiatedUnit unit -> FastString
instUnitFS :: !FastString,
        -- | Cached unique of 'unitFS'.
        forall unit. GenInstantiatedUnit unit -> Unique
instUnitKey :: !Unique,
        -- | The (indefinite) unit being instantiated.
        forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf :: !unit,
        -- | The sorted (by 'ModuleName') instantiations of this unit.
        forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts :: !(GenInstantiations unit),
        -- | A cache of the free module holes of 'instUnitInsts'.
        -- This lets us efficiently tell if a 'InstantiatedUnit' has been
        -- fully instantiated (empty set of free module holes)
        -- and whether or not a substitution can have any effect.
        forall unit. GenInstantiatedUnit unit -> UniqDSet ModuleName
instUnitHoles :: UniqDSet ModuleName
    }

type Unit             = GenUnit             UnitId
type InstantiatedUnit = GenInstantiatedUnit UnitId

type GenInstantiations unit = [(ModuleName,GenModule (GenUnit unit))]
type Instantiations         = GenInstantiations UnitId

holeUnique :: Unique
holeUnique :: Unique
holeUnique = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
holeFS

holeFS :: FastString
holeFS :: FastString
holeFS = String -> FastString
fsLit String
"<hole>"

isHoleUnit :: GenUnit u -> Bool
isHoleUnit :: forall u. GenUnit u -> Bool
isHoleUnit GenUnit u
HoleUnit = Bool
True
isHoleUnit GenUnit u
_        = Bool
False


instance Eq (GenInstantiatedUnit unit) where
  GenInstantiatedUnit unit
u1 == :: GenInstantiatedUnit unit -> GenInstantiatedUnit unit -> Bool
== GenInstantiatedUnit unit
u2 = GenInstantiatedUnit unit -> Unique
forall unit. GenInstantiatedUnit unit -> Unique
instUnitKey GenInstantiatedUnit unit
u1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== GenInstantiatedUnit unit -> Unique
forall unit. GenInstantiatedUnit unit -> Unique
instUnitKey GenInstantiatedUnit unit
u2

instance Ord (GenInstantiatedUnit unit) where
  GenInstantiatedUnit unit
u1 compare :: GenInstantiatedUnit unit -> GenInstantiatedUnit unit -> Ordering
`compare` GenInstantiatedUnit unit
u2 = GenInstantiatedUnit unit -> FastString
forall unit. GenInstantiatedUnit unit -> FastString
instUnitFS GenInstantiatedUnit unit
u1 FastString -> FastString -> Ordering
`lexicalCompareFS` GenInstantiatedUnit unit -> FastString
forall unit. GenInstantiatedUnit unit -> FastString
instUnitFS GenInstantiatedUnit unit
u2

instance Binary InstantiatedUnit where
  put_ :: WriteBinHandle -> InstantiatedUnit -> IO ()
put_ WriteBinHandle
bh InstantiatedUnit
indef = do
    WriteBinHandle -> UnitId -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (InstantiatedUnit -> UnitId
forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf InstantiatedUnit
indef)
    WriteBinHandle -> [(ModuleName, Module)] -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (InstantiatedUnit -> [(ModuleName, Module)]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts InstantiatedUnit
indef)
  get :: ReadBinHandle -> IO InstantiatedUnit
get ReadBinHandle
bh = do
    cid   <- ReadBinHandle -> IO UnitId
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    insts <- get bh
    let fs = UnitId -> [(ModuleName, Module)] -> FastString
forall u.
IsUnitId u =>
u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
mkInstantiatedUnitHash UnitId
cid [(ModuleName, Module)]
insts
    -- InstantiatedUnit has strict fields, so use $! in order not to allocate a thunk
    return $! InstantiatedUnit {
                instUnitInstanceOf = cid,
                instUnitInsts = insts,
                instUnitHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
                instUnitFS = fs,
                instUnitKey = getUnique fs
              }

instance IsUnitId u => Eq (GenUnit u) where
  GenUnit u
uid1 == :: GenUnit u -> GenUnit u -> Bool
== GenUnit u
uid2 = GenUnit u -> Unique
forall u. IsUnitId u => GenUnit u -> Unique
unitUnique GenUnit u
uid1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== GenUnit u -> Unique
forall u. IsUnitId u => GenUnit u -> Unique
unitUnique GenUnit u
uid2

instance IsUnitId u => Uniquable (GenUnit u) where
  getUnique :: GenUnit u -> Unique
getUnique = GenUnit u -> Unique
forall u. IsUnitId u => GenUnit u -> Unique
unitUnique

instance Ord Unit where
  Unit
nm1 compare :: Unit -> Unit -> Ordering
`compare` Unit
nm2 = Unit -> Unit -> Ordering
stableUnitCmp Unit
nm1 Unit
nm2

instance Data Unit where
  -- don't traverse?
  toConstr :: Unit -> Constr
toConstr Unit
_   = String -> Constr
abstractConstr String
"Unit"
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Unit
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c Unit
forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: Unit -> DataType
dataTypeOf Unit
_ = String -> DataType
mkNoRepType String
"Unit"

instance NFData Unit where
  rnf :: Unit -> ()
rnf Unit
x = Unit
x Unit -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | Compares unit ids lexically, rather than by their 'Unique's
stableUnitCmp :: Unit -> Unit -> Ordering
stableUnitCmp :: Unit -> Unit -> Ordering
stableUnitCmp Unit
p1 Unit
p2 = Unit -> FastString
forall u. IsUnitId u => u -> FastString
unitFS Unit
p1 FastString -> FastString -> Ordering
`lexicalCompareFS` Unit -> FastString
forall u. IsUnitId u => u -> FastString
unitFS Unit
p2

instance Outputable Unit where
   ppr :: Unit -> SDoc
ppr Unit
pk = Unit -> SDoc
pprUnit Unit
pk

pprUnit :: Unit -> SDoc
pprUnit :: Unit -> SDoc
pprUnit (RealUnit (Definite UnitId
d)) = UnitId -> SDoc
pprUnitId UnitId
d
pprUnit (VirtUnit InstantiatedUnit
uid) = InstantiatedUnit -> SDoc
pprInstantiatedUnit InstantiatedUnit
uid
pprUnit Unit
HoleUnit       = FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
holeFS

instance Show Unit where
    show :: Unit -> String
show = Unit -> String
forall u. IsUnitId u => u -> String
unitString

-- Performance: would prefer to have a NameCache like thing
instance Binary Unit where
  put_ :: WriteBinHandle -> Unit -> IO ()
put_ WriteBinHandle
bh (RealUnit Definite UnitId
def_uid) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    WriteBinHandle -> Definite UnitId -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Definite UnitId
def_uid
  put_ WriteBinHandle
bh (VirtUnit InstantiatedUnit
indef_uid) = do
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
    WriteBinHandle -> InstantiatedUnit -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh InstantiatedUnit
indef_uid
  put_ WriteBinHandle
bh Unit
HoleUnit =
    WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
  get :: ReadBinHandle -> IO Unit
get ReadBinHandle
bh = do b <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
              u <- case b of
                Word8
0 -> (Definite UnitId -> Unit) -> IO (Definite UnitId) -> IO Unit
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (ReadBinHandle -> IO (Definite UnitId)
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh)
                Word8
1 -> (InstantiatedUnit -> Unit) -> IO InstantiatedUnit -> IO Unit
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InstantiatedUnit -> Unit
forall uid. GenInstantiatedUnit uid -> GenUnit uid
VirtUnit (ReadBinHandle -> IO InstantiatedUnit
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh)
                Word8
_ -> Unit -> IO Unit
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Unit
forall uid. GenUnit uid
HoleUnit
              -- Unit has strict fields that need forcing; otherwise we allocate a thunk.
              pure $! u

-- | Retrieve the set of free module holes of a 'Unit'.
unitFreeModuleHoles :: GenUnit u -> UniqDSet ModuleName
unitFreeModuleHoles :: forall u. GenUnit u -> UniqDSet ModuleName
unitFreeModuleHoles (VirtUnit GenInstantiatedUnit u
x) = GenInstantiatedUnit u -> UniqDSet ModuleName
forall unit. GenInstantiatedUnit unit -> UniqDSet ModuleName
instUnitHoles GenInstantiatedUnit u
x
unitFreeModuleHoles (RealUnit Definite u
_) = UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet
unitFreeModuleHoles GenUnit u
HoleUnit     = UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet

-- | Calculate the free holes of a 'Module'.  If this set is non-empty,
-- this module was defined in an indefinite library that had required
-- signatures.
--
-- If a module has free holes, that means that substitutions can operate on it;
-- if it has no free holes, substituting over a module has no effect.
moduleFreeHoles :: GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHoles :: forall u. GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHoles (Module GenUnit u
HoleUnit ModuleName
name) = ModuleName -> UniqDSet ModuleName
forall a. Uniquable a => a -> UniqDSet a
unitUniqDSet ModuleName
name
moduleFreeHoles (Module GenUnit u
u        ModuleName
_   ) = GenUnit u -> UniqDSet ModuleName
forall u. GenUnit u -> UniqDSet ModuleName
unitFreeModuleHoles GenUnit u
u


-- | Create a new 'GenInstantiatedUnit' given an explicit module substitution.
mkInstantiatedUnit :: IsUnitId u => u -> GenInstantiations u -> GenInstantiatedUnit u
mkInstantiatedUnit :: forall u.
IsUnitId u =>
u -> GenInstantiations u -> GenInstantiatedUnit u
mkInstantiatedUnit u
cid GenInstantiations u
insts =
    InstantiatedUnit {
        instUnitInstanceOf :: u
instUnitInstanceOf = u
cid,
        instUnitInsts :: GenInstantiations u
instUnitInsts = GenInstantiations u
sorted_insts,
        instUnitHoles :: UniqDSet ModuleName
instUnitHoles = [UniqDSet ModuleName] -> UniqDSet ModuleName
forall a. [UniqDSet a] -> UniqDSet a
unionManyUniqDSets (((ModuleName, GenModule (GenUnit u)) -> UniqDSet ModuleName)
-> GenInstantiations u -> [UniqDSet ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (GenModule (GenUnit u) -> UniqDSet ModuleName
forall u. GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHoles(GenModule (GenUnit u) -> UniqDSet ModuleName)
-> ((ModuleName, GenModule (GenUnit u)) -> GenModule (GenUnit u))
-> (ModuleName, GenModule (GenUnit u))
-> UniqDSet ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ModuleName, GenModule (GenUnit u)) -> GenModule (GenUnit u)
forall a b. (a, b) -> b
snd) GenInstantiations u
insts),
        instUnitFS :: FastString
instUnitFS = FastString
fs,
        instUnitKey :: Unique
instUnitKey = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
fs
    }
  where
     fs :: FastString
fs           = u -> GenInstantiations u -> FastString
forall u.
IsUnitId u =>
u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
mkInstantiatedUnitHash u
cid GenInstantiations u
sorted_insts
     sorted_insts :: GenInstantiations u
sorted_insts = ((ModuleName, GenModule (GenUnit u))
 -> (ModuleName, GenModule (GenUnit u)) -> Ordering)
-> GenInstantiations u -> GenInstantiations u
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (ModuleName -> ModuleName -> Ordering
stableModuleNameCmp (ModuleName -> ModuleName -> Ordering)
-> ((ModuleName, GenModule (GenUnit u)) -> ModuleName)
-> (ModuleName, GenModule (GenUnit u))
-> (ModuleName, GenModule (GenUnit u))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (ModuleName, GenModule (GenUnit u)) -> ModuleName
forall a b. (a, b) -> a
fst) GenInstantiations u
insts


-- | Smart constructor for instantiated GenUnit
mkVirtUnit :: IsUnitId u => u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
mkVirtUnit :: forall u.
IsUnitId u =>
u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
mkVirtUnit u
uid []    = Definite u -> GenUnit u
forall uid. Definite uid -> GenUnit uid
RealUnit (Definite u -> GenUnit u) -> Definite u -> GenUnit u
forall a b. (a -> b) -> a -> b
$ u -> Definite u
forall unit. unit -> Definite unit
Definite u
uid
mkVirtUnit u
uid [(ModuleName, GenModule (GenUnit u))]
insts = GenInstantiatedUnit u -> GenUnit u
forall uid. GenInstantiatedUnit uid -> GenUnit uid
VirtUnit (GenInstantiatedUnit u -> GenUnit u)
-> GenInstantiatedUnit u -> GenUnit u
forall a b. (a -> b) -> a -> b
$ u -> [(ModuleName, GenModule (GenUnit u))] -> GenInstantiatedUnit u
forall u.
IsUnitId u =>
u -> GenInstantiations u -> GenInstantiatedUnit u
mkInstantiatedUnit u
uid [(ModuleName, GenModule (GenUnit u))]
insts

-- | Generate a uniquely identifying hash (internal unit-id) for an instantiated
-- unit.
--
-- This is a one-way function. If the indefinite unit has not been instantiated at all, we return its unit-id.
--
-- This hash is completely internal to GHC and is not used for symbol names or
-- file paths. It is different from the hash Cabal would produce for the same
-- instantiated unit.
mkInstantiatedUnitHash :: IsUnitId u => u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
mkInstantiatedUnitHash :: forall u.
IsUnitId u =>
u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
mkInstantiatedUnitHash u
cid [(ModuleName, GenModule (GenUnit u))]
sorted_holes =
    ByteString -> FastString
mkFastStringByteString
  (ByteString -> FastString)
-> (Fingerprint -> ByteString) -> Fingerprint -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Fingerprint -> ByteString
fingerprintUnitId (FastString -> ByteString
bytesFS (u -> FastString
forall u. IsUnitId u => u -> FastString
unitFS u
cid))
  (Fingerprint -> FastString) -> Fingerprint -> FastString
forall a b. (a -> b) -> a -> b
$ [(ModuleName, GenModule (GenUnit u))] -> Fingerprint
forall u.
IsUnitId u =>
[(ModuleName, GenModule (GenUnit u))] -> Fingerprint
hashInstantiations [(ModuleName, GenModule (GenUnit u))]
sorted_holes

-- | Generate a hash for a sorted module instantiation.
hashInstantiations :: IsUnitId u => [(ModuleName, GenModule (GenUnit u))] -> Fingerprint
hashInstantiations :: forall u.
IsUnitId u =>
[(ModuleName, GenModule (GenUnit u))] -> Fingerprint
hashInstantiations [(ModuleName, GenModule (GenUnit u))]
sorted_holes =
    ByteString -> Fingerprint
fingerprintByteString
  (ByteString -> Fingerprint)
-> ([ByteString] -> ByteString) -> [ByteString] -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat ([ByteString] -> Fingerprint) -> [ByteString] -> Fingerprint
forall a b. (a -> b) -> a -> b
$ do
        (m, b) <- [(ModuleName, GenModule (GenUnit u))]
sorted_holes
        [ bytesFS (moduleNameFS m),              BS.Char8.singleton ' ',
          bytesFS (unitFS (moduleUnit b)),       BS.Char8.singleton ':',
          bytesFS (moduleNameFS (moduleName b)), BS.Char8.singleton '\n']

fingerprintUnitId :: BS.ByteString -> Fingerprint -> BS.ByteString
fingerprintUnitId :: ByteString -> Fingerprint -> ByteString
fingerprintUnitId ByteString
prefix (Fingerprint Word64
a Word64
b)
    = [ByteString] -> ByteString
BS.concat
    ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ ByteString
prefix
      , Char -> ByteString
BS.Char8.singleton Char
'-'
      , String -> ByteString
BS.Char8.pack (Word64 -> String
toBase62Padded Word64
a)
      , String -> ByteString
BS.Char8.pack (Word64 -> String
toBase62Padded Word64
b) ]

unitUnique :: IsUnitId u => GenUnit u -> Unique
unitUnique :: forall u. IsUnitId u => GenUnit u -> Unique
unitUnique (VirtUnit GenInstantiatedUnit u
x)            = GenInstantiatedUnit u -> Unique
forall unit. GenInstantiatedUnit unit -> Unique
instUnitKey GenInstantiatedUnit u
x
unitUnique (RealUnit (Definite u
x)) = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (u -> FastString
forall u. IsUnitId u => u -> FastString
unitFS u
x)
unitUnique GenUnit u
HoleUnit                = Unique
holeUnique

-- | Create a new simple unit identifier from a 'FastString'.  Internally,
-- this is primarily used to specify wired-in unit identifiers.
fsToUnit :: FastString -> Unit
fsToUnit :: FastString -> Unit
fsToUnit = Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (Definite UnitId -> Unit)
-> (FastString -> Definite UnitId) -> FastString -> Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite (UnitId -> Definite UnitId)
-> (FastString -> UnitId) -> FastString -> Definite UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> UnitId
UnitId

unitString :: IsUnitId u => u  -> String
unitString :: forall u. IsUnitId u => u -> String
unitString = FastString -> String
unpackFS (FastString -> String) -> (u -> FastString) -> u -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> FastString
forall u. IsUnitId u => u -> FastString
unitFS

stringToUnit :: String -> Unit
stringToUnit :: String -> Unit
stringToUnit = FastString -> Unit
fsToUnit (FastString -> Unit) -> (String -> FastString) -> String -> Unit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString

-- | Map over the unit type of a 'GenUnit'
mapGenUnit :: IsUnitId v => (u -> v) -> GenUnit u -> GenUnit v
mapGenUnit :: forall v u. IsUnitId v => (u -> v) -> GenUnit u -> GenUnit v
mapGenUnit u -> v
f = GenUnit u -> GenUnit v
go
   where
      go :: GenUnit u -> GenUnit v
go GenUnit u
gu = case GenUnit u
gu of
               GenUnit u
HoleUnit   -> GenUnit v
forall uid. GenUnit uid
HoleUnit
               RealUnit Definite u
d -> Definite v -> GenUnit v
forall uid. Definite uid -> GenUnit uid
RealUnit ((u -> v) -> Definite u -> Definite v
forall a b. (a -> b) -> Definite a -> Definite b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap u -> v
f Definite u
d)
               VirtUnit GenInstantiatedUnit u
i ->
                  GenInstantiatedUnit v -> GenUnit v
forall uid. GenInstantiatedUnit uid -> GenUnit uid
VirtUnit (GenInstantiatedUnit v -> GenUnit v)
-> GenInstantiatedUnit v -> GenUnit v
forall a b. (a -> b) -> a -> b
$ v -> GenInstantiations v -> GenInstantiatedUnit v
forall u.
IsUnitId u =>
u -> GenInstantiations u -> GenInstantiatedUnit u
mkInstantiatedUnit
                     (u -> v
f (GenInstantiatedUnit u -> u
forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf GenInstantiatedUnit u
i))
                     (((ModuleName, GenModule (GenUnit u))
 -> (ModuleName, GenModule (GenUnit v)))
-> [(ModuleName, GenModule (GenUnit u))] -> GenInstantiations v
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GenModule (GenUnit u) -> GenModule (GenUnit v))
-> (ModuleName, GenModule (GenUnit u))
-> (ModuleName, GenModule (GenUnit v))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((GenUnit u -> GenUnit v)
-> GenModule (GenUnit u) -> GenModule (GenUnit v)
forall a b. (a -> b) -> GenModule a -> GenModule b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenUnit u -> GenUnit v
go)) (GenInstantiatedUnit u -> [(ModuleName, GenModule (GenUnit u))]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts GenInstantiatedUnit u
i))

-- | Map over the unit identifier of unit instantiations.
mapInstantiations :: IsUnitId v => (u -> v) -> GenInstantiations u -> GenInstantiations v
mapInstantiations :: forall v u.
IsUnitId v =>
(u -> v) -> GenInstantiations u -> GenInstantiations v
mapInstantiations u -> v
f = ((ModuleName, GenModule (GenUnit u))
 -> (ModuleName, GenModule (GenUnit v)))
-> [(ModuleName, GenModule (GenUnit u))]
-> [(ModuleName, GenModule (GenUnit v))]
forall a b. (a -> b) -> [a] -> [b]
map ((GenModule (GenUnit u) -> GenModule (GenUnit v))
-> (ModuleName, GenModule (GenUnit u))
-> (ModuleName, GenModule (GenUnit v))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((GenUnit u -> GenUnit v)
-> GenModule (GenUnit u) -> GenModule (GenUnit v)
forall a b. (a -> b) -> GenModule a -> GenModule b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((u -> v) -> GenUnit u -> GenUnit v
forall v u. IsUnitId v => (u -> v) -> GenUnit u -> GenUnit v
mapGenUnit u -> v
f)))

-- | Return the UnitId of the Unit. For on-the-fly instantiated units, return
-- the UnitId of the indefinite unit this unit is an instance of.
toUnitId :: Unit -> UnitId
toUnitId :: Unit -> UnitId
toUnitId (RealUnit (Definite UnitId
iuid)) = UnitId
iuid
toUnitId (VirtUnit InstantiatedUnit
indef)           = InstantiatedUnit -> UnitId
forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf InstantiatedUnit
indef
toUnitId Unit
HoleUnit                   = String -> UnitId
forall a. HasCallStack => String -> a
error String
"Hole unit"

-- | Return the virtual UnitId of an on-the-fly instantiated unit.
virtualUnitId :: InstantiatedUnit -> UnitId
virtualUnitId :: InstantiatedUnit -> UnitId
virtualUnitId InstantiatedUnit
i = FastString -> UnitId
UnitId (InstantiatedUnit -> FastString
forall unit. GenInstantiatedUnit unit -> FastString
instUnitFS InstantiatedUnit
i)

-- | A 'Unit' is definite if it has no free holes.
unitIsDefinite :: Unit -> Bool
unitIsDefinite :: Unit -> Bool
unitIsDefinite = UniqDSet ModuleName -> Bool
forall a. UniqDSet a -> Bool
isEmptyUniqDSet (UniqDSet ModuleName -> Bool)
-> (Unit -> UniqDSet ModuleName) -> Unit -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> UniqDSet ModuleName
forall u. GenUnit u -> UniqDSet ModuleName
unitFreeModuleHoles

---------------------------------------------------------------------
-- UNIT IDs
---------------------------------------------------------------------

-- | A UnitId identifies a built library in a database and is used to generate
-- unique symbols, etc. It's usually of the form:
--
--    pkgname-1.2:libname+hash
--
-- These UnitId are provided to us via the @-this-unit-id@ flag.
--
-- The library in question may be definite or indefinite; if it is indefinite,
-- none of the holes have been filled (we never install partially instantiated
-- libraries as we can cheaply instantiate them on-the-fly, cf VirtUnit).  Put
-- another way, an installed unit id is either fully instantiated, or not
-- instantiated at all.
newtype UnitId = UnitId
  { UnitId -> FastString
unitIdFS :: FastString
      -- ^ The full hashed unit identifier, including the component id
      -- and the hash.
  }
  deriving (Typeable UnitId
Typeable UnitId =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> UnitId -> c UnitId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UnitId)
-> (UnitId -> Constr)
-> (UnitId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UnitId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnitId))
-> ((forall b. Data b => b -> b) -> UnitId -> UnitId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UnitId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UnitId -> r)
-> (forall u. (forall d. Data d => d -> u) -> UnitId -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UnitId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UnitId -> m UnitId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnitId -> m UnitId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UnitId -> m UnitId)
-> Data UnitId
UnitId -> Constr
UnitId -> DataType
(forall b. Data b => b -> b) -> UnitId -> UnitId
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UnitId -> u
forall u. (forall d. Data d => d -> u) -> UnitId -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnitId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnitId -> c UnitId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnitId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnitId)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnitId -> c UnitId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnitId -> c UnitId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnitId
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnitId
$ctoConstr :: UnitId -> Constr
toConstr :: UnitId -> Constr
$cdataTypeOf :: UnitId -> DataType
dataTypeOf :: UnitId -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnitId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnitId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnitId)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnitId)
$cgmapT :: (forall b. Data b => b -> b) -> UnitId -> UnitId
gmapT :: (forall b. Data b => b -> b) -> UnitId -> UnitId
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UnitId -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> UnitId -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnitId -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnitId -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
Data)

instance Binary UnitId where
  put_ :: WriteBinHandle -> UnitId -> IO ()
put_ WriteBinHandle
bh (UnitId FastString
fs) = WriteBinHandle -> FastString -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh FastString
fs
  get :: ReadBinHandle -> IO UnitId
get ReadBinHandle
bh = do fs <- ReadBinHandle -> IO FastString
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh; return (UnitId fs)

instance Eq UnitId where
    UnitId
uid1 == :: UnitId -> UnitId -> Bool
== UnitId
uid2 = UnitId -> Unique
forall a. Uniquable a => a -> Unique
getUnique UnitId
uid1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId -> Unique
forall a. Uniquable a => a -> Unique
getUnique UnitId
uid2

instance Ord UnitId where
    -- we compare lexically to avoid non-deterministic output when sets of
    -- unit-ids are printed (dependencies, etc.)
    UnitId
u1 compare :: UnitId -> UnitId -> Ordering
`compare` UnitId
u2 = UnitId -> FastString
unitIdFS UnitId
u1 FastString -> FastString -> Ordering
`lexicalCompareFS` UnitId -> FastString
unitIdFS UnitId
u2

instance Uniquable UnitId where
    getUnique :: UnitId -> Unique
getUnique = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (FastString -> Unique)
-> (UnitId -> FastString) -> UnitId -> Unique
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> FastString
unitIdFS

instance Outputable UnitId where
    ppr :: UnitId -> SDoc
ppr = UnitId -> SDoc
pprUnitId

pprUnitId :: UnitId -> SDoc
pprUnitId :: UnitId -> SDoc
pprUnitId (UnitId FastString
fs) = (SDocContext -> FastString -> SDoc)
-> ((FastString -> SDoc) -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> FastString -> SDoc
sdocUnitIdForUser ((FastString -> SDoc) -> FastString -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString
fs)

-- | A 'DefUnitId' is an 'UnitId' with the invariant that
-- it only refers to a definite library; i.e., one we have generated
-- code for.
type DefUnitId = Definite UnitId

unitIdString :: UnitId -> String
unitIdString :: UnitId -> String
unitIdString = FastString -> String
unpackFS (FastString -> String)
-> (UnitId -> FastString) -> UnitId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> FastString
unitIdFS

stringToUnitId :: String -> UnitId
stringToUnitId :: String -> UnitId
stringToUnitId = FastString -> UnitId
UnitId (FastString -> UnitId)
-> (String -> FastString) -> String -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString

---------------------------------------------------------------------
-- UTILS
---------------------------------------------------------------------

-- | A definite unit (i.e. without any free module hole)
newtype Definite unit = Definite { forall unit. Definite unit -> unit
unDefinite :: unit }
   deriving ((forall a b. (a -> b) -> Definite a -> Definite b)
-> (forall a b. a -> Definite b -> Definite a) -> Functor Definite
forall a b. a -> Definite b -> Definite a
forall a b. (a -> b) -> Definite a -> Definite b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Definite a -> Definite b
fmap :: forall a b. (a -> b) -> Definite a -> Definite b
$c<$ :: forall a b. a -> Definite b -> Definite a
<$ :: forall a b. a -> Definite b -> Definite a
Functor)
   deriving newtype (Definite unit -> Definite unit -> Bool
(Definite unit -> Definite unit -> Bool)
-> (Definite unit -> Definite unit -> Bool) -> Eq (Definite unit)
forall unit. Eq unit => Definite unit -> Definite unit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall unit. Eq unit => Definite unit -> Definite unit -> Bool
== :: Definite unit -> Definite unit -> Bool
$c/= :: forall unit. Eq unit => Definite unit -> Definite unit -> Bool
/= :: Definite unit -> Definite unit -> Bool
Eq, Eq (Definite unit)
Eq (Definite unit) =>
(Definite unit -> Definite unit -> Ordering)
-> (Definite unit -> Definite unit -> Bool)
-> (Definite unit -> Definite unit -> Bool)
-> (Definite unit -> Definite unit -> Bool)
-> (Definite unit -> Definite unit -> Bool)
-> (Definite unit -> Definite unit -> Definite unit)
-> (Definite unit -> Definite unit -> Definite unit)
-> Ord (Definite unit)
Definite unit -> Definite unit -> Bool
Definite unit -> Definite unit -> Ordering
Definite unit -> Definite unit -> Definite unit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall unit. Ord unit => Eq (Definite unit)
forall unit. Ord unit => Definite unit -> Definite unit -> Bool
forall unit. Ord unit => Definite unit -> Definite unit -> Ordering
forall unit.
Ord unit =>
Definite unit -> Definite unit -> Definite unit
$ccompare :: forall unit. Ord unit => Definite unit -> Definite unit -> Ordering
compare :: Definite unit -> Definite unit -> Ordering
$c< :: forall unit. Ord unit => Definite unit -> Definite unit -> Bool
< :: Definite unit -> Definite unit -> Bool
$c<= :: forall unit. Ord unit => Definite unit -> Definite unit -> Bool
<= :: Definite unit -> Definite unit -> Bool
$c> :: forall unit. Ord unit => Definite unit -> Definite unit -> Bool
> :: Definite unit -> Definite unit -> Bool
$c>= :: forall unit. Ord unit => Definite unit -> Definite unit -> Bool
>= :: Definite unit -> Definite unit -> Bool
$cmax :: forall unit.
Ord unit =>
Definite unit -> Definite unit -> Definite unit
max :: Definite unit -> Definite unit -> Definite unit
$cmin :: forall unit.
Ord unit =>
Definite unit -> Definite unit -> Definite unit
min :: Definite unit -> Definite unit -> Definite unit
Ord, Definite unit -> SDoc
(Definite unit -> SDoc) -> Outputable (Definite unit)
forall unit. Outputable unit => Definite unit -> SDoc
forall a. (a -> SDoc) -> Outputable a
$cppr :: forall unit. Outputable unit => Definite unit -> SDoc
ppr :: Definite unit -> SDoc
Outputable, ReadBinHandle -> IO (Definite unit)
WriteBinHandle -> Definite unit -> IO ()
WriteBinHandle -> Definite unit -> IO (Bin (Definite unit))
(WriteBinHandle -> Definite unit -> IO ())
-> (WriteBinHandle -> Definite unit -> IO (Bin (Definite unit)))
-> (ReadBinHandle -> IO (Definite unit))
-> Binary (Definite unit)
forall unit. Binary unit => ReadBinHandle -> IO (Definite unit)
forall unit.
Binary unit =>
WriteBinHandle -> Definite unit -> IO ()
forall unit.
Binary unit =>
WriteBinHandle -> Definite unit -> IO (Bin (Definite unit))
forall a.
(WriteBinHandle -> a -> IO ())
-> (WriteBinHandle -> a -> IO (Bin a))
-> (ReadBinHandle -> IO a)
-> Binary a
$cput_ :: forall unit.
Binary unit =>
WriteBinHandle -> Definite unit -> IO ()
put_ :: WriteBinHandle -> Definite unit -> IO ()
$cput :: forall unit.
Binary unit =>
WriteBinHandle -> Definite unit -> IO (Bin (Definite unit))
put :: WriteBinHandle -> Definite unit -> IO (Bin (Definite unit))
$cget :: forall unit. Binary unit => ReadBinHandle -> IO (Definite unit)
get :: ReadBinHandle -> IO (Definite unit)
Binary, Definite unit -> Unique
(Definite unit -> Unique) -> Uniquable (Definite unit)
forall unit. Uniquable unit => Definite unit -> Unique
forall a. (a -> Unique) -> Uniquable a
$cgetUnique :: forall unit. Uniquable unit => Definite unit -> Unique
getUnique :: Definite unit -> Unique
Uniquable, Definite unit -> FastString
(Definite unit -> FastString) -> IsUnitId (Definite unit)
forall unit. IsUnitId unit => Definite unit -> FastString
forall u. (u -> FastString) -> IsUnitId u
$cunitFS :: forall unit. IsUnitId unit => Definite unit -> FastString
unitFS :: Definite unit -> FastString
IsUnitId)

---------------------------------------------------------------------
-- WIRED-IN UNITS
---------------------------------------------------------------------

{-
Note [Wired-in units]
~~~~~~~~~~~~~~~~~~~~~

Certain packages are known to the compiler, in that we know about certain
entities that reside in these packages, and the compiler needs to
declare static Modules and Names that refer to these packages.  Hence
the wired-in packages can't include version numbers in their package UnitId,
since we don't want to bake the version numbers of these packages into GHC.

So here's the plan.  Wired-in units are still versioned as
normal in the packages database, and you can still have multiple
versions of them installed. To the user, everything looks normal.

However, for each invocation of GHC, only a single instance of each wired-in
package will be recognised (the desired one is selected via
@-package@\/@-hide-package@), and GHC will internally pretend that it has the
*unversioned* 'UnitId', including in .hi files and object file symbols.

Unselected versions of wired-in packages will be ignored, as will any other
package that depends directly or indirectly on it (much as if you
had used @-ignore-package@).

The affected packages are compiled with, e.g., @-this-unit-id base@, so that
the symbols in the object files have the unversioned unit id in their name.

Make sure you change 'GHC.Unit.State.findWiredInUnits' if you add an entry here.

-}

bignumUnitId, primUnitId, ghcInternalUnitId, rtsUnitId,
  mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId

bignumUnit, primUnit, ghcInternalUnit, rtsUnit,
  mainUnit, thisGhcUnit, interactiveUnit :: Unit

primUnitId :: UnitId
primUnitId        = FastString -> UnitId
UnitId (String -> FastString
fsLit String
"ghc-prim")
bignumUnitId :: UnitId
bignumUnitId      = FastString -> UnitId
UnitId (String -> FastString
fsLit String
"ghc-bignum")
ghcInternalUnitId :: UnitId
ghcInternalUnitId = FastString -> UnitId
UnitId (String -> FastString
fsLit String
"ghc-internal")
rtsUnitId :: UnitId
rtsUnitId         = FastString -> UnitId
UnitId (String -> FastString
fsLit String
"rts")
thisGhcUnitId :: UnitId
thisGhcUnitId     = FastString -> UnitId
UnitId (String -> FastString
fsLit String
cProjectUnitId) -- See Note [GHC's Unit Id]
interactiveUnitId :: UnitId
interactiveUnitId = FastString -> UnitId
UnitId (String -> FastString
fsLit String
"interactive")

primUnit :: Unit
primUnit          = Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
primUnitId)
bignumUnit :: Unit
bignumUnit        = Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
bignumUnitId)
ghcInternalUnit :: Unit
ghcInternalUnit   = Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
ghcInternalUnitId)
rtsUnit :: Unit
rtsUnit           = Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
rtsUnitId)
thisGhcUnit :: Unit
thisGhcUnit       = Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
thisGhcUnitId)
interactiveUnit :: Unit
interactiveUnit   = Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
interactiveUnitId)

-- | This is the package Id for the current program.  It is the default
-- package Id if you don't specify a package name.  We don't add this prefix
-- to symbol names, since there can be only one main package per program.
mainUnitId :: UnitId
mainUnitId = FastString -> UnitId
UnitId (String -> FastString
fsLit String
"main")
mainUnit :: Unit
mainUnit = Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
mainUnitId)

isInteractiveModule :: Module -> Bool
isInteractiveModule :: QueryQualifyModule
isInteractiveModule Module
mod = Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Unit
interactiveUnit

wiredInUnitIds :: [UnitId]
wiredInUnitIds :: [UnitId]
wiredInUnitIds =
   [ UnitId
primUnitId
   , UnitId
bignumUnitId
   , UnitId
ghcInternalUnitId
   , UnitId
rtsUnitId
   ]
   -- NB: ghc is no longer part of the wired-in units since its unit-id, given
   -- by hadrian or cabal, is no longer overwritten and now matches both the
   -- cProjectUnitId defined in build-time-generated module GHC.Version, and
   -- the unit key.
   --
   -- See also Note [About units], taking into consideration ghc is still a
   -- wired-in unit but whose unit-id no longer needs special handling because
   -- we take care that it matches the unit key.

{-
Note [GHC's Unit Id]
~~~~~~~~~~~~~~~~~~~~
Previously, the unit-id of ghc-the-library was fixed as `ghc`.
This was done primarily because the compiler must know the unit-id of
some packages (including ghc) a-priori to define wired-in names.

However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed
to `ghc` might result in subtle bugs when different ghc's interact.

A good example of this is having GHC_A load a plugin compiled by GHC_B,
where GHC_A and GHC_B are linked to ghc-libraries that are ABI
incompatible. Without a distinction between the unit-id of the ghc library
GHC_A is linked against and the ghc library the plugin it is loading was
compiled against, we can't check compatibility.

Now, we give a better unit-id to ghc (`ghc-version-hash`) by

(1) Not setting -this-unit-id fixed to `ghc` in `ghc.cabal`, but rather by having
    (1.1) Hadrian pass the new unit-id with -this-unit-id for stage0-1
    (1.2) Cabal pass the unit-id it computes to ghc, which it already does by default

(2) Adding a definition to `GHC.Settings.Config` whose value is the new
unit-id. This is crucial to define the wired-in name of the GHC unit
(`thisGhcUnitId`) which *must* match the value of the -this-unit-id flag.
(Where `GHC.Settings.Config` is a module generated by the build system which,
be it either hadrian or cabal, knows exactly the unit-id it passed with -this-unit-id)

Note that we also ensure the ghc's unit key matches its unit id, both when
hadrian or cabal is building ghc. This way, we no longer need to add `ghc` to
the WiringMap, and that's why 'wiredInUnitIds' no longer includes
'thisGhcUnitId'.
-}

---------------------------------------------------------------------
-- Boot Modules
---------------------------------------------------------------------

-- Note [Boot Module Naming]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~
-- Why is this section here? After all, these modules are supposed to be about
-- ways of referring to modules, not modules themselves. Well, the "bootness" of
-- a module is in a way part of its name, because 'import {-# SOURCE #-} Foo'
-- references the boot module in particular while 'import Foo' references the
-- regular module. Backpack signatures live in the normal module namespace (no
-- special import), so they don't matter here. When dealing with the modules
-- themselves, however, one should use not 'IsBoot' or conflate signatures and
-- modules in opposition to boot interfaces. Instead, one should use
-- 'DriverPhases.HscSource'. See Note [HscSource types].

instance Binary IsBootInterface where
  put_ :: WriteBinHandle -> IsBootInterface -> IO ()
put_ WriteBinHandle
bh IsBootInterface
ib = WriteBinHandle -> Bool -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$
    case IsBootInterface
ib of
      IsBootInterface
NotBoot -> Bool
False
      IsBootInterface
IsBoot -> Bool
True
  get :: ReadBinHandle -> IO IsBootInterface
get ReadBinHandle
bh = do
    b <- ReadBinHandle -> IO Bool
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    return $ case b of
      Bool
False -> IsBootInterface
NotBoot
      Bool
True -> IsBootInterface
IsBoot

-- | This data type just pairs a value 'mod' with an IsBootInterface flag. In
-- practice, 'mod' is usually a @Module@ or @ModuleName@'.
data GenWithIsBoot mod = GWIB
  { forall mod. GenWithIsBoot mod -> mod
gwib_mod :: mod
  , forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot :: IsBootInterface
  } deriving ( GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
(GenWithIsBoot mod -> GenWithIsBoot mod -> Bool)
-> (GenWithIsBoot mod -> GenWithIsBoot mod -> Bool)
-> Eq (GenWithIsBoot mod)
forall mod.
Eq mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall mod.
Eq mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
== :: GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
$c/= :: forall mod.
Eq mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
/= :: GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
Eq, Eq (GenWithIsBoot mod)
Eq (GenWithIsBoot mod) =>
(GenWithIsBoot mod -> GenWithIsBoot mod -> Ordering)
-> (GenWithIsBoot mod -> GenWithIsBoot mod -> Bool)
-> (GenWithIsBoot mod -> GenWithIsBoot mod -> Bool)
-> (GenWithIsBoot mod -> GenWithIsBoot mod -> Bool)
-> (GenWithIsBoot mod -> GenWithIsBoot mod -> Bool)
-> (GenWithIsBoot mod -> GenWithIsBoot mod -> GenWithIsBoot mod)
-> (GenWithIsBoot mod -> GenWithIsBoot mod -> GenWithIsBoot mod)
-> Ord (GenWithIsBoot mod)
GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
GenWithIsBoot mod -> GenWithIsBoot mod -> Ordering
GenWithIsBoot mod -> GenWithIsBoot mod -> GenWithIsBoot mod
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall mod. Ord mod => Eq (GenWithIsBoot mod)
forall mod.
Ord mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
forall mod.
Ord mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> Ordering
forall mod.
Ord mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> GenWithIsBoot mod
$ccompare :: forall mod.
Ord mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> Ordering
compare :: GenWithIsBoot mod -> GenWithIsBoot mod -> Ordering
$c< :: forall mod.
Ord mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
< :: GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
$c<= :: forall mod.
Ord mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
<= :: GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
$c> :: forall mod.
Ord mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
> :: GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
$c>= :: forall mod.
Ord mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
>= :: GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
$cmax :: forall mod.
Ord mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> GenWithIsBoot mod
max :: GenWithIsBoot mod -> GenWithIsBoot mod -> GenWithIsBoot mod
$cmin :: forall mod.
Ord mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> GenWithIsBoot mod
min :: GenWithIsBoot mod -> GenWithIsBoot mod -> GenWithIsBoot mod
Ord, Int -> GenWithIsBoot mod -> ShowS
[GenWithIsBoot mod] -> ShowS
GenWithIsBoot mod -> String
(Int -> GenWithIsBoot mod -> ShowS)
-> (GenWithIsBoot mod -> String)
-> ([GenWithIsBoot mod] -> ShowS)
-> Show (GenWithIsBoot mod)
forall mod. Show mod => Int -> GenWithIsBoot mod -> ShowS
forall mod. Show mod => [GenWithIsBoot mod] -> ShowS
forall mod. Show mod => GenWithIsBoot mod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall mod. Show mod => Int -> GenWithIsBoot mod -> ShowS
showsPrec :: Int -> GenWithIsBoot mod -> ShowS
$cshow :: forall mod. Show mod => GenWithIsBoot mod -> String
show :: GenWithIsBoot mod -> String
$cshowList :: forall mod. Show mod => [GenWithIsBoot mod] -> ShowS
showList :: [GenWithIsBoot mod] -> ShowS
Show
             , (forall a b. (a -> b) -> GenWithIsBoot a -> GenWithIsBoot b)
-> (forall a b. a -> GenWithIsBoot b -> GenWithIsBoot a)
-> Functor GenWithIsBoot
forall a b. a -> GenWithIsBoot b -> GenWithIsBoot a
forall a b. (a -> b) -> GenWithIsBoot a -> GenWithIsBoot b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GenWithIsBoot a -> GenWithIsBoot b
fmap :: forall a b. (a -> b) -> GenWithIsBoot a -> GenWithIsBoot b
$c<$ :: forall a b. a -> GenWithIsBoot b -> GenWithIsBoot a
<$ :: forall a b. a -> GenWithIsBoot b -> GenWithIsBoot a
Functor, (forall m. Monoid m => GenWithIsBoot m -> m)
-> (forall m a. Monoid m => (a -> m) -> GenWithIsBoot a -> m)
-> (forall m a. Monoid m => (a -> m) -> GenWithIsBoot a -> m)
-> (forall a b. (a -> b -> b) -> b -> GenWithIsBoot a -> b)
-> (forall a b. (a -> b -> b) -> b -> GenWithIsBoot a -> b)
-> (forall b a. (b -> a -> b) -> b -> GenWithIsBoot a -> b)
-> (forall b a. (b -> a -> b) -> b -> GenWithIsBoot a -> b)
-> (forall a. (a -> a -> a) -> GenWithIsBoot a -> a)
-> (forall a. (a -> a -> a) -> GenWithIsBoot a -> a)
-> (forall a. GenWithIsBoot a -> [a])
-> (forall a. GenWithIsBoot a -> Bool)
-> (forall a. GenWithIsBoot a -> Int)
-> (forall a. Eq a => a -> GenWithIsBoot a -> Bool)
-> (forall a. Ord a => GenWithIsBoot a -> a)
-> (forall a. Ord a => GenWithIsBoot a -> a)
-> (forall a. Num a => GenWithIsBoot a -> a)
-> (forall a. Num a => GenWithIsBoot a -> a)
-> Foldable GenWithIsBoot
forall a. Eq a => a -> GenWithIsBoot a -> Bool
forall a. Num a => GenWithIsBoot a -> a
forall a. Ord a => GenWithIsBoot a -> a
forall m. Monoid m => GenWithIsBoot m -> m
forall a. GenWithIsBoot a -> Bool
forall a. GenWithIsBoot a -> Int
forall a. GenWithIsBoot a -> [a]
forall a. (a -> a -> a) -> GenWithIsBoot a -> a
forall m a. Monoid m => (a -> m) -> GenWithIsBoot a -> m
forall b a. (b -> a -> b) -> b -> GenWithIsBoot a -> b
forall a b. (a -> b -> b) -> b -> GenWithIsBoot a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => GenWithIsBoot m -> m
fold :: forall m. Monoid m => GenWithIsBoot m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GenWithIsBoot a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> GenWithIsBoot a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> GenWithIsBoot a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> GenWithIsBoot a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> GenWithIsBoot a -> b
foldr :: forall a b. (a -> b -> b) -> b -> GenWithIsBoot a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> GenWithIsBoot a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> GenWithIsBoot a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> GenWithIsBoot a -> b
foldl :: forall b a. (b -> a -> b) -> b -> GenWithIsBoot a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> GenWithIsBoot a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> GenWithIsBoot a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> GenWithIsBoot a -> a
foldr1 :: forall a. (a -> a -> a) -> GenWithIsBoot a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GenWithIsBoot a -> a
foldl1 :: forall a. (a -> a -> a) -> GenWithIsBoot a -> a
$ctoList :: forall a. GenWithIsBoot a -> [a]
toList :: forall a. GenWithIsBoot a -> [a]
$cnull :: forall a. GenWithIsBoot a -> Bool
null :: forall a. GenWithIsBoot a -> Bool
$clength :: forall a. GenWithIsBoot a -> Int
length :: forall a. GenWithIsBoot a -> Int
$celem :: forall a. Eq a => a -> GenWithIsBoot a -> Bool
elem :: forall a. Eq a => a -> GenWithIsBoot a -> Bool
$cmaximum :: forall a. Ord a => GenWithIsBoot a -> a
maximum :: forall a. Ord a => GenWithIsBoot a -> a
$cminimum :: forall a. Ord a => GenWithIsBoot a -> a
minimum :: forall a. Ord a => GenWithIsBoot a -> a
$csum :: forall a. Num a => GenWithIsBoot a -> a
sum :: forall a. Num a => GenWithIsBoot a -> a
$cproduct :: forall a. Num a => GenWithIsBoot a -> a
product :: forall a. Num a => GenWithIsBoot a -> a
Foldable, Functor GenWithIsBoot
Foldable GenWithIsBoot
(Functor GenWithIsBoot, Foldable GenWithIsBoot) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> GenWithIsBoot a -> f (GenWithIsBoot b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GenWithIsBoot (f a) -> f (GenWithIsBoot a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GenWithIsBoot a -> m (GenWithIsBoot b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GenWithIsBoot (m a) -> m (GenWithIsBoot a))
-> Traversable GenWithIsBoot
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
GenWithIsBoot (m a) -> m (GenWithIsBoot a)
forall (f :: * -> *) a.
Applicative f =>
GenWithIsBoot (f a) -> f (GenWithIsBoot a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenWithIsBoot a -> m (GenWithIsBoot b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenWithIsBoot a -> f (GenWithIsBoot b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenWithIsBoot a -> f (GenWithIsBoot b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenWithIsBoot a -> f (GenWithIsBoot b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
GenWithIsBoot (f a) -> f (GenWithIsBoot a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
GenWithIsBoot (f a) -> f (GenWithIsBoot a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenWithIsBoot a -> m (GenWithIsBoot b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenWithIsBoot a -> m (GenWithIsBoot b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
GenWithIsBoot (m a) -> m (GenWithIsBoot a)
sequence :: forall (m :: * -> *) a.
Monad m =>
GenWithIsBoot (m a) -> m (GenWithIsBoot a)
Traversable
             )
  -- the Ord instance must ensure that we first sort by Module and then by
  -- IsBootInterface: this is assumed to perform filtering of non-boot modules,
  -- e.g. in GHC.Driver.Env.hptModulesBelow

type ModuleNameWithIsBoot = GenWithIsBoot ModuleName

type ModuleWithIsBoot = GenWithIsBoot Module

type InstalledModuleWithIsBoot = GenWithIsBoot InstalledModule

instance Binary a => Binary (GenWithIsBoot a) where
  put_ :: WriteBinHandle -> GenWithIsBoot a -> IO ()
put_ WriteBinHandle
bh (GWIB { a
gwib_mod :: forall mod. GenWithIsBoot mod -> mod
gwib_mod :: a
gwib_mod, IsBootInterface
gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot :: IsBootInterface
gwib_isBoot }) = do
    WriteBinHandle -> a -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh a
gwib_mod
    WriteBinHandle -> IsBootInterface -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh IsBootInterface
gwib_isBoot
  get :: ReadBinHandle -> IO (GenWithIsBoot a)
get ReadBinHandle
bh = do
    gwib_mod <- ReadBinHandle -> IO a
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    gwib_isBoot <- get bh
    pure $ GWIB { gwib_mod, gwib_isBoot }

instance Outputable a => Outputable (GenWithIsBoot a) where
  ppr :: GenWithIsBoot a -> SDoc
ppr (GWIB  { a
gwib_mod :: forall mod. GenWithIsBoot mod -> mod
gwib_mod :: a
gwib_mod, IsBootInterface
gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot :: IsBootInterface
gwib_isBoot }) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
gwib_mod SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: case IsBootInterface
gwib_isBoot of
    IsBootInterface
IsBoot -> [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"{-# SOURCE #-}" ]
    IsBootInterface
NotBoot -> []

notBoot :: mod -> GenWithIsBoot mod
notBoot :: forall mod. mod -> GenWithIsBoot mod
notBoot mod
gwib_mod = GWIB {mod
gwib_mod :: mod
gwib_mod :: mod
gwib_mod, gwib_isBoot :: IsBootInterface
gwib_isBoot = IsBootInterface
NotBoot}