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
Dan Frumin
ReLoC-v1
Commits
f2045770
Commit
f2045770
authored
Feb 06, 2017
by
Dan Frumin
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Update F_mu_ref_conc to Iris 3
sans examples
parent
70299030
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
337 additions
and
407 deletions
+337
-407
F_mu_ref_conc/fundamental_binary.v
F_mu_ref_conc/fundamental_binary.v
+93
-70
F_mu_ref_conc/fundamental_unary.v
F_mu_ref_conc/fundamental_unary.v
+27
-24
F_mu_ref_conc/lang.v
F_mu_ref_conc/lang.v
+6
-2
F_mu_ref_conc/logrel_binary.v
F_mu_ref_conc/logrel_binary.v
+26
-33
F_mu_ref_conc/logrel_unary.v
F_mu_ref_conc/logrel_unary.v
+16
-20
F_mu_ref_conc/rules.v
F_mu_ref_conc/rules.v
+73
-194
F_mu_ref_conc/rules_binary.v
F_mu_ref_conc/rules_binary.v
+53
-39
F_mu_ref_conc/soundness_binary.v
F_mu_ref_conc/soundness_binary.v
+25
-18
F_mu_ref_conc/soundness_unary.v
F_mu_ref_conc/soundness_unary.v
+18
-7
No files found.
F_mu_ref_conc/fundamental_binary.v
View file @
f2045770
...
...
@@ -5,11 +5,12 @@ From iris.base_logic Require Export big_op.
Section
bin_log_def
.
Context
`
{
cfgSG
Σ
}
.
Context
`
{
heapIG
Σ
}
.
Notation
D
:=
(
prodC
valC
valC
-
n
>
iProp
Σ
).
Definition
bin_log_related
(
Γ
:
list
type
)
(
e
e
'
:
expr
)
(
τ
:
type
)
:=
∀
Δ
vvs
ρ
,
env_PersistentP
Δ
→
heapI_ctx
∧
spec_ctx
ρ
∧
spec_ctx
ρ
∧
⟦
Γ
⟧
*
Δ
vvs
⊢
⟦
τ
⟧ₑ
Δ
(
e
.[
env_subst
(
vvs
.
*
1
)],
e
'
.[
env_subst
(
vvs
.
*
2
)]).
End
bin_log_def
.
...
...
@@ -18,6 +19,7 @@ Notation "Γ ⊨ e '≤log≤' e' : τ" :=
Section
fundamental
.
Context
`
{
cfgSG
Σ
}
.
Context
`
{
heapIG
Σ
}
.
Notation
D
:=
(
prodC
valC
valC
-
n
>
iProp
Σ
).
Implicit
Types
e
:
expr
.
Implicit
Types
Δ
:
listC
D
.
...
...
@@ -37,11 +39,11 @@ Section fundamental.
(
*
Put
all
quantifiers
at
the
outer
level
*
)
Lemma
bin_log_related_alt
{
Γ
e
e
'
τ
}
:
Γ
⊨
e
≤
log
≤
e
'
:
τ
→
∀
Δ
vvs
ρ
j
K
,
env_PersistentP
Δ
→
heapI_ctx
∗
spec_ctx
ρ
∗
⟦
Γ
⟧
*
Δ
vvs
∗
j
⤇
fill
K
(
e
'
.[
env_subst
(
vvs
.
*
2
)])
spec_ctx
ρ
∗
⟦
Γ
⟧
*
Δ
vvs
∗
j
⤇
fill
K
(
e
'
.[
env_subst
(
vvs
.
*
2
)])
⊢
WP
e
.[
env_subst
(
vvs
.
*
1
)]
{{
v
,
∃
v
'
,
j
⤇
fill
K
(
of_val
v
'
)
∗
interp
τ
Δ
(
v
,
v
'
)
}}
.
Proof
.
iIntros
(
Hlog
Δ
vvs
ρ
j
K
?
)
"(
#Hh &
#Hs & HΓ & Hj)"
.
iIntros
(
Hlog
Δ
vvs
ρ
j
K
?
)
"(#Hs & HΓ & Hj)"
.
iApply
(
Hlog
with
"[HΓ] *"
);
iFrame
;
eauto
.
Qed
.
...
...
@@ -50,26 +52,26 @@ Section fundamental.
Lemma
bin_log_related_var
Γ
x
τ
:
Γ
!!
x
=
Some
τ
→
Γ
⊨
Var
x
≤
log
≤
Var
x
:
τ
.
Proof
.
iIntros
(
?
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
?
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iDestruct
(
interp_env_Some_l
with
"HΓ"
)
as
([
v
v
'
])
"[% ?]"
;
first
done
.
rewrite
/
env_subst
!
list_lookup_fmap
;
simplify_option_eq
.
value_case
;
eauto
.
Qed
.
Lemma
bin_log_related_unit
Γ
:
Γ
⊨
Unit
≤
log
≤
Unit
:
TUnit
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
value_case
.
iExists
UnitV
;
eauto
.
Qed
.
Lemma
bin_log_related_nat
Γ
n
:
Γ
⊨
#
n
n
≤
log
≤
#
n
n
:
TNat
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
value_case
.
iExists
(#
nv
_
);
eauto
.
Qed
.
Lemma
bin_log_related_bool
Γ
b
:
Γ
⊨
#
♭
b
≤
log
≤
#
♭
b
:
TBool
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
value_case
.
iExists
(#
♭
v
_
);
eauto
.
Qed
.
...
...
@@ -78,7 +80,7 @@ Section fundamental.
(
IHHtyped2
:
Γ
⊨
e2
≤
log
≤
e2
'
:
τ
2
)
:
Γ
⊨
Pair
e1
e2
≤
log
≤
Pair
e1
'
e2
'
:
TProd
τ
1
τ
2.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
smart_wp_bind
(
PairLCtx
e2
.[
env_subst
_
])
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped1
_
_
_
j
(
K
++
[
PairLCtx
e2
'
.[
env_subst
_
]
])).
smart_wp_bind
(
PairRCtx
v
)
w
w
'
"[Hw #Hiw]"
...
...
@@ -91,29 +93,29 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
TProd
τ
1
τ
2
)
:
Γ
⊨
Fst
e
≤
log
≤
Fst
e
'
:
τ
1.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
smart_wp_bind
(
FstCtx
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped
_
_
_
j
(
K
++
[
FstCtx
]));
cbn
.
iDestruct
"Hiv"
as
([
w1
w1
'
]
[
w2
w2
'
])
"#[% [Hw1 Hw2]]"
;
simplify_eq
.
i
Mod
(
step_fst
_
_
j
K
(
of_val
w1
'
)
w1
'
(
of_val
w2
'
)
w2
'
with
"* [-]"
)
as
"Hw"
;
eauto
.
i
Apply
wp_fst
;
eauto
.
i
Apply
wp_fst
;
eauto
.
iNext
.
i
Mod
(
step_fst
with
"[Hs Hv]"
)
as
"Hw"
;
eauto
.
Qed
.
Lemma
bin_log_related_snd
Γ
e
e
'
τ
1
τ
2
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
TProd
τ
1
τ
2
)
:
Γ
⊨
Snd
e
≤
log
≤
Snd
e
'
:
τ
2.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
smart_wp_bind
(
SndCtx
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped
_
_
_
j
(
K
++
[
SndCtx
]));
cbn
.
iDestruct
"Hiv"
as
([
w1
w1
'
]
[
w2
w2
'
])
"#[% [Hw1 Hw2]]"
;
simplify_eq
.
i
Mod
(
step_snd
_
_
j
K
(
of_val
w1
'
)
w1
'
(
of_val
w2
'
)
w2
'
with
"* [-]"
)
as
"Hw"
;
eauto
.
i
Apply
wp_snd
;
eauto
.
i
Apply
wp_snd
;
eauto
.
iNext
.
i
Mod
(
step_snd
with
"[Hs Hv]"
)
as
"Hw"
;
eauto
.
Qed
.
Lemma
bin_log_related_injl
Γ
e
e
'
τ
1
τ
2
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
τ
1
)
:
Γ
⊨
InjL
e
≤
log
≤
InjL
e
'
:
(
TSum
τ
1
τ
2
).
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
smart_wp_bind
(
InjLCtx
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped
_
_
_
j
(
K
++
[
InjLCtx
]));
cbn
.
value_case
.
iExists
(
InjLV
v
'
);
iFrame
"Hv"
.
...
...
@@ -124,7 +126,7 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
τ
2
)
:
Γ
⊨
InjR
e
≤
log
≤
InjR
e
'
:
TSum
τ
1
τ
2.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
smart_wp_bind
(
InjRCtx
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped
_
_
_
j
(
K
++
[
InjRCtx
]));
cbn
.
value_case
.
iExists
(
InjRV
v
'
);
iFrame
"Hv"
.
...
...
@@ -141,20 +143,22 @@ Section fundamental.
(
IHHtyped3
:
τ
2
::
Γ
⊨
e2
≤
log
≤
e2
'
:
τ
3
)
:
Γ
⊨
Case
e0
e1
e2
≤
log
≤
Case
e0
'
e1
'
e2
'
:
τ
3.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iDestruct
(
interp_env_length
with
"HΓ"
)
as
%?
.
smart_wp_bind
(
CaseCtx
_
_
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped1
_
_
_
j
(
K
++
[
CaseCtx
_
_
]));
cbn
.
iDestruct
"Hiv"
as
"[Hiv|Hiv]"
.
-
iDestruct
"Hiv"
as
([
w
w
'
])
"[% Hw]"
;
simplify_eq
.
iMod
(
step_case_inl
_
_
j
K
(
of_val
w
'
)
w
'
with
"* [-]"
)
as
"Hz"
;
eauto
.
iApply
wp_case_inl
;
auto
1
using
to_of_val
.
iNext
.
asimpl
.
erewrite
!
n_closed_subst_head_simpl
by
(
rewrite
?
fmap_length
;
eauto
).
iApply
(
'
IHHtyped2
_
((
w
,
w
'
)
::
vvs
));
repeat
iSplit
;
eauto
.
iDestruct
"Hiv"
as
"[Hiv|Hiv]"
;
iDestruct
"Hiv"
as
([
w
w
'
])
"[% Hw]"
;
simplify_eq
.
-
iApply
fupd_wp
.
iMod
(
step_case_inl
with
"[Hs Hv]"
)
as
"Hz"
;
eauto
.
iApply
wp_case_inl
;
eauto
using
to_of_val
.
fold
of_val
.
iNext
.
asimpl
.
erewrite
!
n_closed_subst_head_simpl
by
(
rewrite
?
fmap_length
;
eauto
).
iApply
(
'
IHHtyped2
_
((
w
,
w
'
)
::
vvs
)).
repeat
iSplit
;
eauto
.
iApply
interp_env_cons
;
auto
.
-
i
Destruct
"Hiv"
as
([
w
w
'
])
"[% Hw]"
;
simplify_eq
.
iMod
(
step_case_inr
_
_
j
K
(
of_val
w
'
)
w
'
with
"* [-
]"
)
as
"Hz"
;
eauto
.
iApply
wp_case_inr
;
auto
1
using
to_of_val
.
iNext
.
-
i
Apply
fupd_wp
.
iMod
(
step_case_inr
with
"[Hs Hv
]"
)
as
"Hz"
;
eauto
.
iApply
wp_case_inr
;
e
auto
using
to_of_val
.
fold
of_val
.
iNext
.
asimpl
.
erewrite
!
n_closed_subst_head_simpl
by
(
rewrite
?
fmap_length
;
eauto
).
iApply
(
'
IHHtyped3
_
((
w
,
w
'
)
::
vvs
));
repeat
iSplit
;
eauto
.
iApply
interp_env_cons
;
auto
.
...
...
@@ -166,13 +170,13 @@ Section fundamental.
(
IHHtyped3
:
Γ
⊨
e2
≤
log
≤
e2
'
:
τ
)
:
Γ
⊨
If
e0
e1
e2
≤
log
≤
If
e0
'
e1
'
e2
'
:
τ
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
smart_wp_bind
(
IfCtx
_
_
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped1
_
_
_
j
(
K
++
[
IfCtx
_
_
]));
cbn
.
iDestruct
"Hiv"
as
([])
"[% %]"
;
simplify_eq
/=
.
-
iMod
(
step_if_true
_
_
j
K
with
"
*
[-]"
)
as
"Hz"
;
eauto
.
iDestruct
"Hiv"
as
([])
"[% %]"
;
simplify_eq
/=
;
iApply
fupd_wp
.
-
iMod
(
step_if_true
_
_
j
K
with
"[-]"
)
as
"Hz"
;
eauto
.
iApply
wp_if_true
.
iNext
.
iApply
'
IHHtyped2
;
eauto
.
-
iMod
(
step_if_false
_
_
j
K
with
"
*
[-]"
)
as
"Hz"
;
eauto
.
-
iMod
(
step_if_false
_
_
j
K
with
"[-]"
)
as
"Hz"
;
eauto
.
iApply
wp_if_false
.
iNext
.
iApply
'
IHHtyped3
;
eauto
.
Qed
.
...
...
@@ -181,14 +185,15 @@ Section fundamental.
(
IHHtyped2
:
Γ
⊨
e2
≤
log
≤
e2
'
:
TNat
)
:
Γ
⊨
BinOp
op
e1
e2
≤
log
≤
BinOp
op
e1
'
e2
'
:
binop_res_type
op
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
smart_wp_bind
(
BinOpLCtx
_
_
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped1
_
_
_
j
(
K
++
[
BinOpLCtx
_
_
]));
cbn
.
smart_wp_bind
(
BinOpRCtx
_
_
)
w
w
'
"[Hw #Hiw]"
(
'
IHHtyped2
_
_
_
j
(
K
++
[
BinOpRCtx
_
_
]));
cbn
.
iDestruct
"Hiv"
as
(
n
)
"[% %]"
;
simplify_eq
/=
.
iDestruct
"Hiw"
as
(
n
'
)
"[% %]"
;
simplify_eq
/=
.
iMod
(
step_nat_binop
_
_
j
K
with
"* [-]"
)
as
"Hz"
;
eauto
.
iApply
fupd_wp
.
iMod
(
step_nat_binop
_
_
j
K
with
"[-]"
)
as
"Hz"
;
eauto
.
iApply
wp_nat_binop
.
iNext
.
iModIntro
.
iExists
_
;
iSplitL
;
eauto
.
destruct
op
;
simpl
;
try
destruct
eq_nat_dec
;
try
destruct
le_dec
;
try
destruct
lt_dec
;
eauto
.
...
...
@@ -200,11 +205,12 @@ Section fundamental.
(
IHHtyped
:
TArrow
τ
1
τ
2
::
τ
1
::
Γ
⊨
e
≤
log
≤
e
'
:
τ
2
)
:
Γ
⊨
Rec
e
≤
log
≤
Rec
e
'
:
TArrow
τ
1
τ
2.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
value_case
.
iExists
(
RecV
_
).
iIntros
"{$Hj} !#"
.
iL
ö
b
as
"IH"
.
iIntros
([
v
v
'
])
"#Hiv"
.
iIntros
(
j
'
K
'
)
"Hj"
.
iDestruct
(
interp_env_length
with
"HΓ"
)
as
%?
.
iApply
wp_rec
;
auto
1
using
to_of_val
.
iNext
.
iApply
fupd_wp
.
iMod
(
step_rec
_
_
j
'
K
'
_
(
of_val
v
'
)
v
'
with
"* [-]"
)
as
"Hz"
;
eauto
.
asimpl
.
change
(
Rec
?
e
)
with
(
of_val
(
RecV
e
)).
erewrite
!
n_closed_subst_head_simpl_2
by
(
rewrite
?
fmap_length
;
eauto
).
...
...
@@ -217,7 +223,7 @@ Section fundamental.
(
IHHtyped2
:
Γ
⊨
e2
≤
log
≤
e2
'
:
τ
1
)
:
Γ
⊨
App
e1
e2
≤
log
≤
App
e1
'
e2
'
:
τ
2.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
smart_wp_bind
(
AppLCtx
(
e2
.[
env_subst
(
vvs
.
*
1
)]))
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped1
_
_
_
j
(
K
++
[(
AppLCtx
(
e2
'
.[
env_subst
(
vvs
.
*
2
)]))]));
cbn
.
smart_wp_bind
(
AppRCtx
v
)
w
w
'
"[Hw #Hiw]"
...
...
@@ -229,10 +235,11 @@ Section fundamental.
(
IHHtyped
:
(
subst
(
ren
(
+
1
))
<
$
>
Γ
)
⊨
e
≤
log
≤
e
'
:
τ
)
:
Γ
⊨
TLam
e
≤
log
≤
TLam
e
'
:
TForall
τ
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
value_case
.
iExists
(
TLamV
_
).
iIntros
"{$Hj} /= !#"
;
iIntros
(
τ
i
?
j
'
K
'
)
"Hv /="
.
iApply
wp_tlam
;
iNext
.
iApply
fupd_wp
.
iMod
(
step_tlam
_
_
j
'
K
'
(
e
'
.[
env_subst
(
vvs
.
*
2
)])
with
"* [-]"
)
as
"Hz"
;
eauto
.
iApply
'
IHHtyped
;
repeat
iSplit
;
eauto
.
by
iApply
interp_env_ren
.
Qed
.
...
...
@@ -241,13 +248,13 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
TForall
τ
)
:
Γ
⊨
TApp
e
≤
log
≤
TApp
e
'
:
τ
.[
τ'
/
].
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
smart_wp_bind
(
TAppCtx
)
v
v
'
"[Hj #Hv]"
(
'
IHHtyped
_
_
_
j
(
K
++
[
TAppCtx
]));
cbn
.
iApply
wp_wand_r
;
iSplitL
.
{
iSpecialize
(
"Hv"
$
!
(
interp
τ'
Δ
)
with
"[#]"
);
[
iPureIntro
;
apply
_
|
].
iApply
"Hv"
;
eauto
.
}
iIntros
(
w
)
;
iDestruct
1
as
(
w
'
)
"[Hw
#
Hiw]"
.
iIntros
(
w
)
.
iDestruct
1
as
(
w
'
)
"[Hw Hiw]"
.
iExists
_
;
rewrite
-
interp_subst
;
eauto
.
Qed
.
...
...
@@ -255,7 +262,7 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
τ
.[(
TRec
τ
)
/
])
:
Γ
⊨
Fold
e
≤
log
≤
Fold
e
'
:
TRec
τ
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iApply
(
wp_bind
[
FoldCtx
]);
iApply
wp_wand_l
;
iSplitR
;
[
|
iApply
(
'
IHHtyped
_
_
_
j
(
K
++
[
FoldCtx
]));
rewrite
?
fill_app
;
simpl
;
repeat
iSplitR
;
trivial
].
...
...
@@ -269,7 +276,7 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
TRec
τ
)
:
Γ
⊨
Unfold
e
≤
log
≤
Unfold
e
'
:
τ
.[(
TRec
τ
)
/
].
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iApply
(
wp_bind
[
UnfoldCtx
]);
iApply
wp_wand_l
;
iSplitR
;
[
|
iApply
(
'
IHHtyped
_
_
_
j
(
K
++
[
UnfoldCtx
]));
rewrite
?
fill_app
;
simpl
;
repeat
iSplitR
;
trivial
].
...
...
@@ -277,6 +284,7 @@ Section fundamental.
rewrite
/=
fixpoint_unfold
/=
.
change
(
fixpoint
_
)
with
(
interp
(
TRec
τ
)
Δ
).
iDestruct
"Hiw"
as
([
w
w
'
])
"#[% Hiz]"
;
simplify_eq
/=
.
iApply
fupd_wp
.
iMod
(
step_Fold
_
_
j
K
(
of_val
w
'
)
w
'
with
"* [-]"
)
as
"Hz"
;
eauto
.
iApply
wp_fold
;
cbn
;
auto
.
iNext
;
iModIntro
;
iExists
_
;
iFrame
"Hz"
.
by
rewrite
-
interp_subst
.
...
...
@@ -286,7 +294,8 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
TUnit
)
:
Γ
⊨
Fork
e
≤
log
≤
Fork
e
'
:
TUnit
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hh & Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iApply
fupd_wp
.
iMod
(
step_fork
_
_
j
K
with
"* [-]"
)
as
(
j
'
)
"[Hj Hj']"
;
eauto
.
iApply
wp_fork
;
iNext
;
iSplitL
"Hj"
.
-
iExists
UnitV
;
eauto
.
...
...
@@ -297,14 +306,16 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
τ
)
:
Γ
⊨
Alloc
e
≤
log
≤
Alloc
e
'
:
Tref
τ
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
smart_wp_bind
(
AllocCtx
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped
_
_
_
j
(
K
++
[
AllocCtx
])).
iApply
fupd_wp
.
iMod
(
step_alloc
_
_
j
K
(
of_val
v
'
)
v
'
with
"* [-]"
)
as
(
l
'
)
"[Hj Hl]"
;
eauto
.
iApply
wp_fupd
.
iApply
(
wp_alloc
with
"[]"
);
auto
.
iIntros
"!>"
;
iIntros
(
l
)
"Hl'"
.
iApply
wp_atomic
;
eauto
.
iApply
wp_alloc
;
eauto
.
iNext
.
iIntros
(
l
)
"Hl'"
.
iMod
(
inv_alloc
(
logN
.
@
(
l
,
l
'
))
_
(
∃
w
:
val
*
val
,
l
↦ᵢ
w
.1
∗
l
'
↦ₛ
w
.2
∗
interp
τ
Δ
w
)
%
I
with
"[Hl Hl']"
)
as
"HN"
;
eauto
.
{
iNext
;
iExists
(
v
,
v
'
);
by
iFrame
.
}
{
iNext
.
iExists
(
v
,
v
'
);
iFrame
.
iFrame
"Hiv"
.
}
iModIntro
;
iExists
(
LocV
l
'
).
iFrame
"Hj"
.
iExists
(
l
,
l
'
);
eauto
.
Qed
.
...
...
@@ -312,15 +323,18 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
(
Tref
τ
))
:
Γ
⊨
Load
e
≤
log
≤
Load
e
'
:
τ
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
smart_wp_bind
(
LoadCtx
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped
_
_
_
j
(
K
++
[
LoadCtx
])).
iDestruct
"Hiv"
as
([
l
l
'
])
"[% Hinv]"
;
simplify_eq
/=
.
iInv
(
logN
.
@
(
l
,
l
'
))
as
([
w
w
'
])
"[Hw1 [Hw2 #Hw]]"
"Hclose"
;
simpl
.
iMod
"Hw2"
.
iMod
(
step_load
_
_
j
K
l
'
1
w
'
with
"[Hv Hw2]"
)
as
"[Hv Hw2]"
;
iApply
wp_atomic
;
eauto
.
iInv
(
logN
.
@
(
l
,
l
'
))
as
([
w
w
'
])
"[Hw1 [>Hw2 #Hw]]"
"Hclose"
;
simpl
.
(
*
TODO
:
why
can
we
eliminate
the
next
modality
here
?
↑
*
)
iModIntro
.
iApply
(
wp_load
with
"Hw1"
).
iNext
.
iIntros
"Hw1"
.
iMod
(
step_load
with
"[Hv Hw2]"
)
as
"[Hv Hw2]"
;
[
solve_ndisj
|
by
iFrame
|
].
iApply
(
wp_load
_
_
1
with
"[Hw1]"
);
[
|
iFrame
"Hh"
|
];
trivial
;
try
solve_ndisj
.
iNext
.
iIntros
"Hw1"
.
iMod
(
"Hclose"
with
"[Hw1 Hw2]"
).
iMod
(
"Hclose"
with
"[Hw1 Hw2]"
).
{
iNext
.
iExists
(
w
,
w
'
);
by
iFrame
.
}
iModIntro
.
iExists
w
'
;
by
iFrame
.
Qed
.
...
...
@@ -330,18 +344,21 @@ Section fundamental.
(
IHHtyped2
:
Γ
⊨
e2
≤
log
≤
e2
'
:
τ
)
:
Γ
⊨
Store
e1
e2
≤
log
≤
Store
e1
'
e2
'
:
TUnit
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
smart_wp_bind
(
StoreLCtx
_
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped1
_
_
_
j
(
K
++
[
StoreLCtx
_
])).
smart_wp_bind
(
StoreRCtx
_
)
w
w
'
"[Hw #Hiw]"
(
'
IHHtyped2
_
_
_
j
(
K
++
[
StoreRCtx
_
])).
iDestruct
"Hiv"
as
([
l
l
'
])
"[% Hinv]"
;
simplify_eq
/=
.
iInv
(
logN
.
@
(
l
,
l
'
))
as
([
v
v
'
])
"[>Hv1 [>Hv2 #Hv]]"
"Hclose"
.
iMod
(
step_store
_
_
j
K
l
'
v
'
(
of_val
w
'
)
w
'
with
"[Hw Hv2]"
)
as
"[Hw Hv2]"
;
[
eauto
|
solve_ndisj
|
by
iFrame
|
].
iApply
(
wp_store
with
"[Hv1]"
);
auto
using
to_of_val
.
solve_ndisj
.
iNext
.
iIntros
"Hv1"
.
iMod
(
"Hclose"
with
"[Hv1 Hv2]"
).
{
iNext
;
iExists
(
w
,
w
'
);
by
iFrame
.
}
iApply
wp_atomic
;
eauto
.
iInv
(
logN
.
@
(
l
,
l
'
))
as
([
v
v
'
])
"[Hv1 [>Hv2 #Hv]]"
"Hclose"
.
iModIntro
.
iApply
(
wp_store
with
"Hv1"
);
auto
using
to_of_val
.
iNext
.
iIntros
"Hw2"
.
iMod
(
step_store
with
"[$Hs Hw Hv2]"
)
as
"[Hw Hv2]"
;
eauto
;
[
solve_ndisj
|
by
iFrame
|
].
iMod
(
"Hclose"
with
"[Hw2 Hv2]"
).
{
iNext
;
iExists
(
w
,
w
'
);
simpl
;
iFrame
.
iFrame
"Hiw"
.
}
iExists
UnitV
;
iFrame
;
auto
.
Qed
.
...
...
@@ -352,7 +369,7 @@ Section fundamental.
(
IHHtyped3
:
Γ
⊨
e3
≤
log
≤
e3
'
:
τ
)
:
Γ
⊨
CAS
e1
e2
e3
≤
log
≤
CAS
e1
'
e2
'
e3
'
:
TBool
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#(
Hh &
Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#(Hs & HΓ)"
;
iIntros
(
j
K
)
"Hj /="
.
smart_wp_bind
(
CasLCtx
_
_
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped1
_
_
_
j
(
K
++
[
CasLCtx
_
_
])).
smart_wp_bind
(
CasMCtx
_
_
)
w
w
'
"[Hw #Hiw]"
...
...
@@ -360,25 +377,31 @@ Section fundamental.
smart_wp_bind
(
CasRCtx
_
_
)
u
u
'
"[Hu #Hiu]"
(
'
IHHtyped3
_
_
_
j
(
K
++
[
CasRCtx
_
_
])).
iDestruct
"Hiv"
as
([
l
l
'
])
"[% Hinv]"
;
simplify_eq
/=
.
iInv
(
logN
.
@
(
l
,
l
'
))
as
([
v
v
'
])
"[>Hv1 [>Hv2 #Hv]]"
"Hclose"
.
iApply
wp_atomic
;
eauto
.
iInv
(
logN
.
@
(
l
,
l
'
))
as
([
v
v
'
])
"[Hv1 [>Hv2 #Hv]]"
"Hclose"
.
iModIntro
.
iPoseProof
(
"Hv"
)
as
"Hv'"
.
rewrite
{
2
}
[
⟦
τ
⟧
Δ
(
v
,
v
'
)]
interp_EqType_agree
;
trivial
.
iMod
"Hv'"
as
%
Hv
'
;
subst
.
destruct
(
decide
(
v
'
=
w
))
as
[
|
Hneq
];
subst
.
-
iAssert
(
▷
(
w
'
=
w
)
)
%
I
as
">%"
.
-
iAssert
(
▷
⌜
w
'
=
w
⌝
)
%
I
as
">%"
.
{
rewrite
?
interp_EqType_agree
;
trivial
.
by
iSimplifyEq
.
}
iMod
(
step_cas_suc
_
_
j
K
l
'
(
of_val
w
'
)
w
'
w
(
of_val
u
'
)
u
'
with
"[$Hs $Hu $Hv2]"
)
as
"[Hw Hv2]"
;
simpl
;
eauto
;
first
solve_ndisj
.
iApply
(
wp_cas_suc
with
"[Hv1]"
);
eauto
using
to_of_val
;
first
solve_ndisj
.
iNext
.
iIntros
"Hv1"
.
iMod
(
"Hclose"
with
"[Hv1 Hv2]"
).
simpl
.
iApply
(
wp_cas_suc
with
"Hv1"
);
eauto
using
to_of_val
.
iNext
.
iIntros
"Hv1"
.
iMod
(
step_cas_suc
with
"[Hu Hv2]"
)
as
"[Hw Hv2]"
;
simpl
;
eauto
;
first
solve_ndisj
.
iFrame
.
iFrame
"Hs"
.
iMod
(
"Hclose"
with
"[Hv1 Hv2]"
).
{
iNext
;
iExists
(
_
,
_
);
by
iFrame
.
}
iExists
(#
♭
v
true
);
iFrame
;
eauto
.
-
iAssert
(
▷
■
(
v
'
≠
w
'
))
%
I
as
">%"
.
{
rewrite
?
interp_EqType_agree
;
trivial
.
iSimplifyEq
.
auto
.
}
iMod
(
step_cas_fail
_
_
j
K
l
'
1
v
'
(
of_val
w
'
)
w
'
(
of_val
u
'
)
u
'
with
"[$Hs $Hu $Hv2]"
)
as
"[Hw Hv2]"
;
simpl
;
eauto
;
first
solve_ndisj
.
iApply
(
wp_cas_fail
with
"[Hv1]"
);
eauto
using
to_of_val
;
first
solve_ndisj
.
iNext
.
iIntros
"Hv1"
.
iMod
(
"Hclose"
with
"[Hv1 Hv2]"
).
-
iAssert
(
▷
⌜
v
'
≠
w
'⌝
)
%
I
as
">%"
.
{
rewrite
?
interp_EqType_agree
;
trivial
.
iSimplifyEq
.
auto
.
}
simpl
.
iApply
(
wp_cas_fail
with
"Hv1"
);
eauto
.
iNext
.
iIntros
"Hv1"
.
iMod
(
step_cas_fail
with
"[$Hs Hu Hv2]"
)
as
"[Hw Hv2]"
;
simpl
;
eauto
;
first
solve_ndisj
.
iFrame
.
iMod
(
"Hclose"
with
"[Hv1 Hv2]"
).
{
iNext
;
iExists
(
_
,
_
);
by
iFrame
.
}
iExists
(#
♭
v
false
);
eauto
.
Qed
.
...
...
F_mu_ref_conc/fundamental_unary.v
View file @
f2045770
...
...
@@ -5,7 +5,7 @@ From iris.proofmode Require Import tactics.
Definition
log_typed
`
{
heapIG
Σ
}
(
Γ
:
list
type
)
(
e
:
expr
)
(
τ
:
type
)
:=
∀
Δ
vs
,
env_PersistentP
Δ
→
heapI_ctx
∧
⟦
Γ
⟧
*
Δ
vs
⊢
⟦
τ
⟧ₑ
Δ
e
.[
env_subst
vs
].
⟦
Γ
⟧
*
Δ
vs
⊢
⟦
τ
⟧ₑ
Δ
e
.[
env_subst
vs
].
Notation
"Γ ⊨ e : τ"
:=
(
log_typed
Γ
e
τ
)
(
at
level
74
,
e
,
τ
at
next
level
).
Section
typed_interp
.
...
...
@@ -15,13 +15,13 @@ Section typed_interp.
Local
Tactic
Notation
"smart_wp_bind"
uconstr
(
ctx
)
ident
(
v
)
constr
(
Hv
)
uconstr
(
Hp
)
:=
iApply
(
wp_bind
[
ctx
]);
iApply
wp_wand_l
;
iSplit
L
;
[
|
iApply
Hp
;
trivial
];
[
iIntros
(
v
)
Hv
|
iSplit
;
trivial
]
;
cbn
.
iSplit
R
;
[
|
iApply
Hp
;
trivial
];
iIntros
(
v
)
Hv
;
cbn
.
Local
Ltac
value_case
:=
iApply
wp_value
;
[
cbn
;
rewrite
?
to_of_val
;
trivial
|
].
Theorem
fundamental
Γ
e
τ
:
Γ
⊢ₜ
e
:
τ
→
Γ
⊨
e
:
τ
.
Proof
.
induction
1
;
iIntros
(
Δ
vs
H
Δ
)
"#
[Hheap
HΓ
]
/="
.
induction
1
;
iIntros
(
Δ
vs
H
Δ
)
"#HΓ /="
.
-
(
*
var
*
)
iDestruct
(
interp_env_Some_l
with
"HΓ"
)
as
(
v
)
"[% ?]"
;
first
done
.
rewrite
/
env_subst
.
simplify_option_eq
.
by
value_case
.
...
...
@@ -32,7 +32,7 @@ Section typed_interp.
smart_wp_bind
(
BinOpLCtx
_
e2
.[
env_subst
vs
])
v
"#Hv"
IHtyped1
.
smart_wp_bind
(
BinOpRCtx
_
v
)
v
'
"# Hv'"
IHtyped2
.
iDestruct
"Hv"
as
(
n
)
"%"
;
iDestruct
"Hv'"
as
(
n
'
)
"%"
;
simplify_eq
/=
.
iApply
wp_nat_binop
.
iNext
.
iIntros
"!>
{Hheap HΓ}
"
.
iApply
wp_nat_binop
.
iNext
.
iIntros
"!>"
.
destruct
op
;
simpl
;
try
destruct
eq_nat_dec
;
try
destruct
le_dec
;
try
destruct
lt_dec
;
eauto
10.
-
(
*
pair
*
)
...
...
@@ -59,22 +59,22 @@ Section typed_interp.
iDestruct
"Hv"
as
"[Hv|Hv]"
;
iDestruct
"Hv"
as
(
w
)
"[% Hw]"
;
simplify_eq
/=
.
+
iApply
wp_case_inl
;
auto
1
using
to_of_val
;
asimpl
.
iNext
.
erewrite
typed_subst_head_simpl
by
naive_solver
.
iApply
(
IHtyped2
Δ
(
w
::
vs
)).
iSplit
;
[
|
iApply
interp_env_cons
]
;
auto
.
iApply
(
IHtyped2
Δ
(
w
::
vs
)).
iApply
interp_env_cons
;
auto
.
+
iApply
wp_case_inr
;
auto
1
using
to_of_val
;
asimpl
.
iNext
.
erewrite
typed_subst_head_simpl
by
naive_solver
.
iApply
(
IHtyped3
Δ
(
w
::
vs
)).
iSplit
;
[
|
iApply
interp_env_cons
]
;
auto
.
iApply
(
IHtyped3
Δ
(
w
::
vs
)).
iApply
interp_env_cons
;
auto
.
-
(
*
If
*
)
smart_wp_bind
(
IfCtx
_
_
)
v
"#Hv"
IHtyped1
;
cbn
.
iDestruct
"Hv"
as
([])
"%"
;
subst
;
simpl
;
[
iApply
wp_if_true
|
iApply
wp_if_false
];
iNext
;
[
iApply
IHtyped2
|
iApply
IHtyped3
];
auto
.
-
(
*
Rec
*
)
value_case
;
iAlways
.
simpl
.
iL
ö
b
as
"IH"
;
iIntros
(
w
)
"#Hw"
.
value_case
.
simpl
.
iAlways
.
iL
ö
b
as
"IH"
.
iIntros
(
w
)
"#Hw"
.
iDestruct
(
interp_env_length
with
"HΓ"
)
as
%?
.
iApply
wp_rec
;
auto
1
using
to_of_val
.
iNext
.
asimpl
.
change
(
Rec
_
)
with
(
of_val
(
RecV
e
.[
upn
2
(
env_subst
vs
)]))
at
2.
erewrite
typed_subst_head_simpl_2
by
naive_solver
.
iApply
(
IHtyped
Δ
(
_
::
w
::
vs
)).
iSplit
;
[
done
|
].
iApply
(
IHtyped
Δ
(
_
::
w
::
vs
)).
iApply
interp_env_cons
;
iSplit
;
[
|
iApply
interp_env_cons
];
auto
.
-
(
*
app
*
)
smart_wp_bind
(
AppLCtx
(
e2
.[
env_subst
vs
]))
v
"#Hv"
IHtyped1
.
...
...
@@ -83,7 +83,7 @@ Section typed_interp.
-
(
*
TLam
*
)
value_case
.
iAlways
;
iIntros
(
τ
i
)
"%"
.
iApply
wp_tlam
;
iNext
.
iApply
IHtyped
.
iFrame
"Hheap"
.
by
iApply
interp_env_ren
.
iApply
IHtyped
.
by
iApply
interp_env_ren
.
-
(
*
TApp
*
)
smart_wp_bind
TAppCtx
v
"#Hv"
IHtyped
;
cbn
.
iApply
wp_wand_r
;
iSplitL
;
[
iApply
(
"Hv"
$
!
(
⟦
τ'
⟧
Δ
));
iPureIntro
;
apply
_
|
];
cbn
.
...
...
@@ -107,37 +107,40 @@ Section typed_interp.
iApply
wp_wand_l
.
iSplitL
;
[
|
iApply
IHtyped
;
auto
];
auto
.
-
(
*
Alloc
*
)
smart_wp_bind
AllocCtx
v
"#Hv"
IHtyped
;
cbn
.
iClear
"HΓ"
.
iApply
wp_fupd
.
iApply
(
wp_alloc
with
"Hheap []"
)
;
auto
1
using
to_of_val
.
iApply
wp_alloc
;
auto
1
using
to_of_val
.
iNext
;
iIntros
(
l
)
"Hl"
.
iMod
(
inv_alloc
_
with
"[Hl]"
)
as
"HN"
;
[
|
iModIntro
;
iExists
_
;
iSplit
;
trivial
];
eauto
.
-
(
*
Load
*
)
smart_wp_bind
LoadCtx
v
"#Hv"
IHtyped
;
cbn
.
iClear
"HΓ"
.
iDestruct
"Hv"
as
(
l
)
"[% #Hv]"
;
subst
.
iInv
(
logN
.
@
l
)
as
(
w
)
"[Hw1 #Hw2]"
"Hclose"
.
iApply
((
wp_load
_
_
1
)
with
"[Hw1] [Hclose]"
);
[
|
iFrame
"Hheap"
|
];
trivial
.
solve_ndisj
.
iNext
.
iIntros
"Hw1"
.
iMod
(
"Hclose"
with
"[-]"
);
eauto
.
iApply
wp_atomic
;
eauto
.
iInv
(
logN
.
@
l
)
as
(
w
)
"[Hw1 #Hw2]"
"Hclose"
.
iApply
(
wp_load
with
"Hw1"
).
iNext
.
iIntros
"Hw1"
.
iMod
(
"Hclose"
with
"[Hw1 Hw2]"
);
eauto
.
-
(
*
Store
*
)
smart_wp_bind
(
StoreLCtx
_
)
v
"#Hv"
IHtyped1
;
cbn
.
smart_wp_bind
(
StoreRCtx
_
)
w
"#Hw"
IHtyped2
;
cbn
.
iClear
"HΓ"
.
iDestruct
"Hv"
as
(
l
)
"[% #Hv]"
;
subst
.
iApply
wp_atomic
;
eauto
.
iInv
(
logN
.
@
l
)
as
(
z
)
"[Hz1 #Hz2]"
"Hclose"
.
iApply
(
wp_store
with
"
[
Hz1
] [Hclose]"
);
[
|
|
iFrame
"Hheap Hz1"
|
].
by
rewrite
to_of_val
.
solve_ndisj
.
iNext
.
iIntros
"Hz1"
.
iMod
(
"Hclose"
with
"[
-
]"
);
eauto
.
iApply
(
wp_store
with
"Hz1
"
);
auto
using
to_of_val
.
iNext
.
iIntros
"Hz1"
.
iMod
(
"Hclose"
with
"[
Hz1 Hz2
]"
);
eauto
.
-
(
*
CAS
*
)
smart_wp_bind
(
CasLCtx
_
_
)
v1
"#Hv1"
IHtyped1
;
cbn
.
smart_wp_bind
(
CasMCtx
_
_
)
v2
"#Hv2"
IHtyped2
;
cbn
.
smart_wp_bind
(
CasRCtx
_
_
)
v3
"#Hv3"
IHtyped3
;
cbn
.
iClear
"HΓ"
.
iDestruct
"Hv1"
as
(
l
)
"[% Hinv]"
;
subst
.
iDestruct
"Hv1"
as
(
l
)
"[% Hv1]"
;
subst
.
iApply
wp_atomic
;
eauto
.
iInv
(
logN
.
@
l
)
as
(
w
)
"[Hw1 #Hw2]"
"Hclose"
.
destruct
(
decide
(
v2
=
w
))
as
[
|
Hneq
];
subst
.
+
iApply
(
wp_cas_suc
with
"
[
Hw1
] [Hclose]"
);
[
|
|
|
iFrame
"Hheap Hw1"
|
];
eauto
using
to_of_val
.
solve_ndisj
.
iNext
.
iIntros
"Hw1"
.
iMod
(
"Hclose"
with
"[
-
]"
);
eauto
.
+
iApply
(
wp_cas_fail
with
"
[
Hw1
] [Hclose]"
);
[
|
|
|
|
iFrame
"Hheap Hw1"
|
];
eauto
using
to_of_val
.
solve_ndisj
.
iNext
.
iIntros
"Hw1"
.
iMod
(
"Hclose"
with
"[
-
]"
);
eauto
.
+
iApply
(
wp_cas_suc
with
"Hw1
"
);
auto
using
to_of_val
.
iNext
.
iIntros
"Hw1"
.
iMod
(
"Hclose"
with
"[
Hw1 Hw2
]"
);
eauto
.
+
iApply
(
wp_cas_fail
with
"Hw1
"
);
auto
using
to_of_val
.
iNext
.
iIntros
"Hw1"
.
iMod
(
"Hclose"
with
"[
Hw1 Hw2
]"
);
eauto
.
Qed
.
End
typed_interp
.
F_mu_ref_conc/lang.v
View file @
f2045770
From
iris
.
program_logic
Require
Export
ectx_language
ectxi_language
.
From
iris_logrel
.
prelude
Require
Export
base
.
From
iris
.
algebra
Require
Export
c
ofe
.
From
iris
.
algebra
Require
Export
ofe
.
From
iris
.
prelude
Require
Import
gmap
.
Module
lang
.
...
...
@@ -299,10 +299,14 @@ Definition is_atomic (e : expr) : Prop :=
|
CAS
e0
e1
e2
=>
is_Some
(
to_val
e0
)
∧
is_Some
(
to_val
e1
)
∧
is_Some
(
to_val
e2
)
|
_
=>
False
end
.
Local
Hint
Resolve
language
.
val_irreducible
.
Local
Hint
Resolve
to_of_val
.
Local
Hint
Unfold
language
.
irreducible
.
Lemma
is_atomic_correct
e
:
is_atomic
e
→
language
.
atomic
e
.
Proof
.
intros
?
;
apply
ectx_language_atomic
.
-
destruct
1
;
simpl
;
by
eauto
using
to_of_val
.
-
destruct
1
;
simpl
;
eauto
.
-
intros
[
|
Ki
K
]
e
'
->
Hval
%
eq_None_not_Some
;
[
done
|
].
destruct
Hval
;
apply
(
fill_val
K
e
'
).
destruct
Ki
;
naive_solver
.
Qed
.
...
...
F_mu_ref_conc/logrel_binary.v
View file @
f2045770
...
...
@@ -7,7 +7,7 @@ From iris.prelude Require Import tactics.
Import
uPred
.
(
*
HACK
:
move
somewhere
else
*
)
Ltac
auto_equiv
:
:=
Ltac
auto_equiv
:=
(
*
Deal
with
"pointwise_relation"
*
)
repeat
lazymatch
goal
with
|
|-
pointwise_relation
_
_
_
_
=>
intros
?
...
...
@@ -20,6 +20,8 @@ Ltac auto_equiv ::=
(
*
repeatedly
apply
congruence
lemmas
and
use
the
equalities
in
the
hypotheses
.
*
)