[commit: ghc] master: Remove some gratitious varSetElemsWellScoped (31e4974)

git at git.haskell.org git at git.haskell.org
Fri Apr 15 13:27:50 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/31e49746a5f2193e3a2161ea6e279e95b9068048/ghc

>---------------------------------------------------------------

commit 31e49746a5f2193e3a2161ea6e279e95b9068048
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Fri Apr 15 04:48:45 2016 -0700

    Remove some gratitious varSetElemsWellScoped
    
    Summary:
    `varSetElemsWellScoped` uses `varSetElems` under the hood which
    introduces unnecessary nondeterminism.
    This does the same thing, possibly cheaper, while preserving
    determinism.
    
    Test Plan: ./validate
    
    Reviewers: simonmar, goldfire, austin, bgamari, simonpj
    
    Reviewed By: simonpj
    
    Subscribers: thomie, RyanGlScott
    
    Differential Revision: https://phabricator.haskell.org/D2116
    
    GHC Trac Issues: #4012


>---------------------------------------------------------------

31e49746a5f2193e3a2161ea6e279e95b9068048
 compiler/typecheck/TcClassDcl.hs    | 13 ++++++-------
 compiler/typecheck/TcDeriv.hs       |  8 ++++----
 compiler/typecheck/TcGenGenerics.hs | 12 ++++++------
 3 files changed, 16 insertions(+), 17 deletions(-)

diff --git a/compiler/typecheck/TcClassDcl.hs b/compiler/typecheck/TcClassDcl.hs
index 602ef64..48b0e56 100644
--- a/compiler/typecheck/TcClassDcl.hs
+++ b/compiler/typecheck/TcClassDcl.hs
@@ -26,7 +26,7 @@ import TcBinds
 import TcUnify
 import TcHsType
 import TcMType
-import Type     ( getClassPredTys_maybe, varSetElemsWellScoped, piResultTys )
+import Type     ( getClassPredTys_maybe, piResultTys )
 import TcType
 import TcRnMonad
 import BuildTyCl( TcMethInfo )
@@ -41,7 +41,6 @@ import NameEnv
 import NameSet
 import Var
 import VarEnv
-import VarSet
 import Outputable
 import SrcLoc
 import TyCon
@@ -53,7 +52,7 @@ import BooleanFormula
 import Util
 
 import Control.Monad
-import Data.List ( mapAccumL )
+import Data.List ( mapAccumL, partition )
 
 {-
 Dictionary handling
@@ -454,10 +453,10 @@ tcATDefault emit_warn loc inst_subst defined_ats (ATI fam_tc defs)
   = do { let (subst', pat_tys') = mapAccumL subst_tv inst_subst
                                             (tyConTyVars fam_tc)
              rhs'     = substTyUnchecked subst' rhs_ty
-             tcv_set' = tyCoVarsOfTypes pat_tys'
-             (tv_set', cv_set') = partitionVarSet isTyVar tcv_set'
-             tvs'     = varSetElemsWellScoped tv_set'
-             cvs'     = varSetElemsWellScoped cv_set'
+             tcv' = tyCoVarsOfTypesList pat_tys'
+             (tv', cv') = partition isTyVar tcv'
+             tvs'     = toposortTyVars tv'
+             cvs'     = toposortTyVars cv'
        ; rep_tc_name <- newFamInstTyConName (L loc (tyConName fam_tc)) pat_tys'
        ; let axiom = mkSingleCoAxiom Nominal rep_tc_name tvs' cvs'
                                      fam_tc pat_tys' rhs'
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index d3c9295..d88686f 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -1586,7 +1586,7 @@ mkNewTypeEqn dflags overlap_mode tvs
        case mtheta of
         Just theta -> return $ GivenTheta $ DS
             { ds_loc = loc
-            , ds_name = dfun_name, ds_tvs = varSetElemsWellScoped dfun_tvs
+            , ds_name = dfun_name, ds_tvs = dfun_tvs
             , ds_cls = cls, ds_tys = inst_tys
             , ds_tc = rep_tycon
             , ds_theta = theta
@@ -1594,7 +1594,7 @@ mkNewTypeEqn dflags overlap_mode tvs
             , ds_newtype = Just rep_inst_ty }
         Nothing -> return $ InferTheta $ DS
             { ds_loc = loc
-            , ds_name = dfun_name, ds_tvs = varSetElemsWellScoped dfun_tvs
+            , ds_name = dfun_name, ds_tvs = dfun_tvs
             , ds_cls = cls, ds_tys = inst_tys
             , ds_tc = rep_tycon
             , ds_theta = all_preds
@@ -1689,7 +1689,7 @@ mkNewTypeEqn dflags overlap_mode tvs
         -- Next we figure out what superclass dictionaries to use
         -- See Note [Newtype deriving superclasses] above
         cls_tyvars = classTyVars cls
-        dfun_tvs   = tyCoVarsOfTypes inst_tys
+        dfun_tvs   = tyCoVarsOfTypesWellScoped inst_tys
         inst_ty    = mkTyConApp tycon tc_args
         inst_tys   = cls_tys ++ [inst_ty]
         sc_theta   = mkThetaOrigin DerivOrigin TypeLevel $
@@ -1701,7 +1701,7 @@ mkNewTypeEqn dflags overlap_mode tvs
         -- newtype type; precisely the constraints required for the
         -- calls to coercible that we are going to generate.
         coercible_constraints =
-            [ let (Pair t1 t2) = mkCoerceClassMethEqn cls (varSetElemsWellScoped dfun_tvs) inst_tys rep_inst_ty meth
+            [ let (Pair t1 t2) = mkCoerceClassMethEqn cls dfun_tvs inst_tys rep_inst_ty meth
               in mkPredOrigin (DerivOriginCoerce meth t1 t2) TypeLevel
                               (mkReprPrimEqPred t1 t2)
             | meth <- classMethods cls ]
diff --git a/compiler/typecheck/TcGenGenerics.hs b/compiler/typecheck/TcGenGenerics.hs
index 03b4d65..ebe9303 100644
--- a/compiler/typecheck/TcGenGenerics.hs
+++ b/compiler/typecheck/TcGenGenerics.hs
@@ -37,13 +37,13 @@ import ErrUtils( Validity(..), andValid )
 import SrcLoc
 import Bag
 import VarEnv
-import VarSet (elemVarSet, partitionVarSet)
+import VarSet (elemVarSet)
 import Outputable
 import FastString
 import Util
 
 import Control.Monad (mplus)
-import Data.List (zip4)
+import Data.List (zip4, partition)
 import Data.Maybe (isJust)
 
 #include "HsVersions.h"
@@ -395,10 +395,10 @@ tc_mkRepFamInsts gk tycon inst_ty mod =
            in_scope = mkInScopeSet (tyCoVarsOfType inst_ty)
            subst    = mkTvSubst in_scope env
            repTy'   = substTy  subst repTy
-           tcv_set' = tyCoVarsOfType inst_ty
-           (tv_set', cv_set') = partitionVarSet isTyVar tcv_set'
-           tvs'     = varSetElemsWellScoped tv_set'
-           cvs'     = varSetElemsWellScoped cv_set'
+           tcv' = tyCoVarsOfTypeList inst_ty
+           (tv', cv') = partition isTyVar tcv'
+           tvs'     = toposortTyVars tv'
+           cvs'     = toposortTyVars cv'
            axiom    = mkSingleCoAxiom Nominal rep_name tvs' cvs'
                                       fam_tc [inst_ty] repTy'
 



More information about the ghc-commits mailing list