Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Marianna Rapoport
iriscoq
Commits
f351a117
Commit
f351a117
authored
Jan 25, 2017
by
Ralf Jung
Browse files
Merge branch 'master' of
https://gitlab.mpisws.org/FP/iriscoq
parents
b4edc070
76fb6fa5
Changes
43
Hide whitespace changes
Inline
Sidebyside
Showing
3 changed files
with
92 additions
and
23 deletions
+92
23
theories/program_logic/weakestpre.v
theories/program_logic/weakestpre.v
+2
2
theories/proofmode/class_instances.v
theories/proofmode/class_instances.v
+6
0
theories/proofmode/tactics.v
theories/proofmode/tactics.v
+84
21
No files found.
theories/program_logic/weakestpre.v
View file @
f351a117
...
...
@@ 155,10 +155,10 @@ Proof.
{
by
iDestruct
"H"
as
">>> $"
.
}
iIntros
(
σ
1
)
"Hσ"
.
iMod
"H"
.
iMod
(
"H"
$!
σ
1
with
"Hσ"
)
as
"[$ H]"
.
iModIntro
.
iNext
.
iIntros
(
e2
σ
2
efs
Hstep
).
iMod
(
"H"
with
"
*
[]"
)
as
"(Hphy & H & $)"
;
first
done
.
iMod
(
"H"
with
"[]"
)
as
"(Hphy & H & $)"
;
first
done
.
rewrite
!
wp_unfold
/
wp_pre
.
destruct
(
to_val
e2
)
as
[
v2
]
eqn
:
He2
.

iDestruct
"H"
as
">> $"
.
iFrame
.
eauto
.

iMod
(
"H"
with
"
*
Hphy"
)
as
"[H _]"
.

iMod
(
"H"
with
"Hphy"
)
as
"[H _]"
.
iDestruct
"H"
as
%(?
&
?
&
?
&
?).
by
edestruct
(
Hatomic
_
_
_
_
Hstep
).
Qed
.
...
...
theories/proofmode/class_instances.v
View file @
f351a117
...
...
@@ 21,6 +21,9 @@ Proof. rewrite /FromAssumption=><. by rewrite always_always. Qed.
Global
Instance
from_assumption_bupd
p
P
Q
:
FromAssumption
p
P
Q
→
FromAssumption
p
P
(==>
Q
)%
I
.
Proof
.
rewrite
/
FromAssumption
=>>.
apply
bupd_intro
.
Qed
.
Global
Instance
from_assumption_forall
{
A
}
p
(
Φ
:
A
→
uPred
M
)
Q
x
:
FromAssumption
p
(
Φ
x
)
Q
→
FromAssumption
p
(
∀
x
,
Φ
x
)
Q
.
Proof
.
rewrite
/
FromAssumption
=>
<.
by
rewrite
forall_elim
.
Qed
.
(* IntoPure *)
Global
Instance
into_pure_pure
φ
:
@
IntoPure
M
⌜φ⌝
φ
.
...
...
@@ 217,6 +220,9 @@ Proof. by apply and_elim_l', impl_wand. Qed.
Global
Instance
into_wand_iff_r
P
Q
:
IntoWand
(
P
↔
Q
)
Q
P
.
Proof
.
apply
and_elim_r'
,
impl_wand
.
Qed
.
Global
Instance
into_wand_forall
{
A
}
(
Φ
:
A
→
uPred
M
)
P
Q
x
:
IntoWand
(
Φ
x
)
P
Q
→
IntoWand
(
∀
x
,
Φ
x
)
P
Q
.
Proof
.
rewrite
/
IntoWand
=>
<.
apply
forall_elim
.
Qed
.
Global
Instance
into_wand_always
R
P
Q
:
IntoWand
R
P
Q
→
IntoWand
(
□
R
)
P
Q
.
Proof
.
rewrite
/
IntoWand
=>
>.
apply
always_elim
.
Qed
.
...
...
theories/proofmode/tactics.v
View file @
f351a117
...
...
@@ 285,7 +285,9 @@ Local Tactic Notation "iSpecializePat" constr(H) constr(pat) :=
let
rec
go
H1
pats
:
=
lazymatch
pats
with

[]
=>
idtac

SForall
::
?pats
=>
try
(
iSpecializeArgs
H1
(
hcons
_
_
))
;
go
H1
pats

SForall
::
?pats
=>
idtac
"the * specialization pattern is deprecated because it is applied implicitly"
;
go
H1
pats

SName
?H2
::
?pats
=>
eapply
tac_specialize
with
_
_
H2
_
H1
_
_
_
_;
(* (j:=H1) (i:=H2) *)
[
env_cbv
;
reflexivity

fail
"iSpecialize:"
H2
"not found"
...
...
@@ 333,6 +335,8 @@ introduction pattern, which will be coerced into [true] when it solely contains
`#` or `%` patterns at the toplevel. *)
Tactic
Notation
"iSpecializeCore"
open_constr
(
t
)
"as"
constr
(
p
)
:
=
let
p
:
=
intro_pat_persistent
p
in
let
t
:
=
match
type
of
t
with
string
=>
constr
:
(
ITrm
t
hnil
""
)

_
=>
t
end
in
lazymatch
t
with

ITrm
?H
?xs
?pat
=>
lazymatch
type
of
H
with
...
...
@@ 349,6 +353,7 @@ Tactic Notation "iSpecializeCore" open_constr(t) "as" constr(p) :=
end

_
=>
fail
"iSpecialize:"
H
"should be a hypothesis, use iPoseProof instead"
end

_
=>
fail
"iSpecialize:"
t
"should be a proof mode term"
end
.
Tactic
Notation
"iSpecialize"
open_constr
(
t
)
:
=
...
...
@@ 421,11 +426,6 @@ Tactic Notation "iPoseProof" open_constr(lem) "as" constr(H) :=
(** * Apply *)
Tactic
Notation
"iApply"
open_constr
(
lem
)
:
=
let
lem
:
=
(* add a `*` to specialize all toplevel foralls *)
lazymatch
lem
with

ITrm
?t
?xs
?pat
=>
constr
:
(
ITrm
t
xs
(
"*"
+
:
+
pat
))

_
=>
constr
:
(
ITrm
lem
hnil
"*"
)
end
in
let
rec
go
H
:
=
first
[
eapply
tac_apply
with
_
H
_
_
_;
[
env_cbv
;
reflexivity
...
...
@@ 961,27 +961,59 @@ Tactic Notation "iRevertIntros" "(" ident(x1) ident(x2) ident(x3) ident(x4)
iRevertIntros
(
x1
x2
x3
x4
x5
x6
x7
x8
)
""
with
tac
.
(** * Destruct tactic *)
Class
CopyDestruct
{
M
}
(
P
:
uPred
M
).
Hint
Mode
CopyDestruct
+
!
:
typeclass_instances
.
Instance
copy_destruct_forall
{
M
A
}
(
Φ
:
A
→
uPred
M
)
:
CopyDestruct
(
∀
x
,
Φ
x
).
Instance
copy_destruct_impl
{
M
}
(
P
Q
:
uPred
M
)
:
CopyDestruct
Q
→
CopyDestruct
(
P
→
Q
).
Instance
copy_destruct_wand
{
M
}
(
P
Q
:
uPred
M
)
:
CopyDestruct
Q
→
CopyDestruct
(
P

∗
Q
).
Instance
copy_destruct_always
{
M
}
(
P
:
uPred
M
)
:
CopyDestruct
P
→
CopyDestruct
(
□
P
).
Tactic
Notation
"iDestructCore"
open_constr
(
lem
)
"as"
constr
(
p
)
tactic
(
tac
)
:
=
let
hyp_name
:
=
lazymatch
type
of
lem
with

string
=>
constr
:
(
Some
lem
)

iTrm
=>
lazymatch
lem
with

@
iTrm
string
?H
_
_
=>
constr
:
(
Some
H
)

_
=>
constr
:
(@
None
string
)
end

_
=>
constr
:
(@
None
string
)
end
in
let
intro_destruct
n
:
=
let
rec
go
n'
:
=
lazymatch
n'
with

0
=>
fail
"iDestruct: cannot introduce"
n
"hypotheses"

1
=>
repeat
iIntroForall
;
let
H
:
=
iFresh
in
iIntro
H
;
tac
H

S
?n'
=>
repeat
iIntroForall
;
let
H
:
=
iFresh
in
iIntro
H
;
go
n'
end
in
intros
;
iStartProof
;
go
n
in
end
in
intros
;
iStartProof
;
go
n
in
lazymatch
type
of
lem
with

nat
=>
intro_destruct
lem

Z
=>
(* to make it work in Z_scope. We should just be able to bind
tactic notation arguments to notation scopes. *)
let
n
:
=
eval
compute
in
(
Z
.
to_nat
lem
)
in
intro_destruct
n

string
=>
tac
lem

iTrm
=>
(* only copy the hypothesis when universal quantifiers are instantiated *)
lazymatch
lem
with

@
iTrm
string
?H
_
hnil
?pat
=>
iSpecializeCore
lem
as
p
;
last
tac

_
=>
iPoseProofCore
lem
as
p
false
tac

_
=>
(* Only copy the hypothesis in case there is a [CopyDestruct] instance.
Also, rule out cases in which it does not make sense to copy, namely when
destructing a lemma (instead of a hypothesis) or a spatial hyopthesis
(which cannot be kept). *)
lazymatch
hyp_name
with

None
=>
iPoseProofCore
lem
as
p
false
tac

Some
?H
=>
iTypeOf
H
(
fun
q
P
=>
lazymatch
q
with

true
=>
(* persistent hypothesis, check for a CopyDestruct instance *)
tryif
(
let
dummy
:
=
constr
:
(
_
:
CopyDestruct
P
)
in
idtac
)
then
(
iPoseProofCore
lem
as
p
false
tac
)
else
(
iSpecializeCore
lem
as
p
;
last
(
tac
H
))

false
=>
(* spatial hypothesis, cannot copy *)
iSpecializeCore
lem
as
p
;
last
(
tac
H
)
end
)
end

_
=>
iPoseProofCore
lem
as
p
false
tac
end
.
Tactic
Notation
"iDestruct"
open_constr
(
lem
)
"as"
constr
(
pat
)
:
=
...
...
@@ 1166,8 +1198,8 @@ Tactic Notation "iLöb" "as" constr (IH) "forall" "(" ident(x1) ident(x2)
(** * Assert *)
(* The argument [p] denotes whether [Q] is persistent. It can either be a
Boolean or an introduction pattern, which will be coerced into [true]
when
it
only contains `#` or `%` patterns at the toplevel. *)
Boolean or an introduction pattern, which will be coerced into [true]
if
it
only contains `#` or `%` patterns at the toplevel
, and [false] otherwise
. *)
Tactic
Notation
"iAssertCore"
open_constr
(
Q
)
"with"
constr
(
Hs
)
"as"
constr
(
p
)
tactic
(
tac
)
:
=
iStartProof
;
...
...
@@ 1205,15 +1237,46 @@ Tactic Notation "iAssertCore" open_constr(Q)
end

?pat
=>
fail
"iAssert: invalid pattern"
pat
end
.
Tactic
Notation
"iAssertCore"
open_constr
(
Q
)
"as"
constr
(
p
)
tactic
(
tac
)
:
=
let
p
:
=
intro_pat_persistent
p
in
match
p
with

true
=>
iAssertCore
Q
with
"[]"
as
p
tac

false
=>
iAssertCore
Q
with
"[]"
as
p
tac
end
.
Tactic
Notation
"iAssert"
open_constr
(
Q
)
"with"
constr
(
Hs
)
"as"
constr
(
pat
)
:
=
iAssertCore
Q
with
Hs
as
pat
(
fun
H
=>
iDestructHyp
H
as
pat
).
Tactic
Notation
"iAssert"
open_constr
(
Q
)
"with"
constr
(
Hs
)
"as"
"("
simple_intropattern
(
x1
)
")"
constr
(
pat
)
:
=
iAssertCore
Q
with
Hs
as
pat
(
fun
H
=>
iDestructHyp
H
as
(
x1
)
pat
).
Tactic
Notation
"iAssert"
open_constr
(
Q
)
"with"
constr
(
Hs
)
"as"
"("
simple_intropattern
(
x1
)
simple_intropattern
(
x2
)
")"
constr
(
pat
)
:
=
iAssertCore
Q
with
Hs
as
pat
(
fun
H
=>
iDestructHyp
H
as
(
x1
x2
)
pat
).
Tactic
Notation
"iAssert"
open_constr
(
Q
)
"with"
constr
(
Hs
)
"as"
"("
simple_intropattern
(
x1
)
simple_intropattern
(
x2
)
simple_intropattern
(
x3
)
")"
constr
(
pat
)
:
=
iAssertCore
Q
with
Hs
as
pat
(
fun
H
=>
iDestructHyp
H
as
(
x1
x2
x3
)
pat
).
Tactic
Notation
"iAssert"
open_constr
(
Q
)
"with"
constr
(
Hs
)
"as"
"("
simple_intropattern
(
x1
)
simple_intropattern
(
x2
)
simple_intropattern
(
x3
)
simple_intropattern
(
x4
)
")"
constr
(
pat
)
:
=
iAssertCore
Q
with
Hs
as
pat
(
fun
H
=>
iDestructHyp
H
as
(
x1
x2
x3
x4
)
pat
).
Tactic
Notation
"iAssert"
open_constr
(
Q
)
"as"
constr
(
pat
)
:
=
let
p
:
=
intro_pat_persistent
pat
in
match
p
with

true
=>
iAssert
Q
with
"[]"
as
pat

false
=>
iAssert
Q
with
"[]"
as
pat
end
.
iAssertCore
Q
as
pat
(
fun
H
=>
iDestructHyp
H
as
pat
).
Tactic
Notation
"iAssert"
open_constr
(
Q
)
"as"
"("
simple_intropattern
(
x1
)
")"
constr
(
pat
)
:
=
iAssertCore
Q
as
pat
(
fun
H
=>
iDestructHyp
H
as
(
x1
)
pat
).
Tactic
Notation
"iAssert"
open_constr
(
Q
)
"as"
"("
simple_intropattern
(
x1
)
simple_intropattern
(
x2
)
")"
constr
(
pat
)
:
=
iAssertCore
Q
as
pat
(
fun
H
=>
iDestructHyp
H
as
(
x1
x2
)
pat
).
Tactic
Notation
"iAssert"
open_constr
(
Q
)
"as"
"("
simple_intropattern
(
x1
)
simple_intropattern
(
x2
)
simple_intropattern
(
x3
)
")"
constr
(
pat
)
:
=
iAssertCore
Q
as
pat
(
fun
H
=>
iDestructHyp
H
as
(
x1
x2
x3
)
pat
).
Tactic
Notation
"iAssert"
open_constr
(
Q
)
"as"
"("
simple_intropattern
(
x1
)
simple_intropattern
(
x2
)
simple_intropattern
(
x3
)
simple_intropattern
(
x4
)
")"
constr
(
pat
)
:
=
iAssertCore
Q
as
pat
(
fun
H
=>
iDestructHyp
H
as
(
x1
x2
x3
x4
)
pat
).
Tactic
Notation
"iAssert"
open_constr
(
Q
)
"with"
constr
(
Hs
)
"as"
"%"
simple_intropattern
(
pat
)
:
=
...
...
Prev
1
2
3
Next
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment