Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Rice Wine
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:
...
@@ -11,6 +11,7 @@ buildjob:
only
:
only
:
-
master
-
master
-
jh_simplified_resources
-
jh_simplified_resources
-
rk/substitition
artifacts
:
artifacts
:
paths
:
paths
:
-
build-time.txt
-
build-time.txt
heap_lang/derived.v
View file @
30f13e2d
...
@@ -19,29 +19,34 @@ Implicit Types Φ : val → iProp heap_lang Σ.
...
@@ -19,29 +19,34 @@ Implicit Types Φ : val → iProp heap_lang Σ.
(** Proof rules for the sugar *)
(** Proof rules for the sugar *)
Lemma
wp_lam
E
x
ef
e
v
Φ
:
Lemma
wp_lam
E
x
ef
e
v
Φ
:
to_val
e
=
Some
v
→
to_val
e
=
Some
v
→
Closed
(
x
:
b
:
[])
ef
→
▷
WP
subst'
x
e
ef
@
E
{{
Φ
}}
⊢
WP
App
(
Lam
x
ef
)
e
@
E
{{
Φ
}}.
▷
WP
subst'
x
e
ef
@
E
{{
Φ
}}
⊢
WP
App
(
Lam
x
ef
)
e
@
E
{{
Φ
}}.
Proof
.
intros
.
by
rewrite
-(
wp_rec
_
BAnon
)
//.
Qed
.
Proof
.
intros
.
by
rewrite
-(
wp_rec
_
BAnon
)
//.
Qed
.
Lemma
wp_let
E
x
e1
e2
v
Φ
:
Lemma
wp_let
E
x
e1
e2
v
Φ
:
to_val
e1
=
Some
v
→
to_val
e1
=
Some
v
→
Closed
(
x
:
b
:
[])
e2
→
▷
WP
subst'
x
e1
e2
@
E
{{
Φ
}}
⊢
WP
Let
x
e1
e2
@
E
{{
Φ
}}.
▷
WP
subst'
x
e1
e2
@
E
{{
Φ
}}
⊢
WP
Let
x
e1
e2
@
E
{{
Φ
}}.
Proof
.
apply
wp_lam
.
Qed
.
Proof
.
apply
wp_lam
.
Qed
.
Lemma
wp_seq
E
e1
e2
v
Φ
:
Lemma
wp_seq
E
e1
e2
v
Φ
:
to_val
e1
=
Some
v
→
to_val
e1
=
Some
v
→
Closed
[]
e2
→
▷
WP
e2
@
E
{{
Φ
}}
⊢
WP
Seq
e1
e2
@
E
{{
Φ
}}.
▷
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
{{
Φ
}}.
Lemma
wp_skip
E
Φ
:
▷
Φ
(
LitV
LitUnit
)
⊢
WP
Skip
@
E
{{
Φ
}}.
Proof
.
rewrite
-
wp_seq
//
-
wp_value
//.
Qed
.
Proof
.
rewrite
-
wp_seq
//
-
wp_value
//.
Qed
.
Lemma
wp_match_inl
E
e0
v0
x1
e1
x2
e2
Φ
:
Lemma
wp_match_inl
E
e0
v0
x1
e1
x2
e2
Φ
:
to_val
e0
=
Some
v0
→
to_val
e0
=
Some
v0
→
Closed
(
x1
:
b
:
[])
e1
→
▷
WP
subst'
x1
e0
e1
@
E
{{
Φ
}}
⊢
WP
Match
(
InjL
e0
)
x1
e1
x2
e2
@
E
{{
Φ
}}.
▷
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
.
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
Φ
:
Lemma
wp_match_inr
E
e0
v0
x1
e1
x2
e2
Φ
:
to_val
e0
=
Some
v0
→
to_val
e0
=
Some
v0
→
Closed
(
x2
:
b
:
[])
e2
→
▷
WP
subst'
x2
e0
e2
@
E
{{
Φ
}}
⊢
WP
Match
(
InjR
e0
)
x1
e1
x2
e2
@
E
{{
Φ
}}.
▷
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
.
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
Export
derived
.
From
iris
.
heap_lang
Require
Import
wp_tactics
substitution
notation
.
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 *)
if
:
e
then
#()
else
#
0
#
0
.
(* #0 #0 is unsafe *)
Instance
do_wexpr_assert
{
X
Y
}
(
H
:
X
`
included
`
Y
)
e
er
:
Instance
closed_assert
X
e
:
Closed
X
e
→
Closed
X
(
Assert
e
)
:
=
_
.
WExpr
H
e
er
→
WExpr
H
(
Assert
e
)
(
Assert
er
)
:
=
_
.
Instance
do_subst_assert
x
es
e
er
:
Instance
do_wsubst_assert
{
X
Y
}
x
es
(
H
:
X
`
included
`
x
::
Y
)
e
er
:
Subst
x
es
e
er
→
Subst
x
es
(
Assert
e
)
(
Assert
er
).
WSubst
x
es
H
e
er
→
WSubst
x
es
H
(
Assert
e
)
(
Assert
er
).
Proof
.
intros
;
red
.
by
rewrite
/
Assert
/
subst
-/
subst
;
f_equal
/=.
Qed
.
Proof
.
intros
;
red
.
by
rewrite
/
Assert
/
wsubst
-/
wsubst
;
f_equal
/=.
Qed
.
Typeclasses
Opaque
Assert
.
Typeclasses
Opaque
Assert
.
Lemma
wp_assert
{
Σ
}
(
Φ
:
val
→
iProp
heap_lang
Σ
)
:
Lemma
wp_assert
{
Σ
}
(
Φ
:
val
→
iProp
heap_lang
Σ
)
:
...
...
heap_lang/lib/barrier/barrier.v
View file @
30f13e2d
From
iris
.
heap_lang
Require
Export
notation
.
From
iris
.
heap_lang
Require
Export
notation
.
Definition
newbarrier
:
val
:
=
λ
:
<>,
ref
#
0
.
Definition
newbarrier
:
val
:
=
λ
:
<>,
ref
#
0
.
Definition
signal
:
val
:
=
λ
:
"x"
,
'
"x"
<-
#
1
.
Definition
signal
:
val
:
=
λ
:
"x"
,
"x"
<-
#
1
.
Definition
wait
:
val
:
=
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
.
Global
Opaque
newbarrier
signal
wait
.
heap_lang/lib/counter.v
View file @
30f13e2d
...
@@ -8,9 +8,9 @@ Import uPred.
...
@@ -8,9 +8,9 @@ Import uPred.
Definition
newcounter
:
val
:
=
λ
:
<>,
ref
#
0
.
Definition
newcounter
:
val
:
=
λ
:
<>,
ref
#
0
.
Definition
inc
:
val
:
=
Definition
inc
:
val
:
=
rec
:
"inc"
"l"
:
=
rec
:
"inc"
"l"
:
=
let
:
"n"
:
=
!
'
"l"
in
let
:
"n"
:
=
!
"l"
in
if
:
CAS
'
"l"
'
"n"
(#
1
+
'
"n"
)
then
#()
else
'
"inc"
'
"l"
.
if
:
CAS
"l"
"n"
(#
1
+
"n"
)
then
#()
else
"inc"
"l"
.
Definition
read
:
val
:
=
λ
:
"l"
,
!
'
"l"
.
Definition
read
:
val
:
=
λ
:
"l"
,
!
"l"
.
Global
Opaque
newcounter
inc
get
.
Global
Opaque
newcounter
inc
get
.
(** The CMRA we need. *)
(** The CMRA we need. *)
...
...
heap_lang/lib/lock.v
View file @
30f13e2d
...
@@ -6,8 +6,8 @@ Import uPred.
...
@@ -6,8 +6,8 @@ Import uPred.
Definition
newlock
:
val
:
=
λ
:
<>,
ref
#
false
.
Definition
newlock
:
val
:
=
λ
:
<>,
ref
#
false
.
Definition
acquire
:
val
:
=
Definition
acquire
:
val
:
=
rec
:
"acquire"
"l"
:
=
rec
:
"acquire"
"l"
:
=
if
:
CAS
'
"l"
#
false
#
true
then
#()
else
'
"acquire"
'
"l"
.
if
:
CAS
"l"
#
false
#
true
then
#()
else
"acquire"
"l"
.
Definition
release
:
val
:
=
λ
:
"l"
,
'
"l"
<-
#
false
.
Definition
release
:
val
:
=
λ
:
"l"
,
"l"
<-
#
false
.
Global
Opaque
newlock
acquire
release
.
Global
Opaque
newlock
acquire
release
.
(** The CMRA we need. *)
(** The CMRA we need. *)
...
...
heap_lang/lib/par.v
View file @
30f13e2d
...
@@ -2,18 +2,14 @@ From iris.heap_lang Require Export spawn.
...
@@ -2,18 +2,14 @@ From iris.heap_lang Require Export spawn.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
From
iris
.
heap_lang
Require
Import
proofmode
notation
.
Import
uPred
.
Import
uPred
.
Definition
par
{
X
}
:
expr
X
:
=
Definition
par
:
val
:
=
λ
:
"fs"
,
λ
:
"fs"
,
let
:
"handle"
:
=
^
spawn
(
Fst
'
"fs"
)
in
let
:
"handle"
:
=
spawn
(
Fst
"fs"
)
in
let
:
"v2"
:
=
Snd
'
"fs"
#()
in
let
:
"v2"
:
=
Snd
"fs"
#()
in
let
:
"v1"
:
=
^
join
'
"handle"
in
let
:
"v1"
:
=
join
"handle"
in
Pair
'
"v1"
'
"v2"
.
Pair
"v1"
"v2"
.
Notation
Par
e1
e2
:
=
(
par
(
Pair
(
λ
:
<>,
e1
)
(
λ
:
<>,
e2
)))%
E
.
Notation
Par
e1
e2
:
=
(
par
(
Pair
(
λ
:
<>,
e1
)
(
λ
:
<>,
e2
)))%
E
.
Infix
"||"
:
=
Par
:
expr_scope
.
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
.
Global
Opaque
par
.
Section
proof
.
Section
proof
.
...
@@ -36,13 +32,14 @@ Proof.
...
@@ -36,13 +32,14 @@ Proof.
iSpecialize
(
"HΦ"
with
"* [-]"
)
;
first
by
iSplitL
"H1"
.
by
wp_let
.
iSpecialize
(
"HΦ"
with
"* [-]"
)
;
first
by
iSplitL
"H1"
.
by
wp_let
.
Qed
.
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
→
heapN
⊥
N
→
(
heap_ctx
heapN
★
WP
e1
{{
Ψ
1
}}
★
WP
e2
{{
Ψ
2
}}
★
(
heap_ctx
heapN
★
WP
e1
{{
Ψ
1
}}
★
WP
e2
{{
Ψ
2
}}
★
∀
v1
v2
,
Ψ
1
v1
★
Ψ
2
v2
-
★
▷
Φ
(
v1
,
v2
)%
V
)
∀
v1
v2
,
Ψ
1
v1
★
Ψ
2
v2
-
★
▷
Φ
(
v1
,
v2
)%
V
)
⊢
WP
e1
||
e2
{{
Φ
}}.
⊢
WP
e1
||
e2
{{
Φ
}}.
Proof
.
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
.
iFrame
"Hh H"
.
iSplitL
"H1"
;
by
wp_let
.
Qed
.
Qed
.
End
proof
.
End
proof
.
heap_lang/lib/spawn.v
View file @
30f13e2d
...
@@ -6,12 +6,12 @@ Import uPred.
...
@@ -6,12 +6,12 @@ Import uPred.
Definition
spawn
:
val
:
=
Definition
spawn
:
val
:
=
λ
:
"f"
,
λ
:
"f"
,
let
:
"c"
:
=
ref
(
InjL
#
0
)
in
let
:
"c"
:
=
ref
(
InjL
#
0
)
in
Fork
(
'
"c"
<-
InjR
(
'
"f"
#()))
;;
'
"c"
.
Fork
(
"c"
<-
InjR
(
"f"
#()))
;;
"c"
.
Definition
join
:
val
:
=
Definition
join
:
val
:
=
rec
:
"join"
"c"
:
=
rec
:
"join"
"c"
:
=
match
:
!
'
"c"
with
match
:
!
"c"
with
InjR
"x"
=>
'
"x"
InjR
"x"
=>
"x"
|
InjL
<>
=>
'
"join"
'
"c"
|
InjL
<>
=>
"join"
"c"
end
.
end
.
Global
Opaque
spawn
join
.
Global
Opaque
spawn
join
.
...
...
heap_lang/lifting.v
View file @
30f13e2d
...
@@ -10,7 +10,7 @@ Section lifting.
...
@@ -10,7 +10,7 @@ Section lifting.
Context
{
Σ
:
iFunctor
}.
Context
{
Σ
:
iFunctor
}.
Implicit
Types
P
Q
:
iProp
heap_lang
Σ
.
Implicit
Types
P
Q
:
iProp
heap_lang
Σ
.
Implicit
Types
Φ
:
val
→
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. *)
(** Bind. This bundles some arguments that wp_ectx_bind leaves as indices. *)
Lemma
wp_bind
{
E
e
}
K
Φ
:
Lemma
wp_bind
{
E
e
}
K
Φ
:
...
@@ -84,9 +84,10 @@ Qed.
...
@@ -84,9 +84,10 @@ Qed.
Lemma
wp_rec
E
f
x
erec
e1
e2
v2
Φ
:
Lemma
wp_rec
E
f
x
erec
e1
e2
v2
Φ
:
e1
=
Rec
f
x
erec
→
e1
=
Rec
f
x
erec
→
to_val
e2
=
Some
v2
→
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
{{
Φ
}}.
▷
WP
subst'
x
e2
(
subst'
f
e1
erec
)
@
E
{{
Φ
}}
⊢
WP
App
e1
e2
@
E
{{
Φ
}}.
Proof
.
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
;
(
subst'
x
e2
(
subst'
f
(
Rec
f
x
erec
)
erec
))
None
)
//=
?right_id
;
intros
;
inv_head_step
;
eauto
.
intros
;
inv_head_step
;
eauto
.
Qed
.
Qed
.
...
...
heap_lang/notation.v
View file @
30f13e2d
...
@@ -24,6 +24,8 @@ Coercion LitLoc : loc >-> base_lit.
...
@@ -24,6 +24,8 @@ Coercion LitLoc : loc >-> base_lit.
Coercion
App
:
expr
>->
Funclass
.
Coercion
App
:
expr
>->
Funclass
.
Coercion
of_val
:
val
>->
expr
.
Coercion
of_val
:
val
>->
expr
.
Coercion
Var
:
string
>->
expr
.
Coercion
BNamed
:
string
>->
binder
.
Coercion
BNamed
:
string
>->
binder
.
Notation
"<>"
:
=
BAnon
:
binder_scope
.
Notation
"<>"
:
=
BAnon
:
binder_scope
.
...
@@ -32,9 +34,6 @@ properly. *)
...
@@ -32,9 +34,6 @@ properly. *)
Notation
"# l"
:
=
(
LitV
l
%
Z
%
V
)
(
at
level
8
,
format
"# l"
).
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
"# 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
(** Syntax inspired by Coq/Ocaml. Constructions with higher precedence come
first. *)
first. *)
Notation
"( e1 , e2 , .. , en )"
:
=
(
Pair
..
(
Pair
e1
e2
)
..
en
)
:
expr_scope
.
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.
...
@@ -2,196 +2,99 @@ From iris.heap_lang Require Export lang.
Import
heap_lang
.
Import
heap_lang
.
(** The tactic [simpl_subst] performs substitutions in the goal. Its behavior
(** The tactic [simpl_subst] performs substitutions in the goal. Its behavior
can be tuned by declaring [WExpr] and [WSubst] instances. *)
can be tuned by declaring [Subst] instances. *)
(** * Substitution *)
(** * Weakening *)
Class
Subst
(
x
:
string
)
(
es
:
expr
)
(
e
:
expr
)
(
er
:
expr
)
:
=
Class
WExpr
{
X
Y
}
(
H
:
X
`
included
`
Y
)
(
e
:
expr
X
)
(
er
:
expr
Y
)
:
=
do_subst
:
subst
x
es
e
=
er
.
do_wexpr
:
wexpr
H
e
=
er
.
Hint
Mode
Subst
+
+
+
-
:
typeclass_instances
.
Hint
Mode
WExpr
+
+
+
+
-
:
typeclass_instances
.
(* Variables *)
(* Variables *)
Hint
Extern
0
(
WExpr
_
(
Var
?y
)
_
)
=>
Lemma
do_subst_var_eq
x
er
:
Subst
x
er
(
Var
x
)
er
.
apply
var_proof_irrel
:
typeclass_instances
.
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
).
(* Rec *)
Proof
.
rewrite
bool_decide_spec
.
intros
;
red
;
simpl
.
by
case_decide
.
Qed
.
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
.
(** * WSubstitution *)
Hint
Extern
0
(
Subst
?x
?v
(
Var
?y
)
_
)
=>
Class
WSubst
{
X
Y
}
(
x
:
string
)
(
es
:
expr
[])
H
(
e
:
expr
X
)
(
er
:
expr
Y
)
:
=
first
[
apply
do_subst_var_eq
do_wsubst
:
wsubst
x
es
H
e
=
er
.
|
apply
do_subst_var_neq
,
I
]
:
typeclass_instances
.
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
.
(** Rec *)
(** Rec *)
Lemma
do_wsubst_rec_true
{
X
Y
x
es
f
y
e
}
{
H
:
X
`
included
`
x
::
Y
}
Lemma
do_subst_rec_true
{
x
es
f
y
e
er
}
:
(
Hfy
:
BNamed
x
≠
f
∧
BNamed
x
≠
y
)
er
:
bool_decide
(
BNamed
x
≠
f
∧
BNamed
x
≠
y
)
→
WSubst
x
es
(
wsubst_rec_true_prf
H
Hfy
)
e
er
→
Subst
x
es
e
er
→
Subst
x
es
(
Rec
f
y
e
)
(
Rec
f
y
er
).
WSubst
x
es
H
(
Rec
f
y
e
)
(
Rec
f
y
er
).
Proof
.
rewrite
bool_decide_spec
.
intros
;
red
;
f_equal
/=
;
by
case_decide
.
Qed
.
Proof
.
Lemma
do_subst_rec_false
{
x
es
f
y
e
}
:
intros
?
;
red
;
f_equal
/=
;
case_decide
;
last
done
.
bool_decide
(
¬
(
BNamed
x
≠
f
∧
BNamed
x
≠
y
))
→
by
etrans
;
[
apply
wsubst_proof_irrel
|].
Subst
x
es
(
Rec
f
y
e
)
(
Rec
f
y
e
).
Qed
.
Proof
.
rewrite
bool_decide_spec
.
intros
;
red
;
f_equal
/=
;
by
case_decide
.
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
:
Local
Ltac
bool_decide_no_check
:
=
vm_cast_no_check
I
.
WExpr
(
wsubst_rec_false_prf
H
Hfy
)
e
er
→
Hint
Extern
0
(
Subst
?x
?v
(
Rec
?f
?y
?e
)
_
)
=>
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
)
_
)
=>
match
eval
vm_compute
in
(
bool_decide
(
BNamed
x
≠
f
∧
BNamed
x
≠
y
))
with
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
))
|
true
=>
eapply
(
do_subst_rec_true
ltac
:
(
bool_decide_no_check
))
|
false
=>
eapply
(
do_
w
subst_rec_false
ltac
:
(
bool_decide_no_check
))
|
false
=>
eapply
(
do_subst_rec_false
ltac
:
(
bool_decide_no_check
))
end
:
typeclass_instances
.
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 *)
(* Values *)
Instance
do_wsubst_wexpr
X
Y
Z
x
es
Instance
do_subst_of_val
x
es
v
:
Subst
x
es
(
of_val
v
)
(
of_val
v
)
|
0
.
(
H1
:
X
`
included
`
Y
)
(
H2
:
Y
`
included
`
x
::
Z
)
e
er
:
Proof
.
eapply
closed_nil_subst
,
of_val_closed
.
Qed
.
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
.
(* Boring connectives *)
(* Boring connectives *)
Section
w
subst
.
Section
subst
.
Context
{
X
Y
}
(
x
:
string
)
(
es
:
expr
[])
(
H
:
X
`
included
`
x
::
Y
).
Context
(
x
:
string
)
(
es
:
expr
).
Notation
Sub
:
=
(
W
Subst
x
es
H
).
Notation
Sub
:
=
(
Subst
x
es
).
(* Ground terms *)
(* 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
.
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
).
Sub
e1
e1r
→
Sub
e2
e2r
→
Sub
(
App
e1
e2
)
(
App
e1r
e2r
).
Proof
.
intros
;
red
;
f_equal
/=
;
apply
:
do_
w
subst
.
Qed
.
Proof
.
intros
;
red
;
f_equal
/=
;
apply
:
do_subst
.
Qed
.
Global
Instance
do_
w
subst_unop
op
e
er
:
Sub
e
er
→
Sub
(
UnOp
op
e
)
(
UnOp
op
er
).
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
.
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
).
Sub
e1
e1r
→
Sub
e2
e2r
→
Sub
(
BinOp
op
e1
e2
)
(
BinOp
op
e1r
e2r
).
Proof
.
by
intros
;
red
;
f_equal
/=.
Qed
.
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
).
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
.
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
).
Sub
e1
e1r
→
Sub
e2
e2r
→
Sub
(
Pair
e1
e2
)
(
Pair
e1r
e2r
).
Proof
.
by
intros
??
;
red
;
f_equal
/=.
Qed
.
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
.
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
.
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
.
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
.
Proof
.
by