From mathcomp.ssreflect
Require Import ssreflect ssrbool ssrnat eqtype ssrfun seq.
From mathcomp
Require Import path.
Require Import Eqdep.
Require Import Relation_Operators.
From fcsl
Require Import axioms pred prelude ordtype finmap pcm unionmap heap.
From DiSeL
Require Import Freshness State EqTypeX DepMaps Protocols Worlds NetworkSem Rely.
From DiSeL
Require Import Actions Injection Process Always HoareTriples InferenceRules.
From DiSeL
Require Import InductiveInv While StatePredicates.
From DiSeL
Require Import TwoPhaseProtocol.

Require Import Omega.

Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

(* Module TwoPhaseInductiveInv. *)
Section TwoPhaseInductiveInv.

Variable l : Label.
Variables (cn : nid) (pts : seq nid) (others : seq nid).
Hypothesis Hnin : cn \notin pts.
Hypothesis PtsNonEmpty : pts != [::].

Lemma pt_not_cn pt : pt \in pts -> pt != cn.
Proof.
  move => H.
  case X: (pt == cn)=>//.
  move /eqP in X.
  subst.
  move: (Hnin) => /negbTE.
    by rewrite H.
Qed.

Definition tpc := TwoPhaseCommitProtocol others Hnin l.

(* Take the transitions *)
Notation sts := (snd_trans tpc).
Notation rts := (rcv_trans tpc).

Notation loc z d := (getLocal z d).

Definition cn_state (d : dstatelet) (c : CStateT) (l : Log) : Prop :=
  loc cn d = st :-> c \+ log :-> l.

Definition pt_state (d : dstatelet) (p : PStateT) (l : Log) (pt : nid) : Prop :=
  loc pt d = st :-> p \+ log :-> l.

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

(* Phase Zero *)

Definition EverythingInit (d : dstatelet) (round : nat) (l : Log) : Prop :=
  [/\ cn_state d (round, CInit) l &
      forall pt, pt \in pts ->
            [/\ pt_state d (round, PInit) l pt,
               no_msg_from_to pt cn (dsoup d) &
               no_msg_from_to cn pt (dsoup d)]].

(* Phase One *)

Definition pt_PhaseOne (d : dstatelet) (round : nat)
           (next_data : data) (l : Log) (pt : nid) : Prop :=
  [\/ [/\ pt_state d (round, PInit) l pt,
       no_msg_from_to pt cn (dsoup d) &
       msg_spec cn pt prep_req (round :: next_data) (dsoup d)]
   ,  [/\ pt_state d (round, PGotRequest next_data) l pt,
       no_msg_from_to pt cn (dsoup d) &
       no_msg_from_to cn pt (dsoup d)]
   ,  [/\ pt_state d (round, PRespondedYes next_data) l pt,
       no_msg_from_to cn pt (dsoup d) &
       msg_spec pt cn prep_yes [::round] (dsoup d)]
   |  [/\ pt_state d (round, PRespondedNo next_data) l pt,
       no_msg_from_to cn pt (dsoup d) &
       msg_spec pt cn prep_no [::round] (dsoup d)]].

Definition pt_PhaseOneResponded (d : dstatelet) (round : nat) (next_data : data)
           (l : Log) (committed : bool) (pt : nid) : Prop :=
  [/\ no_msg_from_to cn pt (dsoup d), no_msg_from_to pt cn (dsoup d) &
      if committed
      then pt_state d (round, PRespondedYes next_data) l pt
      else pt_state d (round, PRespondedNo next_data) l pt].

Definition pt_Init d round l pt :=
  [/\ pt_state d (round, PInit) l pt,
     no_msg_from_to pt cn (dsoup d) &
     no_msg_from_to cn pt (dsoup d)].

Definition cn_PhaseOneSend d round next_data l sent :=
    [/\ cn_state d (round, CSentPrep next_data sent) l,
     uniq sent, {subset sent <= pts} &
                forall pt, pt \in pts ->
                           if pt \in sent
                           then pt_PhaseOne d round next_data l pt
                           else pt_Init d round l pt].

Definition cn_PhaseOneReceive d round next_data l recvd :=
     let rps := map fst recvd in
     [/\ cn_state d (round, CWaitPrepResponse next_data recvd) l,
      uniq rps, {subset rps <= pts} ,
      forall pt b, pt \in pts -> (pt, b) \in recvd ->
                   pt_PhaseOneResponded d round next_data l b pt &
      forall pt,   pt \in pts -> pt \notin rps ->
                   pt_PhaseOne d round next_data l pt].

Definition PhaseOne (d : dstatelet) (round : nat) (next_data : data) (l : Log) :=
  (exists sent, cn_PhaseOneSend d round next_data l sent) \/
  (exists recvd, cn_PhaseOneReceive d round next_data l recvd).

(* Phase Two *)

Definition pt_PhaseTwoCommit d round next_data l pt :=
  [\/ [/\ pt_state d (round, PRespondedYes next_data) l pt,
       msg_spec cn pt commit_req [::round] (dsoup d) &
       no_msg_from_to pt cn (dsoup d)]
   , [/\ pt_state d (round, PCommitted next_data) (rcons l (true, next_data)) pt,
      no_msg_from_to cn pt (dsoup d) & no_msg_from_to pt cn (dsoup d)]
  | [/\ pt_state d (round.+1, PInit) (rcons l (true, next_data)) pt,
     no_msg_from_to cn pt (dsoup d) &
     msg_spec pt cn commit_ack [::round] (dsoup d)
  ]].

Definition pt_PhaseTwoAbort d round next_data l pt :=
  [\/ [/\ (pt_state d (round, PRespondedYes next_data) l pt \/
           pt_state d (round, PRespondedNo next_data) l pt),
       msg_spec cn pt abort_req [::round] (dsoup d) &
       no_msg_from_to pt cn (dsoup d)]
   , [/\ pt_state d (round, PAborted next_data) (rcons l (false, next_data)) pt,
      no_msg_from_to cn pt (dsoup d) & no_msg_from_to pt cn (dsoup d)]
  | [/\ pt_state d (round.+1, PInit) (rcons l (false, next_data)) pt,
     no_msg_from_to cn pt (dsoup d) &
     msg_spec pt cn abort_ack [::round] (dsoup d)
  ]].

Definition pt_PhaseTwoResponded d round next_data l b pt :=
  [/\ pt_state d (round.+1, PInit) (rcons l (b, next_data)) pt,
   no_msg_from_to cn pt (dsoup d) & no_msg_from_to pt cn (dsoup d)].

Definition cn_PhaseTwoSendCommits d round next_data l sent :=
     [/\ cn_state d (round, CSentCommit next_data sent) l,
      uniq sent, {subset sent <= pts} &
       forall pt, pt \in pts ->
       if pt \in sent
       then pt_PhaseTwoCommit d round next_data l pt
       else pt_PhaseOneResponded d round next_data l true pt].

Definition cn_PhaseTwoSendAborts d round next_data l sent :=
     [/\ cn_state d (round, CSentAbort next_data sent) l,
      uniq sent, {subset sent <= pts} &
      forall pt, pt \in pts ->
      if pt \in sent
      then pt_PhaseTwoAbort d round next_data l pt
      else exists b, pt_PhaseOneResponded d round next_data l b pt].

Definition cn_PhaseTwoReceiveCommits d round next_data l recvd :=
      [/\ cn_state d (round, CWaitAckCommit next_data recvd) l,
       uniq recvd, {subset recvd <= pts} &
       forall pt, pt \in pts ->
       if pt \in recvd
       then pt_PhaseTwoResponded d round next_data l true pt
       else pt_PhaseTwoCommit d round next_data l pt].

Definition cn_PhaseTwoReceiveAborts d round next_data l recvd :=
     [/\ cn_state d (round, CWaitAckAbort next_data recvd) l,
      uniq recvd, {subset recvd <= pts} &
      forall pt, pt \in pts ->
      if pt \in recvd
      then pt_PhaseTwoResponded d round next_data l false pt
      else pt_PhaseTwoAbort d round next_data l pt].

Definition PhaseTwoCommit d round next_data lg :=
  [\/ exists sent : seq nid, cn_PhaseTwoSendCommits d round next_data lg sent |
     exists recvd : seq nid, cn_PhaseTwoReceiveCommits d round next_data lg recvd ].

Definition PhaseTwoAbort d round next_data lg :=
  [\/ exists sent : seq nid, cn_PhaseTwoSendAborts d round next_data lg sent |
     exists recvd : seq nid, cn_PhaseTwoReceiveAborts d round next_data lg recvd ].

Definition PhaseTwo (d : dstatelet) (round : nat) (next_data : data) (l : Log) :=
  [\/ exists sent, cn_PhaseTwoSendCommits d round next_data l sent,
     exists sent, cn_PhaseTwoSendAborts d round next_data l sent,
     exists recvd, cn_PhaseTwoReceiveCommits d round next_data l recvd |
   exists recvd, cn_PhaseTwoReceiveAborts d round next_data l recvd].

Definition Inv (d : dstatelet) :=
  exists round l,
  [\/ EverythingInit d round l
   , exists next_data, PhaseOne d round next_data l
  | exists next_data, PhaseTwo d round next_data l].

(***********************************************************)
(* Elimination lemmas for the invariant to deal with cases *)
(***********************************************************)

Notation coh d := (coh tpc d).
Notation PI := pf_irr.
Export TPCProtocol.

Lemma inv_init d e (C : coh d):
  Inv d -> getStC C = (e, CInit) -> exists lg, EverythingInit d e lg.
Proof.
case=>e'[lg][]=>[|[nd]|[nd]];
do?[by case; case=>xs[]=>E1; rewrite (getStC_K C E1)].
by case=>E1 H; rewrite (getStC_K C E1); case=>Z; subst e'; exists lg.
Qed.

Lemma inv_prep_send d e dt ps (C : coh d):
  Inv d -> getStC C = (e, CSentPrep dt ps) ->
  exists lg sent, cn_PhaseOneSend d e dt lg sent.
Proof.
case=>e'[lg][]=>[|[nd]|[nd]];
 last by case; case=>xs[]=>E1; rewrite (getStC_K C E1).
- by case=>E1 H; rewrite (getStC_K C E1).
case; last by case=>[?]/=[]E1; rewrite (getStC_K C E1).
case=>xs[E1]H1 H2 H3; rewrite (getStC_K C E1); case=>Z1 Z2 Z3.
by subst e' nd xs; exists lg, ps.
Qed.

Lemma inv_waitprep d r (C : coh d) next_data recvd:
  Inv d -> getStC C = (r, CWaitPrepResponse next_data recvd) ->
  exists lg, cn_PhaseOneReceive d r next_data lg recvd.
Proof.
case=>r'[lg][]=>[|[nd]|[nd]].
by case=> CS; rewrite (getStC_K C CS).
case; case => x[]CS; rewrite (getStC_K C CS)//.
by move=>H1 H2 H3 H4; case=><-<-<-; eexists; split; eauto.
by case; case => x[]CS; rewrite (getStC_K C CS).
Qed.

Lemma inv_sentcommit d r (C : coh d) next_data sent:
  Inv d -> getStC C = (r, CSentCommit next_data sent) ->
  exists lg, cn_PhaseTwoSendCommits d r next_data lg sent.
Proof.
case=>r'[lg][]=>[|[nd]|[nd]].
by case=> CS; rewrite (getStC_K C CS).
by case; case => x[]CS; rewrite (getStC_K C CS).
case; case => x[]CS; rewrite (getStC_K C CS)//.
move=>H1 H2 H3. case. intros. subst.
eexists; split; eauto.
Qed.

Lemma inv_sentabort d r (C : coh d) next_data sent:
  Inv d -> getStC C = (r, CSentAbort next_data sent) ->
  exists lg, cn_PhaseTwoSendAborts d r next_data lg sent.
Proof.
case=>r'[lg][]=>[|[nd]|[nd]].
by case=> CS; rewrite (getStC_K C CS).
by case; case => x[]CS; rewrite (getStC_K C CS).
case; case => x[]CS; rewrite (getStC_K C CS)//.
move=>H1 H2 H3. case. intros. subst.
eexists; split; eauto.
Qed.

Lemma inv_waitcommit d r (C : coh d) next_data sent:
  Inv d -> getStC C = (r, CWaitAckCommit next_data sent) ->
  exists lg, cn_PhaseTwoReceiveCommits d r next_data lg sent.
Proof.
case=>r'[lg][]=>[|[nd]|[nd]].
by case=> CS; rewrite (getStC_K C CS).
by case; case => x[]CS; rewrite (getStC_K C CS).
case; case => x[]CS; rewrite (getStC_K C CS)//.
move=>H1 H2 H3. case. intros. subst.
eexists; split; eauto.
Qed.

Lemma inv_waitabort d r (C : coh d) next_data sent:
  Inv d -> getStC C = (r, CWaitAckAbort next_data sent) ->
  exists lg, cn_PhaseTwoReceiveAborts d r next_data lg sent.
Proof.
case=>r'[lg][]=>[|[nd]|[nd]].
by case=> CS; rewrite (getStC_K C CS).
by case; case => x[]CS; rewrite (getStC_K C CS).
case; case => x[]CS; rewrite (getStC_K C CS)//.
move=>H1 H2 H3. case. intros. subst.
eexists; split; eauto.
Qed.

Lemma prep_no_pt_inv d i m pt round next_data lg :
  tag m = prep_no ->
  find i (dsoup d) =
  Some {| content := m; from := pt; to := cn; active := true |} ->
  pt_PhaseOne d round next_data lg pt ->
  [/\ pt_state d (round, PRespondedNo next_data) lg pt,
       no_msg_from_to cn pt (dsoup d) &
       msg_spec pt cn prep_no [::round] (dsoup d)].
Proof.
move=>T F[][]H1 H2 H3; do?[by move: (H2 _ _ _ F)]; split=>//;
by case : m F T=>t c/= F Z; subst t; case:H3=>_/(_ _ _ _ F).
Qed.

Lemma prep_yes_pt_inv d i m pt round next_data lg :
  tag m = prep_yes ->
  find i (dsoup d) =
  Some {| content := m; from := pt; to := cn; active := true |} ->
  pt_PhaseOne d round next_data lg pt ->
  [/\ pt_state d (round, PRespondedYes next_data) lg pt,
       no_msg_from_to cn pt (dsoup d) &
       msg_spec pt cn prep_yes [::round] (dsoup d)].
Proof.
move=>T F[][]H1 H2 H3; do?[by move: (H2 _ _ _ F)]; split=>//;
by case : m F T=>t c/= F Z; subst t; case:H3=>_/(_ _ _ _ F).
Qed.

Lemma commit_ack_pt_inv d i m pt round next_data lg :
  tag m = commit_ack ->
  find i (dsoup d) =
    Some {| content := m; from := pt; to := cn; active := true |} ->
  pt_PhaseTwoCommit d round next_data lg pt ->
  [/\ pt_state d (round.+1, PInit) (rcons lg (true, next_data)) pt,
        no_msg_from_to cn pt (dsoup d)
      & msg_spec pt cn Exports.commit_ack [:: round] (dsoup d)].
Proof.
  by move=>T F[][]// _ _ /(_ _ _ _ F).
Qed.

Lemma abort_ack_pt_inv d i m pt round next_data lg :
  tag m = abort_ack ->
  find i (dsoup d) =
    Some {| content := m; from := pt; to := cn; active := true |} ->
  pt_PhaseTwoAbort d round next_data lg pt ->
  [/\ pt_state d (round.+1, PInit) (rcons lg (false, next_data)) pt,
        no_msg_from_to cn pt (dsoup d)
      & msg_spec pt cn Exports.abort_ack [:: round] (dsoup d)].
Proof.
  by move=>T F[][]// _ _ /(_ _ _ _ F).
Qed.

Lemma prep_req_cn_inv d i m pt :
  tag m = prep_req ->
  pt \in pts ->
  find i (dsoup d) =
    Some {| content := m; from := cn; to := pt; active := true |} ->
  Inv d ->
  exists round lg next_data, PhaseOne d round next_data lg.
Proof.
  case: m=>t m /=T. subst t.
  move=>Hpt F [r][lg][].
  - by move=>[] _ /(_ _ Hpt)[] _ _ /(_ _ _ _ F).
  - move=>[nd]. by eauto.
  - move=>[nd][][l1][] _ _ _ /(_ _ Hpt); case: ifP => _ []; (try case); (try case);
    do?[by move=>_ /(_ _ _ _ F)];
    do?[by move=>/(_ _ _ _ F)];
    by move=>_ []_ /(_ _ _ _ F)/=.
Qed.

Lemma prep_req_pt_inv d i m pt round next_data lg :
  find i (dsoup d) =
  Some {| content := m; from := cn; to := pt; active := true |} ->
  pt_PhaseOne d round next_data lg pt ->
  [/\ pt_state d (round, PInit) lg pt, no_msg_from_to pt cn (dsoup d)
      & msg_spec cn pt Exports.prep_req (round :: next_data) (dsoup d)].
Proof.
by move=>F[][]H1 H2 H3; do?[by move: (H2 _ _ _ F)]; do?[by move: (H3 _ _ _ F)]; split=>//.
Qed.

Lemma commit_req_pt_inv d i m pt round next_data lg :
  find i (dsoup d) =
  Some {| content := m; from := cn; to := pt; active := true |} ->
  pt_PhaseTwoCommit d round next_data lg pt ->
  [/\ pt_state d (round, PRespondedYes next_data) lg pt,
        msg_spec cn pt Exports.commit_req [:: round] (dsoup d)
      & no_msg_from_to pt cn (dsoup d)].
Proof.
by move=>F[][]H1 H2 H3; do?[by move: (H2 _ _ _ F)]; do?[by move: (H3 _ _ _ F)]; split=>//.
Qed.

Lemma abort_req_pt_inv d i m pt round next_data lg :
  find i (dsoup d) =
  Some {| content := m; from := cn; to := pt; active := true |} ->
  pt_PhaseTwoAbort d round next_data lg pt ->
[/\ pt_state d (round, PRespondedYes next_data) lg pt \/
        pt_state d (round, PRespondedNo next_data) lg pt,
        msg_spec cn pt Exports.abort_req [:: round] (dsoup d)
      & no_msg_from_to pt cn (dsoup d)].
Proof.
 move=>F[][]H1 H2 H3; do?[by move: (H2 _ _ _ F)]; do?[by move: (H3 _ _ _ F)]; split=>//.
Qed.

Lemma in_map_exists (x : nid) xs :
  (exists b : bool, (x, b) \in xs) \/ x \notin map fst xs.
Proof.
  case H: (x \in map fst xs); last by right.
  left.
  case/mapP: H =>[][y b] H/=->.
  eauto.
Qed.

Lemma commit_req_cn_inv d i m pt :
  tag m = commit_req ->
  pt \in pts ->
  find i (dsoup d) =
    Some {| content := m; from := cn; to := pt; active := true |} ->
  Inv d ->
  exists round lg next_data,
    PhaseTwoCommit d round next_data lg.
Proof.
  case: m=>t m /=T. subst t.
  move=>Hpt F [r][lg][].
  - by move=>[] _ /(_ _ Hpt)[] _ _ /(_ _ _ _ F).
  - move=>[nd] [][l1][] _ _ _.
    + move/(_ _ Hpt).
      case: ifP=>_ [][];
      do?[by move=>_ _ /(_ _ _ _ F)];
      do?[by move=>_ /(_ _ _ _ F)];
      do?[by move=>/(_ _ _ _ F)];
      by move=>_ _ []_ /(_ _ _ _ F)/=.
    + case: (in_map_exists pt l1).
      * move=>[b] H /(_ _ _ Hpt H) [].
        by move=>/(_ _ _ _ F).
      * move=>H _ /(_ _ Hpt H) [][];
        do?[by move=>_ _ /(_ _ _ _ F)];
        do?[by move=>_ /(_ _ _ _ F)];
        do?[by move=>/(_ _ _ _ F)];
        by move=>_ _ []_ /(_ _ _ _ F)/=.
  - unfold PhaseTwoCommit.
    move=>[nd][][l1]; eauto 10 => [][] CS U S /(_ _ Hpt); case: ifP=> _ [][][];
    do?[by move=>_ _ /(_ _ _ _ F)];
    do?[by move=>_ /(_ _ _ _ F)];
    do?[by move=>/(_ _ _ _ F)];
    by move=>_ []_ /(_ _ _ _ F).
Qed.

Lemma abort_req_cn_inv d i m pt :
  tag m = abort_req ->
  pt \in pts ->
  find i (dsoup d) =
    Some {| content := m; from := cn; to := pt; active := true |} ->
  Inv d ->
  exists round lg next_data,
    PhaseTwoAbort d round next_data lg.
Proof.
  case: m=>t m /=T. subst t.
  move=>Hpt F [r][lg][].
  - by move=>[] _ /(_ _ Hpt)[] _ _ /(_ _ _ _ F).
  - move=>[nd] [][l1][] _ _ _.
    + move/(_ _ Hpt).
      case: ifP=>_ [][];
      do?[by move=>_ _ /(_ _ _ _ F)];
      do?[by move=>_ /(_ _ _ _ F)];
      do?[by move=>/(_ _ _ _ F)];
      by move=>_ _ []_ /(_ _ _ _ F)/=.
    + case: (in_map_exists pt l1).
      * move=>[b] H /(_ _ _ Hpt H) [].
        by move=>/(_ _ _ _ F).
      * move=>H _ /(_ _ Hpt H) [][];
        do?[by move=>_ _ /(_ _ _ _ F)];
        do?[by move=>_ /(_ _ _ _ F)];
        do?[by move=>/(_ _ _ _ F)];
        by move=>_ _ []_ /(_ _ _ _ F)/=.
  - unfold PhaseTwoAbort.
    move=>[nd][][l1]; eauto 10 => [][] CS U S /(_ _ Hpt); case: ifP=> _[]; (try case); (try case);
    do?[by move=>_ _ /(_ _ _ _ F)];
    do?[by move=>_ /(_ _ _ _ F)];
    do?[by move=>/(_ _ _ _ F)];
    try by move=>_ []_ /(_ _ _ _ F).
Qed.

Lemma PhaseTwoCommit_req_round d i m pt round lg next_data :
  tag m = commit_req ->
  pt \in pts ->
  find i (dsoup d) =
    Some {| content := m; from := cn; to := pt; active := true |} ->
  PhaseTwoCommit d round next_data lg ->
  exists ps, pt_state d (round, ps) lg pt.
Proof.
  move=>T Hpt F [][l1][] CS U S /(_ _ Hpt); case: ifP=>_[]; try case; eauto;
   do?[by move=>_ _ /(_ _ _ _ F)];
   do?[by move=>_ /(_ _ _ _ F)].
Qed.

Lemma PhaseTwoAbort_req_round d i m pt round lg next_data :
  tag m = abort_req ->
  pt \in pts ->
  find i (dsoup d) =
    Some {| content := m; from := cn; to := pt; active := true |} ->
  PhaseTwoAbort d round next_data lg ->
  exists ps, pt_state d (round, ps) lg pt.
Proof.
  move=>T Hpt F [][l1][] CS U S /(_ _ Hpt); case: ifP=>_[]; try case; try case; eauto;
   do?[by move=>_ _ /(_ _ _ _ F)];
   do?[by move=>_ /(_ _ _ _ F)].
Qed.

Lemma PhaseTwoAbort_round_cn d round lg next_data :
  PhaseTwoAbort d round next_data lg ->
  exists cs, cn_state d (round, cs) lg.
Proof.
  move=>[][l1][]; eauto.
Qed.

Lemma PhaseTwoCommit_round_cn d round lg next_data :
  PhaseTwoCommit d round next_data lg ->
  exists cs, cn_state d (round, cs) lg.
Proof.
  move=>[][l1][]; eauto.
Qed.

Lemma PhaseOne_round_cn d round lg next_data :
  PhaseOne d round next_data lg ->
  exists cs, cn_state d (round, cs) lg.
Proof.
  move=>[][l1][]; eauto.
Qed.

Lemma PhaseOne_round_pt d pt round lg next_data :
  pt \in pts ->
  PhaseOne d round next_data lg ->
  exists ps, pt_state d (round, ps) lg pt.
Proof.
  move=>Hpt [][l1][] CS U Sub.
  - move=>/(_ _ Hpt).
    case: ifP; move=>_ [][]; eauto.
  - case: (in_map_exists pt l1).
    + move=>[b] H /(_ _ _ Hpt H) [].
      case: b H; by eauto.
    + move=>H _ /(_ _ Hpt H) [][]; by eauto.
Qed.

Lemma c_matches_tag_prep_yes_inv cs :
  c_matches_tag cs prep_yes ->
  exists next_data recvd,
    cs = CWaitPrepResponse next_data recvd.
Proof.
  case: cs=>//=.
  eauto.
Qed.

Lemma c_matches_tag_prep_no_inv cs :
  c_matches_tag cs prep_no ->
  exists next_data recvd,
    cs = CWaitPrepResponse next_data recvd.
Proof.
  case: cs=>//=.
  eauto.
Qed.

Lemma c_matches_tag_commit_ack_inv cs :
  c_matches_tag cs commit_ack ->
  exists next_data recvd,
    cs = CWaitAckCommit next_data recvd.
Proof.
  case: cs=>//=.
  eauto.
Qed.

Lemma c_matches_tag_abort_ack_inv cs :
  c_matches_tag cs abort_ack ->
  exists next_data recvd,
    cs = CWaitAckAbort next_data recvd.
Proof.
  case: cs=>//=.
  eauto.
Qed.

Lemma pt_state_functional d pt ps1 lg1 ps2 lg2 :
  valid (loc pt d) ->
  pt_state d ps1 lg1 pt ->
  pt_state d ps2 lg2 pt ->
  ps1 = ps2 /\ lg1 = lg2.
Proof.
  move=>V.
  rewrite/pt_state=> H.
  move: V.
  rewrite H => V.
  move /(hcancelV V) => [] ?. subst.
  move=> V1.
  by move /(hcancelPtV V1)=>->.
Qed.

Lemma PhaseOne_PGotRequest_next_data_pt d pt round lg next_data r nd :
  coh d ->
  pt \in pts ->
  pt_state d (r, PGotRequest nd) lg pt ->
  PhaseOne d round next_data lg ->
  [/\ pt_state d (round, PGotRequest next_data) lg pt, no_msg_from_to pt cn (dsoup d)
      & no_msg_from_to cn pt (dsoup d)].
Proof.
move=>C Hpt PS [].
- move=>[sent][] _ _ _ /(_ pt Hpt).
  case: ifP=>_[][] PS';
  move: C=>[] _ _ _ /(_ _ (pts_in cn others Hpt)) [] V _;
  move: (pt_state_functional V PS PS')=>[]; try discriminate;
  by case.
- move=>[recvd][] _ _ _ Hrecvd1 Hrecvd2.
  case (in_map_exists pt recvd).
  + move=>[b] H.
    move: (Hrecvd1 _ _ Hpt H)=>[] _.
    case: ifP=>_ _ PS';
    move: C=>[] _ _ _ /(_ _ (pts_in cn others Hpt)) [] V _;
    move: (pt_state_functional V PS PS')=>[]; try discriminate;
    by case.
  + move=> H.
    move: (Hrecvd2 _ Hpt H)=>[][] PS';
    move: C=>[] _ _ _ /(_ _ (pts_in cn others Hpt)) [] V _;
    move: (pt_state_functional V PS PS')=>[]; try discriminate;
    by case.
Qed.

Lemma inv_gotrequest d r nd (C : coh d) this (Hthis : this \in nodes cn pts others) :
  this \in pts ->
  getStP Hnin C Hthis = (r, PGotRequest nd) ->
  Inv d ->
  exists lg, PhaseOne d r nd lg.
Proof.
  move=>HthisPt PS [r'][lg][].
  - move=>[]CS /( _ this HthisPt)[] H.
    move: PS.
    rewrite (getStP_K Hnin C Hthis HthisPt H) => [].
    discriminate.
  - move=>[nd'] PO.
    move: (PhaseOne_round_pt HthisPt PO)=>[ps] PS'.
    move: PS.
    rewrite (getStP_K Hnin C Hthis HthisPt PS').
    case=>? ?. subst.
    move: (PhaseOne_PGotRequest_next_data_pt C HthisPt PS' PO) => [] PS''.
    move: C=>[] _ _ _ /(_ _ (pts_in cn others HthisPt)) [] V _.
    move: (pt_state_functional V PS' PS'')=>[][] ? ?. subst.
    by eauto.
  - move=>[nd'] [][l1][] _ _ _ /(_ this HthisPt);
    case: ifP=> _[]; (try case); (try case); intros;
    match goal with
    | [ PS' : pt_state _ _ _ _ |- _ ] =>
      move: PS;
        rewrite (getStP_K Hnin C Hthis HthisPt PS')
    end; discriminate.
Qed.

Lemma inv_committed d r nd (C : coh d) this (Hthis : this \in nodes cn pts others) :
  this \in pts ->
  getStP Hnin C Hthis = (r, PCommitted nd) ->
  Inv d ->
  exists lg, PhaseTwo d r nd lg.
Proof.
  move=>HthisPt PS [r'][lg][].
  - move=>[]CS /( _ this HthisPt)[] H.
    move: PS.
    rewrite (getStP_K Hnin C Hthis HthisPt H) => [].
    discriminate.
  - move=>[nd'] [][l1][] _ _ _.
    + move /(_ this HthisPt).
      case: ifP=> _[]; (try case); (try case); intros;
      match goal with
      | [ PS' : pt_state _ _ _ _ |- _ ] =>
        move: PS;
          rewrite (getStP_K Hnin C Hthis HthisPt PS')
      end; discriminate.
    + case: (in_map_exists this l1).
      * move=>[b] H /(_ _ _ HthisPt H)[] _ _.
        case: ifP=> _[]; (try case); (try case); intros;
        match goal with
        | [ PS' : pt_state _ _ _ _ |- _ ] =>
          move: PS;
            rewrite (getStP_K Hnin C Hthis HthisPt PS')
        end; discriminate.
      * move=>H _ /(_ _ HthisPt H)[][];
        intros;
        match goal with
        | [ PS' : pt_state _ _ _ _ |- _ ] =>
          move: PS;
            rewrite (getStP_K Hnin C Hthis HthisPt PS')
        end; discriminate.
  - move=>[nd'] PT.
    exists lg.
    case: PT=>[][l1] I; [constructor 1|constructor 2|constructor 3|constructor 4];
    exists l1; case: I => CS U S H.
    + move: (H this HthisPt).
      case: ifP.
      * move=> _ [][] PS' _ _.
        -- move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
           discriminate.
        -- move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
           case=>? ?. subst.
           done.
        -- move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
           discriminate.
      * move=> _ [] _ _ PS'.
        move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
        discriminate.
    + move: (H this HthisPt).
      case: ifP.
      * move=> _ [][] [] PS' _ _.
        -- move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
           discriminate.
        -- move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
           discriminate.
        -- move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
           discriminate.
        -- move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
           discriminate.
      * move=> _ [b] [] _ _; case: ifP => _ PS';
        move: PS; rewrite (getStP_K Hnin C Hthis HthisPt PS');
        discriminate.
    + move: (H this HthisPt).
      case: ifP.
      * move=> _ [][] [] PS' _ _.
        move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
        discriminate.
      * move=> _ [][] PS' _ _;
        move: PS; rewrite (getStP_K Hnin C Hthis HthisPt PS');
        try discriminate.
        case=> ? ?. subst.
        done.
    + move: (H this HthisPt).
      case: ifP.
      * move=> _ [][] [] PS' _ _.
        move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
        discriminate.
      * move=> _ [][] [] PS' _ _;
        move: PS; rewrite (getStP_K Hnin C Hthis HthisPt PS');
        discriminate.
Qed.

Lemma inv_aborted d r nd (C : coh d) this (Hthis : this \in nodes cn pts others) :
  this \in pts ->
  getStP Hnin C Hthis = (r, PAborted nd) ->
  Inv d ->
  exists lg, PhaseTwo d r nd lg.
Proof.
  move=>HthisPt PS [r'][lg][].
  - move=>[]CS /( _ this HthisPt)[] H.
    move: PS.
    rewrite (getStP_K Hnin C Hthis HthisPt H) => [].
    discriminate.
  - move=>[nd'] [][l1][] _ _ _.
    + move /(_ this HthisPt).
      case: ifP=> _[]; (try case); (try case); intros;
      match goal with
      | [ PS' : pt_state _ _ _ _ |- _ ] =>
        move: PS;
          rewrite (getStP_K Hnin C Hthis HthisPt PS')
      end; discriminate.
    + case: (in_map_exists this l1).
      * move=>[b] H /(_ _ _ HthisPt H)[] _ _.
        case: ifP=> _[]; (try case); (try case); intros;
        match goal with
        | [ PS' : pt_state _ _ _ _ |- _ ] =>
          move: PS;
            rewrite (getStP_K Hnin C Hthis HthisPt PS')
        end; discriminate.
      * move=>H _ /(_ _ HthisPt H)[][];
        intros;
        match goal with
        | [ PS' : pt_state _ _ _ _ |- _ ] =>
          move: PS;
            rewrite (getStP_K Hnin C Hthis HthisPt PS')
        end; discriminate.
  - move=>[nd'] PT.
    exists lg.
    case: PT=>[][l1] I; [constructor 1|constructor 2|constructor 3|constructor 4];
    exists l1; case: I => CS U S H.
    + move: (H this HthisPt).
      case: ifP.
      * move=> _ [][][] PS' _ _.
        -- move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
           discriminate.
        -- move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
           discriminate.
        -- move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
           discriminate.
      * move=> _ [] _ _ PS'.
        move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
        discriminate.
    + move: (H this HthisPt).
      case: ifP.
      * move=> _ [][] [] PS' _ _.
        -- move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
           discriminate.
        -- move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
           discriminate.
        -- move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
           case=>? ?. subst.
           done.
        -- move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
           discriminate.
      * move=> _ [b] [] _ _; case: ifP => _ PS';
        move: PS; rewrite (getStP_K Hnin C Hthis HthisPt PS');
        discriminate.
    + move: (H this HthisPt).
      case: ifP.
      * move=> _ [][] [] PS' _ _.
        move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
        discriminate.
      * move=> _ [][] PS' _ _;
        move: PS; rewrite (getStP_K Hnin C Hthis HthisPt PS');
        try discriminate.
    + move: (H this HthisPt).
      case: ifP.
      * move=> _ [][] [] PS' _ _.
        move: PS. rewrite (getStP_K Hnin C Hthis HthisPt PS').
        discriminate.
      * move=> _ [][] [] PS' _ _;
        move: PS; rewrite (getStP_K Hnin C Hthis HthisPt PS');
          try discriminate.
        case=> ? ?. subst.
        done.
Qed.

(***********************************************************)
(* Lemmas about specific sub-predicates *)

Lemma pt_PhaseOneE d e dt lg pt to ds tms:
  let d' :=   {|
    dstate := upd cn ds (dstate d);
    dsoup := (post_msg (dsoup d) (Msg tms cn to true)).1
  |} in
  coh d -> pt \in pts -> pt == to = false ->
  (forall z : nat, (z == cn) = false -> loc z d' = loc z d) ->
  pt_PhaseOne d e dt lg pt ->
  pt_PhaseOne d' e dt lg pt.
Proof.
move=>d' C Hp N G.
have X : pt == cn = false.
+ by apply/negbTE/negP=>/eqP Z; subst pt; move: (Hnin); rewrite Hp.
move: (G _ X)=>{G}G.
case; rewrite /pt_state=>[[E1]]M1 M2;
[constructor 1|constructor 2|constructor 3|constructor 4];
rewrite /pt_state/= G; rewrite eq_sym in X.
- split=>//; first by apply: (no_msg_from_toE' (cohVs C)).
  by move: (msg_specE' tms (cohVs C) N M2)=>/=.
- split=>//; first by apply: (no_msg_from_toE' (cohVs C)).
  by apply: (no_msg_from_toE (cohVs C)).
- split=>//; first by apply: (no_msg_from_toE (cohVs C)).
  apply: (msg_specE'' to tms (cohVs C) _ M2).
  by rewrite eq_sym in X.
split=>//;first by apply: (no_msg_from_toE (cohVs C)).
by apply: (msg_specE'' to tms (cohVs C) _ M2); rewrite eq_sym in X.
Qed.

Lemma pt_PhaseOneRespondedE d e dt lg b pt to ds tms:
  let d' :=   {|
    dstate := upd cn ds (dstate d);
    dsoup := (post_msg (dsoup d) (Msg tms cn to true)).1
  |} in
  coh d -> pt \in pts -> pt == to = false ->
  (forall z : nat, (z == cn) = false -> loc z d' = loc z d) ->
  pt_PhaseOneResponded d e dt lg b pt ->
  pt_PhaseOneResponded d' e dt lg b pt.
Proof.
move=>d' C Hp N G.
have X : pt == cn = false.
+ by apply/negbTE/negP=>/eqP Z; subst pt; move: (Hnin); rewrite Hp.
move: (G _ X)=>{G}G; case=>M1 M2; case: b=> E1;
split=>//; rewrite /d/=; first by apply: (no_msg_from_toE (cohVs C)).
+ by apply: (no_msg_from_toE' (cohVs C))=>//; rewrite eq_sym.
+ by rewrite /pt_state in E1 *; rewrite G.
+ by apply: (no_msg_from_toE (cohVs C)).
+ by apply: (no_msg_from_toE' (cohVs C))=>//; rewrite eq_sym.
by rewrite /pt_state in E1 *; rewrite G.
Qed.

Lemma pt_PhaseTwoCommitE d e dt lg pt to ds tms:
  let d' :=   {|
    dstate := upd cn ds (dstate d);
    dsoup := (post_msg (dsoup d) (Msg tms cn to true)).1
  |} in
  coh d -> pt \in pts -> pt == to = false ->
  (forall z : nat, (z == cn) = false -> loc z d' = loc z d) ->
  pt_PhaseTwoCommit d e dt lg pt ->
  pt_PhaseTwoCommit d' e dt lg pt.
Proof.
move=>d' C Hp N G.
have X : pt == cn = false.
+ by apply/negbTE/negP=>/eqP Z; subst pt; move: (Hnin); rewrite Hp.
move: (G _ X)=>{G}G.
case; rewrite /pt_state=>[[E1]]M1 M2;
[constructor 1|constructor 2|constructor 3];
rewrite /pt_state/= G; rewrite eq_sym in X.
- split=>//; first by move: (msg_specE' tms (cohVs C) N M1)=>/=.
  by apply: (no_msg_from_toE' (cohVs C)).
- split=>//; first by apply: (no_msg_from_toE (cohVs C)).
  by apply: (no_msg_from_toE' (cohVs C)).
split=>//; first by apply: (no_msg_from_toE (cohVs C)).
by apply: (msg_specE'' to tms (cohVs C) _ M2); rewrite eq_sym.
Qed.

Lemma pt_PhaseTwoAbortE d e dt lg pt to ds tms:
  let d' :=   {|
    dstate := upd cn ds (dstate d);
    dsoup := (post_msg (dsoup d) (Msg tms cn to true)).1
  |} in
  coh d -> pt \in pts -> pt == to = false ->
  (forall z : nat, (z == cn) = false -> loc z d' = loc z d) ->
  pt_PhaseTwoAbort d e dt lg pt ->
  pt_PhaseTwoAbort d' e dt lg pt.
Proof.
move=>d' C Hp N G.
have X : pt == cn = false.
+ by apply/negbTE/negP=>/eqP Z; subst pt; move: (Hnin); rewrite Hp.
move: (G _ X)=>{G}G.
case; rewrite /pt_state=>[[E1]]M1 M2;
[constructor 1|constructor 2|constructor 3];
rewrite /pt_state/= G; rewrite eq_sym in X.
- split=>//; first by move: (msg_specE' tms (cohVs C) N M1)=>/=.
  by apply: (no_msg_from_toE' (cohVs C)).
- split=>//; first by apply: (no_msg_from_toE (cohVs C)).
  by apply: (no_msg_from_toE' (cohVs C)).
split=>//; first by apply: (no_msg_from_toE (cohVs C)).
by apply: (msg_specE'' to tms (cohVs C) _ M2); rewrite eq_sym.
Qed.

Lemma cn_state_consume d ds cs lg i n :
  let: d' := {|
       dstate := upd n ds (dstate d);
       dsoup := consume_msg (dsoup d) i
  |} in
  cn != n ->
  coh d ->
  cn_state d cs lg ->
  cn_state d' cs lg.
Proof.
  move=>N C.
  by rewrite /cn_state locU// (cohVl C).
Qed.

Lemma pt_state_consume d ds ps lg pt i n :
  let: d' := {|
       dstate := upd n ds (dstate d);
       dsoup := consume_msg (dsoup d) i
  |} in
  pt != n ->
  coh d ->
  pt_state d ps lg pt ->
  pt_state d' ps lg pt .
Proof.
  move => N C H.
  by rewrite /pt_state locU // (cohVl C).
Qed.

Lemma pt_InitE_consume d e lg pt ds i from to m:
  let: d' :=   {|
    dstate := upd to ds (dstate d);
    dsoup := consume_msg (dsoup d) i
  |} in
  coh d -> pt \in pts ->
  pt != from ->
  pt != to ->
  find i (dsoup d) =
  Some {| content := m; from := from; to := to; active := true |} ->
  pt_Init d e lg pt ->
  pt_Init d' e lg pt.
Proof.
  move=>C Hpt N1 N2 F [] PS NM1 NM2.
  have Vst := cohVs C.
  split.
  + by apply /pt_state_consume.
  + by apply /no_msg_from_to_consume.
  + by apply /no_msg_from_to_consume.
Qed.

Lemma pt_PhaseOneE_consume d e dt lg pt ds i from to m:
  let d' :=   {|
    dstate := upd to ds (dstate d);
    dsoup := consume_msg (dsoup d) i
  |} in
  coh d -> pt \in pts ->
  pt != from ->
  pt != to ->
  find i (dsoup d) =
  Some {| content := m; from := from; to := to; active := true |} ->
  pt_PhaseOne d e dt lg pt ->
  pt_PhaseOne d' e dt lg pt.
Proof.
  move => d' C Hpt.
  subst d'.
  have Npt: pt != cn by apply pt_not_cn.
  (* have Nfrom: from != cn by apply pt_not_cn. *)
  have Vst: valid (dsoup d) by apply /(cohVs C).
  move => N1 N2 F [][] PS NM1.
  - move => M.
    constructor 1.
    split.
    + by apply /pt_state_consume.
    + by apply /no_msg_from_to_consume.
    + by apply /(@msg_specE_consume2 (dsoup d) _ from pt to _ _ i m) => //.
  - move => NM2.
    constructor 2.
    split.
    + by apply /pt_state_consume.
    + by apply /no_msg_from_to_consume.
    + by apply /no_msg_from_to_consume.
  - move => M.
    constructor 3.
    split.
    + by apply /pt_state_consume.
    + by apply /no_msg_from_to_consume=>//.
    + by apply /(@msg_specE_consume1 (dsoup d) _ from _ to _ _ i m).
  - move => M.
    constructor 4.
    split.
    + by apply /pt_state_consume.
    + by apply /no_msg_from_to_consume.
    + by apply /(@msg_specE_consume1 (dsoup d) _ from _ to _ _ i m).
Qed.

Lemma pt_PhaseOneRespondedE_consume d e dt lg b pt ds i from:
  let: d' :=   {|
    dstate := upd from ds (dstate d);
    dsoup := consume_msg (dsoup d) i
  |} in
  coh d -> pt \in pts ->
  pt != from ->
  pt_PhaseOneResponded d e dt lg b pt ->
  pt_PhaseOneResponded d' e dt lg b pt.
Proof.
  move=>C Hpt N [] NM1 NM2 PS.
  have Vs: (valid (dsoup d)) by exact: (cohVs C).
  split.
  - exact: no_msg_from_to_consume.
  - exact: no_msg_from_to_consume.
  - case: b PS => PS; exact: pt_state_consume.
Qed.

Lemma cn_PhaseOneReceive_consume d round next_data lg recvd i m from :
  cn_PhaseOneReceive d round next_data lg recvd ->
  find i (dsoup d) = Some {| content := m; from := from; to := cn; active := true |} ->
  from \in pts ->
  from \in map fst recvd ->
  coh d ->
  let: d' :=
     {|
       dstate := upd cn (mkLocal (round, CWaitPrepResponse next_data recvd, lg)) (dstate d);
       dsoup := consume_msg (dsoup d) i |}
  in
  cn_PhaseOneReceive d' round next_data lg recvd.
Proof.
  move=>[] CS U Hsub Hrecvd1 Hrecvd2 F Hfrom Hold C.
  split=>//.
  - by rewrite /cn_state locE'// (cohVl C).
  - move=>pt b Hpt Hr.
    apply /(pt_PhaseOneRespondedE_consume _ i)=>//.
    by apply: pt_not_cn.
    exact : Hrecvd1.
  - move=>pt Hpt Hr.
    case H: (pt == from).
    + move/eqP in H. subst from.
      move: (Hrecvd2 _ Hpt Hr).
      move /negbTE in Hr.
      by rewrite Hr in Hold.
    + apply /(@pt_PhaseOneE_consume _ _ _ _ _ _ _ from cn m) =>//.
      by apply /negbT/H.
      by apply /pt_not_cn.
      exact: Hrecvd2.
Qed.

Lemma pt_PhaseTwoRespondedE_consume d e dt lg b pt ds i this:
  let: d' :=   {|
    dstate := upd this ds (dstate d);
    dsoup := consume_msg (dsoup d) i
  |} in
  coh d -> pt \in pts -> pt != this ->
  pt_PhaseTwoResponded d e dt lg b pt ->
  pt_PhaseTwoResponded d' e dt lg b pt.
Proof.
  move=>C Hpt N [] NM1 NM2 PS.
  have Vs: (valid (dsoup d)) by exact: (cohVs C).
  have N2: (pt != cn) by exact: pt_not_cn.
  split.
  - exact: pt_state_consume.
  - exact: no_msg_from_to_consume.
  - exact: no_msg_from_to_consume.
Qed.

Lemma pt_PhaseTwoCommitE_consume d e dt lg pt ds from to i m:
  let: d' :=   {|
    dstate := upd to ds (dstate d);
    dsoup := consume_msg (dsoup d) i
  |} in
  coh d ->
  pt != from ->
  pt != to ->
  find i (dsoup d) =
  Some {| content := m; from := from; to := to; active := true |} ->
  pt_PhaseTwoCommit d e dt lg pt ->
  pt_PhaseTwoCommit d' e dt lg pt.
Proof.
  move=>C  N1 N2 F I.
  have Vs: (valid (dsoup d)) by exact: (cohVs C).
  move: I => [][] PS H1 H2; [constructor 1|constructor 2|constructor 3]; split;
  do?[by apply: no_msg_from_to_consume];
  do?[by apply: pt_state_consume].
  - by apply /(msg_specE_consume2 _ F)=>//.
  - by apply /(msg_specE_consume1 _ F)=>//.
Qed.

Lemma pt_PhaseTwoAbortE_consume d e dt lg pt ds from to i m:
  let: d' :=   {|
    dstate := upd to ds (dstate d);
    dsoup := consume_msg (dsoup d) i
  |} in
  coh d ->
  pt != from ->
  pt != to ->
  find i (dsoup d) =
  Some {| content := m; from := from; to := to; active := true |} ->
  pt_PhaseTwoAbort d e dt lg pt ->
  pt_PhaseTwoAbort d' e dt lg pt.
Proof.
  move=>C N1 N2 F I.
  have Vs: (valid (dsoup d)) by exact: (cohVs C).
  move: I => [][] PS H1 H2; [constructor 1|constructor 2|constructor 3]; split;
  do?[by apply: no_msg_from_to_consume];
  do?[by apply: pt_state_consume].
  - case: PS=>PS; [left|right]; by apply: pt_state_consume.
  - by apply /(msg_specE_consume2 _ F)=>//.
  - by apply /(msg_specE_consume1 _ F)=>//.
Qed.

Lemma cn_state_soupE d ds this h cs lg :
  let: d' := {| dstate := upd this h (dstate d);
                dsoup := ds |} in
  coh d ->
  this != cn ->
  cn_state d cs lg ->
  cn_state d' cs lg.
Proof.
move=>C N.
have Vl := (cohVl C).
rewrite /cn_state locU//.
by apply/eqP/nesym/eqP.
Qed.

Lemma pt_state_soupE d ds h ps lg pt n :
  let: d' := {|
       dstate := upd n h (dstate d);
       dsoup := ds
  |} in
  coh d ->
  pt != n ->
  pt_state d ps lg pt ->
  pt_state d' ps lg pt .
Proof.
  move => C N H.
  by rewrite /pt_state locU // (cohVl C).
Qed.

Lemma pt_PhaseOneE' d r nd lg pt from h to m :
  let: d' := {| dstate := upd from h (dstate d);
                dsoup := (post_msg (dsoup d)
                  {| content := m; from := from; to := to; active := true |}).1 |} in
  coh d ->
  from != pt ->
  from != cn ->
  pt_PhaseOne d r nd lg pt ->
  pt_PhaseOne d' r nd lg pt.
Proof.
  move=>C N1 N2.
  have Vl := cohVl C.
  have Vs := cohVs C.
  move=>[][] H1 H2 H3;
  [constructor 1|constructor 2|constructor 3|constructor 4].
  - split.
    + apply /pt_state_soupE=>//.
      by apply /eqP/nesym/eqP.
    + apply no_msg_from_toE'=>//.
      by apply /negbTE.
    + apply msg_specE''=>//.
      by apply /eqP/nesym/eqP.
  - split.
    + apply /pt_state_soupE=>//.
      by apply /eqP/nesym/eqP.
    + apply no_msg_from_toE'=>//.
      by apply /negbTE.
    + apply no_msg_from_toE'=>//.
      by apply /negbTE.
  - split.
    + apply /pt_state_soupE=>//.
      by apply /eqP/nesym/eqP.
    + apply no_msg_from_toE'=>//.
      by apply /negbTE.
    + apply msg_specE''=>//.
      by apply /eqP/nesym/eqP.
  - split.
    + apply /pt_state_soupE=>//.
      by apply /eqP/nesym/eqP.
    + apply no_msg_from_toE'=>//.
      by apply /negbTE.
    + apply msg_specE''=>//.
      by apply /eqP/nesym/eqP.
Qed.

Lemma pt_InitE d r lg pt from h to m :
  let: d' := {| dstate := upd from h (dstate d);
                dsoup := (post_msg (dsoup d)
                  {| content := m; from := from; to := to; active := true |}).1 |} in
  coh d ->
  from != pt ->
  from != cn ->
  pt_Init d r lg pt ->
  pt_Init d' r lg pt.
Proof.
  move=>C N1 N2.
  have Vl := cohVl C.
  have Vs := cohVs C.
  move=>[] H1 H2 H3.
  split.
  - apply pt_state_soupE=>//.
    by apply /eqP/nesym/eqP.
  - apply /no_msg_from_toE'=>//.
    by apply /negbTE.
  - apply /no_msg_from_toE'=>//.
    by apply /negbTE.
Qed.

Lemma pt_PhaseOneRespondedE' d r nd lg pt from h to m b :
  let: d' := {| dstate := upd from h (dstate d);
                dsoup := (post_msg (dsoup d)
                  {| content := m; from := from; to := to; active := true |}).1 |} in
  coh d ->
  from != pt ->
  from != cn ->
  pt_PhaseOneResponded d r nd lg b pt ->
  pt_PhaseOneResponded d' r nd lg b pt.
Proof.
  move=>C N1 N2 [] NM1 NM2 H.
  have Vl := cohVl C.
  have Vs := cohVs C.
  split.
  - apply /no_msg_from_toE'=>//.
    by apply /negbTE.
  - apply /no_msg_from_toE'=>//.
    by apply /negbTE.
  - case: b H.
    + apply: pt_state_soupE=>//.
      by apply /eqP/nesym/eqP.
    + apply: pt_state_soupE=>//.
      by apply /eqP/nesym/eqP.
Qed.

Lemma PhaseTwo_PCommitted_pt d pt round lg next_data r nd (C : coh d)
      (Hpt : pt \in nodes _ _ _) :
  pt \in pts ->
  getStP Hnin C Hpt = (r, PCommitted nd) ->
  PhaseTwo d round next_data lg ->
  [/\ pt_state d (round, PCommitted next_data) (rcons lg (true, next_data)) pt,
        no_msg_from_to cn pt (dsoup d)
      & no_msg_from_to pt cn (dsoup d)].
Proof.
move=>HptP PS[][l1][] CS U S /(_ pt HptP); case: ifP=> _[]; (try case); (try case); intros => //.
all: match goal with
     | [ PS : getStP _ _ _ = _,
         PS' : pt_state _ _ _ _ |- _ ] =>
       rewrite (getStP_K _ _ _ _ PS')// in PS; try discriminate
     end.
Qed.

Lemma pt_PhaseTwoCommitE' d r nd lg pt from h to m :
  let: d' := {| dstate := upd from h (dstate d);
                dsoup := (post_msg (dsoup d)
                  {| content := m; from := from; to := to; active := true |}).1 |} in
  coh d ->
  from != pt ->
  from != cn ->
  pt_PhaseTwoCommit d r nd lg pt ->
  pt_PhaseTwoCommit d' r nd lg pt.
Proof.
move=>C /eqP/nesym/eqP N1 /eqP/nesym/eqP N2.
have Vs := cohVs C.
case=>[][] H1 H2 H3; [constructor 1|constructor 2|constructor 3]; split;
do?[by apply /pt_state_soupE];
do?[by apply /msg_specE''=>//; apply /negbTE];
do?[by apply/no_msg_from_toE'=>//; apply/eqP/nesym/eqP].
Qed.

Lemma pt_PhaseTwoAbortE' d r nd lg pt from h to m :
  let: d' := {| dstate := upd from h (dstate d);
                dsoup := (post_msg (dsoup d)
                  {| content := m; from := from; to := to; active := true |}).1 |} in
  coh d ->
  from != pt ->
  from != cn ->
  pt_PhaseTwoAbort d r nd lg pt ->
  pt_PhaseTwoAbort d' r nd lg pt.
Proof.
move=>C /eqP/nesym/eqP N1 /eqP/nesym/eqP N2.
have Vs := cohVs C.
case=>[][] H1 H2 H3; [constructor 1|constructor 2|constructor 3]; split;
do?[by apply /pt_state_soupE];
do?[by apply /msg_specE''=>//; apply /negbTE];
do?[by apply/no_msg_from_toE'=>//; apply/eqP/nesym/eqP].

case: H1; [left|right];
by apply /pt_state_soupE.
Qed.

Lemma pt_PhaseTwoRespondedE' d r nd lg pt from h to m b :
  let: d' := {| dstate := upd from h (dstate d);
                dsoup := (post_msg (dsoup d)
                  {| content := m; from := from; to := to; active := true |}).1 |} in
  coh d ->
  from != pt ->
  from != cn ->
  pt_PhaseTwoResponded d r nd lg b pt ->
  pt_PhaseTwoResponded d' r nd lg b pt.
Proof.
move=>C N1 N2 [] PS NM1 NM2.
have Vs := cohVs C.
split.
- apply /pt_state_soupE=>//.
  by apply /eqP/nesym/eqP.
- apply /no_msg_from_toE'=>//.
  by apply /negbTE.
- apply /no_msg_from_toE'=>//.
  by apply /negbTE.
Qed.

Lemma PhaseTwo_PAborted_pt d pt round lg next_data r nd (C : coh d)
      (Hpt : pt \in nodes _ _ _) :
  pt \in pts ->
  getStP Hnin C Hpt = (r, PAborted nd) ->
  PhaseTwo d round next_data lg ->
  [/\ pt_state d (round, PAborted next_data) (rcons lg (false, next_data)) pt,
        no_msg_from_to cn pt (dsoup d)
      & no_msg_from_to pt cn (dsoup d)].
Proof.
move=>HptP PS[][l1][] CS U S /(_ pt HptP); case: ifP=> _[]; (try case); (try case); intros => //.
all: match goal with
     | [ PS : getStP _ _ _ = _,
         PS' : pt_state _ _ _ _ |- _ ] =>
       rewrite (getStP_K _ _ _ _ PS')// in PS; try discriminate
     end.
Qed.

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

Definition coord_msg tag (from to : nid) : bool :=
  [&& from == cn, to \in pts & tagFromCoordinator tag].

Definition participant_msg tag (from to : nid) : bool :=
  [&& from \in pts, to == cn & tagFromParticipant tag].

Definition internal_msg (tag : nat) (from to : nid) : bool :=
  coord_msg tag from to || participant_msg tag from to.

Lemma internal_msg_tagFromParticipant_to_cn tag from to :
  internal_msg tag from to ->
  tagFromParticipant tag ->
  to == cn.
Proof.
case/orP; move=>/and3P[]//.
move=> _ _.
rewrite /tagFromCoordinator/tagFromParticipant !inE.
move/or3P=>[]/eqP ? /or4P[]/eqP ?; subst; discriminate.
Qed.

Lemma internal_msg_tagFromParticipant_from_pts tag from to :
  internal_msg tag from to ->
  tagFromParticipant tag ->
  from \in pts.
Proof.
case/orP; move=>/and3P[]//.
move=> _ _.
rewrite /tagFromCoordinator/tagFromParticipant !inE.
move/or3P=>[]/eqP ? /or4P[]/eqP ?; subst; discriminate.
Qed.

Lemma internal_msg_tagFromCoordinator_to_pts tag from to :
  internal_msg tag from to ->
  tagFromCoordinator tag ->
  to \in pts.
Proof.
case/orP; move=>/and3P[]//.
move=> _ _.
rewrite /tagFromCoordinator/tagFromCoordinator !inE.
move/or3P=>[]/eqP ? /or3P[]/eqP ?; subst; discriminate.
Qed.

Lemma internal_msg_tagFromCoordinator_from_cn tag from to :
  internal_msg tag from to ->
  tagFromCoordinator tag ->
  from == cn.
Proof.
case/orP; move=>/and3P[]//.
move=> _ _.
rewrite /tagFromCoordinator/tagFromCoordinator !inE.
move/or3P=>[]/eqP ? /or3P[]/eqP ?; subst; discriminate.
Qed.

Lemma internal_msg_to_cn tag from :
  internal_msg tag from cn ->
  participant_msg tag from cn.
Proof.
  move=>/orP[]// /and3P[] _ H.
  move: Hnin. by rewrite H.
Qed.

Lemma inv_msg_round d (C : coh d) i tag m from to round cs :
  find i (dsoup d) =
    Some {| content := {| tag := tag; tms_cont := m |};
            from := from;
            to := to;
            active := true |} ->
  internal_msg tag from to ->
  Inv d ->
  getStC C = (round, cs) ->
  head 0 m == round.
Proof.
  move=>F Hinternal I St.
  case/orP: Hinternal.
  - move=>/and3P[]/eqP ? Hto T. subst from.
    move: I=>[rd][lg][].
    + by move=>[]CS /(_ _ Hto) [] PS NM1 /(_ _ _ _ F).
    + move=>[next_data][].
      * move=>[sent][] CS U Sub /(_ _ Hto).
        case: ifP.
        -- move=>Hsent [][] PS.
           ++ move=>_[] _ /(_ _ _ _ F) /andP[] _ /eqP->/=.
              rewrite (getStC_K _ CS) in St.
              case: St=>->. by rewrite eqxx.
           ++ by move=>_ /(_ _ _ _ F).
           ++ by move=>/(_ _ _ _ F).
           ++ by move=>/(_ _ _ _ F).
        -- by move=>Hsent[] PS _ /(_ _ _ _ F).
      * move=>[recvd][] CS U Sub Hrecvd1 Hrecvd2.
        case: (in_map_exists to recvd).
        -- move=>[b] Hr.
           by move: (Hrecvd1 _ _ Hto Hr)=>[] /(_ _ _ _ F).
        -- move=>Hr.
           move: (Hrecvd2 _ Hto Hr)=>[][] PS.
           ++ move=>_ [] _ /(_ _ _ _ F) /andP[] _ /eqP->/=.
              rewrite (getStC_K _ CS) in St.
              case: St=>->. by rewrite eqxx.
           ++ by move=>_ /(_ _ _ _ F).
           ++ by move=>/(_ _ _ _ F).
           ++ by move=>/(_ _ _ _ F).
    + move=>[next_data][].
      * move=>[sent][] CS U Sub /(_ _ Hto).
        case: ifP.
        -- move=>Hsent [][] PS.
           ++ move=>[] _ /(_ _ _ _ F) /andP[] _ /eqP->/=.
              rewrite (getStC_K _ CS) in St.
              case: St=>->. by rewrite eqxx.
           ++ by move=>/(_ _ _ _ F).
           ++ by move=>/(_ _ _ _ F).
        -- by move=>_ [] /(_ _ _ _ F).
      * move=>[sent][] CS U Sub /(_ _ Hto).
        case: ifP.
        -- move=>Hsent [][] PS.
           ++ move=>[] _ /(_ _ _ _ F) /andP[] _ /eqP->/=.
              rewrite (getStC_K _ CS) in St.
              case: St=>->. by rewrite eqxx.
           ++ by move=>/(_ _ _ _ F).
           ++ by move=>/(_ _ _ _ F).
        -- by move=> _[b][] /(_ _ _ _ F).
      * move=>[recvd][] CS U Sub /(_ _ Hto).
        case: ifP.
        -- by move=>Hrecvd [] PS /(_ _ _ _ F).
        -- move=>Hrecvd[][] PS.
           ++ move=>[] _ /(_ _ _ _ F) /andP[] _ /eqP->/=.
              rewrite (getStC_K _ CS) in St.
              case: St=>->. by rewrite eqxx.
           ++ by move=>/(_ _ _ _ F).
           ++ by move=>/(_ _ _ _ F).
      * move=>[recvd][] CS U Sub /(_ _ Hto).
        case: ifP.
        -- by move=>Hrecvd [] PS /(_ _ _ _ F).
        -- move=>Hrecvd[][] PS.
           ++ move=>[] _ /(_ _ _ _ F) /andP[] _ /eqP->/=.
              rewrite (getStC_K _ CS) in St.
              case: St=>->. by rewrite eqxx.
           ++ by move=>/(_ _ _ _ F).
           ++ by move=>/(_ _ _ _ F).
  - move=>/and3P[]Hfrom/eqP ? T. subst to.
    move: I=>[rd][lg][].
    + by move=>[]CS /(_ _ Hfrom) [] PS /(_ _ _ _ F).
    + move=>[next_data][].
      * move=>[sent][] CS U Sub /(_ _ Hfrom).
        case: ifP.
        -- move=>Hsent [][] PS.
           ++ by move=>/(_ _ _ _ F).
           ++ by move=>/(_ _ _ _ F).
           ++ move=>_ [] _ /(_ _ _ _ F) /andP[] _ /eqP->/=.
              rewrite (getStC_K _ CS) in St.
              case: St=>->. by rewrite eqxx.
           ++ move=>_ [] _ /(_ _ _ _ F) /andP[] _ /eqP->/=.
              rewrite (getStC_K _ CS) in St.
              case: St=>->. by rewrite eqxx.
        -- by move=>Hsent[] PS /(_ _ _ _ F).
      * move=>[recvd][] CS U Sub Hrecvd1 Hrecvd2.
        case: (in_map_exists from recvd).
        -- move=>[b] Hr.
           by move: (Hrecvd1 _ _ Hfrom Hr)=>[] _/(_ _ _ _ F).
        -- move=>Hr.
           move: (Hrecvd2 _ Hfrom Hr)=>[][] PS.
           ++ by move=>/(_ _ _ _ F).
           ++ by move=>/(_ _ _ _ F).
           ++ move=>_ [] _ /(_ _ _ _ F) /andP[] _ /eqP->/=.
              rewrite (getStC_K _ CS) in St.
              case: St=>->. by rewrite eqxx.
           ++ move=>_ [] _ /(_ _ _ _ F) /andP[] _ /eqP->/=.
              rewrite (getStC_K _ CS) in St.
              case: St=>->. by rewrite eqxx.
    + move=>[next_data][].
      * move=>[sent][] CS U Sub /(_ _ Hfrom).
        case: ifP.
        -- move=>Hsent [][] PS.
           ++ by move=>_ /(_ _ _ _ F).
           ++ by move=>_ /(_ _ _ _ F).
           ++ move=>_ [] _ /(_ _ _ _ F) /andP[] _ /eqP->/=.
              rewrite (getStC_K _ CS) in St.
              case: St=>->. by rewrite eqxx.
        -- by move=>Hsent [] _ /(_ _ _ _ F).
      * move=>[sent][] CS U Sub /(_ _ Hfrom).
        case: ifP.
        -- move=>Hsent [][] PS.
           ++ by move=>_ /(_ _ _ _ F).
           ++ by move=>_ /(_ _ _ _ F).
           ++ move=>_ [] _ /(_ _ _ _ F) /andP[] _ /eqP->/=.
              rewrite (getStC_K _ CS) in St.
              case: St=>->. by rewrite eqxx.
        -- by move=>Hsent [b][] _ /(_ _ _ _ F).
      * move=>[recvd][] CS U Sub /(_ _ Hfrom).
        case: ifP.
        -- by move=>Hrecvd [] PS _ /(_ _ _ _ F).
        -- move=>Hrecvd[][] PS.
           ++ by move=>_ /(_ _ _ _ F).
           ++ by move=>_ /(_ _ _ _ F).
           ++ move=>_ [] _ /(_ _ _ _ F) /andP[] _ /eqP->/=.
              rewrite (getStC_K _ CS) in St.
              case: St=>->. by rewrite eqxx.
      * move=>[recvd][] CS U Sub /(_ _ Hfrom).
        case: ifP.
        -- by move=>Hrecvd [] PS _ /(_ _ _ _ F).
        -- move=>Hrecvd[][] PS.
           ++ by move=>_ /(_ _ _ _ F).
           ++ by move=>_ /(_ _ _ _ F).
           ++ move=>_ [] _ /(_ _ _ _ F) /andP[] _ /eqP->/=.
              rewrite (getStC_K _ CS) in St.
              case: St=>->. by rewrite eqxx.
Qed.

Definition E_consume_external d i this tag m from P :=
  let: d' := {| dstate := upd this (loc this d) (dstate d);
                dsoup := consume_msg (dsoup d) i |} in
  coh d ->
  find i (dsoup d) =
    Some {| content := {| tag := tag; tms_cont := m |};
            from := from;
            to := this;
            active := true |} ->
  ~~ internal_msg tag from this ->
  P d ->
  P d'.

Lemma cn_stateE_consume_external d i this tag m from cs log :
  E_consume_external d i this tag m from (fun d => cn_state d cs log).
Proof.
  move=>C F Hext.
  have Vl := (cohVl C).
  rewrite /cn_state.
  case H: (this == cn).
  - move/eqP in H. subst this. by rewrite locE'.
  rewrite locU//.
  by apply /eqP/nesym/eqP/negbT.
Qed.

Lemma pt_stateE_consume_external d i this tag m from ps lg pt :
  E_consume_external d i this tag m from (fun d => pt_state d ps lg pt).
Proof.
  move=>C F Hext.
  have Vl := (cohVl C).
  rewrite /pt_state.
  case H: (this == pt).
  - move/eqP in H. subst this. by rewrite locE'.
  rewrite locU//.
  by apply /eqP/nesym/eqP/negbT.
Qed.

Lemma msg_specE_consume_external d i this tag m from from' to' tag' m' :
  internal_msg tag' from' to' ->
  E_consume_external d i this tag m from (fun d => msg_spec from' to' tag' m' (dsoup d)).
Proof.
  move=>Hint C F Hext [] [j] [][t][c] F' U H.
  have Vs := cohVs C.
  split.
  - exists j. split.
    + exists t, c. rewrite mark_other//.
      case E: (j == i)=>//.
      move/eqP in E. subst j.
      move: F.
      rewrite F'.
      case=> ? ? ? ?. subst.
      move: (F')=>/H/andP[]/eqP ? _. subst.
      by rewrite Hint in Hext.
    + move=>k[t'][c'] F''.
      case H2: (k == i).
      * move/eqP in H2. subst k.
        move: F''=> /(find_mark Vs)[msg'][F''].
        discriminate.
      * rewrite mark_other// in F''.
        apply /U. by eauto.
  - move=> k t' c' F''.
    case H2: (k == i).
    + move/eqP in H2. subst k.
      move: F''=> /(find_mark Vs)[msg'][F''].
      discriminate.
    + rewrite mark_other// in F''.
      apply /H. exact: F''.
Qed.

Lemma pt_PhaseOneE_consume_external d i this tag m from round next_data lg pt :
  pt \in pts ->
  E_consume_external d i this tag m from (fun d => pt_PhaseOne d round next_data lg pt).
Proof.
  move=>Hpt C F Hext.
  have Vs := (cohVs C).
  case=>[][]PS NM1 H; [constructor 1|constructor 2| constructor 3 | constructor 4].
  - split=>//.
    + by apply: (pt_stateE_consume_external _ F).
    + by apply: no_msg_from_to_consume.
    + apply: (msg_specE_consume_external _ _ F)=>//.
      apply/orP. left.
      by apply/and3P.
  - split=>//.
    + by apply: (pt_stateE_consume_external _ F).
    + by apply: no_msg_from_to_consume.
    + by apply: no_msg_from_to_consume.
  - split=>//.
    + by apply: (pt_stateE_consume_external _ F).
    + by apply: no_msg_from_to_consume.
    + apply: (msg_specE_consume_external _ _ F)=>//.
      apply/orP. right.
      by apply/and3P.
  - split=>//.
    + by apply: (pt_stateE_consume_external _ F).
    + by apply: no_msg_from_to_consume.
    + apply: (msg_specE_consume_external _ _ F)=>//.
      apply/orP. right.
      by apply/and3P.
Qed.

Lemma pt_InitE_consume_external d i this tag m from round lg pt :
  E_consume_external d i this tag m from (fun d => pt_Init d round lg pt).
Proof.
  move=>C F Hext [] PS NM1 NM2.
  have Vs := (cohVs C).
  split.
  - by apply: (pt_stateE_consume_external _ F).
  - by apply: no_msg_from_to_consume.
  - by apply: no_msg_from_to_consume.
Qed.

Lemma pt_PhaseOneRespondedE_consume_external d i this tag m from round next_data lg b pt :
  E_consume_external d i this tag m from (fun d => pt_PhaseOneResponded d round next_data lg b pt).
Proof.
  move=>C F Hext [] NM1 NM2 H.
  have Vs := (cohVs C).
  split.
  - by apply: no_msg_from_to_consume.
  - by apply: no_msg_from_to_consume.
  - case: b H; by apply: (pt_stateE_consume_external _ F).
Qed.

Lemma pt_PhaseTwoRespondedE_consume_external d i this tag m from round next_data lg b pt :
  E_consume_external d i this tag m from (fun d => pt_PhaseTwoResponded d round next_data lg b pt).
Proof.
  move=>C F Hext [] PS NM1 NM2.
  have Vs := (cohVs C).
  split.
  - by apply: (pt_stateE_consume_external _ F).
  - by apply: no_msg_from_to_consume.
  - by apply: no_msg_from_to_consume.
Qed.

Lemma pt_PhaseTwoCommitE_consume_external d i this tag m from round next_data lg pt :
  pt \in pts ->
  E_consume_external d i this tag m from (fun d => pt_PhaseTwoCommit d round next_data lg pt).
Proof.
  move=>Hpt C F Hext [][] PS H1 H2;
  have Vs := (cohVs C); [constructor 1|constructor 2|constructor 3]; split;
  do?[by apply: (pt_stateE_consume_external _ F)];
  do?[by apply: no_msg_from_to_consume].
  - apply: (msg_specE_consume_external _ _ F)=>//.
    apply/orP. left.
    by apply/and3P.
  - apply: (msg_specE_consume_external _ _ F)=>//.
    apply/orP. right.
    by apply/and3P.
Qed.

Lemma pt_PhaseTwoAbortE_consume_external d i this tag m from round next_data lg pt :
  pt \in pts ->
  E_consume_external d i this tag m from (fun d => pt_PhaseTwoAbort d round next_data lg pt).
Proof.
  move=>Hpt C F Hext [][] PS H1 H2;
  have Vs := (cohVs C); [constructor 1|constructor 2|constructor 3]; split;
  do?[by apply: (pt_stateE_consume_external _ F)];
  do?[by apply: no_msg_from_to_consume].
  - case: PS=>PS; [left|right]; by apply: (pt_stateE_consume_external _ F).
  - apply: (msg_specE_consume_external _ _ F)=>//.
    apply/orP. left.
    by apply/and3P.
  - apply: (msg_specE_consume_external _ _ F)=>//.
    apply/orP. right.
    by apply/and3P.
Qed.

Lemma invE_consume_external d i this tag m from :
  E_consume_external d i this tag m from Inv.
Proof.
  move=>C F Hext [round][lg] I.
  have Vs := cohVs C.
  have Vl := cohVl C.
  exists round, lg.
  case: I=>I; [constructor 1|constructor 2|constructor 3].
  - move: I=>[] CS Pts.
    split.
    + by apply: (cn_stateE_consume_external _ F).
    + move=>pt Hpt.
      move: (Pts pt Hpt)=>[] PS NM2.
      split.
      * by apply: (pt_stateE_consume_external _ F).
      * by apply: (no_msg_from_to_consume).
      * by apply: (no_msg_from_to_consume).
  - move: I=>[next_data][[sent]|[recvd]] I; exists next_data;
    [constructor 1; exists sent|constructor 2; exists recvd].
    + move: I=>[] CS U Sub Pts.
      split=>//.
      * by apply: (cn_stateE_consume_external _ F).
      * move=>pt Hpt.
        case: ifP.
        -- move=>Hsent.
           move: (Pts _ Hpt).
           rewrite Hsent.
           by apply: (pt_PhaseOneE_consume_external _ _ F).
        -- move=>Hsent.
           move: (Pts _ Hpt).
           rewrite Hsent.
           by apply: (pt_InitE_consume_external _ F).
    + move: I=>[] CS U Sub Hrecvd1 Hrecvd2.
      split=>//.
      * by apply: (cn_stateE_consume_external _ F).
      * move=>pt b Hpt Hr.
        move: (Hrecvd1 _ _ Hpt Hr).
        by apply: (pt_PhaseOneRespondedE_consume_external _ F).
      * move=>pt Hpt Hr.
        move: (Hrecvd2 _ Hpt Hr).
        by apply: (pt_PhaseOneE_consume_external _ _ F).
  - move: I=>[next_data][[sent]|[sent]|[recvd]|[recvd]] I; exists next_data;
    [constructor 1; exists sent|constructor 2; exists sent|
     constructor 3; exists recvd|constructor 4; exists recvd].
    + move: I=>[] CS U Sub Pts.
      split=>//.
      * by apply: (cn_stateE_consume_external _ F).
      * move=>pt Hpt.
        case: ifP.
        -- move=>Hsent.
           move: (Pts _ Hpt).
           rewrite Hsent.
           by apply: (pt_PhaseTwoCommitE_consume_external _ _ F).
        -- move=>Hsent.
           move: (Pts _ Hpt).
           rewrite Hsent.
           by apply: (pt_PhaseOneRespondedE_consume_external _ F).
    + move: I=>[] CS U Sub Pts.
      split=>//.
      * by apply: (cn_stateE_consume_external _ F).
      * move=>pt Hpt.
        case: ifP.
        -- move=>Hsent.
           move: (Pts _ Hpt).
           rewrite Hsent.
           by apply: (pt_PhaseTwoAbortE_consume_external _ _ F).
        -- move=>Hsent.
           move: (Pts _ Hpt).
           rewrite Hsent=>[][b] I.
           exists b.
           by apply: (pt_PhaseOneRespondedE_consume_external _ F).
    + move: I=>[] CS U Sub Pts.
      split=>//.
      * by apply: (cn_stateE_consume_external _ F).
      * move=>pt Hpt.
        case: ifP.
        -- move=>Hsent.
           move: (Pts _ Hpt).
           rewrite Hsent.
           by apply: (pt_PhaseTwoRespondedE_consume_external _ F).
        -- move=>Hsent.
           move: (Pts _ Hpt).
           rewrite Hsent.
           by apply: (pt_PhaseTwoCommitE_consume_external _ _ F).
    + move: I=>[] CS U Sub Pts.
      split=>//.
      * by apply: (cn_stateE_consume_external _ F).
      * move=>pt Hpt.
        case: ifP.
        -- move=>Hsent.
           move: (Pts _ Hpt).
           rewrite Hsent.
           by apply: (pt_PhaseTwoRespondedE_consume_external _ F).
        -- move=>Hsent.
           move: (Pts _ Hpt).
           rewrite Hsent.
           by apply: (pt_PhaseTwoAbortE_consume_external _ _ F).
Qed.

Lemma rc_step_external d (C : coh d) this (Hthis : this \in nodes cn pts others) tag from m i :
  ~~ internal_msg tag from this ->
   find i (dsoup d) =
    Some {| content := {| tag := tag; tms_cont := m |};
            from := from;
            to := this;
            active := true |} ->
 rc_step tag from m C Hthis = loc this d.
Proof.
  move/norP=>[]/and3P H1 /and3P H2 F.
  rewrite /rc_step.
  case: ifP=>// /eqP ?. subst this.
  pose proof C as C'.
  case: C'=>Hs _ _ /(_ cn Hthis)[] _.
  rewrite eqxx=>[][cs][lg] L.
  rewrite (getStC_K _ L) (getStL_Kc _ _ L).
  rewrite /cstep_recv.
  case: ifP=>// /negbFE Hfrom.
  case: cs L=>round cs L.
  case: ifP=>//.
  move: Hs=>[] _ /(_ _ _ F)[r].
  rewrite /cohMsg/=.
  case: ifP.
  - move=> _ []. by rewrite (negbTE Hnin).
  - move=>_. rewrite Hfrom.
    move=>[] _ /andP[] T.
    exfalso.
    apply/H2.
    by split.
Qed.

Lemma rp_step_external d (C : coh d) this (Hthis : this \in nodes cn pts others) tag from m i :
  ~~ internal_msg tag from this ->
   find i (dsoup d) =
    Some {| content := {| tag := tag; tms_cont := m |};
            from := from;
            to := this;
            active := true |} ->
 rp_step Hnin tag from m C Hthis = loc this d.
Proof.
  move/norP=>[] H1 H2 F.
  rewrite /rp_step.
  case: ifP=>//Hpts.
  pose proof C as C'.
  case: C'=>Hs _ _ /(_ this (pts_in _ _ Hpts)) [] _.
  rewrite (this_not_pts Hnin Hpts) Hpts =>[][ps][lg] L.
  rewrite (getStP_K _ _ _ _ L)//  (getStL_Kp _ _ L).
  rewrite /pstep_recv.
  case: ifP=>//.  move=>/norP[]/norP[] /negbNE H3 /negbNE H4 /negbNE H5.

  destruct ps as[round ps].

  move: H3 H1.
  rewrite /coord_msg H4 Hpts/=/tagFromCoordinator/p_matches_tag.
  destruct ps=>//.
  - move=>/eqP ?. subst tag. done.
  - case/orP=>/eqP ?; subst; done.
  - move=>/eqP ?. subst tag. done.
Qed.

Lemma internal_msg_from_cn tag to :
  internal_msg tag cn to ->
  coord_msg tag cn to.
Proof.
  move=>/orP[]// /and3P[] H.
  move: Hnin. by rewrite H.
Qed.

Lemma p_matches_tag_internal_inv d i t m pt r ps lg :
  coh d ->
  pt \in pts ->
  find i (dsoup d) =
    Some {| content := {| tag := t; tms_cont := m |};
            from := cn;
            to := pt;
            active := true |} ->
  internal_msg t cn pt ->
  pt_state d (r, ps) lg pt ->
  Inv d ->
  p_matches_tag ps t.
Proof.
  move=>C Hpt F /internal_msg_from_cn /and3P[] _ _ T PS.
  move=>[r'][lg'][].
  - by move=>[] _ /(_ pt Hpt) [] _ _ /(_ _ _ _ F).
  - move=>[nd][][l1][] _ _ _.
    + move=>/(_ _ Hpt).
      case: ifP=>_ [][] PS';
      do?[by move=>_ /(_ _ _ _ F)];
      do?[by move=>/(_ _ _ _ F)].
      move=>_[] _ /(_ _ _ _ F) /andP[] /eqP ? /eqP ?. subst.
      move: C=>[] _ _ _ /(_ _ (pts_in cn others Hpt)) [] V _.
      move: (pt_state_functional V PS PS')=>[][] ? ? ?. subst.
      done.
    + case: (in_map_exists pt l1).
      * by move=>[b] H /(_ _ _ Hpt H)[] /(_ _ _ _ F).
      * move=>H _ /(_ _ Hpt H)[][] PS';
        do?[by move=>_ /(_ _ _ _ F)];
        do?[by move=>/(_ _ _ _ F)].
        move=>_[] _ /(_ _ _ _ F) /andP[] /eqP ? /eqP ?. subst.
        move: C=>[] _ _ _ /(_ _ (pts_in cn others Hpt)) [] V _.
        move: (pt_state_functional V PS PS')=>[][] ? ? ?. subst.
        done.
  - move=>[nd][][l1][] _ _ _ /(_ _ Hpt); case: ifP=>_ []; (try case); (try case);
    do?[by move=>_ /(_ _ _ _ F)];
    do?[by move=>/(_ _ _ _ F)];
    move=> PS' [] _ /(_ _ _ _ F) /andP[] /eqP ? /eqP ? _; subst;
    move: C=>[] _ _ _ /(_ _ (pts_in cn others Hpt)) [] V _;
    move: (pt_state_functional V PS PS')=>[][] ? ? ?; subst; done.
Qed.

Lemma PhaseOne_msg_next_data d (C : coh d) i m pt round next_data lg  :
  find i (dsoup d) =
    Some {| content := {| tag := prep_req; tms_cont := m |};
            from := cn;
            to := pt;
            active := true |} ->
  internal_msg prep_req cn pt ->
  PhaseOne d round next_data lg ->
  behead m == next_data.
Proof.
  move=>F /internal_msg_from_cn /and3P[] _ Hpt _ [].
  - move=>[sent][] CS U S /(_ pt Hpt).
    case: ifP=>_ [][] PS;
        do?[by move=>_ /(_ _ _ _ F)];
        do?[by move=>/(_ _ _ _ F)].
    by move=>_ [] _ /(_ _ _ _ F)/andP [] _ /eqP ->.
  - move=>[recvd][] CS U S.
    case: (in_map_exists pt recvd).
    + by move=>[b] H /(_ _ _ Hpt H) [] /(_ _ _ _ F).
    + move=>H _ /(_ _ Hpt H) [][] _;
        do?[by move=>/(_ _ _ _ F)];
        do?[by move=>_ /(_ _ _ _ F)].
      by move=> _ [] _ /(_ _ _ _ F) /andP[] _ /eqP->.
Qed.

Lemma cn_state_functional d cs1 lg1 cs2 lg2 :
  valid (loc cn d) ->
  cn_state d cs1 lg1 ->
  cn_state d cs2 lg2 ->
  cs1 = cs2 /\ lg1 = lg2.
Proof.
  move=>V.
  rewrite/cn_state=> H.
  move: V.
  rewrite H => V.
  move /(hcancelV V) => [] ?. subst.
  move=> V1.
  by move /(hcancelPtV V1)=>->.
Qed.

Lemma pt_log_agreement d r lg pt :
  coh d ->
  pt \in pts ->
  pt_state d (r, PInit) lg pt ->
  Inv d ->
  forall pt' ps' r' lg',
    pt' \in pts ->
    pt_state d (r', ps') lg' pt' ->
    r' = r ->
    lg' = lg.
Proof.
move=>C Hpt PS [r0][lg0].
move: (C)=>[] _ _ _ /(_ _ (pts_in _ _ Hpt)) [] V _.
case.
- move=>[] CS.
  move=>Pts pt' ps' r' lg' Hpt' PS'.
  move: (Pts pt Hpt)=>[].
  move /(pt_state_functional V PS)=>[][] ? ? _ _. subst.
  move: (Pts pt' Hpt')=>[].
  move: (C)=>[] _ _ _ /(_ _ (pts_in _ _ Hpt')) [] V' _.
  move /(pt_state_functional V' PS') =>[][] ? ? ? _.
  by subst.
- move=>[nd][[sent]|[recvd]][] _ _ _.
  + move=>Pts pt' ps' r' lg' Hpt' PS'.
    move: (Pts pt Hpt); case: ifP=>_[][];
    move /(pt_state_functional V PS)=>[]; try discriminate;
    move=>[] ? ? _ _; subst;
    move: (Pts pt' Hpt'); case: ifP=>_ [][]=>//;
    move: (C)=>[] _ _ _ /(_ _ (pts_in _ _ Hpt')) [] V' _;
    move /(pt_state_functional V' PS') =>[][] ? ? ? _; by subst.
  + move=>Hrecvd1 Hrecvd2.
    case: (in_map_exists pt recvd).
    * move=>[b] H.
      case: (Hrecvd1 _ _ Hpt H) => _ _.
      case: ifP=>_;
      move /(pt_state_functional V PS)=>[]; discriminate.
    * move=>H.
      case: (Hrecvd2 _ Hpt H)=>[][];
      move /(pt_state_functional V PS)=>[]; try discriminate.
      case=> ? ?. subst.
      move=> _ _ pt' ps' r' lg' Hpt' PS'.
      case: (in_map_exists pt' recvd).
      -- move=>[b] H'.
         move: (Hrecvd1 _ _ Hpt' H')=>[]; case: ifP=> _ _ _;
         move: (C)=>[] _ _ _ /(_ _ (pts_in _ _ Hpt')) [] V' _;
         move /(pt_state_functional V' PS') =>[][] ? ? ? _; by subst.
      -- move=>H'.
         case: (Hrecvd2 _ Hpt' H')=>[][];
         move: (C)=>[] _ _ _ /(_ _ (pts_in _ _ Hpt')) [] V' _;
         move /(pt_state_functional V' PS') =>[][] ? ? ? _; by subst.
- move=>[nd][[sent]|[sent]|[recvd]|[recvd]][] _ _ _ Pts;
  move: (Pts _ Hpt); case: ifP=>_ []; (try case); (try case); intros H1 H2 H3;
  match goal with
  | [ H : pt_state _ _ _ pt |- _ ] =>
    move: H =>/(pt_state_functional V PS)[]; try discriminate
  end;
  case=> ? ?; subst;
  move=> pt' ps' r' lg' Hpt' PS';
  move: (Pts _ Hpt'); case: ifP=>_[]; (try case); (try case); intros H4 H5 H6;
  move: (C)=>[] _ _ _ /(_ _ (pts_in _ _ Hpt')) [] V' _;
  match goal with
  | [ H : pt_state _ _ _ _ |- _ ] =>
    move: H =>/(pt_state_functional V' PS')[]; try discriminate
  end; case; intros; subst; auto; try omega.
Qed.

Lemma cn_log_agreement d r lg pt :
  coh d ->
  cn_state d (r, CInit) lg ->
  Inv d ->
  pt \in pts ->
  pt_state d (r, PInit) lg pt.
Proof.
move=>C CS [r'][lg'].
move: C=>[] _ _ _ /(_ _ (cn_in _ _ _)) [] V _.
case.
- move=>[].
  move /(cn_state_functional V CS)=>[][] ? ?. subst.
  move=>H Hpt.
  by move: (H pt Hpt)=>[].
- move=>[nd][[sent]|[recvd]][];
  move /(cn_state_functional V CS)=>[]; discriminate.
- move=>[nd][[sent]|[sent]|[recvd]|[recvd]][];
  move /(cn_state_functional V CS)=>[]; discriminate.
Qed.

(* End TwoPhaseInductiveInv. *)

(* Module Exports. *)
(* Section Exports. *)

(* Definition tpc_with_inv := tpc_with_inv. *)
(* Definition tpc_inv := Inv. *)
(* Definition tpc_ii := ii. *)

(* End Exports. *)
(* End Exports. *)

End TwoPhaseInductiveInv.

(* Export TwoPhaseInductiveInv.Exports. *)


From Coq Require Import ZArith .
From Common Require Import Var .
From mQhasm Require Import zDSL zRadix .
From mathcomp Require Import seq .

Open Scope N_scope.
Open Scope zdsl_scope.

Definition fe25519_mul121666 : program :=

let         wsize :=   64%nat in

let crypto_sign_ed25519_amd64_51_121666_213 :=
                       996687872%Z in (* from consts *)
let crypto_sign_ed25519_amd64_51_REDMASK51_width :=
                       51 in        (* 51 bits *)

let            x0 :=   0 in     (* *[uint64 *](xp +  0) *)
let            x1 :=   1 in     (* *[uint64 *](xp +  8) *)
let            x2 :=   2 in     (* *[uint64 *](xp + 16) *)
let            x3 :=   3 in     (* *[uint64 *](xp + 24) *)
let            x4 :=   4 in     (* *[uint64 *](xp + 32) *)

let            z0 :=   5 in     (* *[uint64 *](rp +  0) *)
let            z1 :=   6 in     (* *[uint64 *](rp +  8) *)
let            z2 :=   7 in     (* *[uint64 *](rp + 16) *)
let            z3 :=   8 in     (* *[uint64 *](rp + 24) *)
let            z4 :=   9 in     (* *[uint64 *](rp + 32) *)

let            r0 :=  10 in     (* *[uint64 *](rp +  0) *)
let            r1 :=  11 in     (* *[uint64 *](rp +  8) *)
let            r2 :=  12 in     (* *[uint64 *](rp + 16) *)
let            r3 :=  13 in     (* *[uint64 *](rp + 24) *)
let            r4 :=  14 in     (* *[uint64 *](rp + 32) *)

let           rax :=  20 in
let           rdx :=  21 in

let           tmp := 998 in
let         carry := 999 in

[::

      (* # CPU: Intel(R) Xeon(R) CPU X5675 @ 3.07GHz *)
      (* # RAM: 32GB *)
      (* # Configuration: -c consts -s *)
      (* # With Boolector 1.6.0 (-minisat): ? *)
      (*  *)
      (* int64 rp *)
      (* int64 xp *)
      (*  *)
      (* input rp *)
      (* input xp *)
      (*  *)
      (* int64 r0 *)
      (* int64 r1 *)
      (* int64 r2 *)
      (* int64 r3 *)
      (* int64 r4 *)
      (*  *)
      (* #required for  macro *)
      (* int64 rax *)
      (* int64 rdx *)
      (*  *)
      (*  *)
      (*   #BEGIN MACRO callerregs_declare *)
      (*   int64 caller1 *)
      (*   int64 caller2 *)
      (*   int64 caller3 *)
      (*   int64 caller4 *)
      (*   int64 caller5 *)
      (*   int64 caller6 *)
      (*   int64 caller7 *)
      (*   caller caller1 *)
      (*   caller caller2 *)
      (*   caller caller3 *)
      (*   caller caller4 *)
      (*   caller caller5 *)
      (*   caller caller6 *)
      (*   caller caller7 *)
      (*   stack64 caller1_stack *)
      (*   stack64 caller2_stack *)
      (*   stack64 caller3_stack *)
      (*   stack64 caller4_stack *)
      (*   stack64 caller5_stack *)
      (*   stack64 caller6_stack *)
      (*   stack64 caller7_stack *)
      (*   #END MACRO callerregs_declare *)
      (*  *)
      (*  *)
      (* enter fe25519_mul121666 *)
      (*  *)
      (*  *)
      (*   #BEGIN MACRO callerregs_save *)
      (*   caller1_stack = caller1 *)
      (*   caller2_stack = caller2 *)
      (*   caller3_stack = caller3 *)
      (*   caller4_stack = caller4 *)
      (*   caller5_stack = caller5 *)
      (*   caller6_stack = caller6 *)
      (*   caller7_stack = caller7 *)
      (*   #END MACRO callerregs_save *)
      (*  *)
      (* ################################################################### *)
      (* # Conditions on the inputs: x0 = *[uint64 *](xp +  0), *)
      (* #                           x1 = *[uint64 *](xp +  8), *)
      (* #                           x2 = *[uint64 *](xp + 16), *)
      (* #                           x3 = *[uint64 *](xp + 24), *)
      (* #                           x4 = *[uint64 *](xp + 32), are all in [0,2^64-1] (whole uint64 range) *)
      (* # *)
      (* ################################################################### *)
      (*  *)
      (*  *)
      (*  *)
      (*   #BEGIN MACRO  *)
      (*   rax = *[uint64 *](xp + 0) *)
zAssign rax (zVar x0);
      (*   (uint128) rdx rax = rax * *[uint64 *] &crypto_sign_ed25519_amd64_51_121666_213 *)
zSplit rdx rax (zBinop zMul (zVar rax) (zConst crypto_sign_ed25519_amd64_51_121666_213)) wsize;
      (*   (uint64) rax >>= 13 *)
zSplit rax tmp (zVar rax) 13;
      (*   r0 = rax *)
zAssign r0 (zVar rax);
      (*   r1 = rdx *)
zAssign r1 (zVar rdx);
      (*    *)
      (*   rax = *[uint64 *](xp + 8) *)
zAssign rax (zVar x1);
      (*   (uint128) rdx rax = rax * *[uint64 *] &crypto_sign_ed25519_amd64_51_121666_213 *)
zSplit rdx rax (zBinop zMul (zVar rax) (zConst crypto_sign_ed25519_amd64_51_121666_213)) wsize;
      (*   (uint64) rax >>= 13 *)
zSplit rax tmp (zVar rax) 13;
      (*   r1 += rax *)
zAssign r1 (zBinop zAdd (zVar r1) (zVar rax));
      (*   r2 = rdx *)
zAssign r2 (zVar rdx);
      (*    *)
      (*   rax = *[uint64 *](xp + 16) *)
zAssign rax (zVar x2);
      (*   (uint128) rdx rax = rax * *[uint64 *] &crypto_sign_ed25519_amd64_51_121666_213 *)
zSplit rdx rax (zBinop zMul (zVar rax) (zConst crypto_sign_ed25519_amd64_51_121666_213)) wsize;
      (*   (uint64) rax >>= 13 *)
zSplit rax tmp (zVar rax) 13;
      (*   r2 += rax *)
zAssign r2 (zBinop zAdd (zVar r2) (zVar rax));
      (*   r3 = rdx *)
zAssign r3 (zVar rdx);
      (*    *)
      (*   rax = *[uint64 *](xp + 24) *)
zAssign rax (zVar x3);
      (*   (uint128) rdx rax = rax * *[uint64 *] &crypto_sign_ed25519_amd64_51_121666_213 *)
zSplit rdx rax (zBinop zMul (zVar rax) (zConst crypto_sign_ed25519_amd64_51_121666_213)) wsize;
      (*   (uint64) rax >>= 13 *)
zSplit rax tmp (zVar rax) 13;
      (*   r3 += rax *)
zAssign r3 (zBinop zAdd (zVar r3) (zVar rax));
      (*   r4 = rdx *)
zAssign r4 (zVar rdx);
      (*    *)
      (*   rax = *[uint64 *](xp + 32) *)
zAssign rax (zVar x4);
      (*   (uint128) rdx rax = rax * *[uint64 *] &crypto_sign_ed25519_amd64_51_121666_213 *)
zSplit rdx rax (zBinop zMul (zVar rax) (zConst crypto_sign_ed25519_amd64_51_121666_213)) wsize;
      (*   (uint64) rax >>= 13 *)
zSplit rax tmp (zVar rax) 13;
      (*   r4 += rax *)
zAssign r4 (zBinop zAdd (zVar r4) (zVar rax));
      (*   rdx *= 19 *)
zAssign rdx (zBinop zMul (zVar rdx) (zConst 19%Z));
      (*   r0 += rdx *)
zAssign r0 (zBinop zAdd (zVar r0) (zVar rdx));
      (*   #END MACRO  *)
      (*  *)
      (*   #// var x0 = mem64[xp + 0]@u320 *)
      (*   #//     x1 = mem64[xp + 8]@u320 *)
      (*   #//     x2 = mem64[xp + 16]@u320 *)
      (*   #//     x3 = mem64[xp + 24]@u320 *)
      (*   #//     x4 = mem64[xp + 32]@u320 *)
      (*   #//     lhs = (x0 + x1 * 2**51 + x2 * 2**102 + x3 * 2**153 + x4 * 2**204) * 121666 *)
      (*   #//     rhs = r0@u320 + r1@u320 * 2**51 + r2@u320 * 2**102 + r3@u320 * 2**153 + r4@u320 * 2**204 *)
      (*   #// assert lhs >=u rhs && (lhs - rhs) %u (2**255 - 19) = 0 && *)
      (*   #//        0 <=u r0 <u 2**52 && *)
      (*   #//        0 <=u r1 <u 2**52 && *)
      (*   #//        0 <=u r2 <u 2**52 && *)
      (*   #//        0 <=u r3 <u 2**52 && *)
      (*   #//        0 <=u r4 <u 2**52 *)
      (*  *)
      (* ################################################################### *)
      (* # The following should hold at this point: *)
      (* # *)
      (* # (x0 + 2^51*x1 + 2^102*x2 + 2^153*x3 + 2^204*x4) * 121666 congruent to (r0 + r1*2^51 + r2*2^102 + r3*2^153 + r4*2^204)  [modulo 2^255-19] *)
      (* # *)
      (* # r0l,r1l,r2l,r3l,r4l are all in [0,2^52] *)
      (* # *)
      (* ################################################################### *)
      (*   *)
      (*  *)
      (* *[uint64 *](rp + 0) = r0 *)
zAssign z0 (zVar r0);
      (* *[uint64 *](rp + 8) = r1 *)
zAssign z1 (zVar r1);
      (* *[uint64 *](rp + 16) = r2 *)
zAssign z2 (zVar r2);
      (* *[uint64 *](rp + 24) = r3 *)
zAssign z3 (zVar r3);
      (* *[uint64 *](rp + 32) = r4 *)
zAssign z4 (zVar r4)
      (*  *)
      (*  *)
      (*   #BEGIN MACRO callerregs_restore *)
      (*   caller1 = caller1_stack *)
      (*   caller2 = caller2_stack *)
      (*   caller3 = caller3_stack *)
      (*   caller4 = caller4_stack *)
      (*   caller5 = caller5_stack *)
      (*   caller6 = caller6_stack *)
      (*   caller7 = caller7_stack *)
      (*   #END MACRO callerregs_restore *)
      (*  *)
      (*  *)
      (* leave *)
] .

Definition fe25519_mul121666_inputs : VS.t :=
let            x0 :=   0 in
let            x1 :=   1 in
let            x2 :=   2 in
let            x3 :=   3 in
let            x4 :=   4 in
VSLemmas.OP.P.of_list [:: x0; x1; x2; x3; x4].

Definition fe25519_mul121666_pre : bexp := zTrue.

Definition fe25519_mul121666_post : bexp :=
let            x0 :=   0 in
let            x1 :=   1 in
let            x2 :=   2 in
let            x3 :=   3 in
let            x4 :=   4 in
let            r0 :=  10 in
let            r1 :=  11 in
let            r2 :=  12 in
let            r3 :=  13 in
let            r4 :=  14 in
let        n25519 := 57896044618658097711785492504343953926634992332820282019728792003956564819949%Z in
zEqMod
  (
    (radix51 [::zVar x0; zVar x1; zVar x2; zVar x3; zVar x4])
    @*
    (zConst 121666)
  )
  (radix51 [::zVar r0; zVar r1; zVar r2; zVar r3; zVar r4])
  (zConst n25519).

Definition fe25519_mul121666_spec :=
  {| spre := fe25519_mul121666_pre;
     sprog := fe25519_mul121666;
     spost := fe25519_mul121666_post |}.

From mathcomp Require Import ssreflect eqtype ssrbool.
From mQhasm Require Import zVerify.

Lemma valid_fe25519_mul121666 : valid_zspec (fe25519_mul121666_inputs, fe25519_mul121666_spec).
Proof.
  Time verify_zspec.
  (* *)
Qed.

Close Scope zdsl_scope.
Close Scope N_scope.


From Formalisation Require Import Nom.

Open Scope N_scope.

Section combinator.

  Context {atom : Type}.

  Definition NomG := @NomG atom.

  Definition is_empty : NomG bool :=
    let! len := length in
    ret (len =? 0).

  Definition all_consuming {X} (p : NomG X) : NomG X :=
    let! v := p in
    let! b := is_empty in
    if b
    then ret v
    else fail.

  Definition cond {X} (b : bool) (c : NomG X) : NomG (option X) :=
    if b
    then
      let! v := c in
      ret (Some v)
    else
      ret None.

  Definition recognize {X} (c : NomG X) : NomG span :=
    let! len_before := length in
    let! len_after := peek (let! _ := c in length) in
    take (len_before - len_after).

  Definition consumed {X} (c: NomG X) : NomG (span * X) :=
    let! len_before := length in
    let! (v, len_after) := peek (let! v := c in
                                 let! len := length in
                                 ret (v, len)) in
    let! s := take (len_before - len_after) in
    ret (s, v).

  Definition eof : NomG unit :=
    let! b := is_empty in
    if b
    then ret ()
    else
      fail.

  Definition flat_map {X Y} := @bind X Y.

  Definition map {X Y} (c : NomG X) (f : X -> Y) : NomG Y :=
    let! v := c in
    ret (f v).

  Definition into {X Y} := @map X Y.

  Definition map_opt {X Y} (c : NomG X) (f : X -> option Y) : NomG Y :=
    let! v := c in
    match f v with
    | Some v => ret v
    | None => fail
    end.

  Definition map_parser {X} (c1 : NomG span) (c2 : NomG X) : NomG X :=
    let! s := c1 in
    scope s c2.

  Definition not {X} (c : NomG X): NomG unit :=
    let! b := alt (let! v := c in ret true) (ret false) in
    if b
    then
      fail
    else
      ret tt.

  Definition opt {X} (c : NomG X): NomG(option X) :=
    alt (let! v := c in ret (Some v)) (ret None).

  Definition rest : NomG span :=
    let! l := length in
    take l.

  Definition rest_len : NomG N := length.

  Definition success {X} : X -> NomG X := ret.

  Definition value {X Y} (val : X) (c : NomG Y) : NomG X :=
    let! _ := c in
    ret val.

  Definition verify {X} (c : NomG X) (b : X -> bool) : NomG X :=
    let! v := c in
    if b v
    then
      ret v
    else
      fail.

End combinator.

Close Scope N_scope.


(* Calls to external decision procedures *)

Require Export ZArith.
Require Export Classical.

(* Zenon *)

(*  Copyright 2004 INRIA  *)
(*  $Id: Dp.v 12337 2009-09-17 15:58:14Z glondu $  *)

Lemma zenon_nottrue :
  (~True -> False).
Proof. tauto. Qed.

Lemma zenon_noteq : forall (T : Type) (t : T),
  ((t <> t) -> False).
Proof. tauto. Qed.

Lemma zenon_and : forall P Q : Prop,
  (P -> Q -> False) -> (P /\ Q -> False).
Proof. tauto. Qed.

Lemma zenon_or : forall P Q : Prop,
  (P -> False) -> (Q -> False) -> (P \/ Q -> False).
Proof. tauto. Qed.

Lemma zenon_imply : forall P Q : Prop,
  (~P -> False) -> (Q -> False) -> ((P -> Q) -> False).
Proof. tauto. Qed.

Lemma zenon_equiv : forall P Q : Prop,
  (~P -> ~Q -> False) -> (P -> Q -> False) -> ((P <-> Q) -> False).
Proof. tauto. Qed.

Lemma zenon_notand : forall P Q : Prop,
  (~P -> False) -> (~Q -> False) -> (~(P /\ Q) -> False).
Proof. tauto. Qed.

Lemma zenon_notor : forall P Q : Prop,
  (~P -> ~Q -> False) -> (~(P \/ Q) -> False).
Proof. tauto. Qed.

Lemma zenon_notimply : forall P Q : Prop,
  (P -> ~Q -> False) -> (~(P -> Q) -> False).
Proof. tauto. Qed.

Lemma zenon_notequiv : forall P Q : Prop,
  (~P -> Q -> False) -> (P -> ~Q -> False) -> (~(P <-> Q) -> False).
Proof. tauto. Qed.

Lemma zenon_ex : forall (T : Type) (P : T -> Prop),
  (forall z : T, ((P z) -> False)) -> ((exists x : T, (P x)) -> False).
Proof. firstorder. Qed.

Lemma zenon_all : forall (T : Type) (P : T -> Prop) (t : T),
  ((P t) -> False) -> ((forall x : T, (P x)) -> False).
Proof. firstorder. Qed.

Lemma zenon_notex : forall (T : Type) (P : T -> Prop) (t : T),
  (~(P t) -> False) -> (~(exists x : T, (P x)) -> False).
Proof. firstorder. Qed.

Lemma zenon_notall : forall (T : Type) (P : T -> Prop),
  (forall z : T, (~(P z) -> False)) -> (~(forall x : T, (P x)) -> False).
Proof. intros T P Ha Hb. apply Hb. intro. apply NNPP. exact (Ha x). Qed.

Lemma zenon_equal_base : forall (T : Type) (f : T), f = f.
Proof. auto. Qed.

Lemma zenon_equal_step :
  forall (S T : Type) (fa fb : S -> T) (a b : S),
  (fa = fb) -> (a <> b -> False) -> ((fa a) = (fb b)).
Proof. intros. rewrite (NNPP (a = b)). congruence. auto. Qed.

Lemma zenon_pnotp : forall P Q : Prop,
  (P = Q) -> (P -> ~Q -> False).
Proof. intros P Q Ha. rewrite Ha. auto. Qed.

Lemma zenon_notequal : forall (T : Type) (a b : T),
  (a = b) -> (a <> b -> False).
Proof. auto. Qed.

Ltac zenon_intro id :=
  intro id || let nid := fresh in (intro nid; clear nid)
.

Definition zenon_and_s := fun P Q a b => zenon_and P Q b a.
Definition zenon_or_s := fun P Q a b c => zenon_or P Q b c a.
Definition zenon_imply_s := fun P Q a b c => zenon_imply P Q b c a.
Definition zenon_equiv_s := fun P Q a b c => zenon_equiv P Q b c a.
Definition zenon_notand_s := fun P Q a b c => zenon_notand P Q b c a.
Definition zenon_notor_s := fun P Q a b => zenon_notor P Q b a.
Definition zenon_notimply_s := fun P Q a b => zenon_notimply P Q b a.
Definition zenon_notequiv_s := fun P Q a b c => zenon_notequiv P Q b c a.
Definition zenon_ex_s := fun T P a b => zenon_ex T P b a.
Definition zenon_notall_s := fun T P a b => zenon_notall T P b a.

Definition zenon_pnotp_s := fun P Q a b c => zenon_pnotp P Q c a b.
Definition zenon_notequal_s := fun T a b x y => zenon_notequal T a b y x.

(* Ergo *)

Set Implicit Arguments.
Section congr.
  Variable t:Type.
Lemma ergo_eq_concat_1 :
  forall (P:t -> Prop) (x y:t),
    P x -> x = y -> P y.
Proof.
  intros; subst; auto.
Qed.

Lemma ergo_eq_concat_2 :
  forall (P:t -> t -> Prop) (x1 x2 y1 y2:t),
    P x1 x2 -> x1 = y1 -> x2 = y2 -> P y1 y2.
Proof.
  intros; subst; auto.
Qed.

End congr.


Require Import STLCSubRec.syntax.
Require Import STLCSubRec.bindings.
Require Import Cpdt.CpdtTactics.
(* Require Import STLCdbj.syn_typing. *)
Require Import Utf8.
Require Import Coq.Strings.String.

(* Implicit Types V:Set. *)

(*
Inductive val (V: Set) : Set :=
  | v_var  : V -> val V
  | v_true : val V
  | v_false : val V
  | v_abs  : exp (inc V) -> val V
with exp (V : Set) : Set :=
  | e_val  : val V -> exp V
  | e_if   : exp V -> exp V -> exp V -> exp V
  | e_app  : exp V -> exp V -> exp V.
   *)

(*
  If we can somehow incoporate evaluation context
  into step, then step can write less boilerplate
*)

Inductive step {V U} : Exp V U -> Exp V U -> Prop :=
   | st_app0: forall T exp_body (v : Exp V U),
      val v ->
       step (e_app  (e_abs T exp_body) v) ((V_subst_exp v) exp_body)
   | st_if1: forall a b,
       step (e_if e_true a b) a
   | st_if2: forall a b,
       step (e_if e_false a b) b
   | st_app1: forall e1 e1' e2,
       step e1 e1' ->
       step (e_app e1 e2) (e_app e1' e2)
   | st_app2: forall e1 e2 e2',
       val e1 ->
       step e2 e2' ->
       step (e_app e1 e2) (e_app e1 e2')
   | st_if3: forall cond cond' a b,
       step cond cond' ->
       step (e_if cond a b) (e_if cond' a b)
   | st_prj0: forall name t' term,
      val t' -> val term ->
      step (e_prj name (e_intsctrcd t' name term)) term
   | st_prj1: forall name1 name2 term t',
      name1 <> name2 ->
      val t' -> val term ->
      step (e_prj name1 (e_intsctrcd t' name2 term)) (e_prj name1 t')
   | st_prj2 : forall name a b,
      step a b ->
      step (e_prj name a) (e_prj name b)
   | st_prj3 : forall name t T,
      step (e_prj name (e_recrcd t T)) (e_prj name ((V_subst_exp (e_recrcd t T)) t))
   | st_intsct0 : forall name a b c,
      step a b ->
      step (e_intsctrcd a name c) (e_intsctrcd b name c)
   | st_intsct1 : forall  name a b c,
      val c ->
      step a b ->
      step (e_intsctrcd c name a) (e_intsctrcd c name b).

Notation "s1 '↝' s2" := (step s1 s2)
      (at level 101).

      Section steps_property.

(* Hint Resolve val_pf_irrelevence. *)
Hint Constructors Exp val.

(* Theorem step_determinstic
{V} {x y : Exp V}
(h0: step x y):
forall z,
 step x z ->
y = z.

Ltac cleanup_impossible:=
  match goal with
  (* | h0 :  val_has_type _ (v_abs _ _ _) ty_bool |- _ => inversion h0 *)
  | [h : step (e_if  (e_var _) _ _) _ |- _] => inversion h
  | [h : step (e_if  (e_abs _ _) _ _) _ |- _] => inversion h

  end.

Ltac destruct_ALL :=
    repeat
      match goal with
      | [h : _ \/ _ |- _ ] => destruct h; subst; eauto
      | [h : _ /\ _ |- _ ] => destruct h; subst; eauto
      | [h : exists _ , _ |- _ ] => destruct h; subst; eauto
      | [h : Some _ = Some _ |- _] => inversion h; subst; eauto
      | [h : {_} + {_} |- _] => destruct h; subst; eauto
      end.

induction h0; try(intros z H;
inversion H; subst; eauto;
try cleanup_impossible; try discriminate; try contradiction;
crush; fail).

admit. intros z H;
inversion H; subst; eauto.
idtac.
rewrite (val_pf_irrelevence v v0); eauto.
match goal with
| [h : context[_ ->  _ = _] |- _] => erewrite h; eauto
end.
Qed. *)

Inductive steps {V U} : Exp V U -> Exp V U -> Prop :=
  | sts_refl : forall x,
      steps x x
  | sts_trans: forall x y z,
      step x y ->
      steps y z ->
      steps x z.

Notation "x '↝¹' y" := (step x y)
      (at level 101).

Notation "x '↝⁺' y" := (steps x y)
      (at level 101).

Ltac cleanup_impossible:=
  match goal with
  (* | h0 :  val_has_type _ (v_abs _ _ _) ty_bool |- _ => inversion h0 *)
  | [h : step (e_if  (e_var _) _ _) _ |- _] => inversion h
  | [h : step (e_if  (e_abs _ _) _ _) _ |- _] => inversion h

  end.

Ltac destruct_ALL :=
    repeat
      match goal with
      | [h : _ \/ _ |- _ ] => destruct h; subst; eauto
      | [h : _ /\ _ |- _ ] => destruct h; subst; eauto
      | [h : exists _ , _ |- _ ] => destruct h; subst; eauto
      | [h : Some _ = Some _ |- _] => inversion h; subst; eauto
      | [h : {_} + {_} |- _] => destruct h; subst; eauto
      | [h : _ + {_} |- _] => destruct h; subst; eauto
      | [h : {_ | _} |- _] => destruct h; subst; eauto
      end.

Definition irreducible {V U} (x : Exp V U) :=
    ~(exists y, step x y).

Lemma irreducible_val:
    forall V U (s: Exp V U),
      val s ->
      irreducible s.
    intros V U s h0.
    induction h0; intros h;
    destruct_ALL; subst; eauto;
    try match goal with
          | h : step _ _  |- _ => inversion h; subst; eauto; try cleanup_impossible; try contradiction; try discriminate
    end.

  Qed.

Hint Constructors step steps Exp val.

  Lemma irreducible_eapp_inv:
    forall V U (a b : Exp V U),
      irreducible (e_app a b) ->
      irreducible a.

      unfold irreducible in *.
  intros V U a b h. intros h1; subst; eauto; destruct_ALL; try contradiction; try discriminate; eauto; crush.
  Qed.

  Lemma irreducible_eif_inv:
    forall V U (a b c : Exp V U),
      irreducible (e_if a b c) ->
      irreducible a.

      unfold irreducible in *.
  intros V U a b c h. intros h1; subst; eauto; destruct_ALL; try contradiction; try discriminate; eauto.
  Qed.

  Hint Resolve irreducible_val irreducible_eapp_inv irreducible_eif_inv.

Theorem syntax_eq_dec_abs:
  forall {V U} (t1: Exp V U),
    (exists T body, t1 = e_abs T body) \/
    (forall T body, ~ t1 = e_abs T body).
  intros V U t1.

  Ltac try_both_side2  :=
    try (left; eauto; crush; fail);
    try (right; intros h; destruct_ALL;
    subst; eauto; try contradiction; try discriminate; try cleanup_impossible; eauto;crush; fail).

  induction t1; subst; eauto; try_both_side2.
Qed.

Theorem syntax_eq_dec_intsctrcd:
  forall {V U} (t : Exp V U),
    (exists t0 name t1, t = e_intsctrcd t0 name t1) \/
    (forall t0 name t1, ~ t = e_intsctrcd t0 name t1).

  intros V U t. induction t; subst; eauto; try_both_side2.
Qed.

Theorem syntax_eq_dec_recrcd:
  forall {V U} (t : Exp V U),
    (exists t0 T, t = e_recrcd t0 T) \/
    (forall t0 T, ~ t = e_recrcd t0 T).

  intros V U t. induction t; subst; eauto; try_both_side2.
Qed.

Lemma irreducible_non_stepping:
  forall {V U} {x y : Exp V U},
    step x y -> ~irreducible x.
  intros V U x y H. intro H1. eauto.
Qed.

Lemma val_not_steppable:
  forall {V U} {x : Exp V U},
    val x ->
    forall {y},
     step x y -> False.
  intros V U x h. induction h; intros;
  try (
  match goal with
  | [h : step _ _ |- _ ] =>
  inversion h; subst; eauto; try contradiction; try discriminate
  end);
  eauto.
Qed.

Hint Extern 1  =>
  match goal with
  | [h1 : irreducible ?x, h2 : step ?x _ |- _]
    => destruct (irreducible_non_stepping h2 h1)
  | [h1 : val ?x, h2 : step ?x _ |- _]
    => destruct (val_not_steppable h1 h2)
  end
.

  Theorem steppable_dec:
    forall V U (t : Exp V U),
      (exists t', step t t') \/ (irreducible t).

Ltac try_both_side  :=
    try (left; eauto; crush; fail);
    try (right; intros h; destruct_ALL;
    match goal with
    | h : step (e_if _ _ _ ) _ |- _ =>
      inversion h; subst
    | h : step (e_app _ _) _ |- _ =>
      inversion h; subst
    | h : step (e_prj _ _) _ |- _ =>
      inversion h; subst
    | h : step (e_intsctrcd _ _ _) _ |- _ =>
      inversion h; subst
    | h : step (e_recrcd _ _) _ |- _ =>
      inversion h; subst
    end;
        (* for example
             *)
    subst; eauto; try contradiction; try discriminate; try cleanup_impossible; eauto; fail).
    intros V U t. induction t; subst; eauto.

    (* app *)
    +   destruct_ALL; eauto; subst; try_both_side.
        idtac.
        destruct (val_dec t1); eauto; try_both_side.

        destruct (syntax_eq_dec_abs t1); destruct_ALL; eauto; try_both_side.

        destruct (val_dec t2); eauto; try_both_side.
        right; intro H2; destruct_ALL; eauto.
        inversion H2;try contradiction; try discriminate; try cleanup_impossible; crush.

    (* e_if *)
    + clear IHt2 IHt3. destruct_ALL; crush.
        destruct t1;
        try_both_side.

    (* e_intsctrcd *)
    +  destruct_ALL; try_both_side.
       destruct (val_dec t1); eauto; try_both_side.

    (* e_prj *)
    +  destruct_ALL; try_both_side.

       destruct (val_dec t); subst; eauto; try_both_side.

       destruct (syntax_eq_dec_intsctrcd t); destruct_ALL; eauto; try_both_side.

       inversion v; subst; eauto.

       destruct (string_dec s x0); subst; eauto; try_both_side.

       destruct (syntax_eq_dec_recrcd t); destruct_ALL; eauto; try_both_side.

        right; intros; intro; destruct_ALL.
        try match goal with
        | [h : step (e_prj _ _) _ |- _] => inversion h; subst; eauto; crush; fail
        end.

Qed.

Ltac cleanup_impossible2:=
    match goal with
    (* | h0 :  val_has_type _ (v_abs _ _ _) ty_bool |- _ => inversion h0 *)
    | [h : step (e_if  (e_var _) _ _) _ |- _] => inversion h
    | [h : step (e_if  (e_abs _ _) _ _) _ |- _] => inversion h
    | [h : step (e_var _) _ |- _] => inversion h
    | [h : step (e_abs _ _) _ |- _] => inversion h
    | [h : step e_true _ |- _] => inversion h
    | [h : step e_false _ |- _] => inversion h
    | [h : step e_top _ |- _] => inversion h
    end.

Theorem step_determinsitic
   {V U} {x : Exp V U} {y}
    (h:step x y) :
    forall {z},
    step x z ->
    y = z.
  induction h; intros z h2; subst;
  try (
    match goal with
    | [h : step _ _ |- _] =>
      inversion h; subst; eauto; try cleanup_impossible2;try contradiction
    end
  );
  try (
    erewrite IHh; eauto ;fail
  );
try (
      match goal with
      | [h : step (e_intsctrcd ?a ?b ?c) _ |- _ ] =>
      assert (val (e_intsctrcd a b c)); eauto
      end;fail
);

try (match goal with
      | [h : step (e_recrcd ?a ?b) _ |- _ ] =>
      assert (val (e_recrcd a b)); eauto
end); fail.

Qed.

End steps_property.

Hint Extern 1  =>
  match goal with
  | [h1 : irreducible ?x, h2 : step ?x _ |- _]
    => destruct (irreducible_non_stepping h2 h1)
  | [h1 : val ?x, h2 : step ?x _ |- _]
    => destruct (val_not_steppable h1 h2)
  end
.


Require Import RamifyCoq.CertiGC.gc_spec.

Lemma body_resume: semax_body Vprog Gprog f_resume resume_spec.
Proof.
  start_function.
  unfold thread_info_rep, heap_struct_rep. Intros.
  forward. unfold fun_info_rep. forward. 1: entailer!. rewrite Znth_0_cons.
  replace_SEP 1 (fun_info_rep rsh f_info fi) by (unfold fun_info_rep; entailer!).
  forward_if True.
  - forward; entailer!.
  - remember (ti_heap_p t_info). rewrite (data_at_isptr sh heap_type).
    Intros. exfalso. destruct t_info. simpl in *. subst. contradiction.
  - Intros. destruct (heap_head_cons (ti_heap t_info)) as [hs [hl [? ?]]].
    rewrite H1, <- H2, map_cons.
    destruct (gt_gs_compatible _ _ H _ (graph_has_gen_O _)) as [? [? ?]].
    assert (isptr (space_start (heap_head (ti_heap t_info)))). {
      rewrite H2. unfold nth_space in H3. rewrite H1 in H3. simpl in H3.
      rewrite <- H3. apply start_isptr. } unfold space_tri at 1. do 2 forward.
    rewrite Znth_0_cons.
    destruct (space_start (heap_head (ti_heap t_info))) eqn:? ; try contradiction.
    forward_if (fun_word_size f_info <= total_space hs).
    + unfold denote_tc_samebase. simpl. entailer!.
    + unfold all_string_constants. Intros.
      forward_call ((gv ___stringlit_11),
                    (map init_data2byte (gvar_init v___stringlit_11)), rsh).
      exfalso; assumption.
    + forward. entailer!.
      unfold sem_sub_pp in H7. destruct eq_block in H7; [|easy]; simpl in H7.
      inv_int i. clear -H7. remember (heap_head (ti_heap t_info)) as h.
      rewrite ptrofs_add_repr, ptrofs_sub_repr, Z.add_comm, Z.add_simpl_r in H7.
      simpl in H7. unfold Ptrofs.divs in H7.
      rewrite (Ptrofs.signed_repr 4) in H7 by rep_omega.
      rewrite Ptrofs.signed_repr in H7 by (apply total_space_signed_range).
      rewrite WORD_SIZE_eq in H7. rewrite Z.mul_comm, Z.quot_mul in H7 by omega.
      rewrite ptrofs_to_int_repr in H7. hnf in H7.
      destruct (Int.ltu (Int.repr (total_space h))
                        (Int.repr (fun_word_size f_info))) eqn:? ; simpl in H7.
      1: inversion H7. apply ltu_repr_false in Heqb;
                         [omega | apply total_space_range | apply word_size_range].
    + rewrite <- Heqv in *. red in H0. rewrite H0 in H5.
      unfold previous_vertices_size in H5. simpl in H5. unfold nth_space in H5.
      rewrite H1 in H5. simpl in H5. rewrite <- H2 in H5.
      replace_SEP
        4 (heap_struct_rep
             sh ((space_start (heap_head (ti_heap t_info)),
                  (offset_val (WORD_SIZE * used_space (heap_head (ti_heap t_info)))
                              (space_start (heap_head (ti_heap t_info))),
                   offset_val (WORD_SIZE * total_space (heap_head (ti_heap t_info)))
                              (space_start (heap_head (ti_heap t_info)))))
                   :: map space_tri hl) (ti_heap_p t_info)) by
          (unfold heap_struct_rep; entailer!). do 3 forward.
      unfold before_gc_thread_info_rep. rewrite !heap_struct_rep_eq. rewrite <- H5.
      replace (WORD_SIZE * 0)%Z with 0 by omega.
      rewrite !isptr_offset_val_zero by assumption. cancel. rewrite H1. simpl tl.
      assert (12 = Zlength (map space_tri hl) + 1). {
        pose proof (spaces_size (ti_heap t_info)). rewrite MAX_SPACES_eq in H2.
        rewrite <- H2, H1, Zlength_cons, Zlength_map. omega. } rewrite !H2.
      rewrite !data_at_tarray_split_1 by reflexivity. cancel.
      do 2 (unfold_data_at (data_at _ _ _ _)). cancel.
Qed.