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
George Pirlea
Iris
Commits
82c06c8e
Commit
82c06c8e
authored
Mar 03, 2016
by
Ralf Jung
Browse files
Merge branch 'master' of gitlab.mpi-sws.org:FP/iris-coq
parents
f4f496b8
8ca359a5
Changes
7
Hide whitespace changes
Inline
Side-by-side
barrier/proof.v
View file @
82c06c8e
...
...
@@ -206,7 +206,7 @@ Proof.
apply
exist_elim
=>
γ
.
rewrite
!
sep_exist_r
.
apply
exist_elim
=>
P
.
rewrite
!
sep_exist_r
.
apply
exist_elim
=>
Q
.
rewrite
!
sep_exist_r
.
apply
exist_elim
=>
i
.
rewrite
-!
assoc
.
apply
const_elim_sep_l
=>?.
wp_focus
(!
_
)%
L
.
wp_focus
(!
_
)%
E
.
(* I think some evars here are better than repeating *everything* *)
eapply
(
sts_fsaS
_
(
wp_fsa
_
))
with
(
N0
:
=
N
)
(
γ
0
:
=
γ
)
;
simpl
;
eauto
with
I
ndisj
.
...
...
heap_lang/lang.v
View file @
82c06c8e
...
...
@@ -19,10 +19,6 @@ Inductive binder := BAnon | BNamed : string → binder.
Delimit
Scope
binder_scope
with
binder
.
Bind
Scope
binder_scope
with
binder
.
Delimit
Scope
lang_scope
with
L
.
Bind
Scope
lang_scope
with
base_lit
.
Delimit
Scope
val_scope
with
V
.
Bind
Scope
val_scope
with
base_lit
.
Inductive
expr
:
=
(* Base lambda calculus *)
...
...
@@ -51,6 +47,9 @@ Inductive expr :=
|
Store
(
e1
:
expr
)
(
e2
:
expr
)
|
Cas
(
e0
:
expr
)
(
e1
:
expr
)
(
e2
:
expr
).
Bind
Scope
expr_scope
with
expr
.
Delimit
Scope
expr_scope
with
E
.
Inductive
val
:
=
|
RecV
(
f
x
:
binder
)
(
e
:
expr
)
(* e should be closed *)
|
LitV
(
l
:
base_lit
)
...
...
@@ -59,9 +58,8 @@ Inductive val :=
|
InjRV
(
v
:
val
)
|
LocV
(
l
:
loc
).
Bind
Scope
binder_scope
with
expr
.
Bind
Scope
lang_scope
with
expr
base_lit
.
Bind
Scope
val_scope
with
val
base_lit
.
Bind
Scope
val_scope
with
val
.
Delimit
Scope
val_scope
with
V
.
Global
Instance
base_lit_dec_eq
(
l1
l2
:
base_lit
)
:
Decision
(
l1
=
l2
).
Proof
.
solve_decision
.
Defined
.
...
...
@@ -293,12 +291,12 @@ Qed.
Lemma
fill_not_val
K
e
:
to_val
e
=
None
→
to_val
(
fill
K
e
)
=
None
.
Proof
.
rewrite
!
eq_None_not_Some
;
eauto
using
fill_val
.
Qed
.
Lemma
val
ues
_head_stuck
e1
σ
1 e2
σ
2
ef
:
Lemma
val_head_stuck
e1
σ
1 e2
σ
2
ef
:
head_step
e1
σ
1 e2
σ
2
ef
→
to_val
e1
=
None
.
Proof
.
destruct
1
;
naive_solver
.
Qed
.
Lemma
val
ues
_stuck
e1
σ
1 e2
σ
2
ef
:
prim_step
e1
σ
1 e2
σ
2
ef
→
to_val
e1
=
None
.
Proof
.
intros
[???
->
->
?]
;
eauto
using
fill_not_val
,
val
ues
_head_stuck
.
Qed
.
Lemma
val_stuck
e1
σ
1 e2
σ
2
ef
:
prim_step
e1
σ
1 e2
σ
2
ef
→
to_val
e1
=
None
.
Proof
.
intros
[???
->
->
?]
;
eauto
using
fill_not_val
,
val_head_stuck
.
Qed
.
Lemma
atomic_not_val
e
:
atomic
e
→
to_val
e
=
None
.
Proof
.
destruct
e
;
naive_solver
.
Qed
.
...
...
@@ -326,7 +324,7 @@ Lemma atomic_step e1 σ1 e2 σ2 ef :
atomic
e1
→
prim_step
e1
σ
1 e2
σ
2
ef
→
is_Some
(
to_val
e2
).
Proof
.
intros
Hatomic
[
K
e1'
e2'
->
->
Hstep
].
assert
(
K
=
[])
as
->
by
eauto
10
using
atomic_fill
,
val
ues
_head_stuck
.
assert
(
K
=
[])
as
->
by
eauto
10
using
atomic_fill
,
val_head_stuck
.
naive_solver
eauto
using
atomic_head_step
.
Qed
.
...
...
@@ -357,7 +355,7 @@ Proof.
{
exfalso
;
apply
(
eq_None_not_Some
(
to_val
(
fill
K
e1
)))
;
eauto
using
fill_not_val
,
head_ctx_step_val
.
}
cut
(
Ki
=
Ki'
)
;
[
naive_solver
eauto
using
prefix_of_cons
|].
eauto
using
fill_item_no_val_inj
,
val
ues
_head_stuck
,
fill_not_val
.
eauto
using
fill_item_no_val_inj
,
val_head_stuck
,
fill_not_val
.
Qed
.
Lemma
alloc_fresh
e
v
σ
:
...
...
@@ -373,7 +371,7 @@ Program Canonical Structure heap_lang : language := {|
atomic
:
=
heap_lang
.
atomic
;
prim_step
:
=
heap_lang
.
prim_step
;
|}.
Solve
Obligations
with
eauto
using
heap_lang
.
to_of_val
,
heap_lang
.
of_to_val
,
heap_lang
.
val
ues
_stuck
,
heap_lang
.
atomic_not_val
,
heap_lang
.
atomic_step
.
heap_lang
.
val_stuck
,
heap_lang
.
atomic_not_val
,
heap_lang
.
atomic_step
.
Global
Instance
heap_lang_ctx
K
:
LanguageCtx
heap_lang
(
heap_lang
.
fill
K
).
Proof
.
...
...
heap_lang/notation.v
View file @
82c06c8e
From
heap_lang
Require
Export
derived
.
Arguments
wp
{
_
_
}
_
_
%
L
_
.
Notation
"|| e @ E {{ Φ } }"
:
=
(
wp
E
e
%
L
Φ
)
Arguments
wp
{
_
_
}
_
_
%
E
_
.
Notation
"|| e @ E {{ Φ } }"
:
=
(
wp
E
e
%
E
Φ
)
(
at
level
20
,
e
,
Φ
at
level
200
,
format
"|| e @ E {{ Φ } }"
)
:
uPred_scope
.
Notation
"|| e {{ Φ } }"
:
=
(
wp
⊤
e
%
L
Φ
)
Notation
"|| e {{ Φ } }"
:
=
(
wp
⊤
e
%
E
Φ
)
(
at
level
20
,
e
,
Φ
at
level
200
,
format
"|| e {{ Φ } }"
)
:
uPred_scope
.
...
...
@@ -19,72 +19,71 @@ Coercion of_val : val >-> expr.
Coercion
BNamed
:
string
>->
binder
.
Notation
"<>"
:
=
BAnon
:
binder_scope
.
(** Syntax inspired by Coq/Ocaml. Constructions with higher precedence come
first. *)
(* No scope, does not conflict and scope is often not inferred properly. *)
Notation
"# l"
:
=
(
LitV
l
%
Z
%
V
)
(
at
level
8
,
format
"# l"
).
Notation
"% l"
:
=
(
LocV
l
)
(
at
level
8
,
format
"% l"
).
Notation
"( e1 , e2 , .. , en )"
:
=
(
Pair
..
(
Pair
e1
e2
)
..
en
)
:
lang_scope
.
(** Syntax inspired by Coq/Ocaml. Constructions with higher precedence come
first. *)
Notation
"( e1 , e2 , .. , en )"
:
=
(
Pair
..
(
Pair
e1
e2
)
..
en
)
:
expr_scope
.
Notation
"'match:' e0 'with' 'InjL' x1 => e1 | 'InjR' x2 => e2 'end'"
:
=
(
Match
e0
x1
e1
x2
e2
)
(
e0
,
x1
,
e1
,
x2
,
e2
at
level
200
)
:
lang
_scope
.
(
e0
,
x1
,
e1
,
x2
,
e2
at
level
200
)
:
expr
_scope
.
Notation
"()"
:
=
LitUnit
:
val_scope
.
Notation
"! e"
:
=
(
Load
e
%
L
)
(
at
level
9
,
right
associativity
)
:
lang
_scope
.
Notation
"'ref' e"
:
=
(
Alloc
e
%
L
)
(
at
level
30
,
right
associativity
)
:
lang
_scope
.
Notation
"- e"
:
=
(
UnOp
MinusUnOp
e
%
L
)
(
at
level
35
,
right
associativity
)
:
lang
_scope
.
Notation
"e1 + e2"
:
=
(
BinOp
PlusOp
e1
%
L
e2
%
L
)
(
at
level
50
,
left
associativity
)
:
lang
_scope
.
Notation
"e1 - e2"
:
=
(
BinOp
MinusOp
e1
%
L
e2
%
L
)
(
at
level
50
,
left
associativity
)
:
lang
_scope
.
Notation
"e1 ≤ e2"
:
=
(
BinOp
LeOp
e1
%
L
e2
%
L
)
(
at
level
70
)
:
lang
_scope
.
Notation
"e1 < e2"
:
=
(
BinOp
LtOp
e1
%
L
e2
%
L
)
(
at
level
70
)
:
lang
_scope
.
Notation
"e1 = e2"
:
=
(
BinOp
EqOp
e1
%
L
e2
%
L
)
(
at
level
70
)
:
lang
_scope
.
Notation
"~ e"
:
=
(
UnOp
NegOp
e
%
L
)
(
at
level
75
,
right
associativity
)
:
lang
_scope
.
Notation
"! e"
:
=
(
Load
e
%
E
)
(
at
level
9
,
right
associativity
)
:
expr
_scope
.
Notation
"'ref' e"
:
=
(
Alloc
e
%
E
)
(
at
level
30
,
right
associativity
)
:
expr
_scope
.
Notation
"- e"
:
=
(
UnOp
MinusUnOp
e
%
E
)
(
at
level
35
,
right
associativity
)
:
expr
_scope
.
Notation
"e1 + e2"
:
=
(
BinOp
PlusOp
e1
%
E
e2
%
E
)
(
at
level
50
,
left
associativity
)
:
expr
_scope
.
Notation
"e1 - e2"
:
=
(
BinOp
MinusOp
e1
%
E
e2
%
E
)
(
at
level
50
,
left
associativity
)
:
expr
_scope
.
Notation
"e1 ≤ e2"
:
=
(
BinOp
LeOp
e1
%
E
e2
%
E
)
(
at
level
70
)
:
expr
_scope
.
Notation
"e1 < e2"
:
=
(
BinOp
LtOp
e1
%
E
e2
%
E
)
(
at
level
70
)
:
expr
_scope
.
Notation
"e1 = e2"
:
=
(
BinOp
EqOp
e1
%
E
e2
%
E
)
(
at
level
70
)
:
expr
_scope
.
Notation
"~ e"
:
=
(
UnOp
NegOp
e
%
E
)
(
at
level
75
,
right
associativity
)
:
expr
_scope
.
(* The unicode ← is already part of the notation "_ ← _; _" for bind. *)
Notation
"e1 <- e2"
:
=
(
Store
e1
%
L
e2
%
L
)
(
at
level
80
)
:
lang
_scope
.
Notation
"'rec:' f x := e"
:
=
(
Rec
f
x
e
%
L
)
(
at
level
102
,
f
at
level
1
,
x
at
level
1
,
e
at
level
200
)
:
lang
_scope
.
Notation
"'rec:' f x := e"
:
=
(
RecV
f
x
e
%
L
)
Notation
"e1 <- e2"
:
=
(
Store
e1
%
E
e2
%
E
)
(
at
level
80
)
:
expr
_scope
.
Notation
"'rec:' f x := e"
:
=
(
Rec
f
x
e
%
E
)
(
at
level
102
,
f
at
level
1
,
x
at
level
1
,
e
at
level
200
)
:
expr
_scope
.
Notation
"'rec:' f x := e"
:
=
(
RecV
f
x
e
%
E
)
(
at
level
102
,
f
at
level
1
,
x
at
level
1
,
e
at
level
200
)
:
val_scope
.
Notation
"'if:' e1 'then' e2 'else' e3"
:
=
(
If
e1
%
L
e2
%
L
e3
%
L
)
(
at
level
200
,
e1
,
e2
,
e3
at
level
200
)
:
lang
_scope
.
Notation
"'if:' e1 'then' e2 'else' e3"
:
=
(
If
e1
%
E
e2
%
E
e3
%
E
)
(
at
level
200
,
e1
,
e2
,
e3
at
level
200
)
:
expr
_scope
.
(** Derived notions, in order of declaration. The notations for let and seq
are stated explicitly instead of relying on the Notations Let and Seq as
defined above. This is needed because App is now a coercion, and these
notations are otherwise not pretty printed back accordingly. *)
Notation
"λ: x , e"
:
=
(
Lam
x
e
%
L
)
(
at
level
102
,
x
at
level
1
,
e
at
level
200
)
:
lang
_scope
.
Notation
"λ: x , e"
:
=
(
LamV
x
e
%
L
)
Notation
"λ: x , e"
:
=
(
Lam
x
e
%
E
)
(
at
level
102
,
x
at
level
1
,
e
at
level
200
)
:
expr
_scope
.
Notation
"λ: x , e"
:
=
(
LamV
x
e
%
E
)
(
at
level
102
,
x
at
level
1
,
e
at
level
200
)
:
val_scope
.
Notation
"'let:' x := e1 'in' e2"
:
=
(
Lam
x
e2
%
L
e1
%
L
)
(
at
level
102
,
x
at
level
1
,
e1
,
e2
at
level
200
)
:
lang
_scope
.
Notation
"e1 ;; e2"
:
=
(
Lam
BAnon
e2
%
L
e1
%
L
)
(
at
level
100
,
e2
at
level
200
,
format
"e1 ;; e2"
)
:
lang
_scope
.
Notation
"'let:' x := e1 'in' e2"
:
=
(
Lam
x
e2
%
E
e1
%
E
)
(
at
level
102
,
x
at
level
1
,
e1
,
e2
at
level
200
)
:
expr
_scope
.
Notation
"e1 ;; e2"
:
=
(
Lam
BAnon
e2
%
E
e1
%
E
)
(
at
level
100
,
e2
at
level
200
,
format
"e1 ;; e2"
)
:
expr
_scope
.
(* These are not actually values, but we want them to be pretty-printed. *)
Notation
"'let:' x := e1 'in' e2"
:
=
(
LamV
x
e2
%
L
e1
%
L
)
Notation
"'let:' x := e1 'in' e2"
:
=
(
LamV
x
e2
%
E
e1
%
E
)
(
at
level
102
,
x
at
level
1
,
e1
,
e2
at
level
200
)
:
val_scope
.
Notation
"e1 ;; e2"
:
=
(
LamV
BAnon
e2
%
L
e1
%
L
)
Notation
"e1 ;; e2"
:
=
(
LamV
BAnon
e2
%
E
e1
%
E
)
(
at
level
100
,
e2
at
level
200
,
format
"e1 ;; e2"
)
:
val_scope
.
Notation
"'rec:' f x y := e"
:
=
(
Rec
f
x
(
Lam
y
e
%
L
))
(
at
level
102
,
f
,
x
,
y
at
level
1
,
e
at
level
200
)
:
lang
_scope
.
Notation
"'rec:' f x y := e"
:
=
(
RecV
f
x
(
Lam
y
e
%
L
))
Notation
"'rec:' f x y := e"
:
=
(
Rec
f
x
(
Lam
y
e
%
E
))
(
at
level
102
,
f
,
x
,
y
at
level
1
,
e
at
level
200
)
:
expr
_scope
.
Notation
"'rec:' f x y := e"
:
=
(
RecV
f
x
(
Lam
y
e
%
E
))
(
at
level
102
,
f
,
x
,
y
at
level
1
,
e
at
level
200
)
:
val_scope
.
Notation
"'rec:' f x y z := e"
:
=
(
Rec
f
x
(
Lam
y
(
Lam
z
e
%
L
)))
(
at
level
102
,
f
,
x
,
y
,
z
at
level
1
,
e
at
level
200
)
:
lang
_scope
.
Notation
"'rec:' f x y z := e"
:
=
(
RecV
f
x
(
Lam
y
(
Lam
z
e
%
L
)))
Notation
"'rec:' f x y z := e"
:
=
(
Rec
f
x
(
Lam
y
(
Lam
z
e
%
E
)))
(
at
level
102
,
f
,
x
,
y
,
z
at
level
1
,
e
at
level
200
)
:
expr
_scope
.
Notation
"'rec:' f x y z := e"
:
=
(
RecV
f
x
(
Lam
y
(
Lam
z
e
%
E
)))
(
at
level
102
,
f
,
x
,
y
,
z
at
level
1
,
e
at
level
200
)
:
val_scope
.
Notation
"λ: x y , e"
:
=
(
Lam
x
(
Lam
y
e
%
L
))
(
at
level
102
,
x
,
y
at
level
1
,
e
at
level
200
)
:
lang
_scope
.
Notation
"λ: x y , e"
:
=
(
LamV
x
(
Lam
y
e
%
L
))
Notation
"λ: x y , e"
:
=
(
Lam
x
(
Lam
y
e
%
E
))
(
at
level
102
,
x
,
y
at
level
1
,
e
at
level
200
)
:
expr
_scope
.
Notation
"λ: x y , e"
:
=
(
LamV
x
(
Lam
y
e
%
E
))
(
at
level
102
,
x
,
y
at
level
1
,
e
at
level
200
)
:
val_scope
.
Notation
"λ: x y z , e"
:
=
(
Lam
x
(
Lam
y
(
Lam
z
e
%
L
)))
(
at
level
102
,
x
,
y
,
z
at
level
1
,
e
at
level
200
)
:
lang
_scope
.
Notation
"λ: x y z , e"
:
=
(
LamV
x
(
Lam
y
(
Lam
z
e
%
L
)))
Notation
"λ: x y z , e"
:
=
(
Lam
x
(
Lam
y
(
Lam
z
e
%
E
)))
(
at
level
102
,
x
,
y
,
z
at
level
1
,
e
at
level
200
)
:
expr
_scope
.
Notation
"λ: x y z , e"
:
=
(
LamV
x
(
Lam
y
(
Lam
z
e
%
E
)))
(
at
level
102
,
x
,
y
,
z
at
level
1
,
e
at
level
200
)
:
val_scope
.
heap_lang/tactics.v
View file @
82c06c8e
...
...
@@ -19,7 +19,7 @@ Ltac inv_step :=
simpl
in
H
;
first
[
subst
e
|
discriminate
H
|
injection
H
as
H
]
(* ensure that we make progress for each subgoal *)
|
H
:
head_step
?e
_
_
_
_
,
Hv
:
of_val
?v
=
fill
?K
?e
|-
_
=>
apply
val
ues
_head_stuck
,
(
fill_not_val
K
)
in
H
;
apply
val_head_stuck
,
(
fill_not_val
K
)
in
H
;
by
rewrite
-
Hv
to_of_val
in
H
(* maybe use a helper lemma here? *)
|
H
:
head_step
?e
_
_
_
_
|-
_
=>
try
(
is_var
e
;
fail
1
)
;
(* inversion yields many goals if e is a variable
...
...
heap_lang/tests.v
View file @
82c06c8e
...
...
@@ -4,7 +4,7 @@ From heap_lang Require Import wp_tactics heap notation.
Import
uPred
.
Section
LangTests
.
Definition
add
:
=
(#
21
+
#
21
)%
L
.
Definition
add
:
=
(#
21
+
#
21
)%
E
.
Goal
∀
σ
,
prim_step
add
σ
(#
42
)
σ
None
.
Proof
.
intros
;
do_step
done
.
Qed
.
Definition
rec_app
:
expr
:
=
((
rec
:
"f"
"x"
:
=
"f"
"x"
)
#
0
).
...
...
@@ -14,7 +14,7 @@ Section LangTests.
by
eapply
(
Ectx_step
_
_
_
_
_
[]),
(
BetaS
_
_
_
_
#
0
).
Qed
.
Definition
lam
:
expr
:
=
λ
:
"x"
,
"x"
+
#
21
.
Goal
∀
σ
,
prim_step
(
lam
#
21
)%
L
σ
add
σ
None
.
Goal
∀
σ
,
prim_step
(
lam
#
21
)%
E
σ
add
σ
None
.
Proof
.
intros
.
rewrite
/
lam
.
(* FIXME: do_step does not work here *)
by
eapply
(
Ectx_step
_
_
_
_
_
[]),
(
BetaS
<>
"x"
(
"x"
+
#
21
)
_
#
21
).
...
...
program_logic/adequacy.v
View file @
82c06c8e
...
...
@@ -33,7 +33,7 @@ Proof.
(
Φ
&
Φ
s2
&
r
&
rs2
&->&->&
Hwp
&?)%
Forall3_cons_inv_l
)%
Forall3_app_inv_l
?.
rewrite
wp_eq
in
Hwp
.
destruct
(
wp_step_inv
⊤
∅
Φ
e1
(
k
+
n
)
(
S
(
k
+
n
))
σ
1
r
(
big_op
(
rs1
++
rs2
)))
as
[
_
Hwpstep
]
;
eauto
using
val
ues
_stuck
.
(
big_op
(
rs1
++
rs2
)))
as
[
_
Hwpstep
]
;
eauto
using
val_stuck
.
{
by
rewrite
right_id_L
-
big_op_cons
Permutation_middle
.
}
destruct
(
Hwpstep
e2
σ
2
ef
)
as
(
r2
&
r2'
&
Hwsat
&?&?)
;
auto
;
clear
Hwpstep
.
revert
Hwsat
;
rewrite
big_op_app
right_id_L
=>
Hwsat
.
...
...
program_logic/language.v
View file @
82c06c8e
...
...
@@ -10,7 +10,7 @@ Structure language := Language {
prim_step
:
expr
→
state
→
expr
→
state
→
option
expr
→
Prop
;
to_of_val
v
:
to_val
(
of_val
v
)
=
Some
v
;
of_to_val
e
v
:
to_val
e
=
Some
v
→
of_val
v
=
e
;
val
ues
_stuck
e
σ
e'
σ
'
ef
:
prim_step
e
σ
e'
σ
'
ef
→
to_val
e
=
None
;
val_stuck
e
σ
e'
σ
'
ef
:
prim_step
e
σ
e'
σ
'
ef
→
to_val
e
=
None
;
atomic_not_val
e
:
atomic
e
→
to_val
e
=
None
;
atomic_step
e1
σ
1 e2
σ
2
ef
:
atomic
e1
→
...
...
@@ -23,7 +23,7 @@ Arguments atomic {_} _.
Arguments
prim_step
{
_
}
_
_
_
_
_
.
Arguments
to_of_val
{
_
}
_
.
Arguments
of_to_val
{
_
}
_
_
_
.
Arguments
val
ues
_stuck
{
_
}
_
_
_
_
_
_
.
Arguments
val_stuck
{
_
}
_
_
_
_
_
_
.
Arguments
atomic_not_val
{
_
}
_
_
.
Arguments
atomic_step
{
_
}
_
_
_
_
_
_
_
.
...
...
@@ -45,7 +45,7 @@ Section language.
step
ρ
1
ρ
2
.
Lemma
reducible_not_val
e
σ
:
reducible
e
σ
→
to_val
e
=
None
.
Proof
.
intros
(?&?&?&?)
;
eauto
using
val
ues
_stuck
.
Qed
.
Proof
.
intros
(?&?&?&?)
;
eauto
using
val_stuck
.
Qed
.
Lemma
atomic_of_val
v
:
¬
atomic
(
of_val
v
).
Proof
.
by
intros
Hat
%
atomic_not_val
;
rewrite
to_of_val
in
Hat
.
Qed
.
Global
Instance
:
Inj
(=)
(=)
(@
of_val
Λ
).
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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