(* Assume insertion Delay: inserting Assume instruction *)
(* This versions tries to insert an Assume after a Condition Instruction *)
(* This showcases the possible separation of Framestate and Assume *)
(* This is a pass of the dynamic optimizer *)

Require Export List.
Require Export Coqlib.
Require Export Maps.
Require Export specIR.
Require Export assume_insertion.

(* Checks that a label is not in a list *)
Fixpoint not_in_list (l:list label) (lbl:label): bool :=
  match l with
  | nil => true
  | lbl'::l' =>
    match (Pos.eqb lbl' lbl) with
    | true => false
    | false => not_in_list l' lbl
    end
  end.

(* Check that an instruction has for only predecessor some label *)
Definition only_pred (c:code) (next:label) (pred:label): bool :=
  PTree.fold
    (fun b lbl i =>
       andb b
            (match (Pos.eqb lbl pred) with
             | true => true (* at the predecessor, we can point to next *)
             | false => not_in_list (instr_succ i) next (* elsewehere, next should not be a successor *)
             end))
    c true.

(* Verify that the assume can be inserted after a Cond Instruction *)
Definition validator (v:version) (fs_lbl: label) (guard:list expr) (params:list reg): res unit :=
  match ((ver_code v)#fs_lbl) with
  | Some (Framestate _ _ _ next) =>
    match ((ver_code v)#next) with
    | Some (Cond _ iftrue _) =>
      match (only_pred (ver_code v) next fs_lbl) with
      | true =>
        match (Pos.eqb next (ver_entry v)) with
        | false =>
          do abs <- try_op (defined_regs_analysis (ver_code v) params (ver_entry v)) "Def_regs analysis failed";
            do def_regs <- OK(def_absstate_get next abs);
            match def_regs with
            | DefFlatRegset.Inj def =>
              match (check_guard guard def) with
              | true => OK tt
              | false => Error "The guard might evaluate to an error"
              end
            | _ => Error "The analysis couldn't get the exact set of defined registers"
            end
        | true => Error "The Condition is the entry of the version"
        end
      | false => Error "The Framestate instruction does not dominate the Condition"
      end
    | _ => Error "No Condition instruction after the Framestate"
    end
  | _ => Error "Not pointing to a valid Framestate"
  end.

(* Returns the version where the Assume has been inserted *)
Definition insert_assume_version (v:version) (fid:fun_id) (guard:list expr) (fsl:label) (params:list reg): res version :=
  do code <- OK(ver_code v);
    do _ <- validator v fsl guard params; (* validating that the assume can be inserted *)
    match code # fsl with
    | Some (Framestate tgt vm sl next) =>
      match code # next with
      | Some (Cond condexpr iftrue iffalse) =>
        do freshlbl <- OK (fresh_label (Pos.succ next) code);
        do instr <- try_op (code # iftrue) "Next Label is not used in the function";
          do update_cond <- OK (code # next <- (Cond condexpr freshlbl iffalse));
          do new_code <- OK (update_cond # freshlbl <- (Assume guard tgt vm sl iftrue));
          (* in the new assume, the deopt target, the varmap and the synth list are copied from the framestate *)
          OK (mk_version new_code (ver_entry v))
      | _ => Error "The instruction after the Framestate is not a Cond Instruction"
      end
    | _ => Error "Not pointing to a valid Framestate"
    end.

(* The optimization pass *)
Definition insert_assume_delay (fid: fun_id) (guard:list expr) (fs_lbl: label) (p:program): res program :=
  do f <- try_op (find_function fid p) "Function to optimize not found";
    do v <- OK(current_version f); (* the optimized code if it exists, the base version otherwise *)
    do newv <- insert_assume_version v fid guard fs_lbl (fn_params f);
    do new_program <- OK (set_version p fid newv);
    OK (new_program).

Definition safe_insert_assume_delay (p:program) (fid:fun_id) (guard:list expr) (fs_lbl: label): program :=
  safe_res (insert_assume_delay fid guard fs_lbl) p.


Require Import Bedrock PreAutoSep.

Import DefineStructured.

Section Wrap.
  Variable imports : LabelMap.t assert.
  Hypothesis imports_global : importsGlobal imports.
  Variable modName : string.

  Variable body : cmd imports modName.
  Variable postcondition : assert -> assert.
  Variable verifCond : assert -> list Prop.

  Hypothesis postcondition_ok : forall pre specs x,
    vcs (verifCond pre)
    -> interp specs ((body pre).(Postcondition) x)
    -> interp specs (postcondition pre x).

  Hypothesis verifCond_ok : forall pre,
    vcs (verifCond pre)
    -> vcs (body pre).(VerifCond).

  Hint Extern 1 (_ < _)%N => nomega.
  Hint Extern 1 (not (@eq LabelMap.key _ _)) => lomega.
  Hint Extern 1 (@eq LabelMap.key _ _ -> False) => lomega.
  Hint Extern 1 (LabelMap.MapsTo _ _ _) => apply imps_exit.

  Transparent evalInstrs.

  Definition Wrap : cmd imports modName.
    red; refine (fun pre =>
      let cout := body pre in
      {|
        Postcondition := postcondition pre;
        VerifCond := verifCond pre;
        Generate := fun Base Exit =>
        let cg := cout.(Generate) (Nsucc Base) Base in
          {|
            Entry := Nsucc cg.(Entry);
            Blocks := (cout.(Postcondition),
              (nil, Uncond (RvLabel (modName, Local Exit))))
            :: cg.(Blocks)
          |}
      |}); abstract (struct;
        match goal with
          | [ H : forall k' : LabelMap.key, _
              |- context[Labels _ ?k]  ] =>
            edestruct (H k) as [ ? [ ] ]; eauto;
              match goal with
                | [ H : _ = _ |- _ ] => solve [ rewrite H; eauto 6 ]
              end
          | [ |- context[LabelMap.add (_, Local ?Base) _ _] ] =>
            assert (Base < N.succ Base)%N by nomega;
              match goal with
                | [ H : vcs _ |- _ ] => apply verifCond_ok in H
              end; intuition struct
        end).
  Defined.

End Wrap.

(** * A simpler combinator, for [chunk]-level programs with explicit invariants ahoy *)

Section WrapC.
  Variable body : chunk.

  Definition assertC := bool
    -> (W -> W)
    -> list string
    -> nat
    -> assert.

  Variables precondition postcondition : assertC.
  Variable verifCond : LabelMap.t assert -> list string -> nat -> list Prop.

  Hypothesis postcondition_covered : forall im mn H ns res pre specs st,
    (forall specs st, interp specs (pre st)
      -> interp specs (precondition true (fun x => x) ns res st))
    -> vcs (verifCond im ns res)
    -> interp specs ((toCmd body (im := im) mn H ns res pre).(Postcondition) st)
    -> interp specs (postcondition true (fun x => x) ns res st).

  Hypothesis verifCond_covered : forall im mn H ns res pre,
    (forall specs st, interp specs (pre st) -> interp specs (precondition true (fun x => x) ns res st))
    -> vcs (verifCond im ns res)
    -> vcs ((toCmd body (im := im) mn H ns res pre).(VerifCond)).

  Definition WrapC : chunk.
    red; refine (fun ns res => Structured nil
      (fun im mn H => Wrap im H mn (toCmd body mn H ns res)
        (fun _ => postcondition true (fun x => x) ns res)
        (fun pre => (forall specs st, interp specs (pre st) -> interp specs (precondition true (fun x => x) ns res st)) :: verifCond im ns res)
        _ _)); abstract struct.
  Defined.
End WrapC.

(** * Some tactics useful in clients of [Wrap] *)

Require Import Locals.

Lemma four_plus_variablePosition : forall x ns',
  ~In "rp" ns'
  -> In x ns'
  -> 4 + variablePosition ns' x = variablePosition ("rp" :: ns') x.
  unfold variablePosition at 2; intros.
  destruct (string_dec "rp" x); auto; subst; tauto.
Qed.

Ltac prep_locals :=
  unfold variableSlot in *; repeat rewrite four_plus_variablePosition in * by assumption;
    repeat match goal with
             | [ H : In ?X ?ls |- _ ] =>
               match ls with
                 | "rp" :: _ => fail 1
                 | _ =>
                   match goal with
                     | [ _ : In X ("rp" :: ls) |- _ ] => fail 1
                     | _ => assert (In X ("rp" :: ls)) by (simpl; tauto)
                   end
               end
           end.

Ltac clear_fancy := repeat match goal with
                             | [ H : importsGlobal _ |- _ ] => clear H
                             | [ H : vcs _ |- _ ] => clear H
                           end.

Ltac wrap0 :=
  intros;
    repeat match goal with
             | [ H : vcs nil |- _ ] => clear H
             | [ H : vcs (_ :: _) |- _ ] => inversion H; clear H; intros; subst
             | [ H : vcs (_ ++ _) |- _ ] => specialize (vcs_app_bwd1 _ _ H);
               specialize (vcs_app_bwd2 _ _ H); clear H; intros
           end; simpl;
    repeat match goal with
             | [ |- vcs nil ] => constructor
             | [ |- vcs (_ :: _) ] => constructor
             | [ |- vcs (_ ++ _) ] => apply vcs_app_fwd
           end; propxFo;
    try match goal with
          | [ H : forall stn : settings, _, H' : interp _ _ |- _ ] =>
            specialize (H _ _ _ H')
        end.

Ltac wrap1 := prep_locals; auto; clear_fancy.

Ltac app := match goal with
              | [ H : _, H' : ?P |- _ ] => apply H in H';
                try match goal with
                      | [ H' : P |- _ ] => clear H'
                    end
            end.

Ltac handle_IH :=
  try match goal with
        | [ H : importsGlobal _ |- _ ] =>
          match goal with
            | [ IH : context[H] |- _ ] => clear H IH
            | _ => clear H
          end
      end.

Ltac simp := post; unfold lvalIn, regInL, immInR in *; clear_fancy; prep_locals.

Ltac finish := descend; repeat (step auto_ext; descend); descend; step auto_ext.

(** * Useful facts about instruction sequences not changing parts of machine state *)

Fixpoint scratchOnly (is : list instr) : Prop :=
  match is with
    | nil => True
    | Assign (LvReg r) _ :: is' => r <> Sp /\ scratchOnly is'
    | Binop (LvReg r) _ _ _ :: is' => r <> Sp /\ scratchOnly is'
    | _ => False
  end.

Ltac matcher := repeat match goal with
                         | [ _ : context[match ?E with None => _ | _ => _ end] |- _ ] =>
                           match E with
                             | context[match _ with None => _ | _ => _ end] => fail 1
                             | _ => destruct E; try discriminate
                           end
                         | [ |- context[match ?E with None => _ | _ => _ end] ] =>
                           match E with
                             | context[match _ with None => _ | _ => _ end] => fail 1
                             | _ => destruct E; try discriminate
                           end
                       end.

Transparent evalInstrs.

Theorem scratchOnlySp : forall stn st' is st,
  scratchOnly is
  -> evalInstrs stn st is = Some st'
  -> Regs st' Sp = Regs st Sp.
  induction is as [ | [ [ ] | [ ] ] ]; simpl; intuition; matcher; try congruence;
    erewrite IHis by eassumption; apply rupd_ne; auto.
Qed.

Theorem scratchOnlyMem : forall stn st' is st,
  scratchOnly is
  -> evalInstrs stn st is = Some st'
  -> Mem st' = Mem st.
  induction is as [ | [ [ ] | [ ] ] ]; simpl; intuition; matcher; try congruence;
    erewrite IHis by eassumption; reflexivity.
Qed.

Theorem sepFormula_Mem : forall specs stn st st' P,
  interp specs (![P] (stn, st))
  -> Mem st' = Mem st
  -> interp specs (![P] (stn, st')).
  rewrite sepFormula_eq; unfold sepFormula_def; simpl; intros; congruence.
Qed.

Fixpoint spless (is : list instr) : Prop :=
  match is with
    | nil => True
    | Assign (LvReg r) _ :: is' => r <> Sp /\ spless is'
    | Binop (LvReg r) _ _ _ :: is' => r <> Sp /\ spless is'
    | _ :: is' => spless is'
  end.

Theorem splessSp : forall stn st' is st,
  spless is
  -> evalInstrs stn st is = Some st'
  -> Regs st' Sp = Regs st Sp.
  induction is as [ | [ [ ] | [ ] ] ]; simpl; intuition; matcher; try congruence;
    erewrite IHis by eassumption; simpl; try rewrite rupd_ne by auto; auto.
Qed.

Theorem spless_app : forall is1 is2,
  spless is1
  -> spless is2
  -> spless (is1 ++ is2).
  induction is1 as [ | [ ] ]; simpl; intuition;
    destruct l; intuition.
Qed.

Lemma evalInstrs_app_fwd_None : forall stn is2 is1 st,
  evalInstrs stn st (is1 ++ is2) = None
  -> evalInstrs stn st is1 = None
  \/ (exists st', evalInstrs stn st is1 = Some st' /\ evalInstrs stn st' is2 = None).
  induction is1; simpl; intuition eauto.
  destruct (evalInstr stn st a); eauto.
Qed.

Lemma evalInstrs_app_fwd : forall stn is2 st' is1 st,
  evalInstrs stn st (is1 ++ is2) = Some st'
  -> exists st'', evalInstrs stn st is1 = Some st''
    /\ evalInstrs stn st'' is2 = Some st'.
  induction is1; simpl; intuition eauto.
  destruct (evalInstr stn st a); eauto; discriminate.
Qed.

Lemma evalInstr_evalInstrs : forall stn st i,
  evalInstr stn st i = evalInstrs stn st (i :: nil).
  simpl; intros; destruct (evalInstr stn st i); auto.
Qed.

Lemma evalAssign_rhs : forall stn st lv rv rv',
  evalRvalue stn st rv = evalRvalue stn st rv'
  -> evalInstr stn st (Assign lv rv) = evalInstr stn st (Assign lv rv').
  simpl; intros.
  rewrite H; reflexivity.
Qed.


Require Import VerdiRaft.Raft.

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

Require Import VerdiRaft.RaftRefinementInterface.
Require Import VerdiRaft.CommonTheorems.
Require Import VerdiRaft.RefinementCommonTheorems.

Require Import VerdiRaft.CandidateEntriesInterface.
Require Import VerdiRaft.CroniesCorrectInterface.
Require Import VerdiRaft.CroniesTermInterface.
Require Import VerdiRaft.LeaderLogsTermSanityInterface.

Require Import VerdiRaft.SpecLemmas.
Require Import VerdiRaft.RefinementSpecLemmas.

Require Import VerdiRaft.LeaderLogsCandidateEntriesInterface.

Section CandidateEntriesInterface.
  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 {cci : cronies_correct_interface}.
  Context {cti : cronies_term_interface}.
  Context {cei : candidate_entries_interface}.
  Context {lltsi : leaderLogs_term_sanity_interface}.

  Ltac start :=
    red; unfold leaderLogs_candidateEntries; simpl; intros.

  Lemma leaderLogs_candidateEntries_init :
    refined_raft_net_invariant_init leaderLogs_candidateEntries.
  Proof using.
    start. contradiction.
  Qed.

  Lemma leaderLogs_candidateEntries_client_request :
    refined_raft_net_invariant_client_request leaderLogs_candidateEntries.
  Proof using.
    start.
    eapply candidateEntries_ext; eauto.
    repeat find_higher_order_rewrite.
    assert (candidateEntries e (nwState net)).
    { update_destruct; rewrite_update; simpl in *.
      - find_rewrite_lem update_elections_data_client_request_leaderLogs. eauto.
      - eauto. }
    eapply candidateEntries_same.
    - eauto.
    - intros. update_destruct; rewrite_update; [|auto].
      simpl. subst. eauto using update_elections_data_client_request_cronies.
    - intros. update_destruct; rewrite_update; [|auto].
      simpl. subst. find_apply_lem_hyp handleClientRequest_type. intuition.
    - intros. update_destruct; rewrite_update; [|auto].
      simpl. subst. find_apply_lem_hyp handleClientRequest_type. intuition.
  Qed.

  Lemma leaderLogs_candidateEntries_timeout :
    refined_raft_net_invariant_timeout leaderLogs_candidateEntries.
  Proof using cti.
    start.
    eapply candidateEntries_ext; eauto.
    repeat find_higher_order_rewrite.
    assert (candidateEntries e (nwState net)).
    { update_destruct; rewrite_update; simpl in *.
      - find_rewrite_lem update_elections_data_timeout_leaderLogs. eauto.
      - eauto. }
    unfold candidateEntries in *.
    break_exists; break_and.
    exists x.
    update_destruct; rewrite_update; simpl in *; [|auto].
    subst. split.
    - assert (H100 := update_elections_data_timeout_cronies x (nwState net x) (eTerm e)).
      intuition.
      + find_rewrite. auto.
      + exfalso.
        find_apply_lem_hyp wonElection_exists_voter.
        break_exists.
        find_apply_lem_hyp in_dedup_was_in.
        intro_refined_invariant cronies_term_invariant.
        eapply_prop_hyp cronies_term In.
        simpl in *.
        lia.
    - find_apply_lem_hyp handleTimeout_type_strong.
      break_or_hyp; break_and.
      + repeat find_rewrite. auto.
      + intros. find_rewrite.
        exfalso.
        find_apply_lem_hyp wonElection_exists_voter.
        break_exists.
        find_apply_lem_hyp in_dedup_was_in.
        intro_refined_invariant cronies_term_invariant.
        eapply_prop_hyp cronies_term In.
        simpl in *.
        lia.
  Qed.

  Lemma leaderLogs_candidateEntries_append_entries :
    refined_raft_net_invariant_append_entries leaderLogs_candidateEntries.
  Proof using.
    start.
    eapply candidateEntries_ext; eauto.
    repeat find_higher_order_rewrite.
    update_destruct; rewrite_update.
    - simpl in *.
      find_rewrite_lem update_elections_data_appendEntries_leaderLogs.
      assert (candidateEntries e (nwState net)) by eauto.
      unfold candidateEntries in *.
      break_exists. break_and.
      exists x.
      update_destruct; rewrite_update; [|auto].
      simpl. subst. rewrite update_elections_data_appendEntries_cronies.
      split; [auto|].
      find_apply_lem_hyp handleAppendEntries_type_term.
      break_or_hyp; break_and.
      * repeat find_rewrite. auto.
      * unfold not. intros. find_rewrite. discriminate.
    - assert (candidateEntries e (nwState net)) by eauto.
      unfold candidateEntries in *.
      break_exists. break_and.
      exists x.
      update_destruct; rewrite_update; [|auto].
      simpl. subst. rewrite update_elections_data_appendEntries_cronies.
      split; [auto|].
      find_apply_lem_hyp handleAppendEntries_type_term.
      break_or_hyp; break_and.
      * repeat find_rewrite. auto.
      * unfold not. intros. find_rewrite. discriminate.
  Qed.

  Lemma leaderLogs_candidateEntries_append_entries_reply :
    refined_raft_net_invariant_append_entries_reply leaderLogs_candidateEntries.
  Proof using.
    start.
    eapply candidateEntries_ext; eauto.
    repeat find_higher_order_rewrite.
    assert (candidateEntries e (nwState net)).
    { update_destruct; rewrite_update; eauto. }
    unfold candidateEntries in *.
    break_exists. break_and.
    exists x.
    update_destruct; rewrite_update; simpl; [|auto].
    subst. split; [auto|].
    find_apply_lem_hyp handleAppendEntriesReply_type_term.
    break_or_hyp; break_and.
    - repeat find_rewrite. auto.
    - unfold not. intros. find_rewrite. discriminate.
  Qed.

  Lemma leaderLogs_candidateEntries_request_vote :
    refined_raft_net_invariant_request_vote leaderLogs_candidateEntries.
  Proof using.
    start.
    eapply candidateEntries_ext; eauto.
    repeat find_higher_order_rewrite.
    assert (candidateEntries e (nwState net)).
    { update_destruct; rewrite_update; simpl in *.
      - find_rewrite_lem leaderLogs_update_elections_data_requestVote. eauto.
      - eauto. }
    unfold candidateEntries in *.
    break_exists. break_and.
    exists x.
    update_destruct; rewrite_update; simpl; [|auto].
    subst. split.
    - rewrite update_elections_data_requestVote_cronies. auto.
    - find_apply_lem_hyp handleRequestVote_type_term.
      break_or_hyp; break_and.
      + repeat find_rewrite. auto.
      + unfold not. intros. find_rewrite. discriminate.
  Qed.

  Lemma leaderLogs_candidateEntries_request_vote_reply :
    refined_raft_net_invariant_request_vote_reply leaderLogs_candidateEntries.
  Proof using cei cci.
    start.
    intro_refined_invariant candidate_entries_invariant.
    eapply candidateEntries_ext; eauto.
    subst.
    repeat find_higher_order_rewrite.
    find_rewrite_lem update_fun_comm. simpl in *.
    update_destruct; rewrite_update.
    - find_eapply_lem_hyp leaderLogs_update_elections_data_RVR; eauto.
      intuition.
      + eapply handleRequestVoteReply_preserves_candidate_entries; eauto.
      + subst. find_erewrite_lem handleRequestVoteReply_log.
        eapply handleRequestVoteReply_preserves_candidate_entries; eauto.
    - eapply handleRequestVoteReply_preserves_candidate_entries; eauto.
  Qed.

  Lemma leaderLogs_candidateEntries_do_leader :
    refined_raft_net_invariant_do_leader leaderLogs_candidateEntries.
  Proof using.
    start.
    eapply candidateEntries_ext; eauto.
    find_higher_order_rewrite.
    assert (candidateEntries e (nwState net)).
    { update_destruct; rewrite_update; simpl in *.
      - assert (In (t, ll) (leaderLogs (fst (nwState net h)))) by (repeat find_rewrite; eauto). eauto.
      - eauto. }
    unfold candidateEntries in *.
    break_exists; break_and.
    exists x.
    update_destruct; rewrite_update; [|auto].
    simpl. split.
    - assert (gd = fst (nwState net h)). { repeat find_rewrite. simpl. auto. }
      subst. auto.
    - find_apply_lem_hyp doLeader_type.
      break_and. find_rewrite. repeat find_rewrite.
      auto.
  Qed.

  Lemma leaderLogs_candidateEntries_do_generic_server :
    refined_raft_net_invariant_do_generic_server leaderLogs_candidateEntries.
  Proof using.
    start.
    eapply candidateEntries_ext; eauto.
    find_higher_order_rewrite.
    assert (candidateEntries e (nwState net)).
    { update_destruct; rewrite_update; simpl in *.
      - assert (In (t, ll) (leaderLogs (fst (nwState net h)))) by (repeat find_rewrite; eauto). eauto.
      - eauto. }
    unfold candidateEntries in *.
    break_exists; break_and.
    exists x.
    update_destruct; rewrite_update; [|auto].
    simpl. split.
    - assert (gd = fst (nwState net h)). { repeat find_rewrite. simpl. auto. }
      subst. auto.
    - find_apply_lem_hyp doGenericServer_type.
      break_and. find_rewrite. repeat find_rewrite.
      auto.
  Qed.

  Lemma leaderLogs_candidateEntries_state_same_packet_subset :
    refined_raft_net_invariant_state_same_packet_subset leaderLogs_candidateEntries.
  Proof using.
    start.
    eapply candidateEntries_ext; eauto.
    repeat find_reverse_higher_order_rewrite.
    assert (candidateEntries e (nwState net)) by eauto.
    unfold candidateEntries in *.
    break_exists. break_and.
    exists x.
    repeat find_reverse_higher_order_rewrite. auto.
  Qed.

  Lemma leaderLogs_candidateEntries_reboot :
    refined_raft_net_invariant_reboot leaderLogs_candidateEntries.
  Proof using.
    start.
    eapply candidateEntries_ext; eauto.
    repeat find_higher_order_rewrite.
    assert (candidateEntries e (nwState net)).
    { update_destruct; rewrite_update.
      - assert (gd = fst (nwState net h)). { repeat find_rewrite. simpl. auto. }
        subst. eauto.
      - eauto. }
    unfold candidateEntries in *.
    break_exists; break_and.
    exists x.
    update_destruct; rewrite_update; [|auto].
    simpl. split.
    - assert (gd = fst (nwState net h)). { repeat find_rewrite. simpl. auto. }
      subst. auto.
    - unfold not. intros. subst. unfold reboot in *. simpl in *. discriminate.
  Qed.

  Lemma leaderLogs_candidateEntries_invariant :
    forall net,
      refined_raft_intermediate_reachable net ->
      leaderLogs_candidateEntries net.
  Proof using cei cti cci rri.
    intros.
    apply refined_raft_net_invariant; auto.
    - apply leaderLogs_candidateEntries_init.
    - apply leaderLogs_candidateEntries_client_request.
    - apply leaderLogs_candidateEntries_timeout.
    - apply leaderLogs_candidateEntries_append_entries.
    - apply leaderLogs_candidateEntries_append_entries_reply.
    - apply leaderLogs_candidateEntries_request_vote.
    - apply leaderLogs_candidateEntries_request_vote_reply.
    - apply leaderLogs_candidateEntries_do_leader.
    - apply leaderLogs_candidateEntries_do_generic_server.
    - apply leaderLogs_candidateEntries_state_same_packet_subset.
    - apply leaderLogs_candidateEntries_reboot.
  Qed.

  Instance llcei : leaderLogs_candidate_entries_interface.
  Proof.
    constructor. exact leaderLogs_candidateEntries_invariant.
  Qed.
End CandidateEntriesInterface.


From iris.bi Require Export monpred.
From iris.bi Require Import plainly.
From iris.proofmode Require Import proofmode classes_make modality_instances.
From iris.prelude Require Import options.

Class MakeMonPredAt {I : biIndex} {PROP : bi} (i : I)
      (P : monPred I PROP) (𝓟 : PROP) :=
  make_monPred_at : P i ⊣⊢ 𝓟.
Global Arguments MakeMonPredAt {_ _} _ _%I _%I.
(** Since [MakeMonPredAt] is used by [AsEmpValid] to import lemmas into the
proof mode, the index [I] and BI [PROP] often contain evars. Hence, it is
important to use the mode [!] also for the first two arguments. *)
Global Hint Mode MakeMonPredAt ! ! - ! - : typeclass_instances.

Class IsBiIndexRel {I : biIndex} (i j : I) := is_bi_index_rel : i ⊑ j.
Global Hint Mode IsBiIndexRel + - - : typeclass_instances.
Global Instance is_bi_index_rel_refl {I : biIndex} (i : I) : IsBiIndexRel i i | 0.
Proof. by rewrite /IsBiIndexRel. Qed.
Global Hint Extern 1 (IsBiIndexRel _ _) => unfold IsBiIndexRel; assumption
            : typeclass_instances.

(** Frame [𝓡] into the goal [monPred_at P i] and determine the remainder [𝓠].
    Used when framing encounters a monPred_at in the goal. *)
Class FrameMonPredAt {I : biIndex} {PROP : bi} (p : bool) (i : I)
      (𝓡 : PROP) (P : monPred I PROP) (𝓠 : PROP) :=
  frame_monPred_at : □?p 𝓡 ∗ 𝓠 -∗ P i.
Global Arguments FrameMonPredAt {_ _} _ _ _%I _%I _%I.
Global Hint Mode FrameMonPredAt + + + - ! ! - : typeclass_instances.

Section modalities.
  Context {I : biIndex} {PROP : bi}.

  Lemma modality_objectively_mixin :
    modality_mixin (@monPred_objectively I PROP)
      (MIEnvFilter Objective) (MIEnvFilter Objective).
  Proof.
    split; simpl; split_and?; intros;
      try select (TCDiag _ _ _) (fun H => destruct H);
      eauto using bi.equiv_entails_1_2, objective_objectively,
        monPred_objectively_mono, monPred_objectively_and,
        monPred_objectively_sep_2 with typeclass_instances.
  Qed.
  Definition modality_objectively :=
    Modality _ modality_objectively_mixin.
End modalities.

Section bi.
Context {I : biIndex} {PROP : bi}.
Local Notation monPredI := (monPredI I PROP).
Local Notation monPred := (monPred I PROP).
Local Notation MakeMonPredAt := (@MakeMonPredAt I PROP).
Implicit Types P Q R : monPred.
Implicit Types 𝓟 𝓠 𝓡 : PROP.
Implicit Types φ : Prop.
Implicit Types i j : I.

Global Instance from_modal_objectively P :
  FromModal True modality_objectively (<obj> P) (<obj> P) P | 1.
Proof. by rewrite /FromModal. Qed.
Global Instance from_modal_subjectively P :
  FromModal True modality_id (<subj> P) (<subj> P) P | 1.
Proof. by rewrite /FromModal /= -monPred_subjectively_intro. Qed.

Global Instance from_modal_affinely_monPred_at φ `(sel : A) P Q 𝓠 i :
  FromModal φ modality_affinely sel P Q →
  MakeMonPredAt i Q 𝓠 →
  FromModal φ modality_affinely sel (P i) 𝓠 | 0.
Proof.
  rewrite /FromModal /MakeMonPredAt /==> HPQ <- ?.
  by rewrite -HPQ // monPred_at_affinely.
Qed.
Global Instance from_modal_persistently_monPred_at φ `(sel : A) P Q 𝓠 i :
  FromModal φ modality_persistently sel P Q →
  MakeMonPredAt i Q 𝓠 →
  FromModal φ modality_persistently sel (P i) 𝓠 | 0.
Proof.
  rewrite /FromModal /MakeMonPredAt /==> HPQ <- ?.
  by rewrite -HPQ // monPred_at_persistently.
Qed.
Global Instance from_modal_intuitionistically_monPred_at φ `(sel : A) P Q 𝓠 i :
  FromModal φ modality_intuitionistically sel P Q →
  MakeMonPredAt i Q 𝓠 →
  FromModal φ modality_intuitionistically sel (P i) 𝓠 | 0.
Proof.
  rewrite /FromModal /MakeMonPredAt /==> HPQ <- ?.
  by rewrite -HPQ // monPred_at_affinely monPred_at_persistently.
Qed.
Global Instance from_modal_id_monPred_at φ `(sel : A) P Q 𝓠 i :
  FromModal φ modality_id sel P Q → MakeMonPredAt i Q 𝓠 →
  FromModal φ modality_id sel (P i) 𝓠.
Proof. rewrite /FromModal /MakeMonPredAt=> HPQ <- ?. by rewrite -HPQ. Qed.

Global Instance make_monPred_at_pure φ i : MakeMonPredAt i ⌜φ⌝ ⌜φ⌝.
Proof. by rewrite /MakeMonPredAt monPred_at_pure. Qed.
Global Instance make_monPred_at_emp i : MakeMonPredAt i emp emp.
Proof. by rewrite /MakeMonPredAt monPred_at_emp. Qed.
Global Instance make_monPred_at_sep i P 𝓟 Q 𝓠 :
  MakeMonPredAt i P 𝓟 → MakeMonPredAt i Q 𝓠 →
  MakeMonPredAt i (P ∗ Q) (𝓟 ∗ 𝓠).
Proof. by rewrite /MakeMonPredAt monPred_at_sep=><-<-. Qed.
Global Instance make_monPred_at_and i P 𝓟 Q 𝓠 :
  MakeMonPredAt i P 𝓟 → MakeMonPredAt i Q 𝓠 →
  MakeMonPredAt i (P ∧ Q) (𝓟 ∧ 𝓠).
Proof. by rewrite /MakeMonPredAt monPred_at_and=><-<-. Qed.
Global Instance make_monPred_at_or i P 𝓟 Q 𝓠 :
  MakeMonPredAt i P 𝓟 → MakeMonPredAt i Q 𝓠 →
  MakeMonPredAt i (P ∨ Q) (𝓟 ∨ 𝓠).
Proof. by rewrite /MakeMonPredAt monPred_at_or=><-<-. Qed.
Global Instance make_monPred_at_forall {A} i (Φ : A → monPred) (Ψ : A → PROP) :
  (∀ a, MakeMonPredAt i (Φ a) (Ψ a)) → MakeMonPredAt i (∀ a, Φ a) (∀ a, Ψ a).
Proof. rewrite /MakeMonPredAt monPred_at_forall=>H. by setoid_rewrite <- H. Qed.
Global Instance make_monPred_at_exists {A} i (Φ : A → monPred) (Ψ : A → PROP) :
  (∀ a, MakeMonPredAt i (Φ a) (Ψ a)) → MakeMonPredAt i (∃ a, Φ a) (∃ a, Ψ a).
Proof. rewrite /MakeMonPredAt monPred_at_exist=>H. by setoid_rewrite <- H. Qed.
Global Instance make_monPred_at_persistently i P 𝓟 :
  MakeMonPredAt i P 𝓟 → MakeMonPredAt i (<pers> P) (<pers> 𝓟).
Proof. by rewrite /MakeMonPredAt monPred_at_persistently=><-. Qed.
Global Instance make_monPred_at_affinely i P 𝓟 :
  MakeMonPredAt i P 𝓟 → MakeMonPredAt i (<affine> P) (<affine> 𝓟).
Proof. by rewrite /MakeMonPredAt monPred_at_affinely=><-. Qed.
Global Instance make_monPred_at_intuitionistically i P 𝓟 :
  MakeMonPredAt i P 𝓟 → MakeMonPredAt i (□ P) (□ 𝓟).
Proof. by rewrite /MakeMonPredAt monPred_at_intuitionistically=><-. Qed.
Global Instance make_monPred_at_absorbingly i P 𝓟 :
  MakeMonPredAt i P 𝓟 → MakeMonPredAt i (<absorb> P) (<absorb> 𝓟).
Proof. by rewrite /MakeMonPredAt monPred_at_absorbingly=><-. Qed.
Global Instance make_monPred_at_persistently_if i P 𝓟 p :
  MakeMonPredAt i P 𝓟 →
  MakeMonPredAt i (<pers>?p P) (<pers>?p 𝓟).
Proof. destruct p; simpl; apply _. Qed.
Global Instance make_monPred_at_affinely_if i P 𝓟 p :
  MakeMonPredAt i P 𝓟 →
  MakeMonPredAt i (<affine>?p P) (<affine>?p 𝓟).
Proof. destruct p; simpl; apply _. Qed.
Global Instance make_monPred_at_absorbingly_if i P 𝓟 p :
  MakeMonPredAt i P 𝓟 →
  MakeMonPredAt i (<absorb>?p P) (<absorb>?p 𝓟).
Proof. destruct p; simpl; apply _. Qed.
Global Instance make_monPred_at_intuitionistically_if i P 𝓟 p :
  MakeMonPredAt i P 𝓟 →
  MakeMonPredAt i (□?p P) (□?p 𝓟).
Proof. destruct p; simpl; apply _. Qed.
Global Instance make_monPred_at_embed i 𝓟 : MakeMonPredAt i ⎡𝓟⎤ 𝓟.
Proof. by rewrite /MakeMonPredAt monPred_at_embed. Qed.
Global Instance make_monPred_at_in i j : MakeMonPredAt j (monPred_in i) ⌜i ⊑ j⌝.
Proof. by rewrite /MakeMonPredAt monPred_at_in. Qed.
Global Instance make_monPred_at_default i P : MakeMonPredAt i P (P i) | 100.
Proof. by rewrite /MakeMonPredAt. Qed.
Global Instance make_monPred_at_bupd `{!BiBUpd PROP} i P 𝓟 :
  MakeMonPredAt i P 𝓟 → MakeMonPredAt i (|==> P) (|==> 𝓟).
Proof. by rewrite /MakeMonPredAt monPred_at_bupd=> <-. Qed.

Global Instance from_assumption_make_monPred_at_l p i j P 𝓟 :
  MakeMonPredAt i P 𝓟 → IsBiIndexRel j i → KnownLFromAssumption p (P j) 𝓟.
Proof.
  rewrite /MakeMonPredAt /KnownLFromAssumption /FromAssumption /IsBiIndexRel=><- ->.
  apply  bi.intuitionistically_if_elim.
Qed.
Global Instance from_assumption_make_monPred_at_r p i j P 𝓟 :
  MakeMonPredAt i P 𝓟 → IsBiIndexRel i j → KnownRFromAssumption p 𝓟 (P j).
Proof.
  rewrite /MakeMonPredAt /KnownRFromAssumption /FromAssumption /IsBiIndexRel=><- ->.
  apply  bi.intuitionistically_if_elim.
Qed.

Global Instance from_assumption_make_monPred_objectively p P Q :
  FromAssumption p P Q → KnownLFromAssumption p (<obj> P) Q.
Proof.
  by rewrite /KnownLFromAssumption /FromAssumption monPred_objectively_elim.
Qed.
Global Instance from_assumption_make_monPred_subjectively p P Q :
  FromAssumption p P Q → KnownRFromAssumption p P (<subj> Q).
Proof.
  by rewrite /KnownRFromAssumption /FromAssumption -monPred_subjectively_intro.
Qed.

Global Instance as_emp_valid_monPred_at φ P (Φ : I → PROP) :
  AsEmpValid0 φ P → (∀ i, MakeMonPredAt i P (Φ i)) → AsEmpValid φ (∀ i, Φ i) | 100.
Proof.
  rewrite /MakeMonPredAt /AsEmpValid0 /AsEmpValid /bi_emp_valid=> -> EQ.
  setoid_rewrite <-EQ. split.
  - move=>[H]. apply bi.forall_intro=>i. rewrite -H. by rewrite monPred_at_emp.
  - move=>HP. split=>i. rewrite monPred_at_emp HP bi.forall_elim //.
Qed.
Global Instance as_emp_valid_monPred_at_wand φ P Q (Φ Ψ : I → PROP) :
  AsEmpValid0 φ (P -∗ Q) →
  (∀ i, MakeMonPredAt i P (Φ i)) → (∀ i, MakeMonPredAt i Q (Ψ i)) →
  AsEmpValid φ (∀ i, Φ i -∗ Ψ i).
Proof.
  rewrite /AsEmpValid0 /AsEmpValid /MakeMonPredAt. intros -> EQ1 EQ2.
  setoid_rewrite <-EQ1. setoid_rewrite <-EQ2. split.
  - move=>/bi.wand_entails HP. setoid_rewrite HP. by iIntros (i) "$".
  - move=>HP. apply bi.entails_wand. split=>i. iIntros "H". by iApply HP.
Qed.
Global Instance as_emp_valid_monPred_at_equiv φ P Q (Φ Ψ : I → PROP) :
  AsEmpValid0 φ (P ∗-∗ Q) →
  (∀ i, MakeMonPredAt i P (Φ i)) → (∀ i, MakeMonPredAt i Q (Ψ i)) →
  AsEmpValid φ (∀ i, Φ i ∗-∗ Ψ i).
Proof.
  rewrite /AsEmpValid0 /AsEmpValid /MakeMonPredAt. intros -> EQ1 EQ2.
  setoid_rewrite <-EQ1. setoid_rewrite <-EQ2. split.
  - move=>/bi.wand_iff_equiv HP. setoid_rewrite HP. iIntros. iSplit; iIntros "$".
  - move=>HP. apply bi.equiv_wand_iff. split=>i. by iSplit; iIntros; iApply HP.
Qed.

Global Instance into_pure_monPred_at P φ i : IntoPure P φ → IntoPure (P i) φ.
Proof. rewrite /IntoPure=>->. by rewrite monPred_at_pure. Qed.
Global Instance from_pure_monPred_at a P φ i : FromPure a P φ → FromPure a (P i) φ.
Proof. rewrite /FromPure=><-. by rewrite monPred_at_affinely_if monPred_at_pure. Qed.
Global Instance into_pure_monPred_in i j : @IntoPure PROP (monPred_in i j) (i ⊑ j).
Proof. by rewrite /IntoPure monPred_at_in. Qed.
Global Instance from_pure_monPred_in i j : @FromPure PROP false (monPred_in i j) (i ⊑ j).
Proof. by rewrite /FromPure monPred_at_in. Qed.

Global Instance into_persistent_monPred_at p P Q 𝓠 i :
  IntoPersistent p P Q → MakeMonPredAt i Q 𝓠 → IntoPersistent p (P i) 𝓠 | 0.
Proof.
  rewrite /IntoPersistent /MakeMonPredAt  =>-[/(_ i) ?] <-.
  by rewrite -monPred_at_persistently -monPred_at_persistently_if.
Qed.

Lemma into_wand_monPred_at_unknown_unknown p q R P 𝓟 Q 𝓠 i :
  IntoWand p q R P Q → MakeMonPredAt i P 𝓟 → MakeMonPredAt i Q 𝓠 →
  IntoWand p q (R i) 𝓟 𝓠.
Proof.
  rewrite /IntoWand /MakeMonPredAt /bi_affinely_if /bi_persistently_if.
  destruct p, q=> /bi.wand_elim_l' [/(_ i) H] <- <-; apply bi.wand_intro_r;
  revert H; by rewrite monPred_at_sep ?monPred_at_affinely ?monPred_at_persistently.
Qed.
Lemma into_wand_monPred_at_unknown_known p q R P 𝓟 Q i j :
  IsBiIndexRel i j → IntoWand p q R P Q →
  MakeMonPredAt j P 𝓟 → IntoWand p q (R i) 𝓟 (Q j).
Proof.
  rewrite /IntoWand /IsBiIndexRel /MakeMonPredAt=>-> ? ?.
  eapply into_wand_monPred_at_unknown_unknown=>//. apply _.
Qed.
Lemma into_wand_monPred_at_known_unknown_le p q R P Q 𝓠 i j :
  IsBiIndexRel i j → IntoWand p q R P Q →
  MakeMonPredAt j Q 𝓠 → IntoWand p q (R i) (P j) 𝓠.
Proof.
  rewrite /IntoWand /IsBiIndexRel /MakeMonPredAt=>-> ? ?.
  eapply into_wand_monPred_at_unknown_unknown=>//. apply _.
Qed.
Lemma into_wand_monPred_at_known_unknown_ge p q R P Q 𝓠 i j :
  IsBiIndexRel i j → IntoWand p q R P Q →
  MakeMonPredAt j Q 𝓠 → IntoWand p q (R j) (P i) 𝓠.
Proof.
  rewrite /IntoWand /IsBiIndexRel /MakeMonPredAt=>-> ? ?.
  eapply into_wand_monPred_at_unknown_unknown=>//. apply _.
Qed.

Global Instance into_wand_wand'_monPred p q P Q 𝓟 𝓠 i :
  IntoWand' p q ((P -∗ Q) i) 𝓟 𝓠 → IntoWand p q ((P -∗ Q) i) 𝓟 𝓠 | 100.
Proof. done. Qed.
Global Instance into_wand_impl'_monPred p q P Q 𝓟 𝓠 i :
  IntoWand' p q ((P → Q) i) 𝓟 𝓠 → IntoWand p q ((P → Q) i) 𝓟 𝓠 | 100.
Proof. done. Qed.

Global Instance from_forall_monPred_at_wand P Q (Φ Ψ : I → PROP) i :
  (∀ j, MakeMonPredAt j P (Φ j)) → (∀ j, MakeMonPredAt j Q (Ψ j)) →
  FromForall ((P -∗ Q) i)%I (λ j, ⌜i ⊑ j⌝ → Φ j -∗ Ψ j)%I (to_ident_name idx).
Proof.
  rewrite /FromForall /MakeMonPredAt monPred_at_wand=> H1 H2. do 2 f_equiv.
  by rewrite H1 H2.
Qed.
Global Instance from_forall_monPred_at_impl P Q (Φ Ψ : I → PROP) i :
  (∀ j, MakeMonPredAt j P (Φ j)) → (∀ j, MakeMonPredAt j Q (Ψ j)) →
  FromForall ((P → Q) i)%I (λ j, ⌜i ⊑ j⌝ → Φ j → Ψ j)%I (to_ident_name idx).
Proof.
  rewrite /FromForall /MakeMonPredAt monPred_at_impl=> H1 H2. do 2 f_equiv.
  by rewrite H1 H2 bi.pure_impl_forall.
Qed.

Global Instance into_forall_monPred_at_index P i :
  IntoForall (P i) (λ j, ⌜i ⊑ j⌝ → P j)%I | 100.
Proof.
  rewrite /IntoForall. setoid_rewrite bi.pure_impl_forall.
  do 2 apply bi.forall_intro=>?. by f_equiv.
Qed.

Global Instance from_and_monPred_at P Q1 𝓠1 Q2 𝓠2 i :
  FromAnd P Q1 Q2 → MakeMonPredAt i Q1 𝓠1 → MakeMonPredAt i Q2 𝓠2 →
  FromAnd (P i) 𝓠1 𝓠2.
Proof.
  rewrite /FromAnd /MakeMonPredAt /MakeMonPredAt=> <- <- <-.
  by rewrite monPred_at_and.
Qed.
Global Instance into_and_monPred_at p P Q1 𝓠1 Q2 𝓠2 i :
  IntoAnd p P Q1 Q2 → MakeMonPredAt i Q1 𝓠1 → MakeMonPredAt i Q2 𝓠2 →
  IntoAnd p (P i) 𝓠1 𝓠2.
Proof.
  rewrite /IntoAnd /MakeMonPredAt /bi_affinely_if /bi_persistently_if.
  destruct p=>-[/(_ i) H] <- <-; revert H;
  by rewrite ?monPred_at_affinely ?monPred_at_persistently monPred_at_and.
Qed.

Global Instance from_sep_monPred_at P Q1 𝓠1 Q2 𝓠2 i :
  FromSep P Q1 Q2 → MakeMonPredAt i Q1 𝓠1 → MakeMonPredAt i Q2 𝓠2 →
  FromSep (P i) 𝓠1 𝓠2.
Proof. rewrite /FromSep /MakeMonPredAt=> <- <- <-. by rewrite monPred_at_sep. Qed.
Global Instance into_sep_monPred_at P Q1 𝓠1 Q2 𝓠2 i :
  IntoSep P Q1 Q2 → MakeMonPredAt i Q1 𝓠1 → MakeMonPredAt i Q2 𝓠2 →
  IntoSep (P i) 𝓠1 𝓠2.
Proof. rewrite /IntoSep /MakeMonPredAt=> -> <- <-. by rewrite monPred_at_sep. Qed.
Global Instance from_or_monPred_at P Q1 𝓠1 Q2 𝓠2 i :
  FromOr P Q1 Q2 → MakeMonPredAt i Q1 𝓠1 → MakeMonPredAt i Q2 𝓠2 →
  FromOr (P i) 𝓠1 𝓠2.
Proof. rewrite /FromOr /MakeMonPredAt=> <- <- <-. by rewrite monPred_at_or. Qed.
Global Instance into_or_monPred_at P Q1 𝓠1 Q2 𝓠2 i :
  IntoOr P Q1 Q2 → MakeMonPredAt i Q1 𝓠1 → MakeMonPredAt i Q2 𝓠2 →
  IntoOr (P i) 𝓠1 𝓠2.
Proof. rewrite /IntoOr /MakeMonPredAt=> -> <- <-. by rewrite monPred_at_or. Qed.

Global Instance from_exist_monPred_at {A} P (Φ : A → monPred) (Ψ : A → PROP) i :
  FromExist P Φ → (∀ a, MakeMonPredAt i (Φ a) (Ψ a)) → FromExist (P i) Ψ.
Proof.
  rewrite /FromExist /MakeMonPredAt=><- H. setoid_rewrite <- H.
  by rewrite monPred_at_exist.
Qed.
Global Instance into_exist_monPred_at {A} P (Φ : A → monPred) name (Ψ : A → PROP) i :
  IntoExist P Φ name → (∀ a, MakeMonPredAt i (Φ a) (Ψ a)) → IntoExist (P i) Ψ name.
Proof.
  rewrite /IntoExist /MakeMonPredAt=>-> H. setoid_rewrite <- H.
  by rewrite monPred_at_exist.
Qed.

Global Instance from_forall_monPred_at_objectively P (Φ : I → PROP) i :
  (∀ i, MakeMonPredAt i P (Φ i)) → FromForall ((<obj> P) i)%I Φ (to_ident_name idx).
Proof.
  rewrite /FromForall /MakeMonPredAt monPred_at_objectively=>H. by setoid_rewrite <- H.
Qed.
Global Instance into_forall_monPred_at_objectively P (Φ : I → PROP) i :
  (∀ i, MakeMonPredAt i P (Φ i)) → IntoForall ((<obj> P) i) Φ.
Proof.
  rewrite /IntoForall /MakeMonPredAt monPred_at_objectively=>H. by setoid_rewrite <- H.
Qed.

Global Instance from_exist_monPred_at_ex P (Φ : I → PROP) i :
  (∀ i, MakeMonPredAt i P (Φ i)) → FromExist ((<subj> P) i) Φ.
Proof.
  rewrite /FromExist /MakeMonPredAt monPred_at_subjectively=>H. by setoid_rewrite <- H.
Qed.
(* TODO: this implementation uses [idx] as the automatic name for the index. In
theory a monPred could define an appropriate metavariable for indices with an
[ident_name] argument to [MakeMonPredAt], but this is not implemented. *)
Global Instance into_exist_monPred_at_ex P (Φ : I → PROP) i :
  (∀ i, MakeMonPredAt i P (Φ i)) → IntoExist ((<subj> P) i) Φ (to_ident_name idx).
Proof.
  rewrite /IntoExist /MakeMonPredAt monPred_at_subjectively=>H. by setoid_rewrite <- H.
Qed.

Global Instance from_forall_monPred_at {A} P (Φ : A → monPred) name (Ψ : A → PROP) i :
  FromForall P Φ name → (∀ a, MakeMonPredAt i (Φ a) (Ψ a)) → FromForall (P i) Ψ name.
Proof.
  rewrite /FromForall /MakeMonPredAt=><- H. setoid_rewrite <- H.
  by rewrite monPred_at_forall.
Qed.
Global Instance into_forall_monPred_at {A} P (Φ : A → monPred) (Ψ : A → PROP) i :
  IntoForall P Φ → (∀ a, MakeMonPredAt i (Φ a) (Ψ a)) → IntoForall (P i) Ψ.
Proof.
  rewrite /IntoForall /MakeMonPredAt=>-> H. setoid_rewrite <- H.
  by rewrite monPred_at_forall.
Qed.

(* Framing. *)
Global Instance frame_monPred_at_enter p i 𝓡 P 𝓠 :
  FrameMonPredAt p i 𝓡 P 𝓠 → Frame p 𝓡 (P i) 𝓠 | 2.
Proof. intros. done. Qed.
Global Instance frame_monPred_at_here p P i j :
  IsBiIndexRel i j → FrameMonPredAt p j (P i) P emp | 0.
Proof.
  rewrite /FrameMonPredAt /IsBiIndexRel right_id bi.intuitionistically_if_elim=> -> //.
Qed.

Global Instance frame_monPred_at_embed p 𝓡 𝓠 𝓟 i :
  Frame p 𝓡 𝓟 𝓠 → FrameMonPredAt p i 𝓡 (embed (B:=monPredI) 𝓟) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_embed. Qed.
Global Instance frame_monPred_at_sep p P Q 𝓡 𝓠 i :
  Frame p 𝓡 (P i ∗ Q i) 𝓠 → FrameMonPredAt p i 𝓡 (P ∗ Q) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_sep. Qed.
Global Instance frame_monPred_at_and p P Q 𝓡 𝓠 i :
  Frame p 𝓡 (P i ∧ Q i) 𝓠 → FrameMonPredAt p i 𝓡 (P ∧ Q) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_and. Qed.
Global Instance frame_monPred_at_or p P Q 𝓡 𝓠 i :
  Frame p 𝓡 (P i ∨ Q i) 𝓠 → FrameMonPredAt p i 𝓡 (P ∨ Q) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_or. Qed.
Global Instance frame_monPred_at_wand p P R Q1 Q2 i j :
  IsBiIndexRel i j →
  Frame p R Q1 Q2 →
  FrameMonPredAt p j (R i) (P -∗ Q1) ((P -∗ Q2) i).
Proof.
  rewrite /Frame /FrameMonPredAt=>-> Hframe.
  rewrite -monPred_at_intuitionistically_if -monPred_at_sep. apply monPred_in_entails.
  change ((□?p R ∗ (P -∗ Q2)) -∗ P -∗ Q1). apply bi.wand_intro_r.
  rewrite -assoc bi.wand_elim_l. done.
Qed.
Global Instance frame_monPred_at_impl P R Q1 Q2 i j :
  IsBiIndexRel i j →
  Frame true R Q1 Q2 →
  FrameMonPredAt true j (R i) (P → Q1) ((P → Q2) i).
Proof.
  rewrite /Frame /FrameMonPredAt=>-> Hframe.
  rewrite -monPred_at_intuitionistically_if -monPred_at_sep. apply monPred_in_entails.
  change ((□ R ∗ (P → Q2)) -∗ P → Q1).
  rewrite -bi.persistently_and_intuitionistically_sep_l. apply bi.impl_intro_r.
  rewrite -assoc bi.impl_elim_l bi.persistently_and_intuitionistically_sep_l. done.
Qed.
Global Instance frame_monPred_at_forall {X : Type} p (Ψ : X → monPred) 𝓡 𝓠 i :
  Frame p 𝓡 (∀ x, Ψ x i) 𝓠 → FrameMonPredAt p i 𝓡 (∀ x, Ψ x) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_forall. Qed.
Global Instance frame_monPred_at_exist {X : Type} p (Ψ : X → monPred) 𝓡 𝓠 i :
  Frame p 𝓡 (∃ x, Ψ x i) 𝓠 → FrameMonPredAt p i 𝓡 (∃ x, Ψ x) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_exist. Qed.

Global Instance frame_monPred_at_absorbingly p P 𝓡 𝓠 i :
  Frame p 𝓡 (<absorb> P i) 𝓠 → FrameMonPredAt p i 𝓡 (<absorb> P) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_absorbingly. Qed.
Global Instance frame_monPred_at_affinely p P 𝓡 𝓠 i :
  Frame p 𝓡 (<affine> P i) 𝓠 → FrameMonPredAt p i 𝓡 (<affine> P) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_affinely. Qed.
Global Instance frame_monPred_at_persistently p P 𝓡 𝓠 i :
  Frame p 𝓡 (<pers> P i) 𝓠 → FrameMonPredAt p i 𝓡 (<pers> P) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_persistently. Qed.
Global Instance frame_monPred_at_intuitionistically p P 𝓡 𝓠 i :
  Frame p 𝓡 (□ P i) 𝓠 → FrameMonPredAt p i 𝓡 (□ P) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_intuitionistically. Qed.
Global Instance frame_monPred_at_objectively p P 𝓡 𝓠 i :
  Frame p 𝓡 (∀ i, P i) 𝓠 → FrameMonPredAt p i 𝓡 (<obj> P) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_objectively. Qed.
Global Instance frame_monPred_at_subjectively p P 𝓡 𝓠 i :
  Frame p 𝓡 (∃ i, P i) 𝓠 → FrameMonPredAt p i 𝓡 (<subj> P) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_subjectively. Qed.
Global Instance frame_monPred_at_bupd `{!BiBUpd PROP} p P 𝓡 𝓠 i :
  Frame p 𝓡 (|==> P i) 𝓠 → FrameMonPredAt p i 𝓡 (|==> P) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_bupd. Qed.

Global Instance into_embed_objective P :
  Objective P → IntoEmbed P (∀ i, P i).
Proof.
  rewrite /IntoEmbed=> ?.
  by rewrite {1}(objective_objectively P) monPred_objectively_unfold.
Qed.

Global Instance elim_modal_at_bupd_goal `{!BiBUpd PROP} φ p p' 𝓟 𝓟' Q Q' i :
  ElimModal φ p p' 𝓟 𝓟' (|==> Q i) (|==> Q' i) →
  ElimModal φ p p' 𝓟 𝓟' ((|==> Q) i) ((|==> Q') i).
Proof. by rewrite /ElimModal !monPred_at_bupd. Qed.
Global Instance elim_modal_at_bupd_hyp `{!BiBUpd PROP} φ p p' P 𝓟 𝓟' 𝓠 𝓠' i:
  MakeMonPredAt i P 𝓟 →
  ElimModal φ p p' (|==> 𝓟) 𝓟' 𝓠 𝓠' →
  ElimModal φ p p' ((|==> P) i) 𝓟' 𝓠 𝓠'.
Proof. by rewrite /MakeMonPredAt /ElimModal monPred_at_bupd=><-. Qed.
Global Instance elim_modal_at φ p p' 𝓟 𝓟' P P' V:
  ElimModal φ p p' ⎡𝓟⎤ ⎡𝓟'⎤ P P' → ElimModal φ p p' 𝓟 𝓟' (P V) (P' V).
Proof.
  rewrite /ElimModal -!embed_intuitionistically_if.
  iIntros (HH Hφ) "[? HP]". iApply HH; [done|]. iFrame. iIntros (? <-) "?".
  by iApply "HP".
Qed.

Global Instance add_modal_at_bupd_goal `{!BiBUpd PROP} φ 𝓟 𝓟' Q i :
  AddModal 𝓟 𝓟' (|==> Q i)%I → AddModal 𝓟 𝓟' ((|==> Q) i).
Proof. by rewrite /AddModal !monPred_at_bupd. Qed.

Global Instance from_forall_monPred_at_plainly `{!BiPlainly PROP} i P Φ :
  (∀ i, MakeMonPredAt i P (Φ i)) →
  FromForall ((■ P) i) (λ j, ■ (Φ j))%I (to_ident_name idx).
Proof.
  rewrite /FromForall /MakeMonPredAt=>HPΦ. rewrite monPred_at_plainly.
  by setoid_rewrite HPΦ.
Qed.
Global Instance into_forall_monPred_at_plainly `{!BiPlainly PROP} i P Φ :
  (∀ i, MakeMonPredAt i P (Φ i)) →
  IntoForall ((■ P) i) (λ j, ■ (Φ j))%I.
Proof.
  rewrite /IntoForall /MakeMonPredAt=>HPΦ. rewrite monPred_at_plainly.
  by setoid_rewrite HPΦ.
Qed.

Global Instance is_except_0_monPred_at i P :
  IsExcept0 P → IsExcept0 (P i).
Proof. rewrite /IsExcept0=>- [/(_ i)]. by rewrite monPred_at_except_0. Qed.

Global Instance make_monPred_at_internal_eq `{!BiInternalEq PROP} {A : ofe} (x y : A) i :
  MakeMonPredAt i (x ≡ y) (x ≡ y).
Proof. by rewrite /MakeMonPredAt monPred_at_internal_eq. Qed.
Global Instance make_monPred_at_except_0 i P 𝓠 :
  MakeMonPredAt i P 𝓠 → MakeMonPredAt i (◇ P) (◇ 𝓠).
Proof. by rewrite /MakeMonPredAt monPred_at_except_0=><-. Qed.
Global Instance make_monPred_at_later i P 𝓠 :
  MakeMonPredAt i P 𝓠 → MakeMonPredAt i (▷ P) (▷ 𝓠).
Proof. by rewrite /MakeMonPredAt monPred_at_later=><-. Qed.
Global Instance make_monPred_at_laterN i n P 𝓠 :
  MakeMonPredAt i P 𝓠 → MakeMonPredAt i (▷^n P) (▷^n 𝓠).
Proof. rewrite /MakeMonPredAt=> <-. elim n=>//= ? <-. by rewrite monPred_at_later. Qed.
Global Instance make_monPred_at_fupd `{!BiFUpd PROP} i E1 E2 P 𝓟 :
  MakeMonPredAt i P 𝓟 → MakeMonPredAt i (|={E1,E2}=> P) (|={E1,E2}=> 𝓟).
Proof. by rewrite /MakeMonPredAt monPred_at_fupd=> <-. Qed.

Global Instance into_internal_eq_monPred_at `{!BiInternalEq PROP}
    {A : ofe} (x y : A) P i :
  IntoInternalEq P x y → IntoInternalEq (P i) x y.
Proof. rewrite /IntoInternalEq=> ->. by rewrite monPred_at_internal_eq. Qed.

Global Instance into_except_0_monPred_at_fwd i P Q 𝓠 :
  IntoExcept0 P Q → MakeMonPredAt i Q 𝓠 → IntoExcept0 (P i) 𝓠.
Proof. rewrite /IntoExcept0 /MakeMonPredAt=> -> <-. by rewrite monPred_at_except_0. Qed.
Global Instance into_except_0_monPred_at_bwd i P 𝓟 Q :
  IntoExcept0 P Q → MakeMonPredAt i P 𝓟 → IntoExcept0 𝓟 (Q i).
Proof. rewrite /IntoExcept0 /MakeMonPredAt=> H <-. by rewrite H monPred_at_except_0. Qed.

Global Instance maybe_into_later_monPred_at i n P Q 𝓠 :
  IntoLaterN false n P Q → MakeMonPredAt i Q 𝓠 →
  IntoLaterN false n (P i) 𝓠.
Proof.
  rewrite /IntoLaterN /MaybeIntoLaterN /MakeMonPredAt=> -> <-. elim n=>//= ? <-.
  by rewrite monPred_at_later.
Qed.
Global Instance from_later_monPred_at i φ `(sel : A) n P Q 𝓠 :
  FromModal φ (modality_laterN n) sel P Q →
  MakeMonPredAt i Q 𝓠 →
  FromModal φ (modality_laterN n) sel (P i) 𝓠.
Proof.
  rewrite /FromModal /MakeMonPredAt=> HPQ <- ?. rewrite -HPQ //.
  elim n=>//= ? ->.
  by rewrite monPred_at_later.
Qed.

Global Instance frame_monPred_at_later p P 𝓡 𝓠 i :
  Frame p 𝓡 (▷ P i) 𝓠 → FrameMonPredAt p i 𝓡 (▷ P) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_later. Qed.
Global Instance frame_monPred_at_laterN p n P 𝓡 𝓠 i :
  Frame p 𝓡 (▷^n P i) 𝓠 → FrameMonPredAt p i 𝓡 (▷^n P) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_laterN. Qed.
Global Instance frame_monPred_at_fupd `{!BiFUpd PROP} E1 E2 p P 𝓡 𝓠 i :
  Frame p 𝓡 (|={E1,E2}=> P i) 𝓠 → FrameMonPredAt p i 𝓡 (|={E1,E2}=> P) 𝓠.
Proof. rewrite /Frame /FrameMonPredAt=> ->. by rewrite monPred_at_fupd. Qed.
End bi.
(* When P and/or Q are evars when doing typeclass search on [IntoWand
   (R i) P Q], we use [MakeMonPredAt] in order to normalize the
   result of unification. However, when they are not evars, we want to
   propagate the known information through typeclass search. Hence, we
   do not want to use [MakeMonPredAt].

   As a result, depending on P and Q being evars, we use a different
   version of [into_wand_monPred_at_xx_xx]. *)
Global Hint Extern 3 (IntoWand _ _ (monPred_at _ _) ?P ?Q) =>
     is_evar P; is_evar Q;
     eapply @into_wand_monPred_at_unknown_unknown
     : typeclass_instances.
Global Hint Extern 2 (IntoWand _ _ (monPred_at _ _) ?P (monPred_at ?Q _)) =>
     eapply @into_wand_monPred_at_unknown_known
     : typeclass_instances.
Global Hint Extern 2 (IntoWand _ _ (monPred_at _ _) (monPred_at ?P _) ?Q) =>
     eapply @into_wand_monPred_at_known_unknown_le
     : typeclass_instances.
Global Hint Extern 2 (IntoWand _ _ (monPred_at _ _) (monPred_at ?P _) ?Q) =>
     eapply @into_wand_monPred_at_known_unknown_ge
     : typeclass_instances.

Section modal.
Context {I : biIndex} {PROP : bi}.
Local Notation monPred := (monPred I PROP).
Implicit Types P Q R : monPred.
Implicit Types 𝓟 𝓠 𝓡 : PROP.
Implicit Types φ : Prop.
Implicit Types i j : I.

Global Instance elim_modal_at_fupd_goal `{!BiFUpd PROP} φ p p' E1 E2 E3 𝓟 𝓟' Q Q' i :
  ElimModal φ p p' 𝓟 𝓟' (|={E1,E3}=> Q i) (|={E2,E3}=> Q' i) →
  ElimModal φ p p' 𝓟 𝓟' ((|={E1,E3}=> Q) i) ((|={E2,E3}=> Q') i).
Proof. by rewrite /ElimModal !monPred_at_fupd. Qed.
Global Instance elim_modal_at_fupd_hyp `{!BiFUpd PROP} φ p p' E1 E2 P 𝓟 𝓟' 𝓠 𝓠' i :
  MakeMonPredAt i P 𝓟 →
  ElimModal φ p p' (|={E1,E2}=> 𝓟) 𝓟' 𝓠 𝓠' →
  ElimModal φ p p' ((|={E1,E2}=> P) i) 𝓟' 𝓠 𝓠'.
Proof. by rewrite /MakeMonPredAt /ElimModal monPred_at_fupd=><-. Qed.

Global Instance elim_acc_at_None `{!BiFUpd PROP} {X} φ E1 E2 E3 E4 α α' β β' P P'x i :
  (∀ x, MakeEmbed (α x) (α' x)) → (∀ x, MakeEmbed (β x) (β' x)) →
  ElimAcc (X:=X) φ (fupd E1 E2) (fupd E3 E4) α' β' (λ _, None) P P'x →
  ElimAcc (X:=X) φ (fupd E1 E2) (fupd E3 E4) α β (λ _, None) (P i) (λ x, P'x x i).
Proof.
  rewrite /ElimAcc /MakeEmbed. iIntros (Hα Hβ HEA ?) "Hinner Hacc".
  iApply (HEA with "[Hinner]"); first done.
  - iIntros (x).  iSpecialize ("Hinner" $! x). rewrite -Hα. by iIntros (? <-).
  - iMod "Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]". iModIntro. iExists x.
    rewrite -Hα -Hβ. iFrame. iIntros (? _) "Hβ". by iApply "Hclose".
Qed.
Global Instance elim_acc_at_Some `{!BiFUpd PROP} {X} φ E1 E2 E3 E4 α α' β β' γ γ' P P'x i :
  (∀ x, MakeEmbed (α x) (α' x)) →
  (∀ x, MakeEmbed (β x) (β' x)) →
  (∀ x, MakeEmbed (γ x) (γ' x)) →
  ElimAcc (X:=X) φ (fupd E1 E2) (fupd E3 E4) α' β' (λ x, Some (γ' x)) P P'x →
  ElimAcc (X:=X) φ (fupd E1 E2) (fupd E3 E4) α β (λ x, Some (γ x)) (P i) (λ x, P'x x i).
Proof.
  rewrite /ElimAcc /MakeEmbed. iIntros (Hα Hβ Hγ HEA ?) "Hinner Hacc".
  iApply (HEA with "[Hinner]"); first done.
  - iIntros (x).  iSpecialize ("Hinner" $! x). rewrite -Hα. by iIntros (? <-).
  - iMod "Hacc". iDestruct "Hacc" as (x) "[Hα Hclose]". iModIntro. iExists x.
    rewrite -Hα -Hβ -Hγ. iFrame. iIntros (? _) "Hβ /=". by iApply "Hclose".
Qed.

Global Instance add_modal_at_fupd_goal `{!BiFUpd PROP} E1 E2 𝓟 𝓟' Q i :
  AddModal 𝓟 𝓟' (|={E1,E2}=> Q i) → AddModal 𝓟 𝓟' ((|={E1,E2}=> Q) i).
Proof. by rewrite /AddModal !monPred_at_fupd. Qed.

(* This hard-codes the fact that ElimInv with_close returns a
   [(λ _, ...)] as Q'. *)
Global Instance elim_inv_embed_with_close {X : Type} φ
    𝓟inv 𝓟in (𝓟out 𝓟close : X → PROP)
    Pin (Pout Pclose : X → monPred)
    Q Q' :
  (∀ i, ElimInv φ 𝓟inv 𝓟in 𝓟out (Some 𝓟close) (Q i) (λ _, Q' i)) →
  MakeEmbed 𝓟in Pin → (∀ x, MakeEmbed (𝓟out x) (Pout x)) →
  (∀ x, MakeEmbed (𝓟close x) (Pclose x)) →
  ElimInv (X:=X) φ ⎡𝓟inv⎤ Pin Pout (Some Pclose) Q (λ _, Q').
Proof.
  rewrite /MakeEmbed /ElimInv=>H <- Hout Hclose ?. iStartProof PROP.
  setoid_rewrite <-Hout. setoid_rewrite <-Hclose.
  iIntros (?) "(?&?&HQ')". iApply H; [done|]. iFrame. iIntros (x) "?".
  by iApply "HQ'".
Qed.
Global Instance elim_inv_embed_without_close  {X : Type}
    φ 𝓟inv 𝓟in (𝓟out : X → PROP) Pin (Pout : X → monPred) Q (Q' : X → monPred) :
  (∀ i, ElimInv φ 𝓟inv 𝓟in 𝓟out None (Q i) (λ x, Q' x i)) →
  MakeEmbed 𝓟in Pin → (∀ x, MakeEmbed (𝓟out x) (Pout x)) →
  ElimInv (X:=X) φ ⎡𝓟inv⎤ Pin Pout None Q Q'.
Proof.
  rewrite /MakeEmbed /ElimInv=>H <-Hout ?. iStartProof PROP.
  setoid_rewrite <-Hout.
  iIntros (?) "(?&?&HQ')". iApply H; [done|]. iFrame. iIntros (x) "?".
  by iApply "HQ'".
Qed.
End modal.


Require Import Coq.Strings.String.
Require Import Coq.ZArith.ZArith.
Require Import riscv.Utility.Monads.
Require Import riscv.Utility.MonadNotations.
Require Import riscv.Spec.Decode.
Require Import riscv.Spec.Machine.
Require Import riscv.Utility.Utility.
Require Import riscv.Spec.Primitives.
Require Import Coq.Lists.List. Import ListNotations.
Require Import coqutil.Datatypes.List.
Require Import coqutil.Datatypes.ListSet.
Require Export riscv.Platform.RiscvMachine.
Require Import coqutil.Z.Lia.
Require Import coqutil.Map.Interface.
Require Import coqutil.Map.Properties.
Require Import coqutil.Datatypes.PropSet.
Require Import coqutil.Tactics.Tactics.
Require Import riscv.Platform.Sane.

Local Open Scope Z_scope.
Local Open Scope bool_scope.

Class MMIOSpec{width: Z}{BW: Bitwidth width}{word: word width} := {
  (* should not say anything about alignment, just whether it's in the MMIO range *)
  isMMIOAddr: word -> Prop;

  (* alignment and load size checks *)
  isMMIOAligned: nat -> word -> Prop;
}.

Section Riscv.
  Context {width: Z} {BW: Bitwidth width} {word: word width} {word_ok: word.ok word}.
  Context {Mem: map.map word byte} {Registers: map.map Register word}.

  Definition signedByteTupleToReg{n: nat}(v: HList.tuple byte n): word :=
    word.of_Z (BitOps.signExtend (8 * Z.of_nat n) (LittleEndian.combine n v)).

  Definition mmioLoadEvent(addr: word){n: nat}(v: HList.tuple byte n): LogItem :=
    ((map.empty, "MMIOREAD"%string, [addr]), (map.empty, [signedByteTupleToReg v])).

  Definition mmioStoreEvent(addr: word){n: nat}(v: HList.tuple byte n): LogItem :=
    ((map.empty, "MMIOWRITE"%string, [addr; signedByteTupleToReg v]), (map.empty, [])).

  Context {mmio_spec: MMIOSpec}.

  Definition nonmem_store(n: nat)(ctxid: SourceType) a v mach post :=
    isMMIOAddr a /\ isMMIOAligned n a /\
    post (withXAddrs (invalidateWrittenXAddrs n a mach.(getXAddrs))
         (withLogItem (@mmioStoreEvent a n v)
         mach)).

  Definition store(n: nat)(ctxid: SourceType) a v mach post :=
    match Memory.store_bytes n mach.(getMem) a v with
    | Some m => post (withXAddrs (invalidateWrittenXAddrs n a mach.(getXAddrs)) (withMem m mach))
    | None => nonmem_store n ctxid a v mach post
    end.

  Definition nonmem_load(n: nat)(ctxid: SourceType) a mach (post: _ -> _ -> Prop) :=
    isMMIOAddr a /\ isMMIOAligned n a /\
    forall v, post v (withLogItem (@mmioLoadEvent a n v) mach).

  Definition load(n: nat)(ctxid: SourceType) a mach post :=
    (ctxid = Fetch -> isXAddr4 a mach.(getXAddrs)) /\
    match Memory.load_bytes n mach.(getMem) a with
    | Some v => post v mach
    | None => nonmem_load n ctxid a mach post
    end.

  Instance IsRiscvMachine: RiscvProgram (Post RiscvMachine) word. refine ({|
    getRegister reg := fun mach post => _;
    setRegister reg v := fun mach post => _;
    loadByte   ctxid a := fun mach post => _;
    loadHalf   ctxid a := fun mach post => _;
    loadWord   ctxid a := fun mach post => _;
    loadDouble ctxid a := fun mach post => _;
    storeByte   ctxid a v := fun mach post => _;
    storeHalf   ctxid a v := fun mach post => _;
    storeWord   ctxid a v := fun mach post => _;
    storeDouble ctxid a v := fun mach post => _;
    makeReservation _  := fun _ _ => False;
    clearReservation _ := fun _ _ => False;
    checkReservation _ := fun _ _ => False;
    getPC := fun mach post => _;
    setPC newPC := fun mach post => _;
    getCSRField _      := fun _ _ => False;
    setCSRField _ _    := fun _ _ => False;
    getPrivMode        := fun _ _ => False;
    setPrivMode _      := fun _ _ => False;
    fence _ _          := fun _ _ => False;
    endCycleEarly _    := fun _ _ => False;
    endCycleNormal     := fun mach post => _;
  |}).
  (* TODO: inline the terms below into the holes above while keeping Coq's typechecker happy *)
  - exact (let v :=
        if Z.eq_dec reg 0 then word.of_Z 0
        else match map.get mach.(getRegs) reg with
             | Some x => x
             | None => word.of_Z 0 end in
           post v mach).
  - exact (let regs := if Z.eq_dec reg Register0
                       then mach.(getRegs)
                       else map.put mach.(getRegs) reg v in
      post tt (withRegs regs mach)).
  - exact (load 1 ctxid a mach post).
  - exact (load 2 ctxid a mach post).
  - exact (load 4 ctxid a mach post).
  - exact (load 8 ctxid a mach post).
  - exact (store 1 ctxid a v mach (post tt)).
  - exact (store 2 ctxid a v mach (post tt)).
  - exact (store 4 ctxid a v mach (post tt)).
  - exact (store 8 ctxid a v mach (post tt)).
  - exact (post mach.(getPc) mach).
  - exact (post tt (withNextPc newPC mach)).
  - exact (post tt (withPc mach.(getNextPc) (withNextPc (word.add mach.(getNextPc) (word.of_Z 4)) mach))).
  Defined.

  Definition MinimalMMIOPrimitivesParams: PrimitivesParams (Post RiscvMachine) RiscvMachine := {|
    Primitives.mcomp_sat A (m: Post RiscvMachine A) mach post := m mach post;
    Primitives.is_initial_register_value x := True;
    Primitives.nonmem_load := nonmem_load;
    Primitives.nonmem_store := nonmem_store;
    Primitives.valid_machine mach :=
      map.undef_on mach.(getMem) isMMIOAddr /\ disjoint (of_list mach.(getXAddrs)) isMMIOAddr;
  |}.

  Lemma load_weaken_post n c a m (post1 post2:_->_->Prop)
    (H: forall r s, post1 r s -> post2 r s)
    : load n c a m post1 -> load n c a m post2.
  Proof.
    cbv [load nonmem_load].
    destruct (Memory.load_bytes n (getMem m) a); intuition eauto.
  Qed.

  Lemma store_weaken_post n c a v m (post1 post2:_->Prop)
    (H: forall s, post1 s -> post2 s)
    : store n c a v m post1 -> store n c a v m post2.
  Proof.
    cbv [store nonmem_store].
    destruct (Memory.store_bytes n (getMem m) a); intuition eauto.
  Qed.

  (* all the monadic riscv computations we will construct satisfy weakening, but it is not
     explicit from the type *)
  Definition weakening_for{S A: Type}(m: Post S A): Prop :=
    forall post1 post2: A -> S -> Prop,
      (forall a s, post1 a s -> post2 a s) ->
      forall s, m s post1 -> m s post2.

  Global Instance MinimalMMIOSatisfies_mcomp_sat_spec: mcomp_sat_spec MinimalMMIOPrimitivesParams.
  Proof.
    split; cbv [mcomp_sat MinimalMMIOPrimitivesParams Bind Return Post_Monad
                PostMonadOperations.weaken]; intros. 2: reflexivity.
    (* spec_Bind *)
    split; intros.
    - destruct H as (mid & ? & ?).
      (* can't get weakening because the type "Post RiscvMachine A" does not guarantee that all
         its inhabitant were constructed using the RiscvProgram primitives *)
  Abort.

  Lemma preserve_undef_on{memOk: map.ok Mem}: forall n (m m': Mem) a w s,
      Memory.store_bytes n m a w = Some m' ->
      map.undef_on m s ->
      map.undef_on m' s.
  Proof.
    eauto using map.same_domain_preserves_undef_on, Memory.store_bytes_preserves_domain.
  Qed.

  Global Instance MinimalMMIOPrimitivesSane{memOk: map.ok Mem} :
    PrimitivesSane MinimalMMIOPrimitivesParams.
  Abort.

  Global Instance MinimalMMIOSatisfiesPrimitives{memOk: map.ok Mem} :
    Primitives MinimalMMIOPrimitivesParams.
  Abort.

End Riscv.


Require Import Coq.Lists.List.
Import ListNotations.
Require bedrock2Examples.Demos.
Require Import coqutil.Decidable.
Require Import compiler.ExprImp.
Require Import compiler.NameGen.
Require Import compiler.Pipeline.
Require Import riscv.Spec.Decode.
Require Import riscv.Utility.Words32Naive.
Require Import riscv.Utility.DefaultMemImpl32.
Require Import riscv.Utility.Monads.
Require Import compiler.util.Common.
Require Import coqutil.Decidable.
Require        riscv.Utility.InstructionNotations.
Require Import riscv.Platform.MinimalLogging.
Require Import bedrock2.MetricLogging.
Require Import riscv.Platform.MetricMinimal.
Require Import riscv.Utility.Utility.
Require Import riscv.Utility.Encode.
Require Import coqutil.Map.SortedList.
Require Import compiler.MemoryLayout.
Require Import compiler.StringNameGen.
Require Import riscv.Utility.InstructionCoercions.
Require Import riscv.Platform.MetricRiscvMachine.
Require bedrock2.Hexdump.
Require Import bedrock2Examples.swap.
Require Import bedrock2Examples.stackalloc.
Require Import compilerExamples.SpillingTests.

Open Scope Z_scope.
Open Scope string_scope.
Open Scope ilist_scope.

Definition var: Set := Z.
Definition Reg: Set := Z.

Local Existing Instance DefaultRiscvState.

Axiom TODO: forall {T: Type}, T.

Local Instance funpos_env: map.map string Z := SortedListString.map _.

Definition compile_ext_call(posenv: funpos_env)(mypos stackoffset: Z)(s: FlatImp.stmt Z) :=
  match s with
  | FlatImp.SInteract _ fname _ =>
    if string_dec fname "nop" then
      [[Addi Register0 Register0 0]]
    else
      nil
  | _ => []
  end.

Notation RiscvMachine := MetricRiscvMachine.

Local Existing Instance coqutil.Map.SortedListString.map.
Local Existing Instance coqutil.Map.SortedListString.ok.

Definition main_stackalloc :=
  ("main", ([]: list String.string, []: list String.string,
     cmd.stackalloc "x" 4 (cmd.stackalloc "y" 4 (cmd.call [] "swap_swap" [expr.var "x"; expr.var "y"])))).

Definition allFuns: list Syntax.func := [swap; swap_swap; main_stackalloc; stacknondet; stackdisj; long1].

Definition e := map.putmany_of_list allFuns map.empty.

(* stack grows from high addreses to low addresses, first stack word will be written to
   (stack_pastend-8), next stack word to (stack_pastend-16) etc *)
Definition stack_pastend: Z := 2048.

Lemma f_equal2: forall {A B: Type} {f1 f2: A -> B} {a1 a2: A},
    f1 = f2 -> a1 = a2 -> f1 a1 = f2 a2.
Proof. intros. congruence. Qed.

Lemma f_equal3: forall {A B C: Type} {f1 f2: A -> B -> C} {a1 a2: A} {b1 b2: B},
    f1 = f2 -> a1 = a2 -> b1 = b2 -> f1 a1 b1 = f2 a2 b2.
Proof. intros. congruence. Qed.

Lemma f_equal3_dep: forall {A B C: Type} {f1 f2: A -> B -> C} {a1 a2: A} {b1 b2: B},
    f1 = f2 -> a1 = a2 -> b1 = b2 -> f1 a1 b1 = f2 a2 b2.
Proof. intros. congruence. Qed.

Local Instance RV32I_bitwidth: FlatToRiscvCommon.bitwidth_iset 32 RV32I.
Proof. reflexivity. Qed.

Definition swap_asm: list Instruction.
  let r := eval cbv in (compile compile_ext_call e) in set (res := r).
  match goal with
  | res := Success (?x, _, _) |- _ => exact x
  end.
Defined.

Module PrintAssembly.
  Import riscv.Utility.InstructionNotations.
  Goal True. let r := eval unfold swap_asm in swap_asm in idtac (* r *). Abort.
  (*
  swap_swap:
     addi    x2, x2, -20   // decrease sp
     sw      x2, x1, 8     // save ra
     sw      x2, x3, 0     // save registers modified by swap_swap
     sw      x2, x4, 4
     lw      x3, x2, 12    // load args
     lw      x4, x2, 16
     sw      x2, x3, -8    // store args for first call to swap
     sw      x2, x4, -4
     jal     x1, 36        // first call to swap
     sw      x2, x3, -8    // store args for second call to swap
     sw      x2, x4, -4
     jal     x1, 24        // second call to swap
     lw      x3, x2, 0     // restore registers modified by swap_swap
     lw      x4, x2, 4
     lw      x1, x2, 8     // load ra
     addi    x2, x2, 20    // increase sp
     jalr    x0, x1, 0     // return

  swap:
     addi    x2, x2, -28   // decrease sp
     sw      x2, x1, 16    // save ra
     sw      x2, x5, 0     // save registers modified by swap
     sw      x2, x6, 4
     sw      x2, x3, 8
     sw      x2, x4, 12
     lw      x3, x2, 20    // load args
     lw      x4, x2, 24
     lw      x5, x4, 0     // body of swap
     lw      x6, x3, 0
     sw      x4, x6, 0
     sw      x3, x5, 0
     lw      x5, x2, 0     // restore registers modified by swap
     lw      x6, x2, 4
     lw      x3, x2, 8
     lw      x4, x2, 12
     lw      x1, x2, 16    // restore ra
     addi    x2, x2, 28    // increase sp
     jalr    x0, x1, 0     // return

  stacknondet:
     addi    x2, x2, -56
     sw      x2, x1, 44
     sw      x2, x5, 4
     sw      x2, x6, 8
     sw      x2, x7, 12
     sw      x2, x3, 16
     sw      x2, x8, 20
     sw      x2, x9, 24
     sw      x2, x10, 28
     sw      x2, x11, 32
     sw      x2, x12, 36
     sw      x2, x4, 40
     addi    x5, x2, 0
     lw      x6, x5, 0
     addi    x7, x0, 8
     srl     x3, x6, x7
     addi    x8, x0, 3
     add     x9, x3, x8
     addi    x10, x0, 42
     sb      x9, x10, 0
     lw      x11, x5, 0
     addi    x12, x0, 8
     srl     x4, x11, x12
     sw      x2, x3, 48
     sw      x2, x4, 52
     lw      x5, x2, 4
     lw      x6, x2, 8
     lw      x7, x2, 12
     lw      x3, x2, 16
     lw      x8, x2, 20
     lw      x9, x2, 24
     lw      x10, x2, 28
     lw      x11, x2, 32
     lw      x12, x2, 36
     lw      x4, x2, 40
     lw      x1, x2, 44
     addi    x2, x2, 56
     jalr    x0, x1, 0

  stackdisj:
     addi    x2, x2, -28
     sw      x2, x1, 16
     sw      x2, x3, 8
     sw      x2, x4, 12
     addi    x3, x2, 4
     addi    x4, x2, 0
     sw      x2, x3, 20
     sw      x2, x4, 24
     lw      x3, x2, 8
     lw      x4, x2, 12
     lw      x1, x2, 16
     addi    x2, x2, 28
     jalr    x0, x1, 0

  main:
     addi    x2, x2, -20   // decrease sp
     sw      x2, x1, 16    // save ra
     sw      x2, x3, 8     // save registers modified by main
     sw      x2, x4, 12
     addi    x3, x2, 4     // first stackalloc invocation returns sp+4
     addi    x4, x2, 0     // second stackalloc invocation returns sp
     sw      x2, x3, -8    // store args for call to swap_swap
     sw      x2, x4, -4
     jal     x1, -380      // call swap_swap
     lw      x3, x2, 8     // restore registers modified by main
     lw      x4, x2, 12
     lw      x1, x2, 16    // restore ra
     addi    x2, x2, 20    // increase sp
     jalr    x0, x1, 0     // return
  *)
End PrintAssembly.

Definition swap_as_bytes: list Byte.byte := instrencode swap_asm.

Module PrintBytes.
  Import bedrock2.Hexdump.
  Local Open Scope hexdump_scope.
  Set Printing Width 100.
  Goal True. let x := eval cbv in swap_as_bytes in idtac (* x *). Abort.
End PrintBytes.


(**************************************************************************)
(*  This file is part of CertrBPF,                                        *)
(*  a formally verified rBPF verifier + interpreter + JIT in Coq.         *)
(*                                                                        *)
(*  Copyright (C) 2022 Inria                                              *)
(*                                                                        *)
(*  This program is free software; you can redistribute it and/or modify  *)
(*  it under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation; either version 2 of the License, or     *)
(*  (at your option) any later version.                                   *)
(*                                                                        *)
(*  This program is distributed in the hope that it will be useful,       *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
(*  GNU General Public License for more details.                          *)
(*                                                                        *)
(**************************************************************************)

(** Definition of matching relation between Coq and C representation *)
From bpf.comm Require Import MemRegion Regs Flag ListAsArray.
From compcert Require Import Coqlib Integers Values AST Clight Memory Memtype.

From bpf.clightlogic Require Import Clightlogic.
From bpf.verifier.comm Require Import state.
From Coq Require Import ZArith.
Open Scope Z_scope.

Global Transparent Archi.ptr64.

Definition match_list_ins (m:mem) (b: block) (l: list int64) :=
  forall i, (0 <= i < List.length l)%nat ->
    Mem.loadv AST.Mint64 m  (Vptr b (Ptrofs.repr (8 * (Z.of_nat i)))) = Some (Vlong (List.nth i l Int64.zero)).

Definition match_ins (ins_blk: block) (st: state.state) (m:mem) :=
  List.length (ins st) = (ins_len st) /\
  Z.of_nat (List.length (ins st)) * 8 <= Ptrofs.max_unsigned /\
  match_list_ins m ins_blk (ins st).

Class special_blocks : Type :=
  { st_blk : block;
    ins_blk  : block }.

Section S.

  Context {Blocks : special_blocks}.

  Record match_state  (st: state.state) (m: mem) : Prop :=
    {
      munchange: Mem.unchanged_on (fun b _ => b <> st_blk /\ b <> ins_blk) (bpf_m st) m;
      mins_len : Mem.loadv AST.Mint32 m (Vptr st_blk (Ptrofs.repr 0)) = Some (Vint  (Int.repr (Z.of_nat (ins_len st)))) /\ Z.of_nat (ins_len st) >= 1;
      mins     : Mem.loadv AST.Mptr m (Vptr st_blk (Ptrofs.repr 4)) = Some (Vptr ins_blk (Ptrofs.repr 0)) /\ match_ins ins_blk st m;
      mperm    : Mem.range_perm m st_blk 0 8 Cur Freeable /\
                 Mem.range_perm m ins_blk 0 (Z.of_nat (ins_len st)) Cur Readable;
      minvalid : (~Mem.valid_block (bpf_m st) st_blk /\
                  ~Mem.valid_block (bpf_m st) ins_blk) /\
                 (ins_blk <> st_blk) /\
                 (forall b, b <> st_blk /\ b <> ins_blk ->
                  Mem.valid_block m b -> Mem.valid_block (bpf_m st) b);
    }.

End S.

#[global] Notation dcons := (DList.DCons (F:= fun x => x -> Inv state.state)).

Ltac split_conj :=
  match goal with
  | |- ?X <> ?Y /\ _ =>
    split; [intro Hfalse; inversion Hfalse | split_conj]
  | |- ?X <> ?Y =>
    intro Hfalse; inversion Hfalse
  end.