Preserve coercion axioms when thinning.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Thu, 19 Jan 2017 00:17:04 +0000 (16:17 -0800)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Sun, 22 Jan 2017 20:05:15 +0000 (12:05 -0800)
Forgot to handle these!  In they go, plus a test case.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
compiler/typecheck/TcBackpack.hs
testsuite/tests/backpack/should_compile/all.T
testsuite/tests/backpack/should_compile/bkp50.bkp [new file with mode: 0644]
testsuite/tests/backpack/should_compile/bkp50.stderr [new file with mode: 0644]

index 5c61871..d74cf51 100644 (file)
@@ -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@IfaceFamily{} =
+    case ifFamFlav d of
+        IfaceClosedSynFamilyTyCon (Just (n, _))
+            -> [n]
+        _   -> []
+ifaceDeclNonExportedRefs _ = []
+
 
 -- Note [Blank hsigs for all requirements]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
index 33d0357..9897c03 100644 (file)
@@ -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_compile/bkp50.bkp b/testsuite/tests/backpack/should_compile/bkp50.bkp
new file mode 100644 (file)
index 0000000..2dcee80
--- /dev/null
@@ -0,0 +1,8 @@
+{-# LANGUAGE TypeFamilies #-}
+unit p where
+    signature A where
+        type family F a where
+            F a = Int
+unit q where
+    dependency p[A=<A>]
+    signature A(F) where
diff --git a/testsuite/tests/backpack/should_compile/bkp50.stderr b/testsuite/tests/backpack/should_compile/bkp50.stderr
new file mode 100644 (file)
index 0000000..d8f64f0
--- /dev/null
@@ -0,0 +1,4 @@
+[1 of 2] Processing p
+  [1 of 1] Compiling A[sig]           ( p/A.hsig, nothing )
+[2 of 2] Processing q
+  [1 of 1] Compiling A[sig]           ( q/A.hsig, nothing )