[commit: ghc] wip/lazy-instance-matching: InstEnv: Ensure that instance visibility check is lazy (3c2ce1d)

[git at git.haskell.org]

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

On branch  : wip/lazy-instance-matching
Link       : http://ghc.haskell.org/trac/ghc/changeset/3c2ce1d19bc79d05049f220d191676699b3d02f5/ghc

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

commit 3c2ce1d19bc79d05049f220d191676699b3d02f5
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Tue Jul 19 07:39:56 2016 +0200

    InstEnv: Ensure that instance visibility check is lazy
    
    Previously instIsVisible had completely broken the laziness of
    lookupInstEnv' since it would examine is_dfun_name to check the name of
    the defining module (to know whether it is an interactive module). This
    resulted in the visibility check drawing in an interface file
    unnecessarily.


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

3c2ce1d19bc79d05049f220d191676699b3d02f5
 compiler/iface/TcIface.hs |  2 +-
 compiler/types/InstEnv.hs | 27 ++++++++++++++++++---------
 2 files changed, 19 insertions(+), 10 deletions(-)

diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index f366c51..a551c96 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -657,7 +657,7 @@ tcIfaceInst (IfaceClsInst { ifDFun = dfun_occ, ifOFlag = oflag
   = do { dfun <- forkM (text "Dict fun" <+> ppr dfun_occ) $
                  tcIfaceExtId dfun_occ
        ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
-       ; return (mkImportedInstance cls mb_tcs' dfun oflag orph) }
+       ; return (mkImportedInstance cls mb_tcs' dfun_occ dfun oflag orph) }
 
 tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
 tcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
diff --git a/compiler/types/InstEnv.hs b/compiler/types/InstEnv.hs
index a8b5f0f..e87d732 100644
--- a/compiler/types/InstEnv.hs
+++ b/compiler/types/InstEnv.hs
@@ -61,6 +61,12 @@ data ClsInst
                is_cls_nm :: Name  -- Class name
              , is_tcs  :: [Maybe Name]  -- Top of type args
 
+               -- We use this for the visibility check, instIsVisible. Note how
+               -- we cannot use the Module attached to is_dfun, since doing so
+               -- would mean we would potentially pull in an entire interface
+               -- file unnecessarily. This was the cause of #12367.
+             , is_dfun_name :: Name     -- Defining module
+
                 -- Used for "proper matching"; see Note [Proper-match fields]
              , is_tvs  :: [TyVar]       -- Fresh template tyvars for full match
                                         -- See Note [Template tyvars are fresh]
@@ -226,9 +232,10 @@ mkLocalInstance :: DFunId -> OverlapFlag
 mkLocalInstance dfun oflag tvs cls tys
   = ClsInst { is_flag = oflag, is_dfun = dfun
             , is_tvs = tvs
+            , is_dfun_name = dfun_name
             , is_cls = cls, is_cls_nm = cls_name
             , is_tys = tys, is_tcs = roughMatchTcs tys
-            , is_orphan = orph
+            , is_orphan = pprTrace "mkLocalInstance" empty orph
             }
   where
     cls_name = className cls
@@ -257,21 +264,23 @@ mkLocalInstance dfun oflag tvs cls tys
 
     choose_one nss = chooseOrphanAnchor (unionNameSets nss)
 
-mkImportedInstance :: Name
-                   -> [Maybe Name]
-                   -> DFunId
-                   -> OverlapFlag
-                   -> IsOrphan
+mkImportedInstance :: Name         -- ^ the name of the class
+                   -> [Maybe Name] -- ^ the types which the class was applied to
+                   -> Name         -- ^ the 'Name' of the dictionary binding
+                   -> DFunId       -- ^ the 'Id' of the dictionary.
+                   -> OverlapFlag  -- ^ may this instance overlap?
+                   -> IsOrphan     -- ^ is this instance an orphan?
                    -> ClsInst
 -- Used for imported instances, where we get the rough-match stuff
 -- from the interface file
 -- The bound tyvars of the dfun are guaranteed fresh, because
 -- the dfun has been typechecked out of the same interface file
-mkImportedInstance cls_nm mb_tcs dfun oflag orphan
+mkImportedInstance cls_nm mb_tcs dfun_name dfun oflag orphan
   = ClsInst { is_flag = oflag, is_dfun = dfun
             , is_tvs = tvs, is_tys = tys
+            , is_dfun_name = dfun_name
             , is_cls_nm = cls_nm, is_cls = cls, is_tcs = mb_tcs
-            , is_orphan = orphan }
+            , is_orphan = pprTrace "mkImportedInstance" empty orphan }
   where
     (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
 
@@ -397,7 +406,7 @@ instIsVisible vis_mods ispec
   | IsOrphan <- is_orphan ispec = mod `elemModuleSet` vis_mods
   | otherwise                   = True
   where
-    mod = nameModule (idName (is_dfun ispec))
+    mod = nameModule $ is_dfun_name ispec
 
 classInstances :: InstEnvs -> Class -> [ClsInst]
 classInstances (InstEnvs { ie_global = pkg_ie, ie_local = home_ie, ie_visible = vis_mods }) cls