[GHC] #14172: GHC hangs during type-checking

[GHC]

#14172: GHC hangs during type-checking
-------------------------------------+-------------------------------------
        Reporter:  lightandlight     |                Owner:  (none)
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Compiler          |              Version:  8.0.2
      Resolution:                    |             Keywords:
Operating System:  Linux             |         Architecture:  x86_64
 Type of failure:  Compile-time      |  (amd64)
  crash or panic                     |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by RyanGlScott):

 Aha! The fault was on my end, as I forgot to put `PolyKinds` into
 `Lens.hs`. After doing that, I can reproduce the stack overflow with these
 two files:

 {{{#!hs
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 module Lens where

 import Data.Coerce
 import Data.Functor.Compose
 import Data.Functor.Identity

 class Profunctor p where
   dimap :: (a -> b) -> (c -> d) -> p b c -> p a d
   (#.) :: Coercible c b => (b -> c) -> p a b -> p a c

 instance Profunctor (->) where
   dimap ab cd bc = cd . bc . ab
   {-# INLINE dimap #-}
   (#.) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b
   {-# INLINE (#.) #-}

 type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p
 s (f t)
 type Iso' s a = Iso s s a a

 iso :: (s -> a) -> (b -> t) -> Iso s t a b
 iso sa bt = dimap sa (fmap bt)
 {-# INLINE iso #-}

 type AnIso s t a b = Exchange a b a (Identity b) -> Exchange a b s
 (Identity t)

 data Exchange a b s t = Exchange (s -> a) (b -> t)

 instance Profunctor (Exchange a b) where
   dimap f g (Exchange sa bt) = Exchange (sa . f) (g . bt)
   {-# INLINE dimap #-}
   (#.) _ = coerce
   {-# INLINE ( #. ) #-}

 withIso :: AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
 withIso ai k = case ai (Exchange id Identity) of
   Exchange sa bt -> k sa (runIdentity #. bt)
 {-# INLINE withIso #-}

 class Wrapped s where
   type Unwrapped s :: *
   _Wrapped' :: Iso' s (Unwrapped s)

 class Wrapped s => Rewrapped (s :: *) (t :: *)

 class    (Rewrapped s t, Rewrapped t s) => Rewrapping s t
 instance (Rewrapped s t, Rewrapped t s) => Rewrapping s t

 instance (t ~ Compose f' g' a') => Rewrapped (Compose f g a) t
 instance Wrapped (Compose f g a) where
   type Unwrapped (Compose f g a) = f (g a)
   _Wrapped' = iso getCompose Compose

 _Wrapping :: Rewrapping s t => (Unwrapped s -> s) -> Iso s t (Unwrapped s)
 (Unwrapped t)
 _Wrapping _ = _Wrapped
 {-# INLINE _Wrapping #-}

 _Wrapped :: Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
 _Wrapped = withIso _Wrapped' $ \ sa _ -> withIso _Wrapped' $ \ _ bt -> iso
 sa bt
 {-# INLINE _Wrapped #-}
 }}}
 {{{#!hs
 module Bug where

 import Data.Functor.Compose
 import Lens

 traverseCompose :: (a -> f b) -> g a -> f (h _)
 traverseCompose = _Wrapping Compose . traverse
 }}}
 {{{
 $ /opt/ghc/8.2.1/bin/ghci Bug.hs
 GHCi, version 8.2.1: http://www.haskell.org/ghc/  :? for help
 Loaded GHCi configuration from /home/rgscott/.ghci
 [1 of 2] Compiling Lens             ( Lens.hs, interpreted )
 [2 of 2] Compiling Bug              ( Bug.hs, interpreted )

 Bug.hs:7:19: error:
     • Reduction stack overflow; size = 201
       When simplifying the following type: g ~ Compose f'0 g'0
       Use -freduction-depth=0 to disable this check
       (any upper bound you could choose might fail unpredictably with
        minor updates to GHC, so disabling the check is recommended if
        you're sure that type checking should terminate)
     • In the expression: _Wrapping Compose . traverse
       In an equation for ‘traverseCompose’:
           traverseCompose = _Wrapping Compose . traverse
   |
 7 | traverseCompose = _Wrapping Compose . traverse
   |                   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 }}}

 So now for the magic question: what fixed this in HEAD?

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14172#comment:3>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler