ghc-8.2.2: The GHC API

Safe HaskellNone
LanguageHaskell2010

Module

Contents

Synopsis

The ModuleName type

data ModuleName #

A ModuleName is essentially a simple string, e.g. Data.List.

Instances

Eq ModuleName # 
Data ModuleName # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ModuleName -> c ModuleName Source #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ModuleName Source #

toConstr :: ModuleName -> Constr Source #

dataTypeOf :: ModuleName -> DataType Source #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c ModuleName) Source #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModuleName) Source #

gmapT :: (forall b. Data b => b -> b) -> ModuleName -> ModuleName Source #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ModuleName -> r Source #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ModuleName -> r Source #

gmapQ :: (forall d. Data d => d -> u) -> ModuleName -> [u] Source #

gmapQi :: Int -> (forall d. Data d => d -> u) -> ModuleName -> u Source #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> ModuleName -> m ModuleName Source #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ModuleName -> m ModuleName Source #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ModuleName -> m ModuleName Source #

Ord ModuleName # 
NFData ModuleName # 

Methods

rnf :: ModuleName -> () Source #

BinaryStringRep ModuleName # 
Outputable ModuleName # 
Uniquable ModuleName # 
Binary ModuleName # 
DbUnitIdModuleRep InstalledUnitId ComponentId UnitId ModuleName Module # 

moduleNameSlashes :: ModuleName -> String #

Returns the string version of the module name, with dots replaced by slashes.

moduleNameColons :: ModuleName -> String #

Returns the string version of the module name, with dots replaced by colons.

moduleStableString :: Module -> String #

Get a string representation of a Module that's unique and stable across recompilations. eg. "$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal"

moduleFreeHoles :: Module -> UniqDSet ModuleName #

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.

moduleIsDefinite :: Module -> Bool #

A Module is definite if it has no free holes.

stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering #

Compares module names lexically, rather than by their Uniques

The UnitId type

newtype ComponentId #

A ComponentId consists of the package name, package version, component ID, the transitive dependencies of the component, and other information to uniquely identify the source code and build configuration of a component.

This used to be known as an InstalledPackageId, but a package can contain multiple components and a ComponentId uniquely identifies a component within a package. When a package only has one component, the ComponentId coincides with the InstalledPackageId

Constructors

ComponentId FastString 

data UnitId #

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 UnitId. It can be a DefiniteUnitId, in which case we just have a string that uniquely identifies some fully compiled, installed library we have on disk. However, 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 IndefiniteUnitId, which explicitly records the instantiation, so that we can substitute over it.

Instances

Eq UnitId # 

Methods

(==) :: UnitId -> UnitId -> Bool #

(/=) :: UnitId -> UnitId -> Bool #

Data UnitId # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> UnitId -> c UnitId Source #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c UnitId Source #

toConstr :: UnitId -> Constr Source #

dataTypeOf :: UnitId -> DataType Source #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c UnitId) Source #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnitId) Source #

gmapT :: (forall b. Data b => b -> b) -> UnitId -> UnitId Source #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r Source #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnitId -> r Source #

gmapQ :: (forall d. Data d => d -> u) -> UnitId -> [u] Source #

gmapQi :: Int -> (forall d. Data d => d -> u) -> UnitId -> u Source #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> UnitId -> m UnitId Source #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> UnitId -> m UnitId Source #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> UnitId -> m UnitId Source #

Ord UnitId # 
Show UnitId # 
NFData UnitId # 

Methods

rnf :: UnitId -> () Source #

Outputable UnitId # 

Methods

ppr :: UnitId -> SDoc #

pprPrec :: Rational -> UnitId -> SDoc #

Uniquable UnitId # 

Methods

getUnique :: UnitId -> Unique #

Binary UnitId # 

Methods

put_ :: BinHandle -> UnitId -> IO () #

put :: BinHandle -> UnitId -> IO (Bin * UnitId) #

get :: BinHandle -> IO UnitId #

DbUnitIdModuleRep InstalledUnitId ComponentId UnitId ModuleName Module # 

data IndefUnitId #

A unit identifier which identifies an indefinite library (with holes) that has been *on-the-fly* instantiated with a substitution indefUnitIdInsts. In fact, an indefinite unit identifier could have no holes, but we haven't gotten around to compiling the actual library yet.

An indefinite unit identifier pretty-prints to something like p[H=H,A=aimpl:A>] (p is the ComponentId, and the brackets enclose the module substitution).

Constructors

IndefUnitId 

Fields

indefUnitIdToUnitId :: DynFlags -> IndefUnitId -> UnitId #

Injects an IndefUnitId (indefinite library which was on-the-fly instantiated) to a UnitId (either an indefinite or definite library).

newtype InstalledUnitId #

An installed unit identifier identifies a library which has been installed to the package database. These strings 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.) Put another way, an installed unit id is either fully instantiated, or not instantiated at all.

Installed unit identifiers look something like p+af23SAj2dZ219, or maybe just p if they don't use Backpack.

Constructors

InstalledUnitId 

Fields

Instances

Eq InstalledUnitId # 
Ord InstalledUnitId # 
BinaryStringRep InstalledUnitId # 
Outputable InstalledUnitId # 
Uniquable InstalledUnitId # 
Binary InstalledUnitId # 
DbUnitIdModuleRep InstalledUnitId ComponentId UnitId ModuleName Module # 

toInstalledUnitId :: UnitId -> InstalledUnitId #

Lossy conversion to the on-disk InstalledUnitId for a component.

type ShHoleSubst = ModuleNameEnv Module #

Substitution on module variables, mapping module names to module identifiers.

unitIdIsDefinite :: UnitId -> Bool #

A UnitId is definite if it has no free holes.

unitIdFreeHoles :: UnitId -> UniqDSet ModuleName #

Retrieve the set of free holes of a UnitId.

newUnitId :: ComponentId -> [(ModuleName, Module)] -> UnitId #

Create a new, un-hashed unit identifier.

newIndefUnitId :: ComponentId -> [(ModuleName, Module)] -> IndefUnitId #

Create a new IndefUnitId given an explicit module substitution.

newSimpleUnitId :: ComponentId -> UnitId #

Create a new simple unit identifier (no holes) from a ComponentId.

hashUnitId :: ComponentId -> [(ModuleName, Module)] -> FastString #

Generate a uniquely identifying FastString for a unit identifier. This is a one-way function. You can rely on one special property: if a unit identifier is in most general form, its FastString coincides with its ComponentId. This hash is completely internal to GHC and is not used for symbol names or file paths.

fsToUnitId :: FastString -> UnitId #

Create a new simple unit identifier from a FastString. Internally, this is primarily used to specify wired-in unit identifiers.

stableUnitIdCmp :: UnitId -> UnitId -> Ordering #

Compares package ids lexically, rather than by their Uniques

HOLE renaming

renameHoleUnitId :: DynFlags -> ShHoleSubst -> UnitId -> UnitId #

Substitutes holes in a UnitId, suitable for renaming when an include occurs; see Note [Representation of module/name variable].

p[A=A] maps to p[A=B] with A=B.

renameHoleModule :: DynFlags -> ShHoleSubst -> Module -> Module #

Substitutes holes in a Module. NOT suitable for being called directly on a nameModule, see Note [Representation of module/name variable]. p[A=A]:B maps to p[A=q():A]:B with A=q():A; similarly, A maps to q():A.

renameHoleUnitId' :: PackageConfigMap -> ShHoleSubst -> UnitId -> UnitId #

Like 'renameHoleUnitId, but requires only PackageConfigMap so it can be used by Packages.

renameHoleModule' :: PackageConfigMap -> ShHoleSubst -> Module -> Module #

Like renameHoleModule, but requires only PackageConfigMap so it can be used by Packages.

Generalization

splitModuleInsts :: Module -> (InstalledModule, Maybe IndefModule) #

Given a possibly on-the-fly instantiated module, split it into a Module that we definitely can find on-disk, as well as an instantiation if we need to instantiate it on the fly. If the instantiation is Nothing no on-the-fly renaming is needed.

Parsers

Wired-in UnitIds

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, since we don't want to bake the version numbers of these packages into GHC.

So here's the plan. Wired-in packages are still versioned as normal in the packages database, and you can still have multiple versions of them installed. 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 use the unversioned UnitId below when referring to it, 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).

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.

The Module type

data Module #

A Module is a pair of a UnitId and a ModuleName.

Module variables (i.e. H) which can be instantiated to a specific module at some later point in time are represented with moduleUnitId set to holeUnitId (this allows us to avoid having to make moduleUnitId a partial operation.)

Constructors

Module 

Instances

Eq Module # 

Methods

(==) :: Module -> Module -> Bool #

(/=) :: Module -> Module -> Bool #

Data Module # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Module -> c Module Source #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Module Source #

toConstr :: Module -> Constr Source #

dataTypeOf :: Module -> DataType Source #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Module) Source #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Module) Source #

gmapT :: (forall b. Data b => b -> b) -> Module -> Module Source #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r Source #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Module -> r Source #

gmapQ :: (forall d. Data d => d -> u) -> Module -> [u] Source #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Module -> u Source #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Module -> m Module Source #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Module -> m Module Source #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Module -> m Module Source #

Ord Module # 
NFData Module # 

Methods

rnf :: Module -> () Source #

Outputable Module # 

Methods

ppr :: Module -> SDoc #

pprPrec :: Rational -> Module -> SDoc #

Uniquable Module # 

Methods

getUnique :: Module -> Unique #

Binary Module # 

Methods

put_ :: BinHandle -> Module -> IO () #

put :: BinHandle -> Module -> IO (Bin * Module) #

get :: BinHandle -> IO Module #

DbUnitIdModuleRep InstalledUnitId ComponentId UnitId ModuleName Module # 

mkHoleModule :: ModuleName -> Module #

Create a module variable at some ModuleName. See Note [Representation of module/name variables]

stableModuleCmp :: Module -> Module -> Ordering #

This gives a stable ordering, as opposed to the Ord instance which gives an ordering based on the Uniques of the components, which may not be stable from run to run of the compiler.

class HasModule m where #

Minimal complete definition

getModule

Methods

getModule :: m Module #

Instances

class ContainsModule t where #

Minimal complete definition

extractModule

Methods

extractModule :: t -> Module #

Installed unit ids and modules

data InstalledModuleEnv elt #

A map keyed off of InstalledModule

installedModuleEq :: InstalledModule -> Module -> Bool #

Test if a Module corresponds to a given InstalledModule, modulo instantiation.

installedUnitIdEq :: InstalledUnitId -> UnitId -> Bool #

Test if a UnitId corresponds to a given InstalledUnitId, modulo instantiation.

newtype DefUnitId #

A DefUnitId is an InstalledUnitId with the invariant that it only refers to a definite library; i.e., one we have generated code for.

Constructors

DefUnitId 

The ModuleLocation type

data ModLocation #

Module Location

Where a module lives on the file system: the actual locations of the .hs, .hi and .o files, if we have them

addBootSuffix :: FilePath -> FilePath #

Add the -boot suffix to .hs, .hi and .o files

addBootSuffix_maybe :: Bool -> FilePath -> FilePath #

Add the -boot suffix if the Bool argument is True

addBootSuffixLocn :: ModLocation -> ModLocation #

Add the -boot suffix to all file paths associated with the module

Module mappings

data ModuleEnv elt #

A map keyed off of Modules

extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)] -> ModuleEnv a #

plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a #

mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b #

mkModuleEnv :: [(Module, a)] -> ModuleEnv a #

extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a #

ModuleName mappings

type ModuleNameEnv elt = UniqFM elt #

A map keyed off of ModuleNames (actually, their Uniques)

type DModuleNameEnv elt = UniqDFM elt #

A map keyed off of ModuleNames (actually, their Uniques) Has deterministic folds and can be deterministically converted to a list

Sets of Modules

type ModuleSet = Set NDModule #

A set of Modules