[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