使用 GHC.TypeLits 和单例的长度索引列表的复制函数

Question

我正在尝试使用 GHC.TypeLits, singletons, and constraints 中的机制为长度索引列表编写复制函数。

replicateVec 的 Vect 类型和签名如下：

data Vect :: Nat -> Type -> Type where
  VNil  :: Vect 0 a
  VCons :: a -> Vect (n - 1) a -> Vect n a

replicateVec :: forall n a. SNat n -> a -> Vect n a

如何编写这个 replicateVec 函数？

我有一个可以编译和类型检查的 replicateVec 版本，但是当运行时它似乎进入了无限循环。代码如下。我添加了评论，试图让我使用的定律和证明更容易理解：

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeInType #-}

module VectStuff where

import Data.Constraint ((:-)(Sub), Dict(Dict))
import Data.Kind (Type)
import Data.Singletons.Decide (Decision(Disproved, Proved), Refuted, (:~:)(Refl), (%~))
import Data.Singletons.Prelude (PNum((-)), sing)
import Data.Singletons.TypeLits (SNat, Sing(SNat))
import GHC.TypeLits (CmpNat, KnownNat, Nat)
import Unsafe.Coerce (unsafeCoerce)

data Vect :: Nat -> Type -> Type where
  VNil  :: Vect 0 a
  VCons :: forall n a. a -> Vect (n - 1) a -> Vect n a

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

-- This is used to define the two laws below.
axiom :: Dict a
axiom = unsafeCoerce (Dict :: Dict ())

-- | This law says that if we know that @n@ is not 0, then it MUST be
-- greater than 0.
nGT0CmpNatLaw :: (Refuted (n :~: 0)) -> Dict (CmpNat n 0 ~ 'GT)
nGT0CmpNatLaw _ = axiom

-- | This law says that if we know that @n@ is greater than 0, then we know
-- that @n - 1@ is also a 'KnownNat'.
cmpNatGT0KnownNatLaw :: forall n. (CmpNat n 0 ~ 'GT) :- KnownNat (n - 1)
cmpNatGT0KnownNatLaw = Sub axiom

-- | This is a proof that if we have an @n@ that is greater than 0, then
-- we can get an @'SNat' (n - 1)@
sNatMinus1 :: forall n. (CmpNat n 0 ~ 'GT) => SNat n -> SNat (n - 1)
sNatMinus1 SNat =
  case cmpNatGT0KnownNatLaw @n of
    Sub Dict -> SNat

-- | This is basically a combination of the other proofs.  If we have a
-- @SNat n@ and we know that it is not 0, then we can get an @SNat (n -1)@
-- that we know is a 'KnownNat'.
nGT0Proof ::
     forall n.
     Refuted (n :~: 0)
  -> SNat n
  -> (SNat (n - 1), Dict (KnownNat (n - 1)))
nGT0Proof f snat =
  case nGT0CmpNatLaw f of
    Dict ->
      case cmpNatGT0KnownNatLaw @n of
        Sub d -> (sNatMinus1 snat, d)

replicateVec :: forall n a. SNat n -> a -> Vect n a
replicateVec snat a =
  -- First we check if @snat@ is 0.
  case snat %~ (sing @_ @0) of
    -- If we get a proof that @snat@ is 0, then we just return 'VNil'.
    Proved Refl -> VNil
    -- If we get a proof that @snat@ is not 0, then we use 'nGT0Proof'
    -- to get @n - 1@, and pass that to 'replicateVec' recursively.
    Disproved f ->
      case nGT0Proof f snat of
        (snat', Dict) -> VCons a $ replicateVec snat' a

但是，由于某些原因，当我尝试运行时，这个 replicateVec 函数进入了无限循环：

> replicateVec (sing @_ @3) "4"
["4","4","4","4","4","4","4","4","4","4","4","4",^CInterrupted.

为什么会这样？如何正确编写 replicateVec 函数？

Answer 1

axiom :: Dict a 非常不安全，因为 Dict a 的运行时表示取决于约束 a（对应于 Dict 构造函数捕获的字典).

A KnownNat 约束对应于运行时的整数值，因此在虚拟字典上使用 unsafeCoerce 构造 KnownNat 的 Dict 是不正确的（在 cmpNatGT0KnownNatLaw）。特别地，这个整数在replicateVec中使用来检查整数是否为0。

类型等式 (~) 的特殊之处在于它们没有有意义的运行时表示，因此 axiom-atizing 等式，如果它们是正确的，从技术上讲不会导致不良的运行时行为，因为强制字典从未使用过，但是从 Dict () 强制转换为 Dict (a ~ b) 当然不支持使用 unsafeCoerce。平等之间的强制可能更可靠。

为了解决 KnownNat 约束，constraints 在内部将 type-level 操作与其 term-level 对应项相关联，请参阅 magic in Data.Constraints.Nat 和基于关于 GHC 如何表示类型类.

的隐含知识重建 KnownNat 字典

无论如何，对于像 replicate 这样的归纳结构，我们可以避免 KnownNat，并使用反映 Nat.

归纳性质的不同单例类型

data Sing n where
  Z :: Sing 0
  S :: Sing n -> Sing (1 + n)

这个单例使用起来很烦人，因为(+)不是单射的。（\x -> (1 + x) 技术上是单射的，但 GHC 不能说那么多。）实际上归纳定义的 Nat 会更容易，但仍然有正确的约束集，我们可以做一些事情.例如，单例反射（从 type-level n 映射到 Sing n 值：

class SingN n where
  singN :: Sing n

instance {-# OVERLAPPING #-} SingN 0 where
  singN = Z

instance (n ~ (1 + n'), n' ~ (n - 1), SingN n') => SingN n where
  singN = S (singN @n')

列表类型的结构应类似：

data List n a where
  Nil :: List 0 a
  Cons :: a -> List n a -> List (1 + n) a

以这种方式设置类型索引 n 而不是 Sing (n-1) -> Sing n 和 a -> List (n-1) a -> List n a 的原因是为了禁止一些愚蠢的值：

oops :: Sing 0
oops = S undefined

ouch :: List 0 ()
ouch = Cons () undefined

这将是一个问题，因为函数实际上需要处理那些没有意义的情况。

replicate 结果很容易实现，因为 List 和 Sing 有很多共同的结构。

replicate :: Sing n -> a -> List n a
replicate Z _ = Nil
replicate (S n) a = Cons a (replicate n a)

我们现在可以按如下方式申请replicate：

replicate (singN @3) "x"

Compilable gist

使用 GHC.TypeLits 和单例的长度索引列表的复制函数

replicate function for a length-indexed list using GHC.TypeLits and singletons

haskell

list

dependent-type

singleton-type