bytestring benchmarks: 9.8 eta-expansion regression
If you compile these two files.
```haskell
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Builder(Builder, word8) where
import Data.Word
import GHC.Ptr
import GHC.Word
import GHC.Prim
import GHC.IO
newtype Builder = Builder (forall r. BuildStep r -> BuildStep r)
type BuildStep a = BufferRange -> IO (BuildSignal a)
data BufferRange = BufferRange {-# UNPACK #-} !(Ptr Word8) -- First byte of range
{-# UNPACK #-} !(Ptr Word8) -- First byte /after/ range
-- | 'BuildSignal's abstract signals to the caller of a 'BuildStep'. There are
-- three signals: 'done', 'bufferFull', or 'insertChunks signals
data BuildSignal a =
Done {-# UNPACK #-} !(Ptr Word8) a
--type BuildStep r = () -> r
{-# NOINLINE word8 #-}
word8 :: Word8 -> Builder
word8 x = Builder (\bs br -> IO $ \s -> word1 x bs br s)
word1
:: Word8
-> (forall r.
BuildStep r
-> BufferRange
-> State# RealWorld
-> (# State# RealWorld,
BuildSignal r #))
word1
= \ (x_a3Nz :: Word8)
(eta_a3NB :: BuildStep r_a3NA)
(eta1_a3NC
:: BufferRange)
(eta2_a3ND :: State# RealWorld) ->
case eta1_a3NC of
{ BufferRange (Ptr bx_a3NO) (Ptr bx1_a3NP) ->
case (<#) (minusAddr# bx1_a3NP bx_a3NO) 1# of {
__DEFAULT ->
case x_a3Nz of { W8# x1_i2Az_af5Q ->
case writeWord8OffAddr#
@RealWorld bx_a3NO 0# x1_i2Az_af5Q eta2_a3ND
of
{ s2_i2 ->
(coerce (eta_a3NB
(BufferRange
(Ptr (plusAddr# bx_a3NO 1#)) (Ptr bx1_a3NP)))
s2_i2)
}
};
}
}
-- | The 'Builder' denoting a zero-length sequence of bytes. This function is
-- only exported for use in rewriting rules. Use 'mempty' otherwise.
{-# INLINE[1] empty #-}
empty :: Builder
empty = Builder ($)
-- This eta expansion (hopefully) allows GHC to worker-wrapper the
-- 'BufferRange' in the 'empty' base case of loops (since
-- worker-wrapper requires (TODO: verify this) that all paths match
-- against the wrapped argument.
-- | Concatenate two 'Builder's. This function is only exported for use in rewriting
-- rules. Use 'mappend' otherwise.
{-# INLINE[1] append #-}
append :: Builder -> Builder -> Builder
append (Builder b1) (Builder b2) = Builder $ b1 . b2
instance Semigroup Builder where
{-# INLINE (<>) #-}
(<>) = append
instance Monoid Builder where
{-# INLINE mempty #-}
mempty = empty
{-# INLINE mappend #-}
mappend = (<>)
{-# INLINE mconcat #-}
mconcat = foldr mappend mempty
```
and
```haskell
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MagicHash #-}
{-# OPTIONS_GHC -dno-typeable-binds #-}
module Main (main, repro) where
import qualified Builder as B
import Data.Foldable
repro :: [Int] -> B.Builder
repro xs = foldMap (B.word8 . fromIntegral) xs
main :: IO ()
main = print ()
```
Compile with `ghc -O2 Main.hs`
Then you observe the core for `repro` you can see that in 9.6.2, the definition is nicely eta-expanded but that doesn't happen in 9.8.1-alpha1.
The result is a regression in runtime performance in the bytestring benchmarks.
ghc-9.6.2:
```
Rec {
-- RHS size: {terms: 28, types: 20, coercions: 10, joins: 0/0}
Main.repro1 [Occ=LoopBreaker]
:: [Int]
-> forall {r}.
Builder.BuildStep r
-> Builder.BufferRange
-> GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, Builder.BuildSignal r #)
[GblId, Arity=4, Str=<1L><1C(1,C(1,L))><L><L>, Unf=OtherCon []]
Main.repro1
= \ (ds_a1xD :: [Int])
(@r_X3)
(eta_X4 :: Builder.BuildStep r_X3)
(eta1_X5 :: Builder.BufferRange)
(eta2_X6 [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
case ds_a1xD of {
[] ->
((eta_X4 eta1_X5)
`cast` (GHC.Types.N:IO[0] <Builder.BuildSignal r_X3>_R
:: IO (Builder.BuildSignal r_X3)
~R# (GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld,
Builder.BuildSignal r_X3 #))))
eta2_X6;
: y_a1xG ys_a1xH ->
case y_a1xG of { GHC.Types.I# i_a20t ->
case eta1_X5 of { Builder.BufferRange ww1_i2II ww2_i2IJ ->
Builder.$wword8
(GHC.Prim.wordToWord8# (GHC.Prim.int2Word# i_a20t))
@r_X3
((Main.repro1 ys_a1xH @r_X3 eta_X4)
`cast` (<Builder.BufferRange>_R
%<Many>_N ->_R Sym (GHC.Types.N:IO[0] <Builder.BuildSignal r_X3>_R)
:: (Builder.BufferRange
-> GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld,
Builder.BuildSignal r_X3 #))
~R# (Builder.BufferRange -> IO (Builder.BuildSignal r_X3))))
ww1_i2II
ww2_i2IJ
eta2_X6
}
}
}
end Rec }
```
ghc-9.8.1-alpha1
```
Rec {
-- RHS size: {terms: 28, types: 22, coercions: 7, joins: 0/1}
Main.repro1 [Occ=LoopBreaker]
:: [Int] -> forall r. Builder.BuildStep r -> Builder.BuildStep r
[GblId, Arity=2, Str=<1L><ML>, Unf=OtherCon []]
Main.repro1
= \ (ds_a1yH :: [Int])
(@r_X1)
(eta_X2 :: Builder.BuildStep r_X1) ->
case ds_a1yH of {
[] -> eta_X2;
: y_a1yK ys_a1yL ->
let {
eta1_X3 [Dmd=LC(S,C(1,L))] :: Builder.BuildStep r_X1
[LclId]
eta1_X3 = Main.repro1 ys_a1yL @r_X1 eta_X2 } in
(\ (eta2_B1 :: Builder.BufferRange)
(eta3_B2 [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
case y_a1yK of { GHC.Types.I# i_a21w ->
case eta2_B1 of { Builder.BufferRange ww1_i2Jf ww2_i2Jg ->
Builder.$wword8
(GHC.Prim.wordToWord8# (GHC.Prim.int2Word# i_a21w))
@r_X1
eta1_X3
ww1_i2Jf
ww2_i2Jg
eta3_B2
}
})
`cast` (<Builder.BufferRange>_R
%<Many>_N ->_R Sym (GHC.Types.N:IO[0] <Builder.BuildSignal r_X1>_R)
:: (Builder.BufferRange
-> GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld,
Builder.BuildSignal r_X1 #))
~R# (Builder.BufferRange -> IO (Builder.BuildSignal r_X1)))
}
end Rec }
```
issue