Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/3394d49af13697626145aca6d80b65ae8661418c

>---------------------------------------------------------------

commit 3394d49af13697626145aca6d80b65ae8661418c
Author: Simon Peyton Jones <simo...@microsoft.com>
Date:   Wed Dec 19 17:37:27 2012 +0000

    Pass the correct inst_tys argument to dataConCannotMatch, in mkRecSelBinds
    
    This fixes Trac #7503.

>---------------------------------------------------------------

 compiler/typecheck/TcTyClsDecls.lhs |   16 ++++++++++------
 1 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/compiler/typecheck/TcTyClsDecls.lhs 
b/compiler/typecheck/TcTyClsDecls.lhs
index 0523dcd..46a9445 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -272,8 +272,7 @@ kcTyClGroup decls
 
          -- Step 1: Bind kind variables for non-synonyms
         ; let (syn_decls, non_syn_decls) = partition (isSynDecl . unLoc) decls
-       ; initial_kinds <- 
-                           getInitialKinds TopLevel non_syn_decls
+       ; initial_kinds <- getInitialKinds TopLevel non_syn_decls
         ; traceTc "kcTyClGroup: initial kinds" (ppr initial_kinds)
 
         -- Step 2: Set initial envt, kind-check the synonyms
@@ -1553,7 +1552,7 @@ mkRecSelBind (tycon, sel_name)
     -- 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 | not (any is_unused all_cons) = []
+    deflt | all dealt_with all_cons = []
          | otherwise = [mkSimpleMatch [L loc (WildPat placeHolderType)] 
                            (mkHsApp (L loc (HsVar (getName rEC_SEL_ERROR_ID)))
                                     (L loc (HsLit msg_lit)))]
@@ -1561,9 +1560,14 @@ mkRecSelBind (tycon, sel_name)
        -- 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
+        -- NB: we need to pass type args for the *representation* TyCon
+        --     to dataConCannotMatch, hence the calculation of inst_tys
+        --     This matters in data families
+        --              data instance T Int a where
+        --                 A :: { fld :: Int } -> T Int Bool
+        --                 B :: { fld :: Int } -> T Int Char
+    dealt_with con = con `elem` cons_w_field || dataConCannotMatch inst_tys con
+    inst_tys = substTyVars (mkTopTvSubst (dataConEqSpec con1)) 
(dataConUnivTyVars con1)
 
     unit_rhs = mkLHsTupleExpr []
     msg_lit = HsStringPrim $ unsafeMkByteString $



_______________________________________________
Cvs-ghc mailing list
Cvs-ghc@haskell.org
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to