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和其他类型系列应用程序无法减少，因此没有值可以在结果中给出。

有很多方法可以解决这个问题。最简单的方法是将上下文的左右部分中的类型显式化：

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类型系列返回类约束。这种方法也需要相当多的校对。

在GHC中拆分类型级别列表

1 个答案: