解决方案

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's answer中所阐述的那样，我试图通过编写具有上述类型签名和类型族的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，SNatVect并返回RemoveElem：

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。根据{{1}}的结构，它们始终相等。它允许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；和相关的type family F (x :: a) (y :: b) :: c。每种都以“相同”的方式实现，但是尝试在不实现其前身的情况下实现一个是确保混乱的肯定方法。

现在，您可以将其抬高一点：

f :: forall (x :: a) (y :: b). Sing x -> Sing y -> Sing (F x y)

记下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参数被取消，因为它不包含任何信息，因为一个单例。

最后，您可以编写以下功能：

Sing xs

证明GHC存在类型不等式

解决方案

1 个答案: