module GHC.Core.Subst (
Subst(..),
TvSubstEnv, IdSubstEnv, InScopeSet,
deShadowBinds, substRuleInfo, substRulesForImportedIds,
substTyUnchecked, substCo, substExpr, substExprSC, substBind, substBindSC,
substUnfolding, substUnfoldingSC,
lookupIdSubst, lookupIdSubst_maybe, substIdType, substIdOcc,
substTickish, substDVarSet, substIdInfo,
emptySubst, mkEmptySubst, mkTCvSubst, mkOpenSubst, isEmptySubst,
extendIdSubst, extendIdSubstList, extendTCvSubst, extendTvSubstList,
extendIdSubstWithClone,
extendSubst, extendSubstList, extendSubstWithVar,
extendSubstInScope, extendSubstInScopeList, extendSubstInScopeSet,
isInScope, setInScope, getSubstInScope,
extendTvSubst, extendCvSubst,
delBndr, delBndrs, zapSubst,
substBndr, substBndrs, substRecBndrs, substTyVarBndr, substCoVarBndr,
cloneBndr, cloneBndrs, cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs,
) where
import GHC.Prelude
import GHC.Core
import GHC.Core.FVs
import GHC.Core.Seq
import GHC.Core.Utils
import GHC.Core.Type hiding ( substTy )
import GHC.Core.Coercion
( tyCoFVsOfCo, mkCoVarCo, substCoVarBndr )
import GHC.Types.Var.Set
import GHC.Types.Var.Env as InScopeSet
import GHC.Types.Id
import GHC.Types.Name ( Name )
import GHC.Types.Var
import GHC.Types.Tickish
import GHC.Types.Id.Info
import GHC.Types.Unique.Supply
import GHC.Builtin.Names
import GHC.Data.Maybe
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
import Data.Functor.Identity (Identity (..))
import Data.List (mapAccumL)
extendIdSubst :: Subst -> Id -> CoreExpr -> Subst
extendIdSubst :: Subst -> Id -> CoreExpr -> Subst
extendIdSubst (Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs) Id
v CoreExpr
r
= Bool -> SDoc -> Subst -> Subst
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Id -> Bool
isNonCoVarId Id
v) (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
v SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ CoreExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoreExpr
r) (Subst -> Subst) -> Subst -> Subst
forall a b. (a -> b) -> a -> b
$
InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope (IdSubstEnv -> Id -> CoreExpr -> IdSubstEnv
forall a. VarEnv a -> Id -> a -> VarEnv a
extendVarEnv IdSubstEnv
ids Id
v CoreExpr
r) TvSubstEnv
tvs CvSubstEnv
cvs
extendIdSubstWithClone :: Subst -> Id -> Id -> Subst
extendIdSubstWithClone :: Subst -> Id -> Id -> Subst
extendIdSubstWithClone (Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs) Id
v Id
v'
= Bool -> SDoc -> Subst -> Subst
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Id -> Bool
isNonCoVarId Id
v) (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
v SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
v') (Subst -> Subst) -> Subst -> Subst
forall a b. (a -> b) -> a -> b
$
InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst (InScopeSet -> VarSet -> InScopeSet
extendInScopeSetSet InScopeSet
in_scope VarSet
new_in_scope)
(IdSubstEnv -> Id -> CoreExpr -> IdSubstEnv
forall a. VarEnv a -> Id -> a -> VarEnv a
extendVarEnv IdSubstEnv
ids Id
v (Id -> CoreExpr
forall b. Id -> Expr b
varToCoreExpr Id
v')) TvSubstEnv
tvs CvSubstEnv
cvs
where
new_in_scope :: VarSet
new_in_scope = Type -> VarSet
tyCoVarsOfType (Id -> Type
varType Id
v') VarSet -> Id -> VarSet
`extendVarSet` Id
v'
extendIdSubstList :: Subst -> [(Id, CoreExpr)] -> Subst
extendIdSubstList :: Subst -> [(Id, CoreExpr)] -> Subst
extendIdSubstList (Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs) [(Id, CoreExpr)]
prs
= Bool -> Subst -> Subst
forall a. HasCallStack => Bool -> a -> a
assert (((Id, CoreExpr) -> Bool) -> [(Id, CoreExpr)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Id -> Bool
isNonCoVarId (Id -> Bool) -> ((Id, CoreExpr) -> Id) -> (Id, CoreExpr) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id, CoreExpr) -> Id
forall a b. (a, b) -> a
fst) [(Id, CoreExpr)]
prs) (Subst -> Subst) -> Subst -> Subst
forall a b. (a -> b) -> a -> b
$
InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope (IdSubstEnv -> [(Id, CoreExpr)] -> IdSubstEnv
forall a. VarEnv a -> [(Id, a)] -> VarEnv a
extendVarEnvList IdSubstEnv
ids [(Id, CoreExpr)]
prs) TvSubstEnv
tvs CvSubstEnv
cvs
extendSubst :: Subst -> Var -> CoreArg -> Subst
extendSubst :: Subst -> Id -> CoreExpr -> Subst
extendSubst Subst
subst Id
var CoreExpr
arg
= case CoreExpr
arg of
Type Type
ty -> Bool -> Subst -> Subst
forall a. HasCallStack => Bool -> a -> a
assert (Id -> Bool
isTyVar Id
var) (Subst -> Subst) -> Subst -> Subst
forall a b. (a -> b) -> a -> b
$ Subst -> Id -> Type -> Subst
extendTvSubst Subst
subst Id
var Type
ty
Coercion Coercion
co -> Bool -> Subst -> Subst
forall a. HasCallStack => Bool -> a -> a
assert (Id -> Bool
isCoVar Id
var) (Subst -> Subst) -> Subst -> Subst
forall a b. (a -> b) -> a -> b
$ Subst -> Id -> Coercion -> Subst
extendCvSubst Subst
subst Id
var Coercion
co
CoreExpr
_ -> Bool -> Subst -> Subst
forall a. HasCallStack => Bool -> a -> a
assert (Id -> Bool
isId Id
var) (Subst -> Subst) -> Subst -> Subst
forall a b. (a -> b) -> a -> b
$ Subst -> Id -> CoreExpr -> Subst
extendIdSubst Subst
subst Id
var CoreExpr
arg
extendSubstWithVar :: Subst -> Var -> Var -> Subst
extendSubstWithVar :: Subst -> Id -> Id -> Subst
extendSubstWithVar Subst
subst Id
v1 Id
v2
| Id -> Bool
isTyVar Id
v1 = Bool -> Subst -> Subst
forall a. HasCallStack => Bool -> a -> a
assert (Id -> Bool
isTyVar Id
v2) (Subst -> Subst) -> Subst -> Subst
forall a b. (a -> b) -> a -> b
$ Subst -> Id -> Type -> Subst
extendTvSubst Subst
subst Id
v1 (Id -> Type
mkTyVarTy Id
v2)
| Id -> Bool
isCoVar Id
v1 = Bool -> Subst -> Subst
forall a. HasCallStack => Bool -> a -> a
assert (Id -> Bool
isCoVar Id
v2) (Subst -> Subst) -> Subst -> Subst
forall a b. (a -> b) -> a -> b
$ Subst -> Id -> Coercion -> Subst
extendCvSubst Subst
subst Id
v1 (Id -> Coercion
mkCoVarCo Id
v2)
| Bool
otherwise = Bool -> Subst -> Subst
forall a. HasCallStack => Bool -> a -> a
assert (Id -> Bool
isId Id
v2) (Subst -> Subst) -> Subst -> Subst
forall a b. (a -> b) -> a -> b
$ Subst -> Id -> CoreExpr -> Subst
extendIdSubst Subst
subst Id
v1 (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
v2)
extendSubstList :: Subst -> [(Var,CoreArg)] -> Subst
extendSubstList :: Subst -> [(Id, CoreExpr)] -> Subst
extendSubstList Subst
subst [] = Subst
subst
extendSubstList Subst
subst ((Id
var,CoreExpr
rhs):[(Id, CoreExpr)]
prs) = Subst -> [(Id, CoreExpr)] -> Subst
extendSubstList (Subst -> Id -> CoreExpr -> Subst
extendSubst Subst
subst Id
var CoreExpr
rhs) [(Id, CoreExpr)]
prs
lookupIdSubst :: HasDebugCallStack => Subst -> Id -> CoreExpr
lookupIdSubst :: HasDebugCallStack => Subst -> Id -> CoreExpr
lookupIdSubst (Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
_ CvSubstEnv
_) Id
v
| Bool -> SDoc -> (Bool -> Bool) -> Bool -> Bool
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Id -> Bool
isId Id
v Bool -> Bool -> Bool
&& Bool -> Bool
not (Id -> Bool
isCoVar Id
v)) (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
v)
Bool -> Bool
not (Id -> Bool
isLocalId Id
v) = Id -> CoreExpr
forall b. Id -> Expr b
Var Id
v
| Just CoreExpr
e <- IdSubstEnv -> Id -> Maybe CoreExpr
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv IdSubstEnv
ids Id
v = CoreExpr
e
| Just Id
v' <- InScopeSet -> Id -> Maybe Id
lookupInScope InScopeSet
in_scope Id
v = Id -> CoreExpr
forall b. Id -> Expr b
Var Id
v'
| Bool
otherwise = String -> SDoc -> CoreExpr
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"lookupIdSubst" (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
v SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ InScopeSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr InScopeSet
in_scope)
lookupIdSubst_maybe :: HasDebugCallStack => Subst -> Id -> Maybe CoreExpr
lookupIdSubst_maybe :: HasDebugCallStack => Subst -> Id -> Maybe CoreExpr
lookupIdSubst_maybe (Subst InScopeSet
_ IdSubstEnv
ids TvSubstEnv
_ CvSubstEnv
_) Id
v
= Bool -> SDoc -> Maybe CoreExpr -> Maybe CoreExpr
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Id -> Bool
isId Id
v Bool -> Bool -> Bool
&& Bool -> Bool
not (Id -> Bool
isCoVar Id
v)) (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
v) (Maybe CoreExpr -> Maybe CoreExpr)
-> Maybe CoreExpr -> Maybe CoreExpr
forall a b. (a -> b) -> a -> b
$
IdSubstEnv -> Id -> Maybe CoreExpr
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv IdSubstEnv
ids Id
v
delBndr :: Subst -> Var -> Subst
delBndr :: Subst -> Id -> Subst
delBndr (Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs) Id
v
| Id -> Bool
isCoVar Id
v = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs (CvSubstEnv -> Id -> CvSubstEnv
forall a. VarEnv a -> Id -> VarEnv a
delVarEnv CvSubstEnv
cvs Id
v)
| Id -> Bool
isTyVar Id
v = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope IdSubstEnv
ids (TvSubstEnv -> Id -> TvSubstEnv
forall a. VarEnv a -> Id -> VarEnv a
delVarEnv TvSubstEnv
tvs Id
v) CvSubstEnv
cvs
| Bool
otherwise = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope (IdSubstEnv -> Id -> IdSubstEnv
forall a. VarEnv a -> Id -> VarEnv a
delVarEnv IdSubstEnv
ids Id
v) TvSubstEnv
tvs CvSubstEnv
cvs
delBndrs :: Subst -> [Var] -> Subst
delBndrs :: Subst -> [Id] -> Subst
delBndrs (Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs) [Id]
vs
= InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope (IdSubstEnv -> [Id] -> IdSubstEnv
forall a. VarEnv a -> [Id] -> VarEnv a
delVarEnvList IdSubstEnv
ids [Id]
vs) (TvSubstEnv -> [Id] -> TvSubstEnv
forall a. VarEnv a -> [Id] -> VarEnv a
delVarEnvList TvSubstEnv
tvs [Id]
vs) (CvSubstEnv -> [Id] -> CvSubstEnv
forall a. VarEnv a -> [Id] -> VarEnv a
delVarEnvList CvSubstEnv
cvs [Id]
vs)
mkOpenSubst :: InScopeSet -> [(Var,CoreArg)] -> Subst
mkOpenSubst :: InScopeSet -> [(Id, CoreExpr)] -> Subst
mkOpenSubst InScopeSet
in_scope [(Id, CoreExpr)]
pairs = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope
([(Id, CoreExpr)] -> IdSubstEnv
forall a. [(Id, a)] -> VarEnv a
mkVarEnv [(Id
id,CoreExpr
e) | (Id
id, CoreExpr
e) <- [(Id, CoreExpr)]
pairs, Id -> Bool
isId Id
id])
([(Id, Type)] -> TvSubstEnv
forall a. [(Id, a)] -> VarEnv a
mkVarEnv [(Id
tv,Type
ty) | (Id
tv, Type Type
ty) <- [(Id, CoreExpr)]
pairs])
([(Id, Coercion)] -> CvSubstEnv
forall a. [(Id, a)] -> VarEnv a
mkVarEnv [(Id
v,Coercion
co) | (Id
v, Coercion Coercion
co) <- [(Id, CoreExpr)]
pairs])
substExprSC :: HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
substExprSC :: HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
substExprSC Subst
subst CoreExpr
orig_expr
| Subst -> Bool
isEmptySubst Subst
subst = CoreExpr
orig_expr
| Bool
otherwise =
HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst CoreExpr
orig_expr
substExpr :: HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
substExpr :: HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst CoreExpr
expr
= CoreExpr -> CoreExpr
go CoreExpr
expr
where
go :: CoreExpr -> CoreExpr
go (Var Id
v) = HasDebugCallStack => Subst -> Id -> CoreExpr
Subst -> Id -> CoreExpr
lookupIdSubst Subst
subst Id
v
go (Type Type
ty) = Type -> CoreExpr
forall b. Type -> Expr b
Type (Subst -> Type -> Type
substTyUnchecked Subst
subst Type
ty)
go (Coercion Coercion
co) = Coercion -> CoreExpr
forall b. Coercion -> Expr b
Coercion (HasDebugCallStack => Subst -> Coercion -> Coercion
Subst -> Coercion -> Coercion
substCo Subst
subst Coercion
co)
go (Lit Literal
lit) = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
lit
go (App CoreExpr
fun CoreExpr
arg) = CoreExpr -> CoreExpr -> CoreExpr
forall b. Expr b -> Expr b -> Expr b
App (CoreExpr -> CoreExpr
go CoreExpr
fun) (CoreExpr -> CoreExpr
go CoreExpr
arg)
go (Tick CoreTickish
tickish CoreExpr
e) = CoreTickish -> CoreExpr -> CoreExpr
mkTick (Subst -> CoreTickish -> CoreTickish
substTickish Subst
subst CoreTickish
tickish) (CoreExpr -> CoreExpr
go CoreExpr
e)
go (Cast CoreExpr
e Coercion
co) = CoreExpr -> Coercion -> CoreExpr
forall b. Expr b -> Coercion -> Expr b
Cast (CoreExpr -> CoreExpr
go CoreExpr
e) (HasDebugCallStack => Subst -> Coercion -> Coercion
Subst -> Coercion -> Coercion
substCo Subst
subst Coercion
co)
go (Lam Id
bndr CoreExpr
body) = Id -> CoreExpr -> CoreExpr
forall b. b -> Expr b -> Expr b
Lam Id
bndr' (HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst' CoreExpr
body)
where
(Subst
subst', Id
bndr') = Subst -> Id -> (Subst, Id)
substBndr Subst
subst Id
bndr
go (Let Bind Id
bind CoreExpr
body) = Bind Id -> CoreExpr -> CoreExpr
forall b. Bind b -> Expr b -> Expr b
Let Bind Id
bind' (HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst' CoreExpr
body)
where
(Subst
subst', Bind Id
bind') = HasDebugCallStack => Subst -> Bind Id -> (Subst, Bind Id)
Subst -> Bind Id -> (Subst, Bind Id)
substBind Subst
subst Bind Id
bind
go (Case CoreExpr
scrut Id
bndr Type
ty [Alt Id]
alts) = CoreExpr -> Id -> Type -> [Alt Id] -> CoreExpr
forall b. Expr b -> b -> Type -> [Alt b] -> Expr b
Case (CoreExpr -> CoreExpr
go CoreExpr
scrut) Id
bndr' (Subst -> Type -> Type
substTyUnchecked Subst
subst Type
ty) ((Alt Id -> Alt Id) -> [Alt Id] -> [Alt Id]
forall a b. (a -> b) -> [a] -> [b]
map (Subst -> Alt Id -> Alt Id
go_alt Subst
subst') [Alt Id]
alts)
where
(Subst
subst', Id
bndr') = Subst -> Id -> (Subst, Id)
substBndr Subst
subst Id
bndr
go_alt :: Subst -> Alt Id -> Alt Id
go_alt Subst
subst (Alt AltCon
con [Id]
bndrs CoreExpr
rhs) = AltCon -> [Id] -> CoreExpr -> Alt Id
forall b. AltCon -> [b] -> Expr b -> Alt b
Alt AltCon
con [Id]
bndrs' (HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst' CoreExpr
rhs)
where
(Subst
subst', [Id]
bndrs') = Subst -> [Id] -> (Subst, [Id])
forall (f :: * -> *).
Traversable f =>
Subst -> f Id -> (Subst, f Id)
substBndrs Subst
subst [Id]
bndrs
substBind, substBindSC :: HasDebugCallStack => Subst -> CoreBind -> (Subst, CoreBind)
substBindSC :: HasDebugCallStack => Subst -> Bind Id -> (Subst, Bind Id)
substBindSC Subst
subst Bind Id
bind
| Bool -> Bool
not (Subst -> Bool
isEmptySubst Subst
subst)
= HasDebugCallStack => Subst -> Bind Id -> (Subst, Bind Id)
Subst -> Bind Id -> (Subst, Bind Id)
substBind Subst
subst Bind Id
bind
| Bool
otherwise
= case Bind Id
bind of
NonRec Id
bndr CoreExpr
rhs -> (Subst
subst', Id -> CoreExpr -> Bind Id
forall b. b -> Expr b -> Bind b
NonRec Id
bndr' CoreExpr
rhs)
where
(Subst
subst', Id
bndr') = Subst -> Id -> (Subst, Id)
substBndr Subst
subst Id
bndr
Rec [(Id, CoreExpr)]
pairs -> (Subst
subst', [(Id, CoreExpr)] -> Bind Id
forall b. [(b, Expr b)] -> Bind b
Rec ([Id]
bndrs' [Id] -> [CoreExpr] -> [(Id, CoreExpr)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [CoreExpr]
rhss'))
where
([Id]
bndrs, [CoreExpr]
rhss) = [(Id, CoreExpr)] -> ([Id], [CoreExpr])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
pairs
(Subst
subst', [Id]
bndrs') = Subst -> [Id] -> (Subst, [Id])
forall (f :: * -> *).
Traversable f =>
Subst -> f Id -> (Subst, f Id)
substRecBndrs Subst
subst [Id]
bndrs
rhss' :: [CoreExpr]
rhss' | Subst -> Bool
isEmptySubst Subst
subst'
= [CoreExpr]
rhss
| Bool
otherwise
= (CoreExpr -> CoreExpr) -> [CoreExpr] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map (HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst') [CoreExpr]
rhss
substBind :: HasDebugCallStack => Subst -> Bind Id -> (Subst, Bind Id)
substBind Subst
subst (NonRec Id
bndr CoreExpr
rhs)
= (Subst
subst', Id -> CoreExpr -> Bind Id
forall b. b -> Expr b -> Bind b
NonRec Id
bndr' (HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst CoreExpr
rhs))
where
(Subst
subst', Id
bndr') = Subst -> Id -> (Subst, Id)
substBndr Subst
subst Id
bndr
substBind Subst
subst (Rec [(Id, CoreExpr)]
pairs)
= (Subst
subst', [(Id, CoreExpr)] -> Bind Id
forall b. [(b, Expr b)] -> Bind b
Rec ([Id]
bndrs' [Id] -> [CoreExpr] -> [(Id, CoreExpr)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [CoreExpr]
rhss'))
where
([Id]
bndrs, [CoreExpr]
rhss) = [(Id, CoreExpr)] -> ([Id], [CoreExpr])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
pairs
(Subst
subst', [Id]
bndrs') = Subst -> [Id] -> (Subst, [Id])
forall (f :: * -> *).
Traversable f =>
Subst -> f Id -> (Subst, f Id)
substRecBndrs Subst
subst [Id]
bndrs
rhss' :: [CoreExpr]
rhss' = (CoreExpr -> CoreExpr) -> [CoreExpr] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map (HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst') [CoreExpr]
rhss
deShadowBinds :: CoreProgram -> CoreProgram
deShadowBinds :: CoreProgram -> CoreProgram
deShadowBinds CoreProgram
binds = (Subst, CoreProgram) -> CoreProgram
forall a b. (a, b) -> b
snd ((Subst -> Bind Id -> (Subst, Bind Id))
-> Subst -> CoreProgram -> (Subst, CoreProgram)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL HasDebugCallStack => Subst -> Bind Id -> (Subst, Bind Id)
Subst -> Bind Id -> (Subst, Bind Id)
substBind Subst
emptySubst CoreProgram
binds)
substBndr :: Subst -> Var -> (Subst, Var)
substBndr :: Subst -> Id -> (Subst, Id)
substBndr Subst
subst Id
bndr
| Id -> Bool
isTyVar Id
bndr = HasDebugCallStack => Subst -> Id -> (Subst, Id)
Subst -> Id -> (Subst, Id)
substTyVarBndr Subst
subst Id
bndr
| Id -> Bool
isCoVar Id
bndr = HasDebugCallStack => Subst -> Id -> (Subst, Id)
Subst -> Id -> (Subst, Id)
substCoVarBndr Subst
subst Id
bndr
| Bool
otherwise = SDoc -> Subst -> Subst -> Id -> (Subst, Id)
substIdBndr (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"var-bndr") Subst
subst Subst
subst Id
bndr
substBndrs :: Traversable f => Subst -> f Var -> (Subst, f Var)
substBndrs :: forall (f :: * -> *).
Traversable f =>
Subst -> f Id -> (Subst, f Id)
substBndrs = (Subst -> Id -> (Subst, Id)) -> Subst -> f Id -> (Subst, f Id)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Subst -> Id -> (Subst, Id)
substBndr
{-# INLINE substBndrs #-}
substRecBndrs :: Traversable f => Subst -> f Id -> (Subst, f Id)
substRecBndrs :: forall (f :: * -> *).
Traversable f =>
Subst -> f Id -> (Subst, f Id)
substRecBndrs Subst
subst f Id
bndrs
= (Subst
new_subst, f Id
new_bndrs)
where
(Subst
new_subst, f Id
new_bndrs) = (Subst -> Id -> (Subst, Id)) -> Subst -> f Id -> (Subst, f Id)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (SDoc -> Subst -> Subst -> Id -> (Subst, Id)
substIdBndr (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"rec-bndr") Subst
new_subst) Subst
subst f Id
bndrs
{-# SPECIALIZE substRecBndrs :: Subst -> [Id] -> (Subst, [Id]) #-}
{-# SPECIALIZE substRecBndrs :: Subst -> Identity Id -> (Subst, Identity Id) #-}
substIdBndr :: SDoc
-> Subst
-> Subst -> Id
-> (Subst, Id)
substIdBndr :: SDoc -> Subst -> Subst -> Id -> (Subst, Id)
substIdBndr SDoc
_doc Subst
rec_subst subst :: Subst
subst@(Subst InScopeSet
in_scope IdSubstEnv
env TvSubstEnv
tvs CvSubstEnv
cvs) Id
old_id
=
(InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
new_in_scope IdSubstEnv
new_env TvSubstEnv
tvs CvSubstEnv
cvs, Id
new_id)
where
id1 :: Id
id1 = InScopeSet -> Id -> Id
uniqAway InScopeSet
in_scope Id
old_id
id2 :: Id
id2 | Bool
no_type_change = Id
id1
| Bool
otherwise = (Type -> Type) -> Id -> Id
updateIdTypeAndMult (Subst -> Type -> Type
substTyUnchecked Subst
subst) Id
id1
old_ty :: Type
old_ty = Id -> Type
idType Id
old_id
old_w :: Type
old_w = HasDebugCallStack => Id -> Type
Id -> Type
idMult Id
old_id
no_type_change :: Bool
no_type_change = (TvSubstEnv -> Bool
forall a. VarEnv a -> Bool
isEmptyVarEnv TvSubstEnv
tvs Bool -> Bool -> Bool
&& CvSubstEnv -> Bool
forall a. VarEnv a -> Bool
isEmptyVarEnv CvSubstEnv
cvs) Bool -> Bool -> Bool
||
(Type -> Bool
noFreeVarsOfType Type
old_ty Bool -> Bool -> Bool
&& Type -> Bool
noFreeVarsOfType Type
old_w)
!new_id :: Id
new_id = Maybe IdInfo -> Id -> Id
maybeModifyIdInfo Maybe IdInfo
mb_new_info Id
id2
mb_new_info :: Maybe IdInfo
mb_new_info = Subst -> Id -> IdInfo -> Maybe IdInfo
substIdInfo Subst
rec_subst Id
id2 (HasDebugCallStack => Id -> IdInfo
Id -> IdInfo
idInfo Id
id2)
!new_in_scope :: InScopeSet
new_in_scope = InScopeSet
in_scope InScopeSet -> Id -> InScopeSet
`InScopeSet.extendInScopeSet` Id
new_id
!new_env :: IdSubstEnv
new_env | Bool
no_change = IdSubstEnv -> Id -> IdSubstEnv
forall a. VarEnv a -> Id -> VarEnv a
delVarEnv IdSubstEnv
env Id
old_id
| Bool
otherwise = IdSubstEnv -> Id -> CoreExpr -> IdSubstEnv
forall a. VarEnv a -> Id -> a -> VarEnv a
extendVarEnv IdSubstEnv
env Id
old_id (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
new_id)
no_change :: Bool
no_change = Id
id1 Id -> Id -> Bool
forall a. Eq a => a -> a -> Bool
== Id
old_id
cloneIdBndr :: Subst -> UniqSupply -> Id -> (Subst, Id)
cloneIdBndr :: Subst -> UniqSupply -> Id -> (Subst, Id)
cloneIdBndr Subst
subst UniqSupply
us Id
old_id
= Subst -> Subst -> (Id, Unique) -> (Subst, Id)
clone_id Subst
subst Subst
subst (Id
old_id, UniqSupply -> Unique
uniqFromSupply UniqSupply
us)
cloneIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
cloneIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
cloneIdBndrs Subst
subst UniqSupply
us [Id]
ids
= (Subst -> (Id, Unique) -> (Subst, Id))
-> Subst -> [(Id, Unique)] -> (Subst, [Id])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (Subst -> Subst -> (Id, Unique) -> (Subst, Id)
clone_id Subst
subst) Subst
subst ([Id]
ids [Id] -> [Unique] -> [(Id, Unique)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` UniqSupply -> [Unique]
uniqsFromSupply UniqSupply
us)
cloneBndrs :: MonadUnique m => Subst -> [Var] -> m (Subst, [Var])
cloneBndrs :: forall (m :: * -> *).
MonadUnique m =>
Subst -> [Id] -> m (Subst, [Id])
cloneBndrs Subst
subst [Id]
vs
= do us <- m [Unique]
forall (m :: * -> *). MonadUnique m => m [Unique]
getUniquesM
pure $ mapAccumL (\Subst
subst (Id
v, Unique
u) -> Subst -> Unique -> Id -> (Subst, Id)
cloneBndr Subst
subst Unique
u Id
v) subst (vs `zip` us)
cloneBndr :: Subst -> Unique -> Var -> (Subst, Var)
cloneBndr :: Subst -> Unique -> Id -> (Subst, Id)
cloneBndr Subst
subst Unique
uniq Id
v
| Id -> Bool
isTyVar Id
v = Subst -> Id -> Unique -> (Subst, Id)
cloneTyVarBndr Subst
subst Id
v Unique
uniq
| Bool
otherwise = Subst -> Subst -> (Id, Unique) -> (Subst, Id)
clone_id Subst
subst Subst
subst (Id
v,Unique
uniq)
cloneRecIdBndrs :: MonadUnique m => Subst -> [Id] -> m (Subst, [Id])
cloneRecIdBndrs :: forall (m :: * -> *).
MonadUnique m =>
Subst -> [Id] -> m (Subst, [Id])
cloneRecIdBndrs Subst
subst [Id]
ids
= do us <- m [Unique]
forall (m :: * -> *). MonadUnique m => m [Unique]
getUniquesM
let (subst', ids') = mapAccumL (clone_id subst') subst (ids `zip` us)
pure (subst', ids')
clone_id :: Subst
-> Subst -> (Id, Unique)
-> (Subst, Id)
clone_id :: Subst -> Subst -> (Id, Unique) -> (Subst, Id)
clone_id Subst
rec_subst subst :: Subst
subst@(Subst InScopeSet
in_scope IdSubstEnv
idvs TvSubstEnv
tvs CvSubstEnv
cvs) (Id
old_id, Unique
uniq)
= (InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
new_in_scope IdSubstEnv
new_idvs TvSubstEnv
tvs CvSubstEnv
new_cvs, Id
new_id)
where
id1 :: Id
id1 = Id -> Unique -> Id
setVarUnique Id
old_id Unique
uniq
id2 :: Id
id2 = Subst -> Id -> Id
substIdType Subst
subst Id
id1
!new_id :: Id
new_id = Maybe IdInfo -> Id -> Id
maybeModifyIdInfo (Subst -> Id -> IdInfo -> Maybe IdInfo
substIdInfo Subst
rec_subst Id
id2 (HasDebugCallStack => Id -> IdInfo
Id -> IdInfo
idInfo Id
old_id)) Id
id2
!new_in_scope :: InScopeSet
new_in_scope = InScopeSet
in_scope InScopeSet -> Id -> InScopeSet
`InScopeSet.extendInScopeSet` Id
new_id
(!IdSubstEnv
new_idvs, !CvSubstEnv
new_cvs) | Id -> Bool
isCoVar Id
old_id = (IdSubstEnv
idvs, CvSubstEnv -> Id -> Coercion -> CvSubstEnv
forall a. VarEnv a -> Id -> a -> VarEnv a
extendVarEnv CvSubstEnv
cvs Id
old_id (Id -> Coercion
mkCoVarCo Id
new_id))
| Bool
otherwise = (IdSubstEnv -> Id -> CoreExpr -> IdSubstEnv
forall a. VarEnv a -> Id -> a -> VarEnv a
extendVarEnv IdSubstEnv
idvs Id
old_id (Id -> CoreExpr
forall b. Id -> Expr b
Var Id
new_id), CvSubstEnv
cvs)
substIdType :: Subst -> Id -> Id
substIdType :: Subst -> Id -> Id
substIdType subst :: Subst
subst@(Subst InScopeSet
_ IdSubstEnv
_ TvSubstEnv
tv_env CvSubstEnv
cv_env) Id
id
| (TvSubstEnv -> Bool
forall a. VarEnv a -> Bool
isEmptyVarEnv TvSubstEnv
tv_env Bool -> Bool -> Bool
&& CvSubstEnv -> Bool
forall a. VarEnv a -> Bool
isEmptyVarEnv CvSubstEnv
cv_env)
Bool -> Bool -> Bool
|| (Type -> Bool
noFreeVarsOfType Type
old_ty Bool -> Bool -> Bool
&& Type -> Bool
noFreeVarsOfType Type
old_w) = Id
id
| Bool
otherwise =
(Type -> Type) -> Id -> Id
updateIdTypeAndMult (Subst -> Type -> Type
substTyUnchecked Subst
subst) Id
id
where
old_ty :: Type
old_ty = Id -> Type
idType Id
id
old_w :: Type
old_w = HasDebugCallStack => Id -> Type
Id -> Type
idMult Id
id
substIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo
substIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo
substIdInfo Subst
subst Id
new_id IdInfo
info
| Bool
nothing_to_do = Maybe IdInfo
forall a. Maybe a
Nothing
| Bool
otherwise = IdInfo -> Maybe IdInfo
forall a. a -> Maybe a
Just (IdInfo
info IdInfo -> RuleInfo -> IdInfo
`setRuleInfo` Subst -> Id -> RuleInfo -> RuleInfo
substRuleInfo Subst
subst Id
new_id RuleInfo
old_rules
IdInfo -> Unfolding -> IdInfo
`setUnfoldingInfo` Subst -> Unfolding -> Unfolding
substUnfolding Subst
subst Unfolding
old_unf)
where
old_rules :: RuleInfo
old_rules = IdInfo -> RuleInfo
ruleInfo IdInfo
info
old_unf :: Unfolding
old_unf = IdInfo -> Unfolding
realUnfoldingInfo IdInfo
info
nothing_to_do :: Bool
nothing_to_do = RuleInfo -> Bool
isEmptyRuleInfo RuleInfo
old_rules Bool -> Bool -> Bool
&& Bool -> Bool
not (Unfolding -> Bool
hasCoreUnfolding Unfolding
old_unf)
substUnfolding, substUnfoldingSC :: Subst -> Unfolding -> Unfolding
substUnfoldingSC :: Subst -> Unfolding -> Unfolding
substUnfoldingSC Subst
subst Unfolding
unf
| Subst -> Bool
isEmptySubst Subst
subst = Unfolding
unf
| Bool
otherwise = Subst -> Unfolding -> Unfolding
substUnfolding Subst
subst Unfolding
unf
substUnfolding :: Subst -> Unfolding -> Unfolding
substUnfolding Subst
subst df :: Unfolding
df@(DFunUnfolding { df_bndrs :: Unfolding -> [Id]
df_bndrs = [Id]
bndrs, df_args :: Unfolding -> [CoreExpr]
df_args = [CoreExpr]
args })
= Unfolding
df { df_bndrs = bndrs', df_args = args' }
where
(Subst
subst',[Id]
bndrs') = Subst -> [Id] -> (Subst, [Id])
forall (f :: * -> *).
Traversable f =>
Subst -> f Id -> (Subst, f Id)
substBndrs Subst
subst [Id]
bndrs
args' :: [CoreExpr]
args' = (CoreExpr -> CoreExpr) -> [CoreExpr] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map (HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst') [CoreExpr]
args
substUnfolding Subst
subst unf :: Unfolding
unf@(CoreUnfolding { uf_tmpl :: Unfolding -> CoreExpr
uf_tmpl = CoreExpr
tmpl, uf_src :: Unfolding -> UnfoldingSource
uf_src = UnfoldingSource
src })
| Bool -> Bool
not (UnfoldingSource -> Bool
isStableSource UnfoldingSource
src)
= Unfolding
NoUnfolding
| Bool
otherwise
= CoreExpr -> ()
seqExpr CoreExpr
new_tmpl () -> Unfolding -> Unfolding
forall a b. a -> b -> b
`seq`
Unfolding
unf { uf_tmpl = new_tmpl }
where
new_tmpl :: CoreExpr
new_tmpl = HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst CoreExpr
tmpl
substUnfolding Subst
_ Unfolding
unf = Unfolding
unf
substIdOcc :: Subst -> Id -> Id
substIdOcc :: Subst -> Id -> Id
substIdOcc Subst
subst Id
v = case HasDebugCallStack => Subst -> Id -> CoreExpr
Subst -> Id -> CoreExpr
lookupIdSubst Subst
subst Id
v of
Var Id
v' -> Id
v'
CoreExpr
other -> String -> SDoc -> Id
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"substIdOcc" ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
v SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> CoreExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoreExpr
other, Subst -> SDoc
forall a. Outputable a => a -> SDoc
ppr Subst
subst])
substRuleInfo :: Subst -> Id -> RuleInfo -> RuleInfo
substRuleInfo :: Subst -> Id -> RuleInfo -> RuleInfo
substRuleInfo Subst
subst Id
new_id (RuleInfo [CoreRule]
rules DVarSet
rhs_fvs)
= [CoreRule] -> DVarSet -> RuleInfo
RuleInfo ((CoreRule -> CoreRule) -> [CoreRule] -> [CoreRule]
forall a b. (a -> b) -> [a] -> [b]
map (Subst -> (Name -> Name) -> CoreRule -> CoreRule
substRule Subst
subst Name -> Name
subst_ru_fn) [CoreRule]
rules)
(HasDebugCallStack => Subst -> DVarSet -> DVarSet
Subst -> DVarSet -> DVarSet
substDVarSet Subst
subst DVarSet
rhs_fvs)
where
subst_ru_fn :: Name -> Name
subst_ru_fn = Name -> Name -> Name
forall a b. a -> b -> a
const (Id -> Name
idName Id
new_id)
substRulesForImportedIds :: Subst -> [CoreRule] -> [CoreRule]
substRulesForImportedIds :: Subst -> [CoreRule] -> [CoreRule]
substRulesForImportedIds Subst
subst [CoreRule]
rules
= (CoreRule -> CoreRule) -> [CoreRule] -> [CoreRule]
forall a b. (a -> b) -> [a] -> [b]
map (Subst -> (Name -> Name) -> CoreRule -> CoreRule
substRule Subst
subst Name -> Name
forall {a} {a}. Outputable a => a -> a
not_needed) [CoreRule]
rules
where
not_needed :: a -> a
not_needed a
name = String -> SDoc -> a
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"substRulesForImportedIds" (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
name)
substRule :: Subst -> (Name -> Name) -> CoreRule -> CoreRule
substRule :: Subst -> (Name -> Name) -> CoreRule -> CoreRule
substRule Subst
_ Name -> Name
_ rule :: CoreRule
rule@(BuiltinRule {}) = CoreRule
rule
substRule Subst
subst Name -> Name
subst_ru_fn rule :: CoreRule
rule@(Rule { ru_bndrs :: CoreRule -> [Id]
ru_bndrs = [Id]
bndrs, ru_args :: CoreRule -> [CoreExpr]
ru_args = [CoreExpr]
args
, ru_fn :: CoreRule -> Name
ru_fn = Name
fn_name, ru_rhs :: CoreRule -> CoreExpr
ru_rhs = CoreExpr
rhs
, ru_local :: CoreRule -> Bool
ru_local = Bool
is_local })
= CoreRule
rule { ru_bndrs = bndrs'
, ru_fn = if is_local
then subst_ru_fn fn_name
else fn_name
, ru_args = map (substExpr subst') args
, ru_rhs = substExpr subst' rhs }
where
(Subst
subst', [Id]
bndrs') = Subst -> [Id] -> (Subst, [Id])
forall (f :: * -> *).
Traversable f =>
Subst -> f Id -> (Subst, f Id)
substBndrs Subst
subst [Id]
bndrs
substDVarSet :: HasDebugCallStack => Subst -> DVarSet -> DVarSet
substDVarSet :: HasDebugCallStack => Subst -> DVarSet -> DVarSet
substDVarSet subst :: Subst
subst@(Subst InScopeSet
_ IdSubstEnv
_ TvSubstEnv
tv_env CvSubstEnv
cv_env) DVarSet
fvs
= [Id] -> DVarSet
mkDVarSet ([Id] -> DVarSet) -> [Id] -> DVarSet
forall a b. (a -> b) -> a -> b
$ ([Id], VarSet) -> [Id]
forall a b. (a, b) -> a
fst (([Id], VarSet) -> [Id]) -> ([Id], VarSet) -> [Id]
forall a b. (a -> b) -> a -> b
$ (Id -> ([Id], VarSet) -> ([Id], VarSet))
-> ([Id], VarSet) -> [Id] -> ([Id], VarSet)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Id -> ([Id], VarSet) -> ([Id], VarSet)
subst_fv ([], VarSet
emptyVarSet) ([Id] -> ([Id], VarSet)) -> [Id] -> ([Id], VarSet)
forall a b. (a -> b) -> a -> b
$ DVarSet -> [Id]
dVarSetElems DVarSet
fvs
where
subst_fv :: Var -> ([Var], VarSet) -> ([Var], VarSet)
subst_fv :: Id -> ([Id], VarSet) -> ([Id], VarSet)
subst_fv Id
fv ([Id], VarSet)
acc
| Id -> Bool
isTyVar Id
fv
, let fv_ty :: Type
fv_ty = TvSubstEnv -> Id -> Maybe Type
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv TvSubstEnv
tv_env Id
fv Maybe Type -> Type -> Type
forall a. Maybe a -> a -> a
`orElse` Id -> Type
mkTyVarTy Id
fv
= Type -> FV
tyCoFVsOfType Type
fv_ty (Bool -> Id -> Bool
forall a b. a -> b -> a
const Bool
True) VarSet
emptyVarSet (([Id], VarSet) -> ([Id], VarSet))
-> ([Id], VarSet) -> ([Id], VarSet)
forall a b. (a -> b) -> a -> b
$! ([Id], VarSet)
acc
| Id -> Bool
isCoVar Id
fv
, let fv_co :: Coercion
fv_co = CvSubstEnv -> Id -> Maybe Coercion
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv CvSubstEnv
cv_env Id
fv Maybe Coercion -> Coercion -> Coercion
forall a. Maybe a -> a -> a
`orElse` Id -> Coercion
mkCoVarCo Id
fv
= Coercion -> FV
tyCoFVsOfCo Coercion
fv_co (Bool -> Id -> Bool
forall a b. a -> b -> a
const Bool
True) VarSet
emptyVarSet (([Id], VarSet) -> ([Id], VarSet))
-> ([Id], VarSet) -> ([Id], VarSet)
forall a b. (a -> b) -> a -> b
$! ([Id], VarSet)
acc
| Bool
otherwise
, let fv_expr :: CoreExpr
fv_expr = HasDebugCallStack => Subst -> Id -> CoreExpr
Subst -> Id -> CoreExpr
lookupIdSubst Subst
subst Id
fv
= CoreExpr -> FV
exprFVs CoreExpr
fv_expr (Bool -> Id -> Bool
forall a b. a -> b -> a
const Bool
True) VarSet
emptyVarSet (([Id], VarSet) -> ([Id], VarSet))
-> ([Id], VarSet) -> ([Id], VarSet)
forall a b. (a -> b) -> a -> b
$! ([Id], VarSet)
acc
substTickish :: Subst -> CoreTickish -> CoreTickish
substTickish :: Subst -> CoreTickish -> CoreTickish
substTickish Subst
subst (Breakpoint XBreakpoint 'TickishPassCore
ext Int
n [XTickishId 'TickishPassCore]
ids Module
modl)
= XBreakpoint 'TickishPassCore
-> Int -> [XTickishId 'TickishPassCore] -> Module -> CoreTickish
forall (pass :: TickishPass).
XBreakpoint pass
-> Int -> [XTickishId pass] -> Module -> GenTickish pass
Breakpoint XBreakpoint 'TickishPassCore
ext Int
n ((Id -> Maybe Id) -> [Id] -> [Id]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Id -> Maybe Id
do_one [Id]
[XTickishId 'TickishPassCore]
ids) Module
modl
where
do_one :: Id -> Maybe Id
do_one = CoreExpr -> Maybe Id
getIdFromTrivialExpr_maybe (CoreExpr -> Maybe Id) -> (Id -> CoreExpr) -> Id -> Maybe Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => Subst -> Id -> CoreExpr
Subst -> Id -> CoreExpr
lookupIdSubst Subst
subst
substTickish Subst
_subst CoreTickish
other = CoreTickish
other