證明GHC的類型不等式

Question

出於教育目的，我一直在嘗試通過使用各種語言擴展和單例類型來重構Haskell中的“使用Idris進行類型驅動開發”（即RemoveElem.idr ）一書中的示例。 它的要點是一個從非空向量中移除元素的函數，給出了元素實際上在向量中的證明。 以下代碼是自包含的（GHC 8.4或更高版本）。 問題出現在最后：

{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeInType #-}

import Data.Kind
import Data.Type.Equality
import Data.Void

-- | Inductively defined natural numbers.
data Nat = Z | S Nat deriving (Eq, Show)

-- | Singleton types for natural numbers.
data SNat :: Nat -> Type where
    SZ :: SNat 'Z
    SS :: SNat n -> SNat ('S n)

deriving instance Show (SNat n)

-- | "Demote" a singleton-typed natural number to an ordinary 'Nat'.
fromSNat :: SNat n -> Nat
fromSNat SZ = Z
fromSNat (SS n) = S (fromSNat n)

-- | A decidable proposition.
data Dec a = Yes a | No (a -> Void)

-- | Propositional equality of natural numbers.
eqSNat :: SNat a -> SNat b -> Dec (a :~: b)
eqSNat  SZ     SZ    = Yes Refl
eqSNat  SZ    (SS _) = No (\case {})
eqSNat (SS _)  SZ    = No (\case {})
eqSNat (SS a) (SS b) = case eqSNat a b of
    No  f    -> No (\case Refl -> f Refl)
    Yes Refl -> Yes Refl

-- | A length-indexed list (aka vector).
data Vect :: Nat -> Type -> Type where
    Nil   :: Vect 'Z a
    (:::) :: a -> Vect n a -> Vect ('S n) a

infixr 5 :::

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

-- | @Elem a v@ is the proposition that an element of type @a@
-- is contained in a vector of type @v@. To be useful, @a@ and @v@
-- need to refer to singleton types.
data Elem :: forall a n. a -> Vect n a -> Type where
    Here  :: Elem x (x '::: xs)
    There :: Elem x xs -> Elem x (y '::: xs)

deriving instance Show a => Show (Elem a v)

------------------------------------------------------------------------
-- From here on, to simplify things, only vectors of natural
-- numbers are considered.

-- | Singleton types for vectors of 'Nat's.
data SNatVect :: forall n. Nat -> Vect n Nat -> Type where
    SNatNil  :: SNatVect 'Z 'Nil
    SNatCons :: SNat a -> SNatVect n v -> SNatVect ('S n) (a '::: v)

deriving instance Show (SNatVect n v)

-- | "Demote" a singleton-typed vector of 'SNat's to an
-- ordinary vector of 'Nat's.
fromSNatVect :: SNatVect n v -> Vect n Nat
fromSNatVect SNatNil = Nil
fromSNatVect (SNatCons a v) = fromSNat a ::: fromSNatVect v

-- | Decide whether a value is in a vector.
isElem :: SNat a -> SNatVect n v -> Dec (Elem a v)
isElem _  SNatNil        = No (\case {})
isElem a (SNatCons b as) = case eqSNat a b of
    Yes Refl   -> Yes Here
    No notHere -> case isElem a as of
        Yes there   -> Yes (There there)
        No notThere -> No $ \case
            Here        -> notHere Refl
            There there -> notThere there

type family RemoveElem (a :: Nat) (v :: Vect ('S n) Nat) :: Vect n Nat where
    RemoveElem a (a '::: as) = as
    RemoveElem a (b '::: as) = b '::: RemoveElem a as

-- | Remove a (singleton-typed) element from a (non-empty, singleton-typed)
-- vector, given a proof that the element is in the vector.
removeElem :: forall (a :: Nat) (v :: Vect ('S n) Nat)
    . SNat a
    -> Elem a v
    -> SNatVect ('S n) v
    -> SNatVect n (RemoveElem a v)
removeElem x prf (SNatCons y ys) = case prf of
    Here        -> ys
    There later -> case ys of
        SNatNil    -> case later of {}
        SNatCons{} -> SNatCons y (removeElem x later ys)
            -- ^ Could not deduce:
            --            RemoveElem a (y '::: (a2 '::: v2))
            --          ~ (y '::: RemoveElem a (a2 '::: v2))

顯然，類型系統需要確信值x和y的類型在代碼的那個分支中不可能相等，因此可以明確地使用類型族的第二個等式來根據需要減少返回類型。 我不知道該怎么做。 天真地，我想構造器There ，因此模式匹配在There later攜帶/揭示GHC類型不等式的證明。

以下是一個明顯冗余和部分的解決方案，它只是演示了GHC對遞歸調用進行類型檢查所需的類型不等式：

        SNatCons{} -> case (x, y) of
            (SZ, SS _) -> SNatCons y (removeElem x later ys)
            (SS _, SZ) -> SNatCons y (removeElem x later ys)

現在，例如，這有效：

λ> let vec = SNatCons SZ (SNatCons (SS SZ) (SNatCons SZ SNatNil))
λ> :t vec
vec
  :: SNatVect ('S ('S ('S 'Z))) ('Z '::: ('S 'Z '::: ('Z '::: 'Nil)))
λ> let Yes prf = isElem (SS SZ) vec
λ> :t prf
prf :: Elem ('S 'Z) ('Z '::: ('S 'Z '::: ('Z '::: 'Nil)))
λ> let vec' = removeElem (SS SZ) prf vec
λ> :t vec'
vec' :: SNatVect ('S ('S 'Z)) ('Z '::: ('Z '::: 'Nil))
λ> fromSNatVect vec'
Z ::: (Z ::: Nil)

解析度

正如在@ chi的評論中暗示並在HTNW的答案中詳細闡述的那樣 ，我試圖通過使用上述類型簽名和類型族編寫removeElem來解決錯誤的問題，如果我能夠做到，那么結果程序就會生病了類型。

以下是我根據HTNW的答案所做的更正（您可能需要在繼續閱讀之前閱讀）。

第一個錯誤或不必要的並發症是在SNatVect類型中重復向量的長度。 我認為有必要寫一些fromSNatVect ，但它當然不是：

data SNatVect (v :: Vect n Nat) :: Type where
    SNatNil  :: SNatVect 'Nil
    SNatCons :: SNat a -> SNatVect v -> SNatVect (a '::: v)

deriving instance Show (SNatVect v)

fromSNatVect :: forall (v :: Vect n Nat). SNatVect v -> Vect n Nat
-- implementation unchanged

現在有兩種方法可以編寫removeElem 。 第一個采用Elem ，一個SNatVect並返回一個Vect ：

removeElem :: forall (a :: Nat) (n :: Nat) (v :: Vect ('S n) Nat)
    . Elem a v
    -> SNatVect v
    -> Vect n Nat
removeElem prf (SNatCons y ys) = case prf of
    Here        -> fromSNatVect ys
    There later -> case ys of
        SNatNil    -> case later of {}
        SNatCons{} -> fromSNat y ::: removeElem later ys

第二個采用SElem ，一個SNatVect並使用一個鏡像值級功能的RemoveElem類型系列返回一個SNatVect ：

data SElem (e :: Elem a (v :: Vect n k)) where
    SHere  :: forall x xs. SElem ('Here :: Elem x (x '::: xs))
    SThere :: forall x y xs (e :: Elem x xs). SElem e -> SElem ('There e :: Elem x (y '::: xs))

type family RemoveElem (xs :: Vect ('S n) a) (e :: Elem x xs) :: Vect n a where
    RemoveElem (x '::: xs) 'Here = xs
    RemoveElem (x '::: xs) ('There later) = x '::: RemoveElem xs later

sRemoveElem :: forall (xs :: Vect ('S n) Nat) (e :: Elem x xs)
    . SElem e
    -> SNatVect xs
    -> SNatVect (RemoveElem xs e)
sRemoveElem prf (SNatCons y ys) = case prf of
    SHere        -> ys
    SThere later -> case ys of
        SNatNil    -> case later of {}
        SNatCons{} -> SNatCons y (sRemoveElem later ys)

有趣的是，兩個版本都不會將元素作為單獨的參數傳遞，因為該信息包含在Elem / SElem值中。 value參數也可以從該函數的Idris版本中刪除，但是removeElem_auto變體可能有點令人困惑，因為它只會將向量作為顯式參數，如果隱式prf則刪除向量的第一個元素參數未明確用於不同的證明。

Answer 1

考慮[1, 2, 1] 。 RemoveElem 1 [1, 2, 1]是[2, 1] 。 現在，調用removeElem 1 (There $ There $ Here) ([1, 2, 1] :: SNatVect 3 [1, 2, 1]) :: SNatVect 2 [2, 1] ，應該編譯。 這是錯的。 Elem參數說要刪除第三個元素，它會給出[1, 2] ，但類型簽名說它必須是[2, 1] 。

首先， SNatVect有點破碎。 它有兩個Nat論點：

data SNatVect :: forall n. Nat -> Vect n a -> Type where ...

第一個是n ，第二個是未命名的Nat 。 通過SNatVect的結構，它們總是相等的。 它允許SNatVect加倍作為相等證明，但它可能不是那樣的意圖。 你可能意味着

data SNatVect (n :: Nat) :: Vect n Nat -> Type where ...

使用普通->語法無法在源Haskell中編寫此簽名。 但是，當GHC打印此類型時，您有時會得到

SNatVect :: forall (n :: Nat) -> Vect n Nat -> Type

但這是多余的。 您可以將Nat作為隱式forall參數，並從Vect的類型推斷：

data SNatVect (xs :: Vect n Nat) where
  SNatNil  :: SNatVect 'Nil
  SNatCons :: SNat x -> SNatVect xs -> SNatVect (x '::: xs)

這給了

SNatVect :: forall (n :: Nat). Vect n Nat -> Type

第二，嘗試寫作

removeElem :: forall (n :: Nat) (x :: Nat) (xs :: Vect (S n) Nat).
              Elem x xs -> SNatVect xs -> Vect n Nat

注意SNat參數是如何消失的，以及返回類型是如何簡單的Vect 。 SNat論證使得這個類型“太大了”，所以當函數沒有意義時，你會陷入困境。 SNatVect返回類型意味着您正在跳過步驟。 粗略地說，每個函數都有三種形式：基本形式， f :: a -> b -> c ; 類型級別1， type family F (x :: a) (y :: b) :: c ; 和從屬的， f :: forall (x :: a) (y :: b). Sing x -> Sing y -> Sing (F xy) f :: forall (x :: a) (y :: b). Sing x -> Sing y -> Sing (F xy) 。 每個都以“相同”的方式實現，但是試圖在不實現其前身的情況下實現它是一種讓人感到困惑的可靠方法。

現在，你可以提升一點：

data SElem (e :: Elem x (xs :: Vect n k)) where
  SHere :: forall x xs. SElem ('Here :: Elem x (x '::: xs))
  SThere :: forall x y xs (e :: Elem x xs). SElem e -> SElem ('There e :: Elem x (y '::: xs))

type family RemoveElem (xs :: Vect (S n) a) (e :: Elem x xs) :: Vect n a

記下removeElem和RemoveElem類型之間的關系。 重新排序參數是因為e的類型取決於xs ，因此需要相應地進行排序。 或者： xs參數從forall -and-implicitly-given提升為顯式給定，然后Sing xs參數被添加，因為它不包含任何信息，因為它是一個單例。

最后，你可以編寫這個函數：

sRemoveElem :: forall (xs :: Vect (S n) Nat) (e :: Elem x xs).
               SElem e -> SNatVect xs -> SNatVect (RemoveElem xs e)