Fix #13214 by correctly setting up dep_orphs for signatures.

Prior to this, I hadn't thought about orphan handling at all.
This commit implements the semantics that if a signature
(transitively) imports an orphan instance, that instance
is considered in scope no matter what the implementing module
is.  (As it turns out, this is the semantics that falls out
when orphans are recorded transitively.)

This patch fixes a few bugs:

1. Put semantic modules in dep_orphs rather than identity
   modules.
2. Don't put the implementing module in dep_orphs when
   merging signatures (this is a silly bug that happened
   because we were reusing calculateAvails, which is
   designed for imports. It mostly works for signature
   merging, except this case.)
3. When renaming a signature, blast in the orphans of the
   implementing module inside Dependencies.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: bgamari, austin

Reviewed By: bgamari

Subscribers: thomie

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

3 files changed, 33 insertions, 6 deletions

diff --git a/compiler/backpack/RnModIface.hs b/compiler/backpack/RnModIface.hs
index e32bb74e48..d77d061fb9 100644
--- a/compiler/backpack/RnModIface.hs
+++ b/compiler/backpack/RnModIface.hs
@@ -103,6 +103,7 @@ rnModIface hsc_env insts nsubst iface = do
         decls <- mapM rnIfaceDecl' (mi_decls iface)
         insts <- mapM rnIfaceClsInst (mi_insts iface)
         fams <- mapM rnIfaceFamInst (mi_fam_insts iface)
+        deps <- rnDependencies (mi_deps iface)
         -- TODO:
         -- mi_rules
         -- mi_vect_info (LOW PRIORITY)
@@ -111,7 +112,8 @@ rnModIface hsc_env insts nsubst iface = do
                      , mi_insts = insts
                      , mi_fam_insts = fams
                      , mi_exports = exports
-                     , mi_decls = decls }
+                     , mi_decls = decls
+                     , mi_deps = deps }
 
 -- | Rename just the exports of a 'ModIface'.  Useful when we're doing
 -- shaping prior to signature merging.
@@ -120,6 +122,26 @@ rnModExports hsc_env insts iface
     = initRnIface hsc_env iface insts Nothing
     $ mapM rnAvailInfo (mi_exports iface)
 
+rnDependencies :: Rename Dependencies
+rnDependencies deps = do
+    orphs  <- rnDepModules dep_orphs deps
+    finsts <- rnDepModules dep_finsts deps
+    return deps { dep_orphs = orphs, dep_finsts = finsts }
+
+rnDepModules :: (Dependencies -> [Module]) -> Dependencies -> ShIfM [Module]
+rnDepModules sel deps = do
+    hsc_env <- getTopEnv
+    hmap <- getHoleSubst
+    -- NB: It's not necessary to test if we're doing signature renaming,
+    -- because ModIface will never contain module reference for itself
+    -- in these dependencies.
+    fmap (nubSort . concat) . T.forM (sel deps) $ \mod -> do
+        dflags <- getDynFlags
+        let mod' = renameHoleModule dflags hmap mod
+        iface <- liftIO . initIfaceCheck (text "rnDepModule") hsc_env
+                        $ loadSysInterface (text "rnDepModule") mod'
+        return (mod' : sel (mi_deps iface))
+
 {-
 ************************************************************************
 *                                                                      *
diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 2cde294678..dc9cdd9063 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -321,6 +321,7 @@ calculateAvails :: DynFlags
                 -> ImportAvails
 calculateAvails dflags iface mod_safe' want_boot =
   let imp_mod    = mi_module iface
+      imp_sem_mod= mi_semantic_module iface
       orph_iface = mi_orphan iface
       has_finsts = mi_finsts iface
       deps       = mi_deps iface
@@ -353,12 +354,12 @@ calculateAvails dflags iface mod_safe' want_boot =
       -- 'imp_finsts' if it defines an orphan or instance family; thus the
       -- orph_iface/has_iface tests.
 
-      orphans | orph_iface = ASSERT( not (imp_mod `elem` dep_orphs deps) )
-                             imp_mod : dep_orphs deps
+      orphans | orph_iface = ASSERT2( not (imp_sem_mod `elem` dep_orphs deps), ppr imp_sem_mod <+> ppr (dep_orphs deps) )
+                             imp_sem_mod : dep_orphs deps
               | otherwise  = dep_orphs deps
 
-      finsts | has_finsts = ASSERT( not (imp_mod `elem` dep_finsts deps) )
-                            imp_mod : dep_finsts deps
+      finsts | has_finsts = ASSERT2( not (imp_sem_mod `elem` dep_finsts deps), ppr imp_sem_mod <+> ppr (dep_orphs deps) )
+                            imp_sem_mod : dep_finsts deps
              | otherwise  = dep_finsts deps
 
       pkg = moduleUnitId (mi_module iface)
diff --git a/compiler/typecheck/TcBackpack.hs b/compiler/typecheck/TcBackpack.hs
index ce8ab7a970..fef586f69c 100644
--- a/compiler/typecheck/TcBackpack.hs
+++ b/compiler/typecheck/TcBackpack.hs
@@ -689,8 +689,12 @@ mergeSignatures hsmod lcl_iface0 = do
             (insts, inst_env) = foldl' merge_inst
                                     (tcg_insts tcg_env, tcg_inst_env tcg_env)
                                     (md_insts details)
+            -- This is a HACK to prevent calculateAvails from including imp_mod
+            -- in the listing.  We don't want it because a module is NOT
+            -- supposed to include itself in its dep_orphs/dep_finsts.  See #13214
+            iface' = iface { mi_orphan = False, mi_finsts = False }
             avails = plusImportAvails (tcg_imports tcg_env)
-                                      (calculateAvails dflags iface False False)
+                                      (calculateAvails dflags iface' False False)
         return tcg_env {
             tcg_inst_env = inst_env,
             tcg_insts    = insts,