Commit 9709c97c by Robbert Krebbers

### Clean up anonymous binder hack.

```We no longer abuse empty strings for anonymous binders. Instead, we
now have a data type for binders: a binder is either named or
anonymous.```
parent 0a74ba89
 From heap_lang Require Export substitution notation. Definition newbarrier : val := λ: "", ref #0. Definition newbarrier : val := λ: <>, ref #0. Definition signal : val := λ: "x", "x" <- #1. Definition wait : val := rec: "wait" "x" := if: !"x" = #1 then #() else "wait" "x". ... ...
 ... ... @@ -2,12 +2,12 @@ From heap_lang Require Export lifting. Import uPred. (** Define some derived forms, and derived lemmas about them. *) Notation Lam x e := (Rec "" x e). Notation Lam x e := (Rec BAnom x e). Notation Let x e1 e2 := (App (Lam x e2) e1). Notation Seq e1 e2 := (Let "" e1 e2). Notation LamV x e := (RecV "" x e). Notation Seq e1 e2 := (Let BAnom e1 e2). Notation LamV x e := (RecV BAnom x e). Notation LetCtx x e2 := (AppRCtx (LamV x e2)). Notation SeqCtx e2 := (LetCtx "" e2). Notation SeqCtx e2 := (LetCtx BAnom e2). Notation Skip := (Seq (Lit LitUnit) (Lit LitUnit)). Section derived. ... ... @@ -18,18 +18,18 @@ Implicit Types Φ : val → iProp heap_lang Σ. (** Proof rules for the sugar *) Lemma wp_lam E x ef e v Φ : to_val e = Some v → ▷ || subst ef x v @ E {{ Φ }} ⊑ || App (Lam x ef) e @ E {{ Φ }}. Proof. intros. by rewrite -wp_rec ?subst_empty. Qed. ▷ || subst' ef x v @ E {{ Φ }} ⊑ || App (Lam x ef) e @ E {{ Φ }}. Proof. intros. by rewrite -wp_rec. Qed. Lemma wp_let E x e1 e2 v Φ : to_val e1 = Some v → ▷ || subst e2 x v @ E {{ Φ }} ⊑ || Let x e1 e2 @ E {{ Φ }}. ▷ || subst' e2 x v @ E {{ Φ }} ⊑ || Let x e1 e2 @ E {{ Φ }}. Proof. apply wp_lam. Qed. Lemma wp_seq E e1 e2 v Φ : to_val e1 = Some v → ▷ || e2 @ E {{ Φ }} ⊑ || Seq e1 e2 @ E {{ Φ }}. Proof. intros ?. rewrite -wp_let // subst_empty //. Qed. Proof. intros ?. by rewrite -wp_let. Qed. Lemma wp_skip E Φ : ▷ Φ (LitV LitUnit) ⊑ || Skip @ E {{ Φ }}. Proof. rewrite -wp_seq // -wp_value //. Qed. ... ...
 ... ... @@ -86,18 +86,18 @@ Qed. The final version is defined in substitution.v. *) Lemma wp_rec E f x e1 e2 v Φ : to_val e2 = Some v → ▷ || subst (subst e1 f (RecV f x e1)) x v @ E {{ Φ }} ▷ || subst' (subst' e1 f (RecV f x e1)) x v @ E {{ Φ }} ⊑ || App (Rec f x e1) e2 @ E {{ Φ }}. Proof. intros. rewrite -(wp_lift_pure_det_step (App _ _) (subst (subst e1 f (RecV f x e1)) x v) None) ?right_id //=; (subst' (subst' e1 f (RecV f x e1)) x v) None) ?right_id //=; intros; inv_step; eauto. Qed. Lemma wp_rec' E f x erec v1 e2 v2 Φ : v1 = RecV f x erec → to_val e2 = Some v2 → ▷ || subst (subst erec f v1) x v2 @ E {{ Φ }} ▷ || subst' (subst' erec f v1) x v2 @ E {{ Φ }} ⊑ || App (of_val v1) e2 @ E {{ Φ }}. Proof. intros ->. apply wp_rec. Qed. ... ... @@ -149,18 +149,18 @@ Qed. Lemma wp_case_inl E e0 v0 x1 e1 x2 e2 Φ : to_val e0 = Some v0 → ▷ || subst e1 x1 v0 @ E {{ Φ }} ⊑ || Case (InjL e0) x1 e1 x2 e2 @ E {{ Φ }}. ▷ || subst' e1 x1 v0 @ E {{ Φ }} ⊑ || Case (InjL e0) x1 e1 x2 e2 @ E {{ Φ }}. Proof. intros. rewrite -(wp_lift_pure_det_step (Case _ _ _ _ _) (subst e1 x1 v0) None) ?right_id //; intros; inv_step; eauto. (subst' e1 x1 v0) None) ?right_id //; intros; inv_step; eauto. Qed. Lemma wp_case_inr E e0 v0 x1 e1 x2 e2 Φ : to_val e0 = Some v0 → ▷ || subst e2 x2 v0 @ E {{ Φ }} ⊑ || Case (InjR e0) x1 e1 x2 e2 @ E {{ Φ }}. ▷ || subst' e2 x2 v0 @ E {{ Φ }} ⊑ || Case (InjR e0) x1 e1 x2 e2 @ E {{ Φ }}. Proof. intros. rewrite -(wp_lift_pure_det_step (Case _ _ _ _ _) (subst e2 x2 v0) None) ?right_id //; intros; inv_step; eauto. (subst' e2 x2 v0) None) ?right_id //; intros; inv_step; eauto. Qed. End lifting.
 ... ... @@ -16,6 +16,9 @@ Coercion Var : string >-> expr. Coercion App : expr >-> Funclass. Coercion of_val : val >-> expr. Coercion BNamed : string >-> binder. Notation "<>" := BAnom : binder_scope. (** Syntax inspired by Coq/Ocaml. Constructions with higher precedence come first. *) (* We have overlapping notation for values and expressions, with the expressions ... ... @@ -64,9 +67,9 @@ Notation "'let:' x := e1 'in' e2" := (Lam x e2%L e1%L) (at level 102, x at level 1, e1, e2 at level 200) : lang_scope. Notation "'let:' x := e1 'in' e2" := (LamV x e2%L e1%L) (at level 102, x at level 1, e1, e2 at level 200) : lang_scope. Notation "e1 ;; e2" := (Lam "" e2%L e1%L) Notation "e1 ;; e2" := (Lam BAnom e2%L e1%L) (at level 100, e2 at level 200, format "e1 ;; e2") : lang_scope. Notation "e1 ;; e2" := (LamV "" e2%L e1%L) Notation "e1 ;; e2" := (LamV BAnom e2%L e1%L) (at level 100, e2 at level 200, format "e1 ;; e2") : lang_scope. Notation "'rec:' f x y := e" := (Rec f x (Lam y e%L)) ... ...
 ... ... @@ -51,22 +51,24 @@ Proof. done. Qed. Instance loc_closed l : Closed (Loc l). Proof. done. Qed. Definition subst_var_eq y x v : (x = y ∧ x ≠ "") → Subst (Var y) x v (of_val v). Definition subst_var_eq y x v : x = y → Subst (Var y) x v (of_val v). Proof. intros. by red; rewrite /= decide_True. Defined. Definition subst_var_ne y x v : ¬(x = y ∧ x ≠ "") → Subst (Var y) x v (Var y). Definition subst_var_ne y x v : x ≠ y → Subst (Var y) x v (Var y). Proof. intros. by red; rewrite /= decide_False. Defined. Hint Extern 0 (Subst (Var ?y) ?x ?v _) => match eval vm_compute in (bool_decide (x = y ∧ x ≠ "")) with match eval vm_compute in (bool_decide (x = y)) with | true => apply subst_var_eq; bool_decide_no_check | false => apply subst_var_ne; bool_decide_no_check end : typeclass_instances. Instance subst_rec f y e x v er : SubstIf (x ≠ f ∧ x ≠ y) e x v er → Subst (Rec f y e) x v (Rec f y er). SubstIf (BNamed x ≠ f ∧ BNamed x ≠ y) e x v er → Subst (Rec f y e) x v (Rec f y er). Proof. intros [??]; red; f_equal/=; case_decide; auto. Qed. Instance subst_case e0 x1 e1 x2 e2 x v e0r e1r e2r : Subst e0 x v e0r → SubstIf (x ≠ x1) e1 x v e1r → SubstIf (x ≠ x2) e2 x v e2r → Subst e0 x v e0r → SubstIf (BNamed x ≠ x1) e1 x v e1r → SubstIf (BNamed x ≠ x2) e2 x v e2r → Subst (Case e0 x1 e1 x2 e2) x v (Case e0r x1 e1r x2 e2r). Proof. intros ? [??] [??]; red; f_equal/=; repeat case_decide; auto. Qed. ... ... @@ -109,11 +111,19 @@ Instance subst_cas e0 e1 e2 x v e0r e1r e2r : Subst (Cas e0 e1 e2) x v (Cas e0r e1r e2r). Proof. by intros; red; f_equal/=. Qed. Definition of_binder (mx : binder) : stringset := match mx with BAnom => ∅ | BNamed x => {[ x ]} end. Lemma elem_of_of_binder x mx: x ∈ of_binder mx ↔ mx = BNamed x. Proof. destruct mx; set_solver. Qed. Global Instance set_unfold_of_binder (mx : binder) x : SetUnfold (x ∈ of_binder mx) (mx = BNamed x). Proof. constructor; destruct mx; set_solver. Qed. (** * Solver for [Closed] *) Fixpoint is_closed (X : stringset) (e : expr) : bool := match e with | Var x => bool_decide (x ∈ X) | Rec f y e => is_closed ({[ f ; y ]} ∪ X) e | Rec f y e => is_closed (of_binder f ∪ of_binder y ∪ X) e | App e1 e2 => is_closed X e1 && is_closed X e2 | Lit l => true | UnOp _ e => is_closed X e ... ... @@ -125,7 +135,8 @@ Fixpoint is_closed (X : stringset) (e : expr) : bool := | InjL e => is_closed X e | InjR e => is_closed X e | Case e0 x1 e1 x2 e2 => is_closed X e0 && is_closed ({[x1]} ∪ X) e1 && is_closed ({[x2]} ∪ X) e2 is_closed X e0 && is_closed (of_binder x1 ∪ X) e1 && is_closed (of_binder x2 ∪ X) e2 | Fork e => is_closed X e | Loc l => true | Alloc e => is_closed X e ... ... @@ -147,9 +158,10 @@ Proof. | _ => case_decide | _ => f_equal end; eauto; match goal with try match goal with | H : ∀ _, _ → _ ∉ _ → subst _ _ _ = _ |- _ => eapply H; first done; rewrite !elem_of_union !elem_of_singleton; tauto eapply H; first done; rewrite !elem_of_union !elem_of_of_binder; intuition congruence end. Qed. Ltac solve_closed := apply is_closed_sound; vm_compute; exact I. ... ...
 ... ... @@ -17,7 +17,7 @@ Section LangTests. Goal ∀ σ, prim_step (lam #21)%L σ add σ None. Proof. intros. rewrite /lam. (* FIXME: do_step does not work here *) by eapply (Ectx_step _ _ _ _ _ []), (BetaS "" "x" ("x" + #21) _ #21). by eapply (Ectx_step _ _ _ _ _ []), (BetaS <> "x" ("x" + #21) _ #21). Qed. End LangTests. ... ...
 ... ... @@ -41,7 +41,7 @@ Tactic Notation "wp_lam" ">" := match goal with | |- _ ⊑ wp ?E ?e ?Q => reshape_expr e ltac:(fun K e' => match eval cbv in e' with | App (Rec "" _ _) _ => | App (Rec BAnom _ _) _ => wp_bind K; etrans; [|eapply wp_lam; repeat (reflexivity || rewrite /= to_of_val)]; simpl_subst; wp_finish ... ...
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!