[GHC] #14552: GHC panic on pattern synonym

[GHC]

#14552: GHC panic on pattern synonym
-------------------------------------+-------------------------------------
        Reporter:  Iceland_jack      |                Owner:  (none)
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Compiler          |              Version:  8.3
      Resolution:                    |             Keywords:
                                     |  PatternSynonyms, TypeInType,
                                     |  ViewPatterns
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by RyanGlScott):

 If you don't have a build with `ASSERT`ions enabled, then you can also
 trigger a Core Lint with this program as well:

 {{{
 $ /opt/ghc/8.2.2/bin/ghci Bug.hs -dcore-lint
 GHCi, version 8.2.2: http://www.haskell.org/ghc/  :? for help
 Loaded GHCi configuration from /home/rgscott/.ghci
 [1 of 1] Compiling Main             ( Bug.hs, interpreted )
 *** Core Lint errors : in result of Desugar (after optimization) ***
 <no location info>: warning:
     In the type ‘forall (r :: TYPE rep) (a :: [*]) b (aa :: k).
                  Exp a b
                  -> (forall k1 (f :: k1 --> *).
                      (b :: *) ~# (Limit' f :: *) =>
                      Exp a (f @@ aa) -> r)
                  -> (Void# -> r)
                  -> r’
     @ k_a1K2[ssk:3] is out of scope
 *** Offending Program ***
 $mFOO
   :: forall (r :: TYPE rep) (a :: [*]) b (aa :: k).
      Exp a b
      -> (forall k1 (f :: k1 --> *).
          (b :: *) ~# (Limit' f :: *) =>
          Exp a (f @@ aa) -> r)
      -> (Void# -> r)
      -> r
 [LclIdX]
 $mFOO
   = \ (@ (rep_a1Kn :: RuntimeRep))
       (@ (r_a1Ko :: TYPE rep_a1Kn))
       (@ (a_a1K0 :: [*]))
       (@ b_a1K1)
       (@ (aa_a1Kc :: k_a1K2[ssk:3]))
       (scrut_a1Kq :: Exp a_a1K0 b_a1K1)
       (cont_a1Kr
          :: forall k1 (f :: k1 --> *).
             (b_a1K1 :: *) ~# (Limit' f :: *) =>
             Exp a_a1K0 (f @@ aa_a1Kc) -> r_a1Ko)
       _ [Occ=Dead] ->
       break<0>(scrut_a1Kq,cont_a1Kr)
       case scrut_a1Kq of
       { TLam' @ k_a1K2 @ f_a1K3 cobox_a1K4 ds_d1Lm ds_d1Ln ->
       case ds_d1Lm of { Proxy ->
       cont_a1Kr
         @ k_a1K2
         @ f_a1K3
         @~ (cobox_a1K4 :: (b_a1K1 :: *) ~# (Limit' f_a1K3 :: *))
         ((\ (ds_d1Lp [OS=OneShot]
                :: Proxy aa_a1Kc -> Exp a_a1K0 (f_a1K3 @@ aa_a1Kc)) ->
             $ @ 'LiftedRep
               @ (Proxy aa_a1Kc)
               @ (Exp a_a1K0 (f_a1K3 @@ aa_a1Kc))
               ds_d1Lp
               (Proxy @ k_a1K2 @ aa_a1Kc))
            (ds_d1Ln @ aa_a1Kc))
       }
       }

 $trModule :: Module
 [LclIdX]
 $trModule = Module (TrNameS "main"#) (TrNameS "Main"#)

 $krep_a1Lc [InlPrag=[~]] :: KindRep
 [LclId]
 $krep_a1Lc
   = KindRepTyConApp $tc[] (: @ KindRep krep$* ([] @ KindRep))

 $krep_a1Lb [InlPrag=[~]] :: KindRep
 [LclId]
 $krep_a1Lb = KindRepFun $krep_a1Lc krep$*Arr*

 $krep_a1Lg [InlPrag=[~]] :: KindRep
 [LclId]
 $krep_a1Lg = $WKindRepVar (I# 0#)

 $krep_a1Lh [InlPrag=[~]] :: KindRep
 [LclId]
 $krep_a1Lh = KindRepFun $krep_a1Lg krep$*

 $krep_a1Lf [InlPrag=[~]] :: KindRep
 [LclId]
 $krep_a1Lf
   = KindRepTyConApp
       $tc(,) (: @ KindRep $krep_a1Lg (: @ KindRep krep$* ([] @ KindRep)))

 $krep_a1Le [InlPrag=[~]] :: KindRep
 [LclId]
 $krep_a1Le = KindRepFun $krep_a1Lf krep$*

 $krep_a1Ld [InlPrag=[~]] :: KindRep
 [LclId]
 $krep_a1Ld = KindRepFun $krep_a1Le krep$*

 $krep_a1Lj [InlPrag=[~]] :: KindRep
 [LclId]
 $krep_a1Lj = $WKindRepVar (I# 1#)

 $tcSing :: TyCon
 [LclIdX]
 $tcSing
   = TyCon
       18130532723012807500##
       591365583239837277##
       $trModule
       (TrNameS "Sing"#)
       0#
       krep$*Arr*

 $tcProxy :: TyCon
 [LclIdX]
 $tcProxy
   = TyCon
       637564349063008466##
       16772998216715059205##
       $trModule
       (TrNameS "Proxy"#)
       1#
       $krep_a1Lh

 $krep_a1Li [InlPrag=[~]] :: KindRep
 [LclId]
 $krep_a1Li
   = KindRepTyConApp
       $tcProxy
       (: @ KindRep $krep_a1Lg (: @ KindRep $krep_a1Lj ([] @ KindRep)))

 $tc'Proxy :: TyCon
 [LclIdX]
 $tc'Proxy
   = TyCon
       10313009608267148799##
       11340514327723585599##
       $trModule
       (TrNameS "'Proxy"#)
       2#
       $krep_a1Li

 $tcLimit' :: TyCon
 [LclIdX]
 $tcLimit'
   = TyCon
       15980210257158400910##
       15895439795101193324##
       $trModule
       (TrNameS "Limit'"#)
       1#
       $krep_a1Ld

 $tcExp :: TyCon
 [LclIdX]
 $tcExp
   = TyCon
       14856342479466933336##
       11891426334869696372##
       $trModule
       (TrNameS "Exp"#)
       0#
       $krep_a1Lb

 *** End of Offense ***
 }}}

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