[commit: ghc] wip/ghc-8.0-det: Kill varSetElems try_tyvar_defaulting (9d2e414)
git at git.haskell.org
git at git.haskell.org
Mon Jul 18 17:57:55 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/ghc-8.0-det
Link : http://ghc.haskell.org/trac/ghc/changeset/9d2e414c8df15c1e0112e207f4a4e4bd031c2d66/ghc
>---------------------------------------------------------------
commit 9d2e414c8df15c1e0112e207f4a4e4bd031c2d66
Author: Bartosz Nitka <niteria at gmail.com>
Date: Tue Apr 26 09:51:26 2016 -0700
Kill varSetElems try_tyvar_defaulting
`varSetElems` introduces unnecessary nondeterminism and we can do
the same thing deterministically for the same price.
Test Plan: ./validate
Reviewers: goldfire, austin, simonmar, bgamari, simonpj
Reviewed By: simonpj
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2143
GHC Trac Issues: #4012
>---------------------------------------------------------------
9d2e414c8df15c1e0112e207f4a4e4bd031c2d66
compiler/typecheck/TcMType.hs | 7 +++++++
compiler/typecheck/TcRnTypes.hs | 37 +++++++++++++++++++++++++++----------
compiler/typecheck/TcSMonad.hs | 4 ++++
compiler/typecheck/TcSimplify.hs | 5 ++---
4 files changed, 40 insertions(+), 13 deletions(-)
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index 5fefa2b..5fa0bc9 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -68,6 +68,7 @@ module TcMType (
tidyEvVar, tidyCt, tidySkolemInfo,
skolemiseUnboundMetaTyVar,
zonkTcTyVar, zonkTcTyVars, zonkTyCoVarsAndFV, zonkTcTypeAndFV,
+ zonkTyCoVarsAndFVList,
zonkTcTypeAndSplitDepVars, zonkTcTypesAndSplitDepVars,
zonkQuantifiedTyVar, zonkQuantifiedTyVarOrType,
quantifyTyVars, quantifyZonkedTyVars,
@@ -1202,6 +1203,12 @@ zonkTyCoVar tv | isTcTyVar tv = zonkTcTyVar tv
zonkTyCoVarsAndFV :: TyCoVarSet -> TcM TyCoVarSet
zonkTyCoVarsAndFV tycovars = tyCoVarsOfTypes <$> mapM zonkTyCoVar (varSetElems tycovars)
+-- Takes a list of TyCoVars, zonks them and returns a
+-- deterministically ordered list of their free variables.
+zonkTyCoVarsAndFVList :: [TyCoVar] -> TcM [TyCoVar]
+zonkTyCoVarsAndFVList tycovars =
+ tyCoVarsOfTypesList <$> mapM zonkTyCoVar tycovars
+
-- Takes a deterministic set of TyCoVars, zonks them and returns a
-- deterministic set of their free variables.
-- See Note [quantifyTyVars determinism].
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index dccfd40..4755f8d 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -85,6 +85,7 @@ module TcRnTypes(
andWC, unionsWC, mkSimpleWC, mkImplicWC,
addInsols, addSimples, addImplics,
tyCoVarsOfWC, dropDerivedWC, dropDerivedSimples, dropDerivedInsols,
+ tyCoVarsOfWCList,
isDroppableDerivedLoc, insolubleImplic,
arisesFromGivens,
@@ -1608,22 +1609,38 @@ tyCoVarsOfCtsList = fvVarList . tyCoFVsOfCts
tyCoFVsOfCts :: Cts -> FV
tyCoFVsOfCts = foldrBag (unionFV . tyCoFVsOfCt) emptyFV
+-- | Returns free variables of WantedConstraints as a non-deterministic
+-- set. See Note [Deterministic FV] in FV.
tyCoVarsOfWC :: WantedConstraints -> TyCoVarSet
-- Only called on *zonked* things, hence no need to worry about flatten-skolems
-tyCoVarsOfWC (WC { wc_simple = simple, wc_impl = implic, wc_insol = insol })
- = tyCoVarsOfCts simple `unionVarSet`
- tyCoVarsOfBag tyCoVarsOfImplic implic `unionVarSet`
- tyCoVarsOfCts insol
+tyCoVarsOfWC = fvVarSet . tyCoFVsOfWC
+
+-- | Returns free variables of WantedConstraints as a deterministically
+-- ordered list. See Note [Deterministic FV] in FV.
+tyCoVarsOfWCList :: WantedConstraints -> [TyCoVar]
+-- Only called on *zonked* things, hence no need to worry about flatten-skolems
+tyCoVarsOfWCList = fvVarList . tyCoFVsOfWC
-tyCoVarsOfImplic :: Implication -> TyCoVarSet
+-- | Returns free variables of WantedConstraints as a composable FV
+-- computation. See Note [Deterministic FV] in FV.
+tyCoFVsOfWC :: WantedConstraints -> FV
+-- Only called on *zonked* things, hence no need to worry about flatten-skolems
+tyCoFVsOfWC (WC { wc_simple = simple, wc_impl = implic, wc_insol = insol })
+ = tyCoFVsOfCts simple `unionFV`
+ tyCoFVsOfBag tyCoFVsOfImplic implic `unionFV`
+ tyCoFVsOfCts insol
+
+-- | Returns free variables of Implication as a composable FV computation.
+-- See Note [Deterministic FV] in FV.
+tyCoFVsOfImplic :: Implication -> FV
-- Only called on *zonked* things, hence no need to worry about flatten-skolems
-tyCoVarsOfImplic (Implic { ic_skols = skols
+tyCoFVsOfImplic (Implic { ic_skols = skols
, ic_given = givens, ic_wanted = wanted })
- = (tyCoVarsOfWC wanted `unionVarSet` tyCoVarsOfTypes (map evVarPred givens))
- `delVarSetList` skols
+ = FV.delFVs (mkVarSet skols)
+ (tyCoFVsOfWC wanted `unionFV` tyCoFVsOfTypes (map evVarPred givens))
-tyCoVarsOfBag :: (a -> TyCoVarSet) -> Bag a -> TyCoVarSet
-tyCoVarsOfBag tvs_of = foldrBag (unionVarSet . tvs_of) emptyVarSet
+tyCoFVsOfBag :: (a -> FV) -> Bag a -> FV
+tyCoFVsOfBag tvs_of = foldrBag (unionFV . tvs_of) emptyFV
--------------------------
dropDerivedSimples :: Cts -> Cts
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index ad86f7f..afd199f 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -93,6 +93,7 @@ module TcSMonad (
TcLevel, isTouchableMetaTyVarTcS,
isFilledMetaTyVar_maybe, isFilledMetaTyVar,
zonkTyCoVarsAndFV, zonkTcType, zonkTcTypes, zonkTcTyVar, zonkCo,
+ zonkTyCoVarsAndFVList,
zonkSimples, zonkWC,
-- References
@@ -2756,6 +2757,9 @@ isFilledMetaTyVar tv = wrapTcS (TcM.isFilledMetaTyVar tv)
zonkTyCoVarsAndFV :: TcTyCoVarSet -> TcS TcTyCoVarSet
zonkTyCoVarsAndFV tvs = wrapTcS (TcM.zonkTyCoVarsAndFV tvs)
+zonkTyCoVarsAndFVList :: [TcTyCoVar] -> TcS [TcTyCoVar]
+zonkTyCoVarsAndFVList tvs = wrapTcS (TcM.zonkTyCoVarsAndFVList tvs)
+
zonkCo :: Coercion -> TcS Coercion
zonkCo = wrapTcS . TcM.zonkCo
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index e22a5f6..39923cf 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -130,9 +130,8 @@ simpl_top wanteds
| isEmptyWC wc
= return wc
| otherwise
- = do { free_tvs <- TcS.zonkTyCoVarsAndFV (tyCoVarsOfWC wc)
- ; let meta_tvs = varSetElems $
- filterVarSet (isTyVar <&&> isMetaTyVar) free_tvs
+ = do { free_tvs <- TcS.zonkTyCoVarsAndFVList (tyCoVarsOfWCList wc)
+ ; let meta_tvs = filter (isTyVar <&&> isMetaTyVar) free_tvs
-- zonkTyCoVarsAndFV: the wc_first_go is not yet zonked
-- filter isMetaTyVar: we might have runtime-skolems in GHCi,
-- and we definitely don't want to try to assign to those!
More information about the ghc-commits
mailing list