Fix a buglet in redundant-constraint warnings

Ticket #18036 pointed out that we were reporting a redundant
constraint when it really really wasn't.

Turned out to be a buglet in the SkolemInfo for the
relevant implication constraint.  Easily fixed!

1 files changed, 10 insertions, 3 deletions

diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index 83a449461b..0b9e313ce5 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -1719,19 +1719,26 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind
   | Just hs_sig_ty <- hs_sig_fn sel_name
               -- There is a signature in the instance
               -- See Note [Instance method signatures]
-  = do { let ctxt = FunSigCtxt sel_name True
-       ; (sig_ty, hs_wrap)
+  = do { (sig_ty, hs_wrap)
              <- setSrcSpan (getLoc (hsSigType hs_sig_ty)) $
                 do { inst_sigs <- xoptM LangExt.InstanceSigs
                    ; checkTc inst_sigs (misplacedInstSig sel_name hs_sig_ty)
                    ; sig_ty  <- tcHsSigType (FunSigCtxt sel_name False) hs_sig_ty
                    ; let local_meth_ty = idType local_meth_id
+                         ctxt = FunSigCtxt sel_name False
+                                -- False <=> do not report redundant constraints when
+                                --           checking instance-sig <= class-meth-sig
+                                -- The instance-sig is the focus here; the class-meth-sig
+                                -- is fixed (#18036)
                    ; hs_wrap <- addErrCtxtM (methSigCtxt sel_name sig_ty local_meth_ty) $
                                 tcSubType_NC ctxt sig_ty local_meth_ty
                    ; return (sig_ty, hs_wrap) }
 
        ; inner_meth_name <- newName (nameOccName sel_name)
-       ; let inner_meth_id  = mkLocalId inner_meth_name sig_ty
+       ; let ctxt = FunSigCtxt sel_name True
+                    -- True <=> check for redundant constraints in the
+                    --          user-specified instance signature
+             inner_meth_id  = mkLocalId inner_meth_name sig_ty
              inner_meth_sig = CompleteSig { sig_bndr = inner_meth_id
                                           , sig_ctxt = ctxt
                                           , sig_loc  = getLoc (hsSigType hs_sig_ty) }