Skip to content
Snippets Groups Projects
Commit 3e8fcd4c authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Make use of new `big_sepM2` in Iris.

parent 0975c0ac
No related branches found
No related tags found
No related merge requests found
Pipeline #16894 failed
...@@ -9,6 +9,6 @@ build: [make "-j%{jobs}%"] ...@@ -9,6 +9,6 @@ build: [make "-j%{jobs}%"]
install: [make "install"] install: [make "install"]
remove: ["rm" "-rf" "%{lib}%/coq/user-contrib/iris_examples"] remove: ["rm" "-rf" "%{lib}%/coq/user-contrib/iris_examples"]
depends: [ depends: [
"coq-iris" { (= "dev.2019-04-07.4.4760ad33") | (= "dev") } "coq-iris" { (= "dev.2019-04-17.0.60d28bbb") | (= "dev") }
"coq-autosubst" { = "dev.coq86" } "coq-autosubst" { = "dev.coq86" }
] ]
...@@ -98,8 +98,7 @@ Notation "'ref' A" := (lty_ref A) : lty_scope. ...@@ -98,8 +98,7 @@ Notation "'ref' A" := (lty_ref A) : lty_scope.
(* The semantic typing judgment *) (* The semantic typing judgment *)
Definition env_ltyped `{heapG Σ} (Γ : gmap string (lty Σ)) Definition env_ltyped `{heapG Σ} (Γ : gmap string (lty Σ))
(vs : gmap string val) : iProp Σ := (vs : gmap string val) : iProp Σ :=
( x, is_Some (Γ !! x) is_Some (vs !! x) ([ map] i A;v Γ; vs, lty_car A v)%I.
[ map] i Av map_zip Γ vs, lty_car Av.1 Av.2)%I.
Definition ltyped `{heapG Σ} Definition ltyped `{heapG Σ}
(Γ : gmap string (lty Σ)) (e : expr) (A : lty Σ) : iProp Σ := (Γ : gmap string (lty Σ)) (e : expr) (A : lty Σ) : iProp Σ :=
( vs, env_ltyped Γ vs -∗ WP subst_map vs e {{ A }})%I. ( vs, env_ltyped Γ vs -∗ WP subst_map vs e {{ A }})%I.
...@@ -139,19 +138,15 @@ Section types_properties. ...@@ -139,19 +138,15 @@ Section types_properties.
Γ !! x = Some A Γ !! x = Some A
env_ltyped Γ vs -∗ v, vs !! x = Some v A v. env_ltyped Γ vs -∗ v, vs !! x = Some v A v.
Proof. Proof.
iIntros (HΓx) "[Hlookup HΓ]". iDestruct "Hlookup" as %Hlookup. iIntros (HΓx) "HΓ".
destruct (proj1 (Hlookup x)) as [v Hx]; eauto. iDestruct (big_sepM2_lookup_1 with "HΓ") as (v ?) "H"; eauto.
iExists v. iSplit; first done. iApply (big_sepM_lookup _ _ x (A,v) with "HΓ").
by rewrite map_lookup_zip_with HΓx /= Hx.
Qed. Qed.
Lemma env_ltyped_insert Γ vs x A v : Lemma env_ltyped_insert Γ vs x A v :
A v -∗ env_ltyped Γ vs -∗ A v -∗ env_ltyped Γ vs -∗
env_ltyped (binder_insert x A Γ) (binder_insert x v vs). env_ltyped (binder_insert x A Γ) (binder_insert x v vs).
Proof. Proof.
destruct x as [|x]=> /=; first by auto. destruct x as [|x]=> /=; first by auto.
iIntros "#HA [Hlookup #HΓ]". iDestruct "Hlookup" as %Hlookup. iSplit. iIntros "#HA #HΓ". by iApply (big_sepM2_insert_2 with "[] HΓ").
- iPureIntro=> y. rewrite !lookup_insert_is_Some'. naive_solver.
- rewrite -map_insert_zip_with. by iApply big_sepM_insert_2.
Qed. Qed.
(* Unboxed types *) (* Unboxed types *)
......
...@@ -9,9 +9,6 @@ Lemma ltyped_safety `{heapPreG Σ} e σ es σ' e' : ...@@ -9,9 +9,6 @@ Lemma ltyped_safety `{heapPreG Σ} e σ es σ' e' :
Proof. Proof.
intros Hty. apply (heap_adequacy Σ NotStuck e σ (λ _, True))=> // ?. intros Hty. apply (heap_adequacy Σ NotStuck e σ (λ _, True))=> // ?.
destruct (Hty _) as [A He]. iStartProof. iDestruct (He $! ) as "#He". destruct (Hty _) as [A He]. iStartProof. iDestruct (He $! ) as "#He".
iSpecialize ("He" with "[]"). iSpecialize ("He" with "[]"); first by rewrite /env_ltyped.
{ iSplit.
- iPureIntro=> x. rewrite !lookup_empty -!not_eq_None_Some. by naive_solver.
- by rewrite map_zip_with_empty. }
rewrite subst_map_empty. iApply (wp_wand with "He"); auto. rewrite subst_map_empty. iApply (wp_wand with "He"); auto.
Qed. Qed.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment