summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-06-17 13:14:39 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-09-09 11:19:24 -0400
commitb3df72a699727b00d5dd8212fcbe46cbbec05f9b (patch)
treec3db9b038db8ddc6f894ed0c3e857a4152084229
parent3f32a9c0f4ddceab14a381bfd3732bcad6be43f7 (diff)
downloadhaskell-b3df72a699727b00d5dd8212fcbe46cbbec05f9b.tar.gz
DynFlags: add sm_pre_inline field into SimplMode (#17957)
It avoids passing and querying DynFlags down in the simplifier.
-rw-r--r--compiler/GHC/Core/Opt/Monad.hs11
-rw-r--r--compiler/GHC/Core/Opt/Pipeline.hs7
-rw-r--r--compiler/GHC/Core/Opt/Simplify.hs2
-rw-r--r--compiler/GHC/Core/Opt/Simplify/Utils.hs12
-rw-r--r--compiler/GHC/Core/Opt/Specialise.hs2
-rw-r--r--compiler/GHC/Core/Opt/WorkWrap.hs2
-rw-r--r--compiler/GHC/Core/SimpleOpt.hs24
-rw-r--r--compiler/GHC/Core/SimpleOpt.hs-boot6
-rw-r--r--compiler/GHC/Core/Unfold/Make.hs14
-rw-r--r--compiler/GHC/Driver/Config.hs6
-rw-r--r--compiler/GHC/HsToCore.hs4
-rw-r--r--compiler/GHC/HsToCore/Binds.hs6
-rw-r--r--compiler/GHC/HsToCore/Foreign/Decl.hs2
-rw-r--r--compiler/GHC/HsToCore/PmCheck/Oracle.hs2
-rw-r--r--compiler/GHC/Tc/TyCl/Instance.hs2
-rw-r--r--compiler/GHC/Types/Id/Make.hs18
16 files changed, 61 insertions, 59 deletions
diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs
index 9eddb64ce5..139b9f0af1 100644
--- a/compiler/GHC/Core/Opt/Monad.hs
+++ b/compiler/GHC/Core/Opt/Monad.hs
@@ -157,15 +157,16 @@ pprPassDetails _ = Outputable.empty
data SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad
= SimplMode
- { sm_names :: [String] -- Name(s) of the phase
+ { sm_names :: [String] -- ^ Name(s) of the phase
, sm_phase :: CompilerPhase
, sm_dflags :: DynFlags -- Just for convenient non-monadic
-- access; we don't override these
, sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options
- , sm_rules :: Bool -- Whether RULES are enabled
- , sm_inline :: Bool -- Whether inlining is enabled
- , sm_case_case :: Bool -- Whether case-of-case is enabled
- , sm_eta_expand :: Bool -- Whether eta-expansion is enabled
+ , sm_rules :: !Bool -- ^ Whether RULES are enabled
+ , sm_inline :: !Bool -- ^ Whether inlining is enabled
+ , sm_case_case :: !Bool -- ^ Whether case-of-case is enabled
+ , sm_eta_expand :: !Bool -- ^ Whether eta-expansion is enabled
+ , sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled
}
instance Outputable SimplMode where
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index a44a81480e..c3f2fc9f85 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -16,7 +16,7 @@ import GHC.Driver.Session
import GHC.Driver.Ppr
import GHC.Core
import GHC.Driver.Types
-import GHC.Core.Opt.CSE ( cseProgram )
+import GHC.Core.Opt.CSE ( cseProgram )
import GHC.Core.Rules ( mkRuleBase, unionRuleBase,
extendRuleBaseList, ruleCheckProgram, addRuleInfo,
getRules, initRuleOpts )
@@ -141,6 +141,7 @@ getCoreToDo dflags
static_args = gopt Opt_StaticArgumentTransformation dflags
rules_on = gopt Opt_EnableRewriteRules dflags
eta_expand_on = gopt Opt_DoLambdaEtaExpansion dflags
+ pre_inline_on = gopt Opt_SimplPreInlining dflags
ww_on = gopt Opt_WorkerWrapper dflags
static_ptrs = xopt LangExt.StaticPointers dflags
@@ -158,7 +159,9 @@ getCoreToDo dflags
, sm_rules = rules_on
, sm_eta_expand = eta_expand_on
, sm_inline = True
- , sm_case_case = True }
+ , sm_case_case = True
+ , sm_pre_inline = pre_inline_on
+ }
simpl_phase phase name iter
= CoreDoPasses
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index 1e8b9178d7..e219a0dba9 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -3434,7 +3434,7 @@ mkDupableAlt platform case_bndr jfloats (con, bndrs', rhs')
= return (jfloats, (con, bndrs', rhs'))
| otherwise
- = do { simpl_opts <- initSimpleOptOpts <$> getDynFlags
+ = do { simpl_opts <- initSimpleOpts <$> getDynFlags
; let rhs_ty' = exprType rhs'
scrut_ty = idType case_bndr
case_bndr_w_unf
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index 2b5d37946c..420d406eed 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -866,14 +866,18 @@ simplEnvForGHCi dflags
, sm_uf_opts = uf_opts
, sm_rules = rules_on
, sm_inline = False
+ -- Do not do any inlining, in case we expose some
+ -- unboxed tuple stuff that confuses the bytecode
+ -- interpreter
, sm_eta_expand = eta_expand_on
- , sm_case_case = True }
+ , sm_case_case = True
+ , sm_pre_inline = pre_inline_on
+ }
where
rules_on = gopt Opt_EnableRewriteRules dflags
eta_expand_on = gopt Opt_DoLambdaEtaExpansion dflags
+ pre_inline_on = gopt Opt_SimplPreInlining dflags
uf_opts = unfoldingOpts dflags
- -- Do not do any inlining, in case we expose some unboxed
- -- tuple stuff that confuses the bytecode interpreter
updModeForStableUnfoldings :: Activation -> SimplMode -> SimplMode
-- See Note [Simplifying inside stable unfoldings]
@@ -1259,7 +1263,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env
, occ_int_cxt = IsInteresting } = canInlineInLam rhs
one_occ _ = False
- pre_inline_unconditionally = gopt Opt_SimplPreInlining (seDynFlags env)
+ pre_inline_unconditionally = sm_pre_inline mode
mode = getMode env
active = isActive (sm_phase mode) (inlinePragmaActivation inline_prag)
-- See Note [pre/postInlineUnconditionally in gentle mode]
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index ef83426326..f489ac2eff 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -1480,7 +1480,7 @@ specCalls mb_mod env existing_rules calls_for_me fn rhs
-- See Note [Specialising Calls]
spec_uds = foldr consDictBind rhs_uds dx_binds
- simpl_opts = initSimpleOptOpts dflags
+ simpl_opts = initSimpleOpts dflags
--------------------------------------
-- Add a suitable unfolding if the spec_inl_prag says so
diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs
index 4c58ef911e..97af84ee68 100644
--- a/compiler/GHC/Core/Opt/WorkWrap.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap.hs
@@ -605,7 +605,7 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds div cpr rhs
-- worker is join point iff wrapper is join point
-- (see Note [Don't w/w join points for CPR])
- simpl_opts = initSimpleOptOpts dflags
+ simpl_opts = initSimpleOpts dflags
work_id = mkWorkerId work_uniq fn_id (exprType work_rhs)
`setIdOccInfo` occInfo fn_info
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index e72b6073b4..d5424a2fc9 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/compiler/GHC/Core/SimpleOpt.hs
@@ -7,7 +7,7 @@
{-# LANGUAGE MultiWayIf #-}
module GHC.Core.SimpleOpt (
- SimpleOptOpts (..), defaultSimpleOptOpts,
+ SimpleOpts (..), defaultSimpleOpts,
-- ** Simple expression optimiser
simpleOptPgm, simpleOptExpr, simpleOptExprWith,
@@ -96,26 +96,20 @@ little dance in action; the full Simplifier is a lot more complicated.
-}
-- | Simple optimiser options
-data SimpleOptOpts = SimpleOptOpts
+data SimpleOpts = SimpleOpts
{ so_uf_opts :: !UnfoldingOpts -- ^ Unfolding options
, so_co_opts :: !OptCoercionOpts -- ^ Coercion optimiser options
}
-- | Default options for the Simple optimiser.
---
--- These are used:
--- - to optimise compulsory unfolding in 'GHC.Core.Unfold.mkCompulsoryUnfolding'
--- - to perform beta-reduction in 'exprIsLambda_maybe'
---
--- For now these can't be overriden by user flags.
-defaultSimpleOptOpts :: SimpleOptOpts
-defaultSimpleOptOpts = SimpleOptOpts
+defaultSimpleOpts :: SimpleOpts
+defaultSimpleOpts = SimpleOpts
{ so_uf_opts = defaultUnfoldingOpts
, so_co_opts = OptCoercionOpts
{ optCoercionEnabled = False }
}
-simpleOptExpr :: HasDebugCallStack => SimpleOptOpts -> CoreExpr -> CoreExpr
+simpleOptExpr :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr
-- See Note [The simple optimiser]
-- Do simple optimisation on an expression
-- The optimisation is very straightforward: just
@@ -147,7 +141,7 @@ simpleOptExpr opts expr
-- It's a bit painful to call exprFreeVars, because it makes
-- three passes instead of two (occ-anal, and go)
-simpleOptExprWith :: HasDebugCallStack => SimpleOptOpts -> Subst -> InExpr -> OutExpr
+simpleOptExprWith :: HasDebugCallStack => SimpleOpts -> Subst -> InExpr -> OutExpr
-- See Note [The simple optimiser]
simpleOptExprWith opts subst expr
= simple_opt_expr init_env (occurAnalyseExpr expr)
@@ -155,7 +149,7 @@ simpleOptExprWith opts subst expr
init_env = (emptyEnv opts) { soe_subst = subst }
----------------------
-simpleOptPgm :: SimpleOptOpts
+simpleOptPgm :: SimpleOpts
-> Module
-> CoreProgram
-> [CoreRule]
@@ -208,7 +202,7 @@ instance Outputable SimpleOptEnv where
, text "soe_subst =" <+> ppr subst ]
<+> text "}"
-emptyEnv :: SimpleOptOpts -> SimpleOptEnv
+emptyEnv :: SimpleOpts -> SimpleOptEnv
emptyEnv opts = SOE
{ soe_inl = emptyVarEnv
, soe_subst = emptySubst
@@ -1336,7 +1330,7 @@ exprIsLambda_maybe (in_scope_set, id_unf) e
-- Make sure there is hope to get a lambda
, Just rhs <- expandUnfolding_maybe (id_unf f)
-- Optimize, for beta-reduction
- , let e' = simpleOptExprWith defaultSimpleOptOpts (mkEmptySubst in_scope_set) (rhs `mkApps` as)
+ , let e' = simpleOptExprWith defaultSimpleOpts (mkEmptySubst in_scope_set) (rhs `mkApps` as)
-- Recurse, because of possible casts
, Just (x', e'', ts') <- exprIsLambda_maybe (in_scope_set, id_unf) e'
, let res = Just (x', e'', ts++ts')
diff --git a/compiler/GHC/Core/SimpleOpt.hs-boot b/compiler/GHC/Core/SimpleOpt.hs-boot
index 7a708eb4c8..4a63105475 100644
--- a/compiler/GHC/Core/SimpleOpt.hs-boot
+++ b/compiler/GHC/Core/SimpleOpt.hs-boot
@@ -4,8 +4,8 @@ import GHC.Core
import {-# SOURCE #-} GHC.Core.Unfold
import GHC.Utils.Misc (HasDebugCallStack)
-data SimpleOptOpts
+data SimpleOpts
-so_uf_opts :: SimpleOptOpts -> UnfoldingOpts
+so_uf_opts :: SimpleOpts -> UnfoldingOpts
-simpleOptExpr :: HasDebugCallStack => SimpleOptOpts -> CoreExpr -> CoreExpr
+simpleOptExpr :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr
diff --git a/compiler/GHC/Core/Unfold/Make.hs b/compiler/GHC/Core/Unfold/Make.hs
index 4f0fd85c55..d9b541e49c 100644
--- a/compiler/GHC/Core/Unfold/Make.hs
+++ b/compiler/GHC/Core/Unfold/Make.hs
@@ -51,7 +51,7 @@ mkFinalUnfolding opts src strict_sig expr
expr
-- | Used for things that absolutely must be unfolded
-mkCompulsoryUnfolding :: SimpleOptOpts -> CoreExpr -> Unfolding
+mkCompulsoryUnfolding :: SimpleOpts -> CoreExpr -> Unfolding
mkCompulsoryUnfolding opts expr = mkCompulsoryUnfolding' (simpleOptExpr opts expr)
-- | Same as 'mkCompulsoryUnfolding' but no simple optimiser pass is performed
@@ -80,14 +80,14 @@ mkDFunUnfolding bndrs con ops
, df_args = map occurAnalyseExpr ops }
-- See Note [Occurrence analysis of unfoldings]
-mkWwInlineRule :: SimpleOptOpts -> CoreExpr -> Arity -> Unfolding
+mkWwInlineRule :: SimpleOpts -> CoreExpr -> Arity -> Unfolding
mkWwInlineRule opts expr arity
= mkCoreUnfolding InlineStable True
(simpleOptExpr opts expr)
(UnfWhen { ug_arity = arity, ug_unsat_ok = unSaturatedOk
, ug_boring_ok = boringCxtNotOk })
-mkWorkerUnfolding :: SimpleOptOpts -> (CoreExpr -> CoreExpr) -> Unfolding -> Unfolding
+mkWorkerUnfolding :: SimpleOpts -> (CoreExpr -> CoreExpr) -> Unfolding -> Unfolding
-- See Note [Worker-wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap
mkWorkerUnfolding opts work_fn
(CoreUnfolding { uf_src = src, uf_tmpl = tmpl
@@ -104,7 +104,7 @@ mkWorkerUnfolding _ _ _ = noUnfolding
-- (ug_unsat_ok = unSaturatedOk) and that is reported as having its
-- manifest arity (the number of outer lambdas applications will
-- resolve before doing any work).
-mkInlineUnfolding :: SimpleOptOpts -> CoreExpr -> Unfolding
+mkInlineUnfolding :: SimpleOpts -> CoreExpr -> Unfolding
mkInlineUnfolding opts expr
= mkCoreUnfolding InlineStable
True -- Note [Top-level flag on inline rules]
@@ -118,7 +118,7 @@ mkInlineUnfolding opts expr
-- | Make an unfolding that will be used once the RHS has been saturated
-- to the given arity.
-mkInlineUnfoldingWithArity :: Arity -> SimpleOptOpts -> CoreExpr -> Unfolding
+mkInlineUnfoldingWithArity :: Arity -> SimpleOpts -> CoreExpr -> Unfolding
mkInlineUnfoldingWithArity arity opts expr
= mkCoreUnfolding InlineStable
True -- Note [Top-level flag on inline rules]
@@ -133,13 +133,13 @@ mkInlineUnfoldingWithArity arity opts expr
boring_ok | arity == 0 = True
| otherwise = inlineBoringOk expr'
-mkInlinableUnfolding :: SimpleOptOpts -> CoreExpr -> Unfolding
+mkInlinableUnfolding :: SimpleOpts -> CoreExpr -> Unfolding
mkInlinableUnfolding opts expr
= mkUnfolding (so_uf_opts opts) InlineStable False False expr'
where
expr' = simpleOptExpr opts expr
-specUnfolding :: SimpleOptOpts
+specUnfolding :: SimpleOpts
-> [Var] -> (CoreExpr -> CoreExpr)
-> [CoreArg] -- LHS arguments in the RULE
-> Unfolding -> Unfolding
diff --git a/compiler/GHC/Driver/Config.hs b/compiler/GHC/Driver/Config.hs
index b67e74eeb4..f178597d1c 100644
--- a/compiler/GHC/Driver/Config.hs
+++ b/compiler/GHC/Driver/Config.hs
@@ -1,7 +1,7 @@
-- | Subsystem configuration
module GHC.Driver.Config
( initOptCoercionOpts
- , initSimpleOptOpts
+ , initSimpleOpts
)
where
@@ -18,8 +18,8 @@ initOptCoercionOpts dflags = OptCoercionOpts
}
-- | Initialise Simple optimiser configuration from DynFlags
-initSimpleOptOpts :: DynFlags -> SimpleOptOpts
-initSimpleOptOpts dflags = SimpleOptOpts
+initSimpleOpts :: DynFlags -> SimpleOpts
+initSimpleOpts dflags = SimpleOpts
{ so_uf_opts = unfoldingOpts dflags
, so_co_opts = initOptCoercionOpts dflags
}
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index eda5ad8130..5c1f62104e 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -171,7 +171,7 @@ deSugar hsc_env
-- things into the in-scope set before simplifying; so we get no unfolding for F#!
; endPassIO hsc_env print_unqual CoreDesugar final_pgm rules_for_imps
- ; let simpl_opts = initSimpleOptOpts dflags
+ ; let simpl_opts = initSimpleOpts dflags
; let (ds_binds, ds_rules_for_imps, occ_anald_binds)
= simpleOptPgm simpl_opts mod final_pgm rules_for_imps
-- The simpleOptPgm gets rid of type
@@ -413,7 +413,7 @@ dsRule (L loc (HsRule { rd_name = name
-- we don't want to attach rules to the bindings of implicit Ids,
-- because they don't show up in the bindings until just before code gen
fn_name = idName fn_id
- simpl_opts = initSimpleOptOpts dflags
+ simpl_opts = initSimpleOpts dflags
final_rhs = simpleOptExpr simpl_opts rhs'' -- De-crap it
rule_name = snd (unLoc name)
final_bndrs_set = mkVarSet final_bndrs
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index b05162aa3c..c8b4087958 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -391,7 +391,7 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs
Inline -> inline_pair
where
- simpl_opts = initSimpleOptOpts dflags
+ simpl_opts = initSimpleOpts dflags
inline_prag = idInlinePragma gbl_id
inlinable_unf = mkInlinableUnfolding simpl_opts rhs
inline_pair
@@ -706,7 +706,7 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
{ this_mod <- getModule
; let fn_unf = realIdUnfolding poly_id
- simpl_opts = initSimpleOptOpts dflags
+ simpl_opts = initSimpleOpts dflags
spec_unf = specUnfolding simpl_opts spec_bndrs core_app rule_lhs_args fn_unf
spec_id = mkLocalId spec_name Many spec_ty -- Specialised binding is toplevel, hence Many.
`setInlinePragma` inl_prag
@@ -866,7 +866,7 @@ decomposeRuleLhs dflags orig_bndrs orig_lhs
| otherwise
= Left bad_shape_msg
where
- simpl_opts = initSimpleOptOpts dflags
+ simpl_opts = initSimpleOpts dflags
lhs1 = drop_dicts orig_lhs
lhs2 = simpleOptExpr simpl_opts lhs1 -- See Note [Simplify rule LHS]
(fun2,args2) = collectArgs lhs2
diff --git a/compiler/GHC/HsToCore/Foreign/Decl.hs b/compiler/GHC/HsToCore/Foreign/Decl.hs
index 0c5d8676eb..08cfc7aee6 100644
--- a/compiler/GHC/HsToCore/Foreign/Decl.hs
+++ b/compiler/GHC/HsToCore/Foreign/Decl.hs
@@ -287,7 +287,7 @@ dsFCall fn_id co fcall mDeclHeader = do
wrapper_body = foldr ($) (res_wrapper work_app) arg_wrappers
wrap_rhs = mkLams (tvs ++ args) wrapper_body
wrap_rhs' = Cast wrap_rhs co
- simpl_opts = initSimpleOptOpts dflags
+ simpl_opts = initSimpleOpts dflags
fn_id_w_inl = fn_id `setIdUnfolding` mkInlineUnfoldingWithArity
(length args)
simpl_opts
diff --git a/compiler/GHC/HsToCore/PmCheck/Oracle.hs b/compiler/GHC/HsToCore/PmCheck/Oracle.hs
index 3919b91893..04bff18be1 100644
--- a/compiler/GHC/HsToCore/PmCheck/Oracle.hs
+++ b/compiler/GHC/HsToCore/PmCheck/Oracle.hs
@@ -1668,7 +1668,7 @@ representCoreExpr delta@MkDelta{ delta_tm_st = ts@TmSt{ ts_reps = reps } } e
-- want to record @x ~ y@.
addCoreCt :: Delta -> Id -> CoreExpr -> MaybeT DsM Delta
addCoreCt delta x e = do
- simpl_opts <- initSimpleOptOpts <$> getDynFlags
+ simpl_opts <- initSimpleOpts <$> getDynFlags
let e' = simpleOptExpr simpl_opts e
lift $ tracePm "addCoreCt" (ppr x <+> dcolon <+> ppr (idType x) $$ ppr e $$ ppr e')
execStateT (core_expr x e') delta
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index c9f70ee62a..42ec78276e 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -1208,7 +1208,7 @@ addDFunPrags :: DFunId -> [Id] -> DFunId
-- is messing with.
addDFunPrags dfun_id sc_meth_ids
| is_newtype
- = dfun_id `setIdUnfolding` mkInlineUnfoldingWithArity 0 defaultSimpleOptOpts con_app
+ = dfun_id `setIdUnfolding` mkInlineUnfoldingWithArity 0 defaultSimpleOpts con_app
`setInlinePragma` alwaysInlinePragma { inl_sat = Just 0 }
| otherwise
= dfun_id `setIdUnfolding` mkDFunUnfolding dfun_bndrs dict_con dict_args
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs
index 49e57b44ca..fa445ea25f 100644
--- a/compiler/GHC/Types/Id/Make.hs
+++ b/compiler/GHC/Types/Id/Make.hs
@@ -487,7 +487,7 @@ mkDictSelId name clas
info | new_tycon
= base_info `setInlinePragInfo` alwaysInlinePragma
`setUnfoldingInfo` mkInlineUnfoldingWithArity 1
- defaultSimpleOptOpts
+ defaultSimpleOpts
(mkDictSelRhs clas val_index)
-- See Note [Single-method classes] in GHC.Tc.TyCl.Instance
-- for why alwaysInlinePragma
@@ -602,7 +602,7 @@ mkDataConWorkId wkr_name data_con
isSingleton arg_tys
, ppr data_con )
-- Note [Newtype datacons]
- mkCompulsoryUnfolding defaultSimpleOptOpts $
+ mkCompulsoryUnfolding defaultSimpleOpts $
mkLams univ_tvs $ Lam id_arg1 $
wrapNewTypeBody tycon res_ty_args (Var id_arg1)
@@ -735,9 +735,9 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
-- See Note [Inline partially-applied constructor wrappers]
-- Passing Nothing here allows the wrapper to inline when
-- unsaturated.
- wrap_unf | isNewTyCon tycon = mkCompulsoryUnfolding defaultSimpleOptOpts wrap_rhs
+ wrap_unf | isNewTyCon tycon = mkCompulsoryUnfolding defaultSimpleOpts wrap_rhs
-- See Note [Compulsory newtype unfolding]
- | otherwise = mkInlineUnfolding defaultSimpleOptOpts wrap_rhs
+ | otherwise = mkInlineUnfolding defaultSimpleOpts wrap_rhs
wrap_rhs = mkLams wrap_tvs $
mkLams wrap_args $
wrapFamInstBody tycon res_ty_args $
@@ -1465,7 +1465,7 @@ nullAddrId :: Id
nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info
where
info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
- `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOptOpts (Lit nullAddrLit)
+ `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts (Lit nullAddrLit)
`setNeverLevPoly` addrPrimTy
------------------------------------------------
@@ -1473,7 +1473,7 @@ seqId :: Id -- See Note [seqId magic]
seqId = pcMiscPrelId seqName ty info
where
info = noCafIdInfo `setInlinePragInfo` inline_prag
- `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOptOpts rhs
+ `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts rhs
inline_prag
= alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter
@@ -1510,7 +1510,7 @@ oneShotId :: Id -- See Note [The oneShot function]
oneShotId = pcMiscPrelId oneShotName ty info
where
info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
- `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOptOpts rhs
+ `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts rhs
ty = mkSpecForAllTys [ runtimeRep1TyVar, runtimeRep2TyVar
, openAlphaTyVar, openBetaTyVar ]
(mkVisFunTyMany fun_ty fun_ty)
@@ -1536,7 +1536,7 @@ coerceId :: Id
coerceId = pcMiscPrelId coerceName ty info
where
info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
- `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOptOpts rhs
+ `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts rhs
eqRTy = mkTyConApp coercibleTyCon [ tYPE r , a, b ]
eqRPrimTy = mkTyConApp eqReprPrimTyCon [ tYPE r, tYPE r, a, b ]
ty = mkInvisForAllTys [ Bndr rv InferredSpec
@@ -1783,7 +1783,7 @@ voidPrimId :: Id -- Global constant :: Void#
-- We cannot define it in normal Haskell, since it's
-- a top-level unlifted value.
voidPrimId = pcMiscPrelId voidPrimIdName unboxedUnitTy
- (noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOptOpts rhs
+ (noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding defaultSimpleOpts rhs
`setNeverLevPoly` unboxedUnitTy)
where rhs = Var (dataConWorkId unboxedUnitDataCon)