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.


Load LFindLoad.
From lfind Require Import LFind.
From QuickChick Require Import QuickChick.
From adtind Require Import goal33.

Derive Show for natural.

              Derive Arbitrary for natural.

              Instance Dec_Eq_natural : Dec_Eq natural.

              Proof. dec_eq. Qed.

Lemma conj27synthconj6 : forall  (lv0 : natural) (lv1 : natural) (lv2 : natural) (lv3 : natural), (@eq natural (Succ (plus (mult lv0 lv1) (plus lv1 lv0))) (plus lv2 lv3)).
Admitted.
QuickChick conj27synthconj6.


(** 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.


From iris.program_logic Require Export weakestpre.
From iris.heap_lang Require Export lang.
From iris.proofmode Require Import tactics.
From iris.heap_lang Require Import proofmode notation.
Set Default Proof Using "Type".

Definition assert : val :=
  λ: "v", if: "v" #() then #() else #0 #0. (* #0 #0 is unsafe *)
(* just below ;; *)
Notation "'assert:' e" := (assert (λ: <>, e))%E (at level 99) : expr_scope.

Lemma twp_assert `{heapG Σ} E (Φ : val → iProp Σ) e `{!Closed [] e} :
  WP e @ E [{ v, ⌜v = #true⌝ ∧ Φ #() }] -∗ WP assert: e @ E [{ Φ }].
Proof.
  iIntros "HΦ". rewrite /assert. wp_let. wp_seq.
  wp_apply (twp_wand with "HΦ"). iIntros (v) "[% ?]"; subst. by wp_if.
Qed.

Lemma wp_assert `{heapG Σ} E (Φ : val → iProp Σ) e `{!Closed [] e} :
  WP e @ E {{ v, ⌜v = #true⌝ ∧ ▷ Φ #() }} -∗ WP assert: e @ E {{ Φ }}.
Proof.
  iIntros "HΦ". rewrite /assert. wp_let. wp_seq.
  wp_apply (wp_wand with "HΦ"). iIntros (v) "[% ?]"; subst. by wp_if.
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 *)


From Mtac2 Require Import Base Datatypes.

Goal True.
MProof.
  M.ret I.
Qed.
Import M.notations.
Goal forall P:Type, forall x: P, P.
MProof.
  Mtac Do Set_Trace.
  M.nu Generate mNone (fun P:Type=>M.nu Generate mNone (fun x:P=> M.abs_fun x x >>= M.abs_fun P)).
  Mtac Do Unset_Trace.
Qed.

Goal True.
MProof.
  M.ret I. (* no more tracing *)
Qed.