{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Core.Subst (
        
        Subst(..), 
        TvSubstEnv, IdSubstEnv, InScopeSet,
        
        deShadowBinds, substRuleInfo, substRulesForImportedIds,
        substTy, substCo, substExpr, substExprSC, substBind, substBindSC,
        substUnfolding, substUnfoldingSC,
        lookupIdSubst, substIdType, substIdOcc,
        substTickish, substDVarSet, substIdInfo,
        
        emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, substInScope, isEmptySubst,
        extendIdSubst, extendIdSubstList, extendTCvSubst, extendTvSubstList,
        extendSubst, extendSubstList, extendSubstWithVar, zapSubstEnv,
        extendSubstInScope, extendSubstInScopeList, extendSubstInScopeSet,
        isInScope, setInScope, getTCvSubst, extendTvSubst, extendCvSubst,
        delBndr, delBndrs,
        
        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 qualified GHC.Core.Type as Type
import qualified GHC.Core.Coercion as Coercion
        
import GHC.Core.Type hiding
   ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList
   , isInScope, substTyVarBndr, cloneTyVarBndr )
import GHC.Core.Coercion hiding ( substCo, 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 GHC.Utils.Panic.Plain
import Data.List (mapAccumL)
data Subst
  = Subst InScopeSet  
                      
          IdSubstEnv  
          TvSubstEnv  
          CvSubstEnv  
        
        
        
        
        
        
        
        
type IdSubstEnv = IdEnv CoreExpr   
isEmptySubst :: Subst -> Bool
isEmptySubst :: Subst -> Bool
isEmptySubst (Subst InScopeSet
_ IdSubstEnv
id_env TvSubstEnv
tv_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 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 InScopeSet
in_scope TvSubstEnv
tvs CvSubstEnv
cvs 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 InScopeSet
in_scope IdSubstEnv
_ TvSubstEnv
_ CvSubstEnv
_) = InScopeSet
in_scope
zapSubstEnv :: Subst -> Subst
zapSubstEnv :: Subst -> Subst
zapSubstEnv (Subst InScopeSet
in_scope IdSubstEnv
_ TvSubstEnv
_ CvSubstEnv
_) = 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 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
$$ 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
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
extendTvSubst :: Subst -> TyVar -> Type -> Subst
extendTvSubst :: Subst -> Id -> Type -> Subst
extendTvSubst (Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs) Id
tv Type
ty
  = Bool -> Subst -> Subst
forall a. HasCallStack => Bool -> a -> a
assert (Id -> Bool
isTyVar Id
tv) (Subst -> Subst) -> Subst -> Subst
forall a b. (a -> b) -> a -> b
$
    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 [(Id, Type)]
vrs
  = (Subst -> (Id, Type) -> Subst) -> Subst -> [(Id, Type)] -> Subst
forall b a. (b -> a -> b) -> b -> [a] -> b
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 (Id
v, 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 InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs) Id
v Coercion
r
  = Bool -> Subst -> Subst
forall a. HasCallStack => Bool -> a -> a
assert (Id -> Bool
isCoVar Id
v) (Subst -> Subst) -> Subst -> Subst
forall a b. (a -> b) -> a -> b
$
    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 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 :: (() :: Constraint) => Subst -> Id -> CoreExpr
lookupIdSubst (Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
_ CvSubstEnv
_) 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
$$ InScopeSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr InScopeSet
in_scope)
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])
isInScope :: Var -> Subst -> Bool
isInScope :: Id -> Subst -> Bool
isInScope Id
v (Subst InScopeSet
in_scope IdSubstEnv
_ TvSubstEnv
_ CvSubstEnv
_) = Id
v Id -> InScopeSet -> Bool
`elemInScopeSet` InScopeSet
in_scope
extendSubstInScope :: Subst -> Var -> Subst
extendSubstInScope :: Subst -> Id -> Subst
extendSubstInScope (Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs) Id
v
  = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst (InScopeSet
in_scope InScopeSet -> Id -> InScopeSet
`InScopeSet.extendInScopeSet` Id
v)
          IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs
extendSubstInScopeList :: Subst -> [Var] -> Subst
extendSubstInScopeList :: Subst -> [Id] -> Subst
extendSubstInScopeList (Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs) [Id]
vs
  = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst (InScopeSet
in_scope InScopeSet -> [Id] -> InScopeSet
`extendInScopeSetList` [Id]
vs)
          IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs
extendSubstInScopeSet :: Subst -> VarSet -> Subst
extendSubstInScopeSet :: Subst -> VarSet -> Subst
extendSubstInScopeSet (Subst InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs) VarSet
vs
  = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst (InScopeSet
in_scope InScopeSet -> VarSet -> InScopeSet
`extendInScopeSetSet` VarSet
vs)
          IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs
setInScope :: Subst -> InScopeSet -> Subst
setInScope :: Subst -> InScopeSet -> Subst
setInScope (Subst InScopeSet
_ IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs) 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 InScopeSet
in_scope IdSubstEnv
ids TvSubstEnv
tvs CvSubstEnv
cvs)
        =  String -> SDoc
text String
"<InScope =" SDoc -> SDoc -> SDoc
<+> SDoc
in_scope_doc
        SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
" IdSubst   =" SDoc -> SDoc -> SDoc
<+> IdSubstEnv -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdSubstEnv
ids
        SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
" TvSubst   =" SDoc -> SDoc -> SDoc
<+> TvSubstEnv -> SDoc
forall a. Outputable a => a -> SDoc
ppr TvSubstEnv
tvs
        SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
" CvSubst   =" SDoc -> SDoc -> SDoc
<+> CvSubstEnv -> SDoc
forall a. Outputable a => a -> SDoc
ppr CvSubstEnv
cvs
         SDoc -> SDoc -> SDoc
<> Char -> SDoc
char 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 :: HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
substExprSC :: (() :: Constraint) => Subst -> CoreExpr -> CoreExpr
substExprSC Subst
subst CoreExpr
orig_expr
  | Subst -> Bool
isEmptySubst Subst
subst = CoreExpr
orig_expr
  | Bool
otherwise          = 
                         (() :: Constraint) => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst CoreExpr
orig_expr
substExpr :: HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
   
substExpr :: (() :: Constraint) => Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst CoreExpr
expr
  = CoreExpr -> CoreExpr
go CoreExpr
expr
  where
    go :: CoreExpr -> CoreExpr
go (Var Id
v)         = (() :: Constraint) => 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
substTy Subst
subst Type
ty)
    go (Coercion Coercion
co)   = Coercion -> CoreExpr
forall b. Coercion -> Expr b
Coercion (HasCallStack => 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) (HasCallStack => 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' ((() :: Constraint) => 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' ((() :: Constraint) => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst' CoreExpr
body)
                       where
                         (Subst
subst', Bind Id
bind') = (() :: Constraint) => 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
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
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' ((() :: Constraint) => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst' CoreExpr
rhs)
                                 where
                                   (Subst
subst', [Id]
bndrs') = Subst -> [Id] -> (Subst, [Id])
substBndrs Subst
subst [Id]
bndrs
substBind, substBindSC :: HasDebugCallStack => Subst -> CoreBind -> (Subst, CoreBind)
substBindSC :: (() :: Constraint) => Subst -> Bind Id -> (Subst, Bind Id)
substBindSC Subst
subst Bind Id
bind    
  | Bool -> Bool
not (Subst -> Bool
isEmptySubst Subst
subst)
  = (() :: Constraint) => 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])
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 ((() :: Constraint) => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst') [CoreExpr]
rhss
substBind :: (() :: Constraint) => 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' ((() :: Constraint) => 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])
substRecBndrs Subst
subst [Id]
bndrs
       rhss' :: [CoreExpr]
rhss' = (CoreExpr -> CoreExpr) -> [CoreExpr] -> [CoreExpr]
forall a b. (a -> b) -> [a] -> [b]
map ((() :: Constraint) => 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 (() :: Constraint) => 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  = 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 String
"var-bndr") Subst
subst Subst
subst Id
bndr
substBndrs :: Subst -> [Var] -> (Subst, [Var])
substBndrs :: Subst -> [Id] -> (Subst, [Id])
substBndrs Subst
subst [Id]
bndrs = (Subst -> Id -> (Subst, Id)) -> Subst -> [Id] -> (Subst, [Id])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Subst -> Id -> (Subst, Id)
substBndr Subst
subst [Id]
bndrs
substRecBndrs :: Subst -> [Id] -> (Subst, [Id])
substRecBndrs :: Subst -> [Id] -> (Subst, [Id])
substRecBndrs Subst
subst [Id]
bndrs
  = (Subst
new_subst, [Id]
new_bndrs)
  where         
    (Subst
new_subst, [Id]
new_bndrs) = (Subst -> Id -> (Subst, Id)) -> Subst -> [Id] -> (Subst, [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
text String
"rec-bndr") Subst
new_subst) Subst
subst [Id]
bndrs
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
in_scope InScopeSet -> Id -> InScopeSet
`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      = (Type -> Type) -> Id -> Id
updateIdTypeAndMult (Subst -> Type -> Type
substTy Subst
subst) Id
id1
    old_ty :: Type
old_ty = Id -> Type
idType Id
old_id
    old_w :: Type
old_w = 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 ((() :: Constraint) => 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 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 :: Subst -> UniqSupply -> [Var] -> (Subst, [Var])
cloneBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
cloneBndrs Subst
subst UniqSupply
us [Id]
vs
  = (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
v, 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 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 :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
cloneRecIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
cloneRecIdBndrs Subst
subst UniqSupply
us [Id]
ids
  = (Subst
subst', [Id]
ids')
  where
    (Subst
subst', [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)
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
in_scope InScopeSet -> Id -> InScopeSet
`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 ((() :: Constraint) => Id -> IdInfo
Id -> IdInfo
idInfo Id
old_id)) Id
id2
    (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)
substTyVarBndr :: Subst -> TyVar -> (Subst, TyVar)
substTyVarBndr :: Subst -> Id -> (Subst, Id)
substTyVarBndr (Subst InScopeSet
in_scope IdSubstEnv
id_env TvSubstEnv
tv_env CvSubstEnv
cv_env) Id
tv
  = case (() :: Constraint) => 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 InScopeSet
in_scope' TvSubstEnv
tv_env' CvSubstEnv
cv_env', 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 InScopeSet
in_scope IdSubstEnv
id_env TvSubstEnv
tv_env CvSubstEnv
cv_env) Id
tv 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 InScopeSet
in_scope' TvSubstEnv
tv_env' CvSubstEnv
cv_env', Id
tv')
           -> (InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> Subst
Subst InScopeSet
in_scope' IdSubstEnv
id_env TvSubstEnv
tv_env' CvSubstEnv
cv_env', Id
tv')
substCoVarBndr :: Subst -> CoVar -> (Subst, CoVar)
substCoVarBndr :: Subst -> Id -> (Subst, Id)
substCoVarBndr (Subst InScopeSet
in_scope IdSubstEnv
id_env TvSubstEnv
tv_env CvSubstEnv
cv_env) Id
cv
  = case (() :: Constraint) => 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 InScopeSet
in_scope' TvSubstEnv
tv_env' CvSubstEnv
cv_env', 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 Type
ty = TCvSubst -> Type -> Type
Type.substTyUnchecked (Subst -> TCvSubst
getTCvSubst Subst
subst) Type
ty
getTCvSubst :: Subst -> TCvSubst
getTCvSubst :: Subst -> TCvSubst
getTCvSubst (Subst InScopeSet
in_scope IdSubstEnv
_ TvSubstEnv
tenv CvSubstEnv
cenv) = InScopeSet -> TvSubstEnv -> CvSubstEnv -> TCvSubst
TCvSubst InScopeSet
in_scope TvSubstEnv
tenv CvSubstEnv
cenv
substCo :: HasCallStack => Subst -> Coercion -> Coercion
substCo :: HasCallStack => Subst -> Coercion -> Coercion
substCo Subst
subst Coercion
co = (() :: Constraint) => 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 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
substTy Subst
subst) Id
id
        
        
        
  where
    old_ty :: Type
old_ty = Id -> Type
idType Id
id
    old_w :: Type
old_w  = Id -> Type
varMult 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 :: [Id]
df_bndrs = [Id]
bndrs', df_args :: [CoreExpr]
df_args = [CoreExpr]
args' }
  where
    (Subst
subst',[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 ((() :: Constraint) => 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 :: CoreExpr
uf_tmpl = CoreExpr
new_tmpl }
  where
    new_tmpl :: CoreExpr
new_tmpl = (() :: Constraint) => 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 (() :: Constraint) => 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
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])
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)
                  ((() :: Constraint) => 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 :: [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 ((() :: Constraint) => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst') [CoreExpr]
args
         , ru_rhs :: CoreExpr
ru_rhs   = (() :: Constraint) => Subst -> CoreExpr -> CoreExpr
Subst -> CoreExpr -> CoreExpr
substExpr Subst
subst' CoreExpr
rhs }
           
           
  where
    (Subst
subst', [Id]
bndrs') = Subst -> [Id] -> (Subst, [Id])
substBndrs Subst
subst [Id]
bndrs
substDVarSet :: HasDebugCallStack => Subst -> DVarSet -> DVarSet
substDVarSet :: (() :: Constraint) => 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 = (() :: Constraint) => Subst -> Id -> CoreExpr
Subst -> Id -> CoreExpr
lookupIdSubst Subst
subst Id
fv
     = CoreExpr -> FV
expr_fvs CoreExpr
fv_expr Id -> Bool
isLocalVar 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)
   = XBreakpoint 'TickishPassCore
-> Int -> [XTickishId 'TickishPassCore] -> CoreTickish
forall (pass :: TickishPass).
XBreakpoint pass -> Int -> [XTickishId pass] -> GenTickish pass
Breakpoint XBreakpoint 'TickishPassCore
ext Int
n ((Id -> Id) -> [Id] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Id
do_one [Id]
[XTickishId 'TickishPassCore]
ids)
 where
    do_one :: Id -> Id
do_one = (() :: Constraint) => CoreExpr -> Id
CoreExpr -> Id
getIdFromTrivialExpr (CoreExpr -> Id) -> (Id -> CoreExpr) -> Id -> Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() :: Constraint) => Subst -> Id -> CoreExpr
Subst -> Id -> CoreExpr
lookupIdSubst Subst
subst
substTickish Subst
_subst CoreTickish
other = CoreTickish
other