Require Import Verdi.Verdi.
Require Import Verdi.DynamicNetLemmas.
Require Import Verdi.TotalMapSimulations.
Require Import Verdi.PartialMapSimulations.

Local Arguments update {_} {_} _ _ _ _ _ : simpl never.

Require Import FunctionalExtensionality.
Require Import Sumbool.
Require Import Sorting.Permutation.

Require Import Verdi.Ssrexport.

Set Implicit Arguments.

Class MultiParamsPartialExtendedMap
 (B0 : BaseParams) (B1 : BaseParams)
 (P0 : MultiParams B0) (P1 : MultiParams B1) :=
{
  pt_ext_map_data : @data B0 -> @name B0 P0 -> @data B1 ;
  pt_ext_map_input : @input B0 -> @name B0 P0 -> @data B0 -> option (@input B1)
}.

Section PartialExtendedMapDefs.

Context {base_fst : BaseParams}.
Context {base_snd : BaseParams}.
Context {multi_fst : MultiParams base_fst}.
Context {multi_snd : MultiParams base_snd}.
Context {name_map : MultiParamsNameTotalMap multi_fst multi_snd}.
Context {msg_map : MultiParamsMsgPartialMap multi_fst multi_snd}.
Context {multi_map : MultiParamsPartialExtendedMap multi_fst multi_snd}.

Definition pt_ext_mapped_net_handlers me src m st :=
  let '(_, st', ps) := net_handlers me src m st in
  (pt_ext_map_data st' me, filterMap (pt_map_name_msg (name_map := name_map) (msg_map := msg_map)) ps).

Definition pt_ext_mapped_input_handlers me inp st :=
  let '(_, st', ps) := input_handlers me inp st in
  (pt_ext_map_data st' me, filterMap (pt_map_name_msg (name_map := name_map) (msg_map := msg_map)) ps).

End PartialExtendedMapDefs.

Class MultiParamsPartialExtendedMapCongruency
  (B0 : BaseParams) (B1 : BaseParams)
  (P0 : MultiParams B0) (P1 : MultiParams B1)
  (N : MultiParamsNameTotalMap P0 P1)
  (P : MultiParamsMsgPartialMap P0 P1)
  (P : MultiParamsPartialExtendedMap P0 P1) : Prop :=
  {
    pt_ext_init_handlers_eq : forall n,
      pt_ext_map_data (init_handlers n) n = init_handlers (tot_map_name n) ;
    pt_ext_net_handlers_some : forall me src m st m' out st' ps,
      pt_map_msg m = Some m' ->
      net_handlers (tot_map_name me) (tot_map_name src) m' (pt_ext_map_data st me) = (out, st', ps) ->
      pt_ext_mapped_net_handlers me src m st = (st', ps) ;
    pt_ext_net_handlers_none : forall me src m st out st' ps,
      pt_map_msg m = None ->
      net_handlers me src m st = (out, st', ps) ->
      pt_ext_map_data st' me = pt_ext_map_data st me /\ filterMap pt_map_name_msg ps = [] ;
    pt_ext_input_handlers_some : forall me inp st inp' out st' ps,
      pt_ext_map_input inp me st = Some inp' ->
      input_handlers (tot_map_name me) inp' (pt_ext_map_data st me) = (out, st', ps) ->
      pt_ext_mapped_input_handlers me inp st = (st', ps) ;
    pt_ext_input_handlers_none : forall me inp st out st' ps,
      pt_ext_map_input inp me st = None ->
      input_handlers me inp st = (out, st', ps) ->
      pt_ext_map_data st' me = pt_ext_map_data st me /\ filterMap pt_map_name_msg ps = []
  }.

Class FailureParamsPartialExtendedMapCongruency
  (B0 : BaseParams) (B1 : BaseParams)
  (P0 : MultiParams B0) (P1 : MultiParams B1)
  (F0 : FailureParams P0) (F1 : FailureParams P1)
  (P : MultiParamsPartialExtendedMap P0 P1) : Prop :=
  {
    pt_ext_reboot_eq : forall d me,
      pt_ext_map_data (reboot d) me = reboot (pt_ext_map_data d me)
  }.

Section PartialExtendedMapSimulations.

Context {base_fst : BaseParams}.
Context {base_snd : BaseParams}.
Context {multi_fst : MultiParams base_fst}.
Context {multi_snd : MultiParams base_snd}.
Context {name_map : MultiParamsNameTotalMap multi_fst multi_snd}.
Context {msg_map : MultiParamsMsgPartialMap multi_fst multi_snd}.
Context {multi_map : MultiParamsPartialExtendedMap multi_fst multi_snd}.
Context {name_map_bijective : MultiParamsNameTotalMapBijective name_map}.
Context {multi_map_congr : MultiParamsPartialExtendedMapCongruency name_map msg_map multi_map}.

Lemma pt_ext_init_handlers_fun_eq :
  init_handlers = fun n : name => pt_ext_map_data (init_handlers (tot_map_name_inv n)) (tot_map_name_inv n).
Proof using name_map_bijective multi_map_congr msg_map.
apply functional_extensionality => n.
have H_eq := pt_ext_init_handlers_eq.
rewrite H_eq {H_eq}.
by rewrite tot_map_name_inverse_inv.
Qed.

Definition pt_ext_map_net (net : @network  _ multi_fst) : @network _ multi_snd :=
  {| nwPackets := filterMap pt_map_packet net.(nwPackets) ;
     nwState := fun n => pt_ext_map_data (net.(nwState) (tot_map_name_inv n)) (tot_map_name_inv n) |}.

Lemma pt_ext_map_update_eq :
forall f h d,
  (fun n : name => pt_ext_map_data (update name_eq_dec f h d (tot_map_name_inv n)) (tot_map_name_inv n)) =
  update name_eq_dec (fun n : name => pt_ext_map_data (f (tot_map_name_inv n)) (tot_map_name_inv n)) (tot_map_name h) (pt_ext_map_data d h).
Proof using name_map_bijective.
move => f h d.
apply functional_extensionality => n.
rewrite /update /=.
case (name_eq_dec _ _) => H_dec; case (name_eq_dec _ _) => H_dec' //.
- rewrite -H_dec in H_dec'.
  by rewrite H_dec.
- case: H_dec'.
  rewrite -H_dec.
  by rewrite tot_map_name_inverse_inv.
- rewrite H_dec' in H_dec.
  by rewrite tot_map_name_inv_inverse in H_dec.
Qed.

Lemma pt_ext_map_update_eq_some :
  forall net d p p',
    pt_map_packet p = Some p' ->
    (fun n : name => pt_ext_map_data (update name_eq_dec (nwState net) (pDst p) d (tot_map_name_inv n)) (tot_map_name_inv n)) =
    update name_eq_dec (fun n : name => pt_ext_map_data (nwState net (tot_map_name_inv n)) (tot_map_name_inv n)) (pDst p') (pt_ext_map_data d (pDst p)).
Proof using name_map_bijective.
move => net d p p'.
case: p => src dst m.
case: p' => src' dst' m' /=.
case H_eq: (pt_map_msg _) => [m0|] // H_eq'.
inversion H_eq'; subst.
move {H_eq H_eq'}.
exact: pt_ext_map_update_eq.
Qed.

Theorem step_async_pt_ext_mapped_simulation_1 :
  forall net net' tr,
    @step_async _ multi_fst net net' tr ->
    (exists tr, @step_async _ multi_snd (pt_ext_map_net net) (pt_ext_map_net net') tr) \/ pt_ext_map_net net' = pt_ext_map_net net.
Proof using name_map_bijective multi_map_congr.
move => net net' tr.
case => {net net' tr}.
- move => net net' p ms ms' out d l H_eq H_hnd H_eq'.
  destruct (pt_map_packet p) eqn:?.
    left.
    rewrite H_eq' /= /pt_ext_map_net /=.
    have H_eq_dst: tot_map_name (pDst p) = pDst p0.
      case: p H_eq H_hnd H_eq' Heqo => /= src dst m H_eq H_hnd H_eq'.
      case (pt_map_msg m) => //= m' H_m.
      by inversion H_m.
    destruct (net_handlers (pDst p0) (pSrc p0) (pBody p0) (pt_ext_map_data (nwState net (pDst p)) (pDst p))) eqn:?.
    destruct p1 as [out' d'].
    exists [(pDst p0, inr out')].
    apply @StepAsync_deliver with (xs := filterMap pt_map_packet ms) (ys := filterMap pt_map_packet ms') (d := pt_ext_map_data d (pDst p)) (l := filterMap pt_map_name_msg l).
    * rewrite /= H_eq filterMap_app /=.
      case H_p: (pt_map_packet _) => [p1|]; last by rewrite H_p in Heqo.
      by rewrite H_p in Heqo; injection Heqo => H_eq_p; rewrite H_eq_p.
    * rewrite /=.
      rewrite -{2}H_eq_dst tot_map_name_inv_inverse.
      case: p H_eq H_hnd H_eq' Heqo H_eq_dst Heqp1 => /= src dst mg H_eq H_hnd H_eq'.
      case H_m: (pt_map_msg mg) => [mg'|] //.
      case: p0 H_eq' => src' dst' m0 H_eq' H_eq_p.
      inversion H_eq_p; subst.
      move => H_eq_dst H_eq_n {H_eq_p H_eq_dst}.
      simpl in *.
      have H_q := @pt_ext_net_handlers_some _ _ _ _ _ _ _ multi_map_congr dst src mg (nwState net dst) _ _ _ _ H_m H_eq_n.
      rewrite /pt_ext_mapped_net_handlers in H_q.
      rewrite H_hnd in H_q.
      find_inversion.
      by rewrite tot_map_name_inv_inverse.
    * rewrite /= /pt_ext_map_net /= 2!filterMap_app.
      rewrite (filterMap_pt_map_packet_map_eq_some _ _ Heqo).
      by rewrite (pt_ext_map_update_eq_some _ _ _ Heqo).
  right.
  rewrite H_eq' /= {H_eq'}.
  rewrite /pt_ext_map_net /=.
  case: p H_eq H_hnd Heqo => /= src dst m H_eq H_hnd.
  case H_m: (pt_map_msg _) => [m'|] // H_eq' {H_eq'}.
  rewrite 2!filterMap_app H_eq filterMap_app /=.
  case H_m': (pt_map_msg _) => [m'|]; first by rewrite H_m' in H_m.
  have [H_d H_l] := pt_ext_net_handlers_none _ _ _ _ H_m H_hnd.
  rewrite (filterMap_pt_map_name_msg_empty_eq _ dst H_l) /=.
  set nwS1 := fun _ => _.
  set nwS2 := fun _ => _.
  have H_eq_s: nwS1 = nwS2.
    rewrite /nwS1 /nwS2 /=.
    apply functional_extensionality => n.
    rewrite /update /=.
      case name_eq_dec => H_dec //.
      by rewrite H_dec H_d.
    by rewrite H_eq_s.
- move => h net net' out inp d l H_hnd H_eq.
  destruct (pt_ext_map_input inp h (nwState net h)) eqn:?.
    left.
    destruct (input_handlers (tot_map_name h) i (pt_ext_map_data (nwState net h) h)) eqn:?.
    destruct p  as [out' d'].
    exists [(tot_map_name h, inl i); (tot_map_name h, inr out')].
    apply (@StepAsync_input _ _ _ _ _ _ _ (pt_ext_map_data d h) (filterMap pt_map_name_msg l)).
      rewrite /=.
      have H_q := @pt_ext_input_handlers_some _ _ _ _ _ _ _ multi_map_congr h inp (nwState net h) _ _ _ _ Heqo Heqp.
      rewrite /pt_ext_mapped_input_handlers /= in H_q.
      rewrite H_hnd in H_q.
      find_inversion.
      by rewrite tot_map_name_inv_inverse.
    rewrite /= H_eq /= /pt_ext_map_net /= filterMap_app filterMap_pt_map_packet_map_eq.
    by rewrite -pt_ext_map_update_eq.
  right.
  rewrite H_eq /pt_ext_map_net /=.
  have [H_d H_l] := pt_ext_input_handlers_none _ _ _ Heqo H_hnd.
  rewrite filterMap_app.
  rewrite (filterMap_pt_map_name_msg_empty_eq _ h H_l) /=.
  set nwS1 := fun _ => _.
  set nwS2 := fun _ => _.
  have H_eq_s: nwS1 = nwS2.
      rewrite /nwS1 /nwS2 /=.
      apply functional_extensionality => n.
      rewrite /update /=.
      case name_eq_dec => H_dec //.
      by rewrite H_dec H_d.
    by rewrite H_eq_s.
Qed.

Corollary step_async_pt_ext_mapped_simulation_star_1 :
  forall net tr,
    @step_async_star _ multi_fst step_async_init net tr ->
    exists tr', @step_async_star _ multi_snd step_async_init (pt_ext_map_net net) tr'.
Proof using name_map_bijective multi_map_congr.
move => net tr H_step.
remember step_async_init as y in *.
move: Heqy.
induction H_step using refl_trans_1n_trace_n1_ind => H_init /=.
  rewrite H_init.
  rewrite /step_async_init /= /pt_ext_map_net /=.
  rewrite pt_ext_init_handlers_fun_eq.
  exists [].
  exact: RT1nTBase.
concludes.
rewrite H_init in H_step2 H_step1.
apply step_async_pt_ext_mapped_simulation_1 in H.
case: H => H.
  move: IHH_step1 => [tr' H_star].
  move: H => [tr'' H].
  exists (tr' ++ tr'').
  have H_trans := refl_trans_1n_trace_trans H_star.
  apply: H_trans.
  have ->: tr'' = tr'' ++ [] by rewrite -app_nil_end.
  apply: (@RT1nTStep _ _ _ _ (pt_ext_map_net x'')) => //.
  exact: RT1nTBase.
move: H => [H_eq H_eq'].
move: IHH_step1 => [tr' H_star].
exists tr'.
rewrite /pt_ext_map_net.
by rewrite H_eq H_eq'.
Qed.

Definition pt_ext_map_onet (onet : @ordered_network _ multi_fst) : @ordered_network _ multi_snd :=
mkONetwork (fun src dst => filterMap pt_map_msg (onet.(onwPackets) (tot_map_name_inv src) (tot_map_name_inv dst)))
           (fun n => pt_ext_map_data (onet.(onwState) (tot_map_name_inv n)) (tot_map_name_inv n)).

Theorem step_ordered_pt_ext_mapped_simulation_1 :
  forall net net' tr,
    @step_ordered _ multi_fst net net' tr ->
    (exists tr', @step_ordered _ multi_snd (pt_ext_map_onet net) (pt_ext_map_onet net') tr') \/ pt_ext_map_onet net' = pt_ext_map_onet net.
Proof using name_map_bijective multi_map_congr.
move => net net' tr.
case => {net net' tr}.
- move => net net' tr m ms out d l from to H_eq H_hnd H_eq' H_eq_tr.
  destruct (pt_map_msg m) eqn:?.
    left.
    destruct (net_handlers (tot_map_name to) (tot_map_name from) m0 (pt_ext_map_data (onwState net to) to)) eqn:?.
    destruct p as [out' d'].
    exists (map2fst (tot_map_name to) (map inr out')).
    rewrite H_eq' /= /pt_ext_map_onet /=.
    apply (@StepOrdered_deliver _ _ _ _ _ m0 (filterMap pt_map_msg ms) out' (pt_ext_map_data d to) (filterMap pt_map_name_msg l) (tot_map_name from) (tot_map_name to)) => //=.
    * rewrite 2!tot_map_name_inv_inverse H_eq /=.
      case H_m1: pt_map_msg => [m1|]; last by rewrite Heqo in H_m1.
      rewrite H_m1 in Heqo.
      by inversion Heqo.
    * rewrite tot_map_name_inv_inverse.
      have H_q := @pt_ext_net_handlers_some _ _ _ _ _ _ _ multi_map_congr _ _ _ _ _ _ _ _ Heqo Heqp.
      rewrite /pt_ext_mapped_net_handlers /= in H_q.
      by repeat break_let; repeat tuple_inversion.
    * by rewrite /= pt_ext_map_update_eq collate_pt_map_update2_eq.
  right.
  have [H_eq_d H_ms] := pt_ext_net_handlers_none _ _ _ _ Heqo H_hnd.
  rewrite H_eq' /pt_ext_map_onet /=.
  rewrite pt_ext_map_update_eq /= H_eq_d.
  rewrite collate_pt_map_eq H_ms /=.
  set nwS1 := update _ _ _ _.
  set nwS2 := fun n => pt_ext_map_data _ _.
  set nwP1 := fun _ _ => _.
  set nwP2 := fun _ _ => _.
  have H_eq_s: nwS1 = nwS2.
    rewrite /nwS1 /nwS2 {nwS1 nwS2}.
    apply functional_extensionality => n.
    rewrite /update /=.
    case (name_eq_dec _ _) => H_dec //.
    by rewrite H_dec tot_map_name_inv_inverse.
  have H_eq_p: nwP1 = nwP2.
    rewrite /nwP1 /nwP2 /=.
    apply functional_extensionality => src.
    apply functional_extensionality => dst.
    rewrite /update2 /=.
    case (sumbool_and _ _ _ _) => H_dec //.
    move: H_dec => [H_eq_from H_eq_to].
    rewrite -H_eq_from -H_eq_to H_eq /=.
    case H_m': (pt_map_msg _) => [m'|] //.
    by rewrite H_m' in Heqo.
  by rewrite H_eq_s H_eq_p.
- move => h net net' tr out inp d l H_hnd H_eq H_eq_tr.
  destruct (pt_ext_map_input inp h (onwState net h)) eqn:?.
    left.
    destruct (input_handlers (tot_map_name h) i (pt_ext_map_data (onwState net h) h)) eqn:?.
    destruct p as [out' d'].
    exists ((tot_map_name h, inl i) :: map2fst (tot_map_name h) (map inr out')).
    apply (@StepOrdered_input _ _ (tot_map_name h) _ _ _ out' i (pt_ext_map_data d h) (filterMap pt_map_name_msg l)) => //=; last by rewrite H_eq /pt_ext_map_onet /= pt_ext_map_update_eq collate_pt_map_eq.
    have H_q := @pt_ext_input_handlers_some _ _ _ _ _ _ _ multi_map_congr h inp (onwState net h) _ _ _ _ Heqo Heqp.
    rewrite /pt_ext_mapped_input_handlers /= in H_q.
    rewrite tot_map_name_inv_inverse.
    by repeat break_let; repeat tuple_inversion.
  right.
  rewrite /=.
  have [H_d H_l] := pt_ext_input_handlers_none h inp (onwState net h) Heqo H_hnd.
  rewrite H_eq /= /pt_ext_map_onet /=.
  rewrite pt_ext_map_update_eq /= H_d.
  rewrite collate_pt_map_eq H_l /=.
  set nwS1 := update _ _ _ _.
  set nwS2 := fun n => pt_ext_map_data _ _.
  have H_eq_n: nwS1 = nwS2.
    rewrite /nwS1 /nwS2 /=.
    apply functional_extensionality => n.
    rewrite /update /=.
    case (name_eq_dec _ _) => H_dec //.
    by rewrite H_dec tot_map_name_inv_inverse.
  by rewrite H_eq_n.
Qed.

Corollary step_ordered_pt_ext_mapped_simulation_star_1 :
  forall net tr,
    @step_ordered_star _ multi_fst step_ordered_init net tr ->
    exists tr', @step_ordered_star _ multi_snd step_ordered_init (pt_ext_map_onet net) tr'.
Proof using name_map_bijective multi_map_congr.
move => net tr H_step.
remember step_ordered_init as y in *.
move: Heqy.
induction H_step using refl_trans_1n_trace_n1_ind => H_init /=.
  rewrite H_init.
  rewrite /step_ordered_init /= /pt_ext_map_net /=.
  rewrite pt_ext_init_handlers_fun_eq.
  exists [].
  exact: RT1nTBase.
concludes.
rewrite H_init in H_step2 H_step1.
apply step_ordered_pt_ext_mapped_simulation_1 in H.
case: H => H.
  move: IHH_step1 => [tr' H_star].
  move: H => [tr'' H].
  exists (tr' ++ tr'').
  have H_trans := refl_trans_1n_trace_trans H_star.
  apply: H_trans.
  have ->: tr'' = tr'' ++ [] by rewrite -app_nil_end.
  apply: (@RT1nTStep _ _ _ _ (pt_ext_map_onet x'')) => //.
  exact: RT1nTBase.
move: H => [H_eq H_eq'].
move: IHH_step1 => [tr' H_star].
exists tr'.
by rewrite /pt_ext_map_onet H_eq H_eq'.
Qed.

Context {overlay_fst : NameOverlayParams multi_fst}.
Context {overlay_snd : NameOverlayParams multi_snd}.
Context {overlay_map_congr : NameOverlayParamsTotalMapCongruency overlay_fst overlay_snd name_map}.

Context {fail_msg_fst : FailMsgParams multi_fst}.
Context {fail_msg_snd : FailMsgParams multi_snd}.
Context {fail_msg_map_congr : FailMsgParamsPartialMapCongruency fail_msg_fst fail_msg_snd msg_map}.

Theorem step_ordered_failure_pt_ext_mapped_simulation_1 :
  forall net net' failed failed' tr,
    @step_ordered_failure _ _ overlay_fst fail_msg_fst (failed, net) (failed', net') tr ->
    (exists tr', @step_ordered_failure _ _ overlay_snd fail_msg_snd (map tot_map_name failed, pt_ext_map_onet net) (map tot_map_name failed', pt_ext_map_onet net') tr') \/ pt_ext_map_onet net' = pt_ext_map_onet net /\ failed = failed'.
Proof using overlay_map_congr name_map_bijective multi_map_congr fail_msg_map_congr.
move => net net' failed failed' tr H_step.
invcs H_step.
- destruct (pt_map_msg m) eqn:?.
    left.
    destruct (net_handlers (tot_map_name to) (tot_map_name from) m0 (pt_ext_map_data (onwState net to) to)) eqn:?.
    destruct p as [out' d'].
    exists (map2fst (tot_map_name to) (map inr out')).
    rewrite /pt_ext_map_onet /=.
    apply (@StepOrderedFailure_deliver _ _ _ _ _ _ _ _ m0 (filterMap pt_map_msg ms) out' (pt_ext_map_data d to) (filterMap pt_map_name_msg l) (tot_map_name from) (tot_map_name to)) => //=.
    * rewrite 2!tot_map_name_inv_inverse /= H3 /=.
      case H_m1: (pt_map_msg _) => [m1|]; last by rewrite Heqo in H_m1.
      rewrite Heqo in H_m1.
      by inversion H_m1.
    * exact: not_in_failed_not_in.
    * rewrite /= tot_map_name_inv_inverse.
      have H_q := @pt_ext_net_handlers_some _ _ _ _ _ _ _ multi_map_congr _ _ _ _ _ _ _ _ Heqo Heqp.
      rewrite /pt_ext_mapped_net_handlers /= in H_q.
      by repeat break_let; repeat tuple_inversion.
    * by rewrite /= pt_ext_map_update_eq collate_pt_map_update2_eq.
  right.
  split => //.
  have [H_eq_d H_ms] := pt_ext_net_handlers_none _ _ _ _ Heqo H5.
  rewrite /pt_ext_map_onet /= pt_ext_map_update_eq H_eq_d collate_pt_map_update2_eq H_ms /=.
  set nwP1 := update2 _ _ _ _ _.
  set nwS1 := update _ _ _ _.
  set nwP2 := fun _ _ => _.
  set nwS2 := fun _ => _.
  have H_eq_s: nwS1 = nwS2.
    rewrite /nwS1 /nwS2 {nwS1 nwS2}.
    apply functional_extensionality => n.
    rewrite /update /=.
    case (name_eq_dec _ _) => H_dec //.
    by rewrite H_dec tot_map_name_inv_inverse.
  have H_eq_p: nwP1 = nwP2.
    rewrite /nwP1 /nwP2 /=.
    apply functional_extensionality => src.
    apply functional_extensionality => dst.
    rewrite /update2 /=.
    case (sumbool_and _ _ _ _) => H_dec //.
    move: H_dec => [H_eq_from H_eq_to].
    rewrite -H_eq_from -H_eq_to /= 2!tot_map_name_inv_inverse H3 /=.
    case H_m': (pt_map_msg _) => [m'|] //.
    by rewrite H_m' in Heqo.
  by rewrite H_eq_s H_eq_p.
- destruct (pt_ext_map_input inp h (onwState net h)) eqn:?.
    left.
    destruct (input_handlers (tot_map_name h) i (pt_ext_map_data (onwState net h) h)) eqn:?.
    destruct p as [out' d'].
    exists ((tot_map_name h, inl i) :: map2fst (tot_map_name h) (map inr out')).
    apply (@StepOrderedFailure_input _ _ _ _ (tot_map_name h) _ _ _ _ out' i (pt_ext_map_data d h) (filterMap pt_map_name_msg l)) => //=.
    * exact: not_in_failed_not_in.
    * rewrite /= tot_map_name_inv_inverse.
      have H_q := @pt_ext_input_handlers_some _ _ _ _ _ _ _ multi_map_congr h inp (onwState net h) _ _ _ _ Heqo Heqp.
      rewrite /pt_ext_mapped_input_handlers /= in H_q.
      by repeat break_let; repeat tuple_inversion.
    * by rewrite /pt_ext_map_onet /= pt_ext_map_update_eq collate_pt_map_eq.
  right.
  rewrite /= /pt_ext_map_onet /=.
  have [H_d H_l] := pt_ext_input_handlers_none h inp (onwState net h) Heqo H4.
  split => //.
  rewrite pt_ext_map_update_eq /= H_d.
  rewrite collate_pt_map_eq H_l /=.
  set nwS1 := update _ _ _ _.
  set nwS2 := fun n => pt_ext_map_data _ _.
  have H_eq_n: nwS1 = nwS2.
    rewrite /nwS1 /nwS2 /=.
    apply functional_extensionality => n.
    rewrite /update /=.
    case (name_eq_dec _ _) => H_dec //.
    by rewrite H_dec tot_map_name_inv_inverse.
  by rewrite H_eq_n.
- left.
  rewrite /pt_ext_map_onet /=.
  set l := map2snd _ _.
  have H_nd: NoDup (map (fun nm => fst nm) (filterMap pt_map_name_msg l)).
    rewrite /pt_map_name_msg /=.
    rewrite /l {l}.
    apply NoDup_map_snd_fst.
      apply (@nodup_pt_map _ _ _ _ _ _ _ msg_fail); first exact: in_map2snd_snd.
      apply NoDup_map2snd.
      apply NoDup_remove_all.
      exact: no_dup_nodes.
    move => nm nm' H_in H_in'.
    by rewrite (pt_map_in_snd _ _ _ _ pt_fail_msg_fst_snd H_in) (pt_map_in_snd _ _ _ _ pt_fail_msg_fst_snd H_in').
  exists [].
  apply: StepOrderedFailure_fail => //.
  * exact: not_in_failed_not_in.
  * rewrite /=.
    rewrite /l collate_pt_map_eq /pt_map_name_msg.
    by rewrite (NoDup_Permutation_collate_eq _ _ _ _ _ _ _ H_nd (pt_map_map_pair_eq msg_fail h failed pt_fail_msg_fst_snd)).
Qed.

Corollary step_ordered_failure_pt_ext_mapped_simulation_star_1 :
  forall net failed tr,
    @step_ordered_failure_star _ _ overlay_fst fail_msg_fst step_ordered_failure_init (failed, net) tr ->
    exists tr', @step_ordered_failure_star _ _ overlay_snd fail_msg_snd step_ordered_failure_init (map tot_map_name failed, pt_ext_map_onet net) tr'.
Proof using overlay_map_congr name_map_bijective multi_map_congr fail_msg_map_congr.
move => net failed tr H_step.
remember step_ordered_failure_init as y in *.
have H_eq_f: failed = fst (failed, net) by [].
have H_eq_n: net = snd (failed, net) by [].
rewrite H_eq_f {H_eq_f}.
rewrite {2}H_eq_n {H_eq_n}.
move: Heqy.
induction H_step using refl_trans_1n_trace_n1_ind => H_init /=.
  rewrite H_init.
  rewrite /step_ordered_failure_init /= /pt_ext_map_onet /=.
  exists [].
  rewrite -pt_ext_init_handlers_fun_eq.
  exact: RT1nTBase.
concludes.
rewrite H_init {H_init x} in H_step2 H_step1.
case: x' H IHH_step1 H_step1 => failed' net'.
case: x'' H_step2 => failed'' net''.
rewrite /=.
move => H_step2 H IHH_step1 H_step1.
apply step_ordered_failure_pt_ext_mapped_simulation_1 in H.
case: H => H.
  move: IHH_step1 => [tr' H_star].
  move: H => [tr'' H].
  exists (tr' ++ tr'').
  have H_trans := refl_trans_1n_trace_trans H_star.
  apply: H_trans.
  have ->: tr'' = tr'' ++ [] by rewrite -app_nil_end.
  apply: (@RT1nTStep _ _ _ _ (map tot_map_name failed'', pt_ext_map_onet net'')) => //.
  exact: RT1nTBase.
move: H => [H_eq_n H_eq_f].
rewrite H_eq_n -H_eq_f.
move: IHH_step1 => [tr' H_star].
by exists tr'.
Qed.

Context {new_msg_fst : NewMsgParams multi_fst}.
Context {new_msg_snd : NewMsgParams multi_snd}.
Context {new_msg_map_congr : NewMsgParamsPartialMapCongruency new_msg_fst new_msg_snd msg_map}.

Definition pt_ext_map_odnet (net : @ordered_dynamic_network _ multi_fst) : @ordered_dynamic_network _ multi_snd :=
{| odnwNodes := map tot_map_name net.(odnwNodes) ;
   odnwPackets := fun src dst => filterMap pt_map_msg (net.(odnwPackets) (tot_map_name_inv src) (tot_map_name_inv dst)) ;
   odnwState := fun n => match net.(odnwState) (tot_map_name_inv n) with
                         | None => None
                         | Some d => Some (pt_ext_map_data d (tot_map_name_inv n))
                         end |}.

Theorem step_ordered_dynamic_failure_pt_ext_mapped_simulation_1 :
  forall net net' failed failed' tr,
    NoDup (odnwNodes net) ->
    @step_ordered_dynamic_failure _ _ overlay_fst new_msg_fst fail_msg_fst (failed, net) (failed', net') tr ->
    (exists tr', @step_ordered_dynamic_failure _ _ overlay_snd new_msg_snd fail_msg_snd (map tot_map_name failed, pt_ext_map_odnet net) (map tot_map_name failed', pt_ext_map_odnet net') tr') \/ (pt_ext_map_odnet net' = pt_ext_map_odnet net /\ failed = failed').
Proof using overlay_map_congr new_msg_map_congr name_map_bijective multi_map_congr fail_msg_map_congr.
move => net net' failed failed' tr H_nd H_step.
invcs H_step.
- left.
  rewrite /pt_ext_map_odnet.
  exists [].
  apply (@StepOrderedDynamicFailure_start _ _ _ _ _ _ _ _ (tot_map_name h)) => /=; first exact: not_in_failed_not_in.
  set p1 := fun _ _ => _.
  set p2 := collate_ls _ _ _ _ _.
  set s1 := fun _ => _.
  set s2 := update _ _ _ _.
  have H_eq_s: s1 = s2.
    rewrite /s1 /s2 /update {s1 s2}.
    apply functional_extensionality => n.
    rewrite -pt_ext_init_handlers_eq.
    break_match_goal.
      break_if; break_if; try by congruence.
      - by repeat find_rewrite; repeat find_rewrite_lem tot_map_name_inv_inverse.
      - by find_reverse_rewrite; find_rewrite_lem tot_map_name_inverse_inv.
      - by find_rewrite.
    break_if; break_if; (try by congruence); last by find_rewrite.
    by repeat find_rewrite; repeat find_rewrite_lem tot_map_name_inv_inverse.
  rewrite H_eq_s /s2 {s1 s2 H_eq_s}.
  have H_eq_p: p1 = p2.
    rewrite /p1 /p2 {p1 p2}.
    rewrite (collate_ls_pt_map_eq _ _ _ _ pt_new_msg_fst_snd) /=.
    rewrite collate_pt_map_eq.
    set f1 := fun _ _ => _.
    set c1 := collate _ _ _ _.
    set c2 := collate _ _ _ _.
    set f'1 := map tot_map_name _.
    set f'2 := filter_rel _ (tot_map_name h) _.
    have H_c: c1 = c2.
      rewrite /c1 /c2 {c1 c2}.
      apply: NoDup_Permutation_collate_eq; last first.
        rewrite /pt_map_name_msg.
        apply: pt_nodup_perm_map_map_pair_perm => //.
        by rewrite pt_new_msg_fst_snd.
      rewrite /pt_map_name_msg /=.
      apply: NoDup_map_snd_fst => //.
        apply (@nodup_pt_map _ _ _ _  _ _ _ msg_new); first exact: in_map2snd_snd.
        apply: NoDup_map2snd.
        exact: NoDup_remove_all.
      move => nm nm' H_in H_in'.
      apply (@pt_map_in_snd _ _ _ _ _ _ _ msg_new _ _ _ _ pt_new_msg_fst_snd) in H_in.
      apply (@pt_map_in_snd _ _ _ _ _ _ _ msg_new _ _ _ _ pt_new_msg_fst_snd) in H_in'.
      by rewrite H_in H_in'.
    rewrite H_c {H_c}.
    suff H_suff: f'1 = f'2 by rewrite H_suff.
    rewrite /f'1 /f'2.
    elim (odnwNodes net) => /=; first by rewrite 2!remove_all_nil.
    move => n ns.
    set mn := tot_map_name n.
    set mns := map _ ns.
    set mfailed' := map _ failed'.
    move => IH.
    have H_cn := remove_all_cons name_eq_dec failed' n ns.
    have H_cn' := remove_all_cons name_eq_dec mfailed' mn mns.
    unfold mn, mns, mfailed' in *.
    repeat break_or_hyp; repeat break_and; repeat find_rewrite => //=.
    * by find_apply_lem_hyp not_in_failed_not_in.
    * by find_apply_lem_hyp in_failed_in.
    * case adjacent_to_dec => H_dec; case adjacent_to_dec => H_dec' => //=.
      + by rewrite IH.
      + by find_apply_lem_hyp tot_adjacent_to_fst_snd.
      + by find_apply_lem_hyp tot_adjacent_to_fst_snd.
  by rewrite H_eq_p.
- destruct (pt_map_msg m) eqn:?.
    left.
    destruct (net_handlers (tot_map_name to) (tot_map_name from) m0 (pt_ext_map_data d to)) eqn:?.
    destruct p as [out' d''].
    exists (map2fst (tot_map_name to) (map inr out')).
    rewrite /pt_ext_map_onet /=.
    apply (@StepOrderedDynamicFailure_deliver _ _ _ _ _ _ _ _ _ m0 (filterMap pt_map_msg ms) out' (pt_ext_map_data d to) (pt_ext_map_data d' to) (filterMap pt_map_name_msg l) (tot_map_name from) (tot_map_name to)) => //=.
    * exact: not_in_failed_not_in.
    * exact: in_failed_in.
    * by rewrite /= tot_map_name_inv_inverse /= H5.
    * rewrite /= 2!tot_map_name_inv_inverse /=.
      find_rewrite.
      by rewrite /= Heqo.
    * have H_q := @pt_ext_net_handlers_some _ _ _ _ _ _ _ multi_map_congr _ _ _ _ _ _ _ _ Heqo Heqp.
      rewrite /pt_ext_mapped_net_handlers /= in H_q.
      by repeat break_let; repeat tuple_inversion.
    * rewrite /= /pt_ext_map_odnet /=.
      set u1 := fun _ => match _ with | _ => _ end.
      set u2 := update _ _ _ _.
      rewrite collate_pt_map_update2_eq.
      suff H_suff: u1 = u2 by rewrite H_suff.
      rewrite /u1 /u2 /update /=.
      apply functional_extensionality => n.
      repeat break_if; try by congruence.
        rewrite -(tot_map_name_inverse_inv n) in n0.
        by rewrite e in n0.
      find_rewrite.
      by find_rewrite_lem tot_map_name_inv_inverse.
  right.
  split => //.
  have [H_eq_d H_ms] := pt_ext_net_handlers_none _ _ _ _ Heqo H7.
  rewrite /pt_ext_map_odnet /= collate_pt_map_update2_eq H_ms /=.
  set nwP1 := update2 _ _ _ _ _.
  set nwS1 := fun _ => match _ with _ => _ end.
  set nwP2 := fun _ _ => _.
  set nwS2 := fun _ => _.
  have H_eq_s: nwS1 = nwS2.
    rewrite /nwS1 /nwS2 {nwS1 nwS2}.
    apply functional_extensionality => n.
    rewrite /update /=.
    break_if => //.
    find_rewrite.
    rewrite H5.
    by congruence.
  have H_eq_p: nwP1 = nwP2.
    rewrite /nwP1 /nwP2 /=.
    apply functional_extensionality => src.
    apply functional_extensionality => dst.
    rewrite /update2 /=.
    break_if => //.
    break_and.
    by rewrite -H -H0 2!tot_map_name_inv_inverse H6 /= Heqo.
  by rewrite H_eq_s H_eq_p.
- destruct (pt_ext_map_input inp h d) eqn:?.
    left.
    destruct (input_handlers (tot_map_name h) i (pt_ext_map_data d h)) eqn:?.
    destruct p as [out' d''].
    exists ((tot_map_name h, inl i) :: map2fst (tot_map_name h) (map inr out')).
    apply (@StepOrderedDynamicFailure_input _ _ _ _ _ (tot_map_name h) _ _ _ _ out' i (pt_ext_map_data d h) (pt_ext_map_data d' h) (filterMap pt_map_name_msg l)) => //=.
    * exact: not_in_failed_not_in.
    * exact: in_failed_in.
    * by rewrite /pt_ext_map_odnet /= tot_map_name_inv_inverse H5.
    * have H_q := @pt_ext_input_handlers_some _ _ _ _ _ _ _ multi_map_congr h inp d _ _ _ _ Heqo Heqp.
      rewrite /pt_ext_mapped_input_handlers /= in H_q.
      find_rewrite.
      by repeat tuple_inversion.
    * rewrite /= /pt_ext_map_odnet /= collate_pt_map_eq.
      set u1 := fun _ => match _ with | _ => _ end.
      set u2 := update _ _ _ _.
      suff H_suff: u1 = u2 by rewrite H_suff.
      rewrite /u1 /u2 /update /=.
      apply functional_extensionality => n.
      repeat break_if; try by congruence.
        rewrite -(tot_map_name_inverse_inv n) in n0.
        by rewrite e in n0.
      find_rewrite.
      by find_rewrite_lem tot_map_name_inv_inverse.
  right.
  rewrite /= /pt_ext_map_odnet /=.
  have [H_d H_l] := pt_ext_input_handlers_none h inp d Heqo H6.
  split => //=.
  rewrite collate_pt_map_eq H_l /=.
  set nwS1 := fun n : name => match _ with | _ => _ end.
  set nwS2 := fun n : name => match _ with | _ => _ end.
  have H_eq_n: nwS1 = nwS2.
    rewrite /nwS1 /nwS2 /=.
    apply functional_extensionality => n.
    rewrite /update /=.
    break_if => //.
    by repeat find_rewrite.
  by rewrite H_eq_n.
- left.
  rewrite /pt_ext_map_odnet /=.
  set l := map2snd _ _.
  have H_nd': NoDup (map (fun nm => fst nm) (filterMap pt_map_name_msg l)).
    rewrite /pt_map_name_msg /=.
    rewrite /l {l}.
    apply NoDup_map_snd_fst.
      apply (@nodup_pt_map _ _ _ _ _  _ _ msg_fail); first exact: in_map2snd_snd.
      apply NoDup_map2snd.
      exact: NoDup_remove_all.
    move => nm nm' H_in H_in'.
    by rewrite (pt_map_in_snd  _ _ _ _ pt_fail_msg_fst_snd H_in) (pt_map_in_snd _ _ _ _ pt_fail_msg_fst_snd H_in').
  exists [].
  apply: StepOrderedDynamicFailure_fail => //.
  * exact: not_in_failed_not_in.
  * exact: in_failed_in.
  * rewrite /=.
    rewrite /l collate_pt_map_eq.
    have H_pm := pt_nodup_perm_map_map_pair_perm _ h failed H_nd (Permutation_refl (map tot_map_name (odnwNodes net))) pt_fail_msg_fst_snd.
    have H_pm' := H_pm _ _ _ _ name_map_bijective _ _ overlay_map_congr _ _ fail_msg_map_congr.
    have H_eq := NoDup_Permutation_collate_eq _ _ _ _  _ _ _ H_nd' H_pm'.
    by rewrite H_eq.
Qed.

Corollary step_ordered_dynamic_failure_pt_ext_mapped_simulation_star_1 :
  forall net failed tr,
    @step_ordered_dynamic_failure_star _ _ overlay_fst new_msg_fst fail_msg_fst step_ordered_dynamic_failure_init (failed, net) tr ->
    exists tr', @step_ordered_dynamic_failure_star _ _ overlay_snd new_msg_snd fail_msg_snd step_ordered_dynamic_failure_init (map tot_map_name failed, pt_ext_map_odnet net) tr'.
Proof using overlay_map_congr new_msg_map_congr name_map_bijective multi_map_congr fail_msg_map_congr.
move => net failed tr H_step.
remember step_ordered_dynamic_failure_init as y in *.
change failed with (fst (failed, net)).
change net with (snd (failed, net)) at 2.
move: Heqy.
induction H_step using refl_trans_1n_trace_n1_ind => H_init /=.
  rewrite H_init /step_ordered_dynamic_failure_init /= /step_ordered_failure_init.
  exists [].
  exact: RT1nTBase.
concludes.
rewrite H_init {H_init x} in H_step2 H_step1.
case: x' H IHH_step1 H_step1 => failed' net'.
case: x'' H_step2 => failed'' net''.
rewrite /=.
move => H_step2 H IHH_step1 H_step1.
find_apply_lem_hyp step_ordered_dynamic_failure_pt_ext_mapped_simulation_1; last by move: H_step1; apply: ordered_dynamic_nodes_no_dup.
case: H => H.
  move: IHH_step1 => [tr' H_star].
  move: H => [tr'' H].
  exists (tr' ++ tr'').
  have H_trans := refl_trans_1n_trace_trans H_star.
  apply: H_trans.
  have ->: tr'' = tr'' ++ [] by rewrite -app_nil_end.
  apply: (@RT1nTStep _ _ _ _ (map tot_map_name failed'', pt_ext_map_odnet net'')) => //.
  exact: RT1nTBase.
move: H => [H_eq_n H_eq_f].
rewrite H_eq_n -H_eq_f.
move: IHH_step1 => [tr' H_star].
by exists tr'.
Qed.

End PartialExtendedMapSimulations.


Set Implicit Arguments.

Require Import Platform.Facade.Facade.

Require Import Platform.Cito.StringMapFacts.
Require Import Coq.Lists.List.
Require Import Platform.Cito.ListFacts4.

Section ADTValue.

  Variable ADTValue : Type.

  Notation RunsTo := (@RunsTo ADTValue).
  Notation State := (@State ADTValue).
  Notation Env := (@Env ADTValue).
  Notation Sca := (@SCA ADTValue).

  Section Safe_coind.

    Variable env : Env.

    Variable R : Stmt -> State -> Prop.

    Hypothesis SeqCase : forall a b st, R (Seq a b) st -> R a st /\ forall st', RunsTo env a st st' -> R b st'.

    Hypothesis IfCase : forall cond t f st, R (If cond t f) st -> (is_true st cond /\ R t st) \/ (is_false st cond /\ R f st).

    Hypothesis WhileCase :
      forall cond body st,
        let loop := While cond body in
        R loop st ->
        (is_true st cond /\ R body st /\ (forall st', RunsTo env body st st' -> R loop st')) \/
        (is_false st cond).

    Hypothesis AssignCase :
      forall x e st,
        R (Facade.Assign x e) st ->
        not_mapsto_adt x st = true /\
        exists w, eval st e = Some (Sca w).

    Hypothesis LabelCase :
      forall x lbl st,
        R (Label x lbl) st ->
        not_mapsto_adt x st = true /\
        exists w, Label2Word env lbl = Some w.

    Hypothesis CallCase :
      forall x f args st,
        R (Call x f args) st ->
        NoDup args /\
        not_mapsto_adt x st = true /\
        exists f_w input,
          eval st f = Some (Sca f_w) /\
          mapM (sel st) args = Some input /\
          ((exists spec,
              Word2Spec env f_w = Some (Axiomatic spec) /\
              PreCond spec input) \/
           (exists spec,
              Word2Spec env f_w = Some (Operational _ spec) /\
              length args = length (ArgVars spec) /\
              let callee_st := make_map (ArgVars spec) input in
              R (Body spec) callee_st /\
              (forall callee_st',
                 RunsTo env (Body spec) callee_st callee_st' ->
                 sel callee_st' (RetVar spec) <> None /\
                 no_adt_leak input (ArgVars spec) (RetVar spec) callee_st'))).

    Hint Constructors Safe.

    Require Import Platform.Cito.GeneralTactics.

    Theorem Safe_coind : forall c st, R c st -> Safe env c st.
      cofix; intros; destruct c.
      - eauto.
      - eapply SeqCase in H; openhyp; eapply SafeSeq; eauto.
      - eapply IfCase in H; openhyp; eauto.
      - eapply WhileCase in H; openhyp; eauto.
      - eapply CallCase in H; openhyp; simpl in *; intuition eauto.
      - eapply LabelCase in H; openhyp; eauto.
      - eapply AssignCase in H; openhyp; eauto.
    Qed.

  End Safe_coind.

End ADTValue.


Require Import Raft.
Require Import RaftRefinementInterface.

Require Import UpdateLemmas.
Local Arguments update {_} {_} {_} _ _ _ _ : simpl never.

Require Import CommonTheorems.
Require Import SpecLemmas.

Require Import AppendEntriesRequestsCameFromLeadersInterface.
Require Import OneLeaderLogPerTermInterface.
Require Import LeaderLogsTermSanityInterface.
Require Import OneLeaderPerTermInterface.

Require Import AppendEntriesLeaderInterface.

Section AppendEntriesLeader.

  Context {orig_base_params : BaseParams}.
  Context {one_node_params : OneNodeParams orig_base_params}.
  Context {raft_params : RaftParams orig_base_params}.

  Context {rri : raft_refinement_interface}.

  Context {aecfli : append_entries_came_from_leaders_interface}.
  Context {ollpti : one_leaderLog_per_term_interface}.
  Context {lltsi : leaderLogs_term_sanity_interface}.
  Context {olpti : one_leader_per_term_interface}.

  Ltac update_destruct :=
    match goal with
    | [ H : context [ update _ ?x _ ?y ] |- _ ] =>
      destruct (name_eq_dec x y); subst; rewrite_update; simpl in *
    | [ |- context [ update _ ?x _ ?y ] ] =>
      destruct (name_eq_dec x y); subst; rewrite_update; simpl in *
    end.

  Lemma appendEntries_leader_init :
    refined_raft_net_invariant_init appendEntries_leader.
  Proof using.
    unfold refined_raft_net_invariant_init, appendEntries_leader.
    simpl. intuition.
  Qed.

  Definition type_term_log_monotonic st st' :=
    type st' = Leader ->
    type st = Leader /\
    currentTerm st' = currentTerm st /\
    (forall e, In e (log st) -> In e (log st')).

  Notation appendEntries_leader_predicate ps st :=
    (forall p t lid pli plt es lci e,
      In p ps ->
      pBody p = AppendEntries t lid pli plt es lci ->
      In e es ->
      currentTerm st = t ->
      type st = Leader ->
      In e (log st)).

  Lemma appendEntries_leader_predicate_TTLM_preserved :
    forall ps st st',
      appendEntries_leader_predicate ps st ->
      type_term_log_monotonic st st' ->
      appendEntries_leader_predicate ps st'.
  Proof using.
    unfold type_term_log_monotonic.
    intuition.
    repeat find_rewrite.
    eauto.
  Qed.

  Lemma handleClientRequest_TTLM :
    forall h st client id c out st' l,
      handleClientRequest h st client id c = (out, st', l) ->
      type_term_log_monotonic st st'.
  Proof using.
    unfold type_term_log_monotonic.
    intros.
    find_copy_apply_lem_hyp handleClientRequest_type.
    find_copy_apply_lem_hyp handleClientRequest_log.
    intuition; try congruence.
    break_exists.
    intuition. subst. repeat find_rewrite. auto with *.
  Qed.

  Lemma appendEntries_leader_client_request :
    refined_raft_net_invariant_client_request appendEntries_leader.
  Proof using.
    unfold refined_raft_net_invariant_client_request, appendEntries_leader.
    simpl.
    intros.
    find_apply_hyp_hyp. intuition.
    - repeat find_higher_order_rewrite.
      update_destruct.
      + eapply appendEntries_leader_predicate_TTLM_preserved; eauto using handleClientRequest_TTLM.
        eauto.
      + eauto.
    - find_apply_lem_hyp handleClientRequest_packets.
      subst. simpl in *. intuition.
  Qed.

  Lemma handleTimeout_TTLM :
    forall h st out st' l,
      handleTimeout h st = (out, st', l) ->
      type_term_log_monotonic st st'.
  Proof using.
    unfold type_term_log_monotonic.
    intros.
    find_copy_apply_lem_hyp handleTimeout_type.
    find_apply_lem_hyp handleTimeout_log_same.
    intuition; try congruence.
  Qed.

  Lemma appendEntries_leader_timeout :
    refined_raft_net_invariant_timeout appendEntries_leader.
  Proof using.
    unfold refined_raft_net_invariant_timeout, appendEntries_leader.
    simpl.
    intros.
    find_apply_hyp_hyp.
    intuition.
    - repeat find_higher_order_rewrite.
      update_destruct.
      + eapply appendEntries_leader_predicate_TTLM_preserved; eauto using handleTimeout_TTLM.
        eauto.
      + eauto.
    - do_in_map.
      find_eapply_lem_hyp handleTimeout_packets; eauto.
      subst. exfalso. eauto 10.
  Qed.

  Lemma handleAppendEntries_TTLM :
    forall h st t n pli plt es ci st' ps,
      handleAppendEntries h st t n pli plt es ci = (st', ps) ->
      type_term_log_monotonic st st'.
  Proof using.
    unfold type_term_log_monotonic, handleAppendEntries.
    intros.
    repeat break_match; repeat find_inversion; simpl in *; auto; try congruence.
  Qed.

  Lemma appendEntries_leader_append_entries :
    refined_raft_net_invariant_append_entries appendEntries_leader.
  Proof using.
    unfold refined_raft_net_invariant_append_entries, appendEntries_leader.
    simpl.
    intros.
    find_apply_hyp_hyp.
    intuition.
    - repeat find_higher_order_rewrite.
      update_destruct.
      + eapply appendEntries_leader_predicate_TTLM_preserved; eauto using handleAppendEntries_TTLM.
        eauto.
      + eauto.
    - find_apply_lem_hyp handleAppendEntries_not_append_entries.
      subst. exfalso. eauto 10.
  Qed.

  Lemma handleAppendEntriesReply_TTLM :
    forall h st h' t es r st' ms,
      handleAppendEntriesReply h st h' t es r = (st', ms) ->
      type_term_log_monotonic st st'.
  Proof using.
    unfold type_term_log_monotonic, handleAppendEntriesReply, advanceCurrentTerm.
    intros.
    repeat break_match; repeat find_inversion; simpl in *; auto; try congruence.
  Qed.

  Lemma appendEntries_leader_append_entries_reply :
    refined_raft_net_invariant_append_entries_reply appendEntries_leader.
  Proof using.
    unfold refined_raft_net_invariant_append_entries_reply, appendEntries_leader.
    simpl.
    intros.
    find_apply_hyp_hyp.
    intuition.
    - repeat find_higher_order_rewrite.
      update_destruct.
      + eapply appendEntries_leader_predicate_TTLM_preserved; eauto using handleAppendEntriesReply_TTLM.
        eauto.
      + eauto.
    - find_apply_lem_hyp handleAppendEntriesReply_packets.
      subst. simpl in *. intuition.
  Qed.

  Lemma handleRequestVote_TTLM :
    forall st h h' t lli llt st' m,
      handleRequestVote h st t h' lli llt = (st', m) ->
      type_term_log_monotonic st st'.
  Proof using.
    unfold type_term_log_monotonic, handleRequestVote, advanceCurrentTerm.
    intros.
    repeat break_match; repeat find_inversion; simpl in *; auto; try congruence.
  Qed.

  Lemma appendEntries_leader_request_vote :
    refined_raft_net_invariant_request_vote appendEntries_leader.
  Proof using.
    unfold refined_raft_net_invariant_request_vote, appendEntries_leader.
    simpl.
    intros.
    find_apply_hyp_hyp.
    intuition.
    - repeat find_higher_order_rewrite.
      update_destruct.
      + eapply appendEntries_leader_predicate_TTLM_preserved; eauto using handleRequestVote_TTLM.
        eauto.
      + eauto.
    - find_apply_lem_hyp handleRequestVote_no_append_entries.
      subst. exfalso. eauto 10.
  Qed.

(* p0 is AE.
   by AE_came_from_leaders, there is a ll in pre state at (pSrc p0) for p0's term.
   claim I am (pSrc p0).
     I am ascending, so I have ll in post state.
     pSrc p0 ll still is preserved into post state.
     finish with one ll per term.
   thus I had a leaderLog in the pre state.
   this contradicts leaderLogs_currentTerm_sanity_candidate.
*)

  Lemma handleRequestVoteReply_spec' :
    forall h st h' t r st',
      handleRequestVoteReply h st h' t r = st' ->
      type st' = Follower \/
      st' = st \/
      type st' = Candidate \/
      (type st' = Leader /\
       type st = Candidate /\
       log st' = log st /\
       r = true /\
       t = currentTerm st /\
       wonElection (dedup name_eq_dec (h' :: votesReceived st)) = true /\
       currentTerm st' = currentTerm st).
  Proof using.
    unfold handleRequestVoteReply.
    intros.
    repeat break_match; repeat find_inversion; do_bool; subst; simpl; intuition.
  Qed.

  Lemma update_elections_data_RVR_ascending_leaderLog :
    forall h src t1 v st,
      type (snd st) = Candidate ->
      type (handleRequestVoteReply h (snd st) src t1 v) = Leader ->
      exists ll,
        In (currentTerm (snd st), ll) (leaderLogs (update_elections_data_requestVoteReply h src t1 v st)).
  Proof using.
    unfold update_elections_data_requestVoteReply, handleRequestVoteReply.
    intros.
    repeat find_rewrite. simpl in *.
    repeat break_match; repeat find_inversion; subst; simpl in *; try congruence; eauto.
  Qed.

  Lemma appendEntries_leader_request_vote_reply :
    refined_raft_net_invariant_request_vote_reply' appendEntries_leader.
  Proof using lltsi ollpti aecfli.
    unfold refined_raft_net_invariant_request_vote_reply', appendEntries_leader.
    simpl.
    intros.
    find_apply_hyp_hyp.
    find_copy_apply_lem_hyp handleRequestVoteReply_spec'.
    repeat find_higher_order_rewrite.
    update_destruct.
    - rewrite handleRequestVoteReply_same_log.
      intuition; try congruence.
      + repeat find_rewrite.
        eauto using in_middle_insert with *.
      + subst.
        match goal with
        | [ H : pBody _ = AppendEntries _ _ _ _ _ _ |- _ ] =>
          copy_eapply (append_entries_came_from_leaders_invariant net) H
        end; eauto.
        break_exists.
        assert (pDst p = pSrc p0).
        {
          destruct (name_eq_dec (pDst p) (pSrc p0)); auto.
          find_copy_apply_lem_hyp update_elections_data_RVR_ascending_leaderLog; auto.
          break_exists.
          repeat find_rewrite.
          match goal with
          | [ H : refined_raft_intermediate_reachable ?the_net,
              H': In (?the_t, ?the_ll) (leaderLogs (update_elections_data_requestVoteReply _ _ _ _ _)),
              H'' : In (_, ?the_ll') (leaderLogs (fst _))
              |- _ ] =>
            match the_net with
            | context [ st' ] =>
              apply one_leaderLog_per_term_host_invariant
              with (net0 := the_net) (t := the_t) (ll := the_ll) (ll' := the_ll')
            end
          end; auto; simpl; repeat find_higher_order_rewrite; rewrite_update; simpl; auto.
        }
        exfalso.
        repeat find_rewrite.
        eapply lt_irrefl.
        eapply leaderLogs_currentTerm_sanity_candidate_invariant; [|eauto|]; auto.
    - eauto.
  Qed.

  Lemma doLeader_TTLM :
    forall st h os st' ms,
      doLeader st h = (os, st', ms) ->
      type_term_log_monotonic st st'.
  Proof using.
    unfold doLeader, type_term_log_monotonic.
    intros.
    repeat break_match; repeat find_inversion; simpl in *; auto; try congruence.
  Qed.

  Lemma doLeader_message_entries :
    forall st h os st' ms m t n pli plt es ci e,
      doLeader st h = (os, st', ms) ->
      In m ms ->
      snd m = AppendEntries t n pli plt es ci ->
      In e es ->
      currentTerm st = t /\
      type st = Leader /\
      In e (log st).
  Proof using.
    intros. unfold doLeader, advanceCommitIndex in *.
    break_match; try solve [find_inversion; simpl in *; intuition].
    break_if; try solve [find_inversion; simpl in *; intuition].
    find_inversion. simpl. do_in_map. subst.
    simpl in *. find_inversion.
    eauto using findGtIndex_in.
  Qed.

  Lemma lifted_one_leader_per_term :
    forall net h h',
      refined_raft_intermediate_reachable net ->
      currentTerm (snd (nwState net h)) = currentTerm (snd (nwState net h')) ->
      type (snd (nwState net h)) = Leader ->
      type (snd (nwState net h')) = Leader ->
      h = h'.
  Proof using olpti rri.
    intros.
    eapply (lift_prop _ one_leader_per_term_invariant _ ltac:(eauto));
      simpl in *; repeat break_match; repeat (find_rewrite; simpl in *);
      auto; simpl in *; repeat find_rewrite; simpl in *; auto.
  Qed.

  Lemma appendEntries_leader_do_leader :
    refined_raft_net_invariant_do_leader appendEntries_leader.
  Proof using olpti rri.
    unfold refined_raft_net_invariant_do_leader, appendEntries_leader.
    simpl.
    intros.
    find_apply_hyp_hyp.
    intuition.
    - repeat find_higher_order_rewrite.
      update_destruct.
      + eapply appendEntries_leader_predicate_TTLM_preserved; eauto using doLeader_TTLM.
        match goal with
        | [ H : nwState ?net ?h = (?gd, ?d) |- _ ] =>
          replace d with (snd (nwState net h)) in * by (rewrite H; auto)
        end.
        eauto.
      + eauto.
    - do_in_map. subst. simpl in *.
      repeat find_higher_order_rewrite.
      find_copy_eapply_lem_hyp (doLeader_message_entries d);
        match goal with
        | [ H : nwState ?net ?h = (?gd, ?d) |- _ ] =>
          replace d with (snd (nwState net h)) in * by (rewrite H; auto)
        end; eauto; break_and.
      update_destruct.
      + erewrite doLeader_same_log; eauto.
      + exfalso. eauto using lifted_one_leader_per_term.
  Qed.

  Lemma doGenericServer_TTLM :
    forall h st os st' ps,
      doGenericServer h st = (os, st', ps) ->
      type_term_log_monotonic st st'.
  Proof using.
    unfold type_term_log_monotonic, doGenericServer.
    intros.
    repeat break_match; repeat find_inversion; simpl in *; auto; try congruence;
    use_applyEntries_spec; subst; simpl in *; auto.
  Qed.

  Lemma appendEntries_leader_do_generic_server :
    refined_raft_net_invariant_do_generic_server appendEntries_leader.
  Proof using.
    unfold refined_raft_net_invariant_do_generic_server, appendEntries_leader.
    simpl.
    intros.
    find_apply_hyp_hyp.
    intuition.
    - repeat find_higher_order_rewrite.
      update_destruct.
      + eapply appendEntries_leader_predicate_TTLM_preserved; eauto using doGenericServer_TTLM.
        match goal with
        | [ H : nwState ?net ?h = (?gd, ?d) |- _ ] =>
          replace d with (snd (nwState net h)) in * by (rewrite H; auto)
        end.
        eauto.
      + eauto.
    - find_apply_lem_hyp doGenericServer_packets. subst. simpl in *. intuition.
  Qed.

  Lemma appendEntries_leader_state_same_packet_subset :
    refined_raft_net_invariant_state_same_packet_subset appendEntries_leader.
  Proof using.
    unfold refined_raft_net_invariant_state_same_packet_subset, appendEntries_leader.
    simpl. intros.
    repeat find_reverse_higher_order_rewrite.
    eauto.
  Qed.

  Lemma appendEntries_leader_reboot :
    refined_raft_net_invariant_reboot appendEntries_leader.
  Proof using.
    unfold refined_raft_net_invariant_reboot, appendEntries_leader, reboot.
    simpl.
    intros.
    repeat find_higher_order_rewrite.
    update_destruct.
    - discriminate.
    - eauto.
  Qed.

  Lemma appendEntries_leader_invariant :
    forall net,
      refined_raft_intermediate_reachable net ->
      appendEntries_leader net.
  Proof using olpti lltsi ollpti aecfli rri.
    intros.
    apply refined_raft_net_invariant'; auto.
    - apply appendEntries_leader_init.
    - apply refined_raft_net_invariant_client_request'_weak.
      apply appendEntries_leader_client_request.
    - apply refined_raft_net_invariant_timeout'_weak.
      apply appendEntries_leader_timeout.
    - apply refined_raft_net_invariant_append_entries'_weak.
      apply appendEntries_leader_append_entries.
    - apply refined_raft_net_invariant_append_entries_reply'_weak.
      apply appendEntries_leader_append_entries_reply.
    - apply refined_raft_net_invariant_request_vote'_weak.
      apply appendEntries_leader_request_vote.
    - apply appendEntries_leader_request_vote_reply.
    - apply refined_raft_net_invariant_do_leader'_weak.
      apply appendEntries_leader_do_leader.
    - apply refined_raft_net_invariant_do_generic_server'_weak.
      apply appendEntries_leader_do_generic_server.
    - apply appendEntries_leader_state_same_packet_subset.
    - apply refined_raft_net_invariant_reboot'_weak.
      apply appendEntries_leader_reboot.
  Qed.

  Instance appendeli : append_entries_leader_interface.
  Proof.
    split.
    exact appendEntries_leader_invariant.
  Qed.
End AppendEntriesLeader.


Require Import List.
Require Import String.
Require Import ZArith.

Open Scope list_scope.
Open Scope string_scope.
Open Scope Z_scope.

Require Import StructTactics.
Require Import ImpSyntax.
Require Import ImpCommon.
Require Import ImpExprTransf.
Require Import ImpInterpNock.
Require Import ImpConstFold.

Require Import ImpEval.
Require Import ImpStep.
Require Import ImpSemanticsFacts.
Require Import ImpInterpProof.
Require Import ImpInterpNockProof.
Require Import ImpExprTransfProof.

Lemma cfold_aux_fwd :
  forall s h e v,
    ImpEval.eval_e s h e v ->
    ImpEval.eval_e s h (cfold_aux e) v.
Proof.
  induction e; simpl; intros; auto.
  - break_match; auto.
    find_apply_lem_hyp eval_e_interp_e.
    find_apply_lem_hyp nock_e_ok.
    simpl in *. find_rewrite.
    ee.
  - repeat break_match; auto.
    repeat find_apply_lem_hyp eval_e_interp_e.
    repeat find_apply_lem_hyp nock_e_ok.
    simpl in *. find_rewrite.
    ee.
Qed.

Lemma cfold_aux_bwd' :
  forall s h e v,
    I.interp_e s h (cfold_aux e) = Some v ->
    I.interp_e s h e = Some v \/
    (forall v', ~ ImpEval.eval_e s h e v').
Proof.
  induction e; simpl; intros; auto.
  - break_match_hyp; simpl; auto.
    find_apply_lem_hyp nock_e_ok.
    simpl in *.
    destruct o; destruct v0;
      simpl in *; subst; auto;
      right; unfold not in *; intros;
      repeat on (eval_e _ _ _ _), invc;
      on (eval_unop _ _ _), inv.
  - repeat break_match_hyp; simpl; auto.
    repeat find_apply_lem_hyp nock_e_ok.
    simpl in *.
    destruct o; destruct v0; destruct v1;
    simpl in *; subst; auto; try (
      right; unfold not in *; intros;
      repeat on (eval_e _ _ _ _), invc;
      on (eval_binop _ _ _ _), inv;
      fail).
    + break_match; subst; auto.
      right; unfold not in *; intros.
      repeat on (eval_e _ _ _ _), invc.
      on (eval_binop _ _ _ _), inv.
      congruence.
    + break_match; subst; auto.
      right; unfold not in *; intros.
      repeat on (eval_e _ _ _ _), invc.
      on (eval_binop _ _ _ _), inv.
      congruence.
Qed.

Lemma cfold_aux_bwd :
  forall s h e v,
    eval_e s h (cfold_aux e) v ->
    eval_e s h e v \/
    (forall v', ~ eval_e s h e v').
Proof.
  intros.
  find_apply_lem_hyp eval_e_interp_e.
  find_apply_lem_hyp cfold_aux_bwd'.
  on (or _ _), invc.
  + left. apply interp_e_eval_e; auto.
  + right; auto.
Qed.

Lemma cfold_p_fwd :
  forall p v,
    steps_p p v ->
    steps_p (cfold p) v.
Proof.
  apply transf_p_fwd.
  apply transf_e_fwd.
  apply cfold_aux_fwd.
Qed.

Lemma cfold_p_bwd :
  forall p v,
    steps_p (cfold p) v ->
    steps_p p v \/ can_get_stuck_prog p.
Proof.
  apply transf_p_bwd.
  apply transf_e_bwd.
  apply cfold_aux_fwd.
  apply cfold_aux_bwd.
Qed.


Require Import Lia.
Require Import RelationClasses.

From sflib Require Import sflib.
From Paco Require Import paco.

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import DataStructure.
From PromisingLib Require Import DenseOrder.
From PromisingLib Require Import Loc.
From PromisingLib Require Import Language.

From PromisingLib Require Import Event.
Require Import Time.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Local.
Require Import Thread.

Require Import FulfillStep.

Set Implicit Arguments.

Lemma promise_step_promise_consistent
      lc1 mem1 loc from to msg lc2 mem2 kind
      (STEP: Local.promise_step lc1 mem1 loc from to msg lc2 mem2 kind)
      (CONS: Local.promise_consistent lc2):
  Local.promise_consistent lc1.
Proof.
  inv STEP. ii.
  destruct (Memory.op_kind_is_cancel kind) eqn:KIND.
  - destruct kind; ss. inv PROMISE.
    destruct (Memory.get loc0 ts promises2) as [[]|] eqn:GET2.
    + dup GET2. revert GET0.
      erewrite Memory.remove_o; eauto. condtac; ss. i.
      rewrite PROMISE0 in *. inv GET0. eauto.
    + revert GET2. erewrite Memory.remove_o; eauto.
      condtac; ss; i; try congr.
      des. subst. exploit Memory.remove_get0; eauto. i. des.
      rewrite GET in *. inv PROMISE0. ss.
  - exploit Memory.promise_get1_promise; eauto. i. des.
    inv MSG_LE; ss; eauto. eapply CONS; eauto. ss.
Qed.

Lemma read_step_promise_consistent
      lc1 mem1 loc to val released ord lc2
      (STEP: Local.read_step lc1 mem1 loc to val released ord lc2)
      (CONS: Local.promise_consistent lc2):
  Local.promise_consistent lc1.
Proof.
  inv STEP. ii. exploit CONS; eauto. i.
  eapply TimeFacts.le_lt_lt; eauto. ss.
  etrans; [|apply Time.join_l]. etrans; [|apply Time.join_l]. refl.
Qed.

Lemma fulfill_unset_promises
      loc from ts msg
      promises1 promises2
      l t f m
      (FULFILL: Memory.remove promises1 loc from ts msg promises2)
      (TH1: Memory.get l t promises1 = Some (f, m))
      (TH2: Memory.get l t promises2 = None):
  l = loc /\ t = ts /\ f = from /\ Message.le msg m.
Proof.
  revert TH2. erewrite Memory.remove_o; eauto. condtac; ss; [|congr].
  des. subst. exploit Memory.remove_get0; eauto. i. des.
  rewrite GET in TH1. inv TH1.
  esplits; eauto. refl.
Qed.

Lemma fulfill_step_promise_consistent
      lc1 sc1 loc from to val releasedm released ord lc2 sc2
      (STEP: fulfill_step lc1 sc1 loc from to val releasedm released ord lc2 sc2)
      (CONS: Local.promise_consistent lc2):
  Local.promise_consistent lc1.
Proof.
  inv STEP. ii.
  destruct (Memory.get loc0 ts promises2) as [[]|] eqn:X.
  - dup X. revert X.
    erewrite Memory.remove_o; eauto. condtac; ss. i.
    rewrite X in *. inv PROMISE.
    exploit CONS; eauto. s. i.
    eapply TimeFacts.le_lt_lt; eauto.
    unfold TimeMap.join. apply Time.join_l.
  - exploit fulfill_unset_promises; eauto. i. des. subst.
    apply WRITABLE.
Qed.

Lemma write_step_promise_consistent
      lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind
      (STEP: Local.write_step lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind)
      (CONS: Local.promise_consistent lc2):
  Local.promise_consistent lc1.
Proof.
  inv STEP. inv WRITE. ii.
  exploit Memory.promise_get1_promise; eauto.
  { inv PROMISE; ss. }
  i. des.
  destruct (Memory.get loc0 ts promises2) as [[]|] eqn:X.
  - dup X. revert X0.
    erewrite Memory.remove_o; eauto. condtac; ss; i.
    rewrite GET in *. inv X0.
    apply CONS in X. ss. exploit X; try by (inv MSG_LE; ss). i.
    eapply TimeFacts.le_lt_lt; eauto.
    etrans; [|apply Time.join_l]. refl.
  - exploit fulfill_unset_promises; eauto. i. des. subst.
    apply WRITABLE.
Qed.

Lemma memory_write_promise_consistent
      ts promises1 mem1 loc from to msg promises2 mem2 kind
      (TO: Time.lt ts to)
      (STEP: Memory.write promises1 mem1 loc from to msg promises2 mem2 kind)
      (CONS: forall to' from' msg'
               (PROMISE: Memory.get loc to' promises2 = Some (from', msg'))
               (MSG: msg' <> Message.reserve),
          Time.lt ts to'):
  forall to' from' msg'
    (PROMISE: Memory.get loc to' promises1 = Some (from', msg'))
    (MSG: msg' <> Message.reserve),
    Time.lt ts to'.
Proof.
  i. inv STEP.
  exploit Memory.promise_get1_promise; eauto.
  { inv PROMISE0; ss.
    exploit Memory.remove_get0; try exact PROMISES. i. des.
    exploit Memory.remove_get0; try exact REMOVE. i. des. congr.
  }
  i. des.
  destruct (Memory.get loc to' promises2) as [[]|] eqn:X.
  - dup X. revert X0.
    erewrite Memory.remove_o; eauto. condtac; ss; i.
    rewrite GET in *. inv X0.
    apply CONS in X; ss.
    ii. subst. inv MSG_LE. ss.
  - exploit fulfill_unset_promises; eauto. i. des. subst. ss.
Qed.

Lemma write_na_promise_consistent
      ts' ts promises1 mem1 loc from to val promises2 mem2 msgs kinds kind
      (TS: Time.le ts' ts)
      (STEP: Memory.write_na ts promises1 mem1 loc from to val promises2 mem2 msgs kinds kind)
      (CONS: forall to' from' msg
               (PROMISE: Memory.get loc to' promises2 = Some (from', msg))
               (MSG: msg <> Message.reserve),
          Time.lt ts' to'):
  forall to' from' msg
    (PROMISE: Memory.get loc to' promises1 = Some (from', msg))
    (MSG: msg <> Message.reserve),
    Time.lt ts' to'.
Proof.
  induction STEP; i.
  { hexploit memory_write_promise_consistent; try exact CONS; eauto.
    eapply TimeFacts.le_lt_lt; eauto.
  }
  eapply memory_write_promise_consistent; try exact WRITE_EX; eauto.
  { eapply TimeFacts.le_lt_lt; eauto. }
  eapply IHSTEP; eauto.
  econs. eapply TimeFacts.le_lt_lt; eauto.
Qed.

Lemma write_na_step_promise_consistent
      lc1 sc1 mem1 loc from to val ord lc2 sc2 mem2 msgs kinds kind
      (STEP: Local.write_na_step lc1 sc1 mem1 loc from to val ord lc2 sc2 mem2 msgs kinds kind)
      (CONS: Local.promise_consistent lc2):
  Local.promise_consistent lc1.
Proof.
  inv STEP. ii.
  destruct (classic (loc0 = loc)); cycle 1.
  - hexploit Memory.write_na_get_diff_promise; try exact WRITE; eauto.
    i. rewrite <- H0 in PROMISE.
    exploit CONS; eauto. s.
    unfold TimeMap.join, TimeMap.singleton, LocFun.add, LocFun.init, LocFun.find.
    condtac; ss.
    rewrite TimeFacts.le_join_l; try apply Time.bot_spec. ss.
  - subst.
    eapply write_na_promise_consistent; try exact WRITE; eauto; try refl.
    i. eapply TimeFacts.le_lt_lt; cycle 1.
    { eapply CONS; eauto. }
    s. unfold TimeMap.join. apply Time.join_l.
Qed.

Lemma fence_step_promise_consistent
      lc1 sc1 mem1 ordr ordw lc2 sc2
      (STEP: Local.fence_step lc1 sc1 ordr ordw lc2 sc2)
      (WF: Local.wf lc1 mem1)
      (CONS: Local.promise_consistent lc2):
  Local.promise_consistent lc1.
Proof.
  inv STEP. ii.
  exploit CONS; eauto. i.
  eapply TimeFacts.le_lt_lt; eauto.
  cut (TView.le (Local.tview lc1)
                (TView.write_fence_tview (TView.read_fence_tview (Local.tview lc1) ordr) sc1 ordw)).
  { i. inv H. apply CUR. }
  etrans.
  - eapply TViewFacts.write_fence_tview_incr. apply WF.
  - eapply TViewFacts.write_fence_tview_mon; try refl; try apply WF.
    eapply TViewFacts.read_fence_tview_incr. apply WF.
Qed.

Lemma ordering_relaxed_dec
      ord:
  Ordering.le ord Ordering.relaxed \/ Ordering.le Ordering.strong_relaxed ord.
Proof. destruct ord; auto. Qed.

Lemma step_promise_consistent
      lang pf e th1 th2
      (STEP: @Thread.step lang pf e th1 th2)
      (CONS: Local.promise_consistent (Thread.local th2))
      (WF1: Local.wf (Thread.local th1) (Thread.memory th1))
      (SC1: Memory.closed_timemap (Thread.sc th1) (Thread.memory th1))
      (MEM1: Memory.closed (Thread.memory th1)):
  Local.promise_consistent (Thread.local th1).
Proof.
  inv STEP; [inv STEP0|inv STEP0; inv LOCAL]; ss.
  - eapply promise_step_promise_consistent; eauto.
  - eapply read_step_promise_consistent; eauto.
  - eapply write_step_promise_consistent; eauto.
  - eapply read_step_promise_consistent; eauto.
    eapply write_step_promise_consistent; eauto.
  - eapply fence_step_promise_consistent; eauto.
  - eapply fence_step_promise_consistent; eauto.
  - eapply write_na_step_promise_consistent; eauto.
Qed.

Lemma opt_step_promise_consistent
      lang e th1 th2
      (STEP: @Thread.opt_step lang e th1 th2)
      (CONS: Local.promise_consistent (Thread.local th2))
      (WF1: Local.wf (Thread.local th1) (Thread.memory th1))
      (SC1: Memory.closed_timemap (Thread.sc th1) (Thread.memory th1))
      (MEM1: Memory.closed (Thread.memory th1)):
  Local.promise_consistent (Thread.local th1).
Proof.
  inv STEP; eauto using step_promise_consistent.
Qed.

Lemma rtc_all_step_promise_consistent
      lang th1 th2
      (STEP: rtc (@Thread.all_step lang) th1 th2)
      (CONS: Local.promise_consistent (Thread.local th2))
      (WF1: Local.wf (Thread.local th1) (Thread.memory th1))
      (SC1: Memory.closed_timemap (Thread.sc th1) (Thread.memory th1))
      (MEM1: Memory.closed (Thread.memory th1)):
  Local.promise_consistent (Thread.local th1).
Proof.
  revert_until STEP. induction STEP; auto. i.
  inv H. inv USTEP. exploit Thread.step_future; eauto. i. des.
  eapply step_promise_consistent; eauto.
Qed.

Lemma rtc_tau_step_promise_consistent
      lang th1 th2
      (STEP: rtc (@Thread.tau_step lang) th1 th2)
      (CONS: Local.promise_consistent (Thread.local th2))
      (WF1: Local.wf (Thread.local th1) (Thread.memory th1))
      (SC1: Memory.closed_timemap (Thread.sc th1) (Thread.memory th1))
      (MEM1: Memory.closed (Thread.memory th1)):
  Local.promise_consistent (Thread.local th1).
Proof.
  eapply rtc_all_step_promise_consistent; cycle 1; eauto.
  eapply rtc_implies; [|eauto].
  apply tau_union.
Qed.

Lemma rtc_reserve_step_promise_consistent
      lang th1 th2
      (STEPS: rtc (@Thread.reserve_step lang) th1 th2)
      (CONS: Local.promise_consistent (Thread.local th2)):
  Local.promise_consistent (Thread.local th1).
Proof.
  ginduction STEPS; eauto. i. eapply IHSTEPS in CONS.
  inv H. inv STEP; inv STEP0; inv LOCAL. inv PROMISE. ss.
  ii. eapply Memory.add_get1 in PROMISE; eauto.
Qed.

Lemma rtc_cancel_step_promise_consistent
      lang th1 th2
      (STEPS: rtc (@Thread.cancel_step lang) th1 th2)
      (CONS: Local.promise_consistent (Thread.local th2)):
  Local.promise_consistent (Thread.local th1).
Proof.
  ginduction STEPS; eauto. i. eapply IHSTEPS in CONS.
  inv H. inv STEP; inv STEP0; inv LOCAL. inv PROMISE. ss.
  ii. dup PROMISE. eapply Memory.remove_get1 in PROMISE; eauto. des; eauto.
  clarify. eapply Memory.remove_get0 in PROMISES. des. clarify.
Qed.

Lemma rtc_reserve_step_promise_consistent2
      lang (th1 th2: Thread.t lang)
      (CONS: Local.promise_consistent (Thread.local th1))
      (STEPS: rtc (@Thread.reserve_step lang) th1 th2)
  :
    Local.promise_consistent (Thread.local th2).
Proof.
  ginduction STEPS; eauto.  i. eapply IHSTEPS.
  inv H. inv STEP; inv STEP0; inv LOCAL. inv PROMISE. ss.
  ii. erewrite Memory.add_o in PROMISE; eauto. des_ifs.
  eapply CONS; eauto.
Qed.

Lemma rtc_cancel_step_promise_consistent2
      lang (th1 th2: Thread.t lang)
      (CONS: Local.promise_consistent (Thread.local th1))
      (STEPS: rtc (@Thread.cancel_step lang) th1 th2)
  :
    Local.promise_consistent (Thread.local th2).
Proof.
  ginduction STEPS; eauto.  i. eapply IHSTEPS.
  inv H. inv STEP; inv STEP0; inv LOCAL. inv PROMISE. ss.
  ii. erewrite Memory.remove_o in PROMISE; eauto. des_ifs.
  eapply CONS; eauto.
Qed.

Lemma consistent_promise_consistent
      lang th
      (CONS: @Thread.consistent lang th)
      (WF: Local.wf (Thread.local th) (Thread.memory th))
      (SC: Memory.closed_timemap (Thread.sc th) (Thread.memory th))
      (MEM: Memory.closed (Thread.memory th)):
  Local.promise_consistent (Thread.local th).
Proof.
  destruct th. ss.
  exploit Memory.cap_exists; eauto. i. des.
  exploit Memory.cap_closed; eauto. i.
  exploit Local.cap_wf; eauto. i.
  hexploit Memory.cap_closed_timemap; eauto. i. des.
  exploit CONS; eauto. s. i. des.
  - inv FAILURE. des. inv STEP_FAILURE; inv STEP; ss.
    inv LOCAL; ss; inv LOCAL0;
      hexploit rtc_tau_step_promise_consistent; try exact STEPS; eauto.
  - hexploit rtc_tau_step_promise_consistent; try exact STEPS; eauto.
    ii. rewrite PROMISES, Memory.bot_get in *. congr.
Qed.

Lemma promise_consistent_promise_read
      lc1 mem1 loc to val ord released lc2
      f t v r
      (STEP: Local.read_step lc1 mem1 loc to val released ord lc2)
      (PROMISE: Memory.get loc t (Local.promises lc1) = Some (f, Message.concrete v r))
      (CONS: Local.promise_consistent lc2):
  Time.lt to t.
Proof.
  inv STEP. exploit CONS; eauto; ss. intros x.
  apply TimeFacts.join_lt_des in x. des.
  apply TimeFacts.join_lt_des in AC. des.
  revert BC0. unfold View.singleton_ur_if. condtac; ss.
  - unfold TimeMap.singleton, LocFun.add. condtac; ss.
  - unfold TimeMap.singleton, LocFun.add. condtac; ss.
Qed.

Lemma promise_consistent_promise_write
      lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind
      f t m
      (STEP: Local.write_step lc1 sc1 mem1 loc from to val releasedm released ord lc2 sc2 mem2 kind)
      (PROMISE: Memory.get loc t (Local.promises lc1) = Some (f, m))
      (MSG: m <> Message.reserve)
      (CONS: Local.promise_consistent lc2):
  Time.le to t.
Proof.
  destruct (Memory.get loc t (Local.promises lc2)) as [[]|] eqn:X.
  - inv STEP. inv WRITE. ss.
    dup X. revert X0.
    erewrite Memory.remove_o; eauto. condtac; ss. i. guardH o.
    exploit Memory.promise_get1_promise; try exact PROMISE; eauto.
    { inv PROMISE0; ss. }
    i. des.
    rewrite X0 in *. inv GET.
    exploit CONS; eauto; try by (inv MSG_LE; ss). s. intros x.
    apply TimeFacts.join_lt_des in x. des.
    revert BC. unfold TimeMap.singleton, LocFun.add. condtac; ss. i.
    econs. ss.
  - inv STEP. inv WRITE.
    exploit Memory.promise_get1_promise; eauto.
    { inv PROMISE0; ss. }
    i. des.
    exploit fulfill_unset_promises; eauto. i. des. subst. refl.
Qed.


Require Import Verdi.Verdi.
Require Import Verdi.HandlerMonad.
Require Import Verdi.NameOverlay.
Require Import Verdi.LabeledNet.

Require Import Sumbool.

Require Import mathcomp.ssreflect.ssreflect.

Local Arguments update {_} {_} _ _ _ _ _ : simpl never.

Set Implicit Arguments.

Module FailureRecorder (Import NT : NameType)
 (NOT : NameOrderedType NT) (NSet : MSetInterface.S with Module E := NOT)
 (Import ANT : AdjacentNameType NT).

Inductive Msg : Set :=
| Fail : Msg
| New : Msg.

Definition Msg_eq_dec : forall x y : Msg, {x = y} + {x <> y}.
decide equality.
Defined.

Inductive Input : Set := .

Definition Input_eq_dec : forall x y : Input, {x = y} + {x <> y}.
decide equality.
Defined.

Inductive Output : Set := .

Definition Output_eq_dec : forall x y : Output, {x = y} + {x <> y}.
decide equality.
Defined.

Definition NS := NSet.t.

Record Data := mkData { adjacent : NS }.

Definition InitData (n : name) := mkData NSet.empty.

Inductive Label : Type :=
| Tau : Label
| RecvFail : name -> name -> Label
| RecvNew : name -> name -> Label.

Definition Label_eq_dec : forall x y : Label, {x = y} + {x <> y}.
decide equality; exact: name_eq_dec.
Defined.

Definition Handler (S : Type) := GenHandler (name * Msg) S Output Label.

Definition NetHandler (me src: name) (msg : Msg) : Handler Data :=
st <- get ;;
match msg with
| New =>
  put {| adjacent := NSet.add src st.(adjacent) |} ;;
  ret (RecvNew me src)
| Fail =>
  put {| adjacent := NSet.remove src st.(adjacent) |} ;;
  ret (RecvFail me src)
end.

Definition IOHandler (me : name) (i : Input) : Handler Data := ret Tau.

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

Instance FailureRecorder_LabeledMultiParams : LabeledMultiParams FailureRecorder_BaseParams :=
  {
    lb_name := name ;
    lb_msg := Msg ;
    lb_msg_eq_dec := Msg_eq_dec ;
    lb_name_eq_dec := name_eq_dec ;
    lb_nodes := nodes ;
    lb_all_names_nodes := all_names_nodes ;
    lb_no_dup_nodes := no_dup_nodes ;
    label := Label ;
    label_silent := Tau ;
    lb_init_handlers := InitData ;
    lb_net_handlers := (fun dst src msg s => runGenHandler s (NetHandler dst src msg)) ;
    lb_input_handlers := fun nm msg s => runGenHandler s (IOHandler nm msg) ;
  }.

Instance FailureRecorder_MultiParams : MultiParams FailureRecorder_BaseParams := unlabeled_multi_params.

Instance FailureRecorder_NameOverlayParams : NameOverlayParams FailureRecorder_MultiParams :=
  {
    adjacent_to := adjacent_to ;
    adjacent_to_dec := adjacent_to_dec ;
    adjacent_to_symmetric := adjacent_to_symmetric ;
    adjacent_to_irreflexive := adjacent_to_irreflexive
  }.

Instance FailureRecorder_FailMsgParams : FailMsgParams FailureRecorder_MultiParams :=
  {
    msg_fail := Fail
  }.

Instance FailureRecorder_NewMsgParams : NewMsgParams FailureRecorder_MultiParams :=
  {
    msg_new := New
  }.

Lemma net_handlers_NetHandler :
  forall dst src m st os st' ms,
    net_handlers dst src m st = (os, st', ms) ->
    exists lb, NetHandler dst src m st = (lb, os, st', ms).
Proof.
intros.
simpl in *.
unfold unlabeled_net_handlers, lb_net_handlers in *.
simpl in *.
monad_unfold.
repeat break_let.
find_inversion.
by exists l0; auto.
Qed.

Lemma input_handlers_IOHandler :
  forall h i d os d' ms,
    input_handlers h i d = (os, d', ms) ->
    exists lb, IOHandler h i d = (lb, os, d', ms).
Proof. by []. Qed.

Lemma IOHandler_cases :
  forall h i st u out st' ms,
      IOHandler h i st = (u, out, st', ms) -> False.
Proof. by move => h; case. Qed.

Lemma NetHandler_cases :
  forall dst src msg st lb out st' ms,
    NetHandler dst src msg st = (lb, out, st', ms) ->
    (msg = Fail /\ lb = RecvFail dst src /\ out = [] /\ ms = [] /\ st'.(adjacent) = NSet.remove src st.(adjacent)) \/
    (msg = New /\ lb = RecvNew dst src /\ out = [] /\ ms = [] /\ st'.(adjacent) = NSet.add src st.(adjacent)).
Proof.
move => dst src msg st out st' ms.
rewrite /NetHandler.
case: msg; monad_unfold => /= H_eq.
- by left; find_inversion.
- by right; find_inversion.
Qed.

Ltac net_handler_cases :=
  find_apply_lem_hyp NetHandler_cases;
  intuition idtac; subst;
  repeat find_rewrite.

Ltac io_handler_cases :=
  find_apply_lem_hyp IOHandler_cases.

End FailureRecorder.


Require Import TM.TM.

(** * Basic 1-Tape Machines *)

(** ** Helper functions *)
Section Mk_Mono.
  Variable (sig states : finType).
  Variable mono_trans : states -> option sig -> states * (option sig * move).
  Variable (init : states) (fin : states -> bool).

  Definition Mk_Mono_TM : mTM sig 1.
  Proof.
    split with (states := states).
    - intros (q&tape).
      pose proof (mono_trans q (tape[@Fin0])) as (q', act).
      apply (q', [| act |]).
    - apply init.
    - apply fin.
  Defined.

  Variable (F : finType) (R : Rel (tape sig) (F * tape sig)).

  Definition Mk_R_p : Rel (tapes sig 1) (F * tapes sig 1) :=
      fun tps1 '(p, tps2) => R (tps1[@Fin0]) (p, tps2[@Fin0]).

End Mk_Mono.

Arguments Mk_R_p { sig F } ( R ) x y /.

(** ** Do a single action *)
Section DoAct.
  Variable sig : finType.
  Variable c : sig.

  Variable act : option sig * move.

  Definition DoAct_TM :=
    {|
      trans := fun '(q, sym) => (true, [| act |]);
      start := false;
      halt x := x;
    |}.

  Definition DoAct : pTM sig unit 1 := (DoAct_TM; fun _ => tt).

  Definition DoAct_Rel : pRel sig unit 1 :=
    Mk_R_p (ignoreParam (fun t t' => t' = doAct t act)).

  Lemma DoAct_Sem : DoAct ⊨c(1) DoAct_Rel.
  Proof. intros t. destruct_tapes. cbn. unfold initc; cbn. eexists (mk_mconfig _ _); cbn; eauto. Qed.

End DoAct.

Arguments DoAct : simpl never.
Arguments DoAct_Rel { sig } act x y /.

(** *** Derived Machines *)

Section DoAct_Derived.
  Variable sig : finType.
  Variable c : sig. (* for Write *)
  Variable (D : move). (* for Move *)

  Definition Write : pTM sig unit 1 := DoAct (Some c, N).

  Definition Write_Rel : pRel sig unit 1 :=
    Mk_R_p (ignoreParam (fun t t' => t' = midtape (left t) c (right t))).

  Lemma Write_Sem :
    Write ⊨c(1) Write_Rel.
  Proof.
    eapply RealiseIn_monotone.
    - apply DoAct_Sem.
    - reflexivity.
    - hnf. firstorder.
  Qed.

  Definition Move : pTM sig unit 1 := DoAct (None, D).

  Definition Move_Rel : pRel sig unit 1 :=
    Mk_R_p (ignoreParam (fun t t' => t' = tape_move (sig := sig) t D)).

  Lemma Move_Sem :
    Move ⊨c(1) Move_Rel.
  Proof.
    eapply RealiseIn_monotone.
    - apply DoAct_Sem.
    - reflexivity.
    - hnf. firstorder.
  Qed.

  Definition WriteMove : pTM sig unit 1 := DoAct (Some c, D).

  Definition WriteMove_Rel : pRel sig unit 1 :=
    Mk_R_p (ignoreParam (fun t t' => t' = tape_move (tape_write t (Some c)) D)).

  Lemma WriteMove_Sem :
    WriteMove ⊨c(1) WriteMove_Rel.
  Proof.
    eapply RealiseIn_monotone.
    - apply DoAct_Sem.
    - reflexivity.
    - hnf. firstorder.
  Qed.

End DoAct_Derived.

Arguments Write : simpl never.
Arguments Write_Rel { sig } c x y / : rename.

Arguments Move : simpl never.
Arguments Move { sig } D.
Arguments Move_Rel { sig } ( D ) x y /.

Arguments WriteMove : simpl never.
Arguments WriteMove_Rel { sig } (w D) x y / : rename.

(** ** Read a symbol *)

Section ReadChar.

  Variable sig : finType.

  Definition ReadChar_TM : mTM sig 1 :=
    {|
      trans := fun '(_, sym) =>
                 match sym[@Fin0] with
                 | None => (inl true, [|(None, N)|])
                 | Some c => (inr c, [|(None, N)|])
                 end;
      start := inl false;
      halt := fun s => match s with
                    | inl b => b
                    | inr _ => true
                    end;
    |}.

  Definition ReadChar := (ReadChar_TM; fun s => match s with inl _ => None | inr s => Some s end).

  Definition ReadChar_Rel : pRel sig (option sig) 1 :=
    fun t '(y, t') =>
      y = current t[@Fin0] /\
      t' = t.

  Definition ReadChar_Sem : ReadChar ⊨c(1) ReadChar_Rel.
  Proof.
    intros t. destruct_tapes. cbn. unfold initc; cbn. cbv [step]; cbn. unfold current_chars; cbn.
    destruct (current h) eqn:E.
    - eexists (mk_mconfig _ _); cbv [step]; cbn. split; eauto.
    - eexists (mk_mconfig _ _); cbv [step]; cbn. split; eauto.
  Qed.

End ReadChar.

Arguments ReadChar : simpl never.
Arguments ReadChar {sig}.
Arguments ReadChar_Rel sig x y /.

(** ** Tactic Support *)

Ltac smpl_TM_Mono :=
  lazymatch goal with
  | [ |- DoAct _ ⊨ _] => eapply RealiseIn_Realise; eapply DoAct_Sem
  | [ |- DoAct _ ⊨c(_) _] => eapply DoAct_Sem
  | [ |- projT1 (DoAct _) ↓ _] => eapply RealiseIn_TerminatesIn; eapply DoAct_Sem
  | [ |- Write _ ⊨ _] => eapply RealiseIn_Realise; eapply Write_Sem
  | [ |- Write _ ⊨c(_) _] => eapply Write_Sem
  | [ |- projT1 (Write _) ↓ _] => eapply RealiseIn_TerminatesIn; eapply Write_Sem
  | [ |- Move _ ⊨ _] => eapply RealiseIn_Realise; eapply Move_Sem
  | [ |- Move _ ⊨c(_) _] => eapply Move_Sem
  | [ |- projT1 (Move _) ↓ _] => eapply RealiseIn_TerminatesIn; eapply Move_Sem
  | [ |- WriteMove _ _ ⊨ _] => eapply RealiseIn_Realise; eapply WriteMove_Sem
  | [ |- WriteMove _ _ ⊨c(_) _] => eapply WriteMove_Sem
  | [ |- projT1 (WriteMove _ _) ↓ _] => eapply RealiseIn_TerminatesIn; eapply WriteMove_Sem
  | [ |- ReadChar ⊨ _] => eapply RealiseIn_Realise; eapply ReadChar_Sem
  | [ |- ReadChar ⊨c(_) _] => eapply ReadChar_Sem
  | [ |- projT1 (ReadChar) ↓ _] => eapply RealiseIn_TerminatesIn; eapply ReadChar_Sem
  end.

Smpl Add smpl_TM_Mono : TM_Correct.


From Tweetnacl.Libs Require Import Export.
From Tweetnacl.ListsOp Require Import Export.
From stdpp Require Import list.
Require Import ssreflect.

From Tweetnacl.Gen Require Import AMZubSqSel.
From Tweetnacl.Gen Require Import AMZubSqSel_Prop.
From Tweetnacl.Gen Require Import AMZubSqSel_List.
From Tweetnacl.Gen Require Import Get_abcdef.
From Tweetnacl.Gen Require Import abstract_fn_rev.
From Tweetnacl.Gen Require Import ABCDEF.
From Tweetnacl.Low Require Import List16.
From Tweetnacl.Low Require Import AMZubSqSel_Correct.
From Tweetnacl.Gen Require Import abstract_fn_rev_eq.
From Tweetnacl.Gen Require Import abstract_fn_rev_abcdef.
From Tweetnacl.Low Require Import Constant.

Open Scope Z.

Section Crypto_Scalarmult_Eq_ac_List16_Z.

Context (Mod : Z -> Z).
Context (Z_Ops : (Ops Z Z) Mod).
Context (List_Z_Ops : Ops (list Z) (list Z) id).
Context (List_Z_Ops_Prop : @Ops_List List_Z_Ops).
Context (List_Z_Ops_Prop_Correct : @Ops_Prop_List_Z Mod List_Z_Ops Z_Ops).
Local Instance List16_Ops : (Ops (@List16 Z) (List32B) id) := {}.
Proof.
apply A_List16.
apply M_List16.
apply Zub_List16.
apply Sq_List16.
apply C_0_List16.
apply C_1_List16.
apply C_121665_List16.
apply Sel25519_List16.
apply getbit_List32B.
simpl ; reflexivity.
simpl ; reflexivity.
simpl ; reflexivity.
simpl ; reflexivity.
simpl ; reflexivity.
simpl ; reflexivity.
Defined.
Local Instance List16_Z_Eq : @Ops_Mod_P (@List16 Z) (List32B) Z Mod id List16_Ops Z_Ops := {
P l := (ZofList 16 (List16_to_List l));
P' l := (ZofList 8 (List32_to_List l));
}.
Proof.
- intros [a Ha] [b Hb] ; simpl ; f_equal; apply A_correct.
- intros [a Ha] [b Hb] ; simpl List16_to_List.
  apply mult_GF_Zlengh ; assumption.
- intros [a Ha] [b Hb] ; simpl ; f_equal ; apply Zub_correct.
- intros [a Ha] ; simpl List16_to_List ; apply Sq_GF_Zlengh ; assumption.
- simpl List16_to_List ; f_equal; apply C_121665_correct.
- simpl List16_to_List ; f_equal; apply C_0_correct.
- simpl List16_to_List ; f_equal; apply C_1_correct.
- intros b [p Hp] [q Hq] ; simpl List16_to_List ; f_equal ; apply Sel25519_correct.
- intros b [p Hp] ; simpl ; symmetry ; apply GetBit_correct ; assumption.
Defined.

Lemma abstract_fn_rev_eq_a_Z : ∀ (m p : ℤ) (CN : List32B) (L16ONE L16NUL L16UP : List16 ℤ) (Cn Up:list Z) (n u:Z),
  0 ≤ m →
  List16_to_List L16ONE = Low.C_1 ->
  List16_to_List L16NUL = Low.C_0 ->
  List16_to_List L16UP = Up ->
  List32_to_List CN = Cn ->
  ZofList 16 Up = u ->
  ZofList 8 Cn = n ->
  Mod (P (get_a (abstract_fn_rev m p CN L16ONE L16UP L16NUL L16ONE L16NUL L16NUL L16UP))) =
  Mod (get_a (abstract_fn_rev m p n 1 u 0 1 0 0 u)).
Proof.
  intros m p CN L16ONE L16NUL L16UP Cn Up n u.
  intros Hm.
  intros HL16ONE HL16NUL HL16UP HL32CN.
  intros Hu Hn.
  assert(Heq1:= @abstract_fn_rev_eq_a (List16 Z) List32B Z id Mod List16_Ops Z_Ops List16_Z_Eq m p).
  specialize Heq1 with CN L16ONE L16UP L16NUL L16ONE L16NUL L16NUL L16UP.
  apply Heq1 in Hm.
  clear Heq1.
  move:Hm.
  rewrite /P /P' /List16_Z_Eq ?HL16ONE ?HL16NUL ?HL16UP ?HL32CN ?Hu ?Hn.
  change (ℤ16.lst Low.C_0) with 0.
  change (ℤ16.lst Low.C_1) with 1.
  trivial.
Qed.

Lemma abstract_fn_rev_eq_c_Z : ∀ (m p : ℤ) (CN : List32B) (L16ONE L16NUL L16UP : List16 ℤ) (Cn Up:list Z) (n u:Z),
  0 ≤ m →
  List16_to_List L16ONE = Low.C_1 ->
  List16_to_List L16NUL = Low.C_0 ->
  List16_to_List L16UP = Up ->
  List32_to_List CN = Cn ->
  ZofList 16 Up = u ->
  ZofList 8 Cn = n ->
  Mod (P (get_c (abstract_fn_rev m p CN L16ONE L16UP L16NUL L16ONE L16NUL L16NUL L16UP))) =
  Mod (get_c (abstract_fn_rev m p n 1 u 0 1 0 0 u)).
Proof.
  intros m p CN L16ONE L16NUL L16UP Cn Up n u.
  intros Hm.
  intros HL16ONE HL16NUL HL16UP HL32CN.
  intros Hu Hn.
  assert(Heq1:= @abstract_fn_rev_eq_c (List16 Z) List32B Z id Mod List16_Ops Z_Ops List16_Z_Eq m p).
  specialize Heq1 with CN L16ONE L16UP L16NUL L16ONE L16NUL L16NUL L16UP.
  apply Heq1 in Hm.
  clear Heq1.
  move:Hm.
  rewrite /P /P' /List16_Z_Eq ?HL16ONE ?HL16NUL ?HL16UP ?HL32CN ?Hu ?Hn.
  change (ℤ16.lst Low.C_0) with 0.
  change (ℤ16.lst Low.C_1) with 1.
  trivial.
Qed.

End Crypto_Scalarmult_Eq_ac_List16_Z.

Close Scope Z.


Require Export VST.concurrency.paco.src.paconotation VST.concurrency.paco.src.pacotac VST.concurrency.paco.src.pacodef VST.concurrency.paco.src.pacotacuser.
Set Implicit Arguments.

(** ** Predicates of Arity 4
*)

(** 1 Mutual Coinduction *)

Section Arg4_1.

Definition monotone4 T0 T1 T2 T3 (gf: rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3) :=
  forall x0 x1 x2 x3 r r' (IN: gf r x0 x1 x2 x3) (LE: r <4= r'), gf r' x0 x1 x2 x3.

Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable T2 : forall (x0: @T0) (x1: @T1 x0), Type.
Variable T3 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1), Type.
Variable gf : rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3.
Arguments gf : clear implicits.

Theorem paco4_acc: forall
  l r (OBG: forall rr (INC: r <4= rr) (CIH: l <_paco_4= rr), l <_paco_4= paco4 gf rr),
  l <4= paco4 gf r.
Proof.
  intros; assert (SIM: paco4 gf (r \4/ l) x0 x1 x2 x3) by eauto.
  clear PR; repeat (try left; do 5 paco_revert; paco_cofix_auto).
Qed.

Theorem paco4_mon: monotone4 (paco4 gf).
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_mult_strong: forall r,
  paco4 gf (upaco4 gf r) <4= paco4 gf r.
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Corollary paco4_mult: forall r,
  paco4 gf (paco4 gf r) <4= paco4 gf r.
Proof. intros; eapply paco4_mult_strong, paco4_mon; eauto. Qed.

Theorem paco4_fold: forall r,
  gf (upaco4 gf r) <4= paco4 gf r.
Proof. intros; econstructor; [ |eauto]; eauto. Qed.

Theorem paco4_unfold: forall (MON: monotone4 gf) r,
  paco4 gf r <4= gf (upaco4 gf r).
Proof. unfold monotone4; intros; destruct PR; eauto. Qed.

End Arg4_1.

Hint Unfold monotone4.
Hint Resolve paco4_fold.

Arguments paco4_acc            [ T0 T1 T2 T3 ].
Arguments paco4_mon            [ T0 T1 T2 T3 ].
Arguments paco4_mult_strong    [ T0 T1 T2 T3 ].
Arguments paco4_mult           [ T0 T1 T2 T3 ].
Arguments paco4_fold           [ T0 T1 T2 T3 ].
Arguments paco4_unfold         [ T0 T1 T2 T3 ].

Instance paco4_inst  T0 T1 T2 T3 (gf : rel4 T0 T1 T2 T3->_) r x0 x1 x2 x3 : paco_class (paco4 gf r x0 x1 x2 x3) :=
{ pacoacc    := paco4_acc gf;
  pacomult   := paco4_mult gf;
  pacofold   := paco4_fold gf;
  pacounfold := paco4_unfold gf }.

(** 2 Mutual Coinduction *)

Section Arg4_2.

Definition monotone4_2 T0 T1 T2 T3 (gf: rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3) :=
  forall x0 x1 x2 x3 r_0 r_1 r'_0 r'_1 (IN: gf r_0 r_1 x0 x1 x2 x3) (LE_0: r_0 <4= r'_0)(LE_1: r_1 <4= r'_1), gf r'_0 r'_1 x0 x1 x2 x3.

Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable T2 : forall (x0: @T0) (x1: @T1 x0), Type.
Variable T3 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1), Type.
Variable gf_0 gf_1 : rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3.
Arguments gf_0 : clear implicits.
Arguments gf_1 : clear implicits.

Theorem paco4_2_0_acc: forall
  l r_0 r_1 (OBG: forall rr (INC: r_0 <4= rr) (CIH: l <_paco_4= rr), l <_paco_4= paco4_2_0 gf_0 gf_1 rr r_1),
  l <4= paco4_2_0 gf_0 gf_1 r_0 r_1.
Proof.
  intros; assert (SIM: paco4_2_0 gf_0 gf_1 (r_0 \4/ l) r_1 x0 x1 x2 x3) by eauto.
  clear PR; repeat (try left; do 5 paco_revert; paco_cofix_auto).
Qed.

Theorem paco4_2_1_acc: forall
  l r_0 r_1 (OBG: forall rr (INC: r_1 <4= rr) (CIH: l <_paco_4= rr), l <_paco_4= paco4_2_1 gf_0 gf_1 r_0 rr),
  l <4= paco4_2_1 gf_0 gf_1 r_0 r_1.
Proof.
  intros; assert (SIM: paco4_2_1 gf_0 gf_1 r_0 (r_1 \4/ l) x0 x1 x2 x3) by eauto.
  clear PR; repeat (try left; do 5 paco_revert; paco_cofix_auto).
Qed.

Theorem paco4_2_0_mon: monotone4_2 (paco4_2_0 gf_0 gf_1).
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_2_1_mon: monotone4_2 (paco4_2_1 gf_0 gf_1).
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_2_0_mult_strong: forall r_0 r_1,
  paco4_2_0 gf_0 gf_1 (upaco4_2_0 gf_0 gf_1 r_0 r_1) (upaco4_2_1 gf_0 gf_1 r_0 r_1) <4= paco4_2_0 gf_0 gf_1 r_0 r_1.
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_2_1_mult_strong: forall r_0 r_1,
  paco4_2_1 gf_0 gf_1 (upaco4_2_0 gf_0 gf_1 r_0 r_1) (upaco4_2_1 gf_0 gf_1 r_0 r_1) <4= paco4_2_1 gf_0 gf_1 r_0 r_1.
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Corollary paco4_2_0_mult: forall r_0 r_1,
  paco4_2_0 gf_0 gf_1 (paco4_2_0 gf_0 gf_1 r_0 r_1) (paco4_2_1 gf_0 gf_1 r_0 r_1) <4= paco4_2_0 gf_0 gf_1 r_0 r_1.
Proof. intros; eapply paco4_2_0_mult_strong, paco4_2_0_mon; eauto. Qed.

Corollary paco4_2_1_mult: forall r_0 r_1,
  paco4_2_1 gf_0 gf_1 (paco4_2_0 gf_0 gf_1 r_0 r_1) (paco4_2_1 gf_0 gf_1 r_0 r_1) <4= paco4_2_1 gf_0 gf_1 r_0 r_1.
Proof. intros; eapply paco4_2_1_mult_strong, paco4_2_1_mon; eauto. Qed.

Theorem paco4_2_0_fold: forall r_0 r_1,
  gf_0 (upaco4_2_0 gf_0 gf_1 r_0 r_1) (upaco4_2_1 gf_0 gf_1 r_0 r_1) <4= paco4_2_0 gf_0 gf_1 r_0 r_1.
Proof. intros; econstructor; [ | |eauto]; eauto. Qed.

Theorem paco4_2_1_fold: forall r_0 r_1,
  gf_1 (upaco4_2_0 gf_0 gf_1 r_0 r_1) (upaco4_2_1 gf_0 gf_1 r_0 r_1) <4= paco4_2_1 gf_0 gf_1 r_0 r_1.
Proof. intros; econstructor; [ | |eauto]; eauto. Qed.

Theorem paco4_2_0_unfold: forall (MON: monotone4_2 gf_0) (MON: monotone4_2 gf_1) r_0 r_1,
  paco4_2_0 gf_0 gf_1 r_0 r_1 <4= gf_0 (upaco4_2_0 gf_0 gf_1 r_0 r_1) (upaco4_2_1 gf_0 gf_1 r_0 r_1).
Proof. unfold monotone4_2; intros; destruct PR; eauto. Qed.

Theorem paco4_2_1_unfold: forall (MON: monotone4_2 gf_0) (MON: monotone4_2 gf_1) r_0 r_1,
  paco4_2_1 gf_0 gf_1 r_0 r_1 <4= gf_1 (upaco4_2_0 gf_0 gf_1 r_0 r_1) (upaco4_2_1 gf_0 gf_1 r_0 r_1).
Proof. unfold monotone4_2; intros; destruct PR; eauto. Qed.

End Arg4_2.

Hint Unfold monotone4_2.
Hint Resolve paco4_2_0_fold.
Hint Resolve paco4_2_1_fold.

Arguments paco4_2_0_acc            [ T0 T1 T2 T3 ].
Arguments paco4_2_1_acc            [ T0 T1 T2 T3 ].
Arguments paco4_2_0_mon            [ T0 T1 T2 T3 ].
Arguments paco4_2_1_mon            [ T0 T1 T2 T3 ].
Arguments paco4_2_0_mult_strong    [ T0 T1 T2 T3 ].
Arguments paco4_2_1_mult_strong    [ T0 T1 T2 T3 ].
Arguments paco4_2_0_mult           [ T0 T1 T2 T3 ].
Arguments paco4_2_1_mult           [ T0 T1 T2 T3 ].
Arguments paco4_2_0_fold           [ T0 T1 T2 T3 ].
Arguments paco4_2_1_fold           [ T0 T1 T2 T3 ].
Arguments paco4_2_0_unfold         [ T0 T1 T2 T3 ].
Arguments paco4_2_1_unfold         [ T0 T1 T2 T3 ].

Instance paco4_2_0_inst  T0 T1 T2 T3 (gf_0 gf_1 : rel4 T0 T1 T2 T3->_) r_0 r_1 x0 x1 x2 x3 : paco_class (paco4_2_0 gf_0 gf_1 r_0 r_1 x0 x1 x2 x3) :=
{ pacoacc    := paco4_2_0_acc gf_0 gf_1;
  pacomult   := paco4_2_0_mult gf_0 gf_1;
  pacofold   := paco4_2_0_fold gf_0 gf_1;
  pacounfold := paco4_2_0_unfold gf_0 gf_1 }.

Instance paco4_2_1_inst  T0 T1 T2 T3 (gf_0 gf_1 : rel4 T0 T1 T2 T3->_) r_0 r_1 x0 x1 x2 x3 : paco_class (paco4_2_1 gf_0 gf_1 r_0 r_1 x0 x1 x2 x3) :=
{ pacoacc    := paco4_2_1_acc gf_0 gf_1;
  pacomult   := paco4_2_1_mult gf_0 gf_1;
  pacofold   := paco4_2_1_fold gf_0 gf_1;
  pacounfold := paco4_2_1_unfold gf_0 gf_1 }.

(** 3 Mutual Coinduction *)

Section Arg4_3.

Definition monotone4_3 T0 T1 T2 T3 (gf: rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3) :=
  forall x0 x1 x2 x3 r_0 r_1 r_2 r'_0 r'_1 r'_2 (IN: gf r_0 r_1 r_2 x0 x1 x2 x3) (LE_0: r_0 <4= r'_0)(LE_1: r_1 <4= r'_1)(LE_2: r_2 <4= r'_2), gf r'_0 r'_1 r'_2 x0 x1 x2 x3.

Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable T2 : forall (x0: @T0) (x1: @T1 x0), Type.
Variable T3 : forall (x0: @T0) (x1: @T1 x0) (x2: @T2 x0 x1), Type.
Variable gf_0 gf_1 gf_2 : rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3 -> rel4 T0 T1 T2 T3.
Arguments gf_0 : clear implicits.
Arguments gf_1 : clear implicits.
Arguments gf_2 : clear implicits.

Theorem paco4_3_0_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_0 <4= rr) (CIH: l <_paco_4= rr), l <_paco_4= paco4_3_0 gf_0 gf_1 gf_2 rr r_1 r_2),
  l <4= paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco4_3_0 gf_0 gf_1 gf_2 (r_0 \4/ l) r_1 r_2 x0 x1 x2 x3) by eauto.
  clear PR; repeat (try left; do 5 paco_revert; paco_cofix_auto).
Qed.

Theorem paco4_3_1_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_1 <4= rr) (CIH: l <_paco_4= rr), l <_paco_4= paco4_3_1 gf_0 gf_1 gf_2 r_0 rr r_2),
  l <4= paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco4_3_1 gf_0 gf_1 gf_2 r_0 (r_1 \4/ l) r_2 x0 x1 x2 x3) by eauto.
  clear PR; repeat (try left; do 5 paco_revert; paco_cofix_auto).
Qed.

Theorem paco4_3_2_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_2 <4= rr) (CIH: l <_paco_4= rr), l <_paco_4= paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 rr),
  l <4= paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 (r_2 \4/ l) x0 x1 x2 x3) by eauto.
  clear PR; repeat (try left; do 5 paco_revert; paco_cofix_auto).
Qed.

Theorem paco4_3_0_mon: monotone4_3 (paco4_3_0 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_3_1_mon: monotone4_3 (paco4_3_1 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_3_2_mon: monotone4_3 (paco4_3_2 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_3_0_mult_strong: forall r_0 r_1 r_2,
  paco4_3_0 gf_0 gf_1 gf_2 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_3_1_mult_strong: forall r_0 r_1 r_2,
  paco4_3_1 gf_0 gf_1 gf_2 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Theorem paco4_3_2_mult_strong: forall r_0 r_1 r_2,
  paco4_3_2 gf_0 gf_1 gf_2 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 5 paco_revert; paco_cofix_auto). Qed.

Corollary paco4_3_0_mult: forall r_0 r_1 r_2,
  paco4_3_0 gf_0 gf_1 gf_2 (paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco4_3_0_mult_strong, paco4_3_0_mon; eauto. Qed.

Corollary paco4_3_1_mult: forall r_0 r_1 r_2,
  paco4_3_1 gf_0 gf_1 gf_2 (paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco4_3_1_mult_strong, paco4_3_1_mon; eauto. Qed.

Corollary paco4_3_2_mult: forall r_0 r_1 r_2,
  paco4_3_2 gf_0 gf_1 gf_2 (paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco4_3_2_mult_strong, paco4_3_2_mon; eauto. Qed.

Theorem paco4_3_0_fold: forall r_0 r_1 r_2,
  gf_0 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco4_3_1_fold: forall r_0 r_1 r_2,
  gf_1 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco4_3_2_fold: forall r_0 r_1 r_2,
  gf_2 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <4= paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco4_3_0_unfold: forall (MON: monotone4_3 gf_0) (MON: monotone4_3 gf_1) (MON: monotone4_3 gf_2) r_0 r_1 r_2,
  paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 <4= gf_0 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2).
Proof. unfold monotone4_3; intros; destruct PR; eauto. Qed.

Theorem paco4_3_1_unfold: forall (MON: monotone4_3 gf_0) (MON: monotone4_3 gf_1) (MON: monotone4_3 gf_2) r_0 r_1 r_2,
  paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 <4= gf_1 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2).
Proof. unfold monotone4_3; intros; destruct PR; eauto. Qed.

Theorem paco4_3_2_unfold: forall (MON: monotone4_3 gf_0) (MON: monotone4_3 gf_1) (MON: monotone4_3 gf_2) r_0 r_1 r_2,
  paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 <4= gf_2 (upaco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2).
Proof. unfold monotone4_3; intros; destruct PR; eauto. Qed.

End Arg4_3.

Hint Unfold monotone4_3.
Hint Resolve paco4_3_0_fold.
Hint Resolve paco4_3_1_fold.
Hint Resolve paco4_3_2_fold.

Arguments paco4_3_0_acc            [ T0 T1 T2 T3 ].
Arguments paco4_3_1_acc            [ T0 T1 T2 T3 ].
Arguments paco4_3_2_acc            [ T0 T1 T2 T3 ].
Arguments paco4_3_0_mon            [ T0 T1 T2 T3 ].
Arguments paco4_3_1_mon            [ T0 T1 T2 T3 ].
Arguments paco4_3_2_mon            [ T0 T1 T2 T3 ].
Arguments paco4_3_0_mult_strong    [ T0 T1 T2 T3 ].
Arguments paco4_3_1_mult_strong    [ T0 T1 T2 T3 ].
Arguments paco4_3_2_mult_strong    [ T0 T1 T2 T3 ].
Arguments paco4_3_0_mult           [ T0 T1 T2 T3 ].
Arguments paco4_3_1_mult           [ T0 T1 T2 T3 ].
Arguments paco4_3_2_mult           [ T0 T1 T2 T3 ].
Arguments paco4_3_0_fold           [ T0 T1 T2 T3 ].
Arguments paco4_3_1_fold           [ T0 T1 T2 T3 ].
Arguments paco4_3_2_fold           [ T0 T1 T2 T3 ].
Arguments paco4_3_0_unfold         [ T0 T1 T2 T3 ].
Arguments paco4_3_1_unfold         [ T0 T1 T2 T3 ].
Arguments paco4_3_2_unfold         [ T0 T1 T2 T3 ].

Instance paco4_3_0_inst  T0 T1 T2 T3 (gf_0 gf_1 gf_2 : rel4 T0 T1 T2 T3->_) r_0 r_1 r_2 x0 x1 x2 x3 : paco_class (paco4_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1 x2 x3) :=
{ pacoacc    := paco4_3_0_acc gf_0 gf_1 gf_2;
  pacomult   := paco4_3_0_mult gf_0 gf_1 gf_2;
  pacofold   := paco4_3_0_fold gf_0 gf_1 gf_2;
  pacounfold := paco4_3_0_unfold gf_0 gf_1 gf_2 }.

Instance paco4_3_1_inst  T0 T1 T2 T3 (gf_0 gf_1 gf_2 : rel4 T0 T1 T2 T3->_) r_0 r_1 r_2 x0 x1 x2 x3 : paco_class (paco4_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1 x2 x3) :=
{ pacoacc    := paco4_3_1_acc gf_0 gf_1 gf_2;
  pacomult   := paco4_3_1_mult gf_0 gf_1 gf_2;
  pacofold   := paco4_3_1_fold gf_0 gf_1 gf_2;
  pacounfold := paco4_3_1_unfold gf_0 gf_1 gf_2 }.

Instance paco4_3_2_inst  T0 T1 T2 T3 (gf_0 gf_1 gf_2 : rel4 T0 T1 T2 T3->_) r_0 r_1 r_2 x0 x1 x2 x3 : paco_class (paco4_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1 x2 x3) :=
{ pacoacc    := paco4_3_2_acc gf_0 gf_1 gf_2;
  pacomult   := paco4_3_2_mult gf_0 gf_1 gf_2;
  pacofold   := paco4_3_2_fold gf_0 gf_1 gf_2;
  pacounfold := paco4_3_2_unfold gf_0 gf_1 gf_2 }.


Require Import AbstractLogic.
Require Import BasicMachineTypes.
Require Import Certificates.
Require Import StoreIface.
Require Import GenericAnnotationIface.
Require Import AnnotationIface.
Require Import ResourceAlgebra.
Require Import List.
Require FMapInterface.

Module Type VERIFIER_ANNOTATIONS
  (VA_B    : BASICS)
  (VA_AL   : ABSTRACT_LOGIC VA_B)
  (VA_CERT : CERTIFICATE with Definition asn := VA_AL.formula).

Inductive constantpool_additional : Set :=
| cpae_static_method : VA_AL.formula -> VA_AL.formula -> VA_AL.formula -> constantpool_additional
| cpae_static_field
| cpae_instantiable_class
| cpae_instance_field
| cpae_instance_method : VA_AL.formula -> VA_AL.formula -> VA_AL.formula -> constantpool_additional
| cpae_instance_special_method : VA_AL.formula -> VA_AL.formula -> VA_AL.formula -> constantpool_additional
| cpae_interface_method : VA_AL.formula -> VA_AL.formula -> VA_AL.formula -> constantpool_additional
| cpae_classref.

Declare Module ConstantPoolAdditional : STORE with Definition key := VA_B.ConstantPoolRef.t
                                              with Definition Key.eq := VA_B.ConstantPoolRef.eq
                                              with Definition object := constantpool_additional.

Declare Module ProofTable : STORE with Definition key := (VA_AL.formula * VA_AL.formula)%type
                                  with Definition object := VA_AL.prf_term.

Definition method_specification' := (VA_AL.formula * VA_AL.formula * VA_AL.formula)%type.
Definition method_specification := method_specification'.
Record method_annotation' : Set := {
  method_spec : method_specification'
; grants : option (res_expr VA_B.Classname.t)
}.

Definition code_annotation := VA_CERT.Cert.t.
Definition method_annotation := method_annotation'.
Definition class_annotation := (ProofTable.t * ConstantPoolAdditional.t)%type.

Parameter method_annotation_eqdec : forall (a1 a2:method_annotation), {a1 = a2} + {a1 <> a2}.

Definition trivial_method_annotation := Build_method_annotation'
  (VA_AL.trivial, VA_AL.trivial, VA_AL.trivial)
  None.

Module GA <: GENERIC_ANNOTATION VA_B.
  Module A <: ANNOTATION VA_B.

    Definition code_annotation := VA_CERT.Cert.t.
    Definition method_annotation := method_annotation'.
    Definition grants := grants.
    Definition class_annotation := (ProofTable.t * ConstantPoolAdditional.t)%type.

    Definition trivial_method_annotation := trivial_method_annotation.
  End A.

  Definition method_specification := method_specification'.
  Definition method_spec := method_spec.
End GA.

End VERIFIER_ANNOTATIONS.

(*
   Local Variables:
   coq-prog-args: ("-emacs-U" "-I" ".." "-R" "../ill" "ILL" "-R" "." "Verifier")
   End:
   *)