Re: [GHC] #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus?

27 Jan 2018

      #14728: Is (GeneralizedNewtypeDeriving + associated type classes) completely bogus?
-------------------------------------+-------------------------------------
        Reporter:  RyanGlScott       |                Owner:  (none)
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Compiler (Type    |              Version:  8.2.2
  checker)                           |             Keywords:  deriving,
      Resolution:                    |  TypeFamilies
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by RyanGlScott):

 Sure enough, slightly tweaking the third program can tickle a Core Lint
 error:

 {{{#!hs
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeInType #-}
 module Bug where

 import Data.Functor.Identity
 import Data.Kind

 class C (a :: Type) where
   type T a (x :: a) :: Type

 instance C () where
   type T () '() = Bool

 deriving instance C (Identity a)

 f :: T (Identity ()) ('Identity '())
 f = undefined
 }}}
 {{{
 $ /opt/ghc/8.2.2/bin/ghc Bug.hs -dcore-lint
 [1 of 1] Compiling Bug              ( Bug.hs, Bug.o )
 *** Core Lint errors : in result of Desugar (after optimization) ***
 <no location info>: warning:
     In the expression: undefined
                          @ 'LiftedRep @ (T () ('Identity '())) $dIP_a2e7
     Kind application error in type ‘T () ('Identity '())’
       Function kind = forall a -> a -> *
       Arg kinds = [((), *), ('Identity '(), Identity ())]
 Bug.hs:19:1: warning:
     [RHS of f :: T (Identity ()) ('Identity '())]
     @ a2_a1bw is out of scope
 *** Offending Program ***
 $fC() [InlPrag=CONLIKE] :: C ()
 [LclIdX[DFunId], Unf=DFun: \ -> C:C TYPE: ()]
 $fC() = C:C @ ()

 $fCIdentity [InlPrag=CONLIKE] :: forall a. C (Identity a)
 [LclIdX[DFunId], Unf=DFun: \ (@ a_aWB) -> C:C TYPE: Identity a_aWB]
 $fCIdentity = \ (@ a_a2ea) -> C:C @ (Identity a_a2ea)

 $trModule :: Module
 [LclIdX]
 $trModule = Module (TrNameS "main"#) (TrNameS "Bug"#)

 $krep_a2pm [InlPrag=[~]] :: KindRep
 [LclId]
 $krep_a2pm = KindRepTyConApp $tcConstraint ([] @ KindRep)

 $krep_a2pl [InlPrag=[~]] :: KindRep
 [LclId]
 $krep_a2pl = KindRepFun krep$* $krep_a2pm

 $krep_a2po [InlPrag=[~]] :: KindRep
 [LclId]
 $krep_a2po = $WKindRepVar (I# 0#)

 $tcC :: TyCon
 [LclIdX]
 $tcC
   = TyCon
       12754692886077552850##
       18375870125396612007##
       $trModule
       (TrNameS "C"#)
       0#
       $krep_a2pl

 $krep_a2pn [InlPrag=[~]] :: KindRep
 [LclId]
 $krep_a2pn
   = KindRepTyConApp $tcC (: @ KindRep $krep_a2po ([] @ KindRep))

 $tc'C:C :: TyCon
 [LclIdX]
 $tc'C:C
   = TyCon
       302756782745842909##
       14248103394115774781##
       $trModule
       (TrNameS "'C:C"#)
       1#
       $krep_a2pn

 $dIP_a2e7 :: HasCallStack
 [LclId]
 $dIP_a2e7
   = (pushCallStack
        (unpackCString# "undefined"#,
         SrcLoc
           (unpackCString# "main"#)
           (unpackCString# "Bug"#)
           (unpackCString# "Bug.hs"#)
           (I# 19#)
           (I# 5#)
           (I# 19#)
           (I# 14#))
        ((emptyCallStack
          `cast` (Sym (N:IP[0] <"callStack">_N <CallStack>_N)
                  :: (CallStack :: *) ~R# ((?callStack::CallStack) ::
 Constraint)))
         `cast` (N:IP[0] <"callStack">_N <CallStack>_N
                 :: ((?callStack::CallStack) :: Constraint) ~R# (CallStack
 :: *))))
     `cast` (Sym (N:IP[0] <"callStack">_N <CallStack>_N)
             :: (CallStack :: *) ~R# ((?callStack::CallStack) ::
 Constraint))

 f :: T (Identity ()) ('Identity '())
 [LclIdX]
 f = (undefined @ 'LiftedRep @ (T () ('Identity '())) $dIP_a2e7)
     `cast` (Sub
               (Sym (R:TIdentityx[0] <()>_N <a2_a1bw>_N <'Identity '()>_N))
             :: (T () ('Identity '()) :: *)
                ~R#
                (T (Identity ()) ('Identity '()) :: *))

 *** End of Offense ***

 <no location info>: error:
 Compilation had errors
 }}}

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14728#comment:1>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler