Get rid of varSetElemsWellScoped in abstractFloats
authorBartosz Nitka <niteria@gmail.com>
Fri, 22 Apr 2016 16:47:30 +0000 (09:47 -0700)
committerBartosz Nitka <niteria@gmail.com>
Fri, 22 Apr 2016 16:49:37 +0000 (09:49 -0700)
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

compiler/coreSyn/CoreFVs.hs
compiler/simplCore/SimplUtils.hs
compiler/types/TyCoRep.hs
compiler/types/Type.hs

index 660538c..084ed65 100644 (file)
@@ -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]
index 0e40343..48dce1d 100644 (file)
@@ -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
index 1ca1efb..b1aad56 100644 (file)
@@ -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
index 321797b..42f9110 100644 (file)
@@ -119,7 +119,7 @@ module Type (
         tyCoVarsOfType, tyCoVarsOfTypes, tyCoFVsOfType,
         tyCoVarsOfTypeDSet,
         coVarsOfType,
-        coVarsOfTypes, closeOverKinds,
+        coVarsOfTypes, closeOverKinds, closeOverKindsList,
         splitVisVarsOfType, splitVisVarsOfTypes,
         expandTypeSynonyms,
         typeSize,