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
FP
Stacked Borrows Coq
Commits
38546fc3
Commit
38546fc3
authored
Sep 02, 2019
by
Hai Dang
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
complete retag public
parent
d51d5e9b
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
212 additions
and
26 deletions
+212
-26
theories/lang/steps_retag.v
theories/lang/steps_retag.v
+108
-0
theories/sim/cmra.v
theories/sim/cmra.v
+12
-0
theories/sim/invariant.v
theories/sim/invariant.v
+1
-1
theories/sim/refl.v
theories/sim/refl.v
+2
-2
theories/sim/refl_mem_step.v
theories/sim/refl_mem_step.v
+83
-20
theories/sim/simple.v
theories/sim/simple.v
+6
-3
No files found.
theories/lang/steps_retag.v
View file @
38546fc3
...
@@ -761,6 +761,27 @@ Proof.
...
@@ -761,6 +761,27 @@ Proof.
right
;
(
split
;
[
lia
|
done
]).
right
;
(
split
;
[
lia
|
done
]).
Qed
.
Qed
.
Lemma
retag_change_tag
α
cids
c
nxtp
l
otag
ntag
rk
pk
T
α'
nxtp
'
:
retag
α
nxtp
cids
c
l
otag
rk
pk
T
=
Some
(
ntag
,
α'
,
nxtp
'
)
→
ntag
=
otag
∨
match
ntag
with
|
Tagged
t
=>
t
=
nxtp
∧
nxtp
'
=
S
nxtp
|
_
=>
True
end
.
Proof
.
intros
RT
.
destruct
(
retag_change_case
_
_
_
_
_
_
_
_
_
_
_
_
RT
)
as
[[
?
[
?
[
??
]]]
|
[
?
Eq
]].
-
simplify_eq
;
by
left
.
-
destruct
pk
.
+
apply
retag_nxtp_change
in
RT
as
[];
[
|
done
..].
right
.
by
destruct
ntag
.
+
destruct
rk
.
*
left
.
by
destruct
Eq
as
[
_
[]];
subst
.
*
left
.
by
destruct
Eq
as
[
_
[]];
subst
.
*
apply
retag_nxtp_change
in
RT
as
[];
[
|
done
..].
right
.
by
destruct
ntag
.
*
left
.
by
destruct
Eq
as
[
_
[]];
subst
.
+
apply
retag_nxtp_change
in
RT
as
[];
[
|
done
..].
right
.
by
destruct
ntag
.
Qed
.
Lemma
retag_change_nxtp
α
cids
c
nxtp
l
otag
ntag
rk
pk
T
α'
nxtp
'
:
Lemma
retag_change_nxtp
α
cids
c
nxtp
l
otag
ntag
rk
pk
T
α'
nxtp
'
:
retag
α
nxtp
cids
c
l
otag
rk
pk
T
=
Some
(
ntag
,
α'
,
nxtp
'
)
→
retag
α
nxtp
cids
c
l
otag
rk
pk
T
=
Some
(
ntag
,
α'
,
nxtp
'
)
→
(
nxtp
≤
nxtp
'
)
%
nat
.
(
nxtp
≤
nxtp
'
)
%
nat
.
...
@@ -1546,3 +1567,90 @@ Proof.
...
@@ -1546,3 +1567,90 @@ Proof.
case
reborrow
as
[
α
1
|
];
[
|
done
].
simpl
.
intros
?
.
simplify_eq
.
case
reborrow
as
[
α
1
|
];
[
|
done
].
simpl
.
intros
?
.
simplify_eq
.
move
:
GR
.
eapply
grant_head_preserving
;
eauto
.
move
:
GR
.
eapply
grant_head_preserving
;
eauto
.
Qed
.
Qed
.
Lemma
grant_active_SRW
stk
old
it
cids
stk
'
it
'
(
SRW
:
it
.(
perm
)
=
SharedReadWrite
)
:
grant
stk
old
it
cids
=
Some
stk
'
→
it
'
∈
stk
→
it
'
∈
stk
'
.
Proof
.
rewrite
/
grant
.
case
find_granting
as
[[
n
p
]
|
];
[
|
done
].
rewrite
/=
SRW
.
case
find_first_write_incompatible
as
[
n
'
|
];
[
|
done
].
rewrite
/=
=>
?
.
simplify_eq
.
destruct
(
item_insert_dedup_case
stk
it
n
'
)
as
[
EQ
|
EQ
];
rewrite
EQ
;
[
|
done
].
rewrite
-{
1
}
(
take_drop
n
'
stk
).
set_solver
.
Qed
.
Lemma
grant_active_non_SRW
stk
old
it
cids
stk
'
t
pm
c
(
SRW
:
it
.(
perm
)
≠
SharedReadWrite
)
(
Inc
:
c
∈
cids
)
:
grant
stk
old
it
cids
=
Some
stk
'
→
let
it
'
:=
mkItem
pm
t
(
Some
c
)
in
it
'
∈
stk
→
it
'
∈
stk
'
.
Proof
.
rewrite
/
grant
.
case
find_granting
as
[[
n
p
]
|
]
eqn
:
FR
;
[
|
done
].
case
it
.(
perm
)
eqn
:
Eqp
;
[
|
done
|
..
|
];
cbn
-
[
item_insert_dedup
];
(
case
access1
as
[[
n
'
stk1
]
|
]
eqn
:
ACC
;
[
|
done
]);
cbn
-
[
item_insert_dedup
];
intros
?
;
simplify_eq
;
move
=>
/
(
access1_active_preserving
_
_
_
_
_
_
ACC
_
_
_
Inc
);
(
destruct
(
item_insert_dedup_case
stk1
it
O
)
as
[
EQ
|
EQ
];
rewrite
EQ
;
[
|
done
]);
rewrite
-{
1
}
(
take_drop
0
stk1
);
set_solver
.
Qed
.
Lemma
grant_active_preserving
stk
old
it
cids
stk
'
t
pm
c
(
Inc
:
c
∈
cids
)
:
grant
stk
old
it
cids
=
Some
stk
'
→
let
it
'
:=
mkItem
pm
t
(
Some
c
)
in
it
'
∈
stk
→
it
'
∈
stk
'
.
Proof
.
case
(
decide
(
it
.(
perm
)
=
SharedReadWrite
))
=>
?
.
-
by
apply
grant_active_SRW
.
-
by
eapply
grant_active_non_SRW
.
Qed
.
Lemma
retag_item_active_preserving
α
nxtp
c
cids
l
old
rk
pk
T
new
α'
nxtp
'
:
retag
α
nxtp
cids
c
l
old
rk
pk
T
=
Some
(
new
,
α'
,
nxtp
'
)
→
∀
l
'
stk
t
'
c
'
pm
,
α
!!
l
'
=
Some
stk
→
c
'
∈
cids
→
let
it
'
:=
mkItem
pm
t
'
(
Some
c
'
)
in
it
'
∈
stk
→
∃
stk
'
,
α'
!!
l
'
=
Some
stk
'
∧
it
'
∈
stk
'
.
Proof
.
intros
RT
l
'
stk
t
'
c
'
pm
Eqstk
Inc
'
it
'
IN
.
destruct
(
retag_Some
_
_
_
_
_
_
_
_
_
_
_
_
RT
)
as
[
NEQ
EQ
].
destruct
(
block_case
l
l
'
(
tsize
T
))
as
[
?|
(
i
&
Lti
&
?
)].
{
rewrite
NEQ
//. naive_solver. }
assert
(
∃
sz
,
tsize
T
=
S
sz
)
as
[
sz
Eqsz
].
{
destruct
(
tsize
T
);
[
lia
|
by
eexists
].
}
subst
l
'
.
move
:
RT
.
rewrite
/
retag
/=
/
retag_ref
Eqsz
.
destruct
pk
as
[[]
|
[]
|
].
-
specialize
(
EQ
_
Lti
)
as
(
stk1
&
stk2
&
Eq1
&
Eq2
&
GR
).
simplify_eq
.
case
reborrow
as
[
α
1
|
];
[
|
done
].
simpl
.
intros
?
.
simplify_eq
.
exists
stk2
.
split
;
[
done
|
].
move
:
Inc
'
GR
IN
.
by
apply
grant_active_preserving
.
-
specialize
(
EQ
_
Lti
)
as
(
stk1
&
stk2
&
Eq1
&
Eq2
&
b
&
GR
).
simplify_eq
.
case
reborrow
as
[
α
1
|
];
[
|
done
].
simpl
.
intros
?
.
simplify_eq
.
exists
stk2
.
split
;
[
done
|
].
move
:
Inc
'
GR
IN
.
by
apply
grant_active_preserving
.
-
destruct
rk
;
[
by
intros
;
simplify_eq
;
naive_solver
..
|
|
intros
;
simplify_eq
;
naive_solver
].
specialize
(
EQ
_
Lti
)
as
(
stk1
&
stk2
&
Eq1
&
Eq2
&
GR
).
simplify_eq
.
case
reborrow
as
[
α
1
|
];
[
|
done
].
simpl
.
intros
?
.
simplify_eq
.
exists
stk2
.
split
;
[
done
|
].
move
:
Inc
'
GR
IN
.
by
apply
grant_active_preserving
.
-
destruct
rk
;
[
by
intros
;
simplify_eq
;
naive_solver
..
|
|
intros
;
simplify_eq
;
naive_solver
].
specialize
(
EQ
_
Lti
)
as
(
stk1
&
stk2
&
Eq1
&
Eq2
&
b
&
GR
).
simplify_eq
.
case
reborrow
as
[
α
1
|
];
[
|
done
].
simpl
.
intros
?
.
simplify_eq
.
exists
stk2
.
split
;
[
done
|
].
move
:
Inc
'
GR
IN
.
by
apply
grant_active_preserving
.
-
specialize
(
EQ
_
Lti
)
as
(
stk1
&
stk2
&
Eq1
&
Eq2
&
GR
).
simplify_eq
.
case
reborrow
as
[
α
1
|
];
[
|
done
].
simpl
.
intros
?
.
simplify_eq
.
exists
stk2
.
split
;
[
done
|
].
move
:
Inc
'
GR
IN
.
by
apply
grant_active_preserving
.
Qed
.
theories/sim/cmra.v
View file @
38546fc3
...
@@ -293,6 +293,18 @@ Proof.
...
@@ -293,6 +293,18 @@ Proof.
by
apply
cmra_included_r
.
by
apply
cmra_included_r
.
Qed
.
Qed
.
Lemma
tmap_lookup_op_l_equiv_pub
(
pm1
pm2
:
tmapUR
)
t
h1
(
VALID
:
✓
(
pm1
⋅
pm2
))
:
pm1
!!
t
≡
Some
(
to_tgkR
tkPub
,
h1
)
→
∃
h2
,
(
pm1
⋅
pm2
)
!!
t
≡
Some
(
to_tgkR
tkPub
,
h1
⋅
h2
).
Proof
.
intros
HL
.
move
:
(
VALID
t
).
rewrite
lookup_op
.
destruct
(
pm2
!!
t
)
as
[[
k2
h2
]
|
]
eqn
:
Eqt
;
rewrite
Eqt
;
rewrite
->
HL
.
-
rewrite
-
Some_op
pair_op
.
move
=>
[
VL1
?
].
exists
h2
.
simpl
in
VL1
.
rewrite
HL
-
Some_op
pair_op
.
by
rewrite
-
(
tagKindR_incl_eq
(
to_tgkR
tkPub
)
_
VL1
(
cmra_included_r
_
_
)).
-
intros
_.
exists
(
∅
:
gmap
loc
_
).
by
rewrite
2
!
right_id
HL
.
Qed
.
Lemma
tmap_lookup_op_r_equiv_pub
(
pm1
pm2
:
tmapUR
)
t
h2
Lemma
tmap_lookup_op_r_equiv_pub
(
pm1
pm2
:
tmapUR
)
t
h2
(
VALID
:
✓
(
pm1
⋅
pm2
))
:
(
VALID
:
✓
(
pm1
⋅
pm2
))
:
...
...
theories/sim/invariant.v
View file @
38546fc3
...
@@ -57,7 +57,7 @@ Definition tmap_inv (r: resUR) (σs σt: state) : Prop :=
...
@@ -57,7 +57,7 @@ Definition tmap_inv (r: resUR) (σs σt: state) : Prop :=
(
*
If
[
k
]
ls
Local
,
then
the
stack
is
a
singleton
.
(
*
If
[
k
]
ls
Local
,
then
the
stack
is
a
singleton
.
If
[
k
]
is
Unique
,
then
[
t
]
must
be
Unique
at
the
top
of
[
stk
].
If
[
k
]
is
Unique
,
then
[
t
]
must
be
Unique
at
the
top
of
[
stk
].
Otherwise
if
[
k
]
is
Pub
,
then
[
t
]
can
be
among
the
top
SRO
items
.
*
)
Otherwise
if
[
k
]
is
Pub
,
then
[
t
]
can
be
among
the
top
SRO
items
.
*
)
tmap_inv_post
k
t
l
σ
t
.
tmap_inv_post
k
t
l
σ
t
.
Definition
cmap_inv
(
r
:
resUR
)
(
σ
:
state
)
:
Prop
:=
Definition
cmap_inv
(
r
:
resUR
)
(
σ
:
state
)
:
Prop
:=
∀
(
c
:
call_id
)
(
T
:
tag_locs
),
r
.(
rcm
)
!!
c
≡
Excl
'
T
→
∀
(
c
:
call_id
)
(
T
:
tag_locs
),
r
.(
rcm
)
!!
c
≡
Excl
'
T
→
...
...
theories/sim/refl.v
View file @
38546fc3
...
@@ -297,8 +297,8 @@ Proof using Type*.
...
@@ -297,8 +297,8 @@ Proof using Type*.
sim_bind
(
subst_map
_
e
)
(
subst_map
_
e
).
sim_bind
(
subst_map
_
e
)
(
subst_map
_
e
).
eapply
sim_simple_post_mono
,
IHe
;
[
|
by
auto
..].
eapply
sim_simple_post_mono
,
IHe
;
[
|
by
auto
..].
intros
r
'
n
'
rs
rt
(
->
&
Hrel
).
simpl
.
intros
r
'
n
'
rs
rt
(
->
&
Hrel
).
simpl
.
eapply
sim_simple_
retag_public
;
eauto
.
eapply
sim_simple_
valid_post
.
split
;
first
done
.
constructor
;
done
.
by
eapply
sim_simple_retag_public
;
eauto
.
-
(
*
Let
*
)
-
(
*
Let
*
)
move
=>
[
Hwf1
Hwf2
]
xs
Hxs
/=
.
sim_bind
(
subst_map
_
e1
)
(
subst_map
_
e1
).
move
=>
[
Hwf1
Hwf2
]
xs
Hxs
/=
.
sim_bind
(
subst_map
_
e1
)
(
subst_map
_
e1
).
eapply
sim_simple_frame_core
.
eapply
sim_simple_frame_core
.
...
...
theories/sim/refl_mem_step.v
View file @
38546fc3
...
@@ -1206,13 +1206,14 @@ Qed.
...
@@ -1206,13 +1206,14 @@ Qed.
(
**
Retag
*
)
(
**
Retag
*
)
Lemma
sim_body_retag_public
fs
ft
r
n
ptr
pk
T
kind
σ
s
σ
t
Φ
Lemma
sim_body_retag_public
fs
ft
r
n
ptr
pk
T
kind
σ
s
σ
t
Φ
(
RREL
:
rrel
r
ptr
ptr
)
:
(
RREL
:
rrel
r
ptr
ptr
)
:
(
∀
l
otg
ntg
α'
nxtp
'
c
cids
,
(
∀
l
otg
ntg
α'
nxtp
'
c
cids
r
'
,
ptr
=
ValR
[
ScPtr
l
otg
]
→
ptr
=
ValR
[
ScPtr
l
otg
]
→
σ
t
.(
scs
)
=
c
::
cids
→
σ
t
.(
scs
)
=
c
::
cids
→
retag
σ
t
.(
sst
)
σ
t
.(
snp
)
σ
t
.(
scs
)
c
l
otg
kind
pk
T
=
Some
(
ntg
,
α'
,
nxtp
'
)
→
retag
σ
t
.(
sst
)
σ
t
.(
snp
)
σ
t
.(
scs
)
c
l
otg
kind
pk
T
=
Some
(
ntg
,
α'
,
nxtp
'
)
→
vrel
(
r
⋅
r
'
)
[
ScPtr
l
ntg
]
[
ScPtr
l
ntg
]
→
let
σ
s
'
:=
mkState
σ
s
.(
shp
)
α'
σ
s
.(
scs
)
nxtp
'
σ
s
.(
snc
)
in
let
σ
s
'
:=
mkState
σ
s
.(
shp
)
α'
σ
s
.(
scs
)
nxtp
'
σ
s
.(
snc
)
in
let
σ
t
'
:=
mkState
σ
t
.(
shp
)
α'
σ
t
.(
scs
)
nxtp
'
σ
t
.(
snc
)
in
let
σ
t
'
:=
mkState
σ
t
.(
shp
)
α'
σ
t
.(
scs
)
nxtp
'
σ
t
.(
snc
)
in
Φ
r
n
(
ValR
[
ScPtr
l
ntg
])
σ
s
'
(
ValR
[
ScPtr
l
ntg
])
σ
t
'
)
→
Φ
(
r
⋅
r
'
)
n
(
ValR
[
ScPtr
l
ntg
])
σ
s
'
(
ValR
[
ScPtr
l
ntg
])
σ
t
'
)
→
r
⊨
{
n
,
fs
,
ft
}
r
⊨
{
n
,
fs
,
ft
}
(
Retag
ptr
pk
T
kind
,
σ
s
)
≥
(
Retag
ptr
pk
T
kind
,
σ
s
)
≥
(
Retag
ptr
pk
T
kind
,
σ
t
)
:
Φ
.
(
Retag
ptr
pk
T
kind
,
σ
t
)
:
Φ
.
...
@@ -1250,20 +1251,65 @@ Proof.
...
@@ -1250,20 +1251,65 @@ Proof.
-
rewrite
Eqcs
;
eauto
.
-
rewrite
Eqcs
;
eauto
.
-
by
rewrite
Eqsst
Eqnp
Eqcs
.
}
-
by
rewrite
Eqsst
Eqnp
Eqcs
.
}
exists
(#[
ScPtr
l
ntg
])
%
V
,
σ
s
'
,
r
,
n
.
subst
σ
t
'
.
have
HNP
:=
wsat_tmap_nxtp
_
_
_
WSAT1
.
have
Eqtg
:=
retag_change_tag
_
_
_
_
_
_
_
_
_
_
_
_
EqRT
.
set
r
'
:
resUR
:=
if
(
decide
(
ntg
=
otg
))
then
ε
else
match
ntg
with
|
Tagged
t
=>
res_tag
t
tkPub
∅
|
_
=>
ε
end
.
have
VALID
'
:
✓
(
r_f
⋅
r
⋅
r
'
).
{
rewrite
/
r
'
.
case
decide
=>
?
;
[
by
rewrite
right_id
|
].
destruct
Eqtg
as
[
|
Eqtg
];
[
by
subst
|
].
destruct
ntg
;
[
destruct
Eqtg
;
subst
t
|
by
rewrite
right_id
].
apply
(
local_update_discrete_valid_frame
(
r_f
⋅
r
)
ε
);
[
by
rewrite
right_id
|
].
rewrite
right_id
.
by
apply
res_tag_alloc_local_update
.
}
have
Eqc
'
:
(
r_f
⋅
r
⋅
r
'
).(
rcm
)
≡
(
r_f
⋅
r
).(
rcm
).
{
rewrite
/
r
'
.
case
decide
=>
?
;
[
by
rewrite
right_id
|
].
destruct
ntg
;
by
rewrite
/=
right_id
.
}
have
HLt
:
∀
t
kh
,
(
r_f
⋅
r
).(
rtm
)
!!
t
≡
Some
kh
→
(
r_f
⋅
r
⋅
r
'
).(
rtm
)
!!
t
≡
Some
kh
.
{
intros
t
kh
Eqt
.
rewrite
/
r
'
.
case
decide
=>
?
;
[
by
rewrite
right_id
|
].
destruct
Eqtg
as
[
|
Eqtg
];
[
by
subst
|
].
destruct
ntg
as
[
t1
|
];
[
destruct
Eqtg
;
subst
t1
nxtp
'
|
by
rewrite
right_id
].
rewrite
lookup_op
res_tag_lookup_ne
.
-
by
rewrite
right_id
.
-
intros
?
.
subst
t
.
rewrite
HNP
in
Eqt
.
inversion
Eqt
.
}
(
*
unfolding
rrel
for
place
*
)
simpl
in
RREL
.
inversion
RREL
as
[
|????
AREL
_
];
subst
;
simplify_eq
.
clear
RREL
.
exists
(#[
ScPtr
l
ntg
])
%
V
,
σ
s
'
,
(
r
⋅
r
'
),
n
.
split
;
last
split
.
split
;
last
split
.
{
left
.
by
constructor
.
}
{
left
.
by
constructor
.
}
{
(
*
unfolding
rrel
for
place
*
)
{
have
Lenp
:
(
σ
t
.(
snp
)
≤
nxtp
'
)
%
nat
by
apply
retag_change_nxtp
in
EqRT
.
simpl
in
RREL
.
inversion
RREL
as
[
|????
AREL
_
];
subst
;
simplify_eq
.
clear
RREL
.
have
Lenp
:
(
σ
t
.(
snp
)
≤
nxtp
'
)
%
nat
by
apply
retag_change_nxtp
in
EqRT
.
split
;
last
split
;
last
split
;
last
split
;
last
split
.
split
;
last
split
;
last
split
;
last
split
;
last
split
.
-
by
apply
(
tstep_wf
_
_
_
STEPS
WFS
).
-
by
apply
(
tstep_wf
_
_
_
STEPS
WFS
).
-
by
apply
(
tstep_wf
_
_
_
STEPT
WFT
).
-
by
apply
(
tstep_wf
_
_
_
STEPT
WFT
).
-
done
.
-
by
rewrite
cmra_assoc
.
-
intros
t
'
k
'
h
'
Eqt
'
.
-
intros
t
'
k
'
h
'
Eqt
'
.
specialize
(
PINV
_
_
_
Eqt
'
)
as
[
Ltp
PINV
].
have
Eqh
'
:
(
r_f
⋅
r
).(
rtm
)
!!
t
'
≡
Some
(
to_tgkR
k
'
,
h
'
)
∨
t
'
=
σ
t
.(
snp
)
∧
nxtp
'
=
S
σ
t
.(
snp
)
∧
h
'
≡
∅
.
{
move
:
Eqt
'
.
rewrite
/
r
'
.
case
decide
=>
?
;
[
by
rewrite
right_id
;
left
|
].
destruct
Eqtg
as
[
|
Eqtg
];
[
by
subst
|
].
destruct
ntg
as
[
t1
|
];
[
destruct
Eqtg
;
subst
t1
nxtp
'
|
by
rewrite
right_id
;
left
].
rewrite
cmra_assoc
lookup_op
.
case
(
decide
(
t
'
=
σ
t
.(
snp
)))
=>
?
;
[
subst
t
'
|
].
-
rewrite
res_tag_lookup
.
rewrite
HNP
left_id
fmap_empty
.
intros
[
Eq1
Eq2
]
%
Some_equiv_inj
.
by
right
.
-
rewrite
res_tag_lookup_ne
// right_id. by left. }
destruct
Eqh
'
as
[
Eqt
|
(
?&?&
Eqh
'
)];
last
first
.
{
subst
t
'
nxtp
'
.
split
;
[
simpl
;
lia
|
].
intros
l
'
ss
st
.
rewrite
Eqh
'
lookup_empty
.
by
inversion
1.
}
specialize
(
PINV
_
_
_
Eqt
)
as
[
Ltp
PINV
].
split
;
[
by
simpl
;
lia
|
].
split
;
[
by
simpl
;
lia
|
].
intros
l1
ss
st
Eql1
PRE
.
specialize
(
PINV
_
_
_
Eql1
).
intros
l1
ss
st
Eql1
PRE
.
specialize
(
PINV
_
_
_
Eql1
).
destruct
k
'
.
destruct
k
'
.
...
@@ -1272,7 +1318,7 @@ Proof.
...
@@ -1272,7 +1318,7 @@ Proof.
have
NEq
:
otg
≠
Tagged
t
'
.
have
NEq
:
otg
≠
Tagged
t
'
.
{
intros
?
.
subst
otg
.
simpl
in
AREL
.
{
intros
?
.
subst
otg
.
simpl
in
AREL
.
destruct
AREL
as
(
_
&
_
&
ht
&
Eqh
'
).
destruct
AREL
as
(
_
&
_
&
ht
&
Eqh
'
).
move
:
Eqt
'
.
rewrite
lookup_op
Eqh
'
.
move
:
Eqt
.
rewrite
lookup_op
Eqh
'
.
apply
tagKindR_local_exclusive_r
.
}
apply
tagKindR_local_exclusive_r
.
}
move
:
NEq
Eqstk
.
move
:
NEq
Eqstk
.
by
eapply
retag_Some_local
.
by
eapply
retag_Some_local
.
...
@@ -1293,7 +1339,7 @@ Proof.
...
@@ -1293,7 +1339,7 @@ Proof.
have
NEq
:
Tagged
t
'
≠
otg
.
have
NEq
:
Tagged
t
'
≠
otg
.
{
intros
?
.
subst
otg
.
simpl
in
AREL
.
{
intros
?
.
subst
otg
.
simpl
in
AREL
.
destruct
AREL
as
(
_
&
_
&
ht
&
Eqh
'
).
destruct
AREL
as
(
_
&
_
&
ht
&
Eqh
'
).
move
:
Eqt
'
.
rewrite
lookup_op
Eqh
'
.
move
:
Eqt
.
rewrite
lookup_op
Eqh
'
.
apply
tagKindR_uniq_exclusive_r
.
}
apply
tagKindR_uniq_exclusive_r
.
}
move
:
HTOP
.
move
:
HTOP
.
by
apply
(
retag_item_head_preserving
_
_
_
_
_
_
_
_
_
_
_
_
EqRT
by
apply
(
retag_item_head_preserving
_
_
_
_
_
_
_
_
_
_
_
_
EqRT
...
@@ -1310,21 +1356,38 @@ Proof.
...
@@ -1310,21 +1356,38 @@ Proof.
have
ND2
:=
proj2
(
state_wf_stack_item
_
WFT
_
_
Eqstk1
).
have
ND2
:=
proj2
(
state_wf_stack_item
_
WFT
_
_
Eqstk1
).
by
apply
(
retag_item_active_SRO_preserving
_
_
_
_
_
_
_
_
_
_
_
_
EqRT
by
apply
(
retag_item_active_SRO_preserving
_
_
_
_
_
_
_
_
_
_
_
_
EqRT
_
_
_
_
_
ND2
Eqstk1
Eqstk
'
In
In
'
).
_
_
_
_
_
ND2
Eqstk1
Eqstk
'
In
In
'
).
-
intros
c1
Tc
Eqc
.
specialize
(
CINV
_
_
Eqc
)
as
[
Ltc
CINV
].
-
intros
c1
Tc
.
rewrite
cmra_assoc
Eqc
'
.
intros
Eqc
.
specialize
(
CINV
_
_
Eqc
)
as
[
Ltc
CINV
].
split
;
[
done
|
].
split
;
[
done
|
].
intros
tc
L
EqL
.
specialize
(
CINV
_
_
EqL
)
as
[
Ltp
CINV
].
intros
tc
L
EqL
.
specialize
(
CINV
_
_
EqL
)
as
[
Ltp
CINV
].
split
;
[
by
simpl
;
lia
|
].
split
;
[
by
simpl
;
lia
|
].
intros
l1
InL
.
simpl
.
intros
l1
InL
.
simpl
.
specialize
(
CINV
_
InL
)
as
(
stk
&
pm
&
Eqstk
&
In
&
NDIS
).
specialize
(
CINV
_
InL
)
as
(
stk
&
pm
&
Eqstk
&
In
&
NDIS
).
(
*
Prove
that
this
is
active
(
protector
)
preserving
*
)
destruct
(
retag_item_active_preserving
_
_
_
_
_
_
_
_
_
_
_
_
EqRT
(
*
destruct
(
retag_item_in
_
_
_
_
_
_
_
_
_
_
_
_
EqRT
_
_
t
'
_
Eqstk
'
In
'
)
_
_
_
_
_
Eqstk
Ltc
In
)
as
(
stk
'
&
Eqstk
'
&
In
'
).
as
(
stk
&
Eqstk
&
In
);
[
done
..
|
].
*
)
by
exists
stk
'
,
pm
.
admit
.
-
rewrite
cmra_assoc
.
do
4
(
split
;
[
done
|
]).
-
done
.
}
move
=>
l
'
/
PUBP
[
PB
|
PV
].
+
left
.
move
=>
?
/
PB
[
?
[
?
AREL
'
]].
eexists
.
split
;
[
done
|
].
eapply
arel_mono
;
[
done
|
..
|
exact
AREL
'
].
apply
cmra_included_l
.
+
right
.
destruct
PV
as
(
t
&
k1
&
h1
&
Eqt
&
?
).
exists
t
,
k1
,
h1
.
setoid_rewrite
Eqc
'
.
split
;
[
|
done
].
by
apply
HLt
.
}
left
.
left
.
apply:
sim_body_result
.
intros
.
eapply
POST
;
eauto
.
apply:
sim_body_result
.
intros
VALIDr
.
eapply
POST
;
eauto
.
Abort
.
constructor
;
[
|
done
].
do
2
(
split
;
[
done
|
]).
destruct
ntg
;
[
|
done
].
destruct
AREL
as
(
_
&
_
&
AREL
).
rewrite
/
r
'
.
case
decide
=>
?
;
[
subst
otg
|
].
-
destruct
AREL
as
[
h1
?
].
exists
h1
.
by
rewrite
right_id
.
-
destruct
Eqtg
as
[
|
[]];
[
by
subst
otg
|
subst
t
].
destruct
(
tmap_lookup_op_r_equiv_pub
r
.(
rtm
)
(
res_tag
σ
t
.(
snp
)
tkPub
∅
).(
rtm
)
σ
t
.(
snp
)
(
to_agree
<
$
>
∅
)).
+
move
:
VALIDr
.
rewrite
/
r
'
decide_False
// => VALIDr. apply VALIDr.
+
apply
res_tag_lookup
.
+
by
eexists
.
Qed
.
Lemma
sim_body_retag_mut_ref_default
fs
ft
r
r
'
rs
n
l
told
T
σ
s
σ
t
Φ
:
Lemma
sim_body_retag_mut_ref_default
fs
ft
r
r
'
rs
n
l
told
T
σ
s
σ
t
Φ
:
(
0
<
tsize
T
)
%
nat
→
(
0
<
tsize
T
)
%
nat
→
...
...
theories/sim/simple.v
View file @
38546fc3
...
@@ -385,11 +385,14 @@ Qed.
...
@@ -385,11 +385,14 @@ Qed.
Lemma
sim_simple_retag_public
fs
ft
r
n
(
rs
rt
:
result
)
pk
T
rk
Φ
:
Lemma
sim_simple_retag_public
fs
ft
r
n
(
rs
rt
:
result
)
pk
T
rk
Φ
:
rrel
r
rs
rt
→
rrel
r
rs
rt
→
(
Φ
r
n
(
ValR
[
☠
%
S
])
(
ValR
[
☠
%
S
]))
→
(
∀
l
old
new
rt
,
rs
=
ValR
[
ScPtr
l
old
]
→
vrel
(
r
⋅
rt
)
[
ScPtr
l
new
]
[
ScPtr
l
new
]
→
Φ
(
r
⋅
rt
)
n
(
ValR
[
ScPtr
l
new
])
(
ValR
[
ScPtr
l
new
]))
→
r
⊨ˢ
{
n
,
fs
,
ft
}
Retag
rs
pk
T
rk
≥
Retag
rt
pk
T
rk
:
Φ
.
r
⊨ˢ
{
n
,
fs
,
ft
}
Retag
rs
pk
T
rk
≥
Retag
rt
pk
T
rk
:
Φ
.
Proof
.
Proof
.
intros
[
Hrel
?
]
%
rrel_with_eq
.
simplify_eq
.
intros
[
Hrel
?
]
%
rrel_with_eq
HH
σ
s
σ
t
.
simplify_eq
.
Admitted
.
eapply
sim_body_retag_public
;
eauto
.
Qed
.
(
**
*
Pure
*
)
(
**
*
Pure
*
)
Lemma
sim_simple_let
fs
ft
r
n
x
(
vs1
vt1
:
result
)
es1
et1
es2
et2
Φ
:
Lemma
sim_simple_let
fs
ft
r
n
x
(
vs1
vt1
:
result
)
es1
et1
es2
et2
Φ
:
...
...
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