Check local type family instances against all imported ones

We previously checked type family instance declarations
in a module for consistency with all instances that we happened
to have read into the EPS or HPT. It was possible to arrange that
an imported type family instance (used by an imported function)
was in a module whose interface file was never read during
compilation; then we wouldn't check consistency of local instances
with this imported instance and as a result type safety was lost.

With this patch, we still check consistency of local type family
instances with all type family instances that we have loaded; but
we make sure to load the interface files of all our imports that
define family instances first. More selective consistency checking
is left to #13102.

On the other hand, we can now safely assume when we import a module
that it has been checked for consistency with its imports. So we
can save checking in checkFamInstConsistency, and overall we should
have less work to do now.

This patch also adds a note describing the Plan for ensuring type
family consistency.

Test Plan: Two new tests added; harbormaster

Reviewers: austin, simonpj, bgamari

Reviewed By: simonpj, bgamari

Subscribers: ggreif, thomie

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

20 files changed, 135 insertions, 2 deletions

diff --git a/testsuite/tests/ghci/scripts/T4175.stdout b/testsuite/tests/ghci/scripts/T4175.stdout
index d96a2ef9eb..994886cc4a 100644
--- a/testsuite/tests/ghci/scripts/T4175.stdout
+++ b/testsuite/tests/ghci/scripts/T4175.stdout
@@ -28,9 +28,9 @@ instance Show () -- Defined in ‘GHC.Show’
 type instance D () a = Bool 	-- Defined at T4175.hs:22:10
 data instance B () = MkB 	-- Defined at T4175.hs:13:15
 data Maybe a = Nothing | Just a 	-- Defined in ‘GHC.Base’
-instance Foldable Maybe -- Defined in ‘Data.Foldable’
 instance Traversable Maybe -- Defined in ‘Data.Traversable’
 instance Monoid a => Monoid (Maybe a) -- Defined in ‘GHC.Base’
+instance Foldable Maybe -- Defined in ‘Data.Foldable’
 instance Read a => Read (Maybe a) -- Defined in ‘GHC.Read’
 instance Applicative Maybe -- Defined in ‘GHC.Base’
 instance Functor Maybe -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/indexed-types/should_compile/T13092b/Makefile b/testsuite/tests/indexed-types/should_compile/T13092b/Makefile
new file mode 100644
index 0000000000..2b498980c4
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T13092b/Makefile
@@ -0,0 +1,10 @@
+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T13092b:
+	rm -f T13092b_[12].hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T13092b_1.hs -ddump-if-trace 2> if.out
+	grep 'Reading interface for .*:GHC.Generics' if.out > /dev/null
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T13092b_2.hs -ddump-if-trace 2> if.out
+	! grep 'Reading interface for .*:GHC.Generics' if.out
diff --git a/testsuite/tests/indexed-types/should_compile/T13092b/T13092b_1.hs b/testsuite/tests/indexed-types/should_compile/T13092b/T13092b_1.hs
new file mode 100644
index 0000000000..4d13c1580d
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T13092b/T13092b_1.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies, DeriveGeneric #-}
+
+module T13092b_1 where
+
+import GHC.Generics
+
+data X = X deriving (Generic)
diff --git a/testsuite/tests/indexed-types/should_compile/T13092b/T13092b_2.hs b/testsuite/tests/indexed-types/should_compile/T13092b/T13092b_2.hs
new file mode 100644
index 0000000000..14e1ff8dcc
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T13092b/T13092b_2.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T13092b_2 where
+
+import T13092b_1
+
+x :: X
+x = X
diff --git a/testsuite/tests/indexed-types/should_compile/T13092b/all.T b/testsuite/tests/indexed-types/should_compile/T13092b/all.T
new file mode 100644
index 0000000000..a3047a60e5
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T13092b/all.T
@@ -0,0 +1,5 @@
+# Test that we don't load all family instance interface files
+# when importing a module that defines a family instance
+
+test('T13092b', ignore_stdout,
+     run_command, ['$MAKE -s --no-print-directory T13092b'])
diff --git a/testsuite/tests/indexed-types/should_fail/T13092/A.hs b/testsuite/tests/indexed-types/should_fail/T13092/A.hs
new file mode 100644
index 0000000000..a7acce648b
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13092/A.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE TypeFamilies #-}
+module A where
+type family A a
diff --git a/testsuite/tests/indexed-types/should_fail/T13092/B.hs b/testsuite/tests/indexed-types/should_fail/T13092/B.hs
new file mode 100644
index 0000000000..f04248d4a1
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13092/B.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+module B (A, X) where
+import A
+data X
+type instance A (X, b) = ()
diff --git a/testsuite/tests/indexed-types/should_fail/T13092/C.hs b/testsuite/tests/indexed-types/should_fail/T13092/C.hs
new file mode 100644
index 0000000000..73beecf2e8
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13092/C.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE RankNTypes #-}
+module C (x) where
+import Data.Proxy
+import B
+x :: Proxy b -> (forall t. Proxy t -> Bool -> A (t, b)) -> (Bool -> ())
+x _ f = f (undefined :: Proxy X)
diff --git a/testsuite/tests/indexed-types/should_fail/T13092/Main.hs b/testsuite/tests/indexed-types/should_fail/T13092/Main.hs
new file mode 100644
index 0000000000..ee62cf0cbb
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13092/Main.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module Main where
+
+import Data.Proxy
+import A
+import C
+
+data Y
+type instance A (a, Y) = Bool
+
+y :: Proxy a -> Bool -> A (a, Y)
+y _ = id
+
+z :: Bool -> ()
+z = x (undefined :: Proxy Y) y
+
+main = print (z True)
diff --git a/testsuite/tests/indexed-types/should_fail/T13092/Makefile b/testsuite/tests/indexed-types/should_fail/T13092/Makefile
new file mode 100644
index 0000000000..8bd11ac3c2
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13092/Makefile
@@ -0,0 +1,9 @@
+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T13092:
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c A.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c B.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c C.hs
+	! '$(TEST_HC)' $(TEST_HC_OPTS) -c Main.hs
diff --git a/testsuite/tests/indexed-types/should_fail/T13092/T13092.stderr b/testsuite/tests/indexed-types/should_fail/T13092/T13092.stderr
new file mode 100644
index 0000000000..9df66e7cd1
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13092/T13092.stderr
@@ -0,0 +1,5 @@
+
+Main.hs:10:15: error:
+    Conflicting family instance declarations:
+      A (a, Y) = Bool -- Defined at Main.hs:10:15
+      A (B.X, b) = () -- Defined in ‘B’
diff --git a/testsuite/tests/indexed-types/should_fail/T13092/all.T b/testsuite/tests/indexed-types/should_fail/T13092/all.T
new file mode 100644
index 0000000000..090d10db96
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13092/all.T
@@ -0,0 +1,5 @@
+# Test that we check consistency of local type family instances
+# with imported ones
+
+test('T13092', extra_files(['A.hs', 'B.hs', 'C.hs', 'Main.hs']),
+     run_command, ['$MAKE -s --no-print-directory T13092'])
diff --git a/testsuite/tests/indexed-types/should_fail/T13092c/Makefile b/testsuite/tests/indexed-types/should_fail/T13092c/Makefile
new file mode 100644
index 0000000000..29a3b104eb
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13092c/Makefile
@@ -0,0 +1,12 @@
+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T13092c:
+	rm -f T13092c_[1234].hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T13092c_1.hs -ddump-if-trace > /dev/null 2> if.out
+	! grep 'Reading interface for .*:GHC.Generics' if.out
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T13092c_2.hs -ddump-if-trace > /dev/null 2> if.out
+	! grep 'Reading interface for .*:GHC.Generics' if.out
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T13092c_3.hs
+	! '$(TEST_HC)' $(TEST_HC_OPTS) -c T13092c_4.hs
diff --git a/testsuite/tests/indexed-types/should_fail/T13092c/T13092c.stderr b/testsuite/tests/indexed-types/should_fail/T13092c/T13092c.stderr
new file mode 100644
index 0000000000..6676684ec1
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13092c/T13092c.stderr
@@ -0,0 +1,5 @@
+
+T13092c_4.hs:7:15: error:
+    Conflicting family instance declarations:
+      F (a, Char) = String -- Defined at T13092c_4.hs:7:15
+      F (T13092c_2.X, b) = Bool -- Defined in ‘T13092c_2’
diff --git a/testsuite/tests/indexed-types/should_fail/T13092c/T13092c_1.hs b/testsuite/tests/indexed-types/should_fail/T13092c/T13092c_1.hs
new file mode 100644
index 0000000000..dbab1da195
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13092c/T13092c_1.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T13092c_1 where
+
+type family F a
+type instance F Int = ()
diff --git a/testsuite/tests/indexed-types/should_fail/T13092c/T13092c_2.hs b/testsuite/tests/indexed-types/should_fail/T13092c/T13092c_2.hs
new file mode 100644
index 0000000000..0bbf97efdd
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13092c/T13092c_2.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T13092c_2 (F) where
+
+import T13092c_1
+
+data X
+type instance F (X, b) = Bool
diff --git a/testsuite/tests/indexed-types/should_fail/T13092c/T13092c_3.hs b/testsuite/tests/indexed-types/should_fail/T13092c/T13092c_3.hs
new file mode 100644
index 0000000000..08bda736e5
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13092c/T13092c_3.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T13092c_3 (F) where
+
+import T13092c_2
diff --git a/testsuite/tests/indexed-types/should_fail/T13092c/T13092c_4.hs b/testsuite/tests/indexed-types/should_fail/T13092c/T13092c_4.hs
new file mode 100644
index 0000000000..a3273f9bfe
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13092c/T13092c_4.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T13092c_4 where
+
+import T13092c_3
+
+type instance F (a, Char) = String
diff --git a/testsuite/tests/indexed-types/should_fail/T13092c/all.T b/testsuite/tests/indexed-types/should_fail/T13092c/all.T
new file mode 100644
index 0000000000..c4e38be054
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13092c/all.T
@@ -0,0 +1,8 @@
+# Test that we don't load family instance instance files from
+# external packages when defining an instance for a type family
+# defined in the home package, but do read instance files from
+# the home package. (Instance in T13092c_2 overlaps with the one
+# defined in T13092c_4, and would not be read otherwise.)
+
+test('T13092c', ignore_stdout,
+     run_command, ['$MAKE -s --no-print-directory T13092c'])
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 1df1eae0c0..0592bd6800 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -964,10 +964,11 @@ test('T13056',
 
 test('T12707',
      [ compiler_stats_num_field('bytes allocated',
-          [(wordsize(64), 1280336112, 5),
+          [(wordsize(64), 1310037632, 5),
           # initial:    1271577192
           # 2017-01-22: 1348865648  Allow top-level strings in Core
           # 2017-01-31: 1280336112  Join points (#12988)
+          # 2017-02-11: 1310037632  Check local family instances vs imports
           ]),
      ],
      compile,