Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Dan Frumin
ReLoC-v1
Commits
9ecad48f
Commit
9ecad48f
authored
Jul 01, 2016
by
Robbert Krebbers
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Major simplification of F_mu logrel.
parent
0f96e059
Changes
6
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
165 additions
and
411 deletions
+165
-411
F_mu/fundamental.v
F_mu/fundamental.v
+18
-23
F_mu/logrel.v
F_mu/logrel.v
+105
-333
F_mu/soundness.v
F_mu/soundness.v
+8
-20
F_mu/typing.v
F_mu/typing.v
+13
-32
F_mu_ref_par/typing.v
F_mu_ref_par/typing.v
+2
-2
prelude/base.v
prelude/base.v
+19
-1
No files found.
F_mu/fundamental.v
View file @
9ecad48f
...
...
@@ -5,6 +5,8 @@ From iris.algebra Require Export upred_big_op.
Section
typed_interp
.
Context
{
Σ
:
iFunctor
}
.
Notation
D
:=
(
valC
-
n
>
iProp
lang
Σ
).
Implicit
Types
Δ
:
listC
D
.
Local
Tactic
Notation
"smart_wp_bind"
uconstr
(
ctx
)
ident
(
v
)
constr
(
Hv
)
uconstr
(
Hp
)
:=
iApply
(
@
wp_bind
_
_
_
[
ctx
]);
...
...
@@ -14,21 +16,20 @@ Section typed_interp.
Local
Ltac
value_case
:=
iApply
wp_value
;
cbn
;
rewrite
?
to_of_val
;
trivial
.
Lemma
typed_interp
(
Δ
:
varC
-
n
>
valC
-
n
>
iProp
lang
Σ
)
Γ
vs
e
τ
(
H
Δ
:
∀
x
v
,
PersistentP
(
Δ
x
v
))
:
Lemma
typed_interp
Δ
Γ
vs
e
τ
(
H
Δ
:
ctx_PersistentP
Δ
)
:
Γ
⊢ₜ
e
:
τ
→
length
Γ
=
length
vs
→
[
∧
]
zip_with
(
λ
τ
,
interp
τ
Δ
)
Γ
vs
⊢
WP
e
.[
env_subst
vs
]
{{
interp
τ
Δ
}}
.
Proof
.
intros
Htyped
.
revert
Δ
H
Δ
vs
.
induction
Htyped
;
iIntros
{
Δ
H
Δ
vs
Hlen
}
"#HΓ"
;
cbn
.
induction
Htyped
;
iIntros
{
Δ
H
Δ
vs
Hlen
}
"#HΓ"
;
cbn
.
-
(
*
var
*
)
destruct
(
lookup_lt_is_Some_2
vs
x
)
as
[
v
Hv
].
{
by
rewrite
-
Hlen
;
apply
lookup_lt_Some
with
τ
.
}
rewrite
/
env_subst
Hv
;
value_case
.
iApply
(
big_and_elem_of
with
"HΓ"
).
apply
elem_of_list_lookup_2
with
x
.
rewrite
lookup_zip_with
;
simplify_option_eq
;
trivial
.
rewrite
lookup_zip_with
;
by
simplify_option_eq
.
-
(
*
unit
*
)
value_case
.
-
(
*
pair
*
)
smart_wp_bind
(
PairLCtx
e2
.[
env_subst
vs
])
v
"# Hv"
IHHtyped1
.
...
...
@@ -70,35 +71,29 @@ Section typed_interp.
iApply
wp_mono
;
[
|
iApply
"Hv"
];
auto
.
-
(
*
TLam
*
)
value_case
.
iIntros
{
τ
i
}
"
!
%"
.
iApply
wp_TLam
;
iNext
;
simpl
in
*
.
iApply
(
IHHtyped
(
extend_context_interp_fun1
τ
i
Δ
));
[
rewrite
map_length
|
];
trivial
.
by
iDestruct
(
zip_with_context_interp_subst
with
"HΓ"
)
as
"?"
.
iAlways
;
iIntros
{
τ
i
}
"%"
.
iApply
wp_TLam
;
iNext
.
simpl
in
*
.
iApply
(
IHHtyped
(
τ
i
::
Δ
)).
by
rewrite
f
map_length
.
rewrite
zip_with_fmap_l
.
by
iApply
context_interp_ren_S
.
-
(
*
TApp
*
)
smart_wp_bind
TAppCtx
v
"#Hv"
IHHtyped
;
cbn
.
iApply
wp_wand_r
;
iSplitL
;
[
iApply
(
"Hv"
$
!
(
interp
τ'
Δ
));
iPureIntro
;
apply
_
|
].
iIntros
{
w
}
"?"
.
by
rewrite
interp_subst
.
iIntros
{
w
}
"?"
.
by
rewrite
interp_subst
.
-
(
*
Fold
*
)
rewrite
map_length
in
IHHtyped
.
iApply
(
@
wp_bind
_
_
_
[
FoldCtx
]).
iApply
wp_wand_l
.
iSplitL
;
[
|
iApply
(
IHHtyped
(
extend_context_interp
((
interp
(
TRec
τ
))
Δ
)
Δ
));
trivial
].
+
iIntros
{
v
}
"#Hv"
.
value_case
.
iApply
wp_wand_l
.
iSplitL
;
[
|
iApply
(
IHHtyped
(
interp
(
TRec
τ
)
Δ
::
Δ
));
trivial
].
+
iIntros
{
v
}
"#Hv"
.
value_case
.
change
(
fixpoint
_
)
with
(
interp
(
TRec
τ
)
Δ
)
at
1
;
trivial
.
rewrite
fixpoint_unfold
;
cbn
.
iAlways
;
eauto
.
+
by
iDestruct
(
zip_with_context_interp_subst
with
"HΓ"
)
as
"?"
.
rewrite
fixpoint_unfold
/=
.
iAlways
;
eauto
10.
+
rewrite
zip_with_fmap_l
.
by
iApply
context_interp_ren_S
.
-
(
*
Unfold
*
)
iApply
(
@
wp_bind
_
_
_
[
UnfoldCtx
]);
iApply
wp_wand_l
;
iSplitL
;
[
|
iApply
IHHtyped
;
trivial
].
iIntros
{
v
}
.
cbn
[
interp
interp_rec
cofe_mor_car
].
rewrite
fixpoint_unfold
.
iIntros
"#Hv"
;
cbn
.
change
(
fixpoint
_
)
with
(
interp
(
TRec
τ
)
Δ
).
iDestruct
"Hv"
as
{
w
}
"[% #Hw]"
;
rewrite
H
.
iIntros
{
v
}
"#Hv"
.
rewrite
/=
fixpoint_unfold
.
change
(
fixpoint
_
)
with
(
interp
(
TRec
τ
)
Δ
);
simpl
.
iDestruct
"Hv"
as
{
w
}
"#[% Hw]"
;
subst
.
iApply
wp_Fold
;
cbn
;
auto
using
to_of_val
.
rewrite
-
interp_subst
;
trivial
.
by
rewrite
-
interp_subst
.
Qed
.
End
typed_interp
.
F_mu/logrel.v
View file @
9ecad48f
This diff is collapsed.
Click to expand it.
F_mu/soundness.v
View file @
9ecad48f
...
...
@@ -2,34 +2,22 @@ From iris_logrel.F_mu Require Export fundamental.
From
iris
.
proofmode
Require
Import
tactics
.
From
iris
.
program_logic
Require
Import
adequacy
.
Section
S
oundness
.
Section
s
oundness
.
Let
Σ
:=
#[].
Lemma
empty_env_subst
e
:
e
.[
env_subst
[]]
=
e
.
Proof
.
change
(
env_subst
[])
with
(
@
ids
expr
_
).
by
asimpl
.
Qed
.
Definition
free_type_context
:
varC
-
n
>
valC
-
n
>
iProp
lang
(
globalF
Σ
)
:=
λ
ne
x
y
,
True
%
I
.
Lemma
wp_soundness
e
τ
:
[]
⊢ₜ
e
:
τ
→
True
⊢
WP
e
{{
@
interp
(
globalF
Σ
)
τ
free_type_context
}}
.
[]
⊢ₜ
e
:
τ
→
True
⊢
WP
e
{{
@
interp
(
globalF
Σ
)
τ
[]
}}
.
Proof
.
iIntros
{
H
}
""
.
rewrite
-
(
empty_env_subst
e
).
by
iApply
(
@
typed_interp
_
_
_
[]).
Qed
.
Theorem
Soundness
e
τ
:
[]
⊢ₜ
e
:
τ
→
∀
e
'
thp
,
rtc
step
([
e
],
tt
)
(
e
'
::
thp
,
tt
)
→
¬
reducible
e
'
tt
→
is_Some
(
to_val
e
'
).
Theorem
soundness
e
τ
e
'
thp
:
[]
⊢ₜ
e
:
τ
→
rtc
step
([
e
],
())
(
e
'
::
thp
,
())
→
is_Some
(
to_val
e
'
)
∨
reducible
e
'
().
Proof
.
intros
H1
e
'
thp
Hstp
Hnr
.
eapply
wp_soundness
in
H1
;
eauto
.
edestruct
(
@
wp_adequacy_reducible
lang
(
globalF
Σ
)
⊤
(
interp
τ
free_type_context
)
e
e
'
(
e
'
::
thp
)
tt
∅
)
as
[
Ha
|
Ha
];
eauto
using
ucmra_unit_valid
;
try
tauto
.
-
iIntros
"H"
.
iApply
H1
.
intros
??
.
eapply
wp_adequacy_reducible
;
eauto
using
ucmra_unit_valid
.
-
iIntros
"H"
.
by
iApply
wp_soundness
.
-
constructor
.
Qed
.
End
S
oundness
.
End
s
oundness
.
F_mu/typing.v
View file @
9ecad48f
...
...
@@ -30,25 +30,22 @@ Inductive typed (Γ : list type) : expr → type → Prop :=
Γ
⊢ₜ
Case
e0
e1
e2
:
ρ
|
Lam_typed
e
τ
1
τ
2
:
τ
1
::
Γ
⊢ₜ
e
:
τ
2
→
Γ
⊢ₜ
Lam
e
:
TArrow
τ
1
τ
2
|
App_typed
e1
e2
τ
1
τ
2
:
Γ
⊢ₜ
e1
:
TArrow
τ
1
τ
2
→
Γ
⊢ₜ
e2
:
τ
1
→
Γ
⊢ₜ
App
e1
e2
:
τ
2
|
TLam_typed
e
τ
:
map
(
λ
t
,
t
.[
ren
(
+
1
)
]
)
Γ
⊢ₜ
e
:
τ
→
Γ
⊢ₜ
TLam
e
:
TForall
τ
|
TLam_typed
e
τ
:
subst
(
ren
(
+
1
))
<
$
>
Γ
⊢ₜ
e
:
τ
→
Γ
⊢ₜ
TLam
e
:
TForall
τ
|
TApp_typed
e
τ
τ'
:
Γ
⊢ₜ
e
:
TForall
τ
→
Γ
⊢ₜ
TApp
e
:
τ
.[
τ'
/
]
|
TFold
e
τ
:
map
(
λ
t
,
t
.[
ren
(
+
1
)
]
)
Γ
⊢ₜ
e
:
τ
→
Γ
⊢ₜ
Fold
e
:
TRec
τ
|
TFold
e
τ
:
subst
(
ren
(
+
1
))
<
$
>
Γ
⊢ₜ
e
:
τ
→
Γ
⊢ₜ
Fold
e
:
TRec
τ
|
TUnfold
e
τ
:
Γ
⊢ₜ
e
:
TRec
τ
→
Γ
⊢ₜ
Unfold
e
:
τ
.[
TRec
τ
/
]
where
"Γ ⊢ₜ e : τ"
:=
(
typed
Γ
e
τ
).
Local
Hint
Extern
1
=>
match
goal
with
|
H
:
context
[
length
(
map
_
_
)]
|-
_
=>
rewrite
map_length
in
H
end
:
typed_subst_invariant
.
Lemma
typed_subst_invariant
Γ
e
τ
s1
s2
:
Γ
⊢ₜ
e
:
τ
→
(
∀
x
,
x
<
length
Γ
→
s1
x
=
s2
x
)
→
e
.[
s1
]
=
e
.[
s2
].
Proof
.
intros
Htyped
;
revert
s1
s2
.
assert
(
∀
{
A
}
`
{
Ids
A
}
`
{
Rename
A
}
(
s1
s2
:
nat
→
A
)
x
,
(
x
≠
0
→
s1
(
pred
x
)
=
s2
(
pred
x
))
→
up
s1
x
=
up
s2
x
).
assert
(
∀
x
Γ
,
x
<
length
(
subst
(
ren
(
+
1
))
<
$
>
Γ
)
→
x
<
length
Γ
).
{
intros
??
.
by
rewrite
fmap_length
.
}
assert
(
∀
{
A
}
`
{
Ids
A
}
`
{
Rename
A
}
(
s1
s2
:
nat
→
A
)
x
,
(
x
≠
0
→
s1
(
pred
x
)
=
s2
(
pred
x
))
→
up
s1
x
=
up
s2
x
).
{
intros
A
H1
H2
.
rewrite
/
up
=>
s1
s2
[
|
x
]
//=; auto with f_equal omega. }
induction
Htyped
=>
s1
s2
Hs
;
f_equal
/=
;
eauto
using
lookup_lt_Some
with
omega
typed_subst_invariant
.
induction
Htyped
=>
s1
s2
Hs
;
f_equal
/=
;
eauto
using
lookup_lt_Some
with
omega
.
Qed
.
Definition
env_subst
(
vs
:
list
val
)
(
x
:
var
)
:
expr
:=
...
...
@@ -58,27 +55,11 @@ Lemma typed_subst_head_simpl Δ τ e w ws :
Δ
⊢ₜ
e
:
τ
→
length
Δ
=
S
(
length
ws
)
→
e
.[#
w
.
:
env_subst
ws
]
=
e
.[
env_subst
(
w
::
ws
)].
Proof
.
intros
H1
H2
.
rewrite
/
env_subst
.
eapply
typed_subst_invariant
;
eauto
=>
/=
-
[
|
x
]
?
//=.
destruct
(
lookup_lt_is_Some_2
ws
x
)
as
[
v
'
Hv
];
first
omega
;
simpl
.
by
rewrite
Hv
.
intros
H1
H2
.
rewrite
/
env_subst
.
eapply
typed_subst_invariant
;
eauto
=>
/=
-
[
|
x
]
?
//=.
destruct
(
lookup_lt_is_Some_2
ws
x
)
as
[
v
'
?
];
first
omega
.
by
simplify_option_eq
.
Qed
.
Local
Opaque
eq_nat_dec
.
Lemma
iter_up_subst_type
(
m
:
nat
)
(
τ
:
type
)
(
x
:
var
)
:
iter
m
up
(
τ
.
:
ids
)
x
=
if
lt_dec
x
m
then
ids
x
else
if
eq_nat_dec
x
m
then
τ
.[
ren
(
+
m
)]
else
ids
(
x
-
1
).
Proof
.
revert
x
τ
.
induction
m
;
intros
x
τ
;
cbn
.
-
destruct
x
;
cbn
.
+
destruct
eq_nat_dec
;
auto
with
omega
.
asimpl
;
trivial
.
+
destruct
eq_nat_dec
;
auto
with
omega
.
-
destruct
x
;
asimpl
;
trivial
.
rewrite
IHm
.
repeat
destruct
lt_dec
;
repeat
destruct
eq_nat_dec
;
asimpl
;
auto
with
omega
.
Qed
.
Lemma
empty_env_subst
e
:
e
.[
env_subst
[]]
=
e
.
Proof
.
change
(
env_subst
[])
with
(
@
ids
expr
_
).
by
asimpl
.
Qed
.
F_mu_ref_par/typing.v
View file @
9ecad48f
...
...
@@ -167,7 +167,7 @@ Proof.
Qed
.
Lemma
n_closed_subst_head_simpl
n
e
w
ws
:
(
∀
f
,
e
.[
iter
n
up
f
]
=
e
)
->
(
∀
f
,
e
.[
iter
n
up
f
]
=
e
)
→
S
(
length
ws
)
=
n
→
e
.[#
w
.
:
env_subst
ws
]
=
e
.[
env_subst
(
w
::
ws
)].
Proof
.
...
...
@@ -188,7 +188,7 @@ Proof.
Qed
.
Lemma
n_closed_subst_head_simpl_2
n
e
w
w
'
ws
:
(
∀
f
,
e
.[
iter
n
up
f
]
=
e
)
->
(
S
(
S
(
length
ws
)))
=
n
→
(
∀
f
,
e
.[
iter
n
up
f
]
=
e
)
→
(
S
(
S
(
length
ws
)))
=
n
→
e
.[#
w
.
:
#
w
'
.
:
env_subst
ws
]
=
e
.[
env_subst
(
w
::
w
'
::
ws
)].
Proof
.
intros
H1
H2
.
...
...
prelude/base.v
View file @
9ecad48f
From
iris
.
algebra
Require
Export
base
.
From
iris
.
algebra
Require
Import
cofe
.
From
iris
.
algebra
Require
Import
upred
.
From
iris
.
program_logic
Require
Import
weakestpre
.
From
Autosubst
Require
Export
Autosubst
.
Import
uPred
.
Canonical
Structure
varC
:=
leibnizC
var
.
...
...
@@ -22,3 +24,19 @@ Section Autosubst_Lemmas.
repeat
(
case_match
||
asimpl
||
rewrite
IH
);
auto
with
omega
.
Qed
.
End
Autosubst_Lemmas
.
Ltac
properness
:=
repeat
match
goal
with
|
|-
(
∃
_
:
_
,
_
)
%
I
≡
(
∃
_
:
_
,
_
)
%
I
=>
apply
exist_proper
=>?
|
|-
(
∀
_
:
_
,
_
)
%
I
≡
(
∀
_
:
_
,
_
)
%
I
=>
apply
forall_proper
=>?
|
|-
(
_
∧
_
)
%
I
≡
(
_
∧
_
)
%
I
=>
apply
and_proper
|
|-
(
_
∨
_
)
%
I
≡
(
_
∨
_
)
%
I
=>
apply
or_proper
|
|-
(
_
→
_
)
%
I
≡
(
_
→
_
)
%
I
=>
apply
impl_proper
|
|-
(
WP
_
{{
_
}}
)
%
I
≡
(
WP
_
{{
_
}}
)
%
I
=>
apply
wp_proper
=>?
|
|-
(
▷
_
)
%
I
≡
(
▷
_
)
%
I
=>
apply
later_proper
|
|-
(
□
_
)
%
I
≡
(
□
_
)
%
I
=>
apply
always_proper
end
.
Ltac
solve_proper_alt
:=
repeat
intro
;
(
simpl
+
idtac
);
by
repeat
match
goal
with
H
:
_
≡
{
_
}
≡
_
|-
_
=>
rewrite
H
end
.
\ No newline at end of file
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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