[GHC] #8563: Deriving with PolyKinds broken

#8563: Deriving with PolyKinds broken ------------------------------------+------------------------------------- Reporter: edsko | Owner: Type: bug | Status: new Priority: high | Milestone: Component: Compiler | Version: 7.7 Keywords: | Operating System: Unknown/Multiple Architecture: Unknown/Multiple | Type of failure: None/Unknown Difficulty: Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | ------------------------------------+------------------------------------- Compiling {{{ {-# LANGUAGE DeriveDataTypeable, PolyKinds #-} module Tagged where import Data.Typeable import Data.Ix newtype Tagged s b = Tagged { unTagged :: b } deriving ( Eq, Ord, Ix, Bounded, Typeable ) }}} gives {{{ Tagged.hs:8:5: ‛Tagged’ is applied to too many type arguments In an expression type signature: Tagged k s b -> Tagged k s b -> Bool In the expression: GHC.Prim.coerce ((==) :: b -> b -> Bool) :: Tagged k s b -> Tagged k s b -> Bool In an equation for ‛==’: (==) = GHC.Prim.coerce ((==) :: b -> b -> Bool) :: Tagged k s b -> Tagged k s b -> Bool Tagged.hs:8:9: ‛Tagged’ is applied to too many type arguments In an expression type signature: Tagged k s b -> Tagged k s b -> Ordering In the expression: GHC.Prim.coerce (compare :: b -> b -> Ordering) :: Tagged k s b -> Tagged k s b -> Ordering In an equation for ‛compare’: compare = GHC.Prim.coerce (compare :: b -> b -> Ordering) :: Tagged k s b -> Tagged k s b -> Ordering Tagged.hs:8:14: ‛Tagged’ is applied to too many type arguments In an expression type signature: (,) (Tagged k s b) (Tagged k s b) -> [] (Tagged k s b) In the expression: GHC.Prim.coerce (range :: (,) b b -> [] b) :: (,) (Tagged k s b) (Tagged k s b) -> [] (Tagged k s b) In an equation for ‛range’: range = GHC.Prim.coerce (range :: (,) b b -> [] b) :: (,) (Tagged k s b) (Tagged k s b) -> [] (Tagged k s b) Tagged.hs:8:18: ‛Tagged’ is applied to too many type arguments In an expression type signature: Tagged k s b In the expression: GHC.Prim.coerce (minBound :: b) :: Tagged k s b In an equation for ‛minBound’: minBound = GHC.Prim.coerce (minBound :: b) :: Tagged k s b }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8563 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8563: Deriving with PolyKinds broken -------------------------------------+------------------------------------ Reporter: edsko | Owner: Type: bug | Status: new Priority: high | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Unknown/Multiple Type of failure: None/Unknown | Difficulty: Unknown Test Case: | Blocked By: Blocking: | Related Tickets: -------------------------------------+------------------------------------ Comment (by nomeata): Thanks for the report, added as T8563 in a even simpler form: {{{ {-# LANGUAGE PolyKinds #-} module Tagged where newtype Tagged s b = Tagged b deriving Eq }}} The problems goes away without `PolyKinds` so it is related to that. Probably the `k` option to `Tagged` should not be explicitly given here. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8563#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8563: Deriving with PolyKinds broken
-------------------------------------+------------------------------------
Reporter: edsko | Owner:
Type: bug | Status: new
Priority: high | Milestone:
Component: Compiler | Version: 7.7
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture: Unknown/Multiple
Type of failure: None/Unknown | Difficulty: Unknown
Test Case: | Blocked By:
Blocking: | Related Tickets:
-------------------------------------+------------------------------------
Comment (by Joachim Breitner

#8563: Deriving with PolyKinds broken -------------------------------------+------------------------------------ Reporter: edsko | Owner: Type: bug | Status: new Priority: high | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Unknown/Multiple Type of failure: None/Unknown | Difficulty: Unknown Test Case: | Blocked By: Blocking: | Related Tickets: -------------------------------------+------------------------------------ Comment (by goldfire): Filter out the kind vars in `cls_tys` and `cls_tvs` in `gen_Newtype_binds` in !TcGenDeriv -- I think that should fix it. Let me know if you want me to take a closer look, but it seems like you're on it. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8563#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8563: Deriving with PolyKinds broken -------------------------------------+------------------------------------ Reporter: edsko | Owner: nomeata Type: bug | Status: new Priority: high | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Unknown/Multiple Type of failure: None/Unknown | Difficulty: Unknown Test Case: | Blocked By: Blocking: | Related Tickets: -------------------------------------+------------------------------------ Changes (by nomeata): * owner: => nomeata Comment: I’m on it, just put a trace on `cls_tys`. I’ll let you know if I have problems – thanks. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8563#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8563: Deriving with PolyKinds broken -------------------------------------+------------------------------------ Reporter: edsko | Owner: nomeata Type: bug | Status: new Priority: high | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Unknown/Multiple Type of failure: None/Unknown | Difficulty: Unknown Test Case: | Blocked By: Blocking: | Related Tickets: -------------------------------------+------------------------------------ Comment (by nomeata): The problem seems to be in `toHsType` in `HsUtils`; if I do {{{ to_hs_type (TyConApp tc args) = nlHsTyConApp (getRdrName tc) (map toHsType args') where args' = filter (not . isKind) args }}} it works. (Which make sense: In Core types, we want kinds; in the user- visible type that `toHsType` provides us, we don’t want them). Do you agree? Running validate right now... -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8563#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8563: Deriving with PolyKinds broken
-------------------------------------+------------------------------------
Reporter: edsko | Owner: nomeata
Type: bug | Status: new
Priority: high | Milestone:
Component: Compiler | Version: 7.7
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture: Unknown/Multiple
Type of failure: None/Unknown | Difficulty: Unknown
Test Case: | Blocked By:
Blocking: | Related Tickets:
-------------------------------------+------------------------------------
Comment (by Joachim Breitner

#8563: Deriving with PolyKinds broken -------------------------------------+------------------------------------ Reporter: edsko | Owner: nomeata Type: bug | Status: closed Priority: high | Milestone: Component: Compiler | Version: 7.7 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Unknown/Multiple Type of failure: None/Unknown | Difficulty: Unknown Test Case: | Blocked By: Blocking: | Related Tickets: -------------------------------------+------------------------------------ Changes (by nomeata): * status: new => closed * resolution: => fixed Comment: Yes, validate went through (and I need a faster machine so that I can go home earlier ;-)). If you disagree with the fix, let me know. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8563#comment:7 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#8563: Deriving with PolyKinds broken -------------------------------------+------------------------------------ Reporter: edsko | Owner: nomeata Type: bug | Status: closed Priority: high | Milestone: Component: Compiler | Version: 7.7 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Unknown/Multiple Type of failure: None/Unknown | Difficulty: Unknown Test Case: | Blocked By: Blocking: | Related Tickets: -------------------------------------+------------------------------------ Comment (by goldfire): Looks great to me. I agree that `toHsType` is the right place for this, not in the deriving code. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/8563#comment:8 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC