Improve SPECIALIZE pragma error messages (Fixes #12126)

6 files changed, 10 insertions, 8 deletions

diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 3089f042a7..68b9f00798 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -1151,9 +1151,11 @@ hsSigDoc (ClassOpSig _ is_deflt _ _)
  | is_deflt                     = text "default type signature"
  | otherwise                    = text "class method signature"
 hsSigDoc (IdSig {})             = text "id signature"
-hsSigDoc (SpecSig {})           = text "SPECIALISE pragma"
+hsSigDoc (SpecSig _ _ _ inl)
+                                = ppr inl <+> text "pragma"
 hsSigDoc (InlineSig _ _ prag)   = ppr (inlinePragmaSpec prag) <+> text "pragma"
-hsSigDoc (SpecInstSig {})       = text "SPECIALISE instance pragma"
+hsSigDoc (SpecInstSig _ src _)
+                                = pprWithSourceText src empty <+> text "instance pragma"
 hsSigDoc (FixSig {})            = text "fixity declaration"
 hsSigDoc (MinimalSig {})        = text "MINIMAL pragma"
 hsSigDoc (SCCFunSig {})         = text "SCC pragma"
@@ -1187,7 +1189,7 @@ ppr_sig (InlineSig _ var inl)
   = pragSrcBrackets (inl_src inl) "{-# INLINE"  (pprInline inl
                                    <+> pprPrefixOcc (unLoc var))
 ppr_sig (SpecInstSig _ src ty)
-  = pragSrcBrackets src "{-# SPECIALISE" (text "instance" <+> ppr ty)
+  = pragSrcBrackets src "{-# pragma" (text "instance" <+> ppr ty)
 ppr_sig (MinimalSig _ src bf)
   = pragSrcBrackets src "{-# MINIMAL" (pprMinimalSig bf)
 ppr_sig (PatSynSig _ names sig_ty)
diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs
index 16150dfec7..ff71a6f430 100644
--- a/compiler/typecheck/TcInstDcls.hs
+++ b/compiler/typecheck/TcInstDcls.hs
@@ -2133,7 +2133,7 @@ tcSpecInst dfun_id prag@(SpecInstSig _ _ hs_ty)
         ; co_fn <- tcSpecWrapper SpecInstCtxt (idType dfun_id) spec_dfun_ty
         ; return (SpecPrag dfun_id co_fn defaultInlinePragma) }
   where
-    spec_ctxt prag = hang (text "In the SPECIALISE pragma") 2 (ppr prag)
+    spec_ctxt prag = hang (text "In the pragma:") 2 (ppr prag)
 
 tcSpecInst _  _ = panic "tcSpecInst"
 
diff --git a/compiler/typecheck/TcOrigin.hs b/compiler/typecheck/TcOrigin.hs
index 43bf617749..5a33300918 100644
--- a/compiler/typecheck/TcOrigin.hs
+++ b/compiler/typecheck/TcOrigin.hs
@@ -547,7 +547,7 @@ pprCtOrigin (GivenOrigin sk) = ctoHerald <+> ppr sk
 
 pprCtOrigin (SpecPragOrigin ctxt)
   = case ctxt of
-       FunSigCtxt n _ -> text "a SPECIALISE pragma for" <+> quotes (ppr n)
+       FunSigCtxt n _ -> text "for" <+> quotes (ppr n)
        SpecInstCtxt   -> text "a SPECIALISE INSTANCE pragma"
        _              -> text "a SPECIALISE pragma"  -- Never happens I think
 
diff --git a/compiler/typecheck/TcSigs.hs b/compiler/typecheck/TcSigs.hs
index 9d03576ae0..b4ef967fcb 100644
--- a/compiler/typecheck/TcSigs.hs
+++ b/compiler/typecheck/TcSigs.hs
@@ -766,7 +766,7 @@ tcSpecPrag poly_id prag@(SpecSig _ fun_name hs_tys inl)
   where
     name      = idName poly_id
     poly_ty   = idType poly_id
-    spec_ctxt prag = hang (text "In the SPECIALISE pragma") 2 (ppr prag)
+    spec_ctxt prag = hang (text "In the pragma:") 2 (ppr prag)
 
     tc_one hs_ty
       = do { spec_ty <- tcHsSigType   (FunSigCtxt name False) hs_ty
diff --git a/testsuite/tests/parser/should_fail/T7848.stderr b/testsuite/tests/parser/should_fail/T7848.stderr
index 413920dbe6..9c80704c43 100644
--- a/testsuite/tests/parser/should_fail/T7848.stderr
+++ b/testsuite/tests/parser/should_fail/T7848.stderr
@@ -5,7 +5,7 @@ T7848.hs:10:9: error:
         the type signature for:
           (&) :: forall a. a
         at T7848.hs:10:9-35
-    • In the SPECIALISE pragma {-# SPECIALIZE (&) :: a #-}
+    • In the pragma: {-# SPECIALIZE (&) :: a #-}
       In an equation for ‘x’:
           x (+) ((&)@z) ((:&&) a b) (c :&& d) (e `A` f) (A g h)
             = y
diff --git a/testsuite/tests/rename/should_fail/Misplaced.stderr b/testsuite/tests/rename/should_fail/Misplaced.stderr
index 610281ca5c..85f2d9e4e4 100644
--- a/testsuite/tests/rename/should_fail/Misplaced.stderr
+++ b/testsuite/tests/rename/should_fail/Misplaced.stderr
@@ -1,4 +1,4 @@
 
 Misplaced.hs:4:1: error:
-    Misplaced SPECIALISE instance pragma:
+    Misplaced {-# SPECIALISE instance pragma:
     {-# SPECIALISE instance Eq (T Int) #-}