(* Proving the correctness of generating RTL from RTLblock *)

Require Import common.
Require Import monad.
Require Import monad_impl.
Require Import Errors.
Require Import RTL.
Require Import RTLblock.
Require Import IR.
Require Import flattenRTL.
Require Import customSmallstep.
Require Import internal_simulations.
Require Import sem_properties.
Require Import backend.
Require Import Globalenvs.
Require Import Values.
Require Import Integers.
Require Import IRtoRTLblock.
Require Import Op.
Require Import Integers.

(** * Simple lemmas *)
Lemma same_id:
  forall rtlb rtl,
    flatten rtlb = OK rtl ->
    prtl_id (Some (inr rtlb)) = prtl_id (Some (inl rtl)).
Proof.
  destruct rtlb as  (((fid, code), entry), ci).
  unfold flatten; intros rtl Hf.
  do_ok.
  destruct p; inv H0.
  reflexivity.
Qed.

Lemma same_cont_idx:
  forall i c e cont_ind i' c' e' cont_ind',
    flatten (i, c, e, cont_ind) = OK (i', c', e', cont_ind') ->
    cont_ind = cont_ind'.
Proof.
  intros i c e cont_ind i' c' e' cont_ind' H. unfold flatten in H.
  repeat do_ok. destruct p. inv H1. auto.
Qed.

Lemma same_entry:
  forall i c e cont_ind i' c' e' cont_ind',
    flatten (i, c, e, cont_ind) = OK (i', c', e', cont_ind') ->
    e = e'.
Proof.
  intros i c e cont_ind i' c' e' cont_ind' H. unfold flatten in H.
  repeat do_ok. destruct p. inv H1. auto.
Qed.

(** * Positive arithmetic  *)
Lemma inv_lt:
  forall p,
    (p < p)%positive -> False.
Proof.
  intros p H. eapply Pos.lt_irrefl. eauto.
Qed.

Lemma inv_succ:
  forall p,
    (Pos.succ p <= p)%positive -> False.
Proof.
  intros p H. rewrite Pos.le_succ_l in H. eapply inv_lt; eauto.
Qed.

Lemma succ_le:
  forall p l,
    (Pos.succ p <= l)%positive ->
    (p <= l)%positive.
Proof.
  intros p l H. eapply Pos.le_trans; eauto. apply Pos.lt_le_incl. apply Pos.lt_succ_diag_r.
Qed.

Lemma succ_le_lt:
  forall p l,
    (Pos.succ p <= l)%positive ->
    (p < l)%positive.
Proof.
  lia.
Qed.

Lemma le_succ:
  forall p l,
    (p <= l)%positive ->
    (p <= Pos.succ l)%positive.
Proof.
  intros p l H. eapply Pos.le_trans; eauto. apply Pos.lt_le_incl. apply Pos.lt_succ_diag_r.
Qed.

Lemma lt_succ:
  forall p l,
    (p < l)%positive ->
    (p < Pos.succ l)%positive.
Proof.
  intros p l H. eapply Pos.lt_trans; eauto. apply Pos.lt_succ_diag_r.
Qed.

Lemma succ_lt:
  forall p l,
    (Pos.succ p < l)%positive ->
    (p < l)%positive.
Proof.
  intros p l H. eapply Pos.lt_trans; eauto. apply Pos.lt_succ_diag_r.
Qed.

Lemma lt_le:
  forall p1 p2,
    (p1 < p2)%positive ->
    (p2 <= p1)%positive ->
    False.
Proof.
  intros p1 p2 H H0. assert (p1 < p1)%positive.
  { eapply Pos.lt_le_trans; eauto. }
  eapply inv_lt; eauto.
Qed.

(** * BLOCK Representation  *)
(* representing that some blocks have been unfolded in the rtl code *)

(* expressing that some list of instructions is in rtlc at label pc, ending on next *)
Inductive unf_list: RTL.code -> list block_instr -> positive -> positive -> Prop :=
| unf_nil: forall rtlc pc,
    unf_list rtlc nil pc pc
| unf_cons: forall rtlc pc next bi l (i:RTL.instruction)
              (TRANSF_INSTR: basic_transf_block_instr bi (Pos.succ pc) = i)
              (FIRST: rtlc # pc = Some i)
              (NEXT: unf_list rtlc l (Pos.succ pc) next),
    unf_list rtlc (bi::l) pc next.

(* Expressing that some basic block is in rtlc at label pc *)
Inductive unf_bb: RTL.code -> basic_block -> positive -> Prop :=
| unf_basic: forall rtlc pc next li exiti e
               (LIST: unf_list rtlc li pc next)
               (TRANSF_EXIT: basic_transf_exit_instr exiti = e)
               (EXIT: rtlc # next = Some e),
    unf_bb rtlc (li, exiti) pc.

(* Expressing that some block is in rtlc at label pc *)
Inductive unf_block: RTL.code -> RTLblock.block -> positive -> Prop :=
| unf_bblock: forall rtlc pc bb next
                (BB: unf_bb rtlc bb next)
                (NOP: rtlc # pc = Some (Inop next)),
    unf_block rtlc (Bblock bb) pc
| unf_cblock: forall rtlc pc op args iftrue bb next
                (BB: unf_bb rtlc bb (Pos.succ next))
                (EVAL: rtlc # pc = Some (Iop op args guard_reg next))
                (COND: rtlc # next = Some (Icond (Ccompimm Ceq Int.zero) (guard_reg::nil) (Pos.succ next) iftrue)),
    unf_block rtlc (Cblock op args iftrue bb) pc.

(** * Code Generation Invariants  *)
(* Everything above the fresh label is undefined *)
Definition fresh (fsh:positive) (rtlc:RTL.code) :=
  forall l, (fsh <= l)%positive -> rtlc # l = None.

(* basic inclusion, for what's above the fresh label *)
Definition included (rtlc1 rtlc2:RTL.code) :=
  forall pc i, rtlc1 # pc = Some i -> rtlc2 # pc = Some i.

(* preservation of what's under the fresh label *)
Definition preserved (rtlc1 rtlc2:RTL.code) (fsh:positive) :=
  forall x, (x < fsh)%positive -> rtlc1 # x = rtlc2 # x.

(* When doing the PTree.fold, everything under fresh is set 1 by 1, only changing the current pc *)
Definition preserved_but (rtlc1 rtlc2:RTL.code) (fsh pc:positive) :=
  forall x, (x < fsh)%positive ->
       x <> pc ->
       rtlc1 # x = rtlc2 # x.

(* invariants lemmas *)
Lemma preserved_refl:
  forall r f,
    preserved r r f.
Proof.
  unfold preserved. intros r f x H. auto.
Qed.

Lemma unf_list_set:
  forall rtlc li pc next pcset i,
    unf_list rtlc li pc next ->
    fresh pcset rtlc ->
    unf_list (rtlc # pcset <- i) li pc next.
Proof.
  intros rtlc li pc next pcset i H H0. induction H.
  - constructor.
  - econstructor; eauto. rewrite PTree.gso; auto.
    intros EQ. subst. specialize (H0 _ (Pos.le_refl pcset)). rewrite FIRST in H0. inv H0.
Qed.

Lemma included_refl:
  forall rtlc, included rtlc rtlc.
Proof.
  unfold included. intros rtlc pc i H. auto.
Qed.

Lemma included_trans:
  forall r1 r2 r3,
    included r1 r2 -> included r2 r3 -> included r1 r3.
Proof.
  unfold included. intros r1 r2 r3 H H0 pc i H1. eapply H0. eapply H. auto.
Qed.

Lemma included_set:
  forall pc r i,
    fresh pc r ->
    included r (r # pc <- i).
Proof.
  unfold included, fresh. intros pc r i H pc0 i0 H0. rewrite PTree.gso. auto.
  intros EQ. subst. specialize (H _ (Pos.le_refl pc)). rewrite H in H0. inv H0.
Qed.

Lemma unf_list_inc:
  forall r1 li pc next r2,
    included r1 r2 ->
    unf_list r1 li pc next ->
    unf_list r2 li pc next.
Proof.
  intros r1 li pc next r2 H H0. induction H0.
  - constructor.
  - econstructor; eauto.
Qed.

Lemma unf_bb_inc:
  forall r1 bb pc r2,
    included r1 r2 ->
    unf_bb r1 bb pc ->
    unf_bb r2 bb pc.
Proof.
  intros r1 bb pc r2 H H0. inv H0. econstructor; eauto.
  eapply unf_list_inc; eauto.
Qed.

Lemma unf_block_inc:
  forall r1 b pc r2,
    included r1 r2 ->
    unf_block r1 b pc ->
    unf_block r2 b pc.
Proof.
  intros r1 b pc r2 H H0. inv H0.
  - econstructor; eauto. eapply unf_bb_inc; eauto.
  - econstructor; eauto. eapply unf_bb_inc; eauto.
Qed.

(** * Initial correctness of the transformations  *)
Lemma tbb_init_ok:
  forall r1 bb r2,
    transf_basic_block r1 bb = OK r2 ->
    exists rtlc1 pc, r1 = OK (rtlc1, pc).
Proof.
  intros r1 bb r2 H. unfold transf_basic_block in H. destruct bb.
  generalize dependent r1. induction l; intros.
  - inv H. unfold transf_exit_instr in H1. repeat do_ok. destruct p. inv H0. eauto.
  - simpl in H. apply IHl in H as [rtlc1 [pc H]]. unfold transf_block_instr in H. repeat do_ok.
    destruct p. inv H1. eauto.
Qed.

Lemma tei_init_ok:
  forall r1 ei r2,
    transf_exit_instr r1 ei = OK r2 ->
    exists rtlc1 pc, r1 = OK (rtlc1, pc).
Proof.
  intros r1 ei r2 H. unfold transf_exit_instr in H. repeat do_ok. destruct p. inv H1. eauto.
Qed.

Lemma tb_init_ok:
  forall r1 pc b r2,
    transf_block r1 pc b = OK r2 ->
    exists rtlc1 pc, r1 = OK (rtlc1, pc).
Proof.
  intros r1 pc b r2 H. unfold transf_block in H. destruct b.
  - repeat do_ok. destruct p. apply tbb_init_ok in H1 as H'. destruct H' as [r1 [l INIT]].
    inv INIT. eauto.
  - repeat do_ok. destruct p. apply tbb_init_ok in H1 as H'. destruct H' as [r1 [l' INIT]].
    inv INIT. eauto.
Qed.

Lemma fold_left_init_ok:
  forall l r1 r2,
    fold_left (fun a p => transf_block a (fst p) (snd p)) l r1 = OK (r2) ->
    exists rtlc1 pc, r1 = OK (rtlc1, pc).
Proof.
  intros l. induction l; intros.
  - simpl in H. inv H. destruct r2. eauto.
  - simpl in H. apply IHl in H as H'. destruct H' as [rtlc1 [p1 INIT]].
    apply tb_init_ok in INIT as H'. destruct H' as [rtlc' [p' INIT']]. eauto.
Qed.

(** * Incremental specifications of the transformations  *)
Lemma list_fold_ok:
  forall li rtlc1 fsh rtlc2 next,
    fold_left transf_block_instr li (OK (rtlc1, fsh)) = OK (rtlc2, next) ->
    fresh fsh rtlc1 ->
    fresh next rtlc2 /\
    (fsh <= next)%positive /\
    included rtlc1 rtlc2 /\
    preserved rtlc1 rtlc2 fsh /\
    unf_list rtlc2 li fsh next.
Proof.
  intros li. induction li; intros.
  - simpl in H. inv H. split; auto. split. apply Pos.le_refl. split.
    apply included_refl. split. apply preserved_refl. constructor.
  - simpl in H. apply IHli in H as H'. destruct H' as [FRESH [LT [INCL [PRES UNF]]]].
    + repeat try split; auto.
      * apply succ_le. auto.
      * eapply included_trans; eauto. apply included_set; auto.
      * unfold preserved in *. intros x H1. apply lt_succ in H1 as H2. apply PRES in H2.
        rewrite PTree.gso in H2. 2: { intros EQ. subst. eapply inv_lt. eauto. } auto.
      * econstructor; eauto. apply INCL. rewrite PTree.gss. auto.
    + unfold fresh. intros l H1. rewrite PTree.gso.
      2: { intros EQ. subst. eapply inv_succ; eauto. }
      apply H0. apply succ_le. auto.
Qed.

Lemma tbb_ok:
  forall rtlc1 fsh rtlc2 next bb,
    transf_basic_block (OK (rtlc1, fsh)) bb = OK (rtlc2, next) ->
    fresh fsh rtlc1 ->
    fresh next rtlc2 /\
    (fsh <= next)%positive /\
    included rtlc1 rtlc2 /\
    preserved rtlc1 rtlc2 fsh /\
    unf_bb rtlc2 bb fsh.
Proof.
  intros rtlc1 pc rtlc2 next bb H H0. destruct bb as [li ei]. unfold transf_basic_block in H.
  apply tei_init_ok in H as H'. destruct H' as [rtlc1' [pc' FOLD]]. rewrite FOLD in H.
  apply list_fold_ok in FOLD as H'; auto. destruct H' as [FRESH [LT [INCL [PRES UNF]]]].
  unfold transf_exit_instr in H. repeat do_ok. inv HDO. inv H2. repeat try split; auto.
  - unfold fresh. intros l H. rewrite PTree.gso; auto.
    + apply FRESH. apply succ_le. auto.
    + intros EQ. subst. eapply inv_succ; eauto.
  - apply le_succ. auto.
  - eapply included_trans; eauto. apply included_set; auto.
  - unfold preserved in *. intros x H. apply PRES in H as H'.
    rewrite PTree.gso; auto. intros EQ. subst. eapply lt_le; eauto.
  - eapply unf_basic with (next:=pc'); eauto.
    + apply unf_list_set; auto.
    + rewrite PTree.gss. auto.
Qed.

Lemma tb_ok:
  forall rtlc1 fsh pc rtlc2 next b,
    transf_block (OK (rtlc1, fsh)) pc b = OK (rtlc2, next) ->
    fresh fsh rtlc1 ->
    (pc < fsh)%positive ->
    rtlc1 # pc = None ->
    fresh next rtlc2 /\
    (fsh <= next)%positive /\
    included rtlc1 rtlc2 /\
    preserved_but rtlc1 rtlc2 fsh pc /\
    unf_block rtlc2 b pc.
Proof.
  intros rtlc1 fsh pc rtlc2 next b H H0 H1 H2. destruct b.
  - apply tbb_ok in H as H'. destruct H' as [FRESH [LT [INCL [PRES UNF]]]].
    2: { unfold fresh; intros. rewrite PTree.gso. apply H0. auto.
         intros EQ. subst. eapply lt_le; eauto. }
    repeat try split; auto.
    + eapply included_trans; eauto. unfold included.
      intros pc0 i H3. rewrite PTree.gso; auto. intros EQ. subst. rewrite H2 in H3. inv H3.
    + unfold preserved_but. intros x H3 H4. apply PRES in H3 as H'. rewrite PTree.gso in H'; auto.
    + eapply unf_bblock; eauto. apply INCL. rewrite PTree.gss. auto.
  - apply tbb_ok in H as H'. destruct H' as [FRESH [LT [INCL [PRES UNF]]]].
    2: { unfold fresh; intros. apply succ_le_lt in H3.
         rewrite PTree.gso; try lia. rewrite PTree.gso; try lia. apply H0. lia. }
    repeat try split; auto.
    + lia.
    + eapply included_trans; eauto. unfold included.
      intros pc0 i H3.
      rewrite PTree.gso. 2: { intros EQ. subst. rewrite H0 in H3. inv H3. lia. }
      rewrite PTree.gso. 2: { intros EQ. subst. rewrite H3 in H2. inv H2. }
      auto.
    + unfold preserved_but. intros x H3 H4. assert ((x < Pos.succ fsh)%positive) by lia.
      apply PRES in H5 as H'.
      rewrite PTree.gso in H' by lia. rewrite PTree.gso in H' by lia. auto.
    + eapply unf_cblock; eauto.
      * apply INCL. rewrite PTree.gso by lia. rewrite PTree.gss. auto.
      * apply INCL. rewrite PTree.gss. auto.
Qed.

Lemma flatten_fold_ok:
  forall l rtlc1 rtlc2 fsh next,
    list_norepet (map fst l) ->
    fold_left (fun a p => transf_block a (fst p) (snd p)) l (OK (rtlc1, fsh)) = OK (rtlc2, next) ->
    fresh fsh rtlc1 ->
    (forall x, In x (map fst l) -> (x < fsh)%positive) ->
    (forall x, In x (map fst l) -> rtlc1 # x = None) ->
    fresh next rtlc2 /\
    (fsh <= next)%positive /\
    included rtlc1 rtlc2 /\
    forall pc blk, In (pc, blk) l -> unf_block rtlc2 blk pc.
Proof.
  intros l. induction l; intros.
  - simpl in H0. inv H0. split; try split; try split; auto.
    + apply Pos.le_refl.
    + apply included_refl.
    + intros pc blk H0. inv H0.
  - inv H. destruct a as [pc blk]. simpl in *.
    apply fold_left_init_ok in H0 as H'. destruct H' as [rtlc' [fsh' INIT]].
    apply tb_ok in INIT as H'; auto. destruct H' as [FRESH [LT [INCL [PRES UNF]]]].
    rewrite INIT in H0. apply IHl in H0 as H'; auto. destruct H' as [FRESH' [LT' [INCL' UNF']]].
    2: { intros x H. eapply Pos.lt_le_trans; eauto. }
    2: { intros y H. rewrite <- PRES; auto. intros EQ. subst. apply H6. apply H. }
    split; try split; try split; auto.
    + eapply Pos.le_trans; eauto.
    + eapply included_trans; eauto.
    + intros pc0 blk0 H. destruct H.
      * inv H. eapply unf_block_inc; eauto.
      * apply UNF'. auto.
Qed.

Lemma in_map:
  forall X Y l (x:X),
    In x (map fst l) ->
    exists (y:Y), In (x,y) l.
Proof.
  intros X Y l x H. induction l; inv H.
  - destruct a. exists y. simpl. left. auto.
  - apply IHl in H0. destruct H0. exists x0. simpl. right. auto.
Qed.

(** * Final code preservation theorem  *)
Lemma flatten_ok:
  forall id entry cont blkc rtlc pc blk,
    flatten (id, blkc, entry, cont) = OK (id, rtlc, entry, cont) ->
    blkc # pc = Some blk ->
    unf_block rtlc blk pc.
Proof.
  intros id entry cont blkc rtlc pc blk H H0. unfold flatten in H. repeat do_ok.
  rewrite PTree.fold_spec in HDO. destruct p as [blkc' next]. inv H2.
  apply flatten_fold_ok in HDO as H'. destruct H' as [FRESH [LT [INCL BLK]]].
  - apply BLK. apply PTree.elements_correct. auto.
  - apply PTree.elements_keys_norepet.
  - unfold fresh. intros. rewrite PTree.gempty. auto.
  - intros. unfold fresh_label, max_label.
    apply in_map in H. destruct H as [y IN].
    apply PTree.elements_complete in IN.
    apply max_pos_correct in IN.
    eapply Pos.le_lt_trans; eauto. apply Pos.lt_succ_diag_r.
  - intros x H. rewrite PTree.gempty. auto.
Qed.

(** * Simulation Invariant, order, index  *)

Definition match_states_is_refl (s:synchro_state) : Prop :=
  match s with
  | Halt_RTL _ _ | Halt_Block _ => False
  | _ => True
  end.

(* The index holds the current entry  *)
(* This can be the entry point of a continuation, so it changes along the simulation *)
(* We also include a boolean for the stuttering step of the Cblock *)

Inductive stutter : Type :=
| ONE: stutter
| ZERO: stutter.
Definition index : Type := (positive * stutter).

Inductive order: index -> index -> Prop :=
| stut: forall i,
    order (i, ZERO) (i, ONE).

Lemma order_wf:
  well_founded order.
Proof.
  unfold well_founded. intros a. constructor. intros y H. inv H. constructor. intros y H. inv H.
Qed.

Inductive match_states (p:program) (rtlc:RTL.code): index -> mixed_sem.mixed_state -> mixed_sem.mixed_state -> Prop :=
| ms_refl s m entry: match_states_is_refl s -> match_states p rtlc (entry,ONE) (s, m) (s,m)
| ms_block f stk pc mrtl ge m lbi exb rs next entry
    (GE: ge = Globalenvs.Genv.globalenv (make_prog rtlc entry))
    (FUN: f = make_fun rtlc entry)
    (UNF: unf_list rtlc lbi pc next)
    (EXIT: rtlc # next = Some (basic_transf_exit_instr exb)):
  match_states p rtlc (entry, ONE) (Halt_Block (BState (Bblock (lbi, exb)) rs), m)
                                   (Halt_RTL ge (State nil f (Vptr stk Ptrofs.zero) pc rs mrtl), m)
| ms_cblock f stk pc mrtl ge m rs next entry deoptbb cond args iftrue
    (GE: ge = Globalenvs.Genv.globalenv (make_prog rtlc entry))
    (FUN: f = make_fun rtlc entry)
    (COND: rtlc # next = Some (Icond (Ccompimm Ceq Int.zero) [guard_reg] (Pos.succ next) iftrue))
    (EVAL: rtlc # pc = Some (Iop cond args guard_reg next))
    (UNF: unf_bb rtlc deoptbb (Pos.succ next)):
    match_states p rtlc (entry, ZERO) (Halt_Block (BState (Cblock cond args iftrue deoptbb) rs), m)
                                      (Halt_RTL ge (State nil f (Vptr stk Ptrofs.zero) pc rs mrtl), m)
| ms_bpf f stk pc mrtl ge m rs entry
  (GE: ge = Globalenvs.Genv.globalenv (make_prog rtlc entry))
  (FUN: f = make_fun rtlc entry):
  match_states p rtlc (entry, ONE)  (Halt_Block (BPF pc rs), m)
                                    (Halt_RTL ge (State nil f (Vptr stk Ptrofs.zero) pc rs mrtl), m)
| ms_final r mrtl ge m entry
  (GE: ge = Globalenvs.Genv.globalenv (make_prog rtlc entry)):
  match_states p rtlc (entry, ONE) (Halt_Block (BFinal r), m)
                                   (Halt_RTL ge (Returnstate nil (Vint r) mrtl), m).

Require Import mixed_sem.

Lemma simul_one_step_is_sufficient :
  forall L,
  forall Order:Prop,
  forall match_states: state L -> state L -> Prop,
  forall s t s0,
    (exists s', (Step L s t s' /\ match_states s0 s')) ->
    exists s',
      (SPlus L s t s' \/ (Star L s t s' /\ Order)) /\ match_states s0 s'.
Proof.
  intros L Order ms s t s0 (s', (T1, T2)).
  exists s'; split; auto.
  left.
  constructor 1 with t s' nil; simpl; eauto.
  - constructor 1.
  - unfold Events.Eapp.
    rewrite app_nil_r.
    reflexivity.
Qed.

Ltac inv_not_true:=
  match goal with
  | [H: ~ True |- _] => exfalso; apply H; auto
  end.

(** * Axiomatization of existing initial states for the functions we generate *)
(* There exists an initial memory where the globals (the JIT primitive and the main function) have been *)
(* installed. In practice, this is not in the memory handled by CompCert, but CompCert has no view of *)
(* the external memory *)
Axiom external_in_memory:
  forall rtlc entry,
  exists initm,
    Genv.alloc_globals (Genv.globalenv (make_prog rtlc entry)) Memory.Mem.empty
                       (AST.prog_defs (make_prog rtlc entry)) = Some initm.

Lemma initial_rtl_exists:
  forall rtlc entry,
    exists r, RTL.initial_state (backend.make_prog rtlc entry) r.
Proof.
  intros rtlc entry.
  specialize (external_in_memory rtlc entry) as [initm INITMEM].
  econstructor. eapply initial_state_intro with (b:=backend.main_id) (m0:=initm); unfold backend.make_prog; simpl.
  - unfold Globalenvs.Genv.init_mem. auto.
  - unfold Globalenvs.Genv.find_symbol. simpl. eauto.
  - unfold Globalenvs.Genv.find_funct_ptr. simpl. eauto.
  - simpl. auto.
Qed.

Lemma block_eval_condition_exists_eval_condition mrtl c args b:
  block_eval_condition c args = Some b ->
  Op.eval_condition c args mrtl = Some b.
Proof.
  unfold block_eval_condition.
  destruct c; try congruence;
    repeat (destruct args; try congruence);
    simpl; auto.
Qed.

(** *  Globalenv lemmas *)
Lemma find_ex_prim:
  forall rtlc entry prim rs,
    find_function (Globalenvs.Genv.globalenv (make_prog rtlc entry)) (inr (primitives.EF_ident prim)) rs
    = Some (AST.External (AST.EF_runtime (primitives.EF_name prim) (primitives.EF_sig prim))).
Proof.
  intros rtlc entry prim rs.
  unfold make_prog, Globalenvs.Genv.globalenv. simpl.
  unfold Genv.find_symbol. unfold Genv.genv_symb, Genv.find_funct_ptr. simpl.
  destruct prim; simpl; eauto.
Qed.

Lemma find_main:
  forall rtlc entry b f,
    Genv.find_symbol (Genv.globalenv (make_prog rtlc entry)) main_id = Some b ->
    Genv.find_funct_ptr (Genv.globalenv (make_prog rtlc entry)) b = Some f ->
    f = AST.Internal (make_fun rtlc entry).
Proof.
  unfold make_prog. intros rtlc entry b f H H0.
  unfold Genv.find_symbol, Genv.genv_symb, Genv.globalenv in H.
  simpl in H. inv H.
  unfold Genv.find_funct_ptr, Genv.find_def, Genv.globalenv in H0. simpl in H0. inv H0. auto.
Qed.

(* Freeing of size 0 *)
Lemma free_0:
  forall m stk, exists m',
    Memory.Mem.free m stk 0 0 = Some m'.
Proof.
  intros m stk. Transparent Memory.Mem.free. unfold Memory.Mem.free.
  destruct (Memory.Mem.range_perm_dec m stk 0 0 Memtype.Cur Memtype.Freeable) eqn:FREE.
  - unfold Memory.Mem.unchecked_free. destruct m. simpl.  eauto.
  - unfold Memory.Mem.range_perm in n. exfalso. apply n. intros ofs H. inv H. lia.
    Opaque Memory.Mem.free.
Qed.

(** * Forward Simulation  *)
Theorem flatten_forward:
  forall (p:program) (nc:asm_codes) (rtlb:RTLblockfun) (rtl:RTLfun)
    (NO_CONFLICT: ~ rtl_conflict (Some (inr rtlb)) nc) (* nc doesn't contain a function fid *)
    (FLATTEN: flatten rtlb = OK rtl),
    forward_internal_simulation p p (Some (inr rtlb)) (Some (inl rtl)) nc nc AnchorOff AnchorOff.
Proof.
  intros p nc rtlb rtl; intros.
  destruct rtl as [[[rtlfid rtlc] rtlentry] rtlcont].
  destruct rtlb as [[[fid blockc] entry] cont].
  assert (rtlfid = fid). { apply same_id in FLATTEN. inv FLATTEN. auto. } subst rtlfid.
  apply same_cont_idx in FLATTEN as SAME. subst rtlcont.
  apply same_entry in FLATTEN as SAME. subst rtlentry.

  eapply Forward_internal_simulation with (fsim_match_states:=match_states p rtlc) (fsim_order := order).
  - apply order_wf.
  - unfold call_refl, p_reflexive. intros s H.
    exists (entry, ONE). destruct s. eapply ms_refl. inv H. constructor.
  - intros p0 s1 s2 r Hm Hf1.
    inv Hm; auto; inv Hf1.
  -
{ intros s1 t s1' STEP i s2 MATCH. inv MATCH.
  - destruct s1' as (s', m').
      assert (M:match_states_is_refl s' \/ ~ match_states_is_refl s').
      { destruct s'; simpl; intuition. }
      destruct M.
    + exists (xH, ONE). apply simul_one_step_is_sufficient. exists (s', m').
        split; [idtac | econstructor 1; eauto].
        inv STEP; try (elim H; fail); try (elim H0; fail); econstructor; eauto.
    + inv STEP; try solve[inv H]; simpl in H0; try inv_not_true; try inv RTL.
        (* interpreter can't produce RTL states *)
        { unfold IRinterpreter.ir_step in STEP0. rewrite exec_bind2 in STEP0. simpl in STEP0.
          repeat sdo_ok. destruct p0. destruct i; simpl in H0; try inv_not_true.
          destruct c; simpl in H0; try inv_not_true. }
        (* ASM can't produce RTL states *)
        { unfold ASMinterpreter.asm_int_step in STEP0. rewrite exec_bind2 in STEP0. simpl in STEP0.
          repeat sdo_ok. destruct p0. destruct i; simpl in STEP0; repeat sdo_ok; simpl in H0; try inv_not_true.
          destruct c; simpl in H0; try inv_not_true. }
      * inv RTL_BLOCK.  (* calling RTLBLOCK *)
        exists (entry1, ONE).
        specialize (initial_rtl_exists rtlc entry1) as [inits INIT].
        { inv INIT.
          apply find_main in H3 as MAIN; auto. subst f.
          destruct (Memory.Mem.alloc m0 0 0) as [m0' stk] eqn:E.
          (* Going into the entry program *)
          econstructor; esplit.
          - left. simpl. eapply plus_two.
            + eapply Call_RTL; eauto. econstructor; eauto.
            + eapply rtl_step; eauto.
              * intro T; inv T.
              * eapply exec_function_internal; eauto.
            + reflexivity.
          - simpl. constructor; auto. }
      * inv RTL_BLOCK. (* returning to RTLBLOCK *)
        specialize (initial_rtl_exists rtlc cont_entry) as [inits INIT].
        { inv INIT.
          apply find_main in H3 as MAIN; auto. subst f.
          destruct (Memory.Mem.alloc m0 0 0) as [m0' stk] eqn:E .
          exists (cont_entry, ONE).      (* going into continuation *)
          econstructor; esplit.
          - left. simpl. eapply plus_two.
            + eapply Return_RTL; eauto. econstructor; eauto.
               + eapply rtl_step; eauto.
                 * intro T; inv T.
                 * eapply exec_function_internal; eauto.
               + reflexivity.
          - simpl. constructor; auto. }

  - inv STEP.                   (* ms_block *)
    destruct lbi.
    + inv UNF.                  (* exit instruction *)
      simpl in BLOCK. exists (entry0, ONE). destruct exb.
      * inv BLOCK. econstructor. split. (* nop *)
        ** left. apply plus_one. econstructor.
           { intros H. inv H. simpl in BUILTIN. rewrite BUILTIN in EXIT. inv EXIT. }
           eapply exec_Inop. simpl. eauto.
        ** constructor; auto.
      * repeat sdo_ok. econstructor. split. (* cond *)
        ** left. apply plus_one. econstructor.
           { intros H. inv H. simpl in BUILTIN. rewrite BUILTIN in EXIT. inv EXIT. }
           eapply exec_Icond; eauto. apply eval_condition_correct. eauto.
        ** constructor; auto.
      * assert (HMEM: exists m',  Memory.Mem.free mrtl stk 0 0 = Some m') by apply free_0.
        destruct HMEM as [m' HMEM]. repeat sdo_ok.
        unfold get_int_reg in HDO0. destruct (rs !! r) eqn:GET; inv HDO0.
        repeat sdo_ok. econstructor. split. (* return *)
        ** left. apply plus_one. econstructor.
           { intros H. inv H. simpl in BUILTIN. rewrite BUILTIN in EXIT. inv EXIT. }
           eapply exec_Ireturn; eauto.
        ** unfold Registers.regmap_optget. rewrite GET. constructor. auto.

    + inv UNF.                  (* peeling off one instruction of the block *)
      simpl in BLOCK. repeat sdo_ok. destruct b; simpl in FIRST; simpl in HDO.
      * repeat sdo_ok. eapply eval_operation_correct in HDO. (* Op *)
        exists (entry0, ONE). econstructor. split.
        ** left. apply plus_one. simpl. econstructor.
           { intros H. inv H. simpl in BUILTIN. rewrite BUILTIN in FIRST. inv FIRST. }
           eapply exec_Iop; eauto.
        ** simpl. eapply ms_block; eauto.
      * assert (A: find_function (Globalenvs.Genv.globalenv (make_prog rtlc entry0)) (inr (primitives.EF_ident e)) rs = Some (AST.External (AST.EF_runtime (primitives.EF_name e) (primitives.EF_sig e))) ).
        { apply find_ex_prim. }
        repeat sdo_ok. destruct p1. exists (entry0, ONE). econstructor. split. (* prim call *)
        ** left. eapply plus_three.
           *** eapply rtl_step.
               { intros H. inv H. simpl in BUILTIN. rewrite BUILTIN in FIRST. inv FIRST. }
               eapply exec_Icall; eauto.
           *** eapply RTL_prim. eapply HDO0.
           *** eapply rtl_step.
               { intros H. inv H. }
               eapply exec_return.
           *** simpl. rewrite Events.E0_right. auto.
        ** simpl. eapply ms_block; eauto.

  - exists (entry0, ONE). inv UNF. inv STEP. (* ms_cblock *)
    simpl in BLOCK. repeat sdo_ok.
    eapply eval_operation_correct in HDO0; eauto.
    destruct b.
    + inv BLOCK. econstructor. split.
      * left. eapply plus_two with (t1:=nil) (t2:=nil); auto.
        { eapply rtl_step.
          { intros H. inv H. simpl in BUILTIN. rewrite BUILTIN in EVAL. inv EVAL. }
          eapply exec_Iop; eauto. }
        eapply rtl_step.
        { intros H. inv H. simpl in BUILTIN. rewrite BUILTIN in COND. inv COND. }
        eapply exec_Icond; eauto. simpl. rewrite Registers.Regmap.gss. apply HDO1.
      * simpl. eapply ms_block; eauto.
    + inv BLOCK. econstructor. split.
      * left. eapply plus_two with (t1:=nil) (t2:=nil); auto.
        { eapply rtl_step.
          { intros H. inv H. simpl in BUILTIN. rewrite BUILTIN in EVAL. inv EVAL. }
          eapply exec_Iop; eauto. }
        eapply rtl_step.
        { intros H. inv H. simpl in BUILTIN. rewrite BUILTIN in COND. inv COND. }
        eapply exec_Icond; eauto. simpl. rewrite Registers.Regmap.gss. apply HDO1.
      * eapply ms_bpf; eauto.

  - inv STEP.                   (* ms_bpf *)
    simpl in BLOCK. repeat sdo_ok.
    eapply flatten_ok in FLATTEN as H; eauto. inv H.
    + exists (entry0, ONE). econstructor. split.      (* going into Bblock *)
      * left. apply plus_one. apply rtl_step.
        { intros H. inv H. simpl in BUILTIN. rewrite BUILTIN in NOP. inv NOP. }
        eapply exec_Inop; eauto.
      * destruct bb. inv BB. eapply ms_block; eauto.
    + exists (entry0, ZERO). inv BB. econstructor. split.      (* going into Cblock *)
      * right. split. 2: { apply stut. } eapply star_refl. (* stuttering *)
      * eapply ms_cblock; eauto. econstructor; eauto.

  - inv STEP.                   (* ms_final *)
    { simpl in BLOCK. inv BLOCK. }
    exists (entry0, ONE). econstructor. split.
    + left. eapply plus_one.
      eapply RTL_end; eauto. constructor.
    + apply ms_refl. destruct cp; simpl; auto. }
Qed.

Theorem flatten_correct:
  forall (p:program) (nc:asm_codes) (rtlb:RTLblockfun) (rtl:RTLfun)
    (NO_CONFLICT: ~ rtl_conflict (Some (inr rtlb)) nc)
    (FLATTEN: flatten rtlb = OK rtl),
    backward_internal_simulation p p (Some (inr rtlb)) (Some (inl rtl)) nc nc AnchorOff AnchorOff.
Proof.
  intros p nc rtlb rtl NO_CONFLICT FLATTEN.
  apply forward_to_backward_simulation.
  - apply flatten_forward; auto.
  - apply mixed_receptive.
  - apply mixed_determinate. unfold not. intros H.
    apply NO_CONFLICT. inv H. apply same_id in FLATTEN. destruct rtlb as [[[fid' blk] ent] cont].
    simpl in FLATTEN. inv FLATTEN. eapply conflict; eauto.
Qed.

(** * We show here that we only produce a subset of RTL *)
Require Import primitives.
Require Import Errors.

Inductive rtl_instr_wf : RTL.instruction -> Prop :=
(* no load, no store, no builtin, no jumptable *)
| inop_wf: forall n, rtl_instr_wf (Inop n)
| iop_wf: forall o l r n, rtl_instr_wf (Iop o l r n)
| icond_wf: forall o l n1 n2, rtl_instr_wf (Icond o l n1 n2)
(* calls are limited to primitives *)
| icall_wf: forall (ef:ext_primitive) l r n,
    rtl_instr_wf (Icall (EF_sig ef) (inr (EF_ident ef)) l r n)
| ireturn_wf: forall r, rtl_instr_wf (Ireturn (Some r)).

Definition rtl_code_wf (c:RTL.code): Prop :=
  forall pc i, c#pc = Some i -> rtl_instr_wf i.

Lemma fold_ok:
  forall l cf1 c2 n,
    fold_left (fun a p => transf_block a (fst p) (snd p)) l cf1 = OK (c2, n) ->
    exists cf, cf1 = OK (cf).
Proof.
  intros l. induction l; intros.
  - simpl in H. inv H. eauto.
  - simpl in H. apply IHl in H. destruct H as [cf OK].
    destruct cf1; eauto.
    unfold transf_block in OK. destruct a as [na [b1 | b2]];  inv OK.
Qed.

Lemma transf_basic_ok:
  forall b c1 f1 c2 f2,
    transf_basic_block (OK (c1, f1)) b = OK (c2, f2) ->
    rtl_code_wf c1 ->
    rtl_code_wf c2.
Proof.
  intros [l e]. induction l; intros.
  - simpl in H. inv H. unfold rtl_code_wf in *. unfold basic_transf_exit_instr. destruct e; intros.
    + poseq_destr pc f1.
      * rewrite PTree.gss in H. inv H. constructor.
      * rewrite PTree.gso in H; auto. apply H0 in H. auto.
    + poseq_destr pc f1.
      * rewrite PTree.gss in H. inv H. constructor.
      * rewrite PTree.gso in H; auto. apply H0 in H. auto.
    + poseq_destr pc f1.
      * rewrite PTree.gss in H. inv H. constructor.
      * rewrite PTree.gso in H; auto. apply H0 in H. auto.
  - simpl in H. eapply IHl in H; eauto. unfold rtl_code_wf in *. destruct a; intros.
    + poseq_destr pc f1.
      * rewrite PTree.gss in H1. inv H1. constructor.
      * rewrite PTree.gso in H1; auto. apply H0 in H1. auto.
    + poseq_destr pc f1.
      * rewrite PTree.gss in H1. inv H1. constructor.
      * rewrite PTree.gso in H1; auto. apply H0 in H1. auto.
Qed.

Lemma transf_block_ok:
  forall c1 f1 l b c2 f2,
    transf_block (OK (c1, f1)) l b = OK (c2, f2) ->
    rtl_code_wf c1 ->
    rtl_code_wf c2.
Proof.
  intros c1 f1 l b c2 f2 H H0. unfold transf_block in H.
  destruct b.
  + repeat do_ok. inv HDO. apply transf_basic_ok in H2; auto. unfold rtl_code_wf in *. intros.
    poseq_destr pc l.
    * rewrite PTree.gss in H. inv H. constructor.
    * rewrite PTree.gso in H; auto. apply H0 in H. auto.
  + repeat do_ok. inv HDO. apply transf_basic_ok in H2; auto. unfold rtl_code_wf in *. intros.
    poseq_destr pc f1.
    * rewrite PTree.gss in H. inv H. constructor.
    * rewrite PTree.gso in H; auto. poseq_destr pc l.
      ** rewrite PTree.gss in H. inv H. constructor.
      ** rewrite PTree.gso in H; auto. apply H0 in H. auto.
Qed.

Theorem flatten_wf:
  forall rtlb fid rtlc entry cont,
    flatten rtlb = OK (fid, rtlc, entry, cont) ->
    rtl_code_wf rtlc.
Proof.
  assert (forall l fresh c1 c2 n, rtl_code_wf c1 -> fold_left (fun a p => transf_block a (fst p) (snd p)) l (OK (c1, fresh)) = OK (c2, n) -> rtl_code_wf c2).
  { intros l.
    induction l; intros; simpl in H0. { inv H0. auto. }
    apply fold_ok in H0 as OKinit. destruct OKinit as [[c f] OK]. rewrite OK in H0.
    apply IHl in H0; auto.
    destruct a as [label blk]. simpl in OK. apply transf_block_ok in OK; auto. }
  intros [[[f blkc] ent] co] fid rtlc entry cont H1.
  unfold flatten in H1. do_ok. destruct p as [rtlc' n]. inv H2.
  rewrite PTree.fold_spec in HDO. apply H in HDO; auto.
  unfold rtl_code_wf. intros pc i H0. rewrite PTree.gempty in H0. inv H0.
Qed.


Require Import compcert.common.AST.
Require Import compcert.common.Errors.
Require Import compcert.common.Events.
Require Import compcert.common.Globalenvs.
Require Import compcert.common.Memory.
Require Import compcert.common.Smallstep.
Require Import compcert.common.Values.
Require Import compcert.common.Behaviors.
Require Import compcert.lib.Coqlib.
Require Import compcert.lib.Integers.
Require Import compcert.lib.Maps.
Require Import Seccomp.
Require Import Seccompspec.
Require Import Seccompfilter.
Require Import Seccompconf.
Require Import Seccompproof.
Require Import MiscLemmas.
Require Import CpdtTactics.

Lemma list_length_z_exists:
  forall A:Type,
  forall a:A,
  forall x,
  0 <= x ->
  exists l:list A,
  list_length_z l = x.
Proof.
  intros A a.
  apply (natlike_ind (fun x => exists l:list A, list_length_z l = x)).
  - exists nil; crush.
  - intros.  destruct H0.  exists (a::x0).  rewrite list_length_z_cons.  crush.
Qed.

(* CPDT GeneralRec *)
Definition length_order (A:Type) (ls1 ls2: list A) :=
  (length ls1 < length ls2)%nat.

Hint Constructors Acc.

Lemma length_order_wf':
  forall A, forall len, forall ls,
  (length ls <= len -> Acc (length_order A) ls)%nat.
Proof.
  unfold length_order; induction len; crush.
Qed.

Lemma length_order_wf:
  forall A, well_founded (length_order A).
Proof.
  intro; red; intro; eapply length_order_wf'; eauto.
Qed.

Lemma seccomp_func_filter_skipn:
  forall n c,
  true = seccomp_func_filter c ->
  (n < length c)%nat ->
  true = seccomp_func_filter (skipn n c).
Proof.
  intros n c Hbase.
  induction n.
  - crush.
  - intros.
    cut (n < length c)%nat; [ intro | crush ].
    destruct (skipn_more _ n c).  auto.
    rewrite H1 in IHn.
    remember (IHn H0) as Hf.
    destruct x; destruct (skipn (S n) c); inversion Hf; auto;
      repeat rewrite Bool.andb_false_r in *; auto;
      try destruct (Bool.andb_true_eq _ _ H3); auto.

    remember (skipn_last _ _ _ _ H1); crush.
    remember (skipn_last _ _ _ _ H1); crush.
Qed.

Theorem step_terminates:
  forall ge f sm p,
  forall m0 bytes m,
  list_length_z bytes = Seccompconf.sizeof_seccomp_data ->
  Mem.storebytes m0 p 0 (Memdata.inj_bytes bytes) = Some m ->
  forall c x a,
  true = seccomp_func_filter c ->
  exists r,
  star step ge (State a x sm f c p m) E0 (Returnstate r m).
Proof.
  intros ge f sm p m0 pkt m Hbyteslen Hstorebytes.
  induction c using (well_founded_ind (length_order_wf instruction)).
  destruct x.
  crush.
  intros.
  destruct i; simpl in H0;
    repeat (case (Bool.andb_true_eq _ _ H0); clear H0; intros);
    crush.

  Ltac simpl_step_terminates H :=
    edestruct H; unfold length_order; crush;
    econstructor;
    eapply star_step with (t1:=E0) (t2:=E0); [ constructor | idtac | auto ]; eauto.

  - simpl_step_terminates H.

  - simpl_step_terminates H.

  - simpl_step_terminates H.

  (* Sld_w_abs *)
  - rewrite list_length_nat_z in Hbyteslen.
    assert (Int.unsigned i >= 0) as Hipos; [ destruct (Int.unsigned_range i); crush | idtac ].
    assert (nat_of_Z (Int.unsigned i) < length pkt)%nat as Hilen.
    apply Nat2Z.inj_lt.  rewrite nat_of_Z_eq; [ idtac | auto ].
    rewrite <- Hbyteslen in H0.
    destruct (Zlt_is_lt_bool (Int.unsigned i) (Z.of_nat (length pkt))).
    rewrite <- H0 in H4.  crush.

    assert (4 <= length (skipn (nat_of_Z (Int.unsigned i)) pkt))%nat as Hlskip.
    rewrite length_skipn; [ idtac | crush ].
    apply Nat2Z.inj_le.  rewrite Nat2Z.inj_sub; [ idtac | crush ].
    apply mod0_lt_le; [ crush | idtac | idtac | crush ].
    apply Znumtheory.Zmod_divide; [ crush | idtac ].
    rewrite nat_of_Z_max; rewrite Z.max_l; [ idtac | crush ].
    apply Z.eqb_eq.  auto.
    apply Znumtheory.Zmod_divide; [ crush | idtac ].
    rewrite Hbyteslen.  apply sizeof_mul4.

    edestruct H; eauto; unfold length_order; crush.

    destruct (Mem.storebytes_split m0 p 0
              (firstn (nat_of_Z (Int.unsigned i)) (Memdata.inj_bytes pkt))
              (skipn (nat_of_Z (Int.unsigned i)) (Memdata.inj_bytes pkt)) m);
    [ rewrite firstn_skipn; auto | destruct H4 ].
    destruct (Mem.storebytes_split x2 p
              (0 + Z.of_nat (length (firstn (nat_of_Z (Int.unsigned i)) (Memdata.inj_bytes pkt))))
              (firstn 4 (skipn (nat_of_Z (Int.unsigned i)) (Memdata.inj_bytes pkt)))
              (skipn 4 (skipn (nat_of_Z (Int.unsigned i)) (Memdata.inj_bytes pkt))) m);
    [ rewrite firstn_skipn; auto | destruct H6 ].

    remember (Mem.storebytes_store x2 p
              (0 + Z.of_nat (length (firstn (nat_of_Z (Int.unsigned i)) pkt)))
              Mint32
              (Vint (Int.repr (decode_int (firstn 4 (skipn (nat_of_Z (Int.unsigned i)) pkt))))) x3)
    as Hstore.

    econstructor.
    eapply star_step with (t1:=E0) (t2:=E0); [ constructor | idtac | auto ].
    apply Zlt_is_lt_bool; auto.
    apply Z.eqb_eq; auto.
    rewrite (Mem.load_storebytes_other x3 p
             (0 + Z.of_nat (length (firstn (nat_of_Z (Int.unsigned i)) (inj_bytes pkt)))
                + Z.of_nat (length (firstn 4 (skipn (nat_of_Z (Int.unsigned i)) (inj_bytes pkt)))))
             (skipn 4 (skipn (nat_of_Z (Int.unsigned i)) (inj_bytes pkt)))).
    erewrite Mem.load_store_same with (v:=(Vint _)).
    simpl; eauto.

    cut ((0 + Z.of_nat (length (firstn (nat_of_Z (Int.unsigned i)) pkt))) = Int.unsigned i).
    intro Heq_a; rewrite <- Heq_a at 1.
    apply Hstore; clear HeqHstore; clear Hstore.

    rewrite skipn_inj_bytes in H6.
    repeat rewrite firstn_inj_bytes in H6.
    rewrite length_inj_bytes in H6.
    unfold encode_val.

    assert ((encode_int 4 (Int.unsigned (Int.repr (decode_int (firstn 4 (skipn (nat_of_Z (Int.unsigned i)) pkt))))))
      = (firstn 4 (skipn (nat_of_Z (Int.unsigned i)) pkt))).
    apply decode_encode_int_4.
    rewrite firstn_length.  rewrite min_l; crush.

    rewrite H8; auto.

    rewrite firstn_length.  rewrite min_l; [ idtac | crush ].
    rewrite nat_of_Z_max; rewrite Z.max_l; [ idtac | crush ].
    apply Zmod_divide; [ discriminate | apply Z.eqb_eq; auto ].

    rewrite firstn_length.  rewrite min_l; [ idtac | crush ].
    rewrite nat_of_Z_max; rewrite Z.max_l; [ idtac | crush ].
    auto.

    auto.
    right.  left.
    rewrite skipn_inj_bytes; repeat rewrite firstn_inj_bytes; repeat rewrite length_inj_bytes.
    rewrite firstn_length.  rewrite min_l; [ idtac | crush ].
    rewrite nat_of_Z_max; rewrite Z.max_l; [ idtac | crush ].
    rewrite firstn_length.  rewrite min_l; crush.

    apply H3.

  (* Sld_w_len *)
  - simpl_step_terminates H.

  (* Sldx_w_len *)
  - simpl_step_terminates H.

  (* Sld_imm *)
  - simpl_step_terminates H.

  (* Sldx_imm *)
  - simpl_step_terminates H.

  (* Sjmp_ja *)
  - destruct H with (y:=(skipn (nat_of_Z (Int.unsigned i)) x)) (a:=a) (x:=x0).
    unfold length_order.  simpl.  apply Lt.le_lt_n_Sm.  apply length_skipn_lt.
    apply seccomp_func_filter_skipn; auto.
    rewrite list_length_nat_z in H0.  apply Nat2Z.inj_lt.  rewrite nat_of_Z_eq.
    apply Zlt_is_lt_bool.  crush.  destruct (Int.unsigned_range i).  crush.
    econstructor.
    eapply star_step with (t1:=E0) (t2:=E0); [ constructor | idtac | auto ].
    apply Zlt_is_lt_bool; auto.
    apply H2.

  (* Sjmp_jc *)
  - destruct H with (y:=(skipn (nat_of_Z (Byte.unsigned i)) x)) (a:=a) (x:=x0).
    unfold length_order.  simpl.  apply Lt.le_lt_n_Sm.  apply length_skipn_lt.
    apply seccomp_func_filter_skipn; auto.
    rewrite list_length_nat_z in H0.  apply Nat2Z.inj_lt.  rewrite nat_of_Z_eq.
    apply Zlt_is_lt_bool.  crush.  destruct (Byte.unsigned_range i).  crush.
    destruct H with (y:=(skipn (nat_of_Z (Byte.unsigned i0)) x)) (a:=a) (x:=x0).
    unfold length_order.  simpl.  apply Lt.le_lt_n_Sm.  apply length_skipn_lt.
    apply seccomp_func_filter_skipn; auto.
    rewrite list_length_nat_z in H2.  apply Nat2Z.inj_lt.  rewrite nat_of_Z_eq.
    apply Zlt_is_lt_bool.  crush.  destruct (Byte.unsigned_range i0).  crush.
    case_eq (eval_cond c a x0); intros.
    + econstructor.
      eapply star_step with (t1:=E0) (t2:=E0); [ constructor | idtac | auto ].
      apply Zlt_is_lt_bool; crush.
      rewrite H5.  apply H3.
    + econstructor.
      eapply star_step with (t1:=E0) (t2:=E0); [ constructor | idtac | auto ].
      apply Zlt_is_lt_bool; crush.
      rewrite H5.  apply H4.

  (* Smisc_tax *)
  - simpl_step_terminates H.

  (* Smisc_txa *)
  - simpl_step_terminates H.

  - econstructor.
    eapply star_step with (t1:=E0) (t2:=E0); [ constructor | idtac | auto ].
    apply star_refl.

  - econstructor.
    eapply star_step with (t1:=E0) (t2:=E0); [ constructor | idtac | auto ].
    apply star_refl.
Qed.

Theorem seccomp_terminates:
  forall prog,
  true = seccomp_filter prog ->
  exists r,
  program_behaves (Seccompspec.semantics prog) (Terminates E0 r).
Proof.
  intros.
  destruct prog.
  destruct prog_defs; crush.
  destruct p.
  destruct g; [ idtac | crush ].
  destruct f; crush.
  destruct prog_defs ; [ idtac | crush ].

  unfold seccomp_filter in H.  simpl in H.
  destruct (Bool.andb_true_eq _ _ H); auto.
  clear H.
  cut (i=prog_main); [ intros; inv H | apply Peqb_true_eq; auto ].
  clear H0.

  (* introduce some symbols early on, to help with existential variables *)
  case_eq (Mem.alloc Mem.empty 0 1); intros.
  destruct (Mem.range_perm_drop_2 m b 0 1 Nonempty); unfold Mem.range_perm; intros.
  apply (Mem.perm_alloc_2 Mem.empty 0 1); auto.

  case_eq (Mem.alloc x 0 Seccompconf.sizeof_seccomp_data); intros.
  destruct (Mem.range_perm_storebytes m0 b0 0 (Memdata.inj_bytes seccomp_data)).
  rewrite length_inj_bytes.
  rewrite <- list_length_nat_z; rewrite length_seccomp_data; simpl.
  unfold Mem.range_perm; intros.
  destruct (Mem.valid_access_freeable_any m0 Mint8unsigned b0 ofs Writable).
  unfold Mem.valid_access.  split.
  unfold Mem.range_perm; intros.
  apply (Mem.perm_alloc_2 x 0 Seccompconf.sizeof_seccomp_data); auto.
  crush.  crush.  unfold Mem.range_perm in H3.  apply H3.  crush.

  destruct (step_terminates
    (Genv.globalenv {|
       prog_defs := (prog_main, Gfun (Internal f)) :: nil;
       prog_main := prog_main |})
    f (ZMap.init Vundef) b0
    m0 seccomp_data x0 length_seccomp_data e0
    f Int.zero Int.zero); auto.

  (* split program_behaves into initial_state and state_behaves *)
  econstructor.
  econstructor.

  (* initial_state *)
  - econstructor.
    + unfold Genv.init_mem.
      simpl.  rewrite H.  rewrite e.  auto.
    + unfold Genv.find_symbol.  simpl.  apply PTree.gss.
    + unfold Genv.find_funct_ptr.  simpl.  auto.
    + exact H0.
    + exact e0.

  (* state_behaves *)
  - econstructor; simpl; [ idtac | constructor ].
    instantiate (1:=x0).
    eapply star_step with (t1:=E0) (t2:=E0);
      [ constructor | idtac | auto ].
    apply H2.
Qed.

Theorem transl_terminates:
  forall prog tprog,
  Seccompfilter.transl_program_filter prog = OK tprog ->
  exists t r,
  program_behaves (Cminorp.semantics tprog) (Terminates t r).
Proof.
  intros.
  unfold transl_program_filter in H.
  case_eq (seccomp_filter prog); intros; rewrite H0 in H; [ idtac | crush ].
  destruct (seccomp_terminates prog); [ auto | idtac ].

  econstructor.
  econstructor.

  apply forward_simulation_same_safe_behavior
    with (L1:=(Seccompspec.semantics prog)).

  (* forward_simulation *)
  - apply transl_program_correct; auto.

  (* program_behaves *)
  - exact H1.

  (* not_wrong *)
  - crush.
Qed.


(* This file is generated by Why3's Coq driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require BuiltIn.
Require HighOrd.
Require bool.Bool.
Require int.Int.
Require int.Abs.
Require int.EuclideanDivision.
Require int.ComputerDivision.
Require real.Real.
Require real.RealInfix.
Require real.FromInt.
Require map.Map.
Require option.Option.

Parameter eqb:
  forall {a:Type} {a_WT:WhyType a}, a -> a -> Init.Datatypes.bool.

Axiom eqb1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (y:a), ((eqb x y) = Init.Datatypes.true) <-> (x = y).

Axiom eqb_false :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (y:a), ((eqb x y) = Init.Datatypes.false) <-> ~ (x = y).

Parameter neqb:
  forall {a:Type} {a_WT:WhyType a}, a -> a -> Init.Datatypes.bool.

Axiom neqb1 :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (y:a), ((neqb x y) = Init.Datatypes.true) <-> ~ (x = y).

Parameter zlt: Numbers.BinNums.Z -> Numbers.BinNums.Z -> Init.Datatypes.bool.

Parameter zleq:
  Numbers.BinNums.Z -> Numbers.BinNums.Z -> Init.Datatypes.bool.

Axiom zlt1 :
  forall (x:Numbers.BinNums.Z) (y:Numbers.BinNums.Z),
  ((zlt x y) = Init.Datatypes.true) <-> (x < y)%Z.

Axiom zleq1 :
  forall (x:Numbers.BinNums.Z) (y:Numbers.BinNums.Z),
  ((zleq x y) = Init.Datatypes.true) <-> (x <= y)%Z.

Parameter rlt:
  Reals.Rdefinitions.R -> Reals.Rdefinitions.R -> Init.Datatypes.bool.

Parameter rleq:
  Reals.Rdefinitions.R -> Reals.Rdefinitions.R -> Init.Datatypes.bool.

Axiom rlt1 :
  forall (x:Reals.Rdefinitions.R) (y:Reals.Rdefinitions.R),
  ((rlt x y) = Init.Datatypes.true) <-> (x < y)%R.

Axiom rleq1 :
  forall (x:Reals.Rdefinitions.R) (y:Reals.Rdefinitions.R),
  ((rleq x y) = Init.Datatypes.true) <-> (x <= y)%R.

(* Why3 assumption *)
Definition real_of_int (x:Numbers.BinNums.Z) : Reals.Rdefinitions.R :=
  BuiltIn.IZR x.

Axiom c_euclidian :
  forall (n:Numbers.BinNums.Z) (d:Numbers.BinNums.Z), ~ (d = 0%Z) ->
  (n = (((ZArith.BinInt.Z.quot n d) * d)%Z + (ZArith.BinInt.Z.rem n d))%Z).

Axiom cmod_remainder :
  forall (n:Numbers.BinNums.Z) (d:Numbers.BinNums.Z),
  ((0%Z <= n)%Z -> (0%Z < d)%Z ->
   (0%Z <= (ZArith.BinInt.Z.rem n d))%Z /\ ((ZArith.BinInt.Z.rem n d) < d)%Z) /\
  ((n <= 0%Z)%Z -> (0%Z < d)%Z ->
   ((-d)%Z < (ZArith.BinInt.Z.rem n d))%Z /\
   ((ZArith.BinInt.Z.rem n d) <= 0%Z)%Z) /\
  ((0%Z <= n)%Z -> (d < 0%Z)%Z ->
   (0%Z <= (ZArith.BinInt.Z.rem n d))%Z /\
   ((ZArith.BinInt.Z.rem n d) < (-d)%Z)%Z) /\
  ((n <= 0%Z)%Z -> (d < 0%Z)%Z ->
   (d < (ZArith.BinInt.Z.rem n d))%Z /\ ((ZArith.BinInt.Z.rem n d) <= 0%Z)%Z).

Axiom cdiv_neutral :
  forall (a:Numbers.BinNums.Z), ((ZArith.BinInt.Z.quot a 1%Z) = a).

Axiom cdiv_inv :
  forall (a:Numbers.BinNums.Z), ~ (a = 0%Z) ->
  ((ZArith.BinInt.Z.quot a a) = 1%Z).

Axiom cdiv_closed_remainder :
  forall (a:Numbers.BinNums.Z) (b:Numbers.BinNums.Z) (n:Numbers.BinNums.Z),
  (0%Z <= a)%Z -> (0%Z <= b)%Z ->
  (0%Z <= (b - a)%Z)%Z /\ ((b - a)%Z < n)%Z ->
  ((ZArith.BinInt.Z.rem a n) = (ZArith.BinInt.Z.rem b n)) -> (a = b).

(* Why3 assumption *)
Inductive addr :=
  | addr'mk : Numbers.BinNums.Z -> Numbers.BinNums.Z -> addr.
Axiom addr_WhyType : WhyType addr.
Existing Instance addr_WhyType.

(* Why3 assumption *)
Definition offset (v:addr) : Numbers.BinNums.Z :=
  match v with
  | addr'mk x x1 => x1
  end.

(* Why3 assumption *)
Definition base (v:addr) : Numbers.BinNums.Z :=
  match v with
  | addr'mk x x1 => x
  end.

Parameter addr_le: addr -> addr -> Prop.

Parameter addr_lt: addr -> addr -> Prop.

Parameter addr_le_bool: addr -> addr -> Init.Datatypes.bool.

Parameter addr_lt_bool: addr -> addr -> Init.Datatypes.bool.

Axiom addr_le_def :
  forall (p:addr) (q:addr), ((base p) = (base q)) ->
  addr_le p q <-> ((offset p) <= (offset q))%Z.

Axiom addr_lt_def :
  forall (p:addr) (q:addr), ((base p) = (base q)) ->
  addr_lt p q <-> ((offset p) < (offset q))%Z.

Axiom addr_le_bool_def :
  forall (p:addr) (q:addr),
  addr_le p q <-> ((addr_le_bool p q) = Init.Datatypes.true).

Axiom addr_lt_bool_def :
  forall (p:addr) (q:addr),
  addr_lt p q <-> ((addr_lt_bool p q) = Init.Datatypes.true).

(* Why3 assumption *)
Definition null : addr := addr'mk 0%Z 0%Z.

(* Why3 assumption *)
Definition global (b:Numbers.BinNums.Z) : addr := addr'mk b 0%Z.

(* Why3 assumption *)
Definition shift (p:addr) (k:Numbers.BinNums.Z) : addr :=
  addr'mk (base p) ((offset p) + k)%Z.

(* Why3 assumption *)
Definition included (p:addr) (a:Numbers.BinNums.Z) (q:addr)
    (b:Numbers.BinNums.Z) : Prop :=
  (0%Z < a)%Z ->
  (0%Z <= b)%Z /\
  ((base p) = (base q)) /\
  ((offset q) <= (offset p))%Z /\
  (((offset p) + a)%Z <= ((offset q) + b)%Z)%Z.

(* Why3 assumption *)
Definition separated (p:addr) (a:Numbers.BinNums.Z) (q:addr)
    (b:Numbers.BinNums.Z) : Prop :=
  (a <= 0%Z)%Z \/
  (b <= 0%Z)%Z \/
  ~ ((base p) = (base q)) \/
  (((offset q) + b)%Z <= (offset p))%Z \/
  (((offset p) + a)%Z <= (offset q))%Z.

(* Why3 assumption *)
Definition eqmem {a:Type} {a_WT:WhyType a} (m1:addr -> a) (m2:addr -> a)
    (p:addr) (a1:Numbers.BinNums.Z) : Prop :=
  forall (q:addr), included q 1%Z p a1 -> ((m1 q) = (m2 q)).

Parameter havoc:
  forall {a:Type} {a_WT:WhyType a}, (addr -> a) -> (addr -> a) -> addr ->
  Numbers.BinNums.Z -> addr -> a.

(* Why3 assumption *)
Definition valid_rw (m:Numbers.BinNums.Z -> Numbers.BinNums.Z) (p:addr)
    (n:Numbers.BinNums.Z) : Prop :=
  (0%Z < n)%Z ->
  (0%Z < (base p))%Z /\
  (0%Z <= (offset p))%Z /\ (((offset p) + n)%Z <= (m (base p)))%Z.

(* Why3 assumption *)
Definition valid_rd (m:Numbers.BinNums.Z -> Numbers.BinNums.Z) (p:addr)
    (n:Numbers.BinNums.Z) : Prop :=
  (0%Z < n)%Z ->
  ~ (0%Z = (base p)) /\
  (0%Z <= (offset p))%Z /\ (((offset p) + n)%Z <= (m (base p)))%Z.

(* Why3 assumption *)
Definition valid_obj (m:Numbers.BinNums.Z -> Numbers.BinNums.Z) (p:addr)
    (n:Numbers.BinNums.Z) : Prop :=
  (0%Z < n)%Z ->
  (p = null) \/
  ~ (0%Z = (base p)) /\
  (0%Z <= (offset p))%Z /\ (((offset p) + n)%Z <= (1%Z + (m (base p)))%Z)%Z.

(* Why3 assumption *)
Definition invalid (m:Numbers.BinNums.Z -> Numbers.BinNums.Z) (p:addr)
    (n:Numbers.BinNums.Z) : Prop :=
  (n <= 0%Z)%Z \/
  ((base p) = 0%Z) \/
  ((m (base p)) <= (offset p))%Z \/ (((offset p) + n)%Z <= 0%Z)%Z.

Axiom valid_rw_rd :
  forall (m:Numbers.BinNums.Z -> Numbers.BinNums.Z), forall (p:addr),
  forall (n:Numbers.BinNums.Z), valid_rw m p n -> valid_rd m p n.

Axiom valid_string :
  forall (m:Numbers.BinNums.Z -> Numbers.BinNums.Z), forall (p:addr),
  ((base p) < 0%Z)%Z ->
  (0%Z <= (offset p))%Z /\ ((offset p) < (m (base p)))%Z ->
  valid_rd m p 1%Z /\ ~ valid_rw m p 1%Z.

Axiom separated_1 :
  forall (p:addr) (q:addr),
  forall (a:Numbers.BinNums.Z) (b:Numbers.BinNums.Z) (i:Numbers.BinNums.Z)
    (j:Numbers.BinNums.Z),
  separated p a q b -> ((offset p) <= i)%Z /\ (i < ((offset p) + a)%Z)%Z ->
  ((offset q) <= j)%Z /\ (j < ((offset q) + b)%Z)%Z ->
  ~ ((addr'mk (base p) i) = (addr'mk (base q) j)).

Parameter region: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter linked: (Numbers.BinNums.Z -> Numbers.BinNums.Z) -> Prop.

Parameter sconst: (addr -> Numbers.BinNums.Z) -> Prop.

(* Why3 assumption *)
Definition framed (m:addr -> addr) : Prop :=
  forall (p:addr), ((region (base p)) <= 0%Z)%Z ->
  ((region (base (m p))) <= 0%Z)%Z.

Axiom separated_included :
  forall (p:addr) (q:addr),
  forall (a:Numbers.BinNums.Z) (b:Numbers.BinNums.Z), (0%Z < a)%Z ->
  (0%Z < b)%Z -> separated p a q b -> ~ included p a q b.

Axiom included_trans :
  forall (p:addr) (q:addr) (r:addr),
  forall (a:Numbers.BinNums.Z) (b:Numbers.BinNums.Z) (c:Numbers.BinNums.Z),
  included p a q b -> included q b r c -> included p a r c.

Axiom separated_trans :
  forall (p:addr) (q:addr) (r:addr),
  forall (a:Numbers.BinNums.Z) (b:Numbers.BinNums.Z) (c:Numbers.BinNums.Z),
  included p a q b -> separated q b r c -> separated p a r c.

Axiom separated_sym :
  forall (p:addr) (q:addr),
  forall (a:Numbers.BinNums.Z) (b:Numbers.BinNums.Z),
  separated p a q b <-> separated q b p a.

Axiom eqmem_included :
  forall {a:Type} {a_WT:WhyType a},
  forall (m1:addr -> a) (m2:addr -> a), forall (p:addr) (q:addr),
  forall (a1:Numbers.BinNums.Z) (b:Numbers.BinNums.Z), included p a1 q b ->
  eqmem m1 m2 q b -> eqmem m1 m2 p a1.

Axiom eqmem_sym :
  forall {a:Type} {a_WT:WhyType a},
  forall (m1:addr -> a) (m2:addr -> a), forall (p:addr),
  forall (a1:Numbers.BinNums.Z), eqmem m1 m2 p a1 -> eqmem m2 m1 p a1.

Axiom havoc_access :
  forall {a:Type} {a_WT:WhyType a},
  forall (m0:addr -> a) (m1:addr -> a), forall (q:addr) (p:addr),
  forall (a1:Numbers.BinNums.Z),
  (separated q 1%Z p a1 -> ((havoc m0 m1 p a1 q) = (m1 q))) /\
  (~ separated q 1%Z p a1 -> ((havoc m0 m1 p a1 q) = (m0 q))).

Parameter cinits: (addr -> Init.Datatypes.bool) -> Prop.

(* Why3 assumption *)
Definition is_init_range (m:addr -> Init.Datatypes.bool) (p:addr)
    (l:Numbers.BinNums.Z) : Prop :=
  forall (i:Numbers.BinNums.Z), (0%Z <= i)%Z /\ (i < l)%Z ->
  ((m (shift p i)) = Init.Datatypes.true).

Parameter set_init:
  (addr -> Init.Datatypes.bool) -> addr -> Numbers.BinNums.Z ->
  addr -> Init.Datatypes.bool.

Axiom set_init_access :
  forall (m:addr -> Init.Datatypes.bool), forall (q:addr) (p:addr),
  forall (a:Numbers.BinNums.Z),
  (separated q 1%Z p a -> ((set_init m p a q) = (m q))) /\
  (~ separated q 1%Z p a -> ((set_init m p a q) = Init.Datatypes.true)).

(* Why3 assumption *)
Definition monotonic_init (m1:addr -> Init.Datatypes.bool)
    (m2:addr -> Init.Datatypes.bool) : Prop :=
  forall (p:addr), ((m1 p) = Init.Datatypes.true) ->
  ((m2 p) = Init.Datatypes.true).

Parameter int_of_addr: addr -> Numbers.BinNums.Z.

Parameter addr_of_int: Numbers.BinNums.Z -> addr.

Axiom table : Type.
Parameter table_WhyType : WhyType table.
Existing Instance table_WhyType.

Parameter table_of_base: Numbers.BinNums.Z -> table.

Parameter table_to_offset: table -> Numbers.BinNums.Z -> Numbers.BinNums.Z.

Axiom table_to_offset_zero :
  forall (t:table), ((table_to_offset t 0%Z) = 0%Z).

Axiom table_to_offset_monotonic :
  forall (t:table), forall (o1:Numbers.BinNums.Z) (o2:Numbers.BinNums.Z),
  (o1 <= o2)%Z <-> ((table_to_offset t o1) <= (table_to_offset t o2))%Z.

Axiom int_of_addr_bijection :
  forall (a:Numbers.BinNums.Z), ((int_of_addr (addr_of_int a)) = a).

Axiom addr_of_int_bijection :
  forall (p:addr), ((addr_of_int (int_of_addr p)) = p).

Axiom addr_of_null : ((int_of_addr null) = 0%Z).

Axiom S15_c_protocol : Type.
Parameter S15_c_protocol_WhyType : WhyType S15_c_protocol.
Existing Instance S15_c_protocol_WhyType.

Axiom list : forall (a:Type), Type.
Parameter list_WhyType : forall (a:Type) {a_WT:WhyType a}, WhyType (list a).
Existing Instance list_WhyType.

Parameter nil: forall {a:Type} {a_WT:WhyType a}, list a.

Parameter cons: forall {a:Type} {a_WT:WhyType a}, a -> list a -> list a.

Parameter concat:
  forall {a:Type} {a_WT:WhyType a}, list a -> list a -> list a.

Parameter repeat:
  forall {a:Type} {a_WT:WhyType a}, list a -> Numbers.BinNums.Z -> list a.

Parameter length:
  forall {a:Type} {a_WT:WhyType a}, list a -> Numbers.BinNums.Z.

Parameter nth:
  forall {a:Type} {a_WT:WhyType a}, list a -> Numbers.BinNums.Z -> a.

Axiom length_pos :
  forall {a:Type} {a_WT:WhyType a}, forall (w:list a), (0%Z <= (length w))%Z.

Axiom length_nil :
  forall {a:Type} {a_WT:WhyType a}, ((length (nil : list a)) = 0%Z).

Axiom length_nil_bis :
  forall {a:Type} {a_WT:WhyType a},
  forall (w:list a), ((length w) = 0%Z) -> (w = (nil : list a)).

Axiom length_cons :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (w:list a), ((length (cons x w)) = (1%Z + (length w))%Z).

Axiom length_concat :
  forall {a:Type} {a_WT:WhyType a},
  forall (u:list a) (v:list a),
  ((length (concat u v)) = ((length u) + (length v))%Z).

Axiom length_repeat :
  forall {a:Type} {a_WT:WhyType a},
  forall (w:list a) (n:Numbers.BinNums.Z), (0%Z <= n)%Z ->
  ((length (repeat w n)) = (n * (length w))%Z).

Axiom nth_cons :
  forall {a:Type} {a_WT:WhyType a},
  forall (k:Numbers.BinNums.Z) (x:a) (w:list a),
  ((k = 0%Z) -> ((nth (cons x w) k) = x)) /\
  (~ (k = 0%Z) -> ((nth (cons x w) k) = (nth w (k - 1%Z)%Z))).

Axiom nth_concat :
  forall {a:Type} {a_WT:WhyType a},
  forall (u:list a) (v:list a) (k:Numbers.BinNums.Z),
  ((k < (length u))%Z -> ((nth (concat u v) k) = (nth u k))) /\
  (~ (k < (length u))%Z ->
   ((nth (concat u v) k) = (nth v (k - (length u))%Z))).

Axiom nth_repeat :
  forall {a:Type} {a_WT:WhyType a},
  forall (n:Numbers.BinNums.Z) (k:Numbers.BinNums.Z) (w:list a),
  (0%Z <= k)%Z /\ (k < (n * (length w))%Z)%Z -> (0%Z < (length w))%Z ->
  ((nth (repeat w n) k) = (nth w (ZArith.BinInt.Z.rem k (length w)))).

(* Why3 assumption *)
Definition vlist_eq {a:Type} {a_WT:WhyType a} (u:list a) (v:list a) : Prop :=
  ((length u) = (length v)) /\
  (forall (i:Numbers.BinNums.Z), (0%Z <= i)%Z /\ (i < (length u))%Z ->
   ((nth u i) = (nth v i))).

Axiom extensionality :
  forall {a:Type} {a_WT:WhyType a},
  forall (u:list a) (v:list a), vlist_eq u v -> (u = v).

Axiom eq_nil_concat :
  forall {a:Type} {a_WT:WhyType a},
  forall (w:list a),
  vlist_eq (concat (nil : list a) w) w /\
  vlist_eq (concat w (nil : list a)) w.

Axiom rw_nil_concat_left :
  forall {a:Type} {a_WT:WhyType a},
  forall (w:list a), ((concat (nil : list a) w) = w).

Axiom rw_nil_concat_right :
  forall {a:Type} {a_WT:WhyType a},
  forall (w:list a), ((concat w (nil : list a)) = w).

Axiom eq_cons_concat :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (v:list a) (w:list a),
  vlist_eq (concat (cons x v) w) (cons x (concat v w)).

Axiom rw_cons_concat :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (v:list a) (w:list a),
  ((concat (cons x v) w) = (cons x (concat v w))).

Axiom rw_nil_cons_concat :
  forall {a:Type} {a_WT:WhyType a},
  forall (x:a) (w:list a), ((concat (cons x (nil : list a)) w) = (cons x w)).

Axiom eq_assoc_concat :
  forall {a:Type} {a_WT:WhyType a},
  forall (u:list a) (v:list a) (w:list a),
  vlist_eq (concat (concat u v) w) (concat u (concat v w)).

Axiom rw_nil_repeat :
  forall {a:Type} {a_WT:WhyType a},
  forall (n:Numbers.BinNums.Z), (0%Z <= n)%Z ->
  ((repeat (nil : list a) n) = (nil : list a)).

Axiom rw_repeat_zero :
  forall {a:Type} {a_WT:WhyType a},
  forall (w:list a), ((repeat w 0%Z) = (nil : list a)).

Axiom eq_repeat_one :
  forall {a:Type} {a_WT:WhyType a},
  forall (w:list a), vlist_eq (repeat w 1%Z) w.

Axiom rw_repeat_one :
  forall {a:Type} {a_WT:WhyType a}, forall (w:list a), ((repeat w 1%Z) = w).

Axiom eq_repeat_concat :
  forall {a:Type} {a_WT:WhyType a},
  forall (p:Numbers.BinNums.Z) (q:Numbers.BinNums.Z) (w:list a),
  (0%Z <= p)%Z -> (0%Z <= q)%Z ->
  vlist_eq (repeat w (p + q)%Z) (concat (repeat w p) (repeat w q)).

Axiom rw_repeat_concat :
  forall {a:Type} {a_WT:WhyType a},
  forall (p:Numbers.BinNums.Z) (q:Numbers.BinNums.Z) (w:list a),
  (0%Z <= p)%Z -> (0%Z <= q)%Z ->
  ((repeat w (p + q)%Z) = (concat (repeat w p) (repeat w q))).

Axiom rw_repeat_after :
  forall {a:Type} {a_WT:WhyType a},
  forall (p:Numbers.BinNums.Z) (w:list a), (0%Z <= p)%Z ->
  ((concat (repeat w p) w) = (repeat w (p + 1%Z)%Z)).

Axiom rw_repeat_before :
  forall {a:Type} {a_WT:WhyType a},
  forall (p:Numbers.BinNums.Z) (w:list a), (0%Z <= p)%Z ->
  ((concat w (repeat w p)) = (repeat w (p + 1%Z)%Z)).

Parameter repeat_box:
  forall {a:Type} {a_WT:WhyType a}, list a -> Numbers.BinNums.Z -> list a.

Axiom rw_repeat_box_unfold :
  forall {a:Type} {a_WT:WhyType a},
  forall (w:list a) (n:Numbers.BinNums.Z), ((repeat_box w n) = (repeat w n)).

Axiom rw_repeat_plus_box_unfold :
  forall {a:Type} {a_WT:WhyType a},
  forall (w:list a) (a1:Numbers.BinNums.Z) (b:Numbers.BinNums.Z),
  (0%Z <= a1)%Z -> (0%Z <= b)%Z ->
  ((repeat_box w (a1 + b)%Z) = (concat (repeat w a1) (repeat w b))).

Axiom rw_repeat_plus_one_box_unfold :
  forall {a:Type} {a_WT:WhyType a},
  forall (w:list a) (n:Numbers.BinNums.Z), (0%Z < n)%Z ->
  ((repeat_box w n) = (concat (repeat w (n - 1%Z)%Z) w)) /\
  ((repeat_box w (n + 1%Z)%Z) = (concat (repeat w n) w)).

(* Why3 assumption *)
Inductive mpi_datatype :=
  | MPI_char : mpi_datatype
  | MPI_int : mpi_datatype
  | MPI_float : mpi_datatype.
Axiom mpi_datatype_WhyType : WhyType mpi_datatype.
Existing Instance mpi_datatype_WhyType.

(* Why3 assumption *)
Inductive mpi_op :=
  | MPI_max : mpi_op
  | MPI_min : mpi_op
  | MPI_sum : mpi_op
  | MPI_prod : mpi_op
  | MPI_land : mpi_op
  | MPI_band : mpi_op
  | MPI_lor : mpi_op
  | MPI_bor : mpi_op
  | MPI_lxor : mpi_op
  | MPI_bxor : mpi_op
  | MPI_maxloc : mpi_op
  | MPI_minloc : mpi_op
  | MPI_replace : mpi_op
  | MPI_no_op : mpi_op.
Axiom mpi_op_WhyType : WhyType mpi_op.
Existing Instance mpi_op_WhyType.

Parameter size: Numbers.BinNums.Z.

(* Why3 assumption *)
Inductive protocol :=
  | IntMessage : Numbers.BinNums.Z -> Numbers.BinNums.Z ->
      Numbers.BinNums.Z -> Numbers.BinNums.Z ->
      (list Numbers.BinNums.Z -> Init.Datatypes.bool) -> protocol
  | IntBroadcast : Numbers.BinNums.Z -> Numbers.BinNums.Z ->
      (list Numbers.BinNums.Z -> Init.Datatypes.bool) ->
      (list Numbers.BinNums.Z -> protocol) -> protocol
  | IntGhostBroadcast : Numbers.BinNums.Z -> Numbers.BinNums.Z ->
      (list Numbers.BinNums.Z -> Init.Datatypes.bool) ->
      (list Numbers.BinNums.Z -> protocol) -> protocol
  | Gather : Numbers.BinNums.Z -> Numbers.BinNums.Z -> mpi_datatype ->
      protocol
  | Scatter : Numbers.BinNums.Z -> Numbers.BinNums.Z -> mpi_datatype ->
      protocol
  | Reduce : Numbers.BinNums.Z -> Numbers.BinNums.Z -> mpi_datatype ->
      mpi_op -> protocol
  | Allgather : Numbers.BinNums.Z -> mpi_datatype -> protocol
  | Allreduce : Numbers.BinNums.Z -> mpi_datatype -> mpi_op -> protocol
  | Foreach : Numbers.BinNums.Z -> Numbers.BinNums.Z ->
      (Numbers.BinNums.Z -> protocol) -> protocol
  | If : Init.Datatypes.bool -> protocol -> protocol -> protocol
  | Seq : protocol -> protocol -> protocol
  | Skip : protocol.
Axiom protocol_WhyType : WhyType protocol.
Existing Instance protocol_WhyType.

Axiom array : forall (a:Type), Type.
Parameter array_WhyType :
  forall (a:Type) {a_WT:WhyType a}, WhyType (array a).
Existing Instance array_WhyType.

Parameter elts:
  forall {a:Type} {a_WT:WhyType a}, array a -> Numbers.BinNums.Z -> a.

Parameter length1:
  forall {a:Type} {a_WT:WhyType a}, array a -> Numbers.BinNums.Z.

Axiom array'invariant :
  forall {a:Type} {a_WT:WhyType a},
  forall (self:array a), (0%Z <= (length1 self))%Z.

(* Why3 assumption *)
Definition mixfix_lbrb {a:Type} {a_WT:WhyType a} (a1:array a)
    (i:Numbers.BinNums.Z) : a :=
  elts a1 i.

Parameter mixfix_lblsmnrb:
  forall {a:Type} {a_WT:WhyType a}, array a -> Numbers.BinNums.Z -> a ->
  array a.

Axiom mixfix_lblsmnrb'spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (a1:array a) (i:Numbers.BinNums.Z) (v:a),
  ((length1 (mixfix_lblsmnrb a1 i v)) = (length1 a1)) /\
  ((elts (mixfix_lblsmnrb a1 i v)) = (map.Map.set (elts a1) i v)).

Parameter make:
  forall {a:Type} {a_WT:WhyType a}, Numbers.BinNums.Z -> a -> array a.

Axiom make_spec :
  forall {a:Type} {a_WT:WhyType a},
  forall (n:Numbers.BinNums.Z) (v:a), (0%Z <= n)%Z ->
  (forall (i:Numbers.BinNums.Z), (0%Z <= i)%Z /\ (i < n)%Z ->
   ((mixfix_lbrb (make n v) i) = v)) /\
  ((length1 (make n v)) = n).

Parameter rank: Numbers.BinNums.Z.

Parameter isIntMessage: protocol -> Prop.

Axiom IsIntMessage :
  forall (src:Numbers.BinNums.Z) (dst:Numbers.BinNums.Z)
    (data_size:Numbers.BinNums.Z) (t:Numbers.BinNums.Z)
    (pre:list Numbers.BinNums.Z -> Init.Datatypes.bool),
  isIntMessage (IntMessage src dst data_size t pre).

Parameter isIntBroadcast: protocol -> Prop.

Axiom IsIntBroadcast :
  forall (r:Numbers.BinNums.Z) (data_size:Numbers.BinNums.Z)
    (pred:list Numbers.BinNums.Z -> Init.Datatypes.bool)
    (cont:list Numbers.BinNums.Z -> protocol),
  isIntBroadcast (IntBroadcast r data_size pred cont).

Parameter isGather: protocol -> Prop.

Axiom IsGather :
  forall (r:Numbers.BinNums.Z) (data_size:Numbers.BinNums.Z)
    (mt:mpi_datatype),
  isGather (Gather r data_size mt).

Parameter isScatter: protocol -> Prop.

Axiom IsScatter :
  forall (r:Numbers.BinNums.Z) (data_size:Numbers.BinNums.Z)
    (mt:mpi_datatype),
  isScatter (Scatter r data_size mt).

Parameter isReduce: protocol -> Prop.

Axiom IsReduce :
  forall (r:Numbers.BinNums.Z) (data_size:Numbers.BinNums.Z)
    (mt:mpi_datatype) (op:mpi_op),
  isReduce (Reduce r data_size mt op).

Parameter isAllgather: protocol -> Prop.

Axiom IsAllgather :
  forall (data_size:Numbers.BinNums.Z) (mt:mpi_datatype),
  isAllgather (Allgather data_size mt).

Parameter isAllreduce: protocol -> Prop.

Axiom IsAllreduce :
  forall (data_size:Numbers.BinNums.Z) (mt:mpi_datatype) (op:mpi_op),
  isAllreduce (Allreduce data_size mt op).

Parameter isForeach: protocol -> Prop.

Axiom IsForeach :
  forall (low:Numbers.BinNums.Z) (high:Numbers.BinNums.Z)
    (body:Numbers.BinNums.Z -> protocol),
  isForeach (Foreach low high body).

Parameter isSkip: protocol -> Prop.

Axiom IsSkip : isSkip Skip.

Parameter isMessageforIntSend:
  protocol -> Numbers.BinNums.Z -> Numbers.BinNums.Z -> Numbers.BinNums.Z ->
  list Numbers.BinNums.Z -> Prop.

Axiom isforIntSend :
  forall (dest:Numbers.BinNums.Z) (count:Numbers.BinNums.Z)
    (tag:Numbers.BinNums.Z) (src:Numbers.BinNums.Z) (dst:Numbers.BinNums.Z)
    (data_size:Numbers.BinNums.Z) (t:Numbers.BinNums.Z)
    (data:list Numbers.BinNums.Z)
    (pre:list Numbers.BinNums.Z -> Init.Datatypes.bool),
  (0%Z <= src)%Z /\
  (src < size)%Z /\
  (0%Z <= dst)%Z /\
  (dst < size)%Z /\
  ~ (dst = src) /\
  (src = rank) /\ (dest = dst) /\ (data_size = count) /\ (tag = t) ->
  isMessageforIntSend (IntMessage src dst data_size t pre) dest count tag
  data.

Parameter isPredIntMessage: protocol -> list Numbers.BinNums.Z -> Prop.

Axiom isPredIntMessage1 :
  forall (src:Numbers.BinNums.Z) (dst:Numbers.BinNums.Z)
    (data_size:Numbers.BinNums.Z) (t:Numbers.BinNums.Z)
    (data:list Numbers.BinNums.Z)
    (pre:list Numbers.BinNums.Z -> Init.Datatypes.bool),
  ((pre data) = Init.Datatypes.true) ->
  isPredIntMessage (IntMessage src dst data_size t pre) data.

Parameter isMessageforIntRecv:
  protocol -> Numbers.BinNums.Z -> Numbers.BinNums.Z -> Numbers.BinNums.Z ->
  Prop.

Axiom isforIntRecv :
  forall (source:Numbers.BinNums.Z) (count:Numbers.BinNums.Z)
    (tag:Numbers.BinNums.Z) (src:Numbers.BinNums.Z) (dst:Numbers.BinNums.Z)
    (data_size:Numbers.BinNums.Z) (t:Numbers.BinNums.Z)
    (pre:list Numbers.BinNums.Z -> Init.Datatypes.bool),
  (0%Z <= src)%Z /\
  (src < size)%Z /\
  (0%Z <= dst)%Z /\
  (dst < size)%Z /\
  ~ (dst = src) /\
  (src = source) /\ (dst = rank) /\ (data_size = count) /\ (tag = t) ->
  isMessageforIntRecv (IntMessage src dst data_size t pre) source count tag.

Parameter predIntMessage: protocol -> list Numbers.BinNums.Z -> Prop.

Axiom PredIntMessage :
  forall (src:Numbers.BinNums.Z) (dst:Numbers.BinNums.Z)
    (data_size:Numbers.BinNums.Z) (t:Numbers.BinNums.Z)
    (data:list Numbers.BinNums.Z)
    (pre:list Numbers.BinNums.Z -> Init.Datatypes.bool),
  predIntMessage (IntMessage src dst data_size t pre) data ->
  ((pre data) = Init.Datatypes.true).

Parameter isforIntBroadcast:
  protocol -> Numbers.BinNums.Z -> Numbers.BinNums.Z ->
  list Numbers.BinNums.Z -> Prop.

Axiom isIntBroadcast1 :
  forall (root:Numbers.BinNums.Z) (r:Numbers.BinNums.Z)
    (count:Numbers.BinNums.Z) (data_size:Numbers.BinNums.Z)
    (data:list Numbers.BinNums.Z)
    (pred:list Numbers.BinNums.Z -> Init.Datatypes.bool)
    (cont:list Numbers.BinNums.Z -> protocol),
  (0%Z <= r)%Z /\
  (r < size)%Z /\
  (root = r) /\
  (data_size = count) /\
  ((rank = root) -> ((pred data) = Init.Datatypes.true)) ->
  isforIntBroadcast (IntBroadcast r data_size pred cont) root count data.

Parameter isforIntGhostBroadcast:
  protocol -> Numbers.BinNums.Z -> Numbers.BinNums.Z ->
  list Numbers.BinNums.Z -> Prop.

Axiom isIntGhostBroadcast :
  forall (root:Numbers.BinNums.Z) (r:Numbers.BinNums.Z)
    (count:Numbers.BinNums.Z) (data_size:Numbers.BinNums.Z)
    (data:list Numbers.BinNums.Z)
    (pred:list Numbers.BinNums.Z -> Init.Datatypes.bool)
    (cont:list Numbers.BinNums.Z -> protocol),
  (0%Z <= r)%Z /\
  (r < size)%Z /\
  (root = r) /\
  (data_size = count) /\
  ((rank = root) -> ((pred data) = Init.Datatypes.true)) ->
  isforIntGhostBroadcast (IntGhostBroadcast r data_size pred cont) root count
  data.

Parameter predIntBroadcast: protocol -> list Numbers.BinNums.Z -> Prop.

Axiom PredIntBroadcast :
  forall (r:Numbers.BinNums.Z) (data_size:Numbers.BinNums.Z)
    (pred:list Numbers.BinNums.Z -> Init.Datatypes.bool)
    (cont:list Numbers.BinNums.Z -> protocol) (data:list Numbers.BinNums.Z),
  predIntBroadcast (IntBroadcast r data_size pred cont) data ->
  ((pred data) = Init.Datatypes.true).

Axiom PredIntGhostBroadcast :
  forall (r:Numbers.BinNums.Z) (data_size:Numbers.BinNums.Z)
    (pred:list Numbers.BinNums.Z -> Init.Datatypes.bool)
    (cont:list Numbers.BinNums.Z -> protocol) (data:list Numbers.BinNums.Z),
  predIntBroadcast (IntGhostBroadcast r data_size pred cont) data ->
  ((pred data) = Init.Datatypes.true).

Parameter countiIntBroadcast:
  protocol -> protocol -> protocol -> list Numbers.BinNums.Z -> Prop.

Axiom CountiIntBroadcast :
  forall (r:Numbers.BinNums.Z) (data_size:Numbers.BinNums.Z)
    (pred:list Numbers.BinNums.Z -> Init.Datatypes.bool)
    (cont:list Numbers.BinNums.Z -> protocol) (data:list Numbers.BinNums.Z)
    (old_n:protocol) (new_p:protocol),
  countiIntBroadcast (IntBroadcast r data_size pred cont) old_n new_p data ->
  (new_p = (Seq (cont data) old_n)).

Axiom CountiIntGhostBroadcast :
  forall (r:Numbers.BinNums.Z) (data_size:Numbers.BinNums.Z)
    (pred:list Numbers.BinNums.Z -> Init.Datatypes.bool)
    (cont:list Numbers.BinNums.Z -> protocol) (data:list Numbers.BinNums.Z)
    (old_n:protocol) (new_p:protocol),
  countiIntBroadcast (IntGhostBroadcast r data_size pred cont) old_n new_p
  data -> (new_p = (Seq (cont data) old_n)).

Parameter isforGather:
  protocol -> Numbers.BinNums.Z -> Numbers.BinNums.Z -> mpi_datatype -> Prop.

Axiom isGather1 :
  forall (root:Numbers.BinNums.Z) (r:Numbers.BinNums.Z)
    (count:Numbers.BinNums.Z) (data_size:Numbers.BinNums.Z)
    (datatype:mpi_datatype) (mt:mpi_datatype),
  (0%Z <= r)%Z /\
  (r < size)%Z /\ (root = r) /\ (data_size = count) /\ (datatype = mt) ->
  isforGather (Gather r data_size mt) root count datatype.

Parameter isforScatter:
  protocol -> Numbers.BinNums.Z -> Numbers.BinNums.Z -> mpi_datatype -> Prop.

Axiom isScatter1 :
  forall (root:Numbers.BinNums.Z) (r:Numbers.BinNums.Z)
    (count:Numbers.BinNums.Z) (data_size:Numbers.BinNums.Z)
    (datatype:mpi_datatype) (mt:mpi_datatype),
  (0%Z <= r)%Z /\
  (r < size)%Z /\ (root = r) /\ (data_size = count) /\ (datatype = mt) ->
  isforScatter (Scatter r data_size mt) root count datatype.

Parameter isforReduce:
  protocol -> Numbers.BinNums.Z -> Numbers.BinNums.Z -> mpi_datatype ->
  mpi_op -> Prop.

Axiom isReduce1 :
  forall (root:Numbers.BinNums.Z) (r:Numbers.BinNums.Z)
    (count:Numbers.BinNums.Z) (data_size:Numbers.BinNums.Z)
    (datatype:mpi_datatype) (mt:mpi_datatype) (op:mpi_op) (opera:mpi_op),
  (0%Z <= r)%Z /\
  (r < size)%Z /\
  (root = r) /\ (data_size = count) /\ (datatype = mt) /\ (opera = op) ->
  isforReduce (Reduce r data_size mt op) root count datatype opera.

Parameter isforAllgather:
  protocol -> Numbers.BinNums.Z -> mpi_datatype -> Prop.

Axiom isAllgather1 :
  forall (data_size:Numbers.BinNums.Z) (count:Numbers.BinNums.Z)
    (datatype:mpi_datatype) (mt:mpi_datatype),
  (data_size = count) /\ (datatype = mt) ->
  isforAllgather (Allgather data_size mt) count datatype.

Parameter isforAllreduce:
  protocol -> Numbers.BinNums.Z -> mpi_datatype -> mpi_op -> Prop.

Axiom isAllreduce1 :
  forall (data_size:Numbers.BinNums.Z) (count:Numbers.BinNums.Z)
    (datatype:mpi_datatype) (mt:mpi_datatype) (op:mpi_op) (opera:mpi_op),
  (data_size = count) /\ (datatype = mt) /\ (opera = op) ->
  isforAllreduce (Allreduce data_size mt op) count datatype opera.

Parameter simpl: protocol -> protocol.

Axiom simpl_seq_1 : forall (p:protocol), ((simpl (Seq Skip p)) = p).

Axiom simpl_seq_2 : forall (p:protocol), ((simpl (Seq p Skip)) = p).

Axiom simp_if_true :
  forall (b:Init.Datatypes.bool) (p1:protocol) (p2:protocol),
  (b = Init.Datatypes.true) -> ((simpl (If b p1 p2)) = p1).

Axiom simp_if_false :
  forall (b:Init.Datatypes.bool) (p1:protocol) (p2:protocol),
  ~ (b = Init.Datatypes.true) -> ((simpl (If b p1 p2)) = p2).

Axiom simpl_intmessage :
  forall (source:Numbers.BinNums.Z) (dest:Numbers.BinNums.Z)
    (data_size:Numbers.BinNums.Z) (tag:Numbers.BinNums.Z)
    (pre:list Numbers.BinNums.Z -> Init.Datatypes.bool),
  (0%Z <= source)%Z /\
  (source < size)%Z /\
  (0%Z <= dest)%Z /\
  (dest < size)%Z /\
  ~ (dest = source) /\ ~ (rank = source) /\ ~ (rank = dest) ->
  ((simpl (IntMessage source dest data_size tag pre)) = Skip).

Axiom simpl_foreach_1 :
  forall (low:Numbers.BinNums.Z) (high:Numbers.BinNums.Z)
    (body:Numbers.BinNums.Z -> protocol),
  (low <= high)%Z ->
  ((simpl (Foreach low high body)) =
   (Seq (body low) (Foreach (low + 1%Z)%Z high body))).

Axiom simpl_foreach_2 :
  forall (low:Numbers.BinNums.Z) (high:Numbers.BinNums.Z)
    (body:Numbers.BinNums.Z -> protocol),
  (high < low)%Z -> ((simpl (Foreach low high body)) = Skip).

Axiom simpl_Skip : ((simpl Skip) = Skip).

Parameter fsimpl: protocol -> protocol.

Axiom fsimpl_foreach :
  forall (low:Numbers.BinNums.Z) (high:Numbers.BinNums.Z)
    (body:Numbers.BinNums.Z -> protocol),
  (forall (i:Numbers.BinNums.Z), (low <= i)%Z /\ (i <= high)%Z ->
   ((simpl (body i)) = Skip)) ->
  ((fsimpl (Foreach low high body)) = Skip).

Parameter split: protocol -> Numbers.BinNums.Z -> protocol.

Axiom split_foreach :
  forall (low:Numbers.BinNums.Z) (high:Numbers.BinNums.Z)
    (c:Numbers.BinNums.Z) (body:Numbers.BinNums.Z -> protocol),
  (low <= c)%Z /\ (c <= high)%Z ->
  ((split (Foreach low high body) c) =
   (Seq (Foreach low (c - 1%Z)%Z body) (Foreach c high body))).

Parameter split_right: protocol -> Numbers.BinNums.Z -> protocol.

Axiom split_right_foreach :
  forall (low:Numbers.BinNums.Z) (high:Numbers.BinNums.Z)
    (c:Numbers.BinNums.Z) (body:Numbers.BinNums.Z -> protocol),
  (low <= high)%Z ->
  ((split_right (Foreach low high body) c) = (Foreach c high body)).

Parameter assoc: protocol -> protocol.

Axiom Assoc :
  forall (h:protocol) (q:protocol) (p:protocol),
  ((assoc (Seq (Seq h q) p)) = (Seq h (Seq q p))).

(* Why3 assumption *)
Definition getLeft (p:protocol) : protocol :=
  match p with
  | Seq h _ => h
  | _ => p
  end.

(* Why3 assumption *)
Definition getRight (p:protocol) : protocol :=
  match p with
  | Seq _ q => q
  | _ => Skip
  end.

Parameter P_set_type: S15_c_protocol -> protocol -> Prop.

Parameter L_get_type: S15_c_protocol -> protocol.

Axiom Q_link :
  forall (p:protocol) (s:S15_c_protocol), P_set_type s p ->
  ((L_get_type s) = p).

(* Why3 assumption *)
Definition f1 (n:Numbers.BinNums.Z) (i:Numbers.BinNums.Z) : protocol :=
  IntMessage 0%Z i (int.EuclideanDivision.div n size) 0%Z
  (fun (us:list Numbers.BinNums.Z) => Init.Datatypes.true).

(* Why3 assumption *)
Definition f2 (i:Numbers.BinNums.Z) : protocol :=
  IntMessage (size - i)%Z ((size - i)%Z - 1%Z)%Z 1%Z 0%Z
  (fun (us:list Numbers.BinNums.Z) => Init.Datatypes.true).

(* Why3 assumption *)
Definition f3 (i:Numbers.BinNums.Z) : protocol :=
  IntMessage i (i + 1%Z)%Z 1%Z 0%Z
  (fun (us:list Numbers.BinNums.Z) => Init.Datatypes.true).

(* Why3 assumption *)
Definition protocol_7 : protocol :=
  Foreach 0%Z (size - 2%Z)%Z (fun (i:Numbers.BinNums.Z) => f3 i).

(* Why3 assumption *)
Definition protocol_6 : protocol :=
  Foreach 1%Z (size - 1%Z)%Z (fun (i:Numbers.BinNums.Z) => f2 i).

(* Why3 assumption *)
Definition protocol_4 (numIter:Numbers.BinNums.Z) : protocol :=
  Foreach 0%Z numIter
  (fun (us:Numbers.BinNums.Z) => Seq protocol_6 protocol_7).

(* Why3 assumption *)
Definition protocol_3 (n:Numbers.BinNums.Z) (numIter:Numbers.BinNums.Z)
    (wstep:Numbers.BinNums.Z) : protocol :=
  Seq (Foreach 1%Z (size - 1%Z)%Z (fun (i:Numbers.BinNums.Z) => f1 n i))
  (protocol_4 numIter).

(* Why3 assumption *)
Definition protocol_2 (n:Numbers.BinNums.Z) (numIter:Numbers.BinNums.Z) :
    protocol :=
  IntBroadcast 0%Z 1%Z
  (fun (us:list Numbers.BinNums.Z) => Init.Datatypes.true)
  (fun (l:list Numbers.BinNums.Z) => protocol_3 n numIter (nth l 0%Z)).

Parameter fc: list Numbers.BinNums.Z -> Init.Datatypes.bool.

Axiom fc'def :
  forall (l:list Numbers.BinNums.Z),
  ((fc l) = Init.Datatypes.true) <-> (0%Z < (nth l 0%Z))%Z.

(* Why3 assumption *)
Definition protocol_1 (n:Numbers.BinNums.Z) : protocol :=
  IntBroadcast 0%Z 1%Z fc
  (fun (l:list Numbers.BinNums.Z) => protocol_2 n (nth l 0%Z)).

Parameter fc1: list Numbers.BinNums.Z -> Init.Datatypes.bool.

Axiom fc'def1 :
  forall (l:list Numbers.BinNums.Z),
  ((fc1 l) = Init.Datatypes.true) <->
  (0%Z < (nth l 0%Z))%Z /\ ((nth l 0%Z) <= (10000%Z * size)%Z)%Z.

(* Why3 assumption *)
Definition the_protocol : protocol :=
  IntBroadcast 0%Z 1%Z fc1
  (fun (l:list Numbers.BinNums.Z) => protocol_1 (nth l 0%Z)).

Axiom Q_G_mpi_mpi_op_max_33_region : ((region 34%Z) = 0%Z).

Axiom S6_mpi_op_t : Type.
Parameter S6_mpi_op_t_WhyType : WhyType S6_mpi_op_t.
Existing Instance S6_mpi_op_t_WhyType.

Parameter Length_of_S6_mpi_op_t: Numbers.BinNums.Z.

Axiom Q_Positive_Length_of_S6_mpi_op_t : (0%Z < Length_of_S6_mpi_op_t)%Z.

Axiom Q_G_mpi_mpi_op_max_33_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 34%Z) = Length_of_S6_mpi_op_t).

Axiom Q_G_mpi_mpi_op_min_32_region : ((region 33%Z) = 0%Z).

Axiom Q_G_mpi_mpi_op_min_32_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 33%Z) = Length_of_S6_mpi_op_t).

Axiom Q_G_mpi_mpi_op_sum_34_region : ((region 35%Z) = 0%Z).

Axiom Q_G_mpi_mpi_op_sum_34_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 35%Z) = Length_of_S6_mpi_op_t).

Axiom Q_G_mpi_mpi_op_prod_35_region : ((region 36%Z) = 0%Z).

Axiom Q_G_mpi_mpi_op_prod_35_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 36%Z) = Length_of_S6_mpi_op_t).

Axiom Q_G_mpi_mpi_op_land_36_region : ((region 37%Z) = 0%Z).

Axiom Q_G_mpi_mpi_op_land_36_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 37%Z) = Length_of_S6_mpi_op_t).

Axiom Q_G_mpi_mpi_op_band_37_region : ((region 38%Z) = 0%Z).

Axiom Q_G_mpi_mpi_op_band_37_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 38%Z) = Length_of_S6_mpi_op_t).

Axiom Q_G_mpi_mpi_op_lor_38_region : ((region 39%Z) = 0%Z).

Axiom Q_G_mpi_mpi_op_lor_38_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 39%Z) = Length_of_S6_mpi_op_t).

Axiom Q_G_mpi_mpi_op_bor_39_region : ((region 40%Z) = 0%Z).

Axiom Q_G_mpi_mpi_op_bor_39_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 40%Z) = Length_of_S6_mpi_op_t).

Axiom Q_G_mpi_mpi_op_lxor_40_region : ((region 41%Z) = 0%Z).

Axiom Q_G_mpi_mpi_op_lxor_40_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 41%Z) = Length_of_S6_mpi_op_t).

Axiom Q_G_mpi_mpi_op_bxor_41_region : ((region 42%Z) = 0%Z).

Axiom Q_G_mpi_mpi_op_bxor_41_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 42%Z) = Length_of_S6_mpi_op_t).

Axiom Q_G_mpi_mpi_op_maxloc_42_region : ((region 43%Z) = 0%Z).

Axiom Q_G_mpi_mpi_op_maxloc_42_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 43%Z) = Length_of_S6_mpi_op_t).

Axiom Q_G_mpi_mpi_op_minloc_43_region : ((region 44%Z) = 0%Z).

Axiom Q_G_mpi_mpi_op_minloc_43_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 44%Z) = Length_of_S6_mpi_op_t).

Axiom Q_G_mpi_mpi_op_replace_44_region : ((region 45%Z) = 0%Z).

Axiom Q_G_mpi_mpi_op_replace_44_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 45%Z) = Length_of_S6_mpi_op_t).

Axiom Q_G_mpi_mpi_op_no_op_45_region : ((region 46%Z) = 0%Z).

Axiom Q_G_mpi_mpi_op_no_op_45_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 46%Z) = Length_of_S6_mpi_op_t).

Axiom Q_G_mpi_mpi_int_51_region : ((region 52%Z) = 0%Z).

Axiom S2_mpi_datatype_t : Type.
Parameter S2_mpi_datatype_t_WhyType : WhyType S2_mpi_datatype_t.
Existing Instance S2_mpi_datatype_t_WhyType.

Parameter Length_of_S2_mpi_datatype_t: Numbers.BinNums.Z.

Axiom Q_Positive_Length_of_S2_mpi_datatype_t :
  (0%Z < Length_of_S2_mpi_datatype_t)%Z.

Axiom Q_G_mpi_mpi_int_51_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 52%Z) = Length_of_S2_mpi_datatype_t).

Axiom Q_G_mpi_mpi_char_46_region : ((region 47%Z) = 0%Z).

Axiom Q_G_mpi_mpi_char_46_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 47%Z) = Length_of_S2_mpi_datatype_t).

Axiom Q_G_mpi_mpi_float_57_region : ((region 58%Z) = 0%Z).

Axiom Q_G_mpi_mpi_float_57_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 58%Z) = Length_of_S2_mpi_datatype_t).

Axiom Q_L_buf_604_region : ((region 605%Z) = 2%Z).

Axiom Q_L_buf_604_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 605%Z) = 0%Z).

Axiom Q_L_numIter_594_region : ((region 595%Z) = 2%Z).

Axiom Q_L_numIter_594_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 595%Z) = 0%Z).

Axiom Q_L_u_602_region : ((region 603%Z) = 2%Z).

Axiom Q_L_u_602_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 603%Z) = 0%Z).

Axiom Q_L_wstep_595_region : ((region 596%Z) = 2%Z).

Axiom Q_L_wstep_595_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 596%Z) = 0%Z).

Axiom Q_L_n_592_region : ((region 593%Z) = 2%Z).

Axiom Q_L_n_592_linked :
  forall (t:Numbers.BinNums.Z -> Numbers.BinNums.Z), linked t ->
  ((t 593%Z) = 0%Z).

(* Why3 assumption *)
Definition size_constrain (s:Numbers.BinNums.Z) : Prop :=
  (1%Z < s)%Z /\ (s <= 10000%Z)%Z.

(* Why3 assumption *)
Definition is_bool (x:Numbers.BinNums.Z) : Prop := (x = 0%Z) \/ (x = 1%Z).

(* Why3 assumption *)
Definition is_uint8 (x:Numbers.BinNums.Z) : Prop :=
  (0%Z <= x)%Z /\ (x < 256%Z)%Z.

(* Why3 assumption *)
Definition is_sint8 (x:Numbers.BinNums.Z) : Prop :=
  ((-128%Z)%Z <= x)%Z /\ (x < 128%Z)%Z.

(* Why3 assumption *)
Definition is_uint16 (x:Numbers.BinNums.Z) : Prop :=
  (0%Z <= x)%Z /\ (x < 65536%Z)%Z.

(* Why3 assumption *)
Definition is_sint16 (x:Numbers.BinNums.Z) : Prop :=
  ((-32768%Z)%Z <= x)%Z /\ (x < 32768%Z)%Z.

(* Why3 assumption *)
Definition is_uint32 (x:Numbers.BinNums.Z) : Prop :=
  (0%Z <= x)%Z /\ (x < 4294967296%Z)%Z.

(* Why3 assumption *)
Definition is_sint32 (x:Numbers.BinNums.Z) : Prop :=
  ((-2147483648%Z)%Z <= x)%Z /\ (x < 2147483648%Z)%Z.

(* Why3 assumption *)
Definition is_uint64 (x:Numbers.BinNums.Z) : Prop :=
  (0%Z <= x)%Z /\ (x < 18446744073709551616%Z)%Z.

(* Why3 assumption *)
Definition is_sint64 (x:Numbers.BinNums.Z) : Prop :=
  ((-9223372036854775808%Z)%Z <= x)%Z /\ (x < 9223372036854775808%Z)%Z.

Axiom is_bool0 : is_bool 0%Z.

Axiom is_bool1 : is_bool 1%Z.

Parameter to_bool: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Axiom to_bool'def :
  forall (x:Numbers.BinNums.Z),
  ((x = 0%Z) -> ((to_bool x) = 0%Z)) /\ (~ (x = 0%Z) -> ((to_bool x) = 1%Z)).

Parameter to_uint8: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_sint8: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_uint16: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_sint16: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_uint32: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_sint32: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_uint64: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_sint64: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter two_power_abs: Numbers.BinNums.Z -> Numbers.BinNums.Z.

Axiom two_power_abs_is_positive :
  forall (n:Numbers.BinNums.Z), (0%Z < (two_power_abs n))%Z.

Axiom two_power_abs_plus_pos :
  forall (n:Numbers.BinNums.Z) (m:Numbers.BinNums.Z), (0%Z <= n)%Z ->
  (0%Z <= m)%Z ->
  ((two_power_abs (n + m)%Z) = ((two_power_abs n) * (two_power_abs m))%Z).

Axiom two_power_abs_plus_one :
  forall (n:Numbers.BinNums.Z), (0%Z <= n)%Z ->
  ((two_power_abs (n + 1%Z)%Z) = (2%Z * (two_power_abs n))%Z).

(* Why3 assumption *)
Definition is_uint (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z) : Prop :=
  (0%Z <= x)%Z /\ (x < (two_power_abs n))%Z.

(* Why3 assumption *)
Definition is_sint (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z) : Prop :=
  ((-(two_power_abs n))%Z <= x)%Z /\ (x < (two_power_abs n))%Z.

Parameter to_uint:
  Numbers.BinNums.Z -> Numbers.BinNums.Z -> Numbers.BinNums.Z.

Parameter to_sint:
  Numbers.BinNums.Z -> Numbers.BinNums.Z -> Numbers.BinNums.Z.

Axiom is_to_uint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z), is_uint n (to_uint n x).

Axiom is_to_sint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z), is_sint n (to_sint n x).

Axiom is_to_uint8 : forall (x:Numbers.BinNums.Z), is_uint8 (to_uint8 x).

Axiom is_to_sint8 : forall (x:Numbers.BinNums.Z), is_sint8 (to_sint8 x).

Axiom is_to_uint16 : forall (x:Numbers.BinNums.Z), is_uint16 (to_uint16 x).

Axiom is_to_sint16 : forall (x:Numbers.BinNums.Z), is_sint16 (to_sint16 x).

Axiom is_to_uint32 : forall (x:Numbers.BinNums.Z), is_uint32 (to_uint32 x).

Axiom is_to_sint32 : forall (x:Numbers.BinNums.Z), is_sint32 (to_sint32 x).

Axiom is_to_uint64 : forall (x:Numbers.BinNums.Z), is_uint64 (to_uint64 x).

Axiom is_to_sint64 : forall (x:Numbers.BinNums.Z), is_sint64 (to_sint64 x).

Axiom id_uint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  is_uint n x <-> ((to_uint n x) = x).

Axiom id_sint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  is_sint n x <-> ((to_sint n x) = x).

Axiom id_uint8 :
  forall (x:Numbers.BinNums.Z), is_uint8 x -> ((to_uint8 x) = x).

Axiom id_sint8 :
  forall (x:Numbers.BinNums.Z), is_sint8 x -> ((to_sint8 x) = x).

Axiom id_uint16 :
  forall (x:Numbers.BinNums.Z), is_uint16 x -> ((to_uint16 x) = x).

Axiom id_sint16 :
  forall (x:Numbers.BinNums.Z), is_sint16 x -> ((to_sint16 x) = x).

Axiom id_uint32 :
  forall (x:Numbers.BinNums.Z), is_uint32 x -> ((to_uint32 x) = x).

Axiom id_sint32 :
  forall (x:Numbers.BinNums.Z), is_sint32 x -> ((to_sint32 x) = x).

Axiom id_uint64 :
  forall (x:Numbers.BinNums.Z), is_uint64 x -> ((to_uint64 x) = x).

Axiom id_sint64 :
  forall (x:Numbers.BinNums.Z), is_sint64 x -> ((to_sint64 x) = x).

Axiom proj_uint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  ((to_uint n (to_uint n x)) = (to_uint n x)).

Axiom proj_sint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  ((to_sint n (to_sint n x)) = (to_sint n x)).

Axiom proj_uint8 :
  forall (x:Numbers.BinNums.Z), ((to_uint8 (to_uint8 x)) = (to_uint8 x)).

Axiom proj_sint8 :
  forall (x:Numbers.BinNums.Z), ((to_sint8 (to_sint8 x)) = (to_sint8 x)).

Axiom proj_uint16 :
  forall (x:Numbers.BinNums.Z), ((to_uint16 (to_uint16 x)) = (to_uint16 x)).

Axiom proj_sint16 :
  forall (x:Numbers.BinNums.Z), ((to_sint16 (to_sint16 x)) = (to_sint16 x)).

Axiom proj_uint32 :
  forall (x:Numbers.BinNums.Z), ((to_uint32 (to_uint32 x)) = (to_uint32 x)).

Axiom proj_sint32 :
  forall (x:Numbers.BinNums.Z), ((to_sint32 (to_sint32 x)) = (to_sint32 x)).

Axiom proj_uint64 :
  forall (x:Numbers.BinNums.Z), ((to_uint64 (to_uint64 x)) = (to_uint64 x)).

Axiom proj_sint64 :
  forall (x:Numbers.BinNums.Z), ((to_sint64 (to_sint64 x)) = (to_sint64 x)).

Axiom proj_su :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  ((to_sint n (to_uint n x)) = (to_uint n x)).

Axiom incl_su :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z), is_uint n x ->
  is_sint n x.

Axiom proj_su_uint :
  forall (n:Numbers.BinNums.Z) (m:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  (0%Z <= n)%Z -> (0%Z <= m)%Z ->
  ((to_sint (m + n)%Z (to_uint n x)) = (to_uint n x)).

Axiom proj_su_sint :
  forall (n:Numbers.BinNums.Z) (m:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  (0%Z <= n)%Z -> (0%Z <= m)%Z ->
  ((to_sint n (to_uint (m + (n + 1%Z)%Z)%Z x)) = (to_sint n x)).

Axiom proj_int8 :
  forall (x:Numbers.BinNums.Z), ((to_sint8 (to_uint8 x)) = (to_sint8 x)).

Axiom proj_int16 :
  forall (x:Numbers.BinNums.Z), ((to_sint16 (to_uint16 x)) = (to_sint16 x)).

Axiom proj_int32 :
  forall (x:Numbers.BinNums.Z), ((to_sint32 (to_uint32 x)) = (to_sint32 x)).

Axiom proj_int64 :
  forall (x:Numbers.BinNums.Z), ((to_sint64 (to_uint64 x)) = (to_sint64 x)).

Axiom proj_us_uint :
  forall (n:Numbers.BinNums.Z) (m:Numbers.BinNums.Z) (x:Numbers.BinNums.Z),
  (0%Z <= n)%Z -> (0%Z <= m)%Z ->
  ((to_uint (n + 1%Z)%Z (to_sint (m + n)%Z x)) = (to_uint (n + 1%Z)%Z x)).

Axiom incl_uint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z) (i:Numbers.BinNums.Z),
  (0%Z <= n)%Z -> (0%Z <= i)%Z -> is_uint n x -> is_uint (n + i)%Z x.

Axiom incl_sint :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z) (i:Numbers.BinNums.Z),
  (0%Z <= n)%Z -> (0%Z <= i)%Z -> is_sint n x -> is_sint (n + i)%Z x.

Axiom incl_int :
  forall (n:Numbers.BinNums.Z) (x:Numbers.BinNums.Z) (i:Numbers.BinNums.Z),
  (0%Z <= n)%Z -> (0%Z <= i)%Z -> is_uint n x -> is_sint (n + i)%Z x.

Parameter L_to_list:
  (addr -> Numbers.BinNums.Z) -> addr -> Numbers.BinNums.Z ->
  Numbers.BinNums.Z -> list Numbers.BinNums.Z.

Axiom Q_to_list_empty :
  forall (Mint:addr -> Numbers.BinNums.Z) (a:addr) (i:Numbers.BinNums.Z)
    (n:Numbers.BinNums.Z),
  (n <= i)%Z -> ((L_to_list Mint a i n) = (nil : list Numbers.BinNums.Z)).

Axiom Q_to_list_cons :
  forall (Mint:addr -> Numbers.BinNums.Z) (a:addr) (i:Numbers.BinNums.Z)
    (n:Numbers.BinNums.Z),
  let x := ((-1%Z)%Z + n)%Z in
  (i < n)%Z ->
  ((L_to_list Mint a i n) =
   (concat (L_to_list Mint a i x)
    (cons (Mint (shift a x)) (nil : list Numbers.BinNums.Z)))).

Axiom Q_to_list_length :
  forall (Mint:addr -> Numbers.BinNums.Z) (a:addr) (i:Numbers.BinNums.Z)
    (n:Numbers.BinNums.Z),
  (i <= n)%Z -> ((i + (length (L_to_list Mint a i n)))%Z = n).

Axiom Q_to_list_concat :
  forall (Mint:addr -> Numbers.BinNums.Z) (a:addr) (i:Numbers.BinNums.Z)
    (k:Numbers.BinNums.Z) (n:Numbers.BinNums.Z),
  (i <= k)%Z -> (k <= n)%Z ->
  ((L_to_list Mint a i n) =
   (concat (L_to_list Mint a i k) (L_to_list Mint a k n))).

Axiom Q_to_list_nth :
  forall (Mint:addr -> Numbers.BinNums.Z) (a:addr) (i:Numbers.BinNums.Z)
    (n:Numbers.BinNums.Z) (k:Numbers.BinNums.Z),
  let x := (i + k)%Z in
  (i < n)%Z -> (0%Z <= k)%Z -> (x < n)%Z ->
  ((Mint (shift a x)) = (nth (L_to_list Mint a i n) k)).

Axiom Q_to_list_nth_shift :
  forall (Mint:addr -> Numbers.BinNums.Z) (a:addr) (i:Numbers.BinNums.Z)
    (n:Numbers.BinNums.Z) (k:Numbers.BinNums.Z) (j:Numbers.BinNums.Z),
  (i < n)%Z -> (0%Z <= k)%Z -> ((i + k)%Z < n)%Z ->
  ((Mint (shift a ((i + j)%Z + k)%Z)) =
   (nth (L_to_list Mint (shift a j) i n) k)).

(* Why3 goal *)
Theorem wp_goal :
  let x := (1%Z + rank)%Z in
  let a := global 593%Z in
  let a1 := global 595%Z in
  let a2 := global 596%Z in
  let x1 := ((-1%Z)%Z + rank)%Z in
  let a3 := global 603%Z in
  let a4 := shift a3 1%Z in
  let a5 := shift a3 0%Z in
  forall (t:addr -> Numbers.BinNums.Z) (t1:addr -> Numbers.BinNums.Z)
    (t2:addr -> Numbers.BinNums.Z) (t3:addr -> Numbers.BinNums.Z)
    (t4:addr -> Numbers.BinNums.Z) (t5:addr -> Numbers.BinNums.Z)
    (t6:addr -> Numbers.BinNums.Z) (i:Numbers.BinNums.Z) (c:S15_c_protocol)
    (c1:S15_c_protocol) (c2:S15_c_protocol) (c3:S15_c_protocol)
    (c4:S15_c_protocol) (c5:S15_c_protocol) (c6:S15_c_protocol)
    (c7:S15_c_protocol) (c8:S15_c_protocol) (c9:S15_c_protocol)
    (c10:S15_c_protocol) (c11:S15_c_protocol) (c12:S15_c_protocol)
    (c13:S15_c_protocol) (c14:S15_c_protocol) (c15:S15_c_protocol)
    (c16:S15_c_protocol) (c17:S15_c_protocol) (c18:S15_c_protocol)
    (c19:S15_c_protocol) (c20:S15_c_protocol) (c21:S15_c_protocol)
    (c22:S15_c_protocol) (c23:S15_c_protocol) (c24:S15_c_protocol)
    (c25:S15_c_protocol) (c26:S15_c_protocol) (c27:S15_c_protocol)
    (c28:S15_c_protocol) (c29:S15_c_protocol) (c30:S15_c_protocol)
    (c31:S15_c_protocol) (c32:S15_c_protocol) (c33:S15_c_protocol)
    (c34:S15_c_protocol) (c35:S15_c_protocol) (c36:S15_c_protocol)
    (t7:Numbers.BinNums.Z -> Numbers.BinNums.Z)
    (t8:Numbers.BinNums.Z -> Numbers.BinNums.Z) (i1:Numbers.BinNums.Z)
    (i2:Numbers.BinNums.Z),
  let a6 := L_get_type c20 in
  let a7 := L_get_type c10 in
  let a8 := L_get_type c23 in
  let a9 := getRight a8 in
  let a10 := L_get_type c in
  let a11 := getRight a10 in
  let x2 := t6 a in
  let a12 := L_get_type c34 in
  let x3 := t5 a1 in
  let a13 := getRight a6 in
  let a14 := getRight a7 in
  let a15 := L_get_type c32 in
  let a16 := getLeft a10 in
  let a17 := getLeft a8 in
  let a18 := split_right a16 (1%Z + i)%Z in
  let x4 := t4 a2 in
  let a19 := L_get_type c30 in
  let a20 := getRight a13 in
  let x5 := ZArith.BinInt.Z.quot x2 size in
  let a21 := L_get_type c35 in
  let a22 := L_get_type c33 in
  let a23 := L_get_type c31 in
  let a24 := L_get_type c28 in
  let a25 := L_get_type c25 in
  let a26 := L_get_type c18 in
  let a27 := L_get_type c15 in
  let a28 := L_get_type c12 in
  let a29 := L_get_type c11 in
  let a30 := L_get_type c8 in
  let a31 := L_get_type c5 in
  let a32 := L_get_type c2 in
  let a33 := L_get_type c24 in
  let a34 := getLeft a27 in
  let a35 := getLeft a31 in
  let a36 := getLeft a25 in
  let a37 := L_get_type c36 in
  let a38 := getLeft a37 in
  let a39 := L_get_type c27 in
  let a40 := L_get_type c17 in
  let a41 := L_get_type c14 in
  let a42 := L_get_type c7 in
  let a43 := L_get_type c4 in
  let a44 := havoc t6 t (shift a 0%Z) 1%Z in
  let a45 := L_to_list a44 a 0%Z 1%Z in
  let a46 := getLeft a12 in
  let a47 := havoc t5 a44 (shift a1 0%Z) 1%Z in
  let a48 := L_to_list a47 a1 0%Z 1%Z in
  let a49 := getLeft a15 in
  let a50 := havoc t4 a47 (shift a2 0%Z) 1%Z in
  let a51 := L_to_list a50 a2 0%Z 1%Z in
  let a52 := havoc t3 a50 a4 x5 in
  let a53 := shift a3 (1%Z + x5)%Z in
  let a54 := havoc t2 (map.Map.set (map.Map.set a52 a5 i2) a53 i1) a53 1%Z in
  let a55 := getLeft a28 in
  let a56 := L_to_list a54 a4 0%Z 1%Z in
  let a57 := havoc t1 a54 a5 1%Z in
  let a58 := getLeft a32 in
  let a59 := L_to_list a57 (shift a3 x5) 0%Z 1%Z in
  ~ (rank = 0%Z) -> ~ (x = size) -> ((getLeft a6) = protocol_6) ->
  ((getLeft a7) = protocol_7) -> (a9 = a11) -> ((protocol_1 x2) = a12) ->
  ((protocol_4 x3) = a10) -> ((getLeft a13) = protocol_7) ->
  ((getRight a14) = a11) -> ((protocol_2 x2 x3) = a15) ->
  ((split_right a16 0%Z) = a16) -> ((split_right a16 i) = a17) ->
  (a18 = (getLeft a14)) -> ((protocol_3 x2 x3 x4) = a19) ->
  ((getLeft a20) = a18) -> ((getRight a20) = a11) -> (0%Z < size)%Z ->
  (0%Z < rank)%Z -> (0%Z <= i)%Z -> (rank <= size)%Z -> (0%Z <= rank)%Z ->
  (rank < size)%Z -> (i < x3)%Z -> (0%Z <= x3)%Z -> (i <= x3)%Z ->
  (0%Z <= x5)%Z -> ((2%Z + rank)%Z <= size)%Z -> ((-1%Z)%Z <= x5)%Z ->
  (x5 <= 10000%Z)%Z -> (x5 <= 10001%Z)%Z -> size_constrain size ->
  is_sint32 i -> is_sint32 size -> is_sint32 rank ->
  P_set_type c36 the_protocol -> is_sint32 x1 -> is_sint32 x ->
  is_sint32 x2 -> is_sint32 x3 -> is_sint32 x4 -> is_sint32 x5 ->
  P_set_type c34 (simpl a21) -> P_set_type c32 (simpl a22) ->
  P_set_type c30 (simpl a23) -> P_set_type c28 (assoc (L_get_type c29)) ->
  P_set_type c27 (getRight a24) -> P_set_type c25 (assoc (L_get_type c26)) ->
  P_set_type c24 (getRight a25) -> P_set_type c21 (assoc (L_get_type c22)) ->
  P_set_type c20 (assoc (L_get_type c21)) ->
  P_set_type c18 (assoc (L_get_type c19)) -> P_set_type c17 (getRight a26) ->
  P_set_type c15 (assoc (L_get_type c16)) -> P_set_type c14 (getRight a27) ->
  P_set_type c12 (assoc (L_get_type c13)) -> P_set_type c11 (getRight a28) ->
  P_set_type c10 (getRight a29) -> P_set_type c8 (assoc (L_get_type c9)) ->
  P_set_type c7 (getRight a30) -> P_set_type c5 (assoc (L_get_type c6)) ->
  P_set_type c4 (getRight a31) -> P_set_type c2 (assoc (L_get_type c3)) ->
  P_set_type c1 (getRight a32) -> P_set_type c (getRight a33) ->
  isSkip (fsimpl (getLeft a24)) -> isSkip (fsimpl (getLeft a33)) ->
  isSkip (fsimpl (getLeft a26)) -> isSkip (fsimpl (getLeft a29)) ->
  isSkip (fsimpl (getLeft a30)) -> isMessageforIntRecv a34 x 1%Z 0%Z ->
  isMessageforIntRecv a35 x1 1%Z 0%Z -> isMessageforIntRecv a36 0%Z x5 0%Z ->
  isforIntBroadcast a38 0%Z 1%Z (L_to_list t a 0%Z 1%Z) ->
  P_set_type c26 (Seq (simpl (getLeft a39)) (getRight a39)) ->
  P_set_type c22 (Seq (simpl a17) a9) ->
  P_set_type c16 (Seq (simpl (getLeft a40)) (getRight a40)) ->
  P_set_type c13 (Seq (simpl (getLeft a41)) (getRight a41)) ->
  P_set_type c9 (Seq (split protocol_7 x1) a14) ->
  P_set_type c6 (Seq (simpl (getLeft a42)) (getRight a42)) ->
  P_set_type c3 (Seq (simpl (getLeft a43)) (getRight a43)) ->
  P_set_type c29 (Seq (split (getLeft a19) rank) (getRight a19)) ->
  P_set_type c19
  (Seq (split protocol_6 (((-1%Z)%Z + size)%Z + ((-1%Z)%Z * rank)%Z)%Z) a13) ->
  predIntBroadcast a38 a45 ->
  isforIntBroadcast a46 0%Z 1%Z (L_to_list a44 a1 0%Z 1%Z) ->
  countiIntBroadcast a38 (getRight a37) a21 a45 ->
  predIntBroadcast a46 a48 ->
  isforIntBroadcast a49 0%Z 1%Z (L_to_list a47 a2 0%Z 1%Z) ->
  countiIntBroadcast a46 (getRight a12) a22 a48 ->
  predIntBroadcast a49 a51 ->
  countiIntBroadcast a49 (getRight a15) a23 a51 ->
  predIntMessage a36 (L_to_list a52 a4 0%Z x5) ->
  predIntMessage a34 (L_to_list a54 a53 0%Z 1%Z) ->
  isPredIntMessage a55 a56 -> isMessageforIntSend a55 x1 1%Z 0%Z a56 ->
  predIntMessage a35 (L_to_list a57 a5 0%Z 1%Z) ->
  isPredIntMessage a58 a59 -> isMessageforIntSend a58 x 1%Z 0%Z a59 ->
  (forall (i3:Numbers.BinNums.Z), (0%Z <= i3)%Z -> (i3 <= 10001%Z)%Z ->
   (i3 < 0%Z)%Z \/ (x5 <= i3)%Z -> ((t8 i3) = (t7 i3))) ->
  isSkip (fsimpl (getLeft (L_get_type c1))).
Proof.
intros x a a1 a2 x1 a3 a4 a5 t t1 t2 t3 t4 t5 t6 i c c1 c2 c3 c4 c5 c6 c7 c8
c9 c10 c11 c12 c13 c14 c15 c16 c17 c18 c19 c20 c21 c22 c23 c24 c25 c26 c27
c28 c29 c30 c31 c32 c33 c34 c35 c36 t7 t8 i1 i2 a6 a7 a8 a9 a10 a11 x2 a12 x3
a13 a14 a15 a16 a17 a18 x4 a19 a20 x5 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30
a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47 a48 a49
a50 a51 a52 a53 a54 a55 a56 a57 a58 a59 h1 h2 h3 h4 h5 h6 h7 h8 h9 h10 h11
h12 h13 h14 h15 h16 h17 h18 h19 h20 h21 h22 h23 h24 h25 h26 h27 h28 h29 h30
h31 h32 h33 h34 h35 h36 h37 h38 h39 h40 h41 h42 h43 h44 h45 h46 h47 h48 h49
h50 h51 h52 h53 h54 h55 h56 h57 h58 h59 h60 h61 h62 h63 h64 h65 h66 h67 h68
h69 h70 h71 h72 h73 h74 h75 h76 h77 h78 h79 h80 h81 h82 h83 h84 h85 h86 h87
h88 h89 h90 h91 h92 h93 h94 h95 h96 h97 h98.
erewrite Q_link by apply h63.
unfold a32.
erewrite Q_link by apply h62.
erewrite Q_link by apply h80.
replace (getLeft a43) with (getLeft (L_get_type c4)) ;[ | unfold a43;reflexivity].
erewrite Q_link by apply h61.
unfold a31.
erewrite Q_link by apply h60.
erewrite Q_link by apply h79.
replace (getLeft a42) with (getLeft (L_get_type c7)) ;[ | unfold a42;reflexivity].
erewrite Q_link by apply h59.
unfold a30.
erewrite Q_link by apply h58.
erewrite Q_link by apply h78.
unfold protocol_7.
rewrite split_foreach by Lia.lia.
rewrite Assoc.
simpl.
rewrite simpl_foreach_1 by Lia.lia.
rewrite Assoc.
simpl.
rewrite simpl_foreach_1 by Lia.lia.
rewrite Assoc.
simpl.
rewrite fsimpl_foreach.
apply IsSkip.
intros.
unfold f3.
rewrite simpl_intmessage.
reflexivity.
Lia.lia.
Qed.