Summary

I am trying to compile https://hackage.haskell.org/package/protocol-buffers-descriptor using GHC 8.10.1

When it gets to the file src-auto-generated/Text/DescriptorProtos/FileOptions.hs it compiles for several minutes using up more and more memory until it finally crashes with out of memory (I have 16 GB + swap)

https://github.com/k-bx/protocol-buffers/blob/5986692b2de759458738049a484d5cda72b71f10/descriptor/src-auto-generated/Text/DescriptorProtos/FileOptions.hs#L1

Steps to reproduce

$ ghc --version
8.10.1
$ cabal --version
3.2.0.0
$ git clone https://github.com/k-bx/protocol-buffers.git
$ cd protocol-buffers
$ git checkout 5986692b2de759458738049a484d5cda72b71f10
$ cd descriptor
$ cabal update
$ cabal new-build
....
....
[19 of 29] Compiling Text.DescriptorProtos.FileOptions ( src-auto-generated/Text/DescriptorProtos/FileOptions.hs, 
/home/bitc/tmp/protocol-buffers/descriptor/dist-newstyle/build/x86_64-linux/ghc-8.10.1/protocol-buffers-descriptor-2.4.13/build/Text/DescriptorProtos/FileOptions.o, /home/bitc/tmp/protocol-buffers/descriptor/dist-newstyle/build/x86_64-linux/ghc-8.10.1/protocol-buffers-descriptor-2.4.13/build/Text/DescriptorProtos/FileOptions.dyn_o )

(...hangs and uses up tons of memory)

Standalone reproducer

The following program is a condensed version of what goes wrong:

{-# LANGUAGE BangPatterns  #-}

module T18140 where

class Mergeable a where
  mergeAppend :: a -> a -> a
  mergeAppend _a b = b

instance Mergeable Bool

instance Mergeable a => Mergeable (Maybe a) where
    mergeAppend = mayMerge

mayMerge :: (Mergeable b) => Maybe b -> Maybe b -> Maybe b
mayMerge Nothing  y        = y
mayMerge x        Nothing  = x
mayMerge (Just x) (Just y) = Just (mergeAppend x y)

data D = D
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)
  !(Maybe Bool)

instance Mergeable D where
   mergeAppend
     (D x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11 x'12 x'13 x'14 x'15 x'16 x'17 x'18)
     (D y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8 y'9 y'10 y'11 y'12 y'13 y'14 y'15 y'16 y'17 y'18)
     = D
      (mergeAppend x'1 y'1)
      (mergeAppend x'2 y'2)
      (mergeAppend x'3 y'3)
      (mergeAppend x'4 y'4)
      (mergeAppend x'5 y'5)
      (mergeAppend x'6 y'6)
      (mergeAppend x'7 y'7)
      (mergeAppend x'8 y'8)
      (mergeAppend x'9 y'9)
      (mergeAppend x'10 y'10)
      (mergeAppend x'11 y'11)
      (mergeAppend x'12 y'12)
      (mergeAppend x'13 y'13)
      (mergeAppend x'14 y'14)
      (mergeAppend x'15 y'15)
      (mergeAppend x'16 y'16)
      (mergeAppend x'17 y'17)
      (mergeAppend x'18 y'18)

The behavior is exponential in the number of fields n, roughly 2^n or 3^n.

Environment

• GHC version used: 8.10.1
• Cabal: 3.2.0.0

Optional:

• Operating System: Linux
• System Architecture: x86_64