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
FP
Stacked Borrows Coq
Commits
28168cc9
Commit
28168cc9
authored
Jul 07, 2019
by
Hai Dang
Browse files
functions take and return results; breaking simple.v and refl.v
parent
92a15853
Changes
10
Hide whitespace changes
Inline
Side-by-side
theories/lang/lang.v
View file @
28168cc9
...
...
@@ -59,6 +59,13 @@ Proof. by intros ?? Hv; apply (inj Some); rewrite -2!to_of_result Hv /=. Qed.
Lemma
is_closed_to_result
X
e
v
:
to_result
e
=
Some
v
→
is_closed
X
e
.
Proof
.
intros
<-%
of_to_result
.
apply
is_closed_of_result
.
Qed
.
Lemma
list_Forall_to_of_result
vl
:
Forall
(
λ
ei
,
is_Some
(
to_result
ei
))
(
of_result
<
$
>
vl
).
Proof
.
apply
Forall_forall
.
move
=>
e
/
elem_of_list_fmap
[
?
[
->
?
]].
rewrite
to_of_result
.
by
eexists
.
Qed
.
(
*
Lemma
subst_is_closed
X
x
es
e
:
is_closed
X
es
→
is_closed
(
x
::
X
)
e
→
is_closed
X
(
subst
x
es
e
).
Proof
.
...
...
theories/lang/steps_inversion.v
View file @
28168cc9
...
...
@@ -427,6 +427,30 @@ Proof.
+
by
rewrite
/=
HS
in
Eqv
.
Qed
.
Lemma
tstep_call_inv_result
(
fid
:
fn_id
)
el
e
'
σ
σ'
(
TERM
:
Forall
(
λ
ei
,
is_Some
(
to_result
ei
))
el
)
(
STEP
:
(
Call
#[
fid
]
el
,
σ
)
~{
fns
}~>
(
e
'
,
σ'
))
:
∃
xl
e
HC
es
,
fns
!!
fid
=
Some
(
@
FunV
xl
e
HC
)
∧
subst_l
xl
el
e
=
Some
es
∧
e
'
=
(
EndCall
(
InitCall
es
))
∧
σ'
=
σ
∧
Forall
(
λ
ei
,
is_Some
(
to_value
ei
))
el
.
Proof
.
inv_tstep
.
symmetry
in
Eq
.
destruct
(
fill_call_decompose
_
_
_
_
Eq
)
as
[[]
|
[[
K
'
[
?
Eq
'
]]
|
[
K
'
[
v1
[
vl
[
e2
[
el2
[
?
Eq
'
]]]]]]]];
subst
.
-
simpl
in
*
.
inv_head_step
.
naive_solver
.
-
exfalso
.
simpl
in
*
.
apply
result_head_stuck
in
HS
.
destruct
(
fill_val
(
Λ
:=
bor_ectx_lang
fns
)
K
'
e1
'
)
as
[
?
Eqv
].
+
rewrite
/=
Eq
'
.
by
eexists
.
+
by
rewrite
/=
HS
in
Eqv
.
-
exfalso
.
simpl
in
*
.
destruct
Eq
'
as
[
Eq1
Eq2
].
apply
result_head_stuck
in
HS
.
destruct
(
fill_val
(
Λ
:=
bor_ectx_lang
fns
)
K
'
e1
'
)
as
[
?
Eqv
].
+
rewrite
/=
Eq1
.
apply
(
Forall_forall
(
λ
ei
,
is_Some
(
to_result
ei
))
el
);
[
exact
TERM
|
].
rewrite
Eq2
.
set_solver
.
+
by
rewrite
/=
HS
in
Eqv
.
Qed
.
(
**
MEM
STEP
-----------------------------------------------------------------*
)
(
**
Alloc
*
)
...
...
theories/sim/instance.v
View file @
28168cc9
...
...
@@ -2,7 +2,7 @@ From stbor.lang Require Import steps_inversion.
From
stbor
.
sim
Require
Export
local
invariant
.
Notation
"r ⊨{ n , fs , ft } ( es , σs ) ≥ ( et , σt ) : Φ"
:=
(
sim_local_body
wsat
v
rel
fs
ft
r
n
%
nat
es
%
E
σ
s
et
%
E
σ
t
Φ
)
(
sim_local_body
wsat
r
rel
fs
ft
r
n
%
nat
es
%
E
σ
s
et
%
E
σ
t
Φ
)
(
at
level
70
,
format
"'[hv' r '/' ⊨{ n , fs , ft } '/ ' '[ ' ( es , '/' σs ) ']' '/' ≥ '/ ' '[ ' ( et , '/' σt ) ']' '/' : Φ ']'"
).
...
...
@@ -13,7 +13,8 @@ fn table, allow giving a lower bound. But this is good enough for now.
This
could
be
done
in
general
,
but
we
just
do
it
for
the
instance
.
*
)
Definition
sim_mod_fun
f1
f2
:=
∀
fs
ft
,
sim_local_funs_lookup
fs
ft
→
sim_local_fun
wsat
vrel
fs
ft
end_call_sat
f1
f2
.
∀
fs
ft
,
sim_local_funs_lookup
fs
ft
→
sim_local_fun
wsat
rrel
fs
ft
end_call_sat
f1
f2
.
Definition
sim_mod_funs
(
fns
fnt
:
fn_env
)
:=
∀
name
fn_src
,
fns
!!
name
=
Some
fn_src
→
∃
fn_tgt
,
...
...
@@ -66,7 +67,7 @@ Qed.
assumption
.
*
)
Lemma
sim_mod_funs_local
fs
ft
:
sim_mod_funs
fs
ft
→
sim_local_funs
wsat
v
rel
fs
ft
end_call_sat
.
sim_local_funs
wsat
r
rel
fs
ft
end_call_sat
.
Proof
.
intros
Hmod
.
intros
f
fn_src
Hlk
.
destruct
(
Hmod
_
_
Hlk
)
as
(
fn_tgt
&
?
&
?
&
?
).
exists
fn_tgt
.
...
...
theories/sim/invariant.v
View file @
28168cc9
...
...
@@ -100,8 +100,15 @@ Definition wsat (r: resUR) (σs σt: state) : Prop :=
(
**
Value
relation
for
function
arguments
/
return
values
*
)
(
*
Values
passed
among
functions
are
public
*
)
Definition
vrel
(
r
:
resUR
)
(
v1
v2
:
value
)
:=
Forall2
(
arel
r
)
v1
v2
.
Definition
vrel_res
(
r
:
resUR
)
(
e1
e2
:
result
)
:=
∃
v1
v2
,
e1
=
ValR
v1
∧
e2
=
ValR
v2
∧
vrel
r
v1
v2
.
Definition
rrel
(
r
:
resUR
)
rs
rt
:
Prop
:=
match
rs
,
rt
with
|
ValR
vs
,
ValR
vt
=>
vrel
r
vs
vt
|
PlaceR
ls
ts
Ts
,
PlaceR
lt
t_t
Tt
=>
(
*
Places
are
related
like
pointers
,
and
the
types
must
be
equal
.
*
)
vrel
r
[
ScPtr
ls
ts
]
[
ScPtr
lt
t_t
]
∧
Ts
=
Tt
|
_
,
_
=>
False
end
.
(
**
Condition
for
resource
before
EndCall
*
)
...
...
@@ -141,16 +148,14 @@ Proof.
f_equal
.
by
apply
(
arel_eq
_
_
_
Eq1
).
by
apply
IH
.
Qed
.
Lemma
vrel_
re
s
_eq
r
(
e1
e2
:
result
)
:
vrel_
re
s
r
e1
e2
→
e1
=
e2
.
Lemma
r
re
l
_eq
r
(
e1
e2
:
result
)
:
r
re
l
r
e1
e2
→
e1
=
e2
.
Proof
.
intros
(
v1
&
v2
&
Eq1
&
Eq2
&
VREL
).
subst
.
f_equal
.
by
eapply
vrel_eq
.
destruct
e1
,
e2
;
simpl
;
[
|
done
..
|
].
-
intros
?
.
f_equal
.
by
eapply
vrel_eq
.
-
intros
[
VREL
?
].
subst
.
apply
vrel_eq
in
VREL
.
by
simplify_eq
.
Qed
.
Lemma
vrel_res_vrel
r
(
v1
v2
:
value
)
:
vrel_res
r
#
v1
#
v2
→
vrel
r
v1
v2
.
Proof
.
intros
(
?
&
?
&
Eq1
&
Eq2
&
?
).
by
simplify_eq
.
Qed
.
Lemma
arel_mono
(
r1
r2
:
resUR
)
(
VAL
:
✓
r2
)
:
r1
≼
r2
→
∀
s1
s2
,
arel
r1
s1
s2
→
arel
r2
s1
s2
.
Proof
.
...
...
@@ -179,10 +184,12 @@ Lemma vrel_mono (r1 r2 : resUR) (VAL: ✓ r2) :
r1
≼
r2
→
∀
v1
v2
,
vrel
r1
v1
v2
→
vrel
r2
v1
v2
.
Proof
.
intros
Le
v1
v2
VREL
.
by
apply
(
Forall2_impl
_
_
_
_
VREL
),
arel_mono
.
Qed
.
Lemma
vrel_
re
s
_mono
(
r1
r2
:
resUR
)
(
VAL
:
✓
r2
)
:
r1
≼
r2
→
∀
v1
v2
,
vrel_
re
s
r1
v1
v2
→
vrel_
re
s
r2
v1
v2
.
Lemma
r
re
l
_mono
(
r1
r2
:
resUR
)
(
VAL
:
✓
r2
)
:
r1
≼
r2
→
∀
v1
v2
,
r
re
l
r1
v1
v2
→
r
re
l
r2
v1
v2
.
Proof
.
move
=>
Le
v1
v2
[
?
[
?
[
?
[
?
/
(
vrel_mono
_
_
VAL
Le
)
?
]]]].
do
2
eexists
.
eauto
.
intros
Le
v1
v2
.
destruct
v1
,
v2
;
simpl
;
[
|
done
..
|
].
-
by
apply
vrel_mono
.
-
intros
[
VREL
?
].
split
;
[
|
done
].
move
:
VREL
.
by
apply
vrel_mono
.
Qed
.
Lemma
priv_loc_mono
(
r1
r2
:
resUR
)
(
VAL
:
✓
r2
)
:
...
...
theories/sim/local.v
View file @
28168cc9
...
...
@@ -9,7 +9,7 @@ Set Default Proof Using "Type".
Section
local
.
Context
{
A
:
ucmraT
}
.
Variable
(
wsat
:
A
→
state
→
state
→
Prop
).
Variable
(
v
rel
:
A
→
value
→
value
→
Prop
).
Variable
(
r
rel
:
A
→
result
→
result
→
Prop
).
Variable
(
fs
ft
:
fn_env
).
Notation
PRED
:=
(
A
→
nat
→
result
→
state
→
result
→
state
→
Prop
)
%
type
.
...
...
@@ -33,27 +33,27 @@ Inductive _sim_local_body_step (r_f : A) (sim_local_body : SIM)
|
sim_local_body_step_over_call
(
Ks
:
list
(
ectxi_language
.
ectx_item
(
bor_ectxi_lang
fs
)))
(
Kt
:
list
(
ectxi_language
.
ectx_item
(
bor_ectxi_lang
ft
)))
fid
(
vl_tgt
:
list
value
)
(
vl_src
:
list
value
)
σ
1_
src
fid
(
vl_tgt
:
list
result
)
(
vl_src
:
list
result
)
σ
1_
src
rc
rv
(
*
tgt
is
ready
to
make
a
call
of
[
name
]
*
)
(
CALLTGT
:
et
=
fill
Kt
(
Call
#[
ScFnPtr
fid
]
(
Val
<
$
>
vl_tgt
)))
(
CALLTGT
:
et
=
fill
Kt
(
Call
#[
ScFnPtr
fid
]
(
of_result
<
$
>
vl_tgt
)))
(
*
src
is
ready
to
make
a
call
of
[
name
]
*
)
(
CALLSRC
:
(
es
,
σ
s
)
~{
fs
}~>*
(
fill
Ks
(
Call
#[
ScFnPtr
fid
]
(
Val
<
$
>
vl_src
)),
σ
1_
src
))
(
CALLSRC
:
(
es
,
σ
s
)
~{
fs
}~>*
(
fill
Ks
(
Call
#[
ScFnPtr
fid
]
(
of_result
<
$
>
vl_src
)),
σ
1_
src
))
(
*
and
we
can
pick
a
resource
[
rv
]
for
the
arguments
*
)
(
WSAT
:
wsat
(
r_f
⋅
(
rc
⋅
rv
))
σ
1_
src
σ
t
)
(
*
[
rv
]
justifies
the
arguments
*
)
(
VREL
:
Forall2
(
v
rel
rv
)
vl_src
vl_tgt
)
(
VREL
:
Forall2
(
r
rel
rv
)
vl_src
vl_tgt
)
(
*
and
after
the
call
our
context
can
continue
*
)
(
CONT
:
∀
r
'
v
_src
v
_tgt
σ
s
'
σ
t
'
(
*
For
any
new
resource
r
'
that
supports
the
returned
value
s
are
(
CONT
:
∀
r
'
r
_src
r
_tgt
σ
s
'
σ
t
'
(
*
For
any
new
resource
r
'
that
supports
the
returned
result
s
are
related
w
.
r
.
t
.
(
r
⋅
r
'
⋅
r_f
)
*
)
(
VRET
:
v
rel
r
'
v
_src
v
_tgt
)
(
VRET
:
r
rel
r
'
r
_src
r
_tgt
)
(
WSAT
:
wsat
(
r_f
⋅
(
rc
⋅
r
'
))
σ
s
'
σ
t
'
)
(
STACK
:
σ
t
.(
scs
)
=
σ
t
'
.(
scs
)),
∃
idx
'
,
sim_local_body
(
rc
⋅
r
'
)
idx
'
(
fill
Ks
(
Val
v
_src
))
σ
s
'
(
fill
Kt
(
Val
v
_tgt
))
σ
t
'
Φ
).
(
fill
Ks
(
of_result
r
_src
))
σ
s
'
(
fill
Kt
(
of_result
r
_tgt
))
σ
t
'
Φ
).
Record
sim_local_body_base
(
r_f
:
A
)
(
sim_local_body
:
SIM
)
(
r
:
A
)
(
idx
:
nat
)
es
σ
s
et
σ
t
Φ
:
Prop
:=
{
...
...
@@ -112,20 +112,20 @@ Qed.
(
**
Simulating
functions
:
-
We
start
after
the
substitution
.
-
We
assume
the
arguments
are
value
s
related
by
[
r
]
-
The
returned
result
must
also
be
values
and
related
by
[
v
rel
].
-
We
assume
the
arguments
are
result
s
related
by
[
r
]
-
The
returned
result
must
also
be
related
by
[
r
rel
].
This
is
called
"local"
because
it
considers
one
function
at
a
time
.
However
,
it
does
assume
full
knowledge
about
the
GLOBAL
function
table
!
*
)
Definition
fun_post
(
esat
:
A
→
call_id
→
Prop
)
initial_call_id_stack
(
r
:
A
)
(
n
:
nat
)
rs
(
σ
s
:
state
)
rt
σ
t
:=
(
∃
c
,
σ
t
.(
scs
)
=
c
::
initial_call_id_stack
∧
esat
r
c
)
∧
(
∃
vs
vt
,
rs
=
ValR
vs
∧
rt
=
ValR
vt
∧
v
rel
r
v
s
vt
)
.
r
rel
r
r
s
rt
.
Definition
sim_local_fun
(
esat
:
A
→
call_id
→
Prop
)
(
fn_src
fn_tgt
:
function
)
:
Prop
:=
∀
r
es
et
(
vl_src
vl_tgt
:
list
value
)
σ
s
σ
t
(
VALEQ
:
Forall2
(
v
rel
r
)
vl_src
vl_tgt
)
(
EQS
:
subst_l
fn_src
.(
fun_args
)
(
Val
<
$
>
vl_src
)
fn_src
.(
fun_body
)
=
Some
es
)
(
EQT
:
subst_l
fn_tgt
.(
fun_args
)
(
Val
<
$
>
vl_tgt
)
fn_tgt
.(
fun_body
)
=
Some
et
),
∀
r
es
et
(
vl_src
vl_tgt
:
list
result
)
σ
s
σ
t
(
VALEQ
:
Forall2
(
r
rel
r
)
vl_src
vl_tgt
)
(
EQS
:
subst_l
fn_src
.(
fun_args
)
(
of_result
<
$
>
vl_src
)
fn_src
.(
fun_body
)
=
Some
es
)
(
EQT
:
subst_l
fn_tgt
.(
fun_args
)
(
of_result
<
$
>
vl_tgt
)
fn_tgt
.(
fun_body
)
=
Some
et
),
∃
idx
,
sim_local_body
r
idx
(
InitCall
es
)
σ
s
(
InitCall
et
)
σ
t
(
fun_post
esat
σ
t
.(
scs
)).
...
...
theories/sim/local_adequacy.v
View file @
28168cc9
...
...
@@ -46,15 +46,15 @@ Inductive sim_local_frames:
our
local
resource
r
and
have
world
satisfaction
*
)
(
WSAT
'
:
wsat
(
r_f
⋅
(
frame
.(
rc
)
⋅
r
'
))
σ
_
src
'
σ
_
tgt
'
)
(
*
and
the
returned
values
are
related
w
.
r
.
t
.
(
r
⋅
r
'
⋅
r_f
)
*
)
(
VRET
:
v
rel
r
'
v_src
v_tgt
)
(
VRET
:
r
rel
r
'
v_src
v_tgt
)
(
CIDS
:
σ
_
tgt
'
.(
scs
)
=
frame
.(
callids
)),
∃
idx
'
,
sim_local_body
wsat
v
rel
fns
fnt
∃
idx
'
,
sim_local_body
wsat
r
rel
fns
fnt
(
frame
.(
rc
)
⋅
r
'
)
idx
'
(
fill
frame
.(
K_src
)
(
Val
v_src
))
σ
_
src
'
(
fill
frame
.(
K_tgt
)
(
Val
v_tgt
))
σ
_
tgt
'
(
fill
frame
.(
K_src
)
(
of_result
v_src
))
σ
_
src
'
(
fill
frame
.(
K_tgt
)
(
of_result
v_tgt
))
σ
_
tgt
'
(
λ
r
_
vs
σ
s
vt
σ
t
,
(
∃
c
,
σ
t
.(
scs
)
=
c
::
cids
∧
end_call_sat
r
c
)
∧
vrel_
re
s
r
vs
vt
))
r
re
l
r
vs
vt
))
:
sim_local_frames
(
r_f
⋅
frame
.(
rc
))
frame
.(
callids
)
...
...
@@ -70,17 +70,17 @@ Inductive sim_local_conf:
rc
idx
e_src
σ
_
src
e_tgt
σ
_
tgt
Ke_src
Ke_tgt
(
FRAMES
:
sim_local_frames
r_f
cids
K_src
K_tgt
frames
)
(
LOCAL
:
sim_local_body
wsat
v
rel
fns
fnt
rc
idx
e_src
σ
_
src
e_tgt
σ
_
tgt
(
LOCAL
:
sim_local_body
wsat
r
rel
fns
fnt
rc
idx
e_src
σ
_
src
e_tgt
σ
_
tgt
(
λ
r
_
vs
σ
s
vt
σ
t
,
(
∃
c
,
σ
t
.(
scs
)
=
c
::
cids
∧
end_call_sat
r
c
)
∧
vrel_
re
s
r
vs
vt
))
r
re
l
r
vs
vt
))
(
KE_SRC
:
Ke_src
=
fill
K_src
e_src
)
(
KE_TGT
:
Ke_tgt
=
fill
K_tgt
e_tgt
)
(
WSAT
:
wsat
(
r_f
⋅
rc
)
σ
_
src
σ
_
tgt
)
:
sim_local_conf
idx
Ke_src
σ
_
src
Ke_tgt
σ
_
tgt
.
Lemma
sim_local_conf_sim
(
FUNS
:
sim_local_funs
wsat
v
rel
fns
fnt
end_call_sat
)
(
FUNS
:
sim_local_funs
wsat
r
rel
fns
fnt
end_call_sat
)
(
idx
:
nat
)
(
e_src
:
expr
)
(
σ
_
src
:
state
)
(
e_tgt
:
expr
)
(
σ
_
tgt
:
state
)
(
SIM
:
sim_local_conf
idx
e_src
σ
_
src
e_tgt
σ
_
tgt
)
:
sim
fns
fnt
idx
(
e_src
,
σ
_
src
)
(
e_tgt
,
σ
_
tgt
)
...
...
@@ -94,12 +94,12 @@ Proof.
destruct
sim_local_body_stuck
as
[
vt
Eqvt
].
rewrite
-
(
of_to_result
_
_
Eqvt
).
destruct
(
sim_local_body_terminal
_
Eqvt
)
as
(
vs
'
&
σ
s
'
&
r
'
&
SS
'
&
WSAT
'
&
(
c
&
CALLIDS
&
ESAT
'
)
&
V
REL
).
as
(
vs
'
&
σ
s
'
&
r
'
&
SS
'
&
WSAT
'
&
(
c
&
CALLIDS
&
ESAT
'
)
&
R
REL
).
have
STEPK
:
(
fill
(
Λ
:=
bor_ectxi_lang
fns
)
K_src0
e_src0
,
σ
_
src
)
~{
fns
}~>*
(
fill
(
Λ
:=
bor_ectxi_lang
fns
)
K_src0
vs
'
,
σ
s
'
).
{
by
apply
fill_tstep_rtc
.
}
have
NT3
:=
never_stuck_tstep_rtc
_
_
_
_
_
STEPK
NEVER_STUCK
.
clear
-
STEPK
NT3
FRAMES
WSAT
'
V
REL
.
clear
-
STEPK
NT3
FRAMES
WSAT
'
R
REL
.
inversion
FRAMES
.
{
left
.
rewrite
to_of_result
.
by
eexists
.
}
right
.
subst
K_src0
K_tgt0
.
move
:
NT3
.
simpl
.
intros
NT3
.
...
...
@@ -109,14 +109,14 @@ Proof.
apply
tstep_reducible_fill_inv
in
RED
;
[
|
done
].
apply
tstep_reducible_fill
.
destruct
RED
as
[
e2
[
σ
2
Eq2
]].
destruct
VREL
as
(
v1
&
v2
&
?
&
?
&
?
).
subst
vs
'
vt
.
move
:
Eq2
.
eapply
end_call_tstep_src_tgt
;
eauto
.
by
destruct
(
end_call_tstep_src_tgt
_
fnt
_
_
_
_
_
_
_
_
RREL
WSAT
'
Eq2
)
as
(
?&?&?&?&?
)
.
-
guardH
sim_local_body_stuck
.
s
.
i
.
apply
fill_result
in
H
.
unfold
terminal
in
H
.
des
.
subst
.
inv
FRAMES
.
ss
.
exploit
sim_local_body_terminal
;
eauto
.
i
.
des
.
esplits
;
eauto
;
ss
.
+
rewrite
to_of_result
.
esplits
;
eauto
.
+
ii
.
clarify
.
erewrite
to_of_result
.
f_equal
.
eapply
vrel_
re
s
_eq
;
eauto
.
+
rewrite
to_of_result
;
by
eexists
.
+
ii
.
clarify
.
erewrite
to_of_result
.
f_equal
.
eapply
r
re
l
_eq
;
eauto
.
-
guardH
sim_local_body_stuck
.
i
.
destruct
e
σ
2_
tgt
as
[
e2_tgt
σ
2_
tgt
].
...
...
@@ -130,20 +130,19 @@ Proof.
(
*
Simulatin
EndCall
*
)
rename
σ
_
tgt
into
σ
t
.
rename
σ
s
'
into
σ
s
.
destruct
x3
as
(
vs1
&
vt1
&
Eqvs1
&
Eqv1
&
VR
).
(
*
destruct
x3
as
(
vs1
&
vt1
&
Eqvs1
&
Eqv1
&
VR
).
*
)
simplify_eq
.
set
Φ
:
resUR
→
nat
→
result
→
state
→
result
→
state
→
Prop
:=
λ
r2
_
vs2
σ
s2
vt2
σ
t2
,
vrel_
re
s
r2
vs2
vt2
∧
λ
r2
_
vs2
σ
s2
vt2
σ
t2
,
r
re
l
r2
vs2
vt2
∧
∃
c1
c2
cids1
cids2
,
σ
s
.(
scs
)
=
c1
::
cids1
∧
σ
t
.(
scs
)
=
c2
::
cids2
∧
σ
s2
=
mkState
σ
s
.(
shp
)
σ
s
.(
sst
)
cids1
σ
s
.(
snp
)
σ
s
.(
snc
)
∧
σ
t2
=
mkState
σ
t
.(
shp
)
σ
t
.(
sst
)
cids2
σ
t
.(
snp
)
σ
t
.(
snc
)
∧
r2
=
r
'
.
have
SIMEND
:
r
'
⊨
{
idx
,
fns
,
fnt
}
(
EndCall
vs
1
,
σ
s
)
≥
(
EndCall
v
t1
,
σ
t
)
:
Φ
.
have
SIMEND
:
r
'
⊨
{
idx
,
fns
,
fnt
}
(
EndCall
vs
'
,
σ
s
)
≥
(
EndCall
v
,
σ
t
)
:
Φ
.
{
apply
sim_body_end_call
;
auto
;
[
naive_solver
|
].
clear
-
VR
.
intros
.
rewrite
/
Φ
.
simpl
.
split
;
last
naive_solver
.
by
eexists
_
,
_.
}
intros
.
rewrite
/
Φ
.
simpl
.
split
;
last
naive_solver
.
done
.
}
have
NONE
:
to_result
(
EndCall
e_tgt0
)
=
None
.
by
done
.
destruct
(
fill_tstep_inv
_
_
_
_
_
_
NONE
H
)
as
[
et2
[
?
STEPT2
]].
...
...
@@ -152,20 +151,23 @@ Proof.
have
STEPK
:
(
fill
(
Λ
:=
bor_ectxi_lang
fns
)
(
EndCallCtx
::
K_src
frame0
++
K_f_src
)
e_src0
,
σ
_
src
)
~{
fns
}~>*
(
fill
(
Λ
:=
bor_ectxi_lang
fns
)
(
EndCallCtx
::
K_src
frame0
++
K_f_src
)
vs
1
,
σ
s
).
(
EndCallCtx
::
K_src
frame0
++
K_f_src
)
vs
'
,
σ
s
).
{
by
apply
fill_tstep_rtc
.
}
have
NT3
:=
never_stuck_tstep_rtc
_
_
_
_
_
STEPK
NEVER_STUCK
.
rewrite
/=
in
NT3
.
have
NT4
:=
never_stuck_fill_inv
_
_
_
_
NT3
.
rewrite
-
(
of_to_result
_
_
x0
)
in
STEPT2
.
destruct
(
sim_body_end_call_elim
'
_
_
_
_
_
_
_
_
_
SIMEND
_
_
_
x1
NT4
STEPT2
)
as
(
r2
&
idx2
&
σ
s2
&
STEPS
&
?
&
H
Φ
2
&
WSAT2
).
subst
et2
.
as
(
r2
&
idx2
&
σ
s2
&
vs
&
vt
&
STEPS
&
?
&
H
Φ
2
&
WSAT2
).
subst
et2
.
exploit
(
CONTINUATION
r2
).
{
rewrite
cmra_assoc
;
eauto
.
}
{
apply
vrel_res_vrel
.
apply
H
Φ
2.
}
{
exploit
tstep_end_call_inv
;
try
exact
STEPT2
;
eauto
.
i
.
des
.
subst
.
ss
.
rewrite
HFRAME0
in
x5
.
simplify_eq
.
ss
.
{
apply
H
Φ
2.
}
{
exploit
tstep_end_call_inv
;
try
exact
STEPT2
;
eauto
.
-
rewrite
to_of_result
.
by
eexists
.
-
i
.
des
.
subst
.
ss
.
rewrite
HFRAME0
in
x6
.
simplify_eq
.
ss
.
}
intros
[
idx3
SIMFR
].
rename
σ
2_
tgt
into
σ
t2
.
do
2
eexists
.
split
.
...
...
@@ -189,18 +191,19 @@ Proof.
*
right
.
apply
CIH
.
econs
;
eauto
.
+
(
*
call
*
)
exploit
fill_step_inv_2
;
eauto
.
i
.
des
;
ss
.
exploit
tstep_call_inv
.
{
eapply
list_Forall_to_value
.
eauto
.
}
exploit
tstep_call_inv_result
.
{
instantiate
(
1
:=
(
of_result
<
$
>
vl_tgt
)).
by
apply
list_Forall_to_of_result
.
}
{
exact
x2
.
}
eauto
.
i
.
des
.
subst
.
have
NT
:
never_stuck
fns
(
Call
#[
ScFnPtr
fid
]
(
Val
<
$
>
vl_src
))
σ
1_
src
.
have
NT
:
never_stuck
fns
(
Call
#[
ScFnPtr
fid
]
(
of_result
<
$
>
vl_src
))
σ
1_
src
.
{
apply
(
never_stuck_fill_inv
_
Ks
).
eapply
never_stuck_tstep_rtc
;
eauto
.
by
apply
(
never_stuck_fill_inv
_
K_src0
).
}
edestruct
NT
as
[[]
|
[
e2
[
σ
2
RED
]]];
[
constructor
1
|
done
|
].
apply
tstep_call_inv
in
RED
;
last
first
.
{
apply
list_Forall_to_
value
.
eauto
.
}
destruct
RED
as
(
xls
&
ebs
&
HCs
&
ebss
&
Eqfs
&
Eqss
&
?
&
?
).
subst
e2
σ
2.
apply
tstep_call_inv
_result
in
RED
;
last
first
.
{
by
apply
list_Forall_to_
of_result
.
}
destruct
RED
as
(
xls
&
ebs
&
HCs
&
ebss
&
Eqfs
&
Eqss
&
?
&
?
&
?
).
subst
e2
σ
2.
destruct
(
FUNS
_
_
Eqfs
)
as
([
xlt2
ebt2
HCt2
]
&
Eqft2
&
Eql2
&
SIMf
).
rewrite
Eqft2
in
x3
.
simplify_eq
.
specialize
(
SIMf
_
_
_
_
_
σ
1_
src
σ
_
tgt
VREL
Eqss
x4
)
as
[
idx2
SIMf
].
...
...
@@ -208,8 +211,7 @@ Proof.
*
left
.
eapply
tc_rtc_l
.
{
apply
fill_tstep_rtc
.
eauto
.
}
{
econs
.
rewrite
-
fill_app
.
eapply
(
head_step_fill_tstep
).
econs
.
eapply
(
CallBS
_
_
_
_
xls
ebs
);
eauto
.
apply
list_Forall_to_value
.
eauto
.
}
econs
.
eapply
(
CallBS
_
_
_
_
xls
ebs
);
eauto
.
}
*
right
.
apply
CIH
.
econs
.
{
econs
2
;
eauto
.
i
.
instantiate
(
1
:=
mk_frame
_
_
_
_
).
ss
.
destruct
(
CONT
r
'
v_src
v_tgt
σ
_
src
'
σ
_
tgt
'
VRET
WSAT
'
).
...
...
@@ -217,7 +219,7 @@ Proof.
pclearbot
.
esplits
;
eauto
.
}
{
eapply
sim_local_body_post_mono
;
[
|
apply
SIMf
].
simpl
.
unfold
vrel_res
.
naive_solver
.
}
naive_solver
.
}
{
done
.
}
{
s
.
rewrite
-
fill_app
.
eauto
.
}
{
ss
.
rewrite
-
cmra_assoc
;
eauto
.
}
...
...
theories/sim/program.v
View file @
28168cc9
...
...
@@ -10,7 +10,7 @@ Theorem sim_prog_sim_classical
prog_tgt
`
{
NSD
:
stuck_decidable_1
prog_src
}
(
MAINT
:
has_main
prog_src
)
(
FUNS
:
sim_local_funs
wsat
v
rel
prog_src
prog_tgt
end_call_sat
)
(
FUNS
:
sim_local_funs
wsat
r
rel
prog_src
prog_tgt
end_call_sat
)
:
behave_prog
prog_tgt
<
1
=
behave_prog
prog_src
.
Proof
.
destruct
MAINT
as
(
ebs
&
HCs
&
Eqs
).
...
...
@@ -30,11 +30,10 @@ Proof.
-
eapply
(
sim_body_step_over_call
_
_
init_res
ε
_
_
[]
[]);
[
done
|
..].
{
intros
fid
fn_src
.
specialize
(
FUNS
fid
fn_src
).
naive_solver
.
}
intros
.
simpl
.
exists
1
%
nat
.
apply
(
sim_body_result
_
_
_
_
(
ValR
vs
)
(
ValR
vt
))
.
apply
sim_body_result
.
intros
VALID
.
have
?:
vrel_res
(
init_res
⋅
r
'
)
(#
vs
)
(#
vt
).
{
do
2
eexists
.
do
2
(
split
;
[
done
|
]).
eapply
vrel_mono
;
[
done
|
apply
cmra_included_r
|
done
].
}
have
?:
rrel
(
init_res
⋅
r
'
)
vs
vt
.
{
eapply
rrel_mono
;
[
done
|
apply
cmra_included_r
|
exact
VRET
].
}
split
;
[
|
done
].
exists
O
.
split
;
[
by
rewrite
-
STACKT
|
].
apply
cmap_lookup_op_l_equiv_pub
;
[
apply
VALID
|
].
...
...
theories/sim/refl.v
View file @
28168cc9
...
...
@@ -46,14 +46,6 @@ Context (css cst: call_id_stack).
Definition
sem_steps
:=
10
%
nat
.
Definition
rrel
(
r
:
resUR
)
rs
rt
:
Prop
:=
match
rs
,
rt
with
|
ValR
vs
,
ValR
vt
=>
vrel
r
vs
vt
|
PlaceR
ls
ts
Ts
,
PlaceR
lt
t_t
Tt
=>
(
*
Places
are
related
like
pointers
,
and
the
types
must
be
equal
.
*
)
vrel
r
[
ScPtr
ls
ts
]
[
ScPtr
lt
t_t
]
∧
Ts
=
Tt
|
_
,
_
=>
False
end
.
Definition
sem_post
(
r
:
resUR
)
(
n
:
nat
)
rs
css
'
rt
cst
'
:
Prop
:=
n
=
sem_steps
∧
css
'
=
css
∧
cst
'
=
cst
∧
rrel
r
rs
rt
.
...
...
@@ -130,7 +122,7 @@ Proof.
split
.
-
eexists
.
split
.
subst
cst
css
.
rewrite
<-
Hstacks
.
congruence
.
admit
.
(
*
end_call_sat
*
)
-
admit
.
(
*
need
to
show
they
are
values
?!?
*
)
-
done
.
}
rewrite
(
subst_l_map
_
_
_
_
Hsubst1
).
rewrite
(
subst_l_map
_
_
_
_
Hsubst2
).
...
...
theories/sim/refl_step.v
View file @
28168cc9
...
...
@@ -1137,45 +1137,53 @@ Proof.
Qed
.
(
**
EndCall
*
)
Lemma
end_call_tstep_src_tgt
fs
ft
r
σ
s
σ
t
(
vs
vt
:
value
)
es
'
σ
s
'
:
wsat
r
σ
s
σ
t
→
(
EndCall
vs
,
σ
s
)
~{
fs
}~>
(
es
'
,
σ
s
'
)
→
reducible
ft
(
EndCall
vt
)
σ
t
.
Lemma
end_call_tstep_src_tgt
fs
ft
r_f
r
σ
s
σ
t
(
rs
rt
:
result
)
es
'
σ
s
'
:
rrel
r
rs
rt
→
wsat
(
r_f
⋅
r
)
σ
s
σ
t
→
(
EndCall
rs
,
σ
s
)
~{
fs
}~>
(
es
'
,
σ
s
'
)
→
∃
vs
vt
:
value
,
rs
=
ValR
vs
∧
rt
=
ValR
vt
∧
reducible
ft
(
EndCall
rt
)
σ
t
.
Proof
.
intros
WSAT
STEPS
.
edestruct
(
tstep_end_call_inv
_
v
s
_
_
_
(
ltac
:
(
by
eexists
))
STEPS
)
as
(
vs
'
&
Eqvs
&
?
&
c
&
cids
&
Eqc
&
Eqs
).
intros
RREL
WSAT
STEPS
.
edestruct
(
tstep_end_call_inv
_
r
s
_
_
_
(
ltac
:
(
rewrite
to_of_result
;
by
eexists
))
STEPS
)
as
(
vs
&
Eqvs
&
?
&
c
&
cids
&
Eqc
&
Eqs
).
subst
.
simpl
in
Eqvs
.
symmetry
in
Eqvs
.
simplify_eq
.
destruct
WSAT
as
(
?&?&?&?&?&
SREL
&?
).
destruct
SREL
as
(
?
&
?
&
Eqcs
'
&
?
).
rewrite
to_of_result
in
Eqvs
.
simplify_eq
.
destruct
rt
as
[
vt
|
];
[
|
done
].
exists
vs
,
vt
.
do
2
(
split
;
[
done
|
]).
exists
(#
vt
)
%
E
,
(
mkState
σ
t
.(
shp
)
σ
t
.(
sst
)
cids
σ
t
.(
snp
)
σ
t
.(
snc
)).
eapply
(
head_step_fill_tstep
_
[]).
econstructor
.
by
econstructor
.
econstructor
.
by
rewrite
-
Eqcs
'
.
Qed
.
Lemma
sim_body_end_call
fs
ft
r
n
v
s
v
t
σ
s
σ
t
Φ
:
Lemma
sim_body_end_call
fs
ft
r
n
r
s
r
t
σ
s
σ
t
Φ
:
(
*
return
values
are
related
*
)
v
rel
r
v
s
v
t
→
r
rel
r
r
s
r
t
→
(
*
The
top
of
the
call
stack
has
no
privately
protected
locations
left
*
)
(
∃
c
cids
,
σ
t
.(
scs
)
=
c
::
cids
∧
end_call_sat
r
c
)
→
(
∀
c1
c2
cids1
cids2
,
σ
s
.(
scs
)
=
c1
::
cids1
→
σ
t
.(
scs
)
=
c2
::
cids2
→
(
∀
c1
c2
cids1
cids2
vs
vt
,
σ
s
.(
scs
)
=
c1
::
cids1
→
σ
t
.(
scs
)
=
c2
::
cids2
→
rs
=
ValR
vs
→
rt
=
ValR
vt
→
let
σ
s
'
:=
mkState
σ
s
.(
shp
)
σ
s
.(
sst
)
cids1
σ
s
.(
snp
)
σ
s
.(
snc
)
in
let
σ
t
'
:=
mkState
σ
t
.(
shp
)
σ
t
.(
sst
)
cids2
σ
t
.(
snp
)
σ
t
.(
snc
)
in
Wf
σ
t
→
Φ
r
n
(
ValR
vs
)
σ
s
'
(
ValR
vt
)
σ
t
'
:
Prop
)
→
r
⊨
{
n
,
fs
,
ft
}
(
EndCall
(
Val
v
s
),
σ
s
)
≥
(
EndCall
(
Val
v
t
),
σ
t
)
:
Φ
.
Φ
r
n
rs
σ
s
'
rt
σ
t
'
:
Prop
)
→
r
⊨
{
n
,
fs
,
ft
}
(
EndCall
(
of_result
r
s
),
σ
s
)
≥
(
EndCall
(
of_result
r
t
),
σ
t
)
:
Φ
.
Proof
.
intros
VREL
ESAT
POST
.
pfold
.
intros
NT
r_f
WSAT
.
split
;
[
|
done
|
].
{
right
.
destruct
(
NT
(
EndCall
#
v
s
)
σ
s
)
as
[[]
|
[
es
'
[
σ
s
'
STEPS
]]];
[
done
..
|
].
move
:
WSAT
STEPS
.
apply
end_call_tstep_src_tgt
.
}
destruct
(
NT
(
EndCall
r
s
)
σ
s
)
as
[[]
|
[
es
'
[
σ
s
'
STEPS
]]];
[
done
..
|
].
e
apply
(
end_call_tstep_src_tgt
fs
ft
r_f
r
)
in
STEPS
as
(
?&?&?&?&?
);
eauto
.
}
constructor
1.
intros
et
'
σ
t
'
STEPT
.
destruct
(
tstep_end_call_inv
_
#
vt
_
_
_
(
ltac
:
(
by
eexists
))
STEPT
)
destruct
(
tstep_end_call_inv
ft
(
of_result
rt
)
et
'
σ
t
σ
t
'
(
ltac
:
(
rewrite
to_of_result
;
by
eexists
))
STEPT
)
as
(
vt
'
&
Eqvt
&
?
&
c
&
cids
&
Eqc
&
Eqs
).
subst
.
simpl
in
Eqvt
.
symmetry
in
Eqvt
.
simplify_eq
.
subst
.
rewrite
to_of_result
in
Eqvt
.
simplify_eq
.
rewrite
/
end_call_sat
Eqc
in
ESAT
.
destruct
ESAT
as
[
c
'
[
cs
[
Eqcs
ESAT
]]].
symmetry
in
Eqcs
.
simplify_eq
.
set
σ
s
'
:=
(
mkState
σ
s
.(
shp
)
σ
s
.(
sst
)
cids
σ
s
.(
snp
)
σ
s
.(
snc
)).
destruct
rs
as
[
vs
|
];
[
|
done
].
have
STEPS
:
(
EndCall
#
vs
,
σ
s
)
~{
fs
}~>
((#
vs
)
%
E
,
σ
s
'
).
{
destruct
WSAT
as
(
?&?&?&?&?&
SREL
&?
).
destruct
SREL
as
(
?
&
?
&
Eqcs
'
&
?
).
eapply
(
head_step_fill_tstep
_
[]).
...
...
@@ -1206,17 +1214,17 @@ Proof.
intros
l
InD
SHR
.
by
specialize
(
Eqhp
_
InD
SHR
).
-
intros
??
.
rewrite
/=
.
by
apply
LINV
.
}
(
*
result
*
)
left
.
apply
(
sim_body_result
_
_
_
_
(
ValR
vs
)
(
ValR
vt
)).
left
.
apply
(
sim_body_result
_
_
_
_
(
ValR
vs
)
(
ValR
vt
'
)).
intros
VALID
'
.
eapply
POST
;
eauto
.
destruct
SREL
as
(
?&?&
Eqs
&?
).
by
rewrite
Eqs
.
Qed
.
Lemma
sim_body_end_call_elim
'
fs
ft
r
n
vs
vt
σ
s
σ
t
Φ
:
r
⊨
{
n
,
fs
,
ft
}
(
EndCall
(
Val
vs
)
,
σ
s
)
≥
(
EndCall
(
Val
vt
)
,
σ
t
)
:
Φ
→
Lemma
sim_body_end_call_elim
'
fs
ft
r
n
(
rs
rt
:
result
)
σ
s
σ
t
Φ
:
r
⊨
{
n
,
fs
,
ft
}
(
EndCall
rs
,
σ
s
)
≥
(
EndCall
rt
,
σ
t
)
:
Φ
→
∀
r_f
et
'
σ
t
'
(
WSAT
:
wsat
(
r_f
⋅
r
)
σ
s
σ
t
)
(
NT
:
never_stuck
fs
(
EndCall
(
Val
vs
)
)
σ
s
)
(
STEPT
:
(
EndCall
(
Val
vt
)
,
σ
t
)
~{
ft
}~>
(
et
'
,
σ
t
'
)),
∃
r
'
n
'
σ
s
'
,
(
EndCall
(
Val
vs
)
,
σ
s
)
~{
fs
}~>+
(
Val
vs
,
σ
s
'
)
∧
et
'
=
Val
vt
∧
(
NT
:
never_stuck
fs
(
EndCall
rs
)
σ
s
)
(
STEPT
:
(
EndCall
rt
,
σ
t
)
~{
ft
}~>
(
et
'
,
σ
t
'
)),
∃
r
'
n
'
σ
s
'
vs
vt
,
(
EndCall
rs
,
σ
s
)
~{
fs
}~>+
(
Val
vs
,
σ
s
'
)
∧
et
'
=
Val
vt
∧
Φ
r
'
n
'
(
ValR
vs
)
σ
s
'
(
ValR
vt
)
σ
t
'
∧
wsat
(
r_f
⋅
r
'
)
σ
s
'
σ
t
'
.
Proof
.
...
...
@@ -1226,50 +1234,57 @@ Proof.
inversion
STEPSS
;
last
first
.
{
exfalso
.
clear
-
CALLTGT
.
symmetry
in
CALLTGT
.
apply
fill_end_call_decompose
in
CALLTGT
as
[[]
|
[
K
'
[
?
Eq
]]];
[
done
|
].
destruct
(
fill_result
ft
K
'
(
Call
#[
ScFnPtr
fid
]
(
Val
<
$
>
vl_tgt
)))
as
[[]
?
];
[
rewrite
Eq
;
by
eexists
|
done
].
}
destruct
(
fill_result
ft
K
'
(
Call
#[
ScFnPtr
fid
]
(
of_result
<
$
>
vl_tgt
)))
as
[[]
?
];
[
rewrite
Eq
to_of_result
;
by
eexists
|
done
].
}
specialize
(
STEP
_
_
STEPT
)
as
(
es1
&
σ
s1
&
r1
&
n1
&
STEP1
&
WSAT1
&
SIMV
).
have
STEPK
:
(
EndCall
#
v
s
,
σ
s
)
~{
fs
}~>*
(
es1
,
σ
s1
).
have
STEPK
:
(
EndCall
r
s
,
σ
s
)
~{
fs
}~>*
(
es1
,
σ
s1
).
{
destruct
STEP1
as
[
|
[]].
by
apply
tc_rtc
.
by
simplify_eq
.
}
have
NT1
:=
never_stuck_tstep_rtc
_
_
_
_
_
STEPK
NT
.
pclearbot
.
punfold
SIMV
.
specialize
(
SIMV
NT1
_
WSAT1
)
as
[
ST1
TE1
STEPS1
].
apply
tstep_end_call_inv
in
STEPT
as
(
?
&
Eq1
&?
&
?
&
?
&
?
&
?
);
[
|
by
eexists
].
simpl
in
Eq1
.
symmetry
in
Eq1
.
simplify_eq
.
specialize
(
TE1
vt
eq_refl
)
as
(
vs2
&
σ
s2
&
r2
&
STEP2
&
WSAT2
&
POST
).
apply
tstep_end_call_inv
in
STEPT
as
(
vt
&
Eq1
&?
&
?
&
?
&
?
&
?
);
[
|
by
rewrite
to_of_result
;
eexists
].
rewrite
to_of_result
/=
in
Eq1
.
simplify_eq
.
specialize
(
TE1
vt
eq_refl
)
as
(
rs2
&
σ
s2
&
r2
&
STEP2
&
WSAT2
&
POST
).
exists
r2
,
n1
,
σ
s2
.
assert
(
vs2
=
vs
∧
(
EndCall
#
vs
,
σ
s
)
~{
fs
}~>+
((#
vs
)
%
E
,
σ
s2
))
as
[].
assert
(
rs2
=
rs
∧
∃
vs
,
(
EndCall
rs
,
σ
s
)
~{
fs
}~>+
((#
vs
)
%
E
,
σ
s2
)
∧
rs
=
ValR
vs
)
as
[
?
[
vs
[
??
]]].
{
clear
-
STEP1
STEP2
.
destruct
STEP1
as
[
STEP1
|
[
Eq11
Eq12
]];
[
|
simplify_eq
].
-
have
STEP1
'
:=
STEP1
.