Commit 15bfdc15 authored by Robbert Krebbers's avatar Robbert Krebbers

Redefine big ops to get more definitional equalities.

parent a378b828
coq-stdpp https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp 0ac2b4db07bdc471421c5a4c47789087b3df074c coq-stdpp https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp a0ce0937cfabe16a184af2d92c0466ebacecbca2
This diff is collapsed.
...@@ -23,15 +23,15 @@ Module ra_reflection. Section ra_reflection. ...@@ -23,15 +23,15 @@ Module ra_reflection. Section ra_reflection.
| EOp e1 e2 => flatten e1 ++ flatten e2 | EOp e1 e2 => flatten e1 ++ flatten e2
end. end.
Lemma eval_flatten Σ e : Lemma eval_flatten Σ e :
eval Σ e big_op ((λ n, from_option id (Σ !! n)) <$> flatten e). eval Σ e [ list] n flatten e, from_option id (Σ !! n).
Proof. Proof.
induction e as [| |e1 IH1 e2 IH2]; rewrite /= ?right_id //. induction e as [| |e1 IH1 e2 IH2]; rewrite /= ?right_id //.
by rewrite fmap_app IH1 IH2 big_op_app. by rewrite IH1 IH2 big_opL_app.
Qed. Qed.
Lemma flatten_correct Σ e1 e2 : Lemma flatten_correct Σ e1 e2 :
flatten e1 + flatten e2 eval Σ e1 eval Σ e2. flatten e1 + flatten e2 eval Σ e1 eval Σ e2.
Proof. Proof.
by intros He; rewrite !eval_flatten; apply big_op_submseteq; rewrite ->He. by intros He; rewrite !eval_flatten; apply big_opL_submseteq; rewrite ->He.
Qed. Qed.
Class Quote (Σ1 Σ2 : list A) (l : A) (e : expr) := {}. Class Quote (Σ1 Σ2 : list A) (l : A) (e : expr) := {}.
......
This diff is collapsed.
...@@ -23,17 +23,16 @@ Module uPred_reflection. Section uPred_reflection. ...@@ -23,17 +23,16 @@ Module uPred_reflection. Section uPred_reflection.
| ESep e1 e2 => flatten e1 ++ flatten e2 | ESep e1 e2 => flatten e1 ++ flatten e2
end. end.
Notation eval_list Σ l := ([] ((λ n, from_option id True%I (Σ !! n)) <$> l))%I. Notation eval_list Σ l := ([ list] n l, from_option id True (Σ !! n))%I.
Lemma eval_flatten Σ e : eval Σ e eval_list Σ (flatten e). Lemma eval_flatten Σ e : eval Σ e eval_list Σ (flatten e).
Proof. Proof.
induction e as [| |e1 IH1 e2 IH2]; induction e as [| |e1 IH1 e2 IH2];
rewrite /= ?right_id ?fmap_app ?big_sep_app ?IH1 ?IH2 //. rewrite /= ?right_id ?big_sepL_app ?IH1 ?IH2 //.
Qed. Qed.
Lemma flatten_entails Σ e1 e2 : Lemma flatten_entails Σ e1 e2 :
flatten e2 + flatten e1 eval Σ e1 eval Σ e2. flatten e2 + flatten e1 eval Σ e1 eval Σ e2.
Proof. Proof. intros. rewrite !eval_flatten. by apply big_sepL_submseteq. Qed.
intros. rewrite !eval_flatten. by apply big_sep_submseteq, fmap_submseteq.
Qed.
Lemma flatten_equiv Σ e1 e2 : Lemma flatten_equiv Σ e1 e2 :
flatten e2 flatten e1 eval Σ e1 eval Σ e2. flatten e2 flatten e1 eval Σ e1 eval Σ e2.
Proof. intros He. by rewrite !eval_flatten He. Qed. Proof. intros He. by rewrite !eval_flatten He. Qed.
...@@ -90,7 +89,7 @@ Module uPred_reflection. Section uPred_reflection. ...@@ -90,7 +89,7 @@ Module uPred_reflection. Section uPred_reflection.
Proof. Proof.
intros ??. rewrite !eval_flatten. intros ??. rewrite !eval_flatten.
rewrite (flatten_cancel e1 e1' ns) // (flatten_cancel e2 e2' ns) //; csimpl. rewrite (flatten_cancel e1 e1' ns) // (flatten_cancel e2 e2' ns) //; csimpl.
rewrite !fmap_app !big_sep_app. apply sep_mono_r. rewrite !big_sepL_app. apply sep_mono_r.
Qed. Qed.
Fixpoint to_expr (l : list nat) : expr := Fixpoint to_expr (l : list nat) : expr :=
...@@ -110,7 +109,7 @@ Module uPred_reflection. Section uPred_reflection. ...@@ -110,7 +109,7 @@ Module uPred_reflection. Section uPred_reflection.
cancel ns e = Some e' eval Σ e (eval Σ (to_expr ns) eval Σ e'). cancel ns e = Some e' eval Σ e (eval Σ (to_expr ns) eval Σ e').
Proof. Proof.
intros He%flatten_cancel. intros He%flatten_cancel.
by rewrite eval_flatten He fmap_app big_sep_app eval_to_expr eval_flatten. by rewrite eval_flatten He big_sepL_app eval_to_expr eval_flatten.
Qed. Qed.
Lemma split_r Σ e ns e' : Lemma split_r Σ e ns e' :
cancel ns e = Some e' eval Σ e (eval Σ e' eval Σ (to_expr ns)). cancel ns e = Some e' eval Σ e (eval Σ e' eval Σ (to_expr ns)).
......
...@@ -76,7 +76,7 @@ Lemma wp_fork E e Φ : ...@@ -76,7 +76,7 @@ Lemma wp_fork E e Φ :
Φ (LitV LitUnit) WP e {{ _, True }} WP Fork e @ E {{ Φ }}. Φ (LitV LitUnit) WP e {{ _, True }} WP Fork e @ E {{ Φ }}.
Proof. Proof.
rewrite -(wp_lift_pure_det_head_step (Fork e) (Lit LitUnit) [e]) //=; eauto. rewrite -(wp_lift_pure_det_head_step (Fork e) (Lit LitUnit) [e]) //=; eauto.
- by rewrite -step_fupd_intro // later_sep -(wp_value _ _ (Lit _)) // big_sepL_singleton. - by rewrite -step_fupd_intro // later_sep -(wp_value _ _ (Lit _)) // right_id.
- intros; inv_head_step; eauto. - intros; inv_head_step; eauto.
Qed. Qed.
......
...@@ -354,7 +354,7 @@ Proof. intros. by rewrite /FromAnd big_opL_cons always_and_sep_l. Qed. ...@@ -354,7 +354,7 @@ Proof. intros. by rewrite /FromAnd big_opL_cons always_and_sep_l. Qed.
Global Instance from_and_big_sepL_app {A} (Φ : nat A uPred M) l1 l2 : Global Instance from_and_big_sepL_app {A} (Φ : nat A uPred M) l1 l2 :
FromAnd false ([ list] k y l1 ++ l2, Φ k y) FromAnd false ([ list] k y l1 ++ l2, Φ k y)
([ list] k y l1, Φ k y) ([ list] k y l2, Φ (length l1 + k) y). ([ list] k y l1, Φ k y) ([ list] k y l2, Φ (length l1 + k) y).
Proof. by rewrite /FromAnd big_sepL_app. Qed. Proof. by rewrite /FromAnd big_opL_app. Qed.
Global Instance from_sep_big_sepL_app_persistent {A} (Φ : nat A uPred M) l1 l2 : Global Instance from_sep_big_sepL_app_persistent {A} (Φ : nat A uPred M) l1 l2 :
( k y, PersistentP (Φ k y)) ( k y, PersistentP (Φ k y))
FromAnd true ([ list] k y l1 ++ l2, Φ k y) FromAnd true ([ list] k y l1 ++ l2, Φ k y)
......
...@@ -234,14 +234,14 @@ Proof. ...@@ -234,14 +234,14 @@ Proof.
intros j. apply (env_app_disjoint _ _ _ j) in Happ. intros j. apply (env_app_disjoint _ _ _ j) in Happ.
naive_solver eauto using env_app_fresh. naive_solver eauto using env_app_fresh.
+ rewrite (env_app_perm _ _ Γp') //. + rewrite (env_app_perm _ _ Γp') //.
rewrite big_sep_app always_sep. solve_sep_entails. rewrite big_sepL_app always_sep. solve_sep_entails.
- destruct (env_app Γ Γp) eqn:Happ, - destruct (env_app Γ Γp) eqn:Happ,
(env_app Γ Γs) as [Γs'|] eqn:?; simplify_eq/=. (env_app Γ Γs) as [Γs'|] eqn:?; simplify_eq/=.
apply wand_intro_l, sep_intro_True_l; [apply pure_intro|]. apply wand_intro_l, sep_intro_True_l; [apply pure_intro|].
+ destruct Hwf; constructor; simpl; eauto using env_app_wf. + destruct Hwf; constructor; simpl; eauto using env_app_wf.
intros j. apply (env_app_disjoint _ _ _ j) in Happ. intros j. apply (env_app_disjoint _ _ _ j) in Happ.
naive_solver eauto using env_app_fresh. naive_solver eauto using env_app_fresh.
+ rewrite (env_app_perm _ _ Γs') // big_sep_app. solve_sep_entails. + rewrite (env_app_perm _ _ Γs') // big_sepL_app. solve_sep_entails.
Qed. Qed.
Lemma envs_simple_replace_sound' Δ Δ' i p Γ : Lemma envs_simple_replace_sound' Δ Δ' i p Γ :
...@@ -257,14 +257,14 @@ Proof. ...@@ -257,14 +257,14 @@ Proof.
intros j. apply (env_app_disjoint _ _ _ j) in Happ. intros j. apply (env_app_disjoint _ _ _ j) in Happ.
destruct (decide (i = j)); try naive_solver eauto using env_replace_fresh. destruct (decide (i = j)); try naive_solver eauto using env_replace_fresh.
+ rewrite (env_replace_perm _ _ Γp') //. + rewrite (env_replace_perm _ _ Γp') //.
rewrite big_sep_app always_sep. solve_sep_entails. rewrite big_sepL_app always_sep. solve_sep_entails.
- destruct (env_app Γ Γp) eqn:Happ, - destruct (env_app Γ Γp) eqn:Happ,
(env_replace i Γ Γs) as [Γs'|] eqn:?; simplify_eq/=. (env_replace i Γ Γs) as [Γs'|] eqn:?; simplify_eq/=.
apply wand_intro_l, sep_intro_True_l; [apply pure_intro|]. apply wand_intro_l, sep_intro_True_l; [apply pure_intro|].
+ destruct Hwf; constructor; simpl; eauto using env_replace_wf. + destruct Hwf; constructor; simpl; eauto using env_replace_wf.
intros j. apply (env_app_disjoint _ _ _ j) in Happ. intros j. apply (env_app_disjoint _ _ _ j) in Happ.
destruct (decide (i = j)); try naive_solver eauto using env_replace_fresh. destruct (decide (i = j)); try naive_solver eauto using env_replace_fresh.
+ rewrite (env_replace_perm _ _ Γs') // big_sep_app. solve_sep_entails. + rewrite (env_replace_perm _ _ Γs') // big_sepL_app. solve_sep_entails.
Qed. Qed.
Lemma envs_simple_replace_sound Δ Δ' i p P Γ : Lemma envs_simple_replace_sound Δ Δ' i p P Γ :
......
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