Typeclass dictionary selector unfolding sensitive to type parameter
In the following Haskell module, one method of C
is, by default, implemented via the other method:
{-# LANGUAGE NoImplicitPrelude, NoPolyKinds #-}
{-# LANGUAGE CPP #-}
module RecDict () where
class C m where
#if HKT
foo :: m a -> m a
bar :: m a -> m a
#else
foo :: m -> m
bar :: m -> m
#endif
#if HKT
data T tag a
#else
data T tag
#endif
instance C (T tag) where
foo x = x
{-# NOINLINE bar #-}
bar = foo
instance {-# INCOHERENT #-} C (T ()) where
foo x = x
{-# NOINLINE bar #-}
bar = foo
With HKT
set to 0, the generated (Prep) Core looks generally like what I'd expect: there are two dictionary definitions for C (T tag)
and C (T ())
, and both are simply the dictionary constructor applied on toplevel method bindings.
For readabilty's sake, I present the Core in four groups:
$ ghc input/recursive-dict/RecDict.hs -fforce-recomp -dno-typeable-binds -ddump-prep -dsuppress-all -dno-suppress-type-signatures -O2 -DHKT=0
-- Group 1: dictionary constructor
C:C :: forall m. (m -> m) -=> (m -> m) -=> C m
C:C
= \ (@m_ad) (eta_B0 :: m_ad -> m_ad) (eta_B1 :: m_ad -> m_ad) ->
C:C eta_B0 eta_B1
-- Group 2: method selectors
foo :: forall m. C m => m -> m
foo
= \ (@m_ad) (v_ss7 :: C m_ad) ->
case v_ss7 of { C:C v2_ss9 _ -> v2_ss9 }
bar :: forall m. C m => m -> m
bar
= \ (@m_ad) (v_ssb :: C m_ad) ->
case v_ssb of { C:C _ v3_sse -> v3_sse }
-- Group 3: definition of C (T tag)
$fCT0_$cfoo :: forall tag. T tag -> T tag
$fCT0_$cfoo = \ (@tag_a7N) (x_ssf :: T tag_a7N) -> x_ssf
$fCT0_$cbar :: forall tag. T tag -> T tag
$fCT0_$cbar
= \ (@tag_a7N) (eta_B0 :: T tag_a7N) -> $fCT0_$cfoo eta_B0
$fCT0 :: forall tag. C (T tag)
$fCT0 = \ (@tag_a7N) -> C:C $fCT0_$cfoo $fCT0_$cbar
-- Group 4: definition of C (T ())
$fCT_$cfoo :: T () -> T ()
$fCT_$cfoo = \ (x_ssg :: T ()) -> x_ssg
$fCT_$cbar :: T () -> T ()
$fCT_$cbar = \ (eta_B0 :: T ()) -> $fCT_$cfoo eta_B0
$fCT :: C (T ())
$fCT = C:C $fCT_$cfoo $fCT_$cbar
However, with HKT
set to 1, suddenly the foo
method selector is not inlined into $fCT0_$cbar
, leading to mutual recursion between $fCT0_$cbar
and $fCT0
:
$ ghc input/recursive-dict/RecDict.hs -fforce-recomp -dno-typeable-binds -ddump-prep -dsuppress-all -dno-suppress-type-signatures -O2 -DHKT=1
-- Group 1: dictionary constructor
C:C
:: forall (m :: * -> *).
(forall a. m a -> m a) -=> (forall a. m a -> m a) -=> C m
C:C
= \ (@(m_ae :: * -> *))
(eta_B0 :: forall a. m_ae a -> m_ae a)
(eta_B1 :: forall a. m_ae a -> m_ae a) ->
C:C eta_B0 eta_B1
-- Group 2: method selectors
foo :: forall (m :: * -> *) a. C m => m a -> m a
foo
= \ (@(m_ae :: * -> *)) (v_ssx :: C m_ae) ->
case v_ssx of { C:C v2_ssz _ -> v2_ssz }
bar :: forall (m :: * -> *) a. C m => m a -> m a
bar
= \ (@(m_ae :: * -> *)) (v_ssB :: C m_ae) ->
case v_ssB of { C:C _ v3_ssE -> v3_ssE }
-- Group 3: definition of C (T tag)
$fCT0_$cfoo :: forall tag a. T tag a -> T tag a
$fCT0_$cfoo
= \ (@tag_a87) (@a_a8c) (x_ssF :: T tag_a87 a_a8c) -> x_ssF
Rec {
$fCT0 :: forall tag. C (T tag)
$fCT0 = \ (@tag_a87) -> C:C $fCT0_$cfoo $fCT0_$cbar
$fCT0_$cbar :: forall tag a. T tag a -> T tag a
$fCT0_$cbar = \ (@tag_a87) (@a_a8i) -> foo $fCT0
end Rec }
-- Group 4: definition of C (T ())
$fCT_$cfoo :: forall a. T () a -> T () a
$fCT_$cfoo = \ (@a_a7S) (x_ssG :: T () a_a7S) -> x_ssG
$fCT_$cbar :: forall a. T () a -> T () a
$fCT_$cbar = \ (@a_af) (eta_B0 :: T () a_af) -> $fCT_$cfoo eta_B0
$fCT :: C (T ())
$fCT = C:C $fCT_$cfoo $fCT_$cbar
What is the reason that group 3 is so wildly different between the two programs? Is there a way to produce the non-recursive Core a la the first version for the HKT=1
program?