| isEmptyBag ws = tvs
| otherwise = fixVarSet (\tvs -> foldrBag (growWantedEV gbl_tvs) tvs ws) tvs
+growEvVar :: TyVarSet -> EvVar -> TyVarSet -> TyVarSet
growWantedEV :: TyVarSet -> WantedEvVar -> TyVarSet -> TyVarSet
growWanted :: TyVarSet -> WantedConstraint -> TyVarSet -> TyVarSet
-- (growX gbls wanted tvs) grows a seed 'tvs' against the
-- X-constraint 'wanted', nuking the 'gbls' at each stage
-growWantedEV gbl_tvs wev tvs
+
+growEvVar gbl_tvs ev tvs
= tvs `unionVarSet` (ev_tvs `minusVarSet` gbl_tvs)
where
- ev_tvs = growPredTyVars (wantedEvVarPred wev) tvs
+ ev_tvs = growPredTyVars (evVarPred ev) tvs
+
+growWantedEV gbl_tvs wev tvs = growEvVar gbl_tvs (wantedEvVarToVar wev) tvs
growWanted gbl_tvs (WcEvVar wev) tvs
= growWantedEV gbl_tvs wev tvs
growWanted gbl_tvs (WcImplic implic) tvs
- = foldrBag (growWanted (gbl_tvs `unionVarSet` ic_skols implic))
- tvs (ic_wanted implic)
+ = foldrBag (growWanted inner_gbl_tvs)
+ (foldr (growEvVar inner_gbl_tvs) tvs (ic_given implic))
+ -- Must grow over inner givens too
+ (ic_wanted implic)
+ where
+ inner_gbl_tvs = gbl_tvs `unionVarSet` ic_skols implic
--------------------
quantifyMe :: TyVarSet -- Quantifying over these
pred = wantedEvVarPred wev
quantifyMeWC :: TyVarSet -> WantedConstraint -> Bool
+-- False => we can *definitely* float the WantedConstraint out
quantifyMeWC qtvs (WcImplic implic)
- = anyBag (quantifyMeWC (qtvs `minusVarSet` ic_skols implic)) (ic_wanted implic)
+ = (tyVarsOfEvVars (ic_given implic) `intersectsVarSet` inner_qtvs)
+ || anyBag (quantifyMeWC inner_qtvs) (ic_wanted implic)
+ where
+ inner_qtvs = qtvs `minusVarSet` ic_skols implic
+
quantifyMeWC qtvs (WcEvVar wev)
= quantifyMe qtvs wev
\end{code}
, ic_wanted = wanteds
, ic_loc = loc })
= nestImplicTcS ev_binds untch $
+ recoverTcS (return (emptyBag, emptyBag)) $
+ -- Recover from nested failures. Even the top level is
+ -- just a bunch of implications, so failing at the first
+ -- one is bad
do { traceTcS "solveImplication {" (ppr imp)
-- Solve flat givens