[GHC] #14111: strange error when using data families with levity polymorphism and unboxed sums and data families

[GHC]

#14111: strange error when using data families with levity polymorphism and unboxed
sums and data families
-------------------------------------+-------------------------------------
        Reporter:  carter            |                Owner:  (none)
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Compiler          |              Version:  8.2.1
      Resolution:                    |             Keywords:  TypeFamilies
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:  #14457            |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by RyanGlScott):

 Last night, I tried working on this (in a sleep-deprived haze). I actually
 managed to come up with something that makes the original program compile:

 {{{#!diff
 diff --git a/compiler/typecheck/TcTyClsDecls.hs
 b/compiler/typecheck/TcTyClsDecls.hs
 index 39697d6..842050f 100644
 --- a/compiler/typecheck/TcTyClsDecls.hs
 +++ b/compiler/typecheck/TcTyClsDecls.hs
 @@ -36,7 +36,7 @@ import TcClassDcl
  import {-# SOURCE #-} TcInstDcls( tcInstDecls1 )
  import TcDeriv (DerivInfo)
  import TcEvidence  ( tcCoercionKind, isEmptyTcEvBinds )
 -import TcUnify     ( checkConstraints )
 +import TcUnify     ( checkConstraints, unifyType )
  import TcHsType
  import TcMType
  import TysWiredIn ( unitTy )
 @@ -1801,6 +1801,9 @@ tcConDecl rep_tycon tag_map tmpl_bndrs res_tmpl
                do { ctxt <- tcHsMbContext cxt
                   ; btys <- tcConArgs hs_args
                   ; res_ty' <- tcHsLiftedType res_ty
 +                 ; (meta_subst, _meta_tvs) <- newMetaTyVars $ binderVars
 tmpl_bndrs
 +                 ; let head_shape_with_metas = substTy meta_subst
 res_tmpl
 +                 ; _ <- unifyType Nothing res_ty' head_shape_with_metas
                   ; field_lbls <- lookupConstructorFields name
                   ; let (arg_tys, stricts) = unzip btys
                         bound_vars = allBoundVariabless ctxt `unionVarSet`
 }}}

 This is nowhere near correct, though, since it causes other programs, such
 as
 [http://git.haskell.org/ghc.git/blob/ca535f95a742d885c4082c9dc296c151fb3c1e12:/testsuite/tests/ado/T13242a.hs
 T13242a], to infinitely loop when compiling. What's worse, I don't
 understand why.

 Help? Disclaimer: I have no idea what I'm doing.

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