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
70299030
Commit
70299030
authored
Feb 06, 2017
by
Dan Frumin
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Update F_mu_ref to work with Iris 3
Main changes: - Rewrite cfgG and cfgUR - Use gen_heap from iris
parent
6d458e00
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
270 additions
and
322 deletions
+270
-322
F_mu_ref/fundamental.v
F_mu_ref/fundamental.v
+15
-16
F_mu_ref/fundamental_binary.v
F_mu_ref/fundamental_binary.v
+47
-41
F_mu_ref/lang.v
F_mu_ref/lang.v
+5
-2
F_mu_ref/logrel.v
F_mu_ref/logrel.v
+13
-17
F_mu_ref/logrel_binary.v
F_mu_ref/logrel_binary.v
+22
-28
F_mu_ref/rules.v
F_mu_ref/rules.v
+50
-138
F_mu_ref/rules_binary.v
F_mu_ref/rules_binary.v
+59
-49
F_mu_ref/soundness.v
F_mu_ref/soundness.v
+22
-9
F_mu_ref/soundness_binary.v
F_mu_ref/soundness_binary.v
+37
-22
No files found.
F_mu_ref/fundamental.v
View file @
70299030
...
...
@@ -5,7 +5,7 @@ From iris.base_logic Require Export big_op.
Definition
log_typed
`
{
heapG
Σ
}
(
Γ
:
list
type
)
(
e
:
expr
)
(
τ
:
type
)
:=
∀
Δ
vs
,
env_PersistentP
Δ
→
heap_ctx
∧
⟦
Γ
⟧
*
Δ
vs
⊢
⟦
τ
⟧ₑ
Δ
e
.[
env_subst
vs
].
⟦
Γ
⟧
*
Δ
vs
⊢
⟦
τ
⟧ₑ
Δ
e
.[
env_subst
vs
].
Notation
"Γ ⊨ e : τ"
:=
(
log_typed
Γ
e
τ
)
(
at
level
74
,
e
,
τ
at
next
level
).
Section
fundamental
.
...
...
@@ -15,13 +15,13 @@ Section fundamental.
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
.
...
...
@@ -29,7 +29,7 @@ Section fundamental.
-
(
*
pair
*
)
smart_wp_bind
(
PairLCtx
e2
.[
env_subst
vs
])
v
"#Hv"
IHtyped1
.
smart_wp_bind
(
PairRCtx
v
)
v
'
"# Hv'"
IHtyped2
.
value_case
;
eauto
10.
value_case
;
eauto
10.
-
(
*
fst
*
)
smart_wp_bind
(
FstCtx
)
v
"# Hv"
IHtyped
;
cbn
.
iDestruct
"Hv"
as
(
w1
w2
)
"#[% [H2 H3]]"
;
subst
.
...
...
@@ -50,16 +50,16 @@ Section fundamental.
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
.
-
(
*
lam
*
)
value_case
;
iAlways
;
iIntros
(
w
)
"#Hw"
.
value_case
.
simpl
.
iAlways
.
iIntros
(
w
)
"#Hw"
.
iDestruct
(
interp_env_length
with
"HΓ"
)
as
%?
.
iApply
wp_lam
;
auto
1
using
to_of_val
.
iNext
.
asimpl
.
erewrite
typed_subst_head_simpl
by
naive_solver
.
iApply
(
IHtyped
Δ
(
w
::
vs
)).
iFrame
"Hheap"
.
iApply
interp_env_cons
;
auto
.
iApply
(
IHtyped
Δ
(
w
::
vs
)).
iApply
interp_env_cons
;
auto
.
-
(
*
app
*
)
smart_wp_bind
(
AppLCtx
(
e2
.[
env_subst
vs
]))
v
"#Hv"
IHtyped1
.
smart_wp_bind
(
AppRCtx
v
)
w
"#Hw"
IHtyped2
.
...
...
@@ -67,7 +67,7 @@ Section fundamental.
-
(
*
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"
$
!
(
interp
τ'
Δ
));
iPureIntro
;
apply
_
|
].
...
...
@@ -88,7 +88,7 @@ Section fundamental.
iNext
;
iModIntro
.
by
rewrite
-
interp_subst
.
-
(
*
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
.
...
...
@@ -96,16 +96,15 @@ Section fundamental.
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_load
with
"Hw1 [Hclose]"
)
.
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
.
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 [Hclose]"
);
eauto
using
to_of_val
.
iNext
.
iIntros
"Hz1"
.
iMod
(
"Hclose"
with
"[Hz1 Hz2]"
);
eauto
.
Qed
.
End
fundamental
.
F_mu_ref/fundamental_binary.v
View file @
70299030
...
...
@@ -5,12 +5,12 @@ From iris.base_logic Require Export big_op.
Section
bin_log_def
.
Context
`
{
cfgSG
Σ
}
.
Context
`
{!
heapG
Σ
}
.
Notation
D
:=
(
prodC
valC
valC
-
n
>
iProp
Σ
).
Definition
bin_log_related
(
Γ
:
list
type
)
(
e
e
'
:
expr
)
(
τ
:
type
)
:=
∀
Δ
vvs
ρ
,
env_PersistentP
Δ
→
heap_ctx
∧
spec_ctx
ρ
∧
⟦
Γ
⟧
*
Δ
vvs
⊢
⟦
τ
⟧ₑ
Δ
(
e
.[
env_subst
(
vvs
.
*
1
)],
e
'
.[
env_subst
(
vvs
.
*
2
)]).
Definition
bin_log_related
(
Γ
:
list
type
)
(
e
e
'
:
expr
)
(
τ
:
type
)
:=
∀
Δ
vvs
(
ρ
:
cfg
lang
),
env_PersistentP
Δ
→
spec_inv
ρ
∗
⟦
Γ
⟧
*
Δ
vvs
⊢
⟦
τ
⟧ₑ
Δ
(
e
.[
env_subst
(
vvs
.
*
1
)],
e
'
.[
env_subst
(
vvs
.
*
2
)]).
End
bin_log_def
.
Notation
"Γ ⊨ e '≤log≤' e' : τ"
:=
...
...
@@ -18,6 +18,7 @@ Notation "Γ ⊨ e '≤log≤' e' : τ" :=
Section
fundamental
.
Context
`
{
cfgSG
Σ
}
.
Context
`
{!
heapG
Σ
}
.
Notation
D
:=
(
prodC
valC
valC
-
n
>
iProp
Σ
).
Implicit
Types
e
:
expr
.
Implicit
Types
Δ
:
listC
D
.
...
...
@@ -32,17 +33,17 @@ Section fundamental.
iIntros
(
v
)
Htmp
;
iDestruct
Htmp
as
(
w
)
Hv
;
rewrite
fill_app
;
simpl
.
Local
Ltac
value_case
:=
iApply
wp_value
;
[
cbn
;
rewrite
?
to_of_val
;
trivial
|
]
.
Local
Ltac
value_case
:=
iApply
wp_value
;
eauto
using
to_of_val
.
(
*
Put
all
quantifiers
at
the
outer
level
*
)
Lemma
bin_log_related_alt
{
Γ
e
e
'
τ
}
:
Γ
⊨
e
≤
log
≤
e
'
:
τ
→
∀
Δ
vvs
ρ
K
,
env_PersistentP
Δ
→
heap_ctx
∗
spec_
ctx
ρ
∗
⟦
Γ
⟧
*
Δ
vvs
∗
⤇
fill
K
(
e
'
.[
env_subst
(
vvs
.
*
2
)])
spec_
inv
ρ
∗
⟦
Γ
⟧
*
Δ
vvs
∗
⤇
fill
K
(
e
'
.[
env_subst
(
vvs
.
*
2
)])
⊢
WP
e
.[
env_subst
(
vvs
.
*
1
)]
{{
v
,
∃
v
'
,
⤇
fill
K
(
of_val
v
'
)
∗
interp
τ
Δ
(
v
,
v
'
)
}}
.
Proof
.
iIntros
(
Hlog
Δ
vvs
ρ
K
?
)
"
(
#H
h & #Hs & HΓ & Hj)"
.
iApply
(
Hlog
with
"[HΓ] *"
);
iFrame
;
eauto
.
iIntros
(
Hlog
Δ
vvs
K
ρ
?
)
"
[
#H
ρ [HΓ Hj]]"
.
asimpl
.
iApply
(
Hlog
with
"[HΓ] *"
);
iFrame
.
eauto
.
Qed
.
Notation
"' H"
:=
(
bin_log_related_alt
H
)
(
at
level
8
).
...
...
@@ -50,14 +51,15 @@ Section fundamental.
Lemma
bin_log_related_var
Γ
x
τ
:
Γ
!!
x
=
Some
τ
→
Γ
⊨
Var
x
≤
log
≤
Var
x
:
τ
.
Proof
.
iIntros
(
?
Δ
vvs
ρ
?
)
"#(Hh & Hs & HΓ)"
;
iIntros
(
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
.
iIntros
(
?
Δ
vvs
ρ
?
)
"[#Hρ #HΓ]"
.
iIntros
(
K
)
"Hj /="
.
iDestruct
(
interp_env_Some_l
with
"HΓ"
)
as
([
v
v
'
])
"[% Hv]"
;
first
done
.
rewrite
/
env_subst
!
list_lookup_fmap
;
simplify_option_eq
.
value_case
.
Qed
.
Lemma
bin_log_related_unit
Γ
:
Γ
⊨
Unit
≤
log
≤
Unit
:
TUnit
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#
(Hh & Hs & HΓ)"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[Hρ HΓ]"
.
iIntros
(
K
)
"Hj /="
.
value_case
.
iExists
UnitV
;
eauto
.
Qed
.
...
...
@@ -66,12 +68,13 @@ Section fundamental.
(
IHHtyped2
:
Γ
⊨
e2
≤
log
≤
e2
'
:
τ
2
)
:
Γ
⊨
Pair
e1
e2
≤
log
≤
Pair
e1
'
e2
'
:
TProd
τ
1
τ
2.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#
(Hh & Hs &
HΓ
)
"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[Hρ
HΓ
]
"
;
iIntros
(
K
)
"Hj /="
.
smart_wp_bind
(
PairLCtx
e2
.[
env_subst
_
])
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped1
_
_
_
(
K
++
[
PairLCtx
e2
'
.[
env_subst
_
]
])).
smart_wp_bind
(
PairRCtx
v
)
w
w
'
"[Hw #Hiw]"
(
'
IHHtyped2
_
_
_
(
K
++
[
PairRCtx
v
'
])).
value_case
.
iExists
(
PairV
v
'
w
'
);
iFrame
"Hw"
.
value_case
.
rewrite
/=
to_of_val
/=
to_of_val
/=
.
eauto
.
iExists
(
PairV
v
'
w
'
);
iFrame
"Hw"
.
iExists
(
v
,
v
'
),
(
w
,
w
'
);
simpl
;
repeat
iSplit
;
trivial
.
Qed
.
...
...
@@ -79,10 +82,10 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
TProd
τ
1
τ
2
)
:
Γ
⊨
Fst
e
≤
log
≤
Fst
e
'
:
τ
1.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"
#(Hh & Hs &
HΓ
)
"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"
[#Hρ #
HΓ
]
"
;
iIntros
(
K
)
"Hj /="
.
smart_wp_bind
(
FstCtx
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped
_
_
_
(
K
++
[
FstCtx
]));
cbn
.
iDestruct
"Hiv"
as
([
w1
w1
'
]
[
w2
w2
'
])
"#[% [Hw1 Hw2]]"
;
simplify_eq
.
iMod
(
step_fst
_
_
K
(
of_val
w1
'
)
w1
'
(
of_val
w2
'
)
w2
'
with
"
*
[-]"
)
as
"Hw"
;
eauto
.
iDestruct
"Hiv"
as
([
w1
w1
'
]
[
w2
w2
'
])
"#[% [Hw1 Hw2]]"
;
simplify_eq
.
iMod
(
step_fst
_
_
K
(
of_val
w1
'
)
w1
'
(
of_val
w2
'
)
w2
'
with
"[-]"
)
as
"Hw"
;
eauto
.
iApply
wp_fst
;
eauto
.
Qed
.
...
...
@@ -90,7 +93,7 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
TProd
τ
1
τ
2
)
:
Γ
⊨
Snd
e
≤
log
≤
Snd
e
'
:
τ
2.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#
(Hh & Hs &
HΓ
)
"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[Hρ
HΓ
]
"
;
iIntros
(
K
)
"Hj /="
.
smart_wp_bind
(
SndCtx
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped
_
_
_
(
K
++
[
SndCtx
]));
cbn
.
iDestruct
"Hiv"
as
([
w1
w1
'
]
[
w2
w2
'
])
"#[% [Hw1 Hw2]]"
;
simplify_eq
.
iMod
(
step_snd
_
_
K
(
of_val
w1
'
)
w1
'
(
of_val
w2
'
)
w2
'
with
"* [-]"
)
as
"Hw"
;
eauto
.
...
...
@@ -101,10 +104,11 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
τ
1
)
:
Γ
⊨
InjL
e
≤
log
≤
InjL
e
'
:
(
TSum
τ
1
τ
2
).
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#
(Hh & Hs &
HΓ
)
"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[Hρ
HΓ
]
"
;
iIntros
(
K
)
"Hj /="
.
smart_wp_bind
(
InjLCtx
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped
_
_
_
(
K
++
[
InjLCtx
]));
cbn
.
value_case
.
iExists
(
InjLV
v
'
);
iFrame
"Hv"
.
value_case
.
repeat
rewrite
/=
to_of_val
.
eauto
.
iExists
(
InjLV
v
'
);
iFrame
"Hv"
.
iLeft
;
iExists
(
_
,
_
);
eauto
10.
Qed
.
...
...
@@ -112,10 +116,11 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
τ
2
)
:
Γ
⊨
InjR
e
≤
log
≤
InjR
e
'
:
TSum
τ
1
τ
2.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#
(Hh & Hs &
HΓ
)
"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[Hρ
HΓ
]
"
;
iIntros
(
K
)
"Hj /="
.
smart_wp_bind
(
InjRCtx
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped
_
_
_
(
K
++
[
InjRCtx
]));
cbn
.
value_case
.
iExists
(
InjRV
v
'
);
iFrame
"Hv"
.
value_case
.
repeat
rewrite
/=
to_of_val
.
eauto
.
iExists
(
InjRV
v
'
);
iFrame
"Hv"
.
iRight
;
iExists
(
_
,
_
);
eauto
10.
Qed
.
...
...
@@ -129,7 +134,7 @@ 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
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[Hρ
HΓ
]
"
;
iIntros
(
K
)
"Hj /="
.
iDestruct
(
interp_env_length
with
"HΓ"
)
as
%?
.
smart_wp_bind
(
CaseCtx
_
_
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped1
_
_
_
(
K
++
[
CaseCtx
_
_
]));
cbn
.
...
...
@@ -154,7 +159,7 @@ Section fundamental.
(
IHHtyped
:
τ
1
::
Γ
⊨
e
≤
log
≤
e
'
:
τ
2
)
:
Γ
⊨
Lam
e
≤
log
≤
Lam
e
'
:
TArrow
τ
1
τ
2.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#
(Hh & Hs &
HΓ
)
"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[Hρ
HΓ
]
"
;
iIntros
(
K
)
"Hj /="
.
value_case
.
iExists
(
LamV
_
).
iIntros
"{$Hj} !#"
.
iIntros
([
v
v
'
])
"#Hiv"
.
iIntros
(
K
'
)
"Hj"
.
iDestruct
(
interp_env_length
with
"HΓ"
)
as
%?
.
...
...
@@ -170,7 +175,7 @@ Section fundamental.
(
IHHtyped2
:
Γ
⊨
e2
≤
log
≤
e2
'
:
τ
1
)
:
Γ
⊨
App
e1
e2
≤
log
≤
App
e1
'
e2
'
:
τ
2.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#
(Hh & Hs &
HΓ
)
"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[Hρ
HΓ
]
"
;
iIntros
(
K
)
"Hj /="
.
smart_wp_bind
(
AppLCtx
(
e2
.[
env_subst
(
vvs
.
*
1
)]))
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped1
_
_
_
(
K
++
[(
AppLCtx
(
e2
'
.[
env_subst
(
vvs
.
*
2
)]))]));
cbn
.
smart_wp_bind
(
AppRCtx
v
)
w
w
'
"[Hw #Hiw]"
...
...
@@ -182,7 +187,7 @@ Section fundamental.
(
IHHtyped
:
(
subst
(
ren
(
+
1
))
<
$
>
Γ
)
⊨
e
≤
log
≤
e
'
:
τ
)
:
Γ
⊨
TLam
e
≤
log
≤
TLam
e
'
:
TForall
τ
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#
(Hh & Hs &
HΓ
)
"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[Hρ
HΓ
]
"
;
iIntros
(
K
)
"Hj /="
.
value_case
.
iExists
(
TLamV
_
).
iIntros
"{$Hj} /= !#"
;
iIntros
(
τ
i
?
K
'
)
"Hv /="
.
iApply
wp_tlam
;
iNext
.
...
...
@@ -194,13 +199,13 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
TForall
τ
)
:
Γ
⊨
TApp
e
≤
log
≤
TApp
e
'
:
τ
.[
τ'
/
].
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#
(Hh & Hs &
HΓ
)
"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[Hρ
HΓ
]
"
;
iIntros
(
K
)
"Hj /="
.
smart_wp_bind
(
TAppCtx
)
v
v
'
"[Hj #Hv]"
(
'
IHHtyped
_
_
_
(
K
++
[
TAppCtx
]))
;
cbn
.
(
'
IHHtyped
_
_
_
(
K
++
[
TAppCtx
])).
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"
.
iExists
_
;
rewrite
-
interp_subst
;
eauto
.
Qed
.
...
...
@@ -208,12 +213,13 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
τ
.[(
TRec
τ
)
/
])
:
Γ
⊨
Fold
e
≤
log
≤
Fold
e
'
:
TRec
τ
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#
(Hh & Hs &
HΓ
)
"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[Hρ
HΓ
]
"
;
iIntros
(
K
)
"Hj /="
.
iApply
(
wp_bind
[
FoldCtx
]);
iApply
wp_wand_l
;
iSplitR
;
[
|
iApply
(
'
IHHtyped
_
_
_
(
K
++
[
FoldCtx
]));
rewrite
?
fill_app
;
simpl
;
repeat
iSplitR
;
trivial
].
iIntros
(
v
);
iDestruct
1
as
(
w
)
"[Hv #Hiv]"
;
rewrite
fill_app
.
value_case
.
iExists
(
FoldV
w
);
iFrame
"Hv"
.
value_case
.
repeat
rewrite
/=
to_of_val
.
eauto
.
iExists
(
FoldV
w
);
iFrame
"Hv"
.
rewrite
fixpoint_unfold
/=
-
interp_subst
.
iAlways
;
iExists
(
_
,
_
);
eauto
.
Qed
.
...
...
@@ -222,7 +228,7 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
TRec
τ
)
:
Γ
⊨
Unfold
e
≤
log
≤
Unfold
e
'
:
τ
.[(
TRec
τ
)
/
].
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#
(Hh & Hs &
HΓ
)
"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[Hρ
HΓ
]
"
;
iIntros
(
K
)
"Hj /="
.
iApply
(
wp_bind
[
UnfoldCtx
]);
iApply
wp_wand_l
;
iSplitR
;
[
|
iApply
(
'
IHHtyped
_
_
_
(
K
++
[
UnfoldCtx
]));
rewrite
?
fill_app
;
simpl
;
repeat
iSplitR
;
trivial
].
...
...
@@ -239,29 +245,29 @@ Section fundamental.
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
τ
)
:
Γ
⊨
Alloc
e
≤
log
≤
Alloc
e
'
:
Tref
τ
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#
(Hh & Hs & HΓ)"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[Hρ HΓ]"
.
iIntros
(
K
)
"Hj /="
.
smart_wp_bind
(
AllocCtx
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped
_
_
_
(
K
++
[
AllocCtx
])).
iMod
(
step_alloc
_
_
K
(
of_val
v
'
)
v
'
with
"
* [-
]"
)
as
(
l
'
)
"[Hj Hl]"
;
eauto
.
iApply
wp_fupd
.
iApply
(
wp_alloc
with
"[]"
)
;
auto
.
iIntros
"!>"
;
iIntros
(
l
)
"Hl
'
"
.
iMod
(
step_alloc
_
_
K
(
of_val
v
'
)
v
'
with
"
[Hv
]"
)
as
(
l
'
)
"[Hj Hl
'
]"
;
eauto
.
iApply
wp_fupd
.
iApply
wp_alloc
;
auto
.
iIntros
"!>"
;
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
.
}
iModIntro
;
iExists
(
LocV
l
'
).
iFrame
"Hj"
.
iExists
(
l
,
l
'
)
;
eauto
.
iModIntro
;
iExists
(
LocV
l
'
).
iFrame
"Hj"
.
iExists
(
l
,
l
'
)
.
eauto
.
Qed
.
Lemma
bin_log_related_load
Γ
e
e
'
τ
(
IHHtyped
:
Γ
⊨
e
≤
log
≤
e
'
:
(
Tref
τ
))
:
Γ
⊨
Load
e
≤
log
≤
Load
e
'
:
τ
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#
(Hh & Hs &
HΓ
)
"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[?
HΓ
]
"
;
iIntros
(
K
)
"Hj /="
.
smart_wp_bind
(
LoadCtx
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped
_
_
_
(
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
_
_
K
l
'
1
w
'
with
"[Hv Hw2]"
)
as
"[Hv Hw2]"
;
[
solve_ndisj
|
by
iFrame
|
].
iApply
(
wp_load
_
_
1
with
"[Hw1]"
);
[
|
iFrame
"Hh"
|
];
trivial
;
try
solve_ndisj
.
iApply
(
wp_load
_
_
1
with
"[Hw1]"
);
eauto
.
iNext
.
iIntros
"Hw1"
.
iMod
(
"Hclose"
with
"[Hw1 Hw2]"
).
{
iNext
.
iExists
(
w
,
w
'
);
by
iFrame
.
}
iModIntro
.
iExists
w
'
;
by
iFrame
.
...
...
@@ -272,7 +278,7 @@ Section fundamental.
(
IHHtyped2
:
Γ
⊨
e2
≤
log
≤
e2
'
:
τ
)
:
Γ
⊨
Store
e1
e2
≤
log
≤
Store
e1
'
e2
'
:
TUnit
.
Proof
.
iIntros
(
Δ
vvs
ρ
?
)
"#
(Hh & Hs &
HΓ
)
"
;
iIntros
(
K
)
"Hj /="
.
iIntros
(
Δ
vvs
ρ
?
)
"#
[?
HΓ
]
"
;
iIntros
(
K
)
"Hj /="
.
smart_wp_bind
(
StoreLCtx
_
)
v
v
'
"[Hv #Hiv]"
(
'
IHHtyped1
_
_
_
(
K
++
[
StoreLCtx
_
])).
smart_wp_bind
(
StoreRCtx
_
)
w
w
'
"[Hw #Hiw]"
...
...
@@ -281,7 +287,7 @@ Section fundamental.
iInv
(
logN
.
@
(
l
,
l
'
))
as
([
v
v
'
])
"[>Hv1 [>Hv2 #Hv]]"
"Hclose"
.
iMod
(
step_store
_
_
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
.
iApply
(
wp_store
with
"[Hv1]"
);
e
auto
using
to_of_val
.
iNext
.
iIntros
"Hv1"
.
iMod
(
"Hclose"
with
"[Hv1 Hv2]"
).
{
iNext
;
iExists
(
w
,
w
'
);
by
iFrame
.
}
iExists
UnitV
;
iFrame
;
auto
.
...
...
F_mu_ref/lang.v
View file @
70299030
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
.
...
...
@@ -232,10 +232,13 @@ Definition is_atomic (e : expr) : Prop :=
|
Store
e1
e2
=>
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/logrel.v
View file @
70299030
...
...
@@ -19,16 +19,16 @@ Section logrel.
from_option
id
(
cconst
True
)
%
I
(
Δ
!!
x
).
Solve
Obligations
with
solve_proper_alt
.
Definition
interp_unit
:
listC
D
-
n
>
D
:=
λ
ne
Δ
w
,
(
w
=
UnitV
)
%
I
.
Definition
interp_unit
:
listC
D
-
n
>
D
:=
λ
ne
Δ
w
,
⌜
w
=
UnitV
⌝
%
I
.
Program
Definition
interp_prod
(
interp1
interp2
:
listC
D
-
n
>
D
)
:
listC
D
-
n
>
D
:=
λ
ne
Δ
w
,
(
∃
w1
w2
,
w
=
PairV
w1
w2
∧
interp1
Δ
w1
∧
interp2
Δ
w2
)
%
I
.
(
∃
w1
w2
,
⌜
w
=
PairV
w1
w2
⌝
∧
interp1
Δ
w1
∧
interp2
Δ
w2
)
%
I
.
Solve
Obligations
with
solve_proper
.
Program
Definition
interp_sum
(
interp1
interp2
:
listC
D
-
n
>
D
)
:
listC
D
-
n
>
D
:=
λ
ne
Δ
w
,
((
∃
w1
,
w
=
InjLV
w1
∧
interp1
Δ
w1
)
∨
(
∃
w2
,
w
=
InjRV
w2
∧
interp2
Δ
w2
))
%
I
.
((
∃
w1
,
⌜
w
=
InjLV
w1
⌝
∧
interp1
Δ
w1
)
∨
(
∃
w2
,
⌜
w
=
InjRV
w2
⌝
∧
interp2
Δ
w2
))
%
I
.
Solve
Obligations
with
solve_proper
.
Program
Definition
interp_arrow
...
...
@@ -39,20 +39,16 @@ Section logrel.
Program
Definition
interp_forall
(
interp
:
listC
D
-
n
>
D
)
:
listC
D
-
n
>
D
:=
λ
ne
Δ
w
,
(
□
∀
τ
i
:
D
,
■
(
∀
v
,
PersistentP
(
τ
i
v
))
→
WP
TApp
(#
w
)
{{
interp
(
τ
i
::
Δ
)
}}
)
%
I
.
⌜
(
∀
v
,
PersistentP
(
τ
i
v
))
⌝
→
WP
TApp
(#
w
)
{{
interp
(
τ
i
::
Δ
)
}}
)
%
I
.
Solve
Obligations
with
solve_proper
.
Definition
interp_rec1
(
interp
:
listC
D
-
n
>
D
)
(
Δ
:
listC
D
)
(
τ
i
:
D
)
:
D
:=
λ
ne
w
,
(
□
(
∃
v
,
w
=
FoldV
v
∧
▷
interp
(
τ
i
::
Δ
)
v
))
%
I
.
(
□
(
∃
v
,
⌜
w
=
FoldV
v
⌝
∧
▷
interp
(
τ
i
::
Δ
)
v
))
%
I
.
Global
Instance
interp_rec1_contractive
(
interp
:
listC
D
-
n
>
D
)
(
Δ
:
listC
D
)
:
Contractive
(
interp_rec1
interp
Δ
).
Proof
.
intros
n
τ
i1
τ
i2
H
τ
i
w
;
cbn
.
apply
always_ne
,
exist_ne
;
intros
v
;
apply
and_ne
;
trivial
.
apply
later_contractive
=>
i
Hi
.
by
rewrite
H
τ
i
.
Qed
.
Proof
.
by
solve_contractive
.
Qed
.
Program
Definition
interp_rec
(
interp
:
listC
D
-
n
>
D
)
:
listC
D
-
n
>
D
:=
λ
ne
Δ
,
fixpoint
(
interp_rec1
interp
Δ
).
...
...
@@ -66,7 +62,7 @@ Section logrel.
Program
Definition
interp_ref
(
interp
:
listC
D
-
n
>
D
)
:
listC
D
-
n
>
D
:=
λ
ne
Δ
w
,
(
∃
l
,
w
=
LocV
l
∧
inv
(
logN
.
@
l
)
(
interp_ref_inv
l
(
interp
Δ
)))
%
I
.
(
∃
l
,
⌜
w
=
LocV
l
⌝
∧
inv
(
logN
.
@
l
)
(
interp_ref_inv
l
(
interp
Δ
)))
%
I
.
Solve
Obligations
with
solve_proper
.
Fixpoint
interp
(
τ
:
type
)
:
listC
D
-
n
>
D
:=
...
...
@@ -84,7 +80,7 @@ Section logrel.
Definition
interp_env
(
Γ
:
list
type
)
(
Δ
:
listC
D
)
(
vs
:
list
val
)
:
iProp
Σ
:=
(
length
Γ
=
length
vs
∗
[
∗
]
zip_with
(
λ
τ
,
⟦
τ
⟧
Δ
)
Γ
vs
)
%
I
.
(
⌜
length
Γ
=
length
vs
⌝
∗
[
∗
]
zip_with
(
λ
τ
,
⟦
τ
⟧
Δ
)
Γ
vs
)
%
I
.
Notation
"⟦ Γ ⟧*"
:=
(
interp_env
Γ
).
Definition
interp_expr
(
τ
:
type
)
(
Δ
:
listC
D
)
(
e
:
expr
)
:
iProp
Σ
:=
...
...
@@ -122,7 +118,7 @@ Section logrel.
properness
;
auto
.
apply
(
IH
τ
(
_
::
_
)).
-
rewrite
iter_up
;
destruct
lt_dec
as
[
Hl
|
Hl
];
simpl
.
{
by
rewrite
!
lookup_app_l
.
}
rewrite
!
lookup_app_r
;
[
|
lia
..].
do
2
f_equiv
.
lia
.
done
.
rewrite
!
lookup_app_r
;
[
|
lia
..].
do
2
f_equiv
.
lia
.
-
intros
w
;
simpl
;
properness
;
auto
.
apply
(
IH
τ
(
_
::
_
)).
-
intros
w
;
simpl
;
properness
;
auto
.
by
apply
IH
τ
.
Qed
.
...
...
@@ -143,7 +139,7 @@ Section logrel.
rewrite
!
lookup_app_r
;
[
|
lia
..].
destruct
(
x
-
length
Δ
1
)
as
[
|
n
]
eqn
:?
;
simpl
.
{
symmetry
.
asimpl
.
apply
(
interp_weaken
[]
Δ
1
Δ
2
τ'
).
}
rewrite
!
lookup_app_r
;
[
|
lia
..].
do
2
f_equiv
.
lia
.
done
.
rewrite
!
lookup_app_r
;
[
|
lia
..].
do
2
f_equiv
.
lia
.
-
intros
w
;
simpl
;
properness
;
auto
.
apply
(
IH
τ
(
_
::
_
)).
-
intros
w
;
simpl
;
properness
;
auto
.
by
apply
IH
τ
.
Qed
.
...
...
@@ -151,11 +147,11 @@ Section logrel.
Lemma
interp_subst
Δ
2
τ
τ'
:
⟦
τ
⟧
(
⟦
τ'
⟧
Δ
2
::
Δ
2
)
≡
⟦
τ
.[
τ'
/
]
⟧
Δ
2.
Proof
.
apply
(
interp_subst_up
[]).
Qed
.
Lemma
interp_env_length
Δ
Γ
vs
:
⟦
Γ
⟧
*
Δ
vs
⊢
length
Γ
=
length
vs
.
Lemma
interp_env_length
Δ
Γ
vs
:
⟦
Γ
⟧
*
Δ
vs
⊢
⌜
length
Γ
=
length
vs
⌝
.
Proof
.
by
iIntros
"[% ?]"
.
Qed
.
Lemma
interp_env_Some_l
Δ
Γ
vs
x
τ
:
Γ
!!
x
=
Some
τ
→
⟦
Γ
⟧
*
Δ
vs
⊢
∃
v
,
vs
!!
x
=
Some
v
∧
⟦
τ
⟧
Δ
v
.
Γ
!!
x
=
Some
τ
→
⟦
Γ
⟧
*
Δ
vs
⊢
∃
v
,
⌜
vs
!!
x
=
Some
v
⌝
∧
⟦
τ
⟧
Δ
v
.
Proof
.
iIntros
(
?
)
"[Hlen HΓ]"
;
iDestruct
"Hlen"
as
%
Hlen
.
destruct
(
lookup_lt_is_Some_2
vs
x
)
as
[
v
Hv
].
...
...
@@ -170,7 +166,7 @@ Section logrel.
Lemma
interp_env_cons
Δ
Γ
vs
τ
v
:
⟦
τ
::
Γ
⟧
*
Δ
(
v
::
vs
)
⊣⊢
⟦
τ
⟧
Δ
v
∗
⟦
Γ
⟧
*
Δ
vs
.
Proof
.
rewrite
/
interp_env
/=
(
assoc
_
(
⟦
_
⟧
_
_
))
-
(
comm
_
(
_
=
_
)
%
I
)
-
assoc
.
rewrite
/
interp_env
/=
(
assoc
_
(
⟦
_
⟧
_
_
))
-
(
comm
_
⌜
(
_
=
_
)
⌝
%
I
)
-
assoc
.
by
apply
sep_proper
;
[
apply
pure_proper
;
omega
|
].
Qed
.
...
...
F_mu_ref/logrel_binary.v
View file @
70299030
...
...
@@ -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
?
...
...
@@ -43,20 +43,20 @@ Section logrel.
Solve
Obligations
with
solve_proper_alt
.
Program
Definition
interp_unit
:
listC
D
-
n
>
D
:=
λ
ne
Δ
ww
,
(
ww
.1
=
UnitV
∧
ww
.2
=
UnitV
)
%
I
.
(
⌜
ww
.1
=
UnitV
⌝
∧
⌜
ww
.2
=
UnitV
⌝
)
%
I
.
Solve
Obligations
with
solve_proper_alt
.
Program
Definition
interp_prod
(
interp1
interp2
:
listC
D
-
n
>
D
)
:
listC
D
-
n
>
D
:=
λ
ne
Δ
ww
,
(
∃
vv1
vv2
,
ww
=
(
PairV
(
vv1
.1
)
(
vv2
.1
),
PairV
(
vv1
.2
)
(
vv2
.2
))
∧
(
∃
vv1
vv2
,
⌜
ww
=
(
PairV
(
vv1
.1
)
(
vv2
.1
),
PairV
(
vv1
.2
)
(
vv2
.2
))
⌝
∧
interp1
Δ
vv1
∧
interp2
Δ
vv2
)
%
I
.
Solve
Obligations
with
solve_proper
.
Solve
Obligations
with
(
preprocess_solve_proper
;
auto_equiv
).
Program
Definition
interp_sum
(
interp1
interp2
:
listC
D
-
n
>
D
)
:
listC
D
-
n
>
D
:=
λ
ne
Δ
ww
,
((
∃
vv
,
ww
=
(
InjLV
(
vv
.1
),
InjLV
(
vv
.2
))
∧
interp1
Δ
vv
)
∨
(
∃
vv
,
ww
=
(
InjRV
(
vv
.1
),
InjRV
(
vv
.2
))
∧
interp2
Δ
vv
))
%
I
.
Solve
Obligations
with
solve_proper
.
((
∃
vv
,
⌜
ww
=
(
InjLV
(
vv
.1
),
InjLV
(
vv
.2
))
⌝
∧
interp1
Δ
vv
)
∨
(
∃
vv
,
⌜
ww
=
(
InjRV
(
vv
.1
),
InjRV
(
vv
.2
))
⌝
∧
interp2
Δ
vv
))
%
I
.
Solve
Obligations
with
(
preprocess_solve_proper
;
auto_equiv
)
.
Program
Definition
interp_arrow
(
interp1
interp2
:
listC
D
-
n
>
D
)
:
listC
D
-
n
>
D
:=
...
...
@@ -65,28 +65,24 @@ Section logrel.
interp_expr
interp2
Δ
(
App
(
of_val
(
ww
.1
))
(
of_val
(
vv
.1
)),
App
(
of_val
(
ww
.2
))
(
of_val
(
vv
.2
))))
%
I
.
Solve
Obligations
with
solve_proper
.
Solve
Obligations
with
(
preprocess_solve_proper
;
auto_equiv
)
.
Program
Definition
interp_forall
(
interp
:
listC
D
-
n
>
D
)
:
listC
D
-
n
>
D
:=
λ
ne
Δ
ww
,
(
□
∀
τ
i
,
(
■
∀
ww
,
PersistentP
(
τ
i
ww
)
)
→
⌜
∀
ww
,
PersistentP
(
τ
i
ww
)
⌝
→
interp_expr
interp
(
τ
i
::
Δ
)
(
TApp
(
of_val
(
ww
.1
)),
TApp
(
of_val
(
ww
.2
))))
%
I
.
Solve
Obligations
with
solve_proper
.
Solve
Obligations
with
(
preprocess_solve_proper
;
auto_equiv
)
.
Program
Definition
interp_rec1
(
interp
:
listC
D
-
n
>
D
)
(
Δ
:
listC
D
)
(
τ
i
:
D
)
:
D
:=
λ
ne
ww
,
(
□
∃
vv
,
ww
=
(
FoldV
(
vv
.1
),
FoldV
(
vv
.2
))
∧
▷
interp
(
τ
i
::
Δ
)
vv
)
%
I
.
Solve
Obligations
with
solve_proper
.
(
□
∃
vv
,
⌜
ww
=
(
FoldV
(
vv
.1
),
FoldV
(
vv
.2
))
⌝
∧
▷
interp
(
τ
i
::
Δ
)
vv
)
%
I
.
Solve
Obligations
with
(
preprocess_solve_proper
;
auto_equiv
)
.
Global
Instance
interp_rec1_contractive
(
interp
:
listC
D
-
n
>
D
)
(
Δ
:
listC
D
)
:
Contractive
(
interp_rec1
interp
Δ
).
Proof
.
intros
n
τ
i1
τ
i2
H
τ
i
ww
;
cbn
.
apply
always_ne
,
exist_ne
;
intros
vv
;
apply
and_ne
;
trivial
.
apply
later_contractive
=>
i
Hi
.
by
rewrite
H
τ
i
.
Qed
.
Proof
.
by
solve_contractive
.
Qed
.
Program
Definition
interp_rec
(
interp
:
listC
D
-
n
>
D
)
:
listC
D
-
n
>
D
:=
λ
ne
Δ
,
fixpoint
(
interp_rec1
interp
Δ
).
...
...
@@ -96,13 +92,13 @@ Section logrel.
Program
Definition
interp_ref_inv
(
ll
:
loc
*
loc
)
:
D
-
n
>
iProp
Σ
:=
λ
ne
τ
i
,
(
∃
vv
,
ll
.1
↦
vv
.1
∗
ll
.2
↦ₛ
vv
.2
∗
τ
i
vv
)
%
I
.
Solve
Obligations
with
solve_proper
.
Solve
Obligations
with
(
preprocess_solve_proper
;
auto_equiv
)
.
Program
Definition
interp_ref
(
interp
:
listC
D
-
n
>
D
)
:
listC
D
-
n
>
D
:=
λ
ne
Δ
ww
,
(
∃
ll
,
ww
=
(
LocV
(
ll
.1
),
LocV
(
ll
.2
))
∧
(
∃
ll
,
⌜
ww
=
(
LocV
(
ll
.1
),
LocV
(
ll
.2
))
⌝
∧
inv
(
logN
.
@
ll
)
(
interp_ref_inv
ll
(
interp
Δ
)))
%
I
.
Solve
Obligations
with
solve_proper
.
Solve
Obligations
with
(
preprocess_solve_proper
;
auto_equiv
)
.
Fixpoint
interp
(
τ
:
type
)
:
listC
D
-
n
>
D
:=
match
τ
return
_
with
...
...
@@ -119,7 +115,7 @@ Section logrel.
Definition
interp_env
(
Γ
:
list
type
)
(
Δ
:
listC
D
)
(
vvs
:
list
(
val
*
val
))
:
iProp
Σ
:=