Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Jonas Kastberg
iris
Commits
48ccc290
Commit
48ccc290
authored
Feb 16, 2016
by
Robbert Krebbers
Browse files
Preliminary version of tactics for automatically applying wp rules.
parent
332f96de
Changes
3
Hide whitespace changes
Inline
Side-by-side
_CoqProject
View file @
48ccc290
...
...
@@ -70,6 +70,7 @@ program_logic/auth.v
program_logic/sts.v
heap_lang/heap_lang.v
heap_lang/tactics.v
heap_lang/wp_tactics.v
heap_lang/lifting.v
heap_lang/derived.v
heap_lang/heap.v
...
...
heap_lang/tests.v
View file @
48ccc290
(** This file is essentially a bunch of testcases. *)
From
program_logic
Require
Import
ownership
.
From
heap_lang
Require
Import
substitution
tactics
heap
notation
.
From
heap_lang
Require
Import
wp_
tactics
heap
notation
.
Import
uPred
.
Section
LangTests
.
...
...
@@ -62,48 +62,31 @@ Section LiftingTests.
revert
n1
;
apply
l
ö
b_all_1
=>
n1
.
rewrite
(
comm
uPred_and
(
■
_
)%
I
)
assoc
;
apply
const_elim_r
=>?.
(* first need to do the rec to get a later *)
rewrite
-(
wp_bindi
(
AppLCtx
_
))
/=.
rewrite
-
wp_rec
//
=>-/=
;
rewrite
-
wp_value
//=.
wp_rec
!.
(* FIXME: ssr rewrite fails with "Error: _pattern_value_ is used in conclusion." *)
rewrite
->(
later_intro
(
Q
_
)).
rewrite
-!
later_and
;
apply
later_mono
.
(* Go on *)
rewrite
-
wp_let
//=
-
later_intro
.
rewrite
-(
wp_bindi
(
LetCtx
_
_
))
-
wp_bin_op
//=
-
wp_let'
//=
-!
later_intro
.
rewrite
-(
wp_bindi
(
IfCtx
_
_
))
/=.
apply
wp_lt
=>
?.
-
rewrite
-
wp_if_true
-!
later_intro
.
rewrite
(
forall_elim
(
n1
+
1
))
const_equiv
;
last
omega
.
rewrite
->(
later_intro
(
Q
_
))
;
rewrite
-!
later_and
;
apply
later_mono
.
wp_rec
.
wp_bin_op
.
wp_rec
.
wp_bin_op
=>
?.
-
wp_if
.
rewrite
(
forall_elim
(
n1
+
1
))
const_equiv
;
last
omega
.
by
rewrite
left_id
impl_elim_l
.
-
assert
(
n1
=
n2
-
1
)
as
->
by
omega
.
rewrite
-
wp_if_false
-!
later_intro
.
by
rewrite
-
wp_value
//
and_elim_r
.
wp_if
.
wp_value
.
auto
with
I
.
Qed
.
Lemma
Pred_spec
n
E
Q
:
▷
Q
(
LitV
(
n
-
1
))
⊑
wp
E
(
Pred
'
n
)%
L
Q
.
Proof
.
rewrite
-
wp_lam
//=.
rewrite
-(
wp_bindi
(
IfCtx
_
_
))
/=.
apply
later_mono
,
wp_le
=>
Hn
.
-
rewrite
-
wp_if_true
.
rewrite
-(
wp_bindi
(
UnOpCtx
_
))
/=.
rewrite
-(
wp_bind
[
AppLCtx
_;
AppRCtx
_
])
/=.
rewrite
-(
wp_bindi
(
BinOpLCtx
_
_
))
/=.
rewrite
-
wp_un_op
//=.
rewrite
-
wp_bin_op
//=
-!
later_intro
.
rewrite
-
FindPred_spec
.
apply
and_intro
;
first
by
(
apply
const_intro
;
omega
).
rewrite
-
wp_un_op
//=
-
later_intro
.
by
assert
(
n
-
1
=
-
(-
n
+
2
-
1
))
as
->
by
omega
.
-
rewrite
-
wp_if_false
-!
later_intro
.
rewrite
-
FindPred_spec
.
auto
using
and_intro
,
const_intro
with
omega
.
wp_rec
!
;
apply
later_mono
;
wp_bin_op
=>
?.
-
wp_if
.
wp_un_op
.
wp_bin_op
.
wp_focus
(
FindPred
_
_
)
;
rewrite
-
FindPred_spec
.
apply
and_intro
;
first
auto
with
I
omega
.
wp_un_op
.
by
replace
(
n
-
1
)
with
(-
(-
n
+
2
-
1
))
by
omega
.
-
wp_if
.
rewrite
-
FindPred_spec
.
auto
with
I
omega
.
Qed
.
Goal
∀
E
,
True
⊑
wp
(
Σ
:
=
globalF
Σ
)
E
(
let
:
"x"
:
=
Pred
'
42
in
Pred
"x"
)
(
λ
v
,
v
=
'
40
).
Proof
.
intros
E
.
rewrite
-(
wp_bindi
(
LetCtx
_
_
))
-
Pred_spec
//=
-
wp_let'
//=
.
by
rewrite
-
Pred_spec
-
!
later_intro
/=
.
wp_focus
(
Pred
'
42
)
;
rewrite
-
Pred_spec
-
later_intro
.
wp_rec
.
rewrite
-
Pred_spec
-
later_intro
;
auto
with
I
.
Qed
.
End
LiftingTests
.
heap_lang/wp_tactics.v
0 → 100644
View file @
48ccc290
From
heap_lang
Require
Export
tactics
substitution
.
Import
uPred
.
Ltac
wp_strip_later
:
=
match
goal
with
|
|-
∀
_
,
_
=>
let
H
:
=
fresh
in
intro
H
;
wp_strip_later
;
revert
H
|
|-
_
⊑
▷
_
=>
etransitivity
;
[|
apply
later_intro
]
end
.
Ltac
wp_bind
K
:
=
lazymatch
eval
hnf
in
K
with
|
[]
=>
idtac
|
_
=>
etransitivity
;
[|
apply
(
wp_bind
K
)]
;
simpl
end
.
Tactic
Notation
"wp_value"
:
=
match
goal
with
|
|-
_
⊑
wp
?E
?e
?Q
=>
etransitivity
;
[|
by
eapply
wp_value
]
;
simpl
end
.
Tactic
Notation
"wp_rec"
"!"
:
=
repeat
wp_value
;
match
goal
with
|
|-
_
⊑
wp
?E
?e
?Q
=>
reshape_expr
e
ltac
:
(
fun
K
e'
=>
match
eval
cbv
in
e'
with
|
App
(
Rec
_
_
_
)
_
=>
wp_bind
K
;
etransitivity
;
[|
by
eapply
wp_rec
]
;
simpl
end
)
end
.
Tactic
Notation
"wp_rec"
:
=
wp_rec
!
;
wp_strip_later
.
Tactic
Notation
"wp_bin_op"
"!"
:
=
repeat
wp_value
;
match
goal
with
|
|-
_
⊑
wp
?E
?e
?Q
=>
reshape_expr
e
ltac
:
(
fun
K
e'
=>
match
eval
cbv
in
e'
with
|
BinOp
LtOp
_
_
=>
wp_bind
K
;
apply
wp_lt
;
[|]
|
BinOp
LeOp
_
_
=>
wp_bind
K
;
apply
wp_le
;
[|]
|
BinOp
EqOp
_
_
=>
wp_bind
K
;
apply
wp_eq
;
[|]
|
BinOp
_
_
_
=>
wp_bind
K
;
etransitivity
;
[|
by
eapply
wp_bin_op
]
;
simpl
end
)
end
.
Tactic
Notation
"wp_bin_op"
:
=
wp_bin_op
!
;
wp_strip_later
.
Tactic
Notation
"wp_un_op"
"!"
:
=
repeat
wp_value
;
match
goal
with
|
|-
_
⊑
wp
?E
?e
?Q
=>
reshape_expr
e
ltac
:
(
fun
K
e'
=>
match
eval
cbv
in
e'
with
|
UnOp
_
_
=>
wp_bind
K
;
etransitivity
;
[|
by
eapply
wp_un_op
]
;
simpl
end
)
end
.
Tactic
Notation
"wp_un_op"
:
=
wp_un_op
!
;
wp_strip_later
.
Tactic
Notation
"wp_if"
"!"
:
=
repeat
wp_value
;
match
goal
with
|
|-
_
⊑
wp
?E
?e
?Q
=>
reshape_expr
e
ltac
:
(
fun
K
e'
=>
match
eval
cbv
in
e'
with
|
If
_
_
_
=>
wp_bind
K
;
etransitivity
;
[|
by
apply
wp_if_true
||
by
apply
wp_if_false
]
end
)
end
.
Tactic
Notation
"wp_if"
:
=
wp_if
!
;
wp_strip_later
.
Tactic
Notation
"wp_focus"
open_constr
(
efoc
)
:
=
match
goal
with
|
|-
_
⊑
wp
?E
?e
?Q
=>
reshape_expr
e
ltac
:
(
fun
K
e'
=>
match
e'
with
efoc
=>
unify
e'
efoc
;
wp_bind
K
end
)
end
.
Write
Preview
Supports
Markdown
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