Доказательство коммутативности добавления уровня натуральных чисел

Я играю с тем, что предлагает haskell для зависимого программирования. Я продвинул GADT, представляющий натуральные числа, на добрый уровень и сделал семейство типов для добавления натуральных чисел. Я также сделал ваш стандартный вектор "ребенок первого зависимого типа данных", параметризованный как по его длине, так и по типу, который он содержит. Код выглядит следующим образом:

data Nat where
    Z :: Nat
    S :: Nat -> Nat

type family (a :: Nat) + (b :: Nat) :: Nat where
    Z + n = n
    S m + n = S (m + n)

data Vector (n :: Nat) a where
    Nil :: Vector Z a
    Cons :: a -> Vector n a -> Vector (S n) a

Кроме того, я сделал функцию append которая принимает m -vector, n-vetor и возвращает (m + n) -vector. Это работает так же, как можно было бы надеяться. Однако, просто для этого, я попытался перевернуть его, чтобы он возвращал (n + m) -vector. Это приводит к ошибке компилятора, поскольку GHC не может доказать, что мое добавление является коммутативным. Я по-прежнему относительно новый, чтобы набирать семьи, поэтому я не уверен, как написать это доказательство самостоятельно, или если это даже то, что вы можете сделать в haskell.

Моя первоначальная мысль заключалась в том, чтобы каким-то образом использовать ограничение равенства типов, но я не уверен, как двигаться вперед.

Поэтому, чтобы быть ясным: я хочу написать эту функцию

append :: Vector m a -> Vector n a -> Vector (n + m) a
append Nil xs         = xs
append (Cons x xs) ys = x 'Cons' append xs ys

но он не скомпилирован с

    * Could not deduce: (n + 'Z) ~ n
      from the context: m ~ 'Z
        bound by a pattern with constructor: Nil :: forall a. Vector 'Z a,
                 in an equation for 'append'

ОТВЕТЫ

Ответ 1

Вот полное решение. Предупреждение: включает некоторые hasochism.

Мы начинаем как в исходном коде.

{-# LANGUAGE TypeFamilies, DataKinds, TypeOperators, GADTs, PolyKinds #-}
{-# OPTIONS -Wall -O2 #-}
module CommutativeSum where

data Nat where
    Z :: Nat
    S :: Nat -> Nat

type family (a :: Nat) + (b :: Nat) :: Nat where
    'Z + n = n
     m + n =  (m + n)

data Vector (n :: Nat) a where
    Nil :: Vector 'Z a
    Cons :: a -> Vector n a -> Vector ( n) a

Старый append, тип которого проверяется немедленно.

append :: Vector m a -> Vector n a -> Vector (m + n) a
append Nil xs         = xs
append (Cons x xs) ys = x 'Cons' append xs ys

Для другого приложения нам нужно доказать, что сложение является коммутативным. Начнем с определения равенства на уровне типа, использующего GADT.

-- type equality, also works on Nat because of PolyKinds
data a :~: b where
   Refl :: a :~: a

Мы вводим одноэлементный тип, так что мы можем передавать Nat а также шаблонное совпадение.

-- Nat singleton, to reify type level parameters
data NatI (n :: Nat) where
  ZI :: NatI 'Z
  SI :: NatI n -> NatI ( n)

Мы можем сопоставить каждому вектору его длину как одноточечный NatI.

-- length of a vector as a NatI
vecLengthI :: Vector n a -> NatI n
vecLengthI Nil = ZI
vecLengthI (Cons _ xs) = SI (vecLengthI xs)

Теперь основная часть. Нам нужно доказать индукцию n + m = m + n. Это требует нескольких лемм для некоторых арифметических законов.

-- inductive proof of: n + Z = n  
sumZeroRight :: NatI n -> (n + 'Z) :~: n
sumZeroRight ZI = Refl
sumZeroRight (SI n') = case sumZeroRight n' of
   Refl -> Refl

-- inductive proof of: n + S m = S (n + m)
sumSuccRight :: NatI n -> NatI m -> (n +  m) :~:  (n + m)
sumSuccRight ZI _m = Refl
sumSuccRight (SI n') m  = case sumSuccRight n' m of
   Refl -> Refl

-- inductive proof of commutativity: n + m = m + n
sumComm :: NatI n -> NatI m -> (n + m) :~: (m + n)
sumComm ZI m = case sumZeroRight m of Refl -> Refl
sumComm (SI n') m = case (sumComm n' m, sumSuccRight m n') of
   (Refl, Refl) -> Refl

Наконец, мы можем использовать приведенное выше доказательство, чтобы убедить GHC напечатать append как мы хотели. Обратите внимание, что мы можем повторно использовать реализацию со старым типом, а затем убедить GHC, что он также может использовать новый.

-- append, with the wanted type
append2 :: Vector m a -> Vector n a -> Vector (n + m) a
append2 xs ys = case sumComm (vecLengthI xs) (vecLengthI ys) of
   Refl -> append xs ys

Заключительные замечания. По сравнению с полностью зависящим от языка языком (например, как Coq), мы должны были ввести синглеты и приложить больше усилий, чтобы заставить их работать ("больная" часть хазохизма). В свою очередь, мы можем просто сопоставить соответствие с Refl и позволить GHC выяснить, как использовать выведенные уравнения, не вступая в зависимость от зависимого соответствия (часть удовольствия).

В целом, мне кажется, что все еще немного легче работать с полными зависимыми типами. Если/когда GHC получает не стираемые кванторы типа (pi n.... выше forall n....), вероятно, Haskell станет более удобным.