Skip to content

GitLab

  • Menu
Projects Groups Snippets
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 4,869
    • Issues 4,869
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 456
    • Merge requests 456
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Deployments
    • Deployments
    • Releases
  • Analytics
    • Analytics
    • Value stream
    • CI/CD
    • Code review
    • Insights
    • Issue
    • Repository
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
Collapse sidebar
  • Glasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #17537
Closed
Open
Created Dec 03, 2019 by Ryan Scott@RyanGlScottMaintainer

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 and e with pure . mkName instead of newName, then the panic will also go away. This suggests that reusing NameUs 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.

To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking