Commit 365fca38 authored by Robbert's avatar Robbert

Merge branch 'ci/robbert/simpl_local' into 'master'

Use `simpl` in `wp_` tactics just in the expression

Closes #113

See merge request FP/iris-coq!94
parents e9f14405 11e0f153
Pipeline #5684 passed with stages
in 6 minutes and 25 seconds
...@@ -5,6 +5,18 @@ From iris.heap_lang Require Export tactics lifting. ...@@ -5,6 +5,18 @@ From iris.heap_lang Require Export tactics lifting.
Set Default Proof Using "Type". Set Default Proof Using "Type".
Import uPred. Import uPred.
Lemma tac_wp_expr_eval `{heapG Σ} Δ E Φ e e' :
e = e'
envs_entails Δ (WP e' @ E {{ Φ }}) envs_entails Δ (WP e @ E {{ Φ }}).
Proof. by intros ->. Qed.
Ltac wp_expr_eval t :=
try iStartProof;
try (eapply tac_wp_expr_eval; [t; reflexivity|]).
Ltac wp_expr_simpl := wp_expr_eval simpl.
Ltac wp_expr_simpl_subst := wp_expr_eval simpl_subst.
Lemma tac_wp_pure `{heapG Σ} Δ Δ' E e1 e2 φ Φ : Lemma tac_wp_pure `{heapG Σ} Δ Δ' E e1 e2 φ Φ :
PureExec φ e1 e2 PureExec φ e1 e2
φ φ
...@@ -34,7 +46,7 @@ Tactic Notation "wp_pure" open_constr(efoc) := ...@@ -34,7 +46,7 @@ Tactic Notation "wp_pure" open_constr(efoc) :=
[apply _ (* PureExec *) [apply _ (* PureExec *)
|try fast_done (* The pure condition for PureExec *) |try fast_done (* The pure condition for PureExec *)
|apply _ (* IntoLaters *) |apply _ (* IntoLaters *)
|simpl_subst; try wp_value_head (* new goal *) |wp_expr_simpl_subst; try wp_value_head (* new goal *)
]) ])
|| fail "wp_pure: cannot find" efoc "in" e "or" efoc "is not a reduct" || fail "wp_pure: cannot find" efoc "in" e "or" efoc "is not a reduct"
| _ => fail "wp_pure: not a 'wp'" | _ => fail "wp_pure: not a 'wp'"
...@@ -54,15 +66,16 @@ Tactic Notation "wp_proj" := wp_pure (Fst _) || wp_pure (Snd _). ...@@ -54,15 +66,16 @@ Tactic Notation "wp_proj" := wp_pure (Fst _) || wp_pure (Snd _).
Tactic Notation "wp_case" := wp_pure (Case _ _ _). Tactic Notation "wp_case" := wp_pure (Case _ _ _).
Tactic Notation "wp_match" := wp_case; wp_let. Tactic Notation "wp_match" := wp_case; wp_let.
Lemma tac_wp_bind `{heapG Σ} K Δ E Φ e : Lemma tac_wp_bind `{heapG Σ} K Δ E Φ e f :
envs_entails Δ (WP e @ E {{ v, WP fill K (of_val v) @ E {{ Φ }} }})%I f = (λ e, fill K e) (* as an eta expanded hypothesis so that we can `simpl` it *)
envs_entails Δ (WP e @ E {{ v, WP f (of_val v) @ E {{ Φ }} }})%I
envs_entails Δ (WP fill K e @ E {{ Φ }}). envs_entails Δ (WP fill K e @ E {{ Φ }}).
Proof. rewrite /envs_entails=> ->. by apply: wp_bind. Qed. Proof. rewrite /envs_entails=> -> ->. by apply: wp_bind. Qed.
Ltac wp_bind_core K := Ltac wp_bind_core K :=
lazymatch eval hnf in K with lazymatch eval hnf in K with
| [] => idtac | [] => idtac
| _ => apply (tac_wp_bind K); simpl | _ => eapply (tac_wp_bind K); [simpl; reflexivity|lazy beta]
end. end.
Tactic Notation "wp_bind" open_constr(efoc) := Tactic Notation "wp_bind" open_constr(efoc) :=
...@@ -155,7 +168,7 @@ Tactic Notation "wp_apply" open_constr(lem) := ...@@ -155,7 +168,7 @@ Tactic Notation "wp_apply" open_constr(lem) :=
lazymatch goal with lazymatch goal with
| |- envs_entails _ (wp ?E ?e ?Q) => | |- envs_entails _ (wp ?E ?e ?Q) =>
reshape_expr e ltac:(fun K e' => reshape_expr e ltac:(fun K e' =>
wp_bind_core K; iApplyHyp H; try iNext; simpl) || wp_bind_core K; iApplyHyp H; try iNext; wp_expr_simpl) ||
lazymatch iTypeOf H with lazymatch iTypeOf H with
| Some (_,?P) => fail "wp_apply: cannot apply" P | Some (_,?P) => fail "wp_apply: cannot apply" P
end end
...@@ -174,7 +187,7 @@ Tactic Notation "wp_alloc" ident(l) "as" constr(H) := ...@@ -174,7 +187,7 @@ Tactic Notation "wp_alloc" ident(l) "as" constr(H) :=
|first [intros l | fail 1 "wp_alloc:" l "not fresh"]; |first [intros l | fail 1 "wp_alloc:" l "not fresh"];
eexists; split; eexists; split;
[env_cbv; reflexivity || fail "wp_alloc:" H "not fresh" [env_cbv; reflexivity || fail "wp_alloc:" H "not fresh"
|simpl; try wp_value_head]] |wp_expr_simpl; try wp_value_head]]
| _ => fail "wp_alloc: not a 'wp'" | _ => fail "wp_alloc: not a 'wp'"
end. end.
...@@ -191,7 +204,7 @@ Tactic Notation "wp_load" := ...@@ -191,7 +204,7 @@ Tactic Notation "wp_load" :=
[apply _ [apply _
|let l := match goal with |- _ = Some (_, (?l {_} _)%I) => l end in |let l := match goal with |- _ = Some (_, (?l {_} _)%I) => l end in
iAssumptionCore || fail "wp_load: cannot find" l "↦ ?" iAssumptionCore || fail "wp_load: cannot find" l "↦ ?"
|simpl; try wp_value_head] |wp_expr_simpl; try wp_value_head]
| _ => fail "wp_load: not a 'wp'" | _ => fail "wp_load: not a 'wp'"
end. end.
...@@ -207,7 +220,7 @@ Tactic Notation "wp_store" := ...@@ -207,7 +220,7 @@ Tactic Notation "wp_store" :=
|let l := match goal with |- _ = Some (_, (?l {_} _)%I) => l end in |let l := match goal with |- _ = Some (_, (?l {_} _)%I) => l end in
iAssumptionCore || fail "wp_store: cannot find" l "↦ ?" iAssumptionCore || fail "wp_store: cannot find" l "↦ ?"
|env_cbv; reflexivity |env_cbv; reflexivity
|simpl; try first [wp_pure (Seq (Lit LitUnit) _)|wp_value_head]] |wp_expr_simpl; try first [wp_pure (Seq (Lit LitUnit) _)|wp_value_head]]
| _ => fail "wp_store: not a 'wp'" | _ => fail "wp_store: not a 'wp'"
end. end.
...@@ -223,7 +236,7 @@ Tactic Notation "wp_cas_fail" := ...@@ -223,7 +236,7 @@ Tactic Notation "wp_cas_fail" :=
|let l := match goal with |- _ = Some (_, (?l {_} _)%I) => l end in |let l := match goal with |- _ = Some (_, (?l {_} _)%I) => l end in
iAssumptionCore || fail "wp_cas_fail: cannot find" l "↦ ?" iAssumptionCore || fail "wp_cas_fail: cannot find" l "↦ ?"
|try congruence |try congruence
|simpl; try wp_value_head] |wp_expr_simpl; try wp_value_head]
| _ => fail "wp_cas_fail: not a 'wp'" | _ => fail "wp_cas_fail: not a 'wp'"
end. end.
...@@ -240,6 +253,6 @@ Tactic Notation "wp_cas_suc" := ...@@ -240,6 +253,6 @@ Tactic Notation "wp_cas_suc" :=
iAssumptionCore || fail "wp_cas_suc: cannot find" l "↦ ?" iAssumptionCore || fail "wp_cas_suc: cannot find" l "↦ ?"
|try congruence |try congruence
|env_cbv; reflexivity |env_cbv; reflexivity
|simpl; try wp_value_head] |wp_expr_simpl; try wp_value_head]
| _ => fail "wp_cas_suc: not a 'wp'" | _ => fail "wp_cas_suc: not a 'wp'"
end. end.
...@@ -10,6 +10,16 @@ Section LiftingTests. ...@@ -10,6 +10,16 @@ Section LiftingTests.
Implicit Types P Q : iProp Σ. Implicit Types P Q : iProp Σ.
Implicit Types Φ : val iProp Σ. Implicit Types Φ : val iProp Σ.
Definition simpl_test :
(10 = 4 + 6)%nat -
WP let: "x" := ref #1 in "x" <- !"x";; !"x" {{ v, v = #1 }}.
Proof.
iIntros "?". wp_alloc l. repeat (wp_pure _) || wp_load || wp_store.
match goal with
| |- context [ (10 = 4 + 6)%nat ] => done
end.
Qed.
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".
......
...@@ -40,7 +40,7 @@ Lemma sum_loop_wp `{!heapG Σ} v t l (n : Z) : ...@@ -40,7 +40,7 @@ Lemma sum_loop_wp `{!heapG Σ} v t l (n : Z) :
{{{ RET #(); l #(sum t + n) is_tree v t }}}. {{{ RET #(); l #(sum t + n) is_tree v t }}}.
Proof. Proof.
iIntros (Φ) "[Hl Ht] HΦ". iIntros (Φ) "[Hl Ht] HΦ".
iInduction t as [n'|tl ? tr] "IH" forall (v l n Φ); wp_rec; wp_let. iInduction t as [n'|tl ? tr] "IH" forall (v l n Φ); simpl; wp_rec; wp_let.
- iDestruct "Ht" as "%"; subst. - iDestruct "Ht" as "%"; subst.
wp_match. wp_load. wp_op. wp_store. wp_match. wp_load. wp_op. wp_store.
by iApply ("HΦ" with "[$Hl]"). by iApply ("HΦ" with "[$Hl]").
......
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