Refactor homeUnit

* rename thisPackage into homeUnit
* document and refactor several Backpack things

4 files changed, 17 insertions, 12 deletions

diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 300a870709..0471b85666 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -183,7 +183,7 @@ tcRnModule hsc_env mod_sum save_rn_syntax
     err_msg = mkPlainErrMsg (hsc_dflags hsc_env) loc $
               text "Module does not have a RealSrcSpan:" <+> ppr this_mod
 
-    this_pkg = thisPackage (hsc_dflags hsc_env)
+    this_pkg = homeUnit (hsc_dflags hsc_env)
 
     pair :: (Module, SrcSpan)
     pair@(this_mod,_)
@@ -2830,7 +2830,7 @@ loadUnqualIfaces hsc_env ictxt
   = initIfaceTcRn $ do
     mapM_ (loadSysInterface doc) (moduleSetElts (mkModuleSet unqual_mods))
   where
-    this_pkg = thisPackage (hsc_dflags hsc_env)
+    this_pkg = homeUnit (hsc_dflags hsc_env)
 
     unqual_mods = [ nameModule name
                   | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt)
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 8ff9ad0d3e..6af35c77c2 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -61,6 +61,7 @@ import GHC.Types.Var
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
 import GHC.Unit.Module
+import GHC.Unit.State
 import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Types.Name.Env
@@ -172,7 +173,7 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds
 
            -- Step 1.5: Make sure we don't have any type synonym cycles
        ; traceTc "Starting synonym cycle check" (ppr tyclss)
-       ; this_uid <- fmap thisPackage getDynFlags
+       ; this_uid <- fmap homeUnit getDynFlags
        ; checkSynCycles this_uid tyclss tyclds
        ; traceTc "Done synonym cycle check" (ppr tyclss)
 
@@ -4009,7 +4010,7 @@ checkValidDataCon dflags existential_ok tc con
       -- when we actually fill in the abstract type.  As such, don't
       -- warn in this case (it gives users the wrong idea about whether
       -- or not UNPACK on abstract types is supported; it is!)
-      , unitIsDefinite (thisPackage dflags)
+      , homeUnitIsDefinite dflags
       = addWarnTc NoReason (bad_bang n (text "Ignoring unusable UNPACK pragma"))
       where
         is_strict = case strict_mark of
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index 98458b884b..66733b0618 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -309,7 +309,7 @@ implicitRequirements' hsc_env normal_imports
     forM normal_imports $ \(mb_pkg, L _ imp) -> do
         found <- findImportedModule hsc_env imp mb_pkg
         case found of
-            Found _ mod | thisPackage dflags /= moduleUnit mod ->
+            Found _ mod | not (isHomeModule dflags mod) ->
                 return (uniqDSetToList (moduleFreeHoles mod))
             _ -> return []
   where dflags = hsc_dflags hsc_env
@@ -731,7 +731,7 @@ mergeSignatures
     -- STEP 4: Rename the interfaces
     ext_ifaces <- forM thinned_ifaces $ \((Module iuid _), ireq_iface) ->
         tcRnModIface (instUnitInsts iuid) (Just nsubst) ireq_iface
-    lcl_iface <- tcRnModIface (thisUnitIdInsts dflags) (Just nsubst) lcl_iface0
+    lcl_iface <- tcRnModIface (homeUnitInstantiations dflags) (Just nsubst) lcl_iface0
     let ifaces = lcl_iface : ext_ifaces
 
     -- STEP 4.1: Merge fixities (we'll verify shortly) tcg_fix_env
@@ -753,7 +753,7 @@ mergeSignatures
     let infos = zip ifaces detailss
 
     -- Test for cycles
-    checkSynCycles (thisPackage dflags) (typeEnvTyCons type_env) []
+    checkSynCycles (homeUnit dflags) (typeEnvTyCons type_env) []
 
     -- NB on type_env: it contains NO dfuns.  DFuns are recorded inside
     -- detailss, and given a Name that doesn't correspond to anything real.  See
@@ -1000,9 +1000,13 @@ instantiateSignature = do
     -- TODO: setup the local RdrEnv so the error messages look a little better.
     -- But this information isn't stored anywhere. Should we RETYPECHECK
     -- the local one just to get the information?  Hmm...
-    MASSERT( moduleUnit outer_mod == thisPackage dflags )
+    MASSERT( isHomeModule dflags outer_mod )
+    MASSERT( isJust (homeUnitInstanceOfId dflags) )
+    let uid  = fromJust (homeUnitInstanceOfId dflags)
+        -- we need to fetch the most recent ppr infos from the unit
+        -- database because we might have modified it
+        uid' = updateIndefUnitId (pkgState dflags) uid
     inner_mod `checkImplements`
         Module
-            (mkInstantiatedUnit (thisComponentId dflags)
-                                (thisUnitIdInsts dflags))
+            (mkInstantiatedUnit uid' (homeUnitInstantiations dflags))
             (moduleName outer_mod)
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index d7fbd2e095..5030c61fd3 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -1857,8 +1857,8 @@ initIfaceTcRn thing_inside
         ; let !mod = tcg_semantic_mod tcg_env
               -- When we are instantiating a signature, we DEFINITELY
               -- do not want to knot tie.
-              is_instantiate = unitIsDefinite (thisPackage dflags) &&
-                               not (null (thisUnitIdInsts dflags))
+              is_instantiate = homeUnitIsDefinite dflags &&
+                               not (null (homeUnitInstantiations dflags))
         ; let { if_env = IfGblEnv {
                             if_doc = text "initIfaceTcRn",
                             if_rec_types =