{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module GHC.Unit.Types
(
GenModule (..)
, Module
, InstalledModule
, HomeUnitModule
, InstantiatedModule
, mkModule
, moduleUnitId
, pprModule
, pprInstantiatedModule
, moduleFreeHoles
, 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
, unitIdString
, stringToUnitId
, Definite (..)
, primUnitId
, bignumUnitId
, baseUnitId
, rtsUnitId
, thUnitId
, mainUnitId
, thisGhcUnitId
, interactiveUnitId
, primUnit
, bignumUnit
, baseUnit
, rtsUnit
, thUnit
, mainUnit
, thisGhcUnit
, interactiveUnit
, isInteractiveModule
, wiredInUnitIds
, IsBootInterface (..)
, GenWithIsBoot (..)
, ModuleNameWithIsBoot
, ModuleWithIsBoot
)
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 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 Language.Haskell.Syntax.Module.Name
import {-# SOURCE #-} Language.Haskell.Syntax.ImpExp (IsBootInterface(..))
data GenModule unit = Module
{ forall unit. GenModule unit -> unit
moduleUnit :: !unit
, forall unit. GenModule unit -> ModuleName
moduleName :: !ModuleName
}
deriving (GenModule unit -> GenModule unit -> Bool
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
Eq,GenModule unit -> GenModule unit -> Bool
GenModule unit -> GenModule unit -> Ordering
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
Ord,GenModule unit -> DataType
GenModule unit -> Constr
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 (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))
gmapMo :: 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)
gmapMp :: forall (m :: * -> *).
MonadPlus 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)
gmapM :: forall (m :: * -> *).
Monad m =>
(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 :: forall u.
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 u. (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 :: 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
gmapQl :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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)
Data,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
<$ :: forall a b. a -> GenModule b -> GenModule a
$c<$ :: forall a b. a -> GenModule b -> GenModule a
fmap :: forall a b. (a -> b) -> GenModule a -> GenModule b
$cfmap :: forall a b. (a -> b) -> GenModule a -> GenModule b
Functor)
type Module = GenModule Unit
moduleUnitId :: Module -> UnitId
moduleUnitId :: Module -> UnitId
moduleUnitId = Unit -> UnitId
toUnitId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. GenModule unit -> unit
moduleUnit
type InstalledModule = GenModule UnitId
type HomeUnitModule = GenModule UnitId
type InstantiatedModule = GenModule InstantiatedUnit
mkModule :: u -> ModuleName -> GenModule u
mkModule :: forall u. u -> ModuleName -> GenModule u
mkModule = forall u. u -> ModuleName -> GenModule u
Module
instance Uniquable Module where
getUnique :: Module -> Unique
getUnique (Module Unit
p ModuleName
n) = forall a. Uniquable a => a -> Unique
getUnique (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_ :: BinHandle -> GenModule a -> IO ()
put_ BinHandle
bh (Module a
p ModuleName
n) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ModuleName
n
get :: BinHandle -> IO (GenModule a)
get BinHandle
bh = do a
p <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; ModuleName
n <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; forall (m :: * -> *) a. Monad m => a -> m a
return (forall u. u -> ModuleName -> GenModule u
Module a
p ModuleName
n)
instance NFData (GenModule a) where
rnf :: GenModule a -> ()
rnf (Module a
unit ModuleName
name) = a
unit seq :: forall a b. a -> b -> b
`seq` ModuleName
name seq :: forall a b. a -> b -> b
`seq` ()
instance Outputable Module where
ppr :: Module -> SDoc
ppr = forall doc. IsLine doc => Module -> doc
pprModule
instance Outputable InstalledModule where
ppr :: InstalledModule -> SDoc
ppr (Module UnitId
p ModuleName
n) =
forall a. Outputable a => a -> SDoc
ppr UnitId
p forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
':' forall doc. IsLine doc => doc -> doc -> doc
<> 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 = forall doc. IsLine doc => InstantiatedUnit -> doc
pprInstantiatedUnit
pprInstantiatedUnit :: IsLine doc => InstantiatedUnit -> doc
pprInstantiatedUnit :: forall doc. IsLine doc => InstantiatedUnit -> doc
pprInstantiatedUnit InstantiatedUnit
uid =
forall doc. IsLine doc => UnitId -> doc
pprUnitId UnitId
cid forall doc. IsLine doc => doc -> doc -> doc
<>
(if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null GenInstantiations UnitId
insts)
then
forall doc. IsLine doc => doc -> doc
brackets (forall doc. IsLine doc => [doc] -> doc
hcat
(forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate forall doc. IsLine doc => doc
comma forall a b. (a -> b) -> a -> b
$
[ forall doc. IsLine doc => ModuleName -> doc
pprModuleName ModuleName
modname forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => String -> doc
text String
"=" forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Module -> doc
pprModule Module
m
| (ModuleName
modname, Module
m) <- GenInstantiations UnitId
insts]))
else forall doc. IsOutput doc => doc
empty)
where
cid :: UnitId
cid = forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf InstantiatedUnit
uid
insts :: GenInstantiations UnitId
insts = forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts InstantiatedUnit
uid
{-# SPECIALIZE pprInstantiatedUnit :: InstantiatedUnit -> SDoc #-}
{-# SPECIALIZE pprInstantiatedUnit :: InstantiatedUnit -> HLine #-}
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) = forall unit. GenInstantiatedUnit unit -> FastString
instUnitFS GenInstantiatedUnit u
x
unitFS (RealUnit (Definite u
x)) = 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) = forall doc. IsOutput doc => (SDocContext -> doc) -> doc
docWithContext (PprStyle -> doc
doc forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDocContext -> PprStyle
sdocStyle)
where
doc :: PprStyle -> doc
doc PprStyle
sty
| PprStyle -> Bool
codeStyle PprStyle
sty =
(if Unit
p forall a. Eq a => a -> a -> Bool
== Unit
mainUnit
then forall doc. IsOutput doc => doc
empty
else forall doc. IsLine doc => FastZString -> doc
ztext (FastString -> FastZString
zEncodeFS (forall u. IsUnitId u => u -> FastString
unitFS Unit
p)) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'_')
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => ModuleName -> doc
pprModuleName ModuleName
n
| PprStyle -> QueryQualifyModule
qualModule PprStyle
sty Module
mod =
case Unit
p of
Unit
HoleUnit -> forall doc. IsLine doc => doc -> doc
angleBrackets (forall doc. IsLine doc => ModuleName -> doc
pprModuleName ModuleName
n)
Unit
_ -> forall doc. IsLine doc => Unit -> doc
pprUnit Unit
p forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
':' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => ModuleName -> doc
pprModuleName ModuleName
n
| Bool
otherwise =
forall doc. IsLine doc => ModuleName -> doc
pprModuleName ModuleName
n
{-# SPECIALIZE pprModule :: Module -> SDoc #-}
{-# SPECIALIZE pprModule :: Module -> HLine #-}
pprInstantiatedModule :: InstantiatedModule -> SDoc
pprInstantiatedModule :: InstantiatedModule -> SDoc
pprInstantiatedModule (Module InstantiatedUnit
uid ModuleName
m) =
forall a. Outputable a => a -> SDoc
ppr InstantiatedUnit
uid forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
':' forall doc. IsLine doc => doc -> doc -> doc
<> forall a. Outputable a => a -> SDoc
ppr ModuleName
m
newtype UnitKey = UnitKey FastString
data GenUnit uid
= RealUnit !(Definite uid)
| VirtUnit {-# UNPACK #-} !(GenInstantiatedUnit uid)
| HoleUnit
data GenInstantiatedUnit unit
= InstantiatedUnit {
forall unit. GenInstantiatedUnit unit -> FastString
instUnitFS :: !FastString,
forall unit. GenInstantiatedUnit unit -> Unique
instUnitKey :: !Unique,
forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf :: !unit,
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts :: !(GenInstantiations unit),
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 = 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 = forall unit. GenInstantiatedUnit unit -> Unique
instUnitKey GenInstantiatedUnit unit
u1 forall a. Eq a => a -> a -> Bool
== 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 = forall unit. GenInstantiatedUnit unit -> FastString
instUnitFS GenInstantiatedUnit unit
u1 FastString -> FastString -> Ordering
`lexicalCompareFS` forall unit. GenInstantiatedUnit unit -> FastString
instUnitFS GenInstantiatedUnit unit
u2
instance Binary InstantiatedUnit where
put_ :: BinHandle -> InstantiatedUnit -> IO ()
put_ BinHandle
bh InstantiatedUnit
indef = do
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf InstantiatedUnit
indef)
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts InstantiatedUnit
indef)
get :: BinHandle -> IO InstantiatedUnit
get BinHandle
bh = do
UnitId
cid <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
GenInstantiations UnitId
insts <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
let fs :: FastString
fs = forall u.
IsUnitId u =>
u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
mkInstantiatedUnitHash UnitId
cid GenInstantiations UnitId
insts
forall (m :: * -> *) a. Monad m => a -> m a
return InstantiatedUnit {
instUnitInstanceOf :: UnitId
instUnitInstanceOf = UnitId
cid,
instUnitInsts :: GenInstantiations UnitId
instUnitInsts = GenInstantiations UnitId
insts,
instUnitHoles :: UniqDSet ModuleName
instUnitHoles = forall a. [UniqDSet a] -> UniqDSet a
unionManyUniqDSets (forall a b. (a -> b) -> [a] -> [b]
map (forall u. GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHolesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) GenInstantiations UnitId
insts),
instUnitFS :: FastString
instUnitFS = FastString
fs,
instUnitKey :: Unique
instUnitKey = forall a. Uniquable a => a -> Unique
getUnique FastString
fs
}
instance IsUnitId u => Eq (GenUnit u) where
GenUnit u
uid1 == :: GenUnit u -> GenUnit u -> Bool
== GenUnit u
uid2 = forall u. IsUnitId u => GenUnit u -> Unique
unitUnique GenUnit u
uid1 forall a. Eq a => a -> a -> Bool
== forall u. IsUnitId u => GenUnit u -> Unique
unitUnique GenUnit u
uid2
instance IsUnitId u => Uniquable (GenUnit u) where
getUnique :: GenUnit u -> Unique
getUnique = 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
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
_ = 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 seq :: forall a b. a -> b -> b
`seq` ()
stableUnitCmp :: Unit -> Unit -> Ordering
stableUnitCmp :: Unit -> Unit -> Ordering
stableUnitCmp Unit
p1 Unit
p2 = forall u. IsUnitId u => u -> FastString
unitFS Unit
p1 FastString -> FastString -> Ordering
`lexicalCompareFS` forall u. IsUnitId u => u -> FastString
unitFS Unit
p2
instance Outputable Unit where
ppr :: Unit -> SDoc
ppr Unit
pk = forall doc. IsLine doc => Unit -> doc
pprUnit Unit
pk
pprUnit :: IsLine doc => Unit -> doc
pprUnit :: forall doc. IsLine doc => Unit -> doc
pprUnit (RealUnit (Definite UnitId
d)) = forall doc. IsLine doc => UnitId -> doc
pprUnitId UnitId
d
pprUnit (VirtUnit InstantiatedUnit
uid) = forall doc. IsLine doc => InstantiatedUnit -> doc
pprInstantiatedUnit InstantiatedUnit
uid
pprUnit Unit
HoleUnit = forall doc. IsLine doc => FastString -> doc
ftext FastString
holeFS
{-# SPECIALIZE pprUnit :: Unit -> SDoc #-}
{-# SPECIALIZE pprUnit :: Unit -> HLine #-}
instance Show Unit where
show :: Unit -> String
show = forall u. IsUnitId u => u -> String
unitString
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
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Definite UnitId
def_uid
put_ BinHandle
bh (VirtUnit InstantiatedUnit
indef_uid) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh InstantiatedUnit
indef_uid
put_ BinHandle
bh Unit
HoleUnit =
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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall uid. Definite uid -> GenUnit uid
RealUnit (forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
Word8
1 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall uid. GenInstantiatedUnit uid -> GenUnit uid
VirtUnit (forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
Word8
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall uid. GenUnit uid
HoleUnit
unitFreeModuleHoles :: GenUnit u -> UniqDSet ModuleName
unitFreeModuleHoles :: forall u. GenUnit u -> UniqDSet ModuleName
unitFreeModuleHoles (VirtUnit GenInstantiatedUnit u
x) = forall unit. GenInstantiatedUnit unit -> UniqDSet ModuleName
instUnitHoles GenInstantiatedUnit u
x
unitFreeModuleHoles (RealUnit Definite u
_) = forall a. UniqDSet a
emptyUniqDSet
unitFreeModuleHoles GenUnit u
HoleUnit = forall a. UniqDSet a
emptyUniqDSet
moduleFreeHoles :: GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHoles :: forall u. GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHoles (Module GenUnit u
HoleUnit ModuleName
name) = forall a. Uniquable a => a -> UniqDSet a
unitUniqDSet ModuleName
name
moduleFreeHoles (Module GenUnit u
u ModuleName
_ ) = forall u. GenUnit u -> UniqDSet ModuleName
unitFreeModuleHoles GenUnit u
u
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 = forall a. [UniqDSet a] -> UniqDSet a
unionManyUniqDSets (forall a b. (a -> b) -> [a] -> [b]
map (forall u. GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHolesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
snd) GenInstantiations u
insts),
instUnitFS :: FastString
instUnitFS = FastString
fs,
instUnitKey :: Unique
instUnitKey = forall a. Uniquable a => a -> Unique
getUnique FastString
fs
}
where
fs :: FastString
fs = forall u.
IsUnitId u =>
u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
mkInstantiatedUnitHash u
cid GenInstantiations u
sorted_insts
sorted_insts :: GenInstantiations u
sorted_insts = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (ModuleName -> ModuleName -> Ordering
stableModuleNameCmp forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst) GenInstantiations u
insts
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 [] = forall uid. Definite uid -> GenUnit uid
RealUnit forall a b. (a -> b) -> a -> b
$ forall unit. unit -> Definite unit
Definite u
uid
mkVirtUnit u
uid [(ModuleName, GenModule (GenUnit u))]
insts = forall uid. GenInstantiatedUnit uid -> GenUnit uid
VirtUnit forall a b. (a -> b) -> a -> b
$ forall u.
IsUnitId u =>
u -> GenInstantiations u -> GenInstantiatedUnit u
mkInstantiatedUnit u
uid [(ModuleName, GenModule (GenUnit u))]
insts
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
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Fingerprint -> ByteString
fingerprintUnitId (FastString -> ByteString
bytesFS (forall u. IsUnitId u => u -> FastString
unitFS u
cid))
forall a b. (a -> b) -> a -> b
$ forall u.
IsUnitId u =>
[(ModuleName, GenModule (GenUnit u))] -> Fingerprint
hashInstantiations [(ModuleName, GenModule (GenUnit u))]
sorted_holes
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
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat forall a b. (a -> b) -> a -> b
$ do
(ModuleName
m, GenModule (GenUnit u)
b) <- [(ModuleName, GenModule (GenUnit u))]
sorted_holes
[ FastString -> ByteString
bytesFS (ModuleName -> FastString
moduleNameFS ModuleName
m), Char -> ByteString
BS.Char8.singleton Char
' ',
FastString -> ByteString
bytesFS (forall u. IsUnitId u => u -> FastString
unitFS (forall unit. GenModule unit -> unit
moduleUnit GenModule (GenUnit u)
b)), Char -> ByteString
BS.Char8.singleton Char
':',
FastString -> ByteString
bytesFS (ModuleName -> FastString
moduleNameFS (forall unit. GenModule unit -> ModuleName
moduleName GenModule (GenUnit u)
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
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) = forall unit. GenInstantiatedUnit unit -> Unique
instUnitKey GenInstantiatedUnit u
x
unitUnique (RealUnit (Definite u
x)) = forall a. Uniquable a => a -> Unique
getUnique (forall u. IsUnitId u => u -> FastString
unitFS u
x)
unitUnique GenUnit u
HoleUnit = Unique
holeUnique
fsToUnit :: FastString -> Unit
fsToUnit :: FastString -> Unit
fsToUnit = forall uid. Definite uid -> GenUnit uid
RealUnit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall unit. unit -> Definite unit
Definite 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u. IsUnitId u => u -> FastString
unitFS
stringToUnit :: String -> Unit
stringToUnit :: String -> Unit
stringToUnit = FastString -> Unit
fsToUnit forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString
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 -> forall uid. GenUnit uid
HoleUnit
RealUnit Definite u
d -> forall uid. Definite uid -> GenUnit uid
RealUnit (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap u -> v
f Definite u
d)
VirtUnit GenInstantiatedUnit u
i ->
forall uid. GenInstantiatedUnit uid -> GenUnit uid
VirtUnit forall a b. (a -> b) -> a -> b
$ forall u.
IsUnitId u =>
u -> GenInstantiations u -> GenInstantiatedUnit u
mkInstantiatedUnit
(u -> v
f (forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf GenInstantiatedUnit u
i))
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenUnit u -> GenUnit v
go)) (forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts GenInstantiatedUnit u
i))
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 = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall v u. IsUnitId v => (u -> v) -> GenUnit u -> GenUnit v
mapGenUnit u -> v
f)))
toUnitId :: Unit -> UnitId
toUnitId :: Unit -> UnitId
toUnitId (RealUnit (Definite UnitId
iuid)) = UnitId
iuid
toUnitId (VirtUnit InstantiatedUnit
indef) = forall unit. GenInstantiatedUnit unit -> unit
instUnitInstanceOf InstantiatedUnit
indef
toUnitId Unit
HoleUnit = forall a. HasCallStack => String -> a
error String
"Hole unit"
virtualUnitId :: InstantiatedUnit -> UnitId
virtualUnitId :: InstantiatedUnit -> UnitId
virtualUnitId InstantiatedUnit
i = FastString -> UnitId
UnitId (forall unit. GenInstantiatedUnit unit -> FastString
instUnitFS InstantiatedUnit
i)
unitIsDefinite :: Unit -> Bool
unitIsDefinite :: Unit -> Bool
unitIsDefinite = forall a. UniqDSet a -> Bool
isEmptyUniqDSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u. GenUnit u -> UniqDSet ModuleName
unitFreeModuleHoles
newtype UnitId = UnitId
{ UnitId -> FastString
unitIdFS :: FastString
}
deriving (Typeable UnitId
UnitId -> DataType
UnitId -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UnitId -> m UnitId
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnitId -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UnitId -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> UnitId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UnitId -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r
gmapT :: (forall b. Data b => b -> b) -> UnitId -> UnitId
$cgmapT :: (forall b. Data b => b -> b) -> UnitId -> UnitId
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnitId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnitId)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnitId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UnitId)
dataTypeOf :: UnitId -> DataType
$cdataTypeOf :: UnitId -> DataType
toConstr :: UnitId -> Constr
$ctoConstr :: UnitId -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnitId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnitId
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnitId -> c UnitId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UnitId -> c UnitId
Data)
instance Binary UnitId where
put_ :: BinHandle -> UnitId -> IO ()
put_ BinHandle
bh (UnitId FastString
fs) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
fs
get :: BinHandle -> IO UnitId
get BinHandle
bh = do FastString
fs <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> UnitId
UnitId FastString
fs)
instance Eq UnitId where
UnitId
uid1 == :: UnitId -> UnitId -> Bool
== UnitId
uid2 = forall a. Uniquable a => a -> Unique
getUnique UnitId
uid1 forall a. Eq a => a -> a -> Bool
== forall a. Uniquable a => a -> Unique
getUnique UnitId
uid2
instance Ord UnitId where
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 = forall a. Uniquable a => a -> Unique
getUnique forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> FastString
unitIdFS
instance Outputable UnitId where
ppr :: UnitId -> SDoc
ppr = forall doc. IsLine doc => UnitId -> doc
pprUnitId
pprUnitId :: IsLine doc => UnitId -> doc
pprUnitId :: forall doc. IsLine doc => UnitId -> doc
pprUnitId (UnitId FastString
fs) = forall doc. IsLine doc => SDoc -> HLine -> doc
dualLine (forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> FastString -> SDoc
sdocUnitIdForUser (forall a b. (a -> b) -> a -> b
$ FastString
fs)) (forall doc. IsLine doc => FastString -> doc
ftext FastString
fs)
{-# SPECIALIZE pprUnitId :: UnitId -> SDoc #-}
{-# SPECIALIZE pprUnitId :: UnitId -> HLine #-}
type DefUnitId = Definite UnitId
unitIdString :: UnitId -> String
unitIdString :: UnitId -> String
unitIdString = FastString -> String
unpackFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> FastString
unitIdFS
stringToUnitId :: String -> UnitId
stringToUnitId :: String -> UnitId
stringToUnitId = FastString -> UnitId
UnitId forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString
newtype Definite unit = Definite { forall unit. Definite unit -> unit
unDefinite :: unit }
deriving (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
<$ :: forall a b. a -> Definite b -> Definite a
$c<$ :: forall a b. a -> Definite b -> Definite a
fmap :: forall a b. (a -> b) -> Definite a -> Definite b
$cfmap :: forall a b. (a -> b) -> Definite a -> Definite b
Functor)
deriving newtype (Definite unit -> Definite unit -> Bool
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
Eq, 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
Ord, Definite unit -> SDoc
forall unit. Outputable unit => Definite unit -> SDoc
forall a. (a -> SDoc) -> Outputable a
ppr :: Definite unit -> SDoc
$cppr :: forall unit. Outputable unit => Definite unit -> SDoc
Outputable, BinHandle -> IO (Definite unit)
BinHandle -> Definite unit -> IO ()
BinHandle -> Definite unit -> IO (Bin (Definite unit))
forall unit. Binary unit => BinHandle -> IO (Definite unit)
forall unit. Binary unit => BinHandle -> Definite unit -> IO ()
forall unit.
Binary unit =>
BinHandle -> Definite unit -> IO (Bin (Definite unit))
forall a.
(BinHandle -> a -> IO ())
-> (BinHandle -> a -> IO (Bin a))
-> (BinHandle -> IO a)
-> Binary a
get :: BinHandle -> IO (Definite unit)
$cget :: forall unit. Binary unit => BinHandle -> IO (Definite unit)
put :: BinHandle -> Definite unit -> IO (Bin (Definite unit))
$cput :: forall unit.
Binary unit =>
BinHandle -> Definite unit -> IO (Bin (Definite unit))
put_ :: BinHandle -> Definite unit -> IO ()
$cput_ :: forall unit. Binary unit => BinHandle -> Definite unit -> IO ()
Binary, Definite unit -> Unique
forall unit. Uniquable unit => Definite unit -> Unique
forall a. (a -> Unique) -> Uniquable a
getUnique :: Definite unit -> Unique
$cgetUnique :: forall unit. Uniquable unit => Definite unit -> Unique
Uniquable, Definite unit -> FastString
forall unit. IsUnitId unit => Definite unit -> FastString
forall u. (u -> FastString) -> IsUnitId u
unitFS :: Definite unit -> FastString
$cunitFS :: forall unit. IsUnitId unit => Definite unit -> FastString
IsUnitId)
bignumUnitId, primUnitId, baseUnitId, rtsUnitId,
thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId :: UnitId
bignumUnit, primUnit, baseUnit, rtsUnit,
thUnit, 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")
baseUnitId :: UnitId
baseUnitId = FastString -> UnitId
UnitId (String -> FastString
fsLit String
"base")
rtsUnitId :: UnitId
rtsUnitId = FastString -> UnitId
UnitId (String -> FastString
fsLit String
"rts")
thisGhcUnitId :: UnitId
thisGhcUnitId = FastString -> UnitId
UnitId (String -> FastString
fsLit String
"ghc")
interactiveUnitId :: UnitId
interactiveUnitId = FastString -> UnitId
UnitId (String -> FastString
fsLit String
"interactive")
thUnitId :: UnitId
thUnitId = FastString -> UnitId
UnitId (String -> FastString
fsLit String
"template-haskell")
thUnit :: Unit
thUnit = forall uid. Definite uid -> GenUnit uid
RealUnit (forall unit. unit -> Definite unit
Definite UnitId
thUnitId)
primUnit :: Unit
primUnit = forall uid. Definite uid -> GenUnit uid
RealUnit (forall unit. unit -> Definite unit
Definite UnitId
primUnitId)
bignumUnit :: Unit
bignumUnit = forall uid. Definite uid -> GenUnit uid
RealUnit (forall unit. unit -> Definite unit
Definite UnitId
bignumUnitId)
baseUnit :: Unit
baseUnit = forall uid. Definite uid -> GenUnit uid
RealUnit (forall unit. unit -> Definite unit
Definite UnitId
baseUnitId)
rtsUnit :: Unit
rtsUnit = forall uid. Definite uid -> GenUnit uid
RealUnit (forall unit. unit -> Definite unit
Definite UnitId
rtsUnitId)
thisGhcUnit :: Unit
thisGhcUnit = forall uid. Definite uid -> GenUnit uid
RealUnit (forall unit. unit -> Definite unit
Definite UnitId
thisGhcUnitId)
interactiveUnit :: Unit
interactiveUnit = forall uid. Definite uid -> GenUnit uid
RealUnit (forall unit. unit -> Definite unit
Definite UnitId
interactiveUnitId)
mainUnitId :: UnitId
mainUnitId = FastString -> UnitId
UnitId (String -> FastString
fsLit String
"main")
mainUnit :: Unit
mainUnit = forall uid. Definite uid -> GenUnit uid
RealUnit (forall unit. unit -> Definite unit
Definite UnitId
mainUnitId)
isInteractiveModule :: Module -> Bool
isInteractiveModule :: QueryQualifyModule
isInteractiveModule Module
mod = forall unit. GenModule unit -> unit
moduleUnit Module
mod forall a. Eq a => a -> a -> Bool
== Unit
interactiveUnit
wiredInUnitIds :: [UnitId]
wiredInUnitIds :: [UnitId]
wiredInUnitIds =
[ UnitId
primUnitId
, UnitId
bignumUnitId
, UnitId
baseUnitId
, UnitId
rtsUnitId
, UnitId
thUnitId
, UnitId
thisGhcUnitId
]
instance Binary IsBootInterface where
put_ :: BinHandle -> IsBootInterface -> IO ()
put_ BinHandle
bh IsBootInterface
ib = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh forall a b. (a -> b) -> a -> b
$
case IsBootInterface
ib of
IsBootInterface
NotBoot -> Bool
False
IsBootInterface
IsBoot -> Bool
True
get :: BinHandle -> IO IsBootInterface
get BinHandle
bh = do
Bool
b <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Bool
b of
Bool
False -> IsBootInterface
NotBoot
Bool
True -> IsBootInterface
IsBoot
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
forall mod.
Eq mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
$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
Eq, GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
GenWithIsBoot mod -> GenWithIsBoot mod -> Ordering
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
min :: GenWithIsBoot mod -> GenWithIsBoot mod -> GenWithIsBoot mod
$cmin :: forall mod.
Ord mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> GenWithIsBoot mod
max :: GenWithIsBoot mod -> GenWithIsBoot mod -> GenWithIsBoot mod
$cmax :: forall mod.
Ord mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> GenWithIsBoot mod
>= :: 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
$c< :: forall mod.
Ord mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> Bool
compare :: GenWithIsBoot mod -> GenWithIsBoot mod -> Ordering
$ccompare :: forall mod.
Ord mod =>
GenWithIsBoot mod -> GenWithIsBoot mod -> Ordering
Ord, Int -> GenWithIsBoot mod -> ShowS
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
showList :: [GenWithIsBoot mod] -> ShowS
$cshowList :: forall mod. Show mod => [GenWithIsBoot mod] -> ShowS
show :: GenWithIsBoot mod -> String
$cshow :: forall mod. Show mod => GenWithIsBoot mod -> String
showsPrec :: Int -> GenWithIsBoot mod -> ShowS
$cshowsPrec :: forall mod. Show mod => Int -> GenWithIsBoot mod -> ShowS
Show
, 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
<$ :: forall a b. a -> GenWithIsBoot b -> GenWithIsBoot a
$c<$ :: forall a b. a -> GenWithIsBoot b -> GenWithIsBoot a
fmap :: forall a b. (a -> b) -> GenWithIsBoot a -> GenWithIsBoot b
$cfmap :: forall a b. (a -> b) -> GenWithIsBoot a -> GenWithIsBoot b
Functor, 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
product :: forall a. Num a => GenWithIsBoot a -> a
$cproduct :: forall a. Num a => GenWithIsBoot a -> a
sum :: forall a. Num a => GenWithIsBoot a -> a
$csum :: forall a. Num a => GenWithIsBoot a -> a
minimum :: forall a. Ord a => GenWithIsBoot a -> a
$cminimum :: forall a. Ord a => GenWithIsBoot a -> a
maximum :: forall a. Ord a => GenWithIsBoot a -> a
$cmaximum :: forall a. Ord a => GenWithIsBoot a -> a
elem :: forall a. Eq a => a -> GenWithIsBoot a -> Bool
$celem :: forall a. Eq a => a -> GenWithIsBoot a -> Bool
length :: forall a. GenWithIsBoot a -> Int
$clength :: forall a. GenWithIsBoot a -> Int
null :: forall a. GenWithIsBoot a -> Bool
$cnull :: forall a. GenWithIsBoot a -> Bool
toList :: forall a. GenWithIsBoot a -> [a]
$ctoList :: forall a. GenWithIsBoot a -> [a]
foldl1 :: forall a. (a -> a -> a) -> GenWithIsBoot a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> GenWithIsBoot a -> a
foldr1 :: forall a. (a -> a -> a) -> GenWithIsBoot a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> GenWithIsBoot a -> a
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
$cfoldl :: forall b a. (b -> a -> 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
$cfoldr :: forall a b. (a -> b -> b) -> b -> GenWithIsBoot a -> b
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
$cfoldMap :: forall m a. Monoid m => (a -> m) -> GenWithIsBoot a -> m
fold :: forall m. Monoid m => GenWithIsBoot m -> m
$cfold :: forall m. Monoid m => GenWithIsBoot m -> m
Foldable, Functor GenWithIsBoot
Foldable 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)
sequence :: forall (m :: * -> *) a.
Monad m =>
GenWithIsBoot (m a) -> m (GenWithIsBoot a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
GenWithIsBoot (m a) -> m (GenWithIsBoot a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenWithIsBoot a -> m (GenWithIsBoot b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenWithIsBoot a -> m (GenWithIsBoot b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
GenWithIsBoot (f a) -> f (GenWithIsBoot a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
GenWithIsBoot (f a) -> f (GenWithIsBoot a)
traverse :: 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)
Traversable
)
type ModuleNameWithIsBoot = GenWithIsBoot ModuleName
type ModuleWithIsBoot = GenWithIsBoot Module
instance Binary a => Binary (GenWithIsBoot a) where
put_ :: BinHandle -> GenWithIsBoot a -> IO ()
put_ BinHandle
bh (GWIB { a
gwib_mod :: a
gwib_mod :: forall mod. GenWithIsBoot mod -> mod
gwib_mod, IsBootInterface
gwib_isBoot :: IsBootInterface
gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot }) = do
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh a
gwib_mod
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IsBootInterface
gwib_isBoot
get :: BinHandle -> IO (GenWithIsBoot a)
get BinHandle
bh = do
a
gwib_mod <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
IsBootInterface
gwib_isBoot <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ GWIB { a
gwib_mod :: a
gwib_mod :: a
gwib_mod, IsBootInterface
gwib_isBoot :: IsBootInterface
gwib_isBoot :: IsBootInterface
gwib_isBoot }
instance Outputable a => Outputable (GenWithIsBoot a) where
ppr :: GenWithIsBoot a -> SDoc
ppr (GWIB { a
gwib_mod :: a
gwib_mod :: forall mod. GenWithIsBoot mod -> mod
gwib_mod, IsBootInterface
gwib_isBoot :: IsBootInterface
gwib_isBoot :: forall mod. GenWithIsBoot mod -> IsBootInterface
gwib_isBoot }) = forall doc. IsLine doc => [doc] -> doc
hsep forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr a
gwib_mod forall a. a -> [a] -> [a]
: case IsBootInterface
gwib_isBoot of
IsBootInterface
IsBoot -> [ forall doc. IsLine doc => String -> doc
text String
"{-# SOURCE #-}" ]
IsBootInterface
NotBoot -> []