Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
George Pirlea
Iris
Commits
b6269993
Commit
b6269993
authored
Nov 13, 2017
by
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
Changes
12
Hide whitespace changes
Inline
Side-by-side
theories/base_logic/lib/invariants.v
View file @
b6269993
...
...
@@ -92,7 +92,7 @@ End inv.
Tactic
Notation
"iInvCore"
constr
(
N
)
"as"
tactic
(
tac
)
constr
(
Hclose
)
:
=
let
Htmp
:
=
iFresh
in
let
patback
:
=
intro_pat
.
parse_one
Hclose
in
let
pat
:
=
constr
:
(
IList
[[
I
Name
Htmp
;
patback
]])
in
let
pat
:
=
constr
:
(
IList
[[
I
Ident
Htmp
;
patback
]])
in
iMod
(
inv_open
_
N
with
"[#]"
)
as
pat
;
[
idtac
|
iAssumption
||
fail
"iInv: invariant"
N
"not found"
|
idtac
]
;
[
solve_ndisj
||
match
goal
with
|-
?P
=>
fail
"iInv: cannot solve"
P
end
...
...
theories/base_logic/lib/wsat.v
View file @
b6269993
...
...
@@ -104,7 +104,7 @@ Qed.
Lemma
ownI_open
i
P
:
wsat
∗
ownI
i
P
∗
ownE
{[
i
]}
⊢
wsat
∗
▷
P
∗
ownD
{[
i
]}.
Proof
.
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
(
big_opM_delete
_
_
i
with
"HI"
)
as
"[[[HQ $]|HiE'] HI]"
;
eauto
.
-
iSplitR
"HQ"
;
last
by
iNext
;
iRewrite
-
"HPQ"
.
...
...
@@ -115,7 +115,7 @@ Qed.
Lemma
ownI_close
i
P
:
wsat
∗
ownI
i
P
∗
▷
P
∗
ownD
{[
i
]}
⊢
wsat
∗
ownE
{[
i
]}.
Proof
.
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
(
big_opM_delete
_
_
i
with
"HI"
)
as
"[[[HQ ?]|$] HI]"
;
eauto
.
-
iDestruct
(
ownD_singleton_twice
with
"[$]"
)
as
%[].
...
...
@@ -128,7 +128,7 @@ Lemma ownI_alloc φ P :
wsat
∗
▷
P
==
∗
∃
i
,
⌜φ
i
⌝
∗
wsat
∗
ownI
i
P
.
Proof
.
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_updateP
with
"[$]"
)
as
"HE"
.
{
apply
(
gset_disj_alloc_empty_updateP_strong'
(
λ
i
,
I
!!
i
=
None
∧
φ
i
)).
...
...
@@ -150,7 +150,7 @@ Lemma ownI_alloc_open φ P :
(
∀
E
:
gset
positive
,
∃
i
,
i
∉
E
∧
φ
i
)
→
wsat
==
∗
∃
i
,
⌜φ
i
⌝
∗
(
ownE
{[
i
]}
-
∗
wsat
)
∗
ownI
i
P
∗
ownD
{[
i
]}.
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_updateP
with
"[$]"
)
as
"HD"
.
{
apply
(
gset_disj_alloc_empty_updateP_strong'
(
λ
i
,
I
!!
i
=
None
∧
φ
i
)).
...
...
theories/heap_lang/lib/ticket_lock.v
View file @
b6269993
...
...
@@ -153,7 +153,7 @@ Section proof.
wp_store
.
iDestruct
(
own_valid_2
with
"Hauth Hγo"
)
as
%[[<-%
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
%[[]
?].
}
iMod
(
own_update_2
with
"Hauth Hγo"
)
as
"[Hauth Hγo]"
.
{
apply
auth_update
,
prod_local_update_1
.
...
...
theories/proofmode/base.v
View file @
b6269993
...
...
@@ -49,3 +49,37 @@ Qed.
Lemma
string_beq_reflect
s1
s2
:
reflect
(
s1
=
s2
)
(
string_beq
s1
s2
).
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
.
theories/proofmode/coq_tactics.v
View file @
b6269993
From
iris
.
base_logic
Require
Export
base_logic
.
From
iris
.
base_logic
Require
Import
big_op
tactics
.
From
iris
.
proofmode
Require
Export
base
environments
classes
.
From
stdpp
Require
Import
stringmap
hlist
.
Set
Default
Proof
Using
"Type"
.
Import
uPred
.
Import
env_notations
.
...
...
@@ -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
)
}.
Definition
envs_dom
{
M
}
(
Δ
:
envs
M
)
:
list
string
:
=
Definition
envs_dom
{
M
}
(
Δ
:
envs
M
)
:
list
ident
:
=
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
match
env_lookup
i
Γ
p
with
|
Some
P
=>
Some
(
true
,
P
)
|
None
=>
P
←
env_lookup
i
Γ
s
;
Some
(
false
,
P
)
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
match
p
with
|
true
=>
Envs
(
env_delete
i
Γ
p
)
Γ
s
|
false
=>
Envs
Γ
p
(
env_delete
i
Γ
s
)
end
.
Definition
envs_lookup_delete
{
M
}
(
i
:
string
)
Definition
envs_lookup_delete
{
M
}
(
i
:
ident
)
(
Δ
:
envs
M
)
:
option
(
bool
*
uPred
M
*
envs
M
)
:
=
let
(
Γ
p
,
Γ
s
)
:
=
Δ
in
match
env_lookup_delete
i
Γ
p
with
...
...
@@ -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'
)
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
)
:
=
match
js
with
|
[]
=>
Some
(
true
,
[],
Δ
)
...
...
@@ -71,7 +70,7 @@ Fixpoint envs_lookup_delete_list {M} (js : list string) (remove_persistent : boo
end
.
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
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)
|
false
=>
_
←
env_app
Γ
Γ
p
;
Γ
s'
←
env_app
Γ
Γ
s
;
Some
(
Envs
Γ
p
Γ
s'
)
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
)
:
=
let
(
Γ
p
,
Γ
s
)
:
=
Δ
in
match
p
with
...
...
@@ -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'
)
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
)
:
=
if
eqb
p
q
then
envs_simple_replace
i
p
Γ
Δ
else
envs_app
q
Γ
(
envs_delete
i
p
Δ
).
...
...
@@ -106,7 +105,7 @@ Definition envs_clear_persistent {M} (Δ : envs M) : envs M :=
Envs
Enil
(
env_spatial
Δ
).
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
|
[]
=>
Some
(
Δ
1
,
Δ
2
)
|
j
::
js
=>
...
...
@@ -117,7 +116,7 @@ Fixpoint envs_split_go {M}
(* if [d = Right] then [result = (remaining hyps, hyps named js)] and
if [d = Left] then [result = (hyps named js, remaining hyps)] *)
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
Δ
)
;
if
d
is
Right
then
Some
(
Δ
1
,
Δ
2
)
else
Some
(
Δ
2
,
Δ
1
).
...
...
@@ -224,11 +223,11 @@ Proof.
apply
wand_intro_l
;
destruct
p
;
simpl
.
-
apply
sep_intro_True_l
;
[
apply
pure_intro
|].
+
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
.
-
apply
sep_intro_True_l
;
[
apply
pure_intro
|].
+
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
.
Qed
.
...
...
theories/proofmode/environments.v
View file @
b6269993
From
stdpp
Require
Export
strings
.
From
iris
.
proofmode
Require
Import
base
.
From
iris
.
algebra
Require
Export
base
.
From
stdpp
Require
Import
stringmap
.
Set
Default
Proof
Using
"Type"
.
Inductive
env
(
A
:
Type
)
:
Type
:
=
|
Enil
:
env
A
|
Esnoc
:
env
A
→
string
→
A
→
env
A
.
|
Esnoc
:
env
A
→
ident
→
A
→
env
A
.
Arguments
Enil
{
_
}.
Arguments
Esnoc
{
_
}
_
_
%
string
_
.
Arguments
Esnoc
{
_
}
_
_
_
.
Instance
:
Params
(@
Enil
)
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
|
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
.
Module
env_notations
.
...
...
@@ -37,7 +35,7 @@ Fixpoint env_to_list {A} (E : env A) : list A :=
Coercion
env_to_list
:
env
>->
list
.
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
.
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
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
|
Enil
=>
None
|
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
|
None
=>
Γ
'
←
env_replace
i
Γ
i
Γ
;
Some
(
Esnoc
Γ
'
j
x
)
|
Some
_
=>
None
end
end
.
Fixpoint
env_delete
{
A
}
(
i
:
string
)
(
Γ
:
env
A
)
:
env
A
:
=
Fixpoint
env_delete
{
A
}
(
i
:
ident
)
(
Γ
:
env
A
)
:
env
A
:
=
match
Γ
with
|
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
.
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
|
Enil
=>
None
|
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
)
end
.
...
...
@@ -88,15 +86,15 @@ Inductive env_subenv {A} : relation (env A) :=
Section
env
.
Context
{
A
:
Type
}.
Implicit
Types
Γ
:
env
A
.
Implicit
Types
i
:
string
.
Implicit
Types
i
:
ident
.
Implicit
Types
x
:
A
.
Hint
Resolve
Esnoc_wf
Enil_wf
.
Ltac
simplify
:
=
repeat
match
goal
with
|
_
=>
progress
simplify_eq
/=
|
H
:
context
[
string
_beq
?s1
?s2
]
|-
_
=>
destruct
(
string
_beq_reflect
s1
s2
)
|
|-
context
[
string
_beq
?s1
?s2
]
=>
destruct
(
string
_beq_reflect
s1
s2
)
|
H
:
context
[
ident
_beq
?s1
?s2
]
|-
_
=>
destruct
(
ident
_beq_reflect
s1
s2
)
|
|-
context
[
ident
_beq
?s1
?s2
]
=>
destruct
(
ident
_beq_reflect
s1
s2
)
|
_
=>
case_match
end
.
...
...
theories/proofmode/intro_patterns.v
View file @
b6269993
...
...
@@ -3,7 +3,7 @@ From iris.proofmode Require Import base tokens sel_patterns.
Set
Default
Proof
Using
"Type"
.
Inductive
intro_pat
:
=
|
I
Name
:
string
→
intro_pat
|
I
Ident
:
ident
→
intro_pat
|
IAnom
:
intro_pat
|
IDrop
:
intro_pat
|
IFrame
:
intro_pat
...
...
@@ -73,7 +73,7 @@ Fixpoint parse_go (ts : list token) (k : stack) : option stack :=
match
ts
with
|
[]
=>
Some
k
|
TName
"_"
::
ts
=>
parse_go
ts
(
SPat
IDrop
::
k
)
|
TName
s
::
ts
=>
parse_go
ts
(
SPat
(
I
Name
s
)
::
k
)
|
TName
s
::
ts
=>
parse_go
ts
(
SPat
(
I
Ident
s
)
::
k
)
|
TAnom
::
ts
=>
parse_go
ts
(
SPat
IAnom
::
k
)
|
TFrame
::
ts
=>
parse_go
ts
(
SPat
IFrame
::
k
)
|
TBracketL
::
ts
=>
parse_go
ts
(
SList
::
k
)
...
...
@@ -98,11 +98,11 @@ Fixpoint parse_go (ts : list token) (k : stack) : option stack :=
end
with
parse_clear
(
ts
:
list
token
)
(
k
:
stack
)
:
option
stack
:
=
match
ts
with
|
TFrame
::
TName
s
::
ts
=>
parse_clear
ts
(
SPat
(
IClearFrame
(
Sel
Name
s
))
::
k
)
|
TFrame
::
TName
s
::
ts
=>
parse_clear
ts
(
SPat
(
IClearFrame
(
Sel
Ident
s
))
::
k
)
|
TFrame
::
TPure
::
ts
=>
parse_clear
ts
(
SPat
(
IClearFrame
SelPure
)
::
k
)
|
TFrame
::
TAlways
::
ts
=>
parse_clear
ts
(
SPat
(
IClearFrame
SelPersistent
)
::
k
)
|
TFrame
::
TSep
::
ts
=>
parse_clear
ts
(
SPat
(
IClearFrame
SelSpatial
)
::
k
)
|
TName
s
::
ts
=>
parse_clear
ts
(
SPat
(
IClear
(
Sel
Name
s
))
::
k
)
|
TName
s
::
ts
=>
parse_clear
ts
(
SPat
(
IClear
(
Sel
Ident
s
))
::
k
)
|
TPure
::
ts
=>
parse_clear
ts
(
SPat
(
IClear
SelPure
)
::
k
)
|
TAlways
::
ts
=>
parse_clear
ts
(
SPat
(
IClear
SelPersistent
)
::
k
)
|
TSep
::
ts
=>
parse_clear
ts
(
SPat
(
IClear
SelSpatial
)
::
k
)
...
...
@@ -134,6 +134,7 @@ Ltac parse s :=
lazymatch
eval
vm_compute
in
(
parse
s
)
with
|
Some
?pats
=>
pats
|
_
=>
fail
"invalid list intro_pat"
s
end
|
ident
=>
constr
:
([
IIdent
s
])
|
?X
=>
fail
"intro_pat.parse:"
s
"has unexpected type"
X
end
.
Ltac
parse_one
s
:
=
...
...
@@ -165,6 +166,7 @@ Ltac intro_pat_persistent p :=
|
string
=>
let
pat
:
=
intro_pat
.
parse
p
in
eval
cbv
in
(
forallb
intro_pat_persistent
pat
)
|
ident
=>
false
|
bool
=>
p
|
?X
=>
fail
"intro_pat_persistent:"
p
"has unexpected type"
X
end
.
theories/proofmode/notation.v
View file @
b6269993
...
...
@@ -8,9 +8,12 @@ Arguments Enil {_}.
Arguments
Esnoc
{
_
}
_
%
proof_scope
_
%
string
_
%
uPred_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
,
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"
:
=
(
envs_entails
(
Envs
Γ
Δ
)
Q
%
I
)
...
...
theories/proofmode/sel_patterns.v
View file @
b6269993
...
...
@@ -6,7 +6,7 @@ Inductive sel_pat :=
|
SelPure
|
SelPersistent
|
SelSpatial
|
Sel
Name
:
string
→
sel_pat
.
|
Sel
Ident
:
ident
→
sel_pat
.
Fixpoint
sel_pat_pure
(
ps
:
list
sel_pat
)
:
bool
:
=
match
ps
with
...
...
@@ -19,7 +19,7 @@ Module sel_pat.
Fixpoint
parse_go
(
ts
:
list
token
)
(
k
:
list
sel_pat
)
:
option
(
list
sel_pat
)
:
=
match
ts
with
|
[]
=>
Some
(
reverse
k
)
|
TName
s
::
ts
=>
parse_go
ts
(
Sel
Name
s
::
k
)
|
TName
s
::
ts
=>
parse_go
ts
(
Sel
Ident
s
::
k
)
|
TPure
::
ts
=>
parse_go
ts
(
SelPure
::
k
)
|
TAlways
::
ts
=>
parse_go
ts
(
SelPersistent
::
k
)
|
TSep
::
ts
=>
parse_go
ts
(
SelSpatial
::
k
)
...
...
@@ -32,7 +32,9 @@ Ltac parse s :=
lazymatch
type
of
s
with
|
sel_pat
=>
constr
:
([
s
])
|
list
sel_pat
=>
s
|
list
string
=>
eval
vm_compute
in
(
SelName
<$>
s
)
|
ident
=>
constr
:
([
SelIdent
s
])
|
list
ident
=>
eval
vm_compute
in
(
SelIdent
<$>
s
)
|
list
string
=>
eval
vm_compute
in
(
SelIdent
∘
INamed
<$>
s
)
|
string
=>
lazymatch
eval
vm_compute
in
(
parse
s
)
with
|
Some
?pats
=>
pats
|
_
=>
fail
"invalid sel_pat"
s
...
...
theories/proofmode/spec_patterns.v
View file @
b6269993
From
stdpp
Require
Export
strings
.
From
iris
.
proofmode
Require
Import
tokens
.
From
iris
.
proofmode
Require
Import
base
tokens
.
Set
Default
Proof
Using
"Type"
.
Inductive
goal_kind
:
=
GSpatial
|
GModal
|
GPersistent
.
...
...
@@ -7,14 +7,14 @@ Inductive goal_kind := GSpatial | GModal | GPersistent.
Record
spec_goal
:
=
SpecGoal
{
spec_goal_kind
:
goal_kind
;
spec_goal_negate
:
bool
;
spec_goal_frame
:
list
string
;
spec_goal_hyps
:
list
string
;
spec_goal_frame
:
list
ident
;
spec_goal_hyps
:
list
ident
;
spec_goal_done
:
bool
}.
Inductive
spec_pat
:
=
|
SForall
:
spec_pat
|
S
Name
:
string
→
spec_pat
|
S
Ident
:
ident
→
spec_pat
|
SPureGoal
:
bool
→
spec_pat
|
SGoal
:
spec_goal
→
spec_pat
|
SAutoFrame
:
goal_kind
→
spec_pat
.
...
...
@@ -36,7 +36,7 @@ Inductive state :=
Fixpoint
parse_go
(
ts
:
list
token
)
(
k
:
list
spec_pat
)
:
option
(
list
spec_pat
)
:
=
match
ts
with
|
[]
=>
Some
(
reverse
k
)
|
TName
s
::
ts
=>
parse_go
ts
(
S
Name
s
::
k
)
|
TName
s
::
ts
=>
parse_go
ts
(
S
Ident
s
::
k
)
|
TBracketL
::
TAlways
::
TFrame
::
TBracketR
::
ts
=>
parse_go
ts
(
SAutoFrame
GPersistent
::
k
)
|
TBracketL
::
TFrame
::
TBracketR
::
ts
=>
...
...
@@ -52,14 +52,14 @@ Fixpoint parse_go (ts : list token) (k : list spec_pat) : option (list spec_pat)
|
_
=>
None
end
with
parse_goal
(
ts
:
list
token
)
(
ki
:
goal_kind
)
(
neg
:
bool
)
(
frame
hyps
:
list
string
)
(
ki
:
goal_kind
)
(
neg
:
bool
)
(
frame
hyps
:
list
ident
)
(
k
:
list
spec_pat
)
:
option
(
list
spec_pat
)
:
=
match
ts
with
|
TMinus
::
ts
=>
guard
(
¬
neg
∧
frame
=
[]
∧
hyps
=
[])
;
parse_goal
ts
ki
true
frame
hyps
k
|
TName
s
::
ts
=>
parse_goal
ts
ki
neg
frame
(
s
::
hyps
)
k
|
TFrame
::
TName
s
::
ts
=>
parse_goal
ts
ki
neg
(
s
::
frame
)
hyps
k
|
TName
s
::
ts
=>
parse_goal
ts
ki
neg
frame
(
INamed
s
::
hyps
)
k
|
TFrame
::
TName
s
::
ts
=>
parse_goal
ts
ki
neg
(
INamed
s
::
frame
)
hyps
k
|
TDone
::
TBracketR
::
ts
=>
parse_go
ts
(
SGoal
(
SpecGoal
ki
neg
(
reverse
frame
)
(
reverse
hyps
)
true
)
::
k
)
|
TBracketR
::
ts
=>
...
...
@@ -76,11 +76,4 @@ Ltac parse s :=
|
Some
?pats
=>
pats
|
_
=>
fail
"invalid list spec_pat"
s
end
end
.
Ltac
parse_one
s
:
=
lazymatch
type
of
s
with
|
spec_pat
=>
s
|
string
=>
lazymatch
eval
vm_compute
in
(
parse
s
)
with
|
Some
[
?pat
]
=>
pat
|
_
=>
fail
"invalid spec_pat"
s
end
end
.
End
spec_pat
.
theories/proofmode/tactics.v
View file @
b6269993
...
...
@@ -3,11 +3,12 @@ From iris.proofmode Require Import base intro_patterns spec_patterns sel_pattern
From
iris
.
base_logic
Require
Export
base_logic
big_op
.
From
iris
.
proofmode
Require
Export
classes
notation
.
From
iris
.
proofmode
Require
Import
class_instances
.
From
stdpp
Require
Import
stringmap
hlist
.
From
stdpp
Require
Import
hlist
pretty
.
Set
Default
Proof
Using
"Type"
.
Export
ident
.
Declare
Reduction
env_cbv
:
=
cbv
[
beq
ascii_beq
string_beq
beq
ascii_beq
string_beq
positive_beq
ident_beq
env_lookup
env_lookup_delete
env_delete
env_app
env_replace
env_dom
env_persistent
env_spatial
env_spatial_is_nil
envs_dom
envs_lookup
envs_lookup_delete
envs_delete
envs_snoc
envs_app
...
...
@@ -20,16 +21,19 @@ Ltac env_reflexivity := env_cbv; exact eq_refl.
(** * Misc *)
(* Tactic Notation tactics cannot return terms *)
Ltac
iFresh
'
H
:
=
Ltac
iFresh
:
=
lazymatch
goal
with
|-
envs_entails
?
Δ
_
=>
(* [vm_compute fails] if any of the hypotheses in [Δ] contain evars, so
first use [cbv] to compute the domain of [Δ] *)
let
Hs
:
=
eval
cbv
in
(
envs_dom
Δ
)
in
eval
vm_compute
in
(
fresh_string_of_set
H
(
of_list
Hs
))
|
_
=>
H
eval
vm_compute
in
(
IAnon
(
match
Hs
with
|
[]
=>
1
|
_
=>
1
+
foldr
Pos
.
max
1
(
omap
(
maybe
IAnon
)
Hs
)
end
))%
positive
|
_
=>
constr
:
(
IAnon
1
)
end
.
Ltac
iFresh
:
=
iFresh'
"~"
.
Ltac
iMissingHyps
Hs
:
=
let
Δ
:
=
...
...
@@ -83,7 +87,7 @@ Tactic Notation "iRename" constr(H1) "into" constr(H2) :=
Local
Inductive
esel_pat
:
=
|
ESelPure
|
ESel
Name
:
bool
→
string
→
esel_pat
.
|
ESel
Ident
:
bool
→
ident
→
esel_pat
.
Ltac
iElaborateSelPat
pat
:
=
let
rec
go
pat
Δ
Hs
:
=
...
...
@@ -93,14 +97,14 @@ Ltac iElaborateSelPat pat :=
|
SelPersistent
::
?pat
=>
let
Hs'
:
=
eval
env_cbv
in
(
env_dom
(
env_persistent
Δ
))
in
let
Δ
'
:
=
eval
env_cbv
in
(
envs_clear_persistent
Δ
)
in
go
pat
Δ
'
((
ESel
Name
true
<$>
Hs'
)
++
Hs
)
go
pat
Δ
'
((
ESel
Ident
true
<$>
Hs'
)
++
Hs
)
|
SelSpatial
::
?pat
=>
let
Hs'
:
=
eval
env_cbv
in
(
env_dom
(
env_spatial
Δ
))
in
let
Δ
'
:
=
eval
env_cbv
in
(
envs_clear_spatial
Δ
)
in
go
pat
Δ
'
((
ESel
Name
false
<$>
Hs'
)
++
Hs
)
|
Sel
Name
?H
::
?pat
=>
go
pat
Δ
'
((
ESel
Ident
false
<$>
Hs'
)
++
Hs
)
|
Sel
Ident
?H
::
?pat
=>
lazymatch
eval
env_cbv
in
(
envs_lookup_delete
H
Δ
)
with
|
Some
(
?p
,
_
,?
Δ
'
)
=>
go
pat
Δ
'
(
ESel
Name
p
H
::
Hs
)
|
Some
(
?p
,
_
,?
Δ
'
)
=>
go
pat
Δ
'
(
ESel
Ident
p
H
::
Hs
)
|
None
=>
fail
"iElaborateSelPat:"
H
"not found"
end
end
in
...
...
@@ -109,14 +113,16 @@ Ltac iElaborateSelPat pat :=
let
pat
:
=
sel_pat
.
parse
pat
in
go
pat
Δ
(@
nil
esel_pat
)
end
.
Local
Ltac
iClearHyp
H
:
=
eapply
tac_clear
with
_
H
_
_;
(* (i:=H) *)
[
env_reflexivity
||
fail
"iClear:"
H
"not found"
|].
Tactic
Notation
"iClear"
constr
(
Hs
)
:
=
let
rec
go
Hs
:
=
lazymatch
Hs
with
|
[]
=>
idtac
|
ESelPure
::
?Hs
=>
clear
;
go
Hs
|
ESelName
_
?H
::
?Hs
=>
eapply
tac_clear
with
_
H
_
_;
(* (i:=H) *)
[
env_reflexivity
||
fail
"iClear:"
H
"not found"
|
go
Hs
]
|
ESelIdent
_
?H
::
?Hs
=>
iClearHyp
H
;
go
Hs
end
in
let
Hs
:
=
iElaborateSelPat
Hs
in
go
Hs
.
...
...
@@ -260,7 +266,7 @@ Tactic Notation "iFrame" constr(Hs) :=
|
SelPure
::
?Hs
=>
iFrameAnyPure
;
go
Hs
|
SelPersistent
::
?Hs
=>
iFrameAnyPersistent
;
go
Hs
|
SelSpatial
::
?Hs
=>
iFrameAnySpatial
;
go
Hs
|
Sel
Name
?H
::
?Hs
=>
iFrameHyp
H
;
go
Hs
|
Sel
Ident
?H
::
?Hs
=>
iFrameHyp
H
;
go
Hs
end
in
let
Hs
:
=
sel_pat
.
parse
Hs
in
go
Hs
.
Tactic
Notation
"iFrame"
"("
constr
(
t1
)
")"
constr
(
Hs
)
:
=
...
...
@@ -406,7 +412,7 @@ Local Tactic Notation "iSpecializePat" open_constr(H) constr(pat) :=
|
SForall
::
?pats
=>
idtac
"the * specialization pattern is deprecated because it is applied implicitly"
;
go
H1
pats
|
S
Name
?H2
::
?pats
=>
|
S
Ident
?H2
::
?pats
=>
eapply
tac_specialize
with
_
_
H2
_
H1
_
_
_
_;
(* (j:=H1) (i:=H2) *)
[
env_reflexivity
||
fail
"iSpecialize:"
H2
"not found"