Commit 162c2f80 authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Expressions as dependent type.

parent c1f41d83
From heap_lang Require Export substitution notation. From 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".
Instance newbarrier_closed : Closed newbarrier. Proof. solve_closed. Qed.
Instance signal_closed : Closed signal. Proof. solve_closed. Qed.
Instance wait_closed : Closed wait. Proof. solve_closed. Qed.
...@@ -3,12 +3,12 @@ From program_logic Require Import auth sts saved_prop hoare ownership. ...@@ -3,12 +3,12 @@ From program_logic Require Import auth sts saved_prop hoare ownership.
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
Fork (Fork (worker 12 "b" "y") ;; worker 17 "b" "y") ;; Fork (Fork (^(worker 12) '"b" '"y") ;; ^(worker 17) '"b" '"y") ;;
"y" <- (λ: "z", "z" + #42) ;; signal "b". '"y" <- (λ: "z", '"z" + #42) ;; ^signal '"b".
Section client. Section client.
Context {Σ : rFunctorG} `{!heapG Σ, !barrierG Σ} (heapN N : namespace). Context {Σ : rFunctorG} `{!heapG Σ, !barrierG Σ} (heapN N : namespace).
...@@ -16,7 +16,7 @@ Section client. ...@@ -16,7 +16,7 @@ Section client.
Definition y_inv q y : iProp := Definition y_inv q y : iProp :=
( f : val, y {q} f n : Z, || f #n {{ λ v, v = #(n + 42) }})%I. ( f : val, y {q} f n : Z, || f #n {{ λ v, v = #(n + 42) }})%I.
Lemma y_inv_split q y : Lemma y_inv_split q y :
y_inv q y (y_inv (q/2) y y_inv (q/2) y). y_inv q y (y_inv (q/2) y y_inv (q/2) y).
Proof. Proof.
...@@ -56,7 +56,7 @@ Section client. ...@@ -56,7 +56,7 @@ Section client.
wp_seq. (ewp eapply wp_store); eauto with I. strip_later. wp_seq. (ewp eapply wp_store); eauto with I. strip_later.
rewrite assoc [(_ y _)%I]comm. apply sep_mono_r, wand_intro_l. rewrite assoc [(_ y _)%I]comm. apply sep_mono_r, wand_intro_l.
wp_seq. rewrite -signal_spec right_id assoc sep_elim_l comm. wp_seq. rewrite -signal_spec right_id assoc sep_elim_l comm.
apply sep_mono_r. rewrite /y_inv -(exist_intro (λ: "z", "z" + #42)%V). apply sep_mono_r. rewrite /y_inv -(exist_intro (λ: "z", '"z" + #42)%V).
apply sep_intro_True_r; first done. apply: always_intro. apply sep_intro_True_r; first done. apply: always_intro.
apply forall_intro=>n. wp_let. wp_op. by apply const_intro. } apply forall_intro=>n. wp_let. wp_op. by apply const_intro. }
(* The two spawned threads, the waiters. *) (* The two spawned threads, the waiters. *)
......
...@@ -19,12 +19,12 @@ Implicit Types Φ : val → iProp heap_lang Σ. ...@@ -19,12 +19,12 @@ 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
|| subst' ef x v @ E {{ Φ }} || App (Lam x ef) e @ E {{ Φ }}. || subst' x e ef @ E {{ Φ }} || App (Lam x ef) e @ E {{ Φ }}.
Proof. intros. by rewrite -wp_rec. Qed. Proof. intros. by rewrite -wp_rec. 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
|| subst' e2 x v @ E {{ Φ }} || Let x e1 e2 @ E {{ Φ }}. || subst' x e1 e2 @ E {{ Φ }} || 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 Φ :
...@@ -37,17 +37,13 @@ Proof. rewrite -wp_seq // -wp_value //. Qed. ...@@ -37,17 +37,13 @@ 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
|| subst' e1 x1 v0 @ E {{ Φ }} || Match (InjL e0) x1 e1 x2 e2 @ E {{ Φ }}. || subst' x1 e0 e1 @ E {{ Φ }} || Match (InjL e0) x1 e1 x2 e2 @ E {{ Φ }}.
Proof. Proof. intros. by rewrite -wp_case_inl // -[X in _ ⊑ X]later_intro -wp_let. Qed.
intros. rewrite -wp_case_inl // -[X in _ ⊑ X]later_intro. by apply 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
|| subst' e2 x2 v0 @ E {{ Φ }} || Match (InjR e0) x1 e1 x2 e2 @ E {{ Φ }}. || subst' x2 e0 e2 @ E {{ Φ }} || Match (InjR e0) x1 e1 x2 e2 @ E {{ Φ }}.
Proof. Proof. intros. by rewrite -wp_case_inr // -[X in _ ⊑ X]later_intro -wp_let. Qed.
intros. rewrite -wp_case_inr // -[X in _ ⊑ X]later_intro. by apply wp_let.
Qed.
Lemma wp_le E (n1 n2 : Z) P Φ : Lemma wp_le E (n1 n2 : Z) P Φ :
(n1 n2 P Φ (LitV (LitBool true))) (n1 n2 P Φ (LitV (LitBool true)))
......
This diff is collapsed.
...@@ -12,7 +12,7 @@ Context {Σ : rFunctor}. ...@@ -12,7 +12,7 @@ Context {Σ : rFunctor}.
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 K : ectx. Implicit Types K : ectx.
Implicit Types ef : option expr. Implicit Types ef : option (expr []).
(** Bind. *) (** Bind. *)
Lemma wp_bind {E e} K Φ : Lemma wp_bind {E e} K Φ :
...@@ -84,19 +84,19 @@ Qed. ...@@ -84,19 +84,19 @@ Qed.
Lemma wp_rec E f x e1 e2 v Φ : Lemma wp_rec E f x e1 e2 v Φ :
to_val e2 = Some v to_val e2 = Some v
|| subst' (subst' e1 f (RecV f x e1)) x v @ E {{ Φ }} || subst' x e2 (subst' f (Rec f x e1) e1) @ E {{ Φ }}
|| App (Rec f x e1) e2 @ E {{ Φ }}. || App (Rec f x e1) e2 @ E {{ Φ }}.
Proof. Proof.
intros. rewrite -(wp_lift_pure_det_step (App _ _) intros. rewrite -(wp_lift_pure_det_step (App _ _)
(subst' (subst' e1 f (RecV f x e1)) x v) None) ?right_id //=; (subst' x e2 (subst' f (Rec f x e1) e1)) None) //= ?right_id;
intros; inv_step; eauto. intros; inv_step; eauto.
Qed. Qed.
Lemma wp_rec' E f x erec v1 e2 v2 Φ : Lemma wp_rec' E f x erec e1 e2 v2 Φ :
v1 = RecV f x erec e1 = Rec f x erec
to_val e2 = Some v2 to_val e2 = Some v2
|| subst' (subst' erec f v1) x v2 @ E {{ Φ }} || subst' x e2 (subst' f e1 erec) @ E {{ Φ }}
|| App (of_val v1) e2 @ E {{ Φ }}. || App e1 e2 @ E {{ Φ }}.
Proof. intros ->. apply wp_rec. Qed. Proof. intros ->. apply wp_rec. Qed.
Lemma wp_un_op E op l l' Φ : Lemma wp_un_op E op l l' Φ :
......
...@@ -10,18 +10,22 @@ Notation "|| e {{ Φ } }" := (wp ⊤ e%E Φ) ...@@ -10,18 +10,22 @@ Notation "|| e {{ Φ } }" := (wp ⊤ e%E Φ)
Coercion LitInt : Z >-> base_lit. Coercion LitInt : Z >-> base_lit.
Coercion LitBool : bool >-> base_lit. Coercion LitBool : bool >-> base_lit.
(** No coercion from base_lit to expr. This makes is slightly easier to tell
apart language and Coq expressions. *)
Coercion Var : string >-> expr.
Coercion App : expr >-> Funclass. Coercion App : expr >-> Funclass.
Coercion of_val : val >-> expr. Coercion of_val : val >-> expr.
Coercion BNamed : string >-> binder. Coercion BNamed : string >-> binder.
Notation "<>" := BAnon : binder_scope. Notation "<>" := BAnon : binder_scope.
(* No scope, does not conflict and scope is often not inferred properly. *) (* No scope for the values, does not conflict and scope is often not inferred 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" := (LocV l) (at level 8, format "% l"). Notation "% l" := (LocV l) (at level 8, format "% l").
Notation "# l" := (LitV l%Z%V) (at level 8, format "# l") : val_scope.
Notation "% l" := (LocV l) (at level 8, format "% l") : val_scope.
Notation "# l" := (Lit l%Z%V) (at level 8, format "# l") : expr_scope.
Notation "% l" := (Loc l) (at level 8, format "% l") : expr_scope.
Notation "' x" := (Var x) (at level 8, format "' x") : expr_scope.
Notation "^ v" := (of_val' v%V) (at level 8, format "^ v") : expr_scope.
(** Syntax inspired by Coq/Ocaml. Constructions with higher precedence come (** Syntax inspired by Coq/Ocaml. Constructions with higher precedence come
first. *) first. *)
...@@ -56,10 +60,23 @@ Notation "'if:' e1 'then' e2 'else' e3" := (If e1%E e2%E e3%E) ...@@ -56,10 +60,23 @@ Notation "'if:' e1 'then' e2 'else' e3" := (If e1%E e2%E e3%E)
are stated explicitly instead of relying on the Notations Let and Seq as are stated explicitly instead of relying on the Notations Let and Seq as
defined above. This is needed because App is now a coercion, and these defined above. This is needed because App is now a coercion, and these
notations are otherwise not pretty printed back accordingly. *) notations are otherwise not pretty printed back accordingly. *)
Notation "λ: x , e" := (Lam x e%E) Notation "'rec:' f x y := e" := (Rec f x (Lam y e%E))
(at level 102, f, x, y at level 1, e at level 200) : expr_scope.
Notation "'rec:' f x y := e" := (RecV f x (Lam y e%E))
(at level 102, f, x, y at level 1, e at level 200) : val_scope.
Notation "'rec:' f x y .. z := e" := (Rec f x (Lam y .. (Lam z e%E) ..))
(at level 102, f, x, y, z at level 1, e at level 200) : expr_scope.
Notation "'rec:' f x y .. z := e" := (RecV f x (Lam y .. (Lam z e%E) ..))
(at level 102, f, x, y, z at level 1, e at level 200) : val_scope.
Notation "λ: x , e" := (Lam x e%E)
(at level 102, x at level 1, e at level 200) : expr_scope. (at level 102, x at level 1, e at level 200) : expr_scope.
Notation "λ: x y .. z , e" := (Lam x (Lam y .. (Lam z e%E) ..))
(at level 102, x, y, z at level 1, e at level 200) : expr_scope.
Notation "λ: x , e" := (LamV x e%E) Notation "λ: x , e" := (LamV x e%E)
(at level 102, x at level 1, e at level 200) : val_scope. (at level 102, x at level 1, e at level 200) : val_scope.
Notation "λ: x y .. z , e" := (LamV x (Lam y .. (Lam z e%E) .. ))
(at level 102, x, y, z at level 1, e at level 200) : val_scope.
Notation "'let:' x := e1 'in' e2" := (Lam x e2%E e1%E) Notation "'let:' x := e1 'in' e2" := (Lam x e2%E e1%E)
(at level 102, x at level 1, e1, e2 at level 200) : expr_scope. (at level 102, x at level 1, e1, e2 at level 200) : expr_scope.
...@@ -70,20 +87,3 @@ Notation "'let:' x := e1 'in' e2" := (LamV x e2%E e1%E) ...@@ -70,20 +87,3 @@ Notation "'let:' x := e1 'in' e2" := (LamV x e2%E e1%E)
(at level 102, x at level 1, e1, e2 at level 200) : val_scope. (at level 102, x at level 1, e1, e2 at level 200) : val_scope.
Notation "e1 ;; e2" := (LamV BAnon e2%E e1%E) Notation "e1 ;; e2" := (LamV BAnon e2%E e1%E)
(at level 100, e2 at level 200, format "e1 ;; e2") : val_scope. (at level 100, e2 at level 200, format "e1 ;; e2") : val_scope.
Notation "'rec:' f x y := e" := (Rec f x (Lam y e%E))
(at level 102, f, x, y at level 1, e at level 200) : expr_scope.
Notation "'rec:' f x y := e" := (RecV f x (Lam y e%E))
(at level 102, f, x, y at level 1, e at level 200) : val_scope.
Notation "'rec:' f x y z := e" := (Rec f x (Lam y (Lam z e%E)))
(at level 102, f, x, y, z at level 1, e at level 200) : expr_scope.
Notation "'rec:' f x y z := e" := (RecV f x (Lam y (Lam z e%E)))
(at level 102, f, x, y, z at level 1, e at level 200) : val_scope.
Notation "λ: x y , e" := (Lam x (Lam y e%E))
(at level 102, x, y at level 1, e at level 200) : expr_scope.
Notation "λ: x y , e" := (LamV x (Lam y e%E))
(at level 102, x, y at level 1, e at level 200) : val_scope.
Notation "λ: x y z , e" := (Lam x (Lam y (Lam z e%E)))
(at level 102, x, y, z at level 1, e at level 200) : expr_scope.
Notation "λ: x y z , e" := (LamV x (Lam y (Lam z e%E)))
(at level 102, x, y, z at level 1, e at level 200) : val_scope.
From heap_lang Require Export lang. From heap_lang Require Export lang.
From prelude Require Import stringmap.
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 using instances of the type class [Closed e], which can be used can be tuned using instances of the type class [Closed e], which can be used
to mark that expressions are closed, and should thus not be substituted into. *) to mark that expressions are closed, and should thus not be substituted into. *)
Class Subst (e : expr) (x : string) (v : val) (er : expr) := (** * Weakening *)
do_subst : subst e x v = er. Class WExpr {X Y} (H : X `included` Y) (e : expr X) (er : expr Y) :=
Hint Mode Subst + + + - : typeclass_instances. do_wexpr : wexpr H e = er.
Hint Mode WExpr + + + + - : typeclass_instances.
Ltac simpl_subst := (* Variables *)
repeat match goal with Hint Extern 0 (WExpr _ (Var ?y) _) =>
| |- context [subst ?e ?x ?v] => progress rewrite (@do_subst e x v) apply var_proof_irrel : typeclass_instances.
| |- _ => progress csimpl
end; fold of_val.
Arguments of_val : simpl never.
Hint Extern 10 (Subst (of_val _) _ _ _) => unfold of_val : typeclass_instances.
Hint Extern 10 (Closed (of_val _)) => unfold of_val : typeclass_instances.
Instance subst_fallthrough e x v : Subst e x v (subst e x v) | 1000. (* Rec *)
Proof. done. 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).
Class SubstIf (P : Prop) (e : expr) (x : string) (v : val) (er : expr) := { Proof. intros; red; f_equal/=. by etrans; [apply wexpr_proof_irrel|]. Qed.
subst_if_true : P subst e x v = er;
subst_if_false : ¬P e = er
}.
Hint Mode SubstIf + + + + - : typeclass_instances.
Definition subst_if_mk_true (P : Prop) x v e er :
Subst e x v er P SubstIf P e x v er.
Proof. by split. Qed.
Definition subst_if_mk_false (P : Prop) x v e : ¬P SubstIf P e x v e.
Proof. by split. Qed.
Ltac bool_decide_no_check := apply (bool_decide_unpack _); vm_cast_no_check I. (* Values *)
Instance do_wexpr_of_val_nil (H : [] `included` []) v :
Hint Extern 0 (SubstIf ?P ?e ?x ?v _) => WExpr H (of_val v) (of_val v) | 0.
match eval vm_compute in (bool_decide P) with Proof. apply wexpr_id. Qed.
| true => apply subst_if_mk_true; [|bool_decide_no_check] Instance do_wexpr_of_val_nil' X (H : X `included` []) v :
| false => apply subst_if_mk_false; bool_decide_no_check WExpr H (of_val' v) (of_val v) | 0.
end : typeclass_instances. Proof. by rewrite /WExpr /of_val' wexpr_wexpr' wexpr_id. Qed.
Instance do_wexpr_of_val Y (H : [] `included` Y) v :
WExpr H (of_val v) (of_val' v) | 1.
Proof. apply wexpr_proof_irrel. Qed.
Instance do_wexpr_of_val' X Y (H : X `included` Y) v :
WExpr H (of_val' v) (of_val' v) | 1.
Proof. apply wexpr_wexpr. Qed.
Instance subst_closed e x v : Closed e Subst e x v e | 0. (* Boring connectives *)
Proof. intros He; apply He. Qed. Section do_wexpr.
Context {X Y : list string} (H : X `included` Y).
Notation W := (WExpr H).
Instance lit_closed l : Closed (Lit l). (* Ground terms *)
Global Instance do_wexpr_lit l : W (Lit l) (Lit l).
Proof. done. Qed. Proof. done. Qed.
Instance loc_closed l : Closed (Loc l). Global Instance do_wexpr_loc l : W (Loc l) (Loc l).
Proof. done. Qed. 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.
Definition subst_var_eq y x v : x = y Subst (Var y) x v (of_val v). (** * WSubstitution *)
Proof. intros. by red; rewrite /= decide_True. Defined. Class WSubst {X Y} (x : string) (es : expr []) H (e : expr X) (er : expr Y) :=
Definition subst_var_ne y x v : x y Subst (Var y) x v (Var y). do_wsubst : wsubst x es H e = er.
Proof. intros. by red; rewrite /= decide_False. Defined. Hint Mode WSubst + + + + + + - : typeclass_instances.
Hint Extern 0 (Subst (Var ?y) ?x ?v _) => (* Variables *)
match eval vm_compute in (bool_decide (x = y)) with Lemma do_wsubst_var_eq {X Y x es} {H : X `included` x :: Y} `{VarBound x X} er :
| true => apply subst_var_eq; bool_decide_no_check WExpr (included_nil _) es er WSubst x es H (Var x) er.
| false => apply subst_var_ne; bool_decide_no_check 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 *)
Lemma do_wsubst_rec_true {X Y x es f y e} {H : X `included` x :: Y}
(Hfy : BNamed x f BNamed x y) er :
WSubst x es (wsubst_rec_true_prf H Hfy) e er
WSubst x es H (Rec f y e) (Rec f y er).
Proof.
intros ?; red; f_equal/=; case_decide; last done.
by etrans; [apply wsubst_proof_irrel|].
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 :
WExpr (wsubst_rec_false_prf H Hfy) e er
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
| true => eapply (do_wsubst_rec_true ltac:(bool_decide_no_check))
| false => eapply (do_wsubst_rec_false ltac:(bool_decide_no_check))
end : typeclass_instances. end : typeclass_instances.
Instance subst_rec f y e x v er : (* Values *)
SubstIf (BNamed x f BNamed x y) e x v er Instance do_wsubst_of_val_nil x es (H : [] `included` [x]) w :
Subst (Rec f y e) x v (Rec f y er). WSubst x es H (of_val w) (of_val w) | 0.
Proof. intros [??]; red; f_equal/=; case_decide; auto. Qed. Proof. apply wsubst_closed_nil. Qed.
Instance do_wsubst_of_val_nil' {X} x es (H : X `included` [x]) w :
WSubst x es H (of_val' w) (of_val w) | 0.
Proof. by rewrite /WSubst /of_val' wsubst_wexpr' wsubst_closed_nil. Qed.
Instance do_wsubst_of_val Y x es (H : [] `included` x :: Y) w :
WSubst x es H (of_val w) (of_val' w) | 1.
Proof. apply wsubst_closed, not_elem_of_nil. Qed.
Instance do_wsubst_of_val' X Y x es (H : X `included` x :: Y) w :
WSubst x es H (of_val' w) (of_val' w) | 1.
Proof.
rewrite /WSubst /of_val' wsubst_wexpr'.
apply wsubst_closed, not_elem_of_nil.
Qed.
Instance subst_app e1 e2 x v e1r e2r : (* Boring connectives *)
Subst e1 x v e1r Subst e2 x v e2r Subst (App e1 e2) x v (App e1r e2r). Section wsubst.
Proof. by intros; red; f_equal/=. Qed. Context {X Y} (x : string) (es : expr []) (H : X `included` x :: Y).
Instance subst_unop op e x v er : Notation Sub := (WSubst x es H).
Subst e x v er Subst (UnOp op e) x v (UnOp op er).
(* Ground terms *)
Global Instance do_wsubst_lit l : Sub (Lit l) (Lit l).
Proof. done. Qed.
Global Instance do_wsubst_loc l : Sub (Loc l) (Loc l).
Proof. done. Qed.
Global Instance do_wsubst_app e1 e2 e1r e2r :
Sub e1 e1r Sub e2 e2r Sub (App e1 e2) (App e1r e2r).
Proof. intros; red; f_equal/=; apply: do_wsubst. Qed.
Global Instance do_wsubst_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.
Instance subst_binop op e1 e2 x v e1r e2r : Global Instance do_wsubst_binop op e1 e2 e1r e2r :
Subst e1 x v e1r Subst e2 x v e2r Sub e1 e1r Sub e2 e2r Sub (BinOp op e1 e2) (BinOp op e1r e2r).
Subst (BinOp op e1 e2) x v (BinOp op e1r e2r).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Instance subst_if e0 e1 e2 x v e0r e1r e2r : Global Instance do_wsubst_if e0 e1 e2 e0r e1r e2r :
Subst e0 x v e0r Subst e1 x v e1r Subst e2 x v e2r Sub e0 e0r Sub e1 e1r Sub e2 e2r Sub (If e0 e1 e2) (If e0r e1r e2r).
Subst (If e0 e1 e2) x v (If e0r e1r e2r).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Instance subst_pair e1 e2 x v e1r e2r : Global Instance do_wsubst_pair e1 e2 e1r e2r :
Subst e1 x v e1r Subst e2 x v e2r Subst (Pair e1 e2) x v (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.
Instance subst_fst e x v er : Subst e x v er Subst (Fst e) x v (Fst er). Global Instance do_wsubst_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.
Instance subst_snd e x v er : Subst e x v er Subst (Snd e) x v (Snd er). Global Instance do_wsubst_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.
Instance subst_injL e x v er : Subst e x v er Subst (InjL e) x v (InjL er). Global Instance do_wsubst_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.
Instance subst_injR e x v er : Subst e x v er Subst (InjR e) x v (InjR er). Global Instance do_wsubst_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.
Instance subst_case e0 e1 e2 x v e0r e1r e2r : Global Instance do_wsubst_case e0 e1 e2 e0r e1r e2r :
Subst e0 x v e0r Subst e1 x v e1r Subst e2 x v e2r Sub e0 e0r Sub e1 e1r Sub e2 e2r Sub (Case e0 e1 e2) (Case e0r e1r e2r).
Subst (Case e0 e1 e2) x v (Case e0r e1r e2r).
Proof. by intros; red; f_equal/=. Qed. Proof. by intros; red; f_equal/=. Qed.
Instance subst_fork e x v er : Subst e x v er Subst (Fork e) x v (Fork er). Global Instance do_wsubst_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.
Instance subst_alloc e x v er : Subst e x v er Subst (Alloc e) x v (Alloc er). Global Instance do_wsubst_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.
Instance subst_load e x v er : Subst e x v er Subst (Load e) x v (Load er). Global Instance do_wsubst_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.
Instance subst_store e1 e2 x v e1r e2r : Global Instance do_wsubst_store e1 e2 e1r e2r :
Subst e1 x v e1r Subst e2 x v e2r Subst (Store e1 e2) x v (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.
Instance subst_cas e0 e1 e2 x v e0r e1r e2r : Global Instance do_wsubst_cas e0 e1 e2 e0r e1r e2r :
Subst e0 x v e0r Subst e1 x v e1r Subst e2 x v e2r Sub e0 e0r Sub e1 e1r Sub e2 e2r Sub (Cas e0 e1 e2) (Cas e0r e1r e2r).