定义`exec`

Question

Okasaki描述了可以使用类型

在Haskell中实现的持久实时队列

data Queue a = forall x . Queue
  { front :: [a]
  , rear :: [a]
  , schedule :: [x]
  }

增量旋转保持不变

length schedule = length front - length rear

问题

我讨厌部分功能！我喜欢找到一种方法来表达类型中的结构不变量。通常的依赖向量似乎是一个可能的选择：

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中很好地完成这项工作？

Answer 1

这是我得到的：

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) [])

出于reverse is defined in terms of foldl（或enumerate in terms of genumerate）原因，rotate按grotate定义

Vec A (suc n + m)：因为Vec A (n + suc m)不是定义(B ∘ suc) m ，B (suc m)定义为exec。

subst具有与您提供的相同的实现（以r为模），但我不确定类型：<?php include"contact.html"; ?>是否必须为非-empty？

Answer 2

other answer非常聪明（请花一点时间来提升它），但作为不熟悉Agda的人，如何在Haskell中实现这一点对我来说并不明显。这是一个完整的Haskell版本。我们需要一大堆扩展，以及Data.Type.Equality（因为我们需要做一些有限数量的类型证明）。

{-# LANGUAGE GADTs, ScopedTypeVariables,RankNTypes,
             TypeInType, TypeFamilies, TypeOperators #-}

import Data.Type.Equality

定义`Nat`，`Vec`和`Queue`

接下来，我们定义通常的类型级自然数（这看起来只是一个常规的data定义，但是因为我们启用了TypeInType，所以当我们使用它时会自动提升它type）和一个类型函数（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的函数rotate :: Vec a n -> Vec a (S n + m) -> Vec a m -> Vec a (S n + m)，但是你很快就会遇到各种与证明相关的问题。相反，解决方案是定义稍微更通用的grotate，其中可以以递归方式定义，rotate是一种特殊情况。

Bump的目的是避免在Haskell中没有类型级别组合这样的事实。没有办法像(∘)那样编写运算符，(S ∘ S) x是S (S x)。解决方法是使用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 (:::)

我们需要明确的forall来明确哪些类型变量被捕获，哪些不是，以及表示更高级别的类型。

单身自然数`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和{{ 1}}相当于我的SS和SZero）。

总实时持久队列

更多详情

问题

2 个答案:

定义`Nat`，`Vec`和`Queue`

定义`rotate`

单身自然数`SNat`

定义`exec`

总实时持久队列

更多详情

问题

2 个答案:

定义Nat，Vec和Queue

定义rotate

单身自然数SNat

定义exec

定义`Nat`，`Vec`和`Queue`

定义`rotate`

单身自然数`SNat`

定义`exec`