Commit f149a710 authored by Jacques-Henri Jourdan's avatar Jacques-Henri Jourdan

Update wrt Iris dev.2018-10-13.0.7041c043

parent 1fe68c70
...@@ -4,8 +4,9 @@ Makefile.coq ...@@ -4,8 +4,9 @@ Makefile.coq
*.aux *.aux
*.glob *.glob
*.vo *.vo
*.vio
.lia.cache .lia.cache
*.tar.gz *.tar.gz
*.sw[po] *.sw[po]
\#*.v# \#*.v#
_opam _opam
\ No newline at end of file
...@@ -240,7 +240,7 @@ Lemma prgm_translation_spec `{!timeCreditHeapG Σ} (n : nat) : ...@@ -240,7 +240,7 @@ Lemma prgm_translation_spec `{!timeCreditHeapG Σ} (n : nat) :
Proof. Proof.
iIntros "#Htickinv !#" (Φ) "Htc Post". iIntros "#Htickinv !#" (Φ) "Htc Post".
unfold prgm. unfold prgm.
change « sum_list (make_list (LitV n)) » with («sum_list» (tick «make_list #n»)). change « sum_list (make_list (LitV n)) » with ((tick «sum_list») «make_list #n»).
rewrite !translation_of_val. rewrite !translation_of_val.
replace (6+15*n)%nat with ((3+5*n) + (3+10*n))%nat by lia ; replace (6+15*n)%nat with ((3+5*n) + (3+10*n))%nat by lia ;
rewrite TC_plus ; iDestruct "Htc" as "[Htc_make Htc_sum]". rewrite TC_plus ; iDestruct "Htc" as "[Htc_make Htc_sum]".
...@@ -256,7 +256,7 @@ Proof. ...@@ -256,7 +256,7 @@ Proof.
Qed. Qed.
Lemma prgm_timed_spec (n : nat) (σ : state) `{!timeCreditHeapPreG Σ} : Lemma prgm_timed_spec (n : nat) (σ : state) `{!timeCreditHeapPreG Σ} :
adequate NotStuck (prgm n) σ (λ v, v = #(n*(n+1)/2)) adequate NotStuck (prgm n) σ (λ v _, v = #(n*(n+1)/2))
bounded_time (prgm n) σ (6 + 15 * n)%nat. bounded_time (prgm n) σ (6 + 15 * n)%nat.
Proof. Proof.
apply (spec_tctranslation__adequate_and_bounded' (Σ:=Σ)). apply (spec_tctranslation__adequate_and_bounded' (Σ:=Σ)).
...@@ -264,4 +264,4 @@ Proof. ...@@ -264,4 +264,4 @@ Proof.
- rewrite !andb_True ; repeat split ; apply is_closed_of_val. - rewrite !andb_True ; repeat split ; apply is_closed_of_val.
- intros HtcHeapG. apply prgm_translation_spec. - intros HtcHeapG. apply prgm_translation_spec.
- assumption. - assumption.
Qed. Qed.
\ No newline at end of file
...@@ -440,8 +440,8 @@ Section ActiveItem. ...@@ -440,8 +440,8 @@ Section ActiveItem.
Definition ectx_item_is_active (Ki : ectx_item) : bool := Definition ectx_item_is_active (Ki : ectx_item) : bool :=
match Ki with match Ki with
| AppRCtx _ | UnOpCtx _ | BinOpRCtx _ _ | IfCtx _ _ | FstCtx | SndCtx | AppLCtx _ | UnOpCtx _ | BinOpLCtx _ _ | IfCtx _ _ | FstCtx | SndCtx
| CaseCtx _ _ | AllocCtx | LoadCtx | StoreRCtx _ | CasRCtx _ _ | FaaRCtx _ => true | CaseCtx _ _ | AllocCtx | LoadCtx | StoreLCtx _ | CasLCtx _ _ | FaaLCtx _ => true
| _ => false | _ => false
end. end.
...@@ -482,9 +482,9 @@ Section ActiveItem. ...@@ -482,9 +482,9 @@ Section ActiveItem.
Proof. Proof.
induction e ; induction e ;
try maximal_ectx_from_subterm IHe ; try maximal_ectx_from_subterm IHe ;
try maximal_ectx_from_subterm IHe1 ;
try maximal_ectx_from_subterm IHe2 ;
try maximal_ectx_from_subterm IHe3 ; try maximal_ectx_from_subterm IHe3 ;
try maximal_ectx_from_subterm IHe2 ;
try maximal_ectx_from_subterm IHe1 ;
maximal_ectx_empty. maximal_ectx_empty.
Qed. Qed.
...@@ -605,7 +605,7 @@ End ActiveItem. ...@@ -605,7 +605,7 @@ End ActiveItem.
Section Safety. Section Safety.
Definition safe e σ : Prop := Definition safe e σ : Prop :=
adequate NotStuck e σ (λ _, True). adequate NotStuck e σ (λ _ _, True).
(* (*
Lemma safe_alt e σ : Lemma safe_alt e σ :
...@@ -622,7 +622,7 @@ Section Safety. ...@@ -622,7 +622,7 @@ Section Safety.
Qed. Qed.
*) *)
Lemma safe_adequate e σ (φ : val Prop) : Lemma safe_adequate e σ (φ : val state Prop) :
adequate NotStuck e σ φ adequate NotStuck e σ φ
safe e σ. safe e σ.
Proof. Proof.
......
...@@ -71,11 +71,8 @@ Section Tick_exec. ...@@ -71,11 +71,8 @@ Section Tick_exec.
tick v tick v
)%E (<[ := #(S n)]> σ). )%E (<[ := #(S n)]> σ).
{ {
prim_step ; first exact _. prim_step ; first exact _. simpl_subst. repeat f_equal.
replace (rec: "tick" "x" := _)%E with (of_val tick) by by unlock tick. unfold tick. by unlock. }
unfold subst ; simpl ; fold subst.
rewrite ! subst_is_closed_nil // ; apply is_closed_of_val.
}
apply prim_exec_cons_nofork apply prim_exec_cons_nofork
with ( with (
let: "k" := #(S n) in let: "k" := #(S n) in
...@@ -100,9 +97,7 @@ Section Tick_exec. ...@@ -100,9 +97,7 @@ Section Tick_exec.
tick v tick v
)%E (<[ := #(S n)]> σ). )%E (<[ := #(S n)]> σ).
{ {
prim_step ; first exact _. prim_step ; first exact _. by simpl_subst.
unfold subst ; simpl ; fold subst.
rewrite ! subst_is_closed_nil // ; apply is_closed_of_val.
} }
apply prim_exec_cons_nofork apply prim_exec_cons_nofork
with ( with (
...@@ -129,8 +124,7 @@ Section Tick_exec. ...@@ -129,8 +124,7 @@ Section Tick_exec.
apply prim_exec_cons_nofork apply prim_exec_cons_nofork
with (if: #true then v else tick v)%E (<[ := #(S n - 1)]> (<[ := #(S n)]> σ)). with (if: #true then v else tick v)%E (<[ := #(S n - 1)]> (<[ := #(S n)]> σ)).
{ {
prim_step. prim_step; [apply lookup_insert|auto].
apply lookup_insert.
} }
replace (S n - 1) with (Z.of_nat n) by lia. replace (S n - 1) with (Z.of_nat n) by lia.
rewrite insert_insert. rewrite insert_insert.
...@@ -144,7 +138,7 @@ Section Tick_exec. ...@@ -144,7 +138,7 @@ Section Tick_exec.
Lemma exec_tick_case_branch e1 v2 σ : Lemma exec_tick_case_branch e1 v2 σ :
is_closed [] e1 is_closed [] e1
prim_exec (tick_case_branch (λ: <>, e1) v2)%E σ (e1 (tick v2)) σ []. prim_exec (tick_case_branch (λ: <>, e1) v2)%E σ ((tick e1) v2) σ [].
Proof. Proof.
intros ; assert (Closed [] e1) by exact. intros ; assert (Closed [] e1) by exact.
unfold tick_case_branch ; unlock. unfold tick_case_branch ; unlock.
...@@ -154,20 +148,15 @@ Section Tick_exec. ...@@ -154,20 +148,15 @@ Section Tick_exec.
- rewrite /= decide_left //. - rewrite /= decide_left //.
- exact _. - exact _.
} }
simpl_subst.
eapply prim_exec_cons_nofork. eapply prim_exec_cons_nofork.
{ {
prim_step ; prim_step. exact _.
fold subst.
rewrite subst_is_closed_nil ; last apply is_closed_of_val.
exact _.
} }
eapply prim_exec_cons_nofork, prim_exec_nil ; simpl. simpl_subst.
eapply prim_exec_cons_nofork, prim_exec_nil.
{ {
unfold subst ; simpl ; fold subst. prim_step.
rewrite subst_is_closed_nil ; last assumption.
rewrite subst_is_closed_nil ; last by apply is_closed_subst, is_closed_of_val.
rewrite subst_is_closed_nil ; last apply is_closed_of_val.
by prim_step.
} }
Qed. Qed.
...@@ -251,7 +240,12 @@ Section SimulationLemma. ...@@ -251,7 +240,12 @@ Section SimulationLemma.
(* BetaS f x e1 e2 v2 e' σ : *) (* BetaS f x e1 e2 v2 e' σ : *)
- assert (Closed (f :b: x :b: []) « e1 ») by by apply is_closed_translation. - assert (Closed (f :b: x :b: []) « e1 ») by by apply is_closed_translation.
rewrite 2! translation_subst' translation_of_val. rewrite 2! translation_subst' translation_of_val.
tick_then_step_then_stop. replace (rec: f x := « e1 »)%E with (of_val (rec: f x := « e1 »)%V)
by by unlock.
(* FIXME : tick_then_step_then_stop does not work here. *)
eapply prim_exec_transitive_nofork. exec_tick_success.
eapply prim_exec_cons_nofork, prim_exec_nil.
simpl. unlock. prim_step.
(* UnOpS op e v v' σ : *) (* UnOpS op e v v' σ : *)
- tick_then_step_then_stop. - tick_then_step_then_stop.
by apply un_op_eval_translation. by apply un_op_eval_translation.
...@@ -301,10 +295,12 @@ Section SimulationLemma. ...@@ -301,10 +295,12 @@ Section SimulationLemma.
rewrite lookup_insert_ne ; last done. rewrite lookup_insert_ne ; last done.
by apply lookup_translationS_Some. by apply lookup_translationS_Some.
+ eauto using translationV_injective. + eauto using translationV_injective.
+ by apply vals_cas_compare_safe_translationV.
(* CasSucS l e1 v1 e2 v2 σ : *) (* CasSucS l e1 v1 e2 v2 σ : *)
- tick_then_step_then_stop. - tick_then_step_then_stop.
rewrite lookup_insert_ne ; last exact I. + rewrite lookup_insert_ne ; last exact I.
by apply lookup_translationS_Some. by apply lookup_translationS_Some.
+ by apply vals_cas_compare_safe_translationV.
(* FaaS l i1 e2 i2 σ : *) (* FaaS l i1 e2 i2 σ : *)
- tick_then_step_then_stop. - tick_then_step_then_stop.
rewrite lookup_insert_ne ; last exact I. rewrite lookup_insert_ne ; last exact I.
...@@ -429,7 +425,7 @@ Section SimulationLemma. ...@@ -429,7 +425,7 @@ Section SimulationLemma.
| idtac | idtac
]. ].
(* BetaS *) (* BetaS *)
- destruct v1 ; try discriminate E. - destruct v ; try discriminate E.
eexhibit_prim_step. eexhibit_prim_step.
(* UnOpS *) (* UnOpS *)
- eexhibit_prim_step. - eexhibit_prim_step.
...@@ -465,10 +461,12 @@ Section SimulationLemma. ...@@ -465,10 +461,12 @@ Section SimulationLemma.
(* CasFailS *) (* CasFailS *)
- apply lookup_translationS_Some_inv in Hbound_l as (? & ? & ->). - apply lookup_translationS_Some_inv in Hbound_l as (? & ? & ->).
exhibit_prim_step (#false)%E. exhibit_prim_step (#false)%E.
intros ? % (f_equal translationV). contradiction. + intros ? % (f_equal translationV). contradiction.
+ by apply vals_cas_compare_safe_translationV_inv.
(* CasSucS *) (* CasSucS *)
- apply lookup_translationS_Some_inv in Hbound_l as (? & ? & -> % translationV_injective). - apply lookup_translationS_Some_inv in Hbound_l as (? & ? & -> % translationV_injective).
exhibit_prim_step (#true)%E. exhibit_prim_step (#true)%E.
by apply vals_cas_compare_safe_translationV_inv.
(* FaaS *) (* FaaS *)
- apply lookup_translationS_Some_inv in Hbound_l as (? & ? & -> % eq_sym % translationV_lit_inv). - apply lookup_translationS_Some_inv in Hbound_l as (? & ? & -> % eq_sym % translationV_lit_inv).
rewrite to_of_val in Hval_e2 ; injection Hval_e2 as -> % translationV_lit_inv. rewrite to_of_val in Hval_e2 ; injection Hval_e2 as -> % translationV_lit_inv.
...@@ -559,10 +557,12 @@ Section SimulationLemma. ...@@ -559,10 +557,12 @@ Section SimulationLemma.
(* assuming the adequacy of the translated expression, (* assuming the adequacy of the translated expression,
* a proof that the original expression has m-adequate results. *) * a proof that the original expression has m-adequate results. *)
(* FIXME : this is a weaker result than the adequacy result of Iris,
where the predicate can also speak about the final state. *)
Lemma adequate_translation__adequate_result m n φ e σ t2 σ2 v2 : Lemma adequate_translation__adequate_result m n φ e σ t2 σ2 v2 :
is_closed [] e is_closed [] e
σ2 !! = None σ2 !! = None
adequate NotStuck «e» S«σ, m» (φ invtranslationV) adequate NotStuck «e» S«σ, m» (λ v σ, φ (invtranslationV v))
nsteps step n ([e], σ) (of_val v2 :: t2, σ2) nsteps step n ([e], σ) (of_val v2 :: t2, σ2)
(n m)%nat (n m)%nat
φ v2. φ v2.
...@@ -571,7 +571,7 @@ Section SimulationLemma. ...@@ -571,7 +571,7 @@ Section SimulationLemma.
assert (safe «e» S«σ, m») as Hsafe by by eapply safe_adequate. assert (safe «e» S«σ, m») as Hsafe by by eapply safe_adequate.
replace (φ v2) with ((φ invtranslationV) (translationV v2)) replace (φ v2) with ((φ invtranslationV) (translationV v2))
by (simpl ; by rewrite invtranslationV_translationV). by (simpl ; by rewrite invtranslationV_translationV).
eapply adequate_result ; first done. eapply (adequate_result _ _ _ (λ v σ, φ (invtranslationV v))); first done.
change [«e»%E] with T«[e]». change [«e»%E] with T«[e]».
replace (of_val «v2» :: _) with (T«of_val v2 :: t2») by by rewrite - translation_of_val. replace (of_val «v2» :: _) with (T«of_val v2 :: t2») by by rewrite - translation_of_val.
eapply simulation_exec_success' ; eauto. eapply simulation_exec_success' ; eauto.
...@@ -583,7 +583,7 @@ End SimulationLemma. (* we close the section here as we now want to quantify ove ...@@ -583,7 +583,7 @@ End SimulationLemma. (* we close the section here as we now want to quantify ove
Lemma adequate_translation__adequate m φ e σ : Lemma adequate_translation__adequate m φ e σ :
is_closed [] e is_closed [] e
( {Hloc : TickCounter}, adequate NotStuck «e» S«σ, m» (φ invtranslationV)) ( {Hloc : TickCounter}, adequate NotStuck «e» S«σ, m» (λ v σ, φ (invtranslationV v)))
nadequate NotStuck m e σ φ. nadequate NotStuck m e σ φ.
Proof. Proof.
intros Hclosed Hadq. intros Hclosed Hadq.
......
...@@ -23,15 +23,15 @@ Ltac reshape_expr_ordered b e tac := ...@@ -23,15 +23,15 @@ Ltac reshape_expr_ordered b e tac :=
| false => tac K e | false => tac K e
| true => fail | true => fail
end end
| App ?e1 ?e2 => reshape_val e1 ltac:(fun v1 => go (AppRCtx v1 :: K) e2) | App ?e1 ?e2 => reshape_val e2 ltac:(fun v2 => go (AppLCtx v2 :: K) e1)
| App ?e1 ?e2 => go (AppLCtx e2 :: K) e1 | App ?e1 ?e2 => go (AppRCtx e1 :: K) e2
| UnOp ?op ?e => go (UnOpCtx op :: K) e | UnOp ?op ?e => go (UnOpCtx op :: K) e
| BinOp ?op ?e1 ?e2 => | BinOp ?op ?e1 ?e2 =>
reshape_val e1 ltac:(fun v1 => go (BinOpRCtx op v1 :: K) e2) reshape_val e2 ltac:(fun v2 => go (BinOpLCtx op v2 :: K) e1)
| BinOp ?op ?e1 ?e2 => go (BinOpLCtx op e2 :: K) e1 | BinOp ?op ?e1 ?e2 => go (BinOpRCtx op e1 :: K) e2
| If ?e0 ?e1 ?e2 => go (IfCtx e1 e2 :: K) e0 | If ?e0 ?e1 ?e2 => go (IfCtx e1 e2 :: K) e0
| Pair ?e1 ?e2 => reshape_val e1 ltac:(fun v1 => go (PairRCtx v1 :: K) e2) | Pair ?e1 ?e2 => reshape_val e2 ltac:(fun v2 => go (PairLCtx v2 :: K) e1)
| Pair ?e1 ?e2 => go (PairLCtx e2 :: K) e1 | Pair ?e1 ?e2 => go (PairRCtx e1 :: K) e2
| Fst ?e => go (FstCtx :: K) e | Fst ?e => go (FstCtx :: K) e
| Snd ?e => go (SndCtx :: K) e | Snd ?e => go (SndCtx :: K) e
| InjL ?e => go (InjLCtx :: K) e | InjL ?e => go (InjLCtx :: K) e
...@@ -39,14 +39,14 @@ Ltac reshape_expr_ordered b e tac := ...@@ -39,14 +39,14 @@ Ltac reshape_expr_ordered b e tac :=
| Case ?e0 ?e1 ?e2 => go (CaseCtx e1 e2 :: K) e0 | Case ?e0 ?e1 ?e2 => go (CaseCtx e1 e2 :: K) e0
| Alloc ?e => go (AllocCtx :: K) e | Alloc ?e => go (AllocCtx :: K) e
| Load ?e => go (LoadCtx :: K) e | Load ?e => go (LoadCtx :: K) e
| Store ?e1 ?e2 => reshape_val e1 ltac:(fun v1 => go (StoreRCtx v1 :: K) e2) | Store ?e1 ?e2 => reshape_val e2 ltac:(fun v2 => go (StoreLCtx v2 :: K) e1)
| Store ?e1 ?e2 => go (StoreLCtx e2 :: K) e1 | Store ?e1 ?e2 => go (StoreRCtx e1 :: K) e2
| CAS ?e0 ?e1 ?e2 => reshape_val e0 ltac:(fun v0 => first | CAS ?e0 ?e1 ?e2 => reshape_val e2 ltac:(fun v2 => first
[ reshape_val e1 ltac:(fun v1 => go (CasRCtx v0 v1 :: K) e2) [ reshape_val e1 ltac:(fun v1 => go (CasLCtx v1 v2 :: K) e0)
| go (CasMCtx v0 e2 :: K) e1 ]) | go (CasMCtx e0 v2 :: K) e1 ])
| CAS ?e0 ?e1 ?e2 => go (CasLCtx e1 e2 :: K) e0 | CAS ?e0 ?e1 ?e2 => go (CasRCtx e0 e1 :: K) e2
| FAA ?e1 ?e2 => reshape_val e1 ltac:(fun v1 => go (FaaRCtx v1 :: K) e2) | FAA ?e1 ?e2 => reshape_val e2 ltac:(fun v2 => go (FaaLCtx v2 :: K) e1)
| FAA ?e1 ?e2 => go (FaaLCtx e2 :: K) e1 | FAA ?e1 ?e2 => go (FaaRCtx e1 :: K) e2
| _ => | _ =>
lazymatch b with lazymatch b with
| false => fail | false => fail
...@@ -59,7 +59,7 @@ Local Lemma head_step_into_val e σ e' v' σ' efs : ...@@ -59,7 +59,7 @@ Local Lemma head_step_into_val e σ e' v' σ' efs :
head_step e σ (of_val v') σ' efs head_step e σ (of_val v') σ' efs
head_step e σ e' σ' efs. head_step e σ e' σ' efs.
Proof. Proof.
intros Hval Hstep. by erewrite of_to_val in Hstep. intros Hval Hstep. by rewrite Hval in Hstep.
Qed. Qed.
Ltac prim_step := Ltac prim_step :=
...@@ -67,7 +67,7 @@ Ltac prim_step := ...@@ -67,7 +67,7 @@ Ltac prim_step :=
| |- prim_step ?e _ _ _ _ => | |- prim_step ?e _ _ _ _ =>
reshape_expr_ordered true e ltac:(fun K e' => reshape_expr_ordered true e ltac:(fun K e' =>
esplit with K e' _ ; [ reflexivity | reflexivity | ] ; esplit with K e' _ ; [ reflexivity | reflexivity | ] ;
(idtac + eapply head_step_into_val) ; econstructor (idtac + (eapply head_step_into_val; [apply _|])) ; econstructor
) )
end ; end ;
simpl_to_of_val. simpl_to_of_val.
\ No newline at end of file
From iris.heap_lang Require Import proofmode notation adequacy. From iris.heap_lang Require Import proofmode notation adequacy lang.
From iris.base_logic Require Import invariants. From iris.base_logic Require Import invariants.
From iris_time Require Import Auth_nat Misc Reduction Tactics. From iris_time Require Import Auth_nat Misc Reduction Tactics.
...@@ -96,15 +96,14 @@ Section TickSpec. ...@@ -96,15 +96,14 @@ Section TickSpec.
Timeless (TC n). Timeless (TC n).
Proof. exact _. Qed. Proof. exact _. Qed.
(* note: IntoAnd false will become IntoSep in a future version of Iris *) Global Instance into_sep_TC_plus m n : IntoSep (TC (m + n)) (TC m) (TC n).
Global Instance into_sep_TC_plus m n p : IntoAnd p (TC (m + n)) (TC m) (TC n). Proof. by rewrite /IntoSep TC_plus. Qed.
Proof. rewrite /IntoAnd TC_plus ; iIntros "[Hm Hn]". destruct p ; iFrame. Qed. Global Instance from_sep_TC_plus m n : FromSep (TC (m + n)) (TC m) (TC n).
Global Instance from_sep_TC_plus m n : FromAnd false (TC (m + n)) (TC m) (TC n). Proof. by rewrite /FromSep TC_plus. Qed.
Proof. by rewrite /FromAnd TC_plus. Qed. Global Instance into_sep_TC_succ n : IntoSep (TC (S n)) (TC 1) (TC n).
Global Instance into_sep_TC_succ n p : IntoAnd p (TC (S n)) (TC 1) (TC n). Proof. by rewrite /IntoSep TC_succ. Qed.
Proof. rewrite /IntoAnd TC_succ ; iIntros "[H1 Hn]". destruct p ; iFrame. Qed. Global Instance from_sep_TC_succ n : FromSep (TC (S n)) (TC 1) (TC n).
Global Instance from_sep_TC_succ n : FromAnd false (TC (S n)) (TC 1) (TC n). Proof. by rewrite /FromSep [TC (S n)] TC_succ. Qed.
Proof. by rewrite /FromAnd [TC (S n)] TC_succ. Qed.
Definition timeCreditN := nroot .@ "timeCredit". Definition timeCreditN := nroot .@ "timeCredit".
...@@ -126,7 +125,7 @@ Section TickSpec. ...@@ -126,7 +125,7 @@ Section TickSpec.
TC_invariant - TC_invariant -
{{{ TC 1 }}} tick e @ s ; E {{{ RET v ; True }}}. {{{ TC 1 }}} tick e @ s ; E {{{ RET v ; True }}}.
Proof. Proof.
intros ? <- % of_to_val. iIntros "#Inv" (Ψ) "!# Hγ◯ HΨ". intros ? <-. iIntros "#Inv" (Ψ) "!# Hγ◯ HΨ".
iLöb as "IH". iLöb as "IH".
wp_lam. wp_lam.
(* open the invariant, in order to read the value n of location : *) (* open the invariant, in order to read the value n of location : *)
...@@ -350,6 +349,8 @@ Section Simulation. ...@@ -350,6 +349,8 @@ Section Simulation.
try not_safe_tick. try not_safe_tick.
(* BetaS f x e1 e2 v2 e' σ : *) (* BetaS f x e1 e2 v2 e' σ : *)
- assert (Closed (f :b: x :b: []) « e1 ») by by apply is_closed_translation. - assert (Closed (f :b: x :b: []) « e1 ») by by apply is_closed_translation.
replace (rec: f x := « e1 »)%E with (of_val (rec: f x := « e1 »)%V)
by by unlock.
not_safe_tick. not_safe_tick.
(* ForkS e σ : *) (* ForkS e σ : *)
- eapply not_safe_prim_step ; last prim_step. - eapply not_safe_prim_step ; last prim_step.
...@@ -446,7 +447,7 @@ Section Soundness. ...@@ -446,7 +447,7 @@ Section Soundness.
Lemma adequate_tctranslation__bounded m φ e σ : Lemma adequate_tctranslation__bounded m φ e σ :
is_closed [] e is_closed [] e
( `{TickCounter}, adequate NotStuck «e» S«σ, m» (φ invtranslationV)) ( `{TickCounter}, adequate NotStuck «e» S«σ, m» (λ v σ, φ (invtranslationV v)))
bounded_time e σ m. bounded_time e σ m.
Proof. Proof.
intros Hclosed Hadq. intros Hclosed Hadq.
...@@ -466,9 +467,9 @@ Section Soundness. ...@@ -466,9 +467,9 @@ Section Soundness.
Lemma adequate_tctranslation__adequate_and_bounded m φ e σ : Lemma adequate_tctranslation__adequate_and_bounded m φ e σ :
is_closed [] e is_closed [] e
( (k : nat), (k m)%nat ( (k : nat), (k m)%nat
`{TickCounter}, adequate NotStuck «e» S«σ, k» (φ invtranslationV) `{TickCounter}, adequate NotStuck «e» S«σ, k» (λ v σ, φ (invtranslationV v))
) )
adequate NotStuck e σ φ bounded_time e σ m. adequate NotStuck e σ (λ v σ, φ v) bounded_time e σ m.
Proof. Proof.
intros Hclosed Hadq. intros Hclosed Hadq.
assert (bounded_time e σ m) as Hbounded assert (bounded_time e σ m) as Hbounded
...@@ -494,7 +495,7 @@ Section Soundness. ...@@ -494,7 +495,7 @@ Section Soundness.
{{{ TC m }}} «e» {{{ v, RET v ; ⌜ψ v }}} {{{ TC m }}} «e» {{{ v, RET v ; ⌜ψ v }}}
) )
`{timeCreditHeapPreG Σ} `{TickCounter} σ, `{timeCreditHeapPreG Σ} `{TickCounter} σ,
(k : nat), (k m)%nat adequate NotStuck «e» S«σ,k» ψ. (k : nat), (k m)%nat adequate NotStuck «e» S«σ,k» (λ v σ, ψ v).
Proof. Proof.
intros Hspec HpreG Hloc σ k Ik. intros Hspec HpreG Hloc σ k Ik.
(* apply the adequacy results. *) (* apply the adequacy results. *)
...@@ -541,7 +542,7 @@ Section Soundness. ...@@ -541,7 +542,7 @@ Section Soundness.
{{{ TC m }}} «e» {{{ v, RET v ; ⌜φ (invtranslationV v) }}} {{{ TC m }}} «e» {{{ v, RET v ; ⌜φ (invtranslationV v) }}}
) )
{_ : timeCreditHeapPreG Σ} σ, {_ : timeCreditHeapPreG Σ} σ,
adequate NotStuck e σ φ bounded_time e σ m. adequate NotStuck e σ (λ v σ, φ v) bounded_time e σ m.
Proof. Proof.
intros Hclosed Hspec HpreG σ. intros Hclosed Hspec HpreG σ.
apply adequate_tctranslation__adequate_and_bounded ; first done. apply adequate_tctranslation__adequate_and_bounded ; first done.
...@@ -557,7 +558,7 @@ Section Soundness. ...@@ -557,7 +558,7 @@ Section Soundness.
{{{ TC m }}} «e» {{{ v, RET v ; ⌜φ (invtranslationV v) }}} {{{ TC m }}} «e» {{{ v, RET v ; ⌜φ (invtranslationV v) }}}
) )
{_ : timeCreditHeapPreG Σ} σ, {_ : timeCreditHeapPreG Σ} σ,
adequate NotStuck e σ φ bounded_time e σ m. adequate NotStuck e σ (λ v σ, φ v) bounded_time e σ m.
Proof. Proof.
intros Hclosed Hspec HpreG σ. intros Hclosed Hspec HpreG σ.
eapply spec_tctranslation__adequate_and_bounded ; try done. eapply spec_tctranslation__adequate_and_bounded ; try done.
...@@ -576,7 +577,7 @@ Section Soundness. ...@@ -576,7 +577,7 @@ Section Soundness.
{{{ TC m }}} «e» {{{ v, RET v ; ⌜φ v }}} {{{ TC m }}} «e» {{{ v, RET v ; ⌜φ v }}}
) )
{_ : timeCreditHeapPreG Σ} σ, {_ : timeCreditHeapPreG Σ} σ,
adequate NotStuck e σ φ bounded_time e σ m. adequate NotStuck e σ (λ v σ, φ v) bounded_time e σ m.
Proof. Proof.
intros Hφ Hclosed Hspec HpreG σ. intros Hφ Hclosed Hspec HpreG σ.
apply (spec_tctranslation__adequate_and_bounded (Σ:=Σ)) ; try assumption. apply (spec_tctranslation__adequate_and_bounded (Σ:=Σ)) ; try assumption.
...@@ -600,7 +601,7 @@ Section Tactics. ...@@ -600,7 +601,7 @@ Section Tactics.
Context {Σ : gFunctors}. Context {Σ : gFunctors}.
Implicit Types Φ : val iProp Σ. Implicit Types Φ : val iProp Σ.
Implicit Types Δ : envs (iResUR Σ). Implicit Types Δ : envs (uPredI (iResUR Σ)).
(* concrete version: *) (* concrete version: *)
Lemma tac_wp_tick `{timeCreditHeapG Σ} Δ Δ' Δ'' s E i j n K e v Φ : Lemma tac_wp_tick `{timeCreditHeapG Σ} Δ Δ' Δ'' s E i j n K e v Φ :
...@@ -613,8 +614,8 @@ Section Tactics. ...@@ -613,8 +614,8 @@ Section Tactics.
envs_entails Δ'' (WP fill K v @ s; E {{ Φ }}) envs_entails Δ'' (WP fill K v @ s; E {{ Φ }})
envs_entails Δ (WP fill K (App tick e) @ s; E {{ Φ }}). envs_entails Δ (WP fill K (App tick e) @ s; E {{ Φ }}).
Proof. Proof.
unfold envs_entails => HsubsetE ????? Hentails''. rewrite envs_entails_eq => HsubsetE ????? Hentails''.
rewrite envs_lookup_persistent_sound // persistently_elim. apply wand_elim_r'. rewrite envs_lookup_persistent_sound // intuitionistically_elim. apply wand_elim_r'.
rewrite -wp_bind. rewrite -wp_bind.
eapply wand_apply ; first by (iIntros "HTC1 HΦ #Htick" ; iApply (tick_spec with "Htick HTC1 HΦ")). eapply wand_apply ; first by (iIntros "HTC1 HΦ #Htick" ; iApply (tick_spec with "Htick HTC1 HΦ")).
rewrite into_laterN_env_sound -later_sep /=. apply later_mono. rewrite into_laterN_env_sound -later_sep /=. apply later_mono.
...@@ -657,7 +658,7 @@ Ltac wp_tick := ...@@ -657,7 +658,7 @@ Ltac wp_tick :=
| exact _ | exact _
| solve_TICKCTXT () | solve_TICKCTXT ()
| solve_TC () | solve_TC ()
| env_cbv ; reflexivity | proofmode.reduction.pm_reflexivity
| finish () ] | finish () ]
| |- envs_entails _ (twp ?s ?E ?e ?Q) => | |- envs_entails _ (twp ?s ?E ?e ?Q) =>
fail "wp_tick is not implemented for twp" fail "wp_tick is not implemented for twp"
...@@ -685,4 +686,4 @@ Ltac wp_tick_match := wp_tick ; wp_match ; do 2 wp_lam ; wp_tick. ...@@ -685,4 +686,4 @@ Ltac wp_tick_match := wp_tick ; wp_match ; do 2 wp_lam ; wp_tick.
Ltac wp_tick_proj := wp_tick ; wp_proj. Ltac wp_tick_proj := wp_tick ; wp_proj.
Ltac wp_tick_alloc loc := wp_tick ; wp_alloc loc. Ltac wp_tick_alloc loc := wp_tick ; wp_alloc loc.
Ltac wp_tick_load := wp_tick ; wp_load. Ltac wp_tick_load := wp_tick ; wp_load.
Ltac wp_tick_store := wp_tick ; wp_store. Ltac wp_tick_store := wp_tick ; wp_store.
\ No newline at end of file
From iris.heap_lang Require Import proofmode notation adequacy. From iris.heap_lang Require Import proofmode notation adequacy lang.
From iris.base_logic Require Import invariants. From iris.base_logic Require Import invariants.
From iris_time Require Import Auth_nat Reduction TimeCredits. From iris_time Require Import Auth_nat Reduction TimeCredits.
...@@ -140,7 +140,7 @@ Qed. ...@@ -140,7 +140,7 @@ Qed.
Lemma adequate_tctranslation__adequate_result {Hloc : TickCounter} m φ e σ t2 σ2 v2 : Lemma adequate_tctranslation__adequate_result {Hloc : TickCounter} m φ e σ t2 σ2 v2 :
is_closed [] e is_closed [] e
σ2 !! = None σ2 !! = None
adequate NotStuck «e» S«σ, m» (φ invtranslationV) adequate NotStuck «e» S«σ, m» (λ v σ, φ (invtranslationV v))
rtc step ([e], σ) (of_val v2 :: t2, σ2) rtc step ([e], σ) (of_val v2 :: t2, σ2)
φ v2. φ v2.
Proof. Proof.
...@@ -149,7 +149,7 @@ Proof. ...@@ -149,7 +149,7 @@ Proof.
assert (n m)%nat by by eapply safe_tctranslation__bounded. assert (n m)%nat by by eapply safe_tctranslation__bounded.
replace (φ v2) with ((φ invtranslationV) (translationV v2)) replace (φ v2) with ((φ invtranslationV) (translationV v2))
by (simpl ; by rewrite invtranslationV_translationV). by (simpl ; by rewrite invtranslationV_translationV).
eapply adequate_result ; first done. eapply (adequate_result _ _ _ (λ v σ, φ (invtranslationV v))) ; first done.
change [«e»%E] with T«[e]». change [«e»%E] with T«[e]».
replace (of_val «v2» :: _) with (T«of_val v2 :: t2») by by rewrite - translation_of_val. replace (of_val «v2» :: _) with (T«of_val v2 :: t2») by by rewrite - translation_of_val.
eapply simulation_exec_success' ; eauto. eapply simulation_exec_success' ; eauto.
...@@ -159,8 +159,8 @@ Qed. ...@@ -159,8 +159,8 @@ Qed.
Lemma adequate_tctranslation__adequate m φ e σ : Lemma adequate_tctranslation__adequate m φ e σ :
is_closed [] e is_closed [] e
( `{TickCounter}, adequate NotStuck «e» S«σ, m» (φ invtranslationV)) ( `{TickCounter}, adequate NotStuck «e» S«σ, m» (λ v σ, φ (invtranslationV v)))
adequate NotStuck e σ φ. adequate NotStuck e σ (λ v σ, φ v).
Proof. Proof.
intros Hclosed Hadq. intros Hclosed Hadq.
split. split.
......
From iris.heap_lang Require Import proofmode notation adequacy. From iris.heap_lang Require Import proofmode notation adequacy lang.
From iris.base_logic Require Import invariants. From iris.base_logic Require Import invariants.
From iris_time Require Import Auth_nat Auth_mnat Misc Reduction Tactics. From iris_time Require Import Auth_nat Auth_mnat Misc Reduction Tactics.
...@@ -109,15 +109,14 @@ Section TockSpec. ...@@ -109,15 +109,14 @@ Section TockSpec.
Timeless (TR n). Timeless (TR n).
Proof. exact _. Qed. Proof. exact _. Qed.
(* note: IntoAnd false will become IntoSep in a future version of Iris *) Global Instance into_sep_TR_plus m n : IntoSep (TR (m + n)) (TR m) (TR n).
Global Instance into_sep_TR_plus m n p : IntoAnd p (TR (m + n)) (TR m) (TR n). Proof. by rewrite /IntoSep TR_plus. Qed.
Proof. rewrite /IntoAnd TR_plus ; iIntros "[Hm Hn]". destruct p ; iFrame. Qed. Global Instance from_sep_TR_plus m n : FromSep (TR (m + n)) (TR m) (TR n).
Global Instance from_sep_TR_plus m n : FromAnd false (TR (m + n)) (TR m) (TR n). Proof. by rewrite /FromSep TR_plus. Qed.
Proof. by rewrite /FromAnd TR_plus. Qed. Global Instance into_sep_TR_succ n : IntoSep (TR (S n)) (TR 1) (TR n).
Global Instance into_sep_TR_succ n p : IntoAnd p (TR (S n)) (TR 1) (TR n). Proof. by rewrite /IntoSep TR_succ. Qed.
Proof. rewrite /IntoAnd TR_succ ; iIntros "[H1 Hn]". destruct p ; iFrame. Qed. Global Instance from_sep_TR_succ n : FromSep (TR (S n)) (TR 1) (TR n).
Global Instance from_sep_TR_succ n : FromAnd false (TR (S n)) (TR 1) (TR n). Proof. by rewrite /FromSep [TR (S n)] TR_succ. Qed.