StandaloneKindSignatures/TH panic (updateRole) when reusing unique names
The following program panics on GHC 8.10.1-alpha1:
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Bug where
import Data.Kind
import Language.Haskell.TH hiding (Type)
data TyFun :: Type -> Type -> Type
type a ~> b = TyFun a b -> Type
infixr 0 ~>
type family Apply (f :: a ~> b) (x :: a) :: b
type SameKind (a :: k) (b :: k) = (() :: Constraint)
$(do let pc = mkName "PC"
m1 = mkName "M1"
m2 = mkName "M2"
m1Sym0 = mkName "M1Sym0"
m2Sym0 = mkName "M2Sym0"
m2Sym1 = mkName "M2Sym1"
m1Sym0KI = mkName "M1Sym0KindInference"
m2Sym0KI = mkName "M2Sym0KindInference"
m2Sym1KI = mkName "M2Sym1KindInference"
f <- newName "f"
a <- newName "a"
b <- newName "b"
c <- newName "c"
d <- newName "d"
-- d <- pure $ mkName "d"
e <- newName "e"
-- e <- pure $ mkName "e"
argx <- newName "argx"
argy <- newName "argy"
argz <- newName "argz"
extra1 <- newName "extra1"
extra2 <- newName "extra2"
let m1Sym0_sak = ForallT [PlainTV a, PlainTV f] [] $
ConT ''(~>) `AppT` VarT a `AppT` (VarT f `AppT` VarT a)
mk_m2Sym_sak t
= ForallT [PlainTV f, PlainTV a, PlainTV b] [] $
t `AppT` (VarT f `AppT` VarT a) `AppT`
(ConT ''(~>) `AppT` (VarT f `AppT` VarT b)
`AppT` (VarT f `AppT` VarT a))
m2Sym0_sak = mk_m2Sym_sak (ConT ''(~>))
m2Sym1_sak = mk_m2Sym_sak ArrowT
m1Sym0_sak_dec = KiSigD m1Sym0 m1Sym0_sak
m2Sym0_sak_dec = KiSigD m2Sym0 m2Sym0_sak
m2Sym1_sak_dec = KiSigD m2Sym1 m2Sym1_sak
mk_same_kind t1 t2 = ConT ''SameKind `AppT` t1
`AppT` t2
apply rator rand = ConT ''Apply `AppT` rator `AppT` rand
m1Sym0_body_dec = DataD [] m1Sym0 [PlainTV c] Nothing
[ ForallC [PlainTV c, PlainTV extra1]
[ mk_same_kind (apply (ConT m1Sym0) (VarT extra1))
(ConT m1 `AppT` VarT extra1)
]
(GadtC [m1Sym0KI] [] (ConT m1Sym0 `AppT` VarT c))
] []
m2Sym0_body_dec = DataD [] m2Sym0 [PlainTV d] Nothing
[ ForallC [PlainTV d, PlainTV extra2]
[ mk_same_kind (apply (ConT m2Sym0) (VarT extra2))
(ConT m2Sym1 `AppT` VarT extra2)
]
(GadtC [m2Sym0KI] [] (ConT m2Sym0 `AppT` VarT d))
] []
m2Sym1_body_dec = DataD [] m2Sym1 [PlainTV d, PlainTV e] Nothing
[ ForallC [PlainTV d, PlainTV e, PlainTV extra2]
[ mk_same_kind (apply (ConT m2Sym1 `AppT` VarT d)
(VarT extra2))
(ConT m2 `AppT` VarT d
`AppT` VarT extra2)
]
(GadtC [m2Sym1KI] [] (ConT m2Sym1 `AppT` VarT d
`AppT` VarT e))
] []
pc_dec = ClassD [] pc [PlainTV f] []
[ OpenTypeFamilyD $
TypeFamilyHead m1 [ KindedTV argx (VarT a)
]
(KindSig (VarT f `AppT` VarT a)) Nothing
, OpenTypeFamilyD $
TypeFamilyHead m2 [ KindedTV argy (VarT f `AppT` VarT a)
, KindedTV argz (VarT f `AppT` VarT b)
]
(KindSig (VarT f `AppT` VarT a)) Nothing
]
pure [ m1Sym0_sak_dec
, m1Sym0_body_dec
, m2Sym0_sak_dec
, m2Sym0_body_dec
, m2Sym1_sak_dec
, m2Sym1_body_dec
, pc_dec
])
$ /opt/ghc/8.10.1/bin/ghc Bug.hs
[1 of 1] Compiling Bug ( Bug.hs, Bug.o, Bug.dyn_o )
ghc: panic! (the 'impossible' happened)
(GHC version 8.10.0.20191122:
updateRole
M2Sym1
a_a32O
[a31l :-> 1, a31m :-> 2, a31n :-> 3, a31p :-> 4, a31q :-> 5,
a32k :-> 0]
Call stack:
CallStack (from HasCallStack):
callStackDoc, called at compiler/utils/Outputable.hs:1179:37 in ghc:Outputable
pprPanic, called at compiler/typecheck/TcTyDecls.hs:664:23 in ghc:TcTyDecls
Notes:
- The use of
m2Sym1_sak_dec
(i.e.,type M2Sym1 :: forall f_a35o a_a35p b_a35q. f_a35o a_a35p -> (~>) (f_a35o b_a35q) (f_a35o a_a35p)
) is essential to triggering the panic, as removing it will make the panic go away. - If you create
d
ande
withpure . mkName
instead ofnewName
, then the panic will also go away. This suggests that reusingNameU
s is to blame.
There is a chance that this is related to #11812, but since this requires StandaloneKindSignatures, I figured I would file a new issue just to be safe.