Ответ 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) [])

rotate определяется в терминах grotate по той же причине reverse определяется в терминах foldl ( или enumerate в терминах genumerate): потому что Vec A (suc n + m) не является определяющим Vec A (n + suc m), а (B ∘ suc) m - это определение B (suc m).

exec имеет ту же реализацию, что и вы (по модулю тех subst s), но я не уверен в типах: нормально ли, что r должно быть непустым?

Ответ 2

другой ответ является супер-умным (пожалуйста, найдите минутку, чтобы его продвинуть), но, как кто-то, кто не знаком с 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, который очень похож на список, за исключением того, что он кодирует свою длину в типе phantom 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 для typecheck). Начнем с создания типа SNat (одноэлементного типа, соответствующего Nat). SNat отражает его значение в переменной типа phantom.

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, семейство типов :+ (эквивалентно my +), а одноэлементный тип SNat (с конструкторами SZ и SS, эквивалентными моим SZero и SSucc) все в одном.