A.hs

{-# OPTIONS_GHC -ddump-simpl -dno-typeable-binds -fforce-recomp -O -fno-worker-wrapper #-}
module SpecRepro where

import Data.Kind
import Unsafe.Coerce

class Foo t where

class Too where
  too :: Int

class Qux r where
  qux :: r
  boo :: r
  comb :: r -> r -> r

-- This specialises
--instance Qux Int where
-- This does not
instance Too => Qux Int where
  qux = 0
  boo = 1
  comb = (+)

newtype H = H (Int -> Int)

instance Qux H where
  qux = H (\_ -> 0)
  boo = H (\_ -> 1)
  comb (H f) (H g) = H (\x -> f x + g x)

newtype Gift a r = Gift (Too => r)

give :: Int -> (Too => a) -> a
give x f = co f x
  where
    co :: (Too => a) -> (Int -> a)
    co f = unsafeCoerce (Gift f)

-- This does not specialise
a :: Int -> Int
a n = give n (mieux 100)

-- This call specialised to H
b :: Int -> Int
b n = case (mieux 100) of
        H h -> h n

mieux :: Qux a => Int -> a
mieux 0 = boo
mieux n = boo `comb` qux `comb` (mieux (n - 1))