ghc-lib-9.4.3.20221104: The GHC API, decoupled from GHC versions
Safe HaskellSafe-Inferred
LanguageHaskell2010

GHC.Plugins

Description

This module is not used by GHC itself. Rather, it exports all of the functions and types you are likely to need when writing a plugin for GHC. So authors of plugins can probably get away simply with saying "import GHC.Plugins".

Particularly interesting modules for plugin writers include GHC.Core and GHC.Core.Opt.Monad.

Synopsis

Documentation

mkDFunOcc #

Arguments

:: String

Typically the class and type glommed together e.g. OrdMaybe. Only used in debug mode, for extra clarity

-> Bool

Is this a hs-boot instance DFun?

-> OccSet

avoid these Occs

-> OccName

E.g. $f3OrdMaybe

mkInstTyTcOcc #

Arguments

:: String

Family name, e.g. Map

-> OccSet

avoid these Occs

-> OccName
R:Map

Derive a name for the representation type constructor of a data/newtype instance.

mkLocalOcc #

Arguments

:: Unique

Unique to combine with the OccName

-> OccName

Local name, e.g. sat

-> OccName

Nice unique version, e.g. $L23sat

mkSuperDictSelOcc #

Arguments

:: Int

Index of superclass, e.g. 3

-> OccName

Class, e.g. Ord

-> OccName

Derived Occname, e.g. $p3Ord

isTypeableBindOcc :: OccName -> Bool #

Is an OccName one of a Typeable TyCon or Module binding? This is needed as these bindings are renamed differently. See Note [Grand plan for Typeable] in GHC.Tc.Instance.Typeable.

isDerivedOccName :: OccName -> Bool #

Test for definitions internally generated by GHC. This predicate is used to suppress printing of internal definitions in some debug prints

startsWithUnderscore :: OccName -> Bool #

Haskell 98 encourages compilers to suppress warnings about unused names in a pattern if they start with _: this implements that test

parenSymOcc :: OccName -> SDoc -> SDoc #

Wrap parens around an operator

isSymOcc :: OccName -> Bool #

Test if the OccName is that for any operator (whether it is a data constructor or variable or whatever)

isDataSymOcc :: OccName -> Bool #

Test if the OccName is a data constructor that starts with a symbol (e.g. :, or [])

isValOcc :: OccName -> Bool #

Value OccNamess are those that are either in the variable or data constructor namespaces

occSetToEnv :: OccSet -> OccEnv OccName #

Converts an OccSet to an OccEnv (operationally the identity)

pprOccEnv :: (a -> SDoc) -> OccEnv a -> SDoc #

minusOccEnv_C :: (a -> b -> Maybe a) -> OccEnv a -> OccEnv b -> OccEnv a #

Alters (replaces or removes) those elements of the map that are mentioned in the second map

alterOccEnv :: (Maybe elt -> Maybe elt) -> OccEnv elt -> OccName -> OccEnv elt #

filterOccEnv :: (elt -> Bool) -> OccEnv elt -> OccEnv elt #

mkOccEnv_C :: (a -> a -> a) -> [(OccName, a)] -> OccEnv a #

mapOccEnv :: (a -> b) -> OccEnv a -> OccEnv b #

extendOccEnv_Acc :: (a -> b -> b) -> (a -> b) -> OccEnv b -> OccName -> a -> OccEnv b #

extendOccEnv_C :: (a -> a -> a) -> OccEnv a -> OccName -> a -> OccEnv a #

plusOccEnv_C :: (a -> a -> a) -> OccEnv a -> OccEnv a -> OccEnv a #

foldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b #

mkOccEnv :: [(OccName, a)] -> OccEnv a #

extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a #

extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a #

unitOccEnv :: OccName -> a -> OccEnv a #

data OccEnv a #

Instances

Instances details
Data a => Data (OccEnv a) 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> OccEnv a -> c (OccEnv a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (OccEnv a) #

toConstr :: OccEnv a -> Constr #

dataTypeOf :: OccEnv a -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (OccEnv a)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (OccEnv a)) #

gmapT :: (forall b. Data b => b -> b) -> OccEnv a -> OccEnv a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OccEnv a -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OccEnv a -> r #

gmapQ :: (forall d. Data d => d -> u) -> OccEnv a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> OccEnv a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a) #

Outputable a => Outputable (OccEnv a) 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

ppr :: OccEnv a -> SDoc #

type FastStringEnv a = UniqFM FastString a #

A non-deterministic set of FastStrings. See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for explanation why it's not deterministic and why it matters. Use DFastStringEnv if the set eventually gets converted into a list or folded over in a way where the order changes the generated code.

data OccName #

Occurrence Name

In this context that means: "classified (i.e. as a type name, value name, etc) but not qualified and not yet resolved"

Instances

Instances details
Data OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

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

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

toConstr :: OccName -> Constr #

dataTypeOf :: OccName -> DataType #

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

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

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

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

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

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

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

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

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

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

NFData OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

rnf :: OccName -> () #

HasOccName OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

occName :: OccName -> OccName #

Uniquable OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

getUnique :: OccName -> Unique #

Binary OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Outputable OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

ppr :: OccName -> SDoc #

OutputableBndr OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Eq OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

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

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

Ord OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

class HasOccName name where #

Other names in the compiler add additional information to an OccName. This class provides a consistent way to access the underlying OccName.

Methods

occName :: name -> OccName #

Instances

Instances details
HasOccName IfaceClassOp 
Instance details

Defined in GHC.Iface.Syntax

HasOccName IfaceConDecl 
Instance details

Defined in GHC.Iface.Syntax

HasOccName IfaceDecl 
Instance details

Defined in GHC.Iface.Syntax

Methods

occName :: IfaceDecl -> OccName #

HasOccName HoleFitCandidate 
Instance details

Defined in GHC.Tc.Errors.Hole.FitTypes

HasOccName TcBinder 
Instance details

Defined in GHC.Tc.Types

Methods

occName :: TcBinder -> OccName #

HasOccName GreName 
Instance details

Defined in GHC.Types.Avail

Methods

occName :: GreName -> OccName #

HasOccName FieldLabel 
Instance details

Defined in GHC.Types.FieldLabel

HasOccName Name 
Instance details

Defined in GHC.Types.Name

Methods

occName :: Name -> OccName #

HasOccName OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

occName :: OccName -> OccName #

HasOccName GlobalRdrElt 
Instance details

Defined in GHC.Types.Name.Reader

HasOccName RdrName 
Instance details

Defined in GHC.Types.Name.Reader

Methods

occName :: RdrName -> OccName #

HasOccName Var 
Instance details

Defined in GHC.Types.Var

Methods

occName :: Var -> OccName #

HasOccName name => HasOccName (IEWrappedName name) 
Instance details

Defined in GHC.Hs.ImpExp

Methods

occName :: IEWrappedName name -> OccName #

nameStableString :: Name -> String #

Get a string representation of a Name that's unique and stable across recompilations. Used for deterministic generation of binds for derived instances. eg. "$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal$String"

pprNameUnqualified :: Name -> SDoc #

Print the string of Name unqualifiedly directly.

pprTickyName :: Module -> Name -> SDoc #

Print a ticky ticky styled name

Module argument is the module to use for internal and system names. When printing the name in a ticky profile, the module name is included even for local things. However, ticky uses the format "x (M)" rather than "M.x". Hence, this function provides a separation from normal styling.

pprFullName :: Module -> Name -> SDoc #

Print fully qualified name (with unit-id, module and unique)

stableNameCmp :: Name -> Name -> Ordering #

Compare Names lexicographically This only works for Names that originate in the source code or have been tidied.

localiseName :: Name -> Name #

Make the Name into an internal name, regardless of what it was to begin with

mkFCallName :: Unique -> String -> Name #

Make a name for a foreign call

mkSystemName :: Unique -> OccName -> Name #

Create a name brought into being by the compiler

mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name #

Create a name which is actually defined by the compiler itself

mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name #

Create a name which definitely originates in the given module

mkInternalName :: Unique -> OccName -> SrcSpan -> Name #

Create a name which is (for now at least) local to the current module and hence does not need a GenModule to disambiguate it from other Names

nameIsFromExternalPackage :: HomeUnit -> Name -> Bool #

Returns True if the Name comes from some other package: neither this package nor the interactive package.

nameIsExternalOrFrom :: Module -> Name -> Bool #

Returns True if the name is external or from the interactive package See documentation of nameIsLocalOrFrom function

nameIsLocalOrFrom :: Module -> Name -> Bool #

Returns True if the name is (a) Internal (b) External but from the specified module (c) External but from the interactive package

The key idea is that False means: the entity is defined in some other module you can find the details (type, fixity, instances) in some interface file those details will be stored in the EPT or HPT

True means: the entity is defined in this module or earlier in the GHCi session you can find details (type, fixity, instances) in the TcGblEnv or TcLclEnv

The isInteractiveModule part is because successive interactions of a GHCi session each give rise to a fresh module (Ghci1, Ghci2, etc), but they all come from the magic interactive package; and all the details are kept in the TcLclEnv, TcGblEnv, NOT in the HPT or EPT. See Note [The interactive package] in GHC.Runtime.Context

isDynLinkName :: Platform -> Module -> Name -> Bool #

Will the Name come from a dynamically linked package?

isWiredIn :: NamedThing thing => thing -> Bool #

data BuiltInSyntax #

BuiltInSyntax is for things like (:), [] and tuples, which have special syntactic forms. They aren't in scope as such.

Constructors

BuiltInSyntax 
UserSyntax 

mkDFunOcc #

Arguments

:: String

Typically the class and type glommed together e.g. OrdMaybe. Only used in debug mode, for extra clarity

-> Bool

Is this a hs-boot instance DFun?

-> OccSet

avoid these Occs

-> OccName

E.g. $f3OrdMaybe

mkInstTyTcOcc #

Arguments

:: String

Family name, e.g. Map

-> OccSet

avoid these Occs

-> OccName
R:Map

Derive a name for the representation type constructor of a data/newtype instance.

mkLocalOcc #

Arguments

:: Unique

Unique to combine with the OccName

-> OccName

Local name, e.g. sat

-> OccName

Nice unique version, e.g. $L23sat

mkSuperDictSelOcc #

Arguments

:: Int

Index of superclass, e.g. 3

-> OccName

Class, e.g. Ord

-> OccName

Derived Occname, e.g. $p3Ord

isTypeableBindOcc :: OccName -> Bool #

Is an OccName one of a Typeable TyCon or Module binding? This is needed as these bindings are renamed differently. See Note [Grand plan for Typeable] in GHC.Tc.Instance.Typeable.

isDerivedOccName :: OccName -> Bool #

Test for definitions internally generated by GHC. This predicate is used to suppress printing of internal definitions in some debug prints

startsWithUnderscore :: OccName -> Bool #

Haskell 98 encourages compilers to suppress warnings about unused names in a pattern if they start with _: this implements that test

parenSymOcc :: OccName -> SDoc -> SDoc #

Wrap parens around an operator

isSymOcc :: OccName -> Bool #

Test if the OccName is that for any operator (whether it is a data constructor or variable or whatever)

isDataSymOcc :: OccName -> Bool #

Test if the OccName is a data constructor that starts with a symbol (e.g. :, or [])

isValOcc :: OccName -> Bool #

Value OccNamess are those that are either in the variable or data constructor namespaces

occSetToEnv :: OccSet -> OccEnv OccName #

Converts an OccSet to an OccEnv (operationally the identity)

pprOccEnv :: (a -> SDoc) -> OccEnv a -> SDoc #

minusOccEnv_C :: (a -> b -> Maybe a) -> OccEnv a -> OccEnv b -> OccEnv a #

Alters (replaces or removes) those elements of the map that are mentioned in the second map

alterOccEnv :: (Maybe elt -> Maybe elt) -> OccEnv elt -> OccName -> OccEnv elt #

filterOccEnv :: (elt -> Bool) -> OccEnv elt -> OccEnv elt #

mkOccEnv_C :: (a -> a -> a) -> [(OccName, a)] -> OccEnv a #

mapOccEnv :: (a -> b) -> OccEnv a -> OccEnv b #

extendOccEnv_Acc :: (a -> b -> b) -> (a -> b) -> OccEnv b -> OccName -> a -> OccEnv b #

extendOccEnv_C :: (a -> a -> a) -> OccEnv a -> OccName -> a -> OccEnv a #

plusOccEnv_C :: (a -> a -> a) -> OccEnv a -> OccEnv a -> OccEnv a #

foldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b #

mkOccEnv :: [(OccName, a)] -> OccEnv a #

extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a #

extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a #

unitOccEnv :: OccName -> a -> OccEnv a #

data OccEnv a #

Instances

Instances details
Data a => Data (OccEnv a) 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> OccEnv a -> c (OccEnv a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (OccEnv a) #

toConstr :: OccEnv a -> Constr #

dataTypeOf :: OccEnv a -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (OccEnv a)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (OccEnv a)) #

gmapT :: (forall b. Data b => b -> b) -> OccEnv a -> OccEnv a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OccEnv a -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OccEnv a -> r #

gmapQ :: (forall d. Data d => d -> u) -> OccEnv a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> OccEnv a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> OccEnv a -> m (OccEnv a) #

Outputable a => Outputable (OccEnv a) 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

ppr :: OccEnv a -> SDoc #

type FastStringEnv a = UniqFM FastString a #

A non-deterministic set of FastStrings. See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for explanation why it's not deterministic and why it matters. Use DFastStringEnv if the set eventually gets converted into a list or folded over in a way where the order changes the generated code.

data Name #

A unique, unambiguous name for something, containing information about where that thing originated.

Instances

Instances details
Data Name 
Instance details

Defined in GHC.Types.Name

Methods

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

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

toConstr :: Name -> Constr #

dataTypeOf :: Name -> DataType #

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

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

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

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

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

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

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

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

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

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

NFData Name 
Instance details

Defined in GHC.Types.Name

Methods

rnf :: Name -> () #

NamedThing Name 
Instance details

Defined in GHC.Types.Name

HasOccName Name 
Instance details

Defined in GHC.Types.Name

Methods

occName :: Name -> OccName #

Uniquable Name 
Instance details

Defined in GHC.Types.Name

Methods

getUnique :: Name -> Unique #

Binary Name

Assumes that the Name is a non-binding one. See putIfaceTopBndr and getIfaceTopBndr for serializing binding Names. See UserData for the rationale for this distinction.

Instance details

Defined in GHC.Types.Name

Methods

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

put :: BinHandle -> Name -> IO (Bin Name) #

get :: BinHandle -> IO Name #

Outputable Name 
Instance details

Defined in GHC.Types.Name

Methods

ppr :: Name -> SDoc #

OutputableBndr Name 
Instance details

Defined in GHC.Types.Name

Eq Name

The same comments as for Name's Ord instance apply.

Instance details

Defined in GHC.Types.Name

Methods

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

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

Ord Name

Caution: This instance is implemented via nonDetCmpUnique, which means that the ordering is not stable across deserialization or rebuilds.

See nonDetCmpUnique for further information, and trac #15240 for a bug caused by improper use of this instance.

Instance details

Defined in GHC.Types.Name

Methods

compare :: Name -> Name -> Ordering #

(<) :: Name -> Name -> Bool #

(<=) :: Name -> Name -> Bool #

(>) :: Name -> Name -> Bool #

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

max :: Name -> Name -> Name #

min :: Name -> Name -> Name #

type Anno Name 
Instance details

Defined in GHC.Hs.Extension

type Anno (LocatedN Name) 
Instance details

Defined in GHC.Hs.Binds

type Anno [LocatedN Name] 
Instance details

Defined in GHC.Hs.Binds

class NamedThing a where #

A class allowing convenient access to the Name of various datatypes

Minimal complete definition

getName

Methods

getOccName :: a -> OccName #

getName :: a -> Name #

Instances

Instances details
NamedThing Class 
Instance details

Defined in GHC.Core.Class

NamedThing ConLike 
Instance details

Defined in GHC.Core.ConLike

NamedThing DataCon 
Instance details

Defined in GHC.Core.DataCon

NamedThing FamInst 
Instance details

Defined in GHC.Core.FamInstEnv

NamedThing ClsInst 
Instance details

Defined in GHC.Core.InstEnv

NamedThing PatSyn 
Instance details

Defined in GHC.Core.PatSyn

NamedThing TyCon 
Instance details

Defined in GHC.Core.TyCon

NamedThing IfaceClassOp 
Instance details

Defined in GHC.Iface.Syntax

NamedThing IfaceConDecl 
Instance details

Defined in GHC.Iface.Syntax

NamedThing IfaceDecl 
Instance details

Defined in GHC.Iface.Syntax

NamedThing HoleFitCandidate 
Instance details

Defined in GHC.Tc.Errors.Hole.FitTypes

NamedThing Name 
Instance details

Defined in GHC.Types.Name

NamedThing TyThing 
Instance details

Defined in GHC.Types.TyThing

NamedThing Var 
Instance details

Defined in GHC.Types.Var

Methods

getOccName :: Var -> OccName #

getName :: Var -> Name #

NamedThing (CoAxiom br) 
Instance details

Defined in GHC.Core.Coercion.Axiom

Methods

getOccName :: CoAxiom br -> OccName #

getName :: CoAxiom br -> Name #

NamedThing e => NamedThing (Located e) 
Instance details

Defined in GHC.Types.Name

NamedThing (Located a) => NamedThing (LocatedAn an a) 
Instance details

Defined in GHC.Parser.Annotation

Methods

getOccName :: LocatedAn an a -> OccName #

getName :: LocatedAn an a -> Name #

NamedThing tv => NamedThing (VarBndr tv flag) 
Instance details

Defined in GHC.Types.Var

Methods

getOccName :: VarBndr tv flag -> OccName #

getName :: VarBndr tv flag -> Name #

data OccName #

Occurrence Name

In this context that means: "classified (i.e. as a type name, value name, etc) but not qualified and not yet resolved"

Instances

Instances details
Data OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

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

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

toConstr :: OccName -> Constr #

dataTypeOf :: OccName -> DataType #

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

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

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

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

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

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

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

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

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

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

NFData OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

rnf :: OccName -> () #

HasOccName OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

occName :: OccName -> OccName #

Uniquable OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

getUnique :: OccName -> Unique #

Binary OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Outputable OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

ppr :: OccName -> SDoc #

OutputableBndr OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Eq OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

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

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

Ord OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

class HasOccName name where #

Other names in the compiler add additional information to an OccName. This class provides a consistent way to access the underlying OccName.

Methods

occName :: name -> OccName #

Instances

Instances details
HasOccName IfaceClassOp 
Instance details

Defined in GHC.Iface.Syntax

HasOccName IfaceConDecl 
Instance details

Defined in GHC.Iface.Syntax

HasOccName IfaceDecl 
Instance details

Defined in GHC.Iface.Syntax

Methods

occName :: IfaceDecl -> OccName #

HasOccName HoleFitCandidate 
Instance details

Defined in GHC.Tc.Errors.Hole.FitTypes

HasOccName TcBinder 
Instance details

Defined in GHC.Tc.Types

Methods

occName :: TcBinder -> OccName #

HasOccName GreName 
Instance details

Defined in GHC.Types.Avail

Methods

occName :: GreName -> OccName #

HasOccName FieldLabel 
Instance details

Defined in GHC.Types.FieldLabel

HasOccName Name 
Instance details

Defined in GHC.Types.Name

Methods

occName :: Name -> OccName #

HasOccName OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

occName :: OccName -> OccName #

HasOccName GlobalRdrElt 
Instance details

Defined in GHC.Types.Name.Reader

HasOccName RdrName 
Instance details

Defined in GHC.Types.Name.Reader

Methods

occName :: RdrName -> OccName #

HasOccName Var 
Instance details

Defined in GHC.Types.Var

Methods

occName :: Var -> OccName #

HasOccName name => HasOccName (IEWrappedName name) 
Instance details

Defined in GHC.Hs.ImpExp

Methods

occName :: IEWrappedName name -> OccName #

transferPolyIdInfo :: Id -> [Var] -> Id -> Id #

setIdOneShotInfo :: Id -> OneShotInfo -> Id infixl 1 #

stateHackOneShot :: OneShotInfo #

Should we apply the state hack to values of this Type?

isOneShotBndr :: Var -> Bool #

Returns whether the lambda associated with the Id is certainly applied at most once This one is the "business end", called externally. It works on type variables as well as Ids, returning True Its main purpose is to encapsulate the Horrible State Hack See Note [The state-transformer hack] in GHC.Core.Opt.Arity

idStateHackOneShotInfo :: Id -> OneShotInfo #

Like idOneShotInfo, but taking the Horrible State Hack in to account See Note [The state-transformer hack] in GHC.Core.Opt.Arity

setInlinePragma :: Id -> InlinePragma -> Id infixl 1 #

setIdOccInfo :: Id -> OccInfo -> Id infixl 1 #

idCafInfo :: Id -> CafInfo infixl 1 #

setIdSpecialisation :: Id -> RuleInfo -> Id infixl 1 #

zapIdUnfolding :: Id -> Id #

Similar to trimUnfolding, but also removes evaldness info.

asWorkerLikeId :: Id -> Id #

Turn this id into a WorkerLikeId if possible.

asNonWorkerLikeId :: Id -> Id #

Remove any cbv marks on arguments from a given Id.

setIdCbvMarks :: Id -> [CbvMark] -> Id infixl 1 #

If all marks are NotMarkedStrict we just set nothing.

setIdDemandInfo :: Id -> Demand -> Id infixl 1 #

setIdUnfolding :: Id -> Unfolding -> Id infixl 1 #

realIdUnfolding :: Id -> Unfolding #

Expose the unfolding if there is one, including for loop breakers

idUnfolding :: Id -> Unfolding #

Returns the Ids unfolding, but does not expose the unfolding of a strong loop breaker. See unfoldingInfo.

If you really want the unfolding of a strong loopbreaker, call realIdUnfolding.

isStrictId :: Id -> Bool #

This predicate says whether the Id has a strict demand placed on it or has a type such that it can always be evaluated strictly (i.e an unlifted type, as of GHC 7.6). We need to check separately whether the Id has a so-called "strict type" because if the demand for the given id hasn't been computed yet but id has a strict type, we still want isStrictId id to be True.

setIdCprSig :: Id -> CprSig -> Id infixl 1 #

setIdDmdSig :: Id -> DmdSig -> Id infixl 1 #

idDmdSig :: Id -> DmdSig #

Accesses the Id's dmdSigInfo.

isDeadEndId :: Var -> Bool #

Returns true if an application to n args diverges or throws an exception See Note [Dead ends] in GHC.Types.Demand.

setIdCallArity :: Id -> Arity -> Id infixl 1 #

setIdArity :: Id -> Arity -> Id infixl 1 #

asJoinId_maybe :: Id -> Maybe JoinArity -> Id infixl 1 #

asJoinId :: Id -> JoinArity -> JoinId infixl 1 #

isImplicitId :: Id -> Bool #

isImplicitId tells whether an Ids info is implied by other declarations, so we don't need to put its signature in an interface file, even if it's mentioned in some other interface unfolding.

hasNoBinding :: Id -> Bool #

Returns True of an Id which may not have a binding, even though it is defined in this module.

idDataCon :: Id -> DataCon #

Get from either the worker or the wrapper Id to the DataCon. Currently used only in the desugarer.

INVARIANT: idDataCon (dataConWrapId d) = d: remember, dataConWrapId can return either the wrapper or the worker

isJoinId_maybe :: Var -> Maybe JoinArity #

Doesn't return strictness marks

isWorkerLikeId :: Id -> Bool #

An Id for which we might require all callers to pass strict arguments properly tagged + evaluated.

See Note [CBV Function Ids]

recordSelectorTyCon :: Id -> RecSelParent #

If the Id is that for a record selector, extract the sel_tycon. Panic otherwise.

mkTemplateLocalsNum :: Int -> [Type] -> [Id] #

Create a template local for a series of type, but start from a specified template local

mkTemplateLocals :: [Type] -> [Id] #

Create a template local for a series of types

mkTemplateLocal :: Int -> Type -> Id #

Create a template local: a family of system local Ids in bijection with Ints, typically used in unfoldings

mkWorkerId :: Unique -> Id -> Type -> Id #

Workers get local names. CoreTidy will externalise these if necessary

mkUserLocalOrCoVar :: OccName -> Unique -> Mult -> Type -> SrcSpan -> Id #

Like mkUserLocal, but checks if we have a coercion type

mkUserLocal :: OccName -> Unique -> Mult -> Type -> SrcSpan -> Id #

Create a user local Id. These are local Ids (see GHC.Types.Var) with a name and location that the user might recognize

mkSysLocalOrCoVar :: FastString -> Unique -> Mult -> Type -> Id #

Like mkSysLocal, but checks to see if we have a covar type

mkSysLocal :: FastString -> Unique -> Mult -> Type -> Id #

Create a system local Id. These are local Ids (see Var) that are created by the compiler out of thin air

mkExportedLocalId :: IdDetails -> Name -> Type -> Id #

Create a local Id that is marked as exported. This prevents things attached to it from being removed as dead code. See Note [Exported LocalIds]

mkLocalIdOrCoVar :: Name -> Mult -> Type -> Id #

Like mkLocalId, but checks the type to see if it should make a covar

mkLocalCoVar :: Name -> Type -> CoVar #

Make a local CoVar

mkLocalId :: HasDebugCallStack => Name -> Mult -> Type -> Id #

For an explanation of global vs. local Ids, see GHC.Types.Var

mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id #

Make a global Id with no global information but some generic IdInfo

mkVanillaGlobal :: Name -> Type -> Id #

Make a global Id without any extra information at all

mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id #

For an explanation of global vs. local Ids, see GHC.Types.Var.Var

setIdType :: Id -> Type -> Id #

Not only does this set the Id Type, it also evaluates the type to try and reduce space usage

setIdName :: Id -> Name -> Id #

scaleVarBy :: Mult -> Var -> Var #

Like scaleIdBy, but skips non-Ids. Useful for scaling a mixed list of ids and tyvars.

scaleIdBy :: Mult -> Id -> Id #

idMult :: Id -> Mult #

idType :: Id -> Kind #

isExportedId :: Var -> Bool #

isExportedIdVar means "don't throw this away"

isId :: Var -> Bool #

Is this a value-level (i.e., computationally relevant) Varentifier? Satisfies isId = not . isTyVar.

setIdMult :: Id -> Mult -> Id #

updateIdTypeAndMultM :: Monad m => (Type -> m Type) -> Id -> m Id #

globaliseId :: Id -> Id #

If it's a local, make it global

type JoinId = Id #

type InVar = Var #

type InId = Id #

type OutVar = Var #

type OutId = Id #

idName :: Id -> Name #

data Var #

Variable

Essentially a typed Name, that may also contain some additional information about the Var and its use sites.

Instances

Instances details
Data Var 
Instance details

Defined in GHC.Types.Var

Methods

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

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

toConstr :: Var -> Constr #

dataTypeOf :: Var -> DataType #

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

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

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

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

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

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

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

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

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

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

NamedThing Var 
Instance details

Defined in GHC.Types.Var

Methods

getOccName :: Var -> OccName #

getName :: Var -> Name #

HasOccName Var 
Instance details

Defined in GHC.Types.Var

Methods

occName :: Var -> OccName #

Uniquable Var 
Instance details

Defined in GHC.Types.Var

Methods

getUnique :: Var -> Unique #

Outputable Var 
Instance details

Defined in GHC.Types.Var

Methods

ppr :: Var -> SDoc #

Eq Var 
Instance details

Defined in GHC.Types.Var

Methods

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

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

Ord Var 
Instance details

Defined in GHC.Types.Var

Methods

compare :: Var -> Var -> Ordering #

(<) :: Var -> Var -> Bool #

(<=) :: Var -> Var -> Bool #

(>) :: Var -> Var -> Bool #

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

max :: Var -> Var -> Var #

min :: Var -> Var -> Var #

Eq (DeBruijn Var) 
Instance details

Defined in GHC.Core.Map.Type

OutputableBndr (Id, TagSig) 
Instance details

Defined in GHC.Stg.InferTags.TagSig

type Anno Id 
Instance details

Defined in GHC.Hs.Extension

type Anno (LocatedN Id) 
Instance details

Defined in GHC.Hs.Binds

type Anno [LocatedN Id] 
Instance details

Defined in GHC.Hs.Binds

type Id = Var #

Identifier

module GHC.Core

substRuleInfo :: Subst -> Id -> RuleInfo -> RuleInfo #

Substitutes for the Ids within the RuleInfo given the new function Id

substUnfolding :: Subst -> Unfolding -> Unfolding #

Substitutes for the Ids within an unfolding NB: substUnfolding discards any unfolding without without a Stable source. This is usually what we want, but it may be a bit unexpected

substUnfoldingSC :: Subst -> Unfolding -> Unfolding #

Substitutes for the Ids within an unfolding NB: substUnfolding discards any unfolding without without a Stable source. This is usually what we want, but it may be a bit unexpected

substIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo #

Substitute into some IdInfo with regard to the supplied new Id.

cloneRecIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id]) #

Clone a mutually recursive group of Ids

cloneBndrs :: Subst -> UniqSupply -> [Var] -> (Subst, [Var]) #

cloneIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id]) #

Applies cloneIdBndr to a number of Ids, accumulating a final substitution from left to right

cloneIdBndr :: Subst -> UniqSupply -> Id -> (Subst, Id) #

Very similar to substBndr, but it always allocates a new Unique for each variable in its output. It substitutes the IdInfo though.

substRecBndrs :: Subst -> [Id] -> (Subst, [Id]) #

Substitute in a mutually recursive group of Ids

substBndrs :: Subst -> [Var] -> (Subst, [Var]) #

Applies substBndr to a number of Exprs, accumulating a new Subst left-to-right

substBndr :: Subst -> Var -> (Subst, Var) #

Substitutes a Expr for another one according to the Subst given, returning the result and an updated Subst that should be used by subsequent substitutions. IdInfo is preserved by this process, although it is substituted into appropriately.

deShadowBinds :: CoreProgram -> CoreProgram #

De-shadowing the program is sometimes a useful pre-pass. It can be done simply by running over the bindings with an empty substitution, because substitution returns a result that has no-shadowing guaranteed.

(Actually, within a single type there might still be shadowing, because substTy is a no-op for the empty substitution, but that's probably OK.)

Aug 09
This function is not used in GHC at the moment, but seems so short and simple that I'm going to leave it here

substBind :: HasDebugCallStack => Subst -> CoreBind -> (Subst, CoreBind) #

Apply a substitution to an entire CoreBind, additionally returning an updated Subst that should be used by subsequent substitutions.

substBindSC :: HasDebugCallStack => Subst -> CoreBind -> (Subst, CoreBind) #

Apply a substitution to an entire CoreBind, additionally returning an updated Subst that should be used by subsequent substitutions.

substExpr :: HasDebugCallStack => Subst -> CoreExpr -> CoreExpr #

substExpr applies a substitution to an entire CoreExpr. Remember, you may only apply the substitution once: See Note [Substitutions apply only once] in GHC.Core.TyCo.Subst

Do *not* attempt to short-cut in the case of an empty substitution! See Note [Extending the Subst]

extendInScopeIds :: Subst -> [Id] -> Subst #

Optimized version of extendInScopeList that can be used if you are certain all the things being added are Ids and hence none are TyVars or CoVars

extendInScopeList :: Subst -> [Var] -> Subst #

Add the Exprs to the in-scope set: see also extendInScope

extendInScope :: Subst -> Var -> Subst #

Add the Expr to the in-scope set: as a side effect, and remove any existing substitutions for it

mkOpenSubst :: InScopeSet -> [(Var, CoreArg)] -> Subst #

Simultaneously substitute for a bunch of variables No left-right shadowing ie the substitution for (x y. e) a1 a2 so neither x nor y scope over a1 a2

delBndrs :: Subst -> [Var] -> Subst #

lookupIdSubst :: HasDebugCallStack => Subst -> Id -> CoreExpr #

Find the substitution for an Id in the Subst

extendSubstList :: Subst -> [(Var, CoreArg)] -> Subst #

Add a substitution as appropriate to each of the terms being substituted (whether expressions, types, or coercions). See also extendSubst.

extendSubst :: Subst -> Var -> CoreArg -> Subst #

Add a substitution appropriate to the thing being substituted (whether an expression, type, or coercion). See also extendIdSubst, extendTvSubst, extendCvSubst

extendTvSubstList :: Subst -> [(TyVar, Type)] -> Subst #

Adds multiple TyVar substitutions to the Subst: see also extendTvSubst

extendTvSubst :: Subst -> TyVar -> Type -> Subst #

Add a substitution for a TyVar to the Subst The TyVar *must* be a real TyVar, and not a CoVar You must ensure that the in-scope set is such that GHC.Core.TyCo.Subst Note [The substitution invariant] holds after extending the substitution like this.

extendIdSubstList :: Subst -> [(Id, CoreExpr)] -> Subst #

Adds multiple Id substitutions to the Subst: see also extendIdSubst

extendIdSubst :: Subst -> Id -> CoreExpr -> Subst #

Add a substitution for an Id to the Subst: you must ensure that the in-scope set is such that TyCoSubst Note [The substitution invariant] holds after extending the substitution like this

zapSubstEnv :: Subst -> Subst #

Remove all substitutions for Ids and Exprs that might have been built up while preserving the in-scope set

substInScope :: Subst -> InScopeSet #

Find the in-scope set: see GHC.Core.TyCo.Subst Note [The substitution invariant]

data Subst #

A substitution environment, containing Id, TyVar, and CoVar substitutions.

Some invariants apply to how you use the substitution:

  1. Note [The substitution invariant] in GHC.Core.TyCo.Subst
  2. Note [Substitutions apply only once] in GHC.Core.TyCo.Subst

Instances

Instances details
Outputable Subst 
Instance details

Defined in GHC.Core.Subst

Methods

ppr :: Subst -> SDoc #

type IdSubstEnv = IdEnv CoreExpr #

An environment for substituting for Ids

type TvSubstEnv = TyVarEnv Type #

A substitution of Types for TyVars and Kinds for KindVars

data InScopeSet #

A set of variables that are in scope at some point.

Note that this is a superset of the variables that are currently in scope. See Note [The InScopeSet invariant].

"Secrets of the Glasgow Haskell Compiler inliner" Section 3.2 provides the motivation for this abstraction.

Instances

Instances details
Outputable InScopeSet 
Instance details

Defined in GHC.Types.Var.Env

Methods

ppr :: InScopeSet -> SDoc #

isLinearType :: Type -> Bool #

isLinear t returns True of a if t is a type of (curried) function where at least one argument is linear (or otherwise non-unrestricted). We use this function to check whether it is safe to eta reduce an Id in CorePrep. It is always safe to return True, because True deactivates the optimisation.

scaledSet :: Scaled a -> b -> Scaled b #

mkScaled :: Mult -> a -> Scaled a #

tymult :: a -> Scaled a #

Scale a payload by Many; used for type arguments in core

linear :: a -> Scaled a #

Scale a payload by One

unrestricted :: a -> Scaled a #

Scale a payload by Many

tyConAppNeedsKindSig #

Arguments

:: Bool

Should specified binders count towards injective positions in the kind of the TyCon? (If you're using visible kind applications, then you want True here.

-> TyCon 
-> Int

The number of args the TyCon is applied to.

-> Bool

Does T t_1 ... t_n need a kind signature? (Where n is the number of arguments)

Does a TyCon (that is applied to some number of arguments) need to be ascribed with an explicit kind signature to resolve ambiguity if rendered as a source-syntax type? (See Note [When does a tycon application need an explicit kind signature?] for a full explanation of what this function checks for.)

classifiesTypeWithValues :: Kind -> Bool #

Does this classify a type allowed to have values? Responds True to things like *, TYPE Lifted, TYPE IntRep, TYPE v, Constraint.

True of any sub-kind of OpenTypeKind

isConcrete :: Type -> Bool #

Tests whether the given type is concrete, i.e. it whether it consists only of concrete type constructors, concrete type variables, and applications.

See Note [Concrete types] in GHC.Tc.Utils.Concrete.

isFixedRuntimeRepKind :: HasDebugCallStack => Kind -> Bool #

Checks that a kind of the form Type, Constraint or 'TYPE r is concrete. See isConcrete.

Precondition: The type has kind (TYPE blah).

splitVisVarsOfType :: Type -> Pair TyCoVarSet #

Retrieve the free variables in this type, splitting them based on whether they are used visibly or invisibly. Invisible ones come first.

tyConsOfType :: Type -> UniqSet TyCon #

All type constructors occurring in the type; looking through type synonyms, but not newtypes. When it finds a Class, it returns the class TyCon.

resultHasFixedRuntimeRep :: Type -> Bool #

Looking past all pi-types, does the end result have a fixed runtime rep, as per Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete?

Examples:

  • False for (forall r (a :: TYPE r). String -> a)
  • True for (forall r1 r2 (a :: TYPE r1) (b :: TYPE r2). a -> b -> Type)

typeHasFixedRuntimeRep :: Type -> Bool #

Returns True if a type has a syntactically fixed runtime rep, as per Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete.

This function is equivalent to (isFixedRuntimeRepKind . typeKind), but much faster.

Precondition: The type has kind (TYPE blah)

tcIsRuntimeTypeKind :: Kind -> Bool #

Is this kind equivalent to TYPE r (for some unknown r)?

This considers Constraint to be distinct from *.

tcIsBoxedTypeKind :: Kind -> Bool #

Is this kind equivalent to TYPE (BoxedRep l) for some l :: Levity?

This considers Constraint to be distinct from Type. For a version that treats them as the same type, see isLiftedTypeKind.

tcIsLiftedTypeKind :: Kind -> Bool #

Is this kind equivalent to Type?

This considers Constraint to be distinct from Type. For a version that treats them as the same type, see isLiftedTypeKind.

nonDetCmpTc :: TyCon -> TyCon -> Ordering #

Compare two TyCons. NB: This should never see Constraint (as recognized by Kind.isConstraintKindCon) which is considered a synonym for Type in Core. See Note [Kind Constraint and kind Type] in GHC.Core.Type. See Note [nonDetCmpType nondeterminism]

eqTypes :: [Type] -> [Type] -> Bool #

Type equality on lists of types, looking through type synonyms but not newtypes.

eqTypeX :: RnEnv2 -> Type -> Type -> Bool #

Compare types with respect to a (presumably) non-empty RnEnv2.

eqType :: Type -> Type -> Bool #

Type equality on source types. Does not look through newtypes, PredTypes or type families, but it does look through type synonyms. This first checks that the kinds of the types are equal and then checks whether the types are equal, ignoring casts and coercions. (The kind check is a recursive call, but since all kinds have type Type, there is no need to check the types of kinds.) See also Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep.

seqTypes :: [Type] -> () #

seqType :: Type -> () #

isValidJoinPointType :: JoinArity -> Type -> Bool #

Determine whether a type could be the type of a join point of given total arity, according to the polymorphism rule. A join point cannot be polymorphic in its return type, since given join j a b x y z = e1 in e2, the types of e1 and e2 must be the same, and a and b are not in scope for e2. (See Note [The polymorphism rule of join points] in GHC.Core.) Returns False also if the type simply doesn't have enough arguments.

Note that we need to know how many arguments (type *and* value) the putative join point takes; for instance, if j :: forall a. a -> Int then j could be a binary join point returning an Int, but it could *not* be a unary join point returning a -> Int.

TODO: See Note [Excess polymorphism and join points]

isPrimitiveType :: Type -> Bool #

Returns true of types that are opaque to Haskell.

isStrictType :: HasDebugCallStack => Type -> Bool #

Computes whether an argument (or let right hand side) should be computed strictly or lazily, based only on its type. Currently, it's just isUnliftedType. Panics on representation-polymorphic types.

isDataFamilyAppType :: Type -> Bool #

Check whether a type is a data family type

isAlgType :: Type -> Bool #

See Type for what an algebraic type is. Should only be applied to types, as opposed to e.g. partially saturated type constructors

getLevity_maybe :: HasDebugCallStack => Type -> Maybe Type #

Extract the Levity of a type. For example, getLevity_maybe Int = Just Lifted, getLevity (Array# Int) = Just Unlifted, getLevity Float# = Nothing.

Returns Nothing if this is not possible. Does not look through type family applications.

getRuntimeRep :: HasDebugCallStack => Type -> Type #

Extract the RuntimeRep classifier of a type. For instance, getRuntimeRep_maybe Int = LiftedRep. Panics if this is not possible.

getRuntimeRep_maybe :: HasDebugCallStack => Type -> Maybe Type #

Extract the RuntimeRep classifier of a type. For instance, getRuntimeRep_maybe Int = Just LiftedRep. Returns Nothing if this is not possible.

dropRuntimeRepArgs :: [Type] -> [Type] #

Drops prefix of RuntimeRep constructors in TyConApps. Useful for e.g. dropping 'LiftedRep arguments of unboxed tuple TyCon applications:

dropRuntimeRepArgs [ 'LiftedRep, 'IntRep , String, Int# ] == [String, Int#]

isRuntimeRepKindedTy :: Type -> Bool #

Is this a type of kind RuntimeRep? (e.g. LiftedRep)

isBoxedType :: Type -> Bool #

See Type for what a boxed type is. Panics on representation-polymorphic types; See mightBeUnliftedType for a more approximate predicate that behaves better in the presence of representation polymorphism.

mightBeUnliftedType :: Type -> Bool #

Returns:

  • False if the type is guaranteed lifted or
  • True if it is unlifted, OR we aren't sure (e.g. in a representation-polymorphic case)

mightBeLiftedType :: Type -> Bool #

Returns:

  • False if the type is guaranteed unlifted or
  • True if it lifted, OR we aren't sure (e.g. in a representation-polymorphic case)

isStateType :: Type -> Bool #

State token type.

isUnliftedType :: HasDebugCallStack => Type -> Bool #

Is the given type definitely unlifted? See Type for what an unlifted type is.

Panics on representation-polymorphic types; See mightBeUnliftedType for a more approximate predicate that behaves better in the presence of representation polymorphism.

typeLevity_maybe :: HasDebugCallStack => Type -> Maybe Levity #

Tries to compute the Levity of the given type. Returns either a definite Levity, or Nothing if we aren't sure (e.g. the type is representation-polymorphic).

Panics if the kind does not have the shape TYPE r.

buildSynTyCon #

Arguments

:: Name 
-> [KnotTied TyConBinder] 
-> Kind

result kind

-> [Role] 
-> KnotTied Type 
-> TyCon 

isCoVarType :: Type -> Bool #

Does this type classify a core (unlifted) Coercion? At either role nominal or representational (t1 ~# t2) or (t1 ~R# t2) See Note [Types for coercions, predicates, and evidence] in GHC.Core.TyCo.Rep

coAxNthLHS :: forall (br :: BranchFlag). CoAxiom br -> Int -> Type #

Get the type on the LHS of a coercion induced by a type/data family instance.

mkFamilyTyConApp :: TyCon -> [Type] -> Type #

Given a family instance TyCon and its arg types, return the corresponding family type. E.g:

data family T a
data instance T (Maybe b) = MkT b

Where the instance tycon is :RTL, so:

mkFamilyTyConApp :RTL Int  =  T (Maybe Int)

binderRelevantType_maybe :: TyCoBinder -> Maybe Type #

Extract a relevant type, if there is one.

isAnonTyCoBinder :: TyCoBinder -> Bool #

Does this binder bind a variable that is not erased? Returns True for anonymous binders.

mkAnonBinder :: AnonArgFlag -> Scaled Type -> TyCoBinder #

Make an anonymous binder

appTyArgFlags :: Type -> [Type] -> [ArgFlag] #

Given a Type and a list of argument types to which the Type is applied, determine each argument's visibility (Inferred, Specified, or Required).

Most of the time, the arguments will be Required, but not always. Consider f :: forall a. a -> Type. In f Type Bool, the first argument (Type) is Specified and the second argument (Bool) is Required. It is precisely this sort of higher-rank situation in which appTyArgFlags comes in handy, since f Type Bool would be represented in Core using AppTys. (See also #15792).

tyConArgFlags :: TyCon -> [Type] -> [ArgFlag] #

Given a TyCon and a list of argument types to which the TyCon is applied, determine each argument's visibility (Inferred, Specified, or Required).

Wrinkle: consider the following scenario:

T :: forall k. k -> k
tyConArgFlags T [forall m. m -> m -> m, S, R, Q]

After substituting, we get

T (forall m. m -> m -> m) :: (forall m. m -> m -> m) -> forall n. n -> n -> n

Thus, the first argument is invisible, S is visible, R is invisible again, and Q is visible.

partitionInvisibles :: [(a, ArgFlag)] -> ([a], [a]) #

Given a list of things paired with their visibilities, partition the things into (invisible things, visible things).

filterOutInferredTypes :: TyCon -> [Type] -> [Type] #

Given a TyCon and a list of argument types, filter out any Inferred arguments.

filterOutInvisibleTypes :: TyCon -> [Type] -> [Type] #

Given a TyCon and a list of argument types, filter out any invisible (i.e., Inferred or Specified) arguments.

splitInvisPiTysN :: Int -> Type -> ([TyCoBinder], Type) #

Same as splitInvisPiTys, but stop when - you have found n TyCoBinders, - or you run out of invisible binders

splitInvisPiTys :: Type -> ([TyCoBinder], Type) #

Like splitPiTys, but returns only *invisible* binders, including constraints. Stops at the first visible binder.

splitForAllTyCoVarBinders :: Type -> ([TyCoVarBinder], Type) #

Like splitPiTys but split off only named binders and returns TyCoVarBinders rather than TyCoBinders

getRuntimeArgTys :: Type -> [(Type, AnonArgFlag)] #

Extracts a list of run-time arguments from a function type, looking through newtypes to the right of arrows.

Examples:

   newtype Identity a = I a

   getRuntimeArgTys (Int -> Bool -> Double) == [(Int, VisArg), (Bool, VisArg)]
   getRuntimeArgTys (Identity Int -> Bool -> Double) == [(Identity Int, VisArg), (Bool, VisArg)]
   getRuntimeArgTys (Int -> Identity (Bool -> Identity Double)) == [(Int, VisArg), (Bool, VisArg)]
   getRuntimeArgTys (forall a. Show a => Identity a -> a -> Int -> Bool) == [(Show a, InvisArg), (Identity a, VisArg),(a, VisArg),(Int, VisArg)]

Note that, in the last case, the returned types might mention an out-of-scope type variable. This function is used only when we really care about the kinds of the returned types, so this is OK.

  • *Warning**: this function can return an infinite list. For example:
  newtype N a = MkN (a -> N a)
  getRuntimeArgTys (N a) == repeat (a, VisArg)

splitPiTys :: Type -> ([TyCoBinder], Type) #

Split off all TyCoBinders to a type, splitting both proper foralls and functions

splitPiTy :: Type -> (TyCoBinder, Type) #

Takes a forall type apart, or panics

splitPiTy_maybe :: Type -> Maybe (TyCoBinder, Type) #

Attempts to take a forall type apart; works with proper foralls and functions

splitForAllCoVar_maybe :: Type -> Maybe (TyCoVar, Type) #

Like splitForAllTyCoVar_maybe, but only returns Just if it is a covar binder.

splitForAllTyVar_maybe :: Type -> Maybe (TyCoVar, Type) #

Like splitForAllTyCoVar_maybe, but only returns Just if it is a tyvar binder.

splitForAllTyCoVar_maybe :: Type -> Maybe (TyCoVar, Type) #

Attempts to take a forall type apart, but only if it's a proper forall, with a named binder

dropForAlls :: Type -> Type #

Drops all ForAllTys

splitForAllTyCoVar :: Type -> (TyCoVar, Type) #

Take a forall type apart, or panics if that is not possible.

isFunTy :: Type -> Bool #

Is this a function?

isPiTy :: Type -> Bool #

Is this a function or forall?

isForAllTy_co :: Type -> Bool #

Like isForAllTy, but returns True only if it is a covar binder

isForAllTy_ty :: Type -> Bool #

Like isForAllTy, but returns True only if it is a tyvar binder

isForAllTy :: Type -> Bool #

Checks whether this is a proper forall (with a named binder)

splitForAllInvisTVBinders :: Type -> ([InvisTVBinder], Type) #

Like splitForAllTyCoVars, but only splits ForAllTys with Invisible type variable binders. Furthermore, each returned tyvar is annotated with its Specificity.

splitForAllReqTVBinders :: Type -> ([ReqTVBinder], Type) #

Like splitForAllTyCoVars, but only splits ForAllTys with Required type variable binders. Furthermore, each returned tyvar is annotated with ().

splitForAllTyCoVars :: Type -> ([TyCoVar], Type) #

Take a ForAllTy apart, returning the list of tycovars and the result type. This always succeeds, even if it returns only an empty list. Note that the result type returned may have free variables that were bound by a forall.

mkTyConBindersPreferAnon #

Arguments

:: [TyVar]

binders

-> TyCoVarSet

free variables of result

-> [TyConBinder] 

Given a list of type-level vars and the free vars of a result kind, makes TyCoBinders, preferring anonymous binders if the variable is, in fact, not dependent. e.g. mkTyConBindersPreferAnon (k:*),(b:k),(c:k) We want (k:*) Named, (b:k) Anon, (c:k) Anon

All non-coercion binders are visible.

mkVisForAllTys :: [TyVar] -> Type -> Type #

Like mkForAllTys, but assumes all variables are dependent and visible

mkSpecForAllTys :: [TyVar] -> Type -> Type #

Like mkForAllTys, but assumes all variables are dependent and Specified, a common case

mkSpecForAllTy :: TyVar -> Type -> Type #

Like mkForAllTy, but assumes the variable is dependent and Specified, a common case

mkInfForAllTys :: [TyVar] -> Type -> Type #

Like mkTyCoInvForAllTys, but tvs should be a list of tyvar

mkTyCoInvForAllTys :: [TyCoVar] -> Type -> Type #

Like mkForAllTys, but assumes all variables are dependent and Inferred, a common case

mkInfForAllTy :: TyVar -> Type -> Type #

Like mkTyCoInvForAllTy, but tv should be a tyvar

mkTyCoInvForAllTy :: TyCoVar -> Type -> Type #

Make a dependent forall over an Inferred variable

newTyConInstRhs :: TyCon -> [Type] -> Type #

Unwrap one layer of newtype on a type constructor and its arguments, using an eta-reduced version of the newtype if possible. This requires tys to have at least newTyConInstArity tycon elements.

splitListTyConApp_maybe :: Type -> Maybe Type #

Attempts to tease a list type apart and gives the type of the elements if successful (looks through type synonyms)

tcRepSplitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type]) #

Like tcSplitTyConApp_maybe, but doesn't look through synonyms. This assumes the synonyms have already been dealt with.

Moreover, for a FunTy, it only succeeds if the argument types have enough info to extract the runtime-rep arguments that the funTyCon requires. This will usually be true; but may be temporarily false during canonicalization: see Note [Decomposing FunTy] in GHC.Tc.Solver.Canonical and Note [The Purely Kinded Type Invariant (PKTI)] in GHC.Tc.Gen.HsType, Wrinkle around FunTy

repSplitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type]) #

Like splitTyConApp_maybe, but doesn't look through synonyms. This assumes the synonyms have already been dealt with.

tcSplitTyConApp_maybe :: HasCallStack => Type -> Maybe (TyCon, [Type]) #

Split a type constructor application into its type constructor and applied types. Note that this may fail in the case of a FunTy with an argument of unknown kind FunTy (e.g. FunTy (a :: k) Int. since the kind of a isn't of the form TYPE rep). Consequently, you may need to zonk your type before using this function.

This does *not* split types headed with (=>), as that's not a TyCon in the type-checker.

If you only need the TyCon, consider using tcTyConAppTyCon_maybe.

splitTyConApp :: Type -> (TyCon, [Type]) #

Attempts to tease a type apart into a type constructor and the application of a number of arguments to that constructor. Panics if that is not possible. See also splitTyConApp_maybe

tyConAppArgs_maybe :: Type -> Maybe [Type] #

The same as snd . splitTyConApp

tyConAppTyConPicky_maybe :: Type -> Maybe TyCon #

Retrieve the tycon heading this type, if there is one. Does not look through synonyms.

applyTysX :: [TyVar] -> Type -> [Type] -> Type #

piResultTys :: HasDebugCallStack => Type -> [Type] -> Type #

(piResultTys f_ty [ty1, .., tyn]) gives the type of (f ty1 .. tyn) where f :: f_ty piResultTys is interesting because: 1. f_ty may have more for-alls than there are args 2. Less obviously, it may have fewer for-alls For case 2. think of: piResultTys (forall a.a) [forall b.b, Int] This really can happen, but only (I think) in situations involving undefined. For example: undefined :: forall a. a Term: undefined (forall b. b->b) Int This term should have type (Int -> Int), but notice that there are more type args than foralls in undefineds type.

funArgTy :: Type -> Type #

Just like piResultTys but for a single argument Try not to iterate piResultTy, because it's inefficient to substitute one variable at a time; instead use 'piResultTys"

Extract the function argument type and panic if that is not possible

funResultTy :: Type -> Type #

Extract the function result type and panic if that is not possible

splitFunTy_maybe :: Type -> Maybe (Mult, Type, Type) #

Attempts to extract the multiplicity, argument and result types from a type

splitFunTy :: Type -> (Mult, Type, Type) #

Attempts to extract the multiplicity, argument and result types from a type, and panics if that is not possible. See also splitFunTy_maybe

pprUserTypeErrorTy :: Type -> SDoc #

Render a type corresponding to a user type error into a SDoc.

userTypeError_maybe :: Type -> Maybe Type #

Is this type a custom user error? If so, give us the kind and the error message.

isLitTy :: Type -> Maybe TyLit #

Is this a type literal (symbol, numeric, or char)?

isCharLitTy :: Type -> Maybe Char #

Is this a char literal? We also look through type synonyms.

isStrLitTy :: Type -> Maybe FastString #

Is this a symbol literal. We also look through type synonyms.

isNumLitTy :: Type -> Maybe Integer #

Is this a numeric literal. We also look through type synonyms.

repSplitAppTys :: HasDebugCallStack => Type -> (Type, [Type]) #

Like splitAppTys, but doesn't look through type synonyms

splitAppTys :: Type -> (Type, [Type]) #

Recursively splits a type as far as is possible, leaving a residual type being applied to and the type arguments applied to it. Never fails, even if that means returning an empty list of type applications.

splitAppTy :: Type -> (Type, Type) #

Attempts to take a type application apart, as in splitAppTy_maybe, and panics if this is not possible

tcRepSplitAppTy_maybe :: Type -> Maybe (Type, Type) #

Does the AppTy split as in tcSplitAppTy_maybe, but assumes that any coreView stuff is already done. Refuses to look through (c => t)

repSplitAppTy_maybe :: HasDebugCallStack => Type -> Maybe (Type, Type) #

Does the AppTy split as in splitAppTy_maybe, but assumes that any Core view stuff is already done

splitAppTy_maybe :: Type -> Maybe (Type, Type) #

Attempt to take a type application apart, whether it is a function, type constructor, or plain type application. Note that type family applications are NEVER unsaturated by this!

mkAppTys :: Type -> [Type] -> Type #

repGetTyVar_maybe :: Type -> Maybe TyVar #

Attempts to obtain the type variable underlying a Type, without any expansion

getCastedTyVar_maybe :: Type -> Maybe (TyVar, CoercionN) #

If the type is a tyvar, possibly under a cast, returns it, along with the coercion. Thus, the co is :: kind tv ~N kind ty

getTyVar_maybe :: Type -> Maybe TyVar #

Attempts to obtain the type variable underlying a Type

getTyVar :: String -> Type -> TyVar #

Attempts to obtain the type variable underlying a Type, and panics with the given message if this is not a type variable type. See also getTyVar_maybe

mapTyCoX :: Monad m => TyCoMapper env m -> (env -> Type -> m Type, env -> [Type] -> m [Type], env -> Coercion -> m Coercion, env -> [Coercion] -> m [Coercion]) #

mapTyCo :: Monad m => TyCoMapper () m -> (Type -> m Type, [Type] -> m [Type], Coercion -> m Coercion, [Coercion] -> m [Coercion]) #

isMultiplicityVar :: TyVar -> Bool #

Is a tyvar of type Multiplicity?

isLevityVar :: TyVar -> Bool #

Is a tyvar of type Levity?

isRuntimeRepVar :: TyVar -> Bool #

Is a tyvar of type RuntimeRep?

isUnliftedRuntimeRep :: Type -> Bool #

Check whether a type of kind RuntimeRep is unlifted.

isLiftedRuntimeRep :: Type -> Bool #

Check whether a type of kind RuntimeRep is lifted.

isLiftedRuntimeRep is:

  • True of LiftedRep :: RuntimeRep
  • False of type variables, type family applications, and of other reps such as IntRep :: RuntimeRep.

runtimeRepLevity_maybe :: Type -> Maybe Levity #

Check whether a type of kind RuntimeRep is lifted, unlifted, or unknown.

isLiftedRuntimeRep rr returns:

  • Just Lifted if rr is LiftedRep :: RuntimeRep
  • Just Unlifted if rr is definitely unlifted, e.g. IntRep
  • Nothing if not known (e.g. it's a type variable or a type family application).

isBoxedRuntimeRep :: Type -> Bool #

See isBoxedRuntimeRep_maybe.

isUnliftedTypeKind :: Kind -> Bool #

Returns True if the kind classifies unlifted types (like 'Int#') and False otherwise. Note that this returns False for representation-polymorphic kinds, which may be specialized to a kind that classifies unlifted types.

isBoxedTypeKind :: Kind -> Bool #

Returns True if the kind classifies types which are allocated on the GC'd heap and False otherwise. Note that this returns False for representation-polymorphic kinds, which may be specialized to a kind that classifies AddrRep or even unboxed kinds.

kindRep_maybe :: HasDebugCallStack => Kind -> Maybe Type #

Given a kind (TYPE rr), extract its RuntimeRep classifier rr. For example, kindRep_maybe * = Just LiftedRep Returns Nothing if the kind is not of form (TYPE rr) Treats * and Constraint as the same

kindRep :: HasDebugCallStack => Kind -> Type #

Extract the RuntimeRep classifier of a type from its kind. For example, kindRep * = LiftedRep; Panics if this is not possible. Treats * and Constraint as the same

expandTypeSynonyms :: Type -> Type #

Expand out all type synonyms. Actually, it'd suffice to expand out just the ones that discard type variables (e.g. type Funny a = Int) But we don't know which those are currently, so we just expand all.

expandTypeSynonyms only expands out type synonyms mentioned in the type, not in the kinds of any TyCon or TyVar mentioned in the type.

Keep this synchronized with synonymTyConsOfType

pattern One :: Mult #

pattern Many :: Mult #

data TyCoMapper env (m :: Type -> Type) #

This describes how a "map" operation over a type/coercion should behave

Constructors

TyCoMapper 

Fields

funTyCon :: TyCon #

The FUN type constructor.

FUN :: forall (m :: Multiplicity) ->
       forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}.
       TYPE rep1 -> TYPE rep2 -> *

The runtime representations quantification is left inferred. This means they cannot be specified with -XTypeApplications.

This is a deliberate choice to allow future extensions to the function arrow. To allow visible application a type synonym can be defined:

type Arr :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep).
            TYPE rep1 -> TYPE rep2 -> Type
type Arr = FUN 'Many

substCoUnchecked :: TCvSubst -> Coercion -> Coercion #

Substitute within a Coercion disabling sanity checks. The problems that the sanity checks in substCo catch are described in Note [The substitution invariant]. The goal of #11371 is to migrate all the calls of substCoUnchecked to substCo and remove this function. Please don't use in new code.

substThetaUnchecked :: TCvSubst -> ThetaType -> ThetaType #

Substitute within a ThetaType disabling the sanity checks. The problems that the sanity checks in substTys catch are described in Note [The substitution invariant]. The goal of #11371 is to migrate all the calls of substThetaUnchecked to substTheta and remove this function. Please don't use in new code.

substTheta :: HasDebugCallStack => TCvSubst -> ThetaType -> ThetaType #

Substitute within a ThetaType The substitution has to satisfy the invariants described in Note [The substitution invariant].

substTysUnchecked :: TCvSubst -> [Type] -> [Type] #

Substitute within several Types disabling the sanity checks. The problems that the sanity checks in substTys catch are described in Note [The substitution invariant]. The goal of #11371 is to migrate all the calls of substTysUnchecked to substTys and remove this function. Please don't use in new code.

substTys :: HasDebugCallStack => TCvSubst -> [Type] -> [Type] #

Substitute within several Types The substitution has to satisfy the invariants described in Note [The substitution invariant].

substTyUnchecked :: TCvSubst -> Type -> Type #

Substitute within a Type disabling the sanity checks. The problems that the sanity checks in substTy catch are described in Note [The substitution invariant]. The goal of #11371 is to migrate all the calls of substTyUnchecked to substTy and remove this function. Please don't use in new code.

substTyAddInScope :: TCvSubst -> Type -> Type #

Substitute within a Type after adding the free variables of the type to the in-scope set. This is useful for the case when the free variables aren't already in the in-scope set or easily available. See also Note [The substitution invariant].

substTysWith :: [TyVar] -> [Type] -> [Type] -> [Type] #

Type substitution, see zipTvSubst

substCoWithUnchecked :: [TyVar] -> [Type] -> Coercion -> Coercion #

Coercion substitution, see zipTvSubst. Disables sanity checks. The problems that the sanity checks in substCo catch are described in Note [The substitution invariant]. The goal of #11371 is to migrate all the calls of substCoUnchecked to substCo and remove this function. Please don't use in new code.

substTyWithUnchecked :: [TyVar] -> [Type] -> Type -> Type #

Type substitution, see zipTvSubst. Disables sanity checks. The problems that the sanity checks in substTy catch are described in Note [The substitution invariant]. The goal of #11371 is to migrate all the calls of substTyUnchecked to substTy and remove this function. Please don't use in new code.

substTyWith :: HasDebugCallStack => [TyVar] -> [Type] -> Type -> Type #

Type substitution, see zipTvSubst

mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst #

Generates the in-scope set for the TCvSubst from the types in the incoming environment. No CoVars, please!

zipTvSubst :: HasDebugCallStack => [TyVar] -> [Type] -> TCvSubst #

Generates the in-scope set for the TCvSubst from the types in the incoming environment. No CoVars, please!

getTCvSubstRangeFVs :: TCvSubst -> VarSet #

Returns the free variables of the types in the range of a substitution as a non-deterministic set.

composeTCvSubst :: TCvSubst -> TCvSubst -> TCvSubst #

Composes two substitutions, applying the second one provided first, like in function composition.

composeTCvSubstEnv :: InScopeSet -> (TvSubstEnv, CvSubstEnv) -> (TvSubstEnv, CvSubstEnv) -> (TvSubstEnv, CvSubstEnv) #

(compose env1 env2)(x) is env1(env2(x)); i.e. apply env2 then env1. It assumes that both are idempotent. Typically, env1 is the refinement to a base substitution env2

data TCvSubst #

Type & coercion substitution

The following invariants must hold of a TCvSubst:

  1. The in-scope set is needed only to guide the generation of fresh uniques
  2. In particular, the kind of the type variables in the in-scope set is not relevant
  3. The substitution is only applied ONCE! This is because in general such application will not reach a fixed point.

Instances

Instances details
Outputable TCvSubst 
Instance details

Defined in GHC.Core.TyCo.Subst

Methods

ppr :: TCvSubst -> SDoc #

type TvSubstEnv = TyVarEnv Type #

A substitution of Types for TyVars and Kinds for KindVars

tidyTopType :: Type -> Type #

Calls tidyType on a top-level type (i.e. with an empty tidying environment)

tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type]) #

Grabs the free type variables, tidies them and then uses tidyType to work over the type itself

tidyType :: TidyEnv -> Type -> Type #

Tidy a Type

See Note [Strictness in tidyType and friends]

tidyTypes :: TidyEnv -> [Type] -> [Type] #

Tidy a list of Types

See Note [Strictness in tidyType and friends]

tidyOpenTyCoVar :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar) #

Treat a new TyCoVar as a binder, and give it a fresh tidy name using the environment if one has not already been allocated. See also tidyVarBndr

tidyFreeTyCoVars :: TidyEnv -> [TyCoVar] -> TidyEnv #

Add the free TyVars to the env in tidy form, so that we can tidy the type they are free in

tidyVarBndrs :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar]) #

This tidies up a type for printing in an error message, or in an interface file.

It doesn't change the uniques at all, just the print names.

tyCoVarsOfTypesWellScoped :: [Type] -> [TyVar] #

Get the free vars of types in scoped order

tyCoVarsOfTypeWellScoped :: Type -> [TyVar] #

Get the free vars of a type in scoped order

scopedSort :: [TyCoVar] -> [TyCoVar] #

Do a topological sort on a list of tyvars, so that binders occur before occurrences E.g. given [ a::k, k::*, b::k ] it'll return a well-scoped list [ k::*, a::k, b::k ]

This is a deterministic sorting operation (that is, doesn't depend on Uniques).

It is also meant to be stable: that is, variables should not be reordered unnecessarily. This is specified in Note [ScopedSort] See also Note [Ordering of implicit variables] in GHC.Rename.HsType

tyCoFVsOfType :: Type -> FV #

The worker for tyCoFVsOfType and tyCoFVsOfTypeList. The previous implementation used unionVarSet which is O(n+m) and can make the function quadratic. It's exported, so that it can be composed with other functions that compute free variables. See Note [FV naming conventions] in GHC.Utils.FV.

Eta-expanded because that makes it run faster (apparently) See Note [FV eta expansion] in GHC.Utils.FV for explanation.

tyCoVarsOfTypeDSet :: Type -> DTyCoVarSet #

tyCoFVsOfType that returns free variables of a type in a deterministic set. For explanation of why using VarSet is not deterministic see Note [Deterministic FV] in GHC.Utils.FV.

closeOverKindsDSet :: DTyVarSet -> DTyVarSet #

Add the kind variables free in the kinds of the tyvars in the given set. Returns a deterministic set.

closeOverKindsList :: [TyVar] -> [TyVar] #

Add the kind variables free in the kinds of the tyvars in the given set. Returns a deterministically ordered list.

noView :: Type -> Maybe Type #

A view function that looks through nothing.

foldTyCo :: Monoid a => TyCoFolder env a -> env -> (Type -> a, [Type] -> a, Coercion -> a, [Coercion] -> a) #

mkInvisForAllTys :: [InvisTVBinder] -> Type -> Type #

Wraps foralls over the type using the provided InvisTVBinders from left to right

mkForAllTys :: [TyCoVarBinder] -> Type -> Type #

Wraps foralls over the type using the provided TyCoVars from left to right

mkVisFunTys :: [Scaled Type] -> Type -> Type #

Make nested arrow types

mkInvisFunTyMany :: Type -> Type -> Type infixr 3 #

mkVisFunTyMany :: Type -> Type -> Type infixr 3 #

Special, common, case: Arrow type with mult Many

mkInvisFunTy :: Mult -> Type -> Type -> Type infixr 3 #

mkVisFunTy :: Mult -> Type -> Type -> Type infixr 3 #

mkFunTy :: AnonArgFlag -> Mult -> Type -> Type -> Type infixr 3 #

isVisibleBinder :: TyCoBinder -> Bool #

Does this binder bind a visible argument?

isInvisibleBinder :: TyCoBinder -> Bool #

Does this binder bind an invisible argument?

type KindOrType = Type #

The key representation of types within the compiler

type FRRType = Type #

type KnotTied ty = ty #

A type labeled KnotTied might have knot-tied tycons in it. See Note [Type checking recursive type and class declarations] in GHC.Tc.TyCl

data TyCoFolder env a #

Constructors

TyCoFolder 

Fields

isConstraintKindCon :: TyCon -> Bool #

Returns True for the TyCon of the Constraint kind.

isTyVar :: Var -> Bool #

Is this a type-level (i.e., computationally irrelevant, thus erasable) variable? Satisfies isTyVar = not . isId.

mkTyVarBinders :: vis -> [TyVar] -> [VarBndr TyVar vis] #

Make many named binders Input vars should be type variables

mkTyCoVarBinders :: vis -> [TyCoVar] -> [VarBndr TyCoVar vis] #

Make many named binders

mkTyVarBinder :: vis -> TyVar -> VarBndr TyVar vis #

Make a named binder var should be a type variable

mkTyCoVarBinder :: vis -> TyCoVar -> VarBndr TyCoVar vis #

Make a named binder

binderArgFlag :: VarBndr tv argf -> argf #

binderVars :: [VarBndr tv argf] -> [tv] #

binderVar :: VarBndr tv argf -> tv #

sameVis :: ArgFlag -> ArgFlag -> Bool #

Do these denote the same level of visibility? Required arguments are visible, others are not. So this function equates Specified and Inferred. Used for printing.

isInvisibleArgFlag :: ArgFlag -> Bool #

Does this ArgFlag classify an argument that is not written in Haskell?

isVisibleArgFlag :: ArgFlag -> Bool #

Does this ArgFlag classify an argument that is written in Haskell?

type TyCoVarBinder = VarBndr TyCoVar ArgFlag #

Variable Binder

A TyCoVarBinder is the binder of a ForAllTy It's convenient to define this synonym here rather its natural home in GHC.Core.TyCo.Rep, because it's used in GHC.Core.DataCon.hs-boot

A TyVarBinder is a binder with only TyVar

mkAppTy :: Type -> Type -> Type #

Applies a type to another, as in e.g. k a

mkCastTy :: Type -> Coercion -> Type #

Make a CastTy. The Coercion must be nominal. Checks the Coercion for reflexivity, dropping it if it's reflexive. See Note [Respecting definitional equality] in GHC.Core.TyCo.Rep

mkTyConTy :: TyCon -> Type #

(mkTyConTy tc) returns (TyConApp tc []) but arranges to share that TyConApp among all calls See Note [Sharing nullary TyConApps] in GHC.Core.TyCon

mkTyConApp :: TyCon -> [Type] -> Type #

A key function: builds a TyConApp or FunTy as appropriate to its arguments. Applies its arguments to the constructor from left to right.

coreView :: Type -> Maybe Type #

This function strips off the top layer only of a type synonym application (if any) its underlying representation type. Returns Nothing if there is nothing to look through. This function considers Constraint to be a synonym of Type.

This function does not look through type family applications.

By being non-recursive and inlined, this case analysis gets efficiently joined onto the case analysis that the caller is already doing

tcView :: Type -> Maybe Type #

Gives the typechecker view of a type. This unwraps synonyms but leaves Constraint alone. c.f. coreView, which turns Constraint into Type. Returns Nothing if no unwrapping happens. See also Note [coreView vs tcView]

isRuntimeRepTy :: Type -> Bool #

Is this the type RuntimeRep?

isLevityTy :: Type -> Bool #

Is this the type Levity?

isMultiplicityTy :: Type -> Bool #

Is this the type Multiplicity?

isLiftedTypeKind :: Kind -> Bool #

This version considers Constraint to be the same as *. Returns True if the argument is equivalent to Type/Constraint and False otherwise. See Note [Kind Constraint and kind Type]

splitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type]) #

Attempts to tease a type apart into a type constructor and the application of a number of arguments to that constructor

tyConAppTyCon_maybe :: Type -> Maybe TyCon #

The same as fst . splitTyConApp

getLevity :: HasDebugCallStack => Type -> Type #

Extract the Levity of a type. For example, getLevity Int = Lifted, or getLevity (Array# Int) = Unlifted.

Panics if this is not possible. Does not look through type family applications.

partitionInvisibleTypes :: TyCon -> [Type] -> ([Type], [Type]) #

Given a TyCon and a list of argument types, partition the arguments into:

  1. Inferred or Specified (i.e., invisible) arguments and
  2. Required (i.e., visible) arguments

mkForAllTy :: TyCoVar -> ArgFlag -> Type -> Type #

Like mkTyCoForAllTy, but does not check the occurrence of the binder See Note [Unused coercion variable in ForAllTy]

data Type #

Instances

Instances details
Data Type 
Instance details

Defined in GHC.Core.TyCo.Rep

Methods

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

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

toConstr :: Type -> Constr #

dataTypeOf :: Type -> DataType #

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

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

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

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

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

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

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

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

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

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

Outputable Type 
Instance details

Defined in GHC.Core.TyCo.Rep

Methods

ppr :: Type -> SDoc #

Eq (DeBruijn Type) 
Instance details

Defined in GHC.Core.Map.Type

data TyCoBinder #

A TyCoBinder represents an argument to a function. TyCoBinders can be dependent (Named) or nondependent (Anon). They may also be visible or not. See Note [TyCoBinders]

Instances

Instances details
Data TyCoBinder 
Instance details

Defined in GHC.Core.TyCo.Rep

Methods

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

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

toConstr :: TyCoBinder -> Constr #

dataTypeOf :: TyCoBinder -> DataType #

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

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

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

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

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

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

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

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

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

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

Outputable TyCoBinder 
Instance details

Defined in GHC.Core.TyCo.Rep

Methods

ppr :: TyCoBinder -> SDoc #

data Scaled a #

A shorthand for data with an attached Mult element (the multiplicity).

Instances

Instances details
Data a => Data (Scaled a) 
Instance details

Defined in GHC.Core.TyCo.Rep

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Scaled a -> c (Scaled a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Scaled a) #

toConstr :: Scaled a -> Constr #

dataTypeOf :: Scaled a -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Scaled a)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Scaled a)) #

gmapT :: (forall b. Data b => b -> b) -> Scaled a -> Scaled a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Scaled a -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Scaled a -> r #

gmapQ :: (forall d. Data d => d -> u) -> Scaled a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Scaled a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Scaled a -> m (Scaled a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Scaled a -> m (Scaled a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Scaled a -> m (Scaled a) #

Outputable a => Outputable (Scaled a) 
Instance details

Defined in GHC.Core.TyCo.Rep

Methods

ppr :: Scaled a -> SDoc #

type Mult = Type #

Mult is a type alias for Type.

Mult must contain Type because multiplicity variables are mere type variables (of kind Multiplicity) in Haskell. So the simplest implementation is to make Mult be Type.

Multiplicities can be formed with: - One: GHC.Types.One (= oneDataCon) - Many: GHC.Types.Many (= manyDataCon) - Multiplication: GHC.Types.MultMul (= multMulTyCon)

So that Mult feels a bit more structured, we provide pattern synonyms and smart constructors for these.

type PredType = Type #

A type of the form p of constraint kind represents a value whose type is the Haskell predicate p, where a predicate is what occurs before the => in a Haskell type.

We use PredType as documentation to mark those types that we guarantee to have this kind.

It can be expanded into its representation, but:

  • The type checker must treat it as opaque
  • The rest of the compiler treats it as transparent

Consider these examples:

f :: (Eq a) => a -> Int
g :: (?x :: Int -> Int) => a -> Int
h :: (r\l) => {r} => {l::Int | r}

Here the Eq a and ?x :: Int -> Int and rl are all called "predicates"

type Kind = Type #

The key type representing kinds in the compiler.

type ThetaType = [PredType] #

A collection of PredTypes

data ArgFlag #

Argument Flag

Is something required to appear in source Haskell (Required), permitted by request (Specified) (visible type application), or prohibited entirely from appearing in source Haskell (Inferred)? See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in GHC.Core.TyCo.Rep

Bundled Patterns

pattern Inferred :: ArgFlag 
pattern Specified :: ArgFlag 

Instances

Instances details
Data ArgFlag 
Instance details

Defined in GHC.Types.Var

Methods

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

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

toConstr :: ArgFlag -> Constr #

dataTypeOf :: ArgFlag -> DataType #

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

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

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

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

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

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

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

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

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

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

Binary ArgFlag 
Instance details

Defined in GHC.Types.Var

Outputable ArgFlag 
Instance details

Defined in GHC.Types.Var

Methods

ppr :: ArgFlag -> SDoc #

Eq ArgFlag 
Instance details

Defined in GHC.Types.Var

Methods

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

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

Ord ArgFlag 
Instance details

Defined in GHC.Types.Var

Outputable tv => Outputable (VarBndr tv ArgFlag) 
Instance details

Defined in GHC.Types.Var

Methods

ppr :: VarBndr tv ArgFlag -> SDoc #

data AnonArgFlag #

The non-dependent version of ArgFlag. See Note [AnonArgFlag] Appears here partly so that it's together with its friends ArgFlag and ForallVisFlag, but also because it is used in IfaceType, rather early in the compilation chain

Constructors

VisArg

Used for (->): an ordinary non-dependent arrow. The argument is visible in source code.

InvisArg

Used for (=>): a non-dependent predicate arrow. The argument is invisible in source code.

Instances

Instances details
Data AnonArgFlag 
Instance details

Defined in GHC.Types.Var

Methods

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

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

toConstr :: AnonArgFlag -> Constr #

dataTypeOf :: AnonArgFlag -> DataType #

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

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

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

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

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

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

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

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

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

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

Binary AnonArgFlag 
Instance details

Defined in GHC.Types.Var

Outputable AnonArgFlag 
Instance details

Defined in GHC.Types.Var

Methods

ppr :: AnonArgFlag -> SDoc #

Eq AnonArgFlag 
Instance details

Defined in GHC.Types.Var

Ord AnonArgFlag 
Instance details

Defined in GHC.Types.Var

data Var #

Variable

Essentially a typed Name, that may also contain some additional information about the Var and its use sites.

Instances

Instances details
Data Var 
Instance details

Defined in GHC.Types.Var

Methods

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

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

toConstr :: Var -> Constr #

dataTypeOf :: Var -> DataType #

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

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

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

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

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

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

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

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

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

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

NamedThing Var 
Instance details

Defined in GHC.Types.Var

Methods

getOccName :: Var -> OccName #

getName :: Var -> Name #

HasOccName Var 
Instance details

Defined in GHC.Types.Var

Methods

occName :: Var -> OccName #

Uniquable Var 
Instance details

Defined in GHC.Types.Var

Methods

getUnique :: Var -> Unique #

Outputable Var 
Instance details

Defined in GHC.Types.Var

Methods

ppr :: Var -> SDoc #

Eq Var 
Instance details

Defined in GHC.Types.Var

Methods

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

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

Ord Var 
Instance details

Defined in GHC.Types.Var

Methods

compare :: Var -> Var -> Ordering #

(<) :: Var -> Var -> Bool #

(<=) :: Var -> Var -> Bool #

(>) :: Var -> Var -> Bool #

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

max :: Var -> Var -> Var #

min :: Var -> Var -> Var #

Eq (DeBruijn Var) 
Instance details

Defined in GHC.Core.Map.Type

OutputableBndr (Id, TagSig) 
Instance details

Defined in GHC.Stg.InferTags.TagSig

type Anno Id 
Instance details

Defined in GHC.Hs.Extension

type Anno (LocatedN Id) 
Instance details

Defined in GHC.Hs.Binds

type Anno [LocatedN Id] 
Instance details

Defined in GHC.Hs.Binds

data Specificity #

Whether an Invisible argument may appear in source Haskell.

Constructors

InferredSpec

the argument may not appear in source Haskell, it is only inferred.

SpecifiedSpec

the argument may appear in source Haskell, but isn't required.

Instances

Instances details
Data Specificity 
Instance details

Defined in GHC.Types.Var

Methods

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

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

toConstr :: Specificity -> Constr #

dataTypeOf :: Specificity -> DataType #

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

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

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

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

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

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

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

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

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

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

Binary Specificity 
Instance details

Defined in GHC.Types.Var

Eq Specificity 
Instance details

Defined in GHC.Types.Var

Ord Specificity 
Instance details

Defined in GHC.Types.Var

OutputableBndrFlag Specificity p 
Instance details

Defined in GHC.Hs.Type

Outputable tv => Outputable (VarBndr tv Specificity) 
Instance details

Defined in GHC.Types.Var

Methods

ppr :: VarBndr tv Specificity -> SDoc #

type TyVar = Var #

Type or kind Variable

type TyCoVar = Id #

Type or Coercion Variable

hasCoercionHoleCo :: Coercion -> Bool #

Is there a coercion hole in this coercion?

hasCoercionHoleTy :: Type -> Bool #

Is there a coercion hole in this type?

buildCoercion :: Type -> Type -> CoercionN #

Assuming that two types are the same, ignoring coercions, find a nominal coercion between the types. This is useful when optimizing transitivity over coercion applications, where splitting two AppCos might yield different kinds. See Note [EtaAppCo] in GHC.Core.Coercion.Opt.

mkHeteroReprPrimEqPred :: Kind -> Kind -> Type -> Type -> Type #

Creates a primitive representational type equality predicate with explicit kinds

mkHeteroPrimEqPred :: Kind -> Kind -> Type -> Type -> Type #

Creates a primitive type equality predicate with explicit kinds

mkPrimEqPredRole :: Role -> Type -> Type -> PredType #

Makes a lifted equality predicate at the given role

mkPrimEqPred :: Type -> Type -> Type #

Creates a primitive type equality predicate. Invariant: the types are not Coercions

coercionRole :: Coercion -> Role #

Retrieve the role from a coercion.

coercionKindRole :: Coercion -> (Pair Type, Role) #

Get a coercion's kind and role.

coercionKinds :: [Coercion] -> Pair [Type] #

Apply coercionKind to multiple Coercions

lcTCvSubst :: LiftingContext -> TCvSubst #

Extract the underlying substitution from the LiftingContext

swapLiftCoEnv :: LiftCoEnv -> LiftCoEnv #

Apply "sym" to all coercions in a LiftCoEnv

isMappedByLC :: TyCoVar -> LiftingContext -> Bool #

Is a var in the domain of a lifting context?

liftCoSubstVarBndrUsing #

Arguments

:: (r -> CoercionN)

coercion getter

-> (LiftingContext -> Type -> r)

callback

-> LiftingContext 
-> TyCoVar 
-> (LiftingContext, TyCoVar, r) 

zapLiftingContext :: LiftingContext -> LiftingContext #

Erase the environments in a lifting context

extendLiftingContextAndInScope #

Arguments

:: LiftingContext

Original LC

-> TyCoVar

new variable to map...

-> Coercion

to this coercion

-> LiftingContext 

Extend a lifting context with a new mapping, and extend the in-scope set

extendLiftingContext #

Arguments

:: LiftingContext

original LC

-> TyCoVar

new variable to map...

-> Coercion

...to this lifted version

-> LiftingContext 

Extend a lifting context with a new mapping.

liftCoSubstWithEx :: Role -> [TyVar] -> [Coercion] -> [TyCoVar] -> [Type] -> (Type -> Coercion, [Type]) #

eqCoercionX :: RnEnv2 -> Coercion -> Coercion -> Bool #

Compare two Coercions, with respect to an RnEnv2

eqCoercion :: Coercion -> Coercion -> Bool #

Syntactic equality of coercions

topNormaliseTypeX :: NormaliseStepper ev -> (ev -> ev -> ev) -> Type -> Maybe (ev, Type) #

A general function for normalising the top-level of a type. It continues to use the provided NormaliseStepper until that function fails, and then this function returns. The roles of the coercions produced by the NormaliseStepper must all be the same, which is the role returned from the call to topNormaliseTypeX.

Typically ev is Coercion.

If topNormaliseTypeX step plus ty = Just (ev, ty') then ty ~ev1~ t1 ~ev2~ t2 ... ~evn~ ty' and ev = ev1 plus ev2 plus ... plus evn If it returns Nothing then no newtype unwrapping could happen

unwrapNewTypeStepper :: NormaliseStepper Coercion #

A NormaliseStepper that unwraps newtypes, careful not to fall into a loop. If it would fall into a loop, it produces NS_Abort.

composeSteppers :: NormaliseStepper ev -> NormaliseStepper ev -> NormaliseStepper ev #

Try one stepper and then try the next, if the first doesn't make progress. So if it returns NS_Done, it means that both steppers are satisfied

instNewTyCon_maybe :: TyCon -> [Type] -> Maybe (Type, Coercion) #

If `instNewTyCon_maybe T ts = Just (rep_ty, co)` then `co :: T ts ~R# rep_ty`

Checks for a newtype, and for being saturated

mkPiCo :: Role -> Var -> Coercion -> Coercion #

Make a forall Coercion, where both types related by the coercion are quantified over the same variable.

mkFamilyTyConAppCo :: TyCon -> [CoercionN] -> CoercionN #

Given a family instance TyCon and its arg Coercions, return the corresponding family Coercion. E.g:

data family T a
data instance T (Maybe b) = MkT b

Where the instance TyCon is :RTL, so:

mkFamilyTyConAppCo :RTL (co :: a ~# Int) = T (Maybe a) ~# T (Maybe Int)

cf. mkFamilyTyConApp

castCoercionKind :: Coercion -> CoercionN -> CoercionN -> Coercion #

Creates a new coercion with both of its types casted by different casts castCoercionKind g h1 h2, where g :: t1 ~r t2, has type (t1 |> h1) ~r (t2 |> h2). h1 and h2 must be nominal. It calls coercionKindRole, so it's quite inefficient (which I stands for) Use castCoercionKind2 instead if t1, t2, and r are known beforehand.

castCoercionKind1 :: Coercion -> Role -> Type -> Type -> CoercionN -> Coercion #

castCoercionKind1 g r t1 t2 h = coercionKind g r t1 t2 h h That is, it's a specialised form of castCoercionKind, where the two kind coercions are identical castCoercionKind1 g r t1 t2 h, where g :: t1 ~r t2, has type (t1 |> h) ~r (t2 |> h). h must be nominal. See Note [castCoercionKind1]

castCoercionKind2 :: Coercion -> Role -> Type -> Type -> CoercionN -> CoercionN -> Coercion #

Creates a new coercion with both of its types casted by different casts castCoercionKind2 g r t1 t2 h1 h2, where g :: t1 ~r t2, has type (t1 |> h1) ~r (t2 |> h2). h1 and h2 must be nominal.

promoteCoercion :: Coercion -> CoercionN #

like mkKindCo, but aggressively & recursively optimizes to avoid using a KindCo constructor. The output role is nominal.

ltRole :: Role -> Role -> Bool #

nthRole :: Role -> TyCon -> Int -> Role #

setNominalRole_maybe :: Role -> Coercion -> Maybe Coercion #

Converts a coercion to be nominal, if possible. See Note [Role twiddling functions]

downgradeRole :: Role -> Role -> Coercion -> Coercion #

Like downgradeRole_maybe, but panics if the change isn't a downgrade. See Note [Role twiddling functions]

mkCoherenceRightCo :: Role -> Type -> CoercionN -> Coercion -> Coercion #

Given ty :: k1, co :: k1 ~ k2, co2:: ty' ~r ty, produces @co' :: ty' ~r (ty |> co) It is not only a utility function, but it saves allocation when co is a GRefl coercion.

mkCoherenceLeftCo :: Role -> Type -> CoercionN -> Coercion -> Coercion #

Given ty :: k1, co :: k1 ~ k2, co2:: ty ~r ty', produces @co' :: (ty |> co) ~r ty' It is not only a utility function, but it saves allocation when co is a GRefl coercion.

mkGReflLeftCo :: Role -> Type -> CoercionN -> Coercion #

Given ty :: k1, co :: k1 ~ k2, produces co' :: (ty |> co) ~r ty

mkGReflRightCo :: Role -> Type -> CoercionN -> Coercion #

Given ty :: k1, co :: k1 ~ k2, produces co' :: ty ~r (ty |> co)

nthCoRole :: Int -> Coercion -> Role #

If you're about to call mkNthCo r n co, then r should be whatever nthCoRole n co returns.

mkNthCoFunCo #

Arguments

:: Int

"n"

-> CoercionN

multiplicity coercion

-> Coercion

argument coercion

-> Coercion

result coercion

-> Coercion

nth coercion from a FunCo See Note [Function coercions] If FunCo _ mult arg_co res_co :: (s1:TYPE sk1 :mult-> s2:TYPE sk2) ~ (t1:TYPE tk1 :mult-> t2:TYPE tk2) Then we want to behave as if co was TyConAppCo mult argk_co resk_co arg_co res_co where argk_co :: sk1 ~ tk1 = mkNthCo 0 (mkKindCo arg_co) resk_co :: sk2 ~ tk2 = mkNthCo 0 (mkKindCo res_co) i.e. mkRuntimeRepCo

Extract the nth field of a FunCo

mkHoleCo :: CoercionHole -> Coercion #

Make a coercion from a coercion hole

mkUnbranchedAxInstLHS :: CoAxiom Unbranched -> [Type] -> [Coercion] -> Type #

Instantiate the left-hand side of an unbranched axiom

mkAxInstLHS :: forall (br :: BranchFlag). CoAxiom br -> BranchIndex -> [Type] -> [Coercion] -> Type #

Return the left-hand type of the axiom, when the axiom is instantiated at the types given.

mkAxInstRHS :: forall (br :: BranchFlag). CoAxiom br -> BranchIndex -> [Type] -> [Coercion] -> Type #

mkAxInstCo :: forall (br :: BranchFlag). Role -> CoAxiom br -> BranchIndex -> [Type] -> [Coercion] -> Coercion #

isCoVar_maybe :: Coercion -> Maybe CoVar #

Extract a covar, if possible. This check is dirty. Be ashamed of yourself. (It's dirty because it cares about the structure of a coercion, which is morally reprehensible.)

mkHomoForAllCos :: [TyCoVar] -> Coercion -> Coercion #

Make a Coercion quantified over a type/coercion variable; the variable has the same type in both sides of the coercion

mkForAllCos :: [(TyCoVar, CoercionN)] -> Coercion -> Coercion #

Make nested ForAllCos

mkAppCos :: Coercion -> [Coercion] -> Coercion #

Applies multiple Coercions to another Coercion, from left to right. See also mkAppCo.

mkRepReflCo :: Type -> Coercion #

Make a representational reflexive coercion

isReflexiveCo_maybe :: Coercion -> Maybe (Type, Role) #

Extracts the coerced type from a reflexive coercion. This potentially walks over the entire coercion, so avoid doing this in a loop.

isReflCo_maybe :: Coercion -> Maybe (Type, Role) #

Returns the type coerced if this coercion is reflexive. Guaranteed to work very quickly. Sometimes a coercion can be reflexive, but not obviously so. c.f. isReflexiveCo_maybe

isGReflCo_maybe :: Coercion -> Maybe (Type, Role) #

Returns the type coerced if this coercion is a generalized reflexive coercion. Guaranteed to work very quickly.

splitForAllCo_co_maybe :: Coercion -> Maybe (CoVar, Coercion, Coercion) #

Like splitForAllCo_maybe, but only returns Just for covar binder

splitForAllCo_ty_maybe :: Coercion -> Maybe (TyVar, Coercion, Coercion) #

Like splitForAllCo_maybe, but only returns Just for tyvar binder

splitAppCo_maybe :: Coercion -> Maybe (Coercion, Coercion) #

Attempt to take a coercion application apart.

splitTyConAppCo_maybe :: Coercion -> Maybe (TyCon, [Coercion]) #

Attempts to tease a coercion apart into a type constructor and the application of a number of coercion arguments to that constructor

getCoVar_maybe :: Coercion -> Maybe CoVar #

Attempts to obtain the type variable underlying a Coercion

decomposeCo :: Arity -> Coercion -> [Role] -> [Coercion] #

This breaks a Coercion with type T A B C ~ T D E F into a list of Coercions of kinds A ~ D, B ~ E and E ~ F. Hence:

decomposeCo 3 c [r1, r2, r3] = [nth r1 0 c, nth r2 1 c, nth r3 2 c]

mkCastTyMCo :: Type -> MCoercion -> Type #

Cast a type by an MCoercion

mkSymMCo :: MCoercion -> MCoercion #

Get the reverse of an MCoercion

mkTransMCo :: MCoercion -> MCoercion -> MCoercion #

Compose two MCoercions via transitivity

isGReflMCo :: MCoercion -> Bool #

Tests if this MCoercion is obviously generalized reflexive Guaranteed to work very quickly.

pprCoAxiom :: forall (br :: BranchFlag). CoAxiom br -> SDoc #

type NormaliseStepper ev = RecTcChecker -> TyCon -> [Type] -> NormaliseStepResult ev #

A function to check if we can reduce a type by one step. Used with topNormaliseTypeX.

data NormaliseStepResult ev #

The result of stepping in a normalisation function. See topNormaliseTypeX.

Constructors

NS_Done

Nothing more to do

NS_Abort

Utter failure. The outer function should fail too.

NS_Step RecTcChecker Type ev

We stepped, yielding new bits; ^ ev is evidence; Usually a co :: old type ~ new type

Instances

Instances details
Outputable ev => Outputable (NormaliseStepResult ev) 
Instance details

Defined in GHC.Core.Coercion

Methods

ppr :: NormaliseStepResult ev -> SDoc #

substCos :: HasDebugCallStack => TCvSubst -> [Coercion] -> [Coercion] #

Substitute within several Coercions The substitution has to satisfy the invariants described in Note [The substitution invariant].

substCoWith :: HasDebugCallStack => [TyVar] -> [Type] -> Coercion -> Coercion #

Coercion substitution, see zipTvSubst

type CvSubstEnv = CoVarEnv Coercion #

A substitution of Coercions for CoVars

tidyCo :: TidyEnv -> Coercion -> Coercion #

Tidy a Coercion

See Note [Strictness in tidyType and friends]

tyCoVarsOfCoDSet :: Coercion -> DTyCoVarSet #

Get a deterministic set of the vars free in a coercion

data CoercionHole #

A coercion to be filled in by the type-checker. See Note [Coercion holes]

Constructors

CoercionHole 

Instances

Instances details
Data CoercionHole 
Instance details

Defined in GHC.Core.TyCo.Rep

Methods

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

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

toConstr :: CoercionHole -> Constr #

dataTypeOf :: CoercionHole -> DataType #

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

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

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

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

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

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

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

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

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

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

Uniquable CoercionHole 
Instance details

Defined in GHC.Core.TyCo.Rep

Outputable CoercionHole 
Instance details

Defined in GHC.Core.TyCo.Rep

Methods

ppr :: CoercionHole -> SDoc #

mkReflCo :: Role -> Type -> Coercion #

Make a reflexive coercion

mkTyConAppCo :: HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion #

Apply a type constructor to a list of coercions. It is the caller's responsibility to get the roles correct on argument coercions.

mkAppCo #

Arguments

:: Coercion

:: t1 ~r t2

-> Coercion

:: s1 ~N s2, where s1 :: k1, s2 :: k2

-> Coercion

:: t1 s1 ~r t2 s2

Apply a Coercion to another Coercion. The second coercion must be Nominal, unless the first is Phantom. If the first is Phantom, then the second can be either Phantom or Nominal.

mkForAllCo :: TyCoVar -> CoercionN -> Coercion -> Coercion #

Make a Coercion from a tycovar, a kind coercion, and a body coercion. The kind of the tycovar should be the left-hand kind of the kind coercion. See Note [Unused coercion variable in ForAllCo]

mkFunCo :: Role -> CoercionN -> Coercion -> Coercion -> Coercion #

Build a function Coercion from two other Coercions. That is, given co1 :: a ~ b and co2 :: x ~ y produce co :: (a -> x) ~ (b -> y).

mkPhantomCo :: Coercion -> Type -> Type -> Coercion #

Make a phantom coercion between two types. The coercion passed in must be a nominal coercion between the kinds of the types.

mkUnivCo #

Arguments

:: UnivCoProvenance 
-> Role

role of the built coercion, "r"

-> Type

t1 :: k1

-> Type

t2 :: k2

-> Coercion

:: t1 ~r t2

Make a universal coercion between two arbitrary types.

mkSymCo :: Coercion -> Coercion #

Create a symmetric version of the given Coercion that asserts equality between the same types but in the other "direction", so a kind of t1 ~ t2 becomes the kind t2 ~ t1.

mkTransCo :: Coercion -> Coercion -> Coercion #

Create a new Coercion by composing the two given Coercions transitively. (co1 ; co2)

mkInstCo :: Coercion -> Coercion -> Coercion #

Instantiates a Coercion.

mkGReflCo :: Role -> Type -> MCoercionN -> Coercion #

Make a generalized reflexive coercion

mkNomReflCo :: Type -> Coercion #

Make a nominal reflexive coercion

mkKindCo :: Coercion -> Coercion #

Given co :: (a :: k) ~ (b :: k') produce co' :: k ~ k'.

mkProofIrrelCo #

Arguments

:: Role

role of the created coercion, "r"

-> CoercionN

:: phi1 ~N phi2

-> Coercion

g1 :: phi1

-> Coercion

g2 :: phi2

-> Coercion

:: g1 ~r g2

Make a "coercion between coercions".

isGReflCo :: Coercion -> Bool #

Tests if this coercion is obviously a generalized reflexive coercion. Guaranteed to work very quickly.

isReflCo :: Coercion -> Bool #

Tests if this coercion is obviously reflexive. Guaranteed to work very quickly. Sometimes a coercion can be reflexive, but not obviously so. c.f. isReflexiveCo

isReflexiveCo :: Coercion -> Bool #

Slowly checks if the coercion is reflexive. Don't call this in a loop, as it walks over the entire coercion.

mkCoercionType :: Role -> Type -> Type -> Type #

Makes a coercion type from two types: the types whose equality is proven by the relevant Coercion

liftCoSubst :: HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion #

liftCoSubst role lc ty produces a coercion (at role role) that coerces between lc_left(ty) and lc_right(ty), where lc_left is a substitution mapping type variables to the left-hand types of the mapped coercions in lc, and similar for lc_right.

seqCo :: Coercion -> () #

coercionKind :: Coercion -> Pair Type #

If it is the case that

c :: (t1 ~ t2)

i.e. the kind of c relates t1 and t2, then coercionKind c = Pair t1 t2.

topNormaliseNewType_maybe :: Type -> Maybe (Coercion, Type) #

Sometimes we want to look through a newtype and get its associated coercion. This function strips off newtype layers enough to reveal something that isn't a newtype. Specifically, here's the invariant:

topNormaliseNewType_maybe rec_nts ty = Just (co, ty')

then (a) co : ty ~ ty'. (b) ty' is not a newtype.

The function returns Nothing for non-newtypes, or unsaturated applications

This function does *not* look through type families, because it has no access to the type family environment. If you do have that at hand, consider to use topNormaliseType_maybe, which should be a drop-in replacement for topNormaliseNewType_maybe If topNormliseNewType_maybe ty = Just (co, ty'), then co : ty ~R ty'

data LiftingContext #

Constructors

LC TCvSubst LiftCoEnv 

Instances

Instances details
Outputable LiftingContext 
Instance details

Defined in GHC.Core.Coercion

Methods

ppr :: LiftingContext -> SDoc #

data Role #

Instances

Instances details
Data Role 
Instance details

Defined in GHC.Core.Coercion.Axiom

Methods

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

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

toConstr :: Role -> Constr #

dataTypeOf :: Role -> DataType #

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

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

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

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

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

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

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

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

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

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

Binary Role 
Instance details

Defined in GHC.Core.Coercion.Axiom

Methods

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

put :: BinHandle -> Role -> IO (Bin Role) #

get :: BinHandle -> IO Role #

Outputable Role 
Instance details

Defined in GHC.Core.Coercion.Axiom

Methods

ppr :: Role -> SDoc #

Eq Role 
Instance details

Defined in GHC.Core.Coercion.Axiom

Methods

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

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

Ord Role 
Instance details

Defined in GHC.Core.Coercion.Axiom

Methods

compare :: Role -> Role -> Ordering #

(<) :: Role -> Role -> Bool #

(<=) :: Role -> Role -> Bool #

(>) :: Role -> Role -> Bool #

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

max :: Role -> Role -> Role #

min :: Role -> Role -> Role #

type Anno (Maybe Role) 
Instance details

Defined in GHC.Hs.Decls

type Anno (Maybe Role) 
Instance details

Defined in GHC.Hs.Decls

isCoVar :: Var -> Bool #

Is this a coercion variable? Satisfies isId v ==> isCoVar v == not (isNonCoVarId v).

type CoVar = Id #

Coercion Variable

pickLR :: LeftOrRight -> (a, a) -> a #

data LeftOrRight #

Constructors

CLeft 
CRight 

Instances

Instances details
Data LeftOrRight 
Instance details

Defined in GHC.Types.Basic

Methods

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

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

toConstr :: LeftOrRight -> Constr #

dataTypeOf :: LeftOrRight -> DataType #

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

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

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

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

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

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

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

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

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

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

Binary LeftOrRight 
Instance details

Defined in GHC.Types.Basic

Outputable LeftOrRight 
Instance details

Defined in GHC.Types.Basic

Methods

ppr :: LeftOrRight -> SDoc #

Eq LeftOrRight 
Instance details

Defined in GHC.Types.Basic

data Coercion #

A Coercion is concrete evidence of the equality/convertibility of two types.

Instances

Instances details
Data Coercion 
Instance details

Defined in GHC.Core.TyCo.Rep

Methods

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

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

toConstr :: Coercion -> Constr #

dataTypeOf :: Coercion -> DataType #

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

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

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

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

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

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

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

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

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

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

Outputable Coercion 
Instance details

Defined in GHC.Core.TyCo.Rep

Methods

ppr :: Coercion -> SDoc #

Eq (DeBruijn Coercion) 
Instance details

Defined in GHC.Core.Map.Type

data UnivCoProvenance #

For simplicity, we have just one UnivCo that represents a coercion from some type to some other type, with (in general) no restrictions on the type. The UnivCoProvenance specifies more exactly what the coercion really is and why a program should (or shouldn't!) trust the coercion. It is reasonable to consider each constructor of UnivCoProvenance as a totally independent coercion form; their only commonality is that they don't tell you what types they coercion between. (That info is in the UnivCo constructor of Coercion.

Instances

Instances details
Data UnivCoProvenance 
Instance details

Defined in GHC.Core.TyCo.Rep

Methods

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

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

toConstr :: UnivCoProvenance -> Constr #

dataTypeOf :: UnivCoProvenance -> DataType #

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

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

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

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

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

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

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

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

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

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

Outputable UnivCoProvenance 
Instance details

Defined in GHC.Core.TyCo.Rep

Methods

ppr :: UnivCoProvenance -> SDoc #

data MCoercion #

A semantically more meaningful type to represent what may or may not be a useful Coercion.

Constructors

MRefl 
MCo Coercion 

Instances

Instances details
Data MCoercion 
Instance details

Defined in GHC.Core.TyCo.Rep

Methods

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

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

toConstr :: MCoercion -> Constr #

dataTypeOf :: MCoercion -> DataType #

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

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

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

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

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

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

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

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

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

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

Outputable MCoercion 
Instance details

Defined in GHC.Core.TyCo.Rep

Methods

ppr :: MCoercion -> SDoc #

data Var #

Variable

Essentially a typed Name, that may also contain some additional information about the Var and its use sites.

Instances

Instances details
Data Var 
Instance details

Defined in GHC.Types.Var

Methods

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

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

toConstr :: Var -> Constr #

dataTypeOf :: Var -> DataType #

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

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

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

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

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

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

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

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

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

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

NamedThing Var 
Instance details

Defined in GHC.Types.Var

Methods

getOccName :: Var -> OccName #

getName :: Var -> Name #

HasOccName Var 
Instance details

Defined in GHC.Types.Var

Methods

occName :: Var -> OccName #

Uniquable Var 
Instance details

Defined in GHC.Types.Var

Methods

getUnique :: Var -> Unique #

Outputable Var 
Instance details

Defined in GHC.Types.Var

Methods

ppr :: Var -> SDoc #

Eq Var 
Instance details

Defined in GHC.Types.Var

Methods

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

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

Ord Var 
Instance details

Defined in GHC.Types.Var

Methods

compare :: Var -> Var -> Ordering #

(<) :: Var -> Var -> Bool #

(<=) :: Var -> Var -> Bool #

(>) :: Var -> Var -> Bool #

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

max :: Var -> Var -> Var #

min :: Var -> Var -> Var #

Eq (DeBruijn Var) 
Instance details

Defined in GHC.Core.Map.Type

OutputableBndr (Id, TagSig) 
Instance details

Defined in GHC.Stg.InferTags.TagSig

type Anno Id 
Instance details

Defined in GHC.Hs.Extension

type Anno (LocatedN Id) 
Instance details

Defined in GHC.Hs.Binds

type Anno [LocatedN Id] 
Instance details

Defined in GHC.Hs.Binds

type TyCoVar = Id #

Type or Coercion Variable

data Unique #

Unique identifier.

The type of unique identifiers that are used in many places in GHC for fast ordering and equality tests. You should generate these with the functions from the UniqSupply module

These are sometimes also referred to as "keys" in comments in GHC.

Instances

Instances details
Show Unique 
Instance details

Defined in GHC.Types.Unique

Uniquable Unique 
Instance details

Defined in GHC.Types.Unique

Methods

getUnique :: Unique -> Unique #

Outputable Unique 
Instance details

Defined in GHC.Types.Unique

Methods

ppr :: Unique -> SDoc #

Eq Unique 
Instance details

Defined in GHC.Types.Unique

Methods

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

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

class Uniquable a where #

Class of things that we can obtain a Unique from

Methods

getUnique :: a -> Unique #

Instances

Instances details
Uniquable Reg Source #

so we can put regs in UniqSets

Instance details

Defined in GHC.CmmToAsm.Reg.Graph.Base

Methods

getUnique :: Reg -> Unique #

Uniquable Label 
Instance details

Defined in GHC.Cmm.Dataflow.Label

Methods

getUnique :: Label -> Unique #

Uniquable LocalReg 
Instance details

Defined in GHC.Cmm.Expr

Methods

getUnique :: LocalReg -> Unique #

Uniquable Class 
Instance details

Defined in GHC.Core.Class

Methods

getUnique :: Class -> Unique #

Uniquable CoAxiomRule 
Instance details

Defined in GHC.Core.Coercion.Axiom

Uniquable ConLike 
Instance details

Defined in GHC.Core.ConLike

Methods

getUnique :: ConLike -> Unique #

Uniquable DataCon 
Instance details

Defined in GHC.Core.DataCon

Methods

getUnique :: DataCon -> Unique #

Uniquable PatSyn 
Instance details

Defined in GHC.Core.PatSyn

Methods

getUnique :: PatSyn -> Unique #

Uniquable CoercionHole 
Instance details

Defined in GHC.Core.TyCo.Rep

Uniquable TyCon 
Instance details

Defined in GHC.Core.TyCon

Methods

getUnique :: TyCon -> Unique #

Uniquable FastString 
Instance details

Defined in GHC.Types.Unique

Uniquable RealReg 
Instance details

Defined in GHC.Platform.Reg

Methods

getUnique :: RealReg -> Unique #

Uniquable Reg 
Instance details

Defined in GHC.Platform.Reg

Methods

getUnique :: Reg -> Unique #

Uniquable VirtualReg 
Instance details

Defined in GHC.Platform.Reg

Uniquable RegClass 
Instance details

Defined in GHC.Platform.Reg.Class

Methods

getUnique :: RegClass -> Unique #

Uniquable EvBindsVar 
Instance details

Defined in GHC.Tc.Types.Evidence

Uniquable SkolemInfo 
Instance details

Defined in GHC.Tc.Types.Origin

Uniquable Name 
Instance details

Defined in GHC.Types.Name

Methods

getUnique :: Name -> Unique #

Uniquable OccName 
Instance details

Defined in GHC.Types.Name.Occurrence

Methods

getUnique :: OccName -> Unique #

Uniquable Unique 
Instance details

Defined in GHC.Types.Unique

Methods

getUnique :: Unique -> Unique #

Uniquable Var 
Instance details

Defined in GHC.Types.Var

Methods

getUnique :: Var -> Unique #

Uniquable PackageId 
Instance details

Defined in GHC.Unit.Info

Uniquable PackageName 
Instance details

Defined in GHC.Unit.Info

Uniquable ModuleName 
Instance details

Defined in GHC.Unit.Module.Name

Uniquable Module 
Instance details

Defined in GHC.Unit.Types

Methods

getUnique :: Module -> Unique #

Uniquable UnitId 
Instance details

Defined in GHC.Unit.Types

Methods

getUnique :: UnitId -> Unique #

Uniquable Int 
Instance details

Defined in GHC.Types.Unique

Methods

getUnique :: Int -> Unique #

Uniquable (CoAxiom br) 
Instance details

Defined in GHC.Core.Coercion.Axiom

Methods

getUnique :: CoAxiom br -> Unique #

Uniquable unit => Uniquable (Definite unit) 
Instance details

Defined in GHC.Unit.Types

Methods

getUnique :: Definite unit -> Unique #

IsUnitId u => Uniquable (GenUnit u) 
Instance details

Defined in GHC.Unit.Types

Methods

getUnique :: GenUnit u -> Unique #

data Messages e #

A collection of messages emitted by GHC during error reporting. A diagnostic message is typically a warning or an error. See Note [Messages].

INVARIANT: All the messages in this collection must be relevant, i.e. their Severity should not be SevIgnore. The smart constructor mkMessages will filter out any message which Severity is SevIgnore.

Instances

Instances details
Foldable Messages 
Instance details

Defined in GHC.Types.Error

Methods

fold :: Monoid m => Messages m -> m #

foldMap :: Monoid m => (a -> m) -> Messages a -> m #

foldMap' :: Monoid m => (a -> m) -> Messages a -> m #

foldr :: (a -> b -> b) -> b -> Messages a -> b #

foldr' :: (a -> b -> b) -> b -> Messages a -> b #

foldl :: (b -> a -> b) -> b -> Messages a -> b #

foldl' :: (b -> a -> b) -> b -> Messages a -> b #

foldr1 :: (a -> a -> a) -> Messages a -> a #

foldl1 :: (a -> a -> a) -> Messages a -> a #

toList :: Messages a -> [a] #

null :: Messages a -> Bool #

length :: Messages a -> Int #

elem :: Eq a => a -> Messages a -> Bool #

maximum :: Ord a => Messages a -> a #

minimum :: Ord a => Messages a -> a #

sum :: Num a => Messages a -> a #

product :: Num a => Messages a -> a #

Traversable Messages 
Instance details

Defined in GHC.Types.Error

Methods

traverse :: Applicative f => (a -> f b) -> Messages a -> f (Messages b) #

sequenceA :: Applicative f => Messages (f a) -> f (Messages a) #

mapM :: Monad m => (a -> m b) -> Messages a -> m (Messages b) #

sequence :: Monad m => Messages (m a) -> m (Messages a) #

Functor Messages 
Instance details

Defined in GHC.Types.Error

Methods

fmap :: (a -> b) -> Messages a -> Messages b #

(<$) :: a -> Messages b -> Messages a #

Monoid (Messages e) 
Instance details

Defined in GHC.Types.Error

Methods

mempty :: Messages e #

mappend :: Messages e -> Messages e -> Messages e #

mconcat :: [Messages e] -> Messages e #

Semigroup (Messages e) 
Instance details

Defined in GHC.Types.Error

Methods

(<>) :: Messages e -> Messages e -> Messages e #

sconcat :: NonEmpty (Messages e) -> Messages e #

stimes :: Integral b => b -> Messages e -> Messages e #

Diagnostic e => Outputable (Messages e) 
Instance details

Defined in GHC.Types.Error

Methods

ppr :: Messages e -> SDoc #

Getting Names

thNameToGhcName :: Name -> CoreM (Maybe Name) Source #

Attempt to convert a Template Haskell name to one that GHC can understand. Original TH names such as those you get when you use the 'foo syntax will be translated to their equivalent GHC name exactly. Qualified or unqualified TH names will be dynamically bound to names in the module being compiled, if possible. Exact TH names will be bound to the name they represent, exactly.

thNameToGhcNameIO :: NameCache -> Name -> IO (Maybe Name) Source #

Attempt to convert a Template Haskell name to one that GHC can understand. Original TH names such as those you get when you use the 'foo syntax will be translated to their equivalent GHC name exactly. Qualified or unqualified TH names will be dynamically bound to names in the module being compiled, if possible. Exact TH names will be bound to the name they represent, exactly.

One must be careful to consistently use the same NameCache to create identifier that might be compared. (C.f. how the ST Monad enforces that variables from separate runST invocations are never intermingled; it would be valid to use the same tricks for Names and NameCaches.)

For now, the easiest and recommended way to ensure a consistent NameCache is used it to retrieve the preexisting one from an active HscEnv. A single HscEnv is created per GHC "session", and this ensures everything in that sesssion will getthe same name cache.

Orphan instances