From iris.algebra Require Import auth agree gmap excl.
From iris.base_logic Require Export invariants.
From iris.proofmode Require Import tactics.
From cap_machine Require Import stdpp_extra.
Import uPred.

(** The CMRA for the heap of STS.
    We distinguish between the standard and owned sts. *)

(** For shared resources, we register the state. *)

Definition sts_std_stateUR (A B : Type) {eqD: EqDecision A} {count: Countable A} := authUR (gmapUR A (exclR (leibnizO B))).
Definition STS_std_states (A B : Type) {eqD: EqDecision A} {count: Countable A} : Type := gmap A B.

(** For owned resources, we register the state and the transition relation. *)

Definition sts_stateUR := authUR (gmapUR positive (exclR (leibnizO positive))).
Definition sts_relUR :=
  authUR (gmapUR positive (agreeR (leibnizO ((positive → positive → Prop) * (positive → positive → Prop))))).

Definition STS_states : Type := gmap positive positive.
Definition STS_rels : Type := gmap positive ((positive → positive → Prop) * (positive → positive → Prop)).

(** Standard STS. *)
Class STS_STD (B : Type) :=
  { Rpub : relation B;
    Rpriv : relation B;}.

(** The CMRA for the sts collection. *)
Class STS_preG A B Σ `{EqDecision A, Countable A} :=
  { sts_pre_state_inG :> inG Σ sts_stateUR;
    sts_pre_std_state_inG :> inG Σ (sts_std_stateUR A B);
    sts_pre_rel_inG :> inG Σ sts_relUR; }.

Class STSG A B Σ `{EqDecision A, Countable A} :=
  { sts_state_inG :> inG Σ sts_stateUR;
    sts_std_state_inG :> inG Σ (sts_std_stateUR A B);
    sts_rel_inG :> inG Σ sts_relUR;
    γs_std : gname;
    γs_loc : gname;
    γr_loc : gname;}.

Definition STS_preΣ A B `{EqDecision A, Countable A} :=
  #[ GFunctor sts_stateUR;
     GFunctor (sts_std_stateUR A B);
     GFunctor sts_relUR ].

Instance subG_STS_preΣ A B `{EqDecision A, Countable A} {Σ} :
  subG (STS_preΣ A B) Σ → STS_preG A B Σ.
Proof.
  (* hack: solve_inG does not currently unfold [subG X _] where X has more than
     4 parameters. We have 5. *)
  set f := STS_preΣ A B. unfold STS_preΣ in f.
  solve_inG.
Qed.

Section definitionsS.

  Context {A B C D: Type} {Σ : gFunctors} {eqa: EqDecision A} {count: Countable A}
          {sts_std: STS_STD B} {eqc : EqDecision C} {countC: Countable C}
          {eqd : EqDecision D} {countD: Countable D} {stsg : STSG A B Σ}.
  Notation STS := (leibnizO (STS_states * STS_rels)).
  Notation STS_STD := (leibnizO (STS_std_states A B)).
  Notation WORLD := (prodO STS_STD STS).
  Implicit Types W : WORLD.

  Program Definition sts_state_std (i : A) (x : B) : iProp Σ
    := own (γs_std (A:=A)) (◯ {[ i := Excl x ]}).

  Definition sts_state_loc (i : positive) (y : D) : iProp Σ
    := own (γs_loc (A:=A)) (◯ {[ i := Excl (encode y) ]}).

  Definition convert_rel {D : Type} `{Countable D} (R : D → D → Prop) : positive → positive → Prop :=
    λ x y, ∃ a b, x = encode a ∧ y = encode b ∧ R a b.

  Definition sts_rel_loc (i : positive) (R : D → D → Prop) (P : D → D → Prop) : iProp Σ :=
    own (γr_loc (A:=A)) (◯ {[ i := to_agree ((convert_rel R,convert_rel P)) ]}).

  Program Definition sts_full γs γr (fs : STS_states) (fr : STS_rels) : iProp Σ
    := (own (A := sts_stateUR) γs (● (Excl <$> fs))
            ∗ own (A := sts_relUR) γr (● (to_agree <$> fr)))%I.
  Program Definition sts_full_std γs (fs : STS_std_states A B) : iProp Σ
    := own (A := sts_std_stateUR A B) γs (● (Excl <$> fs))%I.
  Program Definition sts_full_world W : iProp Σ :=
    ((sts_full_std (γs_std (A:=A)) W.1) ∗ (sts_full (γs_loc (A:=A)) (γr_loc (A:=A)) W.2.1 W.2.2))%I.

  Definition related_sts_std_pub (fs gs : STS_std_states A B) : Prop :=
    dom (gset A) fs ⊆ dom (gset A) gs ∧
    ∀ i x y, fs !! i = Some x → gs !! i = Some y → rtc (Rpub) x y.

  Definition related_sts_std_priv (fs gs : STS_std_states A B) : Prop :=
    dom (gset A) fs ⊆ dom (gset A) gs ∧
    ∀ i x y, fs !! i = Some x → gs !! i = Some y → rtc (λ x y, (Rpub x y ∨ Rpriv x y)) x y.

  Definition related_sts_pub (fs gs : STS_states) (fr gr : STS_rels) : Prop :=
    dom (gset positive) fs ⊆ dom (gset positive) gs ∧
    dom (gset positive) fr ⊆ dom (gset positive) gr ∧
    ∀ i r1 r2 r1' r2', fr !! i = Some (r1,r2) → gr !! i = Some (r1',r2') →
                       r1 = r1' ∧ r2 = r2' ∧
                       (∀ x y, fs !! i = Some x → gs !! i = Some y → rtc r1 x y).

  Definition related_sts_priv (fs gs : STS_states) (fr gr : STS_rels) : Prop :=
    dom (gset positive) fs ⊆ dom (gset positive) gs ∧
    dom (gset positive) fr ⊆ dom (gset positive) gr ∧
    ∀ i r1 r2 r1' r2', fr !! i = Some (r1,r2) → gr !! i = Some (r1',r2') →
                       r1 = r1' ∧ r2 = r2' ∧
                       (∀ x y, fs !! i = Some x → gs !! i = Some y → (rtc (λ x y, (r1 x y ∨ r2 x y)) x y)).

  Definition related_sts_pub_world W W' :=
    related_sts_std_pub W.1 W'.1 ∧
    related_sts_pub W.2.1 W'.2.1 W.2.2 W'.2.2.

  Definition related_sts_priv_world W W' :=
    related_sts_std_priv W.1 W'.1 ∧
    related_sts_priv W.2.1 W'.2.1 W.2.2 W'.2.2.

  Global Instance sts_rel_loc_Persistent i R P : Persistent (sts_rel_loc i R P).
  Proof. apply _. Qed.

  Global Instance sts_rel_loc_Timeless i R P : Timeless (sts_rel_loc i R P).
  Proof. apply _. Qed.

  Global Instance sts_state_std_Timeless i x : Timeless (sts_state_std i x).
  Proof. apply _. Qed.
  Global Instance sts_state_loc_Timeless i x : Timeless (sts_state_loc i x).
  Proof. apply _. Qed.

  Global Instance sts_full_Timeless γs γr fs fr : Timeless (sts_full γs γr fs fr).
  Proof. apply _. Qed.
  Global Instance sts_full_world_Timeless W : Timeless (sts_full_world W).
  Proof. apply _. Qed.

End definitionsS.

Typeclasses Opaque sts_state_std sts_state_loc sts_rel_loc sts_full
            related_sts_pub related_sts_priv.

Lemma convert_rel_of_rel {A} `{EqDecision A, Countable A} (R: A -> A -> Prop) x y:
  R x y → convert_rel R (encode x) (encode y).
Proof. rewrite /convert_rel. eauto. Qed.

Lemma rel_of_convert_rel {A} `{EqDecision A, Countable A} (R: A -> A -> Prop) x y:
  convert_rel R (encode x) (encode y) → R x y.
Proof.
  rewrite /convert_rel. intros (?&?&HH1&HH2&?).
  apply encode_inj in HH1.
  apply encode_inj in HH2. subst; eauto.
Qed.

Section pre_STS.
  Context {A B C D: Type} {Σ : gFunctors} {eqa: EqDecision A} {count: Countable A}
          {sts_std: STS_STD B} {eqc : EqDecision C} {countC: Countable C}
          {eqd : EqDecision D} {countD: Countable D} {sts_preg: STS_preG A B Σ}.

  Notation STS := (leibnizO (STS_states * STS_rels)).
  Notation STS_STD := (leibnizO (STS_std_states A B)).
  Notation WORLD := (prodO STS_STD STS).

  Lemma gen_sts_init :
    (|==> ∃ (stsg : STSG A B Σ), sts_full_world ((∅, (∅, ∅)) : WORLD))%I.
  Proof.
    iMod (own_alloc (A:=sts_std_stateUR A B) (● ∅)) as (γsstd) "Hstd". by apply auth_auth_valid.
    iMod (own_alloc (A:=sts_stateUR) (● ∅)) as (γs) "Hs". by apply auth_auth_valid.
    iMod (own_alloc (A:=sts_relUR) (● ∅)) as (γr) "Hr". by apply auth_auth_valid.
    iModIntro. iExists (Build_STSG _ _ _ _ _ _ _ _ _ γsstd γs γr).
    rewrite /sts_full_world /sts_full_std /sts_full /=.
    rewrite !map_fmap_empty. iFrame.
  Qed.

End pre_STS.

Section STS.
  Context {A B C D: Type} {Σ : gFunctors} {eqa: EqDecision A} {count: Countable A}
          {sts_std: STS_STD B} {eqc : EqDecision C} {countC: Countable C}
          {eqd : EqDecision D} {countD: Countable D} {stsg : STSG A B Σ}.
  Implicit Types x y : positive.
  Implicit Types a : A.
  Implicit Types b : B.
  Implicit Types c : C.
  Implicit Types d : D.
  Implicit Types fs gs : STS_states.
  Implicit Types fsd gsd : STS_std_states A B.
  Implicit Types fr_pub fr_priv gr_pub gr_priv : STS_rels.
  Implicit Types R : C → C → Prop.
  Implicit Types Q : D → D → Prop.
  Implicit Types Rp : positive → positive → Prop.

  Notation STS := (leibnizO (STS_states * STS_rels)).
  Notation STS_STD := (leibnizO (STS_std_states A B)).
  Notation WORLD := (prodO STS_STD STS).
  Implicit Types W : WORLD.

  Lemma related_sts_pub_refl fs fr : related_sts_pub fs fs fr fr.
  Proof.
    split; [|split]; trivial.
    intros; simplify_eq.
    split; [|split]; trivial.
    intros; simplify_eq; eauto using rtc_refl.
  Qed.

  Lemma related_sts_priv_refl fs fr : related_sts_priv fs fs fr fr.
  Proof.
    split; [|split]; trivial.
    intros; simplify_eq.
    split; [|split]; trivial.
    intros; simplify_eq;
    eauto using rtc_refl.
  Qed.

  Lemma related_sts_std_pub_refl fsd : related_sts_std_pub fsd fsd.
  Proof.
    split; trivial.
    intros; simplify_eq.
    eauto using rtc_refl.
  Qed.

  Lemma related_sts_std_priv_refl fsd : related_sts_std_priv fsd fsd.
  Proof.
    split; trivial.
    intros; simplify_eq.
    eauto using rtc_refl.
  Qed.

  Lemma related_sts_pub_refl_world W : related_sts_pub_world W W.
  Proof. split;[apply related_sts_std_pub_refl|apply related_sts_pub_refl]. Qed.
  Lemma related_sts_priv_refl_world W : related_sts_priv_world W W.
  Proof. split;[apply related_sts_std_priv_refl|apply related_sts_priv_refl]. Qed.

  Lemma related_sts_pub_priv fs fr gs gr :
    related_sts_pub fs gs fr gr → related_sts_priv fs gs fr gr.
  Proof.
    rewrite /related_sts_pub /related_sts_priv.
    intros [Hf1 [Hf2 Hf3]].
    do 2 (split; auto). intros.
    specialize (Hf3 i r1 r2 r1' r2' H H0) as (Hr1 & Hr2 & Hrtc); auto.
    subst. repeat (split;auto). intros.
    specialize (Hrtc x y H1 H2).
    inversion Hrtc.
    - left.
    - right with y0; auto.
      apply rtc_or_intro. apply H4.
  Qed.

  Lemma related_sts_std_pub_priv fsd gsd :
    related_sts_std_pub fsd gsd → related_sts_std_priv fsd gsd.
  Proof.
    rewrite /related_sts_pub /related_sts_priv.
    intros [Hf1 Hf2].
    repeat (split; auto). intros.
    specialize (Hf2 i _ _ H H0) as Hrtc; auto.
    inversion Hrtc.
    - left.
    - right with y0; auto.
      apply rtc_or_intro. subst. auto.
  Qed.

  Lemma related_sts_pub_trans fs fr gs gr hs hr :
    related_sts_pub fs gs fr gr → related_sts_pub gs hs gr hr →
    related_sts_pub fs hs fr hr.
  Proof.
    intros [Hf1 [Hf2 Hf3]] [Hg1 [Hg2 Hg3]]; split; [|split]; try by etrans.
    intros i r1 r2 r1' r2' Hfr Hhr.
    specialize (Hf1 i); specialize (Hf2 i);
      revert Hf1 Hf2; rewrite !elem_of_dom; intros Hf1 Hf2.
    destruct Hf2; eauto. destruct x as [x1 x2].
    edestruct Hf3 as [Heq1 [Heq2 Hrtc] ] ; eauto; simplify_eq.
    edestruct Hg3 as [Heq1 [Heq2 Hrtc'] ] ; eauto; simplify_eq.
    repeat (split;auto).
    intros x y Hx Hy.
    destruct Hf1;eauto.
    etrans;eauto.
  Qed.

  Lemma related_sts_std_pub_trans fsd gsd hsd :
    related_sts_std_pub fsd gsd → related_sts_std_pub gsd hsd →
    related_sts_std_pub fsd hsd.
  Proof.
    intros [Hf1 Hf2] [Hg1 Hg2]; split; try by etrans.
    intros i x y Hx Hy.
    specialize (Hf1 i);
      revert Hf1; rewrite !elem_of_dom; intros Hf1.
    destruct Hf1 as [x0 Hx0]; eauto.
    specialize (Hf2 i x x0 Hx Hx0); simplify_eq.
    specialize (Hg2 i x0 y Hx0 Hy); simplify_eq.
    etrans;eauto.
  Qed.

  Lemma related_sts_priv_pub_trans fs fr gs gr hs hr :
    related_sts_priv fs gs fr gr → related_sts_pub gs hs gr hr →
    related_sts_priv fs hs fr hr.
  Proof.
    intros [Hf1 [Hf2 Hf3]] [Hg1 [Hg2 Hg3]]; split; [|split]; try by etrans.
    intros i r1 r2 r1' r2' Hfr Hhr.
    specialize (Hf1 i); specialize (Hf2 i);
      revert Hf1 Hf2; rewrite !elem_of_dom; intros Hf1 Hf2.
    destruct Hf2; eauto. destruct x as [x1 x2].
    edestruct Hf3 as [Heq1 [Heq2 Hrtc] ] ; eauto; simplify_eq.
    edestruct Hg3 as [Heq1 [Heq2 Hrtc'] ] ; eauto; simplify_eq.
    repeat (split;auto).
    intros x y Hx Hy.
    destruct Hf1;eauto.
    etrans;eauto.
    apply rtc_or_intro; auto.
  Qed.

  Lemma related_sts_std_priv_pub_trans fsd gsd hsd :
    related_sts_std_priv fsd gsd → related_sts_std_pub gsd hsd →
    related_sts_std_priv fsd hsd.
  Proof.
    intros [Hf1 Hf2] [Hg1 Hg2]; split; try by etrans.
    intros i x y Hx Hy.
    specialize (Hf1 i);
      revert Hf1; rewrite !elem_of_dom; intros Hf1.
    destruct Hf1 as [x0 Hx0]; eauto.
    specialize (Hf2 i x x0 Hx Hx0); simplify_eq.
    specialize (Hg2 i x0 y Hx0 Hy); simplify_eq.
    etrans;eauto.
    apply rtc_or_intro; auto.
  Qed.

  Lemma related_sts_pub_priv_trans fs fr gs gr hs hr :
    related_sts_pub fs gs fr gr → related_sts_priv gs hs gr hr →
    related_sts_priv fs hs fr hr.
  Proof.
    intros [Hf1 [Hf2 Hf3]] [Hg1 [Hg2 Hg3]]; split; [|split]; try by etrans.
    intros i r1 r2 r1' r2' Hfr Hhr.
    specialize (Hf1 i); specialize (Hf2 i);
      revert Hf1 Hf2; rewrite !elem_of_dom; intros Hf1 Hf2.
    destruct Hf2; eauto. destruct x as [x1 x2].
    edestruct Hf3 as [Heq1 [Heq2 Hrtc] ] ; eauto; simplify_eq.
    edestruct Hg3 as [Heq1 [Heq2 Hrtc'] ] ; eauto; simplify_eq.
    repeat (split;auto).
    intros x y Hx Hy.
    destruct Hf1;eauto.
    etrans;eauto.
    apply rtc_or_intro; auto.
  Qed.

  Lemma related_sts_std_pub_priv_trans fsd gsd hsd :
    related_sts_std_pub fsd gsd → related_sts_std_priv gsd hsd →
    related_sts_std_priv fsd hsd.
  Proof.
    intros [Hf1 Hf2] [Hg1 Hg2]; split; try by etrans.
    intros i x y Hx Hy.
    specialize (Hf1 i);
      revert Hf1; rewrite !elem_of_dom; intros Hf1.
    destruct Hf1 as [x0 Hx0]; eauto.
    specialize (Hf2 i x x0 Hx Hx0); simplify_eq.
    specialize (Hg2 i x0 y Hx0 Hy); simplify_eq.
    etrans;eauto.
    apply rtc_or_intro; auto.
  Qed.

  Lemma related_sts_priv_trans fs fr gs gr hs hr :
    related_sts_priv fs gs fr gr → related_sts_priv gs hs gr hr →
    related_sts_priv fs hs fr hr.
  Proof.
    intros [Hf1 [Hf2 Hf3]] [Hg1 [Hg2 Hg3]]; split; [|split]; try by etrans.
    intros i r1 r2 r1' r2' Hfr Hhr.
    specialize (Hf1 i); specialize (Hf2 i);
      revert Hf1 Hf2; rewrite !elem_of_dom; intros Hf1 Hf2.
    destruct Hf2; eauto. destruct x as [x1 x2].
    edestruct Hf3 as [Heq1 [Heq2 Hrtc] ] ; eauto; simplify_eq.
    edestruct Hg3 as [Heq1 [Heq2 Hrtc'] ] ; eauto; simplify_eq.
    repeat (split;auto).
    intros x y Hx Hy.
    destruct Hf1;eauto.
    etrans;eauto.
  Qed.

  Lemma related_sts_std_priv_trans fsd gsd hsd :
    related_sts_std_priv fsd gsd → related_sts_std_priv gsd hsd →
    related_sts_std_priv fsd hsd.
  Proof.
    intros [Hf1 Hf2] [Hg1 Hg2]; split; try by etrans.
    intros i x y Hx Hy.
    specialize (Hf1 i);
      revert Hf1; rewrite !elem_of_dom; intros Hf1.
    destruct Hf1 as [x0 Hx0]; eauto.
    specialize (Hf2 i x x0 Hx Hx0); simplify_eq.
    specialize (Hg2 i x0 y Hx0 Hy); simplify_eq.
    etrans;eauto.
  Qed.

  (* Helper functions for transitivity of sts pairs *)
  Lemma related_sts_pub_priv_trans_world W W' W'' :
    related_sts_pub_world W W' -> related_sts_priv_world W' W'' ->
    related_sts_priv_world W W''.
  Proof.
    intros [Hpub_std Hpub_loc] [Hpriv_std Hpriv_loc].
    split.
    - apply related_sts_std_pub_priv_trans with W'.1; auto.
    - apply related_sts_pub_priv_trans with W'.2.1 W'.2.2; auto.
  Qed.

  Lemma related_sts_priv_pub_trans_world W W' W'' :
    related_sts_priv_world W W' -> related_sts_pub_world W' W'' ->
    related_sts_priv_world W W''.
  Proof.
    intros [Hpub_std Hpub_loc] [Hpriv_std Hpriv_loc].
    split.
    - apply related_sts_std_priv_pub_trans with W'.1; auto.
    - apply related_sts_priv_pub_trans with W'.2.1 W'.2.2; auto.
  Qed.

  Lemma related_sts_priv_trans_world W W' W'' :
    related_sts_priv_world W W' -> related_sts_priv_world W' W'' ->
    related_sts_priv_world W W''.
  Proof.
    intros [Hpub_std Hpub_loc] [Hpriv_std Hpriv_loc].
    split.
    - apply related_sts_std_priv_trans with W'.1; auto.
    - apply related_sts_priv_trans with W'.2.1 W'.2.2; auto.
  Qed.

  Lemma related_sts_pub_trans_world W W' W'' :
    related_sts_pub_world W W' -> related_sts_pub_world W' W'' ->
    related_sts_pub_world W W''.
  Proof.
    intros [Hpub_std Hpub_loc] [Hpriv_std Hpriv_loc].
    split.
    - apply related_sts_std_pub_trans with W'.1; auto.
    - apply related_sts_pub_trans with W'.2.1 W'.2.2; auto.
  Qed.

  Lemma related_sts_pub_priv_world W W' :
    related_sts_pub_world W W' -> related_sts_priv_world W W'.
  Proof.
    intros [Hstd Hloc].
    split; [apply related_sts_std_pub_priv|apply related_sts_pub_priv]; auto.
  Qed.

  Lemma related_sts_priv_world_std_sta_is_Some W W' i :
    related_sts_priv_world W W' -> is_Some ((W.1) !! i) -> is_Some ((W'.1) !! i).
  Proof.
    intros [ [Hdom1 _ ] _] Hsome.
    apply elem_of_gmap_dom in Hsome.
    apply elem_of_gmap_dom.
    apply elem_of_subseteq in Hdom1. auto.
  Qed.

  Lemma related_sts_priv_world_std_sta_region_type W W' i ρ :
    related_sts_priv_world W W' ->
    (W.1) !! i = Some ρ ->
    ∃ ρ', (W'.1) !! i = Some ρ'.
  Proof.
    intros Hrelated Hρ.
    assert (is_Some ((W'.1) !! i)) as [x Hx].
    { apply related_sts_priv_world_std_sta_is_Some with W; eauto. }
    destruct Hrelated as [ [Hdom1 Hrevoked ] _].
    specialize (Hrevoked _ _ _ Hρ Hx). simplify_eq.
    eauto.
  Qed.

  Lemma sts_full_rel_loc W i Q P :
    sts_full_world W -∗ sts_rel_loc (A:=A) i Q P -∗ ⌜W.2.2 !! i = Some (convert_rel Q,convert_rel P)⌝.
  Proof.
    rewrite /sts_rel_loc /sts_full_world /sts_full.
    destruct W as [Wstd [fs fr]].
    iIntros "[_ [_ H1]] H2 /=".
    iDestruct (own_valid_2 with "H1 H2") as %[HR Hv]%auth_both_valid;
      iPureIntro.
    specialize (Hv i).
    revert HR. rewrite /= singleton_included;
      intros [z [Hz HR]]; revert HR; rewrite Some_included_total; intros HR.
    rewrite lookup_fmap in Hz, Hv.
    destruct (fr !! i) eqn:Heq; rewrite Heq /= in Hz, Hv; last by inversion Hz.
    revert Hv; rewrite Hz; intros [u Hu]%to_agree_uninj.
    revert HR; rewrite -Hu; intros HR%to_agree_included%leibniz_equiv;
      simplify_eq.
    inversion Hz as [? ? Hz'|]; simplify_eq.
    revert Hz'; rewrite -Hu. intros Hz'%(to_agree_inj (A:=leibnizO _) p _)%leibniz_equiv.
    by rewrite Hz'.
  Qed.

  Lemma sts_full_state_std W a b :
    sts_full_world W -∗ sts_state_std a b -∗ ⌜W.1 !! a = Some b⌝.
  Proof.
    rewrite /sts_full_world /sts_full /sts_state_std.
    destruct W as [Wsta Wloc].
    iIntros "[H1 _] H2".
    iDestruct (own_valid_2 with "H1 H2") as %[HR Hv]%auth_both_valid;
      iPureIntro.
    specialize (Hv a).
    revert HR; rewrite /= singleton_included;
      intros [z [Hz HR]].
    rewrite lookup_fmap in Hz Hv.
    destruct (Wsta !! a) eqn:Heq; rewrite Heq /= in Hz Hv; last by inversion Hz.
    apply leibniz_equiv in Hz; simplify_eq.
    apply Some_included_exclusive in HR; auto; last by typeclasses eauto.
    apply leibniz_equiv in HR; simplify_eq; eauto.
  Qed.

  Lemma sts_full_state_loc W i d :
    sts_full_world W -∗ sts_state_loc (A:=A) i d -∗ ⌜W.2.1 !! i = Some (encode d)⌝.
  Proof.
    rewrite /sts_full_world /sts_full /sts_state_loc.
    destruct W as [Wstd [fs fr] ].
    iIntros "[_ [H1 _]] H2".
    iDestruct (own_valid_2 with "H1 H2") as %[HR Hv]%auth_both_valid;
      iPureIntro.
    specialize (Hv i).
    revert HR; rewrite /= singleton_included;
      intros [z [Hz HR]].
    rewrite lookup_fmap in Hz Hv.
    destruct (fs !! i) eqn:Heq; rewrite Heq /= in Hz Hv; last by inversion Hz.
    apply leibniz_equiv in Hz; simplify_eq.
    apply Some_included_exclusive in HR; auto; last by typeclasses eauto.
    apply leibniz_equiv in HR; simplify_eq; eauto.
  Qed.

  Lemma sts_dealloc_std W a b :
    sts_full_world W ∗ sts_state_std a b ==∗ sts_full_world (delete a W.1,W.2).
  Proof.
    rewrite /sts_full_world /sts_full /sts_state_std.
    destruct W as [fs Wloc].
    iIntros "[ [Hsta Hloc] Hstate] /=".
    iCombine "Hsta" "Hstate" as "H1".
    iMod (own_update
            (A := sts_std_stateUR A B)
            _ _
            (● (Excl <$> (delete a fs)))
            with "H1") as "H1".
    { apply auth_update_dealloc.
      rewrite fmap_delete /=.
      apply: delete_singleton_local_update. }
    iFrame. iModIntro. done.
  Qed.

  Lemma sts_alloc_std_i W a b :
    ⌜a ∉ dom (gset A) W.1⌝ -∗
    sts_full_world W ==∗
    sts_full_world (<[a := b]>W.1,W.2) ∗ sts_state_std a b.
  Proof.
    rewrite /sts_full_world /sts_full /sts_state_std /=.
    destruct W as [fsd Wloc]. rewrite /sts_full_std.
    iIntros (Hfresh1) "[H1 Hloc] /=".
    iMod (own_update
            (A := sts_std_stateUR A B)
            _ _
            (● (Excl <$> <[a :=b]> fsd)
            ⋅ ◯ {[a := Excl b]})
            with "H1") as "[H1 Hs]".
    { apply auth_update_alloc.
      rewrite fmap_insert /=.
      apply: alloc_singleton_local_update; last done.
      apply (not_elem_of_dom (D := gset A)).
      rewrite dom_fmap. auto. }
    iFrame. done.
  Qed.

  Lemma sts_alloc_loc W d Q P:
    sts_full_world W ==∗
             ∃ i, sts_full_world (W.1,((<[i := encode d ]>W.2.1),(<[i := (convert_rel Q,convert_rel P) ]>W.2.2)))
                  ∗ ⌜i ∉ dom (gset positive) W.2.1⌝ ∗ ⌜i ∉ dom (gset positive) W.2.2⌝
                  ∗ sts_state_loc (A:=A) i d ∗ sts_rel_loc (A:=A) i Q P.
  Proof.
    rewrite /sts_full_world /sts_full /sts_rel_loc /sts_state_loc.
    (* iIntros "[Hd [H1 H2]]". *)
    (* iDestruct "Hd" as %Hd. *)
    destruct W as [Wstd [fs fr]].
    iIntros "[Hstd [H1 H2]] /=".
    assert (fresh (dom (gset positive) fs ∪ dom (gset positive) fr) ∉
                    (dom (gset positive) fs ∪ dom (gset positive) fr)) as Hfresh.
    { apply is_fresh. }
    apply not_elem_of_union in Hfresh as [Hfs Hfr].
    iMod (own_update
            (A := sts_stateUR)
            _ _
            (● (Excl <$>
                <[fresh (dom (gset positive) fs ∪ dom (gset positive) fr) := encode d]> fs)
            ⋅ ◯ {[fresh (dom (gset positive) fs ∪ dom (gset positive) fr) := Excl (encode d)]})
            with "H1") as "[H1 Hs]".
    { apply auth_update_alloc.
      rewrite fmap_insert /=.
      apply: alloc_singleton_local_update; last done.
      apply (not_elem_of_dom (D := gset positive)).
      rewrite dom_fmap.
      auto. }
    iMod (own_update
            (A := sts_relUR)
            _ _
            (● (to_agree <$>
                <[fresh (dom (gset positive) fs ∪ dom (gset positive) fr) := (convert_rel Q,convert_rel P)]> fr)
            ⋅ ◯ {[fresh (dom (gset positive) fs ∪ dom (gset positive) fr) := to_agree (convert_rel Q,convert_rel P)]})
            with "H2") as "[H2 Hr]".
    { apply auth_update_alloc.
      rewrite fmap_insert /=.
      apply: alloc_singleton_local_update; last done.
      apply (not_elem_of_dom (D := gset positive)).
      rewrite dom_fmap.
      auto. }
    iModIntro.
    iExists _; iFrame.
    repeat iSplit; auto.
  Qed.

  Lemma sts_update_std W a b b' :
    sts_full_world W -∗ sts_state_std a b ==∗
    sts_full_world (<[a := b' ]>W.1,W.2) ∗ sts_state_std a b'.
  Proof.
    iIntros "Hsf Hi".
    iDestruct (sts_full_state_std with "Hsf Hi") as %Hfs.
    rewrite /sts_full_world /sts_full /sts_state_std.
    destruct W as [fsd Wloc].
    iDestruct "Hsf" as "[H1 Hloc] /=".
    iCombine "H1" "Hi" as "H1".
    iMod (own_update (A := sts_std_stateUR A B)
            _ _
            (● (<[a := Excl b']> (Excl <$> fsd))
               ⋅ ◯ {[a := Excl b']})
            with "H1") as "[H1 Hs]".
    { apply auth_update.
      apply: singleton_local_update; eauto.
      rewrite lookup_fmap Hfs //=.
      by apply exclusive_local_update. }
    iFrame. rewrite -fmap_insert;
              first iModIntro; iFrame.
  Qed.

  Lemma sts_update_loc W i d d' :
    sts_full_world W -∗ sts_state_loc (A:=A) i d ==∗
    sts_full_world (W.1,((<[i := encode d' ]>W.2.1),W.2.2)) ∗ sts_state_loc (A:=A) i d'.
  Proof.
    iIntros "Hsf Hi".
    iDestruct (sts_full_state_loc with "Hsf Hi") as %Hfs.
    rewrite /sts_full_world /sts_full /sts_rel_loc /sts_state_loc.
    destruct W as [Wstd [fs fr]].
    iDestruct "Hsf" as "[Hdst [H1 H2]] /=".
    iCombine "H1" "Hi" as "H1".
    iMod (own_update (A := sts_stateUR)
            _ _
            (● (<[i := Excl (encode d')]> (Excl <$> fs))
               ⋅ ◯ {[i := Excl (encode d')]})
            with "H1") as "[H1 Hs]".
    { apply auth_update.
      apply: singleton_local_update; eauto.
      rewrite lookup_fmap Hfs //=.
      by apply exclusive_local_update. }
    rewrite fmap_insert (* dom_insert_L *) (* subseteq_union_1_L *);
      first iModIntro; iFrame.
  Qed.

End STS.


(**************************************************************************)
(*                                                                        *)
(*     SMTCoq                                                             *)
(*     Copyright (C) 2011 - 2021                                          *)
(*                                                                        *)
(*     See file "AUTHORS" for the list of authors                         *)
(*                                                                        *)
(*   This file is distributed under the terms of the CeCILL-C licence     *)
(*                                                                        *)
(**************************************************************************)

Require Import PArray List Bool ZArith Psatz.
Require Import Misc State SMT_terms BVList.

Import Form.

Local Open Scope array_scope.
Local Open Scope int63_scope.

Set Implicit Arguments.
Unset Strict Implicit.

Definition or_of_imp args :=
  let last := PArray.length args - 1 in
  PArray.mapi (fun i l => if i == last then l else Lit.neg l) args.
(* Register or_of_imp as PrimInline. *)

Lemma length_or_of_imp : forall args,
  PArray.length (or_of_imp args) = PArray.length args.
Proof. intro; unfold or_of_imp; apply length_mapi. Qed.

Lemma get_or_of_imp : forall args i,
  i < (PArray.length args) - 1 -> (or_of_imp args).[i] = Lit.neg (args.[i]).
Proof.
  unfold or_of_imp; intros args i H; case_eq (0 < PArray.length args).
  intro Heq; rewrite get_mapi.
  replace (i == PArray.length args - 1) with false; auto; symmetry; rewrite eqb_false_spec; intro; subst i; unfold is_true in H; rewrite ltb_spec, (to_Z_sub_1 _ _ Heq) in H; omega.
  rewrite ltb_spec; unfold is_true in H; rewrite ltb_spec, (to_Z_sub_1 _ _ Heq) in H; omega.
  rewrite ltb_negb_geb; case_eq (PArray.length args <= 0); try discriminate; intros Heq _; assert (H1: PArray.length args = 0).
  apply to_Z_inj; rewrite leb_spec in Heq; destruct (to_Z_bounded (PArray.length args)) as [H1 _]; change [|0|] with 0%Z in *; omega.
  rewrite !get_outofbound.
  rewrite default_mapi, H1; auto.
  rewrite H1; case_eq (i < 0); auto; intro H2; eelim ltb_0; eassumption.
  rewrite length_mapi, H1; case_eq (i < 0); auto; intro H2; eelim ltb_0; eassumption.
Qed.

Lemma get_or_of_imp2 : forall args i, 0 < PArray.length args ->
  i = (PArray.length args) - 1 -> (or_of_imp args).[i] = args.[i].
Proof.
  unfold or_of_imp; intros args i Heq Hi; rewrite get_mapi; subst i.
  rewrite Int63Axioms.eqb_refl; auto.
  rewrite ltb_spec, (to_Z_sub_1 _ _ Heq); omega.
Qed.

Lemma afold_right_impb p a :
  (forall x, p (Lit.neg x) = negb (p x)) ->
  (PArray.length a == 0) = false ->
  (afold_right bool int true implb p a) =
  List.existsb p (to_list (or_of_imp a)).
Proof.
  intros Hp Hl.
  case_eq (afold_right bool int true implb p a); intro Heq; symmetry.
  - apply afold_right_implb_true_inv in Heq.
    destruct Heq as [Heq|[[i [Hi Heq]]|Heq]].
    + rewrite Heq in Hl. discriminate.
    + rewrite existsb_exists. exists (Lit.neg (a .[ i])). split.
      * {
          apply (to_list_In_eq _ i).
          - rewrite length_or_of_imp. apply (ltb_trans _ (PArray.length a - 1)); auto.
            now apply minus_1_lt.
          - now rewrite get_or_of_imp.
        }
      * now rewrite Hp, Heq.
    + rewrite existsb_exists. exists (a.[(PArray.length a) - 1]). split.
      * {
          apply (to_list_In_eq _ (PArray.length a - 1)).
          - rewrite length_or_of_imp.
            now apply minus_1_lt.
          - symmetry. apply get_or_of_imp2; auto.
            unfold is_true. rewrite ltb_spec. rewrite eqb_false_spec in Hl.
            assert (0%Z <> [|PArray.length a|])
              by (change 0%Z with [|0|]; intro H; apply to_Z_inj in H; auto).
            destruct (to_Z_bounded (PArray.length a)) as [H1 _].
            clear -H H1. change [|0|] with 0%Z. lia.
        }
      * {
          apply Heq. now apply minus_1_lt.
        }
  - apply afold_right_implb_false_inv in Heq.
    destruct Heq as [H1 [H2 H3]].
    case_eq (existsb p (to_list (or_of_imp a))); auto.
    rewrite existsb_exists. intros [x [H4 H5]].
    apply In_to_list in H4. destruct H4 as [i [H4 ->]].
    case_eq (i < PArray.length a - 1); intro Heq.
    + assert (H6 := H2 _ Heq). now rewrite (get_or_of_imp Heq), Hp, H6 in H5.
    + assert (H6:i = PArray.length a - 1).
      {
        clear -H4 Heq H1.
        rewrite length_or_of_imp in H4.
        apply to_Z_inj. rewrite (to_Z_sub_1 _ 0); auto.
        rewrite ltb_spec in H4; auto.
        rewrite ltb_negb_geb in Heq.
        case_eq (PArray.length a - 1 <= i); intro H2; rewrite H2 in Heq; try discriminate.
        clear Heq. rewrite leb_spec in H2. rewrite (to_Z_sub_1 _ 0) in H2; auto.
        lia.
      }
      rewrite get_or_of_imp2 in H5; auto.
      rewrite H6, H3 in H5. discriminate.
Qed.

Section CHECKER.

  Variable t_form : PArray.array form.
  Local Notation get_hash := (PArray.get t_form) (only parsing).
  Variable s : S.t.

  (*  * true             : {true}  *)

  Definition check_True := C._true.

  (* * false             : {(not false)} *)

  Definition check_False  := Lit.neg (Lit._false)::nil.

  (* * and_neg          : {(and a_1 ... a_n) (not a_1) ... (not a_n)}
     * or_pos           : {(not (or a_1 ... a_n)) a_1 ... a_n}
     * implies_pos      : {(not (implies a b)) (not a) b}
     * xor_pos1         : {(not (xor a b)) a b}
     * xor_neg1         : {(xor a b) a (not b)}
     * equiv_pos1       : {(not (iff a b)) a (not b)}
     * equiv_neg1       : {(iff a b) (not a) (not b)}
     * ite_pos1         : {(not (if_then_else a b c)) a c}
     * ite_neg1         : {(if_then_else a b c) a (not c)} *)

  Definition check_BuildDef l :=
    match get_hash (Lit.blit l) with
    | Fand args =>
      if Lit.is_pos l then l :: List.map Lit.neg (PArray.to_list args)
      else C._true
    | For args =>
      if Lit.is_pos l then C._true
      else l :: PArray.to_list args
    | Fimp args =>
      if Lit.is_pos l then C._true
      else if PArray.length args == 0 then C._true
      else
        let args := or_of_imp args in
        l :: PArray.to_list args
    | Fxor a b =>
      if Lit.is_pos l then l::a::Lit.neg b::nil
      else l::a::b::nil
    | Fiff a b =>
      if Lit.is_pos l then l::Lit.neg a::Lit.neg b::nil
      else l::a::Lit.neg b::nil
    | Fite a b c =>
      if Lit.is_pos l then l::a::Lit.neg c::nil
      else l::a::c::nil
    | _ => C._true
    end.

  (* * not_and           : {(not (and a_1 ... a_n))} --> {(not a_1) ... (not a_n)}
     * or                : {(or a_1 ... a_n)} --> {a_1 ... a_n}
     * implies           : {(implies a b)} --> {(not a) b}
     * xor1              : {(xor a b)} --> {a b}
     * not_xor1          : {(not (xor a b))} --> {a (not b)}
     * equiv2            : {(iff a b)} --> {a (not b)}
     * not_equiv2        : {(not (iff a b))} --> {(not a) (not b)}
     * ite1              : {(if_then_else a b c)} --> {a c}
     * not_ite1          : {(not (if_then_else a b c))} --> {a (not c)} *)

  Definition check_ImmBuildDef pos :=
    match S.get s pos with
    | l::nil =>
      match get_hash (Lit.blit l) with
      | Fand args =>
        if Lit.is_pos l then C._true
        else List.map Lit.neg (PArray.to_list args)
      | For args =>
        if Lit.is_pos l then PArray.to_list args
        else C._true
      | Fimp args =>
        if PArray.length args == 0 then C._true else
        if Lit.is_pos l then
          let args := or_of_imp args in
          PArray.to_list args
        else C._true
      | Fxor a b =>
        if Lit.is_pos l then a::b::nil
        else a::Lit.neg b::nil
      | Fiff a b =>
        if Lit.is_pos l then a::Lit.neg b::nil
        else Lit.neg a::Lit.neg b::nil
      | Fite a b c =>
        if Lit.is_pos l then a::c::nil
        else a::Lit.neg c::nil
      | _ => C._true
      end
    | _ => C._true
    end.

  (* * xor_pos2          : {(not (xor a b)) (not a) (not b)}
     * xor_neg2          : {(xor a b) (not a) b}
     * equiv_pos2        : {(not (iff a b)) (not a) b}
     * equiv_neg2        : {(iff a b) a b}
     * ite_pos2          : {(not (if_then_else a b c)) (not a) b}
     * ite_neg2          : {(if_then_else a b c) (not a) (not b)} *)

  Definition check_BuildDef2 l :=
    match get_hash (Lit.blit l) with
    | Fxor a b =>
      if Lit.is_pos l then l::Lit.neg a::b::nil
      else l::Lit.neg a::Lit.neg b::nil
    | Fiff a b =>
      if Lit.is_pos l then l::a::b::nil
      else l::Lit.neg a::b::nil
    | Fite a b c =>
      if Lit.is_pos l then l::Lit.neg a::Lit.neg b::nil
      else l::Lit.neg a::b::nil
    | _ => C._true
    end.

  (* * xor2              : {(xor a b)} --> {(not a) (not b)}
     * not_xor2          : {(not (xor a b))} --> {(not a) b}
     * equiv1            : {(iff a b)} --> {(not a) b}
     * not_equiv1        : {(not (iff a b))} --> {a b}
     * ite2              : {(if_then_else a b c)} --> {(not a) b}
     * not_ite2          : {(not (if_then_else a b c))} --> {(not a) (not b)}
     *)

  Definition check_ImmBuildDef2 pos :=
    match S.get s pos with
    | l::nil =>
      match get_hash (Lit.blit l) with
      | Fxor a b =>
        if Lit.is_pos l then Lit.neg a::Lit.neg b::nil
        else Lit.neg a::b::nil
      | Fiff a b =>
        if Lit.is_pos l then Lit.neg a::b::nil
        else a::b::nil
      | Fite a b c =>
        if Lit.is_pos l then Lit.neg a::b::nil
        else Lit.neg a::Lit.neg b::nil
      | _ => C._true
      end
    | _ => C._true
    end.

  (* * or_neg           : {(or a_1 ... a_n) (not a_i)}
     * and_pos          : {(not (and a_1 ... a_n)) a_i}
     * implies_neg1     : {(implies a b) a}
     * implies_neg2     : {(implies a b) (not b)} *)

  Definition check_BuildProj l i :=
    let x := Lit.blit l in
    match get_hash x with
    | For args =>
      if i < PArray.length args then Lit.lit x::Lit.neg (args.[i])::nil
      else C._true
    | Fand args =>
      if i < PArray.length args then Lit.nlit x::(args.[i])::nil
      else C._true
    | Fimp args =>
      let len := PArray.length args in
      if i < len then
        if i == len - 1 then Lit.lit x::Lit.neg (args.[i])::nil
        else Lit.lit x::(args.[i])::nil
      else C._true
    | _ => C._true
    end.

  (* * and               : {(and a_1 ... a_n)} --> {a_i}
     * not_or            : {(not (or a_1 ... a_n))} --> {(not a_i)}
     * not_implies1      : {(not (implies a b))} --> {a}
     * not_implies2      : {(not (implies a b))} --> {(not b)} *)

  Definition check_ImmBuildProj pos i :=
    match S.get s pos with
    | l::nil =>
      let x := Lit.blit l in
      match get_hash x with
      | For args =>
        if (i < PArray.length args) && negb (Lit.is_pos l) then Lit.neg (args.[i])::nil
        else C._true
      | Fand args =>
        if (i < PArray.length args) && (Lit.is_pos l) then (args.[i])::nil
        else C._true
      | Fimp args =>
        let len := PArray.length args in
        if (i < len) && negb (Lit.is_pos l) then
          if i == len - 1 then Lit.neg (args.[i])::nil
          else (args.[i])::nil
        else C._true
      | _ => C._true
      end
    | _ => C._true
    end.

  (** The correctness proofs *)

  Variable interp_atom : atom -> bool.
  Variable interp_bvatom : atom -> forall s, BITVECTOR_LIST.bitvector s.

  Hypothesis Hch_f : check_form t_form.

  Local Notation rho := (Form.interp_state_var interp_atom interp_bvatom t_form).

  Let Hwfrho : Valuation.wf rho.
  Proof.
    destruct (check_form_correct interp_atom interp_bvatom _ Hch_f) as (_, H);exact H.
  Qed.

  Lemma valid_check_True : C.valid rho check_True.
  Proof.
    apply C.interp_true;trivial.
  Qed.

  Lemma valid_check_False : C.valid rho check_False.
  Proof.
    unfold check_False, C.valid. change (Lit.interp rho (Lit.neg Lit._false) || false = true).
    rewrite Lit.interp_neg.
    assert (W:= Lit.interp_false _ Hwfrho).
    destruct (Lit.interp rho Lit._false);trivial;elim W;red;trivial.
  Qed.

  Let rho_interp : forall x : int,
    rho x = interp interp_atom interp_bvatom t_form (t_form.[ x]).
  Proof.
    destruct (check_form_correct interp_atom interp_bvatom _ Hch_f) as ((H,H0), _).
    intros x;apply wf_interp_form;trivial.
  Qed.

  Ltac tauto_check :=
   try (rewrite !Lit.interp_neg);
   repeat
     match goal with |- context [Lit.interp rho ?x] =>
     destruct (Lit.interp rho x);trivial end.

  Lemma valid_check_BuildDef : forall l, C.valid rho (check_BuildDef l).
  Proof.
   unfold check_BuildDef,C.valid;intros l.
   case_eq (t_form.[Lit.blit l]);intros;auto using C.interp_true;
     case_eq (Lit.is_pos l);intros Heq;auto using C.interp_true;simpl;
       try (unfold Lit.interp at 1;rewrite Heq;unfold Var.interp; rewrite rho_interp, H;simpl;
            tauto_check).
   - rewrite afold_left_and, C.Cinterp_neg;apply orb_negb_r.
   - rewrite afold_left_or, orb_comm;apply orb_negb_r.
   - case_eq (PArray.length a == 0); auto using C.interp_true.
     intro Hl; simpl.
     unfold Lit.interp at 1;rewrite Heq;unfold Var.interp; rewrite rho_interp, H;simpl.
     rewrite (afold_right_impb (Lit.interp_neg _) Hl), orb_comm;try apply orb_negb_r.
  Qed.

  Lemma valid_check_BuildDef2 : forall l, C.valid rho (check_BuildDef2 l).
  Proof.
   unfold check_BuildDef2,C.valid;intros l.
   case_eq (t_form.[Lit.blit l]);intros;auto using C.interp_true;
   case_eq (Lit.is_pos l);intros Heq;auto using C.interp_true;simpl;
   unfold Lit.interp at 1;rewrite Heq;unfold Var.interp; rewrite rho_interp, H;simpl;
   tauto_check.
  Qed.

  Lemma valid_check_BuildProj : forall l i, C.valid rho (check_BuildProj l i).
  Proof.
   unfold check_BuildProj,C.valid;intros l i.
   case_eq (t_form.[Lit.blit l]);intros;auto using C.interp_true;
   case_eq (i < PArray.length a);intros Hlt;auto using C.interp_true;simpl.
   - rewrite Lit.interp_nlit;unfold Var.interp;rewrite rho_interp, orb_false_r, H.
     simpl;rewrite afold_left_and.
     case_eq (forallb (Lit.interp rho) (to_list a));trivial.
     rewrite forallb_forall;intros Heq;rewrite Heq;trivial.
     apply to_list_In; auto.
   - rewrite Lit.interp_lit;unfold Var.interp;rewrite rho_interp, orb_false_r, H.
     simpl;rewrite afold_left_or.
     unfold C.interp;case_eq (existsb (Lit.interp rho) (to_list a));trivial.
     rewrite <-not_true_iff_false, existsb_exists, Lit.interp_neg.
     case_eq (Lit.interp rho (a .[ i]));trivial.
     intros Heq Hex;elim Hex;exists (a.[i]);split;trivial.
     apply to_list_In; auto.
   - assert (Hl : (PArray.length a == 0) = false)
       by (rewrite eqb_false_spec; intro H1; rewrite H1 in Hlt; now elim (ltb_0 i)).
     case_eq (i == PArray.length a - 1);intros Heq;simpl;
       rewrite Lit.interp_lit;unfold Var.interp;rewrite rho_interp, H;simpl.
     + rewrite Lit.interp_neg, orb_false_r.
       rewrite (afold_right_impb (Lit.interp_neg _) Hl).
       case_eq (Lit.interp rho (a .[ i])); intro Hi.
       * rewrite orb_false_r, existsb_exists.
         exists (a .[ i]). split; auto.
         {
           apply (to_list_In_eq _ i).
           - now rewrite length_or_of_imp.
           - symmetry. apply get_or_of_imp2.
             + clear -Hl. rewrite eqb_false_spec in Hl.
               unfold is_true. rewrite ltb_spec. change [|0|] with 0%Z.
               assert (H:[|PArray.length a|] <> 0%Z)
                 by (intro H; apply Hl; now apply to_Z_inj).
               destruct (to_Z_bounded (PArray.length a)) as [H1 _].
               lia.
             + now rewrite Int63Properties.eqb_spec in Heq.
         }
       * now rewrite orb_true_r.
     + rewrite orb_false_r.
       case_eq (Lit.interp rho (a .[ i])); intro Hi.
       * now rewrite orb_true_r.
       * rewrite (afold_right_impb (Lit.interp_neg _) Hl).
         rewrite orb_false_r, existsb_exists.
         exists (Lit.neg (a .[ i])).
         {
           split.
           - apply (to_list_In_eq _ i).
             + now rewrite length_or_of_imp.
             + symmetry. apply get_or_of_imp.
               clear -Hlt Heq.
               unfold is_true. rewrite ltb_spec. rewrite (to_Z_sub_1 _ i); auto.
               rewrite eqb_false_spec in Heq.
               assert (H:[|i|] <> ([|PArray.length a|] - 1)%Z)
                 by (intro H; apply Heq, to_Z_inj; rewrite (to_Z_sub_1 _ i); auto).
               clear Heq.
               rewrite ltb_spec in Hlt. lia.
           - now rewrite Lit.interp_neg, Hi.
         }
  Qed.

  Hypothesis Hs : S.valid rho s.

  Lemma valid_check_ImmBuildDef : forall cid,
     C.valid rho (check_ImmBuildDef cid).
  Proof.
   unfold check_ImmBuildDef,C.valid;intros cid.
   generalize (Hs cid);unfold C.valid.
   destruct (S.get s cid) as [ | l [ | _l _c]];auto using C.interp_true.
   simpl;unfold Lit.interp, Var.interp; rewrite !rho_interp;
   destruct (t_form.[Lit.blit l]);auto using C.interp_true;
   case_eq (Lit.is_pos l);intros Heq;auto using C.interp_true;simpl;
   tauto_check.
   - rewrite afold_left_and, C.Cinterp_neg, orb_false_r;trivial.
   - rewrite afold_left_or, orb_false_r;trivial.
   - case_eq (PArray.length a == 0); auto using C.interp_true.
     intro Hl. now rewrite orb_false_r, (afold_right_impb (Lit.interp_neg _) Hl).
   - case_eq (PArray.length a == 0); auto using C.interp_true.
  Qed.

  Lemma valid_check_ImmBuildDef2 : forall cid, C.valid rho (check_ImmBuildDef2 cid).
  Proof.
    unfold check_ImmBuildDef2,C.valid;intros cid.
    generalize (Hs cid);unfold C.valid.
    destruct (S.get s cid) as [ | l [ | _l _c]];auto using C.interp_true.
    simpl;unfold Lit.interp, Var.interp; rewrite !rho_interp;
    destruct (t_form.[Lit.blit l]);auto using C.interp_true;
    case_eq (Lit.is_pos l);intros Heq;auto using C.interp_true;simpl;
    tauto_check.
  Qed.

  Lemma valid_check_ImmBuildProj : forall cid i, C.valid rho (check_ImmBuildProj cid i).
  Proof.
   unfold check_ImmBuildProj,C.valid;intros cid i.
   generalize (Hs cid);unfold C.valid.
   destruct (S.get s cid) as [ | l [ | _l _c]];auto using C.interp_true.
   simpl;unfold Lit.interp, Var.interp; rewrite !rho_interp;
     destruct (t_form.[Lit.blit l]);auto using C.interp_true;
       case_eq (i < PArray.length a); intros Hlt;auto using C.interp_true;
       case_eq (Lit.is_pos l);intros Heq;auto using C.interp_true;simpl;
       rewrite !orb_false_r.
   - rewrite afold_left_and.
     rewrite forallb_forall;intros H;apply H;auto.
     apply to_list_In; auto.
   - rewrite negb_true_iff, <-not_true_iff_false, afold_left_or.
     unfold C.interp;rewrite existsb_exists, Lit.interp_neg.
     case_eq (Lit.interp rho (a .[ i]));trivial.
     intros Heq' Hex;elim Hex;exists (a.[i]);split;trivial.
     apply to_list_In; auto.
   - rewrite negb_true_iff, <-not_true_iff_false.
     assert (Hl:(PArray.length a == 0) = false)
       by (rewrite eqb_false_spec; intro H; rewrite H in Hlt; now apply (ltb_0 i)).
     rewrite (afold_right_impb (Lit.interp_neg _) Hl).
     case_eq (i == PArray.length a - 1);intros Heq';simpl;
       unfold C.interp;simpl;try rewrite Lit.interp_neg;rewrite orb_false_r,
                                                        existsb_exists;case_eq (Lit.interp rho (a .[ i]));trivial;
         intros Heq2 Hex;elim Hex.
     exists (a.[i]);split;trivial.
     assert (H1: 0 < PArray.length a) by (apply (leb_ltb_trans _ i _); auto; apply leb_0); rewrite Int63Properties.eqb_spec in Heq'; rewrite <- (get_or_of_imp2 H1 Heq'); apply to_list_In; rewrite length_or_of_imp; auto.
     exists (Lit.neg (a.[i]));rewrite Lit.interp_neg, Heq2;split;trivial.
     assert (H1: i < PArray.length a - 1 = true) by (rewrite ltb_spec, (to_Z_sub_1 _ _ Hlt); rewrite eqb_false_spec in Heq'; assert (H1: [|i|] <> ([|PArray.length a|] - 1)%Z) by (intro H1; apply Heq', to_Z_inj; rewrite (to_Z_sub_1 _ _ Hlt); auto); rewrite ltb_spec in Hlt; omega); rewrite <- (get_or_of_imp H1); apply to_list_In; rewrite length_or_of_imp; auto.
  Qed.

End CHECKER.

Unset Implicit Arguments.


(** Realisation of the DB_resources interface *)
From iris.algebra Require Import agree auth excl gmap.
From aneris.algebra Require Import monotone.
From iris.proofmode Require Import tactics.
From iris.base_logic Require Import invariants.
From aneris.aneris_lang Require Import lang resources.
From aneris.examples.ccddb.spec Require Import base.
From aneris.examples.ccddb.model Require Import events model_spec.
From aneris.examples.ccddb.resources Require Import base.

Notation PrinSeen S := (principal seen_relation S).

Section Local_history.

  Context `{!anerisG Mdl Σ, !DB_params, !internal_DBG Σ}.

  Section Predicates.

    Context (γLs : list (gname * gname)).

    Definition local_history_Global_inv
               (γs : gname * gname) (S : gset apply_event) : iProp Σ :=
      own γs.1 (● (PrinSeen S)) ∗ own γs.2 (◯ S).

    Definition local_history_Local_inv
               (i : nat) (S : gset apply_event) : iProp Σ :=
      ∃ γs, ⌜γLs !! i = Some γs⌝ ∗ own γs.1 (◯ (PrinSeen S)) ∗ own γs.2 (● S).

    Definition local_history_seen (i : nat) (S : gset apply_event) : iProp Σ :=
      ∃ γs, ⌜γLs !! i = Some γs⌝ ∗
        own γs.1 (◯ (PrinSeen S)) ∗ own γs.2 (◯ S).

    Instance local_history_seen_Persistent :
      ∀ i s, Persistent (local_history_seen i s).
    Proof. apply _. Qed.

    Lemma seen_lookup i γs s Ss :
      γLs !! i = Some γs →
      ([∗ list] γs';S ∈ γLs;Ss, local_history_Global_inv γs' S) ⊢
      own γs.1 (◯ (PrinSeen s)) -∗
      ∃ s', ⌜seen_relation s s' ∧ Ss !! i = Some s'⌝.
    Proof.
      iIntros (Hi) "HL Hs".
      iDestruct (big_sepL2_length with "HL") as %Hlen.
      destruct (lookup_lt_is_Some_2 Ss i) as [S HS].
      { rewrite -Hlen; apply lookup_lt_is_Some; eauto. }
      iDestruct (big_sepL2_lookup_acc _ _ _ i with "HL") as "[[HS1 HS2] Hrest]";
        eauto.
      iDestruct (own_valid_2 with "HS1 Hs") as %[Hv1 Hv2]%auth_both_valid_discrete.
      revert Hv1; rewrite principal_included; eauto.
    Qed.

    Lemma local_history_invs_agree i s Ss :
      ([∗ list] γs;S ∈ γLs;Ss, local_history_Global_inv γs S) ⊢
      local_history_Local_inv i s -∗ ⌜Ss !! i = Some s⌝.
    Proof.
      iIntros "HL Hs".
      iDestruct "Hs" as (γs ?) "[Hs1 Hs2]".
      iDestruct (big_sepL2_length with "HL") as %Hlen.
      destruct (lookup_lt_is_Some_2 Ss i) as [s' Hs'].
      { rewrite -Hlen; apply lookup_lt_is_Some; eauto. }
      iDestruct (big_sepL2_lookup_acc _ _ _ i with "HL") as "[[HS1 HS2] Hrest]";
        eauto.
      iDestruct (own_valid_2 with "HS1 Hs1") as %[Hv1 Hv2]%auth_both_valid_discrete.
      revert Hv1; rewrite principal_included; intros [Hv11 Hv12].
      iDestruct (own_valid_2 with "Hs2 HS2") as %[Hv1' Hv2']%auth_both_valid_discrete.
      revert Hv1'; rewrite gset_included; intros Hv1'.
      iPureIntro.
      rewrite Hs'; f_equal.
      set_solver.
    Qed.

    Lemma global_local_history_agree i γs s s':
      γLs !! i = Some γs →
      local_history_Global_inv γs s ⊢ local_history_Local_inv i s' -∗ ⌜s = s'⌝.
    Proof.
      iIntros (Hi) "[Hs1 Hs2]".
      iDestruct 1 as (γs' Hi') "[Hs'1 Hs'2]".
      simplify_eq.
      iDestruct (own_valid_2 with "Hs1 Hs'1") as %[Hv1 Hv2]%auth_both_valid_discrete.
      revert Hv1; rewrite principal_included; intros [Hv11 Hv12].
      iDestruct (own_valid_2 with "Hs'2 Hs2") as %[Hv'1 Hv'2]%auth_both_valid_discrete.
      apply gset_included in Hv'1.
      iPureIntro; set_solver.
    Qed.

    Lemma local_history_seen_included i s s':
      local_history_Local_inv i s' ⊢ local_history_seen i s -∗ ⌜s ⊆ s'⌝.
    Proof.
      iDestruct 1 as (γs Hi) "[Hs1 Hs2]".
      iDestruct 1 as (γs' Hi') "[Hs'1 Hs'2]".
      simplify_eq.
      iDestruct (own_valid_2 with "Hs2 Hs'2") as %[Hv'1 Hv'2]%auth_both_valid_discrete.
      by apply gset_included in Hv'1.
    Qed.

    Lemma local_history_update i s Ss e:
      (∀ (e' : apply_event),
          e' ∈ s → vector_clock_lt (ae_time e) (ae_time e') → False) →
      local_history_Local_inv i s ⊢
      ([∗ list] γs;S ∈ γLs;Ss, local_history_Global_inv γs S) ==∗
      ([∗ list] γs;S ∈ γLs; <[i := s ∪ {[e]} ]> Ss,
        local_history_Global_inv γs S) ∗
      local_history_Local_inv i (s ∪ {[e]}).
    Proof.
      iIntros (He) "Hs HL".
      iDestruct "Hs" as (γs ?) "[Hs1 Hs2]".
      iDestruct (big_sepL2_length with "HL") as %Hlen.
      destruct (lookup_lt_is_Some_2 Ss i) as [s' Hs'].
      { rewrite -Hlen; apply lookup_lt_is_Some; eauto. }
      iDestruct (big_sepL2_insert_acc _ _ _ i with "HL") as "[HS Hback]";
        eauto.
      iDestruct (global_local_history_agree with "HS [Hs1 Hs2]") as %->;
        first done.
      { iExists _; iSplit; first done; iFrame. }
      iDestruct "HS" as "[HS1 HS2]".
      iMod (own_update_2 _ _ _ (● PrinSeen (s ∪ {[e]}) ⋅ ◯ PrinSeen (s ∪ {[e]}))
              with "HS1 Hs1") as "[HS1 Hs1]".
      { apply auth_update.
        apply monotone_local_update_grow.
        split; set_solver. }
      iMod (own_update_2 _ _ _ (● (s ∪ {[e]}) ⋅ ◯ (s ∪ {[e]}))
              with "Hs2 HS2") as "[Hs2 HS2]".
      { apply auth_update.
        apply gset_local_update.
        set_solver. }
      iSpecialize ("Hback" $! γs (s ∪ {[e]}) with "[$HS1 $HS2]").
      rewrite (list_insert_id γLs); last done.
      iModIntro; iFrame.
      iExists _; iSplit; first done; iFrame.
    Qed.

  End Predicates.

  Section init.

    Lemma alloc_lhst :
    True ⊢ |==>
      ∃ γLs,
        ⌜length γLs = length DB_addresses⌝ ∗
        ([∗ list] γs; S ∈ γLs; empty_lhsts, local_history_Global_inv γs S) ∗
        ([∗ list] i ↦ _ ∈ DB_addresses, local_history_Local_inv γLs i ∅).
  Proof.
    iIntros (_).
    rewrite /empty_lhsts.
    iInduction DB_addresses as [|dba] "IHdba"; simpl.
    { by iModIntro; iExists []; rewrite !big_sepL2_nil. }
    iMod ("IHdba") as (γLs Hlen) "[H1 H2]".
    iMod (own_alloc (● PrinSeen ∅ ⋅ ◯ PrinSeen ∅)) as (γ1) "[H31 H32]".
    { by apply auth_both_valid_discrete. }
    iMod (own_alloc (● ∅ ⋅ ◯ ∅)) as (γ2) "[H41 H42]".
    { by apply auth_both_valid_discrete. }
    iModIntro.
    iExists ((γ1, γ2) :: γLs).
    rewrite -Hlen /=; iSplit; first done.
    iFrame.
    iExists (γ1, γ2); iSplit; first done.
    iFrame.
  Qed.

  End init.

End Local_history.


Require Import Bool List Arith Nat.
Import ListNotations.
Require Import Mmx.ast_instructions Mmx.binary Mmx.association_list Mmx.encode.
Require Import Coq.Logic.FunctionalExtensionality.

Lemma list_nil_length {T : Type} : forall (l : list T), length l = 0 -> l = nil.
  Admitted.

(*=encode_decode_t_n *)
Lemma encode_decode : forall (i : instruction)
                                 (bi : binary_instruction),
    encode i = Some bi -> decode bi = Some (i).
(*=End *)
Proof.
  (* first part trying to get lot of information from encode_t_n *)
  intros.
  unfold encode in H.
  repeat destruct i.
  Check bind_rewrite.

  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  unfold decode.
  rewrite ret_rewrite in H.
  inversion H.
  subst.
  assert (length x0 = 8) by (apply commut_equal in H1; apply size_n_bit in H1; auto).
  assert (get_first_n_bit (x0 ++ x1) 8 = (x0, x1)).
  { apply get_first_n_bit_size_2. auto. }
  rewrite H4.
  apply commut_equal in H0.
  apply lookup_lookdown in H0.
  apply commut_equal in H1.
  assert (bit_n x0 = x).
  { apply n_bit_n in H1. exact H1. }
  rewrite H5.
  rewrite H0.
  assert (forall (f : tag -> (option instruction)), bind (Some (t)) f = f (t) ) by reflexivity.
  rewrite H6.
  assert (lookup_sig t sig_dico = Some l0) by admit.
  rewrite H7.
  assert (forall (f : list op_type -> (M instruction)), bind (Some (l0)) f = f (l0) ) by reflexivity.
  rewrite H8.
  unfold decode_sig.
  induction l0.
  - simpl. rewrite ret_rewrite.
    assert (l = @nil operande).
    {   apply commut_equal in H2.
        rewrite <- encode_size_eq in H2.
        simpl in H2.
        apply commut_equal in H2.
        apply list_nil_length in H2.
        assumption.
    }
    rewrite H9.
    reflexivity.
  - Admitted.
 (*
  assert (forall (f : tag -> (option instruction)), bind (Some (tag_t_n (instr_opcode_t_n i))) f = f (tag_t_n (instr_opcode_t_n i))) by reflexivity.
  rewrite H9.
  assert (length x1 = 8) by (apply commut_equal in H2; apply operand_to_bin_size in H2; auto).
  assert (get_first_n_bit  (x1 ++ x2 ++ x3) 8 = (x1,x2 ++ x3)) by (apply get_first_n_bit_size_3; auto).
  rewrite H11.
  assert (length x2 = 8) by (apply commut_equal in H3; apply operand_to_bin_size in H3; auto).
  assert (get_first_n_bit  (x2 ++ x3) 8 = (x2,x3))by (apply commut_equal in H4; apply get_first_n_bit_size_tl; auto).
  rewrite H13.
  assert (length x3 = 8) by (apply commut_equal in H4; apply operand_to_bin_size in H4; auto).
  assert (get_first_n_bit  (x3) 8 = (x3,[])) by (apply get_first_n_bit_size_nil_n; auto).
  rewrite H15.
  rewrite ret_rewrite.
  apply commut_equal in H2.
  apply operand_to_bin_hypothesis_reg in H2.
  rewrite H2.
  apply commut_equal in H3.
  apply operand_to_bin_hypothesis_reg in H3.
  rewrite H3.
  apply commut_equal in H4.
  apply operand_to_bin_hypothesis_reg in H4.
  rewrite H4.
  assert ({|
       instr_opcode_t_n := instr_opcode_t_n i;
       instr_operande1_t_n := instr_operande1_t_n i;
       instr_operande2_t_n := instr_operande2_t_n i;
       instr_operande3_t_n := instr_operande3_t_n i |} = i).
  {
    simpl. destruct i.
    compute. reflexivity.
  }
  rewrite H16.
  repeat rewrite app_length.
  rewrite H5.
  rewrite H10.
  rewrite H12.
  rewrite H14.
  simpl.
  reflexivity.*)
Qed.

Lemma encode_decode_t_i : forall (i : instruction_tern_i) (bi : binary_instruction),
    encode_t_i i = Some bi -> decode bi = Some (instr_t_i i).
Proof.
    (* first part trying to get lot of information from encode_t_n *)
  intros.
  unfold encode_t_n in H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  unfold decode.
  rewrite ret_rewrite in H.
  inversion H.
  (* now going to go further into decode *)
  assert (length x0 = 8) by (apply commut_equal in H1; apply size_n_bit in H1; auto).
  assert (get_first_n_bit (x0 ++ x1 ++ x2 ++ x3) 8 = (x0,x1 ++ x2 ++ x3)) by (apply get_first_n_bit_size_4; auto).
  rewrite H7.
  apply commut_equal in H0.
  apply lookup_lookdown in H0.
  apply commut_equal in H1.
  assert (bit_n x0 = x) by (apply n_bit_n in H1; exact H1).
  rewrite H8.
  rewrite H0.
  assert (forall (f : tag -> (option instruction)), bind (Some (tag_t_i (instr_opcode_t_i i))) f = f (tag_t_i (instr_opcode_t_i i))) by reflexivity.
  rewrite H9.
  assert (length x1 = 8) by (apply commut_equal in H2; apply operand_to_bin_size in H2; auto).
  assert (get_first_n_bit  (x1 ++ x2 ++ x3) 8 = (x1,x2 ++ x3)) by (apply get_first_n_bit_size_3; auto).
  rewrite H11.
  assert (length x2 = 8) by (apply commut_equal in H3; apply operand_to_bin_size in H3; auto).
  assert (get_first_n_bit  (x2 ++ x3) 8 = (x2,x3))by (apply commut_equal in H4; apply get_first_n_bit_size_tl; auto).
  rewrite H13.
  assert (length x3 = 8) by (apply commut_equal in H4; apply operand_to_bin_size in H4; auto).
  assert (get_first_n_bit  (x3) 8 = (x3,[])) by (apply get_first_n_bit_size_nil_n; auto).
  rewrite H15.
  rewrite ret_rewrite.
  apply commut_equal in H2.
  apply operand_to_bin_hypothesis_reg in H2.
  rewrite H2.
  apply commut_equal in H3.
  apply operand_to_bin_hypothesis_reg in H3.
  rewrite H3.
  apply commut_equal in H4.
  apply operand_to_bin_hypothesis_imm in H4.
  rewrite H4.
  assert ({|
       instr_opcode_t_i := instr_opcode_t_i i;
       instr_operande1_t_i := instr_operande1_t_i i;
       instr_operande2_t_i := instr_operande2_t_i i;
       instr_operande3_t_i := instr_operande3_t_i i |} = i).
  {
    simpl. destruct i.
    compute. reflexivity.
  }
  rewrite H16.
  repeat rewrite app_length.
  rewrite H5.
  rewrite H10.
  rewrite H12.
  rewrite H14.
  simpl.
  reflexivity.
Qed.

Lemma encode_decode_t_i2 : forall (i : instruction_tern_i2) (bi : binary_instruction),
    encode_t_i2 i = Some bi -> decode bi = Some (instr_t_i2 i).
Proof.
    (* first part trying to get lot of information from encode_t_n *)
  intros.
  unfold encode_t_n in H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  unfold decode.
  rewrite ret_rewrite in H.
  inversion H.
  (* now going to go further into decode *)
  assert (length x0 = 8) by (apply commut_equal in H1; apply size_n_bit in H1; auto).
  assert (get_first_n_bit (x0 ++ x1 ++ x2 ++ x3) 8 = (x0,x1 ++ x2 ++ x3)) by (apply get_first_n_bit_size_4; auto).
  rewrite H7.
  apply commut_equal in H0.
  apply lookup_lookdown in H0.
  apply commut_equal in H1.
  assert (bit_n x0 = x) by (apply n_bit_n in H1; exact H1).
  rewrite H8.
  rewrite H0.
  assert (forall (f : tag -> (option instruction)), bind (Some (tag_t_i2 (instr_opcode_t_i2 i))) f = f (tag_t_i2 (instr_opcode_t_i2 i))) by reflexivity.
  rewrite H9.
  assert (length x1 = 8) by (apply commut_equal in H2; apply operand_to_bin_size in H2; auto).
  assert (get_first_n_bit  (x1 ++ x2 ++ x3) 8 = (x1,x2 ++ x3)) by (apply get_first_n_bit_size_3; auto).
  rewrite H11.
  assert (length x2 = 8) by (apply commut_equal in H3; apply operand_to_bin_size in H3; auto).
  assert (get_first_n_bit  (x2 ++ x3) 8 = (x2,x3))by (apply commut_equal in H4; apply get_first_n_bit_size_tl; auto).
  rewrite H13.
  assert (length x3 = 8) by (apply commut_equal in H4; apply operand_to_bin_size in H4; auto).
  assert (get_first_n_bit  (x3) 8 = (x3,[])) by (apply get_first_n_bit_size_nil_n; auto).
  rewrite H15.
  rewrite ret_rewrite.
  apply commut_equal in H2.
  Check operand_to_bin_hypothesis_reg.
  apply operand_to_bin_hypothesis_reg in H2.
  rewrite H2.
  apply commut_equal in H3.
  apply operand_to_bin_hypothesis_imm in H3.
  rewrite H3.
  apply commut_equal in H4.
  apply operand_to_bin_hypothesis_reg in H4.
  rewrite H4.
  assert ({|
       instr_opcode_t_i2 := instr_opcode_t_i2 i;
       instr_operande1_t_i2 := instr_operande1_t_i2 i;
       instr_operande2_t_i2 := instr_operande2_t_i2 i;
       instr_operande3_t_i2 := instr_operande3_t_i2 i |} = i).
  {
    simpl. destruct i.
    compute. reflexivity.
  }
  rewrite H16.
  repeat rewrite app_length.
  rewrite H5.
  rewrite H10.
  rewrite H12.
  rewrite H14.
  simpl.
  reflexivity.
Qed.

Lemma encode_decode_t_i3 : forall (i : instruction_tern_i3) (bi : binary_instruction),
    encode_t_i3 i = Some bi -> decode bi = Some (instr_t_i3 i).
Proof.
    (* first part trying to get lot of information from encode_t_n *)
  intros.
  unfold encode_t_n in H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  unfold decode.
  rewrite ret_rewrite in H.
  inversion H.
  (* now going to go further into decode *)
  assert (length x0 = 8) by (apply commut_equal in H1; apply size_n_bit in H1; auto).
  assert (get_first_n_bit (x0 ++ x1 ++ x2 ++ x3) 8 = (x0,x1 ++ x2 ++ x3)) by (apply get_first_n_bit_size_4; auto).
  rewrite H7.
  apply commut_equal in H0.
  apply lookup_lookdown in H0.
  apply commut_equal in H1.
  assert (bit_n x0 = x) by (apply n_bit_n in H1; exact H1).
  rewrite H8.
  rewrite H0.
  assert (forall (f : tag -> (option instruction)), bind (Some (tag_t_i3 (instr_opcode_t_i3 i))) f = f (tag_t_i3 (instr_opcode_t_i3 i))) by reflexivity.
  rewrite H9.
  assert (length x1 = 8) by (apply commut_equal in H2; apply operand_to_bin_size in H2; auto).
  assert (get_first_n_bit  (x1 ++ x2 ++ x3) 8 = (x1,x2 ++ x3)) by (apply get_first_n_bit_size_3; auto).
  rewrite H11.
  assert (length x2 = 8) by (apply commut_equal in H3; apply operand_to_bin_size in H3; auto).
  assert (get_first_n_bit  (x2 ++ x3) 8 = (x2,x3))by (apply commut_equal in H4; apply get_first_n_bit_size_tl; auto).
  rewrite H13.
  assert (length x3 = 8) by (apply commut_equal in H4; apply operand_to_bin_size in H4; auto).
  assert (get_first_n_bit  (x3) 8 = (x3,[])) by (apply get_first_n_bit_size_nil_n; auto).
  rewrite H15.
  rewrite ret_rewrite.
  apply commut_equal in H2.
  Check operand_to_bin_hypothesis_reg.
  apply operand_to_bin_hypothesis_imm in H2.
  rewrite H2.
  apply commut_equal in H3.
  apply operand_to_bin_hypothesis_reg in H3.
  rewrite H3.
  apply commut_equal in H4.
  apply operand_to_bin_hypothesis_reg in H4.
  rewrite H4.
  assert ({|
       instr_opcode_t_i3 := instr_opcode_t_i3 i;
       instr_operande1_t_i3 := instr_operande1_t_i3 i;
       instr_operande2_t_i3 := instr_operande2_t_i3 i;
       instr_operande3_t_i3 := instr_operande3_t_i3 i |} = i).
  {
    simpl. destruct i.
    compute. reflexivity.
  }
  rewrite H16.
  repeat rewrite app_length.
  rewrite H5.
  rewrite H10.
  rewrite H12.
  rewrite H14.
  simpl.
  reflexivity.
Qed.

Lemma encode_decode_t_i4 : forall (i : instruction_tern_i4) (bi : binary_instruction),
    encode_t_i4 i = Some bi -> decode bi = Some (instr_t_i4 i).
Proof.
    (* first part trying to get lot of information from encode_t_n *)
  intros.
  unfold encode_t_n in H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  unfold decode.
  rewrite ret_rewrite in H.
  inversion H.
  (* now going to go further into decode *)
  assert (length x0 = 8) by (apply commut_equal in H1; apply size_n_bit in H1; auto).
  assert (get_first_n_bit (x0 ++ x1 ++ x2 ++ x3) 8 = (x0,x1 ++ x2 ++ x3)) by (apply get_first_n_bit_size_4; auto).
  rewrite H7.
  apply commut_equal in H0.
  apply lookup_lookdown in H0.
  apply commut_equal in H1.
  assert (bit_n x0 = x) by (apply n_bit_n in H1; exact H1).
  rewrite H8.
  rewrite H0.
  assert (forall (f : tag -> (option instruction)), bind (Some (tag_t_i4 (instr_opcode_t_i4 i))) f = f (tag_t_i4 (instr_opcode_t_i4 i))) by reflexivity.
  rewrite H9.
  assert (length x1 = 8) by (apply commut_equal in H2; apply operand_to_bin_size in H2; auto).
  assert (get_first_n_bit  (x1 ++ x2 ++ x3) 8 = (x1,x2 ++ x3)) by (apply get_first_n_bit_size_3; auto).
  rewrite H11.
  assert (length x2 = 8) by (apply commut_equal in H3; apply operand_to_bin_size in H3; auto).
  assert (get_first_n_bit  (x2 ++ x3) 8 = (x2,x3))by (apply commut_equal in H4; apply get_first_n_bit_size_tl; auto).
  rewrite H13.
  assert (length x3 = 8) by (apply commut_equal in H4; apply operand_to_bin_size in H4; auto).
  assert (get_first_n_bit  (x3) 8 = (x3,[])) by (apply get_first_n_bit_size_nil_n; auto).
  rewrite H15.
  rewrite ret_rewrite.
  apply commut_equal in H2.
  Check operand_to_bin_hypothesis_reg.
  apply operand_to_bin_hypothesis_reg in H2.
  rewrite H2.
  apply commut_equal in H3.
  apply operand_to_bin_hypothesis_imm in H3.
  rewrite H3.
  apply commut_equal in H4.
  apply operand_to_bin_hypothesis_imm in H4.
  rewrite H4.
  assert ({|
       instr_opcode_t_i4 := instr_opcode_t_i4 i;
       instr_operande1_t_i4 := instr_operande1_t_i4 i;
       instr_operande2_t_i4 := instr_operande2_t_i4 i;
       instr_operande3_t_i4 := instr_operande3_t_i4 i |} = i).
  {
    simpl. destruct i.
    compute. reflexivity.
  }
  rewrite H16.
  repeat rewrite app_length.
  rewrite H5.
  rewrite H10.
  rewrite H12.
  rewrite H14.
  simpl.
  reflexivity.
Qed.

Lemma encode_decode_t_i5 : forall (i : instruction_tern_i5) (bi : binary_instruction),
    encode_t_i5 i = Some bi -> decode bi = Some (instr_t_i5 i).
Proof.
    (* first part trying to get lot of information from encode_t_n *)
  intros.
  unfold encode_t_n in H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  unfold decode.
  rewrite ret_rewrite in H.
  inversion H.
  (* now going to go further into decode *)
  assert (length x0 = 8) by (apply commut_equal in H1; apply size_n_bit in H1; auto).
  assert (get_first_n_bit (x0 ++ x1 ++ x2 ++ x3) 8 = (x0,x1 ++ x2 ++ x3)) by (apply get_first_n_bit_size_4; auto).
  rewrite H7.
  apply commut_equal in H0.
  apply lookup_lookdown in H0.
  apply commut_equal in H1.
  assert (bit_n x0 = x) by (apply n_bit_n in H1; exact H1).
  rewrite H8.
  rewrite H0.
  assert (forall (f : tag -> (option instruction)), bind (Some (tag_t_i5 (instr_opcode_t_i5 i))) f = f (tag_t_i5 (instr_opcode_t_i5 i))) by reflexivity.
  rewrite H9.
  assert (length x1 = 8) by (apply commut_equal in H2; apply operand_to_bin_size in H2; auto).
  assert (get_first_n_bit  (x1 ++ x2 ++ x3) 8 = (x1,x2 ++ x3)) by (apply get_first_n_bit_size_3; auto).
  rewrite H11.
  assert (length x2 = 8) by (apply commut_equal in H3; apply operand_to_bin_size in H3; auto).
  assert (get_first_n_bit  (x2 ++ x3) 8 = (x2,x3))by (apply commut_equal in H4; apply get_first_n_bit_size_tl; auto).
  rewrite H13.
  assert (length x3 = 8) by (apply commut_equal in H4; apply operand_to_bin_size in H4; auto).
  assert (get_first_n_bit  (x3) 8 = (x3,[])) by (apply get_first_n_bit_size_nil_n; auto).
  rewrite H15.
  rewrite ret_rewrite.
  apply commut_equal in H2.
  Check operand_to_bin_hypothesis_reg.
  apply operand_to_bin_hypothesis_imm in H2.
  rewrite H2.
  apply commut_equal in H3.
  apply operand_to_bin_hypothesis_imm in H3.
  rewrite H3.
  apply commut_equal in H4.
  apply operand_to_bin_hypothesis_imm in H4.
  rewrite H4.
  assert ({|
       instr_opcode_t_i5 := instr_opcode_t_i5 i;
       instr_operande1_t_i5 := instr_operande1_t_i5 i;
       instr_operande2_t_i5 := instr_operande2_t_i5 i;
       instr_operande3_t_i5 := instr_operande3_t_i5 i |} = i).
  {
    simpl. destruct i.
    compute. reflexivity.
  }
  rewrite H16.
  repeat rewrite app_length.
  rewrite H5.
  rewrite H10.
  rewrite H12.
  rewrite H14.
  simpl.
  reflexivity.
Qed.

Lemma encode_decode_t_i6 : forall (i : instruction_tern_i6) (bi : binary_instruction),
    encode_t_i6 i = Some bi -> decode bi = Some (instr_t_i6 i).
Proof.
    (* first part trying to get lot of information from encode_t_n *)
  intros.
  unfold encode_t_n in H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  unfold decode.
  rewrite ret_rewrite in H.
  inversion H.
  (* now going to go further into decode *)
  assert (length x0 = 8) by (apply commut_equal in H1; apply size_n_bit in H1; auto).
  assert (get_first_n_bit (x0 ++ x1 ++ x2 ++ x3) 8 = (x0,x1 ++ x2 ++ x3)) by (apply get_first_n_bit_size_4; auto).
  rewrite H7.
  apply commut_equal in H0.
  apply lookup_lookdown in H0.
  apply commut_equal in H1.
  assert (bit_n x0 = x) by (apply n_bit_n in H1; exact H1).
  rewrite H8.
  rewrite H0.
  assert (forall (f : tag -> (option instruction)), bind (Some (tag_t_i6 (instr_opcode_t_i6 i))) f = f (tag_t_i6 (instr_opcode_t_i6 i))) by reflexivity.
  rewrite H9.
  assert (length x1 = 8) by (apply commut_equal in H2; apply operand_to_bin_size in H2; auto).
  assert (get_first_n_bit  (x1 ++ x2 ++ x3) 8 = (x1,x2 ++ x3)) by (apply get_first_n_bit_size_3; auto).
  rewrite H11.
  assert (length x2 = 8) by (apply commut_equal in H3; apply operand_to_bin_size in H3; auto).
  assert (get_first_n_bit  (x2 ++ x3) 8 = (x2,x3))by (apply commut_equal in H4; apply get_first_n_bit_size_tl; auto).
  rewrite H13.
  assert (length x3 = 8) by (apply commut_equal in H4; apply operand_to_bin_size in H4; auto).
  assert (get_first_n_bit  (x3) 8 = (x3,[])) by (apply get_first_n_bit_size_nil_n; auto).
  rewrite H15.
  rewrite ret_rewrite.
  apply commut_equal in H2.
  Check operand_to_bin_hypothesis_reg.
  apply operand_to_bin_hypothesis_imm in H2.
  rewrite H2.
  apply commut_equal in H3.
  apply operand_to_bin_hypothesis_reg in H3.
  rewrite H3.
  apply commut_equal in H4.
  apply operand_to_bin_hypothesis_imm in H4.
  rewrite H4.
  assert ({|
       instr_opcode_t_i6 := instr_opcode_t_i6 i;
       instr_operande1_t_i6 := instr_operande1_t_i6 i;
       instr_operande2_t_i6 := instr_operande2_t_i6 i;
       instr_operande3_t_i6 := instr_operande3_t_i6 i |} = i).
  {
    simpl. destruct i.
    compute. reflexivity.
  }
  rewrite H16.
  repeat rewrite app_length.
  rewrite H5.
  rewrite H10.
  rewrite H12.
  rewrite H14.
  simpl.
  reflexivity.
Qed.

Lemma encode_decode_d_n : forall (i : instruction_duo_n) (bi : binary_instruction),
    encode_d_n i = Some bi -> decode bi = Some (instr_d_n i).
Proof.
    (* first part trying to get lot of information from encode_t_n *)
  intros.
  unfold encode_t_n in H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  unfold decode.
  rewrite ret_rewrite in H.
  inversion H.
  (* now going to go further into decode *)
  assert (length x0 = 8) by (apply commut_equal in H1; apply size_n_bit in H1; auto).
  assert (get_first_n_bit (x0 ++ x1 ++ x2) 8 = (x0,x1 ++ x2)) by (apply get_first_n_bit_size_3; auto).
  rewrite H6.
  apply commut_equal in H0.
  apply lookup_lookdown in H0.
  apply commut_equal in H1.
  assert (bit_n x0 = x) by (apply n_bit_n in H1; exact H1).
  rewrite H7.
  rewrite H0.
  assert (forall (f : tag -> (option instruction)), bind (Some (tag_d_n (instr_opcode_d_n i))) f = f (tag_d_n (instr_opcode_d_n i))) by reflexivity.
  rewrite H8.
  assert (length x1 = 8) by (apply commut_equal in H2; apply operand_to_bin_size in H2; auto).
  assert (get_first_n_bit  (x1 ++ x2) 8 = (x1,x2)) by (apply get_first_n_bit_size_tl; auto).
  rewrite H10.
  assert (length x2 = 16) by (apply commut_equal in H3; apply operand_to_bin_double_size in H3; auto).
  assert (get_first_n_bit x2 16 = (x2,[]))by (apply commut_equal in H4; apply get_first_n_bit_size_nil_n; auto).
  rewrite H12.
  rewrite ret_rewrite.
  apply commut_equal in H2.
  apply operand_to_bin_hypothesis_reg in H2.
  rewrite H2.
  apply commut_equal in H3.
  apply operand_to_bin_double_hypothesis_reg in H3.
  rewrite H3.
  assert ({|
       instr_opcode_d_n := instr_opcode_d_n i;
       instr_operande1_d_n := instr_operande1_d_n i;
       instr_operande2_d_n := instr_operande2_d_n i; |} = i).
  {
    simpl. destruct i.
    compute. reflexivity.
  }
  rewrite H13.
  repeat rewrite app_length.
  rewrite H4.
  rewrite H9.
  rewrite H11.
  simpl.
  reflexivity.
Qed.

Lemma encode_decode_d_i : forall (i : instruction_duo_i) (bi : binary_instruction),
    encode_d_i i = Some bi -> decode bi = Some (instr_d_i i).
Proof.
    (* first part trying to get lot of information from encode_t_n *)
  intros.
  unfold encode_t_n in H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  unfold decode.
  rewrite ret_rewrite in H.
  inversion H.
  (* now going to go further into decode *)
  assert (length x0 = 8) by (apply commut_equal in H1; apply size_n_bit in H1; auto).
  assert (get_first_n_bit (x0 ++ x1 ++ x2) 8 = (x0,x1 ++ x2)) by (apply get_first_n_bit_size_3; auto).
  rewrite H6.
  apply commut_equal in H0.
  apply lookup_lookdown in H0.
  apply commut_equal in H1.
  assert (bit_n x0 = x) by (apply n_bit_n in H1; exact H1).
  rewrite H7.
  rewrite H0.
  assert (forall (f : tag -> (option instruction)), bind (Some (tag_d_i (instr_opcode_d_i i))) f = f (tag_d_i (instr_opcode_d_i i))) by reflexivity.
  rewrite H8.
  assert (length x1 = 8) by (apply commut_equal in H2; apply operand_to_bin_size in H2; auto).
  assert (get_first_n_bit  (x1 ++ x2) 8 = (x1,x2)) by (apply get_first_n_bit_size_tl; auto).
  rewrite H10.
  assert (length x2 = 16) by (apply commut_equal in H3; apply operand_to_bin_double_size in H3; auto).
  assert (get_first_n_bit x2 16 = (x2,[]))by (apply commut_equal in H4; apply get_first_n_bit_size_nil_n; auto).
  rewrite H12.
  rewrite ret_rewrite.
  apply commut_equal in H2.
  apply operand_to_bin_hypothesis_reg in H2.
  rewrite H2.
  apply commut_equal in H3.
  apply operand_to_bin_double_hypothesis_imm in H3.
  rewrite H3.
  assert ({|
       instr_opcode_d_i := instr_opcode_d_i i;
       instr_operande1_d_i := instr_operande1_d_i i;
       instr_operande2_d_i := instr_operande2_d_i i; |} = i).
  {
    simpl. destruct i.
    compute. reflexivity.
  }
  rewrite H13.
  repeat rewrite app_length.
  rewrite H4.
  rewrite H9.
  rewrite H11.
  reflexivity.
Qed.

Lemma encode_decode_d_i2 : forall (i : instruction_duo_i2) (bi : binary_instruction),
    encode_d_i2 i = Some bi -> decode bi = Some (instr_d_n2 i).
Proof.
    (* first part trying to get lot of information from encode_t_n *)
  intros.
  unfold encode_t_n in H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  unfold decode.
  rewrite ret_rewrite in H.
  inversion H.
  (* now going to go further into decode *)
  assert (length x0 = 8) by (apply commut_equal in H1; apply size_n_bit in H1; auto).
  assert (get_first_n_bit (x0 ++ x1 ++ x2) 8 = (x0,x1 ++ x2)) by (apply get_first_n_bit_size_3; auto).
  rewrite H6.
  apply commut_equal in H0.
  apply lookup_lookdown in H0.
  apply commut_equal in H1.
  assert (bit_n x0 = x) by (apply n_bit_n in H1; exact H1).
  rewrite H7.
  rewrite H0.
  assert (forall (f : tag -> (option instruction)), bind (Some (tag_d_i2 (instr_opcode_d_i2 i))) f = f (tag_d_i2 (instr_opcode_d_i2 i))) by reflexivity.
  rewrite H8.
  assert (length x1 = 8) by (apply commut_equal in H2; apply operand_to_bin_size in H2; auto).
  assert (get_first_n_bit  (x1 ++ x2) 8 = (x1,x2)) by (apply get_first_n_bit_size_tl; auto).
  rewrite H10.
  assert (length x2 = 16) by (apply commut_equal in H3; apply operand_to_bin_double_size in H3; auto).
  assert (get_first_n_bit x2 16 = (x2,[]))by (apply commut_equal in H4; apply get_first_n_bit_size_nil_n; auto).
  rewrite H12.
  rewrite ret_rewrite.
  apply commut_equal in H2.
  apply operand_to_bin_hypothesis_imm in H2.
  rewrite H2.
  apply commut_equal in H3.
  apply operand_to_bin_double_hypothesis_reg in H3.
  rewrite H3.
  assert ({|
       instr_opcode_d_i2 := instr_opcode_d_i2 i;
       instr_operande1_d_i2 := instr_operande1_d_i2 i;
       instr_operande2_d_i2 := instr_operande2_d_i2 i; |} = i).
  {
    simpl. destruct i.
    compute. reflexivity.
  }
  rewrite H13.
  repeat rewrite app_length.
  rewrite H4.
  rewrite H9.
  rewrite H11.
  reflexivity.
Qed.

Lemma encode_decode_d_i3 : forall (i : instruction_duo_i3) (bi : binary_instruction),
    encode_d_i3 i = Some bi -> decode bi = Some (instr_d_n3 i).
Proof.
    (* first part trying to get lot of information from encode_t_n *)
  intros.
  unfold encode_t_n in H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  unfold decode.
  rewrite ret_rewrite in H.
  inversion H.
  (* now going to go further into decode *)
  assert (length x0 = 8) by (apply commut_equal in H1; apply size_n_bit in H1; auto).
  assert (get_first_n_bit (x0 ++ x1 ++ x2) 8 = (x0,x1 ++ x2)) by (apply get_first_n_bit_size_3; auto).
  rewrite H6.
  apply commut_equal in H0.
  apply lookup_lookdown in H0.
  apply commut_equal in H1.
  assert (bit_n x0 = x) by (apply n_bit_n in H1; exact H1).
  rewrite H7.
  rewrite H0.
  assert (forall (f : tag -> (option instruction)), bind (Some (tag_d_i3 (instr_opcode_d_i3 i))) f = f (tag_d_i3 (instr_opcode_d_i3 i))) by reflexivity.
  rewrite H8.
  assert (length x1 = 8) by (apply commut_equal in H2; apply operand_to_bin_size in H2; auto).
  assert (get_first_n_bit  (x1 ++ x2) 8 = (x1,x2)) by (apply get_first_n_bit_size_tl; auto).
  rewrite H10.
  assert (length x2 = 16) by (apply commut_equal in H3; apply operand_to_bin_double_size in H3; auto).
  assert (get_first_n_bit x2 16 = (x2,[]))by (apply commut_equal in H4; apply get_first_n_bit_size_nil_n; auto).
  rewrite H12.
  rewrite ret_rewrite.
  apply commut_equal in H2.
  apply operand_to_bin_hypothesis_imm in H2.
  rewrite H2.
  apply commut_equal in H3.
  apply operand_to_bin_double_hypothesis_imm in H3.
  rewrite H3.
  assert ({|
       instr_opcode_d_i3 := instr_opcode_d_i3 i;
       instr_operande1_d_i3 := instr_operande1_d_i3 i;
       instr_operande2_d_i3 := instr_operande2_d_i3 i; |} = i).
  {
    simpl. destruct i.
    compute. reflexivity.
  }
  rewrite H13.
  repeat rewrite app_length.
  rewrite H4.
  rewrite H9.
  rewrite H11.
  reflexivity.
Qed.

Lemma encode_decode_u : forall (i : instruction_uno) (bi : binary_instruction),
    encode_u i = Some bi -> decode bi = Some (instr_u i).
Proof.
    (* first part trying to get lot of information from encode_t_n *)
  intros.
  unfold encode_t_n in H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  destruct (instr_operande i) eqn:Hi.
  apply bind_rewrite in H.
  destruct H.
  destruct H.
  rewrite ret_rewrite in H.
  inversion H.
  unfold decode.
  (* now going to go further into decode *)
  assert (length x0 = 8) by (apply commut_equal in H1; apply size_n_bit in H1; auto).
  Search get_first_n_bit.
  assert (get_first_n_bit (x0 ++ x1) 8 = (x0,x1)) by (apply get_first_n_bit_size_tl; auto).
  rewrite H5.
  apply commut_equal in H0.
  apply lookup_lookdown in H0.
  apply commut_equal in H1.
  assert (bit_n x0 = x) by (apply n_bit_n in H1; exact H1).
  rewrite H6.
  rewrite H0.
  assert (forall (f : tag -> (option instruction)), bind (Some (tag_u (instr_opcode_s i))) f = f (tag_u (instr_opcode_s i))) by reflexivity.
  rewrite H7.
  assert (length x1 = 24).
  { apply commut_equal in H2. Search n_bit. apply size_n_bit in H2. auto. }
  Search (length (_ ++ _)).
  rewrite app_length.
  rewrite H8.
  rewrite H3.
  simpl.
    assert (get_first_n_bit  x1 24 = (x1,[])).
  { Search get_first_n_bit. apply get_first_n_bit_size_nil_n in H8. auto. }
  rewrite H9.
  rewrite ret_rewrite.
  apply commut_equal in H2.
  assert ({|
       instr_opcode_s := instr_opcode_s i;
       instr_operande := instr_operande i; |} = i).
  {
    simpl. destruct i.
    compute. reflexivity.
  }
  Search (n_bit).
  apply n_bit_n in H2.
  rewrite H2.
  rewrite <- Hi.
  rewrite H10.
  reflexivity.
Qed.

(*=encode_decode *)
Lemma encode_decode : forall (i : instruction) (bi : binary_instruction),
    encode i = Some bi -> decode bi = Some i.
(*=End *)
Proof.
  destruct i.
  -apply encode_decode_t_n.
  -apply encode_decode_t_i.
  -apply encode_decode_t_i2.
  -apply encode_decode_t_i3.
  -apply encode_decode_t_i4.
  -apply encode_decode_t_i5.
  -apply encode_decode_t_i6.
  -apply encode_decode_d_n.
  -apply encode_decode_d_i.
  -apply encode_decode_d_i2.
  -apply encode_decode_d_i3.
  -apply encode_decode_u.
Qed.


(* This file is an automatic translation, the licence of the source can be found here: *)
(* https://github.com/herd/herdtools7/blob/master/LICENSE.txt *)
(* Translation of model Compatibility *)
From Coq Require Import Relations Ensembles String.
From RelationAlgebra Require Import lattice prop monoid rel kat.
From Catincoq.lib Require Import Cat proprel.
Section Model.
Variable c : candidate.
Definition events := events c.
Definition R := R c.
Definition W := W c.
Definition IW := IW c.
Definition FW := FW c.
Definition B := B c.
Definition RMW := RMW c.
Definition F := F c.
Definition rf := rf c.
Definition po := po c.
Definition int := int c.
Definition ext := ext c.
Definition loc := loc c.
Definition addr := addr c.
Definition data := data c.
Definition ctrl := ctrl c.
Definition amo := amo c.
Definition rmw := rmw c.
Definition unknown_set := unknown_set c.
Definition unknown_relation := unknown_relation c.
Definition M := R ⊔ W.
Definition emptyset : set events := empty.
Definition classes_loc : set events -> Ensemble (Ensemble events) := partition loc.
Definition tag2events := unknown_relation "tag2events".
Definition emptyset_0 : set events := domain 0.
Definition partition := classes_loc.
Definition tag2instrs := tag2events.
Definition po_loc := po ⊓ loc.
Definition rfe := rf ⊓ ext.
Definition rfi := rf ⊓ int.
Definition co0 := loc ⊓ ([IW] ⋅ top ⋅ [(W ⊓ !IW)] ⊔ [(W ⊓ !FW)] ⋅ top ⋅ [FW]).
Definition toid (s : set events) : relation events := [s].
Definition fencerel (B : set events) := (po ⊓ [top] ⋅ top ⋅ [B]) ⋅ po.
Definition ctrlcfence (CFENCE : set events) := (ctrl ⊓ [top] ⋅ top ⋅ [CFENCE]) ⋅ po.
Definition imply (A : relation events) (B : relation events) := !A ⊔ B.
Definition nodetour (R1 : relation events) (R2 : relation events) (R3 : relation events) := R1 ⊓ !(R2 ⋅ R3).
Definition singlestep (R : relation events) := nodetour R R R.
(* Definition of map already included in the prelude *)
Definition LKW := (*failed: try LKW with emptyset_0*) emptyset_0.
Definition A := ((*failed: try X with emptyset_0*) emptyset_0) ⊔ ((*failed: try A with emptyset_0*) emptyset_0).
Definition P := M ⊓ !A.
Definition WW r := r ⊓ [W] ⋅ top ⋅ [W].
Definition WR r := r ⊓ [W] ⋅ top ⋅ [R].
Definition RW r := r ⊓ [R] ⋅ top ⋅ [W].
Definition RR r := r ⊓ [R] ⋅ top ⋅ [R].
Definition RM r := r ⊓ [R] ⋅ top ⋅ [M].
Definition MR r := r ⊓ [M] ⋅ top ⋅ [R].
Definition WM r := r ⊓ [W] ⋅ top ⋅ [M].
Definition MW r := r ⊓ [M] ⋅ top ⋅ [W].
Definition MM r := r ⊓ [M] ⋅ top ⋅ [M].
Definition AA r := r ⊓ [A] ⋅ top ⋅ [A].
Definition AP r := r ⊓ [A] ⋅ top ⋅ [P].
Definition PA r := r ⊓ [P] ⋅ top ⋅ [A].
Definition PP r := r ⊓ [P] ⋅ top ⋅ [P].
Definition AM r := r ⊓ [A] ⋅ top ⋅ [M].
Definition MA r := r ⊓ [M] ⋅ top ⋅ [A].
Definition noid r : relation events := r ⊓ !id.
Definition atom := [A].
Definition witness_conditions := True.
Definition model_conditions := True.
End Model.

Hint Unfold events R W IW FW B RMW F rf po int ext loc addr data ctrl amo rmw unknown_set unknown_relation M emptyset classes_loc tag2events emptyset_0 partition tag2instrs po_loc rfe rfi co0 toid fencerel ctrlcfence imply nodetour singlestep LKW A P WW WR RW RR RM MR WM MW MM AA AP PA PP AM MA noid atom witness_conditions model_conditions : cat.

Definition valid (c : candidate) := True.

(* End of translation of model Compatibility *)


(* This file is an automatic translation, the licence of the source can be found here: *)
(* https://github.com/herd/herdtools7/blob/master/LICENSE.txt *)
(* Translation of model TSO *)
From Coq Require Import Relations Ensembles String.
From RelationAlgebra Require Import lattice prop monoid rel kat.
From Catincoq.lib Require Import Cat proprel.
Section Model.
Variable c : candidate.
Definition events := events c.
Definition R := R c.
Definition W := W c.
Definition IW := IW c.
Definition FW := FW c.
Definition B := B c.
Definition RMW := RMW c.
Definition F := F c.
Definition rf := rf c.
Definition po := po c.
Definition int := int c.
Definition ext := ext c.
Definition loc := loc c.
Definition addr := addr c.
Definition data := data c.
Definition ctrl := ctrl c.
Definition amo := amo c.
Definition rmw := rmw c.
Definition unknown_set := unknown_set c.
Definition unknown_relation := unknown_relation c.
Definition M := R ⊔ W.
Definition emptyset : set events := empty.
Definition classes_loc : set events -> Ensemble (Ensemble events) := partition loc.
Definition MFENCE := unknown_set "MFENCE".
Definition sm := unknown_relation "sm".
Definition tag2events := unknown_relation "tag2events".
Definition emptyset_0 : set events := domain 0.
Definition partition := classes_loc.
Definition tag2instrs := tag2events.
Definition po_loc := po ⊓ loc.
Definition rfe := rf ⊓ ext.
Definition rfi := rf ⊓ int.
Definition co0 := loc ⊓ ([IW] ⋅ top ⋅ [(W ⊓ !IW)] ⊔ [(W ⊓ !FW)] ⋅ top ⋅ [FW]).
Definition toid (s : set events) : relation events := [s].
Definition fencerel (B : set events) := (po ⊓ [top] ⋅ top ⋅ [B]) ⋅ po.
Definition ctrlcfence (CFENCE : set events) := (ctrl ⊓ [top] ⋅ top ⋅ [CFENCE]) ⋅ po.
Definition imply (A : relation events) (B : relation events) := !A ⊔ B.
Definition nodetour (R1 : relation events) (R2 : relation events) (R3 : relation events) := R1 ⊓ !(R2 ⋅ R3).
Definition singlestep (R : relation events) := nodetour R R R.
(* Definition of map already included in the prelude *)
Definition LKW := (*failed: try LKW with emptyset_0*) emptyset_0.
Definition mfence := (*successful: try fencerel MFENCE with 0*) fencerel MFENCE.
Definition lfence : relation events := (*failed: try fencerel LFENCE with 0*) 0.
Definition sfence : relation events := (*failed: try fencerel SFENCE with 0*) 0.
Definition A := ((*failed: try X with emptyset_0*) emptyset_0) ⊔ ((*failed: try A with emptyset_0*) emptyset_0).
Definition P := M ⊓ !A.
Definition WW r := r ⊓ [W] ⋅ top ⋅ [W].
Definition WR r := r ⊓ [W] ⋅ top ⋅ [R].
Definition RW r := r ⊓ [R] ⋅ top ⋅ [W].
Definition RR r := r ⊓ [R] ⋅ top ⋅ [R].
Definition RM r := r ⊓ [R] ⋅ top ⋅ [M].
Definition MR r := r ⊓ [M] ⋅ top ⋅ [R].
Definition WM r := r ⊓ [W] ⋅ top ⋅ [M].
Definition MW r := r ⊓ [M] ⋅ top ⋅ [W].
Definition MM r := r ⊓ [M] ⋅ top ⋅ [M].
Definition AA r := r ⊓ [A] ⋅ top ⋅ [A].
Definition AP r := r ⊓ [A] ⋅ top ⋅ [P].
Definition PA r := r ⊓ [P] ⋅ top ⋅ [A].
Definition PP r := r ⊓ [P] ⋅ top ⋅ [P].
Definition AM r := r ⊓ [A] ⋅ top ⋅ [M].
Definition MA r := r ⊓ [M] ⋅ top ⋅ [A].
Definition noid r : relation events := r ⊓ !id.
Definition atom := [A].
(* Definition of co_locs already included in the prelude *)
(* Definition of cross already included in the prelude *)
Definition generate_orders s pco := cross (co_locs pco (partition s)).
Definition generate_cos pco := generate_orders W pco.
Definition cobase := co0.
Variable co : relation events.
Definition coi := co ⊓ int.
Definition coe := co ⊓ !coi.
Definition fr := rf° ⋅ co ⊓ !id.
Definition fri := fr ⊓ int.
Definition fre := fr ⊓ !fri.
Definition test := acyclic (po_loc ⊔ (rf ⊔ (fr ⊔ co))).
Definition test_0 := is_empty (rmw ⊓ fre ⋅ coe).
Definition poWR := [W] ⋅ (po ⋅ [R]).
Definition i1 := poWR ⋅ [A].
Definition i2 := [A] ⋅ poWR.
Definition implied := i1 ⊔ i2.
Definition ppo := [R] ⋅ (po ⋅ [R]) ⊔ ([M] ⋅ (po ⋅ [W]) ⊔ ([M] ⋅ (po ⋅ ([MFENCE] ⋅ (po ⋅ [M]))) ⊔ implied)).
Definition ghb := ppo ⊔ (rfe ⊔ (fr ⊔ co)) ⋅ sm.
Definition tso := acyclic ghb.
Definition witness_conditions := generate_cos cobase co.
Definition model_conditions := test /\ (test_0 /\ tso).
End Model.

Hint Unfold events R W IW FW B RMW F rf po int ext loc addr data ctrl amo rmw unknown_set unknown_relation M emptyset classes_loc MFENCE sm tag2events emptyset_0 partition tag2instrs po_loc rfe rfi co0 toid fencerel ctrlcfence imply nodetour singlestep LKW mfence lfence sfence A P WW WR RW RR RM MR WM MW MM AA AP PA PP AM MA noid atom generate_orders generate_cos cobase coi coe fr fri fre test test_0 poWR i1 i2 implied ppo ghb tso witness_conditions model_conditions : cat.

Definition valid (c : candidate) :=
  exists co : relation (events c),
    witness_conditions c co /\
    model_conditions c co.

(* End of translation of model TSO *)