[GHC] #8095: TypeFamilies painfully slow

[GHC]

#8095: TypeFamilies painfully slow
-------------------------------------+-------------------------------------
        Reporter:  MikeIzbicki       |                Owner:  goldfire
            Type:  bug               |               Status:  new
        Priority:  high              |            Milestone:  8.4.1
       Component:  Compiler (Type    |              Version:  7.6.3
  checker)                           |
      Resolution:                    |             Keywords:  TypeFamilies
Operating System:  Unknown/Multiple  |         Architecture:
 Type of failure:  Compile-time      |  Unknown/Multiple
  performance bug                    |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:  #5321, #11598,    |  Differential Rev(s):
  #12506                             |
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by mbieleck):

 Here's another idea, based on comment:15: Replace every coercion resulting
 from flattening type family applications with `UnivCo`. I think that could
 fix the problem Simon mentioned, because the resulting `UnivCo` should
 have the same free variables as the original chain of coercions. But I
 know approximately nothing about GHC internals, so this may be terribly
 wrong.

 I am experimenting with an implementation of this idea. The code is

 {{{
 --- a/compiler/typecheck/TcFlatten.hs
 +++ b/compiler/typecheck/TcFlatten.hs
 @@ -1139,16 +1139,18 @@ flatten_fam_app tc tys  -- Can be over-saturated
                   -- in which case the remaining arguments should
                   -- be dealt with by AppTys
        do { let (tys1, tys_rest) = splitAt (tyConArity tc) tys
 -         ; (xi1, co1) <- flatten_exact_fam_app tc tys1
 +         ; (xi1, _co1) <- flatten_exact_fam_app tc tys1
                 -- co1 :: xi1 ~ F tys1

                 -- all Nominal roles b/c the tycon is oversaturated
 -         ; (xis_rest, cos_rest) <- flatten_many (repeat Nominal) tys_rest
 +         ; (xis_rest, _cos_rest) <- flatten_many (repeat Nominal)
 tys_rest
                 -- cos_res :: xis_rest ~ tys_rest
 +         ; zonkedTy <- liftTcS $ zonkTcType $ mkTyConApp tc tys
 +         ; role <- getRole

           ; return ( mkAppTys xi1 xis_rest   -- NB mkAppTys: rhs_xi might
 not be a type variable
                                              --    cf Trac #5655
 -                  , mkAppCos co1 cos_rest
 +                  , mkUnsafeCo role (mkAppTys xi1 xis_rest) zonkedTy
                              -- (rhs_xi :: F xis) ; (F cos :: F xis ~ F
 tys)
                    ) }
 }}}

 Here I'm trying to generate an `UnsafeCo` of the same type as the
 original.

 This passes all tests but T13822, which fails with a Core Lint error, and
 I have no idea why. Can someone help me debug this?

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