如何制作 Applicative 的固定长度向量实例？

Question

最近学习了promotion，决定尝试写vector

{-# LANGUAGE DataKinds, GADTs, KindSignatures #-}
module Vector where
  data Nat = Next Nat | Zero
  data Vector :: Nat -> * -> * where
    Construct :: t -> Vector n t -> Vector ('Next n) t
    Empty :: Vector 'Zero t
  instance Functor (Vector n) where
    fmap f a =
      case a of
        Construct x b -> Construct (f x) (fmap f b)
        Empty -> Empty

到目前为止，一切正常。但是我运行在尝试制作 Applicative 的 Vector 实例时遇到了问题。

instance Applicative (Vector n) where
  a <*> b =
    case a of
      Construct f c ->
        case b of
          Construct x d -> Construct (f x) (c <*> d)
      Empty -> Empty
  pure x = _

我不知道该怎么做pure。我试过这个：

case n of
  Next _ -> Construct x (pure x)
  Zero -> Empty

但此表达式的第一行出现 Variable not in scope: n :: Nat 错误，第三行出现 Couldn't match type n with 'Zero 错误。

所以，我使用了以下技巧。

class Applicative' n where
  ap' :: Vector n (t -> u) -> Vector n t -> Vector n u
  pure' :: t -> Vector n t
instance Applicative' n => Applicative' ('Next n) where
  ap' (Construct f a) (Construct x b) = Construct (f x) (ap' a b)
  pure' x = Construct x (pure' x)
instance Applicative' 'Zero where
  ap' Empty Empty = Empty
  pure' _ = Empty
instance Applicative' n => Applicative (Vector n) where
  (<*>) = ap'
  pure = pure'

它完成了工作，但它并不漂亮。它引入了一个没用的classApplicative'。每次我想在任何函数中将 Applicative 用于 Vector 时，我必须提供额外的无用约束 Applicative' n ，它实际上适用于任何 n.

执行此操作的更好、更简洁的方法是什么？

Answer 1

这是一个利用 singletons 包的（已评论）替代方案。

非常粗略地说，Haskell 不允许我们对 type-level 值进行模式匹配，例如上面代码中的 n。使用 singletons，我们可以在此处和那里要求并提供一些 SingI 的实例。

{-# LANGUAGE GADTs , KindSignatures, DataKinds, TemplateHaskell, 
             TypeFamilies, ScopedTypeVariables #-}
{-# OPTIONS -Wall #-}

import Data.Singletons.TH

-- Autogenerate singletons for this type
$(singletons [d|
   data Nat = Next Nat | Zero
   |])

-- as before
data Vector :: Nat -> * -> * where
   Construct :: t -> Vector n t -> Vector ('Next n) t
   Empty :: Vector 'Zero t

-- as before
instance Functor (Vector n) where
   fmap _ Empty = Empty
   fmap f (Construct x b) = Construct (f x) (fmap f b)        

-- We now require n to carry its own SingI instance.
-- This allows us to pattern match on n.
instance SingI n => Applicative (Vector n) where
   Empty <*> Empty = Empty
   -- Here, we need to access the singleton on n, so that later on we
   -- can provide the SingI (n-1) instance we need for the recursive call.
   -- The withSingI allows us to use m :: SNat (n-1) to provide the instance.
   (Construct f c) <*> (Construct x d) = case sing :: SNat n of
      SNext m -> withSingI m $ Construct (f x) (c <*> d)

   -- Here, we can finally pattern match on n.
   -- As above, we need to provide the instance with withSingI
   -- to the recursive call.
   pure x = case sing :: SNat n of
      SZero -> Empty
      SNext m -> withSingI m $ Construct x (pure x)

使用它需要在每次使用时提供一个 SingI n 实例，这有点不方便，但不是太多（IMO）。可悲的是 <*> 并不真正需要 SingI n，因为原则上，它可以从手头的两个向量重新计算。然而，pure 没有输入向量，因此它只能与提供的单例进行模式匹配。

作为另一种替代方案，类似于原始代码，可以编写

instance Applicative (Vector Zero) where
   ...
instance Applicative (Vector n) => Applicative (Vector (Next n)) where
   ...

这并不完全等同，需要在稍后 n 未知的所有函数中添加上下文 Applicative (Vector n) =>，但对于许多用途来说已经足够了。

Answer 2

你可以直接做同样的：

instance Applicative (Vector Zero) where
  a <*> b = Empty
  pure x = Empty

instance Applicative (Vector n) => Applicative (Vector (Next n)) where
  a <*> b = 
    case a of
      Construct f c ->
        case b of
          Construct x d -> Construct (f x) (c <*> d)
  pure x = Construct x (pure x)

据我推测：对于不同类型的 class，代码应该是 type-aware。如果你有多个实例，不同的类型会得到不同的实现，而且很容易解决。但是，如果你试图用单个 non-recursive 实例来实现，运行时基本上没有关于类型的信息，并且始终相同的代码仍然需要决定处理哪种类型。当您有输入参数时，您可以利用 GADT 为您提供类型信息。但是 pure 没有输入参数。因此，您必须为 Applicative 实例提供一些上下文。

Answer 3

将此视为@chi 回答的附录，以提供对单例方法的额外解释...

如果您还没有阅读 Hasochism paper，我建议您阅读。特别是，在那篇论文的第 3.1 节中，他们恰好处理了这个问题，并将其用作隐式单例参数（@chi 答案的 SingI 和 NATTY 类型 class 在 Hasochism 论文中）是必要的，而不仅仅是方便。

因为它适用于您的代码，主要问题是 pure 需要一个 run-time 表示它应该生成的向量的长度，并且 type-level变量 n 不符合要求。解决方案是引入一个新的 GADT，一个 "singleton"，它提供直接对应于提升类型 Next 和 Zero:

的运行时值

data Natty (n :: Nat) where
  ZeroTy :: Natty Zero
  NextTy :: Natty n -> Natty (Next n)

我尝试使用与论文大致相同的命名约定：Natty相同，ZeroTy和NextTy分别对应论文的Zy和Sy.

这个显式单例本身很有用。例如，参见论文中vchop的定义。此外，我们可以轻松编写 pure 的变体，它采用显式单例来完成其工作：

vcopies :: Natty n -> a -> Vector n a
vcopies ZeroTy _ = Empty
vcopies (NextTy n) x = Construct x (vcopies n x)

我们还不能用它来定义 pure，因为 pure 的签名是由 Applicative 类型 class 决定的，我们有无法在其中压缩显式单例 Natty n 。

解决方案是引入隐式单例，它允许我们在需要时通过 natty 函数在以下类型的上下文中检索显式单例 class:

class NATTY n where
  natty :: Natty n
instance NATTY Zero where
  natty = ZeroTy
instance NATTY n => NATTY (Next n) where
  natty = NextTy natty

现在，假设我们处于 NATTY n 上下文中，我们可以调用 vcopies natty 来为 vcopies 提供其明确的 natty 参数，这允许我们编写:

instance NATTY n => Applicative (Vector n) where
  (<*>) = vapp
  pure = vcopies natty

使用上面 vcopies 和 natty 的定义，以及下面 vapp 的定义：

vapp :: Vector n (a -> b) -> Vector n a -> Vector n b
vapp Empty Empty = Empty
vapp (Construct f c) (Construct x d) = Construct (f x) (vapp c d)

注意一个奇怪的地方。我们需要引入这个 vapp 辅助函数，原因不明。以下实例 without NATTY 匹配您基于 case 的定义并且 type-checks 很好：

instance Applicative (Vector n) where
  Empty <*> Empty = Empty
  Construct f c <*> Construct x d = Construct (f x) (c <*> d)
  pure = error "Argh!  No NATTY!"

如果我们添加NATTY约束来定义pure:

instance NATTY n => Applicative (Vector n) where
  Empty <*> Empty = Empty
  Construct f c <*> Construct x d = Construct (f x) (c <*> d)
  pure = vcopies natty

(<*>) 的定义不再进行类型检查。问题是第二个 (<*>) 案例 left-hand 侧的 NATTY n 约束不会自动暗示 right-hand 侧的 NATTY n1 约束（其中Next n ~ n1)，因此 GHC 不允许我们在 right-hand 端调用 (<*>)。在这种情况下，因为第一次使用约束后实际上并不需要约束，所以没有 NATTY 约束的辅助函数，即 vapp，解决了这个问题。

@chi 在 natty 上使用大小写匹配和辅助函数 withSingI 作为替代解决方法。此处的等效代码将使用辅助函数将显式单例转换为隐式 NATTY 上下文：

withNATTY :: Natty n -> (NATTY n => a) -> a
withNATTY ZeroTy a = a
withNATTY (NextTy n) a = withNATTY n a

允许我们写：

instance NATTY n => Applicative (Vector n) where
  Empty <*> Empty = Empty
  Construct f c <*> Construct x d = case (natty :: Natty n) of
    NextTy n -> withNATTY n $ Construct (f x) (c <*> d)
  pure x = case (natty :: Natty n) of
    ZeroTy -> Empty
    NextTy n -> Construct x (withNATTY n $ pure x)

这需要 ScopedTypeVariables 和 RankNTypes。

无论如何，坚持使用辅助函数，完整的程序如下所示：

{-# LANGUAGE DataKinds, GADTs, KindSignatures #-}

module Vector where

data Nat = Next Nat | Zero
data Vector :: Nat -> * -> * where
  Construct :: t -> Vector n t -> Vector ('Next n) t
  Empty :: Vector 'Zero t

data Natty (n :: Nat) where
  ZeroTy :: Natty Zero
  NextTy :: Natty n -> Natty (Next n)

class NATTY n where
  natty :: Natty n
instance NATTY Zero where
  natty = ZeroTy
instance NATTY n => NATTY (Next n) where
  natty = NextTy natty

instance Functor (Vector n) where
  fmap f a =
    case a of
      Construct x b -> Construct (f x) (fmap f b)
      Empty -> Empty

instance NATTY n => Applicative (Vector n) where
  (<*>) = vapp
  pure = vcopies natty

vapp :: Vector n (a -> b) -> Vector n a -> Vector n b
vapp Empty Empty = Empty
vapp (Construct f c) (Construct x d) = Construct (f x) (vapp c d)

vcopies :: Natty n -> a -> Vector n a
vcopies ZeroTy _ = Empty
vcopies (NextTy n) x = Construct x (vcopies n x)

与singletons库的对应关系是：

$(singletons [d|
  data Nat = Next Nat | Zero
  |])

自动生成单例（使用构造函数 SZero 和 SNat 而不是 ZeroTy 和 NatTy；类型 SNat 而不是 Natty) 和隐式单例 class（称为 SingI 而不是 NATTY 并使用函数 sing 而不是 natty），给出完整的程序：

{-# LANGUAGE DataKinds, GADTs, KindSignatures, TemplateHaskell, TypeFamilies #-}

module Vector where

import Data.Singletons
import Data.Singletons.TH

$(singletons [d|
  data Nat = Next Nat | Zero
  |])

data Vector :: Nat -> * -> * where
  Construct :: t -> Vector n t -> Vector ('Next n) t
  Empty :: Vector 'Zero t

instance Functor (Vector n) where
  fmap f a =
    case a of
      Construct x b -> Construct (f x) (fmap f b)
      Empty -> Empty

instance SingI n => Applicative (Vector n) where
  (<*>) = vapp
  pure = vcopies sing

vapp :: Vector n (a -> b) -> Vector n a -> Vector n b
vapp Empty Empty = Empty
vapp (Construct f c) (Construct x d) = Construct (f x) (vapp c d)

vcopies :: SNat n -> a -> Vector n a
vcopies SZero _ = Empty
vcopies (SNext n) x = Construct x (vcopies n x)

有关 singletons 库的功能及其构建方式的更多信息，我建议阅读 Introduction to Singletons。

Answer 4

其他几个答案引入了 Natty 或 SNat 类型来实现 pure。事实上，拥有这样的类型大大减少了对 one-off 类型 classes 的需求。然而，传统 Natty/SNat GADT 的一个潜在缺点是您的程序实际上将构建表示然后使用它，即使 Nat 在编译时已知。使用 auxiliary-class 方法通常不会发生这种情况。您可以使用不同的表示来解决这个问题。

我将使用这些名称：

data Nat = Z | S Nat

假设我们定义通常的

data Natty n where
  Zy :: Natty 'Z
  Sy :: Natty n -> Natty ('S n)

我们可以这样写它的消元器（归纳原理）：

natty :: p 'Z -> (forall k. p k -> p ('S k)) -> Natty n -> p n
natty z _ Zy = z
natty z s (Sy n) = s (natty z s n)

为了我们的目的，我们真的不需要 Natty；我们只需要它的归纳原理！所以让我们定义另一个版本。我想这个编码有一个专有名称，但我不知道它可能是什么。

newtype NatC n = NatC
  { unNatC :: forall p.
              p 'Z  -- base case
           -> (forall k. p k -> p ('S k))  -- inductive step
           -> p n }

这同构于 Natty:

nattyToNatC :: Natty n -> NatC n
nattyToNatC n = NatC (\z s -> natty z s n)

natCToNatty :: NatC n -> Natty n
natCToNatty (NatC f) = f Zy Sy

现在我们可以为 Nat 写一个 class 我们知道如何消除：

class KnownC n where
  knownC :: NatC n
instance KnownC 'Z where
  knownC = NatC $ \z _ -> z
instance KnownC n => KnownC ('S n) where
  knownC = NatC $ \z s -> s $ unNatC knownC z s

现在这是一个矢量类型（我已经重命名以符合我自己的口味）：

infixr 4 :<
data Vec :: Nat -> * -> * where
  (:<) :: t -> Vec n t -> Vec ('S n) t
  Nil :: Vec 'Z t

因为 Vec 的长度参数不是它的最后一个，我们必须翻转它才能与 NatC:

一起使用

newtype Flip f a n = {unFlip :: f n a}

induct2 :: f 'Z a
         -> (forall k. f k a -> f ('S k) a)
         -> NatC n -> f n a
induct2 z s n = unFlip $ unNatC n (Flip z) (\(Flip r) -> Flip (s r))

replC :: NatC n -> a -> Vec n a
replC n a = induct2 Nil (a :<) n

instance KnownC n => Applicative (Vec n) where
   pure = replC knownC
   (<*>) = ...

现在，如果向量长度在编译时已知，pure向量将直接构建，不需要中间结构。

如何制作 Applicative 的固定长度向量实例？

How to make fixed-length vectors instance of Applicative?

haskell

types

pattern-matching

typeclass

gadt