diff options
| -rw-r--r-- | compiler/deSugar/DsExpr.lhs | 7 | ||||
| -rw-r--r-- | compiler/deSugar/Match.lhs | 2 |
2 files changed, 6 insertions, 3 deletions
diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs index 03544bb6ae..c9134c9944 100644 --- a/compiler/deSugar/DsExpr.lhs +++ b/compiler/deSugar/DsExpr.lhs @@ -489,8 +489,11 @@ dsExpr expr@(RecordUpd record_expr (HsRecFields { rec_flds = fields }) -- so that everything works when we are doing fancy unboxing on the -- constructor aguments. ; alts <- mapM (mk_alt upd_fld_env) cons_to_upd - ; ([discrim_var], matching_code) - <- matchWrapper RecUpd (MG { mg_alts = alts, mg_arg_tys = [in_ty], mg_res_ty = out_ty, mg_origin = Generated }) + ; ([discrim_var], matching_code) + <- matchWrapper RecUpd (MG { mg_alts = alts, mg_arg_tys = [in_ty] + , mg_res_ty = out_ty, mg_origin = FromSource }) + -- FromSource is not strictly right, but we + -- want incomplete pattern-match warnings ; return (add_field_binds field_binds' $ bindNonRec discrim_var record_expr' matching_code) } diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs index 8bc8a116af..3bbb0ecd32 100644 --- a/compiler/deSugar/Match.lhs +++ b/compiler/deSugar/Match.lhs @@ -79,7 +79,7 @@ matchCheck_really dflags ctx@(DsMatchContext hs_ctx _) vars ty qs ; match vars ty qs } where (pats, eqns_shadow) = check qs - incomplete = incomplete_flag hs_ctx && (notNull pats) + incomplete = incomplete_flag hs_ctx && notNull pats shadow = wopt Opt_WarnOverlappingPatterns dflags && notNull eqns_shadow |