受约束的递归通用函数的专业化

Question

我一直致力于在linear-baseSjoerd Visscher 开始的一些工作的基础上添加对泛型派生的支持。一般来说，泛型的性能可以达到预期的效果，但我遇到了递归类型（如列表）的问题，我不知道该怎么办。最简单的例子就是类Consumable。如果你不熟悉线性类型的东西，不要被它迷惑；这在这里几乎无关紧要。我们有

class Consumable a where
  -- Read this as consume :: a -> (), but it's guaranteed to use
  -- its argument exactly once.
  consume :: a %1 -> ()

instance (Generic a, GConsumable (Rep a)) => Consumable (Generically a) where
  consume (Generically x) = genericConsume x

genericConsume :: (Generic a, GConsumable (Rep a)) => a %1 -> ()
genericConsume = gconsume . from
{-# INLINEABLE genericConsume #-}

-- | A class for generic representations that can be consumed.
class GConsumable f where
  gconsume :: f p %1 -> ()

instance GConsumable U1 where
  gconsume U1 = ()
  {-# INLINE gconsume #-}

instance (GConsumable f, GConsumable g) => GConsumable (f :+: g) where
  gconsume (L1 a) = gconsume a
  gconsume (R1 a) = gconsume a
  {-# INLINE gconsume #-}

instance (GConsumable f, GConsumable g) => GConsumable (f :*: g) where
  gconsume (a :*: b) = gconsume a `seqUnit` gconsume b
  {-# INLINE gconsume #-}

instance Consumable c => GConsumable (K1 i c) where
  gconsume (K1 c) = consume c
  {-# INLINE gconsume #-}

instance GConsumable f => GConsumable (M1 i t f) where
  gconsume (M1 a) = gconsume a
  {-# INLINE gconsume #-}

-- There are instances for more generic representations, but
-- they're not relevant to the question

如果我们定义

deriving via
  Generically [a]
  instance
    Consumable a => Consumable [a]

那么我们得到如下的Core( -ddump-simpl -dsuppress-coercions -dsuppress-type-applications)：

Rec {
-- RHS size: {terms: 15, types: 12, coercions: 2, joins: 0/0}
Data.Unrestricted.Linear.Internal.Consumable.$fConsumableNonEmpty_$cconsume1 [Occ=LoopBreaker]
  :: forall a. Consumable a => [a] %1 -> ()
[GblId, Arity=2, Str=<LCL(A)><1L>, Unf=OtherCon []]
Data.Unrestricted.Linear.Internal.Consumable.$fConsumableNonEmpty_$cconsume1
  = \ (@a_a6VD)
      ($dConsumable_a6VE :: Consumable a_a6VD)
      (eta_B0 :: [a_a6VD]) ->
      case eta_B0 of {
        [] -> GHC.Tuple.();
        : f1_a7mo f2_a7mp ->
          case ($dConsumable_a6VE `cast` <Co:2>) f1_a7mo of { () ->
          Data.Unrestricted.Linear.Internal.Consumable.$fConsumableNonEmpty_$cconsume1
            $dConsumable_a6VE f2_a7mp
          }
      }
end Rec }

看到问题了吗？这是一个没有展开的循环断路器，因此它不能专门针对特定Consumable a实例。啊。手动编写Consumable实例，我们可以使用作用域类型变量来避免这个问题：

instance Consumable a => Consumable [a] where
  consume = go
    where
      go :: [a] %1 -> ()
      go [] = ()
      go (x : xs) = consume x `seqUnit` go xs

现在我们得到了更满意的结果

-- RHS size: {terms: 18, types: 16, coercions: 2, joins: 1/1}
Data.Unrestricted.Linear.Internal.Consumable.$fConsumableNonEmpty_$cconsume1
  :: forall a. Consumable a => [a] %1 -> ()
[GblId,
 Arity=2,
 Str=<LCL(A)><1L>,
 Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
         Tmpl= \ (@a_a71g)
                 ($dConsumable_a71h [Occ=OnceL1!] :: Consumable a_a71g)
                 (eta_B0 [Occ=Once1] :: [a_a71g]) ->
                 joinrec {
                   go_s7zZ [Occ=LoopBreakerT[1]] :: [a_a71g] %1 -> ()
                   [LclId[JoinId(1)], Arity=1, Str=<L>, Unf=OtherCon []]
                   go_s7zZ (ds_d7bD [Occ=Once1!] :: [a_a71g])
                     = case ds_d7bD of {
                         [] -> GHC.Tuple.();
                         : x_a59q [Occ=Once1] xs_a59r [Occ=Once1] ->
                           case ($dConsumable_a71h `cast` <Co:2>) x_a59q of { () ->
                           jump go_s7zZ xs_a59r
                           }
                       }; } in
                 jump go_s7zZ eta_B0}]
Data.Unrestricted.Linear.Internal.Consumable.$fConsumableNonEmpty_$cconsume1
  = ....

有没有办法用泛型来实现这一点，或者这是一个失败的原因？

原则上，GHC 可以去掉静态字典参数；也许这个问题最好在编译器级别解决？

---

我刚刚意识到这个问题也会影响NFData. 哎哟!