Merge branch 'partial-sigs' of github.com:mrBliss/ghc-head into parti…

…al-sigs

compiler/parser/RdrHsSyn.lhs

@@ -247,6 +247,10 @@ mkTyFamInstEqn :: LHsType RdrName
                -> P (TyFamInstEqn RdrName)
 mkTyFamInstEqn lhs rhs
   = do { (tc, tparams) <- checkTyClHdr lhs
+       ; let err xhs = ptext (sLit "In type family instance equation of") <+>
+                       quotes (ppr tc) <> colon $$ ppr xhs
+       ; checkNoPartialType (err lhs) lhs
+       ; checkNoPartialType (err rhs) rhs
        ; return (TyFamInstEqn { tfie_tycon = tc
                               , tfie_pats  = mkHsWithBndrs tparams
                               , tfie_rhs   = rhs }) }

testsuite/tests/partial-sigs/should_fail/WildcardInTypeFamilyInstanceLHS.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE PartialTypeSignatures, TypeFamilies, InstanceSigs #-}
+module WildcardInTypeFamilyInstanceLHS where
+
+class Foo k where
+  type Dual k :: *
+
+instance Foo Int where
+  type Dual _ = Maybe Int

testsuite/tests/partial-sigs/should_fail/WildcardInTypeFamilyInstanceLHS.stderr

@@ -0,0 +1,5 @@
+
+WildcardInTypeFamilyInstanceLHS.hs:8:8:
+    Wildcard not allowed
+    In type family instance equation of ‛Dual’:
+    Dual _

testsuite/tests/partial-sigs/should_fail/WildcardInTypeFamilyInstanceRHS.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE PartialTypeSignatures, TypeFamilies, InstanceSigs #-}
+module WildcardInTypeFamilyInstanceRHS where
+
+class Foo k where
+  type Dual k :: *
+
+instance Foo Int where
+  type Dual Int = Maybe _

testsuite/tests/partial-sigs/should_fail/WildcardInTypeFamilyInstanceRHS.stderr

@@ -0,0 +1,5 @@
+
+WildcardInTypeFamilyInstanceRHS.hs:8:19:
+    Wildcard not allowed
+    In type family instance equation of ‛Dual’:
+    Maybe _

testsuite/tests/partial-sigs/should_fail/all.T

@@ -17,5 +17,7 @@ test('WildcardInDeriving', normal, compile_fail, [''])
 test('WildcardInGADT1', normal, compile_fail, [''])
 test('WildcardInGADT2', normal, compile_fail, [''])
 test('WildcardInNewtype', normal, compile_fail, [''])
+test('WildcardInTypeFamilyInstanceLHS', normal, compile_fail, [''])
+test('WildcardInTypeFamilyInstanceRHS', normal, compile_fail, [''])
 test('WildcardInTypeSynonymLHS', normal, compile_fail, [''])
 test('WildcardInTypeSynonymRHS', normal, compile_fail, [''])