diff options
| -rw-r--r-- | compiler/coreSyn/CoreFVs.hs | 150 | ||||
| -rw-r--r-- | compiler/coreSyn/CoreSubst.hs | 2 | ||||
| -rw-r--r-- | compiler/simplCore/SetLevels.hs | 4 | ||||
| -rw-r--r-- | compiler/typecheck/TcDeriv.hs | 10 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnTypes.hs | 32 | ||||
| -rw-r--r-- | compiler/typecheck/TcType.hs | 10 | ||||
| -rw-r--r-- | compiler/types/Coercion.hs | 2 | ||||
| -rw-r--r-- | compiler/types/TyCoRep.hs | 132 | ||||
| -rw-r--r-- | compiler/types/Type.hs | 2 | ||||
| -rw-r--r-- | compiler/utils/FV.hs | 69 |
10 files changed, 208 insertions, 205 deletions
diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs index 07edee8d4c..660538c2fb 100644 --- a/compiler/coreSyn/CoreFVs.hs +++ b/compiler/coreSyn/CoreFVs.hs @@ -26,10 +26,10 @@ module CoreFVs ( -- * Free variables of Rules, Vars and Ids varTypeTyCoVars, - varTypeTyCoVarsAcc, + varTypeTyCoFVs, idUnfoldingVars, idFreeVars, dIdFreeVars, idRuleAndUnfoldingVars, idRuleAndUnfoldingVarsDSet, - idFreeVarsAcc, + idFVs, idRuleVars, idRuleRhsVars, stableUnfoldingVars, ruleRhsFreeVars, ruleFreeVars, rulesFreeVars, rulesFreeVarsDSet, @@ -99,23 +99,23 @@ but not those that are free in the type of variable occurrence. -- | Find all locally-defined free Ids or type variables in an expression -- returning a non-deterministic set. exprFreeVars :: CoreExpr -> VarSet -exprFreeVars = runFVSet . exprFreeVarsAcc +exprFreeVars = fvVarSet . exprFVs -- | Find all locally-defined free Ids or type variables in an expression -- returning a composable FV computation. See Note [FV naming coventions] in FV -- for why export it. -exprFreeVarsAcc :: CoreExpr -> FV -exprFreeVarsAcc = filterFV isLocalVar . expr_fvs +exprFVs :: CoreExpr -> FV +exprFVs = filterFV isLocalVar . expr_fvs -- | Find all locally-defined free Ids or type variables in an expression -- returning a deterministic set. exprFreeVarsDSet :: CoreExpr -> DVarSet -exprFreeVarsDSet = runFVDSet . exprFreeVarsAcc +exprFreeVarsDSet = fvDVarSet . exprFVs -- | Find all locally-defined free Ids or type variables in an expression -- returning a deterministically ordered list. exprFreeVarsList :: CoreExpr -> [Var] -exprFreeVarsList = runFVList . exprFreeVarsAcc +exprFreeVarsList = fvVarList . exprFVs -- | Find all locally-defined free Ids in an expression exprFreeIds :: CoreExpr -> IdSet -- Find all locally-defined free Ids @@ -129,23 +129,23 @@ exprsFreeIdsList = exprsSomeFreeVarsList isLocalId -- | Find all locally-defined free Ids or type variables in several expressions -- returning a non-deterministic set. exprsFreeVars :: [CoreExpr] -> VarSet -exprsFreeVars = runFVSet . exprsFreeVarsAcc +exprsFreeVars = fvVarSet . exprsFVs -- | Find all locally-defined free Ids or type variables in several expressions -- returning a composable FV computation. See Note [FV naming coventions] in FV -- for why export it. -exprsFreeVarsAcc :: [CoreExpr] -> FV -exprsFreeVarsAcc exprs = mapUnionFV exprFreeVarsAcc exprs +exprsFVs :: [CoreExpr] -> FV +exprsFVs exprs = mapUnionFV exprFVs exprs -- | Find all locally-defined free Ids or type variables in several expressions -- returning a deterministically ordered list. exprsFreeVarsList :: [CoreExpr] -> [Var] -exprsFreeVarsList = runFVList . exprsFreeVarsAcc +exprsFreeVarsList = fvVarList . exprsFVs -- | Find all locally defined free Ids in a binding group bindFreeVars :: CoreBind -> VarSet -bindFreeVars (NonRec b r) = runFVSet $ filterFV isLocalVar $ rhs_fvs (b,r) -bindFreeVars (Rec prs) = runFVSet $ filterFV isLocalVar $ +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) @@ -153,14 +153,14 @@ bindFreeVars (Rec prs) = runFVSet $ filterFV isLocalVar $ exprSomeFreeVars :: InterestingVarFun -- ^ Says which 'Var's are interesting -> CoreExpr -> VarSet -exprSomeFreeVars fv_cand e = runFVSet $ filterFV fv_cand $ expr_fvs e +exprSomeFreeVars fv_cand e = fvVarSet $ filterFV fv_cand $ expr_fvs e -- | Finds free variables in several expressions selected by a predicate exprsSomeFreeVars :: InterestingVarFun -- Says which 'Var's are interesting -> [CoreExpr] -> VarSet exprsSomeFreeVars fv_cand es = - runFVSet $ filterFV fv_cand $ mapUnionFV expr_fvs es + fvVarSet $ filterFV fv_cand $ mapUnionFV expr_fvs es -- | Finds free variables in several expressions selected by a predicate -- returning a deterministically ordered list. @@ -168,7 +168,7 @@ exprsSomeFreeVarsList :: InterestingVarFun -- Says which 'Var's are interesting -> [CoreExpr] -> [Var] exprsSomeFreeVarsList fv_cand es = - runFVList $ filterFV fv_cand $ mapUnionFV expr_fvs es + fvVarList $ filterFV fv_cand $ mapUnionFV expr_fvs es -- Comment about obselete code -- We used to gather the free variables the RULES at a variable occurrence @@ -200,7 +200,7 @@ exprsSomeFreeVarsList fv_cand es = addBndr :: CoreBndr -> FV -> FV addBndr bndr fv fv_cand in_scope acc - = (varTypeTyCoVarsAcc bndr `unionFV` + = (varTypeTyCoFVs bndr `unionFV` -- Include type variables in the binder's type -- (not just Ids; coercion variables too!) FV.delFV bndr fv) fv_cand in_scope acc @@ -210,11 +210,11 @@ addBndrs bndrs fv = foldr addBndr fv bndrs expr_fvs :: CoreExpr -> FV expr_fvs (Type ty) fv_cand in_scope acc = - tyCoVarsOfTypeAcc ty fv_cand in_scope acc + tyCoFVsOfType ty fv_cand in_scope acc expr_fvs (Coercion co) fv_cand in_scope acc = - tyCoVarsOfCoAcc co fv_cand in_scope acc -expr_fvs (Var var) fv_cand in_scope acc = oneVar var fv_cand in_scope acc -expr_fvs (Lit _) fv_cand in_scope acc = noVars 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 = @@ -222,10 +222,10 @@ expr_fvs (App fun 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` tyCoVarsOfCoAcc 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` tyCoVarsOfTypeAcc ty `unionFV` addBndr bndr + = (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) @@ -242,7 +242,7 @@ expr_fvs (Let (Rec pairs) body) fv_cand in_scope acc --------- rhs_fvs :: (Id, CoreExpr) -> FV rhs_fvs (bndr, rhs) = expr_fvs rhs `unionFV` - bndrRuleAndUnfoldingVarsAcc bndr + bndrRuleAndUnfoldingFVs bndr -- Treat any RULES as extra RHSs of the binding --------- @@ -250,8 +250,8 @@ exprs_fvs :: [CoreExpr] -> FV exprs_fvs exprs = mapUnionFV expr_fvs exprs tickish_fvs :: Tickish Id -> FV -tickish_fvs (Breakpoint _ ids) = someVars ids -tickish_fvs _ = noVars +tickish_fvs (Breakpoint _ ids) = FV.mkFVs ids +tickish_fvs _ = emptyFV {- ************************************************************************ @@ -395,33 +395,33 @@ orphNamesOfFamInst fam_inst = orphNamesOfAxiom (famInstAxiom fam_inst) ruleRhsFreeVars :: CoreRule -> VarSet ruleRhsFreeVars (BuiltinRule {}) = noFVs ruleRhsFreeVars (Rule { ru_fn = _, ru_bndrs = bndrs, ru_rhs = rhs }) - = runFVSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs) + = fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs) -- See Note [Rule free var hack] -- | Those variables free in the both the left right hand sides of a rule -- returned as a non-deterministic set ruleFreeVars :: CoreRule -> VarSet -ruleFreeVars = runFVSet . ruleFreeVarsAcc +ruleFreeVars = fvVarSet . ruleFVs -- | Those variables free in the both the left right hand sides of a rule -- returned as FV computation -ruleFreeVarsAcc :: CoreRule -> FV -ruleFreeVarsAcc (BuiltinRule {}) = noVars -ruleFreeVarsAcc (Rule { ru_fn = _do_not_include - -- See Note [Rule free var hack] - , ru_bndrs = bndrs - , ru_rhs = rhs, ru_args = args }) +ruleFVs :: CoreRule -> FV +ruleFVs (BuiltinRule {}) = emptyFV +ruleFVs (Rule { ru_fn = _do_not_include + -- See Note [Rule free var hack] + , ru_bndrs = bndrs + , ru_rhs = rhs, ru_args = args }) = filterFV isLocalVar $ addBndrs bndrs (exprs_fvs (rhs:args)) -- | Those variables free in the both the left right hand sides of rules -- returned as FV computation -rulesFreeVarsAcc :: [CoreRule] -> FV -rulesFreeVarsAcc = mapUnionFV ruleFreeVarsAcc +rulesFVs :: [CoreRule] -> FV +rulesFVs = mapUnionFV ruleFVs -- | Those variables free in the both the left right hand sides of rules -- returned as a deterministic set rulesFreeVarsDSet :: [CoreRule] -> DVarSet -rulesFreeVarsDSet rules = runFVDSet $ rulesFreeVarsAcc rules +rulesFreeVarsDSet rules = fvDVarSet $ rulesFVs rules idRuleRhsVars :: (Activation -> Bool) -> Id -> VarSet -- Just the variables free on the *rhs* of a rule @@ -434,7 +434,7 @@ idRuleRhsVars is_active id -- See Note [Finding rule RHS free vars] in OccAnal.hs = delFromUFM fvs fn -- Note [Rule free var hack] where - fvs = runFVSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs) + fvs = fvVarSet $ filterFV isLocalVar $ addBndrs bndrs (expr_fvs rhs) get_fvs _ = noFVs -- | Those variables free in the right hand side of several rules @@ -444,18 +444,18 @@ rulesFreeVars rules = mapUnionVarSet ruleFreeVars rules ruleLhsFreeIds :: CoreRule -> VarSet -- ^ This finds all locally-defined free Ids on the left hand side of a rule -- and returns them as a non-deterministic set -ruleLhsFreeIds = runFVSet . ruleLhsFreeIdsAcc +ruleLhsFreeIds = fvVarSet . ruleLhsFVIds ruleLhsFreeIdsList :: CoreRule -> [Var] -- ^ This finds all locally-defined free Ids on the left hand side of a rule -- and returns them as a determinisitcally ordered list -ruleLhsFreeIdsList = runFVList . ruleLhsFreeIdsAcc +ruleLhsFreeIdsList = fvVarList . ruleLhsFVIds -ruleLhsFreeIdsAcc :: CoreRule -> FV +ruleLhsFVIds :: CoreRule -> FV -- ^ This finds all locally-defined free Ids on the left hand side of a rule -- and returns an FV computation -ruleLhsFreeIdsAcc (BuiltinRule {}) = noVars -ruleLhsFreeIdsAcc (Rule { ru_bndrs = bndrs, ru_args = args }) +ruleLhsFVIds (BuiltinRule {}) = emptyFV +ruleLhsFVIds (Rule { ru_bndrs = bndrs, ru_args = args }) = filterFV isLocalId $ addBndrs bndrs (exprs_fvs args) {- @@ -475,7 +475,7 @@ breaker, which is perfectly inlinable. vectsFreeVars :: [CoreVect] -> VarSet vectsFreeVars = mapUnionVarSet vectFreeVars where - vectFreeVars (Vect _ rhs) = runFVSet $ filterFV isLocalId $ expr_fvs rhs + vectFreeVars (Vect _ rhs) = fvVarSet $ filterFV isLocalId $ expr_fvs rhs vectFreeVars (NoVect _) = noFVs vectFreeVars (VectType _ _ _) = noFVs vectFreeVars (VectClass _) = noFVs @@ -581,48 +581,48 @@ delBinderFV b s = (s `delDVarSet` b) `unionFVs` dVarTypeTyCoVars b varTypeTyCoVars :: Var -> TyCoVarSet -- Find the type/kind variables free in the type of the id/tyvar -varTypeTyCoVars var = runFVSet $ varTypeTyCoVarsAcc var +varTypeTyCoVars var = fvVarSet $ varTypeTyCoFVs var dVarTypeTyCoVars :: Var -> DTyCoVarSet -- Find the type/kind/coercion variables free in the type of the id/tyvar -dVarTypeTyCoVars var = runFVDSet $ varTypeTyCoVarsAcc var +dVarTypeTyCoVars var = fvDVarSet $ varTypeTyCoFVs var -varTypeTyCoVarsAcc :: Var -> FV -varTypeTyCoVarsAcc var = tyCoVarsOfTypeAcc (varType var) +varTypeTyCoFVs :: Var -> FV +varTypeTyCoFVs var = tyCoFVsOfType (varType var) idFreeVars :: Id -> VarSet -idFreeVars id = ASSERT( isId id) runFVSet $ idFreeVarsAcc id +idFreeVars id = ASSERT( isId id) fvVarSet $ idFVs id dIdFreeVars :: Id -> DVarSet -dIdFreeVars id = runFVDSet $ idFreeVarsAcc id +dIdFreeVars id = fvDVarSet $ idFVs id -idFreeVarsAcc :: Id -> FV +idFVs :: Id -> FV -- Type variables, rule variables, and inline variables -idFreeVarsAcc id = ASSERT( isId id) - varTypeTyCoVarsAcc id `unionFV` - idRuleAndUnfoldingVarsAcc id +idFVs id = ASSERT( isId id) + varTypeTyCoFVs id `unionFV` + idRuleAndUnfoldingFVs id -bndrRuleAndUnfoldingVarsAcc :: Var -> FV -bndrRuleAndUnfoldingVarsAcc v | isTyVar v = noVars - | otherwise = idRuleAndUnfoldingVarsAcc v +bndrRuleAndUnfoldingFVs :: Var -> FV +bndrRuleAndUnfoldingFVs v | isTyVar v = emptyFV + | otherwise = idRuleAndUnfoldingFVs v idRuleAndUnfoldingVars :: Id -> VarSet -idRuleAndUnfoldingVars id = runFVSet $ idRuleAndUnfoldingVarsAcc id +idRuleAndUnfoldingVars id = fvVarSet $ idRuleAndUnfoldingFVs id idRuleAndUnfoldingVarsDSet :: Id -> DVarSet -idRuleAndUnfoldingVarsDSet id = runFVDSet $ idRuleAndUnfoldingVarsAcc id +idRuleAndUnfoldingVarsDSet id = fvDVarSet $ idRuleAndUnfoldingFVs id -idRuleAndUnfoldingVarsAcc :: Id -> FV -idRuleAndUnfoldingVarsAcc id = ASSERT( isId id) - idRuleVarsAcc id `unionFV` idUnfoldingVarsAcc id +idRuleAndUnfoldingFVs :: Id -> FV +idRuleAndUnfoldingFVs id = ASSERT( isId id) + idRuleFVs id `unionFV` idUnfoldingFVs id idRuleVars ::Id -> VarSet -- Does *not* include CoreUnfolding vars -idRuleVars id = runFVSet $ idRuleVarsAcc id +idRuleVars id = fvVarSet $ idRuleFVs id -idRuleVarsAcc :: Id -> FV -idRuleVarsAcc id = ASSERT( isId id) - someVars (dVarSetElems $ ruleInfoFreeVars (idSpecialisation id)) +idRuleFVs :: Id -> FV +idRuleFVs id = ASSERT( isId id) + FV.mkFVs (dVarSetElems $ ruleInfoFreeVars (idSpecialisation id)) idUnfoldingVars :: Id -> VarSet -- Produce free vars for an unfolding, but NOT for an ordinary @@ -630,16 +630,16 @@ idUnfoldingVars :: Id -> VarSet -- and we'll get exponential behaviour if we look at both unf and rhs! -- But do look at the *real* unfolding, even for loop breakers, else -- we might get out-of-scope variables -idUnfoldingVars id = runFVSet $ idUnfoldingVarsAcc id +idUnfoldingVars id = fvVarSet $ idUnfoldingFVs id -idUnfoldingVarsAcc :: Id -> FV -idUnfoldingVarsAcc id = stableUnfoldingVarsAcc (realIdUnfolding id) `orElse` noVars +idUnfoldingFVs :: Id -> FV +idUnfoldingFVs id = stableUnfoldingFVs (realIdUnfolding id) `orElse` emptyFV stableUnfoldingVars :: Unfolding -> Maybe VarSet -stableUnfoldingVars unf = runFVSet `fmap` stableUnfoldingVarsAcc unf +stableUnfoldingVars unf = fvVarSet `fmap` stableUnfoldingFVs unf -stableUnfoldingVarsAcc :: Unfolding -> Maybe FV -stableUnfoldingVarsAcc unf +stableUnfoldingFVs :: Unfolding -> Maybe FV +stableUnfoldingFVs unf = case unf of CoreUnfolding { uf_tmpl = rhs, uf_src = src } | isStableSource src @@ -721,8 +721,8 @@ freeVars = go go (Let (NonRec binder rhs) body) = ( FVAnn { fva_fvs = freeVarsOf rhs2 `unionFVs` body_fvs - `unionFVs` runFVDSet - (bndrRuleAndUnfoldingVarsAcc binder) + `unionFVs` fvDVarSet + (bndrRuleAndUnfoldingFVs binder) -- Remember any rules; cf rhs_fvs above , fva_ty_fvs = freeVarsOfType body2 , fva_ty = exprTypeFV body2 } @@ -742,7 +742,7 @@ freeVars = go rhss2 = map go rhss rhs_body_fvs = foldr (unionFVs . freeVarsOf) body_fvs rhss2 - binders_fvs = runFVDSet $ mapUnionFV idRuleAndUnfoldingVarsAcc binders + binders_fvs = fvDVarSet $ mapUnionFV idRuleAndUnfoldingFVs binders all_fvs = rhs_body_fvs `unionFVs` binders_fvs -- The "delBinderFV" happens after adding the idSpecVars, -- since the latter may add some of the binders as fvs diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs index 4438d2b694..1f60e7cd1f 100644 --- a/compiler/coreSyn/CoreSubst.hs +++ b/compiler/coreSyn/CoreSubst.hs @@ -735,7 +735,7 @@ substDVarSet subst fvs where subst_fv subst fv acc | isId fv = expr_fvs (lookupIdSubst (text "substDVarSet") subst fv) isLocalVar emptyVarSet $! acc - | otherwise = tyCoVarsOfTypeAcc (lookupTCvSubst subst fv) (const True) emptyVarSet $! acc + | otherwise = tyCoFVsOfType (lookupTCvSubst subst fv) (const True) emptyVarSet $! acc ------------------ substTickish :: Subst -> Tickish Id -> Tickish Id diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs index 897b131d83..f2d82ac7fa 100644 --- a/compiler/simplCore/SetLevels.hs +++ b/compiler/simplCore/SetLevels.hs @@ -786,7 +786,7 @@ lvlBind env (AnnRec pairs) -- Finding the free vars of the binding group is annoying bind_fvs = ((unionDVarSets [ freeVarsOf rhs | (_, rhs) <- pairs]) `unionDVarSet` - (runFVDSet $ unionsFV [ idFreeVarsAcc bndr + (fvDVarSet $ unionsFV [ idFVs bndr | (bndr, (_,_)) <- pairs])) `delDVarSetList` bndrs @@ -1054,7 +1054,7 @@ abstractVars dest_lvl (LE { le_subst = subst, le_lvl_env = lvl_env }) in_fvs -- Result includes the input variable itself close v = foldDVarSet (unionDVarSet . close) (unitDVarSet v) - (runFVDSet $ varTypeTyCoVarsAcc v) + (fvDVarSet $ varTypeTyCoFVs v) type LvlM result = UniqSM result diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 4f45e41458..28d154edd1 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -63,7 +63,7 @@ import Outputable import FastString import Bag import Pair -import FV (runFVList, unionFV, someVars) +import FV (fvVarList, unionFV, mkFVs) import qualified GHC.LanguageExtensions as LangExt import Control.Monad @@ -402,7 +402,7 @@ tcDeriving deriv_infos deriv_decls ; gbl_env <- tcExtendLocalFamInstEnv (bagToList famInsts) $ tcExtendLocalInstEnv (map iSpec (bagToList inst_info)) getGblEnv - ; let all_dus = rn_dus `plusDU` usesOnly (mkFVs $ catMaybes maybe_fvs) + ; let all_dus = rn_dus `plusDU` usesOnly (NameSet.mkFVs $ catMaybes maybe_fvs) ; return (addTcgDUs gbl_env all_dus, inst_info, rn_binds) } where ddump_deriving :: Bag (InstInfo Name) -> HsValBinds Name @@ -646,9 +646,9 @@ deriveTyData tvs tc tc_args deriv_pred Just kind_subst = mb_match all_tkvs = toposortTyVars $ - runFVList $ unionFV - (tyCoVarsOfTypesAcc tc_args_to_keep) - (someVars deriv_tvs) + fvVarList $ unionFV + (tyCoFVsOfTypes tc_args_to_keep) + (FV.mkFVs deriv_tvs) unmapped_tkvs = filter (`notElemTCvSubst` kind_subst) all_tkvs (subst, tkvs) = mapAccumL substTyVarBndr diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index f14ddf70bc..4887626976 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -1576,39 +1576,41 @@ instance Outputable Ct where -- | Returns free variables of constraints as a non-deterministic set tyCoVarsOfCt :: Ct -> TcTyCoVarSet -tyCoVarsOfCt = runFVSet . tyCoVarsOfCtAcc +tyCoVarsOfCt = fvVarSet . tyCoFVsOfCt -- | Returns free variables of constraints as a deterministically ordered. -- list. See Note [Deterministic FV] in FV. tyCoVarsOfCtList :: Ct -> [TcTyCoVar] -tyCoVarsOfCtList = runFVList . tyCoVarsOfCtAcc +tyCoVarsOfCtList = fvVarList . tyCoFVsOfCt -- | Returns free variables of constraints as a composable FV computation. -- See Note [Deterministic FV] in FV. -tyCoVarsOfCtAcc :: Ct -> FV -tyCoVarsOfCtAcc (CTyEqCan { cc_tyvar = tv, cc_rhs = xi }) - = tyCoVarsOfTypeAcc xi `unionFV` oneVar tv `unionFV` tyCoVarsOfTypeAcc (tyVarKind tv) -tyCoVarsOfCtAcc (CFunEqCan { cc_tyargs = tys, cc_fsk = fsk }) - = tyCoVarsOfTypesAcc tys `unionFV` oneVar fsk `unionFV` tyCoVarsOfTypeAcc (tyVarKind fsk) -tyCoVarsOfCtAcc (CDictCan { cc_tyargs = tys }) = tyCoVarsOfTypesAcc tys -tyCoVarsOfCtAcc (CIrredEvCan { cc_ev = ev }) = tyCoVarsOfTypeAcc (ctEvPred ev) -tyCoVarsOfCtAcc (CHoleCan { cc_ev = ev }) = tyCoVarsOfTypeAcc (ctEvPred ev) -tyCoVarsOfCtAcc (CNonCanonical { cc_ev = ev }) = tyCoVarsOfTypeAcc (ctEvPred ev) +tyCoFVsOfCt :: Ct -> FV +tyCoFVsOfCt (CTyEqCan { cc_tyvar = tv, cc_rhs = xi }) + = tyCoFVsOfType xi `unionFV` FV.unitFV tv + `unionFV` tyCoFVsOfType (tyVarKind tv) +tyCoFVsOfCt (CFunEqCan { cc_tyargs = tys, cc_fsk = fsk }) + = tyCoFVsOfTypes tys `unionFV` FV.unitFV fsk + `unionFV` tyCoFVsOfType (tyVarKind fsk) +tyCoFVsOfCt (CDictCan { cc_tyargs = tys }) = tyCoFVsOfTypes tys +tyCoFVsOfCt (CIrredEvCan { cc_ev = ev }) = tyCoFVsOfType (ctEvPred ev) +tyCoFVsOfCt (CHoleCan { cc_ev = ev }) = tyCoFVsOfType (ctEvPred ev) +tyCoFVsOfCt (CNonCanonical { cc_ev = ev }) = tyCoFVsOfType (ctEvPred ev) -- | Returns free variables of a bag of constraints as a non-deterministic -- set. See Note [Deterministic FV] in FV. tyCoVarsOfCts :: Cts -> TcTyCoVarSet -tyCoVarsOfCts = runFVSet . tyCoVarsOfCtsAcc +tyCoVarsOfCts = fvVarSet . tyCoFVsOfCts -- | Returns free variables of a bag of constraints as a deterministically -- odered list. See Note [Deterministic FV] in FV. tyCoVarsOfCtsList :: Cts -> [TcTyCoVar] -tyCoVarsOfCtsList = runFVList . tyCoVarsOfCtsAcc +tyCoVarsOfCtsList = fvVarList . tyCoFVsOfCts -- | Returns free variables of a bag of constraints as a composable FV -- computation. See Note [Deterministic FV] in FV. -tyCoVarsOfCtsAcc :: Cts -> FV -tyCoVarsOfCtsAcc = foldrBag (unionFV . tyCoVarsOfCtAcc) noVars +tyCoFVsOfCts :: Cts -> FV +tyCoFVsOfCts = foldrBag (unionFV . tyCoFVsOfCt) emptyFV tyCoVarsOfWC :: WantedConstraints -> TyCoVarSet -- Only called on *zonked* things, hence no need to worry about flatten-skolems diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index b4a02de184..0a6b499a52 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -169,7 +169,7 @@ module TcType ( tyCoVarsOfType, tyCoVarsOfTypes, closeOverKinds, tyCoVarsOfTelescope, - tyCoVarsOfTypeAcc, tyCoVarsOfTypesAcc, + tyCoFVsOfType, tyCoFVsOfTypes, tyCoVarsOfTypeDSet, tyCoVarsOfTypesDSet, closeOverKindsDSet, tyCoVarsOfTypeList, tyCoVarsOfTypesList, @@ -828,18 +828,18 @@ exactTyCoVarsOfTypes tys = mapUnionVarSet exactTyCoVarsOfType tys -- | Find all variables bound anywhere in a type. -- See also Note [Scope-check inferred kinds] in TcHsType allBoundVariables :: Type -> TyVarSet -allBoundVariables ty = runFVSet $ go ty +allBoundVariables ty = fvVarSet $ go ty where go :: Type -> FV go (TyVarTy tv) = go (tyVarKind tv) go (TyConApp _ tys) = mapUnionFV go tys go (AppTy t1 t2) = go t1 `unionFV` go t2 go (ForAllTy (Anon t1) t2) = go t1 `unionFV` go t2 - go (ForAllTy (Named tv _) t2) = oneVar tv `unionFV` + go (ForAllTy (Named tv _) t2) = FV.unitFV tv `unionFV` go (tyVarKind tv) `unionFV` go t2 - go (LitTy {}) = noVars + go (LitTy {}) = emptyFV go (CastTy ty _) = go ty - go (CoercionTy {}) = noVars + go (CoercionTy {}) = emptyFV -- any types mentioned in a coercion should also be mentioned in -- a type. diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs index 64e2c5b97b..a515d29e90 100644 --- a/compiler/types/Coercion.hs +++ b/compiler/types/Coercion.hs @@ -65,7 +65,7 @@ module Coercion ( -- ** Free variables tyCoVarsOfCo, tyCoVarsOfCos, coVarsOfCo, - tyCoVarsOfCoAcc, tyCoVarsOfCosAcc, tyCoVarsOfCoDSet, + tyCoFVsOfCo, tyCoFVsOfCos, tyCoVarsOfCoDSet, coercionSize, -- ** Substitution diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index ebbc386a48..3eb431dc4b 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -62,14 +62,14 @@ module TyCoRep ( -- * Free variables tyCoVarsOfType, tyCoVarsOfTypeDSet, tyCoVarsOfTypes, tyCoVarsOfTypesDSet, - tyCoVarsBndrAcc, tyCoVarsOfTypeAcc, tyCoVarsOfTypeList, - tyCoVarsOfTypesAcc, tyCoVarsOfTypesList, - closeOverKindsDSet, closeOverKindsAcc, + tyCoFVsBndr, tyCoFVsOfType, tyCoVarsOfTypeList, + tyCoFVsOfTypes, tyCoVarsOfTypesList, + closeOverKindsDSet, closeOverKindsFV, coVarsOfType, coVarsOfTypes, coVarsOfCo, coVarsOfCos, tyCoVarsOfCo, tyCoVarsOfCos, tyCoVarsOfCoDSet, - tyCoVarsOfCoAcc, tyCoVarsOfCosAcc, + tyCoFVsOfCo, tyCoFVsOfCos, tyCoVarsOfCoList, tyCoVarsOfProv, closeOverKinds, tyCoVarsOfTelescope, @@ -1346,21 +1346,21 @@ so, so it's easiest to do it here. -- synonym. tyCoVarsOfType :: Type -> TyCoVarSet -- See Note [Free variables of types] -tyCoVarsOfType ty = runFVSet $ tyCoVarsOfTypeAcc ty +tyCoVarsOfType ty = fvVarSet $ tyCoFVsOfType ty -- | `tyVarsOfType` that returns free variables of a type in a deterministic -- set. For explanation of why using `VarSet` is not deterministic see -- Note [Deterministic FV] in FV. tyCoVarsOfTypeDSet :: Type -> DTyCoVarSet -- See Note [Free variables of types] -tyCoVarsOfTypeDSet ty = runFVDSet $ tyCoVarsOfTypeAcc ty +tyCoVarsOfTypeDSet ty = fvDVarSet $ tyCoFVsOfType ty -- | `tyVarsOfType` that returns free variables of a type in deterministic -- order. For explanation of why using `VarSet` is not deterministic see -- Note [Deterministic FV] in FV. tyCoVarsOfTypeList :: Type -> [TyCoVar] -- See Note [Free variables of types] -tyCoVarsOfTypeList ty = runFVList $ tyCoVarsOfTypeAcc ty +tyCoVarsOfTypeList ty = fvVarList $ tyCoFVsOfType ty -- | The worker for `tyVarsOfType` and `tyVarsOfTypeList`. -- The previous implementation used `unionVarSet` which is O(n+m) and can @@ -1370,101 +1370,101 @@ tyCoVarsOfTypeList ty = runFVList $ tyCoVarsOfTypeAcc ty -- See Note [FV naming conventions] in FV. -- -- Eta-expanded because that makes it run faster (apparently) -tyCoVarsOfTypeAcc :: Type -> FV +tyCoFVsOfType :: Type -> FV -- See Note [Free variables of types] -tyCoVarsOfTypeAcc (TyVarTy v) a b c = (oneVar v `unionFV` tyCoVarsOfTypeAcc (tyVarKind v)) a b c -tyCoVarsOfTypeAcc (TyConApp _ tys) a b c = tyCoVarsOfTypesAcc tys a b c -tyCoVarsOfTypeAcc (LitTy {}) a b c = noVars a b c -tyCoVarsOfTypeAcc (AppTy fun arg) a b c = (tyCoVarsOfTypeAcc fun `unionFV` tyCoVarsOfTypeAcc arg) a b c -tyCoVarsOfTypeAcc (ForAllTy bndr ty) a b c = tyCoVarsBndrAcc bndr (tyCoVarsOfTypeAcc ty) a b c -tyCoVarsOfTypeAcc (CastTy ty co) a b c = (tyCoVarsOfTypeAcc ty `unionFV` tyCoVarsOfCoAcc co) a b c -tyCoVarsOfTypeAcc (CoercionTy co) a b c = tyCoVarsOfCoAcc co a b c - -tyCoVarsBndrAcc :: TyBinder -> FV -> FV +tyCoFVsOfType (TyVarTy v) a b c = (unitFV v `unionFV` tyCoFVsOfType (tyVarKind v)) a b c +tyCoFVsOfType (TyConApp _ tys) a b c = tyCoFVsOfTypes tys a b c +tyCoFVsOfType (LitTy {}) a b c = emptyFV a b c +tyCoFVsOfType (AppTy fun arg) a b c = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) a b c +tyCoFVsOfType (ForAllTy bndr ty) a b c = tyCoFVsBndr bndr (tyCoFVsOfType ty) a b c +tyCoFVsOfType (CastTy ty co) a b c = (tyCoFVsOfType ty `unionFV` tyCoFVsOfCo co) a b c +tyCoFVsOfType (CoercionTy co) a b c = tyCoFVsOfCo co a b c + +tyCoFVsBndr :: TyBinder -> FV -> FV -- Free vars of (forall b. <thing with fvs>) -tyCoVarsBndrAcc bndr fvs = delBinderVarFV bndr fvs - `unionFV` tyCoVarsOfTypeAcc (binderType bndr) +tyCoFVsBndr bndr fvs = delBinderVarFV bndr fvs + `unionFV` tyCoFVsOfType (binderType bndr) -- | Returns free variables of types, including kind variables as -- a non-deterministic set. For type synonyms it does /not/ expand the -- synonym. tyCoVarsOfTypes :: [Type] -> TyCoVarSet -- See Note [Free variables of types] -tyCoVarsOfTypes tys = runFVSet $ tyCoVarsOfTypesAcc tys +tyCoVarsOfTypes tys = fvVarSet $ tyCoFVsOfTypes tys -- | Returns free variables of types, including kind variables as -- a deterministic set. For type synonyms it does /not/ expand the -- synonym. tyCoVarsOfTypesDSet :: [Type] -> DTyCoVarSet -- See Note [Free variables of types] -tyCoVarsOfTypesDSet tys = runFVDSet $ tyCoVarsOfTypesAcc tys +tyCoVarsOfTypesDSet tys = fvDVarSet $ tyCoFVsOfTypes tys -- | Returns free variables of types, including kind variables as -- a deterministically ordered list. For type synonyms it does /not/ expand the -- synonym. tyCoVarsOfTypesList :: [Type] -> [TyCoVar] -- See Note [Free variables of types] -tyCoVarsOfTypesList tys = runFVList $ tyCoVarsOfTypesAcc tys +tyCoVarsOfTypesList tys = fvVarList $ tyCoFVsOfTypes tys -tyCoVarsOfTypesAcc :: [Type] -> FV +tyCoFVsOfTypes :: [Type] -> FV -- See Note [Free variables of types] -tyCoVarsOfTypesAcc (ty:tys) fv_cand in_scope acc = (tyCoVarsOfTypeAcc ty `unionFV` tyCoVarsOfTypesAcc tys) fv_cand in_scope acc -tyCoVarsOfTypesAcc [] fv_cand in_scope acc = noVars fv_cand in_scope acc +tyCoFVsOfTypes (ty:tys) fv_cand in_scope acc = (tyCoFVsOfType ty `unionFV` tyCoFVsOfTypes tys) fv_cand in_scope acc +tyCoFVsOfTypes [] fv_cand in_scope acc = emptyFV fv_cand in_scope acc tyCoVarsOfCo :: Coercion -> TyCoVarSet -- See Note [Free variables of types] -tyCoVarsOfCo co = runFVSet $ tyCoVarsOfCoAcc co +tyCoVarsOfCo co = fvVarSet $ tyCoFVsOfCo co -- | Get a deterministic set of the vars free in a coercion tyCoVarsOfCoDSet :: Coercion -> DTyCoVarSet -- See Note [Free variables of types] -tyCoVarsOfCoDSet co = runFVDSet $ tyCoVarsOfCoAcc co +tyCoVarsOfCoDSet co = fvDVarSet $ tyCoFVsOfCo co tyCoVarsOfCoList :: Coercion -> [TyCoVar] -- See Note [Free variables of types] -tyCoVarsOfCoList co = runFVList $ tyCoVarsOfCoAcc co +tyCoVarsOfCoList co = fvVarList $ tyCoFVsOfCo co -tyCoVarsOfCoAcc :: Coercion -> FV +tyCoFVsOfCo :: Coercion -> FV -- Extracts type and coercion variables from a coercion -- See Note [Free variables of types] -tyCoVarsOfCoAcc (Refl _ ty) fv_cand in_scope acc = tyCoVarsOfTypeAcc ty fv_cand in_scope acc -tyCoVarsOfCoAcc (TyConAppCo _ _ cos) fv_cand in_scope acc = tyCoVarsOfCosAcc cos fv_cand in_scope acc -tyCoVarsOfCoAcc (AppCo co arg) fv_cand in_scope acc - = (tyCoVarsOfCoAcc co `unionFV` tyCoVarsOfCoAcc arg) fv_cand in_scope acc -tyCoVarsOfCoAcc (ForAllCo tv kind_co co) fv_cand in_scope acc - = (delFV tv (tyCoVarsOfCoAcc co) `unionFV` tyCoVarsOfCoAcc kind_co) fv_cand in_scope acc -tyCoVarsOfCoAcc (CoVarCo v) fv_cand in_scope acc - = (oneVar v `unionFV` tyCoVarsOfTypeAcc (varType v)) fv_cand in_scope acc -tyCoVarsOfCoAcc (AxiomInstCo _ _ cos) fv_cand in_scope acc = tyCoVarsOfCosAcc cos fv_cand in_scope acc -tyCoVarsOfCoAcc (UnivCo p _ t1 t2) fv_cand in_scope acc - = (tyCoVarsOfProvAcc p `unionFV` tyCoVarsOfTypeAcc t1 - `unionFV` tyCoVarsOfTypeAcc t2) fv_cand in_scope acc -tyCoVarsOfCoAcc (SymCo co) fv_cand in_scope acc = tyCoVarsOfCoAcc co fv_cand in_scope acc -tyCoVarsOfCoAcc (TransCo co1 co2) fv_cand in_scope acc = (tyCoVarsOfCoAcc co1 `unionFV` tyCoVarsOfCoAcc co2) fv_cand in_scope acc -tyCoVarsOfCoAcc (NthCo _ co) fv_cand in_scope acc = tyCoVarsOfCoAcc co fv_cand in_scope acc -tyCoVarsOfCoAcc (LRCo _ co) fv_cand in_scope acc = tyCoVarsOfCoAcc co fv_cand in_scope acc -tyCoVarsOfCoAcc (InstCo co arg) fv_cand in_scope acc = (tyCoVarsOfCoAcc co `unionFV` tyCoVarsOfCoAcc arg) fv_cand in_scope acc -tyCoVarsOfCoAcc (CoherenceCo c1 c2) fv_cand in_scope acc = (tyCoVarsOfCoAcc c1 `unionFV` tyCoVarsOfCoAcc c2) fv_cand in_scope acc -tyCoVarsOfCoAcc (KindCo co) fv_cand in_scope acc = tyCoVarsOfCoAcc co fv_cand in_scope acc -tyCoVarsOfCoAcc (SubCo co) fv_cand in_scope acc = tyCoVarsOfCoAcc co fv_cand in_scope acc -tyCoVarsOfCoAcc (AxiomRuleCo _ cs) fv_cand in_scope acc = tyCoVarsOfCosAcc cs fv_cand in_scope acc +tyCoFVsOfCo (Refl _ ty) fv_cand in_scope acc = tyCoFVsOfType ty fv_cand in_scope acc +tyCoFVsOfCo (TyConAppCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc +tyCoFVsOfCo (AppCo co arg) fv_cand in_scope acc + = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc +tyCoFVsOfCo (ForAllCo tv kind_co co) fv_cand in_scope acc + = (delFV tv (tyCoFVsOfCo co) `unionFV` tyCoFVsOfCo kind_co) fv_cand in_scope acc +tyCoFVsOfCo (CoVarCo v) fv_cand in_scope acc + = (unitFV v `unionFV` tyCoFVsOfType (varType v)) fv_cand in_scope acc +tyCoFVsOfCo (AxiomInstCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc +tyCoFVsOfCo (UnivCo p _ t1 t2) fv_cand in_scope acc + = (tyCoFVsOfProv p `unionFV` tyCoFVsOfType t1 + `unionFV` tyCoFVsOfType t2) fv_cand in_scope acc +tyCoFVsOfCo (SymCo co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc +tyCoFVsOfCo (TransCo co1 co2) fv_cand in_scope acc = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2) fv_cand in_scope acc +tyCoFVsOfCo (NthCo _ co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc +tyCoFVsOfCo (LRCo _ co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc +tyCoFVsOfCo (InstCo co arg) fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc +tyCoFVsOfCo (CoherenceCo c1 c2) fv_cand in_scope acc = (tyCoFVsOfCo c1 `unionFV` tyCoFVsOfCo c2) fv_cand in_scope acc +tyCoFVsOfCo (KindCo co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc +tyCoFVsOfCo (SubCo co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc +tyCoFVsOfCo (AxiomRuleCo _ cs) fv_cand in_scope acc = tyCoFVsOfCos cs fv_cand in_scope acc tyCoVarsOfProv :: UnivCoProvenance -> TyCoVarSet -tyCoVarsOfProv prov = runFVSet $ tyCoVarsOfProvAcc prov +tyCoVarsOfProv prov = fvVarSet $ tyCoFVsOfProv prov -tyCoVarsOfProvAcc :: UnivCoProvenance -> FV -tyCoVarsOfProvAcc UnsafeCoerceProv fv_cand in_scope acc = noVars fv_cand in_scope acc -tyCoVarsOfProvAcc (PhantomProv co) fv_cand in_scope acc = tyCoVarsOfCoAcc co fv_cand in_scope acc -tyCoVarsOfProvAcc (ProofIrrelProv co) fv_cand in_scope acc = tyCoVarsOfCoAcc co fv_cand in_scope acc -tyCoVarsOfProvAcc (PluginProv _) fv_cand in_scope acc = noVars fv_cand in_scope acc -tyCoVarsOfProvAcc (HoleProv _) fv_cand in_scope acc = noVars fv_cand in_scope acc +tyCoFVsOfProv :: UnivCoProvenance -> FV +tyCoFVsOfProv UnsafeCoerceProv fv_cand in_scope acc = emptyFV fv_cand in_scope acc +tyCoFVsOfProv (PhantomProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc +tyCoFVsOfProv (ProofIrrelProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc +tyCoFVsOfProv (PluginProv _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc +tyCoFVsOfProv (HoleProv _) fv_cand in_scope acc = emptyFV fv_cand in_scope acc tyCoVarsOfCos :: [Coercion] -> TyCoVarSet -tyCoVarsOfCos cos = runFVSet $ tyCoVarsOfCosAcc cos +tyCoVarsOfCos cos = fvVarSet $ tyCoFVsOfCos cos -tyCoVarsOfCosAcc :: [Coercion] -> FV -tyCoVarsOfCosAcc [] fv_cand in_scope acc = noVars fv_cand in_scope acc -tyCoVarsOfCosAcc (co:cos) fv_cand in_scope acc = (tyCoVarsOfCoAcc co `unionFV` tyCoVarsOfCosAcc cos) fv_cand in_scope acc +tyCoFVsOfCos :: [Coercion] -> FV +tyCoFVsOfCos [] fv_cand in_scope acc = emptyFV fv_cand in_scope acc +tyCoFVsOfCos (co:cos) fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCos cos) fv_cand in_scope acc coVarsOfType :: Type -> CoVarSet coVarsOfType (TyVarTy v) = coVarsOfType (tyVarKind v) @@ -1513,19 +1513,19 @@ coVarsOfCos cos = mapUnionVarSet coVarsOfCo cos -- | Add the kind variables free in the kinds of the tyvars in the given set. -- Returns a non-deterministic set. closeOverKinds :: TyVarSet -> TyVarSet -closeOverKinds = runFVSet . closeOverKindsAcc . varSetElems +closeOverKinds = fvVarSet . closeOverKindsFV . varSetElems -- | Given a list of tyvars returns a deterministic FV computation that -- returns the given tyvars with the kind variables free in the kinds of the -- given tyvars. -closeOverKindsAcc :: [TyVar] -> FV -closeOverKindsAcc tvs = - mapUnionFV (tyCoVarsOfTypeAcc . tyVarKind) tvs `unionFV` someVars tvs +closeOverKindsFV :: [TyVar] -> FV +closeOverKindsFV tvs = + mapUnionFV (tyCoFVsOfType . tyVarKind) tvs `unionFV` mkFVs tvs -- | Add the kind variables free in the kinds of the tyvars in the given set. -- Returns a deterministic set. closeOverKindsDSet :: DTyVarSet -> DTyVarSet -closeOverKindsDSet = runFVDSet . closeOverKindsAcc . dVarSetElems +closeOverKindsDSet = fvDVarSet . closeOverKindsFV . dVarSetElems -- | Gets the free vars of a telescope, scoped over a given free var set. tyCoVarsOfTelescope :: [Var] -> TyCoVarSet -> TyCoVarSet diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 93f4df2727..321797b6ab 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -116,7 +116,7 @@ module Type ( liftedTypeKind, -- * Type free variables - tyCoVarsOfType, tyCoVarsOfTypes, tyCoVarsOfTypeAcc, + tyCoVarsOfType, tyCoVarsOfTypes, tyCoFVsOfType, tyCoVarsOfTypeDSet, coVarsOfType, coVarsOfTypes, closeOverKinds, diff --git a/compiler/utils/FV.hs b/compiler/utils/FV.hs index 9ff273024c..8e012209cf 100644 --- a/compiler/utils/FV.hs +++ b/compiler/utils/FV.hs @@ -12,12 +12,12 @@ module FV ( FV, InterestingVarFun, -- * Running the computations - runFV, runFVList, runFVSet, runFVDSet, + fvVarListVarSet, fvVarList, fvVarSet, fvDVarSet, -- ** Manipulating those computations - oneVar, - noVars, - someVars, + unitFV, + emptyFV, + mkFVs, unionFV, unionsFV, delFV, @@ -59,48 +59,49 @@ type FV = InterestingVarFun -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- To get the performance and determinism that FV provides, FV computations -- need to built up from smaller FV computations and then evaluated with --- one of `runFVList`, `runFVDSet`, `runFV`. That means the functions +-- one of `fvVarList`, `fvDVarSet`, `fvVarListVarSet`. That means the functions -- returning FV need to be exported. -- -- The conventions are: -- -- a) non-deterministic functions: --- * x - a function that returns VarSet --- e.g. `tyVarsOfType` +-- * a function that returns VarSet +-- e.g. `tyVarsOfType` -- b) deterministic functions: --- * xAcc - a worker that returns FV --- e.g. `tyVarsOfTypeAcc` --- * xList - a function that returns [Var] --- e.g. `tyVarsOfTypeList` --- * xDSet - a function that returns DVarSet --- e.g. `tyVarsOfTypeDSet` +-- * a worker that returns FV +-- e.g. `tyFVsOfType` +-- * a function that returns [Var] +-- e.g. `tyVarsOfTypeList` +-- * a function that returns DVarSet +-- e.g. `tyVarsOfTypeDSet` -- --- Where x, xList, xDSet are implemented in terms of the worker evaluated with --- runFVSet, runFVList, runFVDSet respectively. +-- Where tyVarsOfType, tyVarsOfTypeList, tyVarsOfTypeDSet are implemented +-- in terms of the worker evaluated with fvVarSet, fvVarList, fvDVarSet +-- respectively. -- | Run a free variable computation, returning a list of distinct free -- variables in deterministic order and a non-deterministic set containing -- those variables. -runFV :: FV -> ([Var], VarSet) -runFV fv = fv (const True) emptyVarSet ([], emptyVarSet) +fvVarListVarSet :: FV -> ([Var], VarSet) +fvVarListVarSet fv = fv (const True) emptyVarSet ([], emptyVarSet) -- | Run a free variable computation, returning a list of distinct free -- variables in deterministic order. -runFVList :: FV -> [Var] -runFVList = fst . runFV +fvVarList :: FV -> [Var] +fvVarList = fst . fvVarListVarSet -- | Run a free variable computation, returning a deterministic set of free -- variables. Note that this is just a wrapper around the version that -- returns a deterministic list. If you need a list you should use --- `runFVList`. -runFVDSet :: FV -> DVarSet -runFVDSet = mkDVarSet . fst . runFV +-- `fvVarList`. +fvDVarSet :: FV -> DVarSet +fvDVarSet = mkDVarSet . fst . fvVarListVarSet -- | Run a free variable computation, returning a non-deterministic set of -- free variables. Don't use if the set will be later converted to a list -- and the order of that list will impact the generated code. -runFVSet :: FV -> VarSet -runFVSet = snd . runFV +fvVarSet :: FV -> VarSet +fvVarSet = snd . fvVarListVarSet -- Note [FV eta expansion] -- ~~~~~~~~~~~~~~~~~~~~~~~ @@ -141,18 +142,18 @@ runFVSet = snd . runFV -- | Add a variable - when free, to the returned free variables. -- Ignores duplicates and respects the filtering function. -oneVar :: Id -> FV -oneVar var fv_cand in_scope acc@(have, haveSet) +unitFV :: Id -> FV +unitFV var fv_cand in_scope acc@(have, haveSet) | var `elemVarSet` in_scope = acc | var `elemVarSet` haveSet = acc | fv_cand var = (var:have, extendVarSet haveSet var) | otherwise = acc -{-# INLINE oneVar #-} +{-# INLINE unitFV #-} -- | Return no free variables. -noVars :: FV -noVars _ _ acc = acc -{-# INLINE noVars #-} +emptyFV :: FV +emptyFV _ _ acc = acc +{-# INLINE emptyFV #-} -- | Union two free variable computations. unionFV :: FV -> FV -> FV @@ -192,7 +193,7 @@ unionsFV fvs fv_cand in_scope acc = mapUnionFV id fvs fv_cand in_scope acc -- | Add multiple variables - when free, to the returned free variables. -- Ignores duplicates and respects the filtering function. -someVars :: [Var] -> FV -someVars vars fv_cand in_scope acc = - mapUnionFV oneVar vars fv_cand in_scope acc -{-# INLINE someVars #-} +mkFVs :: [Var] -> FV +mkFVs vars fv_cand in_scope acc = + mapUnionFV unitFV vars fv_cand in_scope acc +{-# INLINE mkFVs #-} |