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

时间:2018-04-07 15:49:32

标签: list haskell dependent-type singleton-type

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

Vect的{​​{1}}类型和签名如下:

replicateVec

如何编写此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. 函数?

1 个答案:

答案 0 :(得分:6)

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

KnownNat约束对应于运行时的整数值,因此在虚拟字典上使用Dict构造KnownNat unsafeCoerce是不正确的(在{中{1}})。特别是,在cmpNatGT0KnownNatLaw中使用此整数来检查整数是否为replicateVec

类型等式0的特殊之处在于它们没有有意义的运行时表示,因此(~) - 启用等式,如果它们是正确的,技术上不会导致错误的运行时行为,因为强制字典永远不会已使用,但从axiom强制转换为Dict ()肯定不支持使用Dict (a ~ b)。在平等之间进行协调可能更可靠。

要解决unsafeCoerce约束,约束会在内部将类型级操作与其术语级别对应关联,请参阅magic in Data.Constraints.Nat并重新构建基于KnownNat字典的字典关于GHC如何表示类型类的隐含知识。

无论如何,对于像KnownNat这样的归纳式构造,我们可以避免replicate,并使用反映KnownNat的归纳性质的不同单一类型。

Nat

这个单身实际上很烦人,因为data Sing n where Z :: Sing 0 S :: Sing n -> Sing (1 + n) 不是单射的。 ((+)在技术上是单射的,但GHC无法说明这一点。)实际归纳定义\x -> (1 + x)会更容易,但是,如果有正确的约束条件,我们可以做到一些事情。例如,单例反射(从类型级Nat映射到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 原因很简单,因为replicateList有很多共同的结构。

Sing

我们现在可以按以下方式应用replicate :: Sing n -> a -> List n a replicate Z _ = Nil replicate (S n) a = Cons a (replicate n a)

replicate