Commit 85498a9a authored by Dan Frumin's avatar Dan Frumin Committed by Robbert Krebbers
Browse files

Move out some PureExec assumptions into typeclasses

parent 43eeb0a9
From iris.program_logic Require Export ectx_language ectxi_language. From iris.program_logic Require Export language ectx_language ectxi_language.
From iris.algebra Require Export ofe. From iris.algebra Require Export ofe.
From stdpp Require Export strings. From stdpp Require Export strings.
From stdpp Require Import gmap. From stdpp Require Import gmap.
...@@ -109,6 +109,14 @@ Fixpoint to_val (e : expr) : option val := ...@@ -109,6 +109,14 @@ Fixpoint to_val (e : expr) : option val :=
| _ => None | _ => None
end. end.
Class AsRec (e : expr) (f x : binder) (erec : expr) :=
as_rec : e = Rec f x erec.
Instance AsRec_rec f x e : AsRec (Rec f x e) f x e := eq_refl.
Instance AsRec_rec_locked_val v f x e :
AsRec (of_val v) f x e AsRec (of_val (locked v)) f x e.
Proof. by unlock. Qed.
(** The state: heaps of vals. *) (** The state: heaps of vals. *)
Definition state := gmap loc val. Definition state := gmap loc val.
...@@ -411,6 +419,9 @@ Proof. intros. by apply is_closed_weaken with [], list_subseteq_nil. Qed. ...@@ -411,6 +419,9 @@ Proof. intros. by apply is_closed_weaken with [], list_subseteq_nil. Qed.
Lemma is_closed_of_val X v : is_closed X (of_val v). Lemma is_closed_of_val X v : is_closed X (of_val v).
Proof. apply is_closed_weaken_nil. induction v; simpl; auto. Qed. Proof. apply is_closed_weaken_nil. induction v; simpl; auto. Qed.
Lemma is_closed_to_val X e v : to_val e = Some v is_closed X e.
Proof. intros Hev; rewrite -(of_to_val e v Hev); apply is_closed_of_val. Qed.
Lemma is_closed_subst X e x es : Lemma is_closed_subst X e x es :
is_closed [] es is_closed (x :: X) e is_closed X (subst x es e). is_closed [] es is_closed (x :: X) e is_closed X (subst x es e).
Proof. Proof.
......
...@@ -83,25 +83,24 @@ Qed. ...@@ -83,25 +83,24 @@ Qed.
Local Ltac solve_exec_safe := intros; subst; do 3 eexists; econstructor; eauto. Local Ltac solve_exec_safe := intros; subst; do 3 eexists; econstructor; eauto.
Local Ltac solve_exec_puredet := simpl; intros; by inv_head_step. Local Ltac solve_exec_puredet := simpl; intros; by inv_head_step.
Local Ltac solve_pureexec := Local Ltac solve_pureexec :=
repeat lazymatch goal with
| H: IntoVal ?e _ |- _ => rewrite -(of_to_val e _ into_val); clear H
| H: AsRec _ _ _ _ |- _ => rewrite H; clear H
end;
apply hoist_pred_pureexec; intros; destruct_and?; apply hoist_pred_pureexec; intros; destruct_and?;
apply det_head_step_pureexec; [ solve_exec_safe | solve_exec_puredet ]. apply det_head_step_pureexec; [ solve_exec_safe | solve_exec_puredet ].
Global Instance pure_rec f x erec e1 e2 v2 : Global Instance pure_rec f x (erec e1 e2 : expr) (v2 : val)
PureExec (to_val e2 = Some v2 e1 = Rec f x erec Closed (f :b: x :b: []) erec) `{!IntoVal e2 v2, AsRec e1 f x erec, Closed (f :b: x :b: []) erec} :
(App e1 e2) PureExec True (App e1 e2) (subst' x e2 (subst' f e1 erec)).
(subst' x e2 (subst' f e1 erec)).
Proof. solve_pureexec. Qed. Proof. solve_pureexec. Qed.
Global Instance pure_unop op e v v' : Global Instance pure_unop op e v v' `{!IntoVal e v} :
PureExec (to_val e = Some v un_op_eval op v = Some v') PureExec (un_op_eval op v = Some v') (UnOp op e) (of_val v').
(UnOp op e)
(of_val v').
Proof. solve_pureexec. Qed. Proof. solve_pureexec. Qed.
Global Instance pure_binop op e1 e2 v1 v2 v' : Global Instance pure_binop op e1 e2 v1 v2 v' `{!IntoVal e1 v1, !IntoVal e2 v2} :
PureExec (to_val e1 = Some v1 to_val e2 = Some v2 bin_op_eval op v1 v2 = Some v') PureExec (bin_op_eval op v1 v2 = Some v') (BinOp op e1 e2) (of_val v').
(BinOp op e1 e2)
(of_val v').
Proof. solve_pureexec. Qed. Proof. solve_pureexec. Qed.
Global Instance pure_if_true e1 e2 : Global Instance pure_if_true e1 e2 :
...@@ -112,24 +111,20 @@ Global Instance pure_if_false e1 e2 : ...@@ -112,24 +111,20 @@ Global Instance pure_if_false e1 e2 :
PureExec True (If (Lit (LitBool false)) e1 e2) e2. PureExec True (If (Lit (LitBool false)) e1 e2) e2.
Proof. solve_pureexec. Qed. Proof. solve_pureexec. Qed.
Global Instance pure_fst e1 e2 v1 v2 : Global Instance pure_fst e1 e2 v1 v2 `{!IntoVal e1 v1, !IntoVal e2 v2} :
PureExec (to_val e1 = Some v1 to_val e2 = Some v2) PureExec True (Fst (Pair e1 e2)) e1.
(Fst (Pair e1 e2))
e1.
Proof. solve_pureexec. Qed. Proof. solve_pureexec. Qed.
Global Instance pure_snd e1 e2 v1 v2 : Global Instance pure_snd e1 e2 v1 v2 `{!IntoVal e1 v1, !IntoVal e2 v2} :
PureExec (to_val e1 = Some v1 to_val e2 = Some v2) PureExec True (Snd (Pair e1 e2)) e2.
(Snd (Pair e1 e2))
e2.
Proof. solve_pureexec. Qed. Proof. solve_pureexec. Qed.
Global Instance pure_case_inl e0 v e1 e2 : Global Instance pure_case_inl e0 v e1 e2 `{!IntoVal e0 v} :
PureExec (to_val e0 = Some v) (Case (InjL e0) e1 e2) (App e1 e0). PureExec True (Case (InjL e0) e1 e2) (App e1 e0).
Proof. solve_pureexec. Qed. Proof. solve_pureexec. Qed.
Global Instance pure_case_inr e0 v e1 e2 : Global Instance pure_case_inr e0 v e1 e2 `{!IntoVal e0 v} :
PureExec (to_val e0 = Some v) (Case (InjR e0) e1 e2) (App e2 e0). PureExec True (Case (InjR e0) e1 e2) (App e2 e0).
Proof. solve_pureexec. Qed. Proof. solve_pureexec. Qed.
(** Heap *) (** Heap *)
...@@ -209,5 +204,4 @@ Lemma wp_match_inr E e0 x1 e1 x2 e2 Φ : ...@@ -209,5 +204,4 @@ Lemma wp_match_inr E e0 x1 e1 x2 e2 Φ :
is_Some (to_val e0) Closed (x2 :b: []) e2 is_Some (to_val e0) 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. iIntros ([? ?] ?) "?". rewrite -!wp_pure_step_later; by eauto. Qed. Proof. iIntros ([? ?] ?) "?". rewrite -!wp_pure_step_later; by eauto. Qed.
End lifting. End lifting.
...@@ -24,20 +24,9 @@ Ltac wp_done := ...@@ -24,20 +24,9 @@ Ltac wp_done :=
Ltac wp_value_head := etrans; [|eapply wp_value; wp_done]; simpl. Ltac wp_value_head := etrans; [|eapply wp_value; wp_done]; simpl.
Lemma of_val_unlock v e : of_val v = e of_val (locked v) = e.
Proof. by unlock. Qed.
(* Applied to goals that are equalities of expressions. Will try to unlock the
LHS once if necessary, to get rid of the lock added by the syntactic sugar. *)
Ltac solve_of_val_unlock := try apply of_val_unlock; reflexivity.
(* Solves side-conditions generated specifically by wp_pure *) (* Solves side-conditions generated specifically by wp_pure *)
Ltac wp_pure_done := Ltac wp_pure_done :=
split_and?; split_and?; wp_done.
lazymatch goal with
| |- of_val _ = _ => solve_of_val_unlock
| _ => wp_done
end.
Lemma tac_wp_pure `{heapG Σ} K Δ Δ' E e1 e2 φ Φ : Lemma tac_wp_pure `{heapG Σ} K Δ Δ' E e1 e2 φ Φ :
PureExec φ e1 e2 PureExec φ e1 e2
......
...@@ -105,4 +105,8 @@ Section language. ...@@ -105,4 +105,8 @@ Section language.
(P PureExec True e1 e2) (P PureExec True e1 e2)
PureExec P e1 e2. PureExec P e1 e2.
Proof. intros HPE. split; intros; eapply HPE; eauto. Qed. Proof. intros HPE. split; intros; eapply HPE; eauto. Qed.
(* This is a family of frequent assumptions for PureExec *)
Class IntoVal (e : expr Λ) (v : val Λ) :=
into_val : to_val e = Some v.
End language. End language.
Supports Markdown
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