Commit b6269993 authored by Robbert Krebbers's avatar Robbert Krebbers
Browse files

Merge branch 'robbert/proofmode_anon_hyps' into 'master'

Improved treatment of anonymous hypotheses in the proof mode

See merge request FP/iris-coq!83
parents 86692e50 eaf63996
...@@ -92,7 +92,7 @@ End inv. ...@@ -92,7 +92,7 @@ End inv.
Tactic Notation "iInvCore" constr(N) "as" tactic(tac) constr(Hclose) := Tactic Notation "iInvCore" constr(N) "as" tactic(tac) constr(Hclose) :=
let Htmp := iFresh in let Htmp := iFresh in
let patback := intro_pat.parse_one Hclose in let patback := intro_pat.parse_one Hclose in
let pat := constr:(IList [[IName Htmp; patback]]) in let pat := constr:(IList [[IIdent Htmp; patback]]) in
iMod (inv_open _ N with "[#]") as pat; iMod (inv_open _ N with "[#]") as pat;
[idtac|iAssumption || fail "iInv: invariant" N "not found"|idtac]; [idtac|iAssumption || fail "iInv: invariant" N "not found"|idtac];
[solve_ndisj || match goal with |- ?P => fail "iInv: cannot solve" P end [solve_ndisj || match goal with |- ?P => fail "iInv: cannot solve" P end
......
...@@ -104,7 +104,7 @@ Qed. ...@@ -104,7 +104,7 @@ Qed.
Lemma ownI_open i P : wsat ownI i P ownE {[i]} wsat P ownD {[i]}. Lemma ownI_open i P : wsat ownI i P ownE {[i]} wsat P ownD {[i]}.
Proof. Proof.
rewrite /ownI /wsat -!lock. rewrite /ownI /wsat -!lock.
iIntros "(Hw & Hi & HiE)". iDestruct "Hw" as (I) "[? HI]". iIntros "(Hw & Hi & HiE)". iDestruct "Hw" as (I) "[Hw HI]".
iDestruct (invariant_lookup I i P with "[$]") as (Q ?) "#HPQ". iDestruct (invariant_lookup I i P with "[$]") as (Q ?) "#HPQ".
iDestruct (big_opM_delete _ _ i with "HI") as "[[[HQ $]|HiE'] HI]"; eauto. iDestruct (big_opM_delete _ _ i with "HI") as "[[[HQ $]|HiE'] HI]"; eauto.
- iSplitR "HQ"; last by iNext; iRewrite -"HPQ". - iSplitR "HQ"; last by iNext; iRewrite -"HPQ".
...@@ -115,7 +115,7 @@ Qed. ...@@ -115,7 +115,7 @@ Qed.
Lemma ownI_close i P : wsat ownI i P P ownD {[i]} wsat ownE {[i]}. Lemma ownI_close i P : wsat ownI i P P ownD {[i]} wsat ownE {[i]}.
Proof. Proof.
rewrite /ownI /wsat -!lock. rewrite /ownI /wsat -!lock.
iIntros "(Hw & Hi & HP & HiD)". iDestruct "Hw" as (I) "[? HI]". iIntros "(Hw & Hi & HP & HiD)". iDestruct "Hw" as (I) "[Hw HI]".
iDestruct (invariant_lookup with "[$]") as (Q ?) "#HPQ". iDestruct (invariant_lookup with "[$]") as (Q ?) "#HPQ".
iDestruct (big_opM_delete _ _ i with "HI") as "[[[HQ ?]|$] HI]"; eauto. iDestruct (big_opM_delete _ _ i with "HI") as "[[[HQ ?]|$] HI]"; eauto.
- iDestruct (ownD_singleton_twice with "[$]") as %[]. - iDestruct (ownD_singleton_twice with "[$]") as %[].
...@@ -128,7 +128,7 @@ Lemma ownI_alloc φ P : ...@@ -128,7 +128,7 @@ Lemma ownI_alloc φ P :
wsat P == i, ⌜φ i wsat ownI i P. wsat P == i, ⌜φ i wsat ownI i P.
Proof. Proof.
iIntros (Hfresh) "[Hw HP]". rewrite /wsat -!lock. iIntros (Hfresh) "[Hw HP]". rewrite /wsat -!lock.
iDestruct "Hw" as (I) "[? HI]". iDestruct "Hw" as (I) "[Hw HI]".
iMod (own_unit (gset_disjUR positive) disabled_name) as "HE". iMod (own_unit (gset_disjUR positive) disabled_name) as "HE".
iMod (own_updateP with "[$]") as "HE". iMod (own_updateP with "[$]") as "HE".
{ apply (gset_disj_alloc_empty_updateP_strong' (λ i, I !! i = None φ i)). { apply (gset_disj_alloc_empty_updateP_strong' (λ i, I !! i = None φ i)).
...@@ -150,7 +150,7 @@ Lemma ownI_alloc_open φ P : ...@@ -150,7 +150,7 @@ Lemma ownI_alloc_open φ P :
( E : gset positive, i, i E φ i) ( E : gset positive, i, i E φ i)
wsat == i, ⌜φ i (ownE {[i]} - wsat) ownI i P ownD {[i]}. wsat == i, ⌜φ i (ownE {[i]} - wsat) ownI i P ownD {[i]}.
Proof. Proof.
iIntros (Hfresh) "Hw". rewrite /wsat -!lock. iDestruct "Hw" as (I) "[? HI]". iIntros (Hfresh) "Hw". rewrite /wsat -!lock. iDestruct "Hw" as (I) "[Hw HI]".
iMod (own_unit (gset_disjUR positive) disabled_name) as "HD". iMod (own_unit (gset_disjUR positive) disabled_name) as "HD".
iMod (own_updateP with "[$]") as "HD". iMod (own_updateP with "[$]") as "HD".
{ apply (gset_disj_alloc_empty_updateP_strong' (λ i, I !! i = None φ i)). { apply (gset_disj_alloc_empty_updateP_strong' (λ i, I !! i = None φ i)).
......
...@@ -153,7 +153,7 @@ Section proof. ...@@ -153,7 +153,7 @@ Section proof.
wp_store. wp_store.
iDestruct (own_valid_2 with "Hauth Hγo") as iDestruct (own_valid_2 with "Hauth Hγo") as
%[[<-%Excl_included%leibniz_equiv _]%prod_included _]%auth_valid_discrete_2. %[[<-%Excl_included%leibniz_equiv _]%prod_included _]%auth_valid_discrete_2.
iDestruct "Haown" as "[[Hγo' _]|?]". iDestruct "Haown" as "[[Hγo' _]|Haown]".
{ iDestruct (own_valid_2 with "Hγo Hγo'") as %[[] ?]. } { iDestruct (own_valid_2 with "Hγo Hγo'") as %[[] ?]. }
iMod (own_update_2 with "Hauth Hγo") as "[Hauth Hγo]". iMod (own_update_2 with "Hauth Hγo") as "[Hauth Hγo]".
{ apply auth_update, prod_local_update_1. { apply auth_update, prod_local_update_1.
......
...@@ -49,3 +49,37 @@ Qed. ...@@ -49,3 +49,37 @@ Qed.
Lemma string_beq_reflect s1 s2 : reflect (s1 = s2) (string_beq s1 s2). Lemma string_beq_reflect s1 s2 : reflect (s1 = s2) (string_beq s1 s2).
Proof. apply iff_reflect. by rewrite string_beq_true. Qed. Proof. apply iff_reflect. by rewrite string_beq_true. Qed.
Module Export ident.
Inductive ident :=
| IAnon : positive ident
| INamed :> string ident.
End ident.
Instance maybe_IAnon : Maybe IAnon := λ i,
match i with IAnon n => Some n | _ => None end.
Instance maybe_INamed : Maybe INamed := λ i,
match i with INamed s => Some s | _ => None end.
Instance beq_eq_dec : EqDecision ident.
Proof. solve_decision. Defined.
Definition positive_beq := Eval compute in Pos.eqb.
Lemma positive_beq_true x y : positive_beq x y = true x = y.
Proof. apply Pos.eqb_eq. Qed.
Definition ident_beq (i1 i2 : ident) : bool :=
match i1, i2 with
| IAnon n1, IAnon n2 => positive_beq n1 n2
| INamed s1, INamed s2 => string_beq s1 s2
| _, _ => false
end.
Lemma ident_beq_true i1 i2 : ident_beq i1 i2 = true i1 = i2.
Proof.
destruct i1, i2; rewrite /= ?string_beq_true ?positive_beq_true; naive_solver.
Qed.
Lemma ident_beq_reflect i1 i2 : reflect (i1 = i2) (ident_beq i1 i2).
Proof. apply iff_reflect. by rewrite ident_beq_true. Qed.
From iris.base_logic Require Export base_logic. From iris.base_logic Require Export base_logic.
From iris.base_logic Require Import big_op tactics. From iris.base_logic Require Import big_op tactics.
From iris.proofmode Require Export base environments classes. From iris.proofmode Require Export base environments classes.
From stdpp Require Import stringmap hlist.
Set Default Proof Using "Type". Set Default Proof Using "Type".
Import uPred. Import uPred.
Import env_notations. Import env_notations.
...@@ -36,22 +35,22 @@ Record envs_Forall2 {M} (R : relation (uPred M)) (Δ1 Δ2 : envs M) : Prop := { ...@@ -36,22 +35,22 @@ Record envs_Forall2 {M} (R : relation (uPred M)) (Δ1 Δ2 : envs M) : Prop := {
env_spatial_Forall2 : env_Forall2 R (env_spatial Δ1) (env_spatial Δ2) env_spatial_Forall2 : env_Forall2 R (env_spatial Δ1) (env_spatial Δ2)
}. }.
Definition envs_dom {M} (Δ : envs M) : list string := Definition envs_dom {M} (Δ : envs M) : list ident :=
env_dom (env_persistent Δ) ++ env_dom (env_spatial Δ). env_dom (env_persistent Δ) ++ env_dom (env_spatial Δ).
Definition envs_lookup {M} (i : string) (Δ : envs M) : option (bool * uPred M) := Definition envs_lookup {M} (i : ident) (Δ : envs M) : option (bool * uPred M) :=
let (Γp,Γs) := Δ in let (Γp,Γs) := Δ in
match env_lookup i Γp with match env_lookup i Γp with
| Some P => Some (true, P) | None => P env_lookup i Γs; Some (false, P) | Some P => Some (true, P) | None => P env_lookup i Γs; Some (false, P)
end. end.
Definition envs_delete {M} (i : string) (p : bool) (Δ : envs M) : envs M := Definition envs_delete {M} (i : ident) (p : bool) (Δ : envs M) : envs M :=
let (Γp,Γs) := Δ in let (Γp,Γs) := Δ in
match p with match p with
| true => Envs (env_delete i Γp) Γs | false => Envs Γp (env_delete i Γs) | true => Envs (env_delete i Γp) Γs | false => Envs Γp (env_delete i Γs)
end. end.
Definition envs_lookup_delete {M} (i : string) Definition envs_lookup_delete {M} (i : ident)
(Δ : envs M) : option (bool * uPred M * envs M) := (Δ : envs M) : option (bool * uPred M * envs M) :=
let (Γp,Γs) := Δ in let (Γp,Γs) := Δ in
match env_lookup_delete i Γp with match env_lookup_delete i Γp with
...@@ -59,7 +58,7 @@ Definition envs_lookup_delete {M} (i : string) ...@@ -59,7 +58,7 @@ Definition envs_lookup_delete {M} (i : string)
| None => '(P,Γs') env_lookup_delete i Γs; Some (false, P, Envs Γp Γs') | None => '(P,Γs') env_lookup_delete i Γs; Some (false, P, Envs Γp Γs')
end. end.
Fixpoint envs_lookup_delete_list {M} (js : list string) (remove_persistent : bool) Fixpoint envs_lookup_delete_list {M} (js : list ident) (remove_persistent : bool)
(Δ : envs M) : option (bool * list (uPred M) * envs M) := (Δ : envs M) : option (bool * list (uPred M) * envs M) :=
match js with match js with
| [] => Some (true, [], Δ) | [] => Some (true, [], Δ)
...@@ -71,7 +70,7 @@ Fixpoint envs_lookup_delete_list {M} (js : list string) (remove_persistent : boo ...@@ -71,7 +70,7 @@ Fixpoint envs_lookup_delete_list {M} (js : list string) (remove_persistent : boo
end. end.
Definition envs_snoc {M} (Δ : envs M) Definition envs_snoc {M} (Δ : envs M)
(p : bool) (j : string) (P : uPred M) : envs M := (p : bool) (j : ident) (P : uPred M) : envs M :=
let (Γp,Γs) := Δ in let (Γp,Γs) := Δ in
if p then Envs (Esnoc Γp j P) Γs else Envs Γp (Esnoc Γs j P). if p then Envs (Esnoc Γp j P) Γs else Envs Γp (Esnoc Γs j P).
...@@ -83,7 +82,7 @@ Definition envs_app {M} (p : bool) ...@@ -83,7 +82,7 @@ Definition envs_app {M} (p : bool)
| false => _ env_app Γ Γp; Γs' env_app Γ Γs; Some (Envs Γp Γs') | false => _ env_app Γ Γp; Γs' env_app Γ Γs; Some (Envs Γp Γs')
end. end.
Definition envs_simple_replace {M} (i : string) (p : bool) (Γ : env (uPred M)) Definition envs_simple_replace {M} (i : ident) (p : bool) (Γ : env (uPred M))
(Δ : envs M) : option (envs M) := (Δ : envs M) : option (envs M) :=
let (Γp,Γs) := Δ in let (Γp,Γs) := Δ in
match p with match p with
...@@ -91,7 +90,7 @@ Definition envs_simple_replace {M} (i : string) (p : bool) (Γ : env (uPred M)) ...@@ -91,7 +90,7 @@ Definition envs_simple_replace {M} (i : string) (p : bool) (Γ : env (uPred M))
| false => _ env_app Γ Γp; Γs' env_replace i Γ Γs; Some (Envs Γp Γs') | false => _ env_app Γ Γp; Γs' env_replace i Γ Γs; Some (Envs Γp Γs')
end. end.
Definition envs_replace {M} (i : string) (p q : bool) (Γ : env (uPred M)) Definition envs_replace {M} (i : ident) (p q : bool) (Γ : env (uPred M))
(Δ : envs M) : option (envs M) := (Δ : envs M) : option (envs M) :=
if eqb p q then envs_simple_replace i p Γ Δ if eqb p q then envs_simple_replace i p Γ Δ
else envs_app q Γ (envs_delete i p Δ). else envs_app q Γ (envs_delete i p Δ).
...@@ -106,7 +105,7 @@ Definition envs_clear_persistent {M} (Δ : envs M) : envs M := ...@@ -106,7 +105,7 @@ Definition envs_clear_persistent {M} (Δ : envs M) : envs M :=
Envs Enil (env_spatial Δ). Envs Enil (env_spatial Δ).
Fixpoint envs_split_go {M} Fixpoint envs_split_go {M}
(js : list string) (Δ1 Δ2 : envs M) : option (envs M * envs M) := (js : list ident) (Δ1 Δ2 : envs M) : option (envs M * envs M) :=
match js with match js with
| [] => Some (Δ1, Δ2) | [] => Some (Δ1, Δ2)
| j :: js => | j :: js =>
...@@ -117,7 +116,7 @@ Fixpoint envs_split_go {M} ...@@ -117,7 +116,7 @@ Fixpoint envs_split_go {M}
(* if [d = Right] then [result = (remaining hyps, hyps named js)] and (* if [d = Right] then [result = (remaining hyps, hyps named js)] and
if [d = Left] then [result = (hyps named js, remaining hyps)] *) if [d = Left] then [result = (hyps named js, remaining hyps)] *)
Definition envs_split {M} (d : direction) Definition envs_split {M} (d : direction)
(js : list string) (Δ : envs M) : option (envs M * envs M) := (js : list ident) (Δ : envs M) : option (envs M * envs M) :=
'(Δ1,Δ2) envs_split_go js Δ (envs_clear_spatial Δ); '(Δ1,Δ2) envs_split_go js Δ (envs_clear_spatial Δ);
if d is Right then Some (Δ1,Δ2) else Some (Δ2,Δ1). if d is Right then Some (Δ1,Δ2) else Some (Δ2,Δ1).
...@@ -224,11 +223,11 @@ Proof. ...@@ -224,11 +223,11 @@ Proof.
apply wand_intro_l; destruct p; simpl. apply wand_intro_l; destruct p; simpl.
- apply sep_intro_True_l; [apply pure_intro|]. - apply sep_intro_True_l; [apply pure_intro|].
+ destruct Hwf; constructor; simpl; eauto using Esnoc_wf. + destruct Hwf; constructor; simpl; eauto using Esnoc_wf.
intros j; destruct (string_beq_reflect j i); naive_solver. intros j; destruct (ident_beq_reflect j i); naive_solver.
+ by rewrite persistently_sep assoc. + by rewrite persistently_sep assoc.
- apply sep_intro_True_l; [apply pure_intro|]. - apply sep_intro_True_l; [apply pure_intro|].
+ destruct Hwf; constructor; simpl; eauto using Esnoc_wf. + destruct Hwf; constructor; simpl; eauto using Esnoc_wf.
intros j; destruct (string_beq_reflect j i); naive_solver. intros j; destruct (ident_beq_reflect j i); naive_solver.
+ solve_sep_entails. + solve_sep_entails.
Qed. Qed.
......
From stdpp Require Export strings.
From iris.proofmode Require Import base. From iris.proofmode Require Import base.
From iris.algebra Require Export base. From iris.algebra Require Export base.
From stdpp Require Import stringmap.
Set Default Proof Using "Type". Set Default Proof Using "Type".
Inductive env (A : Type) : Type := Inductive env (A : Type) : Type :=
| Enil : env A | Enil : env A
| Esnoc : env A string A env A. | Esnoc : env A ident A env A.
Arguments Enil {_}. Arguments Enil {_}.
Arguments Esnoc {_} _ _%string _. Arguments Esnoc {_} _ _ _.
Instance: Params (@Enil) 1. Instance: Params (@Enil) 1.
Instance: Params (@Esnoc) 1. Instance: Params (@Esnoc) 1.
Fixpoint env_lookup {A} (i : string) (Γ : env A) : option A := Fixpoint env_lookup {A} (i : ident) (Γ : env A) : option A :=
match Γ with match Γ with
| Enil => None | Enil => None
| Esnoc Γ j x => if string_beq i j then Some x else env_lookup i Γ | Esnoc Γ j x => if ident_beq i j then Some x else env_lookup i Γ
end. end.
Module env_notations. Module env_notations.
...@@ -37,7 +35,7 @@ Fixpoint env_to_list {A} (E : env A) : list A := ...@@ -37,7 +35,7 @@ Fixpoint env_to_list {A} (E : env A) : list A :=
Coercion env_to_list : env >-> list. Coercion env_to_list : env >-> list.
Instance: Params (@env_to_list) 1. Instance: Params (@env_to_list) 1.
Fixpoint env_dom {A} (Γ : env A) : list string := Fixpoint env_dom {A} (Γ : env A) : list ident :=
match Γ with Enil => [] | Esnoc Γ i _ => i :: env_dom Γ end. match Γ with Enil => [] | Esnoc Γ i _ => i :: env_dom Γ end.
Fixpoint env_app {A} (Γapp : env A) (Γ : env A) : option (env A) := Fixpoint env_app {A} (Γapp : env A) (Γ : env A) : option (env A) :=
...@@ -48,28 +46,28 @@ Fixpoint env_app {A} (Γapp : env A) (Γ : env A) : option (env A) := ...@@ -48,28 +46,28 @@ Fixpoint env_app {A} (Γapp : env A) (Γ : env A) : option (env A) :=
match Γ' !! i with None => Some (Esnoc Γ' i x) | Some _ => None end match Γ' !! i with None => Some (Esnoc Γ' i x) | Some _ => None end
end. end.
Fixpoint env_replace {A} (i: string) (Γi: env A) (Γ: env A) : option (env A) := Fixpoint env_replace {A} (i: ident) (Γi: env A) (Γ: env A) : option (env A) :=
match Γ with match Γ with
| Enil => None | Enil => None
| Esnoc Γ j x => | Esnoc Γ j x =>
if string_beq i j then env_app Γi Γ else if ident_beq i j then env_app Γi Γ else
match Γi !! j with match Γi !! j with
| None => Γ' env_replace i Γi Γ; Some (Esnoc Γ' j x) | None => Γ' env_replace i Γi Γ; Some (Esnoc Γ' j x)
| Some _ => None | Some _ => None
end end
end. end.
Fixpoint env_delete {A} (i : string) (Γ : env A) : env A := Fixpoint env_delete {A} (i : ident) (Γ : env A) : env A :=
match Γ with match Γ with
| Enil => Enil | Enil => Enil
| Esnoc Γ j x => if string_beq i j then Γ else Esnoc (env_delete i Γ) j x | Esnoc Γ j x => if ident_beq i j then Γ else Esnoc (env_delete i Γ) j x
end. end.
Fixpoint env_lookup_delete {A} (i : string) (Γ : env A) : option (A * env A) := Fixpoint env_lookup_delete {A} (i : ident) (Γ : env A) : option (A * env A) :=
match Γ with match Γ with
| Enil => None | Enil => None
| Esnoc Γ j x => | Esnoc Γ j x =>
if string_beq i j then Some (x,Γ) if ident_beq i j then Some (x,Γ)
else '(y,Γ') env_lookup_delete i Γ; Some (y, Esnoc Γ' j x) else '(y,Γ') env_lookup_delete i Γ; Some (y, Esnoc Γ' j x)
end. end.
...@@ -88,15 +86,15 @@ Inductive env_subenv {A} : relation (env A) := ...@@ -88,15 +86,15 @@ Inductive env_subenv {A} : relation (env A) :=
Section env. Section env.
Context {A : Type}. Context {A : Type}.
Implicit Types Γ : env A. Implicit Types Γ : env A.
Implicit Types i : string. Implicit Types i : ident.
Implicit Types x : A. Implicit Types x : A.
Hint Resolve Esnoc_wf Enil_wf. Hint Resolve Esnoc_wf Enil_wf.
Ltac simplify := Ltac simplify :=
repeat match goal with repeat match goal with
| _ => progress simplify_eq/= | _ => progress simplify_eq/=
| H : context [string_beq ?s1 ?s2] |- _ => destruct (string_beq_reflect s1 s2) | H : context [ident_beq ?s1 ?s2] |- _ => destruct (ident_beq_reflect s1 s2)
| |- context [string_beq ?s1 ?s2] => destruct (string_beq_reflect s1 s2) | |- context [ident_beq ?s1 ?s2] => destruct (ident_beq_reflect s1 s2)
| _ => case_match | _ => case_match
end. end.
......
...@@ -3,7 +3,7 @@ From iris.proofmode Require Import base tokens sel_patterns. ...@@ -3,7 +3,7 @@ From iris.proofmode Require Import base tokens sel_patterns.
Set Default Proof Using "Type". Set Default Proof Using "Type".
Inductive intro_pat := Inductive intro_pat :=
| IName : string intro_pat | IIdent : ident intro_pat
| IAnom : intro_pat | IAnom : intro_pat
| IDrop : intro_pat | IDrop : intro_pat
| IFrame : intro_pat | IFrame : intro_pat
...@@ -73,7 +73,7 @@ Fixpoint parse_go (ts : list token) (k : stack) : option stack := ...@@ -73,7 +73,7 @@ Fixpoint parse_go (ts : list token) (k : stack) : option stack :=
match ts with match ts with
| [] => Some k | [] => Some k
| TName "_" :: ts => parse_go ts (SPat IDrop :: k) | TName "_" :: ts => parse_go ts (SPat IDrop :: k)
| TName s :: ts => parse_go ts (SPat (IName s) :: k) | TName s :: ts => parse_go ts (SPat (IIdent s) :: k)
| TAnom :: ts => parse_go ts (SPat IAnom :: k) | TAnom :: ts => parse_go ts (SPat IAnom :: k)
| TFrame :: ts => parse_go ts (SPat IFrame :: k) | TFrame :: ts => parse_go ts (SPat IFrame :: k)
| TBracketL :: ts => parse_go ts (SList :: k) | TBracketL :: ts => parse_go ts (SList :: k)
...@@ -98,11 +98,11 @@ Fixpoint parse_go (ts : list token) (k : stack) : option stack := ...@@ -98,11 +98,11 @@ Fixpoint parse_go (ts : list token) (k : stack) : option stack :=
end end
with parse_clear (ts : list token) (k : stack) : option stack := with parse_clear (ts : list token) (k : stack) : option stack :=
match ts with match ts with
| TFrame :: TName s :: ts => parse_clear ts (SPat (IClearFrame (SelName s)) :: k) | TFrame :: TName s :: ts => parse_clear ts (SPat (IClearFrame (SelIdent s)) :: k)
| TFrame :: TPure :: ts => parse_clear ts (SPat (IClearFrame SelPure) :: k) | TFrame :: TPure :: ts => parse_clear ts (SPat (IClearFrame SelPure) :: k)
| TFrame :: TAlways :: ts => parse_clear ts (SPat (IClearFrame SelPersistent) :: k) | TFrame :: TAlways :: ts => parse_clear ts (SPat (IClearFrame SelPersistent) :: k)
| TFrame :: TSep :: ts => parse_clear ts (SPat (IClearFrame SelSpatial) :: k) | TFrame :: TSep :: ts => parse_clear ts (SPat (IClearFrame SelSpatial) :: k)
| TName s :: ts => parse_clear ts (SPat (IClear (SelName s)) :: k) | TName s :: ts => parse_clear ts (SPat (IClear (SelIdent s)) :: k)
| TPure :: ts => parse_clear ts (SPat (IClear SelPure) :: k) | TPure :: ts => parse_clear ts (SPat (IClear SelPure) :: k)
| TAlways :: ts => parse_clear ts (SPat (IClear SelPersistent) :: k) | TAlways :: ts => parse_clear ts (SPat (IClear SelPersistent) :: k)
| TSep :: ts => parse_clear ts (SPat (IClear SelSpatial) :: k) | TSep :: ts => parse_clear ts (SPat (IClear SelSpatial) :: k)
...@@ -134,6 +134,7 @@ Ltac parse s := ...@@ -134,6 +134,7 @@ Ltac parse s :=
lazymatch eval vm_compute in (parse s) with lazymatch eval vm_compute in (parse s) with
| Some ?pats => pats | _ => fail "invalid list intro_pat" s | Some ?pats => pats | _ => fail "invalid list intro_pat" s
end end
| ident => constr:([IIdent s])
| ?X => fail "intro_pat.parse:" s "has unexpected type" X | ?X => fail "intro_pat.parse:" s "has unexpected type" X
end. end.
Ltac parse_one s := Ltac parse_one s :=
...@@ -165,6 +166,7 @@ Ltac intro_pat_persistent p := ...@@ -165,6 +166,7 @@ Ltac intro_pat_persistent p :=
| string => | string =>
let pat := intro_pat.parse p in let pat := intro_pat.parse p in
eval cbv in (forallb intro_pat_persistent pat) eval cbv in (forallb intro_pat_persistent pat)
| ident => false
| bool => p | bool => p
| ?X => fail "intro_pat_persistent:" p "has unexpected type" X | ?X => fail "intro_pat_persistent:" p "has unexpected type" X
end. end.
...@@ -8,9 +8,12 @@ Arguments Enil {_}. ...@@ -8,9 +8,12 @@ Arguments Enil {_}.
Arguments Esnoc {_} _%proof_scope _%string _%uPred_scope. Arguments Esnoc {_} _%proof_scope _%string _%uPred_scope.
Notation "" := Enil (only printing) : proof_scope. Notation "" := Enil (only printing) : proof_scope.
Notation "Γ H : P" := (Esnoc Γ H P) Notation "Γ H : P" := (Esnoc Γ (INamed H) P)
(at level 1, P at level 200, (at level 1, P at level 200,
left associativity, format "Γ H : P '//'", only printing) : proof_scope. left associativity, format "Γ H : P '//'", only printing) : proof_scope.
Notation "Γ '_' : P" := (Esnoc Γ (IAnon _) P)
(at level 1, P at level 200,
left associativity, format "Γ '_' : P '//'", only printing) : proof_scope.
Notation "Γ '--------------------------------------' □ Δ '--------------------------------------' ∗ Q" := Notation "Γ '--------------------------------------' □ Δ '--------------------------------------' ∗ Q" :=
(envs_entails (Envs Γ Δ) Q%I) (envs_entails (Envs Γ Δ) Q%I)
......
...@@ -6,7 +6,7 @@ Inductive sel_pat := ...@@ -6,7 +6,7 @@ Inductive sel_pat :=
| SelPure | SelPure
| SelPersistent | SelPersistent
| SelSpatial | SelSpatial
| SelName : string sel_pat. | SelIdent : ident sel_pat.
Fixpoint sel_pat_pure (ps : list sel_pat) : bool := Fixpoint sel_pat_pure (ps : list sel_pat) : bool :=
match ps with match ps with
...@@ -19,7 +19,7 @@ Module sel_pat. ...@@ -19,7 +19,7 @@ Module sel_pat.
Fixpoint parse_go (ts : list token) (k : list sel_pat) : option (list sel_pat) := Fixpoint parse_go (ts : list token) (k : list sel_pat) : option (list sel_pat) :=
match ts with match ts with