Commit 3aceea90 authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

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.
parent 847b0a69
......@@ -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
......
......@@ -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
......
......@@ -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
}
......
......@@ -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
......
......@@ -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
{-
*********************************************************
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment