{-# LANGUAGE CPP #-}
module CoreSubst (
Subst(..),
TvSubstEnv, IdSubstEnv, InScopeSet,
deShadowBinds, substSpec, substRulesForImportedIds,
substTy, substCo, substExpr, substExprSC, substBind, substBindSC,
substUnfolding, substUnfoldingSC,
lookupIdSubst, lookupTCvSubst, substIdOcc,
substTickish, substDVarSet, substIdInfo,
emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, substInScope, isEmptySubst,
extendIdSubst, extendIdSubstList, extendTCvSubst, extendTvSubstList,
extendSubst, extendSubstList, extendSubstWithVar, zapSubstEnv,
addInScopeSet, extendInScope, extendInScopeList, extendInScopeIds,
isInScope, setInScope, getTCvSubst, extendTvSubst, extendCvSubst,
delBndr, delBndrs,
substBndr, substBndrs, substRecBndrs, substTyVarBndr, substCoVarBndr,
cloneBndr, cloneBndrs, cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs,
) where
#include "HsVersions.h"
import GhcPrelude
import CoreSyn
import CoreFVs
import CoreSeq
import CoreUtils
import qualified Type
import qualified Coercion
import Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList
, isInScope, substTyVarBndr, cloneTyVarBndr )
import Coercion hiding ( substCo, substCoVarBndr )
import PrelNames
import VarSet
import VarEnv
import Id
import Name ( Name )
import Var
import IdInfo
import UniqSupply
import Maybes
import Util
import Outputable
import PprCore ()
import Data.List
data Subst
= Subst InScopeSet
IdSubstEnv
TvSubstEnv
CvSubstEnv
type IdSubstEnv = IdEnv CoreExpr
isEmptySubst :: Subst -> Bool
isEmptySubst :: Subst -> Bool
isEmptySubst (Subst _ id_env :: IdSubstEnv
id_env tv_env :: TvSubstEnv
tv_env cv_env :: CvSubstEnv
cv_env)
= IdSubstEnv -> Bool
forall a. VarEnv a -> Bool
isEmptyVarEnv IdSubstEnv
id_env Bool -> Bool -> Bool
&& 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
emptySubst :: Subst
emptySubst :: Subst
emptySubst = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
emptyInScopeSet IdSubstEnv
forall a. VarEnv a
emptyVarEnv TvSubstEnv
forall a. VarEnv a
emptyVarEnv CvSubstEnv
forall a. VarEnv a
emptyVarEnv
mkEmptySubst :: InScopeSet -> Subst
mkEmptySubst :: InScopeSet -> Subst
mkEmptySubst in_scope :: InScopeSet
in_scope = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope IdSubstEnv
forall a. VarEnv a
emptyVarEnv TvSubstEnv
forall a. VarEnv a
emptyVarEnv CvSubstEnv
forall a. VarEnv a
emptyVarEnv
mkSubst :: InScopeSet -> TvSubstEnv -> CvSubstEnv -> IdSubstEnv -> Subst
mkSubst :: InScopeSet -> TvSubstEnv -> CvSubstEnv -> IdSubstEnv -> Subst
mkSubst in_scope :: InScopeSet
in_scope tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs ids :: IdSubstEnv
ids = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs
substInScope :: Subst -> InScopeSet
substInScope :: Subst -> InScopeSet
substInScope (Subst in_scope :: InScopeSet
in_scope _ _ _) = InScopeSet
in_scope
zapSubstEnv :: Subst -> Subst
zapSubstEnv :: Subst -> Subst
zapSubstEnv (Subst in_scope :: InScopeSet
in_scope _ _ _) = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope IdSubstEnv
forall a. VarEnv a
emptyVarEnv TvSubstEnv
forall a. VarEnv a
emptyVarEnv CvSubstEnv
forall a. VarEnv a
emptyVarEnv
extendIdSubst :: Subst -> Id -> CoreExpr -> Subst
extendIdSubst :: Subst -> Id -> CoreExpr -> Subst
extendIdSubst (Subst in_scope :: InScopeSet
in_scope ids :: IdSubstEnv
ids tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs) v :: Id
v r :: CoreExpr
r
= ASSERT2( isNonCoVarId v, ppr v $$ ppr r )
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
extendIdSubstList :: Subst -> [(Id, CoreExpr)] -> Subst
extendIdSubstList :: Subst -> [(Id, CoreExpr)] -> Subst
extendIdSubstList (Subst in_scope :: InScopeSet
in_scope ids :: IdSubstEnv
ids tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs) prs :: [(Id, CoreExpr)]
prs
= ASSERT( all (isNonCoVarId . fst) prs )
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
extendTvSubst :: Subst -> TyVar -> Type -> Subst
extendTvSubst :: Subst -> Id -> Type -> Subst
extendTvSubst (Subst in_scope :: InScopeSet
in_scope ids :: IdSubstEnv
ids tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs) tv :: Id
tv ty :: Type
ty
= ASSERT( isTyVar tv )
InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope IdSubstEnv
ids (TvSubstEnv -> Id -> Type -> TvSubstEnv
forall a. VarEnv a -> Id -> a -> VarEnv a
extendVarEnv TvSubstEnv
tvs Id
tv Type
ty) CvSubstEnv
cvs
extendTvSubstList :: Subst -> [(TyVar,Type)] -> Subst
extendTvSubstList :: Subst -> [(Id, Type)] -> Subst
extendTvSubstList subst :: Subst
subst vrs :: [(Id, Type)]
vrs
= (Subst -> (Id, Type) -> Subst) -> Subst -> [(Id, Type)] -> Subst
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Subst -> (Id, Type) -> Subst
extend Subst
subst [(Id, Type)]
vrs
where
extend :: Subst -> (Id, Type) -> Subst
extend subst :: Subst
subst (v :: Id
v, r :: Type
r) = Subst -> Id -> Type -> Subst
extendTvSubst Subst
subst Id
v Type
r
extendCvSubst :: Subst -> CoVar -> Coercion -> Subst
extendCvSubst :: Subst -> Id -> Coercion -> Subst
extendCvSubst (Subst in_scope :: InScopeSet
in_scope ids :: IdSubstEnv
ids tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs) v :: Id
v r :: Coercion
r
= ASSERT( isCoVar v )
InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs (CvSubstEnv -> Id -> Coercion -> CvSubstEnv
forall a. VarEnv a -> Id -> a -> VarEnv a
extendVarEnv CvSubstEnv
cvs Id
v Coercion
r)
extendSubst :: Subst -> Var -> CoreArg -> Subst
extendSubst :: Subst -> Id -> CoreExpr -> Subst
extendSubst subst :: Subst
subst var :: Id
var arg :: CoreExpr
arg
= case CoreExpr
arg of
Type ty :: Type
ty -> ASSERT( isTyVar var ) extendTvSubst subst var ty
Coercion co :: Coercion
co -> ASSERT( isCoVar var ) extendCvSubst subst var co
_ -> ASSERT( isId var ) extendIdSubst subst var arg
extendSubstWithVar :: Subst -> Var -> Var -> Subst
extendSubstWithVar :: Subst -> Id -> Id -> Subst
extendSubstWithVar subst :: Subst
subst v1 :: Id
v1 v2 :: Id
v2
| Id -> Bool
isTyVar Id
v1 = ASSERT( isTyVar v2 ) extendTvSubst subst v1 (mkTyVarTy v2)
| Id -> Bool
isCoVar Id
v1 = ASSERT( isCoVar v2 ) extendCvSubst subst v1 (mkCoVarCo v2)
| Bool
otherwise = ASSERT( isId v2 ) extendIdSubst subst v1 (Var v2)
extendSubstList :: Subst -> [(Var,CoreArg)] -> Subst
extendSubstList :: Subst -> [(Id, CoreExpr)] -> Subst
extendSubstList subst :: Subst
subst [] = Subst
subst
extendSubstList subst :: Subst
subst ((var :: Id
var,rhs :: CoreExpr
rhs):prs :: [(Id, CoreExpr)]
prs) = Subst -> [(Id, CoreExpr)] -> Subst
extendSubstList (Subst -> Id -> CoreExpr -> Subst
extendSubst Subst
subst Id
var CoreExpr
rhs) [(Id, CoreExpr)]
prs
lookupIdSubst :: SDoc -> Subst -> Id -> CoreExpr
lookupIdSubst :: SDoc -> Subst -> Id -> CoreExpr
lookupIdSubst doc :: SDoc
doc (Subst in_scope :: InScopeSet
in_scope ids :: IdSubstEnv
ids _ _) v :: Id
v
| Bool -> Bool
not (Id -> Bool
isLocalId Id
v) = Id -> CoreExpr
forall b. Id -> Expr b
Var Id
v
| Just e :: CoreExpr
e <- IdSubstEnv -> Id -> Maybe CoreExpr
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv IdSubstEnv
ids Id
v = CoreExpr
e
| Just v' :: Id
v' <- InScopeSet -> Id -> Maybe Id
lookupInScope InScopeSet
in_scope Id
v = Id -> CoreExpr
forall b. Id -> Expr b
Var Id
v'
| Bool
otherwise = WARN( True, text "CoreSubst.lookupIdSubst" <+> doc <+> ppr v
$$ ppr in_scope)
Id -> CoreExpr
forall b. Id -> Expr b
Var Id
v
lookupTCvSubst :: Subst -> TyVar -> Type
lookupTCvSubst :: Subst -> Id -> Type
lookupTCvSubst (Subst _ _ tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs) v :: Id
v
| Id -> Bool
isTyVar Id
v
= TvSubstEnv -> Id -> Maybe Type
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv TvSubstEnv
tvs Id
v Maybe Type -> Type -> Type
forall a. Maybe a -> a -> a
`orElse` Id -> Type
Type.mkTyVarTy Id
v
| Bool
otherwise
= Coercion -> Type
mkCoercionTy (Coercion -> Type) -> Coercion -> Type
forall a b. (a -> b) -> a -> b
$ CvSubstEnv -> Id -> Maybe Coercion
forall a. VarEnv a -> Id -> Maybe a
lookupVarEnv CvSubstEnv
cvs Id
v Maybe Coercion -> Coercion -> Coercion
forall a. Maybe a -> a -> a
`orElse` Id -> Coercion
mkCoVarCo Id
v
delBndr :: Subst -> Var -> Subst
delBndr :: Subst -> Id -> Subst
delBndr (Subst in_scope :: InScopeSet
in_scope ids :: IdSubstEnv
ids tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs) v :: 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 in_scope :: InScopeSet
in_scope ids :: IdSubstEnv
ids tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs) vs :: [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 in_scope :: InScopeSet
in_scope pairs :: [(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
id, e :: CoreExpr
e) <- [(Id, CoreExpr)]
pairs, Id -> Bool
isId Id
id])
([(Id, Type)] -> TvSubstEnv
forall a. [(Id, a)] -> VarEnv a
mkVarEnv [(Id
tv,Type
ty) | (tv :: Id
tv, Type ty :: Type
ty) <- [(Id, CoreExpr)]
pairs])
([(Id, Coercion)] -> CvSubstEnv
forall a. [(Id, a)] -> VarEnv a
mkVarEnv [(Id
v,Coercion
co) | (v :: Id
v, Coercion co :: Coercion
co) <- [(Id, CoreExpr)]
pairs])
isInScope :: Var -> Subst -> Bool
isInScope :: Id -> Subst -> Bool
isInScope v :: Id
v (Subst in_scope :: InScopeSet
in_scope _ _ _) = Id
v Id -> InScopeSet -> Bool
`elemInScopeSet` InScopeSet
in_scope
addInScopeSet :: Subst -> VarSet -> Subst
addInScopeSet :: Subst -> VarSet -> Subst
addInScopeSet (Subst in_scope :: InScopeSet
in_scope ids :: IdSubstEnv
ids tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs) vs :: VarSet
vs
= InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst (InScopeSet
in_scope InScopeSet -> VarSet -> InScopeSet
`extendInScopeSetSet` VarSet
vs) IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs
extendInScope :: Subst -> Var -> Subst
extendInScope :: Subst -> Id -> Subst
extendInScope (Subst in_scope :: InScopeSet
in_scope ids :: IdSubstEnv
ids tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs) v :: Id
v
= InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst (InScopeSet
in_scope InScopeSet -> Id -> InScopeSet
`extendInScopeSet` Id
v)
(IdSubstEnv
ids IdSubstEnv -> Id -> IdSubstEnv
forall a. VarEnv a -> Id -> VarEnv a
`delVarEnv` Id
v) (TvSubstEnv
tvs TvSubstEnv -> Id -> TvSubstEnv
forall a. VarEnv a -> Id -> VarEnv a
`delVarEnv` Id
v) (CvSubstEnv
cvs CvSubstEnv -> Id -> CvSubstEnv
forall a. VarEnv a -> Id -> VarEnv a
`delVarEnv` Id
v)
extendInScopeList :: Subst -> [Var] -> Subst
extendInScopeList :: Subst -> [Id] -> Subst
extendInScopeList (Subst in_scope :: InScopeSet
in_scope ids :: IdSubstEnv
ids tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs) vs :: [Id]
vs
= InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst (InScopeSet
in_scope InScopeSet -> [Id] -> InScopeSet
`extendInScopeSetList` [Id]
vs)
(IdSubstEnv
ids IdSubstEnv -> [Id] -> IdSubstEnv
forall a. VarEnv a -> [Id] -> VarEnv a
`delVarEnvList` [Id]
vs) (TvSubstEnv
tvs TvSubstEnv -> [Id] -> TvSubstEnv
forall a. VarEnv a -> [Id] -> VarEnv a
`delVarEnvList` [Id]
vs) (CvSubstEnv
cvs CvSubstEnv -> [Id] -> CvSubstEnv
forall a. VarEnv a -> [Id] -> VarEnv a
`delVarEnvList` [Id]
vs)
extendInScopeIds :: Subst -> [Id] -> Subst
extendInScopeIds :: Subst -> [Id] -> Subst
extendInScopeIds (Subst in_scope :: InScopeSet
in_scope ids :: IdSubstEnv
ids tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs) vs :: [Id]
vs
= InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst (InScopeSet
in_scope InScopeSet -> [Id] -> InScopeSet
`extendInScopeSetList` [Id]
vs)
(IdSubstEnv
ids IdSubstEnv -> [Id] -> IdSubstEnv
forall a. VarEnv a -> [Id] -> VarEnv a
`delVarEnvList` [Id]
vs) TvSubstEnv
tvs CvSubstEnv
cvs
setInScope :: Subst -> InScopeSet -> Subst
setInScope :: Subst -> InScopeSet -> Subst
setInScope (Subst _ ids :: IdSubstEnv
ids tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs) in_scope :: InScopeSet
in_scope = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs
instance Outputable Subst where
ppr :: Subst -> SDoc
ppr (Subst in_scope :: InScopeSet
in_scope ids :: IdSubstEnv
ids tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs)
= String -> SDoc
text "<InScope =" SDoc -> SDoc -> SDoc
<+> SDoc
in_scope_doc
SDoc -> SDoc -> SDoc
$$ String -> SDoc
text " IdSubst =" SDoc -> SDoc -> SDoc
<+> IdSubstEnv -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdSubstEnv
ids
SDoc -> SDoc -> SDoc
$$ String -> SDoc
text " TvSubst =" SDoc -> SDoc -> SDoc
<+> TvSubstEnv -> SDoc
forall a. Outputable a => a -> SDoc
ppr TvSubstEnv
tvs
SDoc -> SDoc -> SDoc
$$ String -> SDoc
text " CvSubst =" SDoc -> SDoc -> SDoc
<+> CvSubstEnv -> SDoc
forall a. Outputable a => a -> SDoc
ppr CvSubstEnv
cvs
SDoc -> SDoc -> SDoc
<> Char -> SDoc
char '>'
where
in_scope_doc :: SDoc
in_scope_doc = VarSet -> ([Id] -> SDoc) -> SDoc
pprVarSet (InScopeSet -> VarSet
getInScopeVars InScopeSet
in_scope) (SDoc -> SDoc
braces (SDoc -> SDoc) -> ([Id] -> SDoc) -> [Id] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SDoc] -> SDoc
fsep ([SDoc] -> SDoc) -> ([Id] -> [SDoc]) -> [Id] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id -> SDoc) -> [Id] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr)
substExprSC :: SDoc -> Subst -> CoreExpr -> CoreExpr
substExprSC :: SDoc -> Subst -> CoreExpr -> CoreExpr
substExprSC doc :: SDoc
doc subst :: Subst
subst orig_expr :: CoreExpr
orig_expr
| Subst -> Bool
isEmptySubst Subst
subst = CoreExpr
orig_expr
| Bool
otherwise =
SDoc -> Subst -> CoreExpr -> CoreExpr
subst_expr SDoc
doc Subst
subst CoreExpr
orig_expr
substExpr :: SDoc -> Subst -> CoreExpr -> CoreExpr
substExpr :: SDoc -> Subst -> CoreExpr -> CoreExpr
substExpr doc :: SDoc
doc subst :: Subst
subst orig_expr :: CoreExpr
orig_expr = SDoc -> Subst -> CoreExpr -> CoreExpr
subst_expr SDoc
doc Subst
subst CoreExpr
orig_expr
subst_expr :: SDoc -> Subst -> CoreExpr -> CoreExpr
subst_expr :: SDoc -> Subst -> CoreExpr -> CoreExpr
subst_expr doc :: SDoc
doc subst :: Subst
subst expr :: CoreExpr
expr
= CoreExpr -> CoreExpr
go CoreExpr
expr
where
go :: CoreExpr -> CoreExpr
go (Var v :: Id
v) = SDoc -> Subst -> Id -> CoreExpr
lookupIdSubst (SDoc
doc SDoc -> SDoc -> SDoc
$$ String -> SDoc
text "subst_expr") Subst
subst Id
v
go (Type ty :: Type
ty) = Type -> CoreExpr
forall b. Type -> Expr b
Type (Subst -> Type -> Type
substTy Subst
subst Type
ty)
go (Coercion co :: Coercion
co) = Coercion -> CoreExpr
forall b. Coercion -> Expr b
Coercion (Subst -> Coercion -> Coercion
substCo Subst
subst Coercion
co)
go (Lit lit :: Literal
lit) = Literal -> CoreExpr
forall b. Literal -> Expr b
Lit Literal
lit
go (App fun :: CoreExpr
fun arg :: 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 tickish :: Tickish Id
tickish e :: CoreExpr
e) = Tickish Id -> CoreExpr -> CoreExpr
mkTick (Subst -> Tickish Id -> Tickish Id
substTickish Subst
subst Tickish Id
tickish) (CoreExpr -> CoreExpr
go CoreExpr
e)
go (Cast e :: CoreExpr
e co :: Coercion
co) = CoreExpr -> Coercion -> CoreExpr
forall b. Expr b -> Coercion -> Expr b
Cast (CoreExpr -> CoreExpr
go CoreExpr
e) (Subst -> Coercion -> Coercion
substCo Subst
subst Coercion
co)
go (Lam bndr :: Id
bndr body :: CoreExpr
body) = Id -> CoreExpr -> CoreExpr
forall b. b -> Expr b -> Expr b
Lam Id
bndr' (SDoc -> Subst -> CoreExpr -> CoreExpr
subst_expr SDoc
doc Subst
subst' CoreExpr
body)
where
(subst' :: Subst
subst', bndr' :: Id
bndr') = Subst -> Id -> (Subst, Id)
substBndr Subst
subst Id
bndr
go (Let bind :: Bind Id
bind body :: CoreExpr
body) = Bind Id -> CoreExpr -> CoreExpr
forall b. Bind b -> Expr b -> Expr b
Let Bind Id
bind' (SDoc -> Subst -> CoreExpr -> CoreExpr
subst_expr SDoc
doc Subst
subst' CoreExpr
body)
where
(subst' :: Subst
subst', bind' :: Bind Id
bind') = Subst -> Bind Id -> (Subst, Bind Id)
substBind Subst
subst Bind Id
bind
go (Case scrut :: CoreExpr
scrut bndr :: Id
bndr ty :: Type
ty alts :: [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
substTy 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
forall a. Subst -> (a, [Id], CoreExpr) -> (a, [Id], CoreExpr)
go_alt Subst
subst') [Alt Id]
alts)
where
(subst' :: Subst
subst', bndr' :: Id
bndr') = Subst -> Id -> (Subst, Id)
substBndr Subst
subst Id
bndr
go_alt :: Subst -> (a, [Id], CoreExpr) -> (a, [Id], CoreExpr)
go_alt subst :: Subst
subst (con :: a
con, bndrs :: [Id]
bndrs, rhs :: CoreExpr
rhs) = (a
con, [Id]
bndrs', SDoc -> Subst -> CoreExpr -> CoreExpr
subst_expr SDoc
doc Subst
subst' CoreExpr
rhs)
where
(subst' :: Subst
subst', bndrs' :: [Id]
bndrs') = Subst -> [Id] -> (Subst, [Id])
substBndrs Subst
subst [Id]
bndrs
substBind, substBindSC :: Subst -> CoreBind -> (Subst, CoreBind)
substBindSC :: Subst -> Bind Id -> (Subst, Bind Id)
substBindSC subst :: Subst
subst bind :: Bind Id
bind
| Bool -> Bool
not (Subst -> Bool
isEmptySubst Subst
subst)
= Subst -> Bind Id -> (Subst, Bind Id)
substBind Subst
subst Bind Id
bind
| Bool
otherwise
= case Bind Id
bind of
NonRec bndr :: Id
bndr rhs :: CoreExpr
rhs -> (Subst
subst', Id -> CoreExpr -> Bind Id
forall b. b -> Expr b -> Bind b
NonRec Id
bndr' CoreExpr
rhs)
where
(subst' :: Subst
subst', bndr' :: Id
bndr') = Subst -> Id -> (Subst, Id)
substBndr Subst
subst Id
bndr
Rec pairs :: [(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
(bndrs :: [Id]
bndrs, rhss :: [CoreExpr]
rhss) = [(Id, CoreExpr)] -> ([Id], [CoreExpr])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
pairs
(subst' :: Subst
subst', bndrs' :: [Id]
bndrs') = Subst -> [Id] -> (Subst, [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 (SDoc -> Subst -> CoreExpr -> CoreExpr
subst_expr (String -> SDoc
text "substBindSC") Subst
subst') [CoreExpr]
rhss
substBind :: Subst -> Bind Id -> (Subst, Bind Id)
substBind subst :: Subst
subst (NonRec bndr :: Id
bndr rhs :: CoreExpr
rhs)
= (Subst
subst', Id -> CoreExpr -> Bind Id
forall b. b -> Expr b -> Bind b
NonRec Id
bndr' (SDoc -> Subst -> CoreExpr -> CoreExpr
subst_expr (String -> SDoc
text "substBind") Subst
subst CoreExpr
rhs))
where
(subst' :: Subst
subst', bndr' :: Id
bndr') = Subst -> Id -> (Subst, Id)
substBndr Subst
subst Id
bndr
substBind subst :: Subst
subst (Rec pairs :: [(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
(bndrs :: [Id]
bndrs, rhss :: [CoreExpr]
rhss) = [(Id, CoreExpr)] -> ([Id], [CoreExpr])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Id, CoreExpr)]
pairs
(subst' :: Subst
subst', bndrs' :: [Id]
bndrs') = Subst -> [Id] -> (Subst, [Id])
substRecBndrs Subst
subst [Id]
bndrs
rhss' :: [CoreExpr]
rhss' = (CoreExpr -> CoreExpr) -> [CoreExpr] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> Subst -> CoreExpr -> CoreExpr
subst_expr (String -> SDoc
text "substBind") Subst
subst') [CoreExpr]
rhss
deShadowBinds :: CoreProgram -> CoreProgram
deShadowBinds :: CoreProgram -> CoreProgram
deShadowBinds binds :: CoreProgram
binds = (Subst, CoreProgram) -> CoreProgram
forall a b. (a, b) -> b
snd ((Subst -> Bind Id -> (Subst, Bind Id))
-> Subst -> CoreProgram -> (Subst, CoreProgram)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Subst -> Bind Id -> (Subst, Bind Id)
substBind Subst
emptySubst CoreProgram
binds)
substBndr :: Subst -> Var -> (Subst, Var)
substBndr :: Subst -> Id -> (Subst, Id)
substBndr subst :: Subst
subst bndr :: Id
bndr
| Id -> Bool
isTyVar Id
bndr = Subst -> Id -> (Subst, Id)
substTyVarBndr Subst
subst Id
bndr
| Id -> Bool
isCoVar Id
bndr = Subst -> Id -> (Subst, Id)
substCoVarBndr Subst
subst Id
bndr
| Bool
otherwise = SDoc -> Subst -> Subst -> Id -> (Subst, Id)
substIdBndr (String -> SDoc
text "var-bndr") Subst
subst Subst
subst Id
bndr
substBndrs :: Subst -> [Var] -> (Subst, [Var])
substBndrs :: Subst -> [Id] -> (Subst, [Id])
substBndrs subst :: Subst
subst bndrs :: [Id]
bndrs = (Subst -> Id -> (Subst, Id)) -> Subst -> [Id] -> (Subst, [Id])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Subst -> Id -> (Subst, Id)
substBndr Subst
subst [Id]
bndrs
substRecBndrs :: Subst -> [Id] -> (Subst, [Id])
substRecBndrs :: Subst -> [Id] -> (Subst, [Id])
substRecBndrs subst :: Subst
subst bndrs :: [Id]
bndrs
= (Subst
new_subst, [Id]
new_bndrs)
where
(new_subst :: Subst
new_subst, new_bndrs :: [Id]
new_bndrs) = (Subst -> Id -> (Subst, Id)) -> Subst -> [Id] -> (Subst, [Id])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (SDoc -> Subst -> Subst -> Id -> (Subst, Id)
substIdBndr (String -> SDoc
text "rec-bndr") Subst
new_subst) Subst
subst [Id]
bndrs
substIdBndr :: SDoc
-> Subst
-> Subst -> Id
-> (Subst, Id)
substIdBndr :: SDoc -> Subst -> Subst -> Id -> (Subst, Id)
substIdBndr _doc :: SDoc
_doc rec_subst :: Subst
rec_subst subst :: Subst
subst@(Subst in_scope :: InScopeSet
in_scope env :: IdSubstEnv
env tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs) old_id :: Id
old_id
=
(InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst (InScopeSet
in_scope InScopeSet -> Id -> InScopeSet
`extendInScopeSet` Id
new_id) 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 = Id -> Type -> Id
setIdType Id
id1 (Subst -> Type -> Type
substTy Subst
subst Type
old_ty)
old_ty :: Type
old_ty = Id -> Type
idType 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
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_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
subst us :: UniqSupply
us old_id :: 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
subst us :: UniqSupply
us ids :: [Id]
ids
= (Subst -> (Id, Unique) -> (Subst, Id))
-> Subst -> [(Id, Unique)] -> (Subst, [Id])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
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 :: Subst -> UniqSupply -> [Var] -> (Subst, [Var])
cloneBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
cloneBndrs subst :: Subst
subst us :: UniqSupply
us vs :: [Id]
vs
= (Subst -> (Id, Unique) -> (Subst, Id))
-> Subst -> [(Id, Unique)] -> (Subst, [Id])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\subst :: Subst
subst (v :: Id
v, u :: Unique
u) -> Subst -> Unique -> Id -> (Subst, Id)
cloneBndr Subst
subst Unique
u Id
v) Subst
subst ([Id]
vs [Id] -> [Unique] -> [(Id, Unique)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` UniqSupply -> [Unique]
uniqsFromSupply UniqSupply
us)
cloneBndr :: Subst -> Unique -> Var -> (Subst, Var)
cloneBndr :: Subst -> Unique -> Id -> (Subst, Id)
cloneBndr subst :: Subst
subst uniq :: Unique
uniq v :: 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 :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
cloneRecIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
cloneRecIdBndrs subst :: Subst
subst us :: UniqSupply
us ids :: [Id]
ids
= (Subst
subst', [Id]
ids')
where
(subst' :: Subst
subst', ids' :: [Id]
ids') = (Subst -> (Id, Unique) -> (Subst, Id))
-> Subst -> [(Id, Unique)] -> (Subst, [Id])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
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)
clone_id :: Subst
-> Subst -> (Id, Unique)
-> (Subst, Id)
clone_id :: Subst -> Subst -> (Id, Unique) -> (Subst, Id)
clone_id rec_subst :: Subst
rec_subst subst :: Subst
subst@(Subst in_scope :: InScopeSet
in_scope idvs :: IdSubstEnv
idvs tvs :: TvSubstEnv
tvs cvs :: CvSubstEnv
cvs) (old_id :: Id
old_id, uniq :: Unique
uniq)
= (InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst (InScopeSet
in_scope InScopeSet -> Id -> InScopeSet
`extendInScopeSet` Id
new_id) 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_idvs :: IdSubstEnv
new_idvs, new_cvs :: 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)
substTyVarBndr :: Subst -> TyVar -> (Subst, TyVar)
substTyVarBndr :: Subst -> Id -> (Subst, Id)
substTyVarBndr (Subst in_scope :: InScopeSet
in_scope id_env :: IdSubstEnv
id_env tv_env :: TvSubstEnv
tv_env cv_env :: CvSubstEnv
cv_env) tv :: Id
tv
= case HasCallStack => TCvSubst -> Id -> (TCvSubst, Id)
TCvSubst -> Id -> (TCvSubst, Id)
Type.substTyVarBndr (InScopeSet -> TvSubstEnv -> CvSubstEnv -> TCvSubst
TCvSubst InScopeSet
in_scope TvSubstEnv
tv_env CvSubstEnv
cv_env) Id
tv of
(TCvSubst in_scope' :: InScopeSet
in_scope' tv_env' :: TvSubstEnv
tv_env' cv_env' :: CvSubstEnv
cv_env', tv' :: Id
tv')
-> (InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope' IdSubstEnv
id_env TvSubstEnv
tv_env' CvSubstEnv
cv_env', Id
tv')
cloneTyVarBndr :: Subst -> TyVar -> Unique -> (Subst, TyVar)
cloneTyVarBndr :: Subst -> Id -> Unique -> (Subst, Id)
cloneTyVarBndr (Subst in_scope :: InScopeSet
in_scope id_env :: IdSubstEnv
id_env tv_env :: TvSubstEnv
tv_env cv_env :: CvSubstEnv
cv_env) tv :: Id
tv uniq :: Unique
uniq
= case TCvSubst -> Id -> Unique -> (TCvSubst, Id)
Type.cloneTyVarBndr (InScopeSet -> TvSubstEnv -> CvSubstEnv -> TCvSubst
TCvSubst InScopeSet
in_scope TvSubstEnv
tv_env CvSubstEnv
cv_env) Id
tv Unique
uniq of
(TCvSubst in_scope' :: InScopeSet
in_scope' tv_env' :: TvSubstEnv
tv_env' cv_env' :: CvSubstEnv
cv_env', tv' :: Id
tv')
-> (InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope' IdSubstEnv
id_env TvSubstEnv
tv_env' CvSubstEnv
cv_env', Id
tv')
substCoVarBndr :: Subst -> TyVar -> (Subst, TyVar)
substCoVarBndr :: Subst -> Id -> (Subst, Id)
substCoVarBndr (Subst in_scope :: InScopeSet
in_scope id_env :: IdSubstEnv
id_env tv_env :: TvSubstEnv
tv_env cv_env :: CvSubstEnv
cv_env) cv :: Id
cv
= case HasCallStack => TCvSubst -> Id -> (TCvSubst, Id)
TCvSubst -> Id -> (TCvSubst, Id)
Coercion.substCoVarBndr (InScopeSet -> TvSubstEnv -> CvSubstEnv -> TCvSubst
TCvSubst InScopeSet
in_scope TvSubstEnv
tv_env CvSubstEnv
cv_env) Id
cv of
(TCvSubst in_scope' :: InScopeSet
in_scope' tv_env' :: TvSubstEnv
tv_env' cv_env' :: CvSubstEnv
cv_env', cv' :: Id
cv')
-> (InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope' IdSubstEnv
id_env TvSubstEnv
tv_env' CvSubstEnv
cv_env', Id
cv')
substTy :: Subst -> Type -> Type
substTy :: Subst -> Type -> Type
substTy subst :: Subst
subst ty :: Type
ty = TCvSubst -> Type -> Type
Type.substTyUnchecked (Subst -> TCvSubst
getTCvSubst Subst
subst) Type
ty
getTCvSubst :: Subst -> TCvSubst
getTCvSubst :: Subst -> TCvSubst
getTCvSubst (Subst in_scope :: InScopeSet
in_scope _ tenv :: TvSubstEnv
tenv cenv :: CvSubstEnv
cenv) = InScopeSet -> TvSubstEnv -> CvSubstEnv -> TCvSubst
TCvSubst InScopeSet
in_scope TvSubstEnv
tenv CvSubstEnv
cenv
substCo :: Subst -> Coercion -> Coercion
substCo :: Subst -> Coercion -> Coercion
substCo subst :: Subst
subst co :: Coercion
co = HasCallStack => TCvSubst -> Coercion -> Coercion
TCvSubst -> Coercion -> Coercion
Coercion.substCo (Subst -> TCvSubst
getTCvSubst Subst
subst) Coercion
co
substIdType :: Subst -> Id -> Id
substIdType :: Subst -> Id -> Id
substIdType subst :: Subst
subst@(Subst _ _ tv_env :: TvSubstEnv
tv_env cv_env :: CvSubstEnv
cv_env) id :: 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 = Id
id
| Bool
otherwise = Id -> Type -> Id
setIdType Id
id (Subst -> Type -> Type
substTy Subst
subst Type
old_ty)
where
old_ty :: Type
old_ty = Id -> Type
idType Id
id
substIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo
substIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo
substIdInfo subst :: Subst
subst new_id :: Id
new_id info :: 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
substSpec 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
unfoldingInfo IdInfo
info
nothing_to_do :: Bool
nothing_to_do = RuleInfo -> Bool
isEmptyRuleInfo RuleInfo
old_rules Bool -> Bool -> Bool
&& Bool -> Bool
not (Unfolding -> Bool
isFragileUnfolding Unfolding
old_unf)
substUnfolding, substUnfoldingSC :: Subst -> Unfolding -> Unfolding
substUnfoldingSC :: Subst -> Unfolding -> Unfolding
substUnfoldingSC subst :: Subst
subst unf :: 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
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 :: [Id]
df_bndrs = [Id]
bndrs', df_args :: [CoreExpr]
df_args = [CoreExpr]
args' }
where
(subst' :: Subst
subst',bndrs' :: [Id]
bndrs') = Subst -> [Id] -> (Subst, [Id])
substBndrs Subst
subst [Id]
bndrs
args' :: [CoreExpr]
args' = (CoreExpr -> CoreExpr) -> [CoreExpr] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> Subst -> CoreExpr -> CoreExpr
substExpr (String -> SDoc
text "subst-unf:dfun") Subst
subst') [CoreExpr]
args
substUnfolding subst :: 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 :: CoreExpr
uf_tmpl = CoreExpr
new_tmpl }
where
new_tmpl :: CoreExpr
new_tmpl = SDoc -> Subst -> CoreExpr -> CoreExpr
substExpr (String -> SDoc
text "subst-unf") Subst
subst CoreExpr
tmpl
substUnfolding _ unf :: Unfolding
unf = Unfolding
unf
substIdOcc :: Subst -> Id -> Id
substIdOcc :: Subst -> Id -> Id
substIdOcc subst :: Subst
subst v :: Id
v = case SDoc -> Subst -> Id -> CoreExpr
lookupIdSubst (String -> SDoc
text "substIdOcc") Subst
subst Id
v of
Var v' :: Id
v' -> Id
v'
other :: CoreExpr
other -> String -> SDoc -> Id
forall a. HasCallStack => String -> SDoc -> a
pprPanic "substIdOcc" ([SDoc] -> SDoc
vcat [Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
v SDoc -> SDoc -> SDoc
<+> CoreExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoreExpr
other, Subst -> SDoc
forall a. Outputable a => a -> SDoc
ppr Subst
subst])
substSpec :: Subst -> Id -> RuleInfo -> RuleInfo
substSpec :: Subst -> Id -> RuleInfo -> RuleInfo
substSpec subst :: Subst
subst new_id :: Id
new_id (RuleInfo rules :: [CoreRule]
rules rhs_fvs :: DVarSet
rhs_fvs)
= RuleInfo -> ()
seqRuleInfo RuleInfo
new_spec () -> RuleInfo -> RuleInfo
forall a b. a -> b -> b
`seq` RuleInfo
new_spec
where
subst_ru_fn :: b -> Name
subst_ru_fn = Name -> b -> Name
forall a b. a -> b -> a
const (Id -> Name
idName Id
new_id)
new_spec :: RuleInfo
new_spec = [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
forall b. b -> Name
subst_ru_fn) [CoreRule]
rules)
(Subst -> DVarSet -> DVarSet
substDVarSet Subst
subst DVarSet
rhs_fvs)
substRulesForImportedIds :: Subst -> [CoreRule] -> [CoreRule]
substRulesForImportedIds :: Subst -> [CoreRule] -> [CoreRule]
substRulesForImportedIds subst :: Subst
subst rules :: [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 name :: a
name = String -> SDoc -> a
forall a. HasCallStack => String -> SDoc -> a
pprPanic "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 _ _ rule :: CoreRule
rule@(BuiltinRule {}) = CoreRule
rule
substRule subst :: Subst
subst subst_ru_fn :: 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 :: [Id]
ru_bndrs = [Id]
bndrs'
, ru_fn :: Name
ru_fn = if Bool
is_local
then Name -> Name
subst_ru_fn Name
fn_name
else Name
fn_name
, ru_args :: [CoreExpr]
ru_args = (CoreExpr -> CoreExpr) -> [CoreExpr] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> Subst -> CoreExpr -> CoreExpr
substExpr SDoc
doc Subst
subst') [CoreExpr]
args
, ru_rhs :: CoreExpr
ru_rhs = SDoc -> Subst -> CoreExpr -> CoreExpr
substExpr (String -> SDoc
text "foo") Subst
subst' CoreExpr
rhs }
where
doc :: SDoc
doc = String -> SDoc
text "subst-rule" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
fn_name
(subst' :: Subst
subst', bndrs' :: [Id]
bndrs') = Subst -> [Id] -> (Subst, [Id])
substBndrs Subst
subst [Id]
bndrs
substDVarSet :: Subst -> DVarSet -> DVarSet
substDVarSet :: Subst -> DVarSet -> DVarSet
substDVarSet subst :: Subst
subst fvs :: 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 (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Subst -> Id -> ([Id], VarSet) -> ([Id], VarSet)
subst_fv Subst
subst) ([], VarSet
emptyVarSet) ([Id] -> ([Id], VarSet)) -> [Id] -> ([Id], VarSet)
forall a b. (a -> b) -> a -> b
$ DVarSet -> [Id]
dVarSetElems DVarSet
fvs
where
subst_fv :: Subst -> Id -> ([Id], VarSet) -> ([Id], VarSet)
subst_fv subst :: Subst
subst fv :: Id
fv acc :: ([Id], VarSet)
acc
| Id -> Bool
isId Id
fv = CoreExpr -> FV
expr_fvs (SDoc -> Subst -> Id -> CoreExpr
lookupIdSubst (String -> SDoc
text "substDVarSet") Subst
subst Id
fv) Id -> Bool
isLocalVar VarSet
emptyVarSet (([Id], VarSet) -> ([Id], VarSet))
-> ([Id], VarSet) -> ([Id], VarSet)
forall a b. (a -> b) -> a -> b
$! ([Id], VarSet)
acc
| Bool
otherwise = Type -> FV
tyCoFVsOfType (Subst -> Id -> Type
lookupTCvSubst Subst
subst Id
fv) (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 -> Tickish Id -> Tickish Id
substTickish :: Subst -> Tickish Id -> Tickish Id
substTickish subst :: Subst
subst (Breakpoint n :: Int
n ids :: [Id]
ids)
= Int -> [Id] -> Tickish Id
forall id. Int -> [id] -> Tickish id
Breakpoint Int
n ((Id -> Id) -> [Id] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Id
do_one [Id]
ids)
where
do_one :: Id -> Id
do_one = HasDebugCallStack => CoreExpr -> Id
CoreExpr -> Id
getIdFromTrivialExpr (CoreExpr -> Id) -> (Id -> CoreExpr) -> Id -> Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> Subst -> Id -> CoreExpr
lookupIdSubst (String -> SDoc
text "subst_tickish") Subst
subst
substTickish _subst :: Subst
_subst other :: Tickish Id
other = Tickish Id
other