Clean up the conflicting data family instances error message
authorRyan Scott <ryan.gl.scott@gmail.com>
Thu, 24 May 2018 14:33:51 +0000 (10:33 -0400)
committerRyan Scott <ryan.gl.scott@gmail.com>
Thu, 24 May 2018 14:33:51 +0000 (10:33 -0400)
Summary:
The way we were pretty-printing conflicting data family
instances in an error message was far from ideal:

1. If a data type had no constructors, it would print an equals sign
   with nothing to the right of it.
2. It would try to print GADTs using Haskell98 syntax.
3. It eta-reduced away some type variables from the LHS.

This patch addresses these three issues:

1. We no longer print constructors at all in this error message.
   There's really no reason to do so in the first place, since
   duplicate data family instances always conflict, regardless of
   their constructors.
2. Since we no longer print constructors, we no longer have to
   worry about whether we're using GADT or Haskell98 syntax.
3. I've put in a fix to ensure that type variables are no longer
   eta-reduced away from the LHS.

Test Plan: make test TEST=T14179

Reviewers: goldfire, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #14179

Differential Revision: https://phabricator.haskell.org/D4711

16 files changed:
compiler/types/Coercion.hs
testsuite/tests/indexed-types/should_fail/Over.stderr
testsuite/tests/indexed-types/should_fail/OverDirectThisMod.stderr
testsuite/tests/indexed-types/should_fail/OverIndirectThisMod.stderr
testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr
testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr
testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr
testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr
testsuite/tests/indexed-types/should_fail/SimpleFail2b.stderr
testsuite/tests/indexed-types/should_fail/T14179.hs [new file with mode: 0644]
testsuite/tests/indexed-types/should_fail/T14179.stderr [new file with mode: 0644]
testsuite/tests/indexed-types/should_fail/T2334A.stderr
testsuite/tests/indexed-types/should_fail/T9371.stderr
testsuite/tests/indexed-types/should_fail/all.T
testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr
testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr

index 3a3231d..d0c5eed 100644 (file)
@@ -169,18 +169,22 @@ Defined here to avoid module loops. CoAxiom is loaded very early on.
 pprCoAxiom :: CoAxiom br -> SDoc
 pprCoAxiom ax@(CoAxiom { co_ax_branches = branches })
   = hang (text "axiom" <+> ppr ax <+> dcolon)
-       2 (vcat (map (ppr_co_ax_branch (const pprType) ax) $ fromBranches branches))
+       2 (vcat (map (ppr_co_ax_branch (\_ ty -> equals <+> pprType ty) ax) $
+                    fromBranches branches))
 
 pprCoAxBranch :: CoAxiom br -> CoAxBranch -> SDoc
 pprCoAxBranch = ppr_co_ax_branch pprRhs
   where
     pprRhs fam_tc rhs
-      | Just (tycon, _) <- splitTyConApp_maybe rhs
-      , isDataFamilyTyCon fam_tc
-      = pprDataCons tycon
+      | isDataFamilyTyCon fam_tc
+      = empty -- Don't bother printing anything for the RHS of a data family
+              -- instance...
 
       | otherwise
-      = ppr rhs
+      = equals <+> ppr rhs
+              -- ...but for a type family instance, do print out the RHS, since
+              -- it might be needed to disambiguate between duplicate instances
+              -- (#14179)
 
 pprCoAxBranchHdr :: CoAxiom br -> BranchIndex -> SDoc
 pprCoAxBranchHdr ax index = pprCoAxBranch ax (coAxiomNthBranch ax index)
@@ -194,8 +198,8 @@ ppr_co_ax_branch ppr_rhs
                           , cab_rhs = rhs
                           , cab_loc = loc })
   = foldr1 (flip hangNotEmpty 2)
-        [ pprUserForAll (mkTyVarBinders Inferred (tvs ++ cvs))
-        , pprTypeApp fam_tc lhs <+> equals <+> ppr_rhs fam_tc rhs
+        [ pprUserForAll (mkTyVarBinders Inferred (ee_tvs ++ cvs))
+        , pprTypeApp fam_tc ee_lhs <+> ppr_rhs fam_tc rhs
         , text "-- Defined" <+> pprLoc loc ]
   where
         pprLoc loc
@@ -206,6 +210,21 @@ ppr_co_ax_branch ppr_rhs
           = text "in" <+>
               quotes (ppr (nameModule name))
 
+        (ee_tvs, ee_lhs)
+          | Just (tycon, tc_args) <- splitTyConApp_maybe rhs
+          , isDataFamilyTyCon fam_tc
+          = -- Eta-expand LHS types, because sometimes data family instances
+            -- are eta-reduced.
+            -- See Note [Eta reduction for data family axioms] in TcInstDecls.
+            let tc_tvs           = tyConTyVars tycon
+                etad_tvs         = dropList tc_args tc_tvs
+                etad_tys         = mkTyVarTys etad_tvs
+                eta_expanded_tvs = tvs `chkAppend` etad_tvs
+                eta_expanded_lhs = lhs `chkAppend` etad_tys
+            in (eta_expanded_tvs, eta_expanded_lhs)
+          | otherwise
+          = (tvs, lhs)
+
 {-
 %************************************************************************
 %*                                                                      *
index 63b8b30..3e0bc44 100644 (file)
@@ -1,8 +1,8 @@
 
 OverB.hs:7:15: error:
     Conflicting family instance declarations:
-      C [Int] [a] = CListList2 -- Defined at OverB.hs:7:15
-      C [a] [Int] = C9ListList -- Defined at OverC.hs:7:15
+      C [Int] [a] -- Defined at OverB.hs:7:15
+      C [a] [Int] -- Defined at OverC.hs:7:15
 
 OverB.hs:9:15: error:
     Conflicting family instance declarations:
index 28c72df..99a3377 100644 (file)
@@ -1,8 +1,8 @@
 
 OverDirectThisModB.hs:7:15: error:
     Conflicting family instance declarations:
-      C [Int] [a] = CListList2 -- Defined at OverDirectThisModB.hs:7:15
-      C [a] [Int] = C9ListList -- Defined at OverDirectThisModC.hs:10:15
+      C [Int] [a] -- Defined at OverDirectThisModB.hs:7:15
+      C [a] [Int] -- Defined at OverDirectThisModC.hs:10:15
 
 OverDirectThisModB.hs:9:15: error:
     Conflicting family instance declarations:
index 53c93e8..af13670 100644 (file)
@@ -1,10 +1,8 @@
 
 OverIndirectThisModB.hs:7:15: error:
     Conflicting family instance declarations:
-      C [Int] [a] = OverIndirectThisModB.CListList2
-        -- Defined at OverIndirectThisModB.hs:7:15
-      C [a] [Int] = C9ListList
-        -- Defined at OverIndirectThisModD.hs:11:15
+      C [Int] [a] -- Defined at OverIndirectThisModB.hs:7:15
+      C [a] [Int] -- Defined at OverIndirectThisModD.hs:11:15
 
 OverIndirectThisModB.hs:9:15: error:
     Conflicting family instance declarations:
index d467019..41ed865 100644 (file)
@@ -1,10 +1,10 @@
 
-SimpleFail11a.hs:6:15:
+SimpleFail11a.hs:6:15: error:
     Conflicting family instance declarations:
-      C9 Int Int = C9IntInt -- Defined at SimpleFail11a.hs:6:15
-      C9 Int Int = C9IntInt2 -- Defined at SimpleFail11a.hs:8:15
+      C9 Int Int -- Defined at SimpleFail11a.hs:6:15
+      C9 Int Int -- Defined at SimpleFail11a.hs:8:15
 
-SimpleFail11a.hs:11:15:
+SimpleFail11a.hs:11:15: error:
     Conflicting family instance declarations:
       D9 Int Int = Char -- Defined at SimpleFail11a.hs:11:15
       D9 Int Int = Int -- Defined at SimpleFail11a.hs:13:15
index e40a3a6..bd05039 100644 (file)
@@ -1,10 +1,10 @@
 
-SimpleFail11b.hs:7:15:
+SimpleFail11b.hs:7:15: error:
     Conflicting family instance declarations:
-      C9 [a] Int = C9ListInt -- Defined at SimpleFail11b.hs:7:15
-      C9 [a] Int = C9ListInt2 -- Defined at SimpleFail11b.hs:9:15
+      C9 [a] Int -- Defined at SimpleFail11b.hs:7:15
+      C9 [a] Int -- Defined at SimpleFail11b.hs:9:15
 
-SimpleFail11b.hs:13:15:
+SimpleFail11b.hs:13:15: error:
     Conflicting family instance declarations:
       D9 [a] Int = [a] -- Defined at SimpleFail11b.hs:13:15
       D9 [a] Int = Maybe a -- Defined at SimpleFail11b.hs:15:15
index d4a1bb4..cbb4579 100644 (file)
@@ -1,10 +1,10 @@
 
-SimpleFail11c.hs:7:15:
+SimpleFail11c.hs:7:15: error:
     Conflicting family instance declarations:
-      C9 [a] Int = C9ListInt -- Defined at SimpleFail11c.hs:7:15
-      C9 [Int] Int = C9ListInt2 -- Defined at SimpleFail11c.hs:9:15
+      C9 [a] Int -- Defined at SimpleFail11c.hs:7:15
+      C9 [Int] Int -- Defined at SimpleFail11c.hs:9:15
 
-SimpleFail11c.hs:13:15:
+SimpleFail11c.hs:13:15: error:
     Conflicting family instance declarations:
       D9 [a] Int = [a] -- Defined at SimpleFail11c.hs:13:15
       D9 [Int] Int = [Bool] -- Defined at SimpleFail11c.hs:15:15
index cdd8afd..48d3c33 100644 (file)
@@ -1,5 +1,5 @@
 
-SimpleFail11d.hs:8:15:
+SimpleFail11d.hs:8:15: error:
     Conflicting family instance declarations:
-      C9 [Int] [a] = C9ListList2 -- Defined at SimpleFail11d.hs:8:15
-      C9 [a] [Int] = C9ListList -- Defined at SimpleFail11d.hs:10:15
+      C9 [Int] [a] -- Defined at SimpleFail11d.hs:8:15
+      C9 [a] [Int] -- Defined at SimpleFail11d.hs:10:15
index bb0aaca..88fdfe1 100644 (file)
@@ -1,5 +1,5 @@
 
-SimpleFail2b.hs:9:11:
+SimpleFail2b.hs:9:11: error:
     Conflicting family instance declarations:
-      Sd Int = SdC1 Char -- Defined at SimpleFail2b.hs:9:11
-      Sd Int = SdC2 Char -- Defined at SimpleFail2b.hs:10:11
+      Sd Int -- Defined at SimpleFail2b.hs:9:11
+      Sd Int -- Defined at SimpleFail2b.hs:10:11
diff --git a/testsuite/tests/indexed-types/should_fail/T14179.hs b/testsuite/tests/indexed-types/should_fail/T14179.hs
new file mode 100644 (file)
index 0000000..60c8a94
--- /dev/null
@@ -0,0 +1,20 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+module T14179 where
+
+data family   Foo1 a
+data instance Foo1 a
+data instance Foo1 a
+
+data family   Foo2 :: k -> *
+data instance Foo2 :: * -> *
+data instance Foo2 :: * -> *
+
+data family Foo3 a
+data instance Foo3 [a] where
+  Foo3a :: Foo3 [Int]
+  Foo3b :: Foo3 [Bool]
+data instance Foo3 [a] where
+  Foo3c :: Foo3 [a]
+  Foo3d :: Foo3 [Char]
diff --git a/testsuite/tests/indexed-types/should_fail/T14179.stderr b/testsuite/tests/indexed-types/should_fail/T14179.stderr
new file mode 100644 (file)
index 0000000..38d77f1
--- /dev/null
@@ -0,0 +1,15 @@
+
+T14179.hs:7:15: error:
+    Conflicting family instance declarations:
+      Foo1 a -- Defined at T14179.hs:7:15
+      Foo1 a -- Defined at T14179.hs:8:15
+
+T14179.hs:11:15: error:
+    Conflicting family instance declarations:
+      Foo2 a -- Defined at T14179.hs:11:15
+      Foo2 a -- Defined at T14179.hs:12:15
+
+T14179.hs:15:15: error:
+    Conflicting family instance declarations:
+      Foo3 [a] -- Defined at T14179.hs:15:15
+      Foo3 [a] -- Defined at T14179.hs:18:15
index 7b7d265..a5bc0a0 100644 (file)
@@ -1,17 +1,17 @@
 
-T2334A.hs:9:26:
-    The constructor of a newtype must have exactly one field
-      but ‘F’ has two
-    In the definition of data constructor ‘F’
-    In the newtype instance declaration for ‘F’
+T2334A.hs:9:26: error:
+    • The constructor of a newtype must have exactly one field
+        but ‘F’ has two
+    • In the definition of data constructor ‘F’
+      In the newtype instance declaration for ‘F’
 
-T2334A.hs:10:27:
-    The constructor of a newtype must have exactly one field
-      but ‘H’ has none
-    In the definition of data constructor ‘H’
-    In the newtype instance declaration for ‘F’
+T2334A.hs:10:27: error:
+    • The constructor of a newtype must have exactly one field
+        but ‘H’ has none
+    • In the definition of data constructor ‘H’
+      In the newtype instance declaration for ‘F’
 
-T2334A.hs:12:15:
+T2334A.hs:12:15: error:
     Conflicting family instance declarations:
-      F Bool = K1 -- Defined at T2334A.hs:12:15
-      F Bool = K2 -- Defined at T2334A.hs:13:15
+      F Bool -- Defined at T2334A.hs:12:15
+      F Bool -- Defined at T2334A.hs:13:15
index 729ee3a..9207ac5 100644 (file)
@@ -1,5 +1,5 @@
 
-T9371.hs:14:10:
+T9371.hs:14:10: error:
     Conflicting family instance declarations:
-      D = D1 (Either x ()) -- Defined at T9371.hs:14:10
-      D (x, y) = D2 (x, y) -- Defined at T9371.hs:18:10
+      D x -- Defined at T9371.hs:14:10
+      D (x, y) -- Defined at T9371.hs:18:10
index 61025d6..80ea5da 100644 (file)
@@ -140,5 +140,6 @@ test('T13972', normal, compile_fail, [''])
 test('T14033', normal, compile_fail, [''])
 test('T14045a', normal, compile_fail, [''])
 test('T14175', normal, compile_fail, [''])
+test('T14179', normal, compile_fail, [''])
 test('T14369', normal, compile_fail, [''])
 test('T15172', normal, compile_fail, [''])
index 4a94901..4e0975e 100644 (file)
@@ -15,7 +15,7 @@ TYPE CONSTRUCTORS
   data family Sing (a :: k)
 COERCION AXIOMS
   axiom DataFamilyInstanceLHS.D:R:SingMyKind_0 ::
-    Sing = DataFamilyInstanceLHS.R:SingMyKind_
+    Sing = DataFamilyInstanceLHS.R:SingMyKind_
       -- Defined at DataFamilyInstanceLHS.hs:8:15
 FAMILY INSTANCES
   data instance Sing
index c3c383b..8fae725 100644 (file)
@@ -14,7 +14,7 @@ TYPE CONSTRUCTORS
   data family Sing (a :: k)
 COERCION AXIOMS
   axiom NamedWildcardInDataFamilyInstanceLHS.D:R:SingMyKind_a0 ::
-    Sing = NamedWildcardInDataFamilyInstanceLHS.R:SingMyKind_a
+    Sing _a = NamedWildcardInDataFamilyInstanceLHS.R:SingMyKind_a
       -- Defined at NamedWildcardInDataFamilyInstanceLHS.hs:8:15
 FAMILY INSTANCES
   data instance Sing