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
8abdd6bc
Commit
8abdd6bc
authored
Jul 06, 2019
by
Ralf Jung
Browse files
simplified sim relation that does not track the entire physical state, just the call id stacks
parent
7873f96b
Changes
5
Hide whitespace changes
Inline
Side-by-side
_CoqProject
View file @
8abdd6bc
...
...
@@ -32,6 +32,7 @@ theories/sim/body.v
theories/sim/refl_step.v
theories/sim/left_step.v
theories/sim/right_step.v
theories/sim/simple.v
theories/opt/ex1.v
theories/opt/ex1_down.v
...
...
theories/opt/ex1.v
View file @
8abdd6bc
...
...
@@ -28,17 +28,15 @@ Definition ex1_opt : function :=
Lemma
ex1_sim_body
fs
ft
:
⊨ᶠ
{
fs
,
ft
}
ex1
≥
ex1_opt
.
Proof
.
intros
rf
es
et
vls
vlt
σ
s
σ
t
FREL
SUBSTs
SUBSTt
.
destruct
vls
as
[
|
vs
[]];
[
done
|
|
done
].
simpl
in
SUBSTs
.
destruct
vlt
as
[
|
vt
[]];
[
done
|
|
done
].
simpl
in
SUBSTt
.
simplify_eq
.
apply
(
sim_fun_simple1
10
)
=>
// rf es css et cs vs vt FREL ??. simplify_eq/=.
(
*
InitCall
*
)
exists
10
%
nat
.
apply
sim_body_init_call
.
simpl
.
apply
sim_simple_init_call
=>
c
/=
{
css
}
.
(
*
(
*
Alloc
*
)
sim_apply
sim_body_alloc_local
.
simpl
.
(
*
Let
*
)
sim_apply
sim_body_let_place
.
simpl
.
*
)
Abort
.
theories/sim/local.v
View file @
8abdd6bc
...
...
@@ -115,6 +115,11 @@ Qed.
-
We
start
after
the
substitution
.
-
We
assume
the
arguments
are
values
related
by
[
r
]
-
The
returned
result
must
also
be
values
and
related
by
[
vrel
].
*
)
Definition
fun_post
(
esat
:
A
→
state
→
state
→
Prop
)
initial_call_id_stack
(
r
:
A
)
(
n
:
nat
)
rs
σ
s
rt
σ
t
:=
(
∃
c
,
σ
t
.(
scs
)
=
c
::
initial_call_id_stack
)
∧
esat
r
σ
s
σ
t
∧
(
∃
vs
vt
,
rs
=
ValR
vs
∧
rt
=
ValR
vt
∧
vrel
r
vs
vt
).
Definition
sim_local_fun
(
esat
:
A
→
state
→
state
→
Prop
)
(
fn_src
fn_tgt
:
function
)
:
Prop
:=
∀
r
es
et
(
vl_src
vl_tgt
:
list
value
)
σ
s
σ
t
...
...
@@ -123,16 +128,12 @@ Definition sim_local_fun
(
EQT
:
subst_l
fn_tgt
.(
fun_b
)
(
Val
<
$
>
vl_tgt
)
fn_tgt
.(
fun_e
)
=
Some
et
),
∃
idx
,
sim_local_body
r
idx
(
InitCall
es
)
σ
s
(
InitCall
et
)
σ
t
(
λ
r
'
_
rs
'
σ
s
'
rt
'
σ
t
'
,
(
∃
c
,
σ
t
'
.(
scs
)
=
c
::
σ
t
.(
scs
))
∧
esat
r
'
σ
s
'
σ
t
'
∧
(
∃
vs
'
vt
'
,
rs
'
=
ValR
vs
'
∧
rt
'
=
ValR
vt
'
∧
vrel
r
'
vs
'
vt
'
)).
(
fun_post
esat
σ
t
.(
scs
)).
Definition
sim_local_funs
(
esat
:
A
→
state
→
state
→
Prop
)
:
Prop
:=
∀
name
fn_tgt
,
fnt
!!
name
=
Some
fn_tgt
→
∃
fn_src
,
fns
!!
name
=
Some
fn_src
∧
length
(
fn_src
.(
fun_b
)
)
=
length
(
fn_tgt
.(
fun_b
)
)
∧
length
fn_src
.(
fun_b
)
=
length
fn_tgt
.(
fun_b
)
∧
sim_local_fun
esat
fn_src
fn_tgt
.
End
local
.
...
...
theories/sim/refl_step.v
View file @
8abdd6bc
...
...
@@ -906,7 +906,8 @@ Lemma sim_body_init_call fs ft r n es et σs σt Φ :
let
σ
s
'
:=
mkState
σ
s
.(
shp
)
σ
s
.(
sst
)
(
σ
s
.(
snc
)
::
σ
s
.(
scs
))
σ
s
.(
snp
)
(
S
σ
s
.(
snc
))
in
let
σ
t
'
:=
mkState
σ
t
.(
shp
)
σ
t
.(
sst
)
(
σ
t
.(
snc
)
::
σ
t
.(
scs
))
σ
t
.(
snp
)
(
S
σ
t
.(
snc
))
in
let
r
'
:
resUR
:=
res_callState
σ
t
.(
snc
)
(
csOwned
∅
)
in
r
⋅
r
'
⊨
{
n
,
fs
,
ft
}
(
es
,
σ
s
'
)
≥
(
et
,
σ
t
'
)
:
Φ
→
(
σ
s
'
.(
scs
)
=
σ
t
'
.(
scs
)
→
r
⋅
r
'
⊨
{
n
,
fs
,
ft
}
(
es
,
σ
s
'
)
≥
(
et
,
σ
t
'
)
:
Φ
)
→
r
⊨
{
n
,
fs
,
ft
}
(
InitCall
es
,
σ
s
)
≥
(
InitCall
et
,
σ
t
)
:
Φ
.
Proof
.
intros
σ
s
'
σ
t1
r
'
SIM
.
pfold
.
...
...
@@ -925,8 +926,12 @@ Proof.
{
apply
prod_local_update_1
,
prod_local_update_2
.
rewrite
/=
right_id
(
comm
_
(
_
⋅
_
))
-
insert_singleton_op
//.
by
apply
alloc_singleton_local_update
.
}
have
ANNOYING
:
scs
σ
s
'
=
scs
σ
t1
.
{
simpl
.
destruct
WSAT
as
(
_
&
_
&
_
&
_
&
_
&
SREL
&
_
).
destruct
SREL
as
(
?&?&->&->&?
).
done
.
}
exists
n
.
split
;
last
split
;
cycle
2.
{
(
*
sim
cont
*
)
by
punfold
SIM
.
}
{
(
*
sim
cont
*
)
specialize
(
SIM
ANNOYING
).
punfold
SIM
.
}
{
(
*
STEP
src
*
)
left
.
by
apply
tc_once
.
}
(
*
WSAT
new
*
)
destruct
WSAT
as
(
WFS
&
WFT
&
VALID
&
PINV
&
CINV
&
SREL
&
LINV
).
...
...
theories/sim/simple.v
View file @
8abdd6bc
(
**
A
simpler
simulation
relation
that
hides
the
physical
state
.
(
**
A
simpler
simulation
relation
that
hides
most
of
the
physical
state
,
except
for
the
call
ID
stack
.
Useful
whenever
the
resources
we
own
are
strong
enough
to
carry
us
from
step
to
step
.
When
your
goal
is
simple
,
to
make
it
stateful
just
do
[
intros
σ
s
σ
t
].
To
go
the
other
direction
,
[
apply
sim_simplify
].
Then
you
will
likely
To
go
the
other
direction
,
[
apply
sim_simplify
NEW_POST
].
Then
you
will
likely
want
to
clean
some
stuff
from
your
context
.
*
)
From
stbor
.
sim
Require
Export
instance
.
From
stbor
.
sim
Require
Export
instance
refl_step
.
Defini
tion
sim
_simple
fs
ft
r
n
es
et
Φ
:
Prop
:=
∀
σ
s
σ
t
,
r
⊨
{
n
,
fs
,
ft
}
(
es
,
σ
s
)
≥
(
et
,
σ
t
)
:
Φ
.
Sec
tion
sim
ple
.
Implicit
Types
Φ
:
resUR
→
nat
→
result
→
call_id_stack
→
result
→
call_id_stack
→
Prop
.
Notation
"r ⊨ˢ{ n , fs , ft } es '≥' et : Φ"
:=
(
sim_simple
fs
ft
r
n
%
nat
es
%
E
et
%
E
Φ
)
Definition
fun_post_simple
initial_call_id_stack
(
r
:
resUR
)
(
n
:
nat
)
vs
css
vt
cst
:=
(
∃
c
,
cst
=
c
::
initial_call_id_stack
)
∧
end_call_sat
r
(
mkState
∅
∅
css
0
0
)
(
mkState
∅
∅
cst
0
0
)
∧
vrel_res
r
vs
vt
.
Definition
sim_simple
fs
ft
r
n
es
css
et
cst
(
Φ
:
resUR
→
nat
→
result
→
call_id_stack
→
result
→
call_id_stack
→
Prop
)
:
Prop
:=
∀
σ
s
σ
t
,
σ
s
.(
scs
)
=
css
→
σ
t
.(
scs
)
=
cst
→
r
⊨
{
n
,
fs
,
ft
}
(
es
,
σ
s
)
≥
(
et
,
σ
t
)
:
(
λ
r
n
vs
'
σ
s
'
vt
'
σ
t
'
,
Φ
r
n
vs
'
σ
s
'
.(
scs
)
vt
'
σ
t
'
.(
scs
)).
Notation
"r ⊨ˢ{ n , fs , ft } ( es , css ) '≥' ( et , cst ) : Φ"
:=
(
sim_simple
fs
ft
r
n
%
nat
es
%
E
css
et
%
E
cst
Φ
)
(
at
level
70
,
es
,
et
at
next
level
,
format
"'[hv' r '/' ⊨ˢ{ n , fs , ft } '/ ' '[ ' es ']' '/' ≥ '/ ' '[ ' et ']' '/' : Φ ']'"
).
format
"'[hv' r '/' ⊨ˢ{ n , fs , ft } '/ ' '[ ' ( es , css ) ']' '/' ≥ '/ ' '[ ' ( et , cst ) ']' '/' : Φ ']'"
).
(
*
FIXME
:
does
this
[
apply
]
?
*
)
Lemma
sim_simplify
(
Φ
new
:
resUR
→
nat
→
result
→
call_id_stack
→
result
→
call_id_stack
→
Prop
)
(
Φ
:
resUR
→
nat
→
result
→
state
→
result
→
state
→
Prop
)
r
n
fs
ft
es
σ
s
et
σ
t
:
(
∀
r
n
vs
σ
s
vt
σ
t
,
Φ
new
r
n
vs
σ
s
.(
scs
)
vt
σ
t
.(
scs
)
→
Φ
r
n
vs
σ
s
vt
σ
t
)
→
r
⊨ˢ
{
n
,
fs
,
ft
}
(
es
,
σ
s
.(
scs
))
≥
(
et
,
σ
t
.(
scs
))
:
Φ
new
→
r
⊨
{
n
,
fs
,
ft
}
(
es
,
σ
s
)
≥
(
et
,
σ
t
)
:
Φ
.
Proof
.
intros
H
Φ
HH
.
eapply
sim_local_body_post_mono
;
last
by
apply
HH
.
apply
H
Φ
.
Qed
.
Lemma
sim_fun_simple1
n
fs
ft
(
esf
etf
:
function
)
Φ
:
(
**
Simple
proof
for
a
function
taking
one
argument
.
*
)
(
*
TODO
:
make
the
two
call
stacks
the
same
.
*
)
Lemma
sim_fun_simple1
n
fs
ft
(
esf
etf
:
function
)
:
length
(
esf
.(
fun_b
))
=
1
%
nat
→
length
(
etf
.(
fun_b
))
=
1
%
nat
→
(
∀
es
et
vs
vt
r
,
vrel
r
vs
vt
→
subst_l
(
esf
.(
fun_b
))
[
Val
vs
]
(
esf
.(
fun_e
))
=
Some
es
→
subst_l
(
etf
.(
fun_b
))
[
Val
vt
]
(
etf
.(
fun_e
))
=
Some
et
→
r
⊨ˢ
{
n
,
fs
,
ft
}
es
≥
et
:
Φ
)
→
(
∀
rf
es
css
et
cst
vs
vt
,
vrel
rf
vs
vt
→
subst_l
(
esf
.(
fun_b
))
[
Val
vs
]
(
esf
.(
fun_e
))
=
Some
es
→
subst_l
(
etf
.(
fun_b
))
[
Val
vt
]
(
etf
.(
fun_e
))
=
Some
et
→
rf
⊨ˢ
{
n
,
fs
,
ft
}
(
InitCall
es
,
css
)
≥
(
InitCall
et
,
cst
)
:
fun_post_simple
cst
)
→
⊨ᶠ
{
fs
,
ft
}
esf
≥
etf
.
Abort
.
Proof
.
intros
Hls
Hlt
HH
rf
es
et
vls
vlt
σ
s
σ
t
FREL
SUBSTs
SUBSTt
.
exists
n
.
move:
(
subst_l_is_Some_length
_
_
_
_
SUBSTs
)
(
subst_l_is_Some_length
_
_
_
_
SUBSTt
).
rewrite
Hls
Hlt
.
destruct
vls
as
[
|
vs
[]];
[
done
|
|
done
].
destruct
vlt
as
[
|
vt
[]];
[
done
|
|
done
].
inversion
FREL
.
intros
_
_.
simplify_eq
.
eapply
sim_simplify
;
last
by
eapply
HH
.
intros
??????
(
Hhead
&
Hend
&
Hrel
).
split
;
first
done
.
split
;
last
done
.
(
*
Currently
[
end_call_sat
]
still
looks
at
the
state
,
but
we
should
be
able
to
fix
that
.
*
)
admit
.
Admitted
.
Lemma
sim_simple_init_call
fs
ft
r
n
es
css
et
cst
Φ
:
(
∀
c
:
call_id
,
let
r
'
:=
res_callState
c
(
csOwned
∅
)
in
r
⋅
r
'
⊨ˢ
{
n
,
fs
,
ft
}
(
es
,
c
::
cst
)
≥
(
et
,
c
::
cst
)
:
Φ
)
→
r
⊨ˢ
{
n
,
fs
,
ft
}
(
InitCall
es
,
css
)
≥
(
InitCall
et
,
cst
)
:
Φ
.
Proof
.
intros
HH
σ
s
σ
t
<-<-
.
apply
sim_body_init_call
=>/=
?
.
apply
HH
;
done
.
Qed
.
Lemma
sim_simple_alloc_local
fs
ft
r
n
T
css
cst
Φ
:
(
∀
(
l
:
loc
)
(
t
:
tag
),
let
r
'
:=
res_mapsto
l
☠
(
init_stack
t
)
in
Φ
(
r
⋅
r
'
)
n
(
PlaceR
l
t
T
)
css
(
PlaceR
l
t
T
)
cst
)
→
r
⊨ˢ
{
n
,
fs
,
ft
}
(
Alloc
T
,
css
)
≥
(
Alloc
T
,
cst
)
:
Φ
.
Proof
.
intros
HH
σ
s
σ
t
<-<-
.
apply
sim_body_alloc_local
=>/=
.
apply
HH
.
Qed
.
End
simple
.
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