(** This files extends the implementation of finite over [positive] to finite
maps whose keys range over Coq's data type of binary naturals [N]. *)
From stdpp Require Import pmap mapset.
From stdpp Require Export prelude fin_maps.
From stdpp Require Import options.

Local Open Scope N_scope.

Record Nmap (A : Type) : Type := NMap { Nmap_0 : option A; Nmap_pos : Pmap A }.
Global Arguments Nmap_0 {_} _ : assert.
Global Arguments Nmap_pos {_} _ : assert.
Global Arguments NMap {_} _ _ : assert.

Global Instance Nmap_eq_dec `{EqDecision A} : EqDecision (Nmap A).
Proof.
 refine (λ t1 t2,
  match t1, t2 with
  | NMap x t1, NMap y t2 => cast_if_and (decide (x = y)) (decide (t1 = t2))
  end); abstract congruence.
Defined.
Global Instance Nempty {A} : Empty (Nmap A) := NMap None ∅.
Global Opaque Nempty.
Global Instance Nlookup {A} : Lookup N A (Nmap A) := λ i t,
  match i with
  | N0 => Nmap_0 t
  | Npos p => Nmap_pos t !! p
  end.
Global Instance Npartial_alter {A} : PartialAlter N A (Nmap A) := λ f i t,
  match i, t with
  | N0, NMap o t => NMap (f o) t
  | Npos p, NMap o t => NMap o (partial_alter f p t)
  end.
Global Instance Nto_list {A} : FinMapToList N A (Nmap A) := λ t,
  match t with
  | NMap o t =>
     from_option (λ x, [(0,x)]) [] o ++ (prod_map Npos id <$> map_to_list t)
  end.
Global Instance Nomap: OMap Nmap := λ A B f t,
  match t with NMap o t => NMap (o ≫= f) (omap f t) end.
Global Instance Nmerge: Merge Nmap := λ A B C f t1 t2,
  match t1, t2 with
  | NMap o1 t1, NMap o2 t2 => NMap (diag_None f o1 o2) (merge f t1 t2)
  end.
Global Instance Nfmap: FMap Nmap := λ A B f t,
  match t with NMap o t => NMap (f <$> o) (f <$> t) end.

Global Instance: FinMap N Nmap.
Proof.
  split.
  - intros ? [??] [??] H. f_equal; [apply (H 0)|].
    apply map_eq. intros i. apply (H (Npos i)).
  - by intros ? [|?].
  - intros ? f [? t] [|i]; simpl; [done |]. apply lookup_partial_alter.
  - intros ? f [? t] [|i] [|j]; simpl; try intuition congruence.
    intros. apply lookup_partial_alter_ne. congruence.
  - intros ??? [??] []; simpl; [done|]. apply lookup_fmap.
  - intros ? [[x|] t]; unfold map_to_list; simpl.
    + constructor.
      * rewrite elem_of_list_fmap. by intros [[??] [??]].
      * by apply (NoDup_fmap _), NoDup_map_to_list.
    + apply (NoDup_fmap _), NoDup_map_to_list.
  - intros ? t i x. unfold map_to_list. split.
    + destruct t as [[y|] t]; simpl.
      * rewrite elem_of_cons, elem_of_list_fmap.
        intros [? | [[??] [??]]]; simplify_eq/=; [done |].
        by apply elem_of_map_to_list.
      * rewrite elem_of_list_fmap; intros [[??] [??]]; simplify_eq/=.
        by apply elem_of_map_to_list.
    + destruct t as [[y|] t]; simpl.
      * rewrite elem_of_cons, elem_of_list_fmap.
        destruct i as [|i]; simpl; [intuition congruence |].
        intros. right. exists (i, x). by rewrite elem_of_map_to_list.
      * rewrite elem_of_list_fmap.
        destruct i as [|i]; simpl; [done |].
        intros. exists (i, x). by rewrite elem_of_map_to_list.
  - intros ?? f [??] [|?]; simpl; [done|]; apply (lookup_omap f).
  - intros ??? f [??] [??] [|?]; simpl; [done|]; apply (lookup_merge f).
Qed.

(** * Finite sets *)
(** We construct sets of [N]s satisfying extensional equality. *)
Notation Nset := (mapset Nmap).
Global Instance Nmap_dom {A} : Dom (Nmap A) Nset := mapset_dom.
Global Instance: FinMapDom N Nmap Nset := mapset_dom_spec.


Require Import List.
Require Export Util Get Drop Var Val Isa.Ops IL.Exp
        Envs Map CSet AutoIndTac MoreList OptionMap.
Require Export IL.Events SizeInduction SmallStepRelations StateType.
Require Import SetOperations.

Set Implicit Arguments.

(** * Intermediate Language IL *)

(** ** Syntax *)

(** [args] is the type of the list of variables passed at a goto ... *)
Notation "'args'" := (list op) (at level 0).
(** ... while [params] is the type of the list of formal parameters *)
Notation "'params'" := (list var) (at level 0).

Inductive stmt : Type :=
| stmtLet    (x : var) (e: exp) (s : stmt) : stmt
| stmtIf     (e : op) (s : stmt) (t : stmt) : stmt
| stmtApp    (l : lab) (Y:args) : stmt
| stmtReturn (e : op) : stmt
(* block f Z : rt = s in b *)
| stmtFun    (F:list (params * stmt)) (t : stmt) : stmt.

Instance Stmt_size : Size stmt. gen_Size. Defined.

Lemma stmt_ind'
  : forall P : stmt -> Prop,
       (forall (x : var) (e : exp) (s : stmt), P s -> P (stmtLet x e s)) ->
       (forall (e : op) (s : stmt), P s -> forall t : stmt, P t -> P (stmtIf e s t)) ->
       (forall (l : lab) (Y : args), P (stmtApp l Y)) ->
       (forall e : op, P (stmtReturn e)) ->
       (forall (F : 〔params * stmt〕) (t : stmt),
           P t -> (forall n Zs, get F n Zs -> P (snd Zs)) -> P (stmtFun F t)) -> forall s : stmt, P s.
Proof.
  intros. sind s; destruct s; eauto.
Qed.

(** *** Free, Defined and Occuring Variables *)

Fixpoint freeVars (s:stmt) : set var :=
  match s with
    | stmtLet x e s0 => (freeVars s0 \ singleton x) ∪ Exp.freeVars e
    | stmtIf e s1 s2 => freeVars s1 ∪ freeVars s2 ∪ Ops.freeVars e
    | stmtApp l Y => list_union (List.map Ops.freeVars Y)
    | stmtReturn e => Ops.freeVars e
    | stmtFun s t =>
      list_union (List.map (fun f => (freeVars (snd f) \ of_list (fst f))) s) ∪ freeVars t
  end.

Definition defVarsZs (definedVars:stmt -> set var) (Zs:params*stmt) :=
  of_list (fst Zs) ∪ definedVars (snd Zs).

Definition definedVarsF (definedVars:stmt -> set var)
           (F:list (params*stmt)) :=
  list_union (List.map (defVarsZs definedVars) F).

Fixpoint definedVars (s:stmt) : set var :=
  match s with
    | stmtLet x e s0 => {x; definedVars s0}
    | stmtIf e s1 s2 => definedVars s1 ∪ definedVars s2
    | stmtApp l Y => ∅
    | stmtReturn e => ∅
    | stmtFun F t => (definedVarsF definedVars F) ∪ definedVars t
  end.

Fixpoint occurVars (s:stmt) : set var :=
  match s with
    | stmtLet x e s0 => {x; occurVars s0} ∪ Exp.freeVars e
    | stmtIf e s1 s2 => occurVars s1 ∪ occurVars s2 ∪ Ops.freeVars e
    | stmtApp l Y => list_union (List.map Ops.freeVars Y)
    | stmtReturn e => Ops.freeVars e
    | stmtFun s t =>
      list_union (List.map (fun f => (occurVars (snd f) ∪ of_list (fst f))) s) ∪ occurVars t
  end.

Lemma freeVars_occurVars s
: freeVars s ⊆ occurVars s.
Proof.
  sind s; destruct s; simpl in * |- *; repeat rewrite IH; eauto.
  - cset_tac.
  - rewrite list_union_f_incl. reflexivity.
    intros. destruct y; simpl.
    rewrite IH; cset_tac; intuition; eauto.
Qed.

Lemma occurVars_freeVars_definedVars s
: occurVars s [=] freeVars s ∪ definedVars s.
Proof.
  sind s; destruct s; simpl in * |- *; eauto with cset.
  - rewrite IH; eauto.
    clear_all; cset_tac.
  - repeat rewrite IH; eauto.
    clear_all; cset_tac.
  - cset_tac.
  - cset_tac.
  - rewrite IH; eauto. unfold definedVarsF, defVarsZs.
    repeat setoid_rewrite union_assoc at 1.
    setoid_rewrite union_comm at 5.
    repeat setoid_rewrite <- union_assoc.
    erewrite list_union_f_union.
    rewrite list_union_f_eq. cset_tac.
    simpl. intros. rewrite IH; eauto.
    clear; cset_tac.
Qed.

Lemma definedVars_occurVars s
: definedVars s ⊆ occurVars s.
Proof.
  sind s; destruct s; simpl in * |- *; eauto with cset.
  - unfold definedVarsF, defVarsZs.
    rewrite IH, list_union_f_incl; eauto.
    + reflexivity.
    + intros. destruct y; simpl. rewrite IH; cset_tac.
Qed.

Fixpoint externals (s:stmt) : set var :=
  match s with
  | stmtLet x e s0 => Exp.externals e ∪ externals s0
  | stmtIf e s1 s2 => externals s1 ∪ externals s2
  | stmtApp l Y => {}
  | stmtReturn e => {}
  | stmtFun F t => list_union ((fun Zs => externals (snd Zs)) ⊝ F) ∪ externals t
  end.

Definition defVars' ( Zs:params*stmt) := of_list (fst Zs) ∪ definedVars (snd Zs).

Lemma list_union_definedVars F
  : definedVarsF definedVars F
                 [=] list_union (of_list ⊝ fst ⊝ F) ∪ list_union (definedVars ⊝ snd ⊝ F).
Proof.
  unfold definedVarsF, defVarsZs.
  general induction F; simpl; eauto with cset.
  norm_lunion. rewrite IHF; clear IHF. cset_tac.
Qed.

Lemma list_union_definedVars' F
  : list_union (defVars' ⊝ F)
               [=] list_union (of_list ⊝ fst ⊝ F) ∪ list_union (definedVars ⊝ snd ⊝ F).
Proof.
  general induction F; simpl; eauto with cset.
  norm_lunion. rewrite IHF; clear IHF. unfold defVars' at 1.
  cset_tac.
Qed.

Lemma list_union_definedVarsF_decomp F
  : list_union (defVarsZs definedVars ⊝ F)
               [=] list_union (of_list ⊝ fst ⊝ F) ∪ list_union (definedVars ⊝ snd ⊝ F).
Proof.
  general induction F; simpl.
  - cset_tac.
  - norm_lunion. rewrite IHF.
    unfold defVarsZs at 1. clear.
    cset_tac.
Qed.

(** ** Semantics *)

(** *** Functional Semantics *)
Module F.

  Inductive block : Type :=
    blockI {
      block_E : onv val;
      block_Z : params;
      block_s : stmt;
      block_n : nat
    }.

  Definition labenv := list block.
  Definition state : Type := (labenv * onv val * stmt)%type.

  Definition mkBlock E n f :=
    blockI E (fst f) (snd f) n.

  Inductive step : state -> event -> state -> Prop :=
  | StepLet L E x e b v
    (def:op_eval E e = Some v)
    : step (L, E, stmtLet x (Operation e) b) EvtTau (L, E[x<-Some v], b)

  | StepExtern L E x f Y s vl v
    (def:omap (op_eval E) Y = Some vl)
    : step  (L, E, stmtLet x (Call f Y) s)
            (EvtExtern (ExternI f vl v))
            (L, E[x <- Some v], s)

  | StepIfT L E
    e (b1 b2 : stmt) v
    (def:op_eval E e = Some v)
    (condTrue: val2bool v = true)
    : step (L, E, stmtIf e b1 b2) EvtTau (L, E, b1)

  | StepIfF L E
    e (b1 b2:stmt) v
    (def:op_eval E e = Some v)
    (condFalse: val2bool v = false)
    : step (L, E, stmtIf e b1 b2) EvtTau (L, E, b2)

  | StepGoto L E (l:lab) Y blk vl
    (Ldef:get L l blk)
    (len:length (block_Z blk) = length Y)
    (def:omap (op_eval E) Y = Some vl) E'
    (updOk:(block_E blk) [block_Z blk <-- List.map Some vl] = E')
    : step  (L, E, stmtApp l Y)
            EvtTau
            (drop (l - block_n blk) L, E', block_s blk)

  | StepFun L E
    F (t:stmt)
    : step (L, E, stmtFun F t) EvtTau ((mapi (mkBlock E) F ++ L)%list, E, t).

  Lemma step_internally_deterministic
  : internally_deterministic step.
  Proof.
    hnf; intros.
    inv H; inv H0; split; eauto; try get_functional; try congruence.
  Qed.

  Lemma step_externally_determined
  : externally_determined step.
  Proof.
    hnf; intros.
    inv H; inv H0; eauto; try get_functional; try congruence.
  Qed.

  Lemma step_dec
  : reddec2 step.
  Proof.
    hnf; intros. destruct x as [[L V] []].
    - destruct e.
      + case_eq (op_eval V e); intros. left. do 2 eexists. eauto 20 using step.
        right. stuck.
      + case_eq (omap (op_eval V) Y); intros; try now (right; stuck).
        left; eexists (EvtExtern (ExternI f l (default_val))). eexists; eauto using step.
    - case_eq (op_eval V e); intros.
      left. case_eq (val2bool v); intros; do 2 eexists; eauto using step.
      right. stuck.
    - destruct (get_dec L l) as [[blk A]|?]; [ | right; stuck2 ].
      decide (length (block_Z blk) = length Y); [ | right; stuck2 ].
      case_eq (omap (op_eval V) Y); intros; [ | right; stuck2 ].
      left. do 2 eexists. econstructor; eauto.
    - right; stuck.
    - left. eexists. eauto using step.
  Qed.

  Lemma StepGoto_mapi L blk Y E E'' vl (f:lab) F k
        (Ldef:get L (f - ❬F❭) blk)
        (len:length (F.block_Z blk) = length Y)
        (def:omap (op_eval E) Y = Some vl) E'
        (updOk:F.block_E blk [F.block_Z blk <-- List.map Some vl] = E')
        (ST:f - block_n blk >= ❬mapi (F.mkBlock E'') F❭) (GE: f >= ❬F❭) (EQ:k = f - ❬F❭ - block_n blk)
    : F.step (mapi (F.mkBlock E'') F ++ L, E, stmtApp f Y) EvtTau
             (drop k L,
              E', F.block_s blk).
  Proof.
    subst.
    rewrite <- (mapi_length (F.mkBlock E'')).
    orewrite (f - ❬mapi (F.mkBlock E'') F❭ - block_n blk
              =  (f - block_n blk) - ❬mapi (F.mkBlock E'') F❭).
    rewrite <- (drop_app_gen _ (mapi (F.mkBlock E'') F)); eauto.
    eapply F.StepGoto; eauto.
    rewrite get_app_ge. rewrite mapi_length. eauto. omega.
  Qed.

End F.

(** *** Imperative Semantics *)

Module I.
  Inductive block : Type :=
    blockI {
      block_Z : params;
      block_s : stmt;
      block_n : nat
    }.

  Definition labenv := list block.
  Definition state : Type := (labenv * onv val * stmt)%type.
  Definition mkBlock n f := blockI (fst f) (snd f) n.

  Inductive step : state -> event -> state -> Prop :=
  | StepLet L E x e b v
    (def:op_eval E e = Some v)
    : step (L, E, stmtLet x (Operation e) b) EvtTau (L, E[x<-Some v], b)

  | StepExtern L E x f Y s vl v
               (def:omap (op_eval E) Y = Some vl)
    : step  (L, E, stmtLet x (Call f Y) s)
            (EvtExtern (ExternI f vl v))
            (L, E[x <- Some v], s)

  | StepIfT L E
    e (b1 b2 : stmt) v
    (def:op_eval E e = Some v)
    (condTrue: val2bool v = true)
    : step (L, E, stmtIf e b1 b2) EvtTau (L, E, b1)

  | StepIfF L E
    e (b1 b2:stmt) v
    (def:op_eval E e = Some v)
    (condFalse: val2bool v = false)
    : step (L, E, stmtIf e b1 b2) EvtTau (L, E, b2)

  | StepGoto L E (l:lab) Y blk vl
    (Ldef:get L l blk)
    (len:length (block_Z blk) = length Y)
    (def:omap (op_eval E) Y = Some vl) E'
    (updOk:E[block_Z blk  <-- List.map Some vl] = E')
    : step  (L, E, stmtApp l Y)
            EvtTau
            (drop (l - block_n blk) L, E', block_s blk)

  | StepFun L E
    s (t:stmt)
    : step (L, E, stmtFun s t) EvtTau ((mapi mkBlock s ++ L)%list, E, t).

  Lemma step_internally_deterministic
  : internally_deterministic step.
  Proof.
    hnf; intros.
    inv H; inv H0; split; eauto; try get_functional; try congruence.
  Qed.

  Lemma step_externally_determined
  : externally_determined step.
  Proof.
    hnf; intros.
    inv H; inv H0; eauto; try get_functional; try congruence.
  Qed.

  Lemma step_dec
  : reddec2 step.
  Proof.
    hnf; intros. destruct x as [[L V] []].
    - destruct e.
      + case_eq (op_eval V e); intros. left. do 2 eexists. eauto 20 using step.
        right. stuck.
      + case_eq (omap (op_eval V) Y); intros; try now (right; stuck).
        left; eexists (EvtExtern (ExternI f l default_val)). eexists; eauto using step.
    - case_eq (op_eval V e); intros.
      left. case_eq (val2bool v); intros; do 2 eexists; eauto using step.
      right. stuck.
    - destruct (get_dec L l) as [[blk A]|?]; [| right; stuck2].
      decide (length (block_Z blk) = length Y); [| right; stuck2].
      case_eq (omap (op_eval V) Y); intros; [| right; stuck2].
      left. do 2 eexists. econstructor; eauto.
    - right. stuck2.
    - left. eexists. eauto using step.
  Qed.

  Lemma StepGoto_mapi L blk Y E vl (f:lab) F k
        (Ldef:get L (f - ❬F❭) blk)
        (len:length (I.block_Z blk) = length Y)
        (def:omap (op_eval E) Y = Some vl) E'
        (updOk:E [I.block_Z blk <-- List.map Some vl] = E')
        (ST:f - block_n blk >= ❬mapi I.mkBlock F❭)
        (GE:f >= ❬F❭) (EQ:k = f - ❬F❭ - block_n blk)
    : I.step (mapi I.mkBlock F ++ L, E, stmtApp f Y) EvtTau
             (drop k L,
              E', I.block_s blk).
  Proof.
    subst.
    rewrite <- (mapi_length I.mkBlock).
    orewrite (f - ❬mapi I.mkBlock F❭ - block_n blk
              =  (f - block_n blk) - ❬mapi I.mkBlock F❭).
    rewrite <- (drop_app_gen _ (mapi I.mkBlock F)); eauto.
    eapply I.StepGoto; eauto.
    rewrite get_app_ge. rewrite mapi_length. eauto. omega.
  Qed.

End I.

Definition state_result X (s:X*onv val*stmt) : option val :=
  match s with
    | (_, E, stmtReturn e) => op_eval E e
    | _ => None
  end.

Instance statetype_F : StateType F.state := {
  step := F.step;
  result := (@state_result F.labenv);
  step_dec := F.step_dec;
  step_internally_deterministic := F.step_internally_deterministic;
  step_externally_determined := F.step_externally_determined
}.

Instance statetype_I : StateType I.state := {
  step := I.step;
  result := (@state_result I.labenv);
  step_dec := I.step_dec;
  step_internally_deterministic := I.step_internally_deterministic;
  step_externally_determined := I.step_externally_determined
}.

Ltac single_step_IL :=
  match goal with
  | [ H : agree_on _ ?E ?E', I : val2bool (?E ?x) = true |- step (_, ?E', stmtIf ?x _ _) _ ] =>
    econstructor; eauto; rewrite <- H; eauto; cset_tac; intuition
  | [ H : agree_on _ ?E ?E', I : val2bool (?E ?x) = false |- step (_, ?E', stmtIf ?x _ _) _ ] =>
    econstructor 3; eauto; rewrite <- H; eauto; cset_tac; intuition
  | [ H : val2bool _ = false |- @StateType.step _ statetype_I _ _ _ ] =>
    econstructor 4; try eassumption; try reflexivity
  | [ H : val2bool _ = false |- @StateType.step _ statetype_F _ _ _ ] =>
    econstructor 4; try eassumption; try reflexivity
  | [ H : val2bool _ = true |- @StateType.step _ statetype_I _ _ _ ] =>
    econstructor 3; try eassumption; try reflexivity
  | [ H : val2bool _ = true |- @StateType.step _ statetype_F _ _ _ ] =>
    econstructor 3; try eassumption; try reflexivity
  | [ H : step (?L, _ , stmtApp ?l _) _, H': get ?L (labN ?l) _ |- _] =>
    econstructor; try eapply H'; eauto
(*  | [ H': get ?L ?n _ |- @StateType.step _ _ (?L, _ , stmtApp (LabI ?n) _) _ _] =>
    econstructor; [ eapply H'
                  | simpl; eauto with len
                  | try eassumption
                  | reflexivity]*)
  | [ H': get ?F (labN ?l) _ |- @StateType.step _ _ (mapi _ ?F ++ _, _, stmtApp ?l _) _ _] =>
    econstructor; [ try solve [simpl; eauto using get_app, get_mapi]
                  | simpl; eauto with len
                  | try eassumption; eauto; try reflexivity
                  | reflexivity]
  | [ |- @StateType.step _ _ (?L, _ , stmtApp _ _) _ _] =>
    econstructor; [ try eassumption; try solve [simpl; eauto using get]
                  | simpl; eauto with len
                  | try eassumption; eauto; try reflexivity
                  | reflexivity]
  | [ |- @StateType.step _ _ (_, ?E, stmtLet _ (Operation ?e) _) _ _] =>
    econstructor; eauto
  | [ |- @StateType.step _ _ (_, ?E, stmtFun _ _) _ _] =>
    econstructor; eauto
  end.

Smpl Add single_step_IL : single_step.

Lemma ZL_mapi F L
  : I.block_Z ⊝ (mapi I.mkBlock F ++ L) = fst ⊝ F ++ I.block_Z ⊝ L.
Proof.
  rewrite List.map_app. rewrite map_mapi. unfold mapi.
  erewrite <- mapi_map_ext; [ reflexivity | simpl; reflexivity].
Qed.

Hint Extern 1 =>
match goal with
| [ |- context [ I.block_Z ⊝ (mapi I.mkBlock ?F ++ ?L) ] ] =>
  rewrite (ZL_mapi F L)
| [ |- context [ pair ⊜ (?A ++ ?B) (?C ++ ?D) ] ] =>
  rewrite (zip_app pair A C B D);
    [| eauto with len]
end.

Inductive noFun : stmt->Prop :=
| NoFunLet x e s :
   noFun s
   -> noFun (stmtLet x e s)
| NoFunIf e s t :
   noFun s
   -> noFun t
   -> noFun (stmtIf e s t)
| NoFunCall l Y :
   noFun (stmtApp l Y)
| NoFunExp e :
   noFun (stmtReturn e).

Inductive noCall : stmt->Prop :=
| NoCallLet x e s :
   noCall s
   -> noCall (stmtLet x (Operation e) s)
| NoCallIf e s t :
   noCall s
   -> noCall t
   -> noCall (stmtIf e s t)
| NoCallApp l Y :
   noCall (stmtApp l Y)
| NoCallExp e :
    noCall (stmtReturn e)
| NoAppCall F t
  : (forall n Zs, get F n Zs -> noCall (snd Zs))
    -> noCall t
    -> noCall (stmtFun F t).

Inductive notApp : stmt -> Prop :=
| NotAppLet x e s : notApp (stmtLet x e s)
| NotAppIf e s t : notApp (stmtIf e s t)
| NotAppReturn e : notApp (stmtReturn e)
| NotAppFun F t : notApp (stmtFun F t).


Require Import Coq.Logic.Classical.
Require Import Coq.Lists.List.
Require Import Coq.Sets.Ensembles.
Require Import CertiGraph.lib.Coqlib.
Require Import CertiGraph.lib.Ensembles_ext.
Require Import CertiGraph.lib.EquivDec_ext.
Require Import CertiGraph.lib.Relation_ext.
Require Import CertiGraph.lib.List_ext.
Require Import CertiGraph.graph.graph_model.
Require Import CertiGraph.graph.weak_mark_lemmas.
Require Import CertiGraph.graph.path_lemmas.
Require Import CertiGraph.graph.graph_gen.
Require Import CertiGraph.graph.graph_relation.
Require Import CertiGraph.graph.subgraph2.
Require Import CertiGraph.graph.reachable_computable.
Require Export CertiGraph.graph.FiniteGraph.
Require Export CertiGraph.graph.MathGraph.
Require Export CertiGraph.graph.LstGraph.
Require Export CertiGraph.graph.UnionFind.
Require Import CertiGraph.msl_application.Graph.
Require Import CertiGraph.msl_application.UnionFindGraph.

Local Open Scope logic.

Class pPointwiseGraph_GList: Type :=
  {
    addr: Type;
    null: addr;
    SGBA: PointwiseGraphBasicAssum addr (addr * unit)
  }.

#[export] Existing Instance SGBA.

Definition is_null_SGBA {pSGG: pPointwiseGraph_GList} : DecidablePred addr := (existT (fun P => forall a, {P a} + {~ P a}) (fun x => x = null) (fun x => SGBA_VE x null)).

Class sPointwiseGraph_GList {pSGG_Bi: pPointwiseGraph_GList} (DV DE: Type): Type :=
  {
    pred: Type;
    SGP: PointwiseGraphPred addr (addr * unit) (DV * addr) unit pred;
    SGA: PointwiseGraphAssum SGP;
    SGAvs: PointwiseGraphAssum_vs SGP;
    SGAvn: PointwiseGraphAssum_vn SGP null
  }.

#[export] Existing Instances SGP SGA SGAvs.

Section GRAPH_GList.

  Context {pSGG: pPointwiseGraph_GList}.
  Context {DV DE DG: Type}.

  #[global] Instance SGC_GList: PointwiseGraphConstructor addr (addr * unit) DV DE DG (DV * addr) unit.
  Proof.
    refine (Build_PointwiseGraphConstructor _ _ _ _ _ _ _ SGBA _ _).
    + exact (@vgamma addr (addr * unit) SGBA_VE SGBA_EE is_null_SGBA (fun x => (x, tt)) DV DE DG).
    + exact (fun _ _ => tt).
  Defined.

  #[global] Instance L_SGC_GList: Local_PointwiseGraphConstructor addr (addr * unit) DV DE DG (DV * addr) unit.
  Proof.
    refine (Build_Local_PointwiseGraphConstructor
              _ _ _ _ _ _ _ SGBA SGC_GList
              (fun G v => evalid (pg_lg G) (v, tt) /\ src (pg_lg G) (v, tt) = v) _
              (fun _ _ => True) _).
    - intros. simpl. unfold vgamma.  simpl. destruct H as [? ?], H0 as [? ?]. f_equal; auto. pose proof (H3 _ H H5 H0 H6). rewrite <- !H7. clear H7.
      destruct (SGBA_VE (dst (pg_lg G1) (x, tt)) null); auto.
    - intros; simpl. auto.
  Defined.

  Local Coercion UFGraph_LGraph: UFGraph >-> LGraph.
  Local Identity Coercion LGraph_LabeledGraph: LGraph >-> LabeledGraph.
  Local Coercion pg_lg: LabeledGraph >-> PreGraph.

  Notation UFGraph := (@UFGraph addr (addr * unit) _ _ is_null_SGBA (fun x => (x, tt)) DV DE DG).
  Notation LGraph := (@LGraph addr (addr * unit) _ _ DV DE DG).

  #[global] Instance RGF (G: UFGraph): ReachableFiniteGraph G.
  Proof.
    apply Build_ReachableFiniteGraph.
    intros.
    apply finite_reachable_computable with (is_null := is_null_SGBA) in H.
    - destruct H as [l [? ?]]. exists l; auto.
    - apply maGraph.
    - apply (LocalFiniteGraph_FiniteGraph G), finGraph.
    - apply (FiniteGraph_EnumCovered G), finGraph.
  Defined.

  Definition make_set_pregraph (v: addr) (g: PreGraph addr (addr * unit)) := pregraph_add_edge (pregraph_add_vertex g v) (v, tt) v null.

  Lemma is_partial_make_set_pregraph: forall x (g: UFGraph), ~ vvalid g x -> is_partial_graph g (make_set_pregraph x g).
  Proof.
    intros. hnf. simpl. unfold addValidFunc, updateEdgeFunc. split; [|split; [|split]]; intros; [left; auto..| |].
    - destruct (equiv_dec (x, tt) e); auto. hnf in e0. subst e. pose proof (@only_one_edge _ _ _ _ g _ (liGraph g) (src g (x, tt)) (x, tt) H1). simpl in H2.
      assert (src g (x, tt) = src g (x, tt) /\ evalid g (x, tt)) by (split; auto). rewrite H2 in H3. inversion H3. exfalso. rewrite H5 in H. intuition.
    - destruct (equiv_dec (x, tt) e); auto. hnf in e0. subst e. destruct (@valid_graph _ _ _ _ g _ (maGraph g) _ H0) as [? _].
      pose proof (@only_one_edge _ _ _ _ g _ (liGraph g) (src g (x, tt)) (x, tt) H2). assert (src g (x, tt) = src g (x, tt) /\ evalid g (x, tt)) by (split; auto).
      rewrite H3 in H4. inversion H4. exfalso. rewrite H6 in H. intuition.
  Qed.

  Definition make_set_LabeledGraph (v: addr) (g: LabeledGraph addr (addr * unit) DV DE DG) (default_dv: DV) (default_de: DE) (default_dg: DG) : LGraph :=
    Build_LabeledGraph _ _ _ (make_set_pregraph v g) (fun x => if SGBA_VE x v then default_dv else vlabel g x) (fun e => default_de) default_dg.

  Definition make_set_MathGraph (v: addr) (g: PreGraph addr (addr * unit)) (H: v <> null) (Hm: MathGraph g is_null_SGBA): MathGraph (make_set_pregraph v g) is_null_SGBA.
  Proof.
    apply (Build_MathGraph _ is_null_SGBA).
    - intros. simpl. unfold updateEdgeFunc, addValidFunc. destruct (equiv_dec (v, tt) e). 1: intuition. simpl in H0. unfold addValidFunc in H0. destruct H0.
      + destruct Hm. apply valid_graph in H0. destruct H0. split. 1: left; auto. hnf in H1. simpl in H1. destruct H1; [left | right; left]; auto.
      + compute in c. exfalso; intuition.
    - intros. hnf in H0. simpl in H1. destruct H0.
      + subst x. destruct Hm. apply valid_not_null in H0; auto. simpl. auto.
      + subst v. auto.
  Defined.

  Definition make_set_FiniteGraph (v: addr) (g: PreGraph addr (addr * unit)) (Hf: FiniteGraph g): FiniteGraph (make_set_pregraph v g).
  Proof.
    destruct Hf. unfold EnumEnsembles.Enumerable in *. destruct finiteV as [vl [? ?]]. destruct finiteE as [el [? ?]]. constructor; hnf; simpl; unfold addValidFunc.
    - destruct (in_dec SGBA_VE v vl).
      + exists vl. split; auto. intros. unfold In in H0 |-* . rewrite H0. intuition. subst v. rewrite H0 in i. auto.
      + exists (v :: vl). split; [constructor; auto|]. intros. simpl. unfold In in H0 |-* . rewrite H0. intuition.
    - unfold In in H2 |-* . destruct (in_dec SGBA_EE (v, tt) el).
      + exists el. split; auto. intros. rewrite H2. intuition. inversion H4. rewrite H2 in i. auto.
      + exists ((v, tt) :: el). split; [constructor; auto|]. intros. simpl. rewrite H2. intuition.
  Defined.

  Lemma make_set_valid_path_pfoot: forall (v: addr) (g: PreGraph addr (addr * unit)) x p (Hn: v <> null) (Hi: ~ vvalid g v) (Hm: MathGraph g is_null_SGBA),
      x <> v -> pfoot (make_set_pregraph v g) p = x -> valid_path (make_set_pregraph v g) p -> pfoot g p = x /\ valid_path g p.
  Proof.
    intros. destruct p as [p l]. assert (forall e, List.In e l -> e <> (v, tt)). {
      intros. apply (valid_path_strong_evalid _ _ _ e) in H1; auto. hnf in H1. simpl in H1. unfold addValidFunc, updateEdgeFunc in H1.
      destruct H1 as [? [? ?]]. intro. destruct (equiv_dec (v, tt) e). 2: compute in c; auto. destruct H4; auto. destruct Hm. apply valid_not_null in H4; simpl; auto.
    } split.
    - clear H1. revert p H0. induction l; intros. 1: simpl in H0 |-* ; auto.
      assert (forall e : addr * unit, List.In e l -> e <> (v, tt)) by (intros; apply H2; right; auto). specialize (IHl H1). clear H1.
      rewrite pfoot_cons in H0 |-* . simpl dst in H0. unfold updateEdgeFunc in H0. destruct (equiv_dec (v, tt) a).
      + hnf in e. assert (a <> (v, tt)) by (apply H2; left; auto). exfalso; auto.
      + apply IHl; auto.
    - assert (p <> v). {
        intro. subst p. destruct l. 1: simpl in H0; auto. simpl in H1. destruct H1. assert (strong_evalid (make_set_pregraph v g) p) by (destruct l; [|destruct H3]; auto).
        clear H3. hnf in H4. simpl in H4. unfold addValidFunc, updateEdgeFunc in H1, H4. destruct H4 as [? _]. assert (p <> (v, tt)) by (apply H2; left; auto).
        destruct (equiv_dec (v, tt) p). 1: hnf in e; auto. destruct H3; auto. destruct Hm. apply valid_graph in H3. destruct H3 as [? _]. rewrite <- H1 in H3. auto.
      } clear H0. revert p H1 H3. induction l; intros.
      + simpl in H1. unfold addValidFunc in H1. simpl. destruct H1; [|exfalso]; auto.
      + assert (forall e : addr * unit, List.In e l -> e <> (v, tt)) by (intros; apply H2; right; auto). specialize (IHl H0). clear H0.
        assert (a <> (v, tt)) by (apply H2; left; auto). rewrite valid_path_cons_iff in H1 |-* . destruct H1 as [? [? ?]]. split; [|split].
        * simpl in H1. unfold updateEdgeFunc in H1. destruct (equiv_dec (v, tt) a); [exfalso|]; auto.
        * hnf in H4. simpl in H4. unfold addValidFunc, updateEdgeFunc in H4. destruct H4 as [? [? ?]].
          destruct (equiv_dec (v, tt) a); [hnf in e; exfalso|]; auto. destruct H4; [|exfalso]; auto. clear c.
          destruct H6. 2: destruct Hm; apply valid_graph in H4; destruct H4; rewrite H6 in H4; exfalso; auto.
          destruct H7. 2: destruct Hm; apply valid_graph in H4; destruct H4; hnf in H8; simpl in H8; rewrite H7 in H8; exfalso; destruct H8; auto. hnf. split; auto.
        * simpl dst in H5. unfold updateEdgeFunc in H5. destruct (equiv_dec (v, tt) a); [hnf in e; exfalso|]; auto. apply IHl; auto.
          destruct H4 as [? _]. simpl in H4. unfold addValidFunc in H4. destruct H4; [|exfalso]; auto. destruct Hm. apply valid_graph in H4. destruct H4 as [_ ?].
          hnf in H4. simpl in H4. intro. rewrite H6 in H4. destruct H4; auto.
  Qed.

  Definition make_set_LstGraph (v: addr) (g: PreGraph addr (addr * unit)) (Hn: v <> null) (Hi: ~ vvalid g v) (Hm: MathGraph g is_null_SGBA)
             (Hl: LstGraph g (fun x => (x, tt))): LstGraph (make_set_pregraph v g) (fun x => (x, tt)).
  Proof.
    constructor; simpl.
    - unfold addValidFunc, updateEdgeFunc. intros. destruct H.
      + destruct Hl. specialize (only_one_edge x e H). destruct (equiv_dec (v, tt) e).
        * hnf in e0. subst e. rewrite <- only_one_edge. split; intros.
          -- destruct H0. subst v. rewrite only_one_edge. auto.
          -- rewrite only_one_edge in H0. inversion H0. subst v. split; auto.
        * compute in c. rewrite <- only_one_edge. split; intros.
          -- destruct H0. split; auto. destruct H1; auto. exfalso; auto.
          -- destruct H0. split; auto.
      + subst v. split; intros.
        * destruct H. destruct H0; auto. destruct (equiv_dec (x, tt) e).
          -- hnf in e0; auto.
          -- destruct Hm. specialize (valid_graph _ H0). destruct valid_graph. rewrite H in H1. exfalso; auto.
        * destruct (equiv_dec (x, tt) e).
          -- hnf in e0. split; auto.
          -- compute in c. exfalso; auto.
    - intros. destruct_eq_dec x v.
      + subst x. destruct p as [p l]. destruct H as [[? ?] [? _]]. simpl in H. subst p. simpl in H1. destruct l; auto. unfold updateEdgeFunc in H1. destruct H1.
        assert (strong_evalid (make_set_pregraph v g) p) by (simpl in H1; destruct l; [|destruct H1]; auto). hnf in H2. simpl in H2. unfold addValidFunc, updateEdgeFunc in H2.
        destruct H2 as [? [? ?]]. destruct (equiv_dec (v, tt) p).
        * exfalso. destruct H4; auto. destruct Hm. apply valid_not_null in H4; simpl; auto.
        * compute in c. exfalso. destruct H2; auto. destruct Hm. apply valid_graph in H2. destruct H2. subst v. auto.
      + destruct Hl. apply no_loop_path. destruct H as [[? ?] [? ?]]. assert (pfoot g p = x /\ valid_path g p) by (apply (make_set_valid_path_pfoot v); auto).
        destruct H4. split; split; auto.
  Defined.

  Definition make_set_sound (v: addr)  (g: PreGraph addr (addr * unit)) (Hn: v <> null) (Hi: ~ vvalid g v) (Hlmf: LiMaFin g) : LiMaFin (make_set_pregraph v g) :=
    Build_LiMaFin _ (make_set_LstGraph v g Hn Hi ma li) (make_set_MathGraph v g Hn ma) (make_set_FiniteGraph v g fin).

  Definition make_set_Graph (default_dv: DV) (default_de: DE) (default_dg: DG) (v: addr) (g: UFGraph) (Hn: v <> null) (Hi: ~ vvalid g v) : UFGraph :=
    Build_GeneralGraph _ _ _ _ (make_set_LabeledGraph v g default_dv default_de default_dg) (make_set_sound v g Hn Hi (sound_gg g)).

  Lemma uf_under_bound_make_set_graph: forall (default_dv: DV) (default_de: DE) (default_dg: DG) (v: addr) (g: UFGraph) (Hn: v <> null) (Hi: ~ vvalid g v) (extract: DV -> nat),
      extract default_dv = O -> uf_under_bound extract g -> uf_under_bound extract (make_set_Graph default_dv default_de default_dg v g Hn Hi).
  Proof.
    intros. hnf in H0 |-* . simpl. intro x; intros. unfold addValidFunc in H1. destruct (SGBA_VE x v).
    - hnf in e. subst v. destruct H1; [exfalso; auto |]. clear H1. hnf. intros. rewrite H. destruct p as [p l]. destruct l; simpl; auto. exfalso.
      apply pfoot_in_cons in H2. destruct H2 as [e [? ?]]. simpl in H3. unfold updateEdgeFunc in H3. pose proof (valid_path_strong_evalid _ _ _ _ H1 H2). hnf in H4.
      simpl in H4. unfold addValidFunc, updateEdgeFunc in H4. destruct H4 as [? [? ?]]. destruct (equiv_dec (x, tt) e). 1: exfalso; auto. compute in c.
      destruct H4; auto. destruct (@valid_graph _ _ _ _ g _ (maGraph g) _ H4) as [_ ?]. rewrite H3 in H7. destruct H7; auto.
    - compute in c. destruct H1; [|exfalso; auto]. hnf. intros. assert (pfoot g p = x /\ valid_path g p) by (apply (make_set_valid_path_pfoot v); auto; exact (maGraph g)).
      destruct H4. unfold uf_bound in H0. apply H0; auto.
  Qed.

  Definition single_uf_pregraph (v: addr) : PreGraph addr (addr * unit) :=
    pregraph_add_edge (single_vertex_pregraph v) (v, tt) v null.

  Lemma reachabel_single_uf: forall x y, x <> null -> reachable (single_uf_pregraph x) x y <-> x = y.
  Proof.
    intros. split; intros.
    - destruct H0 as [[? ?] [[? ?] [? _]]]. simpl in H0. subst a. destruct l.
      + simpl in H1. auto.
      + destruct H2. simpl in H2. assert (strong_evalid (single_uf_pregraph x) p) by (destruct l; intuition). clear H2. exfalso.
        hnf in H3. simpl in H3. unfold updateEdgeFunc in H3. destruct H3 as [? [_ ?]]. unfold addValidFunc in H2. destruct H2; auto. subst p.
        destruct (equiv_dec (x, tt) (x, tt)); [|compute in c]; auto.
    - subst y. apply reachable_refl. simpl. auto.
  Qed.

  Definition single_uf_LabeledGraph (v: addr) (default_dv: DV) (default_de: DE) (default_dg: DG) : LGraph :=
    Build_LabeledGraph _ _ _ (single_uf_pregraph v) (fun v => default_dv) (fun e => default_de) default_dg.

  Definition single_uf_MathGraph (v: addr) (H: v <> null): MathGraph (single_uf_pregraph v) is_null_SGBA.
  Proof.
    apply (Build_MathGraph _ is_null_SGBA).
    - intros. simpl. unfold updateEdgeFunc.
      destruct (equiv_dec (v, tt) e); intuition.
    - intros. hnf in *. subst v. intuition.
  Defined.

  Definition single_uf_FiniteGraph (v: addr): FiniteGraph (single_uf_pregraph v).
  Proof.
    constructor; hnf.
    - exists (v :: nil). split.
      + constructor. intro. inversion H. constructor.
      + intros. simpl. unfold In. intuition.
    - exists ((v, tt) :: nil). split.
      + constructor. intro. inversion H. constructor.
      + intros. simpl. unfold In, addValidFunc. intuition.
  Defined.

  Definition single_uf_LstGraph (v: addr) (H: v <> null): LstGraph (single_uf_pregraph v) (fun x => (x, tt)).
  Proof.
    constructor; simpl; intros; unfold updateEdgeFunc.
    - unfold addValidFunc. subst. destruct (equiv_dec (x, tt) e); intuition.
    - destruct H0 as [[? _] [? _]]. destruct p as [p l]. simpl in *. subst p.
      destruct l; auto. destruct H1. clear H0. simpl in H1. assert (strong_evalid (single_uf_pregraph v) p) by (destruct l; [|destruct H1]; auto). clear H1.
      hnf in H0. simpl in H0. unfold addValidFunc, updateEdgeFunc in H0. destruct H0 as [? [_ ?]]. exfalso. destruct H0; auto. subst p.
      destruct (equiv_dec (v, tt) (v, tt)); auto. compute in c. apply c; auto.
  Defined.

  Definition single_sound (v: addr) (H: v <> null) : LiMaFin (single_uf_pregraph v) :=
    Build_LiMaFin _ (single_uf_LstGraph v H) (single_uf_MathGraph v H) (single_uf_FiniteGraph v).

  Definition single_Graph (v: addr) (H: v <> null) (default_dv: DV) (default_de: DE) (default_dg: DG): UFGraph :=
    Build_GeneralGraph _ _ _ _ (single_uf_LabeledGraph v default_dv default_de default_dg) (single_sound v H).

End GRAPH_GList.


From Perennial.program_proof Require Import grove_prelude.
From Goose.github_com.mit_pdos.gokv.fencing Require Import ctr.
From Perennial.program_proof Require Import grove_prelude.
From Perennial.program_proof.grove_shared Require Export erpc_lib urpc_proof urpc_spec erpc_proof.
From Perennial.program_proof Require Export marshal_proof.
From iris.algebra Require Import cmra.
From iris.base_logic Require Export mono_nat.
From Perennial.goose_lang Require Import proph.
From Perennial.goose_lang Require Import prelude.

From Perennial.program_proof.fencing Require Export map.

Section ctr_definitions.

Context `{!gooseGlobalGS Σ}.
Context `{!heapGS Σ}.

Record ctr_names :=
{
  epoch_gn : gname ;
  epoch_token_gn : gname ;
  val_gn : gname ;
  urpc_gn : server_chan_gnames ;
  erpc_gn : erpc_names
}.

Implicit Type γ : ctr_names.

Class ctrG Σ :=
  { mnat_inG:> mono_natG Σ;
    val_inG:> mapG Σ u64 u64;
    unused_tok_inG:> mapG Σ u64 bool;
    tok_inG :> inG Σ (dfracR)
  }.

Context `{!ctrG Σ}.

Definition own_latest_epoch γ (e:u64) (q:Qp) : iProp Σ :=
  mono_nat_auth_own γ.(epoch_gn) q (int.nat e).

Definition is_latest_epoch_lb γ (e:u64) : iProp Σ :=
  mono_nat_lb_own γ.(epoch_gn) (int.nat e).

Definition is_latest_epoch_lb_strict γ (e:u64) : iProp Σ :=
  mono_nat_lb_own γ.(epoch_gn) (int.nat e + 1).

Definition own_unused_epoch γ (e:u64) : iProp Σ :=
  e ⤳[γ.(epoch_token_gn)] false.

Definition own_val γ (e:u64) (v:u64) (q:Qp): iProp Σ :=
  e ⤳[γ.(val_gn)]{# q } v ∗
  e ⤳[γ.(epoch_token_gn)]□ true.

Lemma own_val_combine γ e v1 q1 v2 q2 :
  own_val γ e v1 q1 -∗ own_val γ e v2 q2 -∗ own_val γ e v1 (q1 + q2) ∗ ⌜v1 = v2⌝.
Proof.
  iIntros "H1 H2".
  unfold own_val.
  iDestruct "H1" as "[H1 #Hepoch]".
  iDestruct "H2" as "[H2 _]".
  iDestruct (ghost_map_points_to_combine with "H1 H2") as "[$ $]".
  iFrame "#".
Qed.

Lemma own_val_split γ e v q1 q2 :
  own_val γ e v (q1 + q2) -∗ own_val γ e v q1 ∗ own_val γ e v q2.
Proof.
  iIntros "[H1 #Hepoch]".
  iDestruct "H1" as "[H1 H2]".
  iFrame "∗#".
Qed.

Lemma own_val_update v' γ e v:
  own_val γ e v 1 ==∗ own_val γ e v' 1.
Proof.
  iIntros "H1".
  iDestruct "H1" as "[H1 $]".
  iMod (ghost_map_points_to_update with "H1") as "$".
  done.
Qed.

Lemma own_latest_epoch_combine γ e1 e2 q1 q2 :
  own_latest_epoch γ e1 (q1) -∗ own_latest_epoch γ e2 q2 -∗ own_latest_epoch γ e1 (q1 + q2) ∗ ⌜e1 = e2⌝.
Proof.
  iIntros "H1 H2".
  unfold own_latest_epoch.
  iDestruct (mono_nat_auth_own_agree with "H1 H2") as %Hvalid.
  replace (e1) with (e2) by word.
  iCombine "H1 H2" as "H1".
  iFrame.
  done.
Qed.

Lemma own_latest_epoch_split γ e q1 q2 :
  own_latest_epoch γ e (q1 + q2) -∗ own_latest_epoch γ e (q1) ∗ own_latest_epoch γ e q2.
Proof.
  iIntros "H1".
  iDestruct "H1" as "[$ $]".
Qed.

Lemma own_latest_epoch_update e γ eold :
  int.nat eold ≤ int.nat e →
  own_latest_epoch γ eold 1 ==∗ own_latest_epoch γ e 1.
Proof.
  intros Hineq.
  iIntros "H1".
  iMod (mono_nat_own_update with "H1") as "[$ _]".
  { word. }
  done.
Qed.

Lemma own_latest_epoch_get_lb γ e q :
  own_latest_epoch γ e q -∗ is_latest_epoch_lb γ e.
Proof.
  iIntros "H1".
  by iApply (mono_nat_lb_own_get).
Qed.

Lemma own_latest_epoch_with_lb γ e e' q :
  own_latest_epoch γ e q -∗ is_latest_epoch_lb γ e' -∗ ⌜int.Z e' ≤ int.Z e⌝.
Proof.
  iIntros "H1 H2".
  iDestruct (mono_nat_lb_own_valid with "H1 H2") as "[_ %Hineq]".
  iPureIntro.
  word.
Qed.

End ctr_definitions.

Module ctr.
Section ctr_proof.
Context `{!ctrG Σ}.
Context `{!heapGS Σ}.
Implicit Type γ:ctr_names.

Definition unusedN := nroot .@ "unused".

Definition unused_epoch_inv γ : iProp Σ :=
  inv unusedN (
        [∗ set] e ∈ (fin_to_set u64), own_unused_epoch γ e ∨ own_val γ e 0 1
      ).

(* If someone has own_val, that means the ctr sever saw that epoch number, which
   means the own_unused_epoch was given up. *)
Lemma unused_own_val_false γ e v (q:Qp) :
  unused_epoch_inv γ -∗ own_unused_epoch γ e -∗ own_val γ e v q ={↑unusedN}=∗ False.
Proof.
  iIntros "#Hinv Hunused Hval".
  iInv "Hinv" as ">Hi" "Hclose".
  iDestruct (big_sepS_elem_of_acc _ _ e with "Hi") as "[Helem HbigSepClose]".
  { set_solver. }
  iDestruct "Helem" as "[Hunused2|Hval2]".
  {
    unfold own_unused_epoch.
    iDestruct (ghost_map_points_to_valid_2 with "Hunused Hunused2") as "%Hvalid".
    exfalso.
    naive_solver.
  }
  iDestruct "Hval" as "[Hval _]".
  iDestruct "Hval2" as "[Hval2 _]".
  iDestruct (ghost_map_points_to_valid_2 with "Hval Hval2") as "%Hvalid".
  exfalso.
  destruct Hvalid as [Hbad _].
  rewrite dfrac_op_own in Hbad.
  rewrite dfrac_valid_own in Hbad.
  assert (1 < q + 1)%Qp.
  { apply Qp.lt_add_r. }
  apply (Qp.lt_le_trans _ _ _ H) in Hbad.
  clear H.
  by exfalso. (* Why does "by" work but not anything else I tried? E.g.
                 naive_solver, done, eauto. *)
Qed.

Lemma activate_unused_epoch v γ e:
  unused_epoch_inv γ -∗ own_unused_epoch γ e ={↑unusedN}=∗ own_val γ e v 1.
Proof.
  iIntros "#Hinv Hunused".
  iInv "Hinv" as ">Hi" "Hclose".
  iDestruct (big_sepS_elem_of_acc _ _ e with "Hi") as "[Helem Hi]".
  { set_solver. }
  iDestruct "Helem" as "[Hbad|Hval]".
  {
    iDestruct (ghost_map_points_to_valid_2 with "Hunused Hbad") as "%Hvalid".
    exfalso.
    naive_solver.
  }
  iSpecialize ("Hi" with "[$Hunused]").
  iMod ("Hclose" with "Hi").
  iApply (own_val_update with "Hval").
Qed.

Definition own_Server γ (s:loc) : iProp Σ :=
  ∃ (v latestEpoch:u64),
  "Hv" ∷ s ↦[Server :: "v"] #v ∗
  "HlatestEpoch" ∷ s ↦[Server :: "lastEpoch"] #latestEpoch ∗
  "HghostLatestEpoch" ∷ own_latest_epoch γ latestEpoch (1/2) ∗
  "HghostV" ∷ own_val γ latestEpoch v (1/2)
.

Context `{!erpcG Σ}.

Definition is_Server γ (s:loc) : iProp Σ :=
  ∃ mu (es:loc),
  "#Hmu" ∷ readonly (s ↦[Server :: "mu"] mu) ∗
  "#HmuInv" ∷ is_lock unusedN mu (own_Server γ s) ∗
  "#HunusedInv" ∷ unused_epoch_inv γ ∗
  "#He" ∷ readonly (s ↦[Server :: "e"] #es) ∗
  "#Hes" ∷ is_erpc_server γ.(erpc_gn) es
.

Definition has_GetReply_encoding (l:list u8) (err v:u64) :=
  has_encoding l [EncUInt64 err; EncUInt64 v].

(* FIXME: why is it normal to do |={⊤ ∖ mask, ∅}=> rather than |={⊤, mask}=> ? *)
(* Doing {T ∖ unusedN, ∅} means that I have to open up the invariant with unusedN
   before firing this fupd. On the other hand, if it's {T, unusedN}, I can
   optionally open the invariant after firing the fupd *)

Definition getN := nroot .@ "ctr.get".

(* put getN and unusedN etc. as sub-namespaces of one big namespaces *)
Definition EnterNewEpoch_spec γ (e:u64) (Φ:iProp Σ) : iProp Σ :=
|={⊤∖↑getN, ↑unusedN}=> ∃ latestEpoch, if decide (int.Z latestEpoch < int.Z e)%Z then
    own_latest_epoch γ latestEpoch (1/2)%Qp ∗
    own_unused_epoch γ e ∗ (∀ v, own_val γ e v (1/2)%Qp -∗
                                 own_val γ latestEpoch v (1/2)%Qp -∗
                                 own_latest_epoch γ e (1/2)%Qp ={↑unusedN,⊤∖↑getN}=∗ Φ)
else
  (own_latest_epoch γ latestEpoch (1/2)%Qp ∗
   (own_latest_epoch γ latestEpoch (1/2)%Qp ={↑unusedN, ⊤∖↑getN}=∗ Φ))
.

Lemma EnterNewEpoch_spec_wand γ e Φ1 Φ2 :
  (Φ1 -∗ Φ2) -∗
  EnterNewEpoch_spec γ e Φ1 -∗
  EnterNewEpoch_spec γ e Φ2
.
Proof.
  iIntros "Hwand Hupd".
  rewrite /EnterNewEpoch_spec.
  iMod "Hupd".
  iDestruct "Hupd" as (?) "Hupd".
  iExists latestEpoch.
  destruct (decide (_)).
  {
    iModIntro.
    iDestruct "Hupd" as "($ & $ & Hupd)".
    iIntros (v) "H1 H2 H3".
    iApply "Hwand".
    iMod ("Hupd" $! v with "H1 H2 H3") as "$".
    done.
  }
  {
    iModIntro.
    iDestruct "Hupd" as "[$ Hupd]".
    iIntros "H1".
    iApply "Hwand".
    by iApply "Hupd".
  }
Qed.

(** The spec for the "core" of a Get operation. This is what's run after the epoch
    number check succeeds.
*)
Definition Get_core_spec γ (e:u64) (Φ:u64 → iProp Σ) : iProp Σ :=
  (* XXX: have a ∅ here because this runs inside of a larger atomic step, so
     invariants will already have been opened *)
  |={∅}=> ∃ v, own_val γ e v (1/2)%Qp ∗
    (own_val γ e v (1/2)%Qp ={∅}=∗ (Φ v))
    (* XXX: no need for fupds here *)
.

Lemma Get_core_spec_wand γ e Φ1 Φ2 :
  (∀ x, Φ1 x -∗ Φ2 x) -∗
  Get_core_spec γ e Φ1 -∗
  Get_core_spec γ e Φ2
.
Proof.
  iIntros "Hwand Hupd".
  rewrite /Get_core_spec.
  iMod "Hupd".
  iModIntro.
  iDestruct "Hupd" as (v) "Hupd".
  iExists v.
  iDestruct "Hupd" as "[$ Hupd]".
  iIntros "H1".
  iApply "Hwand".
  iApply "Hupd".
  iFrame.
Qed.

(** This is a "fenced" Get. It checks if the requests's epoch number is current,
    then runs the core operation if so, and does nothing if not.
*)
Definition Get_server_spec γ (e:u64) (Φ:u64 → u64 → iProp Σ) : iProp Σ :=
|={⊤∖↑getN,∅}=> ∃ latestEpoch, own_latest_epoch γ latestEpoch (1/2)%Qp ∗
  if decide (int.Z latestEpoch = int.Z e)%Z then
    Get_core_spec γ e (λ v, own_latest_epoch γ e (1/2) ={∅,⊤∖↑getN}=∗ Φ 0 v)
  else
    (own_latest_epoch γ latestEpoch (1/2)%Qp ={∅,⊤∖↑getN}=∗ (∀ dummy_val, Φ 1 dummy_val))
.

(*
SpecMonad T := (T → iProp Σ) → iProp Σ = Hom(Hom(T, P), P)
Sort of a "double dual". Covariant because Hom(-, P) is contravariant.

1. Functoriality:
Let f: A → B. Then,
SpecMonad(f) : SpecMonad(A) → SpecMonad(B) is given by
  (ma: (A → iProp Σ) → iProp Σ ) ↦ (λ (fb:B → iProp Σ), (ma (λ a, fb(f(a)))))

2. Unit transformation.
η : 1_C → SpecMonad

η_T : T → Hom(Hom(T, P), P) given by
η_T : (a:T)  →  (λ (fa:T → iProp Σ), fa a)

3. Multiplication transformation.

μ : SpecMonad ∘ SpecMonad → SpecMonad

μ_T: SpecMonad(SpecMonad(T)) → SpecMonad(t)

μ_T : (f: Hom(Hom(Hom(Hom(T, P), P), P), P)) ↦
(λ (fa:T → P), f (λ (g:((T → P) → P) → P), g (λ (h:(T → P) → P), h fa)))

Definition SpecMonad_mul (T:Type) :
  ((((T → iProp Σ) → iProp Σ) → iProp Σ) → iProp Σ) → ((T → iProp Σ) → iProp Σ)
  :=
  λ f, (λ fa, f (λ g, g (λ h, h fa)  ))....

That's a bit complicated. Maybe easier to see via adjunctions?
*)

(* Via adjunctions.
Let F : C → C^{op} be the functor F(T) = (T → iProp Σ) = Hom(T,P).
Let G : C^{op} → C be the same.
Let's show that F and G are adjoint:

NTS: ∀ X Y, Hom_op(Hom(Y,P), X) ≅ Hom(Y, Hom(X,P))
But this is obvious:
Hom_op(Hom(Y,P), X) ≅ Hom(X, Hom(Y,P)) ≅ Hom(Y, Hom(X,P)).
Have to think about naturality a bit.

Given f : (Y → P) → X, take
  λ y x, f (λ y', )

ε: F∘G → 1_{C^op}
η: 1_C → G∘F

We already defined η above.
Let's define
ε_A : Hom_op(F(G(A), A)
ε_A : Hom(A, F(G(A)),
so we can define ε_A = η_A, by flipping arrows.

The multiplication map for G∘F can be given by

SpecMonad² = G ∘ F ∘ G ∘ F → G ∘ (1_{C^op}) ∘ F = SpecMonad
by using ε in the middle.
*)

(* Via bind.
  β : SpecMonad(A) → (a → SpecMonad(B)) → SpecMonad(B)

  β:(sa: (A → P) → P) ↦ (λ (f:a → SpecMonad(B)), (λ (fb:b → P), sa (λ a, ((f a) fb) )  ))
*)

(* NOTE: some reference about this kind of pretty general monad construction:
 "On Double Dual Monads" https://www.mscand.dk/article/download/10995/9016 *)

Program Definition Get_spec γ :=
  λ (reqData:list u8), λne (Φ : list u8 -d> iPropO Σ),
  (∃ e,
    ⌜has_encoding reqData [EncUInt64 e]⌝ ∗ EnterNewEpoch_spec γ e (
       Get_server_spec γ e (λ v err, (∀ l, ⌜has_GetReply_encoding l err v⌝ -∗ Φ l))
     ))%I
.
Next Obligation.
  rewrite /EnterNewEpoch_spec /Get_server_spec /Get_core_spec.
  solve_proper.
Defined.

Record get_req_names :=
{
  op_gn:gname;
  ne_gn:gname;
  finish_gn:gname;
}.

Implicit Types γreq : get_req_names.

Definition operation_incomplete γreq : iProp Σ := own γreq.(op_gn) (DfracOwn 1).
Definition operation_receipt γreq : iProp Σ := own γreq.(op_gn) (DfracDiscarded).

Definition new_epoch_incomplete γreq : iProp Σ := own γreq.(ne_gn) (DfracOwn 1).
Definition new_epoch_receipt γreq : iProp Σ := own γreq.(ne_gn) (DfracDiscarded).

Lemma complete_operation γreq :
  operation_incomplete γreq ==∗ operation_receipt γreq.
Proof.
  iIntros "H1".
  iApply (own_update with "H1").
  apply (cmra_update_exclusive).
  done.
Qed.

Lemma complete_newepoch_operation γreq :
  new_epoch_incomplete γreq ==∗ new_epoch_receipt γreq.
Proof.
  iIntros "H1".
  iApply (own_update with "H1").
  apply (cmra_update_exclusive).
  done.
Qed.

Definition result_claimed γreq : iProp Σ := own γreq.(finish_gn) (DfracOwn 1).

Definition Get_req_inv prophV e γ γreq Φ : iProp Σ :=
  inv getN (
        (* The server doesn't actually need quite this powerful of a fupd for
           Get_server_spec.  It only needs a fupd that can be fired specifically
           on the input prophV, but it's convenient to just reuse the more
           powerful spec definition.
         *)
        (*
          XXX: This invariant is a bit ad-hoc. A more principled approach would be to
          give the server a fraction of the ghost resources for the "state" of
          this protocol at the beginning of time, and for this invariant to have
          only a fraction of it.
        *)
    operation_incomplete γreq ∗ (
     (new_epoch_incomplete γreq ∗ EnterNewEpoch_spec γ e (Get_server_spec γ e (λ err v, if decide (err = 0) then Φ v else True)%I) ) ∨
     (new_epoch_receipt γreq ∗ is_latest_epoch_lb γ e ∗ Get_server_spec γ e (λ err v, if decide (err = 0) then Φ v else True)%I)
    ) ∨
    is_latest_epoch_lb γ e ∗ new_epoch_receipt γreq  ∗ operation_receipt γreq ∗ ((Φ prophV) ∨ result_claimed γreq) )
.

Program Definition Get_proph_spec γ :=
  λ (reqData:list u8), λne (Φ : list u8 -d> iPropO Σ),
  (∃ (prophV e:u64) γreq Φclient,
    ⌜has_encoding reqData [EncUInt64 e]⌝ ∗
    (Get_req_inv prophV e γ γreq Φclient) ∗
    (∀ (err v:u64), (if (decide (err = (U64 0) ∧ v = prophV)) then operation_receipt γreq else True) -∗
                  (∀ l, ⌜has_GetReply_encoding l err v⌝ -∗ Φ l))
  )%I
.
Next Obligation.
  rewrite /Get_req_inv /EnterNewEpoch_spec /Get_server_spec /Get_core_spec.
  solve_proper.
Defined.

Definition Put_core_spec γ (e v:u64) (Φ:iProp Σ) : iProp Σ :=
  (* XXX: have a ∅ here because this runs inside of a larger atomic step, so
     invariants will already have been opened *)
  |={∅}=> ∃ vold, own_val γ e vold (1/2)%Qp ∗
    (own_val γ e v (1/2)%Qp ={∅}=∗ Φ)
.

Definition Put_server_spec γ (e v:u64) (Φ:u64 → iProp Σ) : iProp Σ :=
|={⊤,∅}=> ∃ latestEpoch, own_latest_epoch γ latestEpoch (1/2)%Qp ∗
  if decide (int.Z latestEpoch = int.Z e)%Z then
    Put_core_spec γ e v (own_latest_epoch γ e (1/2) ={∅,⊤}=∗ Φ 0)
  else
    (own_latest_epoch γ latestEpoch (1/2)%Qp ={∅,⊤}=∗ Φ 1)
.

Definition has_PutReply_encoding (l:list u8) (err:u64) :=
  has_encoding l [EncUInt64 err].

Program Definition Put_spec γ :=
  λ (reqData:list u8), λne (Φ : list u8 -d> iPropO Σ),
  (∃ e v,
    ⌜has_encoding reqData [EncUInt64 v ; EncUInt64 e]⌝ ∗ EnterNewEpoch_spec γ e (
       Put_server_spec γ e v (λ err, (∀ l, ⌜has_PutReply_encoding l err⌝ -∗ Φ l))
     ))%I
.
Next Obligation.
  rewrite /EnterNewEpoch_spec /Put_server_spec /Put_core_spec.
  solve_proper.
Defined.

Definition Put_spec_erpc γ : eRPCSpec :=
  {|
    espec_rpcid := 1;
    espec_ty := (list u8 → iProp Σ);
    espec_Pre := λ Φ reqData, Put_spec γ reqData Φ;
    espec_Post := λ Φ reqData retData, (Φ retData);
  |}.

Context `{!urpcregG Σ}.

Program Definition GetFreshCID_spec γ :=
  λ (reqData:list u8), λne (Φ : list u8 -d> iPropO Σ),
  (∀ cid l, erpc_make_client_pre γ.(erpc_gn) cid -∗ ⌜has_encoding l [EncUInt64 cid]⌝ -∗ Φ l)%I
.
Next Obligation.
  rewrite /EnterNewEpoch_spec /Put_server_spec /Put_core_spec.
  solve_proper.
Defined.

Definition is_host (host:u64) γ : iProp Σ :=
  handler_spec γ.(urpc_gn) host (U64 0) (Get_proph_spec γ) ∗
  handler_erpc_spec γ.(urpc_gn) γ.(erpc_gn) host (Put_spec_erpc γ) ∗
  handler_spec γ.(urpc_gn) host (U64 2) (GetFreshCID_spec γ) ∗
  handlers_dom γ.(urpc_gn) {[ (U64 0) ; (U64 1) ; (U64 2)]}
.

Definition own_Clerk γ (ck:loc) : iProp Σ :=
  ∃ (cl ecl:loc) host,
  "#Hcl" ∷ readonly (ck ↦[Clerk :: "cl"] #cl) ∗
  "#Hcl_is" ∷ is_uRPCClient cl host ∗
  "#Hhost" ∷ is_host host γ ∗
  "#He" ∷ readonly (ck ↦[Clerk :: "e"] #ecl) ∗
  "Hecl_own" ∷ own_erpc_client γ.(erpc_gn) ecl
.

Lemma wp_Clerk__Get γ ck (e:u64) :
  ∀ Φ,
  own_Clerk γ ck -∗
  EnterNewEpoch_spec γ e (
    |={⊤∖↑getN,∅}=> ∃ latestEpoch, own_latest_epoch γ latestEpoch (1 / 2) ∗
    (if decide (int.Z latestEpoch = int.Z e)
        then Get_core_spec γ e (λ v : u64, own_latest_epoch γ e (1 / 2) ={∅,⊤∖↑getN}=∗ (own_Clerk γ ck -∗ Φ #v))
        else
         own_latest_epoch γ latestEpoch (1 / 2) ={∅,⊤∖↑getN}=∗ True) (* Get_server_spec
         actually has an obligation here; here, we'll exit if the epoch is
         stale, so the client doesn't need to prove anything about this case *)
  )%I
   -∗
   WP Clerk__Get #ck #e {{ Φ }}.
Proof.
  iIntros (Φ) "Hck Hupd".
  wp_lam.
  wp_pures.
  wp_apply (wp_new_enc).
  iIntros (enc) "Henc".
  wp_pures.
  wp_apply (wp_Enc__PutInt with "Henc").
  { done. }
  iIntros "Henc".
  wp_pures.
  wp_apply (wp_Enc__Finish with "Henc").
  iIntros (req_sl reqData) "(%Hreq_enc & %Hreq_len & Hreq_sl)".
  wp_pures.
  wp_apply (wp_NewProph_once (T:=u64)).
  iIntros (prophValID prophVal) "Hprophv".
  wp_pures.

  wp_apply (wp_ref_of_zero).
  { done. }
  iIntros (rep) "Hrep".
  wp_pures.
  iNamed "Hck".
  wp_loadField.
  iDestruct (is_slice_to_small with "Hreq_sl") as "Hreq_sl".

  iMod (own_alloc (DfracOwn 1)) as (γreq_op_gn) "HreqTok".
  { done. }
  iMod (own_alloc (DfracOwn 1)) as (γreq_ne_gn) "HneTok".
  { done. }
  iMod (own_alloc (DfracOwn 1)) as (γreq_finish_gn) "HfinishTok".
  { done. }
  set (γreq:={| op_gn:=γreq_op_gn ; ne_gn:=γreq_ne_gn ; finish_gn := γreq_finish_gn |}).
  (* Put the EnterNewEpoch into an invariant now, os we  *)
  iAssert (|={⊤}=> Get_req_inv prophVal e γ γreq (λ v, Φ #v))%I
               with "[Hupd HneTok HreqTok Hecl_own]" as ">#HgetInv".
  {
    rewrite /Get_req_inv.
    iMod (inv_alloc getN  with "[Hupd HneTok HreqTok Hecl_own]") as "$"; last done.
    iNext.
    iLeft.
    iFrame "HreqTok".
    (* Have f(P) in ctx. Want to prove f(Q). Want to know that it's enough to
       show that P -∗ Q. Basically, want to insist that a spec is covariant
       in its Φ argument (or maybe it's contravariant?). *)
    iLeft.
    iFrame.
    iApply (EnterNewEpoch_spec_wand with "[Hecl_own] Hupd").
    iIntros "Hupd".
    rewrite /Get_server_spec.
    iMod "Hupd".
    iModIntro.
    iDestruct "Hupd" as (?) "Hupd".
    iExists latestEpoch.
    iDestruct "Hupd" as "[$ Hupd]".

    destruct (decide (int.Z latestEpoch = int.Z e)).
    {
      rewrite /Get_core_spec.
      iMod "Hupd".
      iModIntro.
      iDestruct "Hupd" as (?) "[H1 Hupd]".
      iExists _; iFrame "H1".
      iIntros "H1".
      iMod ("Hupd" with "H1") as "Hupd".
      iModIntro.

      iIntros "H1".
      iMod ("Hupd" with "H1") as "Hupd".
      iModIntro.
      iSpecialize ("Hupd" with "[Hecl_own ]").
      { iExists _, _, _. iFrame "Hecl_own He Hcl Hcl_is Hhost". }
      iFrame "Hupd".
    }
    {
      iIntros "H1".
      iMod ("Hupd" with "H1") as "Hupd".
      iModIntro.
      iIntros.
      iFrame.
    }
  }

  wp_apply (wp_Client__Call _ _ _ _ _ _ _ _ _ _
                          (λ (l:list u8), ∃ v e, ⌜has_GetReply_encoding l e v⌝ ∗
                                  if (decide (e = (U64 0) ∧ v = prophVal)) then
                                    operation_receipt _
                                  else
                                    True)%I
             with "[] [$Hreq_sl $Hrep $Hcl_is HgetInv]").
  { iDestruct "Hhost" as "[$ _]". }
  {
    iModIntro.
    iNext.
    rewrite /Get_proph_spec.
    iExists _, _, _, _.
    iSplitL ""; first done.
    iFrame "HgetInv".

    iIntros (err v) "Hpost".
    iIntros (l) "%HrepEnc".
    iExists _, _. iSplitL ""; first done.
    destruct (decide (_)).
    {
      iFrame "Hpost".
    }
    {
      done.
    }
  }

  iIntros (errCode) "(_ & Hreq_sl & Hpost)".

  wp_pures.
  destruct errCode.
  { (* case: error *)
    rewrite bool_decide_false; last first.
    { by destruct c. }
    wp_pures.
    wp_apply (wp_Exit).
    iIntros.
    by exfalso.
  }
  wp_pures.
  iNamed "Hpost".
  iDestruct "Hpost" as "(Hrep & Hrep_sl & Hpost)".
  wp_load.
  iDestruct "Hpost" as (v err) "(%Hrep_enc & Hpost)".

  (* TODO: move this to a different lemma *)
  wp_lam.
  wp_apply (wp_new_dec with "Hrep_sl").
  { done. }
  iIntros (dec) "Hdec".
  wp_pures.
  wp_apply (wp_allocStruct).
  { naive_solver. }
  iIntros (r) "Hr".
  iDestruct (struct_fields_split with "Hr") as "HH".
  iNamed "HH".
  simpl.
  wp_pures.
  wp_apply (wp_Dec__GetInt with "Hdec").
  iIntros "Hdec".
  wp_storeField.

  wp_apply (wp_Dec__GetInt with "Hdec").
  iIntros "Hdec".
  wp_storeField.
  wp_pures.
  (* TODO: move the above to a different lemma *)

  wp_loadField.
  destruct (decide (int.Z err = 0)).
  { (* no error *)
    replace (err) with (U64 0) by word.
    wp_pures.

    wp_pures.
    wp_loadField.
    wp_apply (wp_ResolveProph_once (T:=u64) with "[$Hprophv]").
    { done. }
    iIntros "%HprophMatches".
    (* XXX: some later hacking. Open the invariant here so we can strip off a later from the Φ. *)
    iApply fupd_wp.
    rewrite (decide_True); last done.
    iDestruct "Hpost" as "#Hpost".

    (* Open HgetInv and use receipt to get Φ. *)
    iInv "HgetInv" as "Hi" "Hclose".
    iDestruct "Hi" as "[[>Hbad _] | Hgood]".
    {
      iDestruct (own_valid_2 with "Hpost Hbad") as %Hbad.
      exfalso.
      done.
    }
    iDestruct "Hgood" as "(#HlatestEpoch & #HneComplete & _ & [Hgood | >Hbad])"; last first.
    { (* result can't be claimed from invariant because we have HfinishTok *)
      iDestruct (own_valid_2 with "HfinishTok Hbad") as %Hbad.
      exfalso.
      done.
    }

    iMod ("Hclose" with "[HfinishTok]") as "_".
    {
      iNext.
      iRight.
      iFrame "#".
      iRight.
      iFrame.
    }
    iModIntro.
    wp_pures.
    wp_loadField.
    rewrite HprophMatches.
    iFrame.
  }
  { (* error; we'll exit in this case *)
    wp_pures.
    rewrite bool_decide_false; last first.
    { naive_solver. }
    simpl.

    wp_pures.
    wp_apply (wp_Exit).
    by iIntros.
  }
Qed.

Lemma wp_Server__Get γ s (e:u64) (rep:loc) (dummy_err dummy_val:u64) (prophV:u64) γreq Post Φclient :
  is_Server γ s -∗
  {{{
        "Hrep_error" ∷ rep ↦[GetReply :: "err"] #dummy_err ∗
        "Hrep_val" ∷ rep ↦[GetReply :: "val"] #dummy_val ∗

        "#HgetSpec" ∷ (Get_req_inv prophV e γ γreq Φclient) ∗
        "Hpost" ∷ (∀ (err v:u64), (if (decide (err = 0 ∧ v = prophV)) then operation_receipt γreq else True) -∗ Post err v)
  }}}
    Server__Get #s #e #rep
  {{{
        (err v:u64), RET #();
        "Hrep_error" ∷ rep ↦[GetReply :: "err"] #err ∗
        "Hrep_val" ∷ rep ↦[GetReply :: "val"] #v ∗
        "Hpost" ∷ Post err v
  }}}.
Proof.
  iIntros "#His_srv !#" (Φ) "Hpre HΦ".
  iNamed "Hpre".
  wp_lam.
  wp_pures.
  iNamed "His_srv".
  wp_loadField.
  wp_apply (acquire_spec with "HmuInv").
  iIntros "[Hlocked Hown]".
  iNamed "Hown".
  wp_pures.

  wp_storeField.
  wp_loadField.
  wp_bind (BinOp _ _ _).

  (* XXX: have to fire the fupd here so that we can bind around a pure step to
     easily strip off later. Ideally, we would've opened the inv after
     wp_if_destruct on whether the epoch number is stale. *)
  iInv "HgetSpec" as "Hi" "Hclose".
  wp_pures.
  wp_apply wp_value. (* FIXME: why do I have to do this manually? *)

  destruct (bool_decide (int.Z e < int.Z latestEpoch)) as [] eqn:Hineq.
  { (* case: Request epoch number is stale *)
    iMod ("Hclose" with "[$Hi]").
    iModIntro.
    wp_pures.
    wp_loadField.
    wp_apply (release_spec with "[$HmuInv $Hlocked Hv HlatestEpoch HghostLatestEpoch HghostV]").
    {
      iNext.
      iExists _, _.
      iFrame.
    }
    wp_pures.
    wp_storeField.
    iModIntro.
    iApply "HΦ".
    iFrame.
    by iApply "Hpost".
  }
  { (* case: epoch number is not stale. *)

    iAssert (|={⊤∖↑getN,⊤}=> "HghostLatestEpoch" ∷ own_latest_epoch γ e (1/2) ∗
                                                "HghostV" ∷ own_val γ e v (1/2) ∗
                                                "#HneComplete" ∷ new_epoch_receipt γreq
            (* "#Hlatest_lb" ∷ is_latest_epoch_lb γ e *)
            )%I with "[Hi Hclose HgetSpec HghostLatestEpoch HghostV]" as "HH".
    {
      (* Use EnterNewEpoch spec regardless of whether the prophecy matches the current value *)
      rewrite bool_decide_eq_false in Hineq.
      iDestruct "Hi" as "[Hi | Hi]"; last first.
      { (* the request was already run previously, and we already have a receipt that the latestEpoch >= e *)
        iDestruct "Hi" as "[#HlatestLb [#Hreceipt HΦclient]]".
        iDestruct (own_latest_epoch_with_lb with "HghostLatestEpoch HlatestLb") as "%Hineq2".
        replace (latestEpoch) with (e); last first.
        { word. }
        iMod ("Hclose" with "[HΦclient]").
        {
          iNext.
          iRight.
          iFrame "#∗".
        }
        iModIntro.
        iFrame "#∗".
      }
      iDestruct "Hi" as "[HopIncomplete [[HneIncomplete Hgood] | Hi]]"; last first.
      { (* the request was run previously, but the Get fupd wasn't fired
           previously (because the prophecy must not have matched last time). *)
        iDestruct "Hi" as "(#HnewComplete & #Hlb & Hupd)".
        iDestruct (own_latest_epoch_with_lb with "HghostLatestEpoch Hlb") as "%Hineq2".
        replace (latestEpoch) with (e) by word.
        iFrame "∗#".
        iMod ("Hclose" with "[-]"); last done.
        iNext.
        iLeft.
        iFrame.
        iRight.
        iFrame "#∗".
      }
      iEval (rewrite /EnterNewEpoch_spec) in "Hgood".
      iMod "Hgood".

      (* FIXME: currently, we require |={⊤, ↑unusedN}=> from the client fupd.
       It seems enough to require |={⊤∖↑unusedN, ∅}=>, which should be strictly
       stronger than above. fupd_mask_frame_r can help prove that.
       *)
      iDestruct "Hgood" as (?) "Hupd".
      iMod (complete_newepoch_operation with "HneIncomplete") as "#HneComplete".
      destruct (decide (int.Z latestEpoch0 < int.Z e)).
      { (* first time seeing the number e *)
        iDestruct "Hupd" as "(Hlatest2 & Hunused & Hupd)".
        iDestruct (own_latest_epoch_combine with "HghostLatestEpoch Hlatest2") as "[Hlatest %Heq]".
        rewrite Heq.
        rewrite (Qp.half_half).
        iMod (own_latest_epoch_update e with "Hlatest") as "Hlatest".
        { word. }
        iEval (rewrite -Qp.half_half) in "Hlatest".
        iDestruct (own_latest_epoch_split with "Hlatest") as "[Hlatest Hlatest2]".
        iMod (activate_unused_epoch v with "HunusedInv Hunused") as "HghostV2".
        iEval (rewrite -Qp.half_half) in "HghostV2".
        iDestruct (own_val_split with "HghostV2") as "[HghostV21 HghostV22]".
        iSpecialize ("Hupd" $! v with "HghostV22 HghostV Hlatest2").
        iMod "Hupd".
        iDestruct (own_latest_epoch_get_lb with "Hlatest") as "#HlatestLb".
        iMod ("Hclose" with "[HopIncomplete Hupd]") as "_".
        {
          iNext.
          iLeft.
          iFrame "HopIncomplete".
          iRight.
          iFrame "∗#".
        }
        iModIntro.
        iFrame "∗#".
      }
      { (* e ≤ own_latestEpoch *)
        iDestruct "Hupd" as "[Hlatest2 Hupd]".
        iDestruct (own_latest_epoch_combine with "HghostLatestEpoch Hlatest2") as "[Hlatest %Heq]".
        iDestruct (own_latest_epoch_split with "Hlatest") as "[Hlatest1 Hlatest2]".
        rewrite -Heq.
        replace (latestEpoch) with (e); last first.
        {
          rewrite -Heq in n.
          word.
        }
        iDestruct (own_latest_epoch_get_lb with "Hlatest2") as "#HlatestLb".
        iMod ("Hupd" with "Hlatest1") as "Hupd".
        iMod ("Hclose" with "[Hupd HopIncomplete]") as "_".
        {
          iNext.
          iLeft.
          iFrame "∗#".
          iRight.
          iFrame "∗#".
        }
        iModIntro.
        iFrame "∗#".
      }
    }

    iMod "HH".
    iNamed "HH".
    iModIntro.

    (* Done with EnterNewEpoch part of the proof; now, just worry about GetAtEpoch *)

    wp_pures.
    wp_storeField.
    wp_loadField.
    wp_storeField.
    wp_bind (Skip).

    iInv "HgetSpec" as "Hi" "Hclose".
    wp_pures.
    wp_apply (wp_value).

    iDestruct "Hi" as "[Hi | HalreadyDone]"; last first.
    { (* case: someone already fired the client fupd and the receipt is sitting in the invariant *)
      iDestruct "HalreadyDone" as "(#Hlb & #HneReceipt & #Hreceipt & HΦclient)".
      iMod ("Hclose" with "[HΦclient]").
      {
        iNext.
        iRight.
        iFrame "∗#".
      }
      iModIntro.
      wp_pures.
      wp_loadField.
      wp_apply (release_spec with "[$Hlocked $HmuInv Hv HlatestEpoch HghostV HghostLatestEpoch]").
      {
        iNext.
        iExists _, _.
        iFrame.
      }
      wp_pures.
      iModIntro.
      iApply "HΦ".
      iFrame.
      iApply "Hpost".
      destruct (decide (_)); iFrame "#".
      done.
    }
    { (* case: the operation hasn't been run before, so we might run it now *)
      iDestruct "Hi" as "[Hincomplete [Hbad | Hupd]]".
      {
        iDestruct "Hbad" as "[Hbad _]".
        iDestruct (own_valid_2 with "HneComplete Hbad") as %Hbad.
        exfalso.
        done.
      }
      destruct (decide (v = prophV)) as [HprophMatches|HprophWrong].
      { (* case: prophecized value matches physical one; we have to run the fupd in this case *)
        iDestruct "Hupd" as "(#HneReceipt & #Hlb & Hupd)".
        iMod "Hupd".
        clear Hineq latestEpoch.
        iDestruct "Hupd" as (latestEpoch) "[Hlatest2 Hupd]".
        iDestruct (own_latest_epoch_combine with "HghostLatestEpoch Hlatest2") as "[Hlatest %Heq]".
        destruct (decide (int.Z latestEpoch = int.Z e)); last first.
        { (* contradictory: we know for sure that own_latest_epoch e *)
          exfalso.
          naive_solver.
        }
        iMod "Hupd".
        iDestruct "Hupd" as (v2) "[Hval2 Hupd]".
        iDestruct (own_val_combine with "HghostV Hval2") as "[Hval %HvEq]".
        rewrite -HvEq.
        iDestruct (own_val_split with "Hval") as "[Hval Hval2]".
        iMod ("Hupd" with "Hval2") as "Hupd".
        rewrite Heq.
        iDestruct (own_latest_epoch_split with "Hlatest") as "[Hlatest Hlatest2]".
        iMod ("Hupd" with "Hlatest2") as "Hupd".
        iMod (complete_operation with "Hincomplete") as "#Hreceipt".
        rewrite HprophMatches.
        iMod ("Hclose" with "[Hupd]").
        {
          iNext.
          iRight.
          iFrame "#".
          iLeft.
          iFrame.
        }
        iModIntro.
        wp_pures.
        wp_loadField.
        wp_apply (release_spec with "[$Hlocked $HmuInv Hv HlatestEpoch Hval Hlatest]").
        {
          iNext.
          iExists _, _.
          iFrame.
        }
        wp_pures.
        iModIntro.
        iApply "HΦ".
        iFrame.
        iApply "Hpost".
        destruct (decide _); iFrame "#".
        done.
      }
      { (* case: prophecized value doesn't match physical one; we don't have to do anything in this case *)
        iMod ("Hclose" with "[Hincomplete Hupd]").
        {
          iNext.
          iLeft.
          iFrame.
        }
        iModIntro.
        wp_pures.
        wp_loadField.
        wp_apply (release_spec with "[$Hlocked $HmuInv Hv HlatestEpoch HghostV HghostLatestEpoch]").
        {
          iNext.
          iExists _, _.
          iFrame.
        }
        wp_pures.
        iModIntro.
        iApply "HΦ".
        iFrame.
        iApply "Hpost".
        rewrite decide_False; first done.
        naive_solver.
      }
    }
  }
Qed.

Lemma Put_core_spec_wand γ (e v:u64) (Φ Φ':iProp Σ) :
  (Φ -∗ Φ') -∗
  Put_core_spec γ e v Φ -∗
  Put_core_spec γ e v Φ'.
Proof.
  iIntros "Hwand Hupd".
  iMod "Hupd".
  iModIntro.
  iDestruct "Hupd" as (?) "[H1 Hupd]".
  iExists _; iFrame "H1".
  iIntros "H1".
  iApply "Hwand".
  iApply "Hupd".
  iFrame.
Qed.

Lemma wp_Server__Put γ s args_ptr Φclient (e v:u64) :
  is_Server γ s -∗
  {{{
      "Hupd" ∷ EnterNewEpoch_spec γ e (Put_server_spec γ e v Φclient) ∗
      "Hargs_val" ∷ args_ptr ↦[PutArgs :: "v"] #v ∗
      "Hargs_epoch" ∷ args_ptr ↦[PutArgs :: "epoch"] #e
  }}}
    Server__Put #s #args_ptr
  {{{
        (err:u64), RET #err; Φclient err
  }}}.
Proof.
  iIntros "#His_srv !#" (Φ) "Hpre HΦ".
  iNamed "His_srv".
  iNamed "Hpre".
  wp_rec.
  wp_pures.
  wp_loadField.

  wp_apply (acquire_spec with "HmuInv").
  iIntros "[Hlocked Hown]".
  iNamed "Hown".

  wp_pures.

  wp_loadField.
  wp_loadField.
  wp_pures.
  wp_if_destruct.
  { (* stale epoch number *)
    wp_loadField.
    iApply fupd_wp.
    iMod (fupd_mask_subseteq _) as "Hmask"; last iMod "Hupd".
    { set_solver. }
    iDestruct "Hupd" as (?) "Hupd".
    destruct (decide (int.Z latestEpoch0 < int.Z e)).
    { (* case: epoch number is fresh; contradicts the fact that we're in the
         stale case already *)
      iDestruct "Hupd" as "[Hlatest2 Hupd]".
      iDestruct (own_latest_epoch_combine with "Hlatest2 HghostLatestEpoch") as "[_ %Heq]".
      exfalso.
      rewrite Heq in l.
      word.
    }
    iDestruct "Hupd" as "[Hlatest Hupd]".
    iMod ("Hupd" with "Hlatest") as "Hupd".
    iMod "Hmask" as "_".

    (* second linearization point *)
    iMod "Hupd".
    clear latestEpoch0 n.
    iDestruct "Hupd" as (?) "[Hlatest2 Hupd]".
    destruct (decide (int.Z latestEpoch0 = int.Z e)).
    { (* case: epoch number is fresh; contradicts the fact that we're in the
         stale case *)
      iDestruct (own_latest_epoch_combine with "Hlatest2 HghostLatestEpoch") as "[_ %Heq]".
      exfalso.
      rewrite Heq in e0.
      word.
    }
    iMod ("Hupd" with "Hlatest2") as "HΦclient".
    iModIntro.
    wp_apply (release_spec with "[$Hlocked $HmuInv HlatestEpoch Hv HghostLatestEpoch HghostV]").
    {
      iNext.
      iExists _, _.
      iFrame "∗#".
    }
    wp_pures.
    iApply "HΦ".
    iFrame.
    done.
  }
  { (* case: epoch number is valid *)
    wp_loadField.
    wp_storeField.
    wp_loadField.
    wp_storeField.
    wp_loadField.

    iApply fupd_wp.

    (* iAssert to join the two different cases of the EnterNewEpoch fupd *)
    iAssert (
        |={⊤}=> "Hupd" ∷ Put_server_spec γ e v Φclient ∗
               "Hlatest" ∷ own_latest_epoch γ e (1/2) ∗
               "Hval" ∷ own_val γ e v0 (1/2)
      )%I with "[Hupd HghostLatestEpoch HghostV]" as "HH".
    {
      iMod (fupd_mask_subseteq _) as "Hmask"; last iMod "Hupd".

      { set_solver. }
      iDestruct "Hupd" as (?) "Hupd".

      destruct (decide (int.Z latestEpoch0 < int.Z e)).
      { (* case: first time seeing client's epoch number *)
        iDestruct "Hupd" as "(Hlatest2 & Hunused & Hupd)".
        iMod (activate_unused_epoch v0 with "HunusedInv Hunused") as "Hval".
        iEval (rewrite -Qp.half_half) in "Hval".
        iDestruct (own_val_split with "Hval") as "[Hval Hval2]".
        iDestruct (own_latest_epoch_combine with "Hlatest2 HghostLatestEpoch") as "[Hlatest %Heq]".
        rewrite Heq.
        rewrite (Qp.half_half).
        iMod (own_latest_epoch_update e with "Hlatest") as "Hlatest".
        { word. }
        iEval (rewrite -Qp.half_half) in "Hlatest".
        iDestruct (own_latest_epoch_split with "Hlatest") as "[Hlatest Hlatest2]".
        iMod ("Hupd" with "Hval2 HghostV Hlatest2") as "Hupd".
        iFrame.
      }
      { (* case: have seen epoch number before *)
        iDestruct "Hupd" as "[Hlatest2 Hupd]".
        iDestruct (own_latest_epoch_combine with "Hlatest2 HghostLatestEpoch") as "[Hlatest %Heq]".
        rewrite Heq.
        iDestruct (own_latest_epoch_split with "Hlatest") as "[Hlatest Hlatest2]".
        replace (latestEpoch) with (e); last first.
        {
          rewrite Heq in n.
          word_cleanup.
        }
        iMod ("Hupd" with "Hlatest2") as "Hupd".
        iFrame.
        by iMod "Hmask".
      }
    }

    iMod "HH".
    iNamed "HH".

    (* second linearization point: PutAtEpoch () *)
    iMod "Hupd".
    iDestruct "Hupd" as (?) "[Hlatest2 Hupd]".
    iDestruct (own_latest_epoch_combine with "Hlatest2 Hlatest") as "[Hlatest %Heq]".
    rewrite Heq.
    iDestruct (own_latest_epoch_split with "Hlatest") as "[Hlatest Hlatest2]".
    rewrite decide_True; last done.
    iMod "Hupd".
    iDestruct "Hupd" as (vold) "[Hval2 Hupd]".
    iDestruct (own_val_combine with "Hval Hval2") as "[Hval %Hveq]".
    rewrite Hveq.
    rewrite Qp.half_half.
    iMod (own_val_update v with "Hval") as "Hval".
    iEval (rewrite -Qp.half_half) in "Hval".
    iDestruct (own_val_split with "Hval") as "[Hval Hval2]".
    iMod ("Hupd" with "Hval2") as "Hupd".
    iMod ("Hupd" with "Hlatest2") as "Hupd".
    iModIntro.

    wp_apply (release_spec with "[$Hlocked $HmuInv Hv HlatestEpoch Hlatest Hval]").
    {
      iNext.
      iExists _, _.
      iFrame "∗#".
    }
    wp_pures.
    iApply "HΦ".
    iFrame.
    done.
  }
Qed.

Lemma wp_Clerk__Put γ ck (e v:u64) :
  ∀ Φ,
  own_Clerk γ ck -∗
  EnterNewEpoch_spec γ e (
    |={⊤,∅}=> ∃ latestEpoch, own_latest_epoch γ latestEpoch (1 / 2) ∗
    (if decide (int.Z latestEpoch = int.Z e)
        then Put_core_spec γ e v (own_latest_epoch γ e (1 / 2) ={∅,⊤}=∗ (own_Clerk γ ck -∗ Φ #()))
        else
         own_latest_epoch γ latestEpoch (1 / 2) ={∅,⊤}=∗ True) (* Put_server_spec
         actually has an obligation here; here, we'll exit if the epoch is
         stale, so the client doesn't need to prove anything about this case *)
  )%I
  -∗
    WP Clerk__Put #ck #v #e {{ Φ }}.
Proof.
  iIntros (Φ) "Hck Hupd".
  wp_lam.
  wp_pures.
  wp_apply (wp_allocStruct).
  { repeat econstructor. }
  iIntros (args_ptr) "Hargs".
  iDestruct (struct_fields_split with "Hargs") as "HH".
  iNamed "HH".
  wp_pures.

  (* TODO: put this in its own lemma *)
  wp_lam.
  wp_apply (wp_new_enc).
  iIntros (enc) "Henc".
  wp_pures.
  wp_loadField.
  wp_apply (wp_Enc__PutInt with "Henc").
  { done. }
  iIntros "Henc".
  wp_pures.

  wp_loadField.
  wp_apply (wp_Enc__PutInt with "Henc").
  { done. }
  iIntros "Henc".
  wp_apply (wp_Enc__Finish with "Henc").
  iIntros (req_sl reqData) "(%Hreq_enc & %Hreq_len & Hreq_sl)".
  wp_pures.

  iNamed "Hck".
  wp_loadField.
  iDestruct (is_slice_to_small with "Hreq_sl") as "Hreq_small".
  wp_apply (wp_erpc_NewRequest (Put_spec_erpc γ)
      (λ l, ∃ err, ⌜has_PutReply_encoding l err⌝ ∗
      if (decide (err = 0)) then
        (own_Clerk γ ck -∗ Φ #())
      else
        True
      )%I
             with "[$Hreq_small $Hecl_own Hupd]").
  {
    simpl.
    iExists _, _.
    simpl in Hreq_enc.
    iSplitL ""; first done.
    iApply (EnterNewEpoch_spec_wand with "[] Hupd").
    iIntros "Hupd".
    iMod "Hupd".
    iModIntro.
    iDestruct "Hupd" as (?) "[Hlatest Hupd]".
    iExists _. iFrame.
    destruct (decide (_)).
    { (* epoch number is valid; do the operation *)
      iApply (Put_core_spec_wand with "[] Hupd").
      iIntros "Hupd".
      iIntros "Hlatest".
      iMod ("Hupd" with "Hlatest") as "Hupd".
      iModIntro.
      iIntros.
      iExists _.
      iSplitL ""; first done.
      setoid_rewrite decide_True; last done. (* TODO: What is setoid_rewrite?*)
      iApply "Hupd".
    }
    { (* epoch number is stale; do nothing *)
      iIntros "Hlatest".
      iMod ("Hupd" with "Hlatest").
      iModIntro.
      iIntros.
      iExists _; iSplitL ""; first done.
      setoid_rewrite decide_False; last done.
      done.
    }
  }

  (* FIXME: why is so much stuff exposed? Can we hide the urpc precondition etc.
     and return some blackbox thing that gives us the right to make a urpc
     client call (maybe we should just return a WP?). *)
  iIntros (y_urpc reqData_urpc reqSl_urpc) "(Hreq_sl & #Hpre_urpc & Hurpc_post_to_erpc_post)".
  wp_pures.

  wp_apply (wp_ref_of_zero).
  { done. }
  iIntros (rep_ptr) "Hrep".
  wp_pures.
  wp_loadField.
  iDestruct (is_slice_to_small with "Hreq_sl") as "Hreq_small".
  iDestruct "Hhost" as "(Hhost1 & #Hhost_erpc & Hhost2)".
  wp_apply (wp_Client__Call_uRPCSpec with "Hhost_erpc [$Hrep $Hreq_small $Hcl_is]").
  { done. }
  {
    iFrame "#".
  }
  iIntros (err) "(_ & Hreq_urpc_sl & Hpost)".
  wp_pures.

  destruct err.
  { (* urpc error; got no response *)
    rewrite bool_decide_false; last first.
    { simpl. by destruct c. }
    wp_pures.
    wp_apply (wp_Exit).
    by iIntros "Hbad".
  }
  wp_pures.
  iDestruct "Hpost" as (rep_sl repData) "(Hrep_ptr & Hrep_sl & Hpost)".
  wp_load.
  iMod ("Hurpc_post_to_erpc_post" with "Hpost") as "Hpost".
  iDestruct "Hpost" as "[Hecl_own Hpost]".
  simpl.
  iDestruct "Hpost" as (errStale) "Hpost".
  iDestruct "Hpost" as "[>%HencRep Hpost]".

  wp_apply (wp_new_dec with "Hrep_sl").
  { done. }
  iIntros (dec) "Hdec".
  wp_pures.
  wp_apply (wp_Dec__GetInt with "Hdec").
  iIntros "Hdec".
  wp_pures.
  wp_if_destruct.
  { (* got stale error *)
    wp_apply (wp_Exit).
    by iIntros "Hbad".
  }
  wp_pures.
  iEval (simpl) in "Hpost".
  iApply "Hpost".
  iModIntro.
  iExists _, _, _.
  iFrame "Hcl Hcl_is He Hecl_own Hhost1 Hhost_erpc Hhost2".
Qed.

Lemma wp_StartServer host γ :
  is_host host γ -∗
  unused_epoch_inv γ -∗
  {{{
        "Hes" ∷ own_erpc_pre_server γ.(erpc_gn) ∗
        "HghostLatestEpoch" ∷ own_latest_epoch γ 0 (1/2) ∗
        "HghostV" ∷ own_val γ 0 0 (1/2)
  }}}
    StartServer #host
  {{{
        RET #(); True
  }}}.
Proof.
  iIntros "#Hhost #Hunused !#" (Φ) "Hpre HΦ".
  iNamed "Hpre".
  wp_lam.
  wp_apply (wp_allocStruct).
  { repeat econstructor. }
  iIntros (s) "Hs".
  iDestruct (struct_fields_split with "Hs") as "HH".
  iNamed "HH".
  simpl.

  wp_pures.
  wp_apply (wp_new_free_lock).
  iIntros (mu) "HmuInv".

  wp_storeField.

  wp_apply (wp_erpc_MakeServer with "[$Hes]").
  iIntros (es) "#His_erpc".
  wp_storeField.
  wp_storeField.

  wp_apply (map.wp_NewMap).
  iIntros (handlers) "Hhandlers".

  wp_pures.
  wp_apply (map.wp_MapInsert with "Hhandlers").
  iIntros "Hhandlers".
  wp_pures.

  wp_loadField.
  wp_apply (wp_erpc_Server_HandleRequest (Put_spec_erpc γ) with "[$His_erpc]").

  iIntros (put_urpc_handler) "#Hput_erpc_to_urpc".

  wp_apply (map.wp_MapInsert with "Hhandlers").
  iIntros "Hhandlers".
  wp_pures.

  wp_apply (map.wp_MapInsert with "Hhandlers").
  iIntros "Hhandlers".
  wp_pures.

  wp_apply (wp_MakeServer with "Hhandlers").
  iIntros (r) "Hr".
  wp_pures.

  iAssert (|={⊤}=> is_Server γ s)%I with "[mu e v lastEpoch HmuInv HghostLatestEpoch HghostV]" as "HH".
  {
    unfold is_Server.
    iMod (readonly_alloc_1 with "mu") as "#Hmu".
    iMod (readonly_alloc_1 with "e") as "#He".
    iExists _, _; iFrame "#".
    iApply (alloc_lock with "HmuInv").
    iNext.
    iExists _, _.
    iFrame.
  }
  iMod "HH" as "#His_srv".

  wp_apply (wp_StartServer with "[$Hr]").
  {
    set_solver.
  }
  {
    iDestruct "Hhost" as "(H1&H2&H3&Hhandlers)".
    unfold handlers_complete.
    repeat rewrite dom_insert_L.
    rewrite dom_empty_L.
    iSplitL "".
    {
      iExactEq "Hhandlers".
      f_equal.
      set_solver.
    }

    iApply (big_sepM_insert_2 with "").
    {
      simpl. iExists _; iFrame "#".
      clear Φ.
      unfold impl_handler_spec.
      iIntros (???????) "!# Hpre HΦ".
      wp_pures.
      iDestruct "Hpre" as "(Hreq_small & Hrep_ptr & Hrep_sl & Hpre)".
      wp_apply (wp_new_enc).
      iIntros (enc) "Henc".
      wp_pures.
      iNamed "His_srv".
      wp_loadField.
      wp_apply (wp_erpc_GetFreshCID with "[$Hes]").
      iIntros (cid) "Hpost".
      wp_apply (wp_Enc__PutInt with "Henc").
      { done. }
      iIntros "Henc".
      wp_pures.

      wp_apply (wp_Enc__Finish with "Henc").
      iClear "Hrep_sl".
      iIntros (rep_sl repData) "(%HrepEnc & %HrepLen & Hrep_sl)".
      iDestruct (is_slice_to_small with "Hrep_sl") as "Hrep_small".
      wp_store.
      iApply "HΦ".
      iFrame.
      unfold GetFreshCID_spec.
      iApply ("Hpre" with "Hpost").
      done.
    }
    iApply (big_sepM_insert_2 with "").
    {
      simpl. iExists _; iFrame "#".
      iApply "Hput_erpc_to_urpc".
      clear Φ.
      iIntros (???????) "!# Hpre HΦ".
      wp_pures.
      iDestruct "Hpre" as "(Hreq_small & Hrep_ptr & Hrep_sl & Hpre)".
      iDestruct "Hpre" as (??) "[%HreqEnc Hpre]".

      (* TODO: put this in another lemma *)
      wp_lam.
      wp_apply (wp_new_dec with "[$Hreq_small]").
      { done. }
      iIntros (dec) "Hdec".
      wp_pures.
      wp_apply (wp_allocStruct).
      { repeat econstructor. }
      iIntros (args_ptr) "Hargs".
      wp_pures.
      iDestruct (struct_fields_split with "Hargs") as "HH".
      iNamed "HH".
      wp_apply (wp_Dec__GetInt with "Hdec").
      iIntros "Hdec".
      wp_storeField.

      wp_apply (wp_Dec__GetInt with "Hdec").
      iIntros "Hdec".
      wp_storeField.
      (* End separate lemma *)

      wp_pures.
      wp_apply (wp_Server__Put γ with "His_srv [$Hpre $v $epoch]").
      iIntros (err) "Hpost".
      wp_pures.

      wp_apply (wp_new_enc).
      iIntros (enc) "Henc".
      wp_pures.
      wp_apply (wp_Enc__PutInt with "Henc").
      { done. }
      iIntros "Henc".
      wp_pures.
      simpl.
      wp_apply (wp_Enc__Finish with "Henc").
      iClear "Hrep_sl".
      iIntros (rep_sl repData) "(%HrepEnc & %HrepLen & Hrep_sl)".
      iDestruct (is_slice_to_small with "Hrep_sl") as "Hrep_small".
      wp_store.
      iModIntro.
      iApply "HΦ".
      iFrame.
      iApply "Hpost".
      done.
    }
    iApply (big_sepM_insert_2 with "").
    {
      simpl. iExists _; iFrame "#".
      clear Φ.
      unfold impl_handler_spec.
      iIntros (???????) "!# Hpre HΦ".
      wp_pures.
      iDestruct "Hpre" as "(Hreq_small & Hrep_ptr & Hrep_sl & Hpre)".
      iDestruct "Hpre" as (????) "[%HreqEnc Hpre]".

      wp_apply (wp_new_dec with "[$Hreq_small]").
      {
        done.
      }
      iIntros (dec) "Hdec".
      wp_pures.
      wp_apply (wp_Dec__GetInt with "Hdec").
      iIntros "Hdec".
      wp_pures.
      wp_apply (wp_allocStruct).
      { repeat econstructor. }
      iIntros (reply) "Hreply".
      iDestruct (struct_fields_split with "Hreply") as "HH".
      iNamed "HH".
      wp_pures.
      wp_apply (wp_Server__Get γ with "His_srv [$err $val Hpre]").
      {
        iDestruct "Hpre" as "[$ Hpre]".
        iFrame "Hpre".
      }
      iIntros (err v).
      iNamed 1.
      wp_pures.

      (* TODO: move this to a different lemma *)
      wp_lam.
      wp_apply (wp_new_enc).
      iIntros (enc) "Henc".
      wp_pures.
      wp_loadField.
      wp_apply (wp_Enc__PutInt with "Henc").
      { done. }
      iIntros "Henc".
      wp_pures.

      wp_loadField.
      wp_apply (wp_Enc__PutInt with "Henc").
      { done. }
      iIntros "Henc".
      wp_apply (wp_Enc__Finish with "Henc").
      iClear "Hrep_sl".
      iIntros (rep_sl repData) "(%HrepEnc & %HrepLen & Hrep_sl)".
      iDestruct (is_slice_to_small with "Hrep_sl") as "Hrep_small".
      wp_store.
      iApply "HΦ".
      iModIntro.
      iFrame.
      iApply "Hpost".
      done.
    }
    iApply (big_sepM_empty).
    done.
  }
  wp_pures.
  by iApply "HΦ".
Qed.

Lemma wp_MakeClerk host γ :
  is_host host γ -∗
  {{{
      True
  }}}
    MakeClerk #host
  {{{
      (ck:loc), RET #ck; own_Clerk γ ck
  }}}.
Proof.
  iIntros "#Hhost !#" (Φ) "_ HΦ".
  wp_lam.
  wp_apply (wp_allocStruct).
  { repeat econstructor. }

  iIntros (ck) "Hck".
  iDestruct (struct_fields_split with "Hck") as "HH".
  iNamed "HH".

  wp_pures.
  wp_apply (wp_MakeClient).
  iIntros (cl) "#His_cl".

  wp_storeField.
  wp_apply (wp_ref_of_zero).
  { done. }

  iIntros (reply_ptr) "Hrep".
  wp_pures.
  wp_apply (wp_NewSlice).
  iIntros (dummy_sl) "Hdummy_sl".
  iDestruct (is_slice_to_small with "Hdummy_sl") as "Hargs_small".
  wp_loadField.

  wp_apply (wp_Client__Call _ _ _ _ _ _ _ _ _ _ (λ l, (∃ cid, erpc_make_client_pre γ.(erpc_gn) cid ∗ ⌜has_encoding l [EncUInt64 cid]⌝))%I with "[] [$His_cl $Hargs_small $Hrep]").
  {
    iDestruct "Hhost" as "(_ & _ & $ & _)".
  }
  {
    iModIntro.
    iNext.
    simpl.
    iIntros.
    iExists _; iFrame.
    done.
  }
  iIntros (err) "(_ & Hargs_small & Hpost)".
  wp_pures.
  destruct err.
  { (* error *)
    rewrite bool_decide_false; last first.
    { by destruct c. }
    wp_apply (wp_Exit).
    iIntros "Hbad".
    done.
  }
  wp_pures.

  iDestruct "Hpost" as (??) "(Hrep_ptr & Hrep_small & Hpost)".
  wp_load.
  iDestruct "Hpost" as (?) "[Hecl %HrepEnc]".
  wp_apply (wp_new_dec with "[$Hrep_small]").
  { done. }
  iIntros (dec) "Hdec".
  wp_apply (wp_Dec__GetInt with "Hdec").
  iIntros "Hdec".
  wp_apply (wp_erpc_MakeClient with "[$Hecl]").
  iIntros (e) "He".
  wp_storeField.
  iApply "HΦ".
  iExists _, _, _.
  iMod (readonly_alloc_1 with "cl") as "$".
  iMod (readonly_alloc_1 with "e") as "$".
  iFrame "He His_cl Hhost".
  done.
Qed.

End ctr_proof.
End ctr.


Require Import List.
Require Import Cps.
Require Import ExtLib.Structures.Monads.
Require Import ExtLib.Structures.Maps.
Require Import ExtLib.Data.Map.FMapAList.
Require Import ExtLib.Core.RelDec.
Require Import ExtLib.Data.Monads.ReaderMonad ExtLib.Data.Monads.OptionMonad.

Set Implicit Arguments.
Set Strict Implicit.

Module Alpha.
  Import CPS.

  Section maps.
    Variable env_v : Type -> Type.
    Context {Mv : DMap var env_v}.

    Section monadic.
      Variable m : Type -> Type.
      Context {Monad_m : Monad m}.
      Context {Reader_m : MonadReader (env_v var) m}.
      Context {Zero_m : MonadZero m}.

      Import MonadNotation.
      Local Open Scope monad_scope.
      Local Open Scope list_scope.

      Definition alpha_op (o1 o2 : op) : m unit :=
        match o1 , o2 with
          | Var_o v1 , Var_o v2 =>
            x <- ask ;;
            match Maps.lookup v1 x with
              | None => assert (eq_dec v1 v2)
              | Some v1 => assert (eq_dec v1 v2)
            end
          | Con_o c1 , Con_o c2 =>
            assert (eq_dec c1 c2)
          | Int_o z1 , Int_o z2 =>
            assert (eq_dec z1 z2)
          | _ , _ => assert false
        end.

      Fixpoint all2 {T} (p : T -> T -> m unit) (ls1 ls2 : list T) : m unit :=
        match ls1 , ls2 with
          | nil , nil => ret tt
          | l1 :: ls1 , l2 :: ls2 =>
            p l1 l2 ;;
            all2 p ls1 ls2
          | _ , _ => assert false
        end.

      Global Instance RelDec_eq_pattern : RelDec (@eq pattern) :=
      { rel_dec := fun x y =>
        match x , y with
          | Int_p x , Int_p y => eq_dec x y
          | Con_p x , Con_p y => eq_dec x y
          | _ , _ => false
        end }.

      Fixpoint alpha_exp' (e1 e2 : exp) {struct e1} : m unit :=
        match e1, e2 with
          | App_e f1 args1 , App_e f2 args2 =>
            alpha_op f1 f2 ;;
            all2 alpha_op args1 args2
          | Let_e ds1 e1 , Let_e ds2 e2 =>
            (** ignore permutations for now... **)
            alpha_dec ds1 ds2 (alpha_exp' e1 e2)
          | Switch_e op1 br1 e1 , Switch_e op2 br2 e2 =>
            alpha_op op1 op2 ;;
            match e1 , e2 with
              | None , None => assert true
              | Some e1 , Some e2 =>
                alpha_exp' e1 e2
              | _ , _ => assert false
            end ;;
            (fix all2 ls1 ls2 : m unit :=
              match ls1 , ls2 with
                | nil , nil => assert true
                | (p1,e1) :: ls1 , (p2,e2) :: ls2 =>
                  assert (eq_dec p1 p2) ;;
                  alpha_exp' e1 e2
                | _ , _ => assert false
              end) br1 br2
          | Halt_e o1 o1', Halt_e o2 o2'=>
            alpha_op o1 o2 ;;
            alpha_op o1' o2'
          | _ , _ => assert false
        end
      with alpha_dec (d1 d2 : decl) (k : m unit) {struct d1} : m unit :=
        match d1 , d2 with
          | Op_d v1 o1 , Op_d v2 o2 =>
            alpha_op o1 o2 ;;
            local (add v1 v2) k
          | Prim_d v1 p1 args1 , Prim_d v2 p2 args2 =>
            assert (eq_dec p1 p2) ;;
            all2 alpha_op args1 args2 ;;
            local (add v1 v2) k
          | Bind_d v1 w1 p1 args1 , Bind_d v2 w2 p2 args2 =>
            assert (eq_dec p1 p2) ;;
            all2 alpha_op args1 args2 ;;
            local (fun x => add v1 v2 (add w1 w2 x)) k
          | Fn_d v1 a1 e1 , Fn_d v2 a2 e2 =>
            (fix map_multi (x y : list var) (k : m unit) : m unit :=
              match x , y with
                | nil , nil => k
                | x :: xs , y :: ys =>
                  local (add x y) (map_multi xs ys k)
                | _ , _ => assert false
              end) a1 a2 (alpha_exp' e1 e2) ;;
            local (add v1 v2) k
          | _ , _ => assert false
        end.
    End monadic.
  End maps.

  Definition alpha_exp (e1 e2 : exp) : bool :=
    let res := runReader (unOptionT (alpha_exp' (m := optionT (reader (alist var var))) e1 e2)) empty in
    match res with
      | None => false
      | Some _ => true
    end.

  Definition alpha_lam (e1 e2 : exp) : list var -> list var -> bool :=
    (fix build acc l1 l2 {struct l1} : bool :=
      match l1 , l2 with
        | nil , nil =>
          let res := runReader (unOptionT (alpha_exp' (m := optionT (reader (alist var var))) e1 e2)) acc in
          match res with
            | None => false
            | Some _ => true
          end
        | l1 :: ls1 , l2 :: ls2 =>
          build (add l1 l2 acc) ls1 ls2
        | _ , _ => false
      end) empty.

  Module TEST.
    Require Import String.

    (** Test cases needed **)
    Definition f (v : var) : exp := Halt_e (Var_o v) (Var_o (wrapVar "world"%string)).

    Goal (alpha_exp (f (wrapVar "0")) (f (wrapVar "2")) = false)%string.
    Proof. vm_compute; reflexivity. Abort.

    Goal (alpha_exp (f (wrapVar "0")) (f (wrapVar "0")) = true)%string.
    Proof. vm_compute; reflexivity. Abort.

    Goal (alpha_lam (f (wrapVar "0")) (f (wrapVar "1")) (wrapVar "0" :: nil) (wrapVar "1" :: nil) = true)%string.
    Proof. vm_compute; reflexivity. Abort.

    Goal (alpha_lam (f (wrapVar "0")) (f (wrapVar "1")) (wrapVar "0" :: nil) (wrapVar "2" :: nil) = false)%string.
    Proof. vm_compute; reflexivity. Abort.

  End TEST.

End Alpha.


Require Import Lang.Syntax Lang.Bindings.
Set Implicit Arguments.

Section section_ktx.

Context (EV LV V L : Set).

(** Use [t] to fill in the hole of [ktx] *)
Fixpoint ktx_plug
(K : ktx EV LV V L) (t : tm EV LV V L) {struct K} :
tm EV LV V L :=
match K with
| ktx_hole => t
| ktx_op K => tm_op (ktx_plug K t)
| ktx_up K => tm_up (ktx_plug K t)
| ktx_down K X => tm_down X (ktx_plug K t)
| ktx_let K s => tm_let (ktx_plug K t) s
| ktx_throw K s => tm_throw (ktx_plug K t) s
| ktx_app_eff K E => tm_app_eff (ktx_plug K t) E
| ktx_app_lbl K ℓ => tm_app_lbl (ktx_plug K t) ℓ
| ktx_app_tm1 K s => tm_app_tm (ktx_plug K t) s
| ktx_app_tm2 K v => tm_app_tm v (ktx_plug K t)
end.

(** Compose outer evaluation context [K] and inner evaluation context
[J] to form a new evaluation context. *)
Fixpoint ktx_comp
(K : ktx EV LV V L) (J : ktx EV LV V L) {struct K} :
ktx EV LV V L :=
match K with
| ktx_hole => J
| ktx_op K => ktx_op (ktx_comp K J)
| ktx_up K => ktx_up (ktx_comp K J)
| ktx_down K X => ktx_down (ktx_comp K J) X
| ktx_let K t => ktx_let (ktx_comp K J) t
| ktx_throw K t => ktx_throw (ktx_comp K J) t
| ktx_app_eff K E => ktx_app_eff (ktx_comp K J) E
| ktx_app_lbl K ℓ => ktx_app_lbl (ktx_comp K J) ℓ
| ktx_app_tm1 K t => ktx_app_tm1 (ktx_comp K J) t
| ktx_app_tm2 K v => ktx_app_tm2 (ktx_comp K J) v
end.

(** Return [True] iff [X] is not a delimiter in [K]. *)
Fixpoint tunnels (X : var) (K : ktx EV LV V L) : Prop :=
match K with
| ktx_hole => True
| ktx_op K => tunnels X K
| ktx_up K => tunnels X K
| ktx_down K Y => tunnels X K ∧ X ≠ Y
| ktx_let K _ => tunnels X K
| ktx_throw K _ => tunnels X K
| ktx_app_eff K _ => tunnels X K
| ktx_app_lbl K _ => tunnels X K
| ktx_app_tm1 K _ => tunnels X K
| ktx_app_tm2 K _ => tunnels X K
end.

End section_ktx.

Inductive config :=
| config_mk : list var → tm0 → config
.

Notation "⟨ ξ , t ⟩" := (config_mk ξ t) : core_scope.

Inductive step : config → config → Prop :=
(** reduction rules *)
| step_let :
  ∀ ξ (v : val0) t,
  step ⟨ξ, tm_let v t⟩ ⟨ξ, V_subst_tm v t⟩
| step_throw :
  ∀ ξ K t,
  step
  ⟨ξ, tm_throw (val_cont K) t⟩
  ⟨ξ, ktx_plug K t⟩
| step_op :
  ∀ ξ m ι,
  step
  ⟨ξ, tm_op (val_fix m ι)⟩
  ⟨ξ, val_md (V_subst_md (val_fix m ι) m) ι⟩
| step_app_eff :
  ∀ ξ m ι E,
  step
  ⟨ξ, tm_app_eff (val_md (md_ev m) ι) E⟩
  ⟨ξ, val_md (EV_subst_md E m) ι⟩
| step_app_lbl :
  ∀ ξ m ι ℓ,
  step
  ⟨ξ, tm_app_lbl (val_md (md_lv m) ι) ℓ⟩
  ⟨ξ, val_md (LV_subst_md ℓ m) ι⟩
| step_app_tm :
  ∀ ξ m ι (v : val0),
  step
  ⟨ξ, tm_app_tm (val_md (md_tm m) ι) v⟩
  ⟨ξ, val_md (V_subst_md v m) ι⟩
| step_Down :
  ∀ ξ t X,
  X ∉ from_list ξ → (* This arbitrariness of [X] induces non-determinism *)
  step
  ⟨ξ, ⬇ t⟩
  ⟨X :: ξ, ⇩ X (L_subst_tm (lid_f X) t)⟩
| step_down_val :
  ∀ ξ X (v : val0),
  step ⟨ξ, ⇩ X v⟩ ⟨ξ, v⟩
| step_down_up :
  ∀ ξ X K t,
  tunnels X K →
  step
  ⟨ξ, ⇩ X (ktx_plug K (⇧ (val_md (md_res t) (lid_f X))))⟩
  ⟨ξ, V_subst_tm (val_cont (ktx_down K X)) t⟩

(** structural rules *)
| step_ktx_let :
  ∀ ξ₁ ξ₂ t₁ t₂ s,
  step ⟨ξ₁, t₁⟩ ⟨ξ₂, t₂⟩ →
  step ⟨ξ₁, tm_let t₁ s⟩ ⟨ξ₂, tm_let t₂ s⟩
| step_ktx_throw :
  ∀ ξ₁ ξ₂ t₁ t₂ s,
  step ⟨ξ₁, t₁⟩ ⟨ξ₂, t₂⟩ →
  step ⟨ξ₁, tm_throw t₁ s⟩ ⟨ξ₂, tm_throw t₂ s⟩
| step_ktx_app_tm1 :
  ∀ ξ₁ ξ₂ t₁ t₂ s,
  step ⟨ξ₁, t₁⟩ ⟨ξ₂, t₂⟩ →
  step ⟨ξ₁, tm_app_tm t₁ s⟩ ⟨ξ₂, tm_app_tm t₂ s⟩
| step_ktx_app_tm2 :
  ∀ ξ₁ ξ₂ (v : val0) t₁ t₂ ,
  step ⟨ξ₁, t₁⟩ ⟨ξ₂, t₂⟩ →
  step ⟨ξ₁, tm_app_tm v t₁⟩ ⟨ξ₂, tm_app_tm v t₂⟩
| step_ktx_app_eff :
  ∀ ξ₁ ξ₂ t₁ t₂ E,
  step ⟨ξ₁, t₁⟩ ⟨ξ₂, t₂⟩ →
  step ⟨ξ₁, tm_app_eff t₁ E⟩ ⟨ξ₂, tm_app_eff t₂ E⟩
| step_ktx_app_lbl :
  ∀ ξ₁ ξ₂ t₁ t₂ ℓ,
  step ⟨ξ₁, t₁⟩ ⟨ξ₂, t₂⟩ →
  step ⟨ξ₁, tm_app_lbl t₁ ℓ⟩ ⟨ξ₂, tm_app_lbl t₂ ℓ⟩
| step_ktx_op :
  ∀ ξ₁ ξ₂ t₁ t₂ ,
  step ⟨ξ₁, t₁⟩ ⟨ξ₂, t₂⟩ →
  step ⟨ξ₁, tm_op t₁⟩ ⟨ξ₂, tm_op t₂⟩
| step_ktx_up :
  ∀ ξ₁ ξ₂ t₁ t₂ ,
  step ⟨ξ₁, t₁⟩ ⟨ξ₂, t₂⟩ →
  step ⟨ξ₁, tm_up t₁⟩ ⟨ξ₂, tm_up t₂⟩
| step_ktx_down :
  ∀ ξ₁ ξ₂ t₁ t₂ X,
  step ⟨ξ₁, t₁⟩ ⟨ξ₂, t₂⟩ →
  step ⟨ξ₁, ⇩ X t₁⟩ ⟨ξ₂, ⇩ X t₂⟩
.

(** The transitive closure of the reduction relation. *)
Definition step_tran := @Relation_Operators.clos_trans_1n _ step.

(** The reflexive and transitive closure of the reduction relation. *)
Definition step_refl_tran := @Relation_Operators.clos_refl_trans_1n _ step.

(** Reduction in a given number of steps. *)
Inductive step_n : nat → config → config → Prop :=
| step_n_O : ∀ c, step_n O c c
| step_n_S : ∀ n c₁ c₂ c₃,
    step c₁ c₂ →
    step_n n c₂ c₃ →
    step_n (S n) c₁ c₃
.