diff options
| -rw-r--r-- | compiler/GHC/Tc/Errors.hs | 1 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Gen/Default.hs | 9 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Solver.hs | 5 |
3 files changed, 7 insertions, 8 deletions
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs index 4f7c9dfea2..fe4e5a341f 100644 --- a/compiler/GHC/Tc/Errors.hs +++ b/compiler/GHC/Tc/Errors.hs @@ -167,7 +167,6 @@ reportUnsolved wanted -- See Note [Deferring coercion errors to runtime] -- Used by solveEqualities for kind equalities -- (see Note [Fail fast on kind errors] in "GHC.Tc.Solver") --- and for simplifyDefault. reportAllUnsolved :: WantedConstraints -> TcM () reportAllUnsolved wanted = do { ev_binds <- newNoTcEvBinds diff --git a/compiler/GHC/Tc/Gen/Default.hs b/compiler/GHC/Tc/Gen/Default.hs index d37f26df40..0a50f3e983 100644 --- a/compiler/GHC/Tc/Gen/Default.hs +++ b/compiler/GHC/Tc/Gen/Default.hs @@ -12,6 +12,7 @@ import GHC.Prelude import GHC.Hs import GHC.Core.Class +import GHC.Core.Type (typeKind) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Env import GHC.Tc.Gen.HsType @@ -85,10 +86,10 @@ check_instance :: Type -> Class -> TcM Bool -- Check that ty is an instance of cls -- We only care about whether it worked or not; return a boolean check_instance ty cls - = do { (_, success) <- discardErrs $ - askNoErrs $ - simplifyDefault [mkClassPred cls [ty]] - ; return success } + | eqType (typeKind $ mkTyConTy $ classTyCon cls) + (mkVisFunTyMany (typeKind ty) constraintKind) + = simplifyDefault [mkClassPred cls [ty]] + | otherwise = return False defaultDeclCtxt :: SDoc defaultDeclCtxt = text "When checking the types in a default declaration" diff --git a/compiler/GHC/Tc/Solver.hs b/compiler/GHC/Tc/Solver.hs index 991708111d..3a5d771a88 100644 --- a/compiler/GHC/Tc/Solver.hs +++ b/compiler/GHC/Tc/Solver.hs @@ -757,13 +757,12 @@ simplifyInteractive wanteds ------------------ simplifyDefault :: ThetaType -- Wanted; has no type variables in it - -> TcM () -- Succeeds if the constraint is soluble + -> TcM Bool -- Return if the constraint is soluble simplifyDefault theta = do { traceTc "simplifyDefault" empty ; wanteds <- newWanteds DefaultOrigin theta ; unsolved <- runTcSDeriveds (solveWantedsAndDrop (mkSimpleWC wanteds)) - ; reportAllUnsolved unsolved - ; return () } + ; return (isEmptyWC unsolved) } ------------------ tcCheckSatisfiability :: InertSet -> Bag EvVar -> TcM (Maybe InertSet) |