import Name
import Outputable
import Maybes
-import Monad
import Unify
import Util
import SrcLoc
import BasicTypes
import Bag
+import Control.Monad
import Data.List
\end{code}
; checkValidTypeInst t_typats t_rhs
-- (4) construct representation tycon
- ; rep_tc_name <- newFamInstTyConName tc_name loc
+ ; rep_tc_name <- newFamInstTyConName tc_name t_typats loc
; buildSynTyCon rep_tc_name t_tvs (SynonymTyCon t_rhs)
(typeKind t_rhs) (Just (family, t_typats))
}}
newtypeConError tc_name (length k_cons)
-- (4) construct representation tycon
- ; rep_tc_name <- newFamInstTyConName tc_name loc
+ ; rep_tc_name <- newFamInstTyConName tc_name t_typats loc
; let ex_ok = True -- Existentials ok for type families!
; fixM (\ rep_tycon -> do
{ let orig_res_ty = mkTyConApp fam_tycon t_typats
-- Add catch-all default case unless the case is exhaustive
-- We do this explicitly so that we get a nice error message that
-- mentions this particular record selector
- deflt | length cons_w_field == length all_cons = []
+ deflt | not (any is_unused all_cons) = []
| otherwise = [mkSimpleMatch [nlWildPat]
(nlHsApp (nlHsVar (getName rEC_SEL_ERROR_ID))
(nlHsLit msg_lit))]
- unit_rhs = L loc $ ExplicitTuple [] Boxed
+ -- Do not add a default case unless there are unmatched
+ -- constructors. We must take account of GADTs, else we
+ -- get overlap warning messages from the pattern-match checker
+ is_unused con = not (con `elem` cons_w_field
+ || dataConCannotMatch inst_tys con)
+ inst_tys = tyConAppArgs data_ty
+
+ unit_rhs = mkLHsTupleExpr []
msg_lit = HsStringPrim $ mkFastString $
occNameString (getOccName sel_name)