(* ************************************************************************** *)
(*                                                                            *)
(* Verified Flash Translation Layer                                           *)
(*                                                                            *)
(*                                                                            *)
(*   Author: Yu Guo <guoyu@ustc.edu.cn>                                       *)
(*                          School of Computer Science and Technology, USTC   *)
(*                                                                            *)
(*           Hui Zhang <sa512073@mail.ustc.edu.cn>                            *)
(*                                     School of Software Engineering, USTC   *)
(*                                                                            *)
(* ************************************************************************** *)

(* ************* ************************************* *****)
(* ftl interface *)

Require Import LibEx.
Require Import ListEx.
Require Import Monad.
Require Import Data.

Require Import Params.
Require Import Nand.
Require Import NandLems.

Require Import Bast0.
Require Import FTLProp.

Lemma check_used_implies_check_data_log :
  forall bi,
    check_used_block bi = true
    -> check_data_block bi = true \/ check_log_block bi = true.
Proof.
  intros bi.
  destruct bi.
  simpl; intros.
  unfold check_used_block in H.
  simpl in H.
  unfold check_data_block, check_log_block.
  simpl.
  destruct (bi_state); try discriminate.
  left; trivial.
  right; trivial.
Qed.
Arguments check_used_implies_check_data_log [bi] _.

(*  -------------------------------------------------------------

  Lemmas for block info table

*)

Lemma bit_update_same :
  forall bit pbn bi,
    bit_get bit pbn = Some bi
    -> bit_update bit pbn bi = Some bit.
Proof.
  unfold bit_get, bit_update.
  intros.
  rewrite (list_set_same H).
  trivial.
Qed.

Lemma bit_update_bit_get_neq :
  forall bit pbn bit' bi' pbn',
    bit_update bit pbn' bi' = Some bit'
    -> pbn <> pbn'
    -> bit_get bit' pbn = bit_get bit pbn.
Proof.
  unfold bit_update, bit_get.
  intros.
  rewrite (list_get_list_set_neq H (neq_sym H0)).
  trivial.
Qed.

Lemma bit_update_bit_get_eq :
  forall bit pbn bi bit',
    bit_update bit pbn bi = Some bit'
    -> bit_get bit' pbn = Some bi.
Proof.
  unfold bit_update, bit_get.
  intros.
  rewrite (list_get_list_set_eq H).
  trivial.
Qed.

Lemma bit_update_some :
  forall bit pbn bi bi',
    bit_get bit pbn = Some bi
    -> exists bit', bit_update bit pbn bi' = Some bit'.
Proof.
  unfold bit_get, bit_update.
  intros.
  destruct (list_get_list_set bi' H) as [bit' Hbit'].
  exists bit'.
  trivial.
Qed.

(* Lemma bit_get_update_neq :  *)
(*   forall bit pbn bi bit' bi' pbn', *)
(*     bit_get bit pbn = Some bi *)
(*     -> pbn <> pbn' *)
(*     -> bit_update bit pbn' bi' = Some bit' *)
(*     -> bit_get bit' pbn = Some bi. *)
(* Proof. *)
(* Qed. *)

Lemma bit_update_spec :
  forall bit pbn bi bi',
    bit_get bit pbn = Some bi
    -> exists bit',bit_update bit pbn bi' = Some bit'
                  /\ bit_get bit' pbn = Some bi'
                  /\ (forall pbn', pbn <> pbn'
                                   -> bit_get bit' pbn' = bit_get bit pbn').
Proof.
  unfold bit_update, bit_get.
  intros.
  destruct (list_get_list_set bi' H) as [bit' Hbit'].
  exists bit'.
  split; trivial.
  rewrite (list_get_list_set_eq Hbit').
  split; trivial.
  intros.
  rewrite (list_get_list_set_neq Hbit' H0).
  trivial.
Qed.

Lemma bit_update_spec_rev :
  forall bit pbn bi bit',
    bit_update bit pbn bi = Some bit'
    -> exists bi', bit_get bit pbn = Some bi'.
Proof.
  unfold bit_update, bit_get.
  intros bit pbn bi bit' Hset.
  destruct (list_set_list_get_rev Hset) as [bi' Hget].
  exists bi'.
  trivial.
Qed.

(*  -------------------------------------------------------------

  Lemmas for free_block_queue

*)

(* Old name: Lemma pbn_not_in_fbq_presev_fbq_enq :  *)
Lemma fbq_not_in_presev_fbq_enq :
  forall fbq pbn fbq' pbn',
    fbq_in fbq pbn = false
    -> fbq_enq fbq pbn' = Some fbq'
    -> pbn <> pbn'
    -> fbq_in fbq' pbn = false.
Proof.
  induction fbq.
    unfold fbq_in, fbq_enq.
    intros pbn fbq' pbn' Hin Henq Hneq.
    injection Henq.
    intro H.
    subst fbq'.
    simpl.
    simplbnat.
    trivial.

  unfold fbq_in.
  simpl.
  intros pbn fbq' pbn' Hin Henq Hneq.
  destruct fbq'.
    unfold fbq_enq in Henq.
    simpl in Henq.
    discriminate.
  inversion Henq.
  subst b.
  simpl.
  destruct (beq_nat pbn a) eqn:Hb.
    trivial.
  eapply IHfbq; eauto.
  unfold fbq_enq.
  trivial.
Qed.

(* Old name: Lemma fbq_in_fbq_enq_fbq_in :  *)
Lemma fbq_in_preserv_fbq_enq :
  forall pbn fbq pbn' fbq',
    pbn <> pbn'
    -> fbq_enq fbq pbn' = Some fbq'
    -> fbq_in fbq' pbn = fbq_in fbq pbn.
Proof.
  induction fbq.
    intros.
    unfold fbq_enq, fbq_in in * .
    simpl in H0.
    inversion H0.
    subst fbq'.
    simpl.
    simplbnat.
    trivial.
  destruct fbq'.
    intros.
    unfold fbq_enq in H0.
    discriminate.
  intros.
  unfold fbq_enq in * .
  simpl in * .
  inversion H0.
  subst b fbq'.
  simpl.
  unfold fbq_in in * .
  simpl.
  clear H0.
  destruct (beq_nat pbn a) eqn:Hb.
    trivial.
  eapply IHfbq; eauto.
Qed.

Lemma fbq_enq_fbq_in :
  forall pbn fbq fbq',
    fbq_enq fbq pbn = Some fbq'
    -> fbq_in fbq' pbn = true.
Proof.
  unfold fbq_enq, fbq_in.
  induction fbq.
    intros.
    injection H.
    intro; subst fbq'.
    simpl.
    simplbnat.
    trivial.
  intros.
  injection H.
  intro; subst fbq'.
  simpl.
  destruct (beq_nat pbn a) eqn:Hb.
    trivial.
  eapply IHfbq.
  trivial.
Qed.

Lemma fbq_enq_fbq_length_addone :
  forall fbq pbn fbq',
    fbq_enq fbq pbn = Some fbq'
    -> length fbq' = 1 + length fbq.
Proof.
  induction fbq.
    intros.
    unfold fbq_enq in H.
    injection H.
    intro; subst fbq'.
    simpl.
    trivial.
  intros.
  unfold fbq_enq in H.
  injection H.
  intro; subst fbq'.
  simpl.
  rewrite (IHfbq pbn (list_append fbq pbn)); eauto.
Qed.

Lemma fbq_deq_fbq_length_subone :
  forall fbq pbn fbq',
    fbq_deq fbq = Some (pbn, fbq')
    -> length fbq = S (length fbq').
Proof.
  unfold fbq_deq.
  induction fbq; simpl; intros; auto.
    discriminate.
  injection H; intros; subst a fbq'.
  trivial.
Qed.

Lemma fbq_not_in_preserv_fbq_deq :
  forall fbq pbn fbq' pbn',
    fbq_in fbq pbn = false
    -> fbq_deq fbq = Some (pbn', fbq')
    -> fbq_in fbq' pbn = false.
Proof.
  induction fbq; unfold fbq_in, fbq_deq; simpl; intros; auto.
    discriminate.
  injection H0; intros; subst a fbq'.
  destruct (beq_nat pbn pbn') eqn:Hpbn; trivial.
  discriminate.
Qed.

Lemma fbq_not_in_preserv_fbq_enq :
  forall fbq pbn fbq' pbn',
    pbn <> pbn'
    -> fbq_in fbq pbn = false
    -> fbq_enq fbq pbn' = Some fbq'
    -> fbq_in fbq' pbn = false.
Proof.
  unfold fbq_in, fbq_enq.
  induction fbq; simpl; intros; auto.
    injection H1; intros; subst fbq'.
    simpl.
    simplbnat.
    trivial.
  injection H1; intros; subst fbq'.
  simpl.
  destruct (beq_nat pbn a) eqn: Ha.
    discriminate.
  eauto.
Qed.

Lemma fbq_in_fbq_get:
  forall fbq pbn,
    fbq_in fbq pbn = true
    -> exists i, fbq_get fbq i = Some pbn.
Proof.
  induction fbq.
    unfold fbq_in, fbq_get.
    simpl.
    intros; discriminate.
  unfold fbq_in, fbq_get.
  simpl.
  intros.
  destruct (beq_nat pbn a) eqn:Ha.
    exists 0.
    rewbnat Ha.
    trivial.
  assert (pbn <> a).
    intro HF.
    subst a.
    simplbnat.
  destruct (IHfbq pbn H) as [i IH].
  exists (S i).
  trivial.
Qed.

Lemma fbq_get_fbq_deq_fbq_get:
  forall fbq i pbn pbn' fbq',
    fbq_get fbq (S i) = Some pbn
    -> fbq_deq fbq = Some (pbn', fbq')
    -> fbq_get fbq' i = Some pbn.
Proof.
  induction fbq.
    intros.
    unfold fbq_get, fbq_deq in * .
    discriminate.
  intros.
  unfold fbq_get in H.
  unfold fbq_deq in H0.
  injection H0.
  intros; subst fbq' a.
  simpl in H.
  trivial.
Qed.

Lemma fbq_get_fbq_rdeq_fbq_get:
  forall fbq i pbn pbn' fbq',
    fbq_get fbq i = Some pbn
    -> fbq_deq fbq' = Some (pbn', fbq)
    -> fbq_get fbq' (S i) = Some pbn.
Proof.
  induction fbq.
    intros.
    unfold fbq_get in H .
    unfold list_get in H.
    destruct i; discriminate.
  intros.
  unfold fbq_get in H.
  destruct fbq'.
    simpl in H0.
    discriminate.
  simpl in H0.
  injection H0.
  intros; subst fbq' b.
  unfold fbq_get.
  simpl.
  apply H.
Qed.

Lemma fbq_deq_fbq_get :
  forall fbq pbn fbq',
    fbq_deq fbq = Some (pbn, fbq')
    -> fbq_get fbq 0 = Some pbn.
Proof.
  induction fbq.
    intros.
    simpl in * .
    discriminate.
  intros pbn fbq' H.
  unfold fbq_deq in H.
  injection H.
  intros; subst fbq' a.
  unfold fbq_get.
  simpl.
  trivial.
Qed.

Lemma fbq_deq_fbq_in :
  forall fbq pbn fbq',
    fbq_deq fbq = Some (pbn, fbq')
    -> fbq_in fbq pbn = true.
Proof.
  unfold fbq_deq, fbq_in.
  induction fbq; simpl; intros; auto.
    discriminate.
  injection H; intros; subst a fbq'.
  simplbnat.
  trivial.
Qed.

Lemma fbq_in_preserv_fbq_deq :
  forall fbq pbn fbq' pbn',
    fbq_in fbq pbn = true
    -> pbn' <> pbn
    -> fbq_deq fbq = Some (pbn', fbq')
    -> fbq_in fbq' pbn = true.
Proof.
  unfold fbq_in, fbq_deq.
  induction fbq; simpl; intros; auto.
    discriminate.
  injection H1; intros; subst a fbq'.
  simplbnat.
  trivial.
Qed.

Lemma fbq_enq_spec :
  forall fbq pbn,
    exists fbq', fbq_enq fbq pbn = Some fbq'.
Proof.
  intros.
  unfold fbq_enq.
  exists (list_append fbq pbn).
  trivial.
Qed.

Lemma fbq_get_fbq_enq_fbq_get_rev:
  forall fbq fbq' i pbn pbn',
    fbq_enq fbq pbn' = Some fbq'
    -> fbq_get fbq' i = Some pbn
    -> pbn = pbn' /\ i = length fbq \/ fbq_get fbq i = Some pbn .
Proof.
  induction fbq; simpl; intros; trivial.
    unfold fbq_enq in H.
    injection H; intro; subst fbq'; clear H.
    unfold fbq_get in H0.
    simpl in H0.
    destruct i.
      injection H0; intro; subst pbn'; trivial.
      left; split; trivial.
    destruct i; discriminate.
  destruct i.
    unfold fbq_enq in H.
    injection H; intro; subst fbq'; auto.
  destruct fbq'.
    unfold fbq_enq in H.
    discriminate H.
  assert (fbq_enq fbq pbn' = Some fbq').
    clear - H.
    unfold fbq_enq in * .
    simpl in H.
    injection H; intros; subst.
    trivial.
  assert (fbq_get fbq' i = Some pbn).
    clear - H0.
    unfold fbq_get in * .
    simpl in H0.
    trivial.
  destruct (IHfbq fbq' i pbn pbn' H1 H2).
    destruct H3.
    left; subst; split; trivial.
  right.
  clear - H3.
  unfold fbq_get in * .
  simpl.
  trivial.
Qed.

Lemma fbq_not_in_fbq_get_some_implies_false:
  forall fbq pbn,
    fbq_in fbq pbn = false
    -> forall i, fbq_get fbq i = Some pbn
                 -> False.
Proof.
  unfold fbq_get.
  induction fbq; simpl; intros; auto.
    destruct i; discriminate.
  assert (fbq_in fbq pbn = false).
    unfold fbq_in in * .
    simpl in * .
    destruct (beq_nat pbn a).
      discriminate.
    trivial.
  destruct i.
    injection H0; intro; subst a; auto.
    unfold fbq_in in H.
    simpl in H.
    simplbnat.
  apply IHfbq with pbn i ; auto.
Qed.

Lemma fbq_get_fbq_deq_fbq_get_rev:
  forall fbq i pbn pbn' fbq',
    fbq_deq fbq = Some (pbn', fbq')
    -> fbq_get fbq' i = Some pbn
    -> fbq_get fbq (S i) = Some pbn.
Proof.
  induction fbq.
    intros.
    unfold fbq_get, fbq_deq in * .
    discriminate.
  intros.
  destruct i.
    simpl in *.
    unfold fbq_get.
    simpl.
    injection H; intros; subst fbq'; trivial.
  unfold fbq_deq in H.
  injection H; intros; subst a fbq'; auto.
Qed.

(*  -------------------------------------------------------------

  Lemmas for block mapping table

*)

Lemma pbn_in_bmt_lbn_bmt_get :
  forall bmt lbn pbn,
    pbn_in_bmt_lbn bmt lbn pbn
    -> exists bmr, bmt_get bmt lbn = Some bmr
       /\ pbn_in_bmr pbn bmr.
Proof.
  intros bmt lbn pbn Hin.
  unfold pbn_in_bmt_lbn in Hin.
  destruct Hin.
    destruct H as [bmr Hget].
    exists (Some pbn, bmr).
    split; trivial.
    simpl.
    destruct bmr.
      left; trivial.
    trivial.
  destruct H as [bmr Hget].
  exists (bmr, Some pbn).
  split; trivial.
  unfold pbn_in_bmr.
  destruct bmr; trivial.
  right; trivial.
Qed.

Lemma bmt_get_bmt_update_some :
  forall bmt lbn mbr mbr',
    bmt_get bmt lbn = Some mbr
    -> exists bmt', bmt_update bmt lbn mbr' = Some bmt'.
Proof.
  unfold bmt_get, bmt_update.
  intros.
  destruct (list_get_list_set mbr' H) as [bmt' Hbmt'].
  exists bmt'.
  destruct mbr'; trivial.
Qed.

Lemma bmt_update_bmt_get_eq :
  forall bmt lbn bmr bmt',
    bmt_update bmt lbn bmr = Some bmt'
    -> bmt_get bmt' lbn = Some bmr.
Proof.
  unfold bmt_update, bmt_get.
  intros.
  destruct bmr.
  rewrite (list_get_list_set_eq H).
  trivial.
Qed.

Lemma bmt_update_bmt_get_neq :
  forall bmt lbn bmr bmt' lbn',
    bmt_update bmt lbn bmr = Some bmt'
    -> lbn <> lbn'
    -> bmt_get bmt' lbn' = bmt_get bmt lbn'.
Proof.
  unfold bmt_update, bmt_get.
  intros.
  destruct bmr.
  rewrite (list_get_list_set_neq H H0).
  trivial.
Qed.

Lemma bmt_update_bmt_get_eq_rev :
  forall bmt lbn bmr bmt',
    bmt_update bmt lbn bmr = Some bmt'
    -> exists bmr', bmt_get bmt lbn = Some bmr'.
Proof.
  unfold bmt_get, bmt_update.
  intros.
  destruct bmr as [bmrd bmrl].
  destruct (list_set_list_get_rev H) as [bmr' H'].
  exists bmr'; trivial.
Qed.

Lemma bmt_update_spec :
  forall bmt lbn mbr mbr',
    bmt_get bmt lbn = Some mbr
    -> exists bmt', bmt_update bmt lbn mbr' = Some bmt'
                    /\ bmt_get bmt' lbn = Some mbr'
                    /\ forall lbn', lbn' <> lbn
                                    -> bmt_get bmt' lbn' = bmt_get bmt lbn'.
Proof.
  unfold bmt_get, bmt_update.
  intros.
  destruct (list_get_list_set mbr' H) as [bmt' Hbmt'].
  exists bmt'.
  destruct mbr'.
  split; trivial.
  rewrite (list_get_list_set_eq Hbmt').
  split; trivial.
  intros.
  rewrite (list_get_list_set_neq Hbmt' (neq_sym H0)).
  trivial.
Qed.

Lemma bmt_update_pbn_in_bmt_lbn_neq :
  forall bmt lbn bmr bmt' lbn' pbn,
    bmt_update bmt lbn bmr = Some bmt'
    -> lbn' <> lbn
    -> pbn_in_bmt_lbn bmt lbn' pbn
    -> pbn_in_bmt_lbn bmt' lbn' pbn.
Proof.
  unfold pbn_in_bmt_lbn.
  intros bmt lbn bmr bmt' lbn' pbn Hu Hneq H.
  destruct H.
    left.
    unfold pbn_in_bmt_data in * .
    destruct H as [x H].
    rewrite (bmt_update_bmt_get_neq _ _ _ _ _ Hu (neq_sym Hneq)).
    exists x; trivial.
  right.
  unfold pbn_in_bmt_log in * .
  destruct H as [x H].
  rewrite (bmt_update_bmt_get_neq _ _ _ _ _ Hu (neq_sym Hneq)).
  exists x; trivial.
Qed.

Lemma bmt_update_pbn_in_bmt_lbn_eq :
  forall bmt lbn pbn bmr bmt',
    bmt_update bmt lbn bmr = Some bmt'
    -> pbn_in_bmr pbn bmr
    -> pbn_in_bmt_lbn bmt' lbn pbn.
Proof.
  unfold pbn_in_bmr, pbn_in_bmt_lbn.
  intros.
  destruct bmr as [bd bl].
  destruct bd; destruct bl.
    destruct H0.
    left.
    exists (Some b0).
    rewrite (bmt_update_bmt_get_eq _ _ _ _ H).
    subst; trivial.
    right.
    exists (Some b).
    subst b0.
    rewrite (bmt_update_bmt_get_eq _ _ _ _ H).
    trivial.

    left.
    exists None.
    rewrite (bmt_update_bmt_get_eq _ _ _ _ H).
    subst; trivial.

    right.
    exists None.
    rewrite (bmt_update_bmt_get_eq _ _ _ _ H).
    subst; trivial.

    contradiction.
Qed.

Lemma bmt_update_pbn_in_bmt_lbn_neq_rev :
(* Lemma bmt_update_pbn_in_bmt_neq :  *)
  forall bmt bmt' lbn lbn' pbn bmr,
    bmt_update bmt lbn bmr = Some bmt'
    -> lbn <> lbn'
    -> pbn_in_bmt_lbn bmt' lbn' pbn
    -> pbn_in_bmt_lbn bmt lbn' pbn.
Proof.
  unfold pbn_in_bmt_lbn.
  intros.
  destruct H1.
    left.
    unfold pbn_in_bmt_data in * .
    destruct H1.
    exists x.
    rewrite <- (bmt_update_bmt_get_neq _ _ _ _ _ H H0).
    trivial.
  right.
  destruct H1.
  exists x.
  rewrite <- (bmt_update_bmt_get_neq _ _ _ _ _ H H0).
  trivial.
Qed.

Lemma bmt_update_log_bmt_get_neq :
  forall bmt lbn pbn bmt' lbn',
    bmt_update_log bmt lbn pbn = Some bmt'
    -> lbn <> lbn'
    -> bmt_get bmt' lbn' = bmt_get bmt lbn'.
Proof.
  unfold bmt_update_log.
  intros.
  destruct (bmt_get bmt lbn) eqn:Hget; try discriminate.
  destruct b.
  destruct (bmt_update bmt lbn (o, Some pbn)) eqn:Hup; try discriminate.
  injection H; intros; subst b.
  erewrite bmt_update_bmt_get_neq; eauto.
Qed.

Lemma bmt_update_log_spec :
  forall bmt lbn pbn bmr,
    bmt_get bmt lbn = Some bmr
    -> exists bmt', bmt_update_log bmt lbn pbn = Some bmt'
                    /\ bmt_get bmt' lbn = Some (fst bmr, Some pbn)
                    /\ (forall lbn',
                         lbn' <> lbn
                         -> bmt_get bmt' lbn' = bmt_get bmt lbn').
Proof.
  unfold bmt_update_log.
  intros.
  rewrite H.
  destruct bmr.
  destruct (bmt_update_spec bmt lbn _ (o, Some pbn) H) as [bmt' [Hup [Hget Hget']]].
  exists bmt'.
  rewrite Hup.
  split; trivial.
  simpl.
  split; trivial.
Qed.

Lemma bmt_update_log_pbn_in_bmt_log_eq :
  forall bmt lbn pbn bmt',
    bmt_update_log bmt lbn pbn = Some bmt'
    -> pbn_in_bmt_log bmt' lbn pbn.
Proof.
  unfold pbn_in_bmt_log.
  unfold bmt_update_log.
  intros.
  destruct (bmt_get bmt lbn) eqn:Hget; try discriminate.
  destruct b as [bmrd bmrl].
  destruct (bmt_update bmt lbn (bmrd, Some pbn)) eqn:Hup; try discriminate.
  injection H; intros; subst b.
  rewrite (bmt_update_bmt_get_eq _ _ _ _ Hup).
  exists bmrd; trivial.
Qed.

Lemma bmt_update_log_pbn_in_bmt_data_preserv :
  forall bmt lbn pbn bmt' lbn' pbn',
    bmt_update_log bmt lbn pbn = Some bmt'
    -> pbn_in_bmt_data bmt lbn' pbn'
    -> pbn_in_bmt_data bmt' lbn' pbn'.
Proof.
  unfold pbn_in_bmt_data.
  unfold bmt_update_log.
  intros.
  destruct (bmt_get bmt lbn) eqn:Hget; try discriminate.
  destruct b as [bmrd bmrl].
  destruct (bmt_update bmt lbn (bmrd, Some pbn)) eqn:Hup; try discriminate.
  injection H; intros; subst b.
  destruct (pbn_eq_dec lbn lbn') as [Heq | Hneq].
    subst lbn'.
    destruct H0 as [x H0].
    exists (Some pbn).
    rewrite (bmt_update_bmt_get_eq _ _ _ _ Hup).
    rewrite Hget in H0.
    injection H0; intros; subst bmrd x.
    trivial.
  destruct H0 as [x H0].
  clear H.
  rewrite (bmt_update_bmt_get_neq _ _ _ _ _ Hup Hneq).
  rewrite H0.
  exists x; trivial.
Qed.

Lemma bmt_update_log_pbn_in_bmt_data_preserv_rev :
  forall bmt lbn pbn bmt' lbn' pbn',
    bmt_update_log bmt lbn pbn = Some bmt'
    -> pbn_in_bmt_data bmt' lbn' pbn'
    -> pbn_in_bmt_data bmt lbn' pbn'.
Proof.
  unfold pbn_in_bmt_data.
  unfold bmt_update_log.
  intros.
  destruct (bmt_get bmt lbn) eqn:Hget; try discriminate.
  destruct b as [bmrd bmrl].
  destruct (bmt_update bmt lbn (bmrd, Some pbn)) eqn:Hup; try discriminate.
  injection H; intros; subst b.
  destruct (pbn_eq_dec lbn lbn') as [Heq | Hneq].
    subst lbn'.
    destruct H0 as [x H0].
    exists bmrl.
    rewrite (bmt_update_bmt_get_eq _ _ _ _ Hup) in H0.
    injection H0; intros; subst bmrd x.
    trivial.
  destruct H0 as [x H0].
  clear H.
  rewrite (bmt_update_bmt_get_neq _ _ _ _ _ Hup Hneq) in H0.
  exists x; trivial.
Qed.

Lemma bmt_update_log_pbn_in_bmt_log_preserv_rev :
  forall bmt lbn pbn bmt' lbn' pbn',
    bmt_update_log bmt lbn pbn = Some bmt'
    -> lbn <> lbn'
    -> pbn_in_bmt_log bmt' lbn' pbn'
    -> pbn_in_bmt_log bmt lbn' pbn'.
Proof.
  unfold pbn_in_bmt_log.
  unfold bmt_update_log.
  intros.
  destruct (bmt_get bmt lbn) eqn:Hget; try discriminate.
  destruct b as [bmrd bmrl].
  destruct (bmt_update bmt lbn (bmrd, Some pbn)) eqn:Hup; try discriminate.
  injection H; intros; subst b; clear H.
  destruct H1 as [x H1].
  rewrite (bmt_update_bmt_get_neq _ _ _ _ _ Hup H0) in H1.
  exists x; trivial.
Qed.

Lemma bmt_update_log_pbn_in_bmt_lbn_neq :
  forall bmt lbn pbn bmt' lbn' pbn',
    bmt_update_log bmt lbn pbn = Some bmt'
    -> lbn <> lbn'
    -> pbn_in_bmt_lbn bmt lbn' pbn'
    -> pbn_in_bmt_lbn bmt' lbn' pbn'.
Proof.
  unfold pbn_in_bmt_lbn.
  unfold bmt_update_log.
  unfold pbn_in_bmt_data, pbn_in_bmt_log.
  intros.
  destruct (bmt_get bmt lbn) eqn:Hget; try discriminate.
  destruct b as [bmrd bmrl].
  destruct (bmt_update bmt lbn (bmrd, Some pbn)) eqn:Hup; try discriminate.
  injection H; intros; subst b; clear H.
  destruct H1 as [[x H1] | [x H1]].
    left.
    rewrite <- (bmt_update_bmt_get_neq _ _ _ _ _ Hup H0) in H1.
    exists x; trivial.
  right.
  rewrite <- (bmt_update_bmt_get_neq _ _ _ _ _ Hup H0) in H1.
  exists x; trivial.
Qed.

Lemma bmt_update_log_pbn_in_bmt_lbn_neq_rev :
  forall bmt lbn pbn bmt' lbn' pbn',
    bmt_update_log bmt lbn pbn = Some bmt'
    -> lbn <> lbn'
    -> pbn_in_bmt_lbn bmt' lbn' pbn'
    -> pbn_in_bmt_lbn bmt lbn' pbn'.
Proof.
  unfold pbn_in_bmt_lbn.
  intros.
  destruct H1 as [H1 | H1].
  left.
  apply (bmt_update_log_pbn_in_bmt_data_preserv_rev _ _ _ _ _ _ H); trivial.
  right.
  apply (bmt_update_log_pbn_in_bmt_log_preserv_rev _ _ _ _ _ _ H); trivial.
Qed.

Lemma bmt_update_log_bmt_get_eq_rev :
  forall bmt lbn pbn bmt',
    bmt_update_log bmt lbn pbn = Some bmt'
    -> exists bmr, bmt_get bmt lbn = Some bmr.
Proof.
  unfold bmt_update_log.
  intros.
  destruct (bmt_get bmt lbn) as [ bmr | ] eqn:Hget.
    destruct bmr as [bmrd bmrl].
    destruct (bmt_update bmt lbn(bmrd, Some pbn)) as [ bmt'' | ] eqn:Hu.
      injection H; intro; subst bmt''; clear H.
      exists (bmrd, bmrl); trivial.
    discriminate.
  discriminate.
Qed.

Lemma bmt_get_pbn_in_bmt_r :
  forall bmt lbn x pbn2,
    bmt_get bmt lbn = Some (x, Some pbn2)
    -> pbn_in_bmt bmt pbn2.
Proof.
  intros bmt lbn x pbn2 Hget.
  exists lbn; right.
  exists x; trivial.
Qed.

Lemma bmt_get_pbn_in_bmt_l :
  forall bmt lbn pbn1 x,
    bmt_get bmt lbn = Some (Some pbn1, x)
    -> pbn_in_bmt bmt pbn1.
Proof.
  intros bmt lbn pbn1 x Hget.
  exists lbn; left.
  exists x; trivial.
Qed.

(************** *)

Lemma pmt_update_pmt_len :
  forall pmt loc off pmt',
    pmt_update pmt loc off = Some pmt'
    -> pmt_len pmt' = pmt_len pmt.
Proof.
  unfold pmt_update, pmt_len.
  intros.
  erewrite list_set_length_preserv; eauto.
Qed.

Lemma pmt_update_pmt_get_eq :
  forall pmt loc off pmt',
    pmt_update pmt loc off = Some pmt'
    -> pmt_get pmt' loc = Some (pmte_log off).
Proof.
  unfold pmt_update, pmt_get.
  intros.
  rewrite (list_get_list_set_eq H).
  trivial.
Qed.

Lemma pmt_update_pmt_get_neq :
  forall pmt loc off pmt' loc',
    pmt_update pmt loc off = Some pmt'
    -> loc' <> loc
    -> pmt_get pmt' loc' = pmt_get pmt loc'.
Proof.
  unfold pmt_update, pmt_get.
  intros.
  rewrite (list_get_list_set_neq H (neq_sym H0)).
  trivial.
Qed.

Lemma beq_pmt_entry_true_eq :
  forall a1 a2 : pmt_entry, beq_pmt_entry a1 a2 = true -> a1 = a2.
Proof.
  intros a1 a2 H.
  destruct a1; destruct a2; simpl in H; simpl; try discriminate; trivial.
  rewbnat H.
  trivial.
Qed.

Lemma beq_pmt_entry_eq_true :
  forall a1 a2 : pmt_entry, a1 = a2 -> beq_pmt_entry a1 a2 = true.
Proof.
  intros a1 a2 H.
  destruct a1; destruct a2; simpl in H; simpl; try discriminate; trivial.
  injection H; intro; subst; trivial.
  simplbnat.
  trivial.
Qed.

Lemma beq_pmt_entry_false_neq :
  forall a1 a2 : pmt_entry, beq_pmt_entry a1 a2 = false -> a1 <> a2.
Proof.
  intros a1 a2 H.
  destruct a1; destruct a2; simpl in H; simpl; try discriminate; trivial.
  intro HF.
  injection HF; intro; subst off0.
  simplbnat.
Qed.

Lemma beq_pmt_entry_neq_false :
  forall a1 a2 : pmt_entry, a1 <> a2 -> beq_pmt_entry a1 a2 = false.
Proof.
  intros a1 a2 H.
  destruct a1; destruct a2; simpl in H; simpl; try discriminate; trivial.
    destruct (H (refl_equal _)).
  destruct (beq_nat off off0) eqn: Hbeq.
    apply False_ind.
    apply H.
    rewbnat Hbeq.
    trivial.
  trivial.
Qed.

Lemma pmt_find_rev_pmt_get :
  forall pmt off loc,
    pmt_find_rev pmt (pmte_log off) = Some loc
    -> pmt_get pmt loc = Some (pmte_log off).
Proof.
  unfold pmt_find_rev, pmt_get.
  intros pmt off loc Hfind.
  rewrite (list_find_rev_list_get Hfind); trivial.
  apply beq_pmt_entry_true_eq; trivial.
Qed.

Lemma pmt_len_pmt_get:
  forall pmt len,
    pmt_len pmt = len
    -> forall loc,
         (blt_nat loc len = true -> exists pmte, pmt_get pmt loc = Some pmte)
         /\ (blt_nat loc len = false -> pmt_get pmt loc = None).
Proof.
  intros.
  unfold pmt_len, pmt_get in * .
  destruct (length_elim H loc) as [H1 H2].
  split; trivial.
Qed.

Lemma pmt_update_pmt_find_rev_neq :
  forall pmt loc off pmt' off',
    pmt_get pmt loc = Some pmte_empty
    -> pmt_update pmt loc off = Some pmt'
    -> off' <> off
    -> pmt_find_rev pmt' (pmte_log off') = pmt_find_rev pmt (pmte_log off').
Proof.
  unfold pmt_get, pmt_update, pmt_find_rev.
  intros.
  apply list_set_list_find_rev_neq with loc pmte_empty (pmte_log off); trivial.
  intro HF.
  apply H1.
  injection HF; auto.
  intro HF; discriminate.
  apply beq_pmt_entry_neq_false; trivial.
  apply beq_pmt_entry_false_neq; trivial.
Qed.

Lemma pmt_update_spec:
  forall pmt loc off,
    bvalid_page_off loc = true
    -> pmt_get pmt loc = Some pmte_empty
    -> exists pmt', pmt_update pmt loc off = Some pmt'
                    /\ pmt_get pmt' loc = Some (pmte_log off)
                    /\ (forall loc',
                          loc' <> loc
                          -> pmt_get pmt' loc' = pmt_get pmt loc').
Proof.
  intros pmt loc off Hloc Hget.
  assert (exists pmt', pmt_update pmt loc off = Some pmt').
    unfold pmt_update, pmt_get in * .
    destruct (@list_get_list_set _ pmt loc pmte_empty (pmte_log off) Hget) as [pmt' Hx].
    exists pmt'; trivial.
  destruct H as [pmt' H].
  rewrite H.
  exists pmt'.
  split; trivial.
  split.
    rewrite (pmt_update_pmt_get_eq _ _ _ _ H).
    trivial.
  intros loc' Hneq.
  rewrite (pmt_update_pmt_get_neq _ _ _ _ _ H Hneq).
  trivial.
Qed.

(************** *)

Lemma pbn_in_bmt_data_inj :
  forall bmt lbn pbn pbn',
    pbn_in_bmt_data bmt lbn pbn
    -> pbn_in_bmt_data bmt lbn pbn'
    -> pbn = pbn'.
Proof.
  unfold pbn_in_bmt_data.
  intros bmt lbn pbn pbn' Hpbn Hpbn'.
  destruct Hpbn as [x1 Hpbn].
  destruct Hpbn' as [x2 Hpbn'].
  rewrite Hpbn in Hpbn'.
  injection Hpbn'; intros; auto.
Qed.

Lemma pbn_in_bmt_log_inj :
  forall bmt lbn pbn pbn',
    pbn_in_bmt_log bmt lbn pbn
    -> pbn_in_bmt_log bmt lbn pbn'
    -> pbn = pbn'.
Proof.
  unfold pbn_in_bmt_log.
  intros bmt lbn pbn pbn' [x1 Hpbn] [x2 Hpbn'].
  rewrite Hpbn in Hpbn'.
  injection Hpbn'; intros; auto.
Qed.

(************** *)

Lemma invalid_off_implies_read_data_block_none :
  forall c pbn loc,
    ~ valid_page_off loc
    -> read_data_block c pbn loc = None.
Proof.
  intros c pbn loc H.
  unfold read_data_block.
  assert (bvalid_page_off loc = false).
    unfold valid_page_off in H.
    destruct (bvalid_page_off loc).
    destruct (H (refl_equal _)).
    trivial.
  rewrite (invalid_off_implies_nand_read_page_none _ _ _ H0); eauto.
Qed.

Lemma read_data_block_unchanged :
  forall c pbn off c',
    chip_get_block c pbn = chip_get_block c' pbn
    -> read_data_block c pbn off = read_data_block c' pbn off.
Proof.
  intros c pbn off c' Hg.
  unfold read_data_block.
  erewrite nand_read_page_eq_in_same_block; eauto.
Qed.

Lemma read_log_block_unchanged :
  forall c pbn off bi c',
    chip_get_block c pbn = chip_get_block c' pbn
    -> read_log_block c bi pbn off = read_log_block c' bi pbn off.
Proof.
  intros c pbn off bi c' Hg.
  unfold read_log_block.
  destruct (find_page_in_log_block bi off) as [loc | ].
  erewrite nand_read_page_eq_in_same_block; eauto.
  trivial.
Qed.

Lemma abundant_elim :
  forall fbq,
    check_freebq_count fbq = fbqs_abundant
    -> exists b fbq', fbq_deq fbq = Some (b, fbq')
                      /\ fbq_in fbq b = true.
Proof.
  unfold check_freebq_count.
  intros fbq H.
  destruct (ble_nat MIN_FREE_BLOCKS (length fbq)) eqn:Hfbq; try discriminate.
  clear H.
  destruct fbq as [ | b fbq' ].
    simpl in Hfbq.
    unfold ble_nat in Hfbq.
    unfold MIN_FREE_BLOCKS in Hfbq.
    simpl in Hfbq.
    discriminate.
  exists b, fbq'.
  simpl.
  split; trivial.
  unfold fbq_in.
  unfold list_inb.
  simplbnat.
  trivial.
Qed.


(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)

Require Import List Permutation Arith Lia.

From Undecidability.Shared.Libs.DLW
  Require Import utils pos vec.

From Undecidability.ILL
  Require Import ILL.

Set Implicit Arguments.

Section obvious_links_between_fragments.

  Notation "P ⇒ Q" := (forall Γ A, P Γ A -> Q Γ A) (at level 70).

  Fact S_ill_restr_restr_wc : S_ill_restr ⇒ S_ill_restr_wc.
  Proof.
    induction 1.
    all: try now constructor.
    now constructor 3 with (Γ := Γ).
  Qed.

  Fact S_ill_full_wc : S_ill ⇒ S_ill_wc.
  Proof.
    induction 1.
    all: try now constructor.
    now constructor 3 with (Γ := Γ).
  Qed.

  Fact S_ill_restr_full : S_ill_restr ⇒ S_ill.
  Proof.
    induction 1.
    all: try now constructor.
    now constructor 2 with (Γ := Γ).
  Qed.

  Fact S_ill_restr_full_wc : S_ill_restr_wc ⇒ S_ill_wc.
  Proof.
    induction 1.
    all: try now constructor.
    + now constructor 2 with A.
    + now constructor 3 with (Γ := Γ).
  Qed.

End obvious_links_between_fragments.

Local Notation "Γ '⊢r' A" := (S_ill_restr Γ A) (at level 70, no associativity).
Local Notation "Γ '⊢' A" := (S_ill_wc Γ A) (at level 70, no associativity).

Fact S_ill_restr_weak Γ Δ B : Δ ⊢r B -> ‼Γ++Δ ⊢r B.
Proof. intro; induction Γ; simpl; auto; apply in_ill1_weak; auto. Qed.

Fact S_ill_wc_weak Γ Δ B : Δ ⊢ B -> ‼Γ++Δ ⊢ B.
Proof. intro; induction Γ; simpl; auto; apply in_ill4_weak; auto. Qed.

Fact S_ill_restr_cntr Γ Δ B : ‼Γ++‼Γ++Δ ⊢r B -> ‼Γ++ Δ ⊢r B.
Proof.
  revert Γ Δ; intros Ga.
  induction Ga as [ | A Ga IH ]; simpl; auto; intros De.
  intros H.
  apply in_ill1_cntr.
  apply in_ill1_perm with (‼Ga ++ (!A::!A::De)).
  + apply Permutation_sym.
    do 2 apply Permutation_cons_app; auto.
  + apply IH.
    revert H; apply in_ill1_perm.
    rewrite app_assoc.
    apply Permutation_cons_app.
    rewrite <- app_assoc.
    apply Permutation_app; auto.
    apply Permutation_cons_app; auto.
Qed.

Fact S_ill_wc_cntr Γ Δ B : ‼Γ++‼Γ++Δ ⊢ B -> ‼Γ++ Δ ⊢ B.
Proof.
  revert Γ Δ; intros Ga.
  induction Ga as [ | A Ga IH ]; simpl; auto; intros De.
  intros H.
  apply in_ill4_cntr.
  apply in_ill4_perm with (‼Ga ++ (!A::!A::De)).
  + apply Permutation_sym.
    do 2 apply Permutation_cons_app; auto.
  + apply IH.
    revert H; apply in_ill4_perm.
    rewrite app_assoc.
    apply Permutation_cons_app.
    rewrite <- app_assoc.
    apply Permutation_app; auto.
    apply Permutation_cons_app; auto.
Qed.

Theorem S_ill_restr_weak_cntr Σ Γ A B : In A Σ -> ‼Σ++Γ ⊢r B <-> !A::‼Σ++Γ ⊢r B.
Proof.
  revert Σ Γ; intros Si Ga.
  intros H.
  apply In_perm in H.
  destruct H as (Si' & H).
  split.
  + apply in_ill1_weak.
  + intros H1.
    apply in_ill1_perm with (‼(A :: Si') ++ Ga).
    * apply Permutation_app; auto.
      apply Permutation_map; auto.
    * simpl; apply in_ill1_cntr.
      revert H1; apply in_ill1_perm.
      simpl; apply Permutation_cons; auto.
      change (!A::‼Si'++Ga) with (‼(A::Si')++Ga).
      apply Permutation_app; auto.
      apply Permutation_map, Permutation_sym; auto.
Qed.

Theorem S_ill_wc_weak_cntr Σ Γ A B : In A Σ -> ‼Σ++Γ ⊢ B <-> !A::‼Σ++Γ ⊢ B.
Proof.
  revert Σ Γ; intros Si Ga.
  intros H.
  apply In_perm in H.
  destruct H as (Si' & H).
  split.
  + apply in_ill4_weak.
  + intros H1.
    apply in_ill4_perm with (‼(A :: Si') ++ Ga).
    * apply Permutation_app; auto.
      apply Permutation_map; auto.
    * simpl; apply in_ill4_cntr.
      revert H1; apply in_ill4_perm.
      simpl; apply Permutation_cons; auto.
      change (!A::‼Si'++Ga) with (‼(A::Si')++Ga).
      apply Permutation_app; auto.
      apply Permutation_map, Permutation_sym; auto.
Qed.

(* We prove soundness for the stronger system *)

Section trivial_phase_semantics.

  Variables (n : nat) (s : ill_vars -> vec nat n -> Prop).

  Reserved Notation "'⟦' A '⟧'" (at level 65).

  Definition ill_tps_imp (X Y : _ -> Prop) (v : vec _ n) := forall x, X x -> Y (vec_plus x v).
  Definition ill_tps_mult (X Y : _ -> Prop) (x : vec _ n) := exists a b, x = vec_plus a b /\ X a /\ Y b.

  Infix "**" := ill_tps_mult (at level 65, right associativity).
  Infix "-*" := ill_tps_imp (at level 65, right associativity).

  Fact ll_tps_mult_mono (X1 X2 Y1 Y2 : _ -> Prop) :
             (forall x, X1 x -> X2 x)
          -> (forall x, Y1 x -> Y2 x)
          -> (forall x, (X1**Y1) x -> (X2**Y2) x).
  Proof.
    intros H1 H2 x (a & b & H3 & H4 & H5); subst.
    exists a, b; auto.
  Qed.

  Fixpoint ill_tps A x : Prop :=
    match A with
      | £ X     => s X x
      | A & B   => ⟦A⟧ x /\ ⟦B⟧ x
      | !A      => ⟦A⟧ x /\ x = vec_zero
      | A ⊸ B   => (⟦A⟧ -* ⟦B⟧) x
      | A ⊗ B   => (⟦A⟧ ** ⟦B⟧) x
      | A ⊕ B   => ⟦A⟧ x \/ ⟦B⟧ x
      | ⟘              => False
      | ⟙              => True
      | _               => x = vec_zero
    end
  where "⟦ A ⟧" := (ill_tps A).

  Reserved Notation "'[[' Γ ']]'" (at level 0).

  Fixpoint ill_tps_list Γ :=
    match Γ with
      | ∅    => eq vec_zero
      | A::Γ => ⟦A⟧ ** [[Γ]]
    end
  where "[[ Γ ]]" := (ill_tps_list Γ).

  Fact ill_tps_app Γ Δ x : [[Γ++Δ]] x <-> ([[Γ]]**[[Δ]]) x.
  Proof.
    revert Γ Δ x; intros Ga De.
    induction Ga as [ | A Ga IH ]; intros x; simpl; split; intros Hx.
    + exists vec_zero, x; simpl; rew vec.
    + destruct Hx as (a & b & H1 & H2 & H3); subst; auto; rewrite vec_zero_plus; auto.
    + destruct Hx as (a & b & H1 & H2 & H3).
      apply IH in H3.
      destruct H3 as (c & d & H4 & H5 & H6).
      exists (vec_plus a c), d; split.
      * subst; apply vec_add_assoc.
      * split; auto.
        exists a, c; auto.
    + destruct Hx as (y & d & H1 & H2 & H3).
      destruct H2 as (a & g & H2 & H4 & H5).
      exists a, (vec_plus g d); split.
      * subst; symmetry; apply vec_add_assoc.
      * split; auto.
        apply IH.
        exists g, d; auto.
  Qed.

  Fact ill_tps_lbang Γ x : [[‼Γ]] x <-> [[Γ]] x /\ x = vec_zero.
  Proof.
    revert Γ x; intros Ga.
    induction Ga as [ | A Ga IH ]; intros x.
    + simpl; split; auto; tauto.
    + split.
      * intros (a & g & H1 & H2 & H3).
        split.
        - exists a, g; repeat split; auto.
          ** apply H2.
          ** apply IH; auto.
        - apply IH, proj2 in H3.
          apply proj2 in H2; subst; auto.
          apply vec_zero_plus.
      * intros ((a & g & H1 & H2 & H3) & H4).
        exists x, x.
        assert (a = vec_zero /\ g = vec_zero) as E.
        { apply vec_plus_is_zero; subst; auto. }
        destruct E; subst; repeat split; auto; rew vec.
        apply IH; auto.
  Qed.

  Fact ill_tps_list_bang_zero Γ : [[‼Γ]] vec_zero <-> forall A, In A Γ -> ⟦A⟧ vec_zero.
  Proof.
    induction Γ as [ | A Ga IH ].
    + split.
      * simpl; tauto.
      * intros _; simpl; auto.
    + split.
      * intros (u & v & H1 & H2 & H3).
        destruct H2 as [ H2 H4 ]; subst; auto.
        rewrite vec_zero_plus in H1; subst.
        rewrite IH in H3.
        intros B [ E | HB ]; subst; auto.
      * intros H.
        exists vec_zero, vec_zero.
        rewrite vec_zero_plus; repeat split; auto.
        - apply H; left; auto.
        - rewrite IH.
          intros; apply H; right; auto.
  Qed.

  (* Symbols for cut&paste ⟙   ⟘   𝝐  ﹠ ⊗  ⊕  ⊸  ❗   ‼  ∅  ⊢ ⟦ ⟧ Γ Δ Σ*)

  Fact ill_tps_perm Γ Δ : Γ ~p Δ -> forall x, [[Γ]] x -> [[Δ]] x.
  Proof.
    induction 1 as [ | A Ga De H IH | A B Ga | ]; simpl; auto.
    + intros x (a & b & H1 & H2 & H3).
      exists a, b; repeat split; auto.
    + intros x (a & b & H1 & H2 & c & d & H3 & H4 & H5).
      exists c, (vec_plus a d); split.
      * subst; rewrite (vec_add_comm c), vec_add_assoc, (vec_add_comm c); auto.
      * split; auto.
        exists a, d; auto.
  Qed.

  Definition ill_sequent_tps Γ A := [[Γ]] -* ⟦A⟧.

  Notation "'[<' Γ '|-' A '>]'" := (ill_sequent_tps Γ A).

  Fact ill_sequent_tps_mono Γ A B :
     (forall x, ⟦A⟧ x -> ⟦B⟧ x) -> forall x, [< Γ |- A >] x -> [< Γ |- B >] x.
  Proof.
    intros H x; simpl; unfold ill_sequent_tps.
    intros H1 a H2.
    apply H, H1; auto.
  Qed.

  Fact ill_perm_tps Γ Δ : Γ ~p Δ -> forall x A, [< Γ |- A >] x -> [< Δ |- A >] x.
  Proof.
    intros H1 x B; unfold ill_sequent_tps.
    intros H2 a H3.
    apply H2; revert H3.
    apply ill_tps_perm, Permutation_sym; auto.
  Qed.

  Fact ill_sequent_tps_eq  Γ A : [< Γ |- A >] vec_zero <-> forall x, [[Γ]] x -> ⟦A⟧ x.
  Proof.
    split.
    * intros H x Hx.
      rewrite <- vec_zero_plus, vec_add_comm.
      apply (H x); trivial.
    * intros H x Hx.
      rewrite vec_add_comm, vec_zero_plus; auto.
  Qed.

  Theorem ill_tps_sound Γ A : Γ ⊢ A -> [< Γ |- A >] vec_zero.
  Proof.
    induction 1 as [ A
                   | Γ Δ A B H1 IH1 H2 IH2
                   | Γ Δ A H1 H2 IH2
                   | Γ Δ A B C H1 IH1 H2 IH2
                   | Γ A B H1 IH1
                   | Γ A B C H1 IH1
                   | Γ A B C H1 IH1
                   | Γ A B H1 IH1 H2 IH2
                   | Γ A B H1 IH1
                   | Γ A H1 IH1
                   | Γ A B H1 IH1
                   | Γ A B H1 IH1
                   | Γ A B C H1 IH1
                   | Γ Δ A B H1 IH1 H2 IH2
                   | Γ A B C H1 IH1 H2 IH2
                   | Γ A B H1 IH1
                   | Γ A B H1 IH1
                   | Γ A
                   | Γ
                   | Γ A H1 IH1
                   |
                   ]; unfold ill_sequent_tps in * |- *.

    + intros x; simpl; intros (a & b & H1 & H2 & H3); subst; eq goal H2.
      f_equal; do 2 rewrite vec_add_comm, vec_zero_plus; auto.

    (* Cut Rule *)

    + intros x Hx.
      rewrite ill_tps_app in Hx.
      apply IH2.
      destruct Hx as (a & b & G1 & G2 & G3); subst.
      exists a, b; split; auto.
      split; auto.
      rewrite <- vec_zero_plus, vec_add_comm.
      apply IH1; auto.

    + revert IH2; apply ill_perm_tps; auto.

    + intros x (y & z & H3 & H4 & H5); simpl.
      apply IH2.
      apply ill_tps_app in H5.
      destruct H5 as (g & d & H5 & H6 & H7).
      simpl in H4.
      apply IH1, H4 in H6.
      exists (vec_plus y g), d; repeat split; auto.
      * subst; apply vec_add_assoc.
      * eq goal H6; f_equal; rew vec.

    + simpl; intros y Hy a Ha.
      rewrite vec_add_assoc.
      apply IH1.
      exists a, y; repeat split; auto; lia.

    + intros x (a & b & H2 & H3 & H4); apply IH1.
      exists a, b; repeat split; auto; apply H3.

    + intros x (a & b & H2 & H3 & H4); apply IH1.
      exists a, b; repeat split; auto; apply H3.

    + intros x Hx; split.
      * apply IH1; auto.
      * apply IH2; auto.

    + intros x (a & g & H2 & H3 & H4).
      apply IH1; exists a, g; repeat split; auto.
      apply H3.

    + intros x Hx; split.
      apply IH1; auto.
      rew vec.
      apply ill_tps_lbang in Hx; tauto.

    + intros x (a & g & H2 & H3 & H4).
      apply IH1.
      apply proj2 in H3; subst; auto.
      rew vec; auto.

    + intros x (a & g & H2 & H3 & H4).
      apply IH1.
      exists a, g.
      repeat (split; auto).
      exists a, g.
      repeat (split; auto).
      apply proj2 in H3.
      subst; rew vec; auto.

    (* ⊗ left *)

    + intros x Hx.
      apply IH1.
      destruct Hx as (c & g & ? & (a & b & ? & H2 & H3) & H4); subst.
      exists a, (vec_plus b g); split; auto.
      * rewrite vec_add_assoc; trivial.
      * split; auto; exists b, g; auto.

    (* ⊗ right *)

    + intros x Hx.
      apply ill_tps_app in Hx.
      destruct Hx as (a & b & ? & H3 & H4); subst.
      exists a, b; split.
      * rewrite vec_add_comm, vec_zero_plus; auto.
      * split; rewrite <- vec_zero_plus, vec_add_comm.
        - apply IH1; auto.
        - apply IH2; auto.

    (* ⊕ left & ⊕ right 1 & 2 *)

    + intros x Hx.
      destruct Hx as (u & g & ? & [ G1 | G1 ] & G2); subst.
      * apply IH1; exists u, g; auto.
      * apply IH2; exists u, g; auto.
    + intros x Hx; left; apply IH1; auto.
    + intros x Hx; right; apply IH1; auto.

    (* ⟘ left, ⟙ right *)

    + intros ? (? & _ & _ & [] & _).
    + intros x _; red; trivial.

    (* 𝝐 unit left & right *)

    + intros x (i & g & ? & H2 & H3); subst.
      red in H2; subst.
      rewrite vec_zero_plus.
      apply IH1; auto.
    + intros x Hx; red in Hx; subst.
      rewrite vec_zero_plus; red; trivial.
  Qed.

  (* This semantics is NOT complete for ILL
     or even the (!,&,-o) fragment but it is
     complete for the EILL fragment *)

End trivial_phase_semantics.


(* * Addendum for Vectors ([Vector.t]) *)
(* Author: Maximilian Wuttke *)

From Undecidability.Shared.Libs.PSL Require Import Prelim Tactics.Tactics EqDec.
From Coq.Vectors Require Import Fin Vector.
From Undecidability.Shared.Libs.PSL Require Import Vectors.FinNotation.
From Undecidability.Shared.Libs.PSL Require Export Vectors.Fin.

(* Vector.nth should not reduce with simpl, except the index is given with a constructor *)
Arguments Vector.nth {A} {m} (v') !p.
Arguments Vector.map {A B} f {n} !v.
Arguments Vector.map2 {A B C} g {n} !v1 !v2.

Tactic Notation "dependent" "destruct" constr(V) :=
  match type of V with
  | Vector.t ?Z (S ?n) =>
    revert all except V;
    pattern V; revert n V;
    eapply caseS; intros
  | Vector.t ?Z 0 =>
    revert all except V;
    pattern V; revert V;
    eapply case0; intros
  | Fin.t 0 => inv V
  | Fin.t (S ?n) =>
    let pos := V in
    revert all except pos;
    pattern pos; revert n pos;
    eapply Fin.caseS; intros
  | _ => fail "Wrong type"
  end.

Delimit Scope vector_scope with vector.
Local Open Scope vector.

Module VectorNotations2.

Notation "[ | | ]" := (nil _) (format "[ |  | ]"): vector_scope.
Notation "h ':::' t" := (cons _ h _ t) (at level 60, right associativity) : vector_scope.

Notation "[ | x | ]" := (x ::: [| |]) : vector_scope.
Notation "[ | x ; y ; .. ; z | ] " := (cons _ x _ (cons _ y _ .. (cons _ z _ (nil _)) ..))
   (format "[ | x ;  y ;  .. ;  z | ] ") : vector_scope.
Notation "v [@ p ]" := (nth v p) (at level 1, format "v [@ p ]") : vector_scope.

End VectorNotations2.

Import VectorNotations2.

Ltac existT_eq :=
  match goal with
  | [ H: existT ?X1 ?Y1 ?Z1 = existT ?X2 ?Y2 ?Z2 |- _] =>
    apply EqdepFacts.eq_sigT_iff_eq_dep in H; inv H
  end.

Ltac existT_eq' :=
  match goal with
  | [ H: existT ?X1 ?Y1 ?Z1 = existT ?X2 ?Y2 ?Z2 |- _] =>
    apply EqdepFacts.eq_sigT_iff_eq_dep in H; induction H
  end.

Lemma vect_map_injective X Y n (f : X -> Y) (v1 v2 : Vector.t X n) :
  (forall x y, f x = f y -> x = y) ->
  map f v1 = map f v2 -> v1 = v2.
Proof.
  intros Inj Eq.
  induction n; cbn in *.
  - dependent destruct v1. dependent destruct v2; reflexivity.
  - dependent destruct v1. dependent destruct v2. cbn in *.
    eapply cons_inj in Eq as (-> % Inj &?). f_equal. now apply IHn.
Qed.

Lemma replace_nth X n (v : Vector.t X n) i (x : X) :
  (Vector.replace v i x) [@i] = x.
Proof.
  induction i; dependent destruct v; cbn; auto.
Qed.

Lemma replace_nth2 X n (v : Vector.t X n) i j (x : X) :
  i <> j -> (Vector.replace v i x) [@j] = v[@j].
Proof.
  revert v. pattern i, j. revert n i j.
  eapply Fin.rect2; intros; try congruence.
  - revert f H. pattern v. revert n v.
    eapply Vector.caseS.
    cbn. reflexivity.
  - revert f H. pattern v. revert n v.
    eapply Vector.caseS.
    cbn. reflexivity.
  - revert g f H H0. pattern v. revert n v.
    eapply Vector.caseS. firstorder congruence.
Qed.

Lemma destruct_vector_nil (X : Type) :
  forall v : Vector.t X 0, v = [| |].
Proof.
  now apply case0.
Qed.

Lemma destruct_vector_cons (X : Type) (n : nat) :
  forall v : Vector.t X (S n), { h : X & { v' : Vector.t X n | v = h ::: v' }}.
Proof.
  revert n. apply caseS. eauto.
Qed.

Lemma In_nil (X : Type) (x : X) :
  ~ In x [| |].
Proof. intros H. inv H. Qed.

Lemma In_cons (X : Type) (n : nat) (x y : X) (xs : Vector.t X n) :
  In y (x ::: xs) -> x = y \/ In y xs.
Proof.
  intros H. inv H; existT_eq'; tauto.
Qed.

Ltac destruct_vector_in :=
  lazymatch goal with
  | [ H: Vector.In _ [| |] |- _ ] => solve [exfalso;simple apply In_nil in H;exact H]
  | [ H: Vector.In _ (?x ::: _) |- _ ] => simple apply In_cons in H as [H| H] ; try (is_var x;move H at bottom;subst x)
  end.

(*
Goal ~ Vector.In 10 [|1;2;4|].
Proof.
  intros H. repeat destruct_vector_in; congruence.
Qed.
*)

Section In_Dec.
  Variable X : Type.
  Hypothesis X_dec : eq_dec X.

  Fixpoint in_dec (n : nat) (x : X) (xs : Vector.t X n) { struct xs } : bool :=
    match xs with
    | [| |] => false
    | y ::: xs' => if Dec (x = y) then true else in_dec x xs'
    end.

  Lemma in_dec_correct (n : nat) (x : X) (xs : Vector.t X n) :
    in_dec x xs = true <-> In x xs.
  Proof.
    split; intros.
    {
      induction xs; cbn in *.
      - congruence.
      - decide (x = h) as [ -> | D].
        + constructor.
        + constructor. now apply IHxs.
    }
    {
      induction H; cbn.
      - have (x = x).
      - decide (x = x0).
        + reflexivity.
        + apply IHIn.
    }
  Qed.

  Global Instance In_dec (n : nat) (x : X) (xs : Vector.t X n) : dec (In x xs).
  Proof. eapply dec_transfer. eapply in_dec_correct. auto. Defined.

End In_Dec.

(* Destruct a vector of known size *)
Ltac destruct_vector :=
  repeat match goal with
         | [ v : Vector.t ?X 0 |- _ ] =>
           let H  := fresh "Hvect" in
           pose proof (@destruct_vector_nil X v) as H;
           subst v
         | [ v : Vector.t ?X (S ?n) |- _ ] =>
           let h  := fresh "h" in
           let v' := fresh "v'" in
           let H  := fresh "Hvect" in
           pose proof (@destruct_vector_cons X n v) as (h&v'&H);
           subst v; rename v' into v
         end.

Section In_nth.
  Variable (A : Type) (n : nat).

  Lemma vect_nth_In (v : Vector.t A n) (i : Fin.t n) (x : A) :
    Vector.nth v i = x -> Vector.In x v.
  Proof.
    induction n; cbn in *.
    - inv i.
    - dependent destruct v. dependent destruct i; cbn in *; subst; econstructor; eauto.
  Qed.

  Lemma vect_nth_In' (v : Vector.t A n) (x : A) :
    Vector.In x v -> exists i : Fin.t n, Vector.nth v i = x.
  Proof.
    induction n; cbn in *.
    - inversion 1.
    - dependent destruct v. destruct_vector_in.
      + exists Fin.F1. auto.
      + specialize (IHn0 _ H) as (i&<-). exists (Fin.FS i). auto.
  Qed.

End In_nth.

Section tabulate_vec.
  Variable X : Type.

  Fixpoint tabulate (n : nat) (f : Fin.t n -> X) {struct n} : Vector.t X n.
  Proof.
    destruct n.
    - apply Vector.nil.
    - apply Vector.cons.
      + apply f, Fin.F1.
      + apply tabulate. intros m. apply f, Fin.FS, m.
  Defined.

  Lemma nth_tabulate n (f : Fin.t n -> X) (m : Fin.t n) :
    Vector.nth (tabulate f) m = f m.
  Proof.
    induction m.
    - cbn. reflexivity.
    - cbn. rewrite IHm. reflexivity.
  Qed.

  Lemma in_tabulate n (f : Fin.t n -> X) (x : X) :
    In x (tabulate (n := n) f) <-> exists i : Fin.t n, x = f i.
  Proof.
    split.
    {
      revert f x. induction n; intros f x H.
      - cbn in *. inv H.
      - cbn in *. apply In_cons in H as [ <- | H ].
        + eauto.
        + specialize (IHn (fun m => f (Fin.FS m)) _ H) as (i&IH). eauto.
    }
    {
      intros (i&Hi). induction i; cbn in *; subst; econstructor; eauto.
    }
  Qed.

  Lemma Vector_tabulate_const {n} (c : X) f :
  (forall n, f n = c) ->
  tabulate f = Vector.const c n.
  Proof.
  induction n; cbn.
  - reflexivity.
  - intros. rewrite H. f_equal. eapply IHn. intros. eapply H.
  Qed.

End tabulate_vec.

Lemma Vector_map_tabulate {X Y n} (f : X -> Y) g :
  Vector.map (n:=n) f (tabulate g) = tabulate (fun x => f (g x)).
Proof.
induction n; cbn.
- reflexivity.
- f_equal. eapply IHn.
Qed.

Lemma const_at n X (c : X) i :
  (Vector.const c n)[@i] = c.
Proof.
  induction i; cbn; eauto.
Qed.

(*
Lemma vec_replace_nth X x n (t : Vector.t X n) (i : Fin.t n) :
  x = Vector.nth (Vector.replace t i x) i.
Proof.
  induction i; dependent destruct t; simpl; auto.
Qed.

Lemma vec_replace_nth_nochange X x n (t : Vector.t X n) (i j : Fin.t n) :
  Fin.to_nat i <> Fin.to_nat j -> Vector.nth t i = Vector.nth (Vector.replace t j x) i.
Proof.
  revert j. induction i; dependent destruct t; dependent destruct j; simpl; try tauto.
  apply IHi. contradict H. cbn. now rewrite !H.
Qed.
 *)

#[global]
Instance Vector_eq_dec n A: eq_dec A -> eq_dec (Vector.t A n).
Proof.
  intros H x y. eapply VectorEq.eq_dec with (A_beq := fun x y => proj1_sig (Sumbool.bool_of_sumbool (H x y))).
  intros ? ?. destruct (Sumbool.bool_of_sumbool).
  cbn.  destruct x1;intuition.
Defined.

#[global]
Instance Fin_eq_dec n : eq_dec (Fin.t n).
Proof.
  intros; hnf.
  destruct (Fin.eqb x y) eqn:E.
  - left. now eapply Fin.eqb_eq.
  - right. intros H. eapply Fin.eqb_eq in H. congruence.
Defined.

Import VectorNotations.
Lemma Vector_map_app {X Y k1 k2} (v1 : Vector.t X k1) (v2 : Vector.t X k2) (f : X -> Y) :
  Vector.map f (v1 ++ v2)%vector = Vector.map f v1 ++ Vector.map f v2.
Proof.
  induction v1; cbn; congruence.
Qed.

Lemma Vector_in_app {X n1 n2} (x : X) (v1 : Vector.t X n1) (v2 : Vector.t X n2):
  Vector.In x (v1 ++ v2) <-> Vector.In x v1 \/ Vector.In x v2.
Proof.
  induction v1; cbn.
  - firstorder. inversion H.
  - split.
    + intros [-> | H] % In_cons.
      * left. econstructor.
      * eapply IHv1 in H as [ | ]; eauto. left. now econstructor.
    + intros [ [ -> | ] % In_cons | ]; econstructor; intuition.
Qed.

Lemma vect_in_map (X Y : Type) (n : nat) (f : X -> Y) (V : Vector.t X n) (x : X) :
  In x V -> In (f x) (map f V).
Proof. induction 1; cbn; constructor; auto. Qed.

Lemma vect_in_map_iff (X Y : Type) (n : nat) (f : X -> Y) (V : Vector.t X n) (y : Y) :
  In y (map f V) <-> (exists x : X, f x = y /\ In x V).
Proof.
  split.
  - intros H. induction V; cbn in *.
    + inv H.
    + apply In_cons in H as [ <- | H].
      * exists h. split; auto. now constructor 1.
      * specialize (IHV H) as (x&Hx1&Hx2). exists x. split; auto. now constructor 2.
  - intros (x&<-&H). now apply vect_in_map.
Qed.

Lemma In_replace (X : Type) (n : nat) (xs : Vector.t X n) (i : Fin.t n) (x y : X) :
  In y (replace xs i x) -> (x = y \/ In y xs).
Proof.
  revert i x y. induction xs; intros; cbn in *.
  - inv i.
  - dependent destruct i; cbn in *; apply In_cons in H as [-> | H]; auto; try now (right; constructor).
    specialize (IHxs _ _ _ H) as [-> | IH]; [ now left | right; now constructor ].
Qed.

Lemma In_replace' (X : Type) (n : nat) (xs : Vector.t X n) (i : Fin.t n) (x y : X) :
  In y (replace xs i x) -> x = y \/ exists j, i <> j /\ xs[@j] = y.
Proof.
  revert i x y. induction xs; intros; cbn -[nth] in *.
  - inv i.
  - dependent destruct i; cbn -[nth] in *.
    + apply In_cons in H as [->|H].
      * tauto.
      * apply vect_nth_In' in H as (j&H). right. exists (Fin.FS j). split. discriminate. cbn. assumption.
    + apply In_cons in H as [->|H].
      * right. exists Fin.F1. split. discriminate. cbn. reflexivity.
      * specialize (IHxs _ _ _ H) as [-> | (j&IH1&IH2)]; [ tauto | ].
        right. exists (Fin.FS j). split. now intros -> % Fin.FS_inj. cbn. assumption.
Qed.

(* Tactic for simplifying a hypothesis of the form [In x v] *)

Ltac simpl_vector_inv :=
  repeat match goal with
         | [ H : [| |] = (_ ::: _) |- _ ] => solve [discriminate H]
         | [ H : (_ ::: _) = [| |]  |- _ ] => solve [discriminate H]
         | [ H : Fin.F1 = Fin.FS _ |- _] => solve [discriminate H]
         | [ H : Fin.FS _ = Fin.F1 |- _] => solve [discriminate H]
         | [ H : Fin.FS ?i = Fin.FS ?j |- _] =>
           simple apply Fin.FS_inj in H;
           first [is_var i;move H at bottom;subst i | is_var j;move H at bottom;subst j | idtac]
         end.

Ltac simpl_vector_in :=
  repeat
    match goal with
    | _ => first
            [ progress destruct_vector_in
            | progress simpl_vector_inv
            | progress auto
            | congruence
            ]
    | [ H : Vector.In _ (Vector.map _ _) |- _] =>
      let x := fresh "x" in
      eapply vect_in_map_iff in H as (x&<-&H)
    | [ H : Vector.In _ (Vector.map _ _) |- _] =>
      let x := fresh "x" in
      let H' := fresh H in
      eapply vect_in_map_iff in H as (x&H&H')
    | [ H : Vector.In _ (tabulate _) |- _ ] =>
      let i := fresh "i" in
      apply in_tabulate in H as (i&->)
    | [ H : Vector.In _ (tabulate _) |- _ ] =>
      let i := fresh "i" in
      let H := fresh "H" in
      apply in_tabulate in H as (i&H)
    end.

Ltac vector_not_in :=
  let H := fresh "H" in
  intros H; simpl_vector_in.

Goal Vector.In (Fin.F1 (n := 10)) [|Fin1; Fin2; Fin3 |] -> False.
Proof. intros H. simpl_vector_in. Qed.

Goal Vector.In (Fin.F1 (n := 10)) (map (Fin.FS) [|Fin0; Fin1; Fin2|]) -> False.
Proof. intros H. simpl_vector_in. Qed.

Inductive Vector_In2 {A : Type} (a : A) : forall {n}, t A n -> Type :=
| vec_inB {n} (v : t A n) : Vector_In2 a (cons A a n v)
| vec_inS a' {n} (v : t A n) : Vector_In2 a v -> Vector_In2 a (cons A a' n v).
#[global] Hint Constructors Vector_In2 : core.

(* Conversion between vectors and lists *)
Module VecToListCoercion.
  Coercion Vector.to_list : Vector.t >-> list.
End VecToListCoercion.

Import VecToListCoercion.

Lemma tolist_In (X : Type) (n : nat) (xs : Vector.t X n) (x : X) :
  Vector.In x xs <-> List.In x xs.
Proof.
  split; intros H.
  - induction H; cbn; auto.
  - induction xs; cbn in *; auto. destruct H as [-> | H]; econstructor; eauto.
Qed.

Arguments Vector.eqb {_}  _ {_ _}.

Lemma vector_eqb_spec X n eqb:
  (forall (x1 x2 : X) , reflect (x1 = x2) (eqb x1 x2))
  -> forall x y , reflect (x=y) (Vector.eqb (n:=n) eqb x y).
Proof with try (constructor;congruence).
  intros Hf x y.
  apply iff_reflect. symmetry. apply Vector.eqb_eq. symmetry. apply reflect_iff. eauto.
Qed.

Lemma vector_to_list_inj (X : Type) (n : nat) (xs ys : Vector.t X n) :
  Vector.to_list xs = Vector.to_list ys -> xs = ys.
Proof.
  revert ys. induction xs as [ | x n xs IH]; intros; cbn in *.
  - destruct_vector. reflexivity.
  - destruct_vector. cbn in *. inv H. f_equal. auto.
Qed.

Lemma vector_to_list_length (X : Type) (n : nat) (xs : Vector.t X n) :
  length(Vector.to_list xs) = n.
Proof.
  induction xs as [ | x n xs IH].
  - now cbn.
  - change (S (length xs) = S n). congruence.
Qed.

Lemma vector_rev_append_tail_to_list A (n m: nat) (v : Vector.t A n) (w : Vector.t A m):
Vector.to_list (Vector.rev_append_tail v w) = (List.rev (Vector.to_list v) ++ Vector.to_list w)%list.
Proof.
  unfold Vector.to_list. revert v m w. induction n;intros v;dependent destruct v;cbn. reflexivity.
  intros. specialize IHn with (w:=h:::w). cbn in *. rewrite IHn. autorewrite with list. easy.
Qed.

Lemma vector_rev_to_list A (n : nat) (v : Vector.t A n):
  Vector.to_list (Vector.rev v) = List.rev (Vector.to_list v).
Proof.
  unfold Vector.rev,Vector.rev_append.
  specialize (vector_rev_append_tail_to_list v [| |]) as H'. cbn in H'.
  autorewrite with list in H'. rewrite <- H'. generalize (Vector.rev_append_tail v [| |]).
  generalize (Plus.plus_tail_plus n 0). generalize (Plus.tail_plus n 0). generalize (plus_n_O n).
  intros -> ? <-. rewrite <- plus_n_O. reflexivity.
Qed.

Lemma vector_map_to_list A B (f : A -> B)(n : nat) (v : Vector.t A n):
  Vector.to_list (Vector.map f v) = List.map f (Vector.to_list v).
Proof.
  unfold Vector.map, Vector.to_list. revert v;induction n;intros v;dependent destruct v;cbn. easy. now rewrite IHn.
Qed.

Lemma eq_nth_iff' X n (v w : Vector.t X n):
  (forall i : Fin.t n, v[@i] = w[@i]) -> v = w.
Proof. intros. eapply Vector.eq_nth_iff. now intros ? ? ->. Qed.

Lemma vector_fold_right_to_list (A B : Type) (f : A -> B -> B) (n : nat) (v : Vector.t A n) (a : B):
      Vector.fold_right f v a = List.fold_right f a (Vector.to_list v).
Proof.
  unfold Vector.to_list. induction n. all:destruct_vector. all:cbn;congruence.
Qed.
Lemma vector_fold_left_to_list (A B : Type) (f : A -> B -> A) (n : nat) (v : VectorDef.t B n) (a : A):
  VectorDef.fold_left f a v = List.fold_left f (Vector.to_list v) a.
Proof.
  unfold Vector.to_list. induction n in v,a|-*. all:destruct_vector. all:cbn;congruence.
Qed.

Lemma vector_fold_left_right (A B : Type) (f : A -> B -> A) (n : nat) (v : VectorDef.t B n) (a : A):
  Vector.fold_left f a v = Vector.fold_right (fun x y => f y x) (Vector.rev v) a.
Proof.
  rewrite vector_fold_right_to_list, vector_fold_left_to_list.
  setoid_rewrite <- List.rev_involutive at 2. rewrite List.fold_left_rev_right. f_equal.
  rewrite vector_rev_to_list,List.rev_involutive. easy.
Qed.

Local Arguments Fin.of_nat_lt _ {_} _.

Lemma vector_nth_rev_append_tail_r' X n n' (v : Vector.t X n) (v' : Vector.t X n') i (i':=proj1_sig (Fin.to_nat i))
  j (H: i' = n + j) H':
  (Vector.rev_append_tail v v') [@ i] = v'[@ Fin.of_nat_lt j H'].
Proof.
  revert dependent n'. revert j.
  induction v; cbn; intros.
  {f_equal. subst j. erewrite Fin.of_nat_ext, Fin.of_nat_to_nat_inv. easy. }
  cbn. intros.
  erewrite IHv with (v':=h::v') (j:=S j). 2:nia. cbn.
  f_equal. eapply Fin.of_nat_ext.
  Unshelve. nia.
Qed.

Lemma vector_nth_rev_append_tail_r X n n' (v : Vector.t X n) (v' : Vector.t X n') i (i':=proj1_sig (Fin.to_nat i))
  (H : n <= i') H':
  (Vector.rev_append_tail v v') [@ i] = v'[@ Fin.of_nat_lt (i' - n) H'].
Proof.
  revert dependent n'.
  induction v;cbn;intros.
  {f_equal. revert H'. rewrite Nat.sub_0_r. intro. erewrite Fin.of_nat_ext, Fin.of_nat_to_nat_inv. easy. }
  unshelve erewrite IHv with (v':=h::v'). 3:nia. 1:abstract (clear - H'; nia).
  generalize (vector_nth_rev_append_tail_r_subproof n n' i H').
  destruct (proj1_sig (Fin.to_nat i) - n) eqn:H''. nia.
  cbn. intros. f_equal. revert H'. replace (proj1_sig (Fin.to_nat i) - S n) with n0 by nia.
  intros. apply Fin.of_nat_ext.
Qed.

Lemma vector_nth_rev_append_tail_l X n n' (v : Vector.t X n) (v' : Vector.t X n') i (i':=proj1_sig (Fin.to_nat i))
  (H: i' < n) H':
  (Vector.rev_append_tail v v') [@ i] = v[@ Fin.of_nat_lt (n-1-i') H'].
Proof.
  revert dependent n'.
  induction v;cbn;intros. nia.
  revert H'. destruct (n - 0 - proj1_sig (Fin.to_nat i)) eqn:H';cbn.
  - unshelve erewrite vector_nth_rev_append_tail_r. 3:nia. 1:abstract nia.
    generalize (vector_nth_rev_append_tail_l_subproof n n' i H H').
    destruct (proj1_sig (Fin.to_nat i) - n) eqn:H''. 2:nia.
    reflexivity.
  - unshelve erewrite IHv. 3:nia. 1:abstract nia. intros. f_equal.
    generalize (vector_nth_rev_append_tail_l_subproof0 n n' i H n0 H').
    replace (n - 1 - proj1_sig (Fin.to_nat i)) with n0. 2:nia.
    intros. eapply Fin.of_nat_ext.
Qed.

Lemma vector_nth_rev X n (v : Vector.t X n) i H':
  (Vector.rev v) [@ i] = v[@ Fin.of_nat_lt (n -1-proj1_sig (Fin.to_nat i)) H'].
Proof.
  unfold Vector.rev, Vector.rev_append.
  specialize (vector_nth_rev_append_tail_l v []). cbn zeta.
  generalize (Vector.rev_append_tail v []). generalize (Plus.plus_tail_plus n 0).
  generalize (Plus.tail_plus n 0). generalize (plus_n_O n). generalize (n+0).
  intros ? -> ? <- ? H. apply H. now destruct Fin.to_nat.
Qed.

Lemma Vector_nth_L {X k1 k2} (v1 : Vector.t X k1) (v2 : Vector.t X k2) i :
  (v1 ++ v2)[@ Fin.L k2 i] = v1[@i].
Proof.
  revert k2 v2 i.
  induction v1; intros.
  - pattern i. apply Fin.case0.
  - apply (Fin.caseS' i).
    + reflexivity.
    + cbn. eapply IHv1.
Qed.

Lemma Vector_nth_R {X k1 k2} (v1 : Vector.t X k1) (v2 : Vector.t X k2) i :
  (v1 ++ v2)[@ Fin.R k1 i] = v2[@i].
Proof.
  revert k2 v2 i.
  induction v1; intros.
  - reflexivity.
  - cbn. eapply IHv1.
Qed.


From SMTCoq Require Import SMTCoq.
From SMTCoq Require Import PArray Int63.
Require Import GCHQ.

Definition finterp h1 h9 h2 h3 h4 h5 h6 h7 h8 :=
  hinterp h2 h3 h4 h5 h6 h7 h8 h9 h1.

Definition tr (z : Z) : bool.
exact true.
Qed.

Definition tt (i : int) := tr (to_Z i).

Definition pb := pb1.

Time Definition tt1 :=
   Eval vm_compute in  finterp (gen_all pb) tt.

Time Definition tt2 :=
  Eval lazy delta[tt1 mk_andb mk_orb
     seq.head seq.foldl seq.behead] iota beta in
  tt1 true false
  Bool.eqb mk_andb mk_implb mk_orb Datatypes.negb.

Ltac end_tac v :=
  let w := eval compute in v in
idtac w;
(timeout 30 (
    try (
     assert (Datatypes.implb tt2 ((tr w))); [
                          unfold tt2; verit | idtac];
                                  idtac "ho"; fail 1);
      idtac "false"; exact false)) ||
idtac "true"; exact true.

Ltac col i j n :=
  let u := constr:(Zeq_bool j n) in
  let v := eval compute in u in
     match v with true => exact nil
                 |false => apply cons;
                           [end_tac (i * n + j)%Z|
                            col i (j + 1)%Z n]
     end.

Ltac row i n :=
  let u := constr:(Zeq_bool i n) in
  let v := eval compute in u in
     match v with true => exact nil
                 |false => apply cons;
                           [col i 0%Z n|
                            row (i + 1)%Z n]
     end.

Definition s0 : list bool.
col 0 0 (Z.of_nat (p_size pb)).
Defined.