[GHC] #13943: Compiler infinite loop with GHC-8.2

8 Jul 2017

      #13943: Compiler infinite loop with GHC-8.2
-------------------------------------+-------------------------------------
           Reporter:  vagarenko      |             Owner:  (none)
               Type:  bug            |            Status:  new
           Priority:  high           |         Milestone:  8.2.1
          Component:  Compiler       |           Version:  8.2.1-rc3
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:                 |   Type of failure:  None/Unknown
  Unknown/Multiple                   |
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 GHC-8.0.1 compile this module in less than one seconds on my machine.

 Both GHC-8.2rc2 and GHC-8.2rc3 eat all 8GB of memory and don't show any
 signs of stopping.

 -dshow-passes shows this:

 {{{
 [1 of 1] Compiling Data.List.Unrolled ( unrolled.hs, unrolled.o )
 *** Parser [Data.List.Unrolled]:
 !!! Parser [Data.List.Unrolled]: finished in 0.00 milliseconds, allocated
 3.434 megabytes
 *** Renamer/typechecker [Data.List.Unrolled]:

 }}}
 and then nothing. Only memory consumption grows.

 Code:

 {{{#!hs
 {-# LANGUAGE MultiParamTypeClasses   #-}
 {-# LANGUAGE TypeOperators           #-}
 {-# LANGUAGE FlexibleInstances       #-}
 {-# LANGUAGE FlexibleContexts        #-}
 {-# LANGUAGE ScopedTypeVariables     #-}
 {-# LANGUAGE UndecidableInstances    #-}
 {-# LANGUAGE TypeApplications        #-}
 {-# LANGUAGE TypeInType              #-}
 {-# LANGUAGE AllowAmbiguousTypes     #-}
 {-# LANGUAGE NoImplicitPrelude       #-}
 {-# LANGUAGE GADTs                   #-}

 module Data.List.Unrolled where

 import GHC.TypeLits

 -- | Drop @n@ elements from a list
 class Drop (n :: Nat) where
     drop :: [a] -> [a]

 instance {-# OVERLAPPING #-} Drop 0 where
     drop xs = xs
     {-# INLINE drop #-}

 instance {-# OVERLAPPABLE #-} (Drop (n - 1)) => Drop n where
     drop [] = []
     drop (_ : xs) = drop @(n - 1) xs
     {-# INLINE drop #-}

 -- | Take @n@ elements from a list
 class Take (n :: Nat) where
     take :: [a] -> [a]

 instance {-# OVERLAPPING #-} Take 0 where
     take _ = []
     {-# INLINE take #-}

 instance {-# OVERLAPPABLE #-} (Take (n - 1)) => Take n where
     take [] = []
     take (x : xs) = x : take @(n - 1) xs
     {-# INLINE take #-}

 -- | Split list at @n@-th element.
 splitAt :: forall (n :: Nat) a. (Take n, Drop n) => [a] -> ([a], [a])
 splitAt xs = (take @n xs, drop @n xs)

 -- | Split list into chunks of the given length @c@. @n@ is length of the
 list.
 class ChunksOf (n :: Nat) (c :: Nat) where
     chunksOf :: [a] -> [[a]]

 instance {-# OVERLAPPING #-} ChunksOf 0 0 where
     chunksOf _ = []
     {-# INLINE chunksOf #-}

 instance {-# OVERLAPPABLE #-} ChunksOf 0 c where
     chunksOf _ = []
     {-# INLINE chunksOf #-}

 instance {-# OVERLAPPABLE #-} ChunksOf n 0 where
     chunksOf _ = []
     {-# INLINE chunksOf #-}

 instance {-# OVERLAPPABLE #-} (Take c, Drop c, ChunksOf (n - 1) c) =>
 ChunksOf n c where
     chunksOf xs =
         let (l, r) = splitAt @c xs
         in l : chunksOf @(n - 1) @c r
     {-# INLINE chunksOf #-}
 }}}

--
Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/13943
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler