summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBartosz Nitka <niteria@gmail.com>2016-04-15 04:48:45 -0700
committerBartosz Nitka <niteria@gmail.com>2016-07-25 07:12:25 -0700
commita082cd3493bd53d52151c7f5faa34424f6c2f695 (patch)
treeebddd9dadfcd98ecd72b0a043ab77b12829ec735
parent7bfc8c039bd4f4ac82f919e6229660013afdec42 (diff)
downloadhaskell-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.hs13
-rw-r--r--compiler/typecheck/TcDeriv.hs8
-rw-r--r--compiler/typecheck/TcGenGenerics.hs12
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'