import Inst
import Var
import VarSet
+import VarEnv ( varEnvElts )
+
import Name
import NameEnv ( emptyNameEnv )
import Bag
zonked_tau_tvs `minusVarSet` gbl_tvs
(perhaps_bound, surely_free)
= partitionBag (quantifyMeWC proto_qtvs) zonked_wanted
+
; emitConstraints surely_free
- ; traceTc "sinf" (ppr proto_qtvs $$ ppr perhaps_bound $$ ppr surely_free)
+ ; traceTc "sinf" $ vcat
+ [ ptext (sLit "perhaps_bound =") <+> ppr perhaps_bound
+ , ptext (sLit "surely_free =") <+> ppr surely_free
+ ]
-- Now simplify the possibly-bound constraints
; (simplified_perhaps_bound, tc_binds)
, text "inert =" <+> ppr inert ]
; (unsolved_flats, unsolved_implics)
<- simpl_loop 1 can_flats implic_wanteds
+ ; bb <- getTcEvBindsBag
; traceTcS "solveWanteds }" $
vcat [ text "wanteds =" <+> ppr wanteds
, text "unsolved_flats =" <+> ppr unsolved_flats
- , text "unsolved_implics =" <+> ppr unsolved_implics ]
+ , text "unsolved_implics =" <+> ppr unsolved_implics
+ , text "current evbinds =" <+> vcat (map ppr (varEnvElts bb))
+ ]
; return (unsolved_flats, unsolved_implics) }
where
simpl_loop :: Int
, 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
| otherwise
= do { untch <- getUntouchables
; tv_cts <- mapM (defaultTyVar untch) $
- varSetElems (tyVarsOfCanonicals wanteds)
+ varSetElems (tyVarsOfCDicts wanteds)
; info@(_, default_tys, _) <- getDefaultInfo
; let groups = findDefaultableGroups info untch wanteds
-- whatever, because the type-class defaulting rules have yet to run.
defaultTyVar untch the_tv
- | isMetaTyVar the_tv
- , inTouchableRange untch the_tv
+ | isTouchableMetaTyVar_InRange untch the_tv
, not (k `eqKind` default_k)
- = do { (ev, better_ty) <- TcSMonad.newKindConstraint (mkTyVarTy the_tv) default_k
+ = do { (ev, better_ty) <- TcSMonad.newKindConstraint the_tv default_k
; let loc = CtLoc DefaultOrigin (getSrcSpan the_tv) [] -- Yuk
-- 'DefaultOrigin' is strictly the declaration, but it's convenient
wanted_eq = CTyEqCan { cc_id = ev
is_defaultable_group ds@((_,tv):_)
= isTyConableTyVar tv -- Note [Avoiding spurious errors]
&& not (tv `elemVarSet` bad_tvs)
- && inTouchableRange untch tv
+ && isTouchableMetaTyVar_InRange untch tv
&& defaultable_classes [cc_class cc | (cc,_) <- ds]
is_defaultable_group [] = panic "defaultable_group"