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

Remove dependent types in heap_lang representation.

parent aa81760b
No related branches found
No related tags found
No related merge requests found
...@@ -11,6 +11,7 @@ buildjob: ...@@ -11,6 +11,7 @@ buildjob:
only: only:
- master - master
- jh_simplified_resources - jh_simplified_resources
- rk/substitition
artifacts: artifacts:
paths: paths:
- build-time.txt - build-time.txt
...@@ -19,29 +19,34 @@ Implicit Types Φ : val → iProp heap_lang Σ. ...@@ -19,29 +19,34 @@ 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 v Φ :
to_val e = Some v to_val e = Some v
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 v Φ :
to_val e1 = Some v to_val e1 = Some v
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 v Φ :
to_val e1 = Some v to_val e1 = Some v
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 // -wp_value //. Qed.
Lemma wp_match_inl E e0 v0 x1 e1 x2 e2 Φ : Lemma wp_match_inl E e0 v0 x1 e1 x2 e2 Φ :
to_val e0 = Some v0 to_val e0 = Some v0
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 v0 x1 e1 x2 e2 Φ :
to_val e0 = Some v0 to_val e0 = Some v0
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.heap_lang Require Export derived.
From iris.heap_lang Require Import wp_tactics substitution notation. From iris.heap_lang Require Import wp_tactics substitution notation.
Definition Assert {X} (e : expr X) : expr X := Definition Assert (e : expr) : expr :=
if: e then #() else #0 #0. (* #0 #0 is unsafe *) if: e then #() else #0 #0. (* #0 #0 is unsafe *)
Instance do_wexpr_assert {X Y} (H : X `included` Y) e er : Instance closed_assert X e : Closed X e Closed X (Assert e) := _.
WExpr H e er WExpr H (Assert e) (Assert er) := _. Instance do_subst_assert x es e er :
Instance do_wsubst_assert {X Y} x es (H : X `included` x :: Y) e er : Subst x es e er Subst x es (Assert e) (Assert er).
WSubst x es H e er WSubst x es H (Assert e) (Assert er). Proof. intros; red. by rewrite /Assert /subst -/subst; f_equal/=. Qed.
Proof. intros; red. by rewrite /Assert /wsubst -/wsubst; f_equal/=. Qed.
Typeclasses Opaque Assert. Typeclasses Opaque Assert.
Lemma wp_assert {Σ} (Φ : val iProp heap_lang Σ) : Lemma wp_assert {Σ} (Φ : val iProp heap_lang Σ) :
......
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. *)
......
...@@ -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); auto. apply is_value.
iFrame "Hh H". iSplitL "H1"; by wp_let. iFrame "Hh H". iSplitL "H1"; by wp_let.
Qed. Qed.
End proof. End proof.
...@@ -6,12 +6,12 @@ Import uPred. ...@@ -6,12 +6,12 @@ Import uPred.
Definition spawn : val := Definition spawn : val :=
λ: "f", λ: "f",
let: "c" := ref (InjL #0) in let: "c" := ref (InjL #0) in
Fork ('"c" <- InjR ('"f" #())) ;; '"c". Fork ("c" <- InjR ("f" #())) ;; "c".
Definition join : val := Definition join : val :=
rec: "join" "c" := rec: "join" "c" :=
match: !'"c" with match: !"c" with
InjR "x" => '"x" InjR "x" => "x"
| InjL <> => '"join" '"c" | InjL <> => "join" "c"
end. end.
Global Opaque spawn join. Global Opaque spawn join.
......
...@@ -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 Φ :
...@@ -84,9 +84,10 @@ Qed. ...@@ -84,9 +84,10 @@ Qed.
Lemma wp_rec E f x erec e1 e2 v2 Φ : Lemma wp_rec E f x erec e1 e2 v2 Φ :
e1 = Rec f x erec e1 = Rec f x erec
to_val e2 = Some v2 to_val e2 = Some v2
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 -> ??. 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.
......
...@@ -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.
......
...@@ -2,196 +2,99 @@ From iris.heap_lang Require Export lang. ...@@ -2,196 +2,99 @@ From iris.heap_lang Require Export lang.
Import heap_lang. Import heap_lang.
(** The tactic [simpl_subst] performs substitutions in the goal. Its behavior (** The tactic [simpl_subst] performs substitutions in the goal. Its behavior
can be tuned by declaring [WExpr] and [WSubst] instances. *) can be tuned by declaring [Subst] instances. *)
(** * Substitution *)
(** * Weakening *) Class Subst (x : string) (es : expr) (e : expr) (er : expr) :=
Class WExpr {X Y} (H : X `included` Y) (e : expr X) (er : expr Y) := do_subst : subst x es e = er.
do_wexpr : wexpr H e = er. Hint Mode Subst + + + - : typeclass_instances.
Hint Mode WExpr + + + + - : typeclass_instances.
(* Variables *) (* Variables *)
Hint Extern 0 (WExpr _ (Var ?y) _) => Lemma do_subst_var_eq x er : Subst x er (Var x) er.
apply var_proof_irrel : typeclass_instances. Proof. intros; red; simpl. by case_decide. Qed.
Lemma do_subst_var_neq x y er : bool_decide (x y) Subst x er (Var y) (Var y).
(* Rec *) Proof. rewrite bool_decide_spec. intros; red; simpl. by case_decide. Qed.
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.
Global Instance do_wexpr_load e er : W e er W (Load e) (Load er).
Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wexpr_store e1 e2 e1r e2r :
W e1 e1r W e2 e2r W (Store e1 e2) (Store e1r e2r).
Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wexpr_cas e0 e1 e2 e0r e1r e2r :
W e0 e0r W e1 e1r W e2 e2r W (CAS e0 e1 e2) (CAS e0r e1r e2r).
Proof. by intros; red; f_equal/=. Qed.
End do_wexpr.
(** * WSubstitution *) Hint Extern 0 (Subst ?x ?v (Var ?y) _) =>
Class WSubst {X Y} (x : string) (es : expr []) H (e : expr X) (er : expr Y) := first [apply do_subst_var_eq
do_wsubst : wsubst x es H e = er. |apply do_subst_var_neq, I] : typeclass_instances.
Hint Mode WSubst + + + + + + - : typeclass_instances.
Lemma do_wsubst_closed (e: {X}, expr X) {X Y} x es (H : X `included` x :: Y) :
( X, WExpr (included_nil X) e e) WSubst x es H e e.
Proof.
rewrite /WSubst /WExpr=> He. rewrite -(He X) wsubst_wexpr'.
by rewrite (wsubst_closed _ _ _ _ _ (included_nil _)); last set_solver.
Qed.
(* Variables *)
Lemma do_wsubst_var_eq {X Y x es} {H : X `included` x :: Y} `{VarBound x X} er :
WExpr (included_nil _) es er WSubst x es H (Var x) er.
Proof.
intros; red; simpl. case_decide; last done.
by etrans; [apply wexpr_proof_irrel|].
Qed.
Hint Extern 0 (WSubst ?x ?v _ (Var ?y) _) => first
[ apply var_proof_irrel
| apply do_wsubst_var_eq ] : typeclass_instances.
(** Rec *) (** Rec *)
Lemma do_wsubst_rec_true {X Y x es f y e} {H : X `included` x :: Y} Lemma do_subst_rec_true {x es f y e er} :
(Hfy : BNamed x f BNamed x y) er : bool_decide (BNamed x f BNamed x y)
WSubst x es (wsubst_rec_true_prf H Hfy) e er Subst x es e er Subst x es (Rec f y e) (Rec f y er).
WSubst x es H (Rec f y e) (Rec f y er). Proof. rewrite bool_decide_spec. intros; red; f_equal/=; by case_decide. Qed.
Proof. Lemma do_subst_rec_false {x es f y e} :
intros ?; red; f_equal/=; case_decide; last done. bool_decide (¬(BNamed x f BNamed x y))
by etrans; [apply wsubst_proof_irrel|]. Subst x es (Rec f y e) (Rec f y e).
Qed. Proof. rewrite bool_decide_spec. intros; red; f_equal/=; by case_decide. Qed.
Lemma do_wsubst_rec_false {X Y x es f y e} {H : X `included` x :: Y}
(Hfy : ¬(BNamed x f BNamed x y)) er : Local Ltac bool_decide_no_check := vm_cast_no_check I.
WExpr (wsubst_rec_false_prf H Hfy) e er Hint Extern 0 (Subst ?x ?v (Rec ?f ?y ?e) _) =>
WSubst x es H (Rec f y e) (Rec f y er).
Proof.
intros; red; f_equal/=; case_decide; first done.
by etrans; [apply wexpr_proof_irrel|].
Qed.
Ltac bool_decide_no_check := apply (bool_decide_unpack _); vm_cast_no_check I.
Hint Extern 0 (WSubst ?x ?v _ (Rec ?f ?y ?e) _) =>
match eval vm_compute in (bool_decide (BNamed x f BNamed x y)) with match eval vm_compute in (bool_decide (BNamed x f BNamed x y)) with
| true => eapply (do_wsubst_rec_true ltac:(bool_decide_no_check)) | true => eapply (do_subst_rec_true ltac:(bool_decide_no_check))
| false => eapply (do_wsubst_rec_false ltac:(bool_decide_no_check)) | false => eapply (do_subst_rec_false ltac:(bool_decide_no_check))
end : typeclass_instances. end : typeclass_instances.
Lemma do_subst_closed x es e : Closed [] e Subst x es e e.
Proof. apply closed_nil_subst. Qed.
Hint Extern 10 (Subst ?x ?v ?e _) =>
is_var e; class_apply do_subst_closed : typeclass_instances.
(* Values *) (* Values *)
Instance do_wsubst_wexpr X Y Z x es Instance do_subst_of_val x es v : Subst x es (of_val v) (of_val v) | 0.
(H1 : X `included` Y) (H2 : Y `included` x :: Z) e er : Proof. eapply closed_nil_subst, of_val_closed. Qed.
WSubst x es (transitivity H1 H2) e er WSubst x es H2 (wexpr H1 e) er | 0.
Proof. by rewrite /WSubst wsubst_wexpr'. Qed.
Instance do_wsubst_closed_closed x es (H : [] `included` [x]) e :
WSubst x es H e e | 1.
Proof. apply wsubst_closed_nil. Qed.
Instance do_wsubst_closed_wexpr Y x es (H : [] `included` x :: Y) e :
WSubst x es H e (wexpr' e) | 2.
Proof. apply wsubst_closed, not_elem_of_nil. Qed.
(* Boring connectives *) (* Boring connectives *)
Section wsubst. Section subst.
Context {X Y} (x : string) (es : expr []) (H : X `included` x :: Y). Context (x : string) (es : expr).
Notation Sub := (WSubst x es H). Notation Sub := (Subst x es).
(* Ground terms *) (* Ground terms *)
Global Instance do_wsubst_lit l : Sub (Lit l) (Lit l). Global Instance do_subst_lit l : Sub (Lit l) (Lit l).
Proof. done. Qed. Proof. done. Qed.
Global Instance do_wsubst_app e1 e2 e1r e2r : Global Instance do_subst_app e1 e2 e1r e2r :
Sub e1 e1r Sub e2 e2r Sub (App e1 e2) (App e1r e2r). Sub e1 e1r Sub e2 e2r Sub (App e1 e2) (App e1r e2r).
Proof. intros; red; f_equal/=; apply: do_wsubst. Qed. Proof. intros; red; f_equal/=; apply: do_subst. Qed.
Global Instance do_wsubst_unop op e er : Sub e er Sub (UnOp op e) (UnOp op er). Global Instance do_subst_unop op e er : Sub e er Sub (UnOp op e) (UnOp op er).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wsubst_binop op e1 e2 e1r e2r : Global Instance do_subst_binop op e1 e2 e1r e2r :
Sub e1 e1r Sub e2 e2r Sub (BinOp op e1 e2) (BinOp op e1r e2r). Sub e1 e1r Sub e2 e2r Sub (BinOp op e1 e2) (BinOp op e1r e2r).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wsubst_if e0 e1 e2 e0r e1r e2r : Global Instance do_subst_if e0 e1 e2 e0r e1r e2r :
Sub e0 e0r Sub e1 e1r Sub e2 e2r Sub (If e0 e1 e2) (If e0r e1r e2r). Sub e0 e0r Sub e1 e1r Sub e2 e2r Sub (If e0 e1 e2) (If e0r e1r e2r).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wsubst_pair e1 e2 e1r e2r : Global Instance do_subst_pair e1 e2 e1r e2r :
Sub e1 e1r Sub e2 e2r Sub (Pair e1 e2) (Pair e1r e2r). Sub e1 e1r Sub e2 e2r Sub (Pair e1 e2) (Pair e1r e2r).
Proof. by intros ??; red; f_equal/=. Qed. Proof. by intros ??; red; f_equal/=. Qed.
Global Instance do_wsubst_fst e er : Sub e er Sub (Fst e) (Fst er). Global Instance do_subst_fst e er : Sub e er Sub (Fst e) (Fst er).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wsubst_snd e er : Sub e er Sub (Snd e) (Snd er). Global Instance do_subst_snd e er : Sub e er Sub (Snd e) (Snd er).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wsubst_injL e er : Sub e er Sub (InjL e) (InjL er). Global Instance do_subst_injL e er : Sub e er Sub (InjL e) (InjL er).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wsubst_injR e er : Sub e er Sub (InjR e) (InjR er). Global Instance do_subst_injR e er : Sub e er Sub (InjR e) (InjR er).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wsubst_case e0 e1 e2 e0r e1r e2r : Global Instance do_subst_case e0 e1 e2 e0r e1r e2r :
Sub e0 e0r Sub e1 e1r Sub e2 e2r Sub (Case e0 e1 e2) (Case e0r e1r e2r). Sub e0 e0r Sub e1 e1r Sub e2 e2r Sub (Case e0 e1 e2) (Case e0r e1r e2r).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wsubst_fork e er : Sub e er Sub (Fork e) (Fork er). Global Instance do_subst_fork e er : Sub e er Sub (Fork e) (Fork er).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wsubst_alloc e er : Sub e er Sub (Alloc e) (Alloc er). Global Instance do_subst_alloc e er : Sub e er Sub (Alloc e) (Alloc er).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wsubst_load e er : Sub e er Sub (Load e) (Load er). Global Instance do_subst_load e er : Sub e er Sub (Load e) (Load er).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wsubst_store e1 e2 e1r e2r : Global Instance do_subst_store e1 e2 e1r e2r :
Sub e1 e1r Sub e2 e2r Sub (Store e1 e2) (Store e1r e2r). Sub e1 e1r Sub e2 e2r Sub (Store e1 e2) (Store e1r e2r).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Global Instance do_wsubst_cas e0 e1 e2 e0r e1r e2r : Global Instance do_subst_cas e0 e1 e2 e0r e1r e2r :
Sub e0 e0r Sub e1 e1r Sub e2 e2r Sub (CAS e0 e1 e2) (CAS e0r e1r e2r). Sub e0 e0r Sub e1 e1r Sub e2 e2r Sub (CAS e0 e1 e2) (CAS e0r e1r e2r).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
End wsubst. End subst.
(** * The tactic *) (** * The tactic *)
Lemma do_subst {X} (x: string) (es: expr []) (e: expr (x :: X)) (er: expr X) :
WSubst x es (λ _, id) e er subst x es e = er.
Proof. done. Qed.
Ltac simpl_subst := Ltac simpl_subst :=
repeat match goal with repeat match goal with
| |- context [subst ?x ?es ?e] => progress rewrite (@do_subst _ x es e) | |- context [subst ?x ?es ?e] => progress rewrite (@do_subst x es e)
| |- _ => progress csimpl | |- _ => progress csimpl
end. end.
Arguments wexpr : simpl never.
Arguments subst : simpl never. Arguments subst : simpl never.
Arguments wsubst : simpl never.
...@@ -25,7 +25,6 @@ Ltac reshape_val e tac := ...@@ -25,7 +25,6 @@ Ltac reshape_val e tac :=
let rec go e := let rec go e :=
match e with match e with
| of_val ?v => v | of_val ?v => v
| wexpr' ?e => go e
| Rec ?f ?x ?e => constr:(RecV f x e) | Rec ?f ?x ?e => constr:(RecV f x e)
| Lit ?l => constr:(LitV l) | Lit ?l => constr:(LitV l)
| Pair ?e1 ?e2 => | Pair ?e1 ?e2 =>
......
...@@ -9,7 +9,8 @@ Ltac wp_bind K := ...@@ -9,7 +9,8 @@ Ltac wp_bind K :=
| _ => etrans; [|fast_by apply (wp_bind K)]; simpl | _ => etrans; [|fast_by apply (wp_bind K)]; simpl
end. end.
Ltac wp_done := rewrite /= ?to_of_val; fast_done. (* TODO: Do something better here *)
Ltac wp_done := fast_done || apply is_value || apply _ || (rewrite /= ?to_of_val; fast_done).
(* sometimes, we will have to do a final view shift, so only apply (* sometimes, we will have to do a final view shift, so only apply
pvs_intro if we obtain a consecutive wp *) pvs_intro if we obtain a consecutive wp *)
......
...@@ -5,12 +5,12 @@ From iris.heap_lang Require Import proofmode. ...@@ -5,12 +5,12 @@ From iris.heap_lang Require Import proofmode.
Import uPred. Import uPred.
Definition worker (n : Z) : val := Definition worker (n : Z) : val :=
λ: "b" "y", ^wait '"b" ;; !'"y" #n. λ: "b" "y", wait "b" ;; !"y" #n.
Definition client : expr [] := Definition client : expr :=
let: "y" := ref #0 in let: "y" := ref #0 in
let: "b" := ^newbarrier #() in let: "b" := newbarrier #() in
('"y" <- (λ: "z", '"z" + #42) ;; ^signal '"b") || ("y" <- (λ: "z", "z" + #42) ;; signal "b") ||
(^(worker 12) '"b" '"y" || ^(worker 17) '"b" '"y"). (worker 12 "b" "y" || worker 17 "b" "y").
Global Opaque worker client. Global Opaque worker client.
Section client. Section client.
......
...@@ -4,13 +4,13 @@ From iris.heap_lang Require Import proofmode notation. ...@@ -4,13 +4,13 @@ From iris.heap_lang Require Import proofmode notation.
Import uPred. Import uPred.
Section LangTests. Section LangTests.
Definition add : expr [] := (#21 + #21)%E. Definition add : expr := (#21 + #21)%E.
Goal σ, head_step add σ (#42) σ None. Goal σ, head_step add σ (#42) σ None.
Proof. intros; do_head_step done. Qed. Proof. intros; do_head_step done. Qed.
Definition rec_app : expr [] := ((rec: "f" "x" := '"f" '"x") #0)%E. Definition rec_app : expr := ((rec: "f" "x" := "f" "x") #0)%E.
Goal σ, head_step rec_app σ rec_app σ None. Goal σ, head_step rec_app σ rec_app σ None.
Proof. intros. rewrite /rec_app. do_head_step done. Qed. Proof. intros. rewrite /rec_app. do_head_step done. Qed.
Definition lam : expr [] := (λ: "x", '"x" + #21)%E. Definition lam : expr := (λ: "x", "x" + #21)%E.
Goal σ, head_step (lam #21)%E σ add σ None. Goal σ, head_step (lam #21)%E σ add σ None.
Proof. intros. rewrite /lam. do_head_step done. Qed. Proof. intros. rewrite /lam. do_head_step done. Qed.
End LangTests. End LangTests.
...@@ -21,8 +21,8 @@ Section LiftingTests. ...@@ -21,8 +21,8 @@ Section LiftingTests.
Implicit Types P Q : iPropG heap_lang Σ. Implicit Types P Q : iPropG heap_lang Σ.
Implicit Types Φ : val iPropG heap_lang Σ. Implicit Types Φ : val iPropG heap_lang Σ.
Definition heap_e : expr [] := Definition heap_e : expr :=
let: "x" := ref #1 in '"x" <- !'"x" + #1 ;; !'"x". let: "x" := ref #1 in "x" <- !"x" + #1 ;; !"x".
Lemma heap_e_spec E N : Lemma heap_e_spec E N :
nclose N E heap_ctx N WP heap_e @ E {{ v, v = #2 }}. nclose N E heap_ctx N WP heap_e @ E {{ v, v = #2 }}.
Proof. Proof.
...@@ -30,10 +30,10 @@ Section LiftingTests. ...@@ -30,10 +30,10 @@ Section LiftingTests.
wp_alloc l. wp_let. wp_load. wp_op. wp_store. by wp_load. wp_alloc l. wp_let. wp_load. wp_op. wp_store. by wp_load.
Qed. Qed.
Definition heap_e2 : expr [] := Definition heap_e2 : expr :=
let: "x" := ref #1 in let: "x" := ref #1 in
let: "y" := ref #1 in let: "y" := ref #1 in
'"x" <- !'"x" + #1 ;; !'"x". "x" <- !"x" + #1 ;; !"x".
Lemma heap_e2_spec E N : Lemma heap_e2_spec E N :
nclose N E heap_ctx N WP heap_e2 @ E {{ v, v = #2 }}. nclose N E heap_ctx N WP heap_e2 @ E {{ v, v = #2 }}.
Proof. Proof.
...@@ -44,11 +44,11 @@ Section LiftingTests. ...@@ -44,11 +44,11 @@ Section LiftingTests.
Definition FindPred : val := Definition FindPred : val :=
rec: "pred" "x" "y" := rec: "pred" "x" "y" :=
let: "yp" := '"y" + #1 in let: "yp" := "y" + #1 in
if: '"yp" < '"x" then '"pred" '"x" '"yp" else '"y". if: "yp" < "x" then "pred" "x" "yp" else "y".
Definition Pred : val := Definition Pred : val :=
λ: "x", λ: "x",
if: '"x" #0 then -^FindPred (-'"x" + #2) #0 else ^FindPred '"x" #0. if: "x" #0 then -FindPred (-"x" + #2) #0 else FindPred "x" #0.
Global Opaque FindPred Pred. Global Opaque FindPred Pred.
Lemma FindPred_spec n1 n2 E Φ : Lemma FindPred_spec n1 n2 E Φ :
...@@ -71,7 +71,7 @@ Section LiftingTests. ...@@ -71,7 +71,7 @@ Section LiftingTests.
Qed. Qed.
Lemma Pred_user E : Lemma Pred_user E :
(True : iProp) WP let: "x" := Pred #42 in ^Pred '"x" @ E {{ v, v = #40 }}. (True : iProp) WP let: "x" := Pred #42 in Pred "x" @ E {{ v, v = #40 }}.
Proof. iIntros "". wp_apply Pred_spec. wp_let. by wp_apply Pred_spec. Qed. Proof. iIntros "". wp_apply Pred_spec. wp_let. by wp_apply Pred_spec. Qed.
End LiftingTests. End LiftingTests.
......
...@@ -13,9 +13,9 @@ Definition oneShotGF (F : cFunctor) : gFunctor := ...@@ -13,9 +13,9 @@ Definition oneShotGF (F : cFunctor) : gFunctor :=
Instance inGF_oneShotG `{inGF Λ Σ (oneShotGF F)} : oneShotG Λ Σ F. Instance inGF_oneShotG `{inGF Λ Σ (oneShotGF F)} : oneShotG Λ Σ F.
Proof. apply: inGF_inG. Qed. Proof. apply: inGF_inG. Qed.
Definition client eM eW1 eW2 : expr [] := Definition client eM eW1 eW2 : expr :=
let: "b" := newbarrier #() in let: "b" := newbarrier #() in
(eM ;; ^signal '"b") || ((^wait '"b" ;; eW1) || (^wait '"b" ;; eW2)). (eM ;; signal "b") || ((wait "b" ;; eW1) || (wait "b" ;; eW2)).
Global Opaque client. Global Opaque client.
Section proof. Section proof.
...@@ -29,7 +29,7 @@ Definition barrier_res γ (Φ : X → iProp) : iProp := ...@@ -29,7 +29,7 @@ Definition barrier_res γ (Φ : X → iProp) : iProp :=
( x, own γ (Cinr $ to_agree $ ( x, own γ (Cinr $ to_agree $
Next (cFunctor_map G (iProp_fold, iProp_unfold) x)) Φ x)%I. Next (cFunctor_map G (iProp_fold, iProp_unfold) x)) Φ x)%I.
Lemma worker_spec e γ l (Φ Ψ : X iProp) : Lemma worker_spec e γ l (Φ Ψ : X iProp) `{!Closed [] e} :
recv heapN N l (barrier_res γ Φ) ( x, {{ Φ x }} e {{ _, Ψ x }}) recv heapN N l (barrier_res γ Φ) ( x, {{ Φ x }} e {{ _, Ψ x }})
WP wait #l ;; e {{ _, barrier_res γ Ψ }}. WP wait #l ;; e {{ _, barrier_res γ Ψ }}.
Proof. Proof.
...@@ -64,15 +64,15 @@ Proof. ...@@ -64,15 +64,15 @@ Proof.
iExists x; iFrame "Hγ". iApply Ψ_join; by iSplitL "Hx". iExists x; iFrame "Hγ". iApply Ψ_join; by iSplitL "Hx".
Qed. Qed.
Lemma client_spec_new (eM eW1 eW2 : expr []) (eM' eW1' eW2' : expr ("b" :b: [])) : Lemma client_spec_new eM eW1 eW2 `{!Closed [] eM, !Closed [] eW1, !Closed [] eW2} :
heapN N eM' = wexpr' eM eW1' = wexpr' eW1 eW2' = wexpr' eW2 heapN N
heap_ctx heapN P heap_ctx heapN P
{{ P }} eM {{ _, x, Φ x }} {{ P }} eM {{ _, x, Φ x }}
( x, {{ Φ1 x }} eW1 {{ _, Ψ1 x }}) ( x, {{ Φ1 x }} eW1 {{ _, Ψ1 x }})
( x, {{ Φ2 x }} eW2 {{ _, Ψ2 x }}) ( x, {{ Φ2 x }} eW2 {{ _, Ψ2 x }})
WP client eM' eW1' eW2' {{ _, γ, barrier_res γ Ψ }}. WP client eM eW1 eW2 {{ _, γ, barrier_res γ Ψ }}.
Proof. Proof.
iIntros (HN -> -> ->) "/= (#Hh&HP&#He&#He1&#He2)"; rewrite /client. iIntros (HN) "/= (#Hh&HP&#He&#He1&#He2)"; rewrite /client.
iPvs (own_alloc (Cinl (Excl ()))) as (γ) "Hγ". done. iPvs (own_alloc (Cinl (Excl ()))) as (γ) "Hγ". done.
wp_apply (newbarrier_spec heapN N (barrier_res γ Φ)); auto. wp_apply (newbarrier_spec heapN N (barrier_res γ Φ)); auto.
iFrame "Hh". iIntros (l) "[Hr Hs]". iFrame "Hh". iIntros (l) "[Hr Hs]".
......
...@@ -7,15 +7,15 @@ Import uPred. ...@@ -7,15 +7,15 @@ Import uPred.
Definition one_shot_example : val := λ: <>, Definition one_shot_example : val := λ: <>,
let: "x" := ref (InjL #0) in ( let: "x" := ref (InjL #0) in (
(* tryset *) (λ: "n", (* tryset *) (λ: "n",
CAS '"x" (InjL #0) (InjR '"n")), CAS "x" (InjL #0) (InjR "n")),
(* check *) (λ: <>, (* check *) (λ: <>,
let: "y" := !'"x" in λ: <>, let: "y" := !"x" in λ: <>,
match: '"y" with match: "y" with
InjL <> => #() InjL <> => #()
| InjR "n" => | InjR "n" =>
match: !'"x" with match: !"x" with
InjL <> => Assert #false InjL <> => Assert #false
| InjR "m" => Assert ('"n" = '"m") | InjR "m" => Assert ("n" = "m")
end end
end)). end)).
Global Opaque one_shot_example. Global Opaque one_shot_example.
......
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