summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBartosz Nitka <niteria@gmail.com>2016-04-22 09:47:30 -0700
committerBartosz Nitka <niteria@gmail.com>2016-04-22 09:49:37 -0700
commit03006f5ef2daedbbb7b0932b2c0e265f097cf2bf (patch)
tree1df90ecec5eece17bb153aac90abd28fd3b82e4a
parent0f96686b10fd36d479a54c71a6e1753193e85347 (diff)
downloadhaskell-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.hs9
-rw-r--r--compiler/simplCore/SimplUtils.hs8
-rw-r--r--compiler/types/TyCoRep.hs7
-rw-r--r--compiler/types/Type.hs2
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,