Commit 4865b710 authored by Hai Dang's avatar Hai Dang

Fix retag semantics:

- single retag on references
- retagging with Sum (enum) does not look at the memory in the case with UnsafeCell
- cleanups
parent e5bcee56
This diff is collapsed.
......@@ -70,25 +70,6 @@ Lemma of_result_list_expr (vl: list value) :
(of_result <$> (ValR <$> vl)) = Val <$> vl.
Proof. induction vl as [|v vl IH]; [done|]. by rewrite 3!fmap_cons IH. Qed.
(* Lemma subst_is_closed X x es e :
is_closed X es is_closed (x::X) e is_closed X (subst x es e).
Proof.
revert e X. fix FIX 1; destruct e=>X //=; repeat (case_bool_decide=>//=);
try naive_solver; rewrite ?andb_True; intros.
- set_solver.
- split; first naive_solver. induction el; naive_solver.
- (* eauto using is_closed_weaken with set_solver. *)
- eapply is_closed_weaken; first done.
destruct (decide (BNamed x = f)), (decide (BNamed x xl)); set_solver.
- induction el; naive_solver.
- split; first naive_solver. induction el; naive_solver.
Qed.
Lemma subst'_is_closed X b es e :
is_closed X es is_closed (b:b:X) e is_closed X (subst' b es e).
Proof. destruct b; first done. apply subst_is_closed. Qed.
*)
(** Equality and other typeclass stuff *)
Instance bin_op_eq_dec : EqDecision bin_op.
......@@ -354,7 +335,7 @@ Inductive head_step :
: head_step e σ [ev] e' σ []
| HeadImpureS σ e e' ev h' α' cids' nxtp' nxtc'
(ExprStep : mem_expr_step σ.(shp) e ev h' e')
(InstrStep: bor_step h' σ.(sst) σ.(scs) σ.(snp) σ.(snc)
(InstrStep: bor_step σ.(sst) σ.(scs) σ.(snp) σ.(snc)
ev α' cids' nxtp' nxtc')
: head_step e σ [ev] e' (mkState h' α' cids' nxtp' nxtc') [].
......@@ -413,7 +394,6 @@ Definition new_place T (v: expr) : expr :=
Definition retag_place
(p: expr) (pk: pointer_kind) (T: type) (kind: retag_kind) : expr :=
let: "p" := p in
(* read the current tag of the place [p] *)
let: "o" := & "p" in
(* retag and update with new tag *)
"p" <- Retag "o" pk T kind.
(* read the current pointer stored in the place [p] *)
(* retag and update [p] with the pointer with new tag *)
"p" <- Retag (Copy "p") pk T kind.
......@@ -21,7 +21,7 @@ Ltac inv_head_step :=
inversion H ; subst; clear H
| H : pure_expr_step _ _ _ _ _ |- _ =>
inversion H ; subst; clear H
| H : bor_step _ _ _ _ _ _ _ _ _ _ |- _ =>
| H : bor_step _ _ _ _ _ _ _ _ _ |- _ =>
inversion H ; subst; clear H
end.
......@@ -867,20 +867,22 @@ Proof.
- subst K. by exists (Ki :: K0).
Qed.
Lemma tstep_retag_inv l otg T pk rk e' σ σ'
(STEP: (Retag #[ScPtr l otg] pk T rk, σ) ~{fns}~> (e', σ')) :
c cids ntg α' nxtp',
Lemma tstep_retag_inv (ptr: result) T pk rk e' σ σ'
(STEP: (Retag ptr pk T rk, σ) ~{fns}~> (e', σ')) :
l otg c cids ntg α' nxtp',
ptr = ValR [ScPtr l otg]
σ.(scs) = c :: cids
retag1 σ.(shp) σ.(sst) σ.(snp) σ.(scs) c l otg rk pk T
= Some (ntg, α', nxtp')
retag σ.(sst) σ.(snp) σ.(scs) c l otg rk pk T = Some (ntg, α', nxtp')
e' = #[ScPtr l ntg]%V
σ' = mkState σ.(shp) α' σ.(scs) nxtp' σ.(snc).
Proof.
inv_tstep. symmetry in Eq.
destruct (fill_retag_decompose _ _ _ _ _ _ Eq) as [[]|[K' [? Eq']]]; subst.
- clear Eq. simpl in HS. inv_head_step. naive_solver.
- clear Eq. simpl in HS. inv_head_step.
have Eq1 := to_of_result ptr. rewrite -H0 /to_result in Eq1. simplify_eq.
naive_solver.
- exfalso. apply val_head_stuck in HS. destruct (fill_val K' e1') as [? Eq1'].
+ rewrite /= Eq'. by eexists.
+ rewrite /= Eq' to_of_result. by eexists.
+ by rewrite Eq1' in HS.
Qed.
......
This diff is collapsed.
This diff is collapsed.
......@@ -8,7 +8,7 @@ Set Default Proof Using "Type".
Definition ex1_unopt : function :=
fun: ["i"],
let: "x" := new_place (&mut int) "i" in (* put argument into place *)
Retag "x" Default ;;
retag_place "x" (RefPtr Mutable) int Default ;;
Call #[ScFnPtr "f"] [] ;;
*{int} "x" <- #[42] ;;
Call #[ScFnPtr "g"] [] ;;
......@@ -20,7 +20,7 @@ Definition ex1_unopt : function :=
Definition ex1_opt : function :=
fun: ["i"],
let: "x" := new_place (&mut int) "i" in
Retag "x" Default ;;
retag_place "x" (RefPtr Mutable) int Default ;;
Call #[ScFnPtr "f"] [] ;;
*{int} "x" <- #[42] ;;
let: "v" := Copy *{int} "x" in
......@@ -43,13 +43,24 @@ Proof.
intros sarg ->.
sim_apply sim_simple_let=>/=.
apply: sim_simple_result.
(* Retag local *)
(* Retag a local place *)
sim_apply sim_simple_let=>/=.
destruct args as [|args args']; first by inversion AREL.
apply Forall2_cons_inv in AREL as [AREL ATAIL].
destruct args' as [|]; last by inversion ATAIL. clear ATAIL.
sim_apply sim_simple_retag_local; [simpl; lia|solve_sim..|].
move=>l_i tg_i hplt /= Hl_i.
sim_apply sim_simple_let=>/=.
(* Copy local place *)
sim_apply sim_simple_copy_local; [solve_sim..|].
apply: sim_simple_result. simpl.
(* Retag *)
destruct args as [|args args']; first by inversion AREL.
apply Forall2_cons_inv in AREL as [AREL ATAIL].
destruct args' as [|]; last by inversion ATAIL. clear ATAIL.
have AREL': arel rarg sarg sarg.
{ have AREL':=(arel_eq _ _ _ AREL). by subst args. }
sim_apply sim_simple_retag_mut_ref; [simpl; lia| |eauto|..]; [solve_sim|].
move=>l_i tg_i tg_n hplt /= ? IS_i. subst sarg.
specialize (IS_i O ltac:(lia)). rewrite shift_loc_0_nat in IS_i.
(* Write local *)
sim_apply sim_simple_write_local; [solve_sim..|].
intros s ?. simplify_eq.
(* Call *)
sim_apply sim_simple_let=>/=.
sim_apply (sim_simple_call 10 [] [] ε); [solve_sim..|].
......@@ -98,7 +109,7 @@ Proof.
sim_apply sim_simple_let=>/=.
sim_apply sim_simple_free_public.
{ simpl. constructor; [|by constructor].
assert (args = sarg). { by revert AREL; apply arel_eq. } subst args.
assert (args = ScPtr l' tg_i). { by revert AREL; apply arel_eq. } subst args.
revert AREL. apply arel_mono; [|solve_res].
apply (cmra_valid_included _ _ Hval).
do 3 apply cmra_mono_r. apply cmra_included_l. } simpl.
......
......@@ -8,17 +8,19 @@ Set Default Proof Using "Type".
Definition ex1_down : function :=
fun: ["i"],
let: "x" := new_place (&mut int) "i" in (* put argument into place *)
Retag "x" FnEntry ;;
retag_place "x" (RefPtr Mutable) int FnEntry ;;
let: "v" := Copy *{int} "x" in
Call #[ScFnPtr "f"] [] ;;
Free "x" ;; Free "i" ;;
"v"
.
Definition ex1_down_opt : function :=
fun: ["i"],
let: "x" := new_place (&mut int) "i" in
Retag "x" FnEntry ;;
retag_place "x" (RefPtr Mutable) int FnEntry ;;
Call #[ScFnPtr "f"] [] ;;
Free "x" ;; Free "i" ;;
Copy *{int} "x"
.
......
......@@ -8,19 +8,22 @@ Set Default Proof Using "Type".
Definition ex2 : function :=
fun: ["i"],
let: "x" := new_place (& int) "i" in
Retag "x" Default ;;
retag_place "x" (RefPtr Immutable) int Default ;;
Copy *{int} "x" ;;
Call #[ScFnPtr "f"] ["x"] ;;
Copy *{int} "x"
let: "v" := Copy *{int} "x" in
Free "x" ;; Free "i" ;;
"v"
.
Definition ex2_opt : function :=
fun: ["i"],
let: "x" := new_place (& int) "i" in
Retag "x" Default ;;
retag_place "x" (RefPtr Immutable) int Default ;;
Copy *{int} "x" ;;
let: "v" := Copy *{int} "x" in
Call #[ScFnPtr "f"] ["x"] ;;
Free "x" ;; Free "i" ;;
"v"
.
......
......@@ -8,18 +8,21 @@ Set Default Proof Using "Type".
Definition ex2_down : function :=
fun: ["i"],
let: "x" := new_place (& int) "i" in
Retag "x" FnEntry ;;
retag_place "x" (RefPtr Immutable) int FnEntry ;;
let: "v" := Copy *{int} "x" in
Call #[ScFnPtr "f"] ["x"] ;;
Free "x" ;; Free "i" ;;
"v"
.
Definition ex2_down_opt : function :=
fun: ["i"],
let: "x" := new_place (& int) "i" in
Retag "x" FnEntry ;;
retag_place "x" (RefPtr Immutable) int FnEntry ;;
Call #[ScFnPtr "f"] ["x"] ;;
Copy *{int} "x"
let: "v" := Copy *{int} "x" in
Free "x" ;; Free "i" ;;
"v"
.
......
......@@ -4,32 +4,36 @@ Set Default Proof Using "Type".
(** Moving a write to a mutable reference up across unknown code. *)
(* TODO: check if Free is in the right place *)
(* Assuming x : &mut i32 *)
Definition ex3 : function :=
fun: ["i"],
let: "x" := new_place (&mut int) "i" in
Retag "x" FnEntry ;;
retag_place "x" (RefPtr Mutable) int FnEntry ;;
*{int} "x" <- #[42] ;;
let: "v" := Call #[ScFnPtr "f"] [] in
*{int} "x" <- #[13] ;;
Free "x" ;; Free "i" ;;
"v"
.
Definition ex3_opt_1 : function :=
fun: ["i"],
let: "x" := new_place (&mut int) "i" in
Retag "x" FnEntry ;;
retag_place "x" (RefPtr Mutable) int FnEntry ;;
*{int} "x" <- #[42] ;;
*{int} "x" <- #[13] ;;
Call #[ScFnPtr "f"] []
Call #[ScFnPtr "f"] [] ;;
Free "x" ;; Free "i"
.
Definition ex3_opt_2 : function :=
fun: ["i"],
let: "x" := new_place (&mut int) "i" in
Retag "x" FnEntry ;;
retag_place "x" (RefPtr Mutable) int FnEntry ;;
*{int} "x" <- #[13] ;;
Call #[ScFnPtr "f"] []
Call #[ScFnPtr "f"] [] ;;
Free "x" ;; Free "i"
.
Lemma ex3_sim_fun : ⊨ᶠ ex3 ex3_opt_1.
......
......@@ -8,29 +8,32 @@ Set Default Proof Using "Type".
Definition ex3_down : function :=
fun: ["i"],
let: "x" := new_place (&mut int) "i" in
Retag "x" FnEntry ;;
retag_place "x" (RefPtr Mutable) int FnEntry ;;
*{int} "x" <- #[42] ;;
let: "v" := Call #[ScFnPtr "f"] [] in
*{int} "x" <- #[13] ;;
Free "x" ;; Free "i" ;;
"v"
.
Definition ex3_down_opt_1 : function :=
fun: ["i"],
let: "x" := new_place (&mut int) "i" in
Retag "x" FnEntry ;;
retag_place "x" (RefPtr Mutable) int FnEntry ;;
let: "v" := Call #[ScFnPtr "f"] [] in
*{int} "x" <- #[42] ;;
*{int} "x" <- #[13] ;;
Free "x" ;; Free "i" ;;
"v"
.
Definition ex3_down_opt_2 : function :=
fun: ["i"],
let: "x" := new_place (&mut int) "i" in
Retag "x" FnEntry ;;
retag_place "x" (RefPtr Mutable) int FnEntry ;;
let: "v" := Call #[ScFnPtr "f"] [] in
*{int} "x" <- #[13] ;;
Free "x" ;; Free "i" ;;
"v"
.
......
From stbor.lang Require Import steps_retag.
From stbor.lang Require Import steps_retag steps_progress.
From stbor.sim Require Export instance.
Set Default Proof Using "Type".
......
......@@ -27,7 +27,7 @@ Fixpoint expr_wf (e: expr) : Prop :=
| Val v => value_wf v
| Call f args => expr_wf f Forall id (fmap expr_wf args)
| Case e branches => expr_wf e Forall id (fmap expr_wf branches)
| Deref e _ | Ref e | Copy e | Free e | Retag e _ =>
| Deref e _ | Ref e | Copy e | Free e | Retag e _ _ _ =>
expr_wf e
| Proj e1 e2 | Conc e1 e2 | BinOp _ e1 e2 | Let _ e1 e2 | Write e1 e2 =>
expr_wf e1 expr_wf e2
......
......@@ -421,7 +421,7 @@ Proof.
apply: sim_body_result. intros. eapply POST; eauto.
Qed.
(** Freeing to unique/local *)
(** Freeing unique/local *)
(* This one deallocates [l] with [tsize T] and tag [t]. It also deallocates
the logical resource [res_tag t k h0]. In general, we can require that any
locations in [h0] be included in [T]. Here, we prove a simple lemma where
......@@ -430,7 +430,6 @@ Lemma sim_body_free_unique_local_1 fs ft r r' n l t k T s σs σt Φ :
tsize T = 1%nat
r r' res_tag t k {[l := s]}
(k = tkLocal k = tkUnique)
(* is_Some (h0 !! l) *)
(is_Some (σs.(shp) !! l) is_Some (σt.(shp) !! l)
α', memory_deallocated σt.(sst) σt.(scs) l (Tagged t) (tsize T) = Some α'
let σs' := mkState (free_mem l (tsize T) σs.(shp)) α' σs.(scs) σs.(snp) σs.(snc) in
......@@ -1222,43 +1221,119 @@ Proof.
Qed.
(** Retag *)
Lemma sim_body_retag_public fs ft r n ptr pk T kind σs σt Φ
(RREL: rrel r ptr ptr) :
( l otg ntg α' nxtp' c cids,
ptr = ValR [ScPtr l otg]
σt.(scs) = c :: cids
retag σt.(sst) σt.(snp) σt.(scs) c l otg kind pk T = Some (ntg, α', nxtp')
let σs' := mkState σs.(shp) α' σs.(scs) nxtp' σs.(snc) in
let σt' := mkState σt.(shp) α' σt.(scs) nxtp' σt.(snc) in
Φ r n (ValR [ScPtr l ntg]) σs' (ValR [ScPtr l ntg]) σt')
r {n,fs,ft}
(Retag ptr pk T kind, σs)
(Retag ptr pk T kind, σt) : Φ.
Proof.
intros POST. pfold. intros NT. intros.
have WSAT1 := WSAT. (* back up *)
destruct WSAT as (WFS & WFT & VALID & PINV & CINV & SREL).
Lemma sim_body_retag_local_mut_ref fs ft r r' r'' n x xt xs xs' rs T σs σt Φ :
split; [|done|].
{ (* tgt reducible *)
right.
edestruct NT as [[]|[es' [σs' STEPS]]]; [constructor 1|done|].
(* inversion retag of src *)
destruct (tstep_retag_inv _ _ _ _ _ _ _ _ STEPS)
as (l & otg & c & cids & ntg & α' & nxtp' & ? & Eqs & EqT & ? & ?).
subst ptr es'.
destruct SREL as (Eqsst & Eqnp & Eqcs & Eqnc & PUBP).
exists (#[ScPtr l ntg])%V,
(mkState σt.(shp) α' σt.(scs) nxtp' σt.(snc)).
eapply (head_step_fill_tstep _ []), retag_head_step'.
- rewrite -Eqcs; eauto.
- by rewrite -Eqsst -Eqnp -Eqcs. }
constructor 1.
intros.
(* inversion retag of tgt *)
destruct (tstep_retag_inv _ _ _ _ _ _ _ _ STEPT)
as (l & otg & c & cids & ntg & α' & nxtp' & ? & Eqs & EqT & ? & ?).
subst ptr et'.
exists (#[ScPtr l ntg])%V,
(mkState σs.(shp) α' σs.(scs) nxtp' σs.(snc)),
r, n. subst σt'.
split; last split.
{ left. constructor.
destruct SREL as (Eqsst & Eqnp & Eqcs & Eqnc & PUBP).
eapply (head_step_fill_tstep _ []), retag_head_step'.
- rewrite Eqcs; eauto.
- by rewrite Eqsst Eqnp Eqcs. }
{ (* unfolding rrel for place *)
simpl in RREL.
inversion RREL as [|???? AREL _]; subst; simplify_eq. clear RREL.
destruct AREL as (_ & _ & AREL).
admit. }
left.
apply: sim_body_result. intros. eapply POST; eauto.
Abort.
Lemma sim_body_retag_mut_ref_default fs ft r r' rs n l told T σs σt Φ :
(0 < tsize T)%nat
(* owns local x with tag xt and value xs *)
r r' res_loc x [(xs,xs)] xt
(* xs is supposed to be a Ptr(li,told), and, coming from the arguments, told
must be a public tag. *)
arel rs xs' xs
r' r'' rs
let Tr := (Reference (RefPtr Mutable) T) in
( li told,
xs = ScPtr li told
tnew hplt c cids hs' αs' nps' ht' αt' npt' (STACK: σt.(scs) = c :: cids),
retag σt.(shp) σt.(sst) σt.(snp) σt.(scs) c x Default Tr
= Some (ht', αt', npt')
retag σs.(shp) σs.(sst) σs.(snp) σs.(scs) c x Default Tr
= Some (hs', αs', nps')
let σs' := mkState hs' αs' σs.(scs) nps' σs.(snc) in
let σt' := mkState ht' αt' σt.(scs) npt' σt.(snc) in
let s_new := ScPtr li (Tagged tnew) in
let tk := tkUnique in
is_Some (hplt !! li)
tag_on_top αt' li tnew
Φ (r'' rs res_loc x [(s_new,s_new)] xt res_tag tnew tk hplt)
n (ValR [%S]) σs' (ValR [%S]) σt')
r r' rs
let pk : pointer_kind := (RefPtr Mutable) in
let otg : tag := Tagged told in
let s_old : scalar := ScPtr l otg in
(* Ptr(l,otg) comes from the arguments, so [otg] must be a public tag. *)
arel rs s_old s_old
( tnew hplt c cids αs' nps' αt' npt' (STACK: σt.(scs) = c :: cids),
retag σt.(sst) σt.(snp) σt.(scs) c l otg Default pk T
= Some ((Tagged tnew), αt', npt')
retag σs.(sst) σs.(snp) σs.(scs) c l otg Default pk T
= Some ((Tagged tnew), αs', nps')
(* [hplt] contains all [l + i]'s and the new tag [tnew] is on top of the
stack for each [l + i].
TODO: we can also specify that [hplt] knows the values of [l + i]'s. *)
( i: nat, (i < tsize T)
is_Some $ hplt !! (l + i) tag_on_top αt' (l + i) tnew)
let σs' := mkState σs.(shp) αs' σs.(scs) nps' σs.(snc) in
let σt' := mkState σt.(shp) αt' σt.(scs) npt' σt.(snc) in
let s_new := ScPtr l (Tagged tnew) in
Φ (r res_tag tnew tkUnique hplt) n (ValR [s_new]) σs' (ValR [s_new]) σt')
r {n,fs,ft}
(Retag (Place x (Tagged xt) Tr) Default, σs)
(Retag (Place x (Tagged xt) Tr) Default, σt) : Φ.
(Retag #[s_old] pk T Default, σs)
(Retag #[s_old] pk T Default, σt) : Φ.
Proof.
intros NZST Eqr PTag Eqr' Tr POST. pfold. intros NT. intros.
intros NZST Eqr pk otg s_old AREL POST. pfold. intros NT. intros.
have WSAT1 := WSAT. (* back up *)
destruct WSAT as (WFS & WFT & VALID & PINV & CINV & SREL).
destruct SREL as (Eqsst & Eqnp & Eqcs & Eqnc & PUBP).
split; [|done|].
{ (* tgt reducible *)
right.
edestruct NT as [[]|[es' [σs' STEPS]]]; [constructor 1|done|].
(* inversion retag of src *)
destruct (tstep_retag_inv _ (ValR _) _ _ _ _ _ _ STEPS)
as (l' & otg' & c & cids & ntg & α' & nxtp' & ? & Eqs & EqT & ? & ?).
simplify_eq.
(* apply retag_ref_change in EqT as (l & to & Eqx' & Eqh' & Eqp' & RB); [|done..].
subst h' nxtp'. rewrite Eqhs Eqx' in Eqhpl. simplify_eq.
rewrite Eqsst Eqcs Eqnp in RB. rewrite Eqcs in Eqs.
(* retag of tgt *)
exists (#[])%V,
(mkState (<[x:=ScPtr l (Tagged σt.(snp))]> σt.(shp)) α' σt.(scs) (S σt.(snp)) σt.(snc)).
eapply (head_step_fill_tstep _ []), retag1_head_step'; [eauto|].
eapply retag_ref_reborrowN; eauto. *)
admit. }
(* some lookup properties *)
have VALIDr := cmra_valid_op_r _ _ VALID. rewrite ->Eqr in VALIDr.
(* have VALIDr := cmra_valid_op_r _ _ VALID. rewrite ->Eqr in VALIDr.
have HLxtr: r.(rtm) !! xt Some (to_tgkR tkLocal, {[x := to_agree (xs,xs)]}).
{ rewrite Eqr. eapply tmap_lookup_op_local_included;
[apply VALIDr|apply cmra_included_r|].
......@@ -1270,7 +1345,7 @@ Proof.
{ destruct ((r_f r'' rs).(rtm) !! xt) as [ls|] eqn:Eqls; [|done].
exfalso. move : HLxtrf.
rewrite Eqr Eqr' cmra_assoc (cmra_assoc r_f) lookup_op Eqls res_tag_lookup.
apply tagKindR_exclusive_local_heaplet. }
apply tagKindR_exclusive_local_heaplet. } *)
(* have HLxlr : (r.(rlm) !! x : optionR tagR) Some (to_tagR xt).
{ rewrite Eqr. apply lmap_lookup_op_r; [apply VALIDr|].
rewrite (res_mapsto_llookup_1 x [xs]); [done|by simpl;lia]. }
......
......@@ -316,29 +316,30 @@ Proof.
eapply sim_simple_copy_local_r; done.
Qed.
Lemma sim_simple_retag_local fs ft r r' r'' rs n l s' s tg ty Φ :
Lemma sim_simple_retag_mut_ref fs ft r r' rs n (ptr: scalar) ty Φ :
(0 < tsize ty)%nat
r r' res_loc l [(s,s)] tg
arel rs s' s
r' r'' rs
( l_inner tg_inner hplt,
let s_new := ScPtr l_inner (Tagged tg_inner) in
r r' rs
arel rs ptr ptr
( l told tnew hplt,
ptr = ScPtr l told
let s_new := ScPtr l (Tagged tnew) in
(* let tk := match m with Mutable => tkUnique | Immutable => tkPub end in
match m with
| Mutable => is_Some (hplt !! l_inner)
| Immutable => if is_freeze ty then is_Some (hplt !! l_inner) else True
end *)
let s_new := ScPtr l (Tagged tnew) in
let tk := tkUnique in
is_Some (hplt !! l_inner)
Φ (r'' rs res_loc l [(s_new,s_new)] tg res_tag tg_inner tk hplt) n (ValR [%S]) (ValR [%S]))
( i: nat, (i < tsize ty) is_Some $ hplt !! (l + i))
Φ (r res_tag tnew tk hplt) n (ValR [s_new]) (ValR [s_new]))
r ⊨ˢ{n,fs,ft}
Retag (Place l (Tagged tg) (Reference (RefPtr Mutable) ty)) Default
Retag #[ptr] (RefPtr Mutable) ty Default
Retag (Place l (Tagged tg) (Reference (RefPtr Mutable) ty)) Default
Retag #[ptr] (RefPtr Mutable) ty Default
: Φ.
Proof.
intros ???? HH σs σt. eapply sim_body_retag_local_mut_ref; eauto.
Qed.
intros ??? HH σs σt.
Admitted.
(** * Memory: shared *)
Lemma sim_simple_alloc_public fs ft r n T Φ :
......@@ -381,10 +382,10 @@ Proof.
eapply sim_body_copy_public; eauto.
Qed.
Lemma sim_simple_retag_public fs ft r n (rs rt: result) k Φ :
Lemma sim_simple_retag_public fs ft r n (rs rt: result) pk T rk Φ :
rrel r rs rt
(Φ r n (ValR [%S]) (ValR [%S]))
r ⊨ˢ{n,fs,ft} Retag rs k Retag rt k : Φ.
r ⊨ˢ{n,fs,ft} Retag rs pk T rk Retag rt pk T rk : Φ.
Proof.
intros [Hrel ?]%rrel_with_eq. simplify_eq.
Admitted.
......
......@@ -33,7 +33,7 @@ Ltac reshape_expr e tac :=
| Free ?e => go (FreeCtx :: K) e
| Deref ?e ?T => go (DerefCtx T :: K) e
| Ref ?e => go (RefCtx :: K) e
| Retag ?e ?k => go (RetagCtx k :: K) e
| Retag ?e ?k ?T ?rk => go (RetagCtx k T rk :: K) e
| Let ?x ?e1 ?e2 => go (LetCtx x e2 :: K) e1
| Case ?e ?el => go (CaseCtx el :: K) e
end
......
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