Commit 6d49d5be authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Marge Bot

Implement cast worker/wrapper properly

The cast worker/wrapper transformation transforms
   x = e |> co
into
   y = e
   x = y |> co

This is done by the simplifier, but we were being
careless about transferring IdInfo from x to y,
and about what to do if x is a NOINLNE function.
This resulted in a series of bugs:
     #17673, #18093, #18078.

This patch fixes all that:

* Main change is in GHC.Core.Opt.Simplify, and
  the new prepareBinding function, which does this
  cast worker/wrapper transform.
  See Note [Cast worker/wrappers].

* There is quite a bit of refactoring around
  prepareRhs, makeTrivial etc.  It's nicer now.

* Some wrappers from strictness and cast w/w, notably those for
  a function with a NOINLINE, should inline very late. There
  wasn't really a mechanism for that, which was an existing bug
  really; so I invented a new finalPhase = Phase (-1).  It's used
  for all simplifier runs after the user-visible phase 2,1,0 have
  run.  (No new runs of the simplifier are introduced thereby.)

  See new Note [Compiler phases] in GHC.Types.Basic;
  the main changes are in GHC.Core.Opt.Driver

* Doing this made me trip over two places where the AnonArgFlag on a
  FunTy was being lost so we could end up with (Num a -> ty)
  rather than (Num a => ty)
    - In coercionLKind/coercionRKind
    - In contHoleType in the Simplifier

  I fixed the former by defining mkFunctionType and using it in
  coercionLKind/RKind.

  I could have done the same for the latter, but the information
  is almost to hand.  So I fixed the latter by
    - adding sc_hole_ty to ApplyToVal (like ApplyToTy),
    - adding as_hole_ty to ValArg (like TyArg)
    - adding sc_fun_ty to StrictArg
  Turned out I could then remove ai_type from ArgInfo.  This is
  just moving the deck chairs around, but it worked out nicely.

  See the new Note [AnonArgFlag] in GHC.Types.Var

* When looking at the 'arity decrease' thing (#18093) I discovered
  that stable unfoldings had a much lower arity than the actual
  optimised function.  That's what led to the arity-decrease
  message.  Simple solution: eta-expand.

  It's described in Note [Eta-expand stable unfoldings]
  in GHC.Core.Opt.Simplify

* I also discovered that unsafeCoerce wasn't being inlined if
  the context was boring.  So (\x. f (unsafeCoerce x)) would
  create a thunk -- yikes!  I fixed that by making inlineBoringOK
  a bit cleverer: see Note [Inline unsafeCoerce] in GHC.Core.Unfold.

  I also found that unsafeCoerceName was unused, so I removed it.

I made a test case for #18078, and a very similar one for #17673.

The net effect of all this on nofib is very modest, but positive:

--------------------------------------------------------------------------------
        Program           Size    Allocs   Runtime   Elapsed  TotalMem
--------------------------------------------------------------------------------
           anna          -0.4%     -0.1%     -3.1%     -3.1%      0.0%
 fannkuch-redux          -0.4%     -0.3%     -0.1%     -0.1%      0.0%
       maillist          -0.4%     -0.1%     -7.8%     -1.0%    -14.3%
      primetest          -0.4%    -15.6%     -7.1%     -6.6%      0.0%
--------------------------------------------------------------------------------
            Min          -0.9%    -15.6%    -13.3%    -14.2%    -14.3%
            Max          -0.3%      0.0%    +12.1%    +12.4%      0.0%
 Geometric Mean          -0.4%     -0.2%     -2.3%     -2.2%     -0.1%

All following metric decreases are compile-time allocation decreases
between -1% and -3%:

Metric Decrease:
  T5631
  T13701
  T14697
  T15164
parent 9454511b
......@@ -472,7 +472,6 @@ basicKnownKeyNames
, unsafeEqualityTyConName
, unsafeReflDataConName
, unsafeCoercePrimName
, unsafeCoerceName
]
genericTyConNames :: [Name]
......@@ -1333,12 +1332,11 @@ typeErrorShowTypeDataConName =
-- Unsafe coercion proofs
unsafeEqualityProofName, unsafeEqualityTyConName, unsafeCoercePrimName,
unsafeCoerceName, unsafeReflDataConName :: Name
unsafeReflDataConName :: Name
unsafeEqualityProofName = varQual uNSAFE_COERCE (fsLit "unsafeEqualityProof") unsafeEqualityProofIdKey
unsafeEqualityTyConName = tcQual uNSAFE_COERCE (fsLit "UnsafeEquality") unsafeEqualityTyConKey
unsafeReflDataConName = dcQual uNSAFE_COERCE (fsLit "UnsafeRefl") unsafeReflDataConKey
unsafeCoercePrimName = varQual uNSAFE_COERCE (fsLit "unsafeCoerce#") unsafeCoercePrimIdKey
unsafeCoerceName = varQual uNSAFE_COERCE (fsLit "unsafeCoerce") unsafeCoerceIdKey
-- Dynamic
toDynName :: Name
......@@ -2417,10 +2415,9 @@ naturalSDataConKey = mkPreludeMiscIdUnique 568
wordToNaturalIdKey = mkPreludeMiscIdUnique 569
-- Unsafe coercion proofs
unsafeEqualityProofIdKey, unsafeCoercePrimIdKey, unsafeCoerceIdKey :: Unique
unsafeEqualityProofIdKey, unsafeCoercePrimIdKey :: Unique
unsafeEqualityProofIdKey = mkPreludeMiscIdUnique 570
unsafeCoercePrimIdKey = mkPreludeMiscIdUnique 571
unsafeCoerceIdKey = mkPreludeMiscIdUnique 572
{-
************************************************************************
......
......@@ -2188,7 +2188,7 @@ coercionLKind co
go (TyConAppCo _ tc cos) = mkTyConApp tc (map go cos)
go (AppCo co1 co2) = mkAppTy (go co1) (go co2)
go (ForAllCo tv1 _ co1) = mkTyCoInvForAllTy tv1 (go co1)
go (FunCo _ co1 co2) = mkVisFunTy (go co1) (go co2)
go (FunCo _ co1 co2) = mkFunctionType (go co1) (go co2)
  • This just came across my radar (for boring reasons), but why do this? Coercion kinds should be used only when doing core lint or core transformations, when the distinction between -> and => is immaterial. Yet this new mkFunctionType does more work than the old mkVisFunTy. Maybe it's distracting to see Eq a -> a -> Bool in output. But if that's the problem, then I would consider a pre-pass en route to the pretty-printer that twiddles arrow shapes when necessary. (This can be done before converting to IfaceType so that we have kind information easily available. Maybe it can even be done right in toIfaceType.)

  • See Note [AnonArgFlag].

    The specialiser uses the -> vs => distinction.

    I think we can do two things

    • Maintain AnonArgFlag consistently
    • Not have it at all

    But having it sometimes right and sometimes wrong seems... well.. wrong.

Please register or sign in to reply
go (CoVarCo cv) = coVarLType cv
go (HoleCo h) = coVarLType (coHoleCoVar h)
go (UnivCo _ _ ty1 _) = ty1
......@@ -2245,7 +2245,7 @@ coercionRKind co
go (AppCo co1 co2) = mkAppTy (go co1) (go co2)
go (CoVarCo cv) = coVarRType cv
go (HoleCo h) = coVarRType (coHoleCoVar h)
go (FunCo _ co1 co2) = mkVisFunTy (go co1) (go co2)
go (FunCo _ co1 co2) = mkFunctionType (go co1) (go co2)
go (UnivCo _ _ _ ty2) = ty2
go (SymCo co) = coercionLKind co
go (TransCo _ co2) = go co2
......
......@@ -404,7 +404,7 @@ delayInlining top_lvl bndr
-- These rules are probably auto-generated specialisations,
-- since Ids with manual rules usually have manually-inserted
-- delayed inlining anyway
= bndr `setInlineActivation` activeAfterInitial
= bndr `setInlineActivation` activateAfterInitial
| otherwise
= bndr
......
......@@ -331,8 +331,8 @@ cprAnalBind top_lvl env id rhs
cprExpandUnfolding_maybe :: Id -> Maybe CoreExpr
cprExpandUnfolding_maybe id = do
guard (idArity id == 0)
-- There are only phase 0 Simplifier runs after CPR analysis
guard (isActiveIn 0 (idInlineActivation id))
-- There are only FinalPhase Simplifier runs after CPR analysis
guard (activeInFinalPhase (idInlineActivation id))
expandUnfolding_maybe (idUnfolding id)
{- Note [Arity trimming for CPR signatures]
......
......@@ -37,7 +37,7 @@ import GHC.Core.Opt.FloatOut ( floatOutwards )
import GHC.Core.FamInstEnv
import GHC.Types.Id
import GHC.Utils.Error ( withTiming, withTimingD, DumpFormat (..) )
import GHC.Types.Basic ( CompilerPhase(..), isDefaultInlinePragma, defaultInlinePragma )
import GHC.Types.Basic
import GHC.Types.Var.Set
import GHC.Types.Var.Env
import GHC.Core.Opt.LiberateCase ( liberateCase )
......@@ -141,8 +141,10 @@ getCoreToDo dflags
maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
maybe_strictness_before phase
= runWhen (phase `elem` strictnessBefore dflags) CoreDoDemand
maybe_strictness_before (Phase phase)
| phase `elem` strictnessBefore dflags = CoreDoDemand
maybe_strictness_before _
= CoreDoNothing
base_mode = SimplMode { sm_phase = panic "base_mode"
, sm_names = []
......@@ -152,20 +154,20 @@ getCoreToDo dflags
, sm_inline = True
, sm_case_case = True }
simpl_phase phase names iter
simpl_phase phase name iter
= CoreDoPasses
$ [ maybe_strictness_before phase
, CoreDoSimplify iter
(base_mode { sm_phase = Phase phase
, sm_names = names })
(base_mode { sm_phase = phase
, sm_names = [name] })
, maybe_rule_check (Phase phase) ]
, maybe_rule_check phase ]
simpl_phases = CoreDoPasses [ simpl_phase phase ["main"] max_iter
| phase <- [phases, phases-1 .. 1] ]
-- Run GHC's internal simplification phase, after all rules have run.
-- See Note [Compiler phases] in GHC.Types.Basic
simplify name = simpl_phase FinalPhase name max_iter
-- initial simplify: mk specialiser happy: minimum effort please
-- initial simplify: mk specialiser happy: minimum effort please
simpl_gently = CoreDoSimplify max_iter
(base_mode { sm_phase = InitialPhase
, sm_names = ["Gentle"]
......@@ -182,7 +184,7 @@ getCoreToDo dflags
demand_analyser = (CoreDoPasses (
dmd_cpr_ww ++
[simpl_phase 0 ["post-worker-wrapper"] max_iter]
[simplify "post-worker-wrapper"]
))
-- Static forms are moved to the top level with the FloatOut pass.
......@@ -203,7 +205,7 @@ getCoreToDo dflags
if opt_level == 0 then
[ static_ptrs_float_outwards,
CoreDoSimplify max_iter
(base_mode { sm_phase = Phase 0
(base_mode { sm_phase = FinalPhase
, sm_names = ["Non-opt simplification"] })
]
......@@ -251,8 +253,10 @@ getCoreToDo dflags
-- GHC.Iface.Tidy.StaticPtrTable.
static_ptrs_float_outwards,
simpl_phases,
-- Run the simplier phases 2,1,0 to allow rewrite rules to fire
CoreDoPasses [ simpl_phase (Phase phase) "main" max_iter
| phase <- [phases, phases-1 .. 1] ],
simpl_phase (Phase 0) "main" (max max_iter 3),
-- Phase 0: allow all Ids to be inlined now
-- This gets foldr inlined before strictness analysis
......@@ -263,7 +267,6 @@ getCoreToDo dflags
-- ==> let k = BIG in letrec go = \xs -> ...(k x).... in go xs
-- ==> let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
-- Don't stop now!
simpl_phase 0 ["main"] (max max_iter 3),
runWhen do_float_in CoreDoFloatInwards,
-- Run float-inwards immediately before the strictness analyser
......@@ -274,9 +277,10 @@ getCoreToDo dflags
runWhen call_arity $ CoreDoPasses
[ CoreDoCallArity
, simpl_phase 0 ["post-call-arity"] max_iter
, simplify "post-call-arity"
],
-- Strictness analysis
runWhen strictness demand_analyser,
runWhen exitification CoreDoExitify,
......@@ -302,24 +306,24 @@ getCoreToDo dflags
runWhen do_float_in CoreDoFloatInwards,
maybe_rule_check (Phase 0),
maybe_rule_check FinalPhase,
-- Case-liberation for -O2. This should be after
-- strictness analysis and the simplification which follows it.
runWhen liberate_case (CoreDoPasses [
CoreLiberateCase,
simpl_phase 0 ["post-liberate-case"] max_iter
simplify "post-liberate-case"
]), -- Run the simplifier after LiberateCase to vastly
-- reduce the possibility of shadowing
-- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr
runWhen spec_constr CoreDoSpecConstr,
maybe_rule_check (Phase 0),
maybe_rule_check FinalPhase,
runWhen late_specialise
(CoreDoPasses [ CoreDoSpecialising
, simpl_phase 0 ["post-late-spec"] max_iter]),
, simplify "post-late-spec"]),
-- LiberateCase can yield new CSE opportunities because it peels
-- off one layer of a recursive function (concretely, I saw this
......@@ -328,11 +332,10 @@ getCoreToDo dflags
runWhen ((liberate_case || spec_constr) && cse) CoreCSE,
-- Final clean-up simplification:
simpl_phase 0 ["final"] max_iter,
simplify "final",
runWhen late_dmd_anal $ CoreDoPasses (
dmd_cpr_ww ++
[simpl_phase 0 ["post-late-ww"] max_iter]
dmd_cpr_ww ++ [simplify "post-late-ww"]
),
-- Final run of the demand_analyser, ensures that one-shot thunks are
......@@ -342,7 +345,7 @@ getCoreToDo dflags
-- can become /exponentially/ more expensive. See #11731, #12996.
runWhen (strictness || late_dmd_anal) CoreDoDemand,
maybe_rule_check (Phase 0)
maybe_rule_check FinalPhase
]
-- Remove 'CoreDoNothing' and flatten 'CoreDoPasses' for clarity.
......
This diff is collapsed.
This diff is collapsed.
......@@ -1760,8 +1760,8 @@ Note [Transfer activation]
In which phase should the specialise-constructor rules be active?
Originally I made them always-active, but Manuel found that this
defeated some clever user-written rules. Then I made them active only
in Phase 0; after all, currently, the specConstr transformation is
only run after the simplifier has reached Phase 0, but that meant
in FinalPhase; after all, currently, the specConstr transformation is
only run after the simplifier has reached FinalPhase, but that meant
that specialisations didn't fire inside wrappers; see test
simplCore/should_compile/spec-inline.
......
......@@ -245,8 +245,8 @@ NOINLINE pragma to the worker.
(See #13143 for a real-world example.)
It is crucial that we do this for *all* NOINLINE functions. #10069
demonstrates what happens when we promise to w/w a (NOINLINE) leaf function, but
fail to deliver:
demonstrates what happens when we promise to w/w a (NOINLINE) leaf
function, but fail to deliver:
data C = C Int# Int#
......@@ -421,19 +421,27 @@ When should the wrapper inlining be active?
In module Bar we want to give specialisations a chance to fire
before inlining f's wrapper.
Historical note: At one stage I tried making the wrapper inlining
always-active, and that had a very bad effect on nofib/imaginary/x2n1;
a wrapper was inlined before the specialisation fired.
Reminder: Note [Don't w/w INLINE things], so we don't need to worry
about INLINE things here.
Conclusion:
- If the user said NOINLINE[n], respect that
- If the user said NOINLINE, inline the wrapper as late as
poss (phase 0). This is a compromise driven by (2) above
- If the user said NOINLINE, inline the wrapper only after
phase 0, the last user-visible phase. That means that all
rules will have had a chance to fire.
What phase is after phase 0? Answer: FinalPhase, that's the reason it
exists. NB: Similar to InitialPhase, users can't write INLINE[Final] f;
it's syntactically illegal.
- Otherwise inline wrapper in phase 2. That allows the
'gentle' simplification pass to apply specialisation rules
Historical note: At one stage I tried making the wrapper inlining
always-active, and that had a very bad effect on nofib/imaginary/x2n1;
a wrapper was inlined before the specialisation fired.
Note [Wrapper NoUserInline]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -575,8 +583,8 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds div cpr rhs
work_uniq <- getUniqueM
let work_rhs = work_fn rhs
work_act = case fn_inline_spec of -- See Note [Worker activation]
NoInline -> fn_act
_ -> wrap_act
NoInline -> inl_act fn_inl_prag
_ -> inl_act wrap_prag
work_prag = InlinePragma { inl_src = SourceText "{-# INLINE"
, inl_inline = fn_inline_spec
......@@ -626,19 +634,7 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds div cpr rhs
| otherwise = topDmd
wrap_rhs = wrap_fn work_id
wrap_act = case fn_act of -- See Note [Wrapper activation]
ActiveAfter {} -> fn_act
NeverActive -> activeDuringFinal
_ -> activeAfterInitial
wrap_prag = InlinePragma { inl_src = SourceText "{-# INLINE"
, inl_inline = NoUserInline
, inl_sat = Nothing
, inl_act = wrap_act
, inl_rule = rule_match_info }
-- inl_act: see Note [Wrapper activation]
-- inl_inline: see Note [Wrapper NoUserInline]
-- inl_rule: RuleMatchInfo is (and must be) unaffected
wrap_prag = mkStrWrapperInlinePrag fn_inl_prag
wrap_id = fn_id `setIdUnfolding` mkWwInlineRule dflags wrap_rhs arity
`setInlinePragma` wrap_prag
`setIdOccInfo` noOccInfo
......@@ -655,8 +651,6 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds div cpr rhs
rhs_fvs = exprFreeVars rhs
fn_inl_prag = inlinePragInfo fn_info
fn_inline_spec = inl_inline fn_inl_prag
fn_act = inl_act fn_inl_prag
rule_match_info = inlinePragmaRuleMatchInfo fn_inl_prag
fn_unfolding = unfoldingInfo fn_info
arity = arityInfo fn_info
-- The arity is set by the simplifier using exprEtaExpandArity
......@@ -674,6 +668,25 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds div cpr rhs
| otherwise = topCpr
mkStrWrapperInlinePrag :: InlinePragma -> InlinePragma
mkStrWrapperInlinePrag (InlinePragma { inl_act = act, inl_rule = rule_info })
= InlinePragma { inl_src = SourceText "{-# INLINE"
, inl_inline = NoUserInline -- See Note [Wrapper NoUserInline]
, inl_sat = Nothing
, inl_act = wrap_act
, inl_rule = rule_info } -- RuleMatchInfo is (and must be) unaffected
where
wrap_act = case act of -- See Note [Wrapper activation]
NeverActive -> activateDuringFinal
FinalActive -> act
ActiveAfter {} -> act
ActiveBefore {} -> activateAfterInitial
AlwaysActive -> activateAfterInitial
-- For the last two cases, see (4) in Note [Wrapper activation]
-- NB: the (ActiveBefore n) isn't quite right. We really want
-- it to be active *after* Initial but *before* n. We don't have
-- a way to say that, alas.
{-
Note [Demand on the worker]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
......@@ -1367,8 +1367,7 @@ pushCoTyArg co ty
| otherwise
= Nothing
where
tyL = coercionLKind co
tyR = coercionRKind co
Pair tyL tyR = coercionKind co
-- co :: tyL ~ tyR
-- tyL = forall (a1 :: k1). ty1
-- tyR = forall (a2 :: k2). ty2
......
......@@ -51,7 +51,7 @@ module GHC.Core.Type (
splitPiTy_maybe, splitPiTy, splitPiTys,
mkTyConBindersPreferAnon,
mkPiTy, mkPiTys,
mkLamType, mkLamTypes,
mkLamType, mkLamTypes, mkFunctionType,
piResultTy, piResultTys,
applyTysX, dropForAlls,
mkFamilyTyConApp,
......@@ -256,7 +256,7 @@ import {-# SOURCE #-} GHC.Core.Coercion
, mkTyConAppCo, mkAppCo, mkCoVarCo, mkAxiomRuleCo
, mkForAllCo, mkFunCo, mkAxiomInstCo, mkUnivCo
, mkSymCo, mkTransCo, mkNthCo, mkLRCo, mkInstCo
, mkKindCo, mkSubCo, mkFunCo, mkAxiomInstCo
, mkKindCo, mkSubCo
, decomposePiCos, coercionKind, coercionLKind
, coercionRKind, coercionType
, isReflexiveCo, seqCo )
......@@ -1517,6 +1517,8 @@ mkLamType :: Var -> Type -> Type
mkLamTypes :: [Var] -> Type -> Type
-- ^ 'mkLamType' for multiple type or value arguments
mkLamTypes vs ty = foldr mkLamType ty vs
mkLamType v body_ty
| isTyVar v
= ForAllTy (Bndr v Inferred) body_ty
......@@ -1525,43 +1527,19 @@ mkLamType v body_ty
, v `elemVarSet` tyCoVarsOfType body_ty
= ForAllTy (Bndr v Required) body_ty
| isPredTy arg_ty -- See Note [mkLamType: dictionary arguments]
= mkInvisFunTy arg_ty body_ty
| otherwise
= mkVisFunTy arg_ty body_ty
where
arg_ty = varType v
mkLamTypes vs ty = foldr mkLamType ty vs
= mkFunctionType (varType v) body_ty
{- Note [mkLamType: dictionary arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we have (\ (d :: Ord a). blah), we want to give it type
(Ord a => blah_ty)
with a fat arrow; that is, using mkInvisFunTy, not mkVisFunTy.
Why? After all, we are in Core, where (=>) and (->) behave the same.
Yes, but the /specialiser/ does treat dictionary arguments specially.
Suppose we do w/w on 'foo' in module A, thus (#11272, #6056)
foo :: Ord a => Int -> blah
foo a d x = case x of I# x' -> $wfoo @a d x'
mkFunctionType :: Type -> Type -> Type
-- This one works out the AnonArgFlag from the argument type
-- See GHC.Types.Var Note [AnonArgFlag]
mkFunctionType arg_ty res_ty
| isPredTy arg_ty -- See GHC.Types.Var Note [AnonArgFlag]
= mkInvisFunTy arg_ty res_ty
$wfoo :: Ord a => Int# -> blah
Now in module B we see (foo @Int dOrdInt). The specialiser will
specialise this to $sfoo, where
$sfoo :: Int -> blah
$sfoo x = case x of I# x' -> $wfoo @Int dOrdInt x'
Now we /must/ also specialise $wfoo! But it wasn't user-written,
and has a type built with mkLamTypes.
Conclusion: the easiest thing is to make mkLamType build
(c => ty)
when the argument is a predicate type. See GHC.Core.TyCo.Rep
Note [Types for coercions, predicates, and evidence]
-}
| otherwise
= mkVisFunTy arg_ty res_ty
-- | Given a list of type-level vars and the free vars of a result kind,
-- makes TyCoBinders, preferring anonymous binders
......
......@@ -412,6 +412,8 @@ inlineBoringOk e
, exprIsTrivial a = go (credit-1) f
go credit (Tick _ e) = go credit e -- dubious
go credit (Cast e _) = go credit e
go credit (Case scrut _ _ [(_,_,rhs)]) -- See Note [Inline unsafeCoerce]
| isUnsafeEqualityProof scrut = go credit rhs
go _ (Var {}) = boringCxtOk
go _ _ = boringCxtNotOk
......@@ -459,7 +461,21 @@ calcUnfoldingGuidance dflags is_top_bottoming expr
| otherwise = (+)
-- See Note [Function and non-function discounts]
{-
{- Note [Inline unsafeCoerce]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We really want to inline unsafeCoerce, even when applied to boring
arguments. It doesn't look as if its RHS is smaller than the call
unsafeCoerce x = case unsafeEqualityProof @a @b of UnsafeRefl -> x
but that case is discarded -- see Note [Implementing unsafeCoerce]
in base:Unsafe.Coerce.
Moreover, if we /don't/ inline it, we may be left with
f (unsafeCoerce x)
which will build a thunk -- bad, bad, bad.
Conclusion: we really want inlineBoringOk to be True of the RHS of
unsafeCoerce. This is (U4a) in Note [Implementing unsafeCoerce].
Note [Computing the size of an expression]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The basic idea of sizeExpr is obvious enough: count nodes. But getting the
......
......@@ -56,6 +56,9 @@ module GHC.Core.Utils (
-- * Join points
isJoinBind,
-- * unsafeEqualityProof
isUnsafeEqualityProof,
-- * Dumping stuff
dumpIdInfoOfProgram
) where
......@@ -66,7 +69,7 @@ import GHC.Prelude
import GHC.Platform
import GHC.Core
import GHC.Builtin.Names ( makeStaticName )
import GHC.Builtin.Names ( makeStaticName, unsafeEqualityProofName )
import GHC.Core.Ppr
import GHC.Core.FVs( exprFreeVars )
import GHC.Types.Var
......@@ -2533,3 +2536,20 @@ dumpIdInfoOfProgram ppr_id_info binds = vcat (map printId ids)
getIds (Rec bs) = map fst bs
printId id | isExportedId id = ppr id <> colon <+> (ppr_id_info (idInfo id))
| otherwise = empty
{- *********************************************************************
* *
unsafeEqualityProof
* *
********************************************************************* -}
isUnsafeEqualityProof :: CoreExpr -> Bool
-- See (U3) and (U4) in
-- Note [Implementing unsafeCoerce] in base:Unsafe.Coerce
isUnsafeEqualityProof e
| Var v `App` Type _ `App` Type _ `App` Type _ <- e
= idName v == unsafeEqualityProofName
| otherwise
= False
......@@ -1095,15 +1095,6 @@ cpExprIsTrivial e
| otherwise
= exprIsTrivial e
isUnsafeEqualityProof :: CoreExpr -> Bool
-- See (U3) and (U4) in
-- Note [Implementing unsafeCoerce] in base:Unsafe.Coerce
isUnsafeEqualityProof e
| Var v `App` Type _ `App` Type _ `App` Type _ <- e
= idName v == unsafeEqualityProofName
| otherwise
= False
-- This is where we arrange that a non-trivial argument is let-bound
cpeArg :: CorePrepEnv -> Demand
-> CoreArg -> Type -> UniqSM (Floats, CpeArg)
......
......@@ -80,9 +80,9 @@ module GHC.Types.Basic (
CompilerPhase(..), PhaseNum,
Activation(..), isActive, isActiveIn, competesWith,
isNeverActive, isAlwaysActive, isEarlyActive,
activeAfterInitial, activeDuringFinal,
Activation(..), isActive, competesWith,
isNeverActive, isAlwaysActive, activeInFinalPhase,
activateAfterInitial, activateDuringFinal,
RuleMatchInfo(..), isConLike, isFunLike,
InlineSpec(..), noUserInlineSpec,
......@@ -1300,6 +1300,27 @@ pprWithSourceText (SourceText src) _ = text src
************************************************************************
When a rule or inlining is active
Note [Compiler phases]
~~~~~~~~~~~~~~~~~~~~~~
The CompilerPhase says which phase the simplifier is running in:
* InitialPhase: before all user-visible phases
* Phase 2,1,0: user-visible phases; the phase number
controls rule ordering an inlining.
* FinalPhase: used for all subsequent simplifier
runs. By delaying inlining of wrappers to FinalPhase we can
ensure that RULE have a good chance to fire. See
Note [Wrapper activation] in GHC.Core.Opt.WorkWrap
NB: FinalPhase is run repeatedly, not just once.
NB: users don't have access to InitialPhase or FinalPhase.
They write {-# INLINE[n] f #-}, meaning (Phase n)
The phase sequencing is done by GHC.Opt.Simplify.Driver
-}
-- | Phase Number
......@@ -1308,37 +1329,109 @@ type PhaseNum = Int -- Compilation phase
-- Zero is the last phase
data CompilerPhase
= Phase PhaseNum
| InitialPhase -- The first phase -- number = infinity!
= InitialPhase -- The first phase -- number = infinity!
| Phase PhaseNum -- User-specificable phases
| FinalPhase -- The last phase -- number = -infinity!
deriving Eq
instance Outputable CompilerPhase where
ppr (Phase n) = int n
ppr InitialPhase = text "InitialPhase"
ppr FinalPhase = text "FinalPhase"
activeAfterInitial :: Activation
-- See note [Pragma source text]
data Activation
= AlwaysActive
| ActiveBefore SourceText PhaseNum -- Active only *strictly before* this phase
| ActiveAfter SourceText PhaseNum -- Active in this phase and later
| FinalActive -- Active in final phase only
| NeverActive
deriving( Eq, Data )
-- Eq used in comparing rules in GHC.Hs.Decls
activateAfterInitial :: Activation
-- Active in the first phase after the initial phase
-- Currently we have just phases [2,1,0]
activeAfterInitial = ActiveAfter NoSourceText 2
-- Currently we have just phases [2,1,0,FinalPhase,FinalPhase,...]
-- Where FinalPhase means GHC's internal simplification steps
-- after all rules have run
activateAfterInitial = ActiveAfter NoSourceText 2
activeDuringFinal :: Activation
activateDuringFinal :: Activation
-- Active in the final simplification phase (which is repeated)
activeDuringFinal = ActiveAfter NoSourceText 0
activateDuringFinal = FinalActive
-- See note [Pragma source text]
data Activation = NeverActive
| AlwaysActive
| ActiveBefore SourceText PhaseNum
-- Active only *strictly before* this phase
| ActiveAfter SourceText PhaseNum
-- Active in this phase and later
deriving( Eq, Data )
-- Eq used in comparing rules in GHC.Hs.Decls
isActive :: CompilerPhase -> Activation -> Bool
isActive InitialPhase act = activeInInitialPhase act
isActive (Phase p) act = activeInPhase p act
isActive FinalPhase act = activeInFinalPhase act
activeInInitialPhase :: Activation -> Bool
activeInInitialPhase AlwaysActive = True
activeInInitialPhase (ActiveBefore {}) = True
activeInInitialPhase _ = False
activeInPhase :: PhaseNum -> Activation -> Bool
activeInPhase _ AlwaysActive = True
activeInPhase _ NeverActive = False
activeInPhase _ FinalActive = False
activeInPhase p (ActiveAfter _ n) = p <= n
activeInPhase p (ActiveBefore _ n) = p > n
activeInFinalPhase :: Activation -> Bool
activeInFinalPhase AlwaysActive = True
activeInFinalPhase FinalActive = True
activeInFinalPhase (ActiveAfter {}) = True
activeInFinalPhase _ = False
isNeverActive, isAlwaysActive :: Activation -> Bool
isNeverActive NeverActive = True
isNeverActive _ = False
isAlwaysActive AlwaysActive = True
isAlwaysActive _ = False
competesWith :: Activation -> Activation -> Bool
-- See Note [Activation competition]
competesWith AlwaysActive _ = True
competesWith NeverActive _ = False
competesWith _ NeverActive = False
competesWith FinalActive FinalActive = True
competesWith FinalActive _ = False
competesWith (ActiveBefore {}) AlwaysActive = True
competesWith (ActiveBefore {}) FinalActive = False
competesWith (ActiveBefore {}) (ActiveBefore {}) = True
competesWith (ActiveBefore _ a) (ActiveAfter _ b) = a < b
competesWith (ActiveAfter {}) AlwaysActive = False
competesWith (ActiveAfter {}) FinalActive = True
competesWith (ActiveAfter {}) (ActiveBefore {}) = False
competesWith (ActiveAfter _ a) (ActiveAfter _ b) = a >= b
{- Note [Competing activations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sometimes a RULE and an inlining may compete, or two RULES.
See Note [Rules and inlining/other rules] in GHC.HsToCore.
We say that act1 "competes with" act2 iff
act1 is active in the phase when act2 *becomes* active
NB: remember that phases count *down*: 2, 1, 0!
It's too conservative to ensure that the two are never simultaneously
active. For example, a rule might be always active, and an inlining
might switch on in phase 2. We could switch off the rule, but it does
no harm.
-}
{- *********************************************************************
* *
InlinePragma, InlineSpec, RuleMatchInfo
* *
********************************************************************* -}
-- | Rule Match Information
data RuleMatchInfo = ConLike -- See Note [CONLIKE pragma]
| FunLike
deriving( Eq, Data, Show )
-- Show needed for GHC.Parser.Lexer
data InlinePragma -- Note [InlinePragma]
= InlinePragma
......@@ -1358,6 +1451,12 @@ data InlinePragma -- Note [InlinePragma]
, inl_rule :: RuleMatchInfo -- Should the function be treated like a constructor?
} deriving( Eq, Data )