Improving error messageswip/T18126-deep

28 files changed, 183 insertions, 155 deletions

diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 2ef0d62db4..bee21c513f 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -39,6 +39,7 @@ import GHC.Hs.Binds
 -- others:
 import GHC.Tc.Types.Evidence
 import GHC.Core
+import GHC.Types.Id( Id )
 import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Types.Basic
@@ -591,7 +592,6 @@ deriving instance (Data (hs_syn GhcTc), Typeable hs_syn) => Data (HsWrap hs_syn)
 -- ---------------------------------------------------------------------
 
 type instance XVar           (GhcPass _) = NoExtField
-type instance XUnboundVar    (GhcPass _) = NoExtField
 type instance XConLikeOut    (GhcPass _) = NoExtField
 type instance XRecFld        (GhcPass _) = NoExtField
 type instance XOverLabel     (GhcPass _) = NoExtField
@@ -602,6 +602,10 @@ type instance XLam           (GhcPass _) = NoExtField
 type instance XLamCase       (GhcPass _) = NoExtField
 type instance XApp           (GhcPass _) = NoExtField
 
+type instance XUnboundVar    GhcPs = NoExtField
+type instance XUnboundVar    GhcRn = NoExtField
+type instance XUnboundVar    GhcTc = Id
+
 type instance XAppTypeE      GhcPs = NoExtField
 type instance XAppTypeE      GhcRn = NoExtField
 type instance XAppTypeE      GhcTc = Type
@@ -1236,7 +1240,6 @@ isAtomicHsExpr (HsOverLit {})    = True
 isAtomicHsExpr (HsIPVar {})      = True
 isAtomicHsExpr (HsOverLabel {})  = True
 isAtomicHsExpr (HsUnboundVar {}) = True
-isAtomicHsExpr (HsPar _ e)       = isAtomicHsExpr (unLoc e)
 isAtomicHsExpr (HsRecFld{})      = True
 isAtomicHsExpr (XExpr x)
   | GhcTc <- ghcPass @p
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 5739b26319..185c4696e7 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -260,8 +260,8 @@ dsLExprNoLP (L loc e)
 dsExpr :: HsExpr GhcTc -> DsM CoreExpr
 dsExpr (HsPar _ e)            = dsLExpr e
 dsExpr (ExprWithTySig _ e _)  = dsLExpr e
-dsExpr (HsVar _ (L _ var))    = dsHsVar var
-dsExpr (HsUnboundVar {})      = panic "dsExpr: HsUnboundVar" -- Typechecker eliminates them
+dsExpr (HsVar _ (L _ id))     = dsHsVar id
+dsExpr (HsUnboundVar id _)    = dsHsVar id
 dsExpr (HsConLikeOut _ con)   = dsConLike con
 dsExpr (HsIPVar {})           = panic "dsExpr: HsIPVar"
 dsExpr (HsOverLabel{})        = panic "dsExpr: HsOverLabel"
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index c0afde8242..1557a867b7 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -2005,7 +2005,7 @@ patSynErr item l e explanation =
         explanation
      ; return (L l hsHoleExpr) }
 
-hsHoleExpr :: HsExpr (GhcPass id)
+hsHoleExpr :: HsExpr GhcPs
 hsHoleExpr = HsUnboundVar noExtField (mkVarOcc "_")
 
 -- | See Note [Ambiguous syntactic categories] and Note [PatBuilder]
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index 41bc8cd269..e4296d627d 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -1449,8 +1449,8 @@ mkTyVarEqErr dflags ctxt report ct tv1 ty2
        ; mkTyVarEqErr' dflags ctxt report ct tv1 ty2 }
 
 mkTyVarEqErr' dflags ctxt report ct tv1 ty2
-  | isUserSkolem ctxt tv1  -- ty2 won't be a meta-tyvar; we would have
-                           -- swapped in Solver.Canonical.canEqTyVarHomo
+  | isSkolemTyVar tv1  -- ty2 won't be a meta-tyvar; we would have
+                       -- swapped in Solver.Canonical.canEqTyVarHomo
     || isTyVarTyVar tv1 && not (isTyVarTy ty2)
     || ctEqRel ct == ReprEq
      -- The cases below don't really apply to ReprEq (except occurs check)
@@ -1592,6 +1592,7 @@ mkEqInfoMsg ct ty1 ty2
                 <+> text "is a non-injective type family"
               | otherwise = empty
 
+{-
 isUserSkolem :: ReportErrCtxt -> TcTyVar -> Bool
 -- See Note [Reporting occurs-check errors]
 isUserSkolem ctxt tv
@@ -1602,6 +1603,7 @@ isUserSkolem ctxt tv
 
     is_user_skol_info (InferSkol {}) = False
     is_user_skol_info _ = True
+-}
 
 misMatchOrCND :: Bool -> ReportErrCtxt -> Ct
               -> TcType -> TcType -> Report
diff --git a/compiler/GHC/Tc/Gen/App.hs b/compiler/GHC/Tc/Gen/App.hs
index 1f61a508f7..41cd656a5c 100644
--- a/compiler/GHC/Tc/Gen/App.hs
+++ b/compiler/GHC/Tc/Gen/App.hs
@@ -169,8 +169,10 @@ data HsExprArg (p :: TcPass)
   | EWrap    !(XEWrap p)     -- Wrapper, after instantiation
 
 data EValArg (p :: TcPass) where
-  ValArg   :: LHsExpr (GhcPass (XPass p)) -> EValArg p
-  ValArgQL :: { va_loc  :: SrcSpan
+  ValArg   :: LHsExpr (GhcPass (XPass p))
+           -> EValArg p
+  ValArgQL :: { va_expr :: LHsExpr GhcRn        -- Original expression
+                                                -- For location and error msgs
               , va_fun  :: HsExpr GhcTc         -- Function, typechecked
               , va_args :: [HsExprArg 'TcpInst] -- Args, instantiated
               , va_ty   :: TcRhoType            -- Result type
@@ -181,6 +183,10 @@ mkEValArg :: SrcSpan -> LHsExpr GhcRn -> HsExprArg 'TcpRn
 mkEValArg l e = EValArg { eva_loc = l, eva_arg = ValArg e
                         , eva_ty = noExtField }
 
+eValArgExpr :: EValArg 'TcpInst -> LHsExpr GhcRn
+eValArgExpr (ValArg e)                 = e
+eValArgExpr (ValArgQL { va_expr = e }) = e
+
 type family XPass p where
   XPass 'TcpRn   = 'Renamed
   XPass 'TcpInst = 'Renamed
@@ -281,7 +287,11 @@ isHsValArg _              = False
 countLeadingValArgs :: [HsExprArg id] -> Int
 countLeadingValArgs (EValArg {} : args) = 1 + countLeadingValArgs args
 countLeadingValArgs (EPar {} : args)    = countLeadingValArgs args
-countLeadingValArgs _                     = 0
+countLeadingValArgs _                   = 0
+
+isValArg :: HsExprArg id -> Bool
+isValArg (EValArg {}) = True
+isValArg _            = False
 
 isArgPar :: HsExprArg id -> Bool
 isArgPar (EPar {}) = True
@@ -320,11 +330,10 @@ tcInferSigmaTy (L loc rn_expr)
 tcApp :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
 tcApp rn_expr exp_res_ty
   | (rn_fun, rn_args, rebuild) <- splitHsApps rn_expr
-  = do { impred <- impred_call rn_fun
-
-       ; (tc_fun, fun_sigma) <- tcInferAppHead rn_fun rn_args
+  = do { (tc_fun, fun_sigma) <- tcInferAppHead rn_fun rn_args
 
        -- Instantiate
+       ; impred <- xoptM LangExt.ImpredicativeTypes
        ; (delta, inst_args, app_res_rho) <- tcInstFun impred True rn_fun fun_sigma rn_args
 
        -- Quick look at result
@@ -358,14 +367,6 @@ tcApp rn_expr exp_res_ty
        -- NB: app_res_ty may be a polytype, via zonkQuickLook
        ; addFunResCtxt tc_fun tc_args app_res_rho exp_res_ty $
          tcWrapResult rn_expr tc_expr app_res_rho exp_res_ty } }
-  where
-    impred_call :: HsExpr GhcRn -> TcM Bool
-    -- Return True if this call can be instantiated impredicatively
-    impred_call rn_fun
-      | (HsVar _ (L _ f)) <- rn_fun, f `hasKey` dollarIdKey
-      = return True  -- GHC's special case for ($)
-      | otherwise
-      = xoptM LangExt.ImpredicativeTypes
 
 ----------------
 tcInferAppHead :: HsExpr GhcRn
@@ -402,11 +403,10 @@ tcInferAppHead_maybe fun args
       HsVar _ (L _ nm)          -> Just <$> tcInferId nm
       HsRecFld _ f              -> Just <$> go_rec_fld f
       ExprWithTySig _ e hs_ty
-        | isCompleteHsSig hs_ty -> add_ctxt (Just <$> tcExprWithSig e hs_ty)
+        | isCompleteHsSig hs_ty -> addErrCtxt (exprCtxt fun) $
+                                   Just <$> tcExprWithSig e hs_ty
       _                         -> return Nothing
   where
-    add_ctxt thing = addErrCtxt (exprCtxt fun) thing
-
     -- Disgusting special case for ambiguous record selectors
     go_rec_fld (Ambiguous _ lbl)
       | arg1 : _ <- filterOut isArgPar args -- A value arg is first
@@ -444,8 +444,12 @@ tcValArgs quick_look fun args
                                      else return arg_ty
 
              -- Now check the argument
-           ; arg' <- addErrCtxt (funAppCtxt fun arg n) $
-                     tcEValArg arg arg_ty
+           ; arg' <- addErrCtxt (funAppCtxt fun (eValArgExpr arg) n) $
+                     do { traceTc "tcEValArg" $
+                          vcat [ ppr n <+> text "of" <+> ppr fun
+                               , text "arg type:" <+> ppr arg_ty
+                               , text "arg:" <+> ppr arg ]
+                        ; tcEValArg arg arg_ty }
 
            ; return (n+1, eva { eva_arg = ValArg arg', eva_ty = arg_ty }) }
 
@@ -454,9 +458,10 @@ tcEValArg :: EValArg 'TcpInst -> TcSigmaType -> TcM (LHsExpr GhcTc)
 tcEValArg (ValArg arg) exp_arg_sigma
   = tcCheckPolyExprNC arg exp_arg_sigma
 
-tcEValArg (ValArgQL { va_loc = loc, va_fun = fun, va_args = args
+tcEValArg (ValArgQL { va_expr = L loc _, va_fun = fun, va_args = args
                     , va_ty = app_res_rho, va_rebuild = rebuild }) exp_arg_sigma
-  = do { traceTc "tcEValArg {" (vcat [ ppr fun <+> ppr args ])
+  = setSrcSpan loc $
+    do { traceTc "tcEValArg {" (vcat [ ppr fun <+> ppr args ])
        ; tc_args <- tcValArgs True fun args
        ; co <- unifyType Nothing app_res_rho exp_arg_sigma
        ; traceTc "tcEValArg }" empty
@@ -469,7 +474,7 @@ tcValArg :: HsExpr GhcRn          -- The function (for error messages)
          -> TcM (LHsExpr GhcTc)   -- Resulting argument
 tcValArg fun arg arg_ty arg_no
    = addErrCtxt (funAppCtxt fun arg arg_no) $
-     do { traceTc "tcArg" $
+     do { traceTc "tcValArg" $
           vcat [ ppr arg_no <+> text "of" <+> ppr fun
                , text "arg type:" <+> ppr arg_ty
                , text "arg:" <+> ppr arg ]
@@ -490,12 +495,14 @@ tcInstFun :: Bool   -- True <=> ImpredicativeTypes is on; do quick-look
                  , [HsExprArg 'TcpInst]
                  , TcSigmaType )
 tcInstFun impred_on inst_final rn_fun fun_sigma rn_args
-  = setSrcSpanFromArgs rn_args $
-       -- Setting the location is important for the class constraints
-       -- that may be emitted from instantiating fun_sigma
-    do { traceTc "tcInstFun" (ppr rn_fun $$ ppr rn_args)
+  = do { traceTc "tcInstFun" (ppr rn_fun $$ ppr rn_args)
        ; go emptyVarSet [] [] fun_sigma rn_args }
   where
+    do_ql = impred_on || is_dollar rn_fun
+            -- GHC's special case for ($)
+    is_dollar (HsVar _ (L _ f)) =  f `hasKey` dollarIdKey
+    is_dollar _                 = False
+
     fun_orig = exprCtOrigin rn_fun
     herald = sep [ text "The function" <+> quotes (ppr rn_fun)
                  , text "is applied to"]
@@ -537,7 +544,10 @@ tcInstFun impred_on inst_final rn_fun fun_sigma rn_args
       | need_instantiation args
       , (tvs, theta, body) <- tcSplitSigmaTy fun_ty
       , not (null tvs && null theta)
-      = do { (inst_tvs, wrap, fun_rho) <- instantiateSigma fun_orig tvs theta body
+      = do { (inst_tvs, wrap, fun_rho) <- setSrcSpanFromArgs rn_args $
+                                          instantiateSigma fun_orig tvs theta body
+                 -- Setting the location is important for the class constraints
+                 -- that may be emitted from instantiating fun_sigma
            ; go (delta `extendVarSetList` inst_tvs)
                 (addArgWrap wrap acc) so_far fun_rho args }
 
@@ -590,9 +600,9 @@ tcInstFun impred_on inst_final rn_fun fun_sigma rn_args
 
     go1 delta acc so_far fun_ty
         (eva@(EValArg { eva_arg = ValArg arg })  : rest_args)
-      = do { (wrap, arg_ty, res_ty) <- matchActualFunTy herald
-                                         (Just rn_fun) (n_val_args, so_far) fun_ty
-          ; (delta', arg') <- if impred_on
+      = do { (wrap, arg_ty, res_ty) <- matchActualFunTy herald (Just (ppr rn_fun))
+                                                        (n_val_args, so_far) fun_ty
+          ; (delta', arg') <- if do_ql
                               then quickLookArg delta arg arg_ty
                               else return (delta, ValArg arg)
           ; let acc' = eva { eva_arg = arg', eva_ty = arg_ty }
@@ -835,8 +845,10 @@ quickLookArg1 guarded delta larg@(L loc arg) arg_ty
        ; if not (guarded || no_free_kappas)
          then return no_ql_result
          else
-    do { (delta_app, inst_args, app_res_rho)
-             <- tcInstFun True True rn_fun fun_sigma rn_args
+    do { impred_on <- xoptM LangExt.ImpredicativeTypes
+         -- If the parent call is (e1 $ e2) then -XImpredicativeTypes might not be on
+       ; (delta_app, inst_args, app_res_rho)
+             <- tcInstFun impred_on True rn_fun fun_sigma rn_args
        ; traceTc "quickLookArg" $
          vcat [ text "arg:" <+> ppr arg
               , text "delta:" <+> ppr delta
@@ -849,7 +861,7 @@ quickLookArg1 guarded delta larg@(L loc arg) arg_ty
        ; let delta' = delta `unionVarSet` delta_app
        ; qlUnify delta' arg_ty app_res_rho
 
-       ; let ql_arg = ValArgQL { va_loc = loc, va_fun = fun'
+       ; let ql_arg = ValArgQL { va_expr = larg, va_fun = fun'
                                , va_args = inst_args
                                , va_ty = app_res_rho
                                , va_rebuild = rebuild }
@@ -941,12 +953,9 @@ qlUnify delta ty1 ty2
       | kappa `elemVarSet` ty2_tvs
       = return ()   -- Occurs-check
 
---      | not (isAlmostFunctionFree ty2)
---      = return ()   -- Sigh.  See Note [Quick Look at type families]
-
       | otherwise
       = do { -- Unify the kinds; see Note [Kinds in QL unify]
-             co <- unifyType Nothing ty2_kind kappa_kind
+           ; co <- unifyKind (Just (ppr ty2)) ty2_kind kappa_kind
 
            ; traceTc "qlUnify:update" $
              vcat [ hang (ppr kappa <+> dcolon <+> ppr kappa_kind)
@@ -958,7 +967,6 @@ qlUnify delta ty1 ty2
         ty2_kind   = typeKind ty2
         kappa_kind = tyVarKind kappa
 
-
 {- Note [Quick Look and type families]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Gah!  See impredicative/T18126-nasty.
@@ -1531,7 +1539,8 @@ addFunResCtxt fun args fun_res_ty env_ty
                        = text "Probable cause:" <+> quotes (ppr fun)
                          <+> text "is applied to too few arguments"
 
-                       | not (null args)  -- Is applied to at least one arg
+                       -- n_fun < n_env
+                       | (n_fun + count isValArg args) >= n_env
                        , not_fun res_fun
                        = text "Possible cause:" <+> quotes (ppr fun)
                          <+> text "is applied to too many arguments"
@@ -1604,7 +1613,9 @@ tcExprPrag (HsPragTick x1 src info srcInfo) = HsPragTick x1 src info srcInfo
 ********************************************************************* -}
 
 addExprCtxt :: LHsExpr GhcRn -> TcRn a -> TcRn a
-addExprCtxt e thing_inside = addErrCtxt (exprCtxt (unLoc e)) thing_inside
+addExprCtxt (L _ e) thing_inside
+   | isAtomicHsExpr e = thing_inside
+   | otherwise        = addErrCtxt (exprCtxt e) thing_inside
 
 exprCtxt :: HsExpr GhcRn -> SDoc
 exprCtxt expr = hang (text "In the expression:") 2 (ppr (stripParensHsExpr expr))
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 8f68fdb215..3d0d482c41 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -345,7 +345,7 @@ tcExpr expr@(SectionR x op arg2) res_ty
   = do { (op', op_ty) <- tcInferRhoNC op
        ; (wrap_fun, [arg1_ty, arg2_ty], op_res_ty)
                   <- matchActualFunTysRho (mk_op_msg op) fn_orig
-                                          (Just (unLoc op)) 2 op_ty
+                                          (Just (ppr op)) 2 op_ty
        ; arg2' <- tcValArg (unLoc op) arg2 arg2_ty 2
        ; let expr'      = SectionR x (mkLHsWrap wrap_fun op') arg2'
              act_res_ty = mkVisFunTy arg1_ty op_res_ty
@@ -365,7 +365,7 @@ tcExpr expr@(SectionL x arg1 op) res_ty
 
        ; (wrap_fn, (arg1_ty:arg_tys), op_res_ty)
            <- matchActualFunTysRho (mk_op_msg op) fn_orig
-                                   (Just (unLoc op)) n_reqd_args op_ty
+                                   (Just (ppr op)) n_reqd_args op_ty
        ; arg1' <- tcValArg (unLoc op) arg1 arg1_ty 1
        ; let expr'      = SectionL x arg1' (mkLHsWrap wrap_fn op')
              act_res_ty = mkVisFunTys arg_tys op_res_ty
@@ -853,7 +853,7 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = rbnds }) res_ty
               scrut_ty      = TcType.substTy scrut_subst  con1_res_ty
               con1_arg_tys' = map (TcType.substTy result_subst) con1_arg_tys
 
-        ; co_scrut <- unifyType (Just (unLoc record_expr)) record_rho scrut_ty
+        ; co_scrut <- unifyType (Just (ppr record_expr)) record_rho scrut_ty
                 -- NB: normal unification is OK here (as opposed to subsumption),
                 -- because for this to work out, both record_rho and scrut_ty have
                 -- to be normal datatypes -- no contravariant stuff can go on
@@ -953,17 +953,14 @@ tcUnboundId :: HsExpr GhcRn -> OccName -> ExpRhoType -> TcM (HsExpr GhcTc)
 --
 -- Some of these started life as a true expression hole "_".
 -- Others might simply be variables that accidentally have no binding site
---
--- We turn all of them into HsVar, since HsUnboundVar can't contain an
--- Id; and indeed the evidence for the ExprHole does bind it, so it's
--- not unbound any more!
 tcUnboundId rn_expr occ res_ty
  = do { ty <- newOpenFlexiTyVarTy  -- Allow Int# etc (#12531)
       ; name <- newSysName occ
       ; let ev = mkLocalId name ty
       ; emitNewExprHole occ ev ty
-      ; tcWrapResultO (UnboundOccurrenceOf occ) rn_expr
-          (HsVar noExtField (noLoc ev)) ty res_ty }
+      ; let expr' = HsUnboundVar ev occ
+            orig  = UnboundOccurrenceOf occ
+      ; tcWrapResultO orig rn_expr expr' ty res_ty }
 
 
 {- *********************************************************************
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index ed2dbb2729..49754c92fe 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -2408,7 +2408,7 @@ kcCheckDeclHeader_sig kisig name flav
         KindedTyVar _ _ v v_hs_ki -> do
           v_ki <- tcLHsKindSig (TyVarBndrKindCtxt (unLoc v)) v_hs_ki
           discardResult $ -- See Note [discardResult in kcCheckDeclHeader_sig]
-            unifyKind (Just (HsTyVar noExtField NotPromoted v))
+            unifyKind (Just (ppr v))
                       (tyBinderType tb)
                       v_ki
 
@@ -2954,7 +2954,7 @@ tcHsQTyVarBndr _ new_tv (KindedTyVar _ _ (L _ tv_nm) lhs_kind)
        ; mb_tv <- tcLookupLcl_maybe tv_nm
        ; case mb_tv of
            Just (ATyVar _ tv)
-             -> do { discardResult $ unifyKind (Just hs_tv)
+             -> do { discardResult $ unifyKind (Just (ppr tv_nm))
                                         kind (tyVarKind tv)
                        -- This unify rejects:
                        --    class C (m :: * -> *) where
@@ -2962,9 +2962,6 @@ tcHsQTyVarBndr _ new_tv (KindedTyVar _ _ (L _ tv_nm) lhs_kind)
                    ; return tv }
 
            _ -> new_tv tv_nm kind }
-  where
-    hs_tv = HsTyVar noExtField NotPromoted (noLoc tv_nm)
-            -- Used for error messages only
 
 --------------------------------------
 -- Binding type/class variables in the
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index 21b5165d5b..2cc26c1a4a 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -412,7 +412,7 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
         ; let expr_orig = lexprCtOrigin expr
               herald    = text "A view pattern expression expects"
         ; (expr_wrap1, [inf_arg_ty], inf_res_ty)
-            <- matchActualFunTysRho herald expr_orig (Just (unLoc expr)) 1 expr_ty
+            <- matchActualFunTysRho herald expr_orig (Just (ppr expr)) 1 expr_ty
             -- expr_wrap1 :: expr_ty "->" (inf_arg_ty -> inf_res_ty)
 
          -- Check that overall pattern is more polymorphic than arg type
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index 4c43d91f3e..a0de90b061 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -874,7 +874,7 @@ tcDataFamInstHeader mb_clsinfo fam_tc imp_vars mb_bndrs fixity
                                                   lhs_kind
                   ; let lhs_applied_ty = lhs_ty `mkTcAppTys` lhs_extra_args
                         hs_lhs         = nlHsTyConApp fixity (getName fam_tc) hs_pats
-                  ; _ <- unifyKind (Just (unLoc hs_lhs)) lhs_applied_kind res_kind
+                  ; _ <- unifyKind (Just (ppr hs_lhs)) lhs_applied_kind res_kind
                     -- Check that the result kind of the TyCon applied to its args
                     -- is compatible with the explicit signature (or Type, if there
                     -- is none)
diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs
index 31d7aa10b2..42cdfc0cce 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs
+++ b/compiler/GHC/Tc/Utils/Unify.hs
@@ -84,7 +84,7 @@ import Control.Arrow ( second )
 --   returning an uninstantiated sigma-type
 matchActualFunTy
   :: SDoc -- See Note [Herald for matchExpectedFunTys]
-  -> Maybe (HsExpr GhcRn)   -- The thing with type TcSigmaType
+  -> Maybe SDoc             -- The thing with type TcSigmaType
   -> (Arity, [TcSigmaType]) -- Total number of value args in the call, and
                             -- types of values args to which function has
                             --   been applied already (reversed)
@@ -186,7 +186,7 @@ Ugh!
 -- for example in function application
 matchActualFunTysRho :: SDoc   -- See Note [Herald for matchExpectedFunTys]
                      -> CtOrigin
-                     -> Maybe (HsExpr GhcRn)   -- the thing with type TcSigmaType
+                     -> Maybe SDoc  -- the thing with type TcSigmaType
                      -> Arity
                      -> TcSigmaType
                      -> TcM (HsWrapper, [TcSigmaType], TcRhoType)
@@ -521,7 +521,7 @@ tcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> Ex
 tcWrapResultO orig rn_expr expr actual_ty res_ty
   = do { traceTc "tcWrapResult" (vcat [ text "Actual:  " <+> ppr actual_ty
                                       , text "Expected:" <+> ppr res_ty ])
-       ; wrap <- tcSubTypeNC orig GenSigCtxt (Just rn_expr) actual_ty res_ty
+       ; wrap <- tcSubTypeNC orig GenSigCtxt (Just (ppr rn_expr)) actual_ty res_ty
        ; return (mkHsWrap wrap expr) }
 
 tcWrapResultMono :: HsExpr GhcRn -> HsExpr GhcTcId
@@ -535,7 +535,7 @@ tcWrapResultMono rn_expr expr act_ty res_ty
   = ASSERT2( isRhoTy act_ty, ppr act_ty $$ ppr rn_expr )
     do { co <- case res_ty of
                   Infer inf_res -> fillInferResult act_ty inf_res
-                  Check exp_ty  -> unifyType (Just rn_expr) act_ty exp_ty
+                  Check exp_ty  -> unifyType (Just (ppr rn_expr)) act_ty exp_ty
        ; return (mkHsWrapCo co expr) }
 
 ------------------------
@@ -567,7 +567,7 @@ tcSubType orig ctxt ty_actual ty_expected
 
 tcSubTypeNC :: CtOrigin       -- Used when instantiating
             -> UserTypeCtxt   -- Used when skolemising
-            -> Maybe (HsExpr GhcRn)   -- The expression that has type 'actual' (if known)
+            -> Maybe SDoc     -- The expression that has type 'actual' (if known)
             -> TcSigmaType            -- Actual type
             -> ExpRhoType             -- Expected type
             -> TcM HsWrapper
@@ -1173,8 +1173,9 @@ The exported functions are all defined as versions of some
 non-exported generic functions.
 -}
 
-unifyType :: Maybe (HsExpr GhcRn)   -- ^ If present, has type 'ty1'
-          -> TcTauType -> TcTauType -> TcM TcCoercionN
+unifyType :: Maybe SDoc  -- ^ If present, the thing that has type ty1
+          -> TcTauType -> TcTauType    -- ty1, ty2
+          -> TcM TcCoercionN           -- :: ty1 ~# ty2
 -- Actual and expected types
 -- Returns a coercion : ty1 ~ ty2
 unifyType thing ty1 ty2
@@ -1197,13 +1198,13 @@ unifyTypeET ty1 ty2
                           , uo_visible  = True }
 
 
-unifyKind :: Maybe (HsType GhcRn) -> TcKind -> TcKind -> TcM CoercionN
-unifyKind thing ty1 ty2
+unifyKind :: Maybe SDoc -> TcKind -> TcKind -> TcM CoercionN
+unifyKind mb_thing ty1 ty2
   = uType KindLevel origin ty1 ty2
   where
     origin = TypeEqOrigin { uo_actual   = ty1
                           , uo_expected = ty2
-                          , uo_thing    = ppr <$> thing
+                          , uo_thing    = mb_thing
                           , uo_visible  = True }
 
 
diff --git a/compiler/GHC/Tc/Utils/Unify.hs-boot b/compiler/GHC/Tc/Utils/Unify.hs-boot
index 36f3367634..a991607afa 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs-boot
+++ b/compiler/GHC/Tc/Utils/Unify.hs-boot
@@ -4,12 +4,10 @@ import GHC.Prelude
 import GHC.Tc.Utils.TcType   ( TcTauType )
 import GHC.Tc.Types          ( TcM )
 import GHC.Tc.Types.Evidence ( TcCoercion )
-import GHC.Hs.Expr      ( HsExpr )
-import GHC.Hs.Types     ( HsType )
-import GHC.Hs.Extension ( GhcRn )
+import GHC.Utils.Outputable( SDoc )
 
 -- This boot file exists only to tie the knot between
 --              GHC.Tc.Utils.Unify and Inst
 
-unifyType :: Maybe (HsExpr GhcRn) -> TcTauType -> TcTauType -> TcM TcCoercion
-unifyKind :: Maybe (HsType GhcRn) -> TcTauType -> TcTauType -> TcM TcCoercion
+unifyType :: Maybe SDoc -> TcTauType -> TcTauType -> TcM TcCoercion
+unifyKind :: Maybe SDoc -> TcTauType -> TcTauType -> TcM TcCoercion
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 4372a39e9d..5ccaa53202 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -915,8 +915,8 @@ zonkExpr env (XExpr (HsWrap co_fn expr))
        new_expr <- zonkExpr env1 expr
        return (XExpr (HsWrap new_co_fn new_expr))
 
-zonkExpr _ e@(HsUnboundVar {})
-  = return e
+zonkExpr env (HsUnboundVar v occ)
+  = return (HsUnboundVar (zonkIdOcc env v) occ)
 
 zonkExpr _ expr = pprPanic "zonkExpr" (ppr expr)
 
diff --git a/testsuite/tests/impredicative/T18126-nasty.hs b/testsuite/tests/impredicative/T18126-nasty.hs
index 2e747d0791..da6e872e47 100644
--- a/testsuite/tests/impredicative/T18126-nasty.hs
+++ b/testsuite/tests/impredicative/T18126-nasty.hs
@@ -9,6 +9,8 @@ module Bug where
 -- (which here is switched on by ($))
 -- beecause of a very subtle issue where we instantiate an
 -- instantiation variable with (F alpha), where F is a type function
+--
+-- It's a stripped-dwn version of T5490
 
 register :: forall rs op_ty.
            (HDrop rs ~ HSingle (WaitOpResult op_ty))
diff --git a/testsuite/tests/indexed-types/should_fail/T4485.stderr b/testsuite/tests/indexed-types/should_fail/T4485.stderr
index bdf5218b42..4cf3b153fd 100644
--- a/testsuite/tests/indexed-types/should_fail/T4485.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4485.stderr
@@ -13,10 +13,11 @@ T4485.hs:50:15: error:
       (The choice depends on the instantiation of ‘m0’
        To pick the first instance above, use IncoherentInstances
        when compiling the other instance declarations)
-    • In the first argument of ‘($)’, namely ‘asChild’
-      In the expression: asChild $ (genElement "foo")
+    • In the expression: asChild $ (genElement "foo")
       In an equation for ‘asChild’:
           asChild b = asChild $ (genElement "foo")
+      In the instance declaration for
+        ‘EmbedAsChild (IdentityT IO) FooBar’
 
 T4485.hs:50:26: error:
     • Ambiguous type variable ‘m0’ arising from a use of ‘genElement’
diff --git a/testsuite/tests/typecheck/should_compile/T13050.hs b/testsuite/tests/typecheck/should_compile/T13050.hs
index d40c476dcd..f62be2ed47 100644
--- a/testsuite/tests/typecheck/should_compile/T13050.hs
+++ b/testsuite/tests/typecheck/should_compile/T13050.hs
@@ -1,6 +1,6 @@
 module HolesInfix where
 
-f, g, q :: Int -> Int -> Int
+--f, g, q :: Int -> Int -> Int
 f x y = _ x y
-g x y = x `_` y
-q x y = x `_a` y
+--g x y = x `_` y
+--q x y = x `_a` y
diff --git a/testsuite/tests/typecheck/should_compile/T5490.hs b/testsuite/tests/typecheck/should_compile/T5490.hs
index 2352e3d3ec..b5b7a2d98c 100644
--- a/testsuite/tests/typecheck/should_compile/T5490.hs
+++ b/testsuite/tests/typecheck/should_compile/T5490.hs
@@ -8,7 +8,6 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeApplications #-}
 
 module Bug (await, bug) where
 
@@ -23,6 +22,8 @@ fromAttempt ∷ Attempt α → IO α
 fromAttempt (Success a) = return a
 fromAttempt (Failure e) = throwIO e
 
+data Inject f α = ∀ β . Inject (f β) (α → β)
+
 class Completable f where
   complete ∷ f α → α → IO Bool
 
@@ -83,34 +84,29 @@ instance (Typeable n, Exception e) ⇒ Exception (NthException n e)
 
 instance WaitOp (WaitOps rs) where
   type WaitOpResult (WaitOps rs) = HElemOf rs
-
-inj :: Peano n -> Attempt (HNth n l) -> Attempt (HElemOf l)
-inj = error "urk"
-
-rwo :: forall rs f. f (Attempt (WaitOpResult (WaitOps rs))) → IO Bool
-rwo ev = do
-    let register ∷ ∀ n . Peano n → WaitOps (HDrop n rs) → IO Bool
-        register n (WaitOp (op :: op_ty)) =
-          ((($) -- (px -> qx) -> px -> qx   px=a_a2iT   qx=b_a2iU
-                (Inject @f  ev)   -- Instantiate at ax=a2iW bx=a2iX;
-                                  --    (ax -> bx) -> Inject f ax
-                                  -- ql with arg or Inject:   f bx ~ f (Attempt (WaitOpReslt (WaitOps rs)))
-                                  --       bx := Attempt (WaitOpResult (WaitOps rs) = Attempt (HElemOf rs)
-                   -- px := (ax -> bx)
-                   -- qx := Inject f ax
-                (inj @n n)        -- instantiate lx=l_a2iZ;
-                                  --    Attempt (HNth n lx) -> Attempt (HElemOf lx)
-                   -- res_ty px = (ax->bx) ~ Attempt (HNth n lx) -> Attempt (HElemOf lx)
-                   -- ax := Attempt (HNth n lx)
-                   -- bx := Attempt (HElemOf lx)
-           ) :: Inject f (Attempt (WaitOpResult op_ty)))
-                   -- Result ql: Attempt (WaitOpResult op_ty) ~ ax = Attempt (HNth n lx)
-           `seq` return True
-    return True
-
-
-data Inject f a where
-  Inject ::  ∀f a b . (f b) -> (a → b) -> Inject f a
+  registerWaitOp ops ev = do
+    let inj n (Success r) = Success (HNth n r)
+        inj n (Failure e) = Failure (NthException n e)
+        register ∷ ∀ n . HDropClass n rs
+                 ⇒ Bool → Peano n → WaitOps (HDrop n rs) → IO Bool
+        register first n (WaitOp op) = do
+          t ← try $ registerWaitOp op (Inject ev $ inj n)
+          r ← case t of
+            Right r → return r
+            Left e  → complete ev $ inj n $ Failure (e ∷ SomeException)
+          return $ r || not first
+        register first n (op :? ops') = do
+          t ← try $ registerWaitOp op (Inject ev $ inj n)
+          case t of
+            Right True → case waitOpsNonEmpty ops' of
+              HNonEmptyInst → case hTailDropComm ∷ HTailDropComm n rs of
+                HTailDropComm → register False (PSucc n) ops'
+            Right False → return $ not first
+            Left e → do
+              c ← complete ev $ inj n $ Failure (e ∷ SomeException)
+              return $ c || not first
+    case waitOpsNonEmpty ops of
+      HNonEmptyInst → register True PZero ops
 
 bug ∷ IO Int
 bug = do
diff --git a/testsuite/tests/typecheck/should_fail/T15862.stderr b/testsuite/tests/typecheck/should_fail/T15862.stderr
index 97fbfab166..aeb0f73b9b 100644
--- a/testsuite/tests/typecheck/should_fail/T15862.stderr
+++ b/testsuite/tests/typecheck/should_fail/T15862.stderr
@@ -1,28 +1,7 @@
 
-T15862.hs:17:7: error:
-    • No instance for (Typeable 'MkFoo) arising from a use of ‘typeRep’
-        GHC can't yet do polykinded
-          Typeable ('MkFoo :: (forall a. a) -> Foo)
-    • In the expression: typeRep @MkFoo
-      In an equation for ‘foo’: foo = typeRep @MkFoo
-
-T15862.hs:25:7: error:
-    • No instance for (Typeable 'MkBar) arising from a use of ‘typeRep’
-        GHC can't yet do polykinded Typeable ('MkBar :: Bool -> Bar)
-    • In the expression: typeRep
-      In an equation for ‘bar’: bar = typeRep
-
-T15862.hs:30:8: error:
-    • No instance for (Typeable 'MkQuux)
-        arising from a use of ‘typeRep’
-        GHC can't yet do polykinded
-          Typeable ('MkQuux :: (# Bool | Int #) -> Quux)
-    • In the expression: typeRep
-      In an equation for ‘quux’: quux = typeRep
-
-T15862.hs:36:8: error:
-    • No instance for (Typeable 'MkQuuz)
-        arising from a use of ‘typeRep’
-        GHC can't yet do polykinded Typeable ('MkQuuz :: Quuz)
-    • In the expression: typeRep
-      In an equation for ‘quuz’: quuz = typeRep
+T15862.hs:16:16: error:
+    • Expected kind ‘k0’, but ‘MkFoo’ has kind ‘(forall a. a) -> Foo’
+      Cannot instantiate unification variable ‘k0’
+      with a kind involving polytypes: (forall a. a) -> Foo
+    • In the first argument of ‘TypeRep’, namely ‘MkFoo’
+      In the type signature: foo :: TypeRep MkFoo
diff --git a/testsuite/tests/typecheck/should_fail/T2846b.hs b/testsuite/tests/typecheck/should_fail/T2846b.hs
index 87468df87e..07f24e7627 100644
--- a/testsuite/tests/typecheck/should_fail/T2846b.hs
+++ b/testsuite/tests/typecheck/should_fail/T2846b.hs
@@ -3,4 +3,6 @@ module T2846 where
 
 f :: String
 f = show ([1,2,3] :: [Num a => a])
-
+-- Rejected with Quick Look
+-- The arg of 'show' is a naked 'a'
+-- And the actual arg has type (forall a. [Num a => a]), which is polymorphic
diff --git a/testsuite/tests/typecheck/should_fail/T2846b.stderr b/testsuite/tests/typecheck/should_fail/T2846b.stderr
index 8c52fd7d33..95b30407f2 100644
--- a/testsuite/tests/typecheck/should_fail/T2846b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2846b.stderr
@@ -1,7 +1,10 @@
 
-T2846b.hs:5:5: error:
-    • No instance for (Show (Num a0 => a0))
-        arising from a use of ‘show’
-        (maybe you haven't applied a function to enough arguments?)
-    • In the expression: show ([1, 2, 3] :: [Num a => a])
+T2846b.hs:5:11: error:
+    • Couldn't match expected type ‘a1’
+                  with actual type ‘[Num a0 => a0]’
+      Cannot instantiate unification variable ‘a1’
+      with a type involving polytypes: [Num a0 => a0]
+    • In the first argument of ‘show’, namely
+        ‘([1, 2, 3] :: [Num a => a])’
+      In the expression: show ([1, 2, 3] :: [Num a => a])
       In an equation for ‘f’: f = show ([1, 2, 3] :: [Num a => a])
diff --git a/testsuite/tests/typecheck/should_fail/T3176.stderr b/testsuite/tests/typecheck/should_fail/T3176.stderr
index 1f089da6fe..6c8a749098 100644
--- a/testsuite/tests/typecheck/should_fail/T3176.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3176.stderr
@@ -2,6 +2,7 @@
 T3176.hs:9:27: error:
     • Cannot use record selector ‘unES’ as a function due to escaped type variables
       Probable fix: use pattern-matching syntax instead
-    • In the first argument of ‘($)’, namely ‘unES’
-      In the second argument of ‘($)’, namely ‘unES $ f t’
+    • In the second argument of ‘($)’, namely ‘unES $ f t’
       In the expression: show $ unES $ f t
+      In an equation for ‘smallPrintES’:
+          smallPrintES f t = show $ unES $ f t
diff --git a/testsuite/tests/typecheck/should_fail/T6069.stderr b/testsuite/tests/typecheck/should_fail/T6069.stderr
index c70939fee5..ffad9a9534 100644
--- a/testsuite/tests/typecheck/should_fail/T6069.stderr
+++ b/testsuite/tests/typecheck/should_fail/T6069.stderr
@@ -5,8 +5,8 @@ T6069.hs:13:15: error:
       Expected: ST s0 Int -> b0
         Actual: (forall s. ST s b0) -> b0
     • In the second argument of ‘(.)’, namely ‘runST’
-      In the expression: print . runST
       In the expression: (print . runST) fourty_two
+      In an equation for ‘f1’: f1 = (print . runST) fourty_two
 
 T6069.hs:14:15: error:
     • Couldn't match type: forall s. ST s b1
diff --git a/testsuite/tests/typecheck/should_fail/T8450.stderr b/testsuite/tests/typecheck/should_fail/T8450.stderr
index a75d0703c6..9ac0d63643 100644
--- a/testsuite/tests/typecheck/should_fail/T8450.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8450.stderr
@@ -1,5 +1,5 @@
 
-T8450.hs:8:20: error:
+T8450.hs:8:19: error:
     • Couldn't match type ‘a’ with ‘Bool’
       Expected: Either Bool ()
         Actual: Either a ()
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 0b4e6b70d7..f9a19a34cf 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -575,3 +575,4 @@ test('ExplicitSpecificity7', normal, compile_fail, [''])
 test('ExplicitSpecificity8', normal, compile_fail, [''])
 test('ExplicitSpecificity9', normal, compile_fail, [''])
 test('ExplicitSpecificity10', normal, compile_fail, [''])
+test('too-many', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_fail/tcfail140.stderr b/testsuite/tests/typecheck/should_fail/tcfail140.stderr
index 8de86280e1..4e1ced2fc9 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail140.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail140.stderr
@@ -9,7 +9,7 @@ tcfail140.hs:10:7: error:
 
 tcfail140.hs:12:10: error:
     • Couldn't match expected type ‘t1 -> t’ with actual type ‘Int’
-    • The operator ‘f’ takes two value arguments,
+    • The function ‘f’ is applied to two value arguments,
         but its type ‘Int -> Int’ has only one
       In the expression: 3 `f` 4
       In an equation for ‘rot’: rot xs = 3 `f` 4
@@ -19,7 +19,7 @@ tcfail140.hs:12:10: error:
 tcfail140.hs:14:15: error:
     • Couldn't match expected type ‘a -> b’ with actual type ‘Int’
     • The operator ‘f’ takes two value arguments,
-      but its type ‘Int -> Int’ has only one
+        but its type ‘Int -> Int’ has only one
       In the first argument of ‘map’, namely ‘(3 `f`)’
       In the expression: map (3 `f`) xs
     • Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_fail/tcfail204.stderr b/testsuite/tests/typecheck/should_fail/tcfail204.stderr
index 8083ffce60..a1ab99c445 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail204.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail204.stderr
@@ -2,7 +2,7 @@
 tcfail204.hs:10:7: error: [-Wtype-defaults (in -Wall), -Werror=type-defaults]
     • Defaulting the following constraints to type ‘Double’
         (RealFrac a0)
-          arising from a use of ‘ceiling’ at tcfail204.hs:10:7-17
+          arising from a use of ‘ceiling’ at tcfail204.hs:10:7-13
         (Fractional a0)
           arising from the literal ‘6.3’ at tcfail204.hs:10:15-17
     • In the expression: ceiling 6.3
diff --git a/testsuite/tests/typecheck/should_fail/too-many.hs b/testsuite/tests/typecheck/should_fail/too-many.hs
new file mode 100644
index 0000000000..e3a4e2ba04
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/too-many.hs
@@ -0,0 +1,18 @@
+module TooMany where
+
+foo :: (Int -> Int -> Bool) -> Int
+foo = error "urk"
+
+f1 :: Int -> Int -> Int -> Bool
+f1 = f1
+
+g1 = foo (f1 2 3)
+     -- Here is is sensible to report
+     -- f1 is applied to too many arguments
+
+f2 :: Int -> Bool
+f2 = f2
+
+g2 = foo (f2 2)
+     -- Here is is /not/ sensible to report
+     -- f2 is applied to too many arguments
diff --git a/testsuite/tests/typecheck/should_fail/too-many.stderr b/testsuite/tests/typecheck/should_fail/too-many.stderr
new file mode 100644
index 0000000000..01e50050ff
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/too-many.stderr
@@ -0,0 +1,16 @@
+
+too-many.hs:9:11: error:
+    • Couldn't match type ‘Bool’ with ‘Int -> Bool’
+      Expected: Int -> Int -> Bool
+        Actual: Int -> Bool
+    • Possible cause: ‘f1’ is applied to too many arguments
+      In the first argument of ‘foo’, namely ‘(f1 2 3)’
+      In the expression: foo (f1 2 3)
+      In an equation for ‘g1’: g1 = foo (f1 2 3)
+
+too-many.hs:16:11: error:
+    • Couldn't match expected type ‘Int -> Int -> Bool’
+                  with actual type ‘Bool’
+    • In the first argument of ‘foo’, namely ‘(f2 2)’
+      In the expression: foo (f2 2)
+      In an equation for ‘g2’: g2 = foo (f2 2)
diff --git a/testsuite/tests/warnings/should_compile/PluralS.stderr b/testsuite/tests/warnings/should_compile/PluralS.stderr
index 42c81daf5f..53ed5c4633 100644
--- a/testsuite/tests/warnings/should_compile/PluralS.stderr
+++ b/testsuite/tests/warnings/should_compile/PluralS.stderr
@@ -8,7 +8,7 @@ PluralS.hs:15:17: warning: [-Wtype-defaults (in -Wall)]
 
 PluralS.hs:17:24: warning: [-Wtype-defaults (in -Wall)]
     • Defaulting the following constraints to type ‘Integer’
-        (Show a0) arising from a use of ‘show’ at PluralS.hs:17:24-31
+        (Show a0) arising from a use of ‘show’ at PluralS.hs:17:24-27
         (Num a0) arising from the literal ‘123’ at PluralS.hs:17:29-31
     • In the expression: show 123
       In an equation for ‘defaultingNumAndShow’: