Refactor tcExtendLocalFamInst a bit

This patch just pulls out FamInst.loadDependentFamInstModules
as a separate function, and adds better comments.

Provoked by Trac #14759, comment:10.

2 files changed, 47 insertions, 30 deletions

diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 60f87fcd1f..f06fc00db3 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -200,8 +200,8 @@ rnImports imports = do
       new_finsts = imp_finsts imp_avails1
 
 {-
-Note [Combine ImportAvails]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Combining ImportAvails]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 imp_finsts in ImportAvails is a list of family instance modules
 transitively depended on by an import. imp_finsts for a currently
 compiled module is a union of all the imp_finsts of imports.
diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs
index 4fe1430762..cda6404d11 100644
--- a/compiler/typecheck/FamInst.hs
+++ b/compiler/typecheck/FamInst.hs
@@ -46,10 +46,8 @@ import Control.Monad
 
 #include "HsVersions.h"
 
-{-
-
-Note [The type family instance consistency story]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [The type family instance consistency story]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 To preserve type safety we must ensure that for any given module, all
 the type family instances used either in that module or in any module
@@ -588,38 +586,57 @@ tcExtendLocalFamInstEnv [] thing_inside = thing_inside
 
 -- Otherwise proceed...
 tcExtendLocalFamInstEnv fam_insts thing_inside
- = do { env <- getGblEnv
-      ; let this_mod = tcg_mod env
-            imports = tcg_imports env
-
-            -- Optimization: If we're only defining type family instances
-            -- for type families *defined in the home package*, then we
-            -- only have to load interface files that belong to the home
-            -- package. The reason is that there's no recursion between
-            -- packages, so modules in other packages can't possibly define
-            -- instances for our type families.
-            --
-            -- (Within the home package, we could import a module M that
-            -- imports us via an hs-boot file, and thereby defines an
-            -- instance of a type family defined in this module. So we can't
-            -- apply the same logic to avoid reading any interface files at
-            -- all, when we define an instances for type family defined in
-            -- the current module.)
-            home_fams_only = all (nameIsHomePackage this_mod . fi_fam) fam_insts
-            want_module mod
-              | mod == this_mod = False
-              | home_fams_only  = moduleUnitId mod == moduleUnitId this_mod
-              | otherwise       = True
-      ; loadModuleInterfaces (text "Loading family-instance modules")
-                             (filter want_module (imp_finsts imports))
+ = do { -- Load family-instance modules "below" this module, so that
+        -- allLocalFamInst can check for consistency with them
+        -- See Note [The type family instance consistency story]
+        loadDependentFamInstModules fam_insts
+
+        -- Now add the instances one by one
+      ; env <- getGblEnv
       ; (inst_env', fam_insts') <- foldlM addLocalFamInst
                                        (tcg_fam_inst_env env, tcg_fam_insts env)
                                        fam_insts
+
       ; let env' = env { tcg_fam_insts    = fam_insts'
                        , tcg_fam_inst_env = inst_env' }
       ; setGblEnv env' thing_inside
       }
 
+loadDependentFamInstModules :: [FamInst] -> TcM ()
+-- Load family-instance modules "below" this module, so that
+-- allLocalFamInst can check for consistency with them
+-- See Note [The type family instance consistency story]
+loadDependentFamInstModules fam_insts
+ = do { env <- getGblEnv
+      ; let this_mod = tcg_mod env
+            imports  = tcg_imports env
+
+            want_module mod  -- See Note [Home package family instances]
+              | mod == this_mod = False
+              | home_fams_only  = moduleUnitId mod == moduleUnitId this_mod
+              | otherwise       = True
+            home_fams_only = all (nameIsHomePackage this_mod . fi_fam) fam_insts
+
+      ; loadModuleInterfaces (text "Loading family-instance modules") $
+        filter want_module (imp_finsts imports) }
+
+{- Note [Home package family instances]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Optimization: If we're only defining type family instances
+for type families *defined in the home package*, then we
+only have to load interface files that belong to the home
+package. The reason is that there's no recursion between
+packages, so modules in other packages can't possibly define
+instances for our type families.
+
+(Within the home package, we could import a module M that
+imports us via an hs-boot file, and thereby defines an
+instance of a type family defined in this module. So we can't
+apply the same logic to avoid reading any interface files at
+all, when we define an instances for type family defined in
+the current module.
+-}
+
 -- Check that the proposed new instance is OK,
 -- and then add it to the home inst env
 -- This must be lazy in the fam_inst arguments, see Note [Lazy axiom match]