[commit: ghc] master: Preserve coercion axioms when thinning. (294f95d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/294f95dcc2ae4cd9fdcdfca90173d92ef39a4bea/ghc

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

commit 294f95dcc2ae4cd9fdcdfca90173d92ef39a4bea
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date:   Wed Jan 18 16:17:04 2017 -0800

    Preserve coercion axioms when thinning.
    
    Forgot to handle these!  In they go, plus a test case.
    
    Signed-off-by: Edward Z. Yang <ezyang at cs.stanford.edu>


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

294f95dcc2ae4cd9fdcdfca90173d92ef39a4bea
 compiler/typecheck/TcBackpack.hs                   | 40 +++++++++++++++++-----
 testsuite/tests/backpack/should_compile/all.T      |  1 +
 .../bkpfail42.bkp => should_compile/bkp50.bkp}     |  6 ++--
 .../should_compile/{bkp49.stderr => bkp50.stderr}  |  0
 4 files changed, 35 insertions(+), 12 deletions(-)

diff --git a/compiler/typecheck/TcBackpack.hs b/compiler/typecheck/TcBackpack.hs
index 5c61871..d74cf51 100644
--- a/compiler/typecheck/TcBackpack.hs
+++ b/compiler/typecheck/TcBackpack.hs
@@ -368,18 +368,42 @@ thinModIface avails iface =
         -- perhaps there might be two IfaceTopBndr that are the same
         -- OccName but different Name.  Requires better understanding
         -- of invariants here.
-        mi_decls = filter (decl_pred . snd) (mi_decls iface)
+        mi_decls = exported_decls ++ non_exported_decls ++ dfun_decls
         -- mi_insts = ...,
         -- mi_fam_insts = ...,
     }
   where
-    occs = mkOccSet [ occName n
-                    | a <- avails
-                    , n <- availNames a ]
-    -- NB: Never drop DFuns
-    decl_pred IfaceId{ ifIdDetails = IfDFunId } = True
-    decl_pred decl =
-        nameOccName (ifName decl) `elemOccSet` occs
+    decl_pred occs decl = nameOccName (ifName decl) `elemOccSet` occs
+    filter_decls occs = filter (decl_pred occs . snd) (mi_decls iface)
+
+    exported_occs = mkOccSet [ occName n
+                             | a <- avails
+                             , n <- availNames a ]
+    exported_decls = filter_decls exported_occs
+
+    non_exported_occs = mkOccSet [ occName n
+                                 | (_, d) <- exported_decls
+                                 , n <- ifaceDeclNonExportedRefs d ]
+    non_exported_decls = filter_decls non_exported_occs
+
+    dfun_pred IfaceId{ ifIdDetails = IfDFunId } = True
+    dfun_pred _ = False
+    dfun_decls = filter (dfun_pred . snd) (mi_decls iface)
+
+-- | The list of 'Name's of *non-exported* 'IfaceDecl's which this
+-- 'IfaceDecl' may refer to.  A non-exported 'IfaceDecl' should be kept
+-- after thinning if an *exported* 'IfaceDecl' (or 'mi_insts', perhaps)
+-- refers to it; we can't decide to keep it by looking at the exports
+-- of a module after thinning.  Keep this synchronized with
+-- 'rnIfaceDecl'.
+ifaceDeclNonExportedRefs :: IfaceDecl -> [Name]
+ifaceDeclNonExportedRefs d at IfaceFamily{} =
+    case ifFamFlav d of
+        IfaceClosedSynFamilyTyCon (Just (n, _))
+            -> [n]
+        _   -> []
+ifaceDeclNonExportedRefs _ = []
+
 
 -- Note [Blank hsigs for all requirements]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/testsuite/tests/backpack/should_compile/all.T b/testsuite/tests/backpack/should_compile/all.T
index 33d0357..9897c03 100644
--- a/testsuite/tests/backpack/should_compile/all.T
+++ b/testsuite/tests/backpack/should_compile/all.T
@@ -41,3 +41,4 @@ test('bkp46', normal, backpack_compile, [''])
 test('bkp47', normal, backpack_compile, [''])
 test('bkp48', normal, backpack_compile, [''])
 test('bkp49', normal, backpack_compile, [''])
+test('bkp50', normal, backpack_compile, [''])
diff --git a/testsuite/tests/backpack/should_fail/bkpfail42.bkp b/testsuite/tests/backpack/should_compile/bkp50.bkp
similarity index 67%
copy from testsuite/tests/backpack/should_fail/bkpfail42.bkp
copy to testsuite/tests/backpack/should_compile/bkp50.bkp
index 8face3f..2dcee80 100644
--- a/testsuite/tests/backpack/should_fail/bkpfail42.bkp
+++ b/testsuite/tests/backpack/should_compile/bkp50.bkp
@@ -2,9 +2,7 @@
 unit p where
     signature A where
         type family F a where
-            F a = Bool
+            F a = Int
 unit q where
     dependency p[A=<A>]
-    signature A where
-        type family F a where
-            F a = Int
+    signature A(F) where
diff --git a/testsuite/tests/backpack/should_compile/bkp49.stderr b/testsuite/tests/backpack/should_compile/bkp50.stderr
similarity index 100%
copy from testsuite/tests/backpack/should_compile/bkp49.stderr
copy to testsuite/tests/backpack/should_compile/bkp50.stderr