在 GHC 中拆分类型级列表

Question

我很难让 GHC 相信某些属性列表操作是正确的。在我提供代码之前继续，我将举一个我感兴趣的属性的简短示例。假设我们有一些类型级别的列表 xs:

xs ~ '[ 'A, 'B, 'C, 'D, 'E, 'F ]

然后我们删除了一些元素，也取了相同数量的元素元素：

Drop 2 xs ~ '[ 'C, 'D, 'E, 'F ]
TakeReverse 2 xs ~ '[ 'B, 'A ]

很明显，如果我应用 Drop 和 TakeReverse 使用 2 的后继者，然后我可以弹出 'C Drop 2 xs 并将其放在 TakeReverse 2 xs 之上：

Drop 3 xs ~ '[ 'D, 'E, 'F ]
TakeReverse 3 xs ~ '[ 'C, 'B, 'A ]

下面的代码有一个名为 moveRight 的函数，它试图使用这个属性。我已经将我的实际代码缩减为一个有点小的例子说明了问题并且没有依赖性。

{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE PolyKinds            #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE UndecidableInstances #-}
module Minimal where

import Data.Type.Equality

data Nat = Z | S Nat

data Natty (n :: Nat) where
  Zy :: Natty 'Z
  Sy :: Natty n -> Natty ('S n)

data HRec (vs :: [*]) where
  HRecNil  :: HRec '[]
  HRecCons :: x -> HRec xs -> HRec (x ': xs)

data HProxy (vs :: [k]) where
  HProxyNil  :: HProxy '[]
  HProxyCons :: HProxy xs -> HProxy (x ': xs)

data Parts n rs = Parts
  { partLeft  :: HRec (Drop n rs) 
  , partRight :: HRec (TakeReverse n rs)
  , partNatty :: Natty n
  , partProxy :: HProxy rs
  }

-- The type families Drop, Take, and TakeReverse
-- are all partial.
type family Drop (n :: Nat) (xs :: [k]) :: [k] where
  Drop 'Z xs = xs
  Drop ('S n) (x ': xs) = Drop n xs

type family Take (n :: Nat) (xs :: [k]) :: [k] where
  Take 'Z xs = '[]
  Take ('S n) (x ': xs) = x ': Take n xs

type family TakeReverse (n :: Nat) (xs :: [k]) :: [k] where
  TakeReverse n xs = TakeReverseHelper '[] n xs

type family TakeReverseHelper (ys :: [k]) (n :: Nat) (xs :: [k]) :: [k] where
  TakeReverseHelper res 'Z xs = res
  TakeReverseHelper res ('S n) (x ': xs) = TakeReverseHelper (x ': res) n xs

moveRight :: Parts n rs -> Parts (S n) rs
moveRight (Parts pleft@(HRecCons pleftHead _) pright natty proxy) = 
  case dropOneProof natty proxy of
    Refl -> Parts (dropOne pleft) (HRecCons pleftHead pright) (Sy natty) proxy

dropOneProof :: Natty n -> HProxy rs -> (Drop ('S n) rs :~: Drop ('S 'Z) (Drop n rs))
dropOneProof Zy _ = Refl
dropOneProof (Sy n) (HProxyCons rs) = case dropOneProof n rs of
  Refl -> Refl

dropOne :: HRec rs -> HRec (Drop ('S 'Z) rs)
dropOne (HRecCons _ rs) = rs

由于 moveRight，此代码无法编译。基本上，我能够证明从左侧删除一个附加元素可以得到它正确的类型，但我无法证明将此元素添加到右侧侧面使它具有正确的类型。

我真的愿意接受任何改变。我可以改变类型系列，介绍额外的证人等，只要 moveRight 成为可以写。

如果我需要进一步说明我正在尝试做什么，请告诉我。谢谢。

Answer 1

您的表述存在问题，您试图使拆分的位置明确，但不强制执行位置索引的有效性。

目前moveRight :: Parts n rs -> Parts (S n) rs无法实现，因为如果n越界，Take和其他类型的家族应用程序无法减少，因此没有价值可以在结果中给出。

有很多方法可以解决这个问题。最简单的就是让context左右两部分的类型显式：

type HZipper xs ys = (HRec xs, HRec ys)

moveRight :: HZipper xs (y ': ys) -> HZipper (y ': xs) ys
moveRight'(xs, HCons y ys) = (HCons y xs, ys)

这实际上与您的原始 Parts 一样具有很强的代表性。前提是我们在 n 索引上强制执行边界。那是因为这两种类型都表示整个列表和拆分的确切位置。从 HZipper xs ys 开始，原始类型列表可以计算为 Reverse xs ++ ys 以及适当的 ++ 和 Reverse 类型族。这有时不太方便，但从好的方面来说 HZipper 内部结构要简单得多。

或者，您可以隐藏拆分的位置。无论如何，这需要为 moveRight:

编写证明

import Data.Type.Equality
import Data.Proxy

data HRec vs where
  HNil  :: HRec '[]
  HCons :: x -> HRec xs -> HRec (x ': xs)

type family (++) xs ys where
  '[] ++ ys = ys
  (x ': xs) ++ ys = x ': (xs ++ ys)

type family Reverse xs where
  Reverse '[] = '[]
  Reverse (x ': xs) = Reverse xs ++ '[x]

data HZipper xs where
  HZipper :: HRec ys -> HRec zs -> HZipper (Reverse ys ++ zs)

hcat :: HRec xs -> HRec ys -> HRec (xs ++ ys)
hcat HNil         ys = ys
hcat (HCons x xs) ys = HCons x (hcat xs ys)

hreverse :: HRec xs -> HRec (Reverse xs)
hreverse HNil         = HNil
hreverse (HCons x xs) = hreverse xs `hcat` (HCons x HNil)

catAssoc :: HRec xs -> Proxy ys -> Proxy zs -> (xs ++ (ys ++ zs)) :~: ((xs ++ ys) ++ zs)
catAssoc HNil xs ys = Refl
catAssoc (HCons x xs) ys zs = case catAssoc xs ys zs of
  Refl -> Refl

moveRight :: HZipper xs -> HZipper xs
moveRight (HZipper ls HNil) = HZipper ls HNil
moveRight (HZipper ls (HCons (x :: x) (xs :: HRec xs))) =
  case catAssoc (hreverse ls) (Proxy :: Proxy '[x]) (Proxy :: Proxy xs) of
    Refl -> HZipper (HCons x ls) xs

还有第三种可能性，即在原始 Parts 内添加存在性边界检查，或者具有 moveRight :: InBounds (S n) rs -> Parts n rs -> Parts (S n) rs，其中 InBounds 是入站性证明。或者我们可以让 InBounds (S n) rs => ... 和 InBounds 类型族返回 class 约束。不过，这种方法也需要大量的校对工作。

在 GHC 中拆分类型级列表

Splitting a type-level list in GHC

haskell

ghc