[project @ 2003-02-21 14:52:54 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index 90fcb9c..6f8ed08 100644 (file)
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -63,7 +63,7 @@ import VarEnv         ( TidyEnv )
 import FiniteMap
 import Outputable
 import ListSetOps      ( equivClasses )
-import Util            ( zipEqual )
+import Util            ( zipEqual, isSingleton )
 import List            ( partition )
 import CmdLineOpts
 \end{code}
@@ -1608,6 +1608,8 @@ It's OK: the final zonking stage should zap y to (), which is fine.
 
 \begin{code}
 tcSimplifyTop :: [Inst] -> TcM TcDictBinds
+-- The TcLclEnv should be valid here, solely to improve
+-- error message generation for the monomorphism restriction
 tcSimplifyTop wanteds
   = getLclEnv                                                  `thenM` \ lcl_env ->
     traceTc (text "tcSimplifyTop" <+> ppr (lclEnvElts lcl_env))        `thenM_`
@@ -1967,8 +1969,10 @@ addTopAmbigErrs (tidy_env, tidy_dicts)
        where
          dicts = map fst pairs
          msg = sep [text "Ambiguous type variable" <> plural tvs <+> 
-                      pprQuotedList tvs <+> text "in these top-level constraint" <> plural dicts,
+                            pprQuotedList tvs <+> in_msg,
                     nest 2 (pprInstsInFull dicts)]
+         in_msg | isSingleton dicts = text "in the top-level constraint:"
+                | otherwise         = text "in these top-level constraints:"
 
 
 mkMonomorphismMsg :: TidyEnv -> [Inst] -> TcM (TidyEnv, Message)