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

Я играю с тем, какие инструменты 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-вектор, n-вектор и вернуть an (m+n)-вектор. Это работает так хорошо, как можно было бы надеяться. Однако, просто для этого, я попытался перевернуть его, чтобы он вернул (n+m)-вектор. Это приводит к ошибке компилятора, потому что 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'
12
dependent-type haskell type-theory

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
    '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 :: 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

мы вводим одноэлементный тип, так что мы можем пройти Nats, а также шаблон матча на их.

-- Nat singleton, to reify type level parameters
data NatI (n :: Nat) where
  ZI :: NatI 'Z
  SI :: NatI n -> NatI ('S 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 + 'S m) :~: 'S (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), нам пришлось ввести синглеты и потратить больше усилий, чтобы заставить их работать ("боль" Часть Hasochism). Взамен мы можем просто сопоставить шаблон с Refl и пусть GHC выяснит, как использовать выведенные уравнения, не возясь с зависимым соответствием (часть "удовольствие").

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

7