[GHC] #14175: Panic repSplitTyConApp_maybe

#14175: Panic repSplitTyConApp_maybe -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.2 Component: Compiler | Version: 8.2.1 (Type checker) | Keywords: TypeInType | 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: -------------------------------------+------------------------------------- This definition panics! {{{#!hs {-# LANGUAGE TypeFamilies, TypeInType #-} module Whoops where import Data.Kind type family PComp (k :: j -> Type) (x :: k) :: () }}} {{{ ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.3.20170828 for x86_64-unknown-linux): repSplitTyConApp_maybe j_aon[sk:1] * * Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1138:37 in ghc:Outputable pprPanic, called at compiler/types/Type.hs:1123:5 in ghc:Type }}} If I make it a type synonym instead, I get a proper error as expected. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14175 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14175: Panic repSplitTyConApp_maybe -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.2 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13910 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #13910 Comment: On HEAD, this gives a slightly different panic: {{{ $ ghc5/inplace/bin/ghc-stage2 --interactive Bug.hs GHCi, version 8.3.20170818: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Whoops ( Bug.hs, interpreted ) ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.3.20170818 for x86_64-unknown-linux): getRuntimeRep j_a1tG[sk:1] :: k_a1tJ[tau:1] Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1142:37 in ghc:Outputable pprPanic, called at compiler/types/Type.hs:1982:18 in ghc:Type }}} This is a characteristic that it shares with the program in #13910. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14175#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14175: Panic repSplitTyConApp_maybe -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.2 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13910 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: RyanGlScott (added) Comment: I suspect that this program (which panics after 0829821a6b886788a3ba6989e57e25a037bb6d05 on GHC HEAD) has the same underlying symptom: {{{#!hs {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} module Bug where class C k where data CD :: k -> k -> * instance C (Maybe a) where data CD :: (k -> *) -> (k -> *) -> * }}} {{{ $ inplace/bin/ghc-stage2 --interactive ../Bug.hs GHCi, version 8.3.20170818: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( ../Bug.hs, interpreted ) ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.3.20170818 for x86_64-unknown-linux): getRuntimeRep k_a1v3[sk:1] :: k_a1vl[tau:1] Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1142:37 in ghc:Outputable pprPanic, called at compiler/types/Type.hs:1982:18 in ghc:Type }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14175#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14175: Panic repSplitTyConApp_maybe -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.2 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13910 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Thanks. I have a fix for this on my laptop. Not quite daring to push during ICFP lest I break something (alghoug it validates). With the fix I get {{{ T14175a.hs:11:15: error: Not in scope: type variable k | 11 | data CD :: (k -> *) -> (k -> *) -> * | ^ T14175a.hs:11:27: error: Not in scope: type variable k | 11 | data CD :: (k -> *) -> (k -> *) -> * | ^ }}} for comment:1 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14175#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14175: Panic repSplitTyConApp_maybe -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.2 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13910 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I'm confused about what this fix is doing. Isn't `k` implicitly quantified? In other words, what does your patch do on this program, which explicitly quantifies `k` but throws the same panic? {{{#!hs {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} module Bug where import Data.Kind class C a where data CD k (a :: k) :: k -> * instance C (Maybe a) where data CD k (a :: k -> *) :: (k -> *) -> * }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14175#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14175: Panic repSplitTyConApp_maybe -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.2 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13910 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): After my fix I get this for comment:4 {{{ c:/code/HEAD/inplace/bin/ghc-stage1 -c T14175b.hs T14175b.hs:13:3: error: Expected kind (k1 -> *) -> * , but CD k (a :: k -> *) :: (k -> *) -> * has kind k1 -> * In the data instance declaration for CD In the instance declaration for C (Maybe a) | 13 | data CD k (a :: k -> *) :: (k -> *) -> * | ^^^^^^^^^^^^^^^^^^^^^^^ }}} That looks pretty weird too. But at least neither crashes, which is the first thing. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14175#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14175: Panic repSplitTyConApp_maybe -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.2 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13910 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Other than the kind signature in the second full line of the error message there, it looks reasonable to me. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14175#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14175: Panic repSplitTyConApp_maybe
-------------------------------------+-------------------------------------
Reporter: dfeuer | Owner: (none)
Type: bug | Status: new
Priority: normal | Milestone: 8.2.2
Component: Compiler (Type | Version: 8.2.1
checker) |
Resolution: | Keywords: TypeInType
Operating System: Unknown/Multiple | Architecture:
Type of failure: Compile-time | Unknown/Multiple
crash or panic | Test Case:
Blocked By: | Blocking:
Related Tickets: #13910 | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by Simon Peyton Jones

#14175: Panic repSplitTyConApp_maybe -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.2.2 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: fixed | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: indexed- crash or panic | types/should_fail/T14175 Blocked By: | Blocking: Related Tickets: #13910 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * testcase: => indexed-types/should_fail/T14175 * resolution: => fixed -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14175#comment:8 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14175: Panic repSplitTyConApp_maybe -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.2.2 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: fixed | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: indexed- crash or panic | types/should_fail/T14175 Blocked By: | Blocking: Related Tickets: #13910 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): After this patch, GHC HEAD gives this error for the program in comment:2: {{{ Bug.hs:11:3: error: • Expected kind ‘(k -> *) -> (k -> *) -> *’, but ‘CD :: (k -> *) -> (k -> *) -> *’ has kind ‘Maybe a -> Maybe a -> *’ • In the data instance declaration for ‘CD’ In the instance declaration for ‘C (Maybe a)’ | 11 | data CD :: (k -> *) -> (k -> *) -> * | ^^^^^^^ }}} And this error for the program in comment:4: {{{ Bug.hs:13:3: error: • Expected kind ‘(k -> *) -> *’, but ‘CD k (a :: k -> *) :: (k -> *) -> *’ has kind ‘k -> *’ • In the data instance declaration for ‘CD’ In the instance declaration for ‘C (Maybe a)’ | 13 | data CD k (a :: k -> *) :: (k -> *) -> * | ^^^^^^^^^^^^^^^^^^^^^^^ }}} As you observed, these error messages aren't great and could likely be improved. Should I open a separate ticket for this? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14175#comment:9 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14175: Panic repSplitTyConApp_maybe -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.2.2 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: fixed | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: indexed- crash or panic | types/should_fail/T14175 Blocked By: | Blocking: Related Tickets: #13910 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Yes please! -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14175#comment:10 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14175: Panic repSplitTyConApp_maybe -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.2.2 Component: Compiler (Type | Version: 8.2.1 checker) | Resolution: fixed | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: indexed- crash or panic | types/should_fail/T14175 Blocked By: | Blocking: Related Tickets: #13910, #14230 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: #13910 => #13910, #14230 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14175#comment:11 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC