[GHC] #14393: Levity-polymorphic join point crashes 8.2

[GHC]

#14393: Levity-polymorphic join point crashes 8.2
-------------------------------------+-------------------------------------
           Reporter:  simonpj        |             Owner:  (none)
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:  8.2.2
          Component:  Compiler       |           Version:  8.2.1
           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:
-------------------------------------+-------------------------------------
 This program crashes both GHC 8.0 and 8.2
 {{{
 {-# LANGUAGE ViewPatterns, PatternSynonyms #-}

 module Foo where

 data PrimOp = AddOp | Add2Op | OtherOp | BotherOp

 data Expr = Var PrimOp | App Expr Expr | BApp [Expr] | BOp Expr Expr | L
 Integer

 pattern BinOpApp  :: Expr -> PrimOp -> Expr -> Expr
 pattern BinOpApp  x op y =  Var op `App` x `App` y

 pattern (:+:) :: Expr -> Expr -> Expr
 pattern x :+: y <- BinOpApp x (isAddOp -> True) y

 isAddOp :: PrimOp -> Bool
 isAddOp AddOp  = True
 isAddOp Add2Op  = True
 isAddOp _      = False

 pattern (:++:) :: Integer -> Expr -> Expr
 pattern l :++: x <- (isAdd -> Just (l,x))

 isAdd :: Expr -> Maybe (Integer,Expr)
 {-# INLINE isAdd #-}
 isAdd e = case e of
    L l :+: x   -> Just (l,x)
    x   :+: L l -> Just (l,x)
    _           -> Nothing
 }}}
 Reason: the matching function, generated by the pattern synonym `:++:`,
 has a levity-polymorphic join point.

 8.0 has a Lint Error.  8.2 crashes with
 {{{
   (GHC version 8.2.1.20171024 for x86_64-unknown-linux):
         runtimeRepPrimRep
   typePrimRep (r_a1kX :: TYPE rep_a1kW)
   rep_a1kW
   Call stack:
       CallStack (from HasCallStack):
         prettyCurrentCallStack, called at
 compiler/utils/Outputable.hs:1133:58 in ghc:Outputable
         callStackDoc, called at compiler/utils/Outputable.hs:1137:37 in
 ghc:Outputable
         pprPanic, called at compiler/simplStg/RepType.hs:360:5 in
 ghc:RepType
         runtimeRepPrimRep, called at compiler/simplStg/RepType.hs:342:5 in
 ghc:RepType
         kindPrimRep, called at compiler/simplStg/RepType.hs:305:18 in
 ghc:RepType
         typePrimRep, called at compiler/simplStg/RepType.hs:128:19 in
 ghc:RepType
 }}}
 I think this is just #13394, comment:4 again.  It was fixed in comment:5
 of that ticket, but the fix has not yet been transferred to 8.2.

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