Commit 97c0889d authored by Ralf Jung's avatar Ralf Jung
Browse files

get rid of erasures, use exclusive state ownership instead

parent 3fe8c615
Require Import RecDom.PCM. Require Import RecDom.PCM.
Module Type CORE_LANG (Res : PCM_T). Module Type CORE_LANG.
Import Res.
Delimit Scope lang_scope with lang. Delimit Scope lang_scope with lang.
Local Open Scope lang_scope. Local Open Scope lang_scope.
...@@ -98,53 +96,4 @@ Module Type CORE_LANG (Res : PCM_T). ...@@ -98,53 +96,4 @@ Module Type CORE_LANG (Res : PCM_T).
prim_step (e, σ) (e', σ') -> prim_step (e, σ) (e', σ') ->
K = ε /\ is_value e'. K = ε /\ is_value e'.
(******************************************************************)
(** ** Erasures **)
(******************************************************************)
(** Erasure of a resource to the set of states it describes **)
Parameter erase_state : option res -> state -> Prop.
Axiom erase_state_nonzero :
forall σ, ~ erase_state 0%pcm σ.
Axiom erase_state_emp :
forall σ, erase_state 1%pcm σ.
(** Erasure of a resource to the set of expressions it describes **)
(* Not needed for now *)
Parameter erase_exp : option res -> expr -> Prop.
Axiom erase_exp_mono :
forall r r' e,
erase_exp r e ->
erase_exp (r · r')%pcm e.
Axiom erase_fork_ret :
forall r, erase_exp r fork_ret.
Axiom erase_fork :
forall r e,
erase_exp r (fork e) ->
erase_exp r e.
Axiom erase_exp_idemp :
forall r e, erase_exp r e ->
exists r', r = (r · r')%pcm /\ r' = (r' · r')%pcm /\ erase_exp r' e.
Axiom erase_exp_split :
forall r K e,
erase_exp r (fill K e) ->
exists r_K r_e,
r = (r_K · r_e)%pcm /\
erase_exp r_K (fill K fork_ret) /\
erase_exp r_e e.
Axiom erase_exp_combine :
forall r_K r_e e K,
erase_exp r_K (fill K fork_ret) ->
erase_exp r_e e ->
erase_exp (r_K · r_e)%pcm (fill K e).
End CORE_LANG. End CORE_LANG.
Require Import world_prop core_lang lang masks. Require Import world_prop core_lang lang masks.
Require Import RecDom.PCM RecDom.UPred RecDom.BI RecDom.PreoMet RecDom.Finmap. Require Import RecDom.PCM RecDom.UPred RecDom.BI RecDom.PreoMet RecDom.Finmap.
Module Iris (RP RL : PCM_T) (C : CORE_LANG RP). Module Iris (RL : PCM_T) (C : CORE_LANG).
Module Import L := Lang RP RL C. Module Import L := Lang C.
Module Import R <: PCM_T. Module Import R <: PCM_T.
Definition res := (RP.res * RL.res)%type. Definition res := (pcm_res_ex state * RL.res)%type.
Instance res_op : PCM_op res := _. Instance res_op : PCM_op res := _.
Instance res_unit : PCM_unit res := _. Instance res_unit : PCM_unit res := _.
Instance res_pcm : PCM res := _. Instance res_pcm : PCM res := _.
...@@ -142,13 +142,29 @@ Module Iris (RP RL : PCM_T) (C : CORE_LANG RP). ...@@ -142,13 +142,29 @@ Module Iris (RP RL : PCM_T) (C : CORE_LANG RP).
pcmconst (up_cr (pord r)). pcmconst (up_cr (pord r)).
(** Physical part **) (** Physical part **)
Definition ownRP (r : RP.res) : Props := Definition ownRP (r : pcm_res_ex state) : Props :=
ownR (r, pcm_unit _). ownR (r, pcm_unit _).
(** Logical part **) (** Logical part **)
Definition ownRL (r : RL.res) : Props := Definition ownRL (r : RL.res) : Props :=
ownR (pcm_unit _, r). ownR (pcm_unit _, r).
(** Proper physical state: ownership of the machine state **)
Instance state_type : Setoid state := discreteType.
Instance state_metr : metric state := discreteMetric.
Instance state_cmetr : cmetric state := discreteCMetric.
Program Definition ownS : state -n> Props :=
n[(fun s => ownRP (ex_own _ s))].
Next Obligation.
intros r1 r2 EQr. hnf in EQr. now rewrite EQr.
Qed.
Next Obligation.
intros r1 r2 EQr; destruct n as [| n]; [apply dist_bound |].
simpl in EQr. subst; reflexivity.
Qed.
(** Proper ghost state: ownership of logical w/ possibility of undefined **)
Lemma ores_equiv_eq T `{pcmT : PCM T} (r1 r2 : option T) (HEq : r1 == r2) : r1 = r2. Lemma ores_equiv_eq T `{pcmT : PCM T} (r1 r2 : option T) (HEq : r1 == r2) : r1 = r2.
Proof. Proof.
destruct r1 as [r1 |]; destruct r2 as [r2 |]; try contradiction; destruct r1 as [r1 |]; destruct r2 as [r2 |]; try contradiction;
...@@ -158,7 +174,6 @@ Module Iris (RP RL : PCM_T) (C : CORE_LANG RP). ...@@ -158,7 +174,6 @@ Module Iris (RP RL : PCM_T) (C : CORE_LANG RP).
Instance logR_metr : metric RL.res := discreteMetric. Instance logR_metr : metric RL.res := discreteMetric.
Instance logR_cmetr : cmetric RL.res := discreteCMetric. Instance logR_cmetr : cmetric RL.res := discreteCMetric.
(** Proper ghost state: ownership of logical w/ possibility of undefined **)
Program Definition ownL : (option RL.res) -n> Props := Program Definition ownL : (option RL.res) -n> Props :=
n[(fun r => match r with n[(fun r => match r with
| Some r => ownRL r | Some r => ownRL r
...@@ -172,6 +187,7 @@ Module Iris (RP RL : PCM_T) (C : CORE_LANG RP). ...@@ -172,6 +187,7 @@ Module Iris (RP RL : PCM_T) (C : CORE_LANG RP).
destruct r1 as [r1 |]; destruct r2 as [r2 |]; try contradiction; simpl in EQr; subst; reflexivity. destruct r1 as [r1 |]; destruct r2 as [r2 |]; try contradiction; simpl in EQr; subst; reflexivity.
Qed. Qed.
(** Lemmas about box **) (** Lemmas about box **)
Lemma box_intro p q (Hpq : p q) : Lemma box_intro p q (Hpq : p q) :
p q. p q.
...@@ -202,7 +218,7 @@ Module Iris (RP RL : PCM_T) (C : CORE_LANG RP). ...@@ -202,7 +218,7 @@ Module Iris (RP RL : PCM_T) (C : CORE_LANG RP).
destruct u as [u |]; [| now erewrite pcm_op_zero in EQut by apply _]. destruct u as [u |]; [| now erewrite pcm_op_zero in EQut by apply _].
assert (HT := comm (Some u) t); rewrite EQut in HT. assert (HT := comm (Some u) t); rewrite EQut in HT.
destruct t as [t |]; [| now erewrite pcm_op_zero in HT by apply _]; clear HT. destruct t as [t |]; [| now erewrite pcm_op_zero in HT by apply _]; clear HT.
exists (pcm_unit RP.res, u) (pcm_unit RP.res, t). exists (pcm_unit (pcm_res_ex state), u) (pcm_unit (pcm_res_ex state), t).
split; [unfold pcm_op, res_op, pcm_op_prod | split; do 15 red; reflexivity]. split; [unfold pcm_op, res_op, pcm_op_prod | split; do 15 red; reflexivity].
now erewrite pcm_op_unit, EQut by apply _. now erewrite pcm_op_unit, EQut by apply _.
- destruct u as [u |]; [| contradiction]; destruct t as [t |]; [| contradiction]. - destruct u as [u |]; [| contradiction]; destruct t as [t |]; [| contradiction].
...@@ -216,6 +232,8 @@ Module Iris (RP RL : PCM_T) (C : CORE_LANG RP). ...@@ -216,6 +232,8 @@ Module Iris (RP RL : PCM_T) (C : CORE_LANG RP).
destruct (Some rt · Some ru)%pcm as [rut |]; destruct (Some rt · Some ru)%pcm as [rut |];
[| now erewrite pcm_op_zero in EQr by apply _]. [| now erewrite pcm_op_zero in EQr by apply _].
exists rut; assumption. exists rut; assumption.
(* TODO: own 0 = False, own 1 = True *)
Qed. Qed.
Section Erasure. Section Erasure.
...@@ -268,11 +286,16 @@ Module Iris (RP RL : PCM_T) (C : CORE_LANG RP). ...@@ -268,11 +286,16 @@ Module Iris (RP RL : PCM_T) (C : CORE_LANG RP).
rewrite !assoc, (comm (Some r2)); reflexivity. rewrite !assoc, (comm (Some r2)); reflexivity.
Qed. Qed.
Definition erase_state (r: option res) σ: Prop := match r with
| Some (ex_own s, _) => s = σ
| _ => False
end.
Global Instance preo_unit : preoType () := disc_preo (). Global Instance preo_unit : preoType () := disc_preo ().
Program Definition erasure (σ : state) (m : mask) (r s : option res) (w : Wld) : UPred () := Program Definition erasure (σ : state) (m : mask) (r s : option res) (w : Wld) : UPred () :=
(mkUPred (fun n _ => (mkUPred (fun n _ =>
erase_state (option_map fst (r · s)) σ erase_state (r · s) σ
/\ exists rs : nat -f> res, /\ exists rs : nat -f> res,
erase rs == s /\ erase rs == s /\
forall i (Hm : m i), forall i (Hm : m i),
...@@ -321,7 +344,7 @@ Module Iris (RP RL : PCM_T) (C : CORE_LANG RP). ...@@ -321,7 +344,7 @@ Module Iris (RP RL : PCM_T) (C : CORE_LANG RP).
~ erasure σ m r s w (S k) tt. ~ erasure σ m r s w (S k) tt.
Proof. Proof.
intros [HD _]; apply ores_equiv_eq in HN; setoid_rewrite HN in HD. intros [HD _]; apply ores_equiv_eq in HN; setoid_rewrite HN in HD.
now apply erase_state_nonzero in HD. exact HD.
Qed. Qed.
End Erasure. End Erasure.
......
...@@ -3,13 +3,12 @@ Require Import RecDom.PCM. ...@@ -3,13 +3,12 @@ Require Import RecDom.PCM.
Require Import core_lang. Require Import core_lang.
(******************************************************************) (******************************************************************)
(** * Derived language with physical and logical resources **) (** * Derived language with threadpool steps **)
(******************************************************************) (******************************************************************)
Module Lang (RP: PCM_T) (RL: PCM_T) (C : CORE_LANG RP). Module Lang (C : CORE_LANG).
Export C. Export C.
Export RP RL.
Local Open Scope lang_scope. Local Open Scope lang_scope.
...@@ -107,86 +106,4 @@ Module Lang (RP: PCM_T) (RL: PCM_T) (C : CORE_LANG RP). ...@@ -107,86 +106,4 @@ Module Lang (RP: PCM_T) (RL: PCM_T) (C : CORE_LANG RP).
tauto. tauto.
Qed. Qed.
(* Derived facts about expression erasure *)
(* I don't think we need these for now — F. *)
(*
Lemma erase_exp_zero r e :
erase_exp r e ->
erase_exp RP.res_zero e.
Proof.
move=>r e H.
rewrite -(RP.res_timesZ r) RP.res_timesC.
by eapply C.erase_exp_mono.
Qed.
Lemma erase_exp_mono: forall r r' e,
erase_exp (resP r) e ->
erase_exp (resP (r ** r')) e.
Proof.
move=>r r' e H.
case EQ_m:(RL.res_times (resL r) (resL r'))=>[m|].
- erewrite resP_comm.
- by apply C.erase_exp_mono.
- by rewrite EQ_m.
- move:(resL_zero _ _ EQ_m)=>->/=.
eapply erase_exp_zero; eassumption.
Qed.
Lemma erase_exp_idemp: forall r e,
erase_exp (resP r) e ->
exists r',
r = r ** r' /\
r' = r' ** r' /\
erase_exp (resP r') e.
Proof.
move=>[[rP rL]|] /= e H_erase; last first.
- exists None.
split; first done.
split; first done.
done.
move:(C.erase_exp_idemp _ _ H_erase)=>{H_erase}[r'] [H_EQ1 [H_EQ2 H_erase]].
exists (resFP r').
split; last split.
- case:r' H_EQ1 {H_EQ2 H_erase}=>[r'|]/=H_EQ1.
- by rewrite -H_EQ1 RL.res_timesC RL.res_timesI /=.
- by rewrite RP.res_timesC RP.res_timesZ in H_EQ1.
- by rewrite -resFP_comm -H_EQ2.
- by rewrite resP_FP.
Qed.
Lemma erase_exp_split: forall r K e,
erase_exp (resP r) (fill K e) ->
exists r_K r_e,
r = r_K ** r_e /\
erase_exp (resP r_K) (fill K fork_ret) /\
erase_exp (resP r_e) e.
Proof.
move=>r K e H_erase.
move:(C.erase_exp_split _ _ _ H_erase)=>{H_erase}[r_K [r_e [H_EQ [H_erase1 H_erase2]]]].
exists (resFP r_K ** resFL (resL r)). exists (resFP r_e).
split; last split.
- rewrite -{1}(res_eta r).
rewrite res_timesA [_ ** resFP _]res_timesC -res_timesA.
f_equal.
by rewrite -resFP_comm H_EQ.
- eapply erase_exp_mono.
by rewrite resP_FP.
- by rewrite resP_FP.
Qed.
Lemma erase_exp_combine: forall r_K r_e e K,
erase_exp (resP r_K) (fill K fork_ret) ->
erase_exp (resP r_e) e ->
erase_exp (resP (r_K ** r_e)) (fill K e).
Proof.
move=>r_k r_e e K H_K H_e.
case EQ_m:(RL.res_times (resL r_k) (resL r_e))=>[m|]; last first.
- apply resL_zero in EQ_m.
rewrite EQ_m.
eapply erase_exp_zero, erase_exp_combine; eassumption.
rewrite resP_comm; last first.
- by rewrite EQ_m.
eapply erase_exp_combine; eassumption.
Qed.*)
End Lang. End Lang.
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