Commit 86a81cbe authored by Robbert's avatar Robbert

Merge branch 'robbert/logrel_heaplang' into 'master'

Semantic typing for heap_lang

See merge request !12
parents bac9c267 0fd1e1ba
Pipeline #13508 passed with stage
in 6 minutes and 59 seconds
......@@ -17,6 +17,9 @@ concurrent_stacks: $(filter theories/concurrent_stacks/%,$(VOFILES))
logrel: $(filter theories/logrel/%,$(VOFILES))
.PHONY: logrel
logrel_heaplang: $(filter theories/logrel_heaplang/%,$(VOFILES))
.PHONY: logrel_heaplang
hocap: $(filter theories/hocap/%,$(VOFILES))
.PHONY: hocap
......@@ -50,6 +50,8 @@ This repository contains the following case studies:
concurrent counter implementations
- Proof of refinement for a pair of fine-grained/coarse-grained
concurrent stack implementations
* [logrel_heaplang](theories/logrel_heaplang): A unary logical relation for
semantic typing of heap lang.
* [spanning-tree](theories/spanning_tree): Proof of a concurrent spanning tree
algorithm by Amin Timany.
* [concurrent-stacks](theories/concurrent_stacks): Proof of an implementation of
......@@ -72,6 +72,10 @@ theories/logrel/F_mu_ref_conc/examples/stack/FG_stack.v
......@@ -9,6 +9,6 @@ build: [make "-j%{jobs}%"]
install: [make "install"]
remove: ["rm" "-rf" "%{lib}%/coq/user-contrib/iris_examples"]
depends: [
"coq-iris" { (= "dev.2018-11-08.2.9eee9408") | (= "dev") }
"coq-iris" { (= "dev.2018-12-12.0.b1270b7d") | (= "dev") }
"coq-autosubst" { = "dev.coq86" }
From iris_examples.logrel_heaplang Require Export ltyping.
From iris.heap_lang.lib Require Import assert.
From iris.algebra Require Import auth.
From iris.base_logic.lib Require Import invariants.
From iris.heap_lang Require Import notation proofmode.
(* Semantic typing of a symbol ADT (taken from Dreyer's POPL'18 talk) *)
Definition symbol_adt_inc : val := λ: "x" <>, FAA "x" #1.
Definition symbol_adt_check : val := λ: "x" "y", assert: "y" < !"x".
Definition symbol_adt : val := λ: <>,
let: "x" := Alloc #0 in (symbol_adt_inc "x", symbol_adt_check "x").
Definition symbol_adt_ty `{heapG Σ} : lty :=
(() A, (() A) * (A ()))%lty.
(* The required ghost theory *)
Class symbolG Σ := { symbol_inG :> inG Σ (authR mnatUR) }.
Definition symbolΣ : gFunctors := #[GFunctor (authR mnatUR)].
Instance subG_symbolΣ {Σ} : subG symbolΣ Σ symbolG Σ.
Proof. solve_inG. Qed.
Section symbol_ghosts.
Context `{!symbolG Σ}.
Definition counter (γ : gname) (n : nat) : iProp Σ := own γ ( (n : mnat)).
Definition symbol (γ : gname) (n : nat) : iProp Σ := own γ ( (S n : mnat)).
Global Instance counter_timeless γ n : Timeless (counter γ n).
Proof. apply _. Qed.
Global Instance symbol_timeless γ n : Timeless (symbol γ n).
Proof. apply _. Qed.
Lemma counter_exclusive γ n1 n2 : counter γ n1 - counter γ n2 - False.
Proof. apply bi.wand_intro_r. by rewrite -own_op own_valid auth_validI. Qed.
Global Instance symbol_persistent γ n : Persistent (symbol γ n).
Proof. apply _. Qed.
Lemma counter_alloc n : (|==> γ, counter γ n)%I.
iMod (own_alloc ( (n:mnat) (n:mnat))) as (γ) "[Hγ Hγf]"; first done.
iExists γ. by iFrame.
Lemma counter_inc γ n : counter γ n == counter γ (S n) symbol γ n.
rewrite -own_op.
apply own_update, auth_update_alloc, mnat_local_update. omega.
Lemma symbol_obs γ s n : counter γ n - symbol γ s - (s < n)%nat.
iIntros "Hc Hs".
iDestruct (own_valid_2 with "Hc Hs") as %[?%mnat_included _]%auth_valid_discrete_2.
iPureIntro. omega.
End symbol_ghosts.
Typeclasses Opaque counter symbol.
Section ltyped_symbol_adt.
Context `{heapG Σ, symbolG Σ}.
Definition symbol_adtN := nroot .@ "symbol_adt".
Definition symbol_inv (γ : gname) (l : loc) : iProp Σ :=
( n : nat, l #n counter γ n)%I.
Definition symbol_ctx (γ : gname) (l : loc) : iProp Σ :=
inv symbol_adtN (symbol_inv γ l).
Definition lty_symbol (γ : gname) : lty := Lty (λ w,
n : nat, w = #n symbol γ n)%I.
Lemma ltyped_symbol_adt Γ : Γ symbol_adt : symbol_adt_ty.
iIntros (vs) "!# _ /=". iApply wp_value.
iIntros "!#" (v ->). wp_lam. wp_alloc l as "Hl"; wp_pures.
iMod (counter_alloc 0) as (γ) "Hc".
iMod (inv_alloc symbol_adtN _ (symbol_inv γ l) with "[Hl Hc]") as "#?".
{ iExists 0%nat. by iFrame. }
do 2 (wp_lam; wp_pures).
iExists (lty_symbol γ), _, _; repeat iSplit=> //.
- repeat rewrite /lty_car /=. iIntros "!#" (? ->). wp_pures.
iInv symbol_adtN as (n) ">[Hl Hc]". wp_faa.
iMod (counter_inc with "Hc") as "[Hc #Hs]".
iModIntro; iSplitL; last eauto.
iExists (S n). rewrite Nat2Z.inj_succ -Z.add_1_r. iFrame.
- repeat rewrite /lty_car /=. iIntros "!#" (v).
iDestruct 1 as (n ->) "#Hs". wp_pures. iApply wp_assert.
wp_bind (!_)%E. iInv symbol_adtN as (n') ">[Hl Hc]". wp_load.
iDestruct (symbol_obs with "Hc Hs") as %?. iModIntro. iSplitL.
{ iExists n'. iFrame. }
wp_op. rewrite bool_decide_true; last lia. eauto.
End ltyped_symbol_adt.
This diff is collapsed.
From iris_examples.logrel_heaplang Require Export ltyping.
From iris.heap_lang Require Import adequacy.
From iris.heap_lang Require Import proofmode.
Lemma ltyped_safety `{heapPreG Σ} e σ es σ' e' :
( `{heapG Σ}, A, e : A)
rtc erased_step ([e], σ) (es, σ') e' es
is_Some (to_val e') reducible e' σ'.
intros Hty. apply (heap_adequacy Σ NotStuck e σ (λ _, True))=> // ?.
destruct (Hty _) as [A He]. iStartProof. iDestruct (He $! ) as "#He".
iSpecialize ("He" with "[]").
{ 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.
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