Minor code refactoring leads to drastic performance degradation

Hi! I've just observed an important performance problem. This code:

test0 :: Text -> Result
test0 src = let
    s1 = token 't'
    s2 = token 'e'
    s3 = token 's'
    s4 = token 't'
    p  = many $! s1 <> s2 <> s3 <> s4
    in runTokenParser p src
{-# NOINLINE test0 #-}

runs over 10 times faster than this one:

testGrammar1 :: Grammar Char
testGrammar1 = let
    s1 = token 't'
    s2 = token 'e'
    s3 = token 's'
    s4 = token 't'
    in many $! s1 <> s2 <> s3 <> s4
{-# INLINE testGrammar1 #-}

test1 :: Text -> Result
test1 = runTokenParser testGrammar1
{-# NOINLINE test1 #-}

I've also observed another thing here, namely the former code runs also over 10 times faster than this code:

test2 :: Text -> Result
test2 src = let
    s1 = token 't'
    s2 = token 'e'
    s3 = token 's'
    s4 = token 't'
    p  = X $! many $! s1 <> s2 <> s3 <> s4
    in runTokenParser p src
{-# NOINLINE test2 #-}

The only difference here is the X wrapper, while the runTokenParser is defined as runTokenParser (X !a) = runTokenParser a.

I've created sample project for it here: https://github.com/wdanilo/ghc-bug-peg-optimization/blob/master/src/Main.hs

In order to run it execute stack build --exec test.

The results are:

benchmarking test0
time                 420.0 μs   (417.6 μs .. 422.9 μs)
                     1.000 R²   (0.999 R² .. 1.000 R²)
mean                 421.0 μs   (419.2 μs .. 425.3 μs)
std dev              9.286 μs   (4.239 μs .. 15.30 μs)
variance introduced by outliers: 14% (moderately inflated)

benchmarking test1
time                 6.069 ms   (6.022 ms .. 6.123 ms)
                     0.999 R²   (0.998 R² .. 1.000 R²)
mean                 6.065 ms   (6.037 ms .. 6.117 ms)
std dev              114.5 μs   (74.30 μs .. 183.4 μs)

benchmarking test2
time                 6.070 ms   (6.007 ms .. 6.137 ms)
                     0.999 R²   (0.998 R² .. 1.000 R²)
mean                 6.067 ms   (6.039 ms .. 6.129 ms)
std dev              123.0 μs   (63.88 μs .. 220.1 μs)

benchmarking native
time                 428.0 μs   (421.5 μs .. 437.4 μs)
                     0.998 R²   (0.995 R² .. 1.000 R²)
mean                 427.1 μs   (424.1 μs .. 434.7 μs)
std dev              15.18 μs   (5.678 μs .. 26.26 μs)
variance introduced by outliers: 29% (moderately inflated)

Where "native" is just standard Text.takeWhile ....

Trac metadata

Trac field	Value
Version	8.4.3
Type	Bug
TypeOfFailure	OtherFailure
Priority	high
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture