[GHC] #14795: Data type return kinds don't obey the forall-or-nothing rule

#14795: Data type return kinds don't obey the forall-or-nothing rule -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 (Type checker) | Keywords: TypeInType | Operating System: Unknown/Multiple Architecture: | Type of failure: GHC accepts Unknown/Multiple | invalid program Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Originally noticed [https://github.com/ghc-proposals/ghc- proposals/pull/103#issuecomment-364562974 here]. GHC accepts this: {{{#!hs {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeInType #-} import Data.Kind data Foo :: forall a. a -> b -> Type where MkFoo :: a -> Foo a b }}} Despite the fact that `Foo`'s return kind is headed by an explicit `forall` which does not quantify `b`. The users' guide doesn't explicitly indicate that the `forall`-or-nothing rule should apply to data type return kinds, but goldfirere believes that not doing so is an [https://github.com/ghc-proposals/ghc- proposals/pull/103#issuecomment-364670215 inconsistent design], so I'm opening this ticket to track this. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14795 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14795: Data type return kinds don't obey the forall-or-nothing rule -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I agree. Let's fix this. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14795#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14795: Data type return kinds don't obey the forall-or-nothing rule -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Hm. After thinking about this some more, I'm not 100% convinced that this is an inconsistent design. The issue is that the `forall`-or-nothing rule applies to //top-level// type signatures. But data type return kinds are not truly top-level, as they can mention type variables bound before it. For instance, in this example: {{{#!hs data Foo2 (x :: b) :: forall a. a -> b -> Type }}} Here, the explicit return kind is only a small part of `Foo2`'s kind. The full shebang would be (using an [https://github.com/ghc-proposals/ghc- proposals/pull/54 explicit kind signature]): {{{#!hs type Foo2 :: forall b. b -> forall a. a -> b -> Type }}} In that sense, data type return kinds don't need to satisfy the `forall `-or-nothing rule, since they're not actually the thing at the top level. A similar phenomenon occurs at the term level. GHC accepts this: {{{#!hs {-# LANGUAGE RankNTypes #-} f :: (forall a. a -> b -> Int) f _ _ = 42 }}} That's because in some sense, `(forall a. a -> b -> Int)` isn't the real top-level type signature here. The //real// top-level type signature is revealed if you query GHCi: {{{ λ> :type +v f f :: forall b a. a -> b -> Int }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14795#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14795: Data type return kinds don't obey the forall-or-nothing rule -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Very good points. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14795#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#14795: Data type return kinds don't obey the forall-or-nothing rule -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: invalid | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => invalid Comment: I think I'll close this as invalid, then. Feel free to reopen if you disagree. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14795#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC