Require Import VST.msl.seplog.
Require Import VST.msl.log_normalize.
Require Import CertiGraph.lib.Coqlib.
Require Import CertiGraph.lib.Ensembles_ext.
Require Import CertiGraph.lib.EquivDec_ext.
Require Import CertiGraph.lib.List_ext.
Require Import CertiGraph.lib.relation_list.
Require Import CertiGraph.msl_ext.log_normalize.
Require Import CertiGraph.msl_ext.iter_sepcon.
Require Import CertiGraph.msl_ext.ramification_lemmas.
Require Import CertiGraph.graph.graph_model.
Require Import CertiGraph.graph.path_lemmas.
Require Import CertiGraph.graph.reachable_computable.
Require Import CertiGraph.graph.reachable_ind.
Require Import CertiGraph.graph.subgraph2.
Require Import CertiGraph.graph.graph_gen.
Require Import CertiGraph.graph.dag.
Require Import CertiGraph.graph.weak_mark_lemmas.
Require Import CertiGraph.msl_application.Graph.
Require Import Coq.Logic.Classical.

Local Open Scope logic.

Section PointwiseGraph_Mark.

Context {V E: Type}.
Context {GV GE Pred: Type}.
Context {SGBA: PointwiseGraphBasicAssum V E}.
Context {SGC: PointwiseGraphConstructor V E bool unit unit GV GE}.
Context {L_SGC: Local_PointwiseGraphConstructor V E bool unit unit GV GE}.
Context {SGP: PointwiseGraphPred V E GV GE Pred}.
Context {SGA: PointwiseGraphAssum SGP}.

Instance MGS: WeakMarkGraph.MarkGraphSetting bool.
Proof.
  apply (WeakMarkGraph.Build_MarkGraphSetting _ (eq true)).
  intros; destruct x; [left | right]; congruence.
Defined.

Global Existing Instance MGS.

Notation Graph := (LabeledGraph V E bool unit unit).
Notation SGraph := (PointwiseGraph V E GV GE).

Local Coercion pg_lg: LabeledGraph >-> PreGraph.

Definition mark1 x (G1: Graph) (G2: Graph) := WeakMarkGraph.mark1 x G1 G2.
Definition mark x (G1: Graph) (G2: Graph) := WeakMarkGraph.mark x G1 G2 /\ G1 ~=~ G2.

Definition mark_list xs g1 g2 := relation_list (map mark xs) g1 g2.

Lemma mark_invalid_refl: forall (g: Graph) root, ~ vvalid g root -> mark root g g.
Proof.
  intros.
  split.
  + apply WeakMarkGraph.mark_invalid_refl; auto.
  + reflexivity.
Qed.

Lemma mark_marked_root_refl: forall (g: Graph) root, WeakMarkGraph.marked g root -> mark root g g.
Proof.
  intros.
  split.
  + apply WeakMarkGraph.mark_marked_root_refl; auto.
  + reflexivity.
Qed.

Lemma mark_list_eq: forall root xs g1 g2,
  mark_list xs g1 g2 ->
  WeakMarkGraph.componded_mark_list root xs g1 g2 /\ g1 ~=~ g2.
Proof.
  intros.
  change (mark_list xs g1 g2) with
    (relation_list (map (fun x => relation_conjunction (WeakMarkGraph.mark x) (respectful_relation pg_lg structurally_identical)) xs) g1 g2) in H.
  eapply relation_list_conjunction in H.
  rewrite relation_conjunction_iff in H.
  split.
  + destruct H as [? _].
    eapply relation_list_inclusion; [| exact H].
    intros ? _.
    clear.
    intros g1 g2 ?.
    exists g2; [| apply WeakMarkGraph.eq_do_nothing; auto].
    exists g1; [apply WeakMarkGraph.eq_do_nothing; auto |].
    auto.
  + eapply si_list.
    exact (proj2 H).
Qed.

Lemma mark1_mark_list_mark: forall root l (g g': Graph),
  vvalid g root ->
  (WeakMarkGraph.unmarked g) root ->
  step_list g root l ->
  relation_list (mark1 root :: mark_list l :: nil) g g' ->
  mark root g g'.
Proof.
  intros.
  destruct_relation_list g0 in H2.
  eapply (mark_list_eq root) in H2.
  destruct H2; simpl in H2.
  split.
  + eapply WeakMarkGraph.mark1_componded_mark_list_mark; eauto.
    split_relation_list (g :: g0 :: g0 :: g' :: nil); auto;
    apply WeakMarkGraph.eq_do_nothing; auto.
  + destruct H3 as [? _].
    rewrite H3; auto.
Qed.

Lemma mark_partial_labeled_graph_equiv: forall x (g g': Graph),
  mark x g g' ->
  ((predicate_partial_labeledgraph g (Complement _ (reachable g x))) ~=~
  (predicate_partial_labeledgraph g' (Complement _ (reachable g x))))%LabeledGraph.
Proof.
  intros.
  split; [| split].
  + destruct H.
    simpl;
    rewrite <- H0.
    reflexivity.
  + destruct H as [[? ?] _].
    simpl in *; intros.
    specialize (H0 v).
    assert (~ g |= x ~o~> v satisfying (WeakMarkGraph.unmarked g)).
    1: {
      destruct H1.
      intro; apply H3.
      apply reachable_by_is_reachable in H4; auto.
    }
    clear - H0 H3.
    destruct (vlabel g v), (vlabel g' v).
    - auto.
    - rewrite H0; auto.
    - symmetry; tauto.
    - auto.
  + intros; simpl.
    destruct (elabel g e), (elabel g' e); auto.
Qed.

Lemma root_stable_ramify: forall (g: Graph) (x: V) (gx: GV),
  vgamma (Graph_PointwiseGraph g) x = gx ->
  vvalid g x ->
  @derives Pred _
    (reachable_vertices_at x g)
    (vertex_at x gx * (vertex_at x gx -* reachable_vertices_at x g)).
Proof. apply va_reachable_root_stable_ramify. Qed.

Lemma root_update_ramify: forall (g: Graph) (x: V) (lx: bool) (gx gx': GV),
  vvalid g x ->
  vgamma (Graph_PointwiseGraph g) x = gx ->
  vgamma (Graph_PointwiseGraph (labeledgraph_vgen g x lx)) x = gx' ->
  Included (Intersection V (reachable g x) (Complement V (eq x))) (vguard g) ->
  Included (Intersection V (reachable g x) (Complement V (eq x))) (vguard (labeledgraph_vgen g x lx)) ->
  @derives Pred _
    (reachable_vertices_at x g)
    (vertex_at x gx *
      (vertex_at x gx' -* reachable_vertices_at x (labeledgraph_vgen g x lx))).
Proof. apply va_reachable_root_update_ramify. Qed.

(* TODO: remove this lemma? *)
Lemma exp_mark1: forall (g: Graph) (x: V) (lx: bool),
  WeakMarkGraph.label_marked lx ->
  @derives Pred _ (reachable_vertices_at x (labeledgraph_vgen g x lx)) (EX g': Graph, !! (mark1 x g g') && reachable_vertices_at x g').
Proof.
  intros.
  apply (exp_right (labeledgraph_vgen g x lx)).
  apply andp_right; [apply prop_right | auto].
  apply WeakMarkGraph.vertex_update_mark1; auto.
Qed.

Lemma mark_neighbor_ramify: forall {A} (g1: Graph) (g2: A -> Graph) x y,
  (forall (g: Graph) x y, reachable g x y \/ ~ reachable g x y) ->
  vvalid g1 x ->
  step g1 x y ->
  Included (Intersection V (reachable g1 x) (Complement V (reachable g1 y)))
     (vguard g1) ->
  (forall a, mark y g1 (g2 a) -> Included (Intersection V (reachable g1 x) (Complement V (reachable g1 y))) (vguard (g2 a))) ->
  @derives Pred _
    (reachable_vertices_at x g1)
    (reachable_vertices_at y g1 *
      (ALL a: A, !! mark y g1 (g2 a) -->
        (reachable_vertices_at y (g2 a) -*
         reachable_vertices_at x (g2 a)))).
Proof.
  intros.
  assert (Included (reachable g1 y) (reachable g1 x)).
  1: {
    hnf; unfold Ensembles.In; intros.
    apply step_reachable with y; auto.
  }
  apply vertices_at_ramif_xQ. eexists. split; [|split].
  + apply Ensemble_join_Intersection_Complement; auto.
  + intros. destruct H5 as [_ ?].
    rewrite <- H5; clear H5.
    apply Ensemble_join_Intersection_Complement; auto.
  + intros.
    apply GSG_PartialGraphPreserve; auto.
    - unfold Included, Ensembles.In; intros.
      rewrite Intersection_spec in H6; destruct H6 as [? _].
      apply reachable_foot_valid in H6; auto.
    - destruct H5.
      rewrite H6; clear H6.
      unfold Included, Ensembles.In; intros.
      rewrite Intersection_spec in H6; destruct H6 as [? _].
      apply reachable_foot_valid in H6; auto.
    - apply mark_partial_labeled_graph_equiv in H5.
      eapply si_stronger_partial_labeledgraph_simple; [| eassumption].
      unfold Included, Ensembles.In; intros.
      rewrite Intersection_spec in H6.
      tauto.
Qed.

Lemma mark_list_mark_ramify: forall {A} (g1 g2: Graph) (g3: A -> Graph) x l y l',
  (forall (g: Graph) x y, reachable g x y \/ ~ reachable g x y) ->
  vvalid g1 x ->
  step_list g1 x (l ++ y :: l') ->
  relation_list (mark1 x :: mark_list l :: nil) g1 g2 ->
  Included (Intersection V (reachable g2 x) (Complement V (reachable g2 y)))
     (vguard g2) ->
  (forall a, mark y g2 (g3 a) -> Included (Intersection V (reachable g2 x) (Complement V (reachable g2 y))) (vguard (g3 a))) ->
  @derives Pred _
    (reachable_vertices_at x g2)
    (reachable_vertices_at y g2 *
      (ALL a: A, !! mark y g2 (g3 a) -->
        (reachable_vertices_at y (g3 a) -*
         reachable_vertices_at x (g3 a)))).
Proof.
  intros.
  destruct_relation_list g1' in H2.
  destruct H5 as [? _].
  apply (mark_list_eq x) in H2.
  destruct H2 as [_ ?].
  rewrite <- H5 in H2; clear g1' H5.
  apply mark_neighbor_ramify; auto.
  + destruct H2. rewrite <- (H2 x). auto.
  + rewrite <- (step_si g1); auto. hnf in H1. rewrite <- H1.
    rewrite in_app_iff. right. apply in_eq.
Qed.

End PointwiseGraph_Mark.


Require Export decl_inf.
Require Export Coq.Unicode.Utf8.

Notation "G ⊢ e1 <: e2 : A" :=
  (usub G e1 e2 A)
    (at level 65, e1 at level 50, e2 at level 50, no associativity) : type_scope.

Notation "G ⊢ e : A" :=
  (usub G e e A)
    (at level 65, e at level 50, no associativity) : type_scope.

Notation "⊢ G" :=
  (wf_context G)
    (at level 65, no associativity) : type_scope.

Notation "A ⟶ B" := (reduce A B)
  (at level 65, no associativity) : type_scope.

Notation "x :' A ∈ G" := (in_ctx x A G)
  (at level 65, no associativity) : type_scope.

Declare Scope context_scope.
Delimit Scope context_scope with ctx.
Bind Scope context_scope with context.

Notation "G , x : A" :=
  (ctx_cons G x A)
    (at level 58, x at level 0, left associativity) : context_scope.

Reserved Notation "G1 ,, G2"
  (at level 58, left associativity).

Fixpoint ctx_app (Γ1 Γ2 : context) : context :=
  match Γ2 with
  | ctx_nil => Γ1
  | Γ2', x : A => Γ1 ,, Γ2' , x : A
  end%ctx

where "G1 ,, G2" := (ctx_app G1 G2) : context_scope.

Notation "⟦ v /' x ⟧ G" :=
  (subst_context v x G)
    ( at level 56, v at level 50, x at level 0
    , right associativity) : context_scope.

Declare Scope expr_scope.
Delimit Scope expr_scope with expr.
Bind Scope expr_scope with expr.

Notation "` x" := (e_var_f x)
  (at level 0, x at level 0, no associativity) : expr_scope.
Notation "↑ x" := (e_var_b x)
  (at level 0, x at level 0, no associativity) : expr_scope.

Notation "[ v /' x ] e" :=
  (subst_expr v x e)
    ( at level 49, v at level 50, x at level 0
    , right associativity) : expr_scope.

Notation "e ^` x" := (open_expr_wrt_expr e (e_var_f x))
  (at level 48, left associativity) : expr_scope.

Notation "e1 ^^ e2" := (open_expr_wrt_expr e1 e2)
  (at level 48, left associativity) : expr_scope.

Notation "⋆" := (e_kind k_star)
  (at level 0, no associativity) : expr_scope.

Notation "◻" := (e_kind k_box) (at level 0, no associativity) : expr_scope.

Notation "⧼ k ⧽" := (e_kind k)
  (at level 0, no associativity) : expr_scope.

Notation "'λ_' A , e : B" :=
  (e_abs A (b_anno e B))
    (at level 50, A at level 50, e at level 50, no associativity) : expr_scope.

Notation "'Λ' A , e : B" :=
  (e_bind A (b_anno e B))
    (at level 50, A at level 50, e at level 50, no associativity) : expr_scope.

Notation "G ⊢ e1 <: e2 ⇒ A" := (busub G e1 e2 d_infer A)
    (at level 65, e1 at level 50, e2 at level 50, no associativity) : type_scope.

Notation "G ⊢ e ⇒ A" := (busub G e e d_infer A)
    (at level 65, e at level 50, no associativity) : type_scope.

Notation "G ⊢ e1 <: e2 ⇐ A" := (busub G e1 e2 d_check A)
    (at level 65, e1 at level 50, e2 at level 50, no associativity) : type_scope.

Notation "G ⊢ e ⇐ A" := (busub G e e d_check A)
    (at level 65, e at level 50, no associativity) : type_scope.

Notation "G ⊢ A ⋅ e ⇒ B" :=
  (infer_app G A e B)
    ( at level 65, A at level 50, e at level 50
    , no associativity) : type_scope.

Notation "G ⊢ A ⟼ B" := (greduce G A B)
    (at level 65, A at level 50, no associativity) : type_scope.

(* 'varVdash' *)
Notation "⫦ G" := (bwf_context G)
    (at level 65, no associativity) : type_scope.

Open Scope context_scope.
Open Scope expr_scope.

Declare Scope obindd_scope.
Delimit Scope obindd_scope with dob.
Bind Scope obindd_scope with obindd.

Notation "x :? A" :=
  (dob_bind x A) (at level 52, no associativity) : obindd_scope.

Declare Scope dwork_scope.
Delimit Scope dwork_scope with dwork.
Bind Scope dwork_scope with dwork.

Notation "ob ⊢? e1 <: e2 ⇐ B" :=
  (dw_check ob e1 e2 B)
    ( at level 55, e1 at level 50, e2 at level 50
    , no associativity) : dwork_scope.

Notation "ob ⊢? e ⇐ B" :=
  (dw_check ob e e B)
    ( at level 55, e at level 50, no associativity) : dwork_scope.

Notation "e1 <: e2 ⇐ A" :=
  (dw_check dob_none e1 e2 A)
    (at level 55, e2 at level 50, no associativity) : dwork_scope.

Notation "e ⇐ A" :=
  (dw_check dob_none e e A) (at level 55, no associativity) : dwork_scope.

Notation "e1 <: e2 ⇒ wl" :=
  (dw_infer e1 e2 wl)
    (at level 55, e2 at level 50, no associativity) : dwork_scope.

Notation "e ⇒ wl" :=
  (dw_infer e e wl)
    (at level 55, no associativity) : dwork_scope.

Notation "A ⋅ e ⇒ wl" :=
  (dw_infer_app A e wl)
    ( at level 55, e at level 50
    , no associativity) : dwork_scope.

Notation "A ⟼ wl" :=
  (dw_reduce A wl)
    (at level 55, no associativity) : dwork_scope.

(*
Notation "e1 <: e2 ⇐ A" :=
  (dw_check dob_none e1 e2 A)
    (at level 55, e2 at level 50, no associativity) : dwork_scope.
 *)

Notation "A ≲ B" :=
  (dw_compact A B)
    (at level 55, no associativity) : dwork_scope.

Declare Scope dworklist_scope.
Delimit Scope dworklist_scope with dwl.
Bind Scope dworklist_scope with dworklist.

Notation "G ⊨ w" :=
  (dwl_cons G w) (at level 58, left associativity) : dworklist_scope.

Notation "G ,' x : A" :=
  (dwl_bind G x A) (at level 58, x at level 0, left associativity) : dworklist_scope.

Open Scope dworklist_scope.
Open Scope dwork_scope.
Open Scope obindd_scope.


Require Import CSPEC.
Require Import MailboxAPI.
Require Import MailServerAPI.

Module MailboxTmpAbsState <: State.

  Record state_rec := mk_state {
    tmpdir : MailServerState.dir_contents;
    maildir : MailServerState.dir_contents;
    locked : bool;
  }.

  Definition State := state_rec.
  Definition initP (s : State) := locked s = false /\
                              tmpdir s = FMap.empty /\
                              maildir s = FMap.empty.

End MailboxTmpAbsState.
Module MailboxTmpAbsHState := HState MailboxTmpAbsState UserIdx.

Module MailboxTmpAbsAPI <: Layer MailboxOp MailboxTmpAbsState.

  Import MailboxOp.
  Import MailboxTmpAbsState.

  Inductive xstep : forall T, Op T -> nat -> State -> T -> State -> list event -> Prop :=
  | StepDeliverOK : forall m tmp tmp' mbox tid fn lock,
    ~ FMap.In fn mbox ->
    xstep (Deliver m) tid
      (mk_state tmp mbox lock)
      true
      (mk_state tmp' (FMap.add fn m mbox) lock)
      nil
  | StepDeliverErr : forall m tmp tmp' mbox tid lock,
    xstep (Deliver m) tid
      (mk_state tmp mbox lock)
      false
      (mk_state tmp' mbox lock)
      nil
  | StepList : forall tmp mbox tid r lock,
    FMap.is_permutation_key r mbox ->
    xstep List tid
      (mk_state tmp mbox lock)
      r
      (mk_state tmp mbox lock)
      nil
  | StepReadOK : forall fn tmp mbox tid m lock,
    FMap.MapsTo fn m mbox ->
    xstep (Read fn) tid
      (mk_state tmp mbox lock)
      (Some m)
      (mk_state tmp mbox lock)
      nil
  | StepReadNone : forall fn tmp mbox tid lock,
    ~ FMap.In fn mbox ->
    xstep (Read fn) tid
      (mk_state tmp mbox lock)
      None
      (mk_state tmp mbox lock)
      nil
  | StepDelete : forall fn tmp mbox tid lock,
    xstep (Delete fn) tid
      (mk_state tmp mbox lock)
      tt
      (mk_state tmp (FMap.remove fn mbox) lock)
      nil
  | StepLock : forall tmp mbox tid,
    xstep Lock tid
      (mk_state tmp mbox false)
      tt
      (mk_state tmp mbox true)
      nil
  | StepUnlock : forall tmp mbox tid lock,
    xstep Unlock tid
      (mk_state tmp mbox lock)
      tt
      (mk_state tmp mbox false)
      nil

  | StepExt : forall s tid `(extop : _ T) r,
    xstep (Ext extop) tid
      s
      r
      s
      (Event (extop, r) :: nil)
  .

  Definition step := xstep.

  Definition initP := initP.

End MailboxTmpAbsAPI.
Module MailboxTmpAbsHAPI := HLayer MailboxOp MailboxTmpAbsState MailboxTmpAbsAPI UserIdx.


Require Export Nat.
Require Export ch2o.prelude.orders.
Require Export ch2o.prelude.nmap.
Require Export ch2o.prelude.stringmap.
Require Export ch2o.memory.memory_basics.
Require Export ch2o.abstract_c.architectures.
Require Export ch2o.abstract_c.interpreter.
Require Export ch2o.abstract_c.frontend_sound.
Require Export ch2o.core_c.smallstep.
Require Export ch2o.core_c.restricted_smallstep.
Require Export ch2o.core_c.expression_eval_smallstep.
Require Export one_local.

Definition get_right{A B}(v: A + B)(H: match v with inl _ => False | inr _ => True end): B.
destruct v.
elim H.
exact b.
Defined.

Open Local Scope string_scope.

Definition A: architecture := {|
  arch_sizes := architectures.lp64;
  arch_big_endian := false;
  arch_char_signedness := Signed;
  arch_alloc_can_fail := false
|}.
Notation K := (arch_rank A).

Notation M := (error (frontend_state K) string).

Lemma alloc_program_ok: match alloc_program (K:=K) decls empty with inl _ => False | inr _ => True end.
exact I.
Qed.

Definition alloc_program_result: frontend_state K.
eapply snd.
eapply get_right.
apply alloc_program_ok.
Defined.

Compute (stringmap_to_list (env_t (to_env alloc_program_result))).
Compute (stringmap_to_list (env_f (to_env alloc_program_result))).

Definition to_core_c_program: M (env K * funenv K * state K) :=
  _ ← alloc_program decls;
  Δg ← gets to_globals;
  '(_,σs,σ,_) ← error_of_option (Δg !! "main"≫= maybe4 Fun)
    ("function `main` undeclared`");
  guard (σ = sintT%T ∨ σ = uintT%T) with
    ("function `main` should have return type `int`");
  Γ ← gets to_env;
  δ ← gets to_funenv;
  m ← gets to_mem;
  mret (Γ, δ, initial_state m "main" []).

Definition to_core_c_program_result: string + env K * funenv K * state K :=
  error_eval to_core_c_program ∅.

Lemma to_core_c_program_ok: match to_core_c_program_result with inl _ => False | inr _ => True end.
exact I.
Qed.

Definition core_c_program: env K * funenv K * state K := get_right to_core_c_program_result to_core_c_program_ok.

Definition Γ: env K := to_env alloc_program_result.
Definition δ: funenv K := to_funenv alloc_program_result.
Definition m0: mem K := to_mem alloc_program_result.
Definition S0 := initial_state m0 "main" [].

Lemma alloc_program_eq: alloc_program decls empty = mret () alloc_program_result.
reflexivity.
Qed.

Lemma Γ_valid: ✓ Γ.
apply alloc_program_valid with (1:=alloc_program_eq).
Qed.

Lemma δ_valid: ✓{Γ,'{m0}} δ.
apply alloc_program_valid with (1:=alloc_program_eq).
Qed.

Lemma m0_valid: ✓{Γ} m0.
apply alloc_program_valid with (1:=alloc_program_eq).
Qed.

Lemma mem_lock_cmap (Γ: env K) o (m: indexmap (cmap_elem K (pbit K))):
  mem_lock Γ (addr_top o sintT%BT) (CMap m) =
  CMap (alter (cmap_elem_map (ctree_map pbit_lock)) o m).
reflexivity.
Qed.

Lemma zip_with_pbit_unlock_if_list_fmap_pbit_lock (l: list (pbit K)):
  Forall (λ γb, Some Writable ⊆ pbit_kind γb) l ->
  zip_with pbit_unlock_if (pbit_lock <$> l) (replicate (Datatypes.length l) true) = l.
induction l; intros; try reflexivity.
simpl.
unfold fmap in IHl.
rewrite IHl.
- destruct a.
  simpl.
  inversion H; subst.
  destruct tagged_perm.
  + destruct l0; simpl in *.
    * unfold perm_kind in H2.
      elim H2.
    * reflexivity.
  + elim H2.
- inversion H; subst; assumption.
Qed.

Lemma mem_unlock_lock_singleton (Γ: env K) o (m: mem K):
  ✓{Γ} m ->
  '{m} !! o = Some (sintT%T, false) ->
  mem_writable Γ (addr_top o sintT%BT) m ->
  mem_unlock
    (lock_singleton Γ (addr_top o sintT%BT))
    (mem_lock Γ (addr_top o sintT%BT) m) = m.
destruct m as [m].
intros Hvalid. intros.
destruct Hvalid as [Hvalid1 [Hvalid2 Hvalid3]].
simpl in *.
assert (forall (m1: indexmap (cmap_elem K (pbit K))) m2, m1 = m2 -> CMap m1 = CMap m2). { intros; congruence. }
apply H1.
apply map_eq.
intro i.
rewrite lookup_merge.
2:reflexivity.
destruct (decide (i = o)).
- subst.
  rewrite lookup_singleton.
  rewrite lookup_alter.
  destruct H0 as [w [Hw H'w]].
  simpl in *.
  unfold cmap_lookup in Hw.
  simpl in Hw.
  case_eq (m !! o); intros; rewrite H0 in Hw; try discriminate.
  destruct c; try discriminate.
  simpl in Hw.
  injection Hw; clear Hw; intros; subst.
  simpl.
  rewrite lookup_fmap in H.
  rewrite H0 in H.
  simpl in H.
  injection H; clear H; intros; subst.
  destruct w; try discriminate.
  destruct b0; try discriminate.
  destruct i; try discriminate.
  simpl in H.
  injection H; clear H; intros; subst.
  clear H1.
  simpl.
  pose proof H0.
  apply Hvalid3 in H0.
  destruct H0 as [τ [Ho1 [Ho2 [Ho3 Ho4]]]].
  simpl in *.
  unfold typed in Ho1.
  unfold index_typed in Ho1.
  destruct Ho1 as [β Ho1].
  rewrite lookup_fmap in Ho1.
  rewrite H in Ho1.
  simpl in Ho1.
  injection Ho1; clear Ho1; intros; subst.
  simpl in Ho3.
  unfold typed in Ho3.
  unfold ctree_typed in Ho3.
  simpl in Ho3.
  inversion Ho3; subst.
  rewrite fmap_length.
  assert (Datatypes.length l = 32). {
    rewrite H4.
    reflexivity.
  }
  rewrite H0.
  assert (natmap.to_bools 32
              {|
              mapset.mapset_car := natmap.list_to_natmap
                                     [Some (); Some (); Some ();
                                     Some (); Some (); Some ();
                                     Some (); Some (); Some ();
                                     Some (); Some (); Some ();
                                     Some (); Some (); Some ();
                                     Some (); Some (); Some ();
                                     Some (); Some (); Some ();
                                     Some (); Some (); Some ();
                                     Some (); Some (); Some ();
                                     Some (); Some (); Some ();
                                     Some (); Some ()] |} =
    [true; true; true; true; true; true; true; true;
     true; true; true; true; true; true; true; true;
     true; true; true; true; true; true; true; true;
     true; true; true; true; true; true; true; true]).
  reflexivity.
  rewrite H1.
  pose proof (zip_with_pbit_unlock_if_list_fmap_pbit_lock l H'w).
  rewrite H0 in H5.
  simpl in H5.
  rewrite H5.
  reflexivity.
- rewrite lookup_singleton_ne; try congruence.
  rewrite lookup_alter_ne; try congruence.
Qed.

Lemma lockset_union_right_id (Ω: lockset): Ω ∪ ∅ = Ω.
apply lockset_eq.
intros.
solve_elem_of.
Qed.

Lemma cons_snoc0 {A} x (xs: list A): exists y ys, x::xs = (ys ++ [y])%list.
revert x.
induction xs.
- intros.
  exists x.
  exists [].
  reflexivity.
- intros.
  destruct (IHxs a) as [y [ys Hyys]].
  rewrite Hyys.
  exists y.
  exists (x::ys).
  reflexivity.
Qed.

Lemma expr_eval_pure (Γ: env K) ρ e1 m e2 m2 (E: ectx K) ν:
  Γ\ ρ ⊢ₕ e1, m ⇒ e2, m2 ->
  ⟦ subst E e1 ⟧ Γ ρ m = Some ν ->
  m2 = m.
intros.
apply expr_eval_subst in H0.
destruct H0 as [ν' [Hν' _]].
apply symmetry.
apply ehstep_expr_eval_mem with (1:=H) (2:=Hν').
Qed.

Lemma expr_eval_complete_subst (Γ: env K) ρ e1 m e2 m2 (E: ectx K) ν:
  Γ\ ρ ⊢ₕ e1, m ⇒ e2, m2 ->
  ⟦ subst E e1 ⟧ Γ ρ m = Some ν ->
  ⟦ subst E e2 ⟧ Γ ρ m = Some ν.
intros.
pose proof H0.
apply expr_eval_subst in H0.
destruct H0 as [ν' [Hν' _]].
assert (m = m2). {
  apply ehstep_expr_eval_mem with (1:=H) (2:=Hν').
}
subst m2.
assert (⟦ e2 ⟧ Γ ρ m = Some ν'). {
  apply ehstep_expr_eval with (1:=H) (2:=Hν') (3:=Hν').
}
rewrite subst_preserves_expr_eval with (e4:=e2) in H1.
- assumption.
- congruence.
Qed.

Lemma expr_eval_call_None {Γ: env K} {ρ m} {E: ectx K} {f args ν}:
  ⟦ subst E (ECall f args) ⟧ Γ ρ m = Some ν -> False.
intros.
apply expr_eval_subst in H.
destruct H.
destruct H.
simpl in H.
discriminate.
Qed.

Lemma expr_eval_no_locks (Γ: env K) ρ m Ω ν ν':
  ⟦ %#{Ω} ν ⟧ Γ ρ m = Some ν' -> (%#{Ω} ν = %# ν')%E.
intros.
simpl in H.
unfold mguard in H.
unfold option_guard in H.
destruct (lockset_eq_dec Ω ∅); congruence.
Qed.

Lemma assign_pure (Γ: env K) δ ρ S0 S:
  Γ\ δ\ ρ ⊢ₛ S0 ⇒* S ->
  is_undef_state S ->
  forall k el er m νl νr,
  S0 = State k (Expr (el ::= er)) m ->
  ⟦ el ⟧ Γ (rlocals ρ k) m = Some νl ->
  ⟦ er ⟧ Γ (rlocals ρ k) m = Some νr ->
  Γ\ δ\ ρ ⊢ₛ State k (Expr (%# νl ::= %# νr)) m ⇒* S.
induction 1; intros; subst. {
  elim (is_Some_None H).
}
inversion H; clear H; subst.
- (* head reduction *)
  destruct E.
  + (* empty evaluation context *)
    simpl in *.
    subst.
    inversion H8; subst.
    simpl in *.
    unfold mguard in H4.
    unfold option_guard in H4.
    case_eq (lockset_eq_dec Ω2 ∅); intros.
    * rewrite H in H4.
      injection H4; clear H4; intros; subst.
      unfold mguard in H3; unfold option_guard in H3.
      case_eq (lockset_eq_dec Ω1 ∅); intros.
      -- rewrite H2 in H3.
         injection H3; clear H3; intros; subst.
         clear H H2.
         eapply rtc_l.
         ++ eapply rcstep_expr_head with (E:=[]).
            eassumption.
         ++ eassumption.
      -- rewrite H2 in H3; discriminate.
    * rewrite H in H4; discriminate.
  + (* nonempty evaluation context *)
    destruct (cons_snoc0 e E) as [e' [E' H']].
    rewrite H' in *.
    clear H' e E.
    rewrite subst_snoc in H6.
    destruct e'; try discriminate.
    * (* lhs *)
      simpl in H6.
      injection H6; clear H6; intros; subst.
      rewrite subst_snoc in H0.
      rewrite subst_snoc in IHrtc.
      simpl in *.
      assert (m2 = m). {
        apply expr_eval_pure with (1:=H8) (2:=H3).
      }
      subst m2.
      apply expr_eval_complete_subst with (1:=H8) in H3.
      apply IHrtc with (3:=H3) (4:=H4); trivial.
    * (* rhs *)
      simpl in *.
      injection H6; clear H6; intros; subst.
      rewrite subst_snoc in H0.
      rewrite subst_snoc in IHrtc.
      simpl in *.
      assert (m2 = m). {
        apply expr_eval_pure with (1:=H8) (2:=H4).
      }
      subst m2.
      apply expr_eval_complete_subst with (1:=H8) in H4.
      apply IHrtc with (3:=H3) (4:=H4); trivial.
- (* function call *)
  destruct E.
  + (* E = [] *)
    simpl in *.
    discriminate.
  + destruct (cons_snoc0 e0 E) as [e' [E' H']].
    rewrite H' in *.
    clear H' e0 E.
    rewrite subst_snoc in H6.
    destruct e'; try discriminate; simpl in *; injection H6; clear H6; intros; subst.
    * (* lhs *)
      elim (expr_eval_call_None H3).
    * (* rhs *)
      elim (expr_eval_call_None H4).
- (* undef *)
  destruct E.
  * (* E = [] *)
    simpl in *.
    subst.
    eapply rtc_l.
    2: eassumption.
    inversion H8; subst.
    destruct H5.
    destruct H7.
    rewrite expr_eval_no_locks with (1:=H3) in *.
    rewrite expr_eval_no_locks with (1:=H4) in *.
    apply rcstep_expr_undef with (E:=[]).
    -- assumption.
    -- assumption.
  * (* E <> [] *)
    destruct (cons_snoc0 e0 E) as [e' [E' H']].
    rewrite H' in *.
    clear H' e0 E.
    rewrite subst_snoc in H5.
    destruct e'; try discriminate; simpl in *; injection H5; clear H5; intros; subst.
    -- (* lhs *)
       destruct expr_eval_subst_ehstep with (1:=H3) (2:=H8).
       destruct H.
       elim H9.
       eapply ehsafe_step.
       apply H.
    -- (* rhs *)
       destruct expr_eval_subst_ehstep with (1:=H4) (2:=H8).
       destruct H.
       elim H9.
       eapply ehsafe_step.
       apply H.
Qed.

Lemma assign_pure' (Γ: env K) δ ρ S k el er m νl νr:
  Γ\ δ\ ρ ⊢ₛ (State k (Expr (el ::= er)) m) ⇒* S ->
  ⟦ el ⟧ Γ (rlocals ρ k) m = Some νl ->
  ⟦ er ⟧ Γ (rlocals ρ k) m = Some νr ->
  (Γ\ δ\ ρ ⊢ₛ State k (Expr (%# νl ::= %# νr)) m ⇒* S ->
   ¬ is_undef_state S) ->
  ¬ is_undef_state S.
intros.
intro.
apply H2 with (2:=H3).
apply assign_pure with (1:=H) (2:=H3) (4:=H0) (5:=H1).
reflexivity.
Qed.

Lemma Expr_pure (Γ: env K) δ ρ S0 S:
  Γ\ δ\ ρ ⊢ₛ S0 ⇒* S ->
  is_undef_state S ->
  forall k e m ν,
  S0 = State k (Expr e) m ->
  ⟦ e ⟧ Γ (rlocals ρ k) m = Some ν ->
  Γ\ δ\ ρ ⊢ₛ State k (Expr (%# ν)) m ⇒* S.
intro Hrtc.
pose proof Hrtc.
induction H; intros; subst. {
  elim (is_Some_None H).
}
assert (forall Ω ν', e = (%#{Ω} ν')%E -> Γ\ δ\ ρ ⊢ₛ State k (Expr (%# ν)) m ⇒* z). {
  intros.
  subst.
  simpl in H3.
  unfold mguard in H3.
  unfold option_guard in H3.
  destruct (lockset_eq_dec Ω ∅).
  2: discriminate.
  injection H3; clear H3; intros; subst.
  assumption.
}
clear Hrtc.
inversion H; clear H; subst; try (eapply H2; reflexivity); clear H2.
- (* head reduction *)
  assert (m2 = m). {
    apply expr_eval_pure with (1:=H8) (2:=H3).
  }
  subst m2.
  eapply IHrtc; try trivial.
  apply expr_eval_complete_subst with (1:=H8) (2:=H3).
- (* function call *)
  elim (expr_eval_call_None H3).
- elim H9.
  eapply expr_eval_subst_ehsafe; eassumption.
Qed.

Lemma Expr_pure' (Γ: env K) δ ρ S k e m ν:
  Γ\ δ\ ρ ⊢ₛ (State k (Expr e) m) ⇒* S ->
  ⟦ e ⟧ Γ (rlocals ρ k) m = Some ν ->
  (Γ\ δ\ ρ ⊢ₛ State k (Expr (%# ν)) m ⇒* S ->
   ¬ is_undef_state S) ->
  ¬ is_undef_state S.
intros.
intro.
apply H1.
2: assumption.
apply Expr_pure with (1:=H) (2:=H2) (4:=H0).
reflexivity.
Qed.

Lemma call_main_safe: forall S, rtc (cstep Γ δ) (State [] (Call "main" []) ∅) S -> ~ is_undef_state S.
intros.
apply csteps_rcsteps in H.
inv_rcsteps H. {
  inversion 1.
  simpl in H.
  elim (is_Some_None H).
}
inversion H; clear H; subst.
assert (match Some s with None => s | Some s => s end = s). {
  reflexivity.
}
rewrite <- H6 in H.
simpl in H.
subst.
clear H6.
destruct os; simpl in H8; try discriminate; clear H8.
clear H7.
inversion H1; subst; clear H1. {
  inversion 1.
  simpl in H.
  elim (is_Some_None H).
}
simpl in H.
Opaque mem_alloc.
inv_rcstep.
clear H y.
set (m1:=mem_alloc Γ o false perm_full (val_new Γ sintT%BT) ∅).
assert (H: Γ\ δ\ [] ⊢ₛ State [CLocal o sintT%BT; CParams "main" []]
                   (Stmt ↘
                      (var 0 ::= cast{sintT%BT} (# intV{sintT} 3) ;;
                       ret (cast{sintT%BT} (load (var 0)))))
                   m1 ⇒* S -> ¬ is_undef_state S).
2: apply H; assumption.
clear H0; intros.
assert (m1_valid: ✓{Γ} m1). {
  apply mem_alloc_valid' with (τ:=sintT%T).
  - apply Γ_valid.
  - apply cmap_empty_valid'.
  - unfold dom.
    unfold cmap_dom.
    simpl.
    rewrite dom_empty_L.
    apply not_elem_of_empty.
  - apply perm_full_valid.
  - apply perm_full_mapped.
  - rewrite val_new_base. simpl.
    apply VBase_typed.
    constructor.
    + constructor.
    + congruence.
}
assert (typeof_o: '{m1} !! o = Some (sintT%T, false)). {
  unfold m1.
  rewrite mem_alloc_memenv_of with (Δ:=∅) (τ:=sintT%T).
  - rewrite lookup_insert. reflexivity.
  - apply Γ_valid.
  - apply val_new_typed.
    + apply Γ_valid.
    + constructor.
      constructor.
}
assert (a_typed: (Γ, '{m1}) ⊢ addr_top o sintT%BT : sintT%PT). {
  constructor.
  - unfold typed.
    unfold index_typed.
    exists false.
    apply typeof_o.
  - constructor.
    constructor.
  - constructor.
  - reflexivity.
  - constructor.
    simpl.
    lia.
  - apply Nat.divide_0_r.
  - constructor.
}
assert (a_writable: mem_writable Γ (addr_top o sintT%BT) m1). {
  apply mem_alloc_writable_top with (Δ:=∅).
  - apply Γ_valid.
  - rewrite val_new_base. simpl.
    apply VBase_typed.
    constructor.
    + constructor.
    + congruence.
  - rewrite perm_kind_full.
    reflexivity.
}
assert (intV_3_typed: (Γ, '{m1}) ⊢ (intV{sintT} 3 : val K) : (sintT%BT : type K)). {
  apply VBase_typed.
  constructor.
  constructor.
  - unfold int_lower. simpl.
    lia.
  - unfold int_upper. simpl. lia.
}
inv_rcsteps H. {
  inversion 1.
  elim (is_Some_None H).
}
inv_rcstep.
clear y.
inv_rcsteps H1. {
  inversion 1.
  elim (is_Some_None H).
}
inv_rcstep.
clear y.
eapply assign_pure' with (1:=H1); clear H1. {
  simpl.
  reflexivity.
} {
  simpl.
  rewrite option_guard_True.
  2: reflexivity.
  simpl.
  reflexivity.
}
intros.
unfold int_cast in H.
unfold arch_int_env in H.
unfold int_pre_cast in H.
simpl in H.
inversion H; clear H; subst. {
  inversion 1.
  elim (is_Some_None H).
}
inv_rcstep; clear y.
Focus 2. {
  elim H1; clear H0 H1 H2.
  eapply ehsafe_step.
  constructor.
  - assumption.
  - constructor.
    + constructor.
      * unfold int_lower.
        simpl.
        lia.
      * unfold int_upper.
        unfold int_precision.
        simpl.
        lia.
    + reflexivity.
}
Unfocus.
inv_ehstep.
inversion H10; clear H10; subst.
unfold val_cast in *.
simpl in *.
unfold int_cast in *.
simpl in *.
unfold int_pre_cast in *.
simpl in *.
clear H H9.
inv_rcsteps H1. {
  inversion 1.
  elim (is_Some_None H).
}
inv_rcstep.
clear y.
rewrite lockset_union_right_id in H1.
rewrite lockset_union_right_id in H1.
set (m2:=<[addr_top o sintT%BT:=intV{sintT} 3]{Γ}>m1).
assert (Γ\ δ\ [] ⊢ₛ State
                 [CStmt (□ ;; ret (cast{sintT%BT} (load (var 0))));
                 CLocal o sintT%BT; CParams "main" []]
                 (Stmt ↗ (var 0 ::= cast{sintT%BT} (# intV{sintT} 3)))
                 (mem_unlock (lock_singleton Γ (addr_top o sintT%BT))
                    (mem_lock Γ (addr_top o sintT%BT)
                       m2)) ⇒* S).
exact H1.
clear H1.
assert (m2_valid: ✓{Γ} m2). {
  apply mem_insert_valid' with (τ:=sintT%T).
  - apply Γ_valid.
  - apply m1_valid.
  - apply a_typed.
  - apply a_writable.
  - apply intV_3_typed.
}
assert (typeof_o_m2: '{m2} !! o = Some (sintT%T, false)). {
  unfold m2.
  rewrite mem_insert_memenv_of with (Δ:='{m1}) (τ:=sintT%T).
  - apply typeof_o.
  - apply Γ_valid.
  - apply m1_valid.
  - apply a_typed.
  - apply a_writable.
  - apply intV_3_typed.
}
assert (a_writable_m2: mem_writable Γ (addr_top o sintT%BT) m2). {
  unfold m2.
  apply mem_insert_writable with (Δ:='{m1}) (τ2:=sintT%T); try assumption.
  - apply Γ_valid.
  - left; reflexivity.
}
rewrite mem_unlock_lock_singleton in H; try assumption.
inv_rcsteps H. {
  inversion 1.
  elim (is_Some_None H).
}
inv_rcstep.
clear y.
inv_rcsteps H1. {
  inversion 1.
  elim (is_Some_None H).
}
inv_rcstep.
clear y.
eapply Expr_pure' with (1:=H1); clear H1. {
  simpl.
  rewrite option_guard_True.
  + unfold m2.
    simpl.
    rewrite mem_lookup_insert with (Δ:='{m1}) (τ:=sintT%T); try assumption.
    * simpl.
      reflexivity.
    * apply Γ_valid.
    * constructor.
  + apply mem_insert_forced.
}
intros.
unfold int_cast in H.
unfold arch_int_env in H.
unfold int_pre_cast in H.
simpl in H.
inv_rcsteps H. {
  inversion 1.
  elim (is_Some_None H).
}
inv_rcstep.
rewrite mem_unlock_empty in H1.
inv_rcsteps H1. {
  inversion 1.
  elim (is_Some_None H).
}
inv_rcstep.
inv_rcsteps H1. {
  inversion 1.
  elim (is_Some_None H).
}
inv_rcstep.
  inv_rcsteps H1. {
  inversion 1.
  elim (is_Some_None H).
}
inv_rcstep.
inv_rcsteps H1. {
  inversion 1.
  elim (is_Some_None H).
}
inv_rcstep.
Qed.

Goal forall S, rtc (cstep Γ δ) S0 S -> ~ is_undef_state S.
intros.
apply call_main_safe with (1:=H).
Qed.


(** * verif_first_cursor.v: Correctness proof of Trie.first_cursor *)
Require Import VST.floyd.proofauto.
Require Import VST.floyd.library.
Require Import VST.msl.iter_sepcon.
Require Import VST.msl.wand_frame.
Require Import DB.common.
Require Import DB.tactics.
Require Import DB.lemmas.

Require Import DB.functional.bordernode.
Require Import DB.functional.keyslice.

Require Import DB.representation.string.
Require Import DB.representation.key.
Require Import DB.representation.btree.
Require Import DB.representation.trie.

Require Import DB.specs.

Import Coq.Lists.List.ListNotations.

Definition Gprog : funspecs :=
  ltac:(with_library prog [
          UTIL_GetNextKeySlice_spec;
          surely_malloc_spec;
          BN_GetPrefixValue_spec;
          BN_GetSuffixValue_spec;
          BN_TestSuffix_spec;
          BN_GetLink_spec;
          BN_HasSuffix_spec;
          BN_CompareSuffix_spec;
          move_key_spec; new_key_spec; free_key_spec;
          push_cursor_spec; pop_cursor_spec;
          Imake_cursor_spec; Iget_value_spec; Iget_key_spec; Ifree_cursor_spec; Ifirst_cursor_spec;
          bordernode_next_cursor_spec;
          strict_first_cursor_spec
       ]).

Lemma body_strict_first_cursor: semax_body Vprog Gprog f_strict_first_cursor strict_first_cursor_spec.
Proof.
  start_function.
  destruct t as [addr tableform listform].
  unfold Trie.trie_rep; fold Trie.trie_rep.
  inv H.
  Intros.
  forward_call (tableform, addr).
  Intros pnode_cursor.
  forward_call (BTree.first_cursor tableform, pnode_cursor, tableform, addr, v_ret_value, Tsh).
  { split; [apply BTree.first_cursor_abs; assumption | auto ]. }
  forward_if.
  - if_tac in H; simplify.
    unfold BTree.get_value in H0; simplify.
    assert (BTree.get_key (BTree.first_cursor tableform) tableform = Some k) by
        (unfold BTree.get_key; rewrite H1; reflexivity).
    assert (BTree.key_rel k (BTree.first_cursor tableform) tableform). {
      apply BTree.get_key_rel.
      - apply BTree.first_cursor_abs.
        assumption.
      - assumption.
    }
    rename v into pbnode.
    assert (exists bnode, BTree.Flattened.get (BTree.Flattened.first_cursor listform) listform = Some (k, (pbnode, bnode))). {
      admit.
    }
    destruct H10 as [bnode ?].
    assert (In (k, (pbnode, bnode)) listform) by (eapply BTree.Flattened.get_in_weak; eauto).
    rewrite iter_in_wand with (a := (k, (pbnode, bnode))) by assumption.
    Intros.
    change ((Trie.bordernode_rep oo snd) (k, (pbnode, bnode))) with
        (Trie.bnode_rep (pbnode, bnode)).
    assert (Trie.bordernode_correct bnode). {
        rewrite Forall_forall in H7.
        apply H7 in H11.
        simpl in H11.
        assumption.
      }
    forward.
    forward.
    forward_call (bnode, pbnode, BorderNode.before_prefix 1).
    {
      simpl.
      rep_lia.
    }
    assert (1 <= (BorderNode.cursor_to_int (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode)) <= Int.max_unsigned). {
      pose proof (BorderNode.next_cursor_bnode_correct (BorderNode.before_prefix 1)
                                                       bnode
                                                       ltac:(simpl; rep_lia)).
      unfold BorderNode.cursor_correct in H13.
      destruct (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode); simpl; rep_lia.
    }
    forward_if.
    + Trie.make_cursor_slice addr tableform listform
                             bnode
                             (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode)
                             (vint (BorderNode.cursor_to_int (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode))).
      forward_call ((Trie.trienode_of addr tableform listform,
                     (BTree.first_cursor tableform),
                     bnode,
                     (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode)),
                    addr,
                    pnode_cursor,
                    (vint (BorderNode.cursor_to_int (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode))),
                    c, pc).
      match goal with
      | |- context rest[ ?P -* ?Q] =>
          sep_apply (wand_frame_elim P Q)
      end.
      forward.
      rewrite Trie.strict_first_cursor_equation.
      unfold BTree.Flattened.get_value.
      rewrite H10.
      match_tac; simplify; simpl in H14; try rep_lia.
      2: {
        apply BorderNode.next_cursor_prefix_correct in H20.
        congruence.
      }
      entailer!.
    + forward_if.
      * assert (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode = BorderNode.before_suffix). {
          destruct (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode) eqn:Heqn'.
          - simpl in *.
            change (Int.add (Int.repr 4) (Int.repr 1)) with (Int.repr 5) in H15.
            apply repr_inj_unsigned in H15; try rep_lia.
            subst.
            pose proof (BorderNode.next_cursor_bnode_correct (BorderNode.before_prefix 1)
                                                       bnode
                                                       ltac:(simpl; rep_lia)).
            rewrite Heqn' in H15.
            simpl in H15.
            rep_lia.
          - reflexivity.
          - change (Int.add (Int.repr 4) (Int.repr 1)) with (Int.repr 5) in H15.
            simpl in H15.
            apply repr_inj_unsigned in H15; rep_lia.
        }
        Trie.make_cursor_slice addr tableform listform
                               bnode
                               (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode)
                               (vint (BorderNode.cursor_to_int (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode))).
        forward_call ((Trie.trienode_of addr tableform listform,
                       (BTree.first_cursor tableform),
                       bnode,
                       (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode)),
                      addr,
                      pnode_cursor,
                      (vint (BorderNode.cursor_to_int (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode))),
                      c, pc).
        forward_call (bnode, pbnode).
        forward_if.
        -- match goal with
           | |- context rest[ ?P -* ?Q] =>
             sep_apply (wand_frame_elim P Q)
           end.
           forward.
           apply repr_inj_unsigned in H15; [ | rep_lia | rep_lia ].
           rewrite Trie.strict_first_cursor_equation.
           unfold BTree.Flattened.get_value.
           destruct bnode as [? [[ | ] | ]]; if_tac in H17; simplify.
           unfold BorderNode.get_suffix_pair in H22; simpl in H22; simplify.
           rewrite H10.
           rewrite H16.
           simpl.
           entailer!.
        -- forward_call (bnode, pbnode, v_subindex, Tsh).
           change (Int.add (Int.repr 4) (Int.repr 1)) with (Int.repr 5) in H15.
           apply repr_inj_unsigned in H15; [ | rep_lia | rep_lia ].
           if_tac in H17; simplify.
           deadvars.
           match_tac; simpl Trie.bnode_rep at 1.
           ++ destruct bnode as [? [ [|] | ]]; simplify.
              Intros.
              unfold BorderNode.get_link in H20; simplify.
              forward.
              forward_call (c ++
                              [(Trie.trienode_of addr tableform listform, BTree.first_cursor tableform, (l, Some (inr t)),
                                BorderNode.next_cursor (BorderNode.before_prefix 1) (l, Some (inr t)))],
                            pc,
                            t).
              { inv H12; simplify. }
              forward_if.
              ** forward.
                 if_tac in H20; simplify.
                 rewrite Trie.strict_first_cursor_equation.
                 unfold BTree.Flattened.get_value.
                 rewrite H10.
                 rewrite H16.
                 simpl.
                 match_tac; simplify.
                 match goal with
                 | |- context rest[ ?P -* ?Q] =>
                   sep_apply (wand_frame_elim P Q)
                 end.
                 entailer!.
                 rewrite <- app_assoc.
                 rewrite <- semax_lemmas.cons_app.
                 apply derives_refl.
              ** if_tac in H20; simplify.
                 rewrite app_nil_r.
                 forward_call ((c ++
                                  [(Trie.trienode_of addr tableform listform, BTree.first_cursor tableform, (l, Some (inr t)),
                                    BorderNode.next_cursor (BorderNode.before_prefix 1) (l, Some (inr t)))]),
                               pc).
                 rewrite removelast_app by congruence.
                 simpl removelast.
                 rewrite app_nil_r.
                 forward.
                 rewrite Trie.strict_first_cursor_equation.
                 unfold BTree.Flattened.get_value.
                 rewrite H10.
                 rewrite H16.
                 simpl.
                 match_tac; simplify.
                 match goal with
                 | |- context rest[ ?P -* ?Q] =>
                   sep_apply (wand_frame_elim P Q)
                 end.
                 entailer!.
                 rewrite app_nil_r.
                 apply derives_refl.
           ++ apply BorderNode.next_cursor_suffix_correct in H16.
              destruct bnode; unfold BorderNode.get_link in H20; simpl in H16; simplify.
      * change (Int.add (Int.repr 4) (Int.repr 1)) with (Int.repr 5) in H15.
        apply repr_neq_e in H15.
        forward_call (BTree.first_cursor tableform, pnode_cursor).
        match goal with
        | |- context rest[ ?P -* ?Q] =>
          sep_apply (wand_frame_elim P Q)
        end.
        forward.
        rewrite Trie.strict_first_cursor_equation.
        unfold BTree.Flattened.get_value.
        rewrite H10.
        assert (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode = BorderNode.after_suffix). {
          assert (BorderNode.cursor_correct (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode)). {
            apply BorderNode.next_cursor_bnode_correct.
            simpl.
            rep_lia.
          }
          destruct (BorderNode.next_cursor (BorderNode.before_prefix 1) bnode) eqn:Heqn.
          - simpl in *.
            rep_lia.
          - simpl in *.
            rep_lia.
          - reflexivity.
        }
        rewrite H19.
        entailer!.
        rewrite app_nil_r.
        cancel.
  - forward_call (BTree.first_cursor tableform, pnode_cursor).
    forward.
    if_tac in H; simplify.
    unfold BTree.get_value in H11; match_tac in H11; simplify.
    pose proof H12.
    apply BTree.first_cursor_get_empty in H12; [ | assumption].
    apply BTreeFacts.empty_flatten_empty in H12.
    rewrite H12 in *.
    destruct listform; simpl in H5; simplify.
Admitted.


From stdpp Require Import prelude finite.
From Coq Require Import FunctionalExtensionality Reals.
From VLSM.Lib Require Import Preamble FinSetExtras ListFinSetExtras.
From VLSM.Lib Require Import Measurable RealsExtras.
From VLSM.Core Require Import VLSM MessageDependencies VLSMProjections Composition ProjectionTraces.
From VLSM.Core Require Import SubProjectionTraces AnnotatedVLSM Equivocation.
From VLSM.Core Require Import ByzantineTraces.FixedSetByzantineTraces.
From VLSM.Core Require Import Equivocation.FixedSetEquivocation.
From VLSM.Core Require Import Equivocation.LimitedMessageEquivocation.
From VLSM.Core Require Import Equivocation.MsgDepLimitedEquivocation.
From VLSM.Core Require Import Equivocation.TraceWiseEquivocation.

(** * VLSM Compositions with Byzantine nodes of limited weight

  In this module we define and study protocol executions allowing a
  (weight-)limited amount of byzantine faults.

  We will show that, if the non-byzantine nodes are validators for a
  composition constraint allowing only a limited amount of equivocation, then
  they do not distinguish between byzantine nodes and equivocating ones, that is,
  projections of traces with byzantine faults to the non-byzantine nodes are
  projections of traces of the composition of the regular nodes under a
  composition constraint allowing only a limited amount of equivocation.
*)

Section sec_limited_byzantine_traces.

Context
  {message : Type}
  `{FinSet index Ci}
  `{!finite.Finite index}
  (IM : index -> VLSM message)
  `{forall i : index, HasBeenSentCapability (IM i)}
  `{forall i : index, HasBeenReceivedCapability (IM i)}
  (threshold : R)
  `{ReachableThreshold validator Cv threshold}
  `{!finite.Finite validator}
  (A : validator -> index)
  `{!Inj (=) (=) A}
  (sender : message -> option validator)
  .

(**
  We define the [limited_byzantine_trace_prop]erty in two steps. First, we
  leverage the [fixed_byzantine_trace_alt_prop]erty by assuming a fixed selection
  of <<byzantine>> nodes whose added weight is below the [ReachableThreshold].
*)
Definition fixed_limited_byzantine_trace_prop
  (s : composite_state IM)
  (tr : list (composite_transition_item IM))
  (byzantine_vs : Cv)
  (byzantine := fin_sets.set_map A byzantine_vs : Ci)
  : Prop
  := (sum_weights byzantine_vs <= threshold)%R /\
     fixed_byzantine_trace_alt_prop (Ci := Ci) IM byzantine A sender s tr.

(**
  The union of traces with the [fixed_limited_byzantine_trace_prop]erty over
  all possible selections of (limited) byzantine nodes.
*)
Definition limited_byzantine_trace_prop
  (s : composite_state IM)
  (tr : list (composite_transition_item IM))
  : Prop :=
  exists byzantine, fixed_limited_byzantine_trace_prop s tr byzantine.

Context
  `{FinSet message Cm}
  {is_equivocating_tracewise_no_has_been_sent_dec :
    RelDecision (is_equivocating_tracewise_no_has_been_sent IM A sender)}
  (limited_constraint := tracewise_limited_equivocation_constraint (Cv := Cv) IM threshold A sender)
  (Limited : VLSM message := composite_vlsm IM limited_constraint)
  (Hvalidator : forall i : index, component_message_validator_prop IM limited_constraint i)
  (no_initial_messages_in_IM : no_initial_messages_in_IM_prop IM)
  (can_emit_signed : channel_authentication_prop IM A sender)
  (message_dependencies : message -> Cm)
  `{!Irreflexive (msg_dep_happens_before message_dependencies)}
  `{forall i, MessageDependencies (IM i) message_dependencies}
  (Hfull : forall i, message_dependencies_full_node_condition_prop (IM i) message_dependencies)
  .

(** ** Assuming the byzantine nodes are known

  We will first fix a selection of <<byzantine>> nodes of limited weight and
  analyze traces with the [fixed_limited_byzantine_trace_prop]erty w.r.t. that
  selection.
*)

Section sec_fixed_limited_selection.

Context
  (byzantine_vs : Cv)
  (byzantine : Ci := fin_sets.set_map A byzantine_vs )
  (non_byzantine : Ci := difference (list_to_set (enum index)) byzantine)
  (Hlimit : (sum_weights byzantine_vs <= threshold)%R)
  (PreNonByzantine := pre_loaded_fixed_non_byzantine_vlsm IM byzantine A sender)
  (Htracewise_BasicEquivocation : BasicEquivocation (composite_state IM) validator Cv threshold
    := equivocation_dec_tracewise IM threshold A sender)
  (tracewise_not_heavy := not_heavy (1 := Htracewise_BasicEquivocation))
  (tracewise_equivocating_validators := equivocating_validators (1 := Htracewise_BasicEquivocation))
  .

(**
  When replacing the byzantine components of a composite [valid_state] with
  initial states for those machines we obtain a state which is [not_heavy].
*)
Lemma limited_PreNonByzantine_valid_state_lift_not_heavy s
  (Hs : valid_state_prop PreNonByzantine s)
  (sX := lift_sub_state IM (elements non_byzantine) s)
  : tracewise_not_heavy sX.
Proof.
  cut (tracewise_equivocating_validators sX ⊆ byzantine_vs).
  {
    intro Hincl.
    unfold tracewise_not_heavy, not_heavy.
    transitivity (sum_weights byzantine_vs); [| done].
    apply sum_weights_subseteq_list.
    - by apply NoDup_elements.
    - by apply NoDup_elements.
    - intros i Hi.
      by apply elem_of_elements, Hincl, elem_of_elements, Hi.
  }
  apply valid_state_has_trace in Hs as [is [tr Htr]].
  specialize (preloaded_non_byzantine_vlsm_lift IM byzantine A sender)
    as Hproj.
  apply (VLSM_embedding_finite_valid_trace_init_to Hproj) in Htr as Hpre_tr.
  intros v Hv.
  apply equivocating_validators_is_equivocating_tracewise_iff in Hv as Hvs'.
  specialize (Hvs' _ _ Hpre_tr).
  destruct Hvs' as [m0 [Hsender0 [preX [itemX [sufX [Htr_pr [Hm0 Heqv]]]]]]].
  apply map_eq_app in Htr_pr as [pre [item_suf [Heqtr [Hpre_pr Hitem_suf_pr]]]].
  apply map_eq_cons in Hitem_suf_pr as [item [suf [Heqitem_suf [Hitem_pr Hsuf_pr]]]].
  subst tr item_suf. clear Hsuf_pr.
  subst itemX. cbn in Hm0.
  change (pre ++ item :: suf) with (pre ++ [item] ++ suf) in Htr.
  destruct Htr as [Htr Hinit].
  apply (finite_valid_trace_from_to_app_split PreNonByzantine) in Htr.
  destruct Htr as [Hpre Hitem].
  apply (VLSM_embedding_finite_valid_trace_from_to Hproj) in Hpre as Hpre_pre.
  apply valid_trace_last_pstate in Hpre_pre as Hs_pre.
  apply (finite_valid_trace_from_to_app_split PreNonByzantine), proj1 in Hitem.
  inversion Hitem; subst; clear Htl Hitem. simpl in Hm0. subst.
  destruct Ht as [[_ [_ [_ [Hc _]]]] _].
  destruct Hc as [[sub_i Hsenti] | Hemit].
  - destruct_dec_sig sub_i i Hi Heqsub_i; subst sub_i.
    assert (Hsent : composite_has_been_sent IM
                      (lift_sub_state IM (elements non_byzantine) (finite_trace_last is pre)) m0).
    {
      exists i.
      unfold lift_sub_state.
      by rewrite (lift_sub_state_to_eq _ _ _ _ _ Hi).
    }
    apply (composite_proper_sent IM) in Hsent; [| done].
    apply (VLSM_embedding_initial_state Hproj) in Hinit.
    by specialize (Hsent _ _ (conj Hpre_pre Hinit)).
  - specialize (proj1 Hemit) as [i [Hi Hsigned]].
    subst.
    destruct (decide (i ∈ byzantine)).
    + unfold channel_authenticated_message in Hsigned.
      rewrite Hsender0 in Hsigned.
      apply Some_inj in Hsigned; subst.
      by revert e; apply elem_of_set_map_inj.
    + rewrite elem_of_elements in Hi.
      contradict Hi.
      apply elem_of_difference; split; [| done].
      by apply elem_of_list_to_set, elem_of_enum.
Qed.

Existing Instance Htracewise_BasicEquivocation.

(**
  When replacing the byzantine components of a composite [valid_state] with
  initial states for those machines validity of transitions for the non-byzantine
  components is preserved.
*)
Lemma limited_PreNonByzantine_lift_valid
  : weak_embedding_valid_preservation PreNonByzantine Limited
    (lift_sub_label IM (elements non_byzantine))
    (lift_sub_state IM (elements non_byzantine)).
Proof.
  intros l s om Hv HsY HomY.
  repeat split; [by apply lift_sub_valid, Hv |].
  hnf.
  destruct (composite_transition (sub_IM IM (elements non_byzantine)) l (s, om))
    as [s' om'] eqn: Ht.
  apply (lift_sub_transition IM (elements non_byzantine)) in Ht as HtX.
  simpl in HtX |- *; rewrite HtX; simpl.
  change (is_equivocating_tracewise_no_has_been_sent _ _ _) with is_equivocating.
  by eapply tracewise_not_heavy_LimitedEquivocationProp_iff,
    limited_PreNonByzantine_valid_state_lift_not_heavy,
    input_valid_transition_destination.
Qed.

(**
  By replacing the byzantine components of a composite [valid_state] with
  initial states for those machines and ignoring transitions for byzantine nodes
  we obtain valid traces for the <<Limited>> equivocation composition.
*)
Lemma limited_PreNonByzantine_vlsm_lift
  : VLSM_embedding PreNonByzantine Limited
      (lift_sub_label IM (elements non_byzantine))
      (lift_sub_state IM (elements non_byzantine)).
Proof.
  apply basic_VLSM_embedding; intros ? *.
  - by intros; apply limited_PreNonByzantine_lift_valid.
  - by intros * []; rapply lift_sub_transition.
  - by intros; apply (lift_sub_state_initial IM).
  - intros Hv HsY [[sub_i [[im Him] Heqm]] | Hseeded].
    + cbn in Heqm; subst.
      destruct_dec_sig sub_i i Hi Heqsub_i; subst.
      unfold sub_IM in Him; cbn in Him; clear -Him.
      apply initial_message_is_valid.
      by exists i, (exist _ m Him).
    + destruct Hseeded as (Hsigned & i & Hi & li & si & Hpre_valid).
      by eapply Hvalidator.
Qed.

End sec_fixed_limited_selection.

(**
  Given a trace with the [fixed_limited_byzantine_trace_prop]erty for a selection
  of <<byzantine>> nodes, there exists a valid trace for the <<Limited>>
  equivocation composition such that the projection of the two traces to
  the <<non-byzantine>> nodes coincide.
*)
Lemma validator_fixed_limited_non_byzantine_traces_are_limited_non_equivocating s tr byzantine_vs
  (byzantine : Ci := fin_sets.set_map A byzantine_vs)
  (not_byzantine : Ci := difference (list_to_set (enum index)) byzantine)
  : fixed_limited_byzantine_trace_prop s tr byzantine_vs ->
    exists bs btr,
      finite_valid_trace Limited bs btr /\
      composite_state_sub_projection IM (elements not_byzantine) s =
      composite_state_sub_projection IM (elements not_byzantine) bs /\
      finite_trace_sub_projection IM (elements not_byzantine) tr =
      finite_trace_sub_projection IM (elements not_byzantine) btr.
Proof.
  intros [Hlimit Hfixed].
  eexists _, _; split.
  - by apply (VLSM_embedding_finite_valid_trace
            (limited_PreNonByzantine_vlsm_lift byzantine_vs Hlimit)).
  - unfold lift_sub_state.
    rewrite composite_state_sub_projection_lift_to.
    split; [done |].
    by symmetry; apply composite_trace_sub_projection_lift.
Qed.

(** ** The main result

  Given any trace with the [limited_byzantine_trace_prop]erty, there exists
  a valid trace for the <<Limited>> equivocation composition and
  a selection of nodes of limited weight such that the projection of the
  two traces to the nodes not in the selection coincide.
*)
Lemma validator_limited_non_byzantine_traces_are_limited_non_equivocating s tr
  : limited_byzantine_trace_prop s tr ->
    exists bs btr,
      finite_valid_trace Limited bs btr /\
      exists (selection_vs : Cv)
        (selection : Ci := fin_sets.set_map A selection_vs)
        (selection_complement := difference (list_to_set (enum index)) selection),
        (sum_weights selection_vs <= threshold)%R /\
        composite_state_sub_projection IM (elements selection_complement) s =
        composite_state_sub_projection IM (elements selection_complement) bs /\
        finite_trace_sub_projection IM (elements selection_complement) tr =
        finite_trace_sub_projection IM (elements selection_complement) btr.
Proof.
  intros [byzantine Hlimited].
  apply proj1 in Hlimited as Hlimit.
  apply validator_fixed_limited_non_byzantine_traces_are_limited_non_equivocating
    in Hlimited
    as [bs [btr [Hlimited [Hs_pr Htr_pr]]]].
  by exists bs, btr; eauto.
Qed.

End sec_limited_byzantine_traces.

Section sec_msg_dep_limited_byzantine_traces.

Context
  {message : Type}
  `{FinSet index Ci}
  `{!finite.Finite index}
  (IM : index -> VLSM message)
  `{forall i, HasBeenSentCapability (IM i)}
  `{forall i, HasBeenReceivedCapability (IM i)}
  (threshold : R)
  `{ReachableThreshold validator Cv threshold}
  `{!finite.Finite validator}
  `{FinSet message Cm}
  (message_dependencies : message -> Cm)
  (full_message_dependencies : message -> Cm)
  `{!FullMessageDependencies message_dependencies full_message_dependencies}
  `{forall i, MessageDependencies (IM i) message_dependencies}
  (sender : message -> option validator)
  (A : validator -> index)
  `{!Inj (=) (=) A}
  (Limited := msg_dep_limited_equivocation_vlsm (Cv := Cv)
    IM threshold full_message_dependencies sender)
  (no_initial_messages_in_IM : no_initial_messages_in_IM_prop IM)
  (Hchannel : channel_authentication_prop IM A sender)
  (Hsender_safety : sender_safety_alt_prop IM A sender :=
    channel_authentication_sender_safety _ _ _ Hchannel)
  (Hvalidator :
    forall i : index,
      msg_dep_limited_equivocation_message_validator_prop (Cv := Cv)
        IM threshold full_message_dependencies sender i)
  (Hfull : forall i, message_dependencies_full_node_condition_prop (IM i) message_dependencies)
  .

(**
  If the set of byzantine nodes is weight-limited and if an [input_valid_transition]
  of the non-byzantine nodes from a state of weight-limited equivocation does not
  introduce equivocators from the non-byzantine nodes, then the transition is valid
  for weight-limited equivocation.
*)
Lemma lift_pre_loaded_fixed_non_byzantine_valid_transition_to_limited
  (byzantine_vs : Cv)
  (byzantine : Ci := fin_sets.set_map A byzantine_vs)
  (non_byzantine := difference (list_to_set (enum index)) byzantine)
  (Hlimited : (sum_weights byzantine_vs <= threshold)%R)
  sub_l sub_s iom sub_sf oom
  (Ht_sub : input_valid_transition
      (pre_loaded_fixed_non_byzantine_vlsm IM byzantine A sender)
      sub_l (sub_s, iom) (sub_sf, oom))
  ann_s
  (Hann_s : valid_state_prop Limited ann_s)
  (Hann_s_pr : original_state ann_s = lift_sub_state IM (elements non_byzantine) sub_s)
  (ann' := msg_dep_composite_transition_message_equivocators IM full_message_dependencies sender
      (lift_sub_label IM (elements non_byzantine) sub_l) (ann_s, iom))
  (Heqv_byzantine : ann' ⊆ byzantine_vs)
  : input_valid_transition Limited
      (lift_sub_label IM (elements non_byzantine) sub_l) (ann_s, iom)
      (Build_annotated_state (free_composite_vlsm IM) Cv
        (lift_sub_state IM (elements non_byzantine) sub_sf) ann',
      oom).
Proof.
  destruct sub_l as [sub_i li]; destruct_dec_sig sub_i i Hi Heqsub_i; subst.
  repeat split; cbn.
  - done.
  - destruct iom as [im |]; [| apply option_valid_message_None].
    by eapply Hvalidator, pre_loaded_sub_composite_input_valid_projection, Ht_sub.
  - unfold lift_sub_state in Hann_s_pr.
    rewrite Hann_s_pr, (lift_sub_state_to_eq _ _ _ _ _ Hi).
    by apply Ht_sub.
  - apply Rle_trans with (sum_weights byzantine_vs)
    ; [| done].
    apply sum_weights_subseteq.
    by intro; apply Heqv_byzantine.
  - clear -Ht_sub Hann_s_pr.
    destruct Ht_sub as [_ Ht_sub]; revert Ht_sub
    ; unfold annotated_transition; cbn
    ; rewrite Hann_s_pr; unfold lift_sub_state at 1
    ; rewrite (lift_sub_state_to_eq _ _ _ _ _ Hi)
    ; unfold sub_IM at 2; cbn
    ; destruct (vtransition _ _ _) as (si', om')
    ; inversion_clear 1.
    do 2 f_equal; extensionality j.
    unfold lift_sub_state.
    destruct (decide (i = j)); subst; state_update_simpl.
    + by rewrite (lift_sub_state_to_eq _ _ _ _ _ Hi), !state_update_eq.
    + unfold lift_sub_state_to.
      by case_decide; [rewrite sub_IM_state_update_neq |].
Qed.

(**
  Considering a trace with the [fixed_byzantine_trace_alt_prop]erty for a
  set <<byzantine>> of indices of bounded weight, its subtrace corresponding to
  the non-byzantine nodes is of limited equivocation and its set of equivocators
  is included in <<byzantine>>.
*)
Lemma lift_fixed_byzantine_traces_to_limited
  (s : composite_state IM)
  (tr : list (composite_transition_item IM))
  (byzantine_vs : Cv)
  (byzantine : Ci := fin_sets.set_map A byzantine_vs)
  (non_byzantine := difference (list_to_set (enum index)) byzantine)
  (Hlimited : (sum_weights byzantine_vs <= threshold)%R)
  (Hbyzantine :
    fixed_byzantine_trace_alt_prop IM byzantine A sender s tr)
  (s_reset_byzantine :=
    lift_sub_state IM (elements non_byzantine)
      (composite_state_sub_projection IM (elements non_byzantine) s))
  (bs := Build_annotated_state (free_composite_vlsm IM) Cv s_reset_byzantine (` inhabitant))
  (btr :=
    msg_dep_annotate_trace_with_equivocators (Cv := Cv) IM full_message_dependencies sender
      s_reset_byzantine
      (pre_VLSM_embedding_finite_trace_project _ _
        (lift_sub_label IM (elements non_byzantine)) (lift_sub_state IM (elements non_byzantine))
        (finite_trace_sub_projection IM (elements non_byzantine) tr)))
  : finite_valid_trace Limited bs btr /\
    state_annotation (@finite_trace_last _ (type Limited) bs btr) ⊆ byzantine_vs.
Proof.
  subst non_byzantine.
  induction Hbyzantine using finite_valid_trace_rev_ind; [repeat split |].
  - constructor; apply initial_state_is_valid.
    by repeat split; cbn; apply lift_sub_state_initial.
  - by cbn; apply lift_sub_state_initial.
  - by apply empty_subseteq.
  - subst s_reset_byzantine bs btr.
    unfold pre_VLSM_embedding_finite_trace_project; rewrite !map_app.
    rewrite @msg_dep_annotate_trace_with_equivocators_app; cbn.
    unfold annotate_trace_item; cbn; rewrite finite_trace_last_is_last; cbn.
    destruct l as [sub_i li]; destruct_dec_sig sub_i i Hi Heqsub_i; subst sub_i
    ; destruct IHHbyzantine as [[Htr0_ann Hsi_ann] Htr0_eqv_byzantine]
    ; cbn in Htr0_eqv_byzantine |- *.
    remember (@finite_trace_last _ (annotated_type (free_composite_vlsm IM) _) _ _)
     as lst in Htr0_eqv_byzantine at 1 |- * at 1 2 3 4 5 6.
    assert (Hlsti : original_state lst = lift_sub_state IM (elements (list_to_set (enum index) ∖ byzantine))
                                          (finite_trace_last si tr0)).
    {
      subst lst; rewrite msg_dep_annotate_trace_with_equivocators_last_original_state; symmetry.
      apply (pre_VLSM_embedding_finite_trace_last _ _
              (lift_sub_label IM _)
              (lift_sub_state IM _)).
    }
    match goal with
    |- _ /\ ?B => cut B
    end.
    {
      intro Heqv_byzantine.
      do 2 (split; [| done]).
      apply finite_valid_trace_from_app_iff; split; [done |].
      subst x; cbn; apply finite_valid_trace_singleton.
      replace (finite_trace_last _ _) with lst.
      by eapply lift_pre_loaded_fixed_non_byzantine_valid_transition_to_limited;
        [| | subst lst; apply finite_valid_trace_last_pstate | |].
    }
    destruct iom as [im |]; [| done].
    apply set_union_subseteq_iff; split; [done |].
    unfold coeqv_message_equivocators
    ; case_decide as Hnobs; [by apply empty_subseteq |].
    rewrite (full_node_msg_dep_coequivocating_senders _ _ _ _ Hfull _ _ i li);
      [| by cbn; rewrite Hlsti; eapply @pre_loaded_sub_composite_input_valid_projection, Hx].
    rewrite elements_empty, app_nil_r; cbn.
    intro _i_im; rewrite elem_of_list_to_set.
    destruct (sender im) as [i_im |] eqn: Hsender; [| by inversion 1].
    rewrite elem_of_list_singleton; intro; subst _i_im.
    destruct Hx as [(_ & _ & _ & [Hsent | [Hsigned _]] & _) _].
    + contradict Hnobs.
      destruct Hsent as [sub_i_im Hsent]; cbn in Hsent |- *
      ; destruct_dec_sig sub_i_im _i_im H_i_im Heqsub_i_im; subst sub_i_im.
      apply composite_has_been_directly_observed_sent_received_iff; left.
      exists _i_im.
      rewrite Hlsti; cbn; unfold lift_sub_state.
      by rewrite (lift_sub_state_to_eq _ _ _ _ _ H_i_im).
    + destruct Hsigned as (_i_im & H_i_im & Hauth).
      unfold channel_authenticated_message in Hauth
      ; rewrite Hsender in Hauth.
      apply Some_inj in Hauth; subst _i_im.
      destruct (decide (i_im ∈ byzantine_vs)) as [Hi_im | Hni_im]; [done |].
      contradict H_i_im.
      apply elem_of_elements, elem_of_difference; cbn.
      split; [by apply elem_of_list_to_set, elem_of_enum |].
      by contradict Hni_im; revert Hni_im; apply elem_of_set_map_inj.
Qed.

(**
  Under full-message dependencies and full node assumptions, if all components are
  validators for the [msg_dep_limited_equivocation_vlsm] associated to their
  composition, then the traces exposed limited Byzantine behavior coincide with
  the traces exposed to limited equivocation.
*)
Lemma msg_dep_validator_limited_non_equivocating_byzantine_traces_are_limited_non_equivocating s tr
  : limited_byzantine_trace_prop (Ci := Ci) (Cv := Cv) IM threshold A sender s tr <->
    exists bs btr selection_vs
      (selection : Ci := fin_sets.set_map A selection_vs)
      (selection_complement := difference (list_to_set (enum index)) selection),
      finite_valid_trace Limited bs btr /\
      state_annotation (finite_trace_last bs btr) ⊆ selection_vs /\
      (sum_weights selection_vs <= threshold)%R /\
      composite_state_sub_projection IM (elements selection_complement) s =
        composite_state_sub_projection IM (elements selection_complement) (original_state bs) /\
      finite_trace_sub_projection IM (elements selection_complement) tr =
        finite_trace_sub_projection IM (elements selection_complement)
          (pre_VLSM_embedding_finite_trace_project
            (type Limited) (composite_type IM) Datatypes.id original_state btr).
Proof.
  split.
  - intros (byzantine & Hlimited & Hbyzantine).
    apply lift_fixed_byzantine_traces_to_limited in Hbyzantine
       as [Hbtr Heqv_byzantine] ; [| done].
    eexists _, _, byzantine; do 3 (split; [done |]); split.
    + extensionality sub_i; destruct_dec_sig sub_i i Hi Heqsub_i; subst; cbn.
      unfold lift_sub_state.
      by rewrite (lift_sub_state_to_eq _ _ _ _ _ Hi).
    + subst Limited.
      rewrite msg_dep_annotate_trace_with_equivocators_project.
      by symmetry; apply composite_trace_sub_projection_lift.
  - intros (bs & btr & byzantine & Hbtr & Heqv_byzantine & Hlimited & His_pr & Htr_pr).
    exists byzantine; split; [done |].
    eapply VLSM_incl_finite_valid_trace
    ; [by apply fixed_non_equivocating_incl_fixed_non_byzantine |].
    apply fixed_non_equivocating_traces_char.
    symmetry in His_pr, Htr_pr.
    eexists _, _; split; [| done].
    eapply @msg_dep_fixed_limited_equivocation_witnessed in Hbtr as [_ Hbtr]; [| done..].
    revert Hbtr; apply VLSM_incl_finite_valid_trace.
    apply fixed_equivocation_vlsm_composition_index_incl.
    intro; rewrite !elem_of_elements.
    by apply set_map_mono.
Qed.

End sec_msg_dep_limited_byzantine_traces.