{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}

-- | 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
   , InstantiatedModule
   , mkModule
   , pprModule
   , pprInstantiatedModule
   , moduleFreeHoles

     -- * Units
   , GenUnit (..)
   , Unit
   , UnitId (..)
   , GenInstantiatedUnit (..)
   , InstantiatedUnit
   , IndefUnitId
   , DefUnitId
   , Instantiations
   , GenInstantiations
   , mkGenInstantiatedUnit
   , mkInstantiatedUnit
   , mkInstantiatedUnitHash
   , mkGenVirtUnit
   , mkVirtUnit
   , mapGenUnit
   , unitFreeModuleHoles
   , fsToUnit
   , unitFS
   , unitString
   , instUnitToUnit
   , toUnitId
   , stringToUnit
   , stableUnitCmp
   , unitIsDefinite

     -- * Unit Ids
   , unitIdString
   , stringToUnitId

     -- * Utils
   , Definite (..)
   , Indefinite (..)

     -- * Wired-in units
   , primUnitId
   , integerUnitId
   , baseUnitId
   , rtsUnitId
   , thUnitId
   , mainUnitId
   , thisGhcUnitId
   , interactiveUnitId
   , isInteractiveModule
   , wiredInUnitIds
   )
where

import GHC.Prelude
import GHC.Types.Unique
import GHC.Types.Unique.DSet
import GHC.Unit.Ppr
import GHC.Unit.Module.Name
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 Control.DeepSeq
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 {-# SOURCE #-} GHC.Unit.State (improveUnit, PackageState, unitInfoMap, displayUnitId)
import {-# SOURCE #-} GHC.Driver.Session (pkgState)

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

-- | A generic module is a pair of a unit identifier and a 'ModuleName'.
data GenModule unit = Module
   { GenModule unit -> unit
moduleUnit :: !unit       -- ^ Unit the module belongs to
   , 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
/= :: GenModule unit -> GenModule unit -> Bool
$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
External instance of the constraint type Eq ModuleName
Evidence bound by a type signature of the constraint type Eq unit
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
min :: GenModule unit -> GenModule unit -> GenModule unit
$cmin :: forall unit.
Ord unit =>
GenModule unit -> GenModule unit -> GenModule unit
max :: GenModule unit -> GenModule unit -> GenModule unit
$cmax :: forall unit.
Ord unit =>
GenModule unit -> GenModule unit -> GenModule unit
>= :: 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
$c< :: forall unit. Ord unit => GenModule unit -> GenModule unit -> Bool
compare :: GenModule unit -> GenModule unit -> Ordering
$ccompare :: forall unit.
Ord unit =>
GenModule unit -> GenModule unit -> Ordering
External instance of the constraint type Ord ModuleName
Instance of class: Eq of the constraint type forall unit. Eq unit => Eq (GenModule unit)
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a type signature of the constraint type Ord unit
External instance of the constraint type forall a. Ord a => Eq a
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a type signature of the constraint type Ord unit
Instance of class: Ord of the constraint type forall unit. Ord unit => Ord (GenModule unit)
Evidence bound by a type signature of the constraint type Ord unit
Instance of class: Eq of the constraint type forall unit. Eq unit => Eq (GenModule unit)
Ord,Typeable (GenModule unit)
DataType
Constr
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 -> DataType
GenModule unit -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (GenModule unit))
(forall b. Data b => b -> b) -> GenModule unit -> GenModule unit
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenModule unit -> c (GenModule unit)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (GenModule unit)
forall {unit}. Data unit => Typeable (GenModule unit)
forall unit. Data unit => GenModule unit -> DataType
forall unit. Data unit => GenModule unit -> Constr
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))
$cModule :: Constr
$tGenModule :: DataType
gmapMo :: (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)
gmapMp :: (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)
gmapM :: (forall d. Data d => d -> m d)
-> GenModule unit -> m (GenModule unit)
$cgmapM :: forall unit (m :: * -> *).
(Data unit, Monad m) =>
(forall d. Data d => d -> m d)
-> GenModule unit -> m (GenModule unit)
gmapQi :: Int -> (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
gmapQ :: (forall d. Data d => d -> u) -> GenModule unit -> [u]
$cgmapQ :: forall unit u.
Data unit =>
(forall d. Data d => d -> u) -> GenModule unit -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenModule unit -> r
$cgmapQl :: forall unit r r'.
Data unit =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenModule unit -> r
gmapT :: (forall b. Data b => b -> b) -> GenModule unit -> GenModule unit
$cgmapT :: forall unit.
Data unit =>
(forall b. Data b => b -> b) -> GenModule unit -> GenModule unit
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> 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))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (GenModule unit))
$cdataCast1 :: forall unit (t :: * -> *) (c :: * -> *).
(Data unit, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (GenModule unit))
dataTypeOf :: GenModule unit -> DataType
$cdataTypeOf :: forall unit. Data unit => GenModule unit -> DataType
toConstr :: GenModule unit -> Constr
$ctoConstr :: forall unit. Data unit => GenModule unit -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenModule unit -> 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)
Evidence bound by a type signature of the constraint type Typeable t
External instance of the constraint type Data ModuleName
External instance of the constraint type forall a. Data a => Typeable a
Evidence bound by a type signature of the constraint type Data unit
External instance of the constraint type forall a. Data a => Typeable a
External instance of the constraint type forall a. Data a => Typeable a
Evidence bound by a type signature of the constraint type Data unit
Evidence bound by a type signature of the constraint type Data unit
Data,a -> GenModule b -> GenModule a
(a -> b) -> GenModule a -> GenModule b
(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
<$ :: a -> GenModule b -> GenModule a
$c<$ :: forall a b. a -> GenModule b -> GenModule a
fmap :: (a -> b) -> GenModule a -> GenModule b
$cfmap :: forall a b. (a -> b) -> GenModule a -> GenModule b
Functor)

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

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

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


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

instance Uniquable Module where
  getUnique :: Module -> Unique
getUnique (Module Unit
p ModuleName
n) = FastString -> Unique
forall a. Uniquable a => a -> Unique
External instance of the constraint type Uniquable FastString
getUnique (Unit -> FastString
unitFS Unit
p FastString -> FastString -> FastString
`appendFS` ModuleName -> FastString
moduleNameFS ModuleName
n)

instance Binary a => Binary (GenModule a) where
  put_ :: BinHandle -> GenModule a -> IO ()
put_ BinHandle
bh (Module a
p ModuleName
n) = BinHandle -> a -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
Evidence bound by a type signature of the constraint type Binary a
put_ BinHandle
bh a
p IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type Monad IO
>> BinHandle -> ModuleName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary ModuleName
put_ BinHandle
bh ModuleName
n
  get :: BinHandle -> IO (GenModule a)
get BinHandle
bh = do a
p <- BinHandle -> IO a
forall a. Binary a => BinHandle -> IO a
Evidence bound by a type signature of the constraint type Binary a
get BinHandle
bh; ModuleName
n <- BinHandle -> IO ModuleName
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary ModuleName
get BinHandle
bh; GenModule a -> IO (GenModule a)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (a -> ModuleName -> GenModule a
forall unit. unit -> ModuleName -> GenModule unit
Module a
p ModuleName
n)

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

instance Outputable Module where
  ppr :: Module -> SDoc
ppr = Module -> SDoc
pprModule

instance Outputable InstalledModule where
  ppr :: InstalledModule -> SDoc
ppr (Module UnitId
p ModuleName
n) =
    UnitId -> SDoc
forall a. Outputable a => a -> SDoc
Instance of class: Outputable of the constraint type Outputable UnitId
ppr UnitId
p SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':' SDoc -> SDoc -> SDoc
<> ModuleName -> SDoc
pprModuleName ModuleName
n

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

instance Outputable InstantiatedUnit where
    ppr :: InstantiatedUnit -> SDoc
ppr InstantiatedUnit
uid =
      -- getPprStyle $ \sty ->
      Indefinite UnitId -> SDoc
forall a. Outputable a => a -> SDoc
Instance of class: Outputable of the constraint type forall unit. Outputable unit => Outputable (Indefinite unit)
Instance of class: Outputable of the constraint type Outputable UnitId
ppr Indefinite UnitId
cid SDoc -> SDoc -> SDoc
<>
        (if Bool -> Bool
not ([(ModuleName, Module)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [(ModuleName, Module)]
insts) -- pprIf
          then
            SDoc -> SDoc
brackets ([SDoc] -> SDoc
hcat
                (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$
                    [ ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable ModuleName
ppr ModuleName
modname SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"=" SDoc -> SDoc -> SDoc
<> Module -> SDoc
pprModule Module
m
                    | (ModuleName
modname, Module
m) <- [(ModuleName, Module)]
insts]))
          else SDoc
empty)
     where
      cid :: Indefinite UnitId
cid   = InstantiatedUnit -> Indefinite UnitId
forall unit. GenInstantiatedUnit unit -> Indefinite unit
instUnitInstanceOf InstantiatedUnit
uid
      insts :: [(ModuleName, Module)]
insts = InstantiatedUnit -> [(ModuleName, Module)]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts InstantiatedUnit
uid


pprModule :: Module -> SDoc
pprModule :: Module -> SDoc
pprModule mod :: Module
mod@(Module Unit
p ModuleName
n)  = (PprStyle -> SDoc) -> SDoc
getPprStyle PprStyle -> SDoc
doc
 where
  doc :: PprStyle -> SDoc
doc PprStyle
sty
    | PprStyle -> Bool
codeStyle PprStyle
sty =
        (if Unit
p Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
Instance of class: Eq of the constraint type Eq Unit
== Unit
mainUnitId
                then SDoc
empty -- never qualify the main package in code
                else FastZString -> SDoc
ztext (FastString -> FastZString
zEncodeFS (Unit -> FastString
unitFS Unit
p)) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'_')
            SDoc -> SDoc -> SDoc
<> ModuleName -> SDoc
pprModuleName ModuleName
n
    | PprStyle -> QueryQualifyModule
qualModule PprStyle
sty Module
mod =
        case Unit
p of
          Unit
HoleUnit -> SDoc -> SDoc
angleBrackets (ModuleName -> SDoc
pprModuleName ModuleName
n)
          Unit
_        -> Unit -> SDoc
forall a. Outputable a => a -> SDoc
Instance of class: Outputable of the constraint type Outputable Unit
ppr (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':' SDoc -> SDoc -> SDoc
<> ModuleName -> SDoc
pprModuleName ModuleName
n
    | Bool
otherwise =
        ModuleName -> SDoc
pprModuleName ModuleName
n


pprInstantiatedModule :: InstantiatedModule -> SDoc
pprInstantiatedModule :: InstantiatedModule -> SDoc
pprInstantiatedModule (Module InstantiatedUnit
uid ModuleName
m) =
    InstantiatedUnit -> SDoc
forall a. Outputable a => a -> SDoc
Instance of class: Outputable of the constraint type Outputable InstantiatedUnit
ppr InstantiatedUnit
uid SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':' SDoc -> SDoc -> SDoc
<> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable ModuleName
ppr ModuleName
m

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

-- | 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 'IndefUnitId', 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.
        GenInstantiatedUnit unit -> FastString
instUnitFS :: !FastString,
        -- | Cached unique of 'unitFS'.
        GenInstantiatedUnit unit -> Unique
instUnitKey :: !Unique,
        -- | The indefinite unit being instantiated.
        GenInstantiatedUnit unit -> Indefinite unit
instUnitInstanceOf :: !(Indefinite unit),
        -- | The sorted (by 'ModuleName') instantiations of this 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.
        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
External instance of the constraint type Uniquable FastString
getUnique FastString
holeFS

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


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
External instance of the constraint type Eq Unique
== 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
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type Ord FastString
`compare` GenInstantiatedUnit unit -> FastString
forall unit. GenInstantiatedUnit unit -> FastString
instUnitFS GenInstantiatedUnit unit
u2

instance Binary InstantiatedUnit where
  put_ :: BinHandle -> InstantiatedUnit -> IO ()
put_ BinHandle
bh InstantiatedUnit
indef = do
    BinHandle -> Indefinite UnitId -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
Instance of class: Binary of the constraint type forall unit. Binary unit => Binary (Indefinite unit)
Instance of class: Binary of the constraint type Binary UnitId
put_ BinHandle
bh (InstantiatedUnit -> Indefinite UnitId
forall unit. GenInstantiatedUnit unit -> Indefinite unit
instUnitInstanceOf InstantiatedUnit
indef)
    BinHandle -> [(ModuleName, Module)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type forall a. Binary a => Binary [a]
External instance of the constraint type forall a b. (Binary a, Binary b) => Binary (a, b)
External instance of the constraint type Binary ModuleName
Instance of class: Binary of the constraint type forall a. Binary a => Binary (GenModule a)
Instance of class: Binary of the constraint type Binary Unit
put_ BinHandle
bh (InstantiatedUnit -> [(ModuleName, Module)]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts InstantiatedUnit
indef)
  get :: BinHandle -> IO InstantiatedUnit
get BinHandle
bh = do
    Indefinite UnitId
cid   <- BinHandle -> IO (Indefinite UnitId)
forall a. Binary a => BinHandle -> IO a
Instance of class: Binary of the constraint type forall unit. Binary unit => Binary (Indefinite unit)
Instance of class: Binary of the constraint type Binary UnitId
get BinHandle
bh
    [(ModuleName, Module)]
insts <- BinHandle -> IO [(ModuleName, Module)]
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type forall a. Binary a => Binary [a]
External instance of the constraint type forall a b. (Binary a, Binary b) => Binary (a, b)
External instance of the constraint type Binary ModuleName
Instance of class: Binary of the constraint type forall a. Binary a => Binary (GenModule a)
Instance of class: Binary of the constraint type Binary Unit
get BinHandle
bh
    let fs :: FastString
fs = Indefinite UnitId -> [(ModuleName, Module)] -> FastString
mkInstantiatedUnitHash Indefinite UnitId
cid [(ModuleName, Module)]
insts
    InstantiatedUnit -> IO InstantiatedUnit
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return InstantiatedUnit :: forall unit.
FastString
-> Unique
-> Indefinite unit
-> GenInstantiations unit
-> UniqDSet ModuleName
-> GenInstantiatedUnit unit
InstantiatedUnit {
            instUnitInstanceOf :: Indefinite UnitId
instUnitInstanceOf = Indefinite UnitId
cid,
            instUnitInsts :: [(ModuleName, Module)]
instUnitInsts = [(ModuleName, Module)]
insts,
            instUnitHoles :: UniqDSet ModuleName
instUnitHoles = [UniqDSet ModuleName] -> UniqDSet ModuleName
forall a. [UniqDSet a] -> UniqDSet a
unionManyUniqDSets (((ModuleName, Module) -> UniqDSet ModuleName)
-> [(ModuleName, Module)] -> [UniqDSet ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> UniqDSet ModuleName
forall u. GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHoles(Module -> UniqDSet ModuleName)
-> ((ModuleName, Module) -> Module)
-> (ModuleName, Module)
-> UniqDSet ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ModuleName, Module) -> Module
forall a b. (a, b) -> b
snd) [(ModuleName, Module)]
insts),
            instUnitFS :: FastString
instUnitFS = FastString
fs,
            instUnitKey :: Unique
instUnitKey = FastString -> Unique
forall a. Uniquable a => a -> Unique
External instance of the constraint type Uniquable FastString
getUnique FastString
fs
           }

instance Eq Unit where
  Unit
uid1 == :: Unit -> Unit -> Bool
== Unit
uid2 = Unit -> Unique
unitUnique Unit
uid1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Unique
== Unit -> Unique
unitUnique Unit
uid2

instance Uniquable Unit where
  getUnique :: Unit -> Unique
getUnique = Unit -> 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 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 -> () -> ()
`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
unitFS Unit
p1 FastString -> FastString -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type Ord FastString
`compare` Unit -> 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
uid) = Definite UnitId -> SDoc
forall a. Outputable a => a -> SDoc
Instance of class: Outputable of the constraint type forall unit. Outputable unit => Outputable (Definite unit)
Instance of class: Outputable of the constraint type Outputable UnitId
ppr Definite UnitId
uid
pprUnit (VirtUnit InstantiatedUnit
uid) = InstantiatedUnit -> SDoc
forall a. Outputable a => a -> SDoc
Instance of class: Outputable of the constraint type Outputable InstantiatedUnit
ppr InstantiatedUnit
uid
pprUnit Unit
HoleUnit       = FastString -> SDoc
ftext FastString
holeFS

instance Show Unit where
    show :: Unit -> String
show = Unit -> String
unitString

-- Performance: would prefer to have a NameCache like thing
instance Binary Unit where
  put_ :: BinHandle -> Unit -> IO ()
put_ BinHandle
bh (RealUnit Definite UnitId
def_uid) = do
    BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    BinHandle -> Definite UnitId -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
Instance of class: Binary of the constraint type forall unit. Binary unit => Binary (Definite unit)
Instance of class: Binary of the constraint type Binary UnitId
put_ BinHandle
bh Definite UnitId
def_uid
  put_ BinHandle
bh (VirtUnit InstantiatedUnit
indef_uid) = do
    BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    BinHandle -> InstantiatedUnit -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
Instance of class: Binary of the constraint type Binary InstantiatedUnit
put_ BinHandle
bh InstantiatedUnit
indef_uid
  put_ BinHandle
bh Unit
HoleUnit = do
    BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
  get :: BinHandle -> IO Unit
get BinHandle
bh = do Word8
b <- BinHandle -> IO Word8
getByte BinHandle
bh
              case Word8
b of
                Word8
0 -> (Definite UnitId -> Unit) -> IO (Definite UnitId) -> IO Unit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (BinHandle -> IO (Definite UnitId)
forall a. Binary a => BinHandle -> IO a
Instance of class: Binary of the constraint type forall unit. Binary unit => Binary (Definite unit)
Instance of class: Binary of the constraint type Binary UnitId
get BinHandle
bh)
                Word8
1 -> (InstantiatedUnit -> Unit) -> IO InstantiatedUnit -> IO Unit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap InstantiatedUnit -> Unit
forall uid. GenInstantiatedUnit uid -> GenUnit uid
VirtUnit (BinHandle -> IO InstantiatedUnit
forall a. Binary a => BinHandle -> IO a
Instance of class: Binary of the constraint type Binary InstantiatedUnit
get BinHandle
bh)
                Word8
_ -> Unit -> IO Unit
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type Applicative IO
pure Unit
forall uid. GenUnit uid
HoleUnit

instance Binary unit => Binary (Indefinite unit) where
  put_ :: BinHandle -> Indefinite unit -> IO ()
put_ BinHandle
bh (Indefinite unit
fs Maybe UnitPprInfo
_) = BinHandle -> unit -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
Evidence bound by a type signature of the constraint type Binary unit
put_ BinHandle
bh unit
fs
  get :: BinHandle -> IO (Indefinite unit)
get BinHandle
bh = do { unit
fs <- BinHandle -> IO unit
forall a. Binary a => BinHandle -> IO a
Evidence bound by a type signature of the constraint type Binary unit
get BinHandle
bh; Indefinite unit -> IO (Indefinite unit)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (unit -> Maybe UnitPprInfo -> Indefinite unit
forall unit. unit -> Maybe UnitPprInfo -> Indefinite unit
Indefinite unit
fs Maybe UnitPprInfo
forall a. Maybe a
Nothing) }



-- | Retrieve the set of free module holes of a 'Unit'.
unitFreeModuleHoles :: GenUnit u -> UniqDSet ModuleName
unitFreeModuleHoles :: 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 :: GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHoles (Module GenUnit u
HoleUnit ModuleName
name) = ModuleName -> UniqDSet ModuleName
forall a. Uniquable a => a -> UniqDSet a
External instance of the constraint type Uniquable ModuleName
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.
mkGenInstantiatedUnit :: (unit -> FastString) -> Indefinite unit -> GenInstantiations unit -> GenInstantiatedUnit unit
mkGenInstantiatedUnit :: (unit -> FastString)
-> Indefinite unit
-> GenInstantiations unit
-> GenInstantiatedUnit unit
mkGenInstantiatedUnit unit -> FastString
gunitFS Indefinite unit
cid GenInstantiations unit
insts =
    InstantiatedUnit :: forall unit.
FastString
-> Unique
-> Indefinite unit
-> GenInstantiations unit
-> UniqDSet ModuleName
-> GenInstantiatedUnit unit
InstantiatedUnit {
        instUnitInstanceOf :: Indefinite unit
instUnitInstanceOf = Indefinite unit
cid,
        instUnitInsts :: GenInstantiations unit
instUnitInsts = GenInstantiations unit
sorted_insts,
        instUnitHoles :: UniqDSet ModuleName
instUnitHoles = [UniqDSet ModuleName] -> UniqDSet ModuleName
forall a. [UniqDSet a] -> UniqDSet a
unionManyUniqDSets (((ModuleName, GenModule (GenUnit unit)) -> UniqDSet ModuleName)
-> GenInstantiations unit -> [UniqDSet ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (GenModule (GenUnit unit) -> UniqDSet ModuleName
forall u. GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHoles(GenModule (GenUnit unit) -> UniqDSet ModuleName)
-> ((ModuleName, GenModule (GenUnit unit))
    -> GenModule (GenUnit unit))
-> (ModuleName, GenModule (GenUnit unit))
-> UniqDSet ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ModuleName, GenModule (GenUnit unit)) -> GenModule (GenUnit unit)
forall a b. (a, b) -> b
snd) GenInstantiations unit
insts),
        instUnitFS :: FastString
instUnitFS = FastString
fs,
        instUnitKey :: Unique
instUnitKey = FastString -> Unique
forall a. Uniquable a => a -> Unique
External instance of the constraint type Uniquable FastString
getUnique FastString
fs
    }
  where
     fs :: FastString
fs = (unit -> FastString)
-> Indefinite unit -> GenInstantiations unit -> FastString
forall unit.
(unit -> FastString)
-> Indefinite unit
-> [(ModuleName, GenModule (GenUnit unit))]
-> FastString
mkGenInstantiatedUnitHash unit -> FastString
gunitFS Indefinite unit
cid GenInstantiations unit
sorted_insts
     sorted_insts :: GenInstantiations unit
sorted_insts = ((ModuleName, GenModule (GenUnit unit))
 -> (ModuleName, GenModule (GenUnit unit)) -> Ordering)
-> GenInstantiations unit -> GenInstantiations unit
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (ModuleName -> ModuleName -> Ordering
stableModuleNameCmp (ModuleName -> ModuleName -> Ordering)
-> ((ModuleName, GenModule (GenUnit unit)) -> ModuleName)
-> (ModuleName, GenModule (GenUnit unit))
-> (ModuleName, GenModule (GenUnit unit))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (ModuleName, GenModule (GenUnit unit)) -> ModuleName
forall a b. (a, b) -> a
fst) GenInstantiations unit
insts

-- | Create a new 'InstantiatedUnit' given an explicit module substitution.
mkInstantiatedUnit :: IndefUnitId -> Instantiations -> InstantiatedUnit
mkInstantiatedUnit :: Indefinite UnitId -> [(ModuleName, Module)] -> InstantiatedUnit
mkInstantiatedUnit = (UnitId -> FastString)
-> Indefinite UnitId -> [(ModuleName, Module)] -> InstantiatedUnit
forall unit.
(unit -> FastString)
-> Indefinite unit
-> GenInstantiations unit
-> GenInstantiatedUnit unit
mkGenInstantiatedUnit UnitId -> FastString
unitIdFS


-- | Smart constructor for instantiated GenUnit
mkGenVirtUnit :: (unit -> FastString) -> Indefinite unit -> [(ModuleName, GenModule (GenUnit unit))] -> GenUnit unit
mkGenVirtUnit :: (unit -> FastString)
-> Indefinite unit
-> [(ModuleName, GenModule (GenUnit unit))]
-> GenUnit unit
mkGenVirtUnit unit -> FastString
_gunitFS Indefinite unit
uid []    = Definite unit -> GenUnit unit
forall uid. Definite uid -> GenUnit uid
RealUnit (Definite unit -> GenUnit unit) -> Definite unit -> GenUnit unit
forall a b. (a -> b) -> a -> b
$ unit -> Definite unit
forall unit. unit -> Definite unit
Definite (Indefinite unit -> unit
forall unit. Indefinite unit -> unit
indefUnit Indefinite unit
uid) -- huh? indefinite unit without any instantiation/hole?
mkGenVirtUnit unit -> FastString
gunitFS  Indefinite unit
uid [(ModuleName, GenModule (GenUnit unit))]
insts = GenInstantiatedUnit unit -> GenUnit unit
forall uid. GenInstantiatedUnit uid -> GenUnit uid
VirtUnit (GenInstantiatedUnit unit -> GenUnit unit)
-> GenInstantiatedUnit unit -> GenUnit unit
forall a b. (a -> b) -> a -> b
$ (unit -> FastString)
-> Indefinite unit
-> [(ModuleName, GenModule (GenUnit unit))]
-> GenInstantiatedUnit unit
forall unit.
(unit -> FastString)
-> Indefinite unit
-> GenInstantiations unit
-> GenInstantiatedUnit unit
mkGenInstantiatedUnit unit -> FastString
gunitFS Indefinite unit
uid [(ModuleName, GenModule (GenUnit unit))]
insts

-- | Smart constructor for VirtUnit
mkVirtUnit :: IndefUnitId -> Instantiations -> Unit
mkVirtUnit :: Indefinite UnitId -> [(ModuleName, Module)] -> Unit
mkVirtUnit = (UnitId -> FastString)
-> Indefinite UnitId -> [(ModuleName, Module)] -> Unit
forall unit.
(unit -> FastString)
-> Indefinite unit
-> [(ModuleName, GenModule (GenUnit unit))]
-> GenUnit unit
mkGenVirtUnit UnitId -> FastString
unitIdFS

-- | 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.
mkGenInstantiatedUnitHash :: (unit -> FastString) -> Indefinite unit -> [(ModuleName, GenModule (GenUnit unit))] -> FastString
mkGenInstantiatedUnitHash :: (unit -> FastString)
-> Indefinite unit
-> [(ModuleName, GenModule (GenUnit unit))]
-> FastString
mkGenInstantiatedUnitHash unit -> FastString
gunitFS Indefinite unit
cid [(ModuleName, GenModule (GenUnit unit))]
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 (unit -> FastString
gunitFS (Indefinite unit -> unit
forall unit. Indefinite unit -> unit
indefUnit Indefinite unit
cid)))
  (Fingerprint -> FastString) -> Fingerprint -> FastString
forall a b. (a -> b) -> a -> b
$ (unit -> FastString)
-> [(ModuleName, GenModule (GenUnit unit))] -> Fingerprint
forall unit.
(unit -> FastString)
-> [(ModuleName, GenModule (GenUnit unit))] -> Fingerprint
hashInstantiations unit -> FastString
gunitFS [(ModuleName, GenModule (GenUnit unit))]
sorted_holes

mkInstantiatedUnitHash :: IndefUnitId -> Instantiations -> FastString
mkInstantiatedUnitHash :: Indefinite UnitId -> [(ModuleName, Module)] -> FastString
mkInstantiatedUnitHash = (UnitId -> FastString)
-> Indefinite UnitId -> [(ModuleName, Module)] -> FastString
forall unit.
(unit -> FastString)
-> Indefinite unit
-> [(ModuleName, GenModule (GenUnit unit))]
-> FastString
mkGenInstantiatedUnitHash UnitId -> FastString
unitIdFS

-- | Generate a hash for a sorted module instantiation.
hashInstantiations :: (unit -> FastString) -> [(ModuleName, GenModule (GenUnit unit))] -> Fingerprint
hashInstantiations :: (unit -> FastString)
-> [(ModuleName, GenModule (GenUnit unit))] -> Fingerprint
hashInstantiations unit -> FastString
gunitFS [(ModuleName, GenModule (GenUnit unit))]
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
        (ModuleName
m, GenModule (GenUnit unit)
b) <- [(ModuleName, GenModule (GenUnit unit))]
sorted_holes
        [ FastString -> ByteString
bytesFS (ModuleName -> FastString
moduleNameFS ModuleName
m),                   Char -> ByteString
BS.Char8.singleton Char
' ',
          FastString -> ByteString
bytesFS ((unit -> FastString) -> GenUnit unit -> FastString
forall unit. (unit -> FastString) -> GenUnit unit -> FastString
genUnitFS unit -> FastString
gunitFS (GenModule (GenUnit unit) -> GenUnit unit
forall unit. GenModule unit -> unit
moduleUnit GenModule (GenUnit unit)
b)), Char -> ByteString
BS.Char8.singleton Char
':',
          FastString -> ByteString
bytesFS (ModuleName -> FastString
moduleNameFS (GenModule (GenUnit unit) -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName GenModule (GenUnit unit)
b)),      Char -> ByteString
BS.Char8.singleton Char
'\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 :: Unit -> Unique
unitUnique :: Unit -> Unique
unitUnique (VirtUnit InstantiatedUnit
x)            = InstantiatedUnit -> Unique
forall unit. GenInstantiatedUnit unit -> Unique
instUnitKey InstantiatedUnit
x
unitUnique (RealUnit (Definite UnitId
x)) = UnitId -> Unique
forall a. Uniquable a => a -> Unique
Instance of class: Uniquable of the constraint type Uniquable UnitId
getUnique UnitId
x
unitUnique Unit
HoleUnit                = Unique
holeUnique

unitFS :: Unit -> FastString
unitFS :: Unit -> FastString
unitFS = (UnitId -> FastString) -> Unit -> FastString
forall unit. (unit -> FastString) -> GenUnit unit -> FastString
genUnitFS UnitId -> FastString
unitIdFS

genUnitFS :: (unit -> FastString) -> GenUnit unit -> FastString
genUnitFS :: (unit -> FastString) -> GenUnit unit -> FastString
genUnitFS unit -> FastString
_gunitFS (VirtUnit GenInstantiatedUnit unit
x)            = GenInstantiatedUnit unit -> FastString
forall unit. GenInstantiatedUnit unit -> FastString
instUnitFS GenInstantiatedUnit unit
x
genUnitFS unit -> FastString
gunitFS  (RealUnit (Definite unit
x)) = unit -> FastString
gunitFS unit
x
genUnitFS unit -> FastString
_gunitFS GenUnit unit
HoleUnit                = FastString
holeFS

-- | 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 :: Unit -> String
unitString :: Unit -> String
unitString = FastString -> String
unpackFS (FastString -> String) -> (Unit -> FastString) -> Unit -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> 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 :: (u -> v) -> (v -> FastString) -> GenUnit u -> GenUnit v
mapGenUnit :: (u -> v) -> (v -> FastString) -> GenUnit u -> GenUnit v
mapGenUnit u -> v
f v -> FastString
gunitFS = 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Definite
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 -> FastString)
-> Indefinite v -> GenInstantiations v -> GenInstantiatedUnit v
forall unit.
(unit -> FastString)
-> Indefinite unit
-> GenInstantiations unit
-> GenInstantiatedUnit unit
mkGenInstantiatedUnit v -> FastString
gunitFS
                     ((u -> v) -> Indefinite u -> Indefinite v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor Indefinite
fmap u -> v
f (GenInstantiatedUnit u -> Indefinite u
forall unit. GenInstantiatedUnit unit -> Indefinite unit
instUnitInstanceOf GenInstantiatedUnit u
i))
                     (((ModuleName, GenModule (GenUnit u))
 -> (ModuleName, GenModule (GenUnit v)))
-> [(ModuleName, GenModule (GenUnit u))] -> GenInstantiations v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor []
fmap ((GenModule (GenUnit u) -> GenModule (GenUnit v))
-> (ModuleName, GenModule (GenUnit u))
-> (ModuleName, GenModule (GenUnit v))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
External instance of the constraint type Bifunctor (,)
second ((GenUnit u -> GenUnit v)
-> GenModule (GenUnit u) -> GenModule (GenUnit v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Instance of class: Functor of the constraint type Functor GenModule
fmap GenUnit u -> GenUnit v
go)) (GenInstantiatedUnit u -> [(ModuleName, GenModule (GenUnit u))]
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts GenInstantiatedUnit u
i))


-- | Check the database to see if we already have an installed unit that
-- corresponds to the given 'InstantiatedUnit'.
--
-- Return a `UnitId` which either wraps the `InstantiatedUnit` unchanged or
-- references a matching installed unit.
--
-- See Note [VirtUnit to RealUnit improvement]
instUnitToUnit :: PackageState -> InstantiatedUnit -> Unit
instUnitToUnit :: PackageState -> InstantiatedUnit -> Unit
instUnitToUnit PackageState
pkgstate InstantiatedUnit
iuid =
    -- NB: suppose that we want to compare the indefinite
    -- unit id p[H=impl:H] against p+abcd (where p+abcd
    -- happens to be the existing, installed version of
    -- p[H=impl:H].  If we *only* wrap in p[H=impl:H]
    -- VirtUnit, they won't compare equal; only
    -- after improvement will the equality hold.
    UnitInfoMap -> Unit -> Unit
improveUnit (PackageState -> UnitInfoMap
unitInfoMap PackageState
pkgstate) (Unit -> Unit) -> Unit -> Unit
forall a b. (a -> b) -> a -> b
$
        InstantiatedUnit -> Unit
forall uid. GenInstantiatedUnit uid -> GenUnit uid
VirtUnit InstantiatedUnit
iuid

-- | Return the UnitId of the Unit. For 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)           = Indefinite UnitId -> UnitId
forall unit. Indefinite unit -> unit
indefUnit (InstantiatedUnit -> Indefinite UnitId
forall unit. GenInstantiatedUnit unit -> Indefinite unit
instUnitInstanceOf InstantiatedUnit
indef)
toUnitId Unit
HoleUnit                   = String -> UnitId
forall a. HasCallStack => String -> a
error String
"Hole unit"

-- | 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 {
      -- | The full hashed unit identifier, including the component id
      -- and the hash.
      UnitId -> FastString
unitIdFS :: FastString
    }

instance Binary UnitId where
  put_ :: BinHandle -> UnitId -> IO ()
put_ BinHandle
bh (UnitId FastString
fs) = BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
External instance of the constraint type Binary FastString
put_ BinHandle
bh FastString
fs
  get :: BinHandle -> IO UnitId
get BinHandle
bh = do FastString
fs <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
External instance of the constraint type Binary FastString
get BinHandle
bh; UnitId -> IO UnitId
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (FastString -> UnitId
UnitId FastString
fs)

instance Eq UnitId where
    UnitId
uid1 == :: UnitId -> UnitId -> Bool
== UnitId
uid2 = UnitId -> Unique
forall a. Uniquable a => a -> Unique
Instance of class: Uniquable of the constraint type Uniquable UnitId
getUnique UnitId
uid1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Unique
== UnitId -> Unique
forall a. Uniquable a => a -> Unique
Instance of class: Uniquable of the constraint type Uniquable UnitId
getUnique UnitId
uid2

instance Ord UnitId where
    UnitId
u1 compare :: UnitId -> UnitId -> Ordering
`compare` UnitId
u2 = UnitId -> FastString
unitIdFS UnitId
u1 FastString -> FastString -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type Ord FastString
`compare` UnitId -> FastString
unitIdFS UnitId
u2

instance Uniquable UnitId where
    getUnique :: UnitId -> Unique
getUnique = FastString -> Unique
forall a. Uniquable a => a -> Unique
External instance of the constraint type Uniquable FastString
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 uid :: UnitId
uid@(UnitId FastString
fs) =
        (Bool -> SDoc) -> SDoc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug ->
        (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
          case PackageState -> UnitId -> Maybe String
displayUnitId (DynFlags -> PackageState
pkgState DynFlags
dflags) UnitId
uid of
            Just String
str | Bool -> Bool
not Bool
debug -> String -> SDoc
text String
str
            Maybe String
_ -> FastString -> SDoc
ftext 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 { Definite unit -> unit
unDefinite :: unit }
    deriving (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
/= :: Definite unit -> Definite unit -> Bool
$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
Evidence bound by a type signature of the constraint type Eq unit
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
min :: Definite unit -> Definite unit -> Definite unit
$cmin :: forall unit.
Ord unit =>
Definite unit -> Definite unit -> Definite unit
max :: Definite unit -> Definite unit -> Definite unit
$cmax :: forall unit.
Ord unit =>
Definite unit -> Definite unit -> Definite unit
>= :: 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
$c< :: forall unit. Ord unit => Definite unit -> Definite unit -> Bool
compare :: Definite unit -> Definite unit -> Ordering
$ccompare :: forall unit. Ord unit => Definite unit -> Definite unit -> Ordering
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a type signature of the constraint type Ord unit
Instance of class: Eq of the constraint type forall unit. Eq unit => Eq (Definite unit)
External instance of the constraint type forall a. Ord a => Eq a
Evidence bound by a type signature of the constraint type Ord unit
Evidence bound by a type signature of the constraint type Ord unit
Instance of class: Eq of the constraint type forall unit. Eq unit => Eq (Definite unit)
External instance of the constraint type forall a. Ord a => Eq a
Ord, a -> Definite b -> Definite a
(a -> b) -> Definite a -> Definite b
(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
<$ :: a -> Definite b -> Definite a
$c<$ :: forall a b. a -> Definite b -> Definite a
fmap :: (a -> b) -> Definite a -> Definite b
$cfmap :: forall a b. (a -> b) -> Definite a -> Definite b
Functor)

instance Outputable unit => Outputable (Definite unit) where
    ppr :: Definite unit -> SDoc
ppr (Definite unit
uid) = unit -> SDoc
forall a. Outputable a => a -> SDoc
Evidence bound by a type signature of the constraint type Outputable unit
ppr unit
uid

instance Binary unit => Binary (Definite unit) where
    put_ :: BinHandle -> Definite unit -> IO ()
put_ BinHandle
bh (Definite unit
uid) = BinHandle -> unit -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
Evidence bound by a type signature of the constraint type Binary unit
put_ BinHandle
bh unit
uid
    get :: BinHandle -> IO (Definite unit)
get BinHandle
bh = do unit
uid <- BinHandle -> IO unit
forall a. Binary a => BinHandle -> IO a
Evidence bound by a type signature of the constraint type Binary unit
get BinHandle
bh; Definite unit -> IO (Definite unit)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (unit -> Definite unit
forall unit. unit -> Definite unit
Definite unit
uid)


-- | An 'IndefUnitId' is an 'UnitId' with the invariant that it only
-- refers to an indefinite library; i.e., one that can be instantiated.
type IndefUnitId = Indefinite UnitId

data Indefinite unit = Indefinite
   { Indefinite unit -> unit
indefUnit        :: !unit             -- ^ Unit identifier
   , Indefinite unit -> Maybe UnitPprInfo
indefUnitPprInfo :: Maybe UnitPprInfo -- ^ Cache for some unit info retrieved from the DB
   }
   deriving (a -> Indefinite b -> Indefinite a
(a -> b) -> Indefinite a -> Indefinite b
(forall a b. (a -> b) -> Indefinite a -> Indefinite b)
-> (forall a b. a -> Indefinite b -> Indefinite a)
-> Functor Indefinite
forall a b. a -> Indefinite b -> Indefinite a
forall a b. (a -> b) -> Indefinite a -> Indefinite b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Indefinite b -> Indefinite a
$c<$ :: forall a b. a -> Indefinite b -> Indefinite a
fmap :: (a -> b) -> Indefinite a -> Indefinite b
$cfmap :: forall a b. (a -> b) -> Indefinite a -> Indefinite b
Functor)

instance Eq unit => Eq (Indefinite unit) where
   Indefinite unit
a == :: Indefinite unit -> Indefinite unit -> Bool
== Indefinite unit
b = Indefinite unit -> unit
forall unit. Indefinite unit -> unit
indefUnit Indefinite unit
a unit -> unit -> Bool
forall a. Eq a => a -> a -> Bool
Evidence bound by a type signature of the constraint type Eq unit
== Indefinite unit -> unit
forall unit. Indefinite unit -> unit
indefUnit Indefinite unit
b

instance Ord unit => Ord (Indefinite unit) where
   compare :: Indefinite unit -> Indefinite unit -> Ordering
compare Indefinite unit
a Indefinite unit
b = unit -> unit -> Ordering
forall a. Ord a => a -> a -> Ordering
Evidence bound by a type signature of the constraint type Ord unit
compare (Indefinite unit -> unit
forall unit. Indefinite unit -> unit
indefUnit Indefinite unit
a) (Indefinite unit -> unit
forall unit. Indefinite unit -> unit
indefUnit Indefinite unit
b)


instance Uniquable unit => Uniquable (Indefinite unit) where
  getUnique :: Indefinite unit -> Unique
getUnique (Indefinite unit
n Maybe UnitPprInfo
_) = unit -> Unique
forall a. Uniquable a => a -> Unique
Evidence bound by a type signature of the constraint type Uniquable unit
getUnique unit
n

instance Outputable unit => Outputable (Indefinite unit) where
  ppr :: Indefinite unit -> SDoc
ppr (Indefinite unit
uid Maybe UnitPprInfo
Nothing)        = unit -> SDoc
forall a. Outputable a => a -> SDoc
Evidence bound by a type signature of the constraint type Outputable unit
ppr unit
uid
  ppr (Indefinite unit
uid (Just UnitPprInfo
pprinfo)) =
    (Bool -> SDoc) -> SDoc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug ->
      if Bool
debug
         then unit -> SDoc
forall a. Outputable a => a -> SDoc
Evidence bound by a type signature of the constraint type Outputable unit
ppr unit
uid
         else UnitPprInfo -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable UnitPprInfo
ppr UnitPprInfo
pprinfo


---------------------------------------------------------------------
-- 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.findWiredInPackages' if you add an entry here.

For `integer-gmp`/`integer-simple` we also change the base name to
`integer-wired-in`, but this is fundamentally no different.
See Note [The integer library] in PrelNames.
-}

integerUnitId, primUnitId,
  baseUnitId, rtsUnitId,
  thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId  :: Unit
primUnitId :: Unit
primUnitId        = FastString -> Unit
fsToUnit (String -> FastString
fsLit String
"ghc-prim")
integerUnitId :: Unit
integerUnitId     = FastString -> Unit
fsToUnit (String -> FastString
fsLit String
"integer-wired-in")
   -- See Note [The integer library] in PrelNames
baseUnitId :: Unit
baseUnitId        = FastString -> Unit
fsToUnit (String -> FastString
fsLit String
"base")
rtsUnitId :: Unit
rtsUnitId         = FastString -> Unit
fsToUnit (String -> FastString
fsLit String
"rts")
thUnitId :: Unit
thUnitId          = FastString -> Unit
fsToUnit (String -> FastString
fsLit String
"template-haskell")
thisGhcUnitId :: Unit
thisGhcUnitId     = FastString -> Unit
fsToUnit (String -> FastString
fsLit String
"ghc")
interactiveUnitId :: Unit
interactiveUnitId = FastString -> Unit
fsToUnit (String -> FastString
fsLit String
"interactive")

-- | 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 :: Unit
mainUnitId      = FastString -> Unit
fsToUnit (String -> FastString
fsLit String
"main")

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
Instance of class: Eq of the constraint type Eq Unit
== Unit
interactiveUnitId

wiredInUnitIds :: [Unit]
wiredInUnitIds :: [Unit]
wiredInUnitIds =
   [ Unit
primUnitId
   , Unit
integerUnitId
   , Unit
baseUnitId
   , Unit
rtsUnitId
   , Unit
thUnitId
   , Unit
thisGhcUnitId
   ]