[GHC] #15517: -O0 and pattern synonyms triggers panic in trimJoinCont (was: haddock triggers panic in trimJoinCont)

[GHC]

#15517: -O0 and pattern synonyms triggers panic in trimJoinCont
-------------------------------------+-------------------------------------
        Reporter:  sjakobi           |                Owner:  (none)
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:  8.6.1
       Component:  Compiler          |              Version:  8.4.3
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
 Type of failure:  Compile-time      |  Unknown/Multiple
  crash or panic                     |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by RyanGlScott):

 Actually, you don't even need Haddock to reproduce this issue. Here's as
 small of an example as I can extract from `generics-mrsop`:

 {{{#!hs
 {-# LANGUAGE DataKinds               #-}
 {-# LANGUAGE FlexibleInstances       #-}
 {-# LANGUAGE FunctionalDependencies  #-}
 {-# LANGUAGE GADTs                   #-}
 {-# LANGUAGE LambdaCase              #-}
 {-# LANGUAGE PatternSynonyms         #-}
 {-# LANGUAGE PolyKinds               #-}
 {-# LANGUAGE TypeFamilies            #-}
 {-# LANGUAGE TypeOperators           #-}
 module Generics.MRSOP.Examples.RoseTreeTH () where

 import Data.Proxy

 newtype Rep (ki :: kon -> *) (phi :: Nat -> *) (code :: [[Atom kon]])
   = Rep (NS (PoA ki phi) code)

 data NA  :: (kon -> *) -> (Nat -> *) -> Atom kon -> * where
   NA_I :: (IsNat k) => phi k -> NA ki phi (I k)
   NA_K ::              ki  k -> NA ki phi (K k)

 data NP :: (k -> *) -> [k] -> * where
   NP0  :: NP p '[]
   (:*) :: p x -> NP p xs -> NP p (x : xs)

 class IsNat (n :: Nat) where
   getSNat :: Proxy n -> SNat n
 instance IsNat Z where
   getSNat _ = SZ
 instance IsNat n => IsNat (S n) where
   getSNat p = SS (getSNat $ proxyUnsuc p)

 proxyUnsuc :: Proxy (S n) -> Proxy n
 proxyUnsuc _ = Proxy

 type PoA (ki :: kon -> *) (phi :: Nat -> *) = NP (NA ki phi)

 data Atom kon
   = K kon
   | I Nat

 data Nat = S Nat | Z
 data SNat :: Nat -> * where
   SZ ::           SNat Z
   SS :: SNat n -> SNat (S n)

 data Kon = KInt
 data Singl (kon :: Kon) :: * where
   SInt :: Int -> Singl KInt

 type family Lkup (n :: Nat) (ks :: [k]) :: k where
   Lkup Z     (k : ks) = k
   Lkup (S n) (k : ks) = Lkup n ks

 data El :: [*] -> Nat -> * where
   El :: IsNat ix => Lkup ix fam -> El fam ix

 data NS :: (k -> *) -> [k] -> * where
   There :: NS p xs -> NS p (x : xs)
   Here  :: p x     -> NS p (x : xs)

 class Family (ki :: kon -> *) (fam :: [*]) (codes :: [[[Atom kon]]])
       | fam -> ki codes , ki codes -> fam where
     sfrom' :: SNat ix -> El fam ix -> Rep ki (El fam) (Lkup ix codes)

 data Rose a = a :>: [Rose a]
             | Leaf a

 type FamRoseInt = '[Rose Int, [Rose Int]]

 type CodesRoseInt =
     '[ '[ '[K KInt, I (S Z)], '[K KInt]], '[ '[], '[I Z, I (S Z)]]]

 pattern IdxRoseInt = SZ
 pattern IdxListRoseInt = SS SZ

 pat1 :: PoA Singl (El FamRoseInt) '[I Z, I (S Z)]
      -> NS (PoA Singl (El FamRoseInt)) '[ '[], '[I Z, I (S Z)]]
 pat1 d = There (Here d)

 pat2 :: PoA Singl (El FamRoseInt) '[]
      -> NS (PoA Singl (El FamRoseInt)) '[ '[], '[I Z, I (S Z)]]
 pat2 d = Here d

 pat3 :: PoA Singl (El FamRoseInt) '[K KInt]
      -> NS (PoA Singl (El FamRoseInt)) '[ '[K KInt, I (S Z)], '[K KInt]]
 pat3 d = There (Here d)

 pat4 :: PoA Singl (El FamRoseInt) '[K KInt, I (S Z)]
      -> NS (PoA Singl (El FamRoseInt)) '[ '[K KInt, I (S Z)], '[K KInt]]
 pat4 d = Here d

 instance Family Singl FamRoseInt CodesRoseInt where
   sfrom' = \case IdxRoseInt     -> \case El (x :>: xs) -> Rep (pat4 (NA_K
 (SInt x) :* (NA_I (El xs) :* NP0)))
                                          El (Leaf x)   -> Rep (pat3 (NA_K
 (SInt x) :* NP0))
                  IdxListRoseInt -> \case El []     -> Rep (pat2 NP0)
                                          El (x:xs) -> Rep (pat1 (NA_I (El
 x) :* (NA_I (El xs) :* NP0)))
 }}}

 To trigger the panic, compile this with `-O0` using GHC 8.4 or later:

 {{{
 $ /opt/ghc/8.4.3/bin/ghc Bug.hs -O0 -fforce-recomp
 [1 of 1] Compiling Generics.MRSOP.Examples.RoseTreeTH ( Bug.hs, Bug.o )
 ghc: panic! (the 'impossible' happened)
   (GHC version 8.4.3 for x86_64-unknown-linux):
         completeCall
   fail_a1dN
   Select nodup wild_00
   Stop[BoringCtxt] Rep
                      Singl (El FamRoseInt) (Lkup ix_a1en CodesRoseInt)
   Call stack:
       CallStack (from HasCallStack):
         callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in
 ghc:Outputable
         pprPanic, called at compiler/simplCore/Simplify.hs:1533:9 in
 ghc:Simplify
 }}}

 This panic does not occur in GHC 8.2.2, so something must have regressed
 here...

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