Как сделать экземпляр векторов фиксированной длины Applicative?

это (комментарии) альтернатива, которая использует singletons пакета.

очень грубо, Haskell не позволяет нам сопоставлять шаблоны на значениях уровня типа, таких как 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
   ...

это не полностью эквивалентно, и потребуется добавить контексты Applicative (Vector n) => во всех функциях позже, где n - это неизвестно, но может быть достаточно для многих цели.

считай, что это дополнение к ответу @чи, чтобы обеспечить дополнительное объяснение синглтон подход...

я бы предложил чтение бумага Hasochism если вы еще не сделали этого. В частности, в разделе 3.1 этой статьи они занимаются именно этой проблемой и используют ее в качестве мотивирующего примера для неявных одноэлементных параметров (SingI ответа @chi и NATTY класс типа в статье Hasochism) необходимы, скорее чем просто удобно.

поскольку это относится к вашему коду, основная проблема заключается в том, что pure требуется представление во время выполнения длины вектора, который он должен генерировать, и переменной уровня типа n не подходит для счета. Решение состоит в том, чтобы ввести новый GADT, "синглтон", который предоставляет значения времени выполнения, которые соответствуют непосредственно продвигаемым типам 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's подпись определяется Applicative тип класса, и у нас нет способа сжать явный синглтон 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 вспомогательная функция по неясной причине. Следующий экземпляр без NATTY соответствует caseна основе определения и проверки штрафа:

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

определение (<*>) не печатает check any больше. Проблема в том, что NATTY n ограничение на левой стороне второго (<*>) случай автоматически не подразумевает NATTY n1 ограничение с правой стороны (где Next n ~ n1), поэтому GHC не хочет позволять нам звонить (<*>) С правой стороны. В этом случае, поскольку ограничение фактически не требуется после его первого использования, вспомогательная функция без 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) и неявный одноэлементный класс (называемый 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 библиотека делает и как она построена, я бы предложил прочитать введение в синглтоны.

несколько других ответов ввели Natty или SNat типа для реализации pure. Действительно, наличие такого типа значительно уменьшает потребность в одноразовых классах типов. Потенциальный недостаток традиционного Natty/SNat GADT, однако, заключается в том, что ваша программа будет фактически строить представление, а затем использовать его, даже если Nat известно во время компиляции. Это вообще не произойдет с подходом вспомогательного класса. Вы можете обойти это с помощью различные представления.

я собираюсь использовать эти имена:

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

теперь мы можем написать класс для Nats Мы знаем, как устранить:

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 вектор будет построен сразу, без промежуточного звена необходима структура.