Commit 94320e1d authored by niteria's avatar niteria

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
parent 2dc5b92e
......@@ -68,6 +68,7 @@ module TcMType (
tidyEvVar, tidyCt, tidySkolemInfo,
skolemiseUnboundMetaTyVar,
zonkTcTyVar, zonkTcTyVars, zonkTyCoVarsAndFV, zonkTcTypeAndFV,
zonkTyCoVarsAndFVList,
zonkTcTypeAndSplitDepVars, zonkTcTypesAndSplitDepVars,
zonkQuantifiedTyVar, zonkQuantifiedTyVarOrType,
quantifyTyVars, quantifyZonkedTyVars,
......@@ -1219,6 +1220,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].
......
......@@ -85,6 +85,7 @@ module TcRnTypes(
andWC, unionsWC, mkSimpleWC, mkImplicWC,
addInsols, addSimples, addImplics,
tyCoVarsOfWC, dropDerivedWC, dropDerivedSimples, dropDerivedInsols,
tyCoVarsOfWCList,
isDroppableDerivedLoc, insolubleImplic,
arisesFromGivens,
......@@ -1612,22 +1613,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
......
......@@ -93,6 +93,7 @@ module TcSMonad (
TcLevel, isTouchableMetaTyVarTcS,
isFilledMetaTyVar_maybe, isFilledMetaTyVar,
zonkTyCoVarsAndFV, zonkTcType, zonkTcTypes, zonkTcTyVar, zonkCo,
zonkTyCoVarsAndFVList,
zonkSimples, zonkWC,
-- References
......@@ -2762,6 +2763,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
......
......@@ -122,9 +122,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!
......
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