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 ( ...@@ -68,6 +68,7 @@ module TcMType (
tidyEvVar, tidyCt, tidySkolemInfo, tidyEvVar, tidyCt, tidySkolemInfo,
skolemiseUnboundMetaTyVar, skolemiseUnboundMetaTyVar,
zonkTcTyVar, zonkTcTyVars, zonkTyCoVarsAndFV, zonkTcTypeAndFV, zonkTcTyVar, zonkTcTyVars, zonkTyCoVarsAndFV, zonkTcTypeAndFV,
zonkTyCoVarsAndFVList,
zonkTcTypeAndSplitDepVars, zonkTcTypesAndSplitDepVars, zonkTcTypeAndSplitDepVars, zonkTcTypesAndSplitDepVars,
zonkQuantifiedTyVar, zonkQuantifiedTyVarOrType, zonkQuantifiedTyVar, zonkQuantifiedTyVarOrType,
quantifyTyVars, quantifyZonkedTyVars, quantifyTyVars, quantifyZonkedTyVars,
...@@ -1219,6 +1220,12 @@ zonkTyCoVar tv | isTcTyVar tv = zonkTcTyVar tv ...@@ -1219,6 +1220,12 @@ zonkTyCoVar tv | isTcTyVar tv = zonkTcTyVar tv
zonkTyCoVarsAndFV :: TyCoVarSet -> TcM TyCoVarSet zonkTyCoVarsAndFV :: TyCoVarSet -> TcM TyCoVarSet
zonkTyCoVarsAndFV tycovars = tyCoVarsOfTypes <$> mapM zonkTyCoVar (varSetElems tycovars) 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 -- Takes a deterministic set of TyCoVars, zonks them and returns a
-- deterministic set of their free variables. -- deterministic set of their free variables.
-- See Note [quantifyTyVars determinism]. -- See Note [quantifyTyVars determinism].
......
...@@ -85,6 +85,7 @@ module TcRnTypes( ...@@ -85,6 +85,7 @@ module TcRnTypes(
andWC, unionsWC, mkSimpleWC, mkImplicWC, andWC, unionsWC, mkSimpleWC, mkImplicWC,
addInsols, addSimples, addImplics, addInsols, addSimples, addImplics,
tyCoVarsOfWC, dropDerivedWC, dropDerivedSimples, dropDerivedInsols, tyCoVarsOfWC, dropDerivedWC, dropDerivedSimples, dropDerivedInsols,
tyCoVarsOfWCList,
isDroppableDerivedLoc, insolubleImplic, isDroppableDerivedLoc, insolubleImplic,
arisesFromGivens, arisesFromGivens,
...@@ -1612,22 +1613,38 @@ tyCoVarsOfCtsList = fvVarList . tyCoFVsOfCts ...@@ -1612,22 +1613,38 @@ tyCoVarsOfCtsList = fvVarList . tyCoFVsOfCts
tyCoFVsOfCts :: Cts -> FV tyCoFVsOfCts :: Cts -> FV
tyCoFVsOfCts = foldrBag (unionFV . tyCoFVsOfCt) emptyFV tyCoFVsOfCts = foldrBag (unionFV . tyCoFVsOfCt) emptyFV
-- | Returns free variables of WantedConstraints as a non-deterministic
-- set. See Note [Deterministic FV] in FV.
tyCoVarsOfWC :: WantedConstraints -> TyCoVarSet tyCoVarsOfWC :: WantedConstraints -> TyCoVarSet
-- Only called on *zonked* things, hence no need to worry about flatten-skolems -- Only called on *zonked* things, hence no need to worry about flatten-skolems
tyCoVarsOfWC (WC { wc_simple = simple, wc_impl = implic, wc_insol = insol }) tyCoVarsOfWC = fvVarSet . tyCoFVsOfWC
= tyCoVarsOfCts simple `unionVarSet`
tyCoVarsOfBag tyCoVarsOfImplic implic `unionVarSet` -- | Returns free variables of WantedConstraints as a deterministically
tyCoVarsOfCts insol -- 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 -- 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 }) , ic_given = givens, ic_wanted = wanted })
= (tyCoVarsOfWC wanted `unionVarSet` tyCoVarsOfTypes (map evVarPred givens)) = FV.delFVs (mkVarSet skols)
`delVarSetList` skols (tyCoFVsOfWC wanted `unionFV` tyCoFVsOfTypes (map evVarPred givens))
tyCoVarsOfBag :: (a -> TyCoVarSet) -> Bag a -> TyCoVarSet tyCoFVsOfBag :: (a -> FV) -> Bag a -> FV
tyCoVarsOfBag tvs_of = foldrBag (unionVarSet . tvs_of) emptyVarSet tyCoFVsOfBag tvs_of = foldrBag (unionFV . tvs_of) emptyFV
-------------------------- --------------------------
dropDerivedSimples :: Cts -> Cts dropDerivedSimples :: Cts -> Cts
......
...@@ -93,6 +93,7 @@ module TcSMonad ( ...@@ -93,6 +93,7 @@ module TcSMonad (
TcLevel, isTouchableMetaTyVarTcS, TcLevel, isTouchableMetaTyVarTcS,
isFilledMetaTyVar_maybe, isFilledMetaTyVar, isFilledMetaTyVar_maybe, isFilledMetaTyVar,
zonkTyCoVarsAndFV, zonkTcType, zonkTcTypes, zonkTcTyVar, zonkCo, zonkTyCoVarsAndFV, zonkTcType, zonkTcTypes, zonkTcTyVar, zonkCo,
zonkTyCoVarsAndFVList,
zonkSimples, zonkWC, zonkSimples, zonkWC,
-- References -- References
...@@ -2762,6 +2763,9 @@ isFilledMetaTyVar tv = wrapTcS (TcM.isFilledMetaTyVar tv) ...@@ -2762,6 +2763,9 @@ isFilledMetaTyVar tv = wrapTcS (TcM.isFilledMetaTyVar tv)
zonkTyCoVarsAndFV :: TcTyCoVarSet -> TcS TcTyCoVarSet zonkTyCoVarsAndFV :: TcTyCoVarSet -> TcS TcTyCoVarSet
zonkTyCoVarsAndFV tvs = wrapTcS (TcM.zonkTyCoVarsAndFV tvs) zonkTyCoVarsAndFV tvs = wrapTcS (TcM.zonkTyCoVarsAndFV tvs)
zonkTyCoVarsAndFVList :: [TcTyCoVar] -> TcS [TcTyCoVar]
zonkTyCoVarsAndFVList tvs = wrapTcS (TcM.zonkTyCoVarsAndFVList tvs)
zonkCo :: Coercion -> TcS Coercion zonkCo :: Coercion -> TcS Coercion
zonkCo = wrapTcS . TcM.zonkCo zonkCo = wrapTcS . TcM.zonkCo
......
...@@ -122,9 +122,8 @@ simpl_top wanteds ...@@ -122,9 +122,8 @@ simpl_top wanteds
| isEmptyWC wc | isEmptyWC wc
= return wc = return wc
| otherwise | otherwise
= do { free_tvs <- TcS.zonkTyCoVarsAndFV (tyCoVarsOfWC wc) = do { free_tvs <- TcS.zonkTyCoVarsAndFVList (tyCoVarsOfWCList wc)
; let meta_tvs = varSetElems $ ; let meta_tvs = filter (isTyVar <&&> isMetaTyVar) free_tvs
filterVarSet (isTyVar <&&> isMetaTyVar) free_tvs
-- zonkTyCoVarsAndFV: the wc_first_go is not yet zonked -- zonkTyCoVarsAndFV: the wc_first_go is not yet zonked
-- filter isMetaTyVar: we might have runtime-skolems in GHCi, -- filter isMetaTyVar: we might have runtime-skolems in GHCi,
-- and we definitely don't want to try to assign to those! -- 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