-\begin{code}
-pprOrigin :: Inst -> SDoc
-pprOrigin inst
- = hsep [text "arising from", pp_orig orig, text "at", ppr locn]
- where
- (orig, locn) = case inst of
- Dict _ _ _ orig loc -> (orig,loc)
- Method _ _ _ _ _ orig loc -> (orig,loc)
- LitInst _ _ _ orig loc -> (orig,loc)
-
- pp_orig (OccurrenceOf id)
- = hsep [ptext SLIT("use of"), quotes (ppr id)]
- pp_orig (OccurrenceOfCon id)
- = hsep [ptext SLIT("use of"), quotes (ppr id)]
- pp_orig (LiteralOrigin lit)
- = hsep [ptext SLIT("the literal"), quotes (ppr lit)]
- pp_orig (PatOrigin pat)
- = hsep [ptext SLIT("the pattern"), quotes (ppr pat)]
- pp_orig (InstanceDeclOrigin)
- = ptext SLIT("an instance declaration")
- pp_orig (ArithSeqOrigin seq)
- = hsep [ptext SLIT("the arithmetic sequence"), quotes (ppr seq)]
- pp_orig (SignatureOrigin)
- = ptext SLIT("a type signature")
- pp_orig (Rank2Origin)
- = ptext SLIT("a function with an overloaded argument type")
- pp_orig (DoOrigin)
- = ptext SLIT("a do statement")
- pp_orig (ClassDeclOrigin)
- = ptext SLIT("a class declaration")
- pp_orig (InstanceSpecOrigin clas ty)
- = hsep [text "a SPECIALIZE instance pragma; class",
- quotes (ppr clas), text "type:", ppr ty]
- pp_orig (ValSpecOrigin name)
- = hsep [ptext SLIT("a SPECIALIZE user-pragma for"), quotes (ppr name)]
- pp_orig (CCallOrigin clabel Nothing{-ccall result-})
- = hsep [ptext SLIT("the result of the _ccall_ to"), quotes (text clabel)]
- pp_orig (CCallOrigin clabel (Just arg_expr))
- = hsep [ptext SLIT("an argument in the _ccall_ to"), quotes (text clabel) <> comma,
- text "namely", quotes (ppr arg_expr)]
- pp_orig (LitLitOrigin s)
- = hsep [ptext SLIT("the ``literal-literal''"), quotes (text s)]
- pp_orig (UnknownOrigin)
- = ptext SLIT("...oops -- I don't know where the overloading came from!")
+syntaxNameCtxt name orig ty tidy_env
+ = getInstLoc orig `thenM` \ inst_loc ->
+ let
+ msg = vcat [ptext SLIT("When checking that") <+> quotes (ppr name) <+>
+ ptext SLIT("(needed by a syntactic construct)"),
+ nest 2 (ptext SLIT("has the required type:") <+> ppr (tidyType tidy_env ty)),
+ nest 2 (pprInstLoc inst_loc)]
+ in
+ returnM (tidy_env, msg)