Simplifier ticks exhausted when fusing list literals

GHC 8.6.3 cannot compile the following code with -O.

module Main10(func) where
import Control.Monad
import Data.IORef

func :: Int -> IO Int
func n = do
    ref <- newIORef False
    let xs = map (n+) [1,2,3,4,5,6,7,8,9,10]
        step acc x = do
            when (x `mod` 2 == 0) $ modifyIORef' ref not
            pure (acc + 1)
    foldM step 0 xs

$ stack ghc -- --version
The Glorious Glasgow Haskell Compilation System, version 8.6.3
$ stack ghc -- -O Main10.hs
[1 of 1] Compiling Main10           ( Main10.hs, Main10.o )
Simplifier ticks exhausted
  When trying RuleFired +#
  To increase the limit, use -fsimpl-tick-factor=N (default 100).
   
  If you need to increase the limit substantially, please file a
  bug report and indicate the factor you needed.
   
  If GHC was unable to complete compilation even with a very large factor
  (a thousand or more), please consult the "Known bugs or infelicities"
  section in the Users Guide before filing a report. There are a
  few situations unlikely to occur in practical programs for which
  simplifier non-termination has been judged acceptable.
   
  To see detailed counts use -ddump-simpl-stats
  Total ticks: 14321

GHC 8.4.4 and 8.2.2 also fail to compile this but GHC 8.0.2 can.

I tried -fsimpl-tick-factor=10000, then GHC could compile the program but quite slow (it took some minutes).

I measured the total ticks in the dumps from -ddump-simpl-stats, while changing the length of the constant literal ([1,2,...,10]) in the program between 3 to 10. Here is the result. Simplifier ticks seems to be exponential in the length of the constant list.

# length, Total ticks
3,    706
4,   1286
5,   2982
6,   8026
7,  23114
8,  68334
9, 203950
10,610754

Trac metadata

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

changed weight to 5

added Tbug Trac import labels

A simpler example is found.

module Main10S(func) where

foldM :: (Monad m) => (b -> a -> m b) -> b -> [a] -> m b
foldM f z0 xs = foldr (\x k z -> f z x >>= k) pure xs z0

func :: Int -> IO Int
func n = foldM step 0 xs
    where
    xs = map (n+) [1,2,3,4,5,6,7,8,9,10]
    step acc x = 
        case x `mod` 3  of
            0 -> pure acc 
            1 -> pure $ acc + 1
            2 -> pure $ acc + 2

func :: Int -> IO Int
func n = foldM step 0 xs
    where
    xs = map (n+) [1,2,3]
    step acc x = 
        case x `mod` 3  of
            0 -> pure acc 
            1 -> pure $ acc + 1
            2 -> pure $ acc + 2

is simplified to the following core code

func n =
    case n + 1 `mod` 3 of
        0 -> case n + 2 `mod` 3 of
            0 -> case n + 3 `mod` 3 of 
                0 -> pure 0
                1 -> pure 1
                2 -> pure 2
            1 -> case n + 3 `mod` 3 of
                0 -> pure 1
                1 -> pure 2
                2 -> pure 3
            2 -> case n + 3 `mod` 3 of
                0 -> pure 2
                1 -> pure 3
                2 -> pure 4
        1 -> case n + 2 `mod` 3 of
            0 -> case n + 3 `mod` 3 of 
                0 -> pure 1
                1 -> pure 2
                2 -> pure 3
            1 -> case n + 3 `mod` 3 of
                0 -> pure 2
                1 -> pure 3
                2 -> pure 4
            2 -> case n + 3 `mod` 3 of
                0 -> pure 3
                1 -> pure 4
                2 -> pure 5
        2 -> case n + 2 `mod` 3 of
            0 -> case n + 3 `mod` 3 of 
                0 -> pure 2
                1 -> pure 3
                2 -> pure 4
            1 -> case n + 3 `mod` 3 of
                0 -> pure 3
                1 -> pure 4
                2 -> pure 5
            2 -> case n + 3 `mod` 3 of
                0 -> pure 4
                1 -> pure 5
                2 -> pure 6

The size of this code is O(3^L^).

On the other hand, a pure version of func, that is

func' n = foldl step 0 xs
    where
    xs = map (n+) [1,2,3]
    step acc x =
        case x `mod` 3 of
            0 -> acc
            1 -> acc + 1
            2 -> acc + 2

is simplified to the following core code

func' n =
    join j2 w2 =
        join j1 w1 = 
            case n + 3  `mod` 3 of
                0 -> w1
                1 -> w1 + 1
                2 -> w1 + 2
        in case n + 2 `mod` 3 of
            0 -> jump j1 w2
            1 -> jump j1 (w2 + 1)
            2 -> jump j1 (w2 + 2)
    in case n + 1 `mod` 3 of
        0 -> jump j2 0
        1 -> jump j2 1
        2 -> jump j2 2

The size of this code is O(L).

changed title from Simplifier ticks exhausted when fusioning list literals to Simplifier ticks exhausted when fusing list literals

Trac metadata

Trac field	Value
Related	- → #11707 (closed)

A workaround found.

Adding {-# INLINE [0] step #-} avoids the code explosion problem, although I'm not sure why it works.

I think desugaring [1,2,..,10] to build (\c n -> c 1 (c 2 (...(c 10 n)))) is the cause of the problem. Since c is duplicated, code inlininng often generates a very complicated program.

How about desugaring an explicit list literal [v1, v2, v3, ... ,vn] using an indexing function? That is:

[v1, v2, ..., vn ] = map f [1..n ::Int]
  where 
  f i = case i of
   1 -> v1
   2 -> v2
   ...
   n -> vn

Then it is fused to the following code:

build (\c n -> go 1# 
  where
  go i# 
  | i# == n# = n
  | otherwise = 
    let-join j v = v `c` go (i# +# 1) in
    case i# of
      1# -> j v1
      2# -> j v2
      ...
      n# -> j vn)

In this version, inlining does not cause code explosion problems because c occurs at once.

mentioned in issue #16363

added Pnormal label