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
Simon Spies
Iris
Commits
30f13e2d
Commit
30f13e2d
authored
Jul 15, 2016
by
Robbert Krebbers
Browse files
Remove dependent types in heap_lang representation.
parent
aa81760b
Changes
18
Expand all
Hide whitespace changes
Inline
Side-by-side
.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
:
=