X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSimplify.lhs;h=0e7acdd6761197638aaa013a88f2d4069865d9fe;hb=edeee10702955ca3c53444f2f328b4cce0ab3e32;hp=535b5616bde8ffcd136f400ce03c15e74ed91991;hpb=56a437ee698c5a46864e7fcc530707742589ef7d;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index 535b561..0e7acdd 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -236,7 +236,7 @@ simplifyAsMuchAsPossible ctxt wanteds simplifyApproxLoop 0 wanteds -- Report any errors - ; mapBagM_ reportUnsolvedImplication unsolved_implics + ; reportUnsolved (emptyBag, unsolved_implics) ; let final_wanted_evvars = mapBag deCanonicaliseWanted unsolved_flats ; return (final_wanted_evvars, ev_binds) } @@ -676,7 +676,7 @@ floatEqualities :: TcTyVarSet -> [EvVar] -> CanonicalCts -> (CanonicalCts, CanonicalCts) floatEqualities skols can_given wanteds | hasEqualities can_given = (emptyBag, wanteds) - | otherwise = partitionBag is_floatable wanteds + | otherwise = partitionBag is_floatable wanteds where is_floatable :: CanonicalCt -> Bool is_floatable (CTyEqCan { cc_tyvar = tv, cc_rhs = ty }) @@ -787,7 +787,8 @@ defaultTyVar untch the_tv , not (the_tv `elemVarSet` untch) , not (k `eqKind` default_k) = do { (ev, better_ty) <- TcSMonad.newKindConstraint (mkTyVarTy the_tv) default_k - ; let loc = CtLoc TypeEqOrigin (getSrcSpan the_tv) [] -- Yuk + ; let loc = CtLoc DefaultOrigin (getSrcSpan the_tv) [] -- Yuk + -- 'DefaultOrigin' is strictly the declaration, but it's convenient wanted_eq = CTyEqCan { cc_id = ev , cc_flavor = Wanted loc , cc_tyvar = the_tv