Commit c5b40db9 authored by Glen Mével's avatar Glen Mével

implemented thunks using a non-atomic invariant

parent 1e470a3a
......@@ -26,7 +26,6 @@ taken from [here][coqproject]).
* `TimeCredits`: implementation of time credits
* `TimeReceipts`: implementation of time receipts
* `Examples`: a (too) simple example illustrating the use of time credits
* `LibThunk`: implementation of timed thunks using time credits [WIP, does not
compile for now]
* `Thunks`: implementation of timed thunks using time credits
* `test`: an alternative proof of the main theorem of time credits, that does
not rely on the unsafe behaviour of `tick` [to be merged into `TimeCredits`]
......@@ -9,11 +9,39 @@ Section Auth_mnat.
Context `{inG Σ (authR mnatUR)}.
Lemma auth_mnat_alloc (n : mnat) :
(|==> γ, own γ (mnat n) own γ (mnat n))%I.
Proof.
by iMod (own_alloc (mnat n mnat n)) as (γ) "[? ?]" ; auto with iFrame.
Qed.
Global Arguments auth_mnat_alloc _%nat.
Lemma own_auth_mnat_le (γ : gname) (m n : mnat) :
own γ (mnat m) -
own γ (mnat n) -
(n m)%nat.
Proof.
iIntros "H● H◯".
iDestruct (own_valid_2 with "H● H◯") as % [[k ->] _] % auth_valid_discrete_2.
iPureIntro. apply Max.le_max_l.
Qed.
Lemma own_auth_mnat_weaken (γ : gname) (n n : mnat) :
(n n)%nat
own γ (mnat n) -
own γ (mnat n).
Proof.
iIntros (I) "H".
rewrite (_ : n = n `max` n)%nat ; last (by rewrite max_l).
iDestruct "H" as "[_$]".
Qed.
Global Arguments own_auth_mnat_weaken _ (_ _ _)%nat_scope.
Lemma own_auth_mnat_null (γ : gname) (m : mnat) :
own γ (mnat m) -
own γ (mnat m) own γ (mnat 0).
Proof.
by rewrite - own_op (_ : mnat m mnat 0 = mnat m).
by rewrite - own_op.
Qed.
Global Arguments own_auth_mnat_null _ _%nat_scope.
......@@ -38,4 +66,19 @@ Section Auth_mnat.
Qed.
Global Arguments auth_mnat_update_incr _ (_ _)%nat_scope.
Lemma auth_mnat_update_incr' (γ : gname) (m n k : mnat) :
own γ (mnat m) -
own γ (mnat n) -
|==> own γ (mnat (m + k : mnat)) own γ (mnat (n + k : mnat)).
Proof.
iIntros "H● H◯".
iDestruct (own_auth_mnat_le with "H● H◯") as %I. iClear "H◯".
iDestruct (auth_mnat_update_incr _ _ k with "H●") as ">H●".
iDestruct (auth_mnat_update_read_auth with "H●") as ">[$ H◯]".
iModIntro.
rewrite (_ : m + k = (n + k) `max` (m + k))%nat ; last lia.
iDestruct "H◯" as "[$ _]".
Qed.
Global Arguments auth_mnat_update_incr' _ (_ _ _)%nat_scope.
End Auth_mnat.
\ No newline at end of file
......@@ -10,9 +10,9 @@ Section Auth_nat.
Context `{inG Σ (authR natUR)}.
Lemma auth_nat_alloc (n : nat) :
(|==> γ, own γ ( n) own γ ( n))%I.
(|==> γ, own γ (nat n) own γ (nat n))%I.
Proof.
by iMod (own_alloc ( n n)) as (γ) "[? ?]" ; auto with iFrame.
by iMod (own_alloc (nat n nat n)) as (γ) "[? ?]" ; auto with iFrame.
Qed.
Lemma own_auth_nat_le (γ : gname) (m n : nat) :
......@@ -25,6 +25,16 @@ Section Auth_nat.
as % [?%nat_le_sum _] % auth_valid_discrete_2.
Qed.
Lemma own_auth_nat_weaken (γ : gname) (n n : nat) :
(n n)%nat
own γ (nat n) -
own γ (nat n).
Proof.
iIntros (I) "H".
rewrite (_ : n = (n - n) + n)%nat ; last lia.
iDestruct "H" as "[_$]".
Qed.
Lemma own_auth_nat_null (γ : gname) (m : nat) :
own γ (nat m) -
own γ (nat m) own γ (nat 0).
......@@ -53,14 +63,4 @@ Section Auth_nat.
apply auth_update, nat_local_update. lia.
Qed.
Lemma own_auth_nat_weaken (γ : gname) (n n : nat) :
(n n)%nat
own γ (nat n) -
own γ (nat n).
Proof.
iIntros (I) "H".
rewrite (_ : n = (n - n) + n)%nat ; last lia.
iDestruct "H" as "[_$]".
Qed.
End Auth_nat.
\ No newline at end of file
This diff is collapsed.
From iris.heap_lang Require Import proofmode notation.
From iris.base_logic.lib Require Import na_invariants.
From stdpp Require Import namespaces.
Require Import TimeCredits Auth_mnat.
Section Thunk.
Context `{timeCreditHeapG Σ}.
Context `{inG Σ (authR mnatUR)}.
Context `{na_invG Σ}.
Implicit Type t : loc.
Implicit Type γ : gname.
Implicit Type n nc ac : nat.
Implicit Type φ : val iProp Σ.
Implicit Type f v : val.
Implicit Type p : na_inv_pool_name.
Implicit Type E F : coPset.
Notation UNEVALUATED f := (InjL f%V) (only parsing).
Notation EVALUATED v := (InjR v%V) (only parsing).
Notation UNEVALUATEDV f := (InjLV f%V) (only parsing).
Notation EVALUATEDV v := (InjRV v%V) (only parsing).
Notation "'match:' e0 'with' 'UNEVALUATED' x1 => e1 | 'EVALUATED' x2 => e2 'end'" :=
(Match e0 x1%bind e1 x2%bind e2)
(e0, e1, x2, e2 at level 200, only parsing) : expr_scope.
Definition thunkN t : namespace :=
nroot .@ "thunk" .@ string_of_pos t.
Definition ThunkInv t γ nc φ : iProp Σ := (
(ac : nat),
own γ (mnat ac)
(
( (f : val),
t UNEVALUATEDV f
{{{ TC nc }}} f #() {{{ v, RET v ; φ v }}}
TC ac
)
( (v : val),
t EVALUATEDV v
φ v
(nc ac)%nat
)
)
)%I.
Definition Thunk p t n φ : iProp Σ := (
(γ : gname) (nc : nat),
na_inv p (thunkN t) (ThunkInv t γ nc φ)
own γ (mnat (nc-n))
)%I.
Lemma thunk_persistent p t n φ :
Persistent (Thunk p t n φ).
Proof. exact _. Qed.
Lemma thunk_dup p t n φ :
Thunk p t n φ (Thunk p t n φ Thunk p t n φ)%I.
Proof.
iSplit. { auto. } { iIntros "[$_]". }
Qed.
Lemma Thunk_weaken p t n n φ :
(n n)%nat
Thunk p t n φ -
Thunk p t n φ.
Proof.
iIntros (I) "H". iDestruct "H" as (γ nc) "[Hinv Hγ◯]".
iExists γ, nc. iFrame "Hinv".
iDestruct (own_auth_mnat_weaken _ (nc-n)%nat (nc-n)%nat with "Hγ◯") as "$" ; lia.
Qed.
Definition create : val :=
λ: "f",
ref (UNEVALUATED "f").
Definition force : val :=
rec: "force" "t" :=
match: ! "t" with
UNEVALUATED "f" =>
let: "v" := "f" #() in
"t" <- (EVALUATED "v") ;;
"v"
| EVALUATED "v" =>
"v"
end.
Lemma create_spec p nc φ f :
TICKCTXT -
{{{ ( {{{ TC nc }}} f #() {{{ v, RET v ; φ v }}} ) }}}
create f
{{{ (t : loc), RET #t ; |={}=> Thunk p t nc φ }}}.
Proof.
iIntros "#Htickinv" (Φ) "!# Hf Post".
iDestruct (zero_TC with "Htickinv") as ">Htc0".
iMod (auth_mnat_alloc 0) as (γ) "[Hγ● Hγ◯]".
wp_lam. wp_alloc t.
iApply "Post".
iExists γ, nc ; rewrite (_ : nc - nc = 0)%nat ; last lia.
iFrame "Hγ◯".
iApply na_inv_alloc.
iNext. iExists 0%nat. auto with iFrame.
Qed.
Lemma force_spec p F t φ :
(thunkN t) F
( (v : val), φ v - φ v φ v)
{{{ Thunk p t 0 φ na_own p F }}}
force #t
{{{ v, RET v ; φ v |={}=> na_own p F }}}.
Proof.
iIntros (? Hφdup Φ) "[#Hthunk Hp] Post".
iDestruct "Hthunk" as (γ nc) "#[Hthunkinv Hγ◯]".
rewrite (_ : nc - 0 = nc)%nat ; last lia.
wp_rec.
(* reading the thunk *)
iDestruct (na_inv_open p F (thunkN t) with "Hthunkinv Hp")
as ">(Hthunk & Hp & Hclose)" ; [done|done|] ;
iDestruct "Hthunk" as (ac) "(>Hγ● & [ Hunevaluated | Hevaluated ])" ;
[ iDestruct "Hunevaluated" as (f) "(>Ht & Hf & >Htc)"
| iDestruct "Hevaluated" as (v) "(>Ht & Hv & >%)" ].
(* (1) if it is UNEVALUATED, we evaluate it: *)
{
wp_load. wp_match.
iDestruct (own_auth_mnat_le with "Hγ● Hγ◯") as %I.
iDestruct (TC_weaken _ _ I with "Htc") as "Htc".
wp_apply ("Hf" with "Htc") ; iIntros (v) "Hv".
wp_let. wp_store.
iApply "Post".
iDestruct (Hφdup with "Hv") as "[Hv $]".
iApply "Hclose". iFrame "Hp".
iNext. iExists ac. auto with iFrame.
}
(* (2) if it is EVALUATED, we get the result which is already memoized: *)
{
wp_load. wp_match.
iApply "Post".
iDestruct (Hφdup with "Hv") as "[Hv $]".
iApply "Hclose". iFrame "Hp".
iNext. iExists ac. auto with iFrame.
}
Qed.
Lemma pay_spec p F (n k : nat) t φ :
(thunkN t) F
na_own p F - Thunk p t n φ - TC k ={}= Thunk p t (n-k) φ na_own p F.
Proof.
iIntros (?) "Hp #Hthunk Htc_k".
iDestruct "Hthunk" as (γ nc) "#[Hthunkinv Hγ◯]".
(* reading the thunk *)
iDestruct (na_inv_open p F (thunkN t) with "Hthunkinv Hp")
as ">(Hthunk & Hp & Hclose)" ; [done|done|] ;
iDestruct "Hthunk" as (ac) "(>Hγ● & [ Hunevaluated | Hevaluated ])" ;
[ iDestruct "Hunevaluated" as (f) "(>Ht & Hf & >Htc)"
| iDestruct "Hevaluated" as (v) "(>Ht & Hv & >%)" ].
(* (1) if it is UNEVALUATED, then we add the time credits to the deposit: *)
{
iAssert (TC (ac + k)) with "[Htc Htc_k]" as "Htc" ;
first by iSplitL "Htc".
iDestruct (auth_mnat_update_incr' _ _ _ k with "Hγ● Hγ◯") as ">[Hγ●' #Hγ◯']" ;
iClear "Hγ◯".
iMod ("Hclose" with "[-Hγ◯']") as "$". {
iFrame "Hp".
iNext. iExists (ac+k)%nat. auto with iFrame.
}
iModIntro.
iExists γ, nc. iFrame "Hthunkinv".
iDestruct (own_auth_mnat_weaken _ ((nc-n)+k) (nc-(n-k)) with "Hγ◯'") as "$" ; lia.
}
(* (2) if it is EVALUATED, then we do nothing: *)
{
iDestruct (auth_mnat_update_incr' _ _ _ k with "Hγ● Hγ◯") as ">[Hγ●' #Hγ◯']" ;
iClear "Hγ◯".
assert (nc ac + k)%nat by lia.
iMod ("Hclose" with "[-Hγ◯']") as "$". {
iFrame "Hp".
iNext. iExists (ac+k)%nat. auto with iFrame.
}
iModIntro.
iExists γ, nc. iFrame "Hthunkinv".
iDestruct (own_auth_mnat_weaken _ ((nc-n)+k) (nc-(n-k)) with "Hγ◯'") as "$" ; lia.
}
Qed.
(* TODO: prove these specifications on the translation of create, force *)
End Thunk.
\ No newline at end of file
......@@ -78,6 +78,10 @@ Section TickSpec.
Lemma TC_succ n :
TC (S n) (TC 1%nat TC n)%I.
Proof. by rewrite (eq_refl : S n = 1 + n)%nat TC_plus. Qed.
Lemma TC_weaken (n n : nat) :
(n n)%nat
TC n - TC n.
Proof. apply own_auth_nat_weaken. Qed.
Lemma TC_timeless n :
Timeless (TC n).
......@@ -98,6 +102,15 @@ Section TickSpec.
Definition TICKCTXT : iProp Σ :=
inv timeCreditN ( (m:nat), #m own γ (nat m))%I.
Lemma zero_TC :
TICKCTXT ={}= TC 0.
Proof.
iIntros "#Htickinv".
iInv timeCreditN as (m) ">[Hcounter H●]" "Hclose".
iDestruct (own_auth_nat_null with "H●") as "[H● $]".
iApply "Hclose" ; eauto with iFrame.
Qed.
Theorem tick_spec s E e v :
timeCreditN E
IntoVal e v
......
......@@ -2,12 +2,12 @@
Auth_mnat.v
Auth_nat.v
Examples.v
LibThunk.v
Misc.v
Reduction.v
Tactics.v
test.v
Simulation.v
Thunks.v
TimeCredits.v
TimeReceipts.v
Translation.v
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment