Filter instance visibility based on set of visible orphans, fixes #2182.ghc-instvis

Summary:
Amazingly, the fix for this very old bug is quite simple: when type-checking,
maintain a set of "visible orphan modules" based on the orphans list of
modules which we explicitly imported.  When we import an instance and it
is an orphan, we check if it is in the visible modules set, and if not,
ignore it.  A little bit of refactoring for when orphan-hood is calculated
happens so that we always know if an instance is an orphan or not.

For GHCi, we preinitialize the visible modules set based on the list of
interactive imports which are active.

Future work: Cache the visible orphan modules set for GHCi, rather than
recomputing it every type-checking round.  (But it's tricky what to do when you
/remove/ a module: you need a data structure a little more complicated than
just a set of modules.)

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

Test Plan: new tests and validate

Reviewers: simonpj, austin

Subscribers: thomie, carter

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

GHC Trac Issues: #2182

2 files changed, 12 insertions, 4 deletions

diff --git a/compiler/vectorise/Vectorise/Env.hs b/compiler/vectorise/Vectorise/Env.hs
index 3358ceafab..098e9c8227 100644
--- a/compiler/vectorise/Vectorise/Env.hs
+++ b/compiler/vectorise/Vectorise/Env.hs
@@ -123,7 +123,7 @@ data GlobalEnv
         , global_pr_funs              :: NameEnv Var
           -- ^Mapping from TyCons to their PR dfuns.
 
-        , global_inst_env             :: (InstEnv, InstEnv)
+        , global_inst_env             :: InstEnvs
           -- ^External package inst-env & home-package inst-env for class instances.
 
         , global_fam_inst_env         :: FamInstEnvs
@@ -139,7 +139,12 @@ data GlobalEnv
 -- to the global table, so that we can query scalarness during vectorisation, and especially, when
 -- vectorising the scalar entities' definitions themselves.
 --
-initGlobalEnv :: Bool -> VectInfo -> [CoreVect] -> (InstEnv, InstEnv) -> FamInstEnvs -> GlobalEnv
+initGlobalEnv :: Bool
+              -> VectInfo
+              -> [CoreVect]
+              -> InstEnvs
+              -> FamInstEnvs
+              -> GlobalEnv
 initGlobalEnv vectAvoid info vectDecls instEnvs famInstEnvs
   = GlobalEnv 
   { global_vect_avoid           = vectAvoid
diff --git a/compiler/vectorise/Vectorise/Monad.hs b/compiler/vectorise/Vectorise/Monad.hs
index b530b3c6a6..3e6c33ac7d 100644
--- a/compiler/vectorise/Vectorise/Monad.hs
+++ b/compiler/vectorise/Vectorise/Monad.hs
@@ -42,6 +42,7 @@ import Id
 import Name
 import ErrUtils
 import Outputable
+import Module
 
 
 -- |Run a vectorisation computation.
@@ -85,7 +86,9 @@ initV hsc_env guts info thing_inside
                -- set up class and type family envrionments
            ; eps <- liftIO $ hscEPS hsc_env
            ; let famInstEnvs = (eps_fam_inst_env eps, mg_fam_inst_env guts)
-                 instEnvs    = (eps_inst_env     eps, mg_inst_env     guts)
+                 instEnvs    = InstEnvs (eps_inst_env     eps)
+                                        (mg_inst_env     guts)
+                                        (mkModuleSet (dep_orphs (mg_deps guts)))
                  builtin_pas = initClassDicts instEnvs (paClass builtins)  -- grab all 'PA' and..
                  builtin_prs = initClassDicts instEnvs (prClass builtins)  -- ..'PR' class instances
 
@@ -114,7 +117,7 @@ initV hsc_env guts info thing_inside
     -- instance dfun for that type constructor and class.  (DPH class instances cannot overlap in
     -- head constructors.)
     --
-    initClassDicts :: (InstEnv, InstEnv) -> Class -> [(Name, Var)]
+    initClassDicts :: InstEnvs -> Class -> [(Name, Var)]
     initClassDicts insts cls = map find $ classInstances insts cls
       where
         find i | [Just tc] <- instanceRoughTcs i = (tc, instanceDFunId i)