Splice imports wipwip/splice-imports

4 files changed, 29 insertions, 19 deletions

diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index d5ada1f85c..db3f6a65f2 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -144,7 +144,8 @@ checkHsigIface tcg_env gr sig_iface
     -- checking instance satisfiability
     -- TODO: this should not be necessary
     tcg_env <- getGblEnv
-    setGblEnv tcg_env { tcg_inst_env = emptyInstEnv,
+    setGblEnv tcg_env { tcg_tc_inst_env = emptyInstEnv,
+                        tcg_obj_inst_env =  emptyInstEnv,
                         tcg_fam_inst_env = emptyFamInstEnv,
                         tcg_insts = [],
                         tcg_fam_insts = [] } $ do
@@ -895,7 +896,7 @@ mergeSignatures
                 -- see Note [Signature merging DFuns]
                 = (inst:insts, extendInstEnv inst_env inst)
             (insts, inst_env) = foldl' merge_inst
-                                    (tcg_insts tcg_env, tcg_inst_env tcg_env)
+                                    (tcg_insts tcg_env, tcg_tc_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
@@ -903,9 +904,9 @@ mergeSignatures
             iface' = iface { mi_final_exts = (mi_final_exts iface){ mi_orphan = False, mi_finsts = False } }
             home_unit = hsc_home_unit hsc_env
             avails = plusImportAvails (tcg_imports tcg_env) $
-                        calculateAvails home_unit iface' False NotBoot ImportedBySystem
+                        calculateAvails home_unit iface' False NotBoot False ImportedBySystem
         return tcg_env {
-            tcg_inst_env = inst_env,
+            tcg_tc_inst_env = inst_env,
             tcg_insts    = insts,
             tcg_imports  = avails,
             tcg_merged   =
@@ -993,7 +994,7 @@ checkImplements impl_mod req_mod@(Module uid mod_name) = do
                          (dep_orphs (mi_deps impl_iface))
 
     let avails = calculateAvails home_unit
-                    impl_iface False{- safe -} NotBoot ImportedBySystem
+                    impl_iface False{- safe -} NotBoot False ImportedBySystem
         fix_env = mkNameEnv [ (greMangledName rdr_elt, FixItem occ f)
                             | (occ, f) <- mi_fixities impl_iface
                             , rdr_elt <- lookupGlobalRdrEnv impl_gr occ ]
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index 65785fc822..c4119e5999 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -346,7 +346,8 @@ tcGetInstEnvs :: TcM InstEnvs
 tcGetInstEnvs = do { eps <- getEps
                    ; env <- getGblEnv
                    ; return (InstEnvs { ie_global  = eps_inst_env eps
-                                      , ie_local   = tcg_inst_env env
+                                      , ie_local_obj   = tcg_obj_inst_env env
+                                      , ie_local_tc    = tcg_tc_inst_env env
                                       , ie_visible = tcVisibleOrphanMods env }) }
 
 instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where
diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs
index 73c62839e3..0100769734 100644
--- a/compiler/GHC/Tc/Utils/Instantiate.hs
+++ b/compiler/GHC/Tc/Utils/Instantiate.hs
@@ -851,20 +851,22 @@ tcExtendLocalInstEnv dfuns thing_inside
       -- there are a very small number of TcGblEnv. Keeping a TcGblEnv
       -- alive is quite dangerous because it contains reference to many
       -- large data structures.
-      ; let !init_inst_env = tcg_inst_env env
+      ; let !init_obj_inst_env = tcg_obj_inst_env env
+            !init_tc_inst_env  = tcg_tc_inst_env env
+
             !init_insts = tcg_insts env
-      ; (inst_env', cls_insts') <- foldlM addLocalInst
-                                          (init_inst_env, init_insts)
+      ; (inst_env', cls_insts') <- foldlM (addLocalInst init_obj_inst_env)
+                                          (init_tc_inst_env, init_insts)
                                           dfuns
       ; let env' = env { tcg_insts    = cls_insts'
-                       , tcg_inst_env = inst_env' }
+                       , tcg_tc_inst_env = inst_env' }
       ; setGblEnv env' thing_inside }
 
-addLocalInst :: (InstEnv, [ClsInst]) -> ClsInst -> TcM (InstEnv, [ClsInst])
+addLocalInst :: InstEnv -> (InstEnv, [ClsInst]) -> ClsInst -> TcM (InstEnv, [ClsInst])
 -- Check that the proposed new instance is OK,
 -- and then add it to the home inst env
 -- If overwrite_inst, then we can overwrite a direct match
-addLocalInst (home_ie, my_insts) ispec
+addLocalInst home_obj_ie (home_tc_ie, my_insts) ispec
    = do {
              -- Load imported instances, so that we report
              -- duplicates correctly
@@ -879,13 +881,17 @@ addLocalInst (home_ie, my_insts) ispec
            -- In GHCi, we *override* any identical instances
            -- that are also defined in the interactive context
            -- See Note [Override identical instances in GHCi]
-         ; let home_ie'
-                 | isGHCi    = deleteFromInstEnv home_ie ispec
-                 | otherwise = home_ie
+         ; let home_obj_ie'
+                 | isGHCi    = deleteFromInstEnv home_obj_ie ispec
+                 | otherwise = home_obj_ie
+               home_tc_ie'
+                 | isGHCi    = deleteFromInstEnv home_tc_ie ispec
+                 | otherwise = home_tc_ie
 
                global_ie = eps_inst_env eps
                inst_envs = InstEnvs { ie_global  = global_ie
-                                    , ie_local   = home_ie'
+                                    , ie_local_obj = home_obj_ie'
+                                    , ie_local_tc  = home_tc_ie'
                                     , ie_visible = tcVisibleOrphanMods tcg_env }
 
              -- Check for inconsistent functional dependencies
@@ -895,12 +901,13 @@ addLocalInst (home_ie, my_insts) ispec
 
              -- Check for duplicate instance decls.
          ; let (_tvs, cls, tys) = instanceHead ispec
-               (matches, _, _)  = lookupInstEnv False inst_envs cls tys
+               -- TODO: MP check callsite
+               (matches, _, _)  = lookupInstEnv False False inst_envs cls tys
                dups             = filter (identicalClsInstHead ispec) (map fst matches)
          ; unless (null dups) $
            dupInstErr ispec (head dups)
 
-         ; return (extendInstEnv home_ie' ispec, ispec : my_insts) }
+         ; return (extendInstEnv home_tc_ie' ispec, ispec : my_insts) }
 
 {-
 Note [Signature files and type class instances]
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 1c5e79013d..08d75b69d4 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -307,7 +307,8 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
                                      else Nothing,
                 tcg_type_env       = emptyNameEnv,
                 tcg_type_env_var   = type_env_var,
-                tcg_inst_env       = emptyInstEnv,
+                tcg_obj_inst_env   = emptyInstEnv,
+                tcg_tc_inst_env    = emptyInstEnv,
                 tcg_fam_inst_env   = emptyFamInstEnv,
                 tcg_ann_env        = emptyAnnEnv,
                 tcg_th_used        = th_var,