Require Import Coqlib.
Require Import AST.
Require Import Integers.
Require Import Globalenvs.
Require Import Events.
Require Import Smallstep.
Require Import Axioms.
Require Import Floats.
Require Import Asm.
Require Import Values.
Require Import Memory.

Require Import PeekTactics.
Require Import PregTactics.
Require Import PeekLib.
Require Import AsmCallingConv.
Require Import AsmBits.
Require Import MemoryAxioms.
Require Import ValEq.
Require Import MemEq.
Require Import UseBasic.

Require Import NoPtr.

Require Import MemBits.
Require Import Maps.

Lemma val_eq_longofwords :
  forall v1 v2 v1' v2',
    val_eq v1 v2 ->
    val_eq v1' v2' ->
    val_eq (Val.longofwords v1 v1') (Val.longofwords v2 v2').
Proof.
  intros. unfold val_eq in *.
  repeat break_match_hyp; try inv_false; subst; simpl;
  intros; try congruence;
  unfold Val.longofwords;
  repeat break_match; try congruence.
Qed.

Lemma eval_annot_arg_rs :
  forall (prog : AST.program fundef unit) a (s1 s2 : preg -> Values.val) m b md,
    eval_annot_arg_bits md (Genv.globalenv prog) s1 (s1 (IR ESP)) m a b ->
    forall m',
    mem_eq md m m' ->
    (val_eq (s1 ESP) (s2 ESP)) ->
    (forall r, In r (get_annot_preg a) -> val_eq (s1 r) (s2 r)) ->
    exists b',
      eval_annot_arg_bits md (Genv.globalenv prog) s2 (s2 (IR ESP)) m' a b' /\ val_eq b b'.
Proof.

  induction 1; intros;
  try solve [
        eexists; split; try econstructor; eauto;
        eapply H1; simpl; intuition idtac].

  * rewrite H in H3. simpl in H3. rewrite <- H3 in *.
    unfold Mem.loadv in *.
    simpl in *.
    app eq_mem_load H1. break_and.
    exists x.
    split; auto. econstructor; eauto.
  * app val_eq_or H0.
    break_or.
    destruct (Val.add (s2 ESP) (Vint ofs)) eqn:?;
    exists (Val.add (s2 ESP) (Vint ofs));
    split; try econstructor; eauto;
    rewrite H3; simpl; eauto;
    try solve [intros; congruence].
           unfold Val.add in Heqv.
           break_match_hyp; try congruence.
           rewrite H3 in H2. simpl in H2.
           congruence.
    exists (Val.add (s2 ESP) (Vint ofs)).
    split. econstructor; eauto.
    unfold Val.add.
    break_match; simpl; try rewrite <- H3; eauto;
    intros; congruence.
  * unfold Mem.loadv in *. simpl in *.
    break_match_hyp; try congruence.
    app eq_mem_load H. break_and.
    exists x.
    split; eauto.
    econstructor; eauto.
    unfold Mem.loadv.
    find_rewrite. eauto.
  * exists Vundef.
           split; simpl; eauto.
           econstructor; eauto.
           intros. congruence.
  *
  edestruct IHeval_annot_arg_bits1; eauto.
  intros. eapply H3. simpl.
  rewrite in_app. left. eauto.
  break_and.
  edestruct IHeval_annot_arg_bits2; eauto.
  intros. eapply H3. simpl.
  rewrite in_app. right. eauto.
  break_and.
  eexists. split. econstructor; eauto.
  eapply val_eq_longofwords; eauto.

Qed.

Lemma list_forall2_annot:
  forall (prog : AST.program fundef unit) s1 s2 args vargs ef m m' md,
    list_forall2 (eval_annot_arg_bits md (Genv.globalenv prog) s1 (s1 (IR ESP)) m) args vargs ->
    (forall p, In p (use (Pannot ef args)) -> val_eq (s1 p) (s2 p)) ->
    mem_eq md m m' ->
    exists vargs',
      list_forall2 (eval_annot_arg_bits md (Genv.globalenv prog) s2 (s2 (IR ESP)) m') args vargs' /\ list_forall2 val_eq vargs vargs'.
Proof.
  intros. induction H;
    try solve [eexists; split; econstructor; eauto].
  app eval_annot_arg_rs H;
    try eapply H0;
    repeat break_and.

  Focus 2. simpl. right. left. eauto.
  Focus 2. intros. apply H0. simpl.
  right. right. rewrite in_app. left. auto.
  destruct (IHlist_forall2).
  intros. apply H0. simpl.
  rewrite in_app. simpl in H5.
  intuition idtac.
  break_and. exists (x :: x0).
  split; econstructor; eauto.
Qed.

Ltac unify_all :=
  try unify_psur;
  simpl in *;
  try unify_find_funct_ptr;
  simpl in *;
  try unify_find_instr;
  simpl in *.

Fixpoint getres (res : list preg) (vl : list Values.val) : list preg :=
  match res with
    | nil => nil
    | f :: r =>
      match vl with
        | nil => nil
        | x :: y => f :: getres r y
      end
  end.

Lemma set_regs_gnot_in :
  forall res vl x,
    ~ (In x (getres res vl)) ->
    forall rs,
      (set_regs res vl rs) x = rs x.
Proof.
  induction res; intros.
  simpl. reflexivity.
  simpl in H. break_match_hyp; simpl in H.
  subst vl. simpl. reflexivity.
  eapply Decidable.not_or in H.
  break_and. simpl.
  rewrite IHres by eauto.
  preg_simpl. reflexivity.
Qed.

Lemma set_regs_gin :
  forall res vl x,
    In x (getres res vl) ->
    forall rs rs',
      (set_regs res vl rs) x = (set_regs res vl rs') x.
Proof.
  induction res; intros.
  simpl in H. inv H.
  simpl in H. break_match_hyp; simpl in H; try solve [inv H].
  destruct (in_dec preg_eq x (getres res l)).
  simpl. apply IHres. eauto.
  simpl. repeat rewrite set_regs_gnot_in by eauto.
  break_or; try congruence.
  preg_simpl. reflexivity.
Qed.

Lemma undef_regs_undef :
  forall l x rs,
    In x l ->
    undef_regs l rs x = Values.Vundef.
Proof.
  induction l; intros.
  simpl in H. inv_false.
  simpl in H.
  destruct (in_dec preg_eq x l).
  simpl. rewrite IHl; eauto.
  break_or; try congruence.
  simpl. rewrite undef_regs_not_in; eauto.
  preg_simpl. reflexivity.
Qed.

Lemma val_eq_list_lessdef :
  forall a a',
    list_forall2 val_eq a a' ->
    Val.lessdef_list a a'.
Proof.
  induction 1; intros;
  econstructor; eauto.
  eapply val_eq_lessdef; eauto.
Qed.

Lemma no_ptr_nextinstr_nf :
  forall rs,
    (forall x, ~ In x flags -> forall b i, rs x <> Vptr b i) ->
    no_ptr_regs (nextinstr_nf rs).
Proof.
  intros. unfold no_ptr_regs.
  intros. unfold nextinstr_nf.
  unfold nextinstr. simpl.
  repeat preg_case; try congruence.
  name (H PC) HPC.
  unfold Val.add. repeat break_match; try congruence.
  unfold Vone in *. congruence.
  unfold Vone in *. inv Heqv0.
  exfalso. eapply HPC. simpl. intuition idtac; try congruence.
  reflexivity. eapply H. simpl. intuition idtac.
Qed.

Lemma set_regs_either :
  forall res rs l reg,
    set_regs res l rs reg = rs reg \/
    exists v, set_regs res l rs reg = v /\ In v l.
Proof.
  induction res; intros.
  left. simpl. reflexivity.
  simpl. break_match. left. reflexivity.
  subst l. simpl.
  destruct (in_dec preg_eq reg (getres res l0)).
  erewrite set_regs_gin; eauto.
  instantiate (1 := rs).
  specialize (IHres rs l0 reg).
  destruct IHres. left. auto.
  right. break_exists. exists x. break_and. split; auto.
  rewrite set_regs_gnot_in; eauto.
  clear IHres. clear n.
  preg_case. right. eauto.
  left. eauto.
Qed.

Lemma encode_long_no_ptr :
  forall v v' x t,
    val_eq v v' ->
    In x (encode_long t v') ->
    forall b i,
      x <> Vptr b i.
Proof.
  intros. unfold encode_long in *.
  unfold val_eq in *.
  destruct v; simpl in H; try inv_false; try subst v';
  repeat break_match_hyp; simpl in *; repeat break_or; try inv_false;
  eauto; try congruence. unfold Val.hiword. break_match; try congruence.
  unfold Val.loword. break_match; try congruence.
Qed.

Lemma global_perms_mem_eq :
  forall md m m',
    mem_eq md m m' ->
    forall ge,
      global_perms ge m ->
      global_perms ge m'.
Proof.
  intros.
  unfold global_perms in *.
  intros. app H0 H1.
  break_and.
  unfold mem_eq in *.
  repeat break_and.
  app H6 H1.
Qed.

Lemma list_forall2_inv_right :
  forall {A : Type} (P : A -> A -> Prop) (l l' : list A),
    list_forall2 P l l' ->
    forall x,
      In x l' ->
      exists y,
        In y l /\ P y x.
Proof.
  induction 1; intros.
  simpl in H. inv_false.
  simpl in H1.
  break_or. simpl. exists a1.
  split; auto.
  app IHlist_forall2 H2.
  exists x0. simpl.
  split. right. break_and. auto.
  break_and. auto.
Qed.

Lemma list_forall2_map :
  forall l (rs rs' : regset),
    (forall r, In r l -> val_eq (rs r) (rs' r)) ->
      list_forall2 val_eq (map rs l) (map rs' l).
Proof.
  induction l; intros.
  simpl. econstructor.
  simpl. econstructor. eapply H. simpl. left. auto.
  eapply IHl. intros. eapply H. simpl. right. auto.
Qed.

Lemma val_eq_hiword :
  forall v v',
    val_eq v v' ->
    val_eq (Val.hiword v) (Val.hiword v').
Proof.
  intros.
  unfold val_eq in H.
  break_match_hyp; subst; simpl; eauto;
  try congruence.
  intros. unfold Val.hiword.
  break_match; congruence.
Qed.

Lemma val_eq_loword :
  forall v v',
    val_eq v v' ->
    val_eq (Val.loword v) (Val.loword v').
Proof.
  intros.
  unfold val_eq in H.
  break_match_hyp; subst; simpl; eauto;
  try congruence.
  unfold Val.loword; break_match; congruence.
Qed.

Lemma set_regs_efres:
  forall ef p r v v' rs rs',
    In p r ->
    (forall p0, In p0 (efres ef r) -> val_eq (rs p0) (rs' p0)) ->
    val_eq v v' ->
    val_eq ((set_regs r (encode_long (sig_res (ef_sig ef)) v) rs) p) ((set_regs r (encode_long (sig_res (ef_sig ef)) v') rs') p).
Proof.
  induction r; intros.
  * simpl in H. inv H.
  * unfold efres in *; simpl in H0; repeat break_match_hyp.

    simpl. repeat rewrite set_regs_nil.

    destruct (preg_eq p a). subst. simpl.
    repeat rewrite set_regs_nil. repeat rewrite Pregmap.gss.
    assumption.

    simpl. repeat rewrite set_regs_nil. repeat rewrite Pregmap.gso by auto.
    apply H0. simpl in H. destruct H. congruence. assumption.

    destruct (preg_eq p a). subst. simpl.
    repeat rewrite set_regs_nil. repeat rewrite Pregmap.gss.
    assumption.

    simpl. repeat rewrite set_regs_nil. repeat rewrite Pregmap.gso by auto.
    apply H0. simpl in H. destruct H. congruence. assumption.

    destruct (preg_eq p a). subst. simpl.
    destruct r. simpl. repeat rewrite Pregmap.gss.
    eapply val_eq_hiword; assumption.

    simpl. repeat rewrite set_regs_nil.
    destruct (preg_eq p a). subst. repeat rewrite Pregmap.gss.
    eapply val_eq_loword; assumption.
    rewrite Pregmap.gso by auto.
    rewrite Pregmap.gss.
    rewrite Pregmap.gso by auto.
    rewrite Pregmap.gss.

    eapply val_eq_hiword; assumption.

    destruct r. simpl.
    repeat rewrite Pregmap.gso by auto.
    simpl in H. destruct H. congruence. inv H.
    destruct (preg_eq p p0).
    simpl. repeat rewrite set_regs_nil.
    subst. rewrite Pregmap.gss. rewrite Pregmap.gss.

    eapply val_eq_loword; assumption.
    simpl. repeat rewrite set_regs_nil.
    repeat rewrite Pregmap.gso by auto.
    apply H0. simpl. simpl in H.
    destruct H. congruence. destruct H. congruence.
    assumption.

    destruct (preg_eq p a). subst. simpl.
    repeat rewrite set_regs_nil. repeat rewrite Pregmap.gss.
    assumption.

    simpl. repeat rewrite set_regs_nil. repeat rewrite Pregmap.gso by auto.
    apply H0. simpl in H. destruct H. congruence. assumption.

    destruct (preg_eq p a). subst. simpl.
    repeat rewrite set_regs_nil. repeat rewrite Pregmap.gss.
    assumption.

    simpl. repeat rewrite set_regs_nil. repeat rewrite Pregmap.gso by auto.
    apply H0. simpl in H. destruct H. congruence. assumption.

    destruct (preg_eq p a). subst. simpl.
    repeat rewrite set_regs_nil. repeat rewrite Pregmap.gss.
    assumption.

    simpl. repeat rewrite set_regs_nil. repeat rewrite Pregmap.gso by auto.
    apply H0. simpl in H. destruct H. congruence. assumption.

    destruct (preg_eq p a). subst. simpl.
    repeat rewrite set_regs_nil. repeat rewrite Pregmap.gss.
    assumption.

    simpl. repeat rewrite set_regs_nil. repeat rewrite Pregmap.gso by auto.
    apply H0. simpl in H. destruct H. congruence. assumption.
Qed.

Ltac invs2 :=
  match goal with
    | [ H : step_bits _ _ _ _, H2 : step_bits _ _ _ _ |- _ ] => inv_step H; inv_step H2
  end.

Lemma val_eq_set_regs :
  forall v v',
    list_forall2 val_eq v v' ->
    forall r rs rs' p,
      val_eq (rs p) (rs' p) ->
      val_eq (set_regs r v rs p)
             (set_regs r v' rs' p).
Proof.
  intros v v' H.
  induction H; intros.
  repeat rewrite set_regs_nil. eauto.
  destruct r; simpl. eauto.
  eapply IHlist_forall2; eauto.
  preg_case; try subst; eauto.
Qed.

Lemma val_eq_undef_regs :
  forall rs rs' p,
    val_eq (rs p) (rs' p) ->
    forall l,
      val_eq (undef_regs l rs p) (undef_regs l rs' p).
Proof.
  induction l; intros. simpl. eauto.
  simpl.
  destruct (in_dec preg_eq p l).
  erewrite undef_regs_in with (rs' := rs); eauto.
  erewrite undef_regs_in with (rs := rs' # a <- Values.Vundef)(rs' := rs'); eauto.
  repeat rewrite undef_regs_not_in; eauto.
  preg_case; simpl; eauto.
  congruence.
Qed.

Lemma val_eq_decode_longs :
  forall sg l l',
    list_forall2 val_eq l l' ->
    list_forall2 val_eq (decode_longs sg l)
                   (decode_longs sg l').
Proof.
  induction sg; intros; simpl; repeat break_match; subst; try solve [econstructor];
  inv H;
  try solve [
        econstructor; eauto;
        eapply IHsg; eauto].
  inv H5. inv H5.
  inv H5. econstructor.
  eapply val_eq_longofwords; eauto.
  eapply IHsg; eauto.
Qed.

Lemma use_def_spec :
  forall p s1 s1' s2 b z s c i m m0 m' t bits md md',
    s1 PC = Values.Vint bits ->
    s2 PC = Values.Vint bits ->
    no_ptr_regs s2 ->
    psur md bits = Some (b,z) ->
    @Genv.find_funct_ptr fundef unit (Genv.globalenv p) b = Some (Internal (mkfunction s c)) ->
    find_instr (Int.unsigned z) c = Some i ->
    (forall p,
       In p (use i) -> val_eq (s1 p) (s2 p)) ->
    step_bits (Genv.globalenv p) (State_bits s1 m md) t (State_bits s1' m' md') ->
    mem_eq md m m0 ->
    no_ptr_mem m0 ->
    ~ is_call_return i ->
    (exists s2' m0',
       step_bits (Genv.globalenv p) (State_bits s2 m0 md) t (State_bits s2' m0' md') /\ (forall p, In p (def i) -> val_eq (s1' p) (s2' p)) /\ mem_eq md' m' m0'
    ).
Proof.
  intros.
  invs.
  *
    unify_all.

    match goal with
      | [ H : Genv.find_funct_ptr _ _ = _ |- _ ] =>
        name H Hge;
          eapply use_spec with (s1 := s1) (s2 := s2) in H; eauto
    end.

    repeat break_exists. do 2 eexists.
    split.
    eapply exec_step_internal_bits; eauto.
    unfold mem_eq in *.
    repeat break_and. assumption.
    eapply global_perms_mem_eq; eauto.
    intros. eapply use_def_exec; eauto.

  * app mem_eq_extcall' H20.
    repeat break_and.
    eexists. eexists.
    repeat unify_psur.
    split.
    rewrite H14. econstructor; eauto.
    eapply no_ptr_nextinstr_nf.
    intros.
    edestruct (set_regs_either res).
    rewrite H15.
    destruct (in_dec preg_eq x1 (map preg_of (Machregs.destroyed_by_builtin ef))).
    rewrite undef_regs_undef by assumption. congruence.
    rewrite undef_regs_not_in by assumption. apply H1.
    break_exists. break_and. rewrite H15.
    app (@list_forall2_inv_right val) H12.
    break_and. unfold val_eq in H21.
    break_match_hyp; try congruence.
    eapply no_ptr_mem_eq; eauto.
    unfold mem_eq in *.
    repeat break_and. assumption.
    eapply global_perms_mem_eq; eauto.

    split.
    intros.
    repeat unify_psur. repeat unify_find_funct_ptr.
    simpl in *. unify_find_instr.
    simpl in *.
    eapply val_eq_nextinstr_nf. intros.
    rewrite in_app in H2.
    simpl in H15.
    apply Decidable.not_or in H15; break_and.
    apply Decidable.not_or in H16; break_and.
    apply Decidable.not_or in H18; break_and.
    apply Decidable.not_or in H19; break_and.
    apply Decidable.not_or in H20; break_and.

    assert (p0 = PC \/ In p0 res \/ In p0 (map preg_of (Machregs.destroyed_by_builtin ef))) by (
      repeat break_or; try congruence; try (left; reflexivity); prove_or_eq assumption; assumption).

    clear H2.

    inv H11. inv H10.
    destruct (in_dec preg_eq p0 res).
    eapply set_regs_efres; eauto.
    intros.

    destruct (in_dec preg_eq p1 (map preg_of (Machregs.destroyed_by_builtin ef))).
    repeat rewrite undef_regs_undef by assumption.
    simpl. congruence.
    repeat rewrite undef_regs_not_in; eauto.
    eapply H5. right. rewrite in_app. right. eauto.

    app mem_eq_extcall H11. repeat break_and.
    eapply external_call_determ in H11; try eapply H2.
    break_and.
    specialize (H30 eq_refl). break_and.
    subst. assumption.

    eapply val_eq_decode_longs.
    eapply list_forall2_map. intros.
    eapply H5. right. rewrite in_app. left. auto.

    repeat rewrite set_regs_not_in by assumption.

    repeat break_or; try congruence.
    destruct (in_dec preg_eq PC (map preg_of (Machregs.destroyed_by_builtin ef))).
    repeat rewrite undef_regs_undef by assumption.
    simpl. congruence.
    repeat rewrite undef_regs_not_in; eauto.
    repeat rewrite undef_regs_undef by assumption. simpl. congruence.

    congruence.

    eapply list_forall2_map.
    intros. apply H5. repeat unify_psur.
    unify_find_funct_ptr.
    simpl in *. rewrite H4 in H19. inv H19.
    simpl. right. rewrite in_app. left. assumption.

  *
    unify_psur. unfold fundef in *.
    unify_find_funct_ptr. simpl in *.
    rewrite H4 in *. opt_inv. subst.

    eapply (list_forall2_annot p s1 s2) in H23;
    intros;
    try eapply H5;
    eauto.
    repeat break_exists. break_and.
    app mem_eq_extcall H24.

    repeat break_and. rewrite H15.

    eexists. eexists. split.
    eapply exec_step_annot_bits; eauto.
    eapply no_ptr_mem_eq; eauto.
    unfold mem_eq in *. tauto.
    eapply global_perms_mem_eq; eauto.

    split.
    intros. simpl in H16. break_or; try inv_false.
    preg_simpl. eapply val_eq_add.
    eapply H5. simpl. left. reflexivity.
    simpl. reflexivity.

    congruence.

  * unify_psur. unify_find_funct_ptr.

Qed.

Lemma def_spec' :
  forall prog s c z b i s1 m s1' m' t bits md md',
    s1 PC = Values.Vint bits ->
    psur md bits = Some (b,z) ->
    @Genv.find_funct_ptr fundef unit (Genv.globalenv prog) b = Some (Internal (mkfunction s c)) ->
    find_instr (Int.unsigned z) c = Some i ->
    step_bits (Genv.globalenv prog) (State_bits s1 m md) t (State_bits s1' m' md') ->
    ~ is_call_return i ->
    (forall p, (In p (def i) \/ s1 p = s1' p)).
Proof.
  intros. invs; unify_all.

  *
    eapply def_spec; eauto.

  * destruct (preg_eq PC p).
      left. left. assumption.
    destruct (in_dec preg_eq p flags).
      left. simpl. simpl in i. tauto.
    destruct (in_dec preg_eq p res).
      left. simpl. repeat right. rewrite in_app. left. assumption.
    destruct (in_dec preg_eq p (map preg_of (Machregs.destroyed_by_builtin ef))).
      left. simpl. repeat right. rewrite in_app. right. assumption.
    right. unfold nextinstr_nf. fold flags.
    unfold nextinstr. rewrite Pregmap.gso by auto.
    rewrite undef_regs_not_in by auto.
    rewrite set_regs_not_in by auto.
    rewrite undef_regs_not_in by auto.
    reflexivity.

  * destruct (preg_eq PC p).
      left. simpl. left. assumption.
    right. unfold nextinstr.
    rewrite Pregmap.gso by auto.
    reflexivity.
Qed.

Lemma val_eq_refl :
  forall v,
    (forall b ofs, v <> Vptr b ofs) ->
    val_eq v v.
Proof.
  intros. unfold val_eq.
  break_match; auto.
  congruence.
Qed.

(* Lemma use_def_exec' : *)
(*   forall prog s c i b z s1 s2 m m' s1' s2' m0 m0' t bits md md', *)
(*     s1 PC = Values.Vint bits -> *)
(*     s2 PC = Values.Vint bits -> *)
(*     psur md bits = Some (b,z) -> *)
(*     @Genv.find_funct_ptr fundef unit (Genv.globalenv prog) b = Some (Internal (mkfunction s c)) -> *)
(*     find_instr (Int.unsigned z) c = Some i -> *)
(*     step_bits (Genv.globalenv prog) (State_bits s1 m md) t (State_bits s1' m' md') -> *)
(*     step_bits (Genv.globalenv prog) (State_bits s2 m0 md) t (State_bits s2' m0' md') -> *)
(*     mem_eq md m m0 -> *)
(*     (forall p, In p (use i) -> val_eq (s1 p) (s2 p)) -> *)
(*     ~ is_call_return i -> *)
(*     (forall p, In p (def i) -> val_eq (s1' p) (s2' p)) /\ mem_eq md' m' m0'. *)
(* Proof. *)
(*   intros. invs2; repeat unify_all; try state_inv. *)

(*   * eapply use_def_exec; eauto. *)
(*   * split; intros. *)
(*     eapply val_eq_nextinstr_nf. *)
(*     intros. *)
(*     repeat break_or; try subst p; *)
(*     try solve [exfalso; apply H9; simpl; prove_or_eq reflexivity]. *)
(*     eapply val_eq_set_regs. *)

(*     eapply val_eq_undef_regs. *)

(*     eapply H7. left. eauto. *)

(*     inv H19. inv H27. *)

(*     rewrite in_app in H1. break_or. *)
(*     eapply set_regs_efres. eauto. *)
(*     intros. *)
(*     eapply val_eq_undef_regs. apply H7. *)
(*     right. rewrite in_app. right. eauto. *)

(*     eapply val_eq_set_regs. *)

(*     repeat rewrite undef_regs_undef by assumption. *)
(*     simpl. auto. *)
(*     congruence. *)

(*   * split; intros. *)
(*     break_or; try inv_false. *)
(*     eapply val_eq_nextinstr. *)
(*     eapply H7; eauto. *)
(* Qed. *)


Require Import VST.floyd.proofauto.
Require Import sha.sha.
Require Import sha.SHA256.
Require Import sha.sha_lemmas.
Require Import sha.spec_sha.
Local Open Scope nat.
Local Open Scope logic.

Lemma body_SHA256_Init: semax_body Vprog Gtot f_SHA256_Init SHA256_Init_spec.
Proof.
start_function.
name c_ _c.
unfold data_at_.
(* BEGIN: without these lines, the "do 8 forward" takes 40 times as long. *)
unfold field_at_.
unfold_data_at (field_at _ _ _ _ _).
simpl fst; simpl snd.
(* END: without these lines *)
Time do 8 (forward; unfold upd_Znth; if_tac;
  unfold Zlength in *; simpl Zlength_aux in *; try lia;
  unfold sublist; simpl app).
Time repeat forward. (* 14 sec *)
unfold sha256state_.
Exists (map Vint init_registers,
      (Vint Int.zero, (Vint Int.zero, (repeat Vundef (Z.to_nat 64), Vint Int.zero)))).
unfold_data_at (data_at _ _ _ _).
Time entailer!. (* 5.2 sec *)
repeat split; auto.
unfold s256_h, fst, s256a_regs.
rewrite hash_blocks_equation. reflexivity.
unfold data_at. apply derives_refl'; f_equal.
f_equal.
simpl.
repeat (apply f_equal2; [f_equal; apply int_eq_e; compute; reflexivity | ]); auto.
Time Qed. (* 33.6 sec *)


From fae_gtlc_mu.refinements.static_gradual Require Export compat_cast.defs.
From fae_gtlc_mu.backtranslation Require Export general_def_lemmas.
From fae_gtlc_mu.cast_calculus Require Export lang.

Section compat_cast_arrow_arrow.
  Context `{!implG Σ,!specG Σ}.

  (** The case `throughArrow` in our proof by induction on the alternative consistency relation. *)
  Lemma back_cast_ar_arrow_arrow:
    ∀ (A : list (type * type)) (τ1 τ1' τ2 τ2' : type) (pC1 : alternative_consistency A τ1' τ1) (pC2 : alternative_consistency A τ2 τ2')
      (IHpC1 : back_cast_ar pC1) (IHpC2 : back_cast_ar pC2),
      back_cast_ar (throughArrow A τ1 τ1' τ2 τ2' pC1 pC2).
  Proof.
    intros A τ1 τ1' τ2 τ2' pC1 pC2 IHpC1 IHpC2.
    rewrite /back_cast_ar. iIntros (ei' K' v v' fs) "(#Hfs & #Hvv' & #Hei' & Hv')".
    (* extract small lemma about length fs *)
    iDestruct "Hfs" as "[% Hfs']"; iAssert (rel_cast_functions A fs) with "[Hfs']" as "Hfs". iSplit; done. iClear "Hfs'".
    (* rewriting stuff *)
    rewrite /𝓕c /𝓕. fold (𝓕 pC1) (𝓕 pC2). rewrite between_TArrow_subst_rewrite.
    rename v into f. rename v' into f'. iDestruct "Hv'" as "Hf'". iDestruct "Hvv'" as "Hff'".
    fold (𝓕c pC1 fs) (𝓕c pC2 fs).
    do 2 rewrite 𝓕c_rewrite.
    (* 1 step in WP *)
    unfold between_TArrow.
    wp_head.
    asimpl.
    (* prove postcondition because value *)
    iApply wp_value.
    iExists (CastV f' (TArrow τ1 τ2) (TArrow τ1' τ2') (TArrow_TArrow_icp τ1 τ2 τ1' τ2')).
    rewrite interp_rw_TArrow.
    iSplitL "Hf'"; auto.
    rewrite interp_rw_TArrow.
    iModIntro.
    (** actual thing to prove *)
    (** ===================== *)
    iIntros ((a , a')) "#Haa'".
    simpl. clear K'.
    iIntros (K') "Hf'".
    simpl in *.
    (* step in wp *)
    wp_head. asimpl.
    (* step in gradual side *)
    iMod (step_pure _ ei' K'
                    (App (Cast f' (TArrow τ1 τ2) (TArrow τ1' τ2')) a')
                    (Cast (App f' (Cast a' τ1' τ1)) τ2 τ2') with "[Hf']") as "Hf'".
    intros. eapply AppCast; try by rewrite -to_of_val. auto. by iFrame.
    (* first IH for the arguments *)
    iApply (wp_bind (ectx_language.fill $ [stlc_mu.lang.AppRCtx _ ; stlc_mu.lang.AppRCtx _])).
    iApply (wp_wand with "[-]").
    rewrite -𝓕c_rewrite.
    iApply (IHpC1 ei' (AppRCtx f' :: CastCtx τ2 τ2' :: K') with "[Hf']"). auto.
    iIntros (b) "HHH".
    iDestruct "HHH" as (b') "[Hb' #Hbb']".
    simpl.
    iClear "Haa'". clear a a'.
    (* using the relatedness of functions *)
    iApply (wp_bind (ectx_language.fill $ [stlc_mu.lang.AppRCtx _ ])).
    iApply (wp_wand with "[-]").
    iDestruct ("Hff'" with "Hbb'") as "Hfbf'b' /=".
    iApply ("Hfbf'b'" $! (CastCtx τ2 τ2' :: K')).
    simpl.
    iExact "Hb'".
    iIntros (r) "HHH". iDestruct "HHH" as (r') "[Hr' Hrr']".
    simpl.
    iClear "Hbb'". clear b b'.
    (** second IH for the results *)
    iApply (wp_wand with "[-]").
    rewrite -𝓕c_rewrite.
    iApply (IHpC2 ei' K' r r' with "[-]").
    iSplitR. done.
    iSplitL "Hrr'"; try done.
    iSplitR. done.
    done.
    iIntros (s) "HHH". done.
  Qed.

End compat_cast_arrow_arrow.


Require Import AutoSep Malloc Abort Bootstrap.

Module Type S.
  Variable heapSize : nat.
End S.

Module Make(M : S).
Import M.

Section boot.
  Hypothesis heapSizeLowerBound : (3 <= heapSize)%nat.

  Definition size := heapSize + 50 + 0.

  Hypothesis mem_size : goodSize (size * 4)%nat.

  Let heapSizeUpperBound : goodSize (heapSize * 4).
    goodSize.
  Qed.

  Definition bootS := bootS heapSize 0.

  Definition boot := bimport [[ "malloc"!"init" @ [Malloc.initS], "test"!"main" @ [Abort.mainS] ]]
    bmodule "main" {{
      bfunctionNoRet "main"() [bootS]
        Sp <- (heapSize * 4)%nat;;

        Assert [PREonly[_] 0 =?> heapSize];;

        Call "malloc"!"init"(0, heapSize)
        [PREonly[_] mallocHeap 0];;

        Goto "test"!"main"
      end
    }}.

  Theorem ok : moduleOk boot.
    vcgen; abstract genesis.
  Qed.

  Definition m0 := link Malloc.m boot.
  Definition m1 := link Abort.m m0.

  Lemma ok0 : moduleOk m0.
    link Malloc.ok ok.
  Qed.

  Lemma ok1 : moduleOk m1.
    link Abort.ok ok0.
  Qed.

  Variable stn : settings.
  Variable prog : program.

  Hypothesis inj : forall l1 l2 w, Labels stn l1 = Some w
    -> Labels stn l2 = Some w
    -> l1 = l2.

  Hypothesis agree : forall l pre bl,
    LabelMap.MapsTo l (pre, bl) (XCAP.Blocks m1)
    -> exists w, Labels stn l = Some w
      /\ prog w = Some bl.

  Hypothesis agreeImp : forall l pre, LabelMap.MapsTo l pre (XCAP.Imports m1)
    -> exists w, Labels stn l = Some w
      /\ prog w = None.

  Hypothesis omitImp : forall l w,
    Labels stn ("sys", l) = Some w
    -> prog w = None.

  Variable w : W.
  Hypothesis at_start : Labels stn ("main", Global "main") = Some w.

  Variable st : state.

  Hypothesis mem_low : forall n, (n < size * 4)%nat -> st.(Mem) n <> None.
  Hypothesis mem_high : forall w, $(size * 4) <= w -> st.(Mem) w = None.

  Theorem safe : sys_safe stn prog (w, st).
    safety ok1.
  Qed.
End boot.

End Make.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import AbsAccessor.Spec.
Require Import RealmExitHandlerAux.Spec.

Local Open Scope Z_scope.

Section SpecLow.

  Definition handle_realm_exit_spec0 (rec: Pointer) (exception: Z) (adt: RData) : option (RData * Z) :=
    match rec, exception with
    | (_rec_base, _rec_ofst), _exception =>
      if (_exception =? 0) then
        when adt == set_rec_run_exit_reason_spec (VZ64 0) adt;
        when _t'1, adt == handle_exception_sync_spec (_rec_base, _rec_ofst) adt;
        rely is_int _t'1;
        Some (adt, _t'1)
      else
        if (_exception =? 1) then
          when _t'2, adt == handle_excpetion_irq_lel_spec (_rec_base, _rec_ofst) adt;
          rely is_int _t'2;
          Some (adt, _t'2)
        else
          if (_exception =? 2) then
            when adt == set_rec_run_exit_reason_spec (VZ64 2) adt;
            Some (adt, 0)
          else
            Some (adt, 0)
     end
    .

End SpecLow.


Require Import List.
From mathcomp Require Import ssreflect ssrbool ssrnat eqtype seq tuple ssrfun fintype.
From mathcomp Require Import choice path bigop.
Require Import Lib.Base Ipdl.Exp Ipdl.Core String Ipdl.Lems Lib.TupleLems Lib.Dist Ipdl.Tacs Pars Lib.Set.
Require Import OTIdeal.

Require Import Setoid Relation_Definitions Morphisms.
Require Import Permutation Typ Lib.SeqOps.
Close Scope bool_scope.

  Lemma samp_pair {chan} {t'} {t : finType} `{unif t} `{Inhabited t'} `{Inhabited t} (x : chan t') (c d : chan t) :
    pars [::
            Out c (_ <-- Read x ;; Samp (Unif));
         Out d (_ <-- Read x ;; Samp Unif)] =p
    e <- new (t * t) ;;
    pars [::
            Out e (_ <-- Read x ;; Samp Unif) ;
            Out c (_ <-- Read x ;; x <-- Read e ;; Ret (x.1));
            Out d (_ <-- Read x ;; x <-- Read e ;; Ret (x.2))].
    symmetry.
    simpl.
    etransitivity.
    Intro => e.
    edit_tac 0.
    rewrite /Unif_pair.
    setoid_rewrite EqSampBind.
    setoid_rewrite EqSampBind.
    instantiate (1 :=
                   x0 <-- (_ <-- Read x ;; Samp Unif) ;;
                   y <-- (_ <-- Read x ;; Samp Unif) ;;
                   Ret (x0, y)).
         symmetry; simp_rxn.
         r_swap 1 2.
         rewrite EqReadSame.
         setoid_rewrite EqSampRet.
         done.
    rewrite -pars_fold.
    Intro => c'.
    swap_at 0 0 1.
    rewrite -pars_fold.
    Intro => d'.
    do_inline; simp_all.
    do_inline; simp_all.

    simpl.
    swap_tac 0 3.
    rewrite -pars_mkdep //=; last by firstorder.
    swap_tac 0 4.
    swap_at 0 0 1.
    swap_tac 1 2.
    rewrite -pars_mkdep //=; last by firstorder.
    apply EqRefl.
    rewrite EqNewExch.
    setoid_rewrite EqNewExch at 2.
    swap_tac 0 3.
    setoid_rewrite new_pars_remove.
    swap_tac 0 2.
    setoid_rewrite pars_fold.
    swap_tac 0 2.
    rewrite pars_fold.
    align.
    apply EqCongReact; simp_rxn; r_swap 1 2; rewrite EqReadSame; setoid_rewrite EqBindRet; done.
    apply EqCongReact; simp_rxn; r_swap 1 2; rewrite EqReadSame; setoid_rewrite EqBindRet; done.
Qed.

  Lemma rerandomP {chan : Type -> Type} {L : nat} b (i : chan (bool * bool)%type) (c1 c2 : chan L.-bv) :
    pars [::
            Out c1 (_ <-- Read i ;; Samp Unif);
            Out c2 (_ <-- Read i ;; Samp Unif)
         ]
    =p
       c1' <- new L.-bv ;;
       c2' <- new L.-bv ;;
       pars [::
               Out c1' (Samp Unif);
               Out c2' (Samp Unif);
               Out c1 (i <-- Read i ;; x <-- Read c1' ;; y <-- Read c2' ;; Ret (if  (if b then i.1 else i.2) then x else y));
               Out c2 (i <-- Read i ;; x <-- Read c1' ;; y <-- Read c2' ;; Ret (if (if b then i.1 else i.2) then y else x))
                   ].
    rewrite samp_pair.
    etransitivity.
    Intro => e.
    edit_tac 0.
    instantiate (1 :=
                   (i <-- Read i ;; x <-- Samp Unif ;; y <-- Samp Unif ;;
                    Ret (if (if b then i.1 else i.2) then (x, y) else (y, x )))).
         apply EqBind_r => x.
         destruct x as [x0 x1]; simpl.
         destruct b.
         destruct x0.
         rewrite /Unif_pair EqSampBind; setoid_rewrite EqSampBind; setoid_rewrite EqSampRet; done.
         rewrite /Unif_pair EqSampBind; setoid_rewrite EqSampBind; setoid_rewrite EqSampRet.
         r_swap 0 1.
         done.
         destruct x1.
         rewrite /Unif_pair EqSampBind; setoid_rewrite EqSampBind; setoid_rewrite EqSampRet; done.
         rewrite /Unif_pair EqSampBind; setoid_rewrite EqSampBind; setoid_rewrite EqSampRet.
         r_swap 0 1.
         done.
    swap_at 0 0 1.
    rewrite -pars_fold.
    Intro => c1'.
    swap_at 0 0 2.
    rewrite -pars_fold.
    Intro => c2'.
    do_inline; simp_all.
    do_inline; simp_all.
    apply EqRefl.
    setoid_rewrite EqNewExch at 1.
    setoid_rewrite EqNewExch at 2.
    setoid_rewrite new_pars_remove.
    Intro => c1'.
    Intro => c2'.
    align.
        apply EqCongReact.
        r_swap 0 2.
        r_swap 1 3.
        rewrite EqReadSame.
        r_swap 1 2.
        apply EqBind_r => x.
        apply EqBind_r => y.
        apply EqBind_r => z.
        destruct x as [x0 x1]; destruct b; [ destruct x0 | destruct x1]; rewrite //=.

        apply EqCongReact.
        r_swap 0 2.
        r_swap 1 3.
        rewrite EqReadSame.
        r_swap 1 2.
        apply EqBind_r => x.
        apply EqBind_r => y.
        apply EqBind_r => z.
        destruct x as [x0 x1]; destruct b; [ destruct x0 | destruct x1]; rewrite //=.
Qed.

  Lemma rerandomP_rs {chan : Type -> Type} {L : nat} b (i : chan (bool * bool)%type) (c1 c2 : chan L.-bv) rs :
    pars [::
            Out c1 (_ <-- Read i ;; Samp Unif),
            Out c2 (_ <-- Read i ;; Samp Unif) & rs
         ]
    =p
       c1' <- new L.-bv ;;
       c2' <- new L.-bv ;;
       pars [::
               Out c1' (Samp Unif),
               Out c2' (Samp Unif),
               Out c1 (i <-- Read i ;; x <-- Read c1' ;; y <-- Read c2' ;; Ret (if  (if b then i.1 else i.2) then x else y)),
               Out c2 (i <-- Read i ;; x <-- Read c1' ;; y <-- Read c2' ;; Ret (if (if b then i.1 else i.2) then y else x)) & rs
                   ].
    rewrite (pars_split 2); simpl; rewrite take0 drop0.
    rewrite rerandomP.
    rewrite newComp.
    Intro => c.
    rewrite newComp.
    Intro => c'.
    rewrite -pars_cat //=.
Qed.

Lemma ot14_xort_subproof {t} (a b c : t.-tuple bool) :
    ((((a +t b) +t c) +t a) +t b)
              =
              (c +t (a +t a) +t (b +t b)).
  rewrite (xortC _ c).
  rewrite !xortA.
  congr (_ _).
  congr (_ _).
  rewrite (xortC b).
  rewrite xortA //=.
Qed.

Ltac rxn_intros_combine_reads :=
  lazymatch goal with
  | [ |- @EqRxn _ _ ?r1 _ ] =>
    lazymatch r1 with
    | @Bind _ _ _ ?c ?k =>
      lazymatch c with
      | Read ?ch =>
        find_read_in_rxn (k witness) ch
                         ltac:(fun p =>
                            lazymatch p with
                            | Some ?j => r_swap 1 (j.+1); rewrite EqReadSame; apply EqBind_r; intro; rxn_intros_combine_reads
                            | None => apply EqBind_r; intro; rxn_intros_combine_reads
                                                               end
                         )
      | _ => apply EqBind_r; intro; rxn_intros_combine_reads
      end
    | _ => idtac
 end end.

Section OneOutOf4.
  Context (L : nat).
  Context {chan : Type -> Type}.
  Context (ot_i1 ot_i2 ot_i3 : chan bool).
  Context (ot_o1 ot_o2 ot_o3 : chan L.-bv).

  Context (ot14_m : chan ((L.-bv * L.-bv) * (L.-bv * L.-bv))).
  Context (ot14_i : chan (bool * bool)).
  Context (ot14_o : chan L.-bv).

  (* Leakage channels for bob *)
  Context (leak_ot_o1 leak_ot_o2 leak_ot_o3 : chan L.-bv).
  Context (leak_send : chan ((L.-bv * L.-bv) * (L.-bv * L.-bv))).

  Definition One4_sender (ot_m1 ot_m2 ot_m3 : chan (L.-bv * L.-bv)) (ready : chan unit) (send : chan ((L.-bv * L.-bv) * (L.-bv * L.-bv)))  :=
    s0 <- new L.-bv ;;
    s1 <- new L.-bv;;
    s2 <- new L.-bv;;
    s3 <- new L.-bv;;
    s4 <- new L.-bv;;
    s5 <- new L.-bv;;
    pars [::
            Out s0 (_ <-- Read ready;; Samp Unif);
            Out s1 (_ <-- Read ready;; Samp Unif);
            Out s2 (_ <-- Read ready;; Samp Unif);
            Out s3 (_ <-- Read ready;; Samp Unif);
            Out s4 (_ <-- Read ready;; Samp Unif);
            Out s5 (_ <-- Read ready;; Samp Unif);

            Out send (
                  m <-- Read ot14_m ;;
                  s0 <-- Read s0 ;;
                  s1 <-- Read s1 ;;
                  s2 <-- Read s2 ;;
                  s3 <-- Read s3 ;;
                  s4 <-- Read s4 ;;
                  s5 <-- Read s5 ;;
                  Ret (
                  let '((m0, m1), (m2, m3)) := m in
                  ( (s0 +t s2 +t m0,
                     s0 +t s3 +t m1),
                    (s1 +t s4 +t m2, s1 +t s5 +t m3))));
         Out ot_m1 (
               a <-- Read s0 ;;
               b <-- Read s1 ;;
               Ret (a, b) );
         Out ot_m2 (
               a <-- Read s2 ;;
               b <-- Read s3 ;;
               Ret (a, b) );
         Out ot_m3 (
               a <-- Read s4 ;;
               b <-- Read s5 ;;
               Ret (a, b) ) ].

  Definition One4_recv (ready : chan unit) (ot_i1 ot_i2 ot_i3 : chan bool) (ot_o1 ot_o2 ot_o3 : chan L.-bv) (send : chan ((L.-bv * L.-bv) * (L.-bv * L.-bv))) :=
    pars [::
            Out ready (_ <-- Read ot14_i ;; Ret tt);
            Out ot_i1 (
                  i <-- Read ot14_i ;; Ret (i.1));
            Out ot_i2 (
                  i <-- Read ot14_i ;; Ret (i.2));
            Out ot_i3 (
                  i <-- Read ot14_i ;; Ret (i.2));
            Out leak_send (copy send);
            Out leak_ot_o1 (copy ot_o1);
            Out leak_ot_o2 (copy ot_o2);
            Out leak_ot_o3 (copy ot_o3);
            Out ot14_o (
                  t <-- Read ot14_i ;;
                  a <-- Read send ;;
                  T0 <-- Read ot_o1 ;;
                  T1 <-- Read ot_o2 ;;
                  T2 <-- Read ot_o3 ;;
                  Ret (
                      let '((a0, a1), (a2, a3)) := a in
                      match t.1, t.2 with
                        | false, false => a0 +t T0 +t T1
                        | false, true => a1 +t T0 +t T1
                        | true, false => a2 +t T0 +t T2
                        | true, true => a3 +t T0 +t T2
                                                    end))].

  Definition OT14_real_simpl :=
    c <- new L.-bv ;;
    c0 <- new L.-bv ;;
    c1 <- new L.-bv ;;
    c2 <- new L.-bv ;;
    c3 <- new L.-bv ;;
    c4 <- new L.-bv ;;
    [pars [:: Out ot14_o
              (x <-- Read ot14_i;; x_m <-- Read ot14_m;; Ret ((x_m # x.1) # x.2 : L.-bv));
            Out c2 (_ <-- Read ot14_i;; Samp Unif);
            Out c3 (_ <-- Read ot14_i;; Samp Unif);
            Out leak_send
              (x <-- Read ot14_m;;
               x0 <-- Read c;;
               x1 <-- Read c0;;
               x2 <-- Read c1;;
               x3 <-- Read c2;;
               x4 <-- Read c3;;
               x5 <-- Read c4;;
               Ret
                 (let
                  '(m0, m1, (m2, m3)) := x in
                   ( ( (x0 +t x2) +t m0, (x0 +t x3) +t m1),
                     ( (x1 +t x4) +t m2, (x1 +t x5) +t m3))));
            Out leak_ot_o3
              (x <-- Read c3;;
               x0 <-- Read c4;;
               x1 <-- Read ot14_i;; Ret (if x1 .2 then x0 else x));
            Out leak_ot_o2
              (x <-- Read c1;;
               x0 <-- Read c2;;
               x1 <-- Read ot14_i;; Ret (if x1 .2 then x0 else x));
            Out leak_ot_o1
              (x <-- Read c;;
               x0 <-- Read c0;;
               x1 <-- Read ot14_i;; Ret (if x1 .1 then x0 else x));
            Out c1 (_ <-- Read ot14_i;; Samp Unif);
            Out c4 (_ <-- Read ot14_i;; Samp Unif);
            Out c (_ <-- Read ot14_i;; Samp Unif);
            Out c0 (_ <-- Read ot14_i;; Samp Unif) ]].

  Definition OT14_real :=
    ot_i1 <- new bool ;;
    ot_i2 <- new bool ;;
    ot_i3 <- new bool ;;
    ot_m1 <- new (L.-bv * L.-bv) ;;
    ot_m2 <- new (L.-bv * L.-bv) ;;
    ot_m3 <- new (L.-bv * L.-bv) ;;
    ot_o1 <- new L.-bv ;;
    ot_o2 <- new L.-bv ;;
    ot_o3 <- new L.-bv ;;
    send <- new ((L.-bv * L.-bv) * (L.-bv * L.-bv)) ;;
    ready <- new unit ;;
    pars [::
            OTIdeal _ ot_i1 ot_m1 ot_o1;
            OTIdeal _ ot_i2 ot_m2 ot_o2;
            OTIdeal _ ot_i3 ot_m3 ot_o3;
            One4_sender ot_m1 ot_m2 ot_m3 ready send;
            One4_recv ready ot_i1 ot_i2 ot_i3 ot_o1 ot_o2 ot_o3 send ].

  Lemma ot14_simp : OT14_real =p OT14_real_simpl.
    etransitivity.
    repeat ltac:(apply EqCongNew; intro).
    rewrite /OTIdeal.
    rewrite /One4_sender.
    swap_tac 0 3.
    setoid_rewrite New_in_pars at 1.
    setoid_rewrite New_in_pars at 1.
    setoid_rewrite New_in_pars at 1.
    setoid_rewrite New_in_pars at 1.
    setoid_rewrite New_in_pars at 1.
    setoid_rewrite New_in_pars at 1.
    apply EqCongNew => s0.
    apply EqCongNew => s1.
    apply EqCongNew => s2.
    apply EqCongNew => s3.
    apply EqCongNew => s4.
    apply EqCongNew => s5.
    rewrite pars_pars; simpl.
    swap_tac 0 13.
    rewrite pars_pars; simpl.
    do_inline; simp_all.
    do_inline; simp_all.
    do_inline; simp_all.
    do_inline; simp_all.
    do_inline; simp_all.
    do_inline; simp_all.
    do_inline; simp_all.
    do_inline; simp_all.
    do_inline; simp_all.
    do_inline; simp_all.
    do_inline; simp_all.
    do_inline; simp_all.
    do_inline; simp_all.
    do_inline; simp_all.
    progress ltac:(do_inline; simp_all).
    progress ltac:(do_inline; simp_all).
    progress ltac:(do_inline; simp_all).
    progress ltac:(do_inline; simp_all).
    progress ltac:(do_inline; simp_all).
    progress ltac:(do_inline; simp_all).
    apply EqRefl.
    (* now we elim all the useless channels *)
    simpl.
    repeat setoid_rewrite (EqNewExch unit).
    under_new rewrite new_pars_remove; last first; apply EqRefl.
    simpl.
    repeat setoid_rewrite (EqNewExch ((L.-bv * L.-bv) * (L.-bv * L.-bv))).
    swap_tac 0 13.
    under_new rewrite new_pars_remove; last first; apply EqRefl.
    simpl.
    repeat setoid_rewrite (EqNewExch bool) at 3.
    swap_tac 0 1.
    under_new rewrite new_pars_remove; last first; apply EqRefl.
    repeat setoid_rewrite (EqNewExch bool) at 2.
    under_new rewrite new_pars_remove; last first; apply EqRefl.
    simpl.
    repeat setoid_rewrite (EqNewExch bool) at 1.
    swap_tac 0 10.
    under_new rewrite new_pars_remove; last first; apply EqRefl.
    simpl.
    repeat setoid_rewrite (EqNewExch (L.-bv * L.-bv)) at 3.
    swap_tac 0 12.
    under_new rewrite new_pars_remove; last first; apply EqRefl.
    simpl.
    repeat setoid_rewrite (EqNewExch (L.-bv * L.-bv)) at 2.
    swap_tac 0 10.
    under_new rewrite new_pars_remove; last first; apply EqRefl.
    simpl.
    repeat setoid_rewrite (EqNewExch (L.-bv * L.-bv)).
    swap_tac 0 8.
    under_new rewrite new_pars_remove; last first; apply EqRefl.

    simpl.
    swap_tac 0 10.
    setoid_rewrite (EqNewExch L.-bv) at 2.
    setoid_rewrite (EqNewExch L.-bv) at 3.
    setoid_rewrite (EqNewExch L.-bv) at 4.
    setoid_rewrite (EqNewExch L.-bv) at 5.
    setoid_rewrite (EqNewExch L.-bv) at 6.
    setoid_rewrite (EqNewExch L.-bv) at 7.
    setoid_rewrite (EqNewExch L.-bv) at 8.
    under_new rewrite new_pars_remove; last first; apply EqRefl.

    simpl.
    swap_tac 0 11.
    setoid_rewrite (EqNewExch L.-bv) at 1.
    setoid_rewrite (EqNewExch L.-bv) at 2.
    setoid_rewrite (EqNewExch L.-bv) at 3.
    setoid_rewrite (EqNewExch L.-bv) at 4.
    setoid_rewrite (EqNewExch L.-bv) at 5.
    setoid_rewrite (EqNewExch L.-bv) at 6.
    setoid_rewrite (EqNewExch L.-bv) at 7.
    under_new rewrite new_pars_remove; last first; apply EqRefl.

    simpl.
    swap_tac 0 9.
    setoid_rewrite (EqNewExch L.-bv) at 1.
    setoid_rewrite (EqNewExch L.-bv) at 2.
    setoid_rewrite (EqNewExch L.-bv) at 3.
    setoid_rewrite (EqNewExch L.-bv) at 4.
    setoid_rewrite (EqNewExch L.-bv) at 5.
    setoid_rewrite (EqNewExch L.-bv) at 6.
    under_new rewrite new_pars_remove; last first; apply EqRefl.

    (* Now do some final simpl *)
    etransitivity.
    repeat ltac:(apply EqCongNew; intro).
    edit_tac 7.
    etransitivity.
    rxn_intros_combine_reads.
    apply EqRxnRefl.
    etransitivity.
    rxn_intros_combine_reads.
    apply EqRxnRefl.
    apply EqBind_r; intro.
    apply EqBind_r; intro.
    apply EqBind_r; intros x_i.
    apply EqBind_r; intro.
    apply EqBind_r; intro.
    apply EqBind_r; intro.
    apply EqBind_r; intro.
    apply EqBind_r; intros x_m.
    instantiate (1 :=
                   fun x_m => _).
    simpl.
    instantiate (1 := Ret ((x_m # x_i.1) # x_i.2)).
    destruct x_m as [[m0 m1] [m2 m3]].
    simpl.
    destruct x_i as [i1 i2]; simpl.
    destruct i1, i2; simpl.

    rewrite ot14_xort_subproof !xortK !xort0 //=.
    rewrite ot14_xort_subproof !xortK !xort0 //=.
    rewrite ot14_xort_subproof !xortK !xort0 //=.
    rewrite ot14_xort_subproof !xortK !xort0 //=.

    swap_tac 0 7.
    swap_tac 1 10.
    rewrite -pars_mkdep //=; last by firstorder.
    swap_tac 1 9.
    rewrite -pars_mkdep //=; last by firstorder.
    swap_at 0 0 1.
    swap_tac 1 10.
    rewrite -pars_mkdep //=; last by firstorder.
    swap_at 0 0 1.
    swap_tac 1 2.
    rewrite -pars_mkdep //=; last by firstorder.
    swap_at 0 0 1.
    swap_tac 1 8.
    rewrite -pars_mkdep //=; last by firstorder.
    swap_at 0 0 1.
    swap_tac 1 7.
    rewrite -pars_mkdep //=; last by firstorder.
    apply EqRefl.
    apply EqRefl.
Qed.

  Definition mkpair4 {t} (f : bool -> bool -> t) : (t * t) * (t * t) :=
    ((f false false, f false true), (f true false, f true true)).

  Definition cflip {t} (p : t * t) (b : bool) : t * t :=
    if b then p else (p.2, p.1).

  Lemma bind_samp_xor {n : nat} {t} (a : n.-tuple bool) (k : n.-bv -> @rxn chan t) :
    EqRxn _ (x <-- Samp (Unif) ;; k x) (x <-- Samp Unif ;; k (x +t a)).
    apply EqBind_r_samp_bijection.
    apply is_unif.
    apply xort_inj_r.
  Qed.

  Definition OT14_real_rerandomize :=
    c <- new L.-bv;;
  c0 <- new L.-bv;;
  c1 <- new L.-bv;;
  [pars [:: Out leak_send
              (x <-- Read ot14_i;;
               x0 <-- Read c1;;
               x1 <-- Read c0;;
               x2 <-- Read c;;
               x3 <-- Read ot14_m;;
               x4 <-- Samp Unif;;
               x5 <-- Samp Unif;;
               x6 <-- Samp Unif;;
               Ret
                 (let o := (x3 # x .1) # x .2 in
                  let o0 := if x .2 && x .1 then o else tzero _ in
                  let o1 := if ~~ x .2 && x .1 then o else tzero _ in
                  let o2 := if x .2 && ~~ x .1 then o else tzero _ in
                  let o3 := if ~~ x .2 && ~~ x .1 then o else tzero _ in
                  ( ( ((x2, x4) # x .1 +t (x0, x6) # x .2) +t o3 : L.-bv,
                    ((x2, x4) # x .1 +t (x6, x0) # x .2) +t o2 : L.-bv),
                  (((x4, x2) # x .1 +t (x1, x5) # x .2) +t o1 : L.-bv,
                  ((x4, x2) # x .1 +t (x5, x1) # x .2) +t o0 : L.-bv))));
            Out leak_ot_o1 (_ <-- Read ot14_i;; Read c);
            Out leak_ot_o3 (_ <-- Read ot14_i;; Read c0);
            Out leak_ot_o2 (_ <-- Read ot14_i;; y <-- Read c1;; Ret y);
            Out c1 (Samp Unif); Out c (Samp Unif);             Out ot14_o
              (x <-- Read ot14_i;; x0 <-- Read ot14_m;; Ret ((x0 # x.1) # x.2 : L.-bv));
            Out c0 (Samp Unif) ] ].

Lemma ot_simpl_rerandomize : OT14_real_simpl =p OT14_real_rerandomize.
    etransitivity.
    repeat ltac:(apply EqCongNew; intro).
    swap_tac 0 9.
    swap_tac 1 10.
    etransitivity.
    rewrite (rerandomP_rs true).
    repeat ltac:(apply EqCongNew; intro).
    repeat ltac:(do_inline; simp_all).
    edit_tac 8.
        r_swap 1 3.
        rewrite EqReadSame.
        r_swap 1 5.
        rewrite EqReadSame.
        apply EqBind_r => i.
        r_swap 1 2.
        rewrite !EqReadSame.
        apply EqBind_r => x.
        rewrite !EqReadSame.
        apply EqBind_r => y.
        instantiate (1 := fun y => Ret y).
        destruct i; simpl.
        destruct b; done.
   swap_tac 0 4.
   swap_tac 1 10.
    rewrite (rerandomP_rs false).
    repeat ltac:(apply EqCongNew; intro).
    repeat ltac:(do_inline; simp_all).
    edit_tac 8.
        r_swap 1 3.
        rewrite EqReadSame.
        r_swap 1 5.
        rewrite EqReadSame.
        apply EqBind_r => i.
        r_swap 1 2.
        rewrite !EqReadSame.
        apply EqBind_r => x.
        rewrite !EqReadSame.
        apply EqBind_r => y.
        instantiate (1 := fun y => Ret y).
        destruct i; simpl.
        destruct b0; done.
  swap_tac 0 11.
  swap_tac 1 14.
    rewrite (rerandomP_rs false).
    repeat ltac:(apply EqCongNew; intro).
    repeat ltac:(do_inline; simp_all).
    edit_tac 11.
        r_swap 1 3.
        rewrite EqReadSame.
        r_swap 1 5.
        rewrite EqReadSame.
        apply EqBind_r => i.
        r_swap 1 2.
        rewrite !EqReadSame.
        apply EqBind_r => x.
        rewrite !EqReadSame.
        apply EqBind_r => y.
        instantiate (1 := fun y => Ret y).
        destruct i; simpl.
        destruct b0; done.
  apply EqRefl.
  apply EqRefl.
  (* Now elim useless channels *)
  setoid_rewrite (EqNewExch L.-bv) at 1.
  setoid_rewrite (EqNewExch L.-bv) at 2.
  setoid_rewrite (EqNewExch L.-bv) at 3.
  setoid_rewrite (EqNewExch L.-bv) at 4.
  setoid_rewrite (EqNewExch L.-bv) at 5.
  setoid_rewrite (EqNewExch L.-bv) at 6.
  setoid_rewrite (EqNewExch L.-bv) at 7.
  setoid_rewrite (EqNewExch L.-bv) at 8.
  setoid_rewrite (EqNewExch L.-bv) at 9.
  setoid_rewrite (EqNewExch L.-bv) at 10.
  setoid_rewrite (EqNewExch L.-bv) at 11.
  swap_tac 0 6.
  under_new rewrite new_pars_remove; last first.
  apply EqRefl.

  setoid_rewrite (EqNewExch L.-bv) at 1.
  setoid_rewrite (EqNewExch L.-bv) at 2.
  setoid_rewrite (EqNewExch L.-bv) at 3.
  setoid_rewrite (EqNewExch L.-bv) at 4.
  setoid_rewrite (EqNewExch L.-bv) at 5.
  setoid_rewrite (EqNewExch L.-bv) at 6.
  setoid_rewrite (EqNewExch L.-bv) at 7.
  setoid_rewrite (EqNewExch L.-bv) at 8.
  setoid_rewrite (EqNewExch L.-bv) at 9.
  setoid_rewrite (EqNewExch L.-bv) at 10.
  swap_tac 0 6.
  under_new rewrite new_pars_remove; last first.
  apply EqRefl.

  setoid_rewrite (EqNewExch L.-bv) at 1.
  setoid_rewrite (EqNewExch L.-bv) at 2.
  setoid_rewrite (EqNewExch L.-bv) at 3.
  setoid_rewrite (EqNewExch L.-bv) at 4.
  setoid_rewrite (EqNewExch L.-bv) at 5.
  setoid_rewrite (EqNewExch L.-bv) at 6.
  setoid_rewrite (EqNewExch L.-bv) at 7.
  setoid_rewrite (EqNewExch L.-bv) at 8.
  setoid_rewrite (EqNewExch L.-bv) at 9.
  under_new rewrite new_pars_remove; last first.
  apply EqRefl.

  setoid_rewrite (EqNewExch L.-bv) at 1.
  setoid_rewrite (EqNewExch L.-bv) at 2.
  setoid_rewrite (EqNewExch L.-bv) at 3.
  setoid_rewrite (EqNewExch L.-bv) at 4.
  setoid_rewrite (EqNewExch L.-bv) at 5.
  setoid_rewrite (EqNewExch L.-bv) at 6.
  setoid_rewrite (EqNewExch L.-bv) at 7.
  setoid_rewrite (EqNewExch L.-bv) at 8.
  under_new rewrite new_pars_remove; last first.
  apply EqRefl.

  setoid_rewrite (EqNewExch L.-bv) at 1.
  setoid_rewrite (EqNewExch L.-bv) at 2.
  setoid_rewrite (EqNewExch L.-bv) at 3.
  setoid_rewrite (EqNewExch L.-bv) at 4.
  setoid_rewrite (EqNewExch L.-bv) at 5.
  setoid_rewrite (EqNewExch L.-bv) at 6.
  setoid_rewrite (EqNewExch L.-bv) at 7.
  under_new rewrite new_pars_remove; last first.
  apply EqRefl.

  setoid_rewrite (EqNewExch L.-bv) at 1.
  setoid_rewrite (EqNewExch L.-bv) at 2.
  setoid_rewrite (EqNewExch L.-bv) at 3.
  setoid_rewrite (EqNewExch L.-bv) at 4.
  setoid_rewrite (EqNewExch L.-bv) at 5.
  setoid_rewrite (EqNewExch L.-bv) at 6.
  under_new rewrite new_pars_remove; last first.
  apply EqRefl.

  (* Now undep the leaks *)
  etransitivity.
  repeat ltac:(apply EqCongNew; intro).
  swap_at 4 0 1.
  (* leak_ok_o3 *)
  swap_tac 0 4.
  swap_tac 1 7.
  rewrite -pars_mkdep //=.

  (* leak_ok_o2 *)
  swap_tac 0 5.
  swap_at 0 0 1.
  swap_tac 1 4.
  rewrite -pars_mkdep //=.

  (* leak_ot_o1 *)
  swap_tac 0 6.
  swap_at 0 0 1.
  swap_tac 1 2.
  rewrite -pars_mkdep //=.
  edit_tac 3.

    r_swap 1 3.
    r_swap 2 6.
    r_swap 3 9.
    r_swap 4 12.
    r_swap 5 15.
    rewrite !EqReadSame.
    apply EqBind_r => i.
    r_swap 1 2.
    rewrite !EqReadSame.
    apply EqBind_r => x.
    rewrite !EqReadSame.
    apply EqBind_r => y.
    r_swap 1 2.
    rewrite !EqReadSame.
    apply EqBind_r => z.
    rewrite !EqReadSame.
    apply EqBind_r => w.
    r_swap 1 2.
    rewrite !EqReadSame.
    apply EqBind_r => a.
    rewrite !EqReadSame.
    apply EqRxnRefl.
  apply EqRefl.

  (* Now fold in the samps *)
  simpl.
  setoid_rewrite (EqNewExch L.-bv) at 5.
  swap_tac 0 3.
  under_new swap_at 0 0 1.
  simpl.
  swap_tac 1 2.
  under_new rewrite pars_fold; [ apply EqRefl ].

  simpl.
  under_new swap_at 0 0 3.
  simpl.
  swap_tac 1 3.
  setoid_rewrite (EqNewExch L.-bv) at 3.
  setoid_rewrite (EqNewExch L.-bv) at 4.
  under_new rewrite pars_fold; [ apply EqRefl ].

  simpl.
  under_new swap_at 0 0 5.
  simpl.
  setoid_rewrite (EqNewExch L.-bv) at 1.
  setoid_rewrite (EqNewExch L.-bv) at 2.
  setoid_rewrite (EqNewExch L.-bv) at 3.
  swap_tac 1 2.
  under_new rewrite pars_fold; [ apply EqRefl ].

  (* Now simplify leak_send *)
  simpl.
  etransitivity.
  apply EqCongNew; intro.
  apply EqCongNew; intro.
  apply EqCongNew; intro.
  edit_tac 0.
    r_swap 0 3.
    r_swap 1 4.
    r_swap 2 5.
    r_swap 3 6.
    r_swap 4 7.
    apply EqBind_r; intro.
    apply EqBind_r; intro.
    apply EqBind_r; intro.
    apply EqBind_r; intro.
    apply EqBind_r; intro.
    instantiate (1 := fun x3 =>
                   x4 <-- Samp Unif ;;
                   x5 <-- Samp Unif ;;
                   x6 <-- Samp Unif ;;
                   Ret (
                       let o := (x3 # x.1) # x.2 in
                       let o0 := if x.2 && x.1 then o else tzero _ in
                       let o1 := if (~~ x.2) && x.1 then o else tzero _ in
                       let o2 := if (x.2) && (~~ x.1) then o else tzero _ in
                       let o3 := if (~~ x.2) && (~~ x.1) then o else tzero _ in
                       ( (
                              (x2, x4) # x.1 +t (x0, x6) # x.2 +t o3,
                              (x2, x4) # x.1 +t (x6, x0) # x.2 +t o2 ),
                         (
                              (x4, x2) # x.1 +t (x1, x5) # x.2 +t o1,
                              (x4, x2) # x.1 +t (x5, x1) # x.2 +t o0 )
                            ))).
    simpl.
    destruct x3 as [[m0 m1] [m2 m3]]; simpl.
    destruct x as [ [ | ] [ | ]]; simpl.

    rewrite (bind_samp_xor m1).
    apply EqBind_r => x.
    rewrite (bind_samp_xor m2).
    apply EqBind_r => y.
    rewrite (bind_samp_xor (m1 +t m0)).
    apply EqBind_r => z.
    rewrite (xortC _ x0).
    rewrite !xortA !xortK !xort0.
    rewrite (xortC m1) xortA xortK xort0.
    rewrite (xortC x0) //=.

    rewrite (bind_samp_xor m0).
    apply EqBind_r => x.
    rewrite (bind_samp_xor m3).
    apply EqBind_r => y.
    rewrite (bind_samp_xor (m0 +t m1)).
    apply EqBind_r => z.
    rewrite (xortC _ x0).
    rewrite !xortA !xortK !xort0.
    rewrite (xortC m0) xortA xortK xort0.
    rewrite (xortC x0) //=.

    rewrite (bind_samp_xor m3).
    apply EqBind_r => x.
    rewrite (bind_samp_xor (m3 +t m2)).
    apply EqBind_r => y.
    rewrite (bind_samp_xor m0).
    apply EqBind_r => z.
    rewrite !xortA !xortK !xort0.
    rewrite (xortC m3) xortA xortK xort0.
    rewrite (xortC m3) xortA xortK xort0 //=.

    rewrite (bind_samp_xor m2).
    apply EqBind_r => x.
    rewrite (bind_samp_xor (m3 +t m2)).
    apply EqBind_r => y.
    rewrite (bind_samp_xor m1).
    apply EqBind_r => z.
    rewrite !xortA !xortK !xort0.
    rewrite (xortC m3) xortA xortK xort0.
    rewrite (xortC m2) xortA xortK xort0 //=.
    rewrite (xortC m2) xortA xortK xort0 //=.
    apply EqRefl.

    rewrite /OT14_real_rerandomize.
    apply EqCongNew => c.
    apply EqCongNew => c1.
    apply EqCongNew => c2.
    align.
    apply EqCongReact; apply EqBind_r; intro; rewrite EqBindRet //=.
    apply EqCongReact; apply EqBind_r; intro; rewrite EqBindRet //=.
 Qed.

Definition OT14_sim (out : chan L.-bv) :=
c <- new L.-bv;;
c0 <- new L.-bv;;
c1 <- new L.-bv;;
[pars [:: Out leak_send
          (
            o <-- Read out ;;
            x <-- Read ot14_i;;
             x0 <-- Read c1;;
             x1 <-- Read c0;;
             x2 <-- Read c;;
             x4 <-- Samp Unif;;
             x5 <-- Samp Unif;;
             x6 <-- Samp Unif;;
             Ret
               (
                let o0 := if x .2 && x .1 then o else tzero L in
                let o1 := if ~~ x .2 && x .1 then o else tzero L in
                let o2 := if x .2 && ~~ x .1 then o else tzero L in
                let o3 := if ~~ x .2 && ~~ x .1 then o else tzero L in
                ((((x2, x4) # x .1 +t (x0, x6) # x .2) +t o3,
                  ((x2, x4) # x .1 +t (x6, x0) # x .2) +t o2),
                (((x4, x2) # x .1 +t (x1, x5) # x .2) +t o1,
                ((x4, x2) # x .1 +t (x5, x1) # x .2) +t o0))));
          Out leak_ot_o1 (_ <-- Read ot14_i;; Read c);
          Out leak_ot_o3 (_ <-- Read ot14_i;; Read c0);
          Out leak_ot_o2 (_ <-- Read ot14_i;; y <-- Read c1;; Ret y);
          Out c1 (Samp Unif); Out c (Samp Unif);
          Out c0 (Samp Unif) ] ].

Lemma OT14_real_simE :
  OT14_real_rerandomize =p
                           o <- new L.-bv ;;
                           pars [::
                                   OT14Ideal _ ot14_i ot14_m ot14_o;
                                   OT14Ideal _ ot14_i ot14_m o;
                                   OT14_sim o ].
  symmetry.
  rewrite /OT14Ideal.
  rewrite /OT14_sim.
  swap_tac 0 2.
  repeat setoid_rewrite newPars.
  repeat setoid_rewrite pars_pars; simpl.
  etransitivity.
  repeat ltac:(apply EqCongNew; intro).
  do_inline; simp_all.
  apply EqRefl.
  setoid_rewrite (EqNewExch L.-bv) at 1.
  setoid_rewrite (EqNewExch L.-bv) at 2.
  setoid_rewrite (EqNewExch L.-bv) at 3.
  swap_tac 0 7.
  under_new rewrite new_pars_remove. apply EqRefl.
  rewrite /OT14_real_rerandomize.
  apply EqCongNew => c.
  apply EqCongNew => c0.
  apply EqCongNew => c1.
  swap_tac 0 6.
  apply pars_cons_cong.
  apply EqCongReact.
  r_swap 1 2.
  rewrite EqReadSame.
  apply EqBind_r; intro.
  r_swap 0 1.
  apply EqBind_r; intro.
  r_swap 0 1.
  apply EqBind_r; intro.
  r_swap 0 1.
  apply EqBind_r; intro.
  apply EqBind_r; intro.
  apply EqBind_r; intro.
  apply EqBind_r; intro.
  apply EqBind_r; intro.
  destruct x as [ [|] [|] ]; done.
  align.
  apply _.
  apply _.
  apply _.
Qed.

Definition OT14_sim_ideal :=
                           o <- new L.-bv ;;
                           pars [::
                                   OT14Ideal _ ot14_i ot14_m ot14_o;
                                   OT14Ideal _ ot14_i ot14_m o;
                                   OT14_sim o ].

Theorem OT14_security :
  OT14_real =p OT14_sim_ideal.
  rewrite ot14_simp.
  rewrite ot_simpl_rerandomize.
  rewrite OT14_real_simE.
  done.
Qed.

Definition ot14_chans :=
[:: tag ot14_o; tag leak_ot_o1; tag leak_ot_o2; tag leak_ot_o3; tag leak_send].

Lemma OT14_t : ipdl_t ot14_chans OT14_real.
  rewrite /OT14_real /OTIdeal.
  rewrite /One4_sender /One4_recv.
  repeat type_tac.
  perm_match_step; rewrite insert_0.
  perm_match_step.
  perm_match_step.
  simpl in *.
  perm_match.
Qed.

Lemma OT14_sim_t o : ipdl_t [:: tag leak_send; tag leak_ot_o1; tag leak_ot_o3; tag leak_ot_o2] (OT14_sim o).
  rewrite /OT14_sim.
  repeat type_tac.
  perm_match.
Qed.

Lemma OT14_sim_ideal_t : ipdl_t ot14_chans OT14_sim_ideal.
  rewrite /OT14_sim_ideal.
  rewrite /OT14Ideal.
  repeat type_tac.
  apply OT14_sim_t.
  rewrite /ot14_chans.
  perm_match.
Qed.

End OneOutOf4.


Require Import GraphBasics.Graphs.
Require Import Coq.Logic.Classical_Prop.
Require Import Verdi.Verdi.

Require Export StructTact.Fin.

Require Import ExtrOcamlBasic.
Require Import ExtrOcamlNatInt.

Require Import Verdi.ExtrOcamlBasicExt.
Require Import Verdi.ExtrOcamlList.

Load PO_III.

(* helping functions*)

Fixpoint remove (x : Component) (l : list Component) : list Component :=
    match l with
      | [] => []
      | y::tl => if ((Component_index x) == (Component_index y)) then tl else y::(remove x tl)
    end.

Definition empty (l : list Component) : bool :=
  match l with
  | nil => true
  | a :: m => false
  end.

(***)

Inductive Name := Checker : Component  -> Name.

(* get component from name*)
Definition name_component (n: Name): Component :=
match n with
  | Checker x => x
end.

Definition Nodes : list Name := (map Checker (CV_list v a g)) .

Axiom all_Names_Nodes : forall n, In n Nodes.

Axiom NoDup_Nodes : NoDup Nodes.

Definition Name_eq_dec : forall x y : Name, {x = y} + {x <> y}.
  decide equality.
  destruct c. destruct c0.
  case (eq_nat_dec n n0); intros H.
  left; rewrite H; trivial.
  right; injection; trivial.
Qed.

Inductive Msg := Checkermessage : list Fact -> Msg.

Definition Msg_eq_dec : forall x y : Msg, {x = y} + {x <> y}.
decide equality.
apply list_eq_dec.
apply fact_eq_dec.
Qed.

Record Checkerknowledge: Set := mk_Checkerknowledge {
  Inp : list inp;
  Sub_predicates: list Predicate;
  facts: list Key
}.

Record Checkerinput  := mk_Checkerinput {
output : list outp;
certificate : list Fact
}.

Inductive Input : Type :=
  | ci : Checkerinput -> Input
  | li : Checkerknowledge -> Input.

Definition Output := Msg.

Record Data := mkData{
 queue : list Component ;
 messages_received : list Component;
 consistent : bool ;
 checkerresult: bool;
 checkerinput : Checkerinput ;
 localinput : Checkerknowledge;
 initialized_localinput: bool;
 initialized_checkerinput: bool;
 control_neighbourlist: list Component
 }.

Definition init_Data (n: Name) := mkData
(neighbors g (name_component n)) [] true false (mk_Checkerinput [] [(fact_cons keynull valuenull)] ) (mk_Checkerknowledge []  []  []) false false (neighbors g (name_component n)).

Definition set_queue a v := mkData v  (messages_received a) (consistent a) (checkerresult a) (checkerinput a) (localinput a) (initialized_localinput a) (initialized_checkerinput a)(control_neighbourlist a) .
Definition set_consistent a v:= mkData (queue a) (messages_received a)  v (checkerresult a) (checkerinput a) (localinput a)(initialized_localinput a)(initialized_checkerinput a)(control_neighbourlist a).
Definition set_queue_consistent a q r c:= mkData q r  c (checkerresult a)(checkerinput a) (localinput a)(initialized_localinput a)(initialized_checkerinput a)(control_neighbourlist a).
Definition set_checkeroutput_queue a q r v:= mkData q r (consistent a)  v (checkerinput a) (localinput a)(initialized_localinput a)(initialized_checkerinput a)(control_neighbourlist a).

(* Send messages to all entries of a list (neighbours)*)
Fixpoint sendlist (neighbours: list Component) (me : Component)(cert: list Fact): list (Name * Msg)  :=
         match neighbours with
              | nil => [(Checker me, Checkermessage cert)]
              | n::m => (Checker n, Checkermessage cert) :: (sendlist m me cert)
         end.

(**** 2 Inputs -> 1. Input Checkerknowledge  2. Input Checkerinput (from component) **)
Definition InputHandler (me : Name) (c : Input) (state: Data) :
            (list Output) * Data * list (Name * Msg) :=
	match me,c  with
    (**** Initialize with Checkerknowledge  **)
    | Checker x, li locali => if  (eqb state.(initialized_localinput)  false) then
                             (* let myneighbors := (neighbors g x) in*)
                             ( [] , (mkData (queue state) [] true (checkerresult state) (checkerinput state) locali true (initialized_checkerinput state) (control_neighbourlist state)) , [])

                              else ([], state, [])
    (**** Initialize with Checkerinput, send message to all neighbours **)
		| Checker x, ci checkeri => if  (eqb state.(initialized_checkerinput) false)   then
                                let cert := checkeri.(certificate) in
                                ( [] , (mkData (queue state) [] (consistent state) (checkerresult state) checkeri (localinput state)(initialized_localinput state) true (control_neighbourlist state) ), (sendlist state.(queue) x cert))

                                else ([], state, [])

	end.

(** Check Consistency for a single fact *)
Definition One_Fact_Consistency_Check (c1 c2 : list Fact)  (key : Key) : bool :=
match (overlap c1 c2 key) with
          | (Some x, Some y) => if (beqValue  (findValue  c1 (Some x)) (findValue  c2 (Some y))) then true else false
          | (None, None) => false
          | (None, Some _ ) => false
          | (Some _, None ) => false
end.

(** Check Consistency for all facts in a fact list; return true if consistency is given for two certificate lists *)
Fixpoint All_Fact_Consistency_Check_ (init: bool) (c1 c2 : list Fact)  (keys : list Key) : bool :=
match keys with
          | nil  => init
          | a :: b => ( One_Fact_Consistency_Check c1 c2 a ) && All_Fact_Consistency_Check_ init c1 c2 b
end.

Functional Scheme all_fact_ind := Induction for All_Fact_Consistency_Check_  Sort Prop.

(** Initialize Consistency Check with true - Consistency Check for an empty list of facts returns true as well *)
Definition All_Fact_Consistency_Check := All_Fact_Consistency_Check_ true.

(*stub-function for next phase of checker, e.g. decide sub-predicates*)
Variable Check : Checkerknowledge -> Checkerinput -> bool.

Definition NetHandler (me : Name) (src: Name) (m : Msg) (state: Data) :
    (list Output) * Data * list (Name * Msg) :=

   (****  Consistency Check **)
    match m with
      | Checkermessage certif => if  (state.(initialized_localinput) && state.(initialized_checkerinput)) then

                                     let c := state.(checkerinput) in
                                     let l := state.(localinput) in
                                     let mycertif := c.(certificate) in
                                     let consistent := state.(consistent) && All_Fact_Consistency_Check mycertif certif l.(facts) in

                                       if (empty (remove (name_component src) state.(queue)) && (eqb consistent true)) then
                                            let result := Check state.(localinput) state.(checkerinput) in (** check () **)
     	                                      ([], (set_checkeroutput_queue state (remove  (name_component src) state.(queue)) ([(name_component src)] ++ state.(messages_received)) result) , []) (** finales Resultat **)
                                       else ([], (set_queue_consistent state  (remove  (name_component src) state.(queue)) ([(name_component src)] ++ state.(messages_received))  consistent), [])
                                 else ([], state,[])
   end.

(* verdi stuff*)

Instance Checker_BaseParams : BaseParams :=
  {
    data := Data;
    input := Input;
    output := Output
  }.

Instance Checker_MultiParams : MultiParams Checker_BaseParams :=
  {
    name := Name;
    name_eq_dec := Name_eq_dec;
    msg := Msg;
    msg_eq_dec := Msg_eq_dec;
    nodes := Nodes;
    all_names_nodes := all_Names_Nodes;
    no_dup_nodes := NoDup_Nodes;
    init_handlers := init_Data;
    input_handlers := InputHandler ;
    net_handlers := NetHandler

    }.

(** helping functions for verification **)

(* get certificate in message *)
Definition certificate_from_message ( msg: Msg) :  list Fact :=
match msg with
  | Checkermessage certif => certif
end.

Definition initialized (state: Data) :=
(state.(initialized_localinput) && state.(initialized_checkerinput)).

(* If one fact consistency check returns true for x y na, then we have fact consistency for x y na *)
Lemma One_Fact_Consistency_Check_true:
forall cert1 cert2 key, One_Fact_Consistency_Check cert1 cert2 key = true -> consistent_in_var cert1 cert2 key.
Proof.
intros.
unfold One_Fact_Consistency_Check in *.
unfold consistent_in_var.
repeat break_match.
intros.
inversion H0.
apply beqValue_eq in Heqb.
trivial.
discriminate.
discriminate.
discriminate.
discriminate.
Qed.

(* helping lemma *)
Lemma Consistency_Check_List:
forall a c1 c2 keys, (forall k, In k (a :: keys) -> One_Fact_Consistency_Check c1 c2 k = true) -> (forall m : Key, In m keys -> One_Fact_Consistency_Check c1 c2 m = true ).
Proof.
intros.
apply in_cons with (a:=a0) in H0.
apply H in H0.
trivial.
Qed.

(* If one fact consistency check returns true for x y and all facts in fact list, then All_Fact_Consistency Check returns true for x y and fact list*)
Lemma one_fact_all_fact :
forall c1 c2 keys, (forall k,  In k keys ->  One_Fact_Consistency_Check c1 c2 k = true) -> All_Fact_Consistency_Check c1 c2 keys = true.
Proof.
intros.
unfold All_Fact_Consistency_Check.
induction keys.
unfold All_Fact_Consistency_Check_.
trivial.
unfold All_Fact_Consistency_Check_.
apply andb_true_iff.
split.
apply H with (k:=a0).
apply in_eq.
fold All_Fact_Consistency_Check_.
apply IHkeys.
intros.
apply Consistency_Check_List with (a:=a0) (keys :=keys).
apply H .
trivial.
Qed.

Lemma both_one_fact_all_fact :
forall c1 c2 keys, All_Fact_Consistency_Check c1 c2 keys = true -> (forall k,  In k keys ->  One_Fact_Consistency_Check c1 c2 k = true)  .
Proof.
intros.
unfold All_Fact_Consistency_Check in *.
unfold All_Fact_Consistency_Check_ in *.
induction keys.
unfold One_Fact_Consistency_Check.
  repeat break_match; repeat tuple_inversion;
      subst; simpl in *; subst; simpl in *.
trivial.
exfalso.
trivial.
exfalso.
trivial.
exfalso.
trivial.
exfalso.
trivial.

fold All_Fact_Consistency_Check_ in *.
apply andb_true_iff in H.
destruct H.
destruct H0.
rewrite H0 in H.
trivial.
apply IHkeys.
auto.
auto.
Qed.

Variable localin : Checkerknowledge.

Lemma both_one_fact_all_fact_allna :
forall c1 c2, All_Fact_Consistency_Check c1 c2 localin.(facts) = true ->
(forall k,  In k localin.(facts) ->  One_Fact_Consistency_Check c1 c2 k = true)  .
Proof.
intros.
apply both_one_fact_all_fact with (keys:=localin.(facts)).
trivial.
trivial.
Qed.

Definition keylist (a : list Fact) : list Key :=   map fact_key a.

Variable all_Keys: list Key.
Axiom all_in_all_Keys:
forall key: Key , In key all_Keys.

Axiom keylistprop: forall k cert1 n,  get_pos cert1 k = Some n -> In k (keylist cert1).

Axiom allkeylist: forall k cert1 , In k (facts localin) <-> In k (keylist cert1).

Lemma inkeylist:
forall cert1 cert2 k, overlapping_in_var cert1 cert2 k -> In k (keylist cert1).
Proof.
intros.
unfold overlapping_in_var in *.
unfold overlap in *.
repeat break_match.
apply keylistprop in Heqo; trivial.
destruct H. destruct H. discriminate.
destruct H. destruct H.  discriminate.
destruct H. destruct H.  discriminate.
Qed.

Lemma All_Fact_Consistency_Check_for_true:
forall cert1 cert2 , All_Fact_Consistency_Check cert1 cert2 localin.(facts) = true -> consistent_in_all_var cert1 cert2.
Proof.
intros.
apply consistency_defs.
unfold consistent_alt.
intros.
apply both_one_fact_all_fact_allna with (k:=k) in H.
unfold overlapping_in_var in H0.
apply One_Fact_Consistency_Check_true in H.
unfold consistent_in_var in H.
unfold overlap in *.
repeat break_match.
destruct H0. destruct H0.
assert (G:=H0). apply H in H0. inversion G. rewrite <- H2. rewrite <-  H3. trivial.
destruct H0. destruct H0. discriminate.
destruct H0. destruct H0. discriminate.
destruct H0. destruct H0. discriminate.
trivial.
apply inkeylist in H0.
apply allkeylist in H0.
trivial.
Qed.

(************************ FOR ALL IN MESSAGES RECEIVED -> ALL FACT CONSISTENCY ********************)

Lemma inititialized_nethandler_b:
forall me src msg data u dataout st',
NetHandler me src msg data = (u, dataout, st') ->
initialized dataout = true -> initialized data = true.
Proof.
intros.
unfold NetHandler in *.
repeat break_match.
inversion H.
unfold initialized.
trivial.
trivial.
inversion H.
trivial.
Qed.

Lemma inititialized_nethandler_:
forall me src msg data u dataout st',
NetHandler me src msg data = (u, dataout, st') ->
initialized_localinput data &&
initialized_checkerinput data  = true ->
initialized_checkerinput dataout = true.
Proof.
intros.
unfold NetHandler in *.
repeat break_match.
unfold set_checkeroutput_queue in H.
find_inversion. simpl in *.
apply andb_true_iff in Heqb.
destruct Heqb.
trivial.
find_inversion. simpl in *.
apply andb_true_iff in Heqb.
destruct Heqb.
trivial.
discriminate.
Qed.

Lemma inititialized_nethandler_2:
forall me src msg data u dataout st',
NetHandler me src msg data = (u, dataout, st') ->
initialized_localinput data &&
initialized_checkerinput data  = true ->
initialized_localinput dataout = true.
Proof.
intros.
unfold NetHandler in *.
repeat break_match.
unfold set_checkeroutput_queue in H.
find_inversion. simpl in *.
apply andb_true_iff in Heqb.
destruct Heqb.
trivial.
find_inversion. simpl in *.
apply andb_true_iff in Heqb.
destruct Heqb.
trivial.
discriminate.
Qed.

Lemma consistent_nethandler_b:
forall me src msg data u dataout st',
NetHandler me src msg data = (u, dataout, st') ->
consistent dataout = true -> consistent data = true.
Proof.
intros.
unfold NetHandler in *.
repeat break_match.
unfold set_checkeroutput_queue in H.
find_inversion. simpl in *. trivial.
find_inversion. simpl in *. apply andb_true_iff in H0.
destruct H0. trivial.
inversion H.
trivial.
Qed.

Lemma consistent_inputhandler_b:
forall me input data u dataout l ,
InputHandler me input data = (u, dataout, l) ->
initialized data = true ->
consistent dataout = true -> consistent data = true.
Proof.
intros.
unfold InputHandler in *.
repeat break_match.
find_inversion. simpl in *. trivial.
find_inversion. trivial.
find_inversion. simpl in *. unfold initialized in H0.
apply andb_true_iff in H0. destruct H0.
apply eqb_prop in Heqb. rewrite H in Heqb. discriminate.
find_inversion. trivial.
Qed.

Lemma initialized_inputhandler_b:
forall me input data u dataout l ,
InputHandler me input data = (u, dataout, l) ->
messages_received dataout <> [] ->
initialized dataout = true -> initialized data = true.
Proof.
intros.
unfold InputHandler in *.
repeat break_match.
find_inversion. simpl in *. contradiction.

find_inversion. trivial.
find_inversion. simpl in *. contradiction.
find_inversion. trivial.
Qed.

Axiom certificate_from_src :
forall l me src msg data u dataout st',
NetHandler me src msg data = (u, dataout, st') ->
msg = Checkermessage l ->
getCertificate (name_component src) =  l.

Lemma consistency_check_in_src :
forall me src msg data u dataout st',
initialized data = true ->
NetHandler me src msg data = (u, dataout, st') ->
dataout.(consistent) = true ->
All_Fact_Consistency_Check data.(checkerinput).(certificate) (getCertificate (name_component src))  data.(localinput).(facts) = true.
Proof.
intros.
assert (G:=H0).
unfold NetHandler in H0.
repeat break_match.
- apply andb_true_iff in Heqb0.
destruct Heqb0.
apply eqb_prop in H3.

rewrite  certificate_from_src with (data:=data)(me:=me)(src:=src)(msg:=msg)(u:=u)(dataout:=dataout)(st':=st')(l:=l).
trivial.
apply andb_true_iff  in H3.
destruct H3.
trivial.
trivial.
rewrite Heqm.
trivial.
trivial.
-
rewrite  certificate_from_src with (data:=data)(me:=me)(src:=src)(msg:=msg)(u:=u)(dataout:=dataout)(st':=st')(l:=l).
find_inversion. simpl in *. subst.
apply andb_true_iff  in H1.
destruct H1.
trivial.
rewrite Heqm.
trivial.
trivial.
- unfold initialized in H.
rewrite H in Heqb.
discriminate.
Qed.

Lemma consistency_check_NetHandler :
forall me src msg data u dataout st',
initialized dataout = true ->
dataout.(consistent) = true ->
NetHandler me src msg data = (u, dataout, st') ->
forall k,
(In k data.(messages_received)  ->
All_Fact_Consistency_Check data.(checkerinput).(certificate) (getCertificate  k)  data.(localinput).(facts) = true) ->
(In k dataout.(messages_received) ->
All_Fact_Consistency_Check data.(checkerinput).(certificate) (getCertificate  k)  data.(localinput).(facts) = true).
Proof.
intros.
assert (G:=H0).
assert (N:=H1).
unfold NetHandler in H1.
repeat break_match.
- apply andb_true_iff in Heqb0.
destruct Heqb0.
apply eqb_prop in H5.
apply andb_true_iff in H5.
inversion H1. simpl in *.
unfold set_checkeroutput_queue in H8.
find_inversion. simpl in *. subst.
destruct H3.
rewrite <- H1.
apply consistency_check_in_src with  (me:=me)(src:=src)(msg:=Checkermessage l)(u:=[])(dataout:= {|
    queue := remove (name_component src) (queue data);
    messages_received := name_component src :: messages_received data;
    consistent := consistent data;
    checkerresult := Check (localinput data) (checkerinput data);
    checkerinput := checkerinput data;
    localinput := localinput data;
    initialized_localinput := initialized_localinput data;
    initialized_checkerinput := initialized_checkerinput data;
    control_neighbourlist := control_neighbourlist data
  |})(st':=[]).
    unfold initialized.
    trivial.
    unfold NetHandler.
    apply N.
    simpl in *.
    destruct H5.
    trivial.
    apply H2.
    trivial.
   - apply andb_false_iff in Heqb0.
     destruct Heqb0.
     unfold set_queue_consistent in H1.
     find_inversion. simpl in *. subst.
     destruct H3.
     rewrite <- H1.
    apply consistency_check_in_src with  (me:=me)(src:=src)(msg:=Checkermessage l)(u:=[])(dataout:= {|
      queue := remove (name_component src) (queue data);
      messages_received := name_component src :: messages_received data;
      consistent := consistent data &&
                    All_Fact_Consistency_Check
                      (certificate (checkerinput data)) l
                      (facts (localinput data));
      checkerresult := checkerresult data;
      checkerinput := checkerinput data;
      localinput := localinput data;
      initialized_localinput := initialized_localinput data;
      initialized_checkerinput := initialized_checkerinput data;
      control_neighbourlist := control_neighbourlist data |} )(st':=[]).
    unfold initialized.
    trivial.
     unfold NetHandler.
    apply N.
    simpl in *.
    apply G.
    apply H2.
    trivial.
    inversion H1. simpl in *. subst.
    unfold set_queue_consistent in G. simpl in *.
    apply eqb_false_iff  in H4.
    contradiction.
   -apply inititialized_nethandler_b with (me:=me)(src:=src) (msg:=msg) (data:=data) (dataout:=dataout) (st':=st') (u:=u) in H.
    unfold initialized in H.
    rewrite H in Heqb.
    discriminate.
    rewrite Heqm.
    trivial.
Qed.

Lemma facts_nethandler:
forall me src msg data u dataout st',
NetHandler me src msg data = (u, dataout, st') ->
initialized dataout = true ->
facts (localinput (data)) = facts (localinput (dataout)).
Proof.
intros.
unfold NetHandler in *.
repeat break_match.
find_inversion. simpl in *. reflexivity.
find_inversion. simpl in *. reflexivity.
find_inversion. simpl in *. reflexivity.
Qed.

Lemma certificate_nethandler:
forall me src msg data u dataout st',
NetHandler me src msg data = (u, dataout, st') ->
initialized dataout = true ->
(certificate (checkerinput data )) = (certificate (checkerinput dataout)).
Proof.
intros.
unfold NetHandler in *.
repeat break_match.
find_inversion; simpl in *; reflexivity.
find_inversion; simpl in *; reflexivity.
find_inversion; simpl in *; reflexivity.
Qed.

Lemma certificate_inputhandler:
forall me input data u dataout l,
InputHandler me input data = (u, dataout, l) ->
messages_received dataout <> [] ->
(certificate (checkerinput data )) = (certificate (checkerinput dataout)).
Proof.
intros.
unfold InputHandler in *.
repeat break_match.
find_inversion. simpl in *. contradiction.
find_inversion. trivial.
find_inversion. simpl in *. contradiction.
find_inversion. trivial.
Qed.

Lemma facts_inputhandler:
forall me input data u dataout l,
InputHandler me input data = (u, dataout, l) ->
messages_received dataout <> [] ->
facts (localinput (data)) = facts (localinput (dataout)).
Proof.
intros.
unfold InputHandler in *.
repeat break_match.
find_inversion. simpl in *. contradiction.
find_inversion. trivial.
find_inversion. simpl in *. contradiction.
find_inversion. trivial.
Qed.

Lemma consistency_check_Inputhandler :
forall me input data u dataout l,
InputHandler me input data = (u, dataout, l) ->
messages_received dataout <> []  ->
dataout.(consistent) = true ->
forall k,
(In k data.(messages_received)  ->
All_Fact_Consistency_Check data.(checkerinput).(certificate) (getCertificate  k)  data.(localinput).(facts) = true) ->
(In k dataout.(messages_received) ->
All_Fact_Consistency_Check dataout.(checkerinput).(certificate) (getCertificate  k)  dataout.(localinput).(facts) = true).
Proof.
intros.
assert (G:=H).
assert (I:=H).
unfold InputHandler in H.
repeat break_match.
assert (K:=H0).

apply facts_inputhandler with (me:=me) (input:=input) (data:=data) (u:=u) (dataout:=dataout) (l:=l) in H0.
rewrite <- H0.
apply certificate_inputhandler with (me:=me) (input:=input) (data:=data) (u:=u) (dataout:=dataout) (l:=l) in K.
rewrite <- K.
apply H2.
find_inversion. simpl in *. subst.
trivial.
exfalso. trivial.
rewrite Heqi.
rewrite Heqn.
trivial.
rewrite Heqn.
rewrite Heqi.
trivial.

assert (K:=H0).
apply facts_inputhandler with (me:=me) (input:=input) (data:=data) (u:=u) (dataout:=dataout) (l:=l) in H0.
rewrite <- H0.
apply certificate_inputhandler with (me:=me) (input:=input) (data:=data) (u:=u) (dataout:=dataout) (l:=l) in K.
rewrite <- K.
apply H2.
find_inversion. simpl in *. subst.
trivial.
rewrite Heqn.
rewrite Heqi.
trivial.
rewrite Heqn.
rewrite Heqi.
trivial.

find_inversion. simpl in *. exfalso. trivial.

assert (K:=H0).
apply facts_inputhandler with (me:=me) (input:=input) (data:=data) (u:=u) (dataout:=dataout) (l:=l) in H0.
rewrite <- H0.
apply certificate_inputhandler with (me:=me) (input:=input) (data:=data) (u:=u) (dataout:=dataout) (l:=l) in K.
rewrite <- K.
apply H2.
find_inversion. simpl in *. subst.
trivial.
rewrite Heqn.
rewrite Heqi.
trivial.
rewrite Heqn.
rewrite Heqi.
trivial.
Qed.

Lemma notEmptylist:
forall (clist : list Component), clist <> [] -> exists (m:Component), In m clist.
Proof.
intros.
destruct clist.
contradiction.
exists c.
apply  in_eq .
Qed.

Lemma notEmptylist_b:
forall (clist : list Component) m, In m clist -> clist <> [].
Proof.
intros.
destruct clist.
contradiction.
apply not_eq_sym.
apply nil_cons.
Qed.

Lemma All_Fact_Consistency_Check_Network:
forall  net tr,
step_async_star (params := Checker_MultiParams) step_async_init net tr ->
forall component c,
(nwState net (Checker c)).(initialized)  = true ->
(nwState net (Checker c)).(consistent)  = true ->
(In component (nwState net (Checker c)).(messages_received) ->
All_Fact_Consistency_Check  (nwState net (Checker c)).(checkerinput).(certificate) (getCertificate  component)  (nwState net (Checker c)).(localinput).(facts) = true).
Proof.
intros net tr H .
remember step_async_init as y in *.
induction H using refl_trans_1n_trace_n1_ind. intros. subst.
simpl in *.
exfalso.
trivial.
intros.
invc H0.

- destruct p. destruct pDst. unfold nwState in *. unfold update in *. repeat break_match.
+  unfold net_handlers in *. unfold Checker_MultiParams in *. simpl in *.
assert (J:=H3).

apply consistency_check_NetHandler with (me :=(Checker c0)) (src:=pSrc)(u:=out) (st':=l) (k:=component) (data:=(nwState (Checker c0))) (msg:= pBody ) (dataout:=d)  in H3.
rewrite <- certificate_nethandler with (me :=(Checker c0)) (src:=pSrc)(u:=out) (st':=l) (data:=(nwState (Checker c0))) (msg:= pBody ) (dataout:=d).
rewrite <- facts_nethandler with (me :=(Checker c0)) (src:=pSrc)(u:=out) (st':=l) (data:=(nwState (Checker c0))) (msg:= pBody ) (dataout:=d).
apply H3.
trivial.
trivial.
trivial.
trivial.
trivial.
trivial.
apply IHrefl_trans_1n_trace1  with (c:=c0).
trivial.
apply consistent_nethandler_b  with (me :=(Checker c0)) (src:=pSrc)(u:=out) (st':=l)(data:=(nwState (Checker c0))) (msg:= pBody ) (dataout:=d)  in H3.
apply inititialized_nethandler_b  with (me :=(Checker c0)) (src:=pSrc)(u:=out) (st':=l)(data:=(nwState (Checker c0))) (msg:= pBody ) (dataout:=d)  in H2.
trivial.
trivial.
trivial.
apply consistent_nethandler_b  with (me :=(Checker c0)) (src:=pSrc)(u:=out) (st':=l)(data:=(nwState (Checker c0))) (msg:= pBody ) (dataout:=d)  in H3.
trivial.
trivial.
trivial.
+
concludes. apply IHrefl_trans_1n_trace1. trivial. trivial. trivial.
-destruct h. unfold nwState in *. unfold update in *. repeat break_match.
+  unfold input_handlers in *. unfold Checker_MultiParams in *. concludes.
apply consistency_check_Inputhandler with (k:=component) in H5 .
trivial.
assert (G:=H4).
apply notEmptylist_b in H4.
trivial.
trivial.
apply IHrefl_trans_1n_trace1 with (c:=c0).
apply initialized_inputhandler_b in H5.
trivial.
apply notEmptylist_b in H4.
trivial.
trivial.
apply consistent_inputhandler_b in H5.
trivial.
apply initialized_inputhandler_b in H5.
trivial.
apply notEmptylist_b in H4.
trivial.
trivial.
trivial.
trivial.
+ concludes. apply IHrefl_trans_1n_trace1. trivial. trivial. trivial.
Qed.

Axiom all_keys_in_nw:
forall  net tr c,
step_async_star (params := Checker_MultiParams) step_async_init net tr ->
facts (localinput (nwState net (Checker c))) = localin.(facts).

Lemma All_Fact_Check_Network:
forall  net tr,
step_async_star (params := Checker_MultiParams) step_async_init net tr ->
forall component c,
(nwState net (Checker c)).(initialized)  = true ->
(nwState net (Checker c)).(consistent)  = true ->
(In component (nwState net (Checker c)).(messages_received)) ->
consistent_in_all_var (nwState net (Checker c)).(checkerinput).(certificate) (getCertificate  component) .
Proof.
intros.
apply All_Fact_Consistency_Check_for_true.
rewrite <- all_keys_in_nw with (net:=net) (tr:=tr) (c:=c).
apply All_Fact_Consistency_Check_Network with (net:=net) (c:=c) (tr:=tr) (component:=component);trivial.
trivial.
Qed.

(********************************* QUEUE EMPTY -> ALL IN MESSAGES RECEIVED ***************************************************************)

Lemma removeprop:
forall name k l1 l2,
 In k (l1 ++ l2) ->
 In k   (remove (name_component name) l1 ++  name_component name :: l2).
Proof.
intros.
apply in_app_or in H.
destruct H.
apply in_or_app.
- assert ({k= name_component name} + {k <> name_component name}) .
  destruct name.
  destruct k.
  destruct Checker.
  destruct name_component.
  destruct index.
  apply V_eq_dec with (x:= index n1) (y:=index n0).
destruct H0.
right.
rewrite e.
apply in_eq .
left.
induction l1; auto.
destruct H.
rewrite H.
unfold remove.
repeat break_match.
apply beq_nat_true in Heqb.
unfold Component_index in Heqb.
repeat break_match.
rewrite Heqb in n.
contradiction.
simpl.
left.
reflexivity.
unfold remove.
repeat break_match.
trivial.
fold remove.
unfold In.
right.
unfold In in IHl1.
apply IHl1.
unfold In in H.
trivial.
- apply in_or_app.
right.
apply in_cons with (a:=name_component name) in H.
trivial.
Qed.

Lemma allincontrol_queue_messagesreceived_nethandler:
forall me src msg data u dataout st' k,
NetHandler me src msg data = (u, dataout, st') ->
(In k (control_neighbourlist data) -> In k ((queue data ) ++ (messages_received data))) ->
(In k (control_neighbourlist dataout) -> In k ( ( queue dataout ) ++ (messages_received dataout))).
Proof.
intros.
unfold NetHandler in *.
repeat break_match. inversion H.
unfold set_checkeroutput_queue in * .
find_inversion. simpl in *.
apply removeprop with (l1:=queue data) (l2:=messages_received data) (k:=k) (name:=src).

apply H0.
trivial.
intros.
find_inversion.
unfold set_queue_consistent.
simpl in *.
apply removeprop with (l1:=queue data) (l2:=messages_received data) (k:=k) (name:=src).
apply H0.
trivial.
intros.

unfold NetHandler in *.
repeat break_match. inversion H.
unfold set_checkeroutput_queue in * .
find_inversion. apply H0.
trivial.
Qed.

Lemma initialized_false__prop_nethandler_b:
forall me src msg data u dataout st' ,
NetHandler me src msg data = (u, dataout, st') ->
dataout.(initialized_checkerinput) = false ->
data.(initialized_checkerinput) = false.
Proof.
intros.
unfold NetHandler in *.
repeat break_match.
apply andb_true_iff in Heqb. destruct Heqb. unfold set_checkeroutput_queue. find_inversion. simpl in *.
rewrite  H0 in H2. discriminate.
unfold  set_queue_consistent . find_inversion. simpl in *.
apply andb_true_iff in Heqb. destruct Heqb. rewrite H0 in H1. discriminate.
find_inversion. trivial.
Qed.

Lemma initialized_false_network_nethandler:
forall me src msg data u dataout st' ,
NetHandler me src msg data = (u, dataout, st') ->
data.(initialized_checkerinput) = false ->
data.(queue) = data.(control_neighbourlist) ->
dataout.(queue) = dataout.(control_neighbourlist).
Proof.
intros.
assert (G:=H).
unfold NetHandler in *.
repeat break_match.
apply andb_true_iff in Heqb. destruct Heqb. unfold set_checkeroutput_queue. find_inversion. simpl in *. rewrite H0 in H3. discriminate.
apply andb_true_iff in Heqb. destruct Heqb. rewrite H0 in H3. discriminate.
find_inversion. trivial.
Qed.

Lemma initialized_false_network:
forall  net tr ,
step_async_star (params := Checker_MultiParams) step_async_init net tr ->
forall c,
(nwState net (Checker c)).(initialized_checkerinput) = false ->
(nwState net (Checker c)).(queue) = (nwState net (Checker c)).(control_neighbourlist).
Proof.
  intros net tr  H.
  remember step_async_init as y in *.
  induction H using refl_trans_1n_trace_n1_ind. intros. subst. reflexivity.
  invc H0.
  - intros.  destruct p. destruct pDst. unfold nwState in *. unfold update in *. repeat break_match.
  +  unfold net_handlers in *. unfold Checker_MultiParams in *. simpl in *.
     apply initialized_false_network_nethandler in H3. trivial.
     apply initialized_false__prop_nethandler_b with (msg:=pBody) (src:=pSrc) (data:=(nwState (Checker c0))) (me:=(Checker c0)) (dataout:=d) (u:=out) (st':=l) in H3. trivial. trivial.
     concludes. apply IHrefl_trans_1n_trace1  with (c:=c0). apply initialized_false__prop_nethandler_b with (msg:=pBody) (src:=pSrc) (data:=(nwState (Checker c0))) (me:=(Checker c0)) (dataout:=d) (u:=out) (st':=l) in H3. trivial. trivial.
  +  concludes. apply IHrefl_trans_1n_trace1. trivial.
  - intros. destruct h. unfold nwState in *. unfold update in *. repeat break_match.
  *   unfold input_handlers in *. unfold Checker_MultiParams in *. concludes.
  intros.
  unfold InputHandler in *.
  repeat break_match.
  find_inversion. simpl in *. discriminate.
  find_inversion. apply IHrefl_trans_1n_trace1  with (c:=c0). trivial.
   find_inversion. simpl in *.  apply IHrefl_trans_1n_trace1  with (c:=c0). trivial. find_inversion. apply IHrefl_trans_1n_trace1  with (c:=c0). trivial.
 *  apply IHrefl_trans_1n_trace1. trivial. trivial.
Qed.

Lemma messages_received_not_empty_nethandler:
forall  net tr,
step_async_star (params := Checker_MultiParams) step_async_init net tr ->
forall c,
(nwState net (Checker c)).(initialized_checkerinput) = false ->
(nwState net (Checker c)).(queue) = (nwState net (Checker c)).(control_neighbourlist).
Proof.
  intros net tr  H.
  remember step_async_init as y in *.
  induction H using refl_trans_1n_trace_n1_ind. intros. subst. reflexivity.
  invc H0.

  - intros. destruct (pDst p) eqn:?. unfold nwState in *. unfold update in *. repeat break_match.
  +
     unfold net_handlers in *. unfold Checker_MultiParams in *. assert (K:=H3). unfold NetHandler in H3. concludes.
     repeat break_match.
   apply inititialized_nethandler_ in K.  rewrite K in H0. discriminate. trivial.
   apply inititialized_nethandler_ in K.  rewrite K in H0. discriminate. trivial.
     find_inversion. apply IHrefl_trans_1n_trace1.  trivial.
  + apply IHrefl_trans_1n_trace1. trivial. trivial.
   - intros. destruct h. unfold nwState in *. unfold update in *. repeat break_match.

  *   unfold input_handlers in *. unfold Checker_MultiParams in *. concludes.  unfold InputHandler in *.
  repeat break_match.
  find_inversion. simpl in *. discriminate.
  find_inversion. apply IHrefl_trans_1n_trace1  with (c:=c0). trivial.
   find_inversion. simpl in *. trivial.
  find_inversion. apply IHrefl_trans_1n_trace1  with (c:=c0). trivial.
  find_inversion. apply IHrefl_trans_1n_trace1  with (c:=c0). trivial.
 *  apply IHrefl_trans_1n_trace1. trivial. trivial.
Qed.

Lemma messages_received_not_empty_nethandler2:
forall  net tr,
step_async_star (params := Checker_MultiParams) step_async_init net tr ->
forall c,
(nwState net (Checker c)).(initialized_localinput) = false ->
(nwState net (Checker c)).(queue) = (nwState net (Checker c)).(control_neighbourlist).
Proof.
  intros net tr  H.
  remember step_async_init as y in *.
  induction H using refl_trans_1n_trace_n1_ind. intros. subst. reflexivity.
  invc H0.
 - intros. destruct (pDst p) eqn:?. unfold nwState in *. unfold update in *. repeat break_match.
     unfold net_handlers in *. unfold Checker_MultiParams in *. assert (K:=H3). unfold NetHandler in H3. concludes.
     repeat break_match.
     apply inititialized_nethandler_2 in K. rewrite K in H0. discriminate. trivial.
     apply inititialized_nethandler_2 in K.  rewrite K in H0. discriminate. trivial.
         find_inversion. apply IHrefl_trans_1n_trace1.  trivial.
      apply IHrefl_trans_1n_trace1. trivial. trivial.
 -  intros. destruct h. unfold nwState in *. unfold update in *. repeat break_match.
 * unfold input_handlers in *. unfold Checker_MultiParams in *. concludes. unfold InputHandler in *. repeat break_match.
  find_inversion. simpl in *.  apply IHrefl_trans_1n_trace1 with (c:=c0); trivial.
  find_inversion. apply IHrefl_trans_1n_trace1  with (c:=c0). trivial.
  find_inversion.  simpl in *. apply IHrefl_trans_1n_trace1  with (c:=c0). apply eqb_prop in Heqb. discriminate.
  find_inversion. apply IHrefl_trans_1n_trace1  with (c:=c0). trivial.
 *  apply IHrefl_trans_1n_trace1. trivial. trivial.
Qed.

Lemma queue_message_received_equals_controllist:
forall  net tr,
step_async_star (params := Checker_MultiParams) step_async_init net tr ->
forall k c,
In k (nwState net (Checker c)).(control_neighbourlist) ->
In k ( (nwState net (Checker c)).(queue) ++ (nwState net (Checker c)).(messages_received)).
Proof.
intros net tr H.
  remember step_async_init as y in *.
  induction H using refl_trans_1n_trace_n1_ind. intros. subst. unfold step_async_init in *. unfold nwState in *. unfold init_handlers in *. unfold Checker_MultiParams in *. unfold init_Data in *. simpl in *. trivial. rewrite app_nil_r. trivial.
- invc H0.
+ destruct (pDst p) eqn:?.  unfold nwState in *. unfold update in *. intros. repeat break_match.
  unfold net_handlers in *. unfold Checker_MultiParams in *. concludes.
  apply allincontrol_queue_messagesreceived_nethandler with
  (st':=l)(u:=out) (k :=k)(me:= (pDst p)) (src:=(pSrc p)) (msg:= (pBody p) )(data:= (nwState (Checker c)) ) (dataout:=d) in H3.
  trivial.
  apply IHrefl_trans_1n_trace1 with (k:=k) (c:=c).
  simpl in *.
  trivial.
  apply IHrefl_trans_1n_trace1 with (k:=k) (c:=c0); trivial.
+ intros. destruct h. unfold nwState in *. unfold update in *. repeat break_match.
*
  unfold input_handlers in *. unfold Checker_MultiParams in *. concludes.
  intros.
  unfold InputHandler in *.   repeat break_match.  find_inversion. intros. simpl in *. rewrite app_nil_r.
  apply eqb_prop in Heqb.
  apply messages_received_not_empty_nethandler with (c:=c) in H. simpl in *.
  rewrite <- e. rewrite H. rewrite <-  e in H0. trivial. simpl in *. rewrite  e. trivial.
  intros. find_inversion. apply IHrefl_trans_1n_trace1 with (c:=c0). trivial.
  intros. find_inversion. simpl in *.  rewrite app_nil_r.   apply eqb_prop in Heqb.
  apply messages_received_not_empty_nethandler2 with (c:=c0) in H. simpl in *. rewrite H. trivial. simpl in *. trivial.
  find_inversion.  apply IHrefl_trans_1n_trace1 with (c:=c0). trivial. (*apply IHrefl_trans_1n_trace1 with (c:=c0). trivial.*)
* intros.  apply IHrefl_trans_1n_trace1 . trivial. trivial.
Qed.

Lemma queue_empty_message_received_equals_controllist:
forall  net tr,
step_async_star (params := Checker_MultiParams) step_async_init net tr ->
forall k c,
(nwState net (Checker c)).(queue) = [] ->
In k (nwState net (Checker c)).(control_neighbourlist) ->
In k  (nwState net (Checker c)).(messages_received).
Proof.
intros.
apply queue_message_received_equals_controllist with (k:=k) (c:=c) in H.
rewrite  H0 in H.
auto.
trivial.
Qed.

(***************** ALL IN CONTROLL LIST ARE NEIGHBOURS *******************)

Lemma neighbours_controllist_nethandler:
forall me src msg data u dataout st' k,
NetHandler me src msg data = (u, dataout, st') ->
(In k (neighbors g (name_component me) ) ->
In k (control_neighbourlist data))  ->
( In k (neighbors g (name_component me)) ->
In k (control_neighbourlist dataout )).
Proof.
intros.
assert (K:=H).
unfold NetHandler in *.
repeat break_match.
unfold set_checkeroutput_queue in *.
inversion H.
simpl in *.
apply  andb_true_iff in Heqb.
destruct Heqb.
apply H0.
trivial.
inversion H.
simpl in *.
trivial.
unfold set_queue_consistent.
inversion H.
simpl in *.
apply H0.
trivial.
inversion H.
rewrite <- H4.
apply H0.
trivial.
Qed.

Lemma local_input_Inputhandler :
forall me  data u input dataout l,
InputHandler me input data = (u, dataout, l) ->
forall k,
( In k (neighbors g  (name_component me)) ->
In k data.(control_neighbourlist)) ->
(In k (neighbors g  (name_component me)) ->
In k dataout.(control_neighbourlist)).
Proof.
intros.
unfold InputHandler in *.
repeat break_match.
find_inversion; simpl in *.
apply H0;trivial.
find_inversion; simpl in *.  apply H0;trivial.
find_inversion; simpl in *.  apply H0;trivial.
find_inversion; simpl in *.  apply H0;trivial.
Qed.

Lemma neighbours_in_controllist:
forall  net tr ,
step_async_star (params := Checker_MultiParams) step_async_init net tr ->
forall c k,
In k (neighbors g c) ->
In k (nwState net (Checker c)).(control_neighbourlist).
Proof.
intros net tr H.
  remember step_async_init as y in *.
  induction H using refl_trans_1n_trace_n1_ind. intros. subst. unfold initialized in *. unfold step_async_init in *. unfold nwState in *. unfold init_handlers in *. unfold Checker_MultiParams in *. unfold init_Data in *. simpl in *. trivial.
  (*step*)
   invc H0.

  (*NetHandler*)
  +
  intros. destruct (pDst p) eqn:?. unfold nwState in *. unfold update in *. repeat break_match.
 -   unfold net_handlers in *. unfold Checker_MultiParams in *.
     apply neighbours_controllist_nethandler with (k:=k) in H3. trivial. intros. apply IHrefl_trans_1n_trace1. trivial. trivial. rewrite <- e.  unfold name_component. trivial.
  -   apply IHrefl_trans_1n_trace1; trivial.
 (*InputHandler*)
  +   intros. destruct h. unfold nwState in *. unfold update in *. repeat break_match.
  *   unfold input_handlers in *. unfold Checker_MultiParams in *. concludes.   assert (G:=H2). unfold InputHandler in H2.  repeat break_match.

   apply local_input_Inputhandler with (k:=k) in G. trivial.  intros. apply IHrefl_trans_1n_trace1.  inversion e. rewrite <- H5. trivial. rewrite <- e.  unfold name_component. trivial.

    find_inversion.  simpl in *.  apply IHrefl_trans_1n_trace1 . trivial.  inversion e. rewrite <- H3. trivial.
       find_inversion.  simpl in *. inversion e. rewrite <- H3. apply IHrefl_trans_1n_trace1 . trivial.
    find_inversion. simpl in *. rewrite <- e. apply IHrefl_trans_1n_trace1. trivial.
 *  concludes. apply IHrefl_trans_1n_trace1; trivial.
Qed.

(*********************** FINAL THEOREM ***********************************)

Axiom getCertificate_prop:
forall  net c,
certificate (checkerinput (nwState net (Checker c))) =  (getCertificate (name_component (Checker c))).

Lemma Neighbourhood_Consistency_Ver:
forall  net tr,
step_async_star (params := Checker_MultiParams) step_async_init net tr ->
forall c,
(nwState net (Checker c)).(consistent) = true ->
(nwState net (Checker c)).(initialized) = true ->
(nwState net (Checker c)).(queue) = [] ->
neighbourhood_consistent( name_component (Checker c)).
Proof.
intros.
unfold neighbourhood_consistent.
intros.
apply All_Fact_Check_Network  with (component := comp1) (c:=c) in H.
trivial.
rewrite <- getCertificate_prop with (net:=net).
apply H.
apply queue_empty_message_received_equals_controllist with (k:=comp1) (c:=c) in H.
trivial.
trivial.
unfold initialized in H1.
apply  andb_true_iff in H1.
destruct H1.
apply neighbours_in_controllist with (k:=comp1) (c:=c) (tr:=tr) (net:=net) in H3.
trivial.
trivial.
unfold name_component in H3; trivial.
trivial.
apply queue_empty_message_received_equals_controllist with (k:=comp1) (c:=c) (tr:=tr).
trivial.
trivial.
apply neighbours_in_controllist with (k:=comp1) (tr:=tr).
trivial.
trivial.
Qed.

Extraction "Checker_Consistent.ml"  Checker_BaseParams Checker_MultiParams.