[GHC] #8147: Exponential behavior in instance resolution on fixpoint-of-sum

[GHC]

#8147: Exponential behavior in instance resolution on fixpoint-of-sum
-------------------------+-------------------------------------------------
       Reporter:         |             Owner:
  jkoppel                |            Status:  new
           Type:  bug    |         Milestone:
       Priority:         |           Version:  7.6.3
  normal                 |  Operating System:  Unknown/Multiple
      Component:         |   Type of failure:  Compile-time performance bug
  Compiler               |         Test Case:
       Keywords:         |          Blocking:
  performance,           |
   Architecture:         |
  Unknown/Multiple       |
     Difficulty:         |
  Unknown                |
     Blocked By:         |
Related Tickets:         |
-------------------------+-------------------------------------------------
 Doing instance resolution on a fixpoint-of-sum type takes a very long
 time. This is possibly the same issue as issue #5642.

 These are the numbers I see for various n:

 {{{
 10 : 0.329s
 20 : 0.479s
 40 : 0.935s
 80 : 2.821s
 160 : 11.694s
 320 : 1m30.39s
 640:  Ran for over 1 hour without terminating
 }}}

 This uses a couple of attached support files. Apologies for not being able
 to reduce further.

 {{{
 -- Test.hs
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances,
 UndecidableInstances, OverlappingInstances, TypeOperators, DeriveFunctor,
 TemplateHaskell #-}

 module Test where

 import Control.Monad

 import Lib
 import TH

 {-
 With n=3, produces

 data X1 e = X1 e deriving (Functor)
 data X2 e = X2 e deriving (Functor)
 data X3 e = X3 e deriving (Functor)

 type X = X1 :+: X2 :+: X3
 -}
 $(let n = 320 in
   liftM concat $ sequence [liftM concat $ mapM mkDec $ map (('X':).show)
 [1..n]
                           , makeSumType "X" (map (('X':).show) [1..n])])


 data Y0 e = Y0 e deriving ( Functor )

 type X' = Y0 :+: X

 class Lift f g where
   lift' :: f (Fix g) -> Fix g

 instance (Lift f g, Lift f' g) => Lift (f :+: f') g where
   lift' x = case x of
               L e -> lift' e
               R e -> lift' e

 instance (Functor f, f :<: g) => Lift f g where
   lift' = In . inj

 cata :: (Functor f) => (f a -> a) -> Fix f -> a
 cata f = f . fmap (cata f) . out

 lift :: Fix X -> Fix X'
 lift = cata lift'
 }}}

 Virtually all the time is spent in compiling lift. For example, with
 n=640, commenting out lift makes it compile in around 2 seconds.

 Interestingly, when I add the following code, compilation times only
 increase by 10-20%. In the original code where I encountered this issue,
 doing so doubles compilation time.

 {{{

 instance Lift Y0 X where
   lift' = undefined

 lower :: Fix X' -> Fix X
 lower = cata lift'
 }}}

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