[project @ 2001-08-24 12:47:04 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcBinds.lhs

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index 7f630a3..9ace4e4 100644 (file)
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -28,7 +28,7 @@ import TcEnv          ( tcExtendLocalValEnv,
                          newSpecPragmaId, newLocalId
                        )
 import TcSimplify      ( tcSimplifyInfer, tcSimplifyInferCheck, tcSimplifyRestricted, tcSimplifyToDicts )
-import TcMonoType      ( tcHsSigType, checkSigTyVars,
+import TcMonoType      ( tcHsSigType, UserTypeCtxt(..), checkSigTyVars,
                          TcSigInfo(..), tcTySig, maybeSig, sigCtxt
                        )
 import TcPat           ( tcPat )
@@ -736,7 +736,7 @@ tcSpecSigs (SpecSig name poly_ty src_loc : sigs)
     tcAddErrCtxt (valSpecSigCtxt name poly_ty) $
 
        -- Get and instantiate its alleged specialised type
-    tcHsSigType poly_ty                                `thenTc` \ sig_ty ->
+    tcHsSigType (FunSigCtxt name) poly_ty      `thenTc` \ sig_ty ->
 
        -- Check that f has a more general type, and build a RHS for
        -- the spec-pragma-id at the same time
@@ -780,9 +780,10 @@ valSpecSigCtxt v ty
 sigContextsErr = ptext SLIT("Mismatched contexts")
 
 sigContextsCtxt s1 s2
-  = hang (hsep [ptext SLIT("When matching the contexts of the signatures for"), 
-               quotes (ppr s1), ptext SLIT("and"), quotes (ppr s2)])
-        4 (ptext SLIT("(the signature contexts in a mutually recursive group should all be identical)"))
+  = vcat [ptext SLIT("When matching the contexts of the signatures for"), 
+         nest 2 (vcat [ppr s1 <+> dcolon <+> ppr (idType s1),
+                       ppr s2 <+> dcolon <+> ppr (idType s2)]),
+         ptext SLIT("The signature contexts in a mutually recursive group should all be identical")]
 
 -----------------------------------------------
 unliftedBindErr flavour mbind