[ghc-steering-committee] Mind the gap

Richard Eisenberg lists at richarde.dev
Tue Jul 5 14:00:33 UTC 2022


This is PolyKinds, which generalizes the kind of D, meaning that satisfying the Typeable a superclass constraint of C also requires a Typeable k constraint, where (a :: k).

Richard

> On Jul 2, 2022, at 12:49 AM, Chris Dornan <chris at chrisdornan.com> wrote:
> 
> Quick quiz: the below Haskell2010 ‘Phantoms' module (also in this Gist: https://gist.github.com/cdornan/f75cd8024434d998c87610cbb7fb6ab3) appears (for me on GHC 9.2.2 and 9.2.3) to not be a GHC2021 module, reporting this error under the latter configuration:
> 
> Phantoms.hs:22:10: error:
>    • Could not deduce (Typeable k)
>        arising from the superclasses of an instance declaration
>      from the context: (C a, Typeable a)
>        bound by the instance declaration
>        at Phantoms.hs:22:10-36
>    • In the instance declaration for ‘S (D a)’
>   |
> 22 | instance (C a,Typeable a) => S (D a) where smethod = undefined
>   |          ^^^^^^^^^^^^^^^^^^^^^^^^^^^
> 
> Phantoms.hs:22:10: error:
>    • Could not deduce (Typeable k)
>        arising from the superclasses of an instance declaration
>      from the context: (C a, Typeable a)
>        bound by the instance declaration
>        at Phantoms.hs:22:10-36
>    • In the instance declaration for ‘S (D a)’
>   |
> 22 | instance (C a,Typeable a) => S (D a) where smethod = undefined
> 
> The question is which language extension(s) are giving rise to these errors?
> 
> The ‘Phantoms' module is this:
> 
> {-# LANGUAGE DerivingVia #-}
> 
> module Phantoms where
> 
> import Data.Typeable
> 
> 
> class C a where
>  cmethod :: Proxy a -> ()
> 
> class (Show a, Typeable a) => S a where
>  smethod :: a -> Int
> 
> 
> newtype UsingD a = UsingD { getUsingD :: a }
> 
> 
> newtype D a = D { getD :: Int }
>    deriving (Show) via UsingD (D a)
> 
> 
> instance (C a,Typeable a) => S (D a) where smethod = undefined
> 
> instance (C a,Typeable a) => Show (UsingD a) where showsPrec = undefined
> 
> 
> instance (C a) => C (D a) where cmethod _ = undefined
> 
> _______________________________________________
> ghc-steering-committee mailing list
> ghc-steering-committee at haskell.org
> https://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-steering-committee



More information about the ghc-steering-committee mailing list