FloatOut should only eta-expand a dead-ending RHS when arity will increase
Eta-expansion can turn trivial RHSs into non-trivial RHSs. That leads to more top-level bindings after the next Simplifier run, meaning more churn. We should therefore only eta-expand (at least trivial RHSs) if we actually need to (OTOH that's only the case for CorePrep).
FloatOut is currently a bit careless in that regard. Consider
module Lib where
import Control.Monad (forever)
import Control.Monad.Trans.State.Strict
inc :: State Int ()
inc = modify' (+1)
m :: State Int ()
m = forever inc
After the second FloatOut (after demand analysis), we have
...
m :: State Int ()
m = ...
Rec {
-- RHS size: {terms: 6, types: 1, coercions: 0, joins: 0/0}
lvl_sOv
:: GHC.Prim.Int# -> Data.Functor.Identity.Identity ((), Int)
[LclId, Arity=1, Str=<L,U>b, Cpr=b]
lvl_sOv
= \ (x_aNg :: GHC.Prim.Int#) ->
a'_sO0 (GHC.Types.I# (GHC.Prim.+# x_aNg 1#))
-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
a'_sO0 [Occ=LoopBreaker]
:: Int -> Data.Functor.Identity.Identity ((), Int)
[LclId, Arity=1, Str=<L,U>b, Cpr=b]
a'_sO0
= \ (s1_aNP :: Int) ->
case s1_aNP of { GHC.Types.I# x_aNg [Dmd=<B,A>] -> lvl_sOv x_aNg }
end Rec }
-- RHS size: {terms: 3, types: 1, coercions: 5, joins: 0/0}
a :: State Int ()
[LclIdX,
Arity=1,
Str=<B,1*H>b,
Cpr=b,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)
Tmpl= a'_sO0
`cast` (Sym (Control.Monad.Trans.State.Strict.N:StateT[0]
<Int>_N <Data.Functor.Identity.Identity>_R <()>_N)
:: (Int -> Data.Functor.Identity.Identity ((), Int))
~R# StateT Int Data.Functor.Identity.Identity ())}]
a = (\ (eta_B1 :: Int) -> a'_sO0 eta_B1)
`cast` (Sym (Control.Monad.Trans.State.Strict.N:StateT[0]
<Int>_N <Data.Functor.Identity.Identity>_R <()>_N)
:: (Int -> Data.Functor.Identity.Identity ((), Int))
~R# StateT Int Data.Functor.Identity.Identity ())
Both lvl
and the eta-expanded RHS of a
(which will lead to yet another top-level binding after the next simplifier run) are unnecessary.
Also we end up allocating an I#
box in each loop iteration (in lvl
). But that is probably due to the Simplifier refraining from inlining dead-ending functions. Or SetLevels. I don't know. I think we should inline that, but don't know on what grounds and if we would punish code using error
by that. I have to understand Note [Bottoming floats]
. Or maybe it's because we don't do strictness WW for dead-ending functions. Anyway, the allocation isn't too concerning, but the extra binding is annoying.