Migrate cvs diff from fptools-assoc branch

[ghc-hetmet.git] / compiler / rename / RnTypes.lhs

diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index d7d435c..055cd34 100644 (file)
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -416,7 +416,14 @@ checkPrecMatch True op (MatchGroup ms _)
       = checkPrec op (unLoc p1) False  `thenM_`
         checkPrec op (unLoc p2) True
 
       = checkPrec op (unLoc p1) False  `thenM_`
         checkPrec op (unLoc p2) True
 

-    check _ = panic "checkPrecMatch"
+    check _ = return ()        
+       -- This can happen.  Consider
+       --      a `op` True = ...
+       --      op          = ...
+       -- The infix flag comes from the first binding of the group
+       -- but the second eqn has no args (an error, but not discovered
+       -- until the type checker).  So we don't want to crash on the
+       -- second eqn.

 
 checkPrec op (ConPatIn op1 (InfixCon _ _)) right
   = lookupFixityRn op          `thenM` \  op_fix@(Fixity op_prec  op_dir) ->
 
 checkPrec op (ConPatIn op1 (InfixCon _ _)) right
   = lookupFixityRn op          `thenM` \  op_fix@(Fixity op_prec  op_dir) ->

@@ -745,12 +752,10 @@ checkTupSize tup_size
 
 forAllWarn doc ty (L loc tyvar)
   = ifOptM Opt_WarnUnusedMatches       $
 
 forAllWarn doc ty (L loc tyvar)
   = ifOptM Opt_WarnUnusedMatches       $

-    setSrcSpan loc $
-    addWarn (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
-                  nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
+    addWarnAt loc (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
+                       nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]

                   $$
                   $$

-                  doc
-                )
+                  doc)

 
 bogusCharError c
   = ptext SLIT("character literal out of range: '\\") <> char c  <> char '\''
 
 bogusCharError c
   = ptext SLIT("character literal out of range: '\\") <> char c  <> char '\''