diff options
author | Bartosz Nitka <niteria@gmail.com> | 2016-04-15 04:48:45 -0700 |
---|---|---|
committer | Bartosz Nitka <niteria@gmail.com> | 2016-07-25 07:12:25 -0700 |
commit | a082cd3493bd53d52151c7f5faa34424f6c2f695 (patch) | |
tree | ebddd9dadfcd98ecd72b0a043ab77b12829ec735 | |
parent | 7bfc8c039bd4f4ac82f919e6229660013afdec42 (diff) | |
download | haskell-a082cd3493bd53d52151c7f5faa34424f6c2f695.tar.gz |
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
(cherry picked from commit 31e49746a5f2193e3a2161ea6e279e95b9068048)
-rw-r--r-- | compiler/typecheck/TcClassDcl.hs | 13 | ||||
-rw-r--r-- | compiler/typecheck/TcDeriv.hs | 8 | ||||
-rw-r--r-- | 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 602ef64d86..48b0e56baf 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 9b9a22b283..03f593ccc9 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 03b4d65c6f..ebe9303455 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' |