Commit 31e49746 authored by niteria's avatar niteria

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
parent e24b3b1e
......@@ -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'
......
......@@ -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 ]
......
......@@ -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'
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment