From iris.algebra Require Export auth excl frac numbers.
From iris.base_logic.lib Require Export invariants token.
From iris.heap_lang Require Import lang proofmode notation par.

(* ################################################################# *)
(** * Spin Lock *)

Definition mk_lock : val :=
  λ: <>, ref #false.

Definition acquire : val :=
  rec: "acquire" "l" :=
  if: CAS "l" #false #true then
    #()
  else
    "acquire" "l".

Definition release : val :=
  λ: "l", "l" <- #false.

Section proofs.
Context `{heapGS Σ, !tokenG Σ}.

Definition locked γ : iProp Σ := token γ.

(**
  Allocation and exclusivity of the [locked] predicate then follows
  directly from the properties of the token.
*)
Lemma locked_alloc : ⊢ |==> ∃ γ, locked γ.
Proof. apply token_alloc. Qed.

Lemma locked_excl γ : locked γ -∗ locked γ -∗ False.
Proof. apply token_exclusive. Qed.

(**
  We will need our representation predicate for the lock, [is_lock], to
  be persistent so that it can be shared among participating threads.
  Therefore, we will be needing an invariant. The invariant states that
  the location representing the lock, [l], maps to a boolean [b], and if
  [b] is [false], meaning the lock is unlocked, then the invariant owns
  both the protected resources and the [locked] predicate.
*)
Let N := nroot .@ "lock".

Definition lock_inv γ l P : iProp Σ :=
  ∃ b : bool, l ↦ #b ∗
  if b then True
  else locked γ ∗ P.

(**
  The representation predicate then just asserts that the value
  representing the lock is a location which satisfies the lock
  invariant.
*)
Definition is_lock γ v P : iProp Σ :=
  ∃ l : loc, ⌜v = #l⌝ ∗ inv N (lock_inv γ l P).

(* ================================================================= *)
(** ** Specifications *)

Lemma mk_lock_spec P :
  {{{ P }}} mk_lock #() {{{ γ v, RET v; is_lock γ v P }}}.
Proof.
  iIntros "%Φ HP HΦ".
  wp_lam.
  wp_alloc l as "Hl".
  iMod locked_alloc as "[%γ Hγ]".
  iMod (inv_alloc N _ (lock_inv γ l P) with "[HP Hl Hγ]") as "I".
  {
    iNext.
    iExists false.
    iFrame.
  }
  iModIntro.
  iApply "HΦ".
  iExists l.
  by iFrame.
Qed.

(**
  Acquiring the lock should grant access to the protected resources as
  well as knowledge that the lock has been locked.
*)
Lemma acquire_spec γ v P :
  {{{ is_lock γ v P }}} acquire v {{{ RET #(); locked γ ∗ P }}}.
Proof.
  iIntros "%Φ (%l & -> & #I) HΦ".
  iLöb as "IH".
  wp_rec.
  wp_bind (CmpXchg _ _ _).
  iInv "I" as ([]) "[Hl Hγ]".
  - wp_cmpxchg_fail.
    iModIntro.
    iSplitL "Hl Hγ".
    {
      iNext.
      iExists true.
      iFrame.
    }
    wp_pures.
    wp_apply ("IH" with "HΦ").
  - wp_cmpxchg_suc.
    iModIntro.
    iSplitL "Hl".
    {
      iNext.
      iExists true.
      iFrame.
    }
    wp_pures.
    iModIntro.
    iApply ("HΦ" with "Hγ").
Qed.

(**
  Releasing the lock consists of transferring back the protected
  resources and the [locked] predicate to the lock.
*)

(** exercise: release_spec (2 stars) **)
Lemma release_spec γ v P :
  {{{ is_lock γ v P ∗ locked γ ∗ P }}} release v {{{ RET #(); True }}}.
Proof.
  (* exercise *)
Admitted.

(** exercise: lock_client_spec (3 stars)
    Below is a program that uses a lock. Prove that it meets the following
    specification, using the lock specs above.
    You can refer to prog_spec in spin_lock.v as an example.
    Hint 1: When you apply mk_lock_spec, you will need to choose an invariant for
    the lock. Make sure it's one that allows you to prove the postcondition.
    Hint 2: Make sure to introduce your "is_lock" predicate with the # mode, so it
    persists through all the lock operations. **)
Definition lock_client : expr :=
  let: "x" := ref #2 in
  let: "l" := mk_lock #() in
  Fork (
    acquire "l";;
    "x" <- !"x" + #1;;
    "x" <- !"x" + #1;;
    release "l"
  );;
  acquire "l";;
  let: "v" := !"x" in
  release "l";;
  "v".

Lemma lock_client_spec :
  {{{ True }}} lock_client {{{ v, RET #v; ⌜Zeven v⌝ }}}.
Proof.
  (* exercise *)
Admitted.

End proofs.

(* ################################################################# *)
(** * Counter *)

(* ================================================================= *)
(** ** Implementation *)

(**
  Let us define a simple counter module. Our counter consists of three
  functions:
  - a constructor, [mk_counter], which creates a new counter starting at
    [0].
  - an increment function, [incr], which increments the counter and
    returns the old value of the counter.
  - a read function, [read], which reads the current value of the
    counter.
  Furthermore, we want the counter to be shareable across multiple
  threads, so we will implement [incr] with [CAS] as the synchronisation
  mechanism.
*)

Definition mk_counter : val :=
  λ: <>, ref #0.

Definition incr : val :=
  rec: "incr" "c" :=
  let: "n" := !"c" in
  let: "m" := "n" + #1 in
  if: CAS "c" "n" "m" then "n" else "incr" "c".

Definition read : val :=
  λ: "c", !"c".

(* ================================================================= *)
(** ** Defining a Representation Predicate for the Counter *)

Module spec1.
Section spec1.
Context `{heapGS Σ}.

Let N := nroot .@ "counter".

(**
  The final step is to use ghost state. The idea is to link [n] and [m]
  to pieces of ghost state in such a way that the validity of their
  composite is [n ≤ m].

  To achieve this, we will use the _authoritative_ resource algebra,
  [auth]. This resource algebra is parametrised by a CMRA, [A]. There
  are two types of elements in the carrier of the authoritative RA:
  - [● x] called an authoritative element    \aa if you've done editor.md
  - [◯ y] called a fragment                  \af
  where [x, y ∈ A].

  The idea of the authoritative RA is as follows. The authoritative
  element represents the whole of the resource, while the fragments act
  as the pieces. To achieve this, the authoritative element acts like
  the exclusive RA, while the fragment inherits all the operations of
  [A]. Furthermore, validity of [● x ⋅ ◯ y] is defined as [✓ x ∧ y ≼ x].

  In our case, we will use the authoritative RA over the [max_nat]
  resource algebra. The carrier of [max_nat] is the natural numbers, and
  the operation is the maximum.
*)
Context `{!inG Σ (authR max_natUR)}.

(**
  As such, [● (MaxNat m)] will represent the _true_ value of the counter
  [m], and [◯ (MaxNat n)] will represent a _fragment_ of the counter – a
  lower bound [n].
*)

Definition is_counter (v : val) (γ : gname) (n : nat) : iProp Σ :=
  ∃ l : loc, ⌜v = #l⌝ ∗ own γ (◯ MaxNat n) ∗ (* γ ↦ (◯ MaxNat n) *)
    inv N (∃ m : nat, l ↦ #m ∗ own γ (● MaxNat m)).

Global Instance is_counter_persistent v γ n :
  Persistent (is_counter v γ n) := _.

(* ================================================================= *)
(** ** Properties of the Authoritative RA with MaxNat *)

(**
  Before we start proving the specification, let us prove some useful
  lemmas about our ghost state. For starters, we need to know that we
  can allocate the initial state we need.
*)


Lemma alloc_initial_state n :
  ⊢ |==> ∃ γ, own γ (● MaxNat n) ∗ own γ (◯ MaxNat n).
Proof.
  (**
    Ownership of multiple fragments of state amounts to ownership of
    their composite. So we can simplify the goal a little.
  *)
  setoid_rewrite <- own_op.
  (** Now the goal is on the form expected by [own_alloc]. *)
  apply own_alloc.
  (**
    However, we are only allowed to allocate valid states. So we must
    prove that our desired state is a valid one.

    The validity of [auth] says that the fragment must be included in
    the authoritative element and the authoritative element must be
    valid.
  *)
  apply auth_both_valid_discrete.
  split.
  - (** Inclusion for [max_nat] turns out to be the natural ordering. *)
    apply max_nat_included; simpl.
    reflexivity.
  - (** All elements of [max_nat] are valid. *)
    cbv.
    done.
Qed.

Lemma state_valid γ n m :
  own γ (● MaxNat n) -∗
  own γ (◯ MaxNat m) -∗
  ⌜m ≤ n⌝.
Proof.
  iIntros "Hγ Hγ'".
  iPoseProof (own_valid_2 with "Hγ Hγ'") as "%H".
  iPureIntro.
  apply auth_both_valid_discrete in H.
  destruct H as [H _].
  apply max_nat_included in H; cbn in H.
  done.
Qed.

Lemma update_state γ n :  (* own γ (◯ MaxNat 4) *)
  own γ (● MaxNat n) ==∗
  own γ (● MaxNat (S n)) ∗ own γ (◯ MaxNat (S n)).
Proof.
  iIntros "H".
  rewrite <- own_op.
  (**
    As we saw in the Resource Algebra chapter, to update a resource, we
    must show that we can perform a frame preserving update to the
    updated resource.
  *)
  iApply (own_update with "H").
  (**
    [auth] has its own special version of these called _local updates_,
    as we know what the whole of the state is.
  *)
  apply auth_update_alloc.
  apply max_nat_local_update; cbn.
  by apply le_S.
Qed.

(* ================================================================= *)
(** ** Proving the Counter Specification *)

(** exercise: read_spec (2 stars) **)
Lemma read_spec c γ n :
  {{{ is_counter c γ n }}} read c {{{ (u : nat), RET #u; ⌜n ≤ u⌝ }}}.
Proof.
  (* exercise *)
Admitted.

End spec1.
End spec1.