Don't pass homeUnitId at ExternalPackageState creation time (#10827)

It makes the external package state independent of the home unit which
is needed to make several home units share the EPS.

5 files changed, 23 insertions, 25 deletions

diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index 230d3498ce..168e33e189 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -1400,6 +1400,7 @@ data RuleOpts = RuleOpts
    { roPlatform                :: !Platform -- ^ Target platform
    , roNumConstantFolding      :: !Bool     -- ^ Enable more advanced numeric constant folding
    , roExcessRationalPrecision :: !Bool     -- ^ Cut down precision of Rational values to that of Float/Double if disabled
+   , roBignumRules             :: !Bool     -- ^ Enable rules for bignums
    }
 
 type RuleFun = RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe CoreExpr
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index dfb24b6cc4..02a3983e92 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -35,7 +35,6 @@ module GHC.Core.Opt.ConstantFold
    ( primOpRules
    , builtinRules
    , caseRules
-   , EnableBignumRules (..)
    )
 where
 
@@ -1676,11 +1675,9 @@ bindings (see occurAnalysePgm), which sorts out the dependency, so all
 is fine.
 -}
 
-newtype EnableBignumRules = EnableBignumRules Bool
-
-builtinRules :: EnableBignumRules -> [CoreRule]
+builtinRules :: [CoreRule]
 -- Rules for non-primops that can't be expressed using a RULE pragma
-builtinRules enableBignumRules
+builtinRules
   = [BuiltinRule { ru_name = fsLit "AppendLitString",
                    ru_fn = unpackCStringFoldrName,
                    ru_nargs = 4, ru_try = match_append_lit_C },
@@ -1719,14 +1716,13 @@ builtinRules enableBignumRules
             `App` arg `App` mkIntVal platform (d - 1)
         ]
      ]
- ++ builtinBignumRules enableBignumRules
+ ++ builtinBignumRules
 {-# NOINLINE builtinRules #-}
 -- there is no benefit to inlining these yet, despite this, GHC produces
 -- unfoldings for this regardless since the floated list entries look small.
 
-builtinBignumRules :: EnableBignumRules -> [CoreRule]
-builtinBignumRules (EnableBignumRules False) = []
-builtinBignumRules _ =
+builtinBignumRules :: [CoreRule]
+builtinBignumRules =
   [ -- conversions
     lit_to_integer "Word# -> Integer"   integerFromWordName
   , lit_to_integer "Int64# -> Integer"  integerFromInt64Name
@@ -1872,7 +1868,10 @@ builtinBignumRules _ =
       { ru_name = fsLit str
       , ru_fn = name
       , ru_nargs = nargs
-      , ru_try = runRuleM f
+      , ru_try = runRuleM $ do
+          env <- getEnv
+          guard (roBignumRules env)
+          f
       }
 
     integer_to_lit str name convert = mkRule str name 1 $ do
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs
index 5d5330d510..f29d700719 100644
--- a/compiler/GHC/Core/Rules.hs
+++ b/compiler/GHC/Core/Rules.hs
@@ -31,6 +31,7 @@ module GHC.Core.Rules (
 import GHC.Prelude
 
 import GHC.Core         -- All of it
+import GHC.Unit.Types    ( primUnitId, bignumUnitId )
 import GHC.Unit.Module   ( Module )
 import GHC.Unit.Module.Env
 import GHC.Core.Subst
@@ -59,7 +60,7 @@ import GHC.Types.Name.Env
 import GHC.Types.Unique.FM
 import GHC.Core.Unify as Unify ( ruleMatchTyKiX )
 import GHC.Types.Basic
-import GHC.Driver.Session      ( DynFlags, gopt, targetPlatform )
+import GHC.Driver.Session      ( DynFlags, gopt, targetPlatform, homeUnitId_ )
 import GHC.Driver.Ppr
 import GHC.Driver.Flags
 import GHC.Utils.Outputable
@@ -524,9 +525,12 @@ matchRule _ in_scope is_active _ args rough_args
 -- | Initialize RuleOpts from DynFlags
 initRuleOpts :: DynFlags -> RuleOpts
 initRuleOpts dflags = RuleOpts
-  { roPlatform = targetPlatform dflags
-  , roNumConstantFolding = gopt Opt_NumConstantFolding dflags
+  { roPlatform                = targetPlatform dflags
+  , roNumConstantFolding      = gopt Opt_NumConstantFolding dflags
   , roExcessRationalPrecision = gopt Opt_ExcessPrecision dflags
+    -- disable bignum rules in ghc-prim and ghc-bignum itself
+  , roBignumRules             = homeUnitId_ dflags /= primUnitId
+                                && homeUnitId_ dflags /= bignumUnitId
   }
 
 
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 6c80c6827c..f16685775b 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -239,7 +239,7 @@ newHscEnv :: DynFlags -> IO HscEnv
 newHscEnv dflags = do
     -- we don't store the unit databases and the unit state to still
     -- allow `setSessionDynFlags` to be used to set unit db flags.
-    eps_var <- newIORef (initExternalPackageState (homeUnitId_ dflags))
+    eps_var <- newIORef initExternalPackageState
     us      <- mkSplitUniqSupply 'r'
     nc_var  <- newIORef (initNameCache us knownKeyNames)
     fc_var  <- newIORef emptyInstalledModuleEnv
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index e8f1c62592..b1a4f4d27c 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -78,7 +78,7 @@ import GHC.Core.TyCon
 import GHC.Core.InstEnv
 import GHC.Core.FamInstEnv
 
-import GHC.Types.Id.Make      ( seqId, EnableBignumRules(..) )
+import GHC.Types.Id.Make      ( seqId )
 import GHC.Types.Annotations
 import GHC.Types.Name
 import GHC.Types.Name.Env
@@ -962,8 +962,8 @@ readIface wanted_mod file_path
 *********************************************************
 -}
 
-initExternalPackageState :: UnitId -> ExternalPackageState
-initExternalPackageState home_unit_id
+initExternalPackageState :: ExternalPackageState
+initExternalPackageState
   = EPS {
       eps_is_boot          = emptyUFM,
       eps_PIT              = emptyPackageIfaceTable,
@@ -971,21 +971,15 @@ initExternalPackageState home_unit_id
       eps_PTE              = emptyTypeEnv,
       eps_inst_env         = emptyInstEnv,
       eps_fam_inst_env     = emptyFamInstEnv,
-      eps_rule_base        = mkRuleBase builtinRules',
+      eps_rule_base        = mkRuleBase builtinRules,
         -- Initialise the EPS rule pool with the built-in rules
       eps_mod_fam_inst_env = emptyModuleEnv,
       eps_complete_matches = [],
       eps_ann_env          = emptyAnnEnv,
       eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
                            , n_insts_in = 0, n_insts_out = 0
-                           , n_rules_in = length builtinRules', n_rules_out = 0 }
+                           , n_rules_in = length builtinRules, n_rules_out = 0 }
     }
-    where
-      enableBignumRules
-         | home_unit_id == primUnitId   = EnableBignumRules False
-         | home_unit_id == bignumUnitId = EnableBignumRules False
-         | otherwise                    = EnableBignumRules True
-      builtinRules' = builtinRules enableBignumRules
 
 {-
 *********************************************************