Proving two-list queue in coq

Question

I'm trying to prove correctness of the queue implementation described here:

Inductive queue_type (A : Type) : Type := Queue : list A -> list A -> queue_type A.
Context {A : Type}.
Definition empty_queue : queue_type A := Queue nil nil.

Definition enqueue (queue : queue_type A) (elt : A) : queue_type A :=
  match queue with Queue front back => Queue front (elt :: back) end.

Definition dequeue (queue : queue_type A) : queue_type A * option A :=
  match queue with
  | Queue nil nil => (queue, None)
  | Queue (x :: xs) back => (Queue xs back, Some x)
  | Queue nil back =>
    let front := rev' back in
    match front with
    | (x :: xs) => (Queue xs nil, Some x)
    | nil => (Queue nil nil, None) (* Dead code *)
    end
  end.

Definition queue_to_list (* last elt in head *) (queue : queue_type A) : list A :=
    match queue with Queue front back => (back ++ rev front) end.

Definition queue_length (queue : queue_type A) : nat :=
    match queue with Queue front back => List.length front + List.length back end.

Fiddle here

One of the things I'd like to prove involves draining the queue, so I defined this function to do the computation:

Equations queue_dump_all (queue : queue_type A): list A :=
    queue_dump_all queue := worker queue nil
  where worker (queue': queue_type A) : list A -> list A by wf (queue_length queue') lt :=
        worker queue' acc := match (dequeue queue') as deq_res return (deq_res = (dequeue queue')) -> list A with 
                               | (queue'', Some elt) => fun pf => (worker queue'' (elt :: acc))
                               | _ => fun _=> acc
                               end _.

Reasoning with queue_dump_all is challenging, so I'm trying to prove this lemma to allow a more direct computation:

Lemma queue_dump_all_to_list: forall (queue: queue_type A), (queue_dump_all queue) = (queue_to_list queue).

I haven't been able to make progress using queue_dump_all_elim, though. I suspect the problem might be the 'manual' matching in worker instead of relying on Equation's pattern matching construct, but I had trouble with the proof of well formedness that way. Is there a way to push this proof forward?

(Originally written using Program Fixpoint but I couldn't get this answer to work either).

Answer 1

Here is a solution following your initial try: https://x80.org/collacoq/amugunalib.coq

The moral is: do not use match ... with end eq_refl constructs but rather rely on with and the inspect pattern, Equations will then avoid getting you into dependent rewrite hell.

From Equations Require Import Equations.
Require Import List.
Set Implicit Arguments.
Set Asymmetric Patterns.

Inductive queue_type (A : Type) : Type := Queue : list A -> list A -> queue_type A.
Context {A : Type}.
Definition empty_queue : queue_type A := Queue nil nil.

Definition enqueue (queue : queue_type A) (elt : A) : queue_type A :=
  match queue with Queue front back => Queue front (elt :: back) end.

Equations dequeue (queue : queue_type A) : queue_type A * option A :=
  | Queue nil nil => (Queue nil nil, None);
  | Queue (x :: xs) back => (Queue xs back, Some x);
  | Queue nil back with rev' back := {
    | (x :: xs) => (Queue xs nil, Some x);
    | nil => (Queue nil nil, None) (* Dead code *) }.

Definition queue_to_list (* last elt in head *) (queue : queue_type A) : list A :=
    match queue with Queue front back => (back ++ rev front) end.

Definition queue_length (queue : queue_type A) : nat :=
    match queue with Queue front back => List.length front + List.length back end.
Axiom cheat : forall {A}, A.

Lemma dequeue_queue_to_list (q : queue_type A) : 
  let (l, r) := dequeue q in queue_to_list q = 
  match r with Some x => queue_to_list l ++ (cons x nil) | None => nil end.
Proof.
  funelim (dequeue q); unfold queue_to_list; auto.
  - cbn. now rewrite app_assoc.
  - cbn. apply cheat. (* contradiction *)
  - cbn. apply cheat. (* algebra on rev, etc *)
Qed.

Definition inspect {A} (a : A) : { b : A | a = b } := (exist _ a eq_refl).

Equations queue_dump_all (queue : queue_type A): list A :=
    queue_dump_all queue := worker queue nil
  where worker (queue': queue_type A) : list A -> list A by wf (queue_length queue') lt :=
        worker queue' acc with inspect (dequeue queue') := {
                         | @exist (queue'', Some elt) eq => 
                            (worker queue'' (elt :: acc));
                         | _ => acc }.
                           
Next Obligation.
 apply cheat.
 Defined.

Lemma app_cons_nil_app {A} (l : list A) a l' : (l ++ a :: nil) ++ l' = l ++ a :: l'.
Proof.
  now rewrite <- app_assoc; cbn.
Qed.

Lemma queue_dump_all_to_list: forall (queue: queue_type A), (queue_dump_all queue) = (queue_to_list queue).
Proof.
  intros q.
  apply (queue_dump_all_elim (fun q l => l = queue_to_list q)
    (fun q queue' acc res =>
      
      res = queue_to_list queue' ++ acc)); auto.
  - intros.
    now rewrite app_nil_r in H.
  - intros. rewrite H; clear H.
    generalize (dequeue_queue_to_list queue').    
    destruct (dequeue queue').
    clear Heq. noconf e.
    intros ->. now rewrite app_cons_nil_app.
  - intros.
    generalize (dequeue_queue_to_list queue').
    destruct (dequeue queue').
    clear Heq. noconf e. cbn.
    now intros ->.
Qed.

Answer 2

The problem with the well founded recursion is that it uses the proof terms for computing. This was readily apparent when attempting to compute with queue_dump_all, which required rewriting and making some lemmas transparent and being careful with the proof for the hole. (this blogpost helped me figure this one out).

The dependency on proof terms, however, made it difficult to do any reasoning with the unfolded term. My first attempt was to reify the measure and move the proof into a signature type:

Equations queue_dump_all: queue_type A -> list A :=
    queue_dump_all qu := worker (exist (fun q => queue_length q = (queue_length queue)) qu eq_refl) nil
                                      
  where worker (len: nat) (q: {q: queue_type A | queue_length q = len}) (acc: list A): list A :=
        @worker 0 _ acc := acc;
        @worker (S len') queue acc with (dequeue queue.val).2 := {
            | Some elt := (worker (exist (fun q=> queue_length q = len') (dequeue (proj1_sig queue)).1 _) (elt :: acc));
            | _ := acc
        }.

This was easier to prove and actually computed since the proof terms could now easily be removed. However, the sig objects made the resulting equations difficult to work with. (Lots of "Dependent type error in rewrite of ..." like in this question).

The solution was finally moving to a weak specification like this:

Equations drain' (queue : queue_type A): option (list A) :=
  drain' queue := worker (S (queue_length queue)) queue nil
where worker (gas: nat) (q: queue_type A) (acc: list A): option (list A) :=
      @worker 0 _ _ := None;
      @worker (S gas') queue acc with (dequeue queue).2 := {
          | Some elt := worker gas' (dequeue queue).1 (elt :: acc);
          | _ := Some acc
      }.

Lemma drain_completes: forall q, drain' q <> None. ... Qed.

Definition queue_drain (queue: queue_type A): list A :=
    match drain' queue as res return (drain' queue = res -> list A) with
    | Some drained => fun pf => drained
    | None => fun pf => False_rect _ (drain_completes pf)
    end eq_refl.

Moving the proof terms out of the computation makes it much easier to reason with the lemmas generated by Equation with freedom to rewrite.