我正在尝试使用GHC.TypeLits,singletons和constraints中的机制为长度索引列表编写复制函数。
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.
函数?
答案 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
原因很简单,因为replicate
和List
有很多共同的结构。
Sing
我们现在可以按以下方式应用replicate :: Sing n -> a -> List n a
replicate Z _ = Nil
replicate (S n) a = Cons a (replicate n a)
:
replicate