如何將歸納推理應用於“ GHC.TypeLits.Nat”？

Question

對於Peano數字索引的通常矢量長度，請考慮zip定義：

{-# language DataKinds          #-}
{-# language KindSignatures     #-}
{-# language GADTs              #-}
{-# language TypeOperators      #-}
{-# language StandaloneDeriving #-}
{-# language FlexibleInstances  #-}
{-# language FlexibleContexts   #-}

module Vector
  where

import Prelude hiding (zip)

data N
  where
    Z :: N
    S :: N -> N

data Vector (n :: N) a
  where
    VZ :: Vector Z a
    (:::) :: a -> Vector n a -> Vector (S n) a

infixr 1 :::

deriving instance Show a => Show (Vector n a)

class Zip z
  where
    zip :: z a -> z b -> z (a, b)

instance Zip (Vector n) => Zip (Vector (S n))
  where
    zip (x ::: xs) (y ::: ys) = (x, y) ::: zip xs ys

instance Zip (Vector Z)
  where
    zip _ _ = VZ

-- ^
-- λ :t zip (1 ::: 2 ::: 3 ::: VZ) (4 ::: 5 ::: 6 ::: VZ)
-- zip (1 ::: 2 ::: 3 ::: VZ) (4 ::: 5 ::: 6 ::: VZ)
--   :: (Num a, Num b) => Vector ('S ('S ('S 'Z))) (a, b)
-- λ zip (1 ::: 2 ::: 3 ::: VZ) (4 ::: 5 ::: 6 ::: VZ)
-- (1,4) ::: ((2,5) ::: ((3,6) ::: VZ))

輸入一元數會很麻煩（即使我有一個宏） 。 幸運的是，這里有GHC.TypeLits 。 讓我們使用它：

module Vector
  where

import Prelude hiding (zip)
import GHC.TypeLits

data Vector (n :: Nat) a
  where
    VZ :: Vector 0 a
    (:::) :: a -> Vector n a -> Vector (n + 1) a

infixr 1 :::

deriving instance Show a => Show (Vector n a)

class Zip z
  where
    zip :: z a -> z b -> z (a, b)

instance Zip (Vector n) => Zip (Vector (n + 1))
  where
    zip (x ::: xs) (y ::: ys) = (x, y) ::: zip xs ys

instance Zip (Vector 0)
  where
    zip _ _ = VZ

- 但不是：

    • Illegal type synonym family application in instance:
        Vector (n + 1)
    • In the instance declaration for ‘Zip (Vector (n + 1))’
   |
28 | instance Zip (Vector n) => Zip (Vector (n + 1))
   |                            ^^^^^^^^^^^^^^^^^^^^

因此，我將類替換為普通函數：

zip :: Vector n a -> Vector n b -> Vector n (a, b)
zip (x ::: xs) (y ::: ys) = (x, y) ::: zip xs ys
zip VZ VZ = VZ

—但是現在我不能再使用歸納推理了：

Vector.hs:25:47: error:
    • Could not deduce: n2 ~ n1
      from the context: n ~ (n1 + 1)
        bound by a pattern with constructor:
                   ::: :: forall a (n :: Nat). a -> Vector n a -> Vector (n + 1) a,
                 in an equation for ‘zip’
        at Vector.hs:25:6-13
      or from: n ~ (n2 + 1)
        bound by a pattern with constructor:
                   ::: :: forall a (n :: Nat). a -> Vector n a -> Vector (n + 1) a,
                 in an equation for ‘zip’
        at Vector.hs:25:17-24
      ‘n2’ is a rigid type variable bound by
        a pattern with constructor:
          ::: :: forall a (n :: Nat). a -> Vector n a -> Vector (n + 1) a,
        in an equation for ‘zip’
        at Vector.hs:25:17-24
      ‘n1’ is a rigid type variable bound by
        a pattern with constructor:
          ::: :: forall a (n :: Nat). a -> Vector n a -> Vector (n + 1) a,
        in an equation for ‘zip’
        at Vector.hs:25:6-13
      Expected type: Vector n1 b
        Actual type: Vector n2 b
    • In the second argument of ‘zip’, namely ‘ys’
      In the second argument of ‘(:::)’, namely ‘zip xs ys’
      In the expression: (x, y) ::: zip xs ys
    • Relevant bindings include
        ys :: Vector n2 b (bound at Vector.hs:25:23)
        xs :: Vector n1 a (bound at Vector.hs:25:12)
   |
25 | zip (x ::: xs) (y ::: ys) = (x, y) ::: zip xs ys
   |                                               ^^

我沒有觀察到明顯的東西嗎？ 這些TypeLits不能沒有用嗎？..它應該如何工作？

Answer 1

在TypeLits上沒有歸納TypeLits ，默認情況下確實使它們幾乎無用，但是您可以通過兩種方式改善這種情況。

使用ghc-typelits-natnormalise 。 這是一個GHC插件，在類型檢查器中添加了算術求解器，並使GHC認為許多相等的Nat表達式相等。 這非常方便，並且與下一個解決方案兼容。 開箱即用的zip即可使用。

假定您需要的任何屬性。 為了避免潛在的內存安全性問題，您應該僅假設真實語句的證明，並且僅假設相等性或其他與計算無關的數據類型的證明。 例如，您的zip可以通過以下方式工作：

{-# language
    RankNTypes, TypeApplications, TypeOperators,
    GADTs, TypeInType, ScopedTypeVariables #-}

import GHC.TypeLits
import Data.Type.Equality
import Unsafe.Coerce

data Vector (n :: Nat) a
  where
    VZ :: Vector 0 a
    (:::) :: a -> Vector n a -> Vector (n + 1) a

lemma :: forall n m k. (n :~: (m + 1)) -> (n :~: (k + 1)) -> m :~: k
lemma _ _ = unsafeCoerce (Refl @n)

vzip :: Vector n a -> Vector n b -> Vector n (a, b)
vzip VZ VZ = VZ
vzip ((a ::: (as :: Vector m a)) :: Vector n a)
     ((b ::: (bs :: Vector k b)) :: Vector n b) =
  case lemma @n @m @k Refl Refl of
    Refl -> (a, b) ::: vzip as bs