[commit: ghc] wip/ghc-8.0-det: Remove some gratitious varSetElemsWellScoped (429b97c)
git at git.haskell.org
git at git.haskell.org
Thu Jul 14 13:53:09 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/ghc-8.0-det
Link : http://ghc.haskell.org/trac/ghc/changeset/429b97c66fd8291178d76f43ecba7878dcef5c9c/ghc
>---------------------------------------------------------------
commit 429b97c66fd8291178d76f43ecba7878dcef5c9c
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
>---------------------------------------------------------------
429b97c66fd8291178d76f43ecba7878dcef5c9c
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 9b9a22b..03f593c 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