diff options
author | Bartosz Nitka <niteria@gmail.com> | 2016-04-22 09:47:30 -0700 |
---|---|---|
committer | Bartosz Nitka <niteria@gmail.com> | 2016-04-22 09:49:37 -0700 |
commit | 03006f5ef2daedbbb7b0932b2c0e265f097cf2bf (patch) | |
tree | 1df90ecec5eece17bb153aac90abd28fd3b82e4a | |
parent | 0f96686b10fd36d479a54c71a6e1753193e85347 (diff) | |
download | haskell-03006f5ef2daedbbb7b0932b2c0e265f097cf2bf.tar.gz |
Get rid of varSetElemsWellScoped in abstractFloats
It's possible to get rid of this use site in a local way
and it introduces unneccessary nondeterminism.
Test Plan: ./validate
Reviewers: simonmar, goldfire, austin, bgamari, simonpj
Reviewed By: simonpj
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2122
GHC Trac Issues: #4012
-rw-r--r-- | compiler/coreSyn/CoreFVs.hs | 9 | ||||
-rw-r--r-- | compiler/simplCore/SimplUtils.hs | 8 | ||||
-rw-r--r-- | compiler/types/TyCoRep.hs | 7 | ||||
-rw-r--r-- | compiler/types/Type.hs | 2 |
4 files changed, 19 insertions, 7 deletions
diff --git a/compiler/coreSyn/CoreFVs.hs b/compiler/coreSyn/CoreFVs.hs index 660538c2fb..084ed65762 100644 --- a/compiler/coreSyn/CoreFVs.hs +++ b/compiler/coreSyn/CoreFVs.hs @@ -22,7 +22,7 @@ module CoreFVs ( -- * Selective free variables of expressions InterestingVarFun, exprSomeFreeVars, exprsSomeFreeVars, - exprsSomeFreeVarsList, + exprSomeFreeVarsList, exprsSomeFreeVarsList, -- * Free variables of Rules, Vars and Ids varTypeTyCoVars, @@ -155,6 +155,13 @@ exprSomeFreeVars :: InterestingVarFun -- ^ Says which 'Var's are interesting -> VarSet exprSomeFreeVars fv_cand e = fvVarSet $ filterFV fv_cand $ expr_fvs e +-- | Finds free variables in an expression selected by a predicate +-- returning a deterministically ordered list. +exprSomeFreeVarsList :: InterestingVarFun -- ^ Says which 'Var's are interesting + -> CoreExpr + -> [Var] +exprSomeFreeVarsList fv_cand e = fvVarList $ 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] diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs index 0e403430b4..48dce1d090 100644 --- a/compiler/simplCore/SimplUtils.hs +++ b/compiler/simplCore/SimplUtils.hs @@ -1566,10 +1566,10 @@ abstractFloats main_tvs body_env body rhs' = CoreSubst.substExpr (text "abstract_floats2") subst rhs -- tvs_here: see Note [Which type variables to abstract over] - tvs_here = varSetElemsWellScoped $ - intersectVarSet main_tv_set $ - closeOverKinds $ - exprSomeFreeVars isTyVar rhs' + tvs_here = toposortTyVars $ + filter (`elemVarSet` main_tv_set) $ + closeOverKindsList $ + exprSomeFreeVarsList isTyVar rhs' abstract subst (Rec prs) = do { (poly_ids, poly_apps) <- mapAndUnzipM (mk_poly tvs_here) ids diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 1ca1efbc21..b1aad56457 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -64,7 +64,7 @@ module TyCoRep ( tyCoVarsOfType, tyCoVarsOfTypeDSet, tyCoVarsOfTypes, tyCoVarsOfTypesDSet, tyCoFVsBndr, tyCoFVsOfType, tyCoVarsOfTypeList, tyCoFVsOfTypes, tyCoVarsOfTypesList, - closeOverKindsDSet, closeOverKindsFV, + closeOverKindsDSet, closeOverKindsFV, closeOverKindsList, coVarsOfType, coVarsOfTypes, coVarsOfCo, coVarsOfCos, tyCoVarsOfCo, tyCoVarsOfCos, @@ -1523,6 +1523,11 @@ 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 deterministically ordered list. +closeOverKindsList :: [TyVar] -> [TyVar] +closeOverKindsList tvs = fvVarList $ closeOverKindsFV tvs + +-- | Add the kind variables free in the kinds of the tyvars in the given set. -- Returns a deterministic set. closeOverKindsDSet :: DTyVarSet -> DTyVarSet closeOverKindsDSet = fvDVarSet . closeOverKindsFV . dVarSetElems diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index 321797b6ab..42f91101eb 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -119,7 +119,7 @@ module Type ( tyCoVarsOfType, tyCoVarsOfTypes, tyCoFVsOfType, tyCoVarsOfTypeDSet, coVarsOfType, - coVarsOfTypes, closeOverKinds, + coVarsOfTypes, closeOverKinds, closeOverKindsList, splitVisVarsOfType, splitVisVarsOfTypes, expandTypeSynonyms, typeSize, |