[project @ 2004-10-18 18:24:59 by igloo]

[ghc-hetmet.git] / ghc / compiler / deSugar / Match.lhs

diff --git a/ghc/compiler/deSugar/Match.lhs b/ghc/compiler/deSugar/Match.lhs
index 150cdc6..ebe503a 100644 (file)
--- a/ghc/compiler/deSugar/Match.lhs
+++ b/ghc/compiler/deSugar/Match.lhs
@@ -67,8 +67,12 @@ matchCheck_really dflags ctx vars ty qs
   | otherwise             =
       match vars ty qs
   where (pats, eqns_shadow) = check qs
-        incomplete    = dopt Opt_WarnIncompletePatterns dflags
-                       && (notNull pats)
+        incomplete    = want_incomplete && (notNull pats)
+        want_incomplete = case ctx of
+                              DsMatchContext RecUpd _ _ ->
+                                  dopt Opt_WarnIncompletePatternsRecUpd dflags
+                              _ ->
+                                  dopt Opt_WarnIncompletePatterns       dflags
         shadow        = dopt Opt_WarnOverlappingPatterns dflags
                        && not (null eqns_shadow)
 \end{code}
@@ -430,8 +434,8 @@ tidy1 v (LazyPat pat) rhs
 
 -- re-express <con-something> as (ConPat ...) [directly]
 
-tidy1 v (ConPatOut con ex_tvs dicts binds ps pat_ty) rhs
-  = returnDs (ConPatOut con ex_tvs dicts binds tidy_ps pat_ty, rhs)
+tidy1 v (ConPatOut (L loc con) ex_tvs dicts binds ps pat_ty) rhs
+  = returnDs (ConPatOut (L loc con) ex_tvs dicts binds tidy_ps pat_ty, rhs)
   where
     tidy_ps = PrefixCon (tidy_con con pat_ty ps)