Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Simon Spies
Iris
Commits
30f13e2d
Commit
30f13e2d
authored
Jul 15, 2016
by
Robbert Krebbers
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Remove dependent types in heap_lang representation.
parent
aa81760b
Changes
18
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
18 changed files
with
312 additions
and
453 deletions
+312
-453
.gitlab-ci.yml
.gitlab-ci.yml
+1
-0
heap_lang/derived.v
heap_lang/derived.v
+6
-1
heap_lang/lang.v
heap_lang/lang.v
+192
-238
heap_lang/lib/assert.v
heap_lang/lib/assert.v
+5
-6
heap_lang/lib/barrier/barrier.v
heap_lang/lib/barrier/barrier.v
+2
-2
heap_lang/lib/counter.v
heap_lang/lib/counter.v
+3
-3
heap_lang/lib/lock.v
heap_lang/lib/lock.v
+2
-2
heap_lang/lib/par.v
heap_lang/lib/par.v
+8
-11
heap_lang/lib/spawn.v
heap_lang/lib/spawn.v
+4
-4
heap_lang/lifting.v
heap_lang/lifting.v
+3
-2
heap_lang/notation.v
heap_lang/notation.v
+2
-3
heap_lang/substitution.v
heap_lang/substitution.v
+54
-151
heap_lang/tactics.v
heap_lang/tactics.v
+0
-1
heap_lang/wp_tactics.v
heap_lang/wp_tactics.v
+2
-1
tests/barrier_client.v
tests/barrier_client.v
+5
-5
tests/heap_lang.v
tests/heap_lang.v
+11
-11
tests/joining_existentials.v
tests/joining_existentials.v
+7
-7
tests/one_shot.v
tests/one_shot.v
+5
-5
No files found.
.gitlab-ci.yml
View file @
30f13e2d
...
...
@@ -11,6 +11,7 @@ buildjob:
only
:
-
master
-
jh_simplified_resources
-
rk/substitition
artifacts
:
paths
:
-
build-time.txt
heap_lang/derived.v
View file @
30f13e2d
...
...
@@ -19,29 +19,34 @@ Implicit Types Φ : val → iProp heap_lang Σ.
(** Proof rules for the sugar *)
Lemma
wp_lam
E
x
ef
e
v
Φ
:
to_val
e
=
Some
v
→
Closed
(
x
:
b
:
[])
ef
→
▷
WP
subst'
x
e
ef
@
E
{{
Φ
}}
⊢
WP
App
(
Lam
x
ef
)
e
@
E
{{
Φ
}}.
Proof
.
intros
.
by
rewrite
-(
wp_rec
_
BAnon
)
//.
Qed
.
Lemma
wp_let
E
x
e1
e2
v
Φ
:
to_val
e1
=
Some
v
→
Closed
(
x
:
b
:
[])
e2
→
▷
WP
subst'
x
e1
e2
@
E
{{
Φ
}}
⊢
WP
Let
x
e1
e2
@
E
{{
Φ
}}.
Proof
.
apply
wp_lam
.
Qed
.
Lemma
wp_seq
E
e1
e2
v
Φ
:
to_val
e1
=
Some
v
→
Closed
[]
e2
→
▷
WP
e2
@
E
{{
Φ
}}
⊢
WP
Seq
e1
e2
@
E
{{
Φ
}}.
Proof
.
intros
?.
by
rewrite
-
wp_let
.
Qed
.
Proof
.
intros
?
?.
by
rewrite
-
wp_let
.
Qed
.
Lemma
wp_skip
E
Φ
:
▷
Φ
(
LitV
LitUnit
)
⊢
WP
Skip
@
E
{{
Φ
}}.
Proof
.
rewrite
-
wp_seq
//
-
wp_value
//.
Qed
.
Lemma
wp_match_inl
E
e0
v0
x1
e1
x2
e2
Φ
:
to_val
e0
=
Some
v0
→
Closed
(
x1
:
b
:
[])
e1
→
▷
WP
subst'
x1
e0
e1
@
E
{{
Φ
}}
⊢
WP
Match
(
InjL
e0
)
x1
e1
x2
e2
@
E
{{
Φ
}}.
Proof
.
intros
.
by
rewrite
-
wp_case_inl
//
-[
X
in
_
⊢
X
]
later_intro
-
wp_let
.
Qed
.
Lemma
wp_match_inr
E
e0
v0
x1
e1
x2
e2
Φ
:
to_val
e0
=
Some
v0
→
Closed
(
x2
:
b
:
[])
e2
→
▷
WP
subst'
x2
e0
e2
@
E
{{
Φ
}}
⊢
WP
Match
(
InjR
e0
)
x1
e1
x2
e2
@
E
{{
Φ
}}.
Proof
.
intros
.
by
rewrite
-
wp_case_inr
//
-[
X
in
_
⊢
X
]
later_intro
-
wp_let
.
Qed
.
...
...
heap_lang/lang.v
View file @
30f13e2d
This diff is collapsed.
Click to expand it.
heap_lang/lib/assert.v
View file @
30f13e2d
From
iris
.
heap_lang
Require
Export
derived
.
From
iris
.
heap_lang
Require
Import
wp_tactics
substitution
notation
.
Definition
Assert
{
X
}
(
e
:
expr
X
)
:
expr
X
:
=
Definition
Assert
(
e
:
expr
)
:
expr
:
=
if
:
e
then
#()
else
#
0
#
0
.
(* #0 #0 is unsafe *)
Instance
do_wexpr_assert
{
X
Y
}
(
H
:
X
`
included
`
Y
)
e
er
:
WExpr
H
e
er
→
WExpr
H
(
Assert
e
)
(
Assert
er
)
:
=
_
.
Instance
do_wsubst_assert
{
X
Y
}
x
es
(
H
:
X
`
included
`
x
::
Y
)
e
er
:
WSubst
x
es
H
e
er
→
WSubst
x
es
H
(
Assert
e
)
(
Assert
er
).
Proof
.
intros
;
red
.
by
rewrite
/
Assert
/
wsubst
-/
wsubst
;
f_equal
/=.
Qed
.
Instance
closed_assert
X
e
:
Closed
X
e
→
Closed
X
(
Assert
e
)
:
=
_
.
Instance
do_subst_assert
x
es
e
er
:
Subst
x
es
e
er
→
Subst
x
es
(
Assert
e
)
(
Assert
er
).
Proof
.
intros
;
red
.
by
rewrite
/
Assert
/
subst
-/
subst
;
f_equal
/=.
Qed
.
Typeclasses
Opaque
Assert
.
Lemma
wp_assert
{
Σ
}
(
Φ
:
val
→
iProp
heap_lang
Σ
)
:
...
...
heap_lang/lib/barrier/barrier.v
View file @
30f13e2d
From
iris
.
heap_lang
Require
Export
notation
.
Definition
newbarrier
:
val
:
=
λ
:
<>,
ref
#
0
.
Definition
signal
:
val
:
=
λ
:
"x"
,
'
"x"
<-
#
1
.
Definition
signal
:
val
:
=
λ
:
"x"
,
"x"
<-
#
1
.
Definition
wait
:
val
:
=
rec
:
"wait"
"x"
:
=
if
:
!
'
"x"
=
#
1
then
#()
else
'
"wait"
'
"x"
.
rec
:
"wait"
"x"
:
=
if
:
!
"x"
=
#
1
then
#()
else
"wait"
"x"
.
Global
Opaque
newbarrier
signal
wait
.
heap_lang/lib/counter.v
View file @
30f13e2d
...
...
@@ -8,9 +8,9 @@ Import uPred.
Definition
newcounter
:
val
:
=
λ
:
<>,
ref
#
0
.
Definition
inc
:
val
:
=
rec
:
"inc"
"l"
:
=
let
:
"n"
:
=
!
'
"l"
in
if
:
CAS
'
"l"
'
"n"
(#
1
+
'
"n"
)
then
#()
else
'
"inc"
'
"l"
.
Definition
read
:
val
:
=
λ
:
"l"
,
!
'
"l"
.
let
:
"n"
:
=
!
"l"
in
if
:
CAS
"l"
"n"
(#
1
+
"n"
)
then
#()
else
"inc"
"l"
.
Definition
read
:
val
:
=
λ
:
"l"
,
!
"l"
.
Global
Opaque
newcounter
inc
get
.
(** The CMRA we need. *)
...
...
heap_lang/lib/lock.v
View file @
30f13e2d
...
...
@@ -6,8 +6,8 @@ Import uPred.
Definition
newlock
:
val
:
=
λ
:
<>,
ref
#
false
.
Definition
acquire
:
val
:
=
rec
:
"acquire"
"l"
:
=
if
:
CAS
'
"l"
#
false
#
true
then
#()
else
'
"acquire"
'
"l"
.
Definition
release
:
val
:
=
λ
:
"l"
,
'
"l"
<-
#
false
.
if
:
CAS
"l"
#
false
#
true
then
#()
else
"acquire"
"l"
.
Definition
release
:
val
:
=
λ
:
"l"
,
"l"
<-
#
false
.
Global
Opaque
newlock
acquire
release
.
(** The CMRA we need. *)
...
...
heap_lang/lib/par.v
View file @
30f13e2d
...
...
@@ -2,18 +2,14 @@ From iris.heap_lang Require Export spawn.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
Import
uPred
.
Definition
par
{
X
}
:
expr
X
:
=
Definition
par
:
val
:
=
λ
:
"fs"
,
let
:
"handle"
:
=
^
spawn
(
Fst
'
"fs"
)
in
let
:
"v2"
:
=
Snd
'
"fs"
#()
in
let
:
"v1"
:
=
^
join
'
"handle"
in
Pair
'
"v1"
'
"v2"
.
let
:
"handle"
:
=
spawn
(
Fst
"fs"
)
in
let
:
"v2"
:
=
Snd
"fs"
#()
in
let
:
"v1"
:
=
join
"handle"
in
Pair
"v1"
"v2"
.
Notation
Par
e1
e2
:
=
(
par
(
Pair
(
λ
:
<>,
e1
)
(
λ
:
<>,
e2
)))%
E
.
Infix
"||"
:
=
Par
:
expr_scope
.
Instance
do_wexpr_par
{
X
Y
}
(
H
:
X
`
included
`
Y
)
:
WExpr
H
par
par
:
=
_
.
Instance
do_wsubst_par
{
X
Y
}
x
es
(
H
:
X
`
included
`
x
::
Y
)
:
WSubst
x
es
H
par
par
:
=
do_wsubst_closed
_
x
es
H
_
.
Global
Opaque
par
.
Section
proof
.
...
...
@@ -36,13 +32,14 @@ Proof.
iSpecialize
(
"HΦ"
with
"* [-]"
)
;
first
by
iSplitL
"H1"
.
by
wp_let
.
Qed
.
Lemma
wp_par
(
Ψ
1
Ψ
2
:
val
→
iProp
)
(
e1
e2
:
expr
[])
(
Φ
:
val
→
iProp
)
:
Lemma
wp_par
(
Ψ
1
Ψ
2
:
val
→
iProp
)
(
e1
e2
:
expr
)
`
{!
Closed
[]
e1
,
Closed
[]
e2
}
(
Φ
:
val
→
iProp
)
:
heapN
⊥
N
→
(
heap_ctx
heapN
★
WP
e1
{{
Ψ
1
}}
★
WP
e2
{{
Ψ
2
}}
★
∀
v1
v2
,
Ψ
1
v1
★
Ψ
2
v2
-
★
▷
Φ
(
v1
,
v2
)%
V
)
⊢
WP
e1
||
e2
{{
Φ
}}.
Proof
.
iIntros
(?)
"(#Hh&H1&H2&H)"
.
iApply
(
par_spec
Ψ
1
Ψ
2
)
;
auto
.
iIntros
(?)
"(#Hh&H1&H2&H)"
.
iApply
(
par_spec
Ψ
1
Ψ
2
)
;
auto
.
apply
is_value
.
iFrame
"Hh H"
.
iSplitL
"H1"
;
by
wp_let
.
Qed
.
End
proof
.
heap_lang/lib/spawn.v
View file @
30f13e2d
...
...
@@ -6,12 +6,12 @@ Import uPred.
Definition
spawn
:
val
:
=
λ
:
"f"
,
let
:
"c"
:
=
ref
(
InjL
#
0
)
in
Fork
(
'
"c"
<-
InjR
(
'
"f"
#()))
;;
'
"c"
.
Fork
(
"c"
<-
InjR
(
"f"
#()))
;;
"c"
.
Definition
join
:
val
:
=
rec
:
"join"
"c"
:
=
match
:
!
'
"c"
with
InjR
"x"
=>
'
"x"
|
InjL
<>
=>
'
"join"
'
"c"
match
:
!
"c"
with
InjR
"x"
=>
"x"
|
InjL
<>
=>
"join"
"c"
end
.
Global
Opaque
spawn
join
.
...
...
heap_lang/lifting.v
View file @
30f13e2d
...
...
@@ -10,7 +10,7 @@ Section lifting.
Context
{
Σ
:
iFunctor
}.
Implicit
Types
P
Q
:
iProp
heap_lang
Σ
.
Implicit
Types
Φ
:
val
→
iProp
heap_lang
Σ
.
Implicit
Types
ef
:
option
(
expr
[])
.
Implicit
Types
ef
:
option
expr
.
(** Bind. This bundles some arguments that wp_ectx_bind leaves as indices. *)
Lemma
wp_bind
{
E
e
}
K
Φ
:
...
...
@@ -84,9 +84,10 @@ Qed.
Lemma
wp_rec
E
f
x
erec
e1
e2
v2
Φ
:
e1
=
Rec
f
x
erec
→
to_val
e2
=
Some
v2
→
Closed
(
f
:
b
:
x
:
b
:
[])
erec
→
▷
WP
subst'
x
e2
(
subst'
f
e1
erec
)
@
E
{{
Φ
}}
⊢
WP
App
e1
e2
@
E
{{
Φ
}}.
Proof
.
intros
->
?.
rewrite
-(
wp_lift_pure_det_head_step
(
App
_
_
)
intros
->
?
?.
rewrite
-(
wp_lift_pure_det_head_step
(
App
_
_
)
(
subst'
x
e2
(
subst'
f
(
Rec
f
x
erec
)
erec
))
None
)
//=
?right_id
;
intros
;
inv_head_step
;
eauto
.
Qed
.
...
...
heap_lang/notation.v
View file @
30f13e2d
...
...
@@ -24,6 +24,8 @@ Coercion LitLoc : loc >-> base_lit.
Coercion
App
:
expr
>->
Funclass
.
Coercion
of_val
:
val
>->
expr
.
Coercion
Var
:
string
>->
expr
.
Coercion
BNamed
:
string
>->
binder
.
Notation
"<>"
:
=
BAnon
:
binder_scope
.
...
...
@@ -32,9 +34,6 @@ properly. *)
Notation
"# l"
:
=
(
LitV
l
%
Z
%
V
)
(
at
level
8
,
format
"# l"
).
Notation
"# l"
:
=
(
Lit
l
%
Z
%
V
)
(
at
level
8
,
format
"# l"
)
:
expr_scope
.
Notation
"' x"
:
=
(
Var
x
)
(
at
level
8
,
format
"' x"
)
:
expr_scope
.
Notation
"^ e"
:
=
(
wexpr'
e
)
(
at
level
8
,
format
"^ e"
)
:
expr_scope
.
(** Syntax inspired by Coq/Ocaml. Constructions with higher precedence come
first. *)
Notation
"( e1 , e2 , .. , en )"
:
=
(
Pair
..
(
Pair
e1
e2
)
..
en
)
:
expr_scope
.
...
...
heap_lang/substitution.v
View file @
30f13e2d
...
...
@@ -2,196 +2,99 @@ From iris.heap_lang Require Export lang.
Import
heap_lang
.
(** The tactic [simpl_subst] performs substitutions in the goal. Its behavior
can be tuned by declaring [WExpr] and [WSubst] instances. *)
(** * Weakening *)
Class
WExpr
{
X
Y
}
(
H
:
X
`
included
`
Y
)
(
e
:
expr
X
)
(
er
:
expr
Y
)
:
=
do_wexpr
:
wexpr
H
e
=
er
.
Hint
Mode
WExpr
+
+
+
+
-
:
typeclass_instances
.
can be tuned by declaring [Subst] instances. *)
(** * Substitution *)
Class
Subst
(
x
:
string
)
(
es
:
expr
)
(
e
:
expr
)
(
er
:
expr
)
:
=
do_subst
:
subst
x
es
e
=
er
.
Hint
Mode
Subst
+
+
+
-
:
typeclass_instances
.
(* Variables *)
Hint
Extern
0
(
WExpr
_
(
Var
?y
)
_
)
=>
apply
var_proof_irrel
:
typeclass_instances
.
(* Rec *)
Instance
do_wexpr_rec_true
{
X
Y
f
y
e
}
{
H
:
X
`
included
`
Y
}
er
:
WExpr
(
wexpr_rec_prf
H
)
e
er
→
WExpr
H
(
Rec
f
y
e
)
(
Rec
f
y
er
)
|
10
.
Proof
.
intros
;
red
;
f_equal
/=.
by
etrans
;
[
apply
wexpr_proof_irrel
|].
Qed
.
(* Values *)
Instance
do_wexpr_wexpr
X
Y
Z
(
H1
:
X
`
included
`
Y
)
(
H2
:
Y
`
included
`
Z
)
e
er
:
WExpr
(
transitivity
H1
H2
)
e
er
→
WExpr
H2
(
wexpr
H1
e
)
er
|
0
.
Proof
.
by
rewrite
/
WExpr
wexpr_wexpr'
.
Qed
.
Instance
do_wexpr_closed_closed
(
H
:
[]
`
included
`
[])
e
:
WExpr
H
e
e
|
1
.
Proof
.
apply
wexpr_id
.
Qed
.
Instance
do_wexpr_closed_wexpr
Y
(
H
:
[]
`
included
`
Y
)
e
:
WExpr
H
e
(
wexpr'
e
)
|
2
.
Proof
.
apply
wexpr_proof_irrel
.
Qed
.
(* Boring connectives *)
Section
do_wexpr
.
Context
{
X
Y
:
list
string
}
(
H
:
X
`
included
`
Y
).
Notation
W
:
=
(
WExpr
H
).
(* Ground terms *)
Global
Instance
do_wexpr_lit
l
:
W
(
Lit
l
)
(
Lit
l
).
Proof
.
done
.
Qed
.
Global
Instance
do_wexpr_app
e1
e2
e1r
e2r
:
W
e1
e1r
→
W
e2
e2r
→
W
(
App
e1
e2
)
(
App
e1r
e2r
).
Proof
.
intros
;
red
;
f_equal
/=
;
apply
:
do_wexpr
.
Qed
.
Global
Instance
do_wexpr_unop
op
e
er
:
W
e
er
→
W
(
UnOp
op
e
)
(
UnOp
op
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_wexpr_binop
op
e1
e2
e1r
e2r
:
W
e1
e1r
→
W
e2
e2r
→
W
(
BinOp
op
e1
e2
)
(
BinOp
op
e1r
e2r
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_wexpr_if
e0
e1
e2
e0r
e1r
e2r
:
W
e0
e0r
→
W
e1
e1r
→
W
e2
e2r
→
W
(
If
e0
e1
e2
)
(
If
e0r
e1r
e2r
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_wexpr_pair
e1
e2
e1r
e2r
:
W
e1
e1r
→
W
e2
e2r
→
W
(
Pair
e1
e2
)
(
Pair
e1r
e2r
).
Proof
.
by
intros
??
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_wexpr_fst
e
er
:
W
e
er
→
W
(
Fst
e
)
(
Fst
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_wexpr_snd
e
er
:
W
e
er
→
W
(
Snd
e
)
(
Snd
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_wexpr_injL
e
er
:
W
e
er
→
W
(
InjL
e
)
(
InjL
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_wexpr_injR
e
er
:
W
e
er
→
W
(
InjR
e
)
(
InjR
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_wexpr_case
e0
e1
e2
e0r
e1r
e2r
:
W
e0
e0r
→
W
e1
e1r
→
W
e2
e2r
→
W
(
Case
e0
e1
e2
)
(
Case
e0r
e1r
e2r
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_wexpr_fork
e
er
:
W
e
er
→
W
(
Fork
e
)
(
Fork
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_wexpr_alloc
e
er
:
W
e
er
→
W
(
Alloc
e
)
(
Alloc
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_wexpr_load
e
er
:
W
e
er
→
W
(
Load
e
)
(
Load
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_wexpr_store
e1
e2
e1r
e2r
:
W
e1
e1r
→
W
e2
e2r
→
W
(
Store
e1
e2
)
(
Store
e1r
e2r
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_wexpr_cas
e0
e1
e2
e0r
e1r
e2r
:
W
e0
e0r
→
W
e1
e1r
→
W
e2
e2r
→
W
(
CAS
e0
e1
e2
)
(
CAS
e0r
e1r
e2r
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
End
do_wexpr
.
Lemma
do_subst_var_eq
x
er
:
Subst
x
er
(
Var
x
)
er
.
Proof
.
intros
;
red
;
simpl
.
by
case_decide
.
Qed
.
Lemma
do_subst_var_neq
x
y
er
:
bool_decide
(
x
≠
y
)
→
Subst
x
er
(
Var
y
)
(
Var
y
).
Proof
.
rewrite
bool_decide_spec
.
intros
;
red
;
simpl
.
by
case_decide
.
Qed
.
(** * WSubstitution *)
Class
WSubst
{
X
Y
}
(
x
:
string
)
(
es
:
expr
[])
H
(
e
:
expr
X
)
(
er
:
expr
Y
)
:
=
do_wsubst
:
wsubst
x
es
H
e
=
er
.
Hint
Mode
WSubst
+
+
+
+
+
+
-
:
typeclass_instances
.
Lemma
do_wsubst_closed
(
e
:
∀
{
X
},
expr
X
)
{
X
Y
}
x
es
(
H
:
X
`
included
`
x
::
Y
)
:
(
∀
X
,
WExpr
(
included_nil
X
)
e
e
)
→
WSubst
x
es
H
e
e
.
Proof
.
rewrite
/
WSubst
/
WExpr
=>
He
.
rewrite
-(
He
X
)
wsubst_wexpr'
.
by
rewrite
(
wsubst_closed
_
_
_
_
_
(
included_nil
_
))
;
last
set_solver
.
Qed
.
(* Variables *)
Lemma
do_wsubst_var_eq
{
X
Y
x
es
}
{
H
:
X
`
included
`
x
::
Y
}
`
{
VarBound
x
X
}
er
:
WExpr
(
included_nil
_
)
es
er
→
WSubst
x
es
H
(
Var
x
)
er
.
Proof
.
intros
;
red
;
simpl
.
case_decide
;
last
done
.
by
etrans
;
[
apply
wexpr_proof_irrel
|].
Qed
.
Hint
Extern
0
(
WSubst
?x
?v
_
(
Var
?y
)
_
)
=>
first
[
apply
var_proof_irrel
|
apply
do_wsubst_var_eq
]
:
typeclass_instances
.
Hint
Extern
0
(
Subst
?x
?v
(
Var
?y
)
_
)
=>
first
[
apply
do_subst_var_eq
|
apply
do_subst_var_neq
,
I
]
:
typeclass_instances
.
(** Rec *)
Lemma
do_wsubst_rec_true
{
X
Y
x
es
f
y
e
}
{
H
:
X
`
included
`
x
::
Y
}
(
Hfy
:
BNamed
x
≠
f
∧
BNamed
x
≠
y
)
er
:
WSubst
x
es
(
wsubst_rec_true_prf
H
Hfy
)
e
er
→
WSubst
x
es
H
(
Rec
f
y
e
)
(
Rec
f
y
er
).
Proof
.
intros
?
;
red
;
f_equal
/=
;
case_decide
;
last
done
.
by
etrans
;
[
apply
wsubst_proof_irrel
|].
Qed
.
Lemma
do_wsubst_rec_false
{
X
Y
x
es
f
y
e
}
{
H
:
X
`
included
`
x
::
Y
}
(
Hfy
:
¬
(
BNamed
x
≠
f
∧
BNamed
x
≠
y
))
er
:
WExpr
(
wsubst_rec_false_prf
H
Hfy
)
e
er
→
WSubst
x
es
H
(
Rec
f
y
e
)
(
Rec
f
y
er
).
Proof
.
intros
;
red
;
f_equal
/=
;
case_decide
;
first
done
.
by
etrans
;
[
apply
wexpr_proof_irrel
|].
Qed
.
Ltac
bool_decide_no_check
:
=
apply
(
bool_decide_unpack
_
)
;
vm_cast_no_check
I
.
Hint
Extern
0
(
WSubst
?x
?v
_
(
Rec
?f
?y
?e
)
_
)
=>
Lemma
do_subst_rec_true
{
x
es
f
y
e
er
}
:
bool_decide
(
BNamed
x
≠
f
∧
BNamed
x
≠
y
)
→
Subst
x
es
e
er
→
Subst
x
es
(
Rec
f
y
e
)
(
Rec
f
y
er
).
Proof
.
rewrite
bool_decide_spec
.
intros
;
red
;
f_equal
/=
;
by
case_decide
.
Qed
.
Lemma
do_subst_rec_false
{
x
es
f
y
e
}
:
bool_decide
(
¬
(
BNamed
x
≠
f
∧
BNamed
x
≠
y
))
→
Subst
x
es
(
Rec
f
y
e
)
(
Rec
f
y
e
).
Proof
.
rewrite
bool_decide_spec
.
intros
;
red
;
f_equal
/=
;
by
case_decide
.
Qed
.
Local
Ltac
bool_decide_no_check
:
=
vm_cast_no_check
I
.
Hint
Extern
0
(
Subst
?x
?v
(
Rec
?f
?y
?e
)
_
)
=>
match
eval
vm_compute
in
(
bool_decide
(
BNamed
x
≠
f
∧
BNamed
x
≠
y
))
with
|
true
=>
eapply
(
do_
w
subst_rec_true
ltac
:
(
bool_decide_no_check
))
|
false
=>
eapply
(
do_
w
subst_rec_false
ltac
:
(
bool_decide_no_check
))
|
true
=>
eapply
(
do_subst_rec_true
ltac
:
(
bool_decide_no_check
))
|
false
=>
eapply
(
do_subst_rec_false
ltac
:
(
bool_decide_no_check
))
end
:
typeclass_instances
.
Lemma
do_subst_closed
x
es
e
:
Closed
[]
e
→
Subst
x
es
e
e
.
Proof
.
apply
closed_nil_subst
.
Qed
.
Hint
Extern
10
(
Subst
?x
?v
?e
_
)
=>
is_var
e
;
class_apply
do_subst_closed
:
typeclass_instances
.
(* Values *)
Instance
do_wsubst_wexpr
X
Y
Z
x
es
(
H1
:
X
`
included
`
Y
)
(
H2
:
Y
`
included
`
x
::
Z
)
e
er
:
WSubst
x
es
(
transitivity
H1
H2
)
e
er
→
WSubst
x
es
H2
(
wexpr
H1
e
)
er
|
0
.
Proof
.
by
rewrite
/
WSubst
wsubst_wexpr'
.
Qed
.
Instance
do_wsubst_closed_closed
x
es
(
H
:
[]
`
included
`
[
x
])
e
:
WSubst
x
es
H
e
e
|
1
.
Proof
.
apply
wsubst_closed_nil
.
Qed
.
Instance
do_wsubst_closed_wexpr
Y
x
es
(
H
:
[]
`
included
`
x
::
Y
)
e
:
WSubst
x
es
H
e
(
wexpr'
e
)
|
2
.
Proof
.
apply
wsubst_closed
,
not_elem_of_nil
.
Qed
.
Instance
do_subst_of_val
x
es
v
:
Subst
x
es
(
of_val
v
)
(
of_val
v
)
|
0
.
Proof
.
eapply
closed_nil_subst
,
of_val_closed
.
Qed
.
(* Boring connectives *)
Section
w
subst
.
Context
{
X
Y
}
(
x
:
string
)
(
es
:
expr
[])
(
H
:
X
`
included
`
x
::
Y
).
Notation
Sub
:
=
(
W
Subst
x
es
H
).
Section
subst
.
Context
(
x
:
string
)
(
es
:
expr
).
Notation
Sub
:
=
(
Subst
x
es
).
(* Ground terms *)
Global
Instance
do_
w
subst_lit
l
:
Sub
(
Lit
l
)
(
Lit
l
).
Global
Instance
do_subst_lit
l
:
Sub
(
Lit
l
)
(
Lit
l
).
Proof
.
done
.
Qed
.
Global
Instance
do_
w
subst_app
e1
e2
e1r
e2r
:
Global
Instance
do_subst_app
e1
e2
e1r
e2r
:
Sub
e1
e1r
→
Sub
e2
e2r
→
Sub
(
App
e1
e2
)
(
App
e1r
e2r
).
Proof
.
intros
;
red
;
f_equal
/=
;
apply
:
do_
w
subst
.
Qed
.
Global
Instance
do_
w
subst_unop
op
e
er
:
Sub
e
er
→
Sub
(
UnOp
op
e
)
(
UnOp
op
er
).
Proof
.
intros
;
red
;
f_equal
/=
;
apply
:
do_subst
.
Qed
.
Global
Instance
do_subst_unop
op
e
er
:
Sub
e
er
→
Sub
(
UnOp
op
e
)
(
UnOp
op
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_
w
subst_binop
op
e1
e2
e1r
e2r
:
Global
Instance
do_subst_binop
op
e1
e2
e1r
e2r
:
Sub
e1
e1r
→
Sub
e2
e2r
→
Sub
(
BinOp
op
e1
e2
)
(
BinOp
op
e1r
e2r
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_
w
subst_if
e0
e1
e2
e0r
e1r
e2r
:
Global
Instance
do_subst_if
e0
e1
e2
e0r
e1r
e2r
:
Sub
e0
e0r
→
Sub
e1
e1r
→
Sub
e2
e2r
→
Sub
(
If
e0
e1
e2
)
(
If
e0r
e1r
e2r
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_
w
subst_pair
e1
e2
e1r
e2r
:
Global
Instance
do_subst_pair
e1
e2
e1r
e2r
:
Sub
e1
e1r
→
Sub
e2
e2r
→
Sub
(
Pair
e1
e2
)
(
Pair
e1r
e2r
).
Proof
.
by
intros
??
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_
w
subst_fst
e
er
:
Sub
e
er
→
Sub
(
Fst
e
)
(
Fst
er
).
Global
Instance
do_subst_fst
e
er
:
Sub
e
er
→
Sub
(
Fst
e
)
(
Fst
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_
w
subst_snd
e
er
:
Sub
e
er
→
Sub
(
Snd
e
)
(
Snd
er
).
Global
Instance
do_subst_snd
e
er
:
Sub
e
er
→
Sub
(
Snd
e
)
(
Snd
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_
w
subst_injL
e
er
:
Sub
e
er
→
Sub
(
InjL
e
)
(
InjL
er
).
Global
Instance
do_subst_injL
e
er
:
Sub
e
er
→
Sub
(
InjL
e
)
(
InjL
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_
w
subst_injR
e
er
:
Sub
e
er
→
Sub
(
InjR
e
)
(
InjR
er
).
Global
Instance
do_subst_injR
e
er
:
Sub
e
er
→
Sub
(
InjR
e
)
(
InjR
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_
w
subst_case
e0
e1
e2
e0r
e1r
e2r
:
Global
Instance
do_subst_case
e0
e1
e2
e0r
e1r
e2r
:
Sub
e0
e0r
→
Sub
e1
e1r
→
Sub
e2
e2r
→
Sub
(
Case
e0
e1
e2
)
(
Case
e0r
e1r
e2r
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_
w
subst_fork
e
er
:
Sub
e
er
→
Sub
(
Fork
e
)
(
Fork
er
).
Global
Instance
do_subst_fork
e
er
:
Sub
e
er
→
Sub
(
Fork
e
)
(
Fork
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_
w
subst_alloc
e
er
:
Sub
e
er
→
Sub
(
Alloc
e
)
(
Alloc
er
).
Global
Instance
do_subst_alloc
e
er
:
Sub
e
er
→
Sub
(
Alloc
e
)
(
Alloc
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_
w
subst_load
e
er
:
Sub
e
er
→
Sub
(
Load
e
)
(
Load
er
).
Global
Instance
do_subst_load
e
er
:
Sub
e
er
→
Sub
(
Load
e
)
(
Load
er
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_
w
subst_store
e1
e2
e1r
e2r
:
Global
Instance
do_subst_store
e1
e2
e1r
e2r
:
Sub
e1
e1r
→
Sub
e2
e2r
→
Sub
(
Store
e1
e2
)
(
Store
e1r
e2r
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
Global
Instance
do_
w
subst_cas
e0
e1
e2
e0r
e1r
e2r
:
Global
Instance
do_subst_cas
e0
e1
e2
e0r
e1r
e2r
:
Sub
e0
e0r
→
Sub
e1
e1r
→
Sub
e2
e2r
→
Sub
(
CAS
e0
e1
e2
)
(
CAS
e0r
e1r
e2r
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
End
w
subst
.
End
subst
.
(** * The tactic *)
Lemma
do_subst
{
X
}
(
x
:
string
)
(
es
:
expr
[])
(
e
:
expr
(
x
::
X
))
(
er
:
expr
X
)
:
WSubst
x
es
(
λ
_
,
id
)
e
er
→
subst
x
es
e
=
er
.
Proof
.
done
.
Qed
.
Ltac
simpl_subst
:
=
repeat
match
goal
with
|
|-
context
[
subst
?x
?es
?e
]
=>
progress
rewrite
(@
do_subst
_
x
es
e
)
|
|-
context
[
subst
?x
?es
?e
]
=>
progress
rewrite
(@
do_subst
x
es
e
)
|
|-
_
=>
progress
csimpl
end
.
Arguments
wexpr
:
simpl
never
.
Arguments
subst
:
simpl
never
.
Arguments
wsubst
:
simpl
never
.
heap_lang/tactics.v
View file @
30f13e2d
...
...
@@ -25,7 +25,6 @@ Ltac reshape_val e tac :=
let
rec
go
e
:
=
match
e
with
|
of_val
?v
=>
v
|
wexpr'
?e
=>
go
e
|
Rec
?f
?x
?e
=>
constr
:
(
RecV
f
x
e
)
|
Lit
?l
=>
constr
:
(
LitV
l
)
|
Pair
?e1
?e2
=>
...
...
heap_lang/wp_tactics.v
View file @
30f13e2d
...
...
@@ -9,7 +9,8 @@ Ltac wp_bind K :=
|
_
=>
etrans
;
[|
fast_by
apply
(
wp_bind
K
)]
;
simpl
end
.
Ltac
wp_done
:
=
rewrite
/=
?to_of_val
;
fast_done
.
(* TODO: Do something better here *)
Ltac
wp_done
:
=
fast_done
||
apply
is_value
||
apply
_
||
(
rewrite
/=
?to_of_val
;
fast_done
).
(* sometimes, we will have to do a final view shift, so only apply
pvs_intro if we obtain a consecutive wp *)
...
...
tests/barrier_client.v
View file @
30f13e2d
...
...
@@ -5,12 +5,12 @@ From iris.heap_lang Require Import proofmode.
Import
uPred
.
Definition
worker
(
n
:
Z
)
:
val
:
=
λ
:
"b"
"y"
,
^
wait
'
"b"
;;
!
'
"y"
#
n
.
Definition
client
:
expr
[]
:
=
λ
:
"b"
"y"
,
wait
"b"
;;
!
"y"
#
n
.
Definition
client
:
expr
:
=
let
:
"y"
:
=
ref
#
0
in
let
:
"b"
:
=
^
newbarrier
#()
in
(
'
"y"
<-
(
λ
:
"z"
,
'
"z"
+
#
42
)
;;
^
signal
'
"b"
)
||
(^
(
worker
12
)
'
"b"
'
"y"
||
^(
worker
17
)
'
"b"
'
"y"
).
let
:
"b"
:
=
newbarrier
#()
in
(
"y"
<-
(
λ
:
"z"
,
"z"
+
#
42
)
;;
signal
"b"
)
||
(
worker
12
"b"
"y"
||
worker
17
"b"
"y"
).
Global
Opaque
worker
client
.
Section
client
.
...
...
tests/heap_lang.v
View file @
30f13e2d
...
...
@@ -4,13 +4,13 @@ From iris.heap_lang Require Import proofmode notation.
Import
uPred
.
Section
LangTests
.
Definition
add
:
expr
[]
:
=
(#
21
+
#
21
)%
E
.
Definition
add
:
expr
:
=
(#
21
+
#
21
)%
E
.
Goal
∀
σ
,
head_step
add
σ
(#
42
)
σ
None
.
Proof
.
intros
;
do_head_step
done
.
Qed
.
Definition
rec_app
:
expr
[]
:
=
((
rec
:
"f"
"x"
:
=
'
"f"
'
"x"
)
#
0
)%
E
.
Definition
rec_app
:
expr
:
=
((
rec
:
"f"
"x"
:
=
"f"
"x"
)
#
0
)%
E
.
Goal
∀
σ
,
head_step
rec_app
σ
rec_app
σ
None
.
Proof
.
intros
.
rewrite
/
rec_app
.
do_head_step
done
.
Qed
.
Definition
lam
:
expr
[]
:
=
(
λ
:
"x"
,
'
"x"
+
#
21
)%
E
.
Definition
lam
:
expr
:
=
(
λ
:
"x"
,
"x"
+
#
21
)%
E
.
Goal
∀
σ
,
head_step
(
lam
#
21
)%
E
σ
add
σ
None
.
Proof
.
intros
.
rewrite
/
lam
.
do_head_step
done
.
Qed
.
End
LangTests
.
...
...
@@ -21,8 +21,8 @@ Section LiftingTests.
Implicit
Types
P
Q
:
iPropG
heap_lang
Σ
.
Implicit
Types
Φ
:
val
→
iPropG
heap_lang
Σ
.
Definition
heap_e
:
expr
[]
:
=
let
:
"x"
:
=
ref
#
1
in
'
"x"
<-
!
'
"x"
+
#
1
;;
!
'
"x"
.
Definition
heap_e
:
expr
:
=
let
:
"x"
:
=
ref
#
1
in
"x"
<-
!
"x"
+
#
1
;;
!
"x"
.