实时持久队列总数
Total real-time persistent queues
Okasaki 描述了可以在 Haskell 中使用类型
实现的持久实时队列
data Queue a = forall x . Queue
{ front :: [a]
, rear :: [a]
, schedule :: [x]
}
增量旋转保持不变
length schedule = length front - length rear
更多详情
如果您熟悉所涉及的队列，可以跳过此部分。
旋转函数看起来像
rotate :: [a] -> [a] -> [a] -> [a]
rotate [] (y : _) a = y : a
rotate (x : xs) (y : ys) a =
x : rotate xs ys (y : a)
并且由智能构造函数调用
exec :: [a] -> [a] -> [x] -> Queue a
exec f r (_ : s) = Queue f r s
exec f r [] = Queue f' [] f' where
f' = rotate f r []
在每个队列操作之后。 length s = length f - length r + 1时总是调用智能构造函数，确保rotate中的模式匹配成功。
问题
我讨厌偏函数！我很想找到一种方法来表达类型中的结构不变性。通常的相关向量似乎是一个可能的选择：
data Nat = Z | S Nat
data Vec n a where
Nil :: Vec 'Z a
Cons :: a -> Vec n a -> Vec ('S n) a
然后（也许）
data Queue a = forall x rl sl . Queue
{ front :: Vec (sl :+ rl) a
, rear :: Vec rl a
, schedule :: Vec sl x
}
问题是我还没弄清楚如何兼顾这些类型。似乎极有可能需要 一些 数量的 unsafeCoerce 才能提高效率。但是，我还没有想出一种甚至可以模糊管理的方法。在 Haskell 中可以很好地做到这一点吗？
这是我得到的：
open import Function
open import Data.Nat.Base
open import Data.Vec
grotate : ∀ {n m} {A : Set}
-> (B : ℕ -> Set)
-> (∀ {n} -> A -> B n -> B (suc n))
-> Vec A n
-> Vec A (suc n + m)
-> B m
-> B (suc n + m)
grotate B cons [] (y ∷ ys) a = cons y a
grotate B cons (x ∷ xs) (y ∷ ys) a = grotate (B ∘ suc) cons xs ys (cons y a)
rotate : ∀ {n m} {A : Set} -> Vec A n -> Vec A (suc n + m) -> Vec A m -> Vec A (suc n + m)
rotate = grotate (Vec _) _∷_
record Queue (A : Set) : Set₁ where
constructor queue
field
{X} : Set
{n m} : ℕ
front : Vec A (n + m)
rear : Vec A m
schedule : Vec X n
open import Relation.Binary.PropositionalEquality
open import Data.Nat.Properties.Simple
exec : ∀ {m n A} -> Vec A (n + m) -> Vec A (suc m) -> Vec A n -> Queue A
exec {m} {suc n} f r (_ ∷ s) = queue (subst (Vec _) (sym (+-suc n m)) f) r s
exec {m} f r [] = queue (with-zero f') [] f' where
with-zero = subst (Vec _ ∘ suc) (sym (+-right-identity m))
without-zero = subst (Vec _ ∘ suc) (+-right-identity m)
f' = without-zero (rotate f (with-zero r) [])
rotate 是根据 grotate 定义的，原因与 reverse is defined in terms of foldl (or 相同）：因为 Vec A (suc n + m) 在定义上不是 Vec A (n + suc m)，而 (B ∘ suc) m 在定义上是 B (suc m).
exec 与您提供的实现相同（模那些 substs），但我不确定类型：r 必须是非-空？
非常聪明（请花点时间给它点个赞），但作为不熟悉 Agda 的人，Haskell 中的实现方式对我来说并不明显。这是完整的 Haskell 版本。我们需要大量的扩展，以及 Data.Type.Equality（因为我们需要做一些有限的类型证明）。
{-# LANGUAGE GADTs, ScopedTypeVariables,RankNTypes,
TypeInType, TypeFamilies, TypeOperators #-}
import Data.Type.Equality
定义 Nat、Vec 和 Queue
接下来，我们定义通常的类型级自然数（这看起来只是一个常规的 data 定义，但是因为我们启用了 TypeInType，所以当我们使用它时它会自动提升在一个类型中）和一个类型函数（a type family）用于加法。请注意，虽然有多种定义 + 的方法，但我们在这里的选择将影响后面的内容。我们还将定义通常的 Vec，它非常像一个列表，只是它在幻像类型 n 中编码其长度。这样，我们就可以继续定义队列的类型了。
data Nat = Z | S Nat
type family n + m where
Z + m = m
S n + m = S (n + m)
data Vec a n where
Nil :: Vec a Z
(:::) :: a -> Vec a n -> Vec a (S n)
data Queue a where
Queue :: { front :: Vec a (n + m)
, rear :: Vec a m
, schedule :: Vec x n } -> Queue a
定义rotate
现在，事情开始变得更棘手了。我们想定义一个类型为 rotate :: Vec a n -> Vec a (S n + m) -> Vec a m -> Vec a (S n + m) 的函数 rotate，但是您很快 运行 陷入各种与证明相关的问题，只需递归地定义它。解决方案是定义一个稍微更通用的grotate，可以递归定义，而rotate是一个特例。
Bump 的要点是规避 Haskell 中没有类型级别组合的事实。没有办法像 (∘) 这样的运算符写出 (S ∘ S) x 是 S (S x) 的东西。解决方法是连续 wrap/unwrap 和 Bump/lower.
newtype Bump p n = Bump { lower :: p (S n) }
grotate :: forall p n m a.
(forall n. a -> p n -> p (S n)) ->
Vec a n ->
Vec a (S n + m) ->
p m ->
p (S n + m)
grotate cons Nil (y ::: _) zs = cons y zs
grotate cons (x ::: xs) (y ::: ys) zs = lower (grotate consS xs ys (Bump (cons y zs)))
where
consS :: forall n. a -> Bump p n -> Bump p (S n)
consS = \a -> Bump . cons a . lower
rotate :: Vec a n -> Vec a (S n + m) -> Vec a m -> Vec a (S n + m)
rotate = grotate (:::)
我们在这里需要明确的 foralls 来非常清楚哪些类型变量被捕获，哪些不被捕获，以及表示更高级别的类型。
单一自然数SNat
在我们继续 exec 之前，我们建立了一些机制来证明一些类型级的算术声明（我们需要 exec 来进行类型检查）。我们首先创建一个 SNat 类型（这是一个对应于 Nat 的单例类型）。 SNat 将其值反映在幻像类型变量中。
data SNat n where
SZero :: SNat Z
SSucc :: SNat n -> SNat (S n)
然后我们可以创建一些有用的函数来处理 SNat。
sub1 :: SNat (S n) -> SNat n
sub1 (SSucc x) = x
size :: Vec a n -> SNat n
size Nil = SZero
size (_ ::: xs) = SSucc (size xs)
最后，我们准备证明一些算术，即n + S m ~ S (n + m)和n + Z ~ n。
plusSucc :: (SNat n) -> (SNat m) -> (n + S m) :~: S (n + m)
plusSucc SZero _ = Refl
plusSucc (SSucc n) m = gcastWith (plusSucc n m) Refl
plusZero :: SNat n -> (n + Z) :~: n
plusZero SZero = Refl
plusZero (SSucc n) = gcastWith (plusZero n) Refl
定义exec
现在我们有 rotate，我们可以定义 exec。这个定义看起来几乎与问题中的定义相同（带有列表），除了用 gcastWith <some-proof>.
注释
exec :: Vec a (n + m) -> Vec a (S m) -> Vec a n -> Queue a
exec f r (_ ::: s) = gcastWith (plusSucc (size s) (sub1 (size r))) $ Queue f r s
exec f r Nil = gcastWith (plusZero (sub1 (size r))) $
let f' = rotate f r Nil in (Queue f' Nil f')
可能值得注意的是，我们可以使用 singletons 免费获得一些东西。启用正确的扩展后，以下代码更具可读性
import Data.Singletons.TH
singletons [d|
data Nat = Z | S Nat
(+) :: Nat -> Nat -> Nat
Z + n = n
S m + n = S (m + n)
|]
定义，Nat，类型族:+（相当于我的+），以及单例类型SNat（带有构造函数SZ和SS 相当于我的 SZero 和 SSucc) 合二为一。
Okasaki 描述了可以在 Haskell 中使用类型
实现的持久实时队列data Queue a = forall x . Queue
{ front :: [a]
, rear :: [a]
, schedule :: [x]
}
增量旋转保持不变
length schedule = length front - length rear
更多详情
如果您熟悉所涉及的队列，可以跳过此部分。
旋转函数看起来像
rotate :: [a] -> [a] -> [a] -> [a]
rotate [] (y : _) a = y : a
rotate (x : xs) (y : ys) a =
x : rotate xs ys (y : a)
并且由智能构造函数调用
exec :: [a] -> [a] -> [x] -> Queue a
exec f r (_ : s) = Queue f r s
exec f r [] = Queue f' [] f' where
f' = rotate f r []
在每个队列操作之后。 length s = length f - length r + 1时总是调用智能构造函数，确保rotate中的模式匹配成功。
问题
我讨厌偏函数！我很想找到一种方法来表达类型中的结构不变性。通常的相关向量似乎是一个可能的选择：
data Nat = Z | S Nat
data Vec n a where
Nil :: Vec 'Z a
Cons :: a -> Vec n a -> Vec ('S n) a
然后（也许）
data Queue a = forall x rl sl . Queue
{ front :: Vec (sl :+ rl) a
, rear :: Vec rl a
, schedule :: Vec sl x
}
问题是我还没弄清楚如何兼顾这些类型。似乎极有可能需要 一些 数量的 unsafeCoerce 才能提高效率。但是，我还没有想出一种甚至可以模糊管理的方法。在 Haskell 中可以很好地做到这一点吗？
这是我得到的：
open import Function
open import Data.Nat.Base
open import Data.Vec
grotate : ∀ {n m} {A : Set}
-> (B : ℕ -> Set)
-> (∀ {n} -> A -> B n -> B (suc n))
-> Vec A n
-> Vec A (suc n + m)
-> B m
-> B (suc n + m)
grotate B cons [] (y ∷ ys) a = cons y a
grotate B cons (x ∷ xs) (y ∷ ys) a = grotate (B ∘ suc) cons xs ys (cons y a)
rotate : ∀ {n m} {A : Set} -> Vec A n -> Vec A (suc n + m) -> Vec A m -> Vec A (suc n + m)
rotate = grotate (Vec _) _∷_
record Queue (A : Set) : Set₁ where
constructor queue
field
{X} : Set
{n m} : ℕ
front : Vec A (n + m)
rear : Vec A m
schedule : Vec X n
open import Relation.Binary.PropositionalEquality
open import Data.Nat.Properties.Simple
exec : ∀ {m n A} -> Vec A (n + m) -> Vec A (suc m) -> Vec A n -> Queue A
exec {m} {suc n} f r (_ ∷ s) = queue (subst (Vec _) (sym (+-suc n m)) f) r s
exec {m} f r [] = queue (with-zero f') [] f' where
with-zero = subst (Vec _ ∘ suc) (sym (+-right-identity m))
without-zero = subst (Vec _ ∘ suc) (+-right-identity m)
f' = without-zero (rotate f (with-zero r) [])
rotate 是根据 grotate 定义的，原因与 reverse is defined in terms of foldl (or Vec A (suc n + m) 在定义上不是 Vec A (n + suc m)，而 (B ∘ suc) m 在定义上是 B (suc m).
exec 与您提供的实现相同（模那些 substs），但我不确定类型：r 必须是非-空？
Data.Type.Equality（因为我们需要做一些有限的类型证明）。
{-# LANGUAGE GADTs, ScopedTypeVariables,RankNTypes,
TypeInType, TypeFamilies, TypeOperators #-}
import Data.Type.Equality
定义 Nat、Vec 和 Queue
接下来，我们定义通常的类型级自然数（这看起来只是一个常规的 data 定义，但是因为我们启用了 TypeInType，所以当我们使用它时它会自动提升在一个类型中）和一个类型函数（a type family）用于加法。请注意，虽然有多种定义 + 的方法，但我们在这里的选择将影响后面的内容。我们还将定义通常的 Vec，它非常像一个列表，只是它在幻像类型 n 中编码其长度。这样，我们就可以继续定义队列的类型了。
data Nat = Z | S Nat
type family n + m where
Z + m = m
S n + m = S (n + m)
data Vec a n where
Nil :: Vec a Z
(:::) :: a -> Vec a n -> Vec a (S n)
data Queue a where
Queue :: { front :: Vec a (n + m)
, rear :: Vec a m
, schedule :: Vec x n } -> Queue a
定义rotate
现在，事情开始变得更棘手了。我们想定义一个类型为 rotate :: Vec a n -> Vec a (S n + m) -> Vec a m -> Vec a (S n + m) 的函数 rotate，但是您很快 运行 陷入各种与证明相关的问题，只需递归地定义它。解决方案是定义一个稍微更通用的grotate，可以递归定义，而rotate是一个特例。
Bump 的要点是规避 Haskell 中没有类型级别组合的事实。没有办法像 (∘) 这样的运算符写出 (S ∘ S) x 是 S (S x) 的东西。解决方法是连续 wrap/unwrap 和 Bump/lower.
newtype Bump p n = Bump { lower :: p (S n) }
grotate :: forall p n m a.
(forall n. a -> p n -> p (S n)) ->
Vec a n ->
Vec a (S n + m) ->
p m ->
p (S n + m)
grotate cons Nil (y ::: _) zs = cons y zs
grotate cons (x ::: xs) (y ::: ys) zs = lower (grotate consS xs ys (Bump (cons y zs)))
where
consS :: forall n. a -> Bump p n -> Bump p (S n)
consS = \a -> Bump . cons a . lower
rotate :: Vec a n -> Vec a (S n + m) -> Vec a m -> Vec a (S n + m)
rotate = grotate (:::)
我们在这里需要明确的 foralls 来非常清楚哪些类型变量被捕获，哪些不被捕获，以及表示更高级别的类型。
单一自然数SNat
在我们继续 exec 之前，我们建立了一些机制来证明一些类型级的算术声明（我们需要 exec 来进行类型检查）。我们首先创建一个 SNat 类型（这是一个对应于 Nat 的单例类型）。 SNat 将其值反映在幻像类型变量中。
data SNat n where
SZero :: SNat Z
SSucc :: SNat n -> SNat (S n)
然后我们可以创建一些有用的函数来处理 SNat。
sub1 :: SNat (S n) -> SNat n
sub1 (SSucc x) = x
size :: Vec a n -> SNat n
size Nil = SZero
size (_ ::: xs) = SSucc (size xs)
最后，我们准备证明一些算术，即n + S m ~ S (n + m)和n + Z ~ n。
plusSucc :: (SNat n) -> (SNat m) -> (n + S m) :~: S (n + m)
plusSucc SZero _ = Refl
plusSucc (SSucc n) m = gcastWith (plusSucc n m) Refl
plusZero :: SNat n -> (n + Z) :~: n
plusZero SZero = Refl
plusZero (SSucc n) = gcastWith (plusZero n) Refl
定义exec
现在我们有 rotate，我们可以定义 exec。这个定义看起来几乎与问题中的定义相同（带有列表），除了用 gcastWith <some-proof>.
exec :: Vec a (n + m) -> Vec a (S m) -> Vec a n -> Queue a
exec f r (_ ::: s) = gcastWith (plusSucc (size s) (sub1 (size r))) $ Queue f r s
exec f r Nil = gcastWith (plusZero (sub1 (size r))) $
let f' = rotate f r Nil in (Queue f' Nil f')
可能值得注意的是，我们可以使用 singletons 免费获得一些东西。启用正确的扩展后，以下代码更具可读性
import Data.Singletons.TH
singletons [d|
data Nat = Z | S Nat
(+) :: Nat -> Nat -> Nat
Z + n = n
S m + n = S (m + n)
|]
定义，Nat，类型族:+（相当于我的+），以及单例类型SNat（带有构造函数SZ和SS 相当于我的 SZero 和 SSucc) 合二为一。