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
Dan Frumin
ReLoC-v1
Commits
940861cf
Commit
940861cf
authored
Sep 13, 2017
by
Dan Frumin
Browse files
Cleanup
parent
d6237350
Changes
3
Hide whitespace changes
Inline
Side-by-side
theories/examples/stack/module_refinement.v
View file @
940861cf
...
...
@@ -16,49 +16,6 @@ Section Mod_refinement.
Instance
sint_persistent
`
{
logrelG
Σ
,
stackPreG
Σ
}
τ
i
vv
:
PersistentP
(
sint
τ
i
vv
).
Proof
.
apply
_.
Qed
.
Lemma
interp_subst_up_2
Δ
1
Δ
2
τ
τ
i
:
⟦
τ
⟧
(
Δ
1
++
Δ
2
)
≡
⟦
τ
.[
upn
(
length
Δ
1
)
(
ren
(
+
1
))]
⟧
(
Δ
1
++
τ
i
::
Δ
2
).
Proof
.
revert
Δ
1
Δ
2.
induction
τ
=>
Δ
1
Δ
2
;
simpl
;
eauto
.
-
intros
vv
;
simpl
;
properness
;
eauto
.
by
apply
IH
τ
1.
by
apply
IH
τ
2.
-
intros
vv
;
simpl
;
properness
;
eauto
.
by
apply
IH
τ
1.
by
apply
IH
τ
2.
-
unfold
interp_expr
.
intros
vv
;
simpl
;
properness
;
eauto
.
by
apply
IH
τ
1.
by
apply
IH
τ
2.
-
apply
fixpoint_proper
=>
τ'
ww
/=
.
properness
;
auto
.
apply
(
IH
τ
(
_
::
_
)).
-
intros
vv
;
simpl
.
rewrite
iter_up
;
destruct
lt_dec
as
[
Hl
|
Hl
];
simpl
;
properness
.
{
by
rewrite
!
lookup_app_l
.
}
rewrite
!
lookup_app_r
;
[
|
lia
..].
assert
((
length
Δ
1
+
S
(
x
-
length
Δ
1
)
-
length
Δ
1
)
=
S
(
x
-
length
Δ
1
))
as
Hwat
.
{
lia
.
}
rewrite
Hwat
.
simpl
.
done
.
-
unfold
interp_expr
.
intros
vv
;
simpl
;
properness
;
auto
.
apply
(
IH
τ
(
_
::
_
)).
-
intros
vv
;
simpl
;
properness
;
auto
.
apply
(
IH
τ
(
_
::
_
)).
-
intros
vv
;
simpl
;
properness
;
auto
.
by
apply
IH
τ
.
Qed
.
Lemma
interp_subst_2
τ
τ
i
Δ
:
⟦
τ
⟧
Δ
≡
⟦
τ
.[
ren
(
+
1
)]
⟧
(
τ
i
::
Δ
).
Proof
.
by
apply
(
interp_subst_up_2
[]).
Qed
.
Lemma
bin_log_weaken_2
τ
i
Δ
Γ
e1
e2
τ
:
{
⊤
,
⊤
;
Δ
;
Γ
}
⊨
e1
≤
log
≤
e2
:
τ
-
∗
{
⊤
,
⊤
;
τ
i
::
Δ
;
Autosubst_Classes
.
subst
(
ren
(
+
1
))
<
$
>
Γ
}
⊨
e1
≤
log
≤
e2
:
τ
.[
ren
(
+
1
)].
Proof
.
rewrite
bin_log_related_eq
/
bin_log_related_def
.
iIntros
"Hlog"
(
vvs
ρ
)
"#Hs #HΓ"
.
iSpecialize
(
"Hlog"
$
!
vvs
with
"Hs [HΓ]"
).
{
by
rewrite
interp_env_ren
.
}
unfold
interp_expr
.
iIntros
(
j
K
)
"Hj /="
.
iMod
(
"Hlog"
with
"Hj"
)
as
"Hlog"
.
iApply
(
wp_mono
with
"Hlog"
).
iIntros
(
v
).
simpl
.
iDestruct
1
as
(
v
'
)
"[Hj Hτ]"
.
iExists
v
'
.
iFrame
.
by
rewrite
-
interp_subst_2
.
Qed
.
Lemma
module_refinement
`
{
SPG
:
stackPreG
Σ
}
Δ
Γ
:
{
⊤
,
⊤
;
Δ
;
Γ
}
⊨
FG_stack
.
stackmod
≤
log
≤
CG_stack
.
stackmod
:
TForall
$
TExists
$
TProd
(
TProd
...
...
@@ -115,7 +72,7 @@ Section Mod_refinement.
{
unlock
CG_locked_pop
.
simpl_subst
/=
.
reflexivity
.
}
replace
(
TSum
TUnit
(
TVar
1
))
with
(
TSum
TUnit
(
TVar
0
)).[
ren
(
+
1
)]
by
done
.
iApply
bin_log_weaken_2
.
iApply
bin_log_
related_
weaken_2
.
pose
(
SG
:=
StackG
Σ
_
γ
).
change
γ
with
stack_name
.
iApply
(
FG_CG_pop_refinement
'
(
stackN
.
@
(
stk
,
stk
'
))).
...
...
theories/logrel/logrel_binary.v
View file @
940861cf
...
...
@@ -199,6 +199,24 @@ Section related_facts.
iMod
"HP"
.
iApply
(
"HI"
with
"HP"
).
Qed
.
Lemma
bin_log_related_weaken_2
τ
i
Δ
Γ
e1
e2
τ
:
{
⊤
,
⊤
;
Δ
;
Γ
}
⊨
e1
≤
log
≤
e2
:
τ
-
∗
{
⊤
,
⊤
;
τ
i
::
Δ
;
Autosubst_Classes
.
subst
(
ren
(
+
1
))
<
$
>
Γ
}
⊨
e1
≤
log
≤
e2
:
τ
.[
ren
(
+
1
)].
Proof
.
rewrite
bin_log_related_eq
/
bin_log_related_def
.
iIntros
"Hlog"
(
vvs
ρ
)
"#Hs #HΓ"
.
iSpecialize
(
"Hlog"
$
!
vvs
with
"Hs [HΓ]"
).
{
by
rewrite
interp_env_ren
.
}
unfold
interp_expr
.
iIntros
(
j
K
)
"Hj /="
.
iMod
(
"Hlog"
with
"Hj"
)
as
"Hlog"
.
iApply
(
wp_mono
with
"Hlog"
).
iIntros
(
v
).
simpl
.
iDestruct
1
as
(
v
'
)
"[Hj Hτ]"
.
iExists
v
'
.
iFrame
.
by
rewrite
-
interp_ren
.
Qed
.
End
related_facts
.
(
**
Monadic
-
like
operations
on
logrel
*
)
...
...
theories/logrel/semtypes.v
View file @
940861cf
...
...
@@ -218,6 +218,32 @@ Section semtypes.
apply
interp_subst
.
Qed
.
Lemma
interp_ren_up
Δ
1
Δ
2
E
τ
τ
i
:
interp
E
E
τ
(
Δ
1
++
Δ
2
)
≡
interp
E
E
(
τ
.[
upn
(
length
Δ
1
)
(
ren
(
+
1
))])
(
Δ
1
++
τ
i
::
Δ
2
).
Proof
.
revert
E
Δ
1
Δ
2.
induction
τ
=>
E
Δ
1
Δ
2
;
simpl
;
eauto
.
-
intros
vv
;
simpl
;
properness
;
eauto
.
by
apply
IH
τ
1.
by
apply
IH
τ
2.
-
intros
vv
;
simpl
;
properness
;
eauto
.
by
apply
IH
τ
1.
by
apply
IH
τ
2.
-
unfold
interp_expr
.
intros
vv
;
simpl
;
properness
;
eauto
.
by
apply
IH
τ
1.
by
apply
IH
τ
2.
-
apply
fixpoint_proper
=>
τ'
ww
/=
.
properness
;
auto
.
apply
(
IH
τ
_
(
_
::
_
)).
-
intros
vv
;
simpl
.
rewrite
iter_up
;
destruct
lt_dec
as
[
Hl
|
Hl
];
simpl
;
properness
.
{
by
rewrite
!
lookup_app_l
.
}
rewrite
!
lookup_app_r
;
[
|
lia
..].
assert
((
length
Δ
1
+
S
(
x
-
length
Δ
1
)
-
length
Δ
1
)
=
S
(
x
-
length
Δ
1
))
as
Hwat
.
{
lia
.
}
rewrite
Hwat
.
simpl
.
done
.
-
unfold
interp_expr
.
intros
vv
;
simpl
;
properness
;
auto
.
apply
(
IH
τ
_
(
_
::
_
)).
-
intros
vv
;
simpl
;
properness
;
auto
.
apply
(
IH
τ
_
(
_
::
_
)).
-
intros
vv
;
simpl
;
properness
;
auto
.
by
apply
IH
τ
.
Qed
.
Lemma
interp_ren
τ
τ
i
E
Δ
:
interp
E
E
τ
Δ
≡
interp
E
E
(
τ
.[
ren
(
+
1
)])
(
τ
i
::
Δ
).
Proof
.
by
apply
(
interp_ren_up
[]).
Qed
.
Lemma
interp_EqType_agree
τ
v
v
'
E1
E2
Δ
:
EqType
τ
→
interp
E1
E2
τ
Δ
(
v
,
v
'
)
⊢
⌜
v
=
v
'⌝
.
Proof
.
...
...
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