Safe Haskell | None |
---|---|
Language | Haskell2010 |
GHC.Core.Make
Description
Handy functions for creating much Core syntax
Synopsis
- mkCoreLet :: CoreBind -> CoreExpr -> CoreExpr
- mkCoreLets :: [CoreBind] -> CoreExpr -> CoreExpr
- mkCoreApp :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr
- mkCoreApps :: CoreExpr -> [CoreExpr] -> CoreExpr
- mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr
- mkCoreLams :: [CoreBndr] -> CoreExpr -> CoreExpr
- mkWildCase :: CoreExpr -> Scaled Type -> Type -> [CoreAlt] -> CoreExpr
- mkIfThenElse :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr
- mkWildValBinder :: Mult -> Type -> Id
- mkSingleAltCase :: CoreExpr -> Id -> AltCon -> [Var] -> CoreExpr -> CoreExpr
- sortQuantVars :: [Var] -> [Var]
- castBottomExpr :: CoreExpr -> Type -> CoreExpr
- mkLitRubbish :: Type -> Maybe CoreExpr
- mkWordExpr :: Platform -> Integer -> CoreExpr
- mkIntExpr :: Platform -> Integer -> CoreExpr
- mkIntExprInt :: Platform -> Int -> CoreExpr
- mkUncheckedIntExpr :: Integer -> CoreExpr
- mkIntegerExpr :: Platform -> Integer -> CoreExpr
- mkNaturalExpr :: Platform -> Integer -> CoreExpr
- mkFloatExpr :: Float -> CoreExpr
- mkDoubleExpr :: Double -> CoreExpr
- mkCharExpr :: Char -> CoreExpr
- mkStringExpr :: MonadThings m => String -> m CoreExpr
- mkStringExprFS :: MonadThings m => FastString -> m CoreExpr
- mkStringExprFSWith :: MkStringIds -> FastString -> CoreExpr
- data MkStringIds = MkStringIds {
- unpackCStringId :: !Id
- unpackCStringUtf8Id :: !Id
- getMkStringIds :: Applicative m => (Name -> m Id) -> m MkStringIds
- data FloatBind
- wrapFloat :: FloatBind -> CoreExpr -> CoreExpr
- wrapFloats :: [FloatBind] -> CoreExpr -> CoreExpr
- floatBindings :: FloatBind -> [Var]
- mkCoreVarTupTy :: [Id] -> Type
- mkCoreTup :: [CoreExpr] -> CoreExpr
- mkCoreUnboxedTuple :: [CoreExpr] -> CoreExpr
- mkCoreUnboxedSum :: Int -> Int -> [Type] -> CoreExpr -> CoreExpr
- mkCoreTupBoxity :: Boxity -> [CoreExpr] -> CoreExpr
- unitExpr :: CoreExpr
- mkChunkified :: ([a] -> a) -> [a] -> a
- chunkify :: [a] -> [[a]]
- mkBigCoreVarTup :: [Id] -> CoreExpr
- mkBigCoreVarTupSolo :: [Id] -> CoreExpr
- mkBigCoreVarTupTy :: [Id] -> Type
- mkBigCoreTupTy :: [Type] -> Type
- mkBigCoreTup :: [CoreExpr] -> CoreExpr
- mkBigTupleSelector :: [Id] -> Id -> Id -> CoreExpr -> CoreExpr
- mkBigTupleSelectorSolo :: [Id] -> Id -> Id -> CoreExpr -> CoreExpr
- mkBigTupleCase :: MonadUnique m => [Id] -> CoreExpr -> CoreExpr -> m CoreExpr
- mkNilExpr :: Type -> CoreExpr
- mkConsExpr :: Type -> CoreExpr -> CoreExpr -> CoreExpr
- mkListExpr :: Type -> [CoreExpr] -> CoreExpr
- mkFoldrExpr :: MonadThings m => Type -> Type -> CoreExpr -> CoreExpr -> CoreExpr -> m CoreExpr
- mkBuildExpr :: (MonadFail m, MonadThings m, MonadUnique m) => Type -> ((Id, Type) -> (Id, Type) -> m CoreExpr) -> m CoreExpr
- mkNothingExpr :: Type -> CoreExpr
- mkJustExpr :: Type -> CoreExpr -> CoreExpr
- mkRuntimeErrorApp :: Id -> Type -> String -> CoreExpr
- mkImpossibleExpr :: Type -> String -> CoreExpr
- mkAbsentErrorApp :: Type -> String -> CoreExpr
- errorIds :: [Id]
- rEC_CON_ERROR_ID :: Id
- nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id
- nO_METHOD_BINDING_ERROR_ID :: Id
- pAT_ERROR_ID :: Id
- rEC_SEL_ERROR_ID :: Id
- tYPE_ERROR_ID :: Id
- aBSENT_SUM_FIELD_ERROR_ID :: Id
Constructing normal syntax
mkCoreLet :: CoreBind -> CoreExpr -> CoreExpr #
Bind a binding group over an expression, using a let
or case
as
appropriate (see GHC.Core)
mkCoreLets :: [CoreBind] -> CoreExpr -> CoreExpr #
Bind a list of binding groups over an expression. The leftmost binding group becomes the outermost group in the resulting expression
Construct an expression which represents the application of one expression to the other
mkCoreApps infixl 4 #
Construct an expression which represents the application of a number of expressions to another. The leftmost expression in the list is applied first
mkCoreConApps :: DataCon -> [CoreExpr] -> CoreExpr #
Construct an expression which represents the application of a number of expressions to that of a data constructor expression. The leftmost expression in the list is applied first
mkCoreLams :: [CoreBndr] -> CoreExpr -> CoreExpr #
Create a lambda where the given expression has a number of variables bound over it. The leftmost binder is that bound by the outermost lambda in the result
Make a case expression whose case binder is unused The alts and res_ty should not have any occurrences of WildId
mkWildValBinder :: Mult -> Type -> Id #
Make a wildcard binder. This is typically used when you need a binder that you expect to use only at a *binding* site. Do not use it at occurrence sites because it has a single, fixed unique, and it's very easy to get into difficulties with shadowing. That's why it is used so little.
See Note [WildCard binders] in GHC.Core.Opt.Simplify.Env
sortQuantVars :: [Var] -> [Var] #
Sort the variables, putting type and covars first, in scoped order, and then other Ids
It is a deterministic sort, meaning it doesn't look at the values of Uniques. For explanation why it's important See Note [Unique Determinism] in GHC.Types.Unique.
castBottomExpr :: CoreExpr -> Type -> CoreExpr #
Constructing boxed literals
mkLitRubbish :: Type -> Maybe CoreExpr #
mkWordExpr :: Platform -> Integer -> CoreExpr #
Create a CoreExpr
which will evaluate to a Word
with the given value
mkIntExpr :: Platform -> Integer -> CoreExpr #
Create a CoreExpr
which will evaluate to the given Int
mkUncheckedIntExpr :: Integer -> CoreExpr #
Create a CoreExpr
which will evaluate to the given Int
. Don't check
that the number is in the range of the target platform Int
mkIntegerExpr :: Platform -> Integer -> CoreExpr #
Create a CoreExpr
which will evaluate to the given Integer
mkNaturalExpr :: Platform -> Integer -> CoreExpr #
Create a CoreExpr
which will evaluate to the given Natural
mkFloatExpr :: Float -> CoreExpr #
Create a CoreExpr
which will evaluate to the given Float
mkDoubleExpr :: Double -> CoreExpr #
Create a CoreExpr
which will evaluate to the given Double
mkCharExpr :: Char -> CoreExpr #
Create a CoreExpr
which will evaluate to the given Char
mkStringExpr :: MonadThings m => String -> m CoreExpr #
Create a CoreExpr
which will evaluate to the given String
mkStringExprFS :: MonadThings m => FastString -> m CoreExpr #
Create a CoreExpr
which will evaluate to a string morally equivalent to the given FastString
mkStringExprFSWith :: MkStringIds -> FastString -> CoreExpr #
data MkStringIds #
Constructors
MkStringIds | |
Fields
|
getMkStringIds :: Applicative m => (Name -> m Id) -> m MkStringIds #
Floats
Instances
Outputable FloatBind # | |
Defined in GHC.Core.Make |
wrapFloats :: [FloatBind] -> CoreExpr -> CoreExpr #
Applies the floats from right to left. That is wrapFloats [b1, b2, …, bn]
u = let b1 in let b2 in … in let bn in u
floatBindings :: FloatBind -> [Var] #
Constructing small tuples
mkCoreVarTupTy :: [Id] -> Type #
Build the type of a small tuple that holds the specified variables One-tuples are flattened; see Note [Flattening one-tuples]
mkCoreTup :: [CoreExpr] -> CoreExpr #
Build a small tuple holding the specified expressions One-tuples are flattened; see Note [Flattening one-tuples]
mkCoreUnboxedTuple :: [CoreExpr] -> CoreExpr #
Build a small unboxed tuple holding the specified expressions. Do not include the RuntimeRep specifiers; this function calculates them for you. Does not flatten one-tuples; see Note [Flattening one-tuples]
mkCoreUnboxedSum :: Int -> Int -> [Type] -> CoreExpr -> CoreExpr #
Build an unboxed sum.
Alternative number ("alt") starts from 1.
mkCoreTupBoxity :: Boxity -> [CoreExpr] -> CoreExpr #
Make a core tuple of the given boxity; don't flatten 1-tuples
Constructing big tuples
Arguments
:: ([a] -> a) | "Small" constructor function, of maximum input arity |
-> [a] | Possible "big" list of things to construct from |
-> a | Constructed thing made possible by recursive decomposition |
Lifts a "small" constructor into a "big" constructor by recursive decomposition
Split a list into lists that are small enough to have a corresponding
tuple arity. The sub-lists of the result all have length <= mAX_TUPLE_SIZE
But there may be more than mAX_TUPLE_SIZE
sub-lists
mkBigCoreVarTup :: [Id] -> CoreExpr #
Build a big tuple holding the specified variables One-tuples are flattened; see Note [Flattening one-tuples] Arguments don't have to have kind Type
mkBigCoreVarTupSolo :: [Id] -> CoreExpr #
mkBigCoreVarTupTy :: [Id] -> Type #
Build the type of a big tuple that holds the specified variables One-tuples are flattened; see Note [Flattening one-tuples]
mkBigCoreTupTy :: [Type] -> Type #
Build the type of a big tuple that holds the specified type of thing One-tuples are flattened; see Note [Flattening one-tuples]
mkBigCoreTup :: [CoreExpr] -> CoreExpr #
Build a "big" tuple holding the specified expressions One-tuples are flattened; see Note [Flattening one-tuples] Arguments don't have to have kind Type; ones that do not are boxed This function crashes (in wrapBox) if given a non-Type argument that it doesn't know how to box.
Deconstructing big tuples
Arguments
:: [Id] | The |
-> Id | The |
-> Id | A variable of the same type as the scrutinee |
-> CoreExpr | Scrutinee |
-> CoreExpr | Selector expression |
Builds a selector which scrutinises the given expression and extracts the one name from the list given. If you want the no-shadowing rule to apply, the caller is responsible for making sure that none of these names are in scope.
If there is just one Id
in the tuple, then the selector is
just the identity.
If necessary, we pattern match on a "big" tuple.
A tuple selector is not linear in its argument. Consequently, the case
expression built by mkBigTupleSelector
must consume its scrutinee Many
times. And all the argument variables must have multiplicity Many
.
mkBigTupleSelectorSolo
is like mkBigTupleSelector
but one-tuples are NOT flattened (see Note [Flattening one-tuples])
Arguments
:: [Id] | The |
-> Id | The |
-> Id | A variable of the same type as the scrutinee |
-> CoreExpr | Scrutinee |
-> CoreExpr | Selector expression |
Builds a selector which scrutinises the given expression and extracts the one name from the list given. If you want the no-shadowing rule to apply, the caller is responsible for making sure that none of these names are in scope.
If there is just one Id
in the tuple, then the selector is
just the identity.
If necessary, we pattern match on a "big" tuple.
A tuple selector is not linear in its argument. Consequently, the case
expression built by mkBigTupleSelector
must consume its scrutinee Many
times. And all the argument variables must have multiplicity Many
.
Arguments
:: MonadUnique m | |
=> [Id] | The tuple identifiers to pattern match on; Bring these into scope in the body |
-> CoreExpr | Body of the case |
-> CoreExpr | Scrutinee |
-> m CoreExpr |
A generalization of mkBigTupleSelector
, allowing the body
of the case to be an arbitrary expression.
To avoid shadowing, we use uniques to invent new variables.
If necessary we pattern match on a "big" tuple.
Constructing list expressions
mkConsExpr :: Type -> CoreExpr -> CoreExpr -> CoreExpr #
Makes a list (:)
for lists of the specified type
mkListExpr :: Type -> [CoreExpr] -> CoreExpr #
Make a list containing the given expressions, where the list has the given type
Arguments
:: MonadThings m | |
=> Type | Element type of the list |
-> Type | Fold result type |
-> CoreExpr | Cons function expression for the fold |
-> CoreExpr | Nil expression for the fold |
-> CoreExpr | List expression being folded acress |
-> m CoreExpr |
Make a fully applied foldr
expression
Arguments
:: (MonadFail m, MonadThings m, MonadUnique m) | |
=> Type | Type of list elements to be built |
-> ((Id, Type) -> (Id, Type) -> m CoreExpr) | Function that, given information about the |
-> m CoreExpr |
Make a build
expression applied to a locally-bound worker function
Constructing Maybe expressions
mkNothingExpr :: Type -> CoreExpr #
Makes a Nothing for the specified type
mkJustExpr :: Type -> CoreExpr -> CoreExpr #
Makes a Just from a value of the specified type
Error Ids
mkImpossibleExpr :: Type -> String -> CoreExpr #
mkAbsentErrorApp :: Type -> String -> CoreExpr #
rEC_CON_ERROR_ID :: Id #
pAT_ERROR_ID :: Id #
rEC_SEL_ERROR_ID :: Id #
tYPE_ERROR_ID :: Id #