Commit 5f56adf8 authored by Robbert Krebbers's avatar Robbert Krebbers

Merge branch 'rk/substitution'

parents 748638de 24de06c7
Pipeline #2287 passed with stage
...@@ -11,6 +11,7 @@ buildjob: ...@@ -11,6 +11,7 @@ buildjob:
only: only:
- master - master
- jh_simplified_resources - jh_simplified_resources
- rk/substitution
artifacts: artifacts:
paths: paths:
- build-time.txt - build-time.txt
...@@ -88,7 +88,6 @@ heap_lang/wp_tactics.v ...@@ -88,7 +88,6 @@ heap_lang/wp_tactics.v
heap_lang/lifting.v heap_lang/lifting.v
heap_lang/derived.v heap_lang/derived.v
heap_lang/notation.v heap_lang/notation.v
heap_lang/substitution.v
heap_lang/heap.v heap_lang/heap.v
heap_lang/lib/spawn.v heap_lang/lib/spawn.v
heap_lang/lib/par.v heap_lang/lib/par.v
......
...@@ -17,31 +17,31 @@ Implicit Types P Q : iProp heap_lang Σ. ...@@ -17,31 +17,31 @@ Implicit Types P Q : iProp heap_lang Σ.
Implicit Types Φ : val iProp heap_lang Σ. Implicit Types Φ : val iProp heap_lang Σ.
(** Proof rules for the sugar *) (** Proof rules for the sugar *)
Lemma wp_lam E x ef e v Φ : Lemma wp_lam E x ef e Φ :
to_val e = Some v is_Some (to_val e) Closed (x :b: []) ef
WP subst' x e ef @ E {{ Φ }} WP App (Lam x ef) e @ E {{ Φ }}. WP subst' x e ef @ E {{ Φ }} WP App (Lam x ef) e @ E {{ Φ }}.
Proof. intros. by rewrite -(wp_rec _ BAnon) //. Qed. Proof. intros. by rewrite -(wp_rec _ BAnon) //. Qed.
Lemma wp_let E x e1 e2 v Φ : Lemma wp_let E x e1 e2 Φ :
to_val e1 = Some v is_Some (to_val e1) Closed (x :b: []) e2
WP subst' x e1 e2 @ E {{ Φ }} WP Let x e1 e2 @ E {{ Φ }}. WP subst' x e1 e2 @ E {{ Φ }} WP Let x e1 e2 @ E {{ Φ }}.
Proof. apply wp_lam. Qed. Proof. apply wp_lam. Qed.
Lemma wp_seq E e1 e2 v Φ : Lemma wp_seq E e1 e2 Φ :
to_val e1 = Some v is_Some (to_val e1) Closed [] e2
WP e2 @ E {{ Φ }} WP Seq e1 e2 @ E {{ Φ }}. WP e2 @ E {{ Φ }} WP Seq e1 e2 @ E {{ Φ }}.
Proof. intros ?. by rewrite -wp_let. Qed. Proof. intros ??. by rewrite -wp_let. Qed.
Lemma wp_skip E Φ : Φ (LitV LitUnit) WP Skip @ E {{ Φ }}. Lemma wp_skip E Φ : Φ (LitV LitUnit) WP Skip @ E {{ Φ }}.
Proof. rewrite -wp_seq // -wp_value //. Qed. Proof. rewrite -wp_seq; last eauto. by rewrite -wp_value. Qed.
Lemma wp_match_inl E e0 v0 x1 e1 x2 e2 Φ : Lemma wp_match_inl E e0 x1 e1 x2 e2 Φ :
to_val e0 = Some v0 is_Some (to_val e0) Closed (x1 :b: []) e1
WP subst' x1 e0 e1 @ E {{ Φ }} WP Match (InjL e0) x1 e1 x2 e2 @ E {{ Φ }}. WP subst' x1 e0 e1 @ E {{ Φ }} WP Match (InjL e0) x1 e1 x2 e2 @ E {{ Φ }}.
Proof. intros. by rewrite -wp_case_inl // -[X in _ X]later_intro -wp_let. Qed. Proof. intros. by rewrite -wp_case_inl // -[X in _ X]later_intro -wp_let. Qed.
Lemma wp_match_inr E e0 v0 x1 e1 x2 e2 Φ : Lemma wp_match_inr E e0 x1 e1 x2 e2 Φ :
to_val e0 = Some v0 is_Some (to_val e0) Closed (x2 :b: []) e2
WP subst' x2 e0 e2 @ E {{ Φ }} WP Match (InjR e0) x1 e1 x2 e2 @ E {{ Φ }}. WP subst' x2 e0 e2 @ E {{ Φ }} WP Match (InjR e0) x1 e1 x2 e2 @ E {{ Φ }}.
Proof. intros. by rewrite -wp_case_inr // -[X in _ X]later_intro -wp_let. Qed. Proof. intros. by rewrite -wp_case_inr // -[X in _ X]later_intro -wp_let. Qed.
......
This diff is collapsed.
From iris.heap_lang Require Export derived. From iris.proofmode Require Import tactics.
From iris.heap_lang Require Import wp_tactics substitution notation. From iris.heap_lang Require Import proofmode notation.
Definition Assert {X} (e : expr X) : expr X := Definition assert : val :=
if: e then #() else #0 #0. (* #0 #0 is unsafe *) λ: "v", if: "v" #() then #() else #0 #0. (* #0 #0 is unsafe *)
(* just below ;; *)
Notation "'assert:' e" := (assert (λ: <>, e))%E (at level 99) : expr_scope.
Global Opaque assert.
Instance do_wexpr_assert {X Y} (H : X `included` Y) e er : Lemma wp_assert {Σ} (Φ : val iProp heap_lang Σ) e `{!Closed [] e} :
WExpr H e er WExpr H (Assert e) (Assert er) := _. WP e {{ v, v = #true Φ #() }} WP assert: e {{ Φ }}.
Instance do_wsubst_assert {X Y} x es (H : X `included` x :: Y) e er :
WSubst x es H e er WSubst x es H (Assert e) (Assert er).
Proof. intros; red. by rewrite /Assert /wsubst -/wsubst; f_equal/=. Qed.
Typeclasses Opaque Assert.
Lemma wp_assert {Σ} (Φ : val iProp heap_lang Σ) :
Φ #() WP Assert #true {{ Φ }}.
Proof. by rewrite -wp_if_true -wp_value. Qed.
Lemma wp_assert' {Σ} (Φ : val iProp heap_lang Σ) e :
WP e {{ v, v = #true Φ #() }} WP Assert e {{ Φ }}.
Proof. Proof.
rewrite /Assert. wp_focus e; apply wp_mono=>v. iIntros "HΦ". rewrite /assert. wp_let. wp_seq.
apply uPred.pure_elim_l=>->. apply wp_assert. iApply wp_wand_r; iFrame "HΦ"; iIntros (v) "[% ?]"; subst.
wp_if. done.
Qed. Qed.
From iris.heap_lang Require Export notation. From iris.heap_lang Require Export notation.
Definition newbarrier : val := λ: <>, ref #0. Definition newbarrier : val := λ: <>, ref #0.
Definition signal : val := λ: "x", '"x" <- #1. Definition signal : val := λ: "x", "x" <- #1.
Definition wait : val := Definition wait : val :=
rec: "wait" "x" := if: !'"x" = #1 then #() else '"wait" '"x". rec: "wait" "x" := if: !"x" = #1 then #() else "wait" "x".
Global Opaque newbarrier signal wait. Global Opaque newbarrier signal wait.
...@@ -8,9 +8,9 @@ Import uPred. ...@@ -8,9 +8,9 @@ Import uPred.
Definition newcounter : val := λ: <>, ref #0. Definition newcounter : val := λ: <>, ref #0.
Definition inc : val := Definition inc : val :=
rec: "inc" "l" := rec: "inc" "l" :=
let: "n" := !'"l" in let: "n" := !"l" in
if: CAS '"l" '"n" (#1 + '"n") then #() else '"inc" '"l". if: CAS "l" "n" (#1 + "n") then #() else "inc" "l".
Definition read : val := λ: "l", !'"l". Definition read : val := λ: "l", !"l".
Global Opaque newcounter inc get. Global Opaque newcounter inc get.
(** The CMRA we need. *) (** The CMRA we need. *)
...@@ -49,11 +49,12 @@ Lemma inc_spec l j (Φ : val → iProp) : ...@@ -49,11 +49,12 @@ Lemma inc_spec l j (Φ : val → iProp) :
Proof. Proof.
iIntros "[Hl HΦ]". iLöb as "IH". wp_rec. iIntros "[Hl HΦ]". iLöb as "IH". wp_rec.
iDestruct "Hl" as (N γ) "(% & #? & #Hγ & Hγf)". iDestruct "Hl" as (N γ) "(% & #? & #Hγ & Hγf)".
wp_focus (! _)%E; iApply (auth_fsa (counter_inv l) (wp_fsa _) _ N); auto. wp_focus (! _)%E.
iApply (auth_fsa (counter_inv l) (wp_fsa _) _ N); auto with fsaV.
iIntros "{$Hγ $Hγf}"; iIntros (j') "[% Hl] /="; rewrite {2}/counter_inv. iIntros "{$Hγ $Hγf}"; iIntros (j') "[% Hl] /="; rewrite {2}/counter_inv.
wp_load; iPvsIntro; iExists j; iSplit; [done|iIntros "{$Hl} Hγf"]. wp_load; iPvsIntro; iExists j; iSplit; [done|iIntros "{$Hl} Hγf"].
wp_let; wp_op. wp_let; wp_op. wp_focus (CAS _ _ _).
wp_focus (CAS _ _ _); iApply (auth_fsa (counter_inv l) (wp_fsa _) _ N); auto. iApply (auth_fsa (counter_inv l) (wp_fsa _) _ N); auto with fsaV.
iIntros "{$Hγ $Hγf}"; iIntros (j'') "[% Hl] /="; rewrite {2}/counter_inv. iIntros "{$Hγ $Hγf}"; iIntros (j'') "[% Hl] /="; rewrite {2}/counter_inv.
destruct (decide (j `max` j'' = j `max` j')) as [Hj|Hj]. destruct (decide (j `max` j'' = j `max` j')) as [Hj|Hj].
- wp_cas_suc; first (by do 3 f_equal); iPvsIntro. - wp_cas_suc; first (by do 3 f_equal); iPvsIntro.
...@@ -74,7 +75,8 @@ Lemma read_spec l j (Φ : val → iProp) : ...@@ -74,7 +75,8 @@ Lemma read_spec l j (Φ : val → iProp) :
WP read #l {{ Φ }}. WP read #l {{ Φ }}.
Proof. Proof.
iIntros "[Hc HΦ]". iDestruct "Hc" as (N γ) "(% & #? & #Hγ & Hγf)". iIntros "[Hc HΦ]". iDestruct "Hc" as (N γ) "(% & #? & #Hγ & Hγf)".
rewrite /read. wp_let. iApply (auth_fsa (counter_inv l) (wp_fsa _) _ N); auto. rewrite /read. wp_let.
iApply (auth_fsa (counter_inv l) (wp_fsa _) _ N); auto with fsaV.
iIntros "{$Hγ $Hγf}"; iIntros (j') "[% Hl] /=". iIntros "{$Hγ $Hγf}"; iIntros (j') "[% Hl] /=".
wp_load; iPvsIntro; iExists (j `max` j'); iSplit. wp_load; iPvsIntro; iExists (j `max` j'); iSplit.
{ iPureIntro; apply mnat_local_update; abstract lia. } { iPureIntro; apply mnat_local_update; abstract lia. }
......
...@@ -6,8 +6,8 @@ Import uPred. ...@@ -6,8 +6,8 @@ Import uPred.
Definition newlock : val := λ: <>, ref #false. Definition newlock : val := λ: <>, ref #false.
Definition acquire : val := Definition acquire : val :=
rec: "acquire" "l" := rec: "acquire" "l" :=
if: CAS '"l" #false #true then #() else '"acquire" '"l". if: CAS "l" #false #true then #() else "acquire" "l".
Definition release : val := λ: "l", '"l" <- #false. Definition release : val := λ: "l", "l" <- #false.
Global Opaque newlock acquire release. Global Opaque newlock acquire release.
(** The CMRA we need. *) (** The CMRA we need. *)
......
...@@ -2,18 +2,14 @@ From iris.heap_lang Require Export spawn. ...@@ -2,18 +2,14 @@ From iris.heap_lang Require Export spawn.
From iris.heap_lang Require Import proofmode notation. From iris.heap_lang Require Import proofmode notation.
Import uPred. Import uPred.
Definition par {X} : expr X := Definition par : val :=
λ: "fs", λ: "fs",
let: "handle" := ^spawn (Fst '"fs") in let: "handle" := spawn (Fst "fs") in
let: "v2" := Snd '"fs" #() in let: "v2" := Snd "fs" #() in
let: "v1" := ^join '"handle" in let: "v1" := join "handle" in
Pair '"v1" '"v2". Pair "v1" "v2".
Notation Par e1 e2 := (par (Pair (λ: <>, e1) (λ: <>, e2)))%E. Notation Par e1 e2 := (par (Pair (λ: <>, e1) (λ: <>, e2)))%E.
Infix "||" := Par : expr_scope. Infix "||" := Par : expr_scope.
Instance do_wexpr_par {X Y} (H : X `included` Y) : WExpr H par par := _.
Instance do_wsubst_par {X Y} x es (H : X `included` x :: Y) :
WSubst x es H par par := do_wsubst_closed _ x es H _.
Global Opaque par. Global Opaque par.
Section proof. Section proof.
...@@ -36,13 +32,14 @@ Proof. ...@@ -36,13 +32,14 @@ Proof.
iSpecialize ("HΦ" with "* [-]"); first by iSplitL "H1". by wp_let. iSpecialize ("HΦ" with "* [-]"); first by iSplitL "H1". by wp_let.
Qed. Qed.
Lemma wp_par (Ψ1 Ψ2 : val iProp) (e1 e2 : expr []) (Φ : val iProp) : Lemma wp_par (Ψ1 Ψ2 : val iProp)
(e1 e2 : expr) `{!Closed [] e1, Closed [] e2} (Φ : val iProp) :
heapN N heapN N
(heap_ctx heapN WP e1 {{ Ψ1 }} WP e2 {{ Ψ2 }} (heap_ctx heapN WP e1 {{ Ψ1 }} WP e2 {{ Ψ2 }}
v1 v2, Ψ1 v1 Ψ2 v2 - Φ (v1,v2)%V) v1 v2, Ψ1 v1 Ψ2 v2 - Φ (v1,v2)%V)
WP e1 || e2 {{ Φ }}. WP e1 || e2 {{ Φ }}.
Proof. Proof.
iIntros (?) "(#Hh&H1&H2&H)". iApply (par_spec Ψ1 Ψ2); auto. iIntros (?) "(#Hh&H1&H2&H)". iApply (par_spec Ψ1 Ψ2); try wp_done.
iFrame "Hh H". iSplitL "H1"; by wp_let. iFrame "Hh H". iSplitL "H1"; by wp_let.
Qed. Qed.
End proof. End proof.
...@@ -5,13 +5,13 @@ Import uPred. ...@@ -5,13 +5,13 @@ Import uPred.
Definition spawn : val := Definition spawn : val :=
λ: "f", λ: "f",
let: "c" := ref (InjL #0) in let: "c" := ref NONE in
Fork ('"c" <- InjR ('"f" #())) ;; '"c". Fork ("c" <- SOME ("f" #())) ;; "c".
Definition join : val := Definition join : val :=
rec: "join" "c" := rec: "join" "c" :=
match: !'"c" with match: !"c" with
InjR "x" => '"x" SOME "x" => "x"
| InjL <> => '"join" '"c" | NONE => "join" "c"
end. end.
Global Opaque spawn join. Global Opaque spawn join.
...@@ -33,8 +33,8 @@ Context (heapN N : namespace). ...@@ -33,8 +33,8 @@ Context (heapN N : namespace).
Local Notation iProp := (iPropG heap_lang Σ). Local Notation iProp := (iPropG heap_lang Σ).
Definition spawn_inv (γ : gname) (l : loc) (Ψ : val iProp) : iProp := Definition spawn_inv (γ : gname) (l : loc) (Ψ : val iProp) : iProp :=
( lv, l lv (lv = InjLV #0 ( lv, l lv (lv = NONEV
v, lv = InjRV v (Ψ v own γ (Excl ()))))%I. v, lv = SOMEV v (Ψ v own γ (Excl ()))))%I.
Definition join_handle (l : loc) (Ψ : val iProp) : iProp := Definition join_handle (l : loc) (Ψ : val iProp) : iProp :=
(heapN N γ, heap_ctx heapN own γ (Excl ()) (heapN N γ, heap_ctx heapN own γ (Excl ())
...@@ -60,13 +60,13 @@ Proof. ...@@ -60,13 +60,13 @@ Proof.
wp_let. wp_alloc l as "Hl". wp_let. wp_let. wp_alloc l as "Hl". wp_let.
iPvs (own_alloc (Excl ())) as (γ) "Hγ"; first done. iPvs (own_alloc (Excl ())) as (γ) "Hγ"; first done.
iPvs (inv_alloc N _ (spawn_inv γ l Ψ) with "[Hl]") as "#?"; first done. iPvs (inv_alloc N _ (spawn_inv γ l Ψ) with "[Hl]") as "#?"; first done.
{ iNext. iExists (InjLV #0). iFrame; eauto. } { iNext. iExists NONEV. iFrame; eauto. }
wp_apply wp_fork. iSplitR "Hf". wp_apply wp_fork. iSplitR "Hf".
- iPvsIntro. wp_seq. iPvsIntro. iApply "HΦ". rewrite /join_handle. eauto. - iPvsIntro. wp_seq. iPvsIntro. iApply "HΦ". rewrite /join_handle. eauto.
- wp_focus (f _). iApply wp_wand_l. iFrame "Hf"; iIntros (v) "Hv". - wp_focus (f _). iApply wp_wand_l. iFrame "Hf"; iIntros (v) "Hv".
iInv N as (v') "[Hl _]"; first wp_done. iInv N as (v') "[Hl _]".
wp_store. iPvsIntro. iSplit; [iNext|done]. wp_store. iPvsIntro. iSplit; [iNext|done].
iExists (InjRV v). iFrame. eauto. iExists (SOMEV v). iFrame. eauto.
Qed. Qed.
Lemma join_spec (Ψ : val iProp) l (Φ : val iProp) : Lemma join_spec (Ψ : val iProp) l (Φ : val iProp) :
......
...@@ -10,7 +10,7 @@ Section lifting. ...@@ -10,7 +10,7 @@ Section lifting.
Context {Σ : iFunctor}. Context {Σ : iFunctor}.
Implicit Types P Q : iProp heap_lang Σ. Implicit Types P Q : iProp heap_lang Σ.
Implicit Types Φ : val iProp heap_lang Σ. Implicit Types Φ : val iProp heap_lang Σ.
Implicit Types ef : option (expr []). Implicit Types ef : option expr.
(** Bind. This bundles some arguments that wp_ectx_bind leaves as indices. *) (** Bind. This bundles some arguments that wp_ectx_bind leaves as indices. *)
Lemma wp_bind {E e} K Φ : Lemma wp_bind {E e} K Φ :
...@@ -81,12 +81,13 @@ Proof. ...@@ -81,12 +81,13 @@ Proof.
rewrite later_sep -(wp_value_pvs _ _ (Lit _)) //. rewrite later_sep -(wp_value_pvs _ _ (Lit _)) //.
Qed. Qed.
Lemma wp_rec E f x erec e1 e2 v2 Φ : Lemma wp_rec E f x erec e1 e2 Φ :
e1 = Rec f x erec e1 = Rec f x erec
to_val e2 = Some v2 is_Some (to_val e2)
Closed (f :b: x :b: []) erec
WP subst' x e2 (subst' f e1 erec) @ E {{ Φ }} WP App e1 e2 @ E {{ Φ }}. WP subst' x e2 (subst' f e1 erec) @ E {{ Φ }} WP App e1 e2 @ E {{ Φ }}.
Proof. Proof.
intros -> ?. rewrite -(wp_lift_pure_det_head_step (App _ _) intros -> [v2 ?] ?. rewrite -(wp_lift_pure_det_head_step (App _ _)
(subst' x e2 (subst' f (Rec f x erec) erec)) None) //= ?right_id; (subst' x e2 (subst' f (Rec f x erec) erec)) None) //= ?right_id;
intros; inv_head_step; eauto. intros; inv_head_step; eauto.
Qed. Qed.
...@@ -121,35 +122,35 @@ Proof. ...@@ -121,35 +122,35 @@ Proof.
?right_id //; intros; inv_head_step; eauto. ?right_id //; intros; inv_head_step; eauto.
Qed. Qed.
Lemma wp_fst E e1 v1 e2 v2 Φ : Lemma wp_fst E e1 v1 e2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2 to_val e1 = Some v1 is_Some (to_val e2)
(|={E}=> Φ v1) WP Fst (Pair e1 e2) @ E {{ Φ }}. (|={E}=> Φ v1) WP Fst (Pair e1 e2) @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -(wp_lift_pure_det_head_step (Fst _) e1 None) intros ? [v2 ?]. rewrite -(wp_lift_pure_det_head_step (Fst _) e1 None)
?right_id -?wp_value_pvs //; intros; inv_head_step; eauto. ?right_id -?wp_value_pvs //; intros; inv_head_step; eauto.
Qed. Qed.
Lemma wp_snd E e1 v1 e2 v2 Φ : Lemma wp_snd E e1 e2 v2 Φ :
to_val e1 = Some v1 to_val e2 = Some v2 is_Some (to_val e1) to_val e2 = Some v2
(|={E}=> Φ v2) WP Snd (Pair e1 e2) @ E {{ Φ }}. (|={E}=> Φ v2) WP Snd (Pair e1 e2) @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -(wp_lift_pure_det_head_step (Snd _) e2 None) intros [v1 ?] ?. rewrite -(wp_lift_pure_det_head_step (Snd _) e2 None)
?right_id -?wp_value_pvs //; intros; inv_head_step; eauto. ?right_id -?wp_value_pvs //; intros; inv_head_step; eauto.
Qed. Qed.
Lemma wp_case_inl E e0 v0 e1 e2 Φ : Lemma wp_case_inl E e0 e1 e2 Φ :
to_val e0 = Some v0 is_Some (to_val e0)
WP App e1 e0 @ E {{ Φ }} WP Case (InjL e0) e1 e2 @ E {{ Φ }}. WP App e1 e0 @ E {{ Φ }} WP Case (InjL e0) e1 e2 @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -(wp_lift_pure_det_head_step (Case _ _ _) intros [v0 ?]. rewrite -(wp_lift_pure_det_head_step (Case _ _ _)
(App e1 e0) None) ?right_id //; intros; inv_head_step; eauto. (App e1 e0) None) ?right_id //; intros; inv_head_step; eauto.
Qed. Qed.
Lemma wp_case_inr E e0 v0 e1 e2 Φ : Lemma wp_case_inr E e0 e1 e2 Φ :
to_val e0 = Some v0 is_Some (to_val e0)
WP App e2 e0 @ E {{ Φ }} WP Case (InjR e0) e1 e2 @ E {{ Φ }}. WP App e2 e0 @ E {{ Φ }} WP Case (InjR e0) e1 e2 @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -(wp_lift_pure_det_head_step (Case _ _ _) intros [v0 ?]. rewrite -(wp_lift_pure_det_head_step (Case _ _ _)
(App e2 e0) None) ?right_id //; intros; inv_head_step; eauto. (App e2 e0) None) ?right_id //; intros; inv_head_step; eauto.
Qed. Qed.
End lifting. End lifting.
...@@ -24,6 +24,8 @@ Coercion LitLoc : loc >-> base_lit. ...@@ -24,6 +24,8 @@ Coercion LitLoc : loc >-> base_lit.
Coercion App : expr >-> Funclass. Coercion App : expr >-> Funclass.
Coercion of_val : val >-> expr. Coercion of_val : val >-> expr.
Coercion Var : string >-> expr.
Coercion BNamed : string >-> binder. Coercion BNamed : string >-> binder.
Notation "<>" := BAnon : binder_scope. Notation "<>" := BAnon : binder_scope.
...@@ -32,9 +34,6 @@ properly. *) ...@@ -32,9 +34,6 @@ properly. *)
Notation "# l" := (LitV l%Z%V) (at level 8, format "# l"). Notation "# l" := (LitV l%Z%V) (at level 8, format "# l").
Notation "# l" := (Lit l%Z%V) (at level 8, format "# l") : expr_scope. Notation "# l" := (Lit l%Z%V) (at level 8, format "# l") : expr_scope.
Notation "' x" := (Var x) (at level 8, format "' x") : expr_scope.
Notation "^ e" := (wexpr' e) (at level 8, format "^ e") : expr_scope.
(** Syntax inspired by Coq/Ocaml. Constructions with higher precedence come (** Syntax inspired by Coq/Ocaml. Constructions with higher precedence come
first. *) first. *)
Notation "( e1 , e2 , .. , en )" := (Pair .. (Pair e1 e2) .. en) : expr_scope. Notation "( e1 , e2 , .. , en )" := (Pair .. (Pair e1 e2) .. en) : expr_scope.
...@@ -115,6 +114,6 @@ Notation SOMEV x := (InjRV x). ...@@ -115,6 +114,6 @@ Notation SOMEV x := (InjRV x).
Notation "'match:' e0 'with' 'NONE' => e1 | 'SOME' x => e2 'end'" := Notation "'match:' e0 'with' 'NONE' => e1 | 'SOME' x => e2 'end'" :=
(Match e0 BAnon e1 x%bind e2) (Match e0 BAnon e1 x%bind e2)
(e0, e1, x, e2 at level 200) : expr_scope. (e0, e1, x, e2 at level 200) : expr_scope.
Notation "'match:' e0 'with' 'SOME' x => e2 | 'NONE' => e1 | 'end'" := Notation "'match:' e0 'with' 'SOME' x => e2 | 'NONE' => e1 'end'" :=
(Match e0 BAnon e1 x%bind e2) (Match e0 BAnon e1 x%bind e2)
(e0, e1, x, e2 at level 200, only parsing) : expr_scope. (e0, e1, x, e2 at level 200, only parsing) : expr_scope.
From iris.heap_lang Require Export lang.
Import heap_lang.
(** The tactic [simpl_subst] performs substitutions in the goal. Its behavior
can be tuned by declaring [WExpr] and [WSubst] instances. *)
(** * Weakening *)
Class WExpr {X Y} (H : X `included` Y) (e : expr X) (er : expr Y) :=
do_wexpr : wexpr H e = er.
Hint Mode WExpr + + + + - : typeclass_instances.
(* Variables *)
Hint Extern 0 (WExpr _ (Var ?y) _) =>
apply var_proof_irrel : typeclass_instances.
(* Rec *)
Instance do_wexpr_rec_true {X Y f y e} {H : X `included` Y} er :
WExpr (wexpr_rec_prf H) e er WExpr H (Rec f y e) (Rec f y er) | 10.
Proof. intros; red; f_equal/=. by etrans; [apply wexpr_proof_irrel|]. Qed.
(* Values *)
Instance do_wexpr_wexpr X Y Z (H1 : X `included` Y) (H2 : Y `included` Z) e er :
WExpr (transitivity H1 H2) e er WExpr H2 (wexpr H1 e) er | 0.
Proof. by rewrite /WExpr wexpr_wexpr'. Qed.
Instance do_wexpr_closed_closed (H : [] `included` []) e : WExpr H e e | 1.
Proof. apply wexpr_id. Qed.
Instance do_wexpr_closed_wexpr Y (H : [] `included` Y) e :
WExpr H e (wexpr' e) | 2.
Proof. apply wexpr_proof_irrel. Qed.
(* Boring connectives *)
Section do_wexpr.
Context {X Y : list string} (H : X `included` Y).
Notation W := (WExpr H).
(* Ground terms *)
Global Instance do_wexpr_lit l : W (Lit l) (Lit l).
Proof. done. Qed.
Global Instance do_wexpr_app e1 e2 e1r e2r :
W e1 e1r W e2 e2r W (App e1 e2) (App e1r e2r).
Proof. intros; red; f_equal/=; apply: do_wexpr. Qed.
Global Instance do_wexpr_unop op e er : W e er W (UnOp op e) (UnOp op er).
Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wexpr_binop op e1 e2 e1r e2r :
W e1 e1r W e2 e2r W (BinOp op e1 e2) (BinOp op e1r e2r).
Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wexpr_if e0 e1 e2 e0r e1r e2r :
W e0 e0r W e1 e1r W e2 e2r W (If e0 e1 e2) (If e0r e1r e2r).
Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wexpr_pair e1 e2 e1r e2r :
W e1 e1r W e2 e2r W (Pair e1 e2) (Pair e1r e2r).
Proof. by intros ??; red; f_equal/=. Qed.
Global Instance do_wexpr_fst e er : W e er W (Fst e) (Fst er).
Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wexpr_snd e er : W e er W (Snd e) (Snd er).
Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wexpr_injL e er : W e er W (InjL e) (InjL er).
Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wexpr_injR e er : W e er W (InjR e) (InjR er).
Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wexpr_case e0 e1 e2 e0r e1r e2r :
W e0 e0r W e1 e1r W e2 e2r W (Case e0 e1 e2) (Case e0r e1r e2r).
Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wexpr_fork e er : W e er W (Fork e) (Fork er).
Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wexpr_alloc e er : W e er W (Alloc e) (Alloc er).
Proof. by intros; red; f_equal/=. Qed.