module CoreFVs (
exprFreeVars,
exprFreeVarsDSet,
exprFreeVarsList,
exprFreeIds,
exprFreeIdsDSet,
exprFreeIdsList,
exprsFreeIdsDSet,
exprsFreeIdsList,
exprsFreeVars,
exprsFreeVarsList,
bindFreeVars,
InterestingVarFun,
exprSomeFreeVars, exprsSomeFreeVars,
exprSomeFreeVarsList, exprsSomeFreeVarsList,
varTypeTyCoVars,
varTypeTyCoFVs,
idUnfoldingVars, idFreeVars, dIdFreeVars,
bndrRuleAndUnfoldingVarsDSet,
idFVs,
idRuleVars, idRuleRhsVars, stableUnfoldingVars,
ruleRhsFreeVars, ruleFreeVars, rulesFreeVars,
rulesFreeVarsDSet,
ruleLhsFreeIds, ruleLhsFreeIdsList,
vectsFreeVars,
expr_fvs,
orphNamesOfType, orphNamesOfCo, orphNamesOfAxiom,
orphNamesOfTypes, orphNamesOfCoCon,
exprsOrphNames, orphNamesOfFamInst,
FVAnn,
CoreExprWithFVs,
CoreExprWithFVs',
CoreBindWithFVs,
CoreAltWithFVs,
freeVars,
freeVarsBind,
freeVarsOf,
freeVarsOfType,
freeVarsOfAnn, freeVarsOfTypeAnn,
exprTypeFV
) where
#include "HsVersions.h"
import CoreSyn
import Id
import IdInfo
import NameSet
import UniqSet
import Unique (Uniquable (..))
import Literal ( literalType )
import Name
import VarSet
import Var
import Type
import TyCoRep
import TyCon
import CoAxiom
import FamInstEnv
import TysPrim( funTyConName )
import Coercion
import Maybes( orElse )
import Util
import BasicTypes( Activation )
import Outputable
import FV
exprFreeVars :: CoreExpr -> VarSet
exprFreeVars = fvVarSet . exprFVs
exprFVs :: CoreExpr -> FV
exprFVs = filterFV isLocalVar . expr_fvs
exprFreeVarsDSet :: CoreExpr -> DVarSet
exprFreeVarsDSet = fvDVarSet . exprFVs
exprFreeVarsList :: CoreExpr -> [Var]
exprFreeVarsList = fvVarList . exprFVs
exprFreeIds :: CoreExpr -> IdSet
exprFreeIds = exprSomeFreeVars isLocalId
exprFreeIdsDSet :: CoreExpr -> DIdSet
exprFreeIdsDSet = exprSomeFreeVarsDSet isLocalId
exprFreeIdsList :: CoreExpr -> [Id]
exprFreeIdsList = exprSomeFreeVarsList isLocalId
exprsFreeIdsDSet :: [CoreExpr] -> DIdSet
exprsFreeIdsDSet = exprsSomeFreeVarsDSet isLocalId
exprsFreeIdsList :: [CoreExpr] -> [Id]
exprsFreeIdsList = exprsSomeFreeVarsList isLocalId
exprsFreeVars :: [CoreExpr] -> VarSet
exprsFreeVars = fvVarSet . exprsFVs
exprsFVs :: [CoreExpr] -> FV
exprsFVs exprs = mapUnionFV exprFVs exprs
exprsFreeVarsList :: [CoreExpr] -> [Var]
exprsFreeVarsList = fvVarList . exprsFVs
bindFreeVars :: CoreBind -> VarSet
bindFreeVars (NonRec b r) = fvVarSet $ filterFV isLocalVar $ rhs_fvs (b,r)
bindFreeVars (Rec prs) = fvVarSet $ filterFV isLocalVar $
addBndrs (map fst prs)
(mapUnionFV rhs_fvs prs)
exprSomeFreeVars :: InterestingVarFun
-> CoreExpr
-> VarSet
exprSomeFreeVars fv_cand e = fvVarSet $ filterFV fv_cand $ expr_fvs e
exprSomeFreeVarsList :: InterestingVarFun
-> CoreExpr
-> [Var]
exprSomeFreeVarsList fv_cand e = fvVarList $ filterFV fv_cand $ expr_fvs e
exprSomeFreeVarsDSet :: InterestingVarFun
-> CoreExpr
-> DVarSet
exprSomeFreeVarsDSet fv_cand e = fvDVarSet $ filterFV fv_cand $ expr_fvs e
exprsSomeFreeVars :: InterestingVarFun
-> [CoreExpr]
-> VarSet
exprsSomeFreeVars fv_cand es =
fvVarSet $ filterFV fv_cand $ mapUnionFV expr_fvs es
exprsSomeFreeVarsList :: InterestingVarFun
-> [CoreExpr]
-> [Var]
exprsSomeFreeVarsList fv_cand es =
fvVarList $ filterFV fv_cand $ mapUnionFV expr_fvs es
exprsSomeFreeVarsDSet :: InterestingVarFun
-> [CoreExpr]
-> DVarSet
exprsSomeFreeVarsDSet fv_cand e =
fvDVarSet $ filterFV fv_cand $ mapUnionFV expr_fvs e
addBndr :: CoreBndr -> FV -> FV
addBndr bndr fv fv_cand in_scope acc
= (varTypeTyCoFVs bndr `unionFV`
FV.delFV bndr fv) fv_cand in_scope acc
addBndrs :: [CoreBndr] -> FV -> FV
addBndrs bndrs fv = foldr addBndr fv bndrs
expr_fvs :: CoreExpr -> FV
expr_fvs (Type ty) fv_cand in_scope acc =
tyCoFVsOfType ty fv_cand in_scope acc
expr_fvs (Coercion co) fv_cand in_scope acc =
tyCoFVsOfCo co fv_cand in_scope acc
expr_fvs (Var var) fv_cand in_scope acc = FV.unitFV var fv_cand in_scope acc
expr_fvs (Lit _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc
expr_fvs (Tick t expr) fv_cand in_scope acc =
(tickish_fvs t `unionFV` expr_fvs expr) fv_cand in_scope acc
expr_fvs (App fun arg) fv_cand in_scope acc =
(expr_fvs fun `unionFV` expr_fvs arg) fv_cand in_scope acc
expr_fvs (Lam bndr body) fv_cand in_scope acc =
addBndr bndr (expr_fvs body) fv_cand in_scope acc
expr_fvs (Cast expr co) fv_cand in_scope acc =
(expr_fvs expr `unionFV` tyCoFVsOfCo co) fv_cand in_scope acc
expr_fvs (Case scrut bndr ty alts) fv_cand in_scope acc
= (expr_fvs scrut `unionFV` tyCoFVsOfType ty `unionFV` addBndr bndr
(mapUnionFV alt_fvs alts)) fv_cand in_scope acc
where
alt_fvs (_, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)
expr_fvs (Let (NonRec bndr rhs) body) fv_cand in_scope acc
= (rhs_fvs (bndr, rhs) `unionFV` addBndr bndr (expr_fvs body))
fv_cand in_scope acc
expr_fvs (Let (Rec pairs) body) fv_cand in_scope acc
= addBndrs (map fst pairs)
(mapUnionFV rhs_fvs pairs `unionFV` expr_fvs body)
fv_cand in_scope acc
rhs_fvs :: (Id, CoreExpr) -> FV
rhs_fvs (bndr, rhs) = expr_fvs rhs `unionFV`
bndrRuleAndUnfoldingFVs bndr
exprs_fvs :: [CoreExpr] -> FV
exprs_fvs exprs = mapUnionFV expr_fvs exprs
tickish_fvs :: Tickish Id -> FV
tickish_fvs (Breakpoint _ ids) = FV.mkFVs ids
tickish_fvs _ = emptyFV
exprOrphNames :: CoreExpr -> NameSet
exprOrphNames e
= go e
where
go (Var v)
| isExternalName n = unitNameSet n
| otherwise = emptyNameSet
where n = idName v
go (Lit _) = emptyNameSet
go (Type ty) = orphNamesOfType ty
go (Coercion co) = orphNamesOfCo co
go (App e1 e2) = go e1 `unionNameSet` go e2
go (Lam v e) = go e `delFromNameSet` idName v
go (Tick _ e) = go e
go (Cast e co) = go e `unionNameSet` orphNamesOfCo co
go (Let (NonRec _ r) e) = go e `unionNameSet` go r
go (Let (Rec prs) e) = exprsOrphNames (map snd prs) `unionNameSet` go e
go (Case e _ ty as) = go e `unionNameSet` orphNamesOfType ty
`unionNameSet` unionNameSets (map go_alt as)
go_alt (_,_,r) = go r
exprsOrphNames :: [CoreExpr] -> NameSet
exprsOrphNames es = foldr (unionNameSet . exprOrphNames) emptyNameSet es
orphNamesOfTyCon :: TyCon -> NameSet
orphNamesOfTyCon tycon = unitNameSet (getName tycon) `unionNameSet` case tyConClass_maybe tycon of
Nothing -> emptyNameSet
Just cls -> unitNameSet (getName cls)
orphNamesOfType :: Type -> NameSet
orphNamesOfType ty | Just ty' <- coreView ty = orphNamesOfType ty'
orphNamesOfType (TyVarTy _) = emptyNameSet
orphNamesOfType (LitTy {}) = emptyNameSet
orphNamesOfType (TyConApp tycon tys) = orphNamesOfTyCon tycon
`unionNameSet` orphNamesOfTypes tys
orphNamesOfType (ForAllTy bndr res) = orphNamesOfType (binderKind bndr)
`unionNameSet` orphNamesOfType res
orphNamesOfType (FunTy arg res) = unitNameSet funTyConName
`unionNameSet` orphNamesOfType arg
`unionNameSet` orphNamesOfType res
orphNamesOfType (AppTy fun arg) = orphNamesOfType fun `unionNameSet` orphNamesOfType arg
orphNamesOfType (CastTy ty co) = orphNamesOfType ty `unionNameSet` orphNamesOfCo co
orphNamesOfType (CoercionTy co) = orphNamesOfCo co
orphNamesOfThings :: (a -> NameSet) -> [a] -> NameSet
orphNamesOfThings f = foldr (unionNameSet . f) emptyNameSet
orphNamesOfTypes :: [Type] -> NameSet
orphNamesOfTypes = orphNamesOfThings orphNamesOfType
orphNamesOfCo :: Coercion -> NameSet
orphNamesOfCo (Refl _ ty) = orphNamesOfType ty
orphNamesOfCo (TyConAppCo _ tc cos) = unitNameSet (getName tc) `unionNameSet` orphNamesOfCos cos
orphNamesOfCo (AppCo co1 co2) = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2
orphNamesOfCo (ForAllCo _ kind_co co)
= orphNamesOfCo kind_co `unionNameSet` orphNamesOfCo co
orphNamesOfCo (FunCo _ co1 co2) = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2
orphNamesOfCo (CoVarCo _) = emptyNameSet
orphNamesOfCo (AxiomInstCo con _ cos) = orphNamesOfCoCon con `unionNameSet` orphNamesOfCos cos
orphNamesOfCo (UnivCo p _ t1 t2) = orphNamesOfProv p `unionNameSet` orphNamesOfType t1 `unionNameSet` orphNamesOfType t2
orphNamesOfCo (SymCo co) = orphNamesOfCo co
orphNamesOfCo (TransCo co1 co2) = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2
orphNamesOfCo (NthCo _ co) = orphNamesOfCo co
orphNamesOfCo (LRCo _ co) = orphNamesOfCo co
orphNamesOfCo (InstCo co arg) = orphNamesOfCo co `unionNameSet` orphNamesOfCo arg
orphNamesOfCo (CoherenceCo co1 co2) = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2
orphNamesOfCo (KindCo co) = orphNamesOfCo co
orphNamesOfCo (SubCo co) = orphNamesOfCo co
orphNamesOfCo (AxiomRuleCo _ cs) = orphNamesOfCos cs
orphNamesOfProv :: UnivCoProvenance -> NameSet
orphNamesOfProv UnsafeCoerceProv = emptyNameSet
orphNamesOfProv (PhantomProv co) = orphNamesOfCo co
orphNamesOfProv (ProofIrrelProv co) = orphNamesOfCo co
orphNamesOfProv (PluginProv _) = emptyNameSet
orphNamesOfProv (HoleProv _) = emptyNameSet
orphNamesOfCos :: [Coercion] -> NameSet
orphNamesOfCos = orphNamesOfThings orphNamesOfCo
orphNamesOfCoCon :: CoAxiom br -> NameSet
orphNamesOfCoCon (CoAxiom { co_ax_tc = tc, co_ax_branches = branches })
= orphNamesOfTyCon tc `unionNameSet` orphNamesOfCoAxBranches branches
orphNamesOfAxiom :: CoAxiom br -> NameSet
orphNamesOfAxiom axiom
= orphNamesOfTypes (concatMap coAxBranchLHS $ fromBranches $ coAxiomBranches axiom)
`extendNameSet` getName (coAxiomTyCon axiom)
orphNamesOfCoAxBranches :: Branches br -> NameSet
orphNamesOfCoAxBranches
= foldr (unionNameSet . orphNamesOfCoAxBranch) emptyNameSet . fromBranches
orphNamesOfCoAxBranch :: CoAxBranch -> NameSet
orphNamesOfCoAxBranch (CoAxBranch { cab_lhs = lhs, cab_rhs = rhs })
= orphNamesOfTypes lhs `unionNameSet` orphNamesOfType rhs
orphNamesOfFamInst :: FamInst -> NameSet
orphNamesOfFamInst fam_inst = orphNamesOfAxiom (famInstAxiom fam_inst)
ruleRhsFreeVars :: CoreRule -> VarSet
ruleRhsFreeVars (BuiltinRule {}) = noFVs
ruleRhsFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs })
= fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs)
ruleFreeVars :: CoreRule -> VarSet
ruleFreeVars = fvVarSet . ruleFVs
ruleFVs :: CoreRule -> FV
ruleFVs (BuiltinRule {}) = emptyFV
ruleFVs (Rule { ru_fn = _do_not_include
, ru_bndrs = bndrs
, ru_rhs = rhs, ru_args = args })
= filterFV isLocalVar $ addBndrs bndrs (exprs_fvs (rhs:args))
rulesFVs :: [CoreRule] -> FV
rulesFVs = mapUnionFV ruleFVs
rulesFreeVarsDSet :: [CoreRule] -> DVarSet
rulesFreeVarsDSet rules = fvDVarSet $ rulesFVs rules
idRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet
idRuleRhsVars is_active id
= mapUnionVarSet get_fvs (idCoreRules id)
where
get_fvs (Rule { ru_fn = fn, ru_bndrs = bndrs
, ru_rhs = rhs, ru_act = act })
| is_active act
= delOneFromUniqSet_Directly fvs (getUnique fn)
where
fvs = fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs)
get_fvs _ = noFVs
rulesFreeVars :: [CoreRule] -> VarSet
rulesFreeVars rules = mapUnionVarSet ruleFreeVars rules
ruleLhsFreeIds :: CoreRule -> VarSet
ruleLhsFreeIds = fvVarSet . ruleLhsFVIds
ruleLhsFreeIdsList :: CoreRule -> [Var]
ruleLhsFreeIdsList = fvVarList . ruleLhsFVIds
ruleLhsFVIds :: CoreRule -> FV
ruleLhsFVIds (BuiltinRule {}) = emptyFV
ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args })
= filterFV isLocalId $ addBndrs bndrs (exprs_fvs args)
vectsFreeVars :: [CoreVect] -> VarSet
vectsFreeVars = mapUnionVarSet vectFreeVars
where
vectFreeVars (Vect _ rhs) = fvVarSet $ filterFV isLocalId $ expr_fvs rhs
vectFreeVars (NoVect _) = noFVs
vectFreeVars (VectType _ _ _) = noFVs
vectFreeVars (VectClass _) = noFVs
vectFreeVars (VectInst _) = noFVs
data FVAnn = FVAnn { fva_fvs :: DVarSet
, fva_ty_fvs :: DVarSet
, fva_ty :: Type
}
type CoreBindWithFVs = AnnBind Id FVAnn
type CoreExprWithFVs = AnnExpr Id FVAnn
type CoreExprWithFVs' = AnnExpr' Id FVAnn
type CoreAltWithFVs = AnnAlt Id FVAnn
freeVarsOf :: CoreExprWithFVs -> DIdSet
freeVarsOf (FVAnn { fva_fvs = fvs }, _) = fvs
freeVarsOfType :: CoreExprWithFVs -> DTyCoVarSet
freeVarsOfType (FVAnn { fva_ty_fvs = ty_fvs }, _) = ty_fvs
exprTypeFV :: CoreExprWithFVs -> Type
exprTypeFV (FVAnn { fva_ty = ty }, _) = ty
freeVarsOfAnn :: FVAnn -> DIdSet
freeVarsOfAnn = fva_fvs
freeVarsOfTypeAnn :: FVAnn -> DTyCoVarSet
freeVarsOfTypeAnn = fva_ty_fvs
noFVs :: VarSet
noFVs = emptyVarSet
aFreeVar :: Var -> DVarSet
aFreeVar = unitDVarSet
unionFVs :: DVarSet -> DVarSet -> DVarSet
unionFVs = unionDVarSet
unionFVss :: [DVarSet] -> DVarSet
unionFVss = unionDVarSets
delBindersFV :: [Var] -> DVarSet -> DVarSet
delBindersFV bs fvs = foldr delBinderFV fvs bs
delBinderFV :: Var -> DVarSet -> DVarSet
delBinderFV b s = (s `delDVarSet` b) `unionFVs` dVarTypeTyCoVars b
varTypeTyCoVars :: Var -> TyCoVarSet
varTypeTyCoVars var = fvVarSet $ varTypeTyCoFVs var
dVarTypeTyCoVars :: Var -> DTyCoVarSet
dVarTypeTyCoVars var = fvDVarSet $ varTypeTyCoFVs var
varTypeTyCoFVs :: Var -> FV
varTypeTyCoFVs var = tyCoFVsOfType (varType var)
idFreeVars :: Id -> VarSet
idFreeVars id = ASSERT( isId id) fvVarSet $ idFVs id
dIdFreeVars :: Id -> DVarSet
dIdFreeVars id = fvDVarSet $ idFVs id
idFVs :: Id -> FV
idFVs id = ASSERT( isId id)
varTypeTyCoFVs id `unionFV`
bndrRuleAndUnfoldingFVs id
bndrRuleAndUnfoldingVarsDSet :: Id -> DVarSet
bndrRuleAndUnfoldingVarsDSet id = fvDVarSet $ bndrRuleAndUnfoldingFVs id
bndrRuleAndUnfoldingFVs :: Id -> FV
bndrRuleAndUnfoldingFVs id
| isId id = idRuleFVs id `unionFV` idUnfoldingFVs id
| otherwise = emptyFV
idRuleVars ::Id -> VarSet
idRuleVars id = fvVarSet $ idRuleFVs id
idRuleFVs :: Id -> FV
idRuleFVs id = ASSERT( isId id)
FV.mkFVs (dVarSetElems $ ruleInfoFreeVars (idSpecialisation id))
idUnfoldingVars :: Id -> VarSet
idUnfoldingVars id = fvVarSet $ idUnfoldingFVs id
idUnfoldingFVs :: Id -> FV
idUnfoldingFVs id = stableUnfoldingFVs (realIdUnfolding id) `orElse` emptyFV
stableUnfoldingVars :: Unfolding -> Maybe VarSet
stableUnfoldingVars unf = fvVarSet `fmap` stableUnfoldingFVs unf
stableUnfoldingFVs :: Unfolding -> Maybe FV
stableUnfoldingFVs unf
= case unf of
CoreUnfolding { uf_tmpl = rhs, uf_src = src }
| isStableSource src
-> Just (filterFV isLocalVar $ expr_fvs rhs)
DFunUnfolding { df_bndrs = bndrs, df_args = args }
-> Just (filterFV isLocalVar $ FV.delFVs (mkVarSet bndrs) $ exprs_fvs args)
_other -> Nothing
freeVarsBind :: CoreBind
-> DVarSet
-> (CoreBindWithFVs, DVarSet)
freeVarsBind (NonRec binder rhs) body_fvs
= ( AnnNonRec binder rhs2
, freeVarsOf rhs2 `unionFVs` body_fvs2
`unionFVs` bndrRuleAndUnfoldingVarsDSet binder )
where
rhs2 = freeVars rhs
body_fvs2 = binder `delBinderFV` body_fvs
freeVarsBind (Rec binds) body_fvs
= ( AnnRec (binders `zip` rhss2)
, delBindersFV binders all_fvs )
where
(binders, rhss) = unzip binds
rhss2 = map freeVars rhss
rhs_body_fvs = foldr (unionFVs . freeVarsOf) body_fvs rhss2
binders_fvs = fvDVarSet $ mapUnionFV bndrRuleAndUnfoldingFVs binders
all_fvs = rhs_body_fvs `unionFVs` binders_fvs
freeVars :: CoreExpr -> CoreExprWithFVs
freeVars = go
where
go :: CoreExpr -> CoreExprWithFVs
go (Var v)
= (FVAnn fvs ty_fvs (idType v), AnnVar v)
where
(fvs, ty_fvs)
| isLocalVar v = (aFreeVar v `unionFVs` ty_fvs, dVarTypeTyCoVars v)
| otherwise = (emptyDVarSet, emptyDVarSet)
go (Lit lit) = (FVAnn emptyDVarSet emptyDVarSet (literalType lit), AnnLit lit)
go (Lam b body)
= ( FVAnn { fva_fvs = b_fvs `unionFVs` (b `delBinderFV` body_fvs)
, fva_ty_fvs = b_fvs `unionFVs` (b `delBinderFV` body_ty_fvs)
, fva_ty = mkFunTy b_ty body_ty }
, AnnLam b body' )
where
body'@(FVAnn { fva_fvs = body_fvs, fva_ty_fvs = body_ty_fvs
, fva_ty = body_ty }, _) = go body
b_ty = idType b
b_fvs = tyCoVarsOfTypeDSet b_ty
go (App fun arg)
= ( FVAnn { fva_fvs = freeVarsOf fun' `unionFVs` freeVarsOf arg'
, fva_ty_fvs = tyCoVarsOfTypeDSet res_ty
, fva_ty = res_ty }
, AnnApp fun' arg' )
where
fun' = go fun
fun_ty = exprTypeFV fun'
arg' = go arg
res_ty = applyTypeToArg fun_ty arg
go (Case scrut bndr ty alts)
= ( FVAnn { fva_fvs = (bndr `delBinderFV` alts_fvs)
`unionFVs` freeVarsOf scrut2
`unionFVs` tyCoVarsOfTypeDSet ty
, fva_ty_fvs = tyCoVarsOfTypeDSet ty
, fva_ty = ty }
, AnnCase scrut2 bndr ty alts2 )
where
scrut2 = go scrut
(alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
alts_fvs = unionFVss alts_fvs_s
fv_alt (con,args,rhs) = (delBindersFV args (freeVarsOf rhs2),
(con, args, rhs2))
where
rhs2 = go rhs
go (Let bind body)
= ( FVAnn { fva_fvs = bind_fvs
, fva_ty_fvs = freeVarsOfType body2
, fva_ty = exprTypeFV body2 }
, AnnLet bind2 body2 )
where
(bind2, bind_fvs) = freeVarsBind bind (freeVarsOf body2)
body2 = go body
go (Cast expr co)
= ( FVAnn (freeVarsOf expr2 `unionFVs` cfvs) (tyCoVarsOfTypeDSet to_ty) to_ty
, AnnCast expr2 (c_ann, co) )
where
expr2 = go expr
cfvs = tyCoVarsOfCoDSet co
c_ann = FVAnn cfvs (tyCoVarsOfTypeDSet co_ki) co_ki
co_ki = coercionType co
Just (_, to_ty) = splitCoercionType_maybe co_ki
go (Tick tickish expr)
= ( FVAnn { fva_fvs = tickishFVs tickish `unionFVs` freeVarsOf expr2
, fva_ty_fvs = freeVarsOfType expr2
, fva_ty = exprTypeFV expr2 }
, AnnTick tickish expr2 )
where
expr2 = go expr
tickishFVs (Breakpoint _ ids) = mkDVarSet ids
tickishFVs _ = emptyDVarSet
go (Type ty) = ( FVAnn (tyCoVarsOfTypeDSet ty)
(tyCoVarsOfTypeDSet ki)
ki
, AnnType ty)
where
ki = typeKind ty
go (Coercion co) = ( FVAnn (tyCoVarsOfCoDSet co)
(tyCoVarsOfTypeDSet ki)
ki
, AnnCoercion co)
where
ki = coercionType co