{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Core (
Expr(..), Alt(..), Bind(..), AltCon(..), Arg,
CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr,
InId, InBind, InExpr, InAlt, InArg, InType, InKind,
InBndr, InVar, InCoercion, InTyVar, InCoVar,
OutId, OutBind, OutExpr, OutAlt, OutArg, OutType, OutKind,
OutBndr, OutVar, OutCoercion, OutTyVar, OutCoVar, MOutCoercion,
mkLet, mkLets, mkLetNonRec, mkLetRec, mkLams,
mkApps, mkTyApps, mkCoApps, mkVarApps, mkTyArg,
mkIntLit, mkIntLitWrap,
mkWordLit, mkWordLitWrap,
mkWord8Lit,
mkWord64LitWord64, mkInt64LitInt64,
mkCharLit, mkStringLit,
mkFloatLit, mkFloatLitFloat,
mkDoubleLit, mkDoubleLitDouble,
mkConApp, mkConApp2, mkTyBind, mkCoBind,
varToCoreExpr, varsToCoreExprs,
isId, cmpAltCon, cmpAlt, ltAlt,
bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
collectBinders, collectTyBinders, collectTyAndValBinders,
collectNBinders,
collectArgs, stripNArgs, collectArgsTicks, flattenBinds,
exprToType, exprToCoercion_maybe,
applyTypeToArg,
isValArg, isTypeArg, isCoArg, isTyCoArg, valArgCount, valBndrCount,
isRuntimeArg, isRuntimeVar,
Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
noUnfolding, bootUnfolding, evaldUnfolding, mkOtherCon,
unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
unfoldingTemplate, expandUnfolding_maybe,
maybeUnfoldingTemplate, otherCons,
isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
isStableUnfolding, hasCoreUnfolding, hasSomeUnfolding,
isBootUnfolding,
canUnfold, neverUnfoldGuidance, isStableSource,
AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt(..),
collectAnnArgs, collectAnnArgsTicks,
deAnnotate, deAnnotate', deAnnAlt, deAnnBind,
collectAnnBndrs, collectNAnnBndrs,
IsOrphan(..), isOrphan, notOrphan, chooseOrphanAnchor,
CoreRule(..), RuleBase,
RuleName, RuleFun, IdUnfoldingFun, InScopeEnv,
RuleEnv(..), RuleOpts(..), mkRuleEnv, emptyRuleEnv,
ruleArity, ruleName, ruleIdName, ruleActivation,
setRuleIdName, ruleModule,
isBuiltinRule, isLocalRule, isAutoRule,
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Platform
import GHC.Types.Var.Env( InScopeSet )
import GHC.Types.Var
import GHC.Core.Type
import GHC.Core.Coercion
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env( NameEnv, emptyNameEnv )
import GHC.Types.Literal
import GHC.Types.Tickish
import GHC.Core.DataCon
import GHC.Unit.Module
import GHC.Types.Basic
import GHC.Types.Unique.Set
import GHC.Utils.Binary
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Driver.Ppr
import Data.Data hiding (TyCon)
import Data.Int
import Data.Word
infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`, `mkCoApps`
data Expr b
= Var Id
| Lit Literal
| App (Expr b) (Arg b)
| Lam b (Expr b)
| Let (Bind b) (Expr b)
| Case (Expr b) b Type [Alt b]
| Cast (Expr b) CoercionR
| Tick CoreTickish (Expr b)
| Type Type
| Coercion Coercion
deriving Expr b -> DataType
Expr b -> Constr
forall {b}. Data b => Typeable (Expr b)
forall b. Data b => Expr b -> DataType
forall b. Data b => Expr b -> Constr
forall b.
Data b =>
(forall b. Data b => b -> b) -> Expr b -> Expr b
forall b u.
Data b =>
ConTag -> (forall d. Data d => d -> u) -> Expr b -> u
forall b u. Data b => (forall d. Data d => d -> u) -> Expr b -> [u]
forall b r r'.
Data b =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr b -> r
forall b r r'.
Data b =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr b -> r
forall b (m :: * -> *).
(Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Expr b -> m (Expr b)
forall b (m :: * -> *).
(Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Expr b -> m (Expr b)
forall b (c :: * -> *).
Data b =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Expr b)
forall b (c :: * -> *).
Data b =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr b -> c (Expr b)
forall b (t :: * -> *) (c :: * -> *).
(Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Expr b))
forall b (t :: * -> * -> *) (c :: * -> *).
(Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Expr b))
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. ConTag -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Expr b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr b -> c (Expr b)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Expr b))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expr b -> m (Expr b)
$cgmapMo :: forall b (m :: * -> *).
(Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Expr b -> m (Expr b)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Expr b -> m (Expr b)
$cgmapMp :: forall b (m :: * -> *).
(Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Expr b -> m (Expr b)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Expr b -> m (Expr b)
$cgmapM :: forall b (m :: * -> *).
(Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Expr b -> m (Expr b)
gmapQi :: forall u. ConTag -> (forall d. Data d => d -> u) -> Expr b -> u
$cgmapQi :: forall b u.
Data b =>
ConTag -> (forall d. Data d => d -> u) -> Expr b -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Expr b -> [u]
$cgmapQ :: forall b u. Data b => (forall d. Data d => d -> u) -> Expr b -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr b -> r
$cgmapQr :: forall b r r'.
Data b =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Expr b -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr b -> r
$cgmapQl :: forall b r r'.
Data b =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Expr b -> r
gmapT :: (forall b. Data b => b -> b) -> Expr b -> Expr b
$cgmapT :: forall b.
Data b =>
(forall b. Data b => b -> b) -> Expr b -> Expr b
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Expr b))
$cdataCast2 :: forall b (t :: * -> * -> *) (c :: * -> *).
(Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Expr b))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Expr b))
$cdataCast1 :: forall b (t :: * -> *) (c :: * -> *).
(Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Expr b))
dataTypeOf :: Expr b -> DataType
$cdataTypeOf :: forall b. Data b => Expr b -> DataType
toConstr :: Expr b -> Constr
$ctoConstr :: forall b. Data b => Expr b -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Expr b)
$cgunfold :: forall b (c :: * -> *).
Data b =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Expr b)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr b -> c (Expr b)
$cgfoldl :: forall b (c :: * -> *).
Data b =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Expr b -> c (Expr b)
Data
type Arg b = Expr b
data Alt b
= Alt AltCon [b] (Expr b)
deriving (Alt b -> DataType
Alt b -> Constr
forall {b}. Data b => Typeable (Alt b)
forall b. Data b => Alt b -> DataType
forall b. Data b => Alt b -> Constr
forall b. Data b => (forall b. Data b => b -> b) -> Alt b -> Alt b
forall b u.
Data b =>
ConTag -> (forall d. Data d => d -> u) -> Alt b -> u
forall b u. Data b => (forall d. Data d => d -> u) -> Alt b -> [u]
forall b r r'.
Data b =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Alt b -> r
forall b r r'.
Data b =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Alt b -> r
forall b (m :: * -> *).
(Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Alt b -> m (Alt b)
forall b (m :: * -> *).
(Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Alt b -> m (Alt b)
forall b (c :: * -> *).
Data b =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Alt b)
forall b (c :: * -> *).
Data b =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Alt b -> c (Alt b)
forall b (t :: * -> *) (c :: * -> *).
(Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Alt b))
forall b (t :: * -> * -> *) (c :: * -> *).
(Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Alt b))
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. ConTag -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Alt b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Alt b -> c (Alt b)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Alt b))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Alt b -> m (Alt b)
$cgmapMo :: forall b (m :: * -> *).
(Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Alt b -> m (Alt b)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Alt b -> m (Alt b)
$cgmapMp :: forall b (m :: * -> *).
(Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Alt b -> m (Alt b)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Alt b -> m (Alt b)
$cgmapM :: forall b (m :: * -> *).
(Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Alt b -> m (Alt b)
gmapQi :: forall u. ConTag -> (forall d. Data d => d -> u) -> Alt b -> u
$cgmapQi :: forall b u.
Data b =>
ConTag -> (forall d. Data d => d -> u) -> Alt b -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Alt b -> [u]
$cgmapQ :: forall b u. Data b => (forall d. Data d => d -> u) -> Alt b -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Alt b -> r
$cgmapQr :: forall b r r'.
Data b =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Alt b -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Alt b -> r
$cgmapQl :: forall b r r'.
Data b =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Alt b -> r
gmapT :: (forall b. Data b => b -> b) -> Alt b -> Alt b
$cgmapT :: forall b. Data b => (forall b. Data b => b -> b) -> Alt b -> Alt b
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Alt b))
$cdataCast2 :: forall b (t :: * -> * -> *) (c :: * -> *).
(Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Alt b))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Alt b))
$cdataCast1 :: forall b (t :: * -> *) (c :: * -> *).
(Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Alt b))
dataTypeOf :: Alt b -> DataType
$cdataTypeOf :: forall b. Data b => Alt b -> DataType
toConstr :: Alt b -> Constr
$ctoConstr :: forall b. Data b => Alt b -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Alt b)
$cgunfold :: forall b (c :: * -> *).
Data b =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Alt b)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Alt b -> c (Alt b)
$cgfoldl :: forall b (c :: * -> *).
Data b =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Alt b -> c (Alt b)
Data)
data AltCon
= DataAlt DataCon
| LitAlt Literal
| DEFAULT
deriving (AltCon -> AltCon -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AltCon -> AltCon -> Bool
$c/= :: AltCon -> AltCon -> Bool
== :: AltCon -> AltCon -> Bool
$c== :: AltCon -> AltCon -> Bool
Eq, Typeable AltCon
AltCon -> DataType
AltCon -> Constr
(forall b. Data b => b -> b) -> AltCon -> AltCon
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. ConTag -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. ConTag -> (forall d. Data d => d -> u) -> AltCon -> u
forall u. (forall d. Data d => d -> u) -> AltCon -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> AltCon -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> AltCon -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AltCon -> m AltCon
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AltCon -> m AltCon
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AltCon
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AltCon -> c AltCon
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AltCon)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AltCon)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AltCon -> m AltCon
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AltCon -> m AltCon
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AltCon -> m AltCon
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AltCon -> m AltCon
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AltCon -> m AltCon
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AltCon -> m AltCon
gmapQi :: forall u. ConTag -> (forall d. Data d => d -> u) -> AltCon -> u
$cgmapQi :: forall u. ConTag -> (forall d. Data d => d -> u) -> AltCon -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> AltCon -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AltCon -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> AltCon -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> AltCon -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> AltCon -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> AltCon -> r
gmapT :: (forall b. Data b => b -> b) -> AltCon -> AltCon
$cgmapT :: (forall b. Data b => b -> b) -> AltCon -> AltCon
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AltCon)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AltCon)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AltCon)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AltCon)
dataTypeOf :: AltCon -> DataType
$cdataTypeOf :: AltCon -> DataType
toConstr :: AltCon -> Constr
$ctoConstr :: AltCon -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AltCon
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AltCon
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AltCon -> c AltCon
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AltCon -> c AltCon
Data)
instance Ord AltCon where
compare :: AltCon -> AltCon -> Ordering
compare (DataAlt DataCon
con1) (DataAlt DataCon
con2) =
ASSERT( dataConTyCon con1 == dataConTyCon con2 )
forall a. Ord a => a -> a -> Ordering
compare (DataCon -> ConTag
dataConTag DataCon
con1) (DataCon -> ConTag
dataConTag DataCon
con2)
compare (DataAlt DataCon
_) AltCon
_ = Ordering
GT
compare AltCon
_ (DataAlt DataCon
_) = Ordering
LT
compare (LitAlt Literal
l1) (LitAlt Literal
l2) = forall a. Ord a => a -> a -> Ordering
compare Literal
l1 Literal
l2
compare (LitAlt Literal
_) AltCon
DEFAULT = Ordering
GT
compare AltCon
DEFAULT AltCon
DEFAULT = Ordering
EQ
compare AltCon
DEFAULT AltCon
_ = Ordering
LT
data Bind b = NonRec b (Expr b)
| Rec [(b, (Expr b))]
deriving Bind b -> DataType
Bind b -> Constr
forall {b}. Data b => Typeable (Bind b)
forall b. Data b => Bind b -> DataType
forall b. Data b => Bind b -> Constr
forall b.
Data b =>
(forall b. Data b => b -> b) -> Bind b -> Bind b
forall b u.
Data b =>
ConTag -> (forall d. Data d => d -> u) -> Bind b -> u
forall b u. Data b => (forall d. Data d => d -> u) -> Bind b -> [u]
forall b r r'.
Data b =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bind b -> r
forall b r r'.
Data b =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bind b -> r
forall b (m :: * -> *).
(Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Bind b -> m (Bind b)
forall b (m :: * -> *).
(Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Bind b -> m (Bind b)
forall b (c :: * -> *).
Data b =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bind b)
forall b (c :: * -> *).
Data b =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bind b -> c (Bind b)
forall b (t :: * -> *) (c :: * -> *).
(Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Bind b))
forall b (t :: * -> * -> *) (c :: * -> *).
(Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Bind b))
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. ConTag -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bind b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bind b -> c (Bind b)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Bind b))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bind b -> m (Bind b)
$cgmapMo :: forall b (m :: * -> *).
(Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Bind b -> m (Bind b)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Bind b -> m (Bind b)
$cgmapMp :: forall b (m :: * -> *).
(Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Bind b -> m (Bind b)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Bind b -> m (Bind b)
$cgmapM :: forall b (m :: * -> *).
(Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Bind b -> m (Bind b)
gmapQi :: forall u. ConTag -> (forall d. Data d => d -> u) -> Bind b -> u
$cgmapQi :: forall b u.
Data b =>
ConTag -> (forall d. Data d => d -> u) -> Bind b -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Bind b -> [u]
$cgmapQ :: forall b u. Data b => (forall d. Data d => d -> u) -> Bind b -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bind b -> r
$cgmapQr :: forall b r r'.
Data b =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Bind b -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bind b -> r
$cgmapQl :: forall b r r'.
Data b =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Bind b -> r
gmapT :: (forall b. Data b => b -> b) -> Bind b -> Bind b
$cgmapT :: forall b.
Data b =>
(forall b. Data b => b -> b) -> Bind b -> Bind b
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Bind b))
$cdataCast2 :: forall b (t :: * -> * -> *) (c :: * -> *).
(Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Bind b))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Bind b))
$cdataCast1 :: forall b (t :: * -> *) (c :: * -> *).
(Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Bind b))
dataTypeOf :: Bind b -> DataType
$cdataTypeOf :: forall b. Data b => Bind b -> DataType
toConstr :: Bind b -> Constr
$ctoConstr :: forall b. Data b => Bind b -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bind b)
$cgunfold :: forall b (c :: * -> *).
Data b =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bind b)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bind b -> c (Bind b)
$cgfoldl :: forall b (c :: * -> *).
Data b =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bind b -> c (Bind b)
Data
type InBndr = CoreBndr
type InType = Type
type InKind = Kind
type InBind = CoreBind
type InExpr = CoreExpr
type InAlt = CoreAlt
type InArg = CoreArg
type InCoercion = Coercion
type OutBndr = CoreBndr
type OutType = Type
type OutKind = Kind
type OutCoercion = Coercion
type OutBind = CoreBind
type OutExpr = CoreExpr
type OutAlt = CoreAlt
type OutArg = CoreArg
type MOutCoercion = MCoercion
data IsOrphan
= IsOrphan
| NotOrphan OccName
deriving Typeable IsOrphan
IsOrphan -> DataType
IsOrphan -> Constr
(forall b. Data b => b -> b) -> IsOrphan -> IsOrphan
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. ConTag -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. ConTag -> (forall d. Data d => d -> u) -> IsOrphan -> u
forall u. (forall d. Data d => d -> u) -> IsOrphan -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IsOrphan -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IsOrphan -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IsOrphan -> m IsOrphan
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IsOrphan -> m IsOrphan
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IsOrphan
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IsOrphan -> c IsOrphan
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IsOrphan)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IsOrphan)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IsOrphan -> m IsOrphan
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IsOrphan -> m IsOrphan
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IsOrphan -> m IsOrphan
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IsOrphan -> m IsOrphan
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IsOrphan -> m IsOrphan
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IsOrphan -> m IsOrphan
gmapQi :: forall u. ConTag -> (forall d. Data d => d -> u) -> IsOrphan -> u
$cgmapQi :: forall u. ConTag -> (forall d. Data d => d -> u) -> IsOrphan -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> IsOrphan -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IsOrphan -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IsOrphan -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IsOrphan -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IsOrphan -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IsOrphan -> r
gmapT :: (forall b. Data b => b -> b) -> IsOrphan -> IsOrphan
$cgmapT :: (forall b. Data b => b -> b) -> IsOrphan -> IsOrphan
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IsOrphan)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IsOrphan)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IsOrphan)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IsOrphan)
dataTypeOf :: IsOrphan -> DataType
$cdataTypeOf :: IsOrphan -> DataType
toConstr :: IsOrphan -> Constr
$ctoConstr :: IsOrphan -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IsOrphan
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IsOrphan
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IsOrphan -> c IsOrphan
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IsOrphan -> c IsOrphan
Data
isOrphan :: IsOrphan -> Bool
isOrphan :: IsOrphan -> Bool
isOrphan IsOrphan
IsOrphan = Bool
True
isOrphan IsOrphan
_ = Bool
False
notOrphan :: IsOrphan -> Bool
notOrphan :: IsOrphan -> Bool
notOrphan NotOrphan{} = Bool
True
notOrphan IsOrphan
_ = Bool
False
chooseOrphanAnchor :: NameSet -> IsOrphan
chooseOrphanAnchor :: NameSet -> IsOrphan
chooseOrphanAnchor NameSet
local_names
| NameSet -> Bool
isEmptyNameSet NameSet
local_names = IsOrphan
IsOrphan
| Bool
otherwise = OccName -> IsOrphan
NotOrphan (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [OccName]
occs)
where
occs :: [OccName]
occs = forall a b. (a -> b) -> [a] -> [b]
map Name -> OccName
nameOccName forall a b. (a -> b) -> a -> b
$ forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet NameSet
local_names
instance Binary IsOrphan where
put_ :: BinHandle -> IsOrphan -> IO ()
put_ BinHandle
bh IsOrphan
IsOrphan = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
put_ BinHandle
bh (NotOrphan OccName
n) = do
BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh OccName
n
get :: BinHandle -> IO IsOrphan
get BinHandle
bh = do
Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
case Word8
h of
Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return IsOrphan
IsOrphan
Word8
_ -> do
OccName
n <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OccName -> IsOrphan
NotOrphan OccName
n
type RuleBase = NameEnv [CoreRule]
data RuleEnv
= RuleEnv { RuleEnv -> RuleBase
re_base :: RuleBase
, RuleEnv -> ModuleSet
re_visible_orphs :: ModuleSet
}
mkRuleEnv :: RuleBase -> [Module] -> RuleEnv
mkRuleEnv :: RuleBase -> [Module] -> RuleEnv
mkRuleEnv RuleBase
rules [Module]
vis_orphs = RuleBase -> ModuleSet -> RuleEnv
RuleEnv RuleBase
rules ([Module] -> ModuleSet
mkModuleSet [Module]
vis_orphs)
emptyRuleEnv :: RuleEnv
emptyRuleEnv :: RuleEnv
emptyRuleEnv = RuleBase -> ModuleSet -> RuleEnv
RuleEnv forall a. NameEnv a
emptyNameEnv ModuleSet
emptyModuleSet
data CoreRule
= Rule {
CoreRule -> RuleName
ru_name :: RuleName,
CoreRule -> Activation
ru_act :: Activation,
CoreRule -> Name
ru_fn :: Name,
CoreRule -> [Maybe Name]
ru_rough :: [Maybe Name],
CoreRule -> [Id]
ru_bndrs :: [CoreBndr],
CoreRule -> [CoreExpr]
ru_args :: [CoreExpr],
CoreRule -> CoreExpr
ru_rhs :: CoreExpr,
CoreRule -> Bool
ru_auto :: Bool,
CoreRule -> Module
ru_origin :: !Module,
CoreRule -> IsOrphan
ru_orphan :: !IsOrphan,
CoreRule -> Bool
ru_local :: Bool
}
| BuiltinRule {
ru_name :: RuleName,
ru_fn :: Name,
CoreRule -> ConTag
ru_nargs :: Int,
CoreRule -> RuleFun
ru_try :: RuleFun
}
data RuleOpts = RuleOpts
{ RuleOpts -> Platform
roPlatform :: !Platform
, RuleOpts -> Bool
roNumConstantFolding :: !Bool
, RuleOpts -> Bool
roExcessRationalPrecision :: !Bool
, RuleOpts -> Bool
roBignumRules :: !Bool
}
type RuleFun = RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe CoreExpr
type InScopeEnv = (InScopeSet, IdUnfoldingFun)
type IdUnfoldingFun = Id -> Unfolding
isBuiltinRule :: CoreRule -> Bool
isBuiltinRule :: CoreRule -> Bool
isBuiltinRule (BuiltinRule {}) = Bool
True
isBuiltinRule CoreRule
_ = Bool
False
isAutoRule :: CoreRule -> Bool
isAutoRule :: CoreRule -> Bool
isAutoRule (BuiltinRule {}) = Bool
False
isAutoRule (Rule { ru_auto :: CoreRule -> Bool
ru_auto = Bool
is_auto }) = Bool
is_auto
ruleArity :: CoreRule -> Int
ruleArity :: CoreRule -> ConTag
ruleArity (BuiltinRule {ru_nargs :: CoreRule -> ConTag
ru_nargs = ConTag
n}) = ConTag
n
ruleArity (Rule {ru_args :: CoreRule -> [CoreExpr]
ru_args = [CoreExpr]
args}) = forall (t :: * -> *) a. Foldable t => t a -> ConTag
length [CoreExpr]
args
ruleName :: CoreRule -> RuleName
ruleName :: CoreRule -> RuleName
ruleName = CoreRule -> RuleName
ru_name
ruleModule :: CoreRule -> Maybe Module
ruleModule :: CoreRule -> Maybe Module
ruleModule Rule { Module
ru_origin :: Module
ru_origin :: CoreRule -> Module
ru_origin } = forall a. a -> Maybe a
Just Module
ru_origin
ruleModule BuiltinRule {} = forall a. Maybe a
Nothing
ruleActivation :: CoreRule -> Activation
ruleActivation :: CoreRule -> Activation
ruleActivation (BuiltinRule { }) = Activation
AlwaysActive
ruleActivation (Rule { ru_act :: CoreRule -> Activation
ru_act = Activation
act }) = Activation
act
ruleIdName :: CoreRule -> Name
ruleIdName :: CoreRule -> Name
ruleIdName = CoreRule -> Name
ru_fn
isLocalRule :: CoreRule -> Bool
isLocalRule :: CoreRule -> Bool
isLocalRule = CoreRule -> Bool
ru_local
setRuleIdName :: Name -> CoreRule -> CoreRule
setRuleIdName :: Name -> CoreRule -> CoreRule
setRuleIdName Name
nm CoreRule
ru = CoreRule
ru { ru_fn :: Name
ru_fn = Name
nm }
data Unfolding
= NoUnfolding
| BootUnfolding
| OtherCon [AltCon]
| DFunUnfolding {
Unfolding -> [Id]
df_bndrs :: [Var],
Unfolding -> DataCon
df_con :: DataCon,
Unfolding -> [CoreExpr]
df_args :: [CoreExpr]
}
| CoreUnfolding {
Unfolding -> CoreExpr
uf_tmpl :: CoreExpr,
Unfolding -> UnfoldingSource
uf_src :: UnfoldingSource,
Unfolding -> Bool
uf_is_top :: Bool,
Unfolding -> Bool
uf_is_value :: Bool,
Unfolding -> Bool
uf_is_conlike :: Bool,
Unfolding -> Bool
uf_is_work_free :: Bool,
Unfolding -> Bool
uf_expandable :: Bool,
Unfolding -> UnfoldingGuidance
uf_guidance :: UnfoldingGuidance
}
data UnfoldingSource
=
InlineRhs
| InlineStable
| InlineCompulsory
data UnfoldingGuidance
= UnfWhen {
UnfoldingGuidance -> ConTag
ug_arity :: Arity,
UnfoldingGuidance -> Bool
ug_unsat_ok :: Bool,
UnfoldingGuidance -> Bool
ug_boring_ok :: Bool
}
| UnfIfGoodArgs {
UnfoldingGuidance -> [ConTag]
ug_args :: [Int],
UnfoldingGuidance -> ConTag
ug_size :: Int,
UnfoldingGuidance -> ConTag
ug_res :: Int
}
| UnfNever
deriving (UnfoldingGuidance -> UnfoldingGuidance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnfoldingGuidance -> UnfoldingGuidance -> Bool
$c/= :: UnfoldingGuidance -> UnfoldingGuidance -> Bool
== :: UnfoldingGuidance -> UnfoldingGuidance -> Bool
$c== :: UnfoldingGuidance -> UnfoldingGuidance -> Bool
Eq)
needSaturated, unSaturatedOk :: Bool
needSaturated :: Bool
needSaturated = Bool
False
unSaturatedOk :: Bool
unSaturatedOk = Bool
True
boringCxtNotOk, boringCxtOk :: Bool
boringCxtOk :: Bool
boringCxtOk = Bool
True
boringCxtNotOk :: Bool
boringCxtNotOk = Bool
False
noUnfolding :: Unfolding
evaldUnfolding :: Unfolding
noUnfolding :: Unfolding
noUnfolding = Unfolding
NoUnfolding
evaldUnfolding :: Unfolding
evaldUnfolding = [AltCon] -> Unfolding
OtherCon []
bootUnfolding :: Unfolding
bootUnfolding :: Unfolding
bootUnfolding = Unfolding
BootUnfolding
mkOtherCon :: [AltCon] -> Unfolding
mkOtherCon :: [AltCon] -> Unfolding
mkOtherCon = [AltCon] -> Unfolding
OtherCon
isStableSource :: UnfoldingSource -> Bool
isStableSource :: UnfoldingSource -> Bool
isStableSource UnfoldingSource
InlineCompulsory = Bool
True
isStableSource UnfoldingSource
InlineStable = Bool
True
isStableSource UnfoldingSource
InlineRhs = Bool
False
unfoldingTemplate :: Unfolding -> CoreExpr
unfoldingTemplate :: Unfolding -> CoreExpr
unfoldingTemplate = Unfolding -> CoreExpr
uf_tmpl
maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl :: Unfolding -> CoreExpr
uf_tmpl = CoreExpr
expr })
= forall a. a -> Maybe a
Just CoreExpr
expr
maybeUnfoldingTemplate (DFunUnfolding { df_bndrs :: Unfolding -> [Id]
df_bndrs = [Id]
bndrs, df_con :: Unfolding -> DataCon
df_con = DataCon
con, df_args :: Unfolding -> [CoreExpr]
df_args = [CoreExpr]
args })
= forall a. a -> Maybe a
Just (forall b. [b] -> Expr b -> Expr b
mkLams [Id]
bndrs (forall b. Expr b -> [Expr b] -> Expr b
mkApps (forall b. Id -> Expr b
Var (DataCon -> Id
dataConWorkId DataCon
con)) [CoreExpr]
args))
maybeUnfoldingTemplate Unfolding
_
= forall a. Maybe a
Nothing
otherCons :: Unfolding -> [AltCon]
otherCons :: Unfolding -> [AltCon]
otherCons (OtherCon [AltCon]
cons) = [AltCon]
cons
otherCons Unfolding
_ = []
isValueUnfolding :: Unfolding -> Bool
isValueUnfolding :: Unfolding -> Bool
isValueUnfolding (CoreUnfolding { uf_is_value :: Unfolding -> Bool
uf_is_value = Bool
is_evald }) = Bool
is_evald
isValueUnfolding Unfolding
_ = Bool
False
isEvaldUnfolding :: Unfolding -> Bool
isEvaldUnfolding :: Unfolding -> Bool
isEvaldUnfolding (OtherCon [AltCon]
_) = Bool
True
isEvaldUnfolding (CoreUnfolding { uf_is_value :: Unfolding -> Bool
uf_is_value = Bool
is_evald }) = Bool
is_evald
isEvaldUnfolding Unfolding
_ = Bool
False
isConLikeUnfolding :: Unfolding -> Bool
isConLikeUnfolding :: Unfolding -> Bool
isConLikeUnfolding (OtherCon [AltCon]
_) = Bool
True
isConLikeUnfolding (CoreUnfolding { uf_is_conlike :: Unfolding -> Bool
uf_is_conlike = Bool
con }) = Bool
con
isConLikeUnfolding Unfolding
_ = Bool
False
isCheapUnfolding :: Unfolding -> Bool
isCheapUnfolding :: Unfolding -> Bool
isCheapUnfolding (CoreUnfolding { uf_is_work_free :: Unfolding -> Bool
uf_is_work_free = Bool
is_wf }) = Bool
is_wf
isCheapUnfolding Unfolding
_ = Bool
False
isExpandableUnfolding :: Unfolding -> Bool
isExpandableUnfolding :: Unfolding -> Bool
isExpandableUnfolding (CoreUnfolding { uf_expandable :: Unfolding -> Bool
uf_expandable = Bool
is_expable }) = Bool
is_expable
isExpandableUnfolding Unfolding
_ = Bool
False
expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
expandUnfolding_maybe (CoreUnfolding { uf_expandable :: Unfolding -> Bool
uf_expandable = Bool
True, uf_tmpl :: Unfolding -> CoreExpr
uf_tmpl = CoreExpr
rhs }) = forall a. a -> Maybe a
Just CoreExpr
rhs
expandUnfolding_maybe Unfolding
_ = forall a. Maybe a
Nothing
isCompulsoryUnfolding :: Unfolding -> Bool
isCompulsoryUnfolding :: Unfolding -> Bool
isCompulsoryUnfolding (CoreUnfolding { uf_src :: Unfolding -> UnfoldingSource
uf_src = UnfoldingSource
InlineCompulsory }) = Bool
True
isCompulsoryUnfolding Unfolding
_ = Bool
False
isStableUnfolding :: Unfolding -> Bool
isStableUnfolding :: Unfolding -> Bool
isStableUnfolding (CoreUnfolding { uf_src :: Unfolding -> UnfoldingSource
uf_src = UnfoldingSource
src }) = UnfoldingSource -> Bool
isStableSource UnfoldingSource
src
isStableUnfolding (DFunUnfolding {}) = Bool
True
isStableUnfolding Unfolding
_ = Bool
False
hasSomeUnfolding :: Unfolding -> Bool
hasSomeUnfolding :: Unfolding -> Bool
hasSomeUnfolding Unfolding
NoUnfolding = Bool
False
hasSomeUnfolding Unfolding
BootUnfolding = Bool
False
hasSomeUnfolding Unfolding
_ = Bool
True
isBootUnfolding :: Unfolding -> Bool
isBootUnfolding :: Unfolding -> Bool
isBootUnfolding Unfolding
BootUnfolding = Bool
True
isBootUnfolding Unfolding
_ = Bool
False
neverUnfoldGuidance :: UnfoldingGuidance -> Bool
neverUnfoldGuidance :: UnfoldingGuidance -> Bool
neverUnfoldGuidance UnfoldingGuidance
UnfNever = Bool
True
neverUnfoldGuidance UnfoldingGuidance
_ = Bool
False
hasCoreUnfolding :: Unfolding -> Bool
hasCoreUnfolding :: Unfolding -> Bool
hasCoreUnfolding (CoreUnfolding {}) = Bool
True
hasCoreUnfolding (DFunUnfolding {}) = Bool
True
hasCoreUnfolding Unfolding
_ = Bool
False
canUnfold :: Unfolding -> Bool
canUnfold :: Unfolding -> Bool
canUnfold (CoreUnfolding { uf_guidance :: Unfolding -> UnfoldingGuidance
uf_guidance = UnfoldingGuidance
g }) = Bool -> Bool
not (UnfoldingGuidance -> Bool
neverUnfoldGuidance UnfoldingGuidance
g)
canUnfold Unfolding
_ = Bool
False
instance Outputable AltCon where
ppr :: AltCon -> SDoc
ppr (DataAlt DataCon
dc) = forall a. Outputable a => a -> SDoc
ppr DataCon
dc
ppr (LitAlt Literal
lit) = forall a. Outputable a => a -> SDoc
ppr Literal
lit
ppr AltCon
DEFAULT = String -> SDoc
text String
"__DEFAULT"
cmpAlt :: Alt a -> Alt a -> Ordering
cmpAlt :: forall a. Alt a -> Alt a -> Ordering
cmpAlt (Alt AltCon
con1 [a]
_ Expr a
_) (Alt AltCon
con2 [a]
_ Expr a
_) = AltCon
con1 AltCon -> AltCon -> Ordering
`cmpAltCon` AltCon
con2
ltAlt :: Alt a -> Alt a -> Bool
ltAlt :: forall a. Alt a -> Alt a -> Bool
ltAlt Alt a
a1 Alt a
a2 = (Alt a
a1 forall a. Alt a -> Alt a -> Ordering
`cmpAlt` Alt a
a2) forall a. Eq a => a -> a -> Bool
== Ordering
LT
cmpAltCon :: AltCon -> AltCon -> Ordering
cmpAltCon :: AltCon -> AltCon -> Ordering
cmpAltCon AltCon
DEFAULT AltCon
DEFAULT = Ordering
EQ
cmpAltCon AltCon
DEFAULT AltCon
_ = Ordering
LT
cmpAltCon (DataAlt DataCon
d1) (DataAlt DataCon
d2) = DataCon -> ConTag
dataConTag DataCon
d1 forall a. Ord a => a -> a -> Ordering
`compare` DataCon -> ConTag
dataConTag DataCon
d2
cmpAltCon (DataAlt DataCon
_) AltCon
DEFAULT = Ordering
GT
cmpAltCon (LitAlt Literal
l1) (LitAlt Literal
l2) = Literal
l1 forall a. Ord a => a -> a -> Ordering
`compare` Literal
l2
cmpAltCon (LitAlt Literal
_) AltCon
DEFAULT = Ordering
GT
cmpAltCon AltCon
con1 AltCon
con2 = WARN( True, text "Comparing incomparable AltCons" <+>
ppr con1 <+> ppr con2 )
Ordering
LT
type CoreProgram = [CoreBind]
type CoreBndr = Var
type CoreExpr = Expr CoreBndr
type CoreArg = Arg CoreBndr
type CoreBind = Bind CoreBndr
type CoreAlt = Alt CoreBndr
data TaggedBndr t = TB CoreBndr t
type TaggedBind t = Bind (TaggedBndr t)
type TaggedExpr t = Expr (TaggedBndr t)
type TaggedArg t = Arg (TaggedBndr t)
type TaggedAlt t = Alt (TaggedBndr t)
instance Outputable b => Outputable (TaggedBndr b) where
ppr :: TaggedBndr b -> SDoc
ppr (TB Id
b b
l) = Char -> SDoc
char Char
'<' SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr Id
b SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<> forall a. Outputable a => a -> SDoc
ppr b
l SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'>'
deTagExpr :: TaggedExpr t -> CoreExpr
deTagExpr :: forall t. TaggedExpr t -> CoreExpr
deTagExpr (Var Id
v) = forall b. Id -> Expr b
Var Id
v
deTagExpr (Lit Literal
l) = forall b. Literal -> Expr b
Lit Literal
l
deTagExpr (Type Type
ty) = forall b. Type -> Expr b
Type Type
ty
deTagExpr (Coercion CoercionR
co) = forall b. CoercionR -> Expr b
Coercion CoercionR
co
deTagExpr (App Expr (TaggedBndr t)
e1 Expr (TaggedBndr t)
e2) = forall b. Expr b -> Expr b -> Expr b
App (forall t. TaggedExpr t -> CoreExpr
deTagExpr Expr (TaggedBndr t)
e1) (forall t. TaggedExpr t -> CoreExpr
deTagExpr Expr (TaggedBndr t)
e2)
deTagExpr (Lam (TB Id
b t
_) Expr (TaggedBndr t)
e) = forall b. b -> Expr b -> Expr b
Lam Id
b (forall t. TaggedExpr t -> CoreExpr
deTagExpr Expr (TaggedBndr t)
e)
deTagExpr (Let Bind (TaggedBndr t)
bind Expr (TaggedBndr t)
body) = forall b. Bind b -> Expr b -> Expr b
Let (forall t. TaggedBind t -> CoreBind
deTagBind Bind (TaggedBndr t)
bind) (forall t. TaggedExpr t -> CoreExpr
deTagExpr Expr (TaggedBndr t)
body)
deTagExpr (Case Expr (TaggedBndr t)
e (TB Id
b t
_) Type
ty [Alt (TaggedBndr t)]
alts) = forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
Case (forall t. TaggedExpr t -> CoreExpr
deTagExpr Expr (TaggedBndr t)
e) Id
b Type
ty (forall a b. (a -> b) -> [a] -> [b]
map forall t. TaggedAlt t -> CoreAlt
deTagAlt [Alt (TaggedBndr t)]
alts)
deTagExpr (Tick CoreTickish
t Expr (TaggedBndr t)
e) = forall b. CoreTickish -> Expr b -> Expr b
Tick CoreTickish
t (forall t. TaggedExpr t -> CoreExpr
deTagExpr Expr (TaggedBndr t)
e)
deTagExpr (Cast Expr (TaggedBndr t)
e CoercionR
co) = forall b. Expr b -> CoercionR -> Expr b
Cast (forall t. TaggedExpr t -> CoreExpr
deTagExpr Expr (TaggedBndr t)
e) CoercionR
co
deTagBind :: TaggedBind t -> CoreBind
deTagBind :: forall t. TaggedBind t -> CoreBind
deTagBind (NonRec (TB Id
b t
_) Expr (TaggedBndr t)
rhs) = forall b. b -> Expr b -> Bind b
NonRec Id
b (forall t. TaggedExpr t -> CoreExpr
deTagExpr Expr (TaggedBndr t)
rhs)
deTagBind (Rec [(TaggedBndr t, Expr (TaggedBndr t))]
prs) = forall b. [(b, Expr b)] -> Bind b
Rec [(Id
b, forall t. TaggedExpr t -> CoreExpr
deTagExpr Expr (TaggedBndr t)
rhs) | (TB Id
b t
_, Expr (TaggedBndr t)
rhs) <- [(TaggedBndr t, Expr (TaggedBndr t))]
prs]
deTagAlt :: TaggedAlt t -> CoreAlt
deTagAlt :: forall t. TaggedAlt t -> CoreAlt
deTagAlt (Alt AltCon
con [TaggedBndr t]
bndrs Expr (TaggedBndr t)
rhs) = forall b. AltCon -> [b] -> Expr b -> Alt b
Alt AltCon
con [Id
b | TB Id
b t
_ <- [TaggedBndr t]
bndrs] (forall t. TaggedExpr t -> CoreExpr
deTagExpr Expr (TaggedBndr t)
rhs)
mkApps :: Expr b -> [Arg b] -> Expr b
mkTyApps :: Expr b -> [Type] -> Expr b
mkCoApps :: Expr b -> [Coercion] -> Expr b
mkVarApps :: Expr b -> [Var] -> Expr b
mkConApp :: DataCon -> [Arg b] -> Expr b
mkApps :: forall b. Expr b -> [Expr b] -> Expr b
mkApps Expr b
f [Expr b]
args = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall b. Expr b -> Expr b -> Expr b
App Expr b
f [Expr b]
args
mkCoApps :: forall b. Expr b -> [CoercionR] -> Expr b
mkCoApps Expr b
f [CoercionR]
args = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ Expr b
e CoercionR
a -> forall b. Expr b -> Expr b -> Expr b
App Expr b
e (forall b. CoercionR -> Expr b
Coercion CoercionR
a)) Expr b
f [CoercionR]
args
mkVarApps :: forall b. Expr b -> [Id] -> Expr b
mkVarApps Expr b
f [Id]
vars = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ Expr b
e Id
a -> forall b. Expr b -> Expr b -> Expr b
App Expr b
e (forall b. Id -> Expr b
varToCoreExpr Id
a)) Expr b
f [Id]
vars
mkConApp :: forall b. DataCon -> [Arg b] -> Arg b
mkConApp DataCon
con [Arg b]
args = forall b. Expr b -> [Expr b] -> Expr b
mkApps (forall b. Id -> Expr b
Var (DataCon -> Id
dataConWorkId DataCon
con)) [Arg b]
args
mkTyApps :: forall b. Expr b -> [Type] -> Expr b
mkTyApps Expr b
f [Type]
args = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ Expr b
e Type
a -> forall b. Expr b -> Expr b -> Expr b
App Expr b
e (forall b. Type -> Expr b
mkTyArg Type
a)) Expr b
f [Type]
args
mkConApp2 :: DataCon -> [Type] -> [Var] -> Expr b
mkConApp2 :: forall b. DataCon -> [Type] -> [Id] -> Expr b
mkConApp2 DataCon
con [Type]
tys [Id]
arg_ids = forall b. Id -> Expr b
Var (DataCon -> Id
dataConWorkId DataCon
con)
forall b. Expr b -> [Expr b] -> Expr b
`mkApps` forall a b. (a -> b) -> [a] -> [b]
map forall b. Type -> Expr b
Type [Type]
tys
forall b. Expr b -> [Expr b] -> Expr b
`mkApps` forall a b. (a -> b) -> [a] -> [b]
map forall b. Id -> Expr b
varToCoreExpr [Id]
arg_ids
mkTyArg :: Type -> Expr b
mkTyArg :: forall b. Type -> Expr b
mkTyArg Type
ty
| Just CoercionR
co <- Type -> Maybe CoercionR
isCoercionTy_maybe Type
ty = forall b. CoercionR -> Expr b
Coercion CoercionR
co
| Bool
otherwise = forall b. Type -> Expr b
Type Type
ty
mkIntLit :: Platform -> Integer -> Expr b
mkIntLit :: forall b. Platform -> Integer -> Expr b
mkIntLit Platform
platform Integer
n = forall b. Literal -> Expr b
Lit (Platform -> Integer -> Literal
mkLitInt Platform
platform Integer
n)
mkIntLitWrap :: Platform -> Integer -> Expr b
mkIntLitWrap :: forall b. Platform -> Integer -> Expr b
mkIntLitWrap Platform
platform Integer
n = forall b. Literal -> Expr b
Lit (Platform -> Integer -> Literal
mkLitIntWrap Platform
platform Integer
n)
mkWordLit :: Platform -> Integer -> Expr b
mkWordLit :: forall b. Platform -> Integer -> Expr b
mkWordLit Platform
platform Integer
w = forall b. Literal -> Expr b
Lit (Platform -> Integer -> Literal
mkLitWord Platform
platform Integer
w)
mkWordLitWrap :: Platform -> Integer -> Expr b
mkWordLitWrap :: forall b. Platform -> Integer -> Expr b
mkWordLitWrap Platform
platform Integer
w = forall b. Literal -> Expr b
Lit (Platform -> Integer -> Literal
mkLitWordWrap Platform
platform Integer
w)
mkWord8Lit :: Integer -> Expr b
mkWord8Lit :: forall b. Integer -> Expr b
mkWord8Lit Integer
w = forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitWord8 Integer
w)
mkWord64LitWord64 :: Word64 -> Expr b
mkWord64LitWord64 :: forall b. Word64 -> Expr b
mkWord64LitWord64 Word64
w = forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitWord64 (forall a. Integral a => a -> Integer
toInteger Word64
w))
mkInt64LitInt64 :: Int64 -> Expr b
mkInt64LitInt64 :: forall b. Int64 -> Expr b
mkInt64LitInt64 Int64
w = forall b. Literal -> Expr b
Lit (Integer -> Literal
mkLitInt64 (forall a. Integral a => a -> Integer
toInteger Int64
w))
mkCharLit :: Char -> Expr b
mkStringLit :: String -> Expr b
mkCharLit :: forall b. Char -> Expr b
mkCharLit Char
c = forall b. Literal -> Expr b
Lit (Char -> Literal
mkLitChar Char
c)
mkStringLit :: forall b. String -> Expr b
mkStringLit String
s = forall b. Literal -> Expr b
Lit (String -> Literal
mkLitString String
s)
mkFloatLit :: Rational -> Expr b
mkFloatLitFloat :: Float -> Expr b
mkFloatLit :: forall b. Rational -> Expr b
mkFloatLit Rational
f = forall b. Literal -> Expr b
Lit (Rational -> Literal
mkLitFloat Rational
f)
mkFloatLitFloat :: forall b. Float -> Expr b
mkFloatLitFloat Float
f = forall b. Literal -> Expr b
Lit (Rational -> Literal
mkLitFloat (forall a. Real a => a -> Rational
toRational Float
f))
mkDoubleLit :: Rational -> Expr b
mkDoubleLitDouble :: Double -> Expr b
mkDoubleLit :: forall b. Rational -> Expr b
mkDoubleLit Rational
d = forall b. Literal -> Expr b
Lit (Rational -> Literal
mkLitDouble Rational
d)
mkDoubleLitDouble :: forall b. Double -> Expr b
mkDoubleLitDouble Double
d = forall b. Literal -> Expr b
Lit (Rational -> Literal
mkLitDouble (forall a. Real a => a -> Rational
toRational Double
d))
mkLets :: [Bind b] -> Expr b -> Expr b
mkLams :: [b] -> Expr b -> Expr b
mkLams :: forall b. [b] -> Expr b -> Expr b
mkLams [b]
binders Expr b
body = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b. b -> Expr b -> Expr b
Lam Expr b
body [b]
binders
mkLets :: forall b. [Bind b] -> Expr b -> Expr b
mkLets [Bind b]
binds Expr b
body = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b. Bind b -> Expr b -> Expr b
mkLet Expr b
body [Bind b]
binds
mkLet :: Bind b -> Expr b -> Expr b
mkLet :: forall b. Bind b -> Expr b -> Expr b
mkLet (Rec []) Expr b
body = Expr b
body
mkLet Bind b
bind Expr b
body = forall b. Bind b -> Expr b -> Expr b
Let Bind b
bind Expr b
body
mkLetNonRec :: b -> Expr b -> Expr b -> Expr b
mkLetNonRec :: forall b. b -> Expr b -> Expr b -> Expr b
mkLetNonRec b
b Expr b
rhs Expr b
body = forall b. Bind b -> Expr b -> Expr b
Let (forall b. b -> Expr b -> Bind b
NonRec b
b Expr b
rhs) Expr b
body
mkLetRec :: [(b, Expr b)] -> Expr b -> Expr b
mkLetRec :: forall b. [(b, Expr b)] -> Expr b -> Expr b
mkLetRec [] Expr b
body = Expr b
body
mkLetRec [(b, Expr b)]
bs Expr b
body = forall b. Bind b -> Expr b -> Expr b
Let (forall b. [(b, Expr b)] -> Bind b
Rec [(b, Expr b)]
bs) Expr b
body
mkTyBind :: TyVar -> Type -> CoreBind
mkTyBind :: Id -> Type -> CoreBind
mkTyBind Id
tv Type
ty = forall b. b -> Expr b -> Bind b
NonRec Id
tv (forall b. Type -> Expr b
Type Type
ty)
mkCoBind :: CoVar -> Coercion -> CoreBind
mkCoBind :: Id -> CoercionR -> CoreBind
mkCoBind Id
cv CoercionR
co = forall b. b -> Expr b -> Bind b
NonRec Id
cv (forall b. CoercionR -> Expr b
Coercion CoercionR
co)
varToCoreExpr :: CoreBndr -> Expr b
varToCoreExpr :: forall b. Id -> Expr b
varToCoreExpr Id
v | Id -> Bool
isTyVar Id
v = forall b. Type -> Expr b
Type (Id -> Type
mkTyVarTy Id
v)
| Id -> Bool
isCoVar Id
v = forall b. CoercionR -> Expr b
Coercion (Id -> CoercionR
mkCoVarCo Id
v)
| Bool
otherwise = ASSERT( isId v ) Var v
varsToCoreExprs :: [CoreBndr] -> [Expr b]
varsToCoreExprs :: forall b. [Id] -> [Expr b]
varsToCoreExprs [Id]
vs = forall a b. (a -> b) -> [a] -> [b]
map forall b. Id -> Expr b
varToCoreExpr [Id]
vs
applyTypeToArg :: Type -> CoreExpr -> Type
applyTypeToArg :: Type -> CoreExpr -> Type
applyTypeToArg Type
fun_ty CoreExpr
arg = HasDebugCallStack => Type -> Type -> Type
piResultTy Type
fun_ty (CoreExpr -> Type
exprToType CoreExpr
arg)
exprToType :: CoreExpr -> Type
exprToType :: CoreExpr -> Type
exprToType (Type Type
ty) = Type
ty
exprToType CoreExpr
_bad = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"exprToType" SDoc
empty
exprToCoercion_maybe :: CoreExpr -> Maybe Coercion
exprToCoercion_maybe :: CoreExpr -> Maybe CoercionR
exprToCoercion_maybe (Coercion CoercionR
co) = forall a. a -> Maybe a
Just CoercionR
co
exprToCoercion_maybe CoreExpr
_ = forall a. Maybe a
Nothing
bindersOf :: Bind b -> [b]
bindersOf :: forall b. Bind b -> [b]
bindersOf (NonRec b
binder Expr b
_) = [b
binder]
bindersOf (Rec [(b, Expr b)]
pairs) = [b
binder | (b
binder, Expr b
_) <- [(b, Expr b)]
pairs]
bindersOfBinds :: [Bind b] -> [b]
bindersOfBinds :: forall b. [Bind b] -> [b]
bindersOfBinds [Bind b]
binds = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Bind b -> [b]
bindersOf) [] [Bind b]
binds
rhssOfBind :: Bind b -> [Expr b]
rhssOfBind :: forall b. Bind b -> [Expr b]
rhssOfBind (NonRec b
_ Expr b
rhs) = [Expr b
rhs]
rhssOfBind (Rec [(b, Expr b)]
pairs) = [Expr b
rhs | (b
_,Expr b
rhs) <- [(b, Expr b)]
pairs]
rhssOfAlts :: [Alt b] -> [Expr b]
rhssOfAlts :: forall b. [Alt b] -> [Expr b]
rhssOfAlts [Alt b]
alts = [Expr b
e | Alt AltCon
_ [b]
_ Expr b
e <- [Alt b]
alts]
flattenBinds :: [Bind b] -> [(b, Expr b)]
flattenBinds :: forall b. [Bind b] -> [(b, Expr b)]
flattenBinds (NonRec b
b Expr b
r : [Bind b]
binds) = (b
b,Expr b
r) forall a. a -> [a] -> [a]
: forall b. [Bind b] -> [(b, Expr b)]
flattenBinds [Bind b]
binds
flattenBinds (Rec [(b, Expr b)]
prs1 : [Bind b]
binds) = [(b, Expr b)]
prs1 forall a. [a] -> [a] -> [a]
++ forall b. [Bind b] -> [(b, Expr b)]
flattenBinds [Bind b]
binds
flattenBinds [] = []
collectBinders :: Expr b -> ([b], Expr b)
collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
collectValBinders :: CoreExpr -> ([Id], CoreExpr)
collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
collectNBinders :: Int -> Expr b -> ([b], Expr b)
collectBinders :: forall b. Expr b -> ([b], Expr b)
collectBinders Expr b
expr
= forall {a}. [a] -> Expr a -> ([a], Expr a)
go [] Expr b
expr
where
go :: [a] -> Expr a -> ([a], Expr a)
go [a]
bs (Lam a
b Expr a
e) = [a] -> Expr a -> ([a], Expr a)
go (a
bforall a. a -> [a] -> [a]
:[a]
bs) Expr a
e
go [a]
bs Expr a
e = (forall a. [a] -> [a]
reverse [a]
bs, Expr a
e)
collectTyBinders :: CoreExpr -> ([Id], CoreExpr)
collectTyBinders CoreExpr
expr
= [Id] -> CoreExpr -> ([Id], CoreExpr)
go [] CoreExpr
expr
where
go :: [Id] -> CoreExpr -> ([Id], CoreExpr)
go [Id]
tvs (Lam Id
b CoreExpr
e) | Id -> Bool
isTyVar Id
b = [Id] -> CoreExpr -> ([Id], CoreExpr)
go (Id
bforall a. a -> [a] -> [a]
:[Id]
tvs) CoreExpr
e
go [Id]
tvs CoreExpr
e = (forall a. [a] -> [a]
reverse [Id]
tvs, CoreExpr
e)
collectValBinders :: CoreExpr -> ([Id], CoreExpr)
collectValBinders CoreExpr
expr
= [Id] -> CoreExpr -> ([Id], CoreExpr)
go [] CoreExpr
expr
where
go :: [Id] -> CoreExpr -> ([Id], CoreExpr)
go [Id]
ids (Lam Id
b CoreExpr
e) | Id -> Bool
isId Id
b = [Id] -> CoreExpr -> ([Id], CoreExpr)
go (Id
bforall a. a -> [a] -> [a]
:[Id]
ids) CoreExpr
e
go [Id]
ids CoreExpr
body = (forall a. [a] -> [a]
reverse [Id]
ids, CoreExpr
body)
collectTyAndValBinders :: CoreExpr -> ([Id], [Id], CoreExpr)
collectTyAndValBinders CoreExpr
expr
= ([Id]
tvs, [Id]
ids, CoreExpr
body)
where
([Id]
tvs, CoreExpr
body1) = CoreExpr -> ([Id], CoreExpr)
collectTyBinders CoreExpr
expr
([Id]
ids, CoreExpr
body) = CoreExpr -> ([Id], CoreExpr)
collectValBinders CoreExpr
body1
collectNBinders :: forall b. ConTag -> Expr b -> ([b], Expr b)
collectNBinders ConTag
orig_n Expr b
orig_expr
= ConTag -> [b] -> Expr b -> ([b], Expr b)
go ConTag
orig_n [] Expr b
orig_expr
where
go :: ConTag -> [b] -> Expr b -> ([b], Expr b)
go ConTag
0 [b]
bs Expr b
expr = (forall a. [a] -> [a]
reverse [b]
bs, Expr b
expr)
go ConTag
n [b]
bs (Lam b
b Expr b
e) = ConTag -> [b] -> Expr b -> ([b], Expr b)
go (ConTag
nforall a. Num a => a -> a -> a
-ConTag
1) (b
bforall a. a -> [a] -> [a]
:[b]
bs) Expr b
e
go ConTag
_ [b]
_ Expr b
_ = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"collectNBinders" forall a b. (a -> b) -> a -> b
$ ConTag -> SDoc
int ConTag
orig_n
collectArgs :: Expr b -> (Expr b, [Arg b])
collectArgs :: forall b. Expr b -> (Expr b, [Expr b])
collectArgs Expr b
expr
= forall {b}. Expr b -> [Expr b] -> (Expr b, [Expr b])
go Expr b
expr []
where
go :: Expr b -> [Expr b] -> (Expr b, [Expr b])
go (App Expr b
f Expr b
a) [Expr b]
as = Expr b -> [Expr b] -> (Expr b, [Expr b])
go Expr b
f (Expr b
aforall a. a -> [a] -> [a]
:[Expr b]
as)
go Expr b
e [Expr b]
as = (Expr b
e, [Expr b]
as)
stripNArgs :: Word -> Expr a -> Maybe (Expr a)
stripNArgs :: forall a. Word -> Expr a -> Maybe (Expr a)
stripNArgs !Word
n (Tick CoreTickish
_ Expr a
e) = forall a. Word -> Expr a -> Maybe (Expr a)
stripNArgs Word
n Expr a
e
stripNArgs Word
n (Cast Expr a
f CoercionR
_) = forall a. Word -> Expr a -> Maybe (Expr a)
stripNArgs Word
n Expr a
f
stripNArgs Word
0 Expr a
e = forall a. a -> Maybe a
Just Expr a
e
stripNArgs Word
n (App Expr a
f Expr a
_) = forall a. Word -> Expr a -> Maybe (Expr a)
stripNArgs (Word
n forall a. Num a => a -> a -> a
- Word
1) Expr a
f
stripNArgs Word
_ Expr a
_ = forall a. Maybe a
Nothing
collectArgsTicks :: (CoreTickish -> Bool) -> Expr b
-> (Expr b, [Arg b], [CoreTickish])
collectArgsTicks :: forall b.
(CoreTickish -> Bool)
-> Expr b -> (Expr b, [Expr b], [CoreTickish])
collectArgsTicks CoreTickish -> Bool
skipTick Expr b
expr
= Expr b
-> [Expr b] -> [CoreTickish] -> (Expr b, [Expr b], [CoreTickish])
go Expr b
expr [] []
where
go :: Expr b
-> [Expr b] -> [CoreTickish] -> (Expr b, [Expr b], [CoreTickish])
go (App Expr b
f Expr b
a) [Expr b]
as [CoreTickish]
ts = Expr b
-> [Expr b] -> [CoreTickish] -> (Expr b, [Expr b], [CoreTickish])
go Expr b
f (Expr b
aforall a. a -> [a] -> [a]
:[Expr b]
as) [CoreTickish]
ts
go (Tick CoreTickish
t Expr b
e) [Expr b]
as [CoreTickish]
ts
| CoreTickish -> Bool
skipTick CoreTickish
t = Expr b
-> [Expr b] -> [CoreTickish] -> (Expr b, [Expr b], [CoreTickish])
go Expr b
e [Expr b]
as (CoreTickish
tforall a. a -> [a] -> [a]
:[CoreTickish]
ts)
go Expr b
e [Expr b]
as [CoreTickish]
ts = (Expr b
e, [Expr b]
as, forall a. [a] -> [a]
reverse [CoreTickish]
ts)
isRuntimeVar :: Var -> Bool
isRuntimeVar :: Id -> Bool
isRuntimeVar = Id -> Bool
isId
isRuntimeArg :: CoreExpr -> Bool
isRuntimeArg :: CoreExpr -> Bool
isRuntimeArg = forall b. Expr b -> Bool
isValArg
isValArg :: Expr b -> Bool
isValArg :: forall b. Expr b -> Bool
isValArg Expr b
e = Bool -> Bool
not (forall b. Expr b -> Bool
isTypeArg Expr b
e)
isTyCoArg :: Expr b -> Bool
isTyCoArg :: forall b. Expr b -> Bool
isTyCoArg (Type {}) = Bool
True
isTyCoArg (Coercion {}) = Bool
True
isTyCoArg Expr b
_ = Bool
False
isCoArg :: Expr b -> Bool
isCoArg :: forall b. Expr b -> Bool
isCoArg (Coercion {}) = Bool
True
isCoArg Expr b
_ = Bool
False
isTypeArg :: Expr b -> Bool
isTypeArg :: forall b. Expr b -> Bool
isTypeArg (Type {}) = Bool
True
isTypeArg Expr b
_ = Bool
False
valBndrCount :: [CoreBndr] -> Int
valBndrCount :: [Id] -> ConTag
valBndrCount = forall a. (a -> Bool) -> [a] -> ConTag
count Id -> Bool
isId
valArgCount :: [Arg b] -> Int
valArgCount :: forall b. [Arg b] -> ConTag
valArgCount = forall a. (a -> Bool) -> [a] -> ConTag
count forall b. Expr b -> Bool
isValArg
type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
data AnnExpr' bndr annot
= AnnVar Id
| AnnLit Literal
| AnnLam bndr (AnnExpr bndr annot)
| AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
| AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
| AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
| AnnCast (AnnExpr bndr annot) (annot, Coercion)
| AnnTick CoreTickish (AnnExpr bndr annot)
| AnnType Type
| AnnCoercion Coercion
data AnnAlt bndr annot = AnnAlt AltCon [bndr] (AnnExpr bndr annot)
data AnnBind bndr annot
= AnnNonRec bndr (AnnExpr bndr annot)
| AnnRec [(bndr, AnnExpr bndr annot)]
collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])
collectAnnArgs :: forall b a. AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])
collectAnnArgs AnnExpr b a
expr
= forall {bndr} {annot}.
AnnExpr bndr annot
-> [AnnExpr bndr annot]
-> (AnnExpr bndr annot, [AnnExpr bndr annot])
go AnnExpr b a
expr []
where
go :: AnnExpr bndr annot
-> [AnnExpr bndr annot]
-> (AnnExpr bndr annot, [AnnExpr bndr annot])
go (annot
_, AnnApp AnnExpr bndr annot
f AnnExpr bndr annot
a) [AnnExpr bndr annot]
as = AnnExpr bndr annot
-> [AnnExpr bndr annot]
-> (AnnExpr bndr annot, [AnnExpr bndr annot])
go AnnExpr bndr annot
f (AnnExpr bndr annot
aforall a. a -> [a] -> [a]
:[AnnExpr bndr annot]
as)
go AnnExpr bndr annot
e [AnnExpr bndr annot]
as = (AnnExpr bndr annot
e, [AnnExpr bndr annot]
as)
collectAnnArgsTicks :: (CoreTickish -> Bool) -> AnnExpr b a
-> (AnnExpr b a, [AnnExpr b a], [CoreTickish])
collectAnnArgsTicks :: forall b a.
(CoreTickish -> Bool)
-> AnnExpr b a -> (AnnExpr b a, [AnnExpr b a], [CoreTickish])
collectAnnArgsTicks CoreTickish -> Bool
tickishOk AnnExpr b a
expr
= AnnExpr b a
-> [AnnExpr b a]
-> [CoreTickish]
-> (AnnExpr b a, [AnnExpr b a], [CoreTickish])
go AnnExpr b a
expr [] []
where
go :: AnnExpr b a
-> [AnnExpr b a]
-> [CoreTickish]
-> (AnnExpr b a, [AnnExpr b a], [CoreTickish])
go (a
_, AnnApp AnnExpr b a
f AnnExpr b a
a) [AnnExpr b a]
as [CoreTickish]
ts = AnnExpr b a
-> [AnnExpr b a]
-> [CoreTickish]
-> (AnnExpr b a, [AnnExpr b a], [CoreTickish])
go AnnExpr b a
f (AnnExpr b a
aforall a. a -> [a] -> [a]
:[AnnExpr b a]
as) [CoreTickish]
ts
go (a
_, AnnTick CoreTickish
t AnnExpr b a
e) [AnnExpr b a]
as [CoreTickish]
ts | CoreTickish -> Bool
tickishOk CoreTickish
t
= AnnExpr b a
-> [AnnExpr b a]
-> [CoreTickish]
-> (AnnExpr b a, [AnnExpr b a], [CoreTickish])
go AnnExpr b a
e [AnnExpr b a]
as (CoreTickish
tforall a. a -> [a] -> [a]
:[CoreTickish]
ts)
go AnnExpr b a
e [AnnExpr b a]
as [CoreTickish]
ts = (AnnExpr b a
e, [AnnExpr b a]
as, forall a. [a] -> [a]
reverse [CoreTickish]
ts)
deAnnotate :: AnnExpr bndr annot -> Expr bndr
deAnnotate :: forall bndr annot. AnnExpr bndr annot -> Expr bndr
deAnnotate (annot
_, AnnExpr' bndr annot
e) = forall bndr annot. AnnExpr' bndr annot -> Expr bndr
deAnnotate' AnnExpr' bndr annot
e
deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
deAnnotate' :: forall bndr annot. AnnExpr' bndr annot -> Expr bndr
deAnnotate' (AnnType Type
t) = forall b. Type -> Expr b
Type Type
t
deAnnotate' (AnnCoercion CoercionR
co) = forall b. CoercionR -> Expr b
Coercion CoercionR
co
deAnnotate' (AnnVar Id
v) = forall b. Id -> Expr b
Var Id
v
deAnnotate' (AnnLit Literal
lit) = forall b. Literal -> Expr b
Lit Literal
lit
deAnnotate' (AnnLam bndr
binder AnnExpr bndr annot
body) = forall b. b -> Expr b -> Expr b
Lam bndr
binder (forall bndr annot. AnnExpr bndr annot -> Expr bndr
deAnnotate AnnExpr bndr annot
body)
deAnnotate' (AnnApp AnnExpr bndr annot
fun AnnExpr bndr annot
arg) = forall b. Expr b -> Expr b -> Expr b
App (forall bndr annot. AnnExpr bndr annot -> Expr bndr
deAnnotate AnnExpr bndr annot
fun) (forall bndr annot. AnnExpr bndr annot -> Expr bndr
deAnnotate AnnExpr bndr annot
arg)
deAnnotate' (AnnCast AnnExpr bndr annot
e (annot
_,CoercionR
co)) = forall b. Expr b -> CoercionR -> Expr b
Cast (forall bndr annot. AnnExpr bndr annot -> Expr bndr
deAnnotate AnnExpr bndr annot
e) CoercionR
co
deAnnotate' (AnnTick CoreTickish
tick AnnExpr bndr annot
body) = forall b. CoreTickish -> Expr b -> Expr b
Tick CoreTickish
tick (forall bndr annot. AnnExpr bndr annot -> Expr bndr
deAnnotate AnnExpr bndr annot
body)
deAnnotate' (AnnLet AnnBind bndr annot
bind AnnExpr bndr annot
body)
= forall b. Bind b -> Expr b -> Expr b
Let (forall b annot. AnnBind b annot -> Bind b
deAnnBind AnnBind bndr annot
bind) (forall bndr annot. AnnExpr bndr annot -> Expr bndr
deAnnotate AnnExpr bndr annot
body)
deAnnotate' (AnnCase AnnExpr bndr annot
scrut bndr
v Type
t [AnnAlt bndr annot]
alts)
= forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
Case (forall bndr annot. AnnExpr bndr annot -> Expr bndr
deAnnotate AnnExpr bndr annot
scrut) bndr
v Type
t (forall a b. (a -> b) -> [a] -> [b]
map forall bndr annot. AnnAlt bndr annot -> Alt bndr
deAnnAlt [AnnAlt bndr annot]
alts)
deAnnAlt :: AnnAlt bndr annot -> Alt bndr
deAnnAlt :: forall bndr annot. AnnAlt bndr annot -> Alt bndr
deAnnAlt (AnnAlt AltCon
con [bndr]
args AnnExpr bndr annot
rhs) = forall b. AltCon -> [b] -> Expr b -> Alt b
Alt AltCon
con [bndr]
args (forall bndr annot. AnnExpr bndr annot -> Expr bndr
deAnnotate AnnExpr bndr annot
rhs)
deAnnBind :: AnnBind b annot -> Bind b
deAnnBind :: forall b annot. AnnBind b annot -> Bind b
deAnnBind (AnnNonRec b
var AnnExpr b annot
rhs) = forall b. b -> Expr b -> Bind b
NonRec b
var (forall bndr annot. AnnExpr bndr annot -> Expr bndr
deAnnotate AnnExpr b annot
rhs)
deAnnBind (AnnRec [(b, AnnExpr b annot)]
pairs) = forall b. [(b, Expr b)] -> Bind b
Rec [(b
v,forall bndr annot. AnnExpr bndr annot -> Expr bndr
deAnnotate AnnExpr b annot
rhs) | (b
v,AnnExpr b annot
rhs) <- [(b, AnnExpr b annot)]
pairs]
collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
collectAnnBndrs :: forall bndr annot.
AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
collectAnnBndrs AnnExpr bndr annot
e
= forall {a} {annot}.
[a] -> AnnExpr a annot -> ([a], AnnExpr a annot)
collect [] AnnExpr bndr annot
e
where
collect :: [a] -> AnnExpr a annot -> ([a], AnnExpr a annot)
collect [a]
bs (annot
_, AnnLam a
b AnnExpr a annot
body) = [a] -> AnnExpr a annot -> ([a], AnnExpr a annot)
collect (a
bforall a. a -> [a] -> [a]
:[a]
bs) AnnExpr a annot
body
collect [a]
bs AnnExpr a annot
body = (forall a. [a] -> [a]
reverse [a]
bs, AnnExpr a annot
body)
collectNAnnBndrs :: Int -> AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
collectNAnnBndrs :: forall bndr annot.
ConTag -> AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
collectNAnnBndrs ConTag
orig_n AnnExpr bndr annot
e
= ConTag
-> [bndr] -> AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
collect ConTag
orig_n [] AnnExpr bndr annot
e
where
collect :: ConTag
-> [bndr] -> AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
collect ConTag
0 [bndr]
bs AnnExpr bndr annot
body = (forall a. [a] -> [a]
reverse [bndr]
bs, AnnExpr bndr annot
body)
collect ConTag
n [bndr]
bs (annot
_, AnnLam bndr
b AnnExpr bndr annot
body) = ConTag
-> [bndr] -> AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
collect (ConTag
nforall a. Num a => a -> a -> a
-ConTag
1) (bndr
bforall a. a -> [a] -> [a]
:[bndr]
bs) AnnExpr bndr annot
body
collect ConTag
_ [bndr]
_ AnnExpr bndr annot
_ = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"collectNBinders" forall a b. (a -> b) -> a -> b
$ ConTag -> SDoc
int ConTag
orig_n