Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
GHC.Unit.Types
Description
Unit & Module types
This module is used to resolve the loops between Unit and Module types (Module references a Unit and vice-versa).
Synopsis
- data GenModule unit = Module {
- moduleUnit :: !unit
- moduleName :: !ModuleName
- type Module = GenModule Unit
- type InstalledModule = GenModule UnitId
- type HomeUnitModule = GenModule UnitId
- type InstantiatedModule = GenModule InstantiatedUnit
- mkModule :: u -> ModuleName -> GenModule u
- moduleUnitId :: Module -> UnitId
- pprModule :: IsLine doc => Module -> doc
- pprInstantiatedModule :: InstantiatedModule -> SDoc
- moduleFreeHoles :: GenModule (GenUnit u) -> UniqDSet ModuleName
- class IsUnitId u
- data GenUnit uid
- = RealUnit !(Definite uid)
- | VirtUnit !(GenInstantiatedUnit uid)
- | HoleUnit
- type Unit = GenUnit UnitId
- newtype UnitId = UnitId {}
- newtype UnitKey = UnitKey FastString
- data GenInstantiatedUnit unit = InstantiatedUnit {
- instUnitFS :: !FastString
- instUnitKey :: !Unique
- instUnitInstanceOf :: !unit
- instUnitInsts :: !(GenInstantiations unit)
- instUnitHoles :: UniqDSet ModuleName
- type InstantiatedUnit = GenInstantiatedUnit UnitId
- type DefUnitId = Definite UnitId
- type Instantiations = GenInstantiations UnitId
- type GenInstantiations unit = [(ModuleName, GenModule (GenUnit unit))]
- mkInstantiatedUnit :: IsUnitId u => u -> GenInstantiations u -> GenInstantiatedUnit u
- mkInstantiatedUnitHash :: IsUnitId u => u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
- mkVirtUnit :: IsUnitId u => u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
- mapGenUnit :: IsUnitId v => (u -> v) -> GenUnit u -> GenUnit v
- mapInstantiations :: IsUnitId v => (u -> v) -> GenInstantiations u -> GenInstantiations v
- unitFreeModuleHoles :: GenUnit u -> UniqDSet ModuleName
- fsToUnit :: FastString -> Unit
- unitFS :: IsUnitId u => u -> FastString
- unitString :: IsUnitId u => u -> String
- toUnitId :: Unit -> UnitId
- virtualUnitId :: InstantiatedUnit -> UnitId
- stringToUnit :: String -> Unit
- stableUnitCmp :: Unit -> Unit -> Ordering
- unitIsDefinite :: Unit -> Bool
- isHoleUnit :: GenUnit u -> Bool
- pprUnit :: Unit -> SDoc
- unitIdString :: UnitId -> String
- stringToUnitId :: String -> UnitId
- newtype Definite unit = Definite {
- unDefinite :: unit
- primUnitId :: UnitId
- bignumUnitId :: UnitId
- baseUnitId :: UnitId
- rtsUnitId :: UnitId
- thUnitId :: UnitId
- mainUnitId :: UnitId
- thisGhcUnitId :: UnitId
- interactiveUnitId :: UnitId
- primUnit :: Unit
- bignumUnit :: Unit
- baseUnit :: Unit
- rtsUnit :: Unit
- thUnit :: Unit
- mainUnit :: Unit
- thisGhcUnit :: Unit
- interactiveUnit :: Unit
- isInteractiveModule :: Module -> Bool
- wiredInUnitIds :: [UnitId]
- data IsBootInterface
- data GenWithIsBoot mod = GWIB {
- gwib_mod :: mod
- gwib_isBoot :: IsBootInterface
- type ModuleNameWithIsBoot = GenWithIsBoot ModuleName
- type ModuleWithIsBoot = GenWithIsBoot Module
Modules
A generic module is a pair of a unit identifier and a ModuleName
.
Constructors
Module | |
Fields
|
Instances
Functor GenModule # | |
Uniquable Module # | |
Defined in GHC.Unit.Types | |
Outputable InstalledModule # | |
Defined in GHC.Unit.Types Methods ppr :: InstalledModule -> SDoc # | |
Outputable InstantiatedModule # | |
Defined in GHC.Unit.Types Methods ppr :: InstantiatedModule -> SDoc # | |
Outputable Module # | |
Defined in GHC.Unit.Types | |
Data unit => Data (GenModule unit) # | |
Defined in GHC.Unit.Types Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> GenModule unit -> c (GenModule unit) gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (GenModule unit) toConstr :: GenModule unit -> Constr dataTypeOf :: GenModule unit -> DataType dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (GenModule unit)) dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (GenModule unit)) gmapT :: (forall b. Data b => b -> b) -> GenModule unit -> GenModule unit gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> GenModule unit -> r gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> GenModule unit -> r gmapQ :: (forall d. Data d => d -> u) -> GenModule unit -> [u] gmapQi :: Int -> (forall d. Data d => d -> u) -> GenModule unit -> u gmapM :: Monad m => (forall d. Data d => d -> m d) -> GenModule unit -> m (GenModule unit) gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> GenModule unit -> m (GenModule unit) gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> GenModule unit -> m (GenModule unit) | |
NFData (GenModule a) # | |
Defined in GHC.Unit.Types | |
Binary a => Binary (GenModule a) # | |
Eq unit => Eq (GenModule unit) # | |
Ord unit => Ord (GenModule unit) # | |
Defined in GHC.Unit.Types Methods compare :: 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 # |
type InstalledModule = GenModule UnitId #
A InstalledModule
is a GenModule
whose unit is identified with an
UnitId
.
type HomeUnitModule = GenModule UnitId #
A HomeUnitModule
is like an InstalledModule
but we expect to find it in
one of the home units rather than the package database.
type InstantiatedModule = GenModule InstantiatedUnit #
An InstantiatedModule
is a GenModule
whose unit is identified with an GenInstantiatedUnit
.
mkModule :: u -> ModuleName -> GenModule u #
moduleUnitId :: Module -> UnitId #
moduleFreeHoles :: GenModule (GenUnit u) -> UniqDSet ModuleName #
Calculate the free holes of a GenModule
. 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.
Units
Class for types that are used as unit identifiers (UnitKey, UnitId, Unit)
We need this class because we create new unit ids for virtual units (see VirtUnit) and they have to to be made from units with different kinds of identifiers.
Minimal complete definition
Instances
IsUnitId UnitId # | |
Defined in GHC.Unit.Types Methods unitFS :: UnitId -> FastString # | |
IsUnitId UnitKey # | |
Defined in GHC.Unit.Types Methods unitFS :: UnitKey -> FastString # | |
IsUnitId unit => IsUnitId (Definite unit) # | |
Defined in GHC.Unit.Types Methods unitFS :: Definite unit -> FastString # | |
IsUnitId u => IsUnitId (GenUnit u) # | |
Defined in GHC.Unit.Types Methods unitFS :: GenUnit u -> FastString # |
A unit identifier identifies a (possibly partially) instantiated library.
It is primarily used as part of GenModule
, 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
GenInstantiatedUnit
, which explicitly records the instantiation, so that we
can substitute over it.
Constructors
RealUnit !(Definite uid) | Installed definite unit (either a fully instantiated unit or a closed unit) |
VirtUnit !(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 |
Instances
Data Unit # | |
Defined in GHC.Unit.Types Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Unit -> c Unit gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Unit dataTypeOf :: Unit -> DataType dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Unit) dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Unit) gmapT :: (forall b. Data b => b -> b) -> Unit -> Unit gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Unit -> r gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Unit -> r gmapQ :: (forall d. Data d => d -> u) -> Unit -> [u] gmapQi :: Int -> (forall d. Data d => d -> u) -> Unit -> u gmapM :: Monad m => (forall d. Data d => d -> m d) -> Unit -> m Unit gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Unit -> m Unit gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Unit -> m Unit | |
Show Unit # | |
NFData Unit # | |
Defined in GHC.Unit.Types | |
Uniquable Module # | |
Defined in GHC.Unit.Types | |
Binary Unit # | |
Outputable Module # | |
Defined in GHC.Unit.Types | |
Outputable Unit # | |
Defined in GHC.Unit.Types | |
Ord Unit # | |
IsUnitId u => Uniquable (GenUnit u) # | |
Defined in GHC.Unit.Types | |
IsUnitId u => IsUnitId (GenUnit u) # | |
Defined in GHC.Unit.Types Methods unitFS :: GenUnit u -> FastString # | |
IsUnitId u => Eq (GenUnit u) # | |
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.
Constructors
UnitId | |
Fields
|
Instances
Data Unit # | |
Defined in GHC.Unit.Types Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Unit -> c Unit gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Unit dataTypeOf :: Unit -> DataType dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Unit) dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Unit) gmapT :: (forall b. Data b => b -> b) -> Unit -> Unit gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Unit -> r gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Unit -> r gmapQ :: (forall d. Data d => d -> u) -> Unit -> [u] gmapQi :: Int -> (forall d. Data d => d -> u) -> Unit -> u gmapM :: Monad m => (forall d. Data d => d -> m d) -> Unit -> m Unit gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Unit -> m Unit gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Unit -> m Unit | |
Data UnitId # | |
Defined in GHC.Unit.Types Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> UnitId -> c UnitId gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c UnitId dataTypeOf :: UnitId -> DataType dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c UnitId) dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnitId) gmapT :: (forall b. Data b => b -> b) -> UnitId -> UnitId gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r gmapQ :: (forall d. Data d => d -> u) -> UnitId -> [u] gmapQi :: Int -> (forall d. Data d => d -> u) -> UnitId -> u gmapM :: Monad m => (forall d. Data d => d -> m d) -> UnitId -> m UnitId gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> UnitId -> m UnitId gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> UnitId -> m UnitId | |
Show Unit # | |
NFData Unit # | |
Defined in GHC.Unit.Types | |
Uniquable Module # | |
Defined in GHC.Unit.Types | |
Uniquable UnitId # | |
Defined in GHC.Unit.Types | |
IsUnitId UnitId # | |
Defined in GHC.Unit.Types Methods unitFS :: UnitId -> FastString # | |
Binary InstantiatedUnit # | |
Defined in GHC.Unit.Types Methods put_ :: BinHandle -> InstantiatedUnit -> IO () # put :: BinHandle -> InstantiatedUnit -> IO (Bin InstantiatedUnit) # get :: BinHandle -> IO InstantiatedUnit # | |
Binary Unit # | |
Binary UnitId # | |
Outputable InstalledModule # | |
Defined in GHC.Unit.Types Methods ppr :: InstalledModule -> SDoc # | |
Outputable InstantiatedModule # | |
Defined in GHC.Unit.Types Methods ppr :: InstantiatedModule -> SDoc # | |
Outputable InstantiatedUnit # | |
Defined in GHC.Unit.Types Methods ppr :: InstantiatedUnit -> SDoc # | |
Outputable Module # | |
Defined in GHC.Unit.Types | |
Outputable Unit # | |
Defined in GHC.Unit.Types | |
Outputable UnitId # | |
Defined in GHC.Unit.Types | |
Eq UnitId # | |
Ord Unit # | |
Ord UnitId # | |
A unit key in the database
Constructors
UnitKey FastString |
Instances
IsUnitId UnitKey # | |
Defined in GHC.Unit.Types Methods unitFS :: UnitKey -> FastString # |
data GenInstantiatedUnit unit #
An instantiated unit.
It identifies an indefinite library (with holes) that has been instantiated.
This unit may be indefinite or not (i.e. with remaining holes or not). If it is definite, we don't know if it has already been compiled and installed in a database. Nevertheless, we have a mechanism called "improvement" to try to match a fully instantiated unit with existing compiled and installed units: see Note [VirtUnit to RealUnit improvement].
An indefinite unit identifier pretty-prints to something like
p[H=H,A=aimpl:A>]
(p
is the UnitId
, and the
brackets enclose the module substitution).
Constructors
InstantiatedUnit | |
Fields
|
Instances
type Instantiations = GenInstantiations UnitId #
type GenInstantiations unit = [(ModuleName, GenModule (GenUnit unit))] #
mkInstantiatedUnit :: IsUnitId u => u -> GenInstantiations u -> GenInstantiatedUnit u #
Create a new GenInstantiatedUnit
given an explicit module substitution.
mkInstantiatedUnitHash :: IsUnitId u => u -> [(ModuleName, GenModule (GenUnit u))] -> FastString #
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.
mkVirtUnit :: IsUnitId u => u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u #
Smart constructor for instantiated GenUnit
mapInstantiations :: IsUnitId v => (u -> v) -> GenInstantiations u -> GenInstantiations v #
Map over the unit identifier of unit instantiations.
unitFreeModuleHoles :: GenUnit u -> UniqDSet ModuleName #
Retrieve the set of free module holes of a Unit
.
fsToUnit :: FastString -> Unit #
Create a new simple unit identifier from a FastString
. Internally,
this is primarily used to specify wired-in unit identifiers.
unitFS :: IsUnitId u => u -> FastString #
unitString :: IsUnitId u => u -> String #
Return the UnitId of the Unit. For on-the-fly instantiated units, return the UnitId of the indefinite unit this unit is an instance of.
virtualUnitId :: InstantiatedUnit -> UnitId #
Return the virtual UnitId of an on-the-fly instantiated unit.
stringToUnit :: String -> Unit #
stableUnitCmp :: Unit -> Unit -> Ordering #
Compares unit ids lexically, rather than by their Unique
s
unitIsDefinite :: Unit -> Bool #
A Unit
is definite if it has no free holes.
isHoleUnit :: GenUnit u -> Bool #
Unit Ids
unitIdString :: UnitId -> String #
stringToUnitId :: String -> UnitId #
Utils
A definite unit (i.e. without any free module hole)
Constructors
Definite | |
Fields
|
Instances
Functor Definite # | |
Uniquable unit => Uniquable (Definite unit) # | |
Defined in GHC.Unit.Types | |
IsUnitId unit => IsUnitId (Definite unit) # | |
Defined in GHC.Unit.Types Methods unitFS :: Definite unit -> FastString # | |
Binary unit => Binary (Definite unit) # | |
Outputable unit => Outputable (Definite unit) # | |
Defined in GHC.Unit.Types | |
Eq unit => Eq (Definite unit) # | |
Ord unit => Ord (Definite unit) # | |
Defined in GHC.Unit.Types Methods compare :: 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 # |
Wired-in units
primUnitId :: UnitId #
bignumUnitId :: UnitId #
baseUnitId :: UnitId #
mainUnitId :: UnitId #
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.
thisGhcUnitId :: UnitId #
bignumUnit :: Unit #
thisGhcUnit :: Unit #
interactiveUnit :: Unit #
isInteractiveModule :: Module -> Bool #
wiredInUnitIds :: [UnitId] #
Boot modules
data IsBootInterface #
Instances
data GenWithIsBoot mod #
This data type just pairs a value mod
with an IsBootInterface flag. In
practice, mod
is usually a Module
or ModuleName
'.
Constructors
GWIB | |
Fields
|
Instances
type ModuleWithIsBoot = GenWithIsBoot Module #
Orphan instances
Binary IsBootInterface # | |
Methods put_ :: BinHandle -> IsBootInterface -> IO () # put :: BinHandle -> IsBootInterface -> IO (Bin IsBootInterface) # get :: BinHandle -> IO IsBootInterface # |