GitLab

358a66d8

by soulomoon at 2025-06-12T23:43:39+08:00

use unsafeInterleaveIO to only load FamInstances if needed

@@ -266,6 +266,9 @@ hugInstancesBelow hsc_env uid mnwib = do
                            mnwib
   return (foldl' unionInstEnv emptyInstEnv insts, concat famInsts)
 +-- | Get things from modules in the transitive closure of the given module.
 +--
 +-- Note: Don't expose this function. This is a footgun if exposed!
  hugSomeThingsBelowUs' :: (HomeModInfo -> a -> a) -> a -> Bool -> HscEnv -> UnitId -> ModuleNameWithIsBoot -> IO a
  hugSomeThingsBelowUs' _ acc _ hsc_env _ _ | isOneShot (ghcMode (hsc_dflags hsc_env)) = return acc
  -- An explicit check to see if we are in one-shot mode to avoid poking the ModuleGraph thunk

@@ -25,6 +25,7 @@ import GHC.Core.TyCo.Rep
  import GHC.Core.TyCo.FVs
  import GHC.Iface.Load
 +import GHC.IO (unsafeInterleaveIO)
  import GHC.Tc.Errors.Types
  import GHC.Tc.Types.Evidence
@@ -317,7 +318,7 @@ checkFamInstConsistency directlyImpMods hsc_env unitId mnwib
               -- See Note [Order of type family consistency checks]
+              }
 -       ; hpt_fam_insts <- liftIO $ hugFamInstancesBelow hsc_env unitId mnwib
 +       ; hpt_fam_insts <- liftIO $ unsafeInterleaveIO $ hugFamInstancesBelow hsc_env unitId mnwib
         ; debug_consistent_set <- mapM (\x -> (\y -> (x, length y)) <$> modConsistent x) directlyImpMods
         ; traceTc "init_consistent_set" (ppr debug_consistent_set)
         ; let init_consistent_set = map fst (reverse (sortOn snd debug_consistent_set))