[commit: ghc] wip/ghc-8.0-det: Get rid of varSetElemsWellScoped in abstractFloats (085f449)
git at git.haskell.org
git at git.haskell.org
Mon Jul 25 14:58:06 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/ghc-8.0-det
Link : http://ghc.haskell.org/trac/ghc/changeset/085f44923b163b022e3b156e732d95740be712e7/ghc
>---------------------------------------------------------------
commit 085f44923b163b022e3b156e732d95740be712e7
Author: Bartosz Nitka <niteria at gmail.com>
Date: Fri Apr 22 09:47:30 2016 -0700
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
(cherry picked from commit 03006f5ef2daedbbb7b0932b2c0e265f097cf2bf)
>---------------------------------------------------------------
085f44923b163b022e3b156e732d95740be712e7
compiler/coreSyn/CoreFVs.hs | 9 ++++++++-
compiler/simplCore/SimplUtils.hs | 8 ++++----
compiler/types/TyCoRep.hs | 7 ++++++-
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 660538c..084ed65 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 266a051..a3eb357 100644
--- a/compiler/simplCore/SimplUtils.hs
+++ b/compiler/simplCore/SimplUtils.hs
@@ -1573,10 +1573,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 2295cac..7054ed5 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,
@@ -1405,6 +1405,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 774db35..36cdf06 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -120,7 +120,7 @@ module Type (
tyCoVarsOfType, tyCoVarsOfTypes, tyCoFVsOfType,
tyCoVarsOfTypeDSet,
coVarsOfType,
- coVarsOfTypes, closeOverKinds,
+ coVarsOfTypes, closeOverKinds, closeOverKindsList,
splitDepVarsOfType, splitDepVarsOfTypes,
splitVisVarsOfType, splitVisVarsOfTypes,
expandTypeSynonyms,
More information about the ghc-commits
mailing list