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
aaa597f0
Commit
aaa597f0
authored
Jul 06, 2019
by
Ralf Jung
Browse files
make tactics work for simple sim
parent
8abdd6bc
Changes
3
Hide whitespace changes
Inline
Side-by-side
theories/opt/ex1.v
View file @
aaa597f0
...
...
@@ -31,11 +31,12 @@ Proof.
apply
(
sim_fun_simple1
10
)
=>
// rf es css et cs vs vt FREL ??. simplify_eq/=.
(
*
InitCall
*
)
apply
sim_simple_init_call
=>
c
/=
{
css
}
.
(
*
apply
sim_simple_init_call
=>
c
/=
{
css
}
.
(
*
Alloc
*
)
sim_apply
sim_
body
_alloc_local
.
simpl
.
sim_apply
sim_
simple
_alloc_local
=>
l
t
/=
.
(
*
(
*
Let
*
)
sim_apply
sim_body_let_place
.
simpl
.
*
)
...
...
theories/sim/simple.v
View file @
aaa597f0
...
...
@@ -7,10 +7,7 @@ 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
refl_step
.
Section
simple
.
Implicit
Types
Φ
:
resUR
→
nat
→
result
→
call_id_stack
→
result
→
call_id_stack
→
Prop
.
From
stbor
.
sim
Require
Import
body
instance
refl_step
.
Definition
fun_post_simple
initial_call_id_stack
(
r
:
resUR
)
(
n
:
nat
)
vs
css
vt
cst
:=
(
∃
c
,
cst
=
c
::
initial_call_id_stack
)
∧
...
...
@@ -23,11 +20,14 @@ Definition sim_simple fs ft r n es css et 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 ) : Φ"
:=
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 , css ) ']' '/' ≥ '/ ' '[ ' ( et , cst ) ']' '/' : Φ ']'"
).
Section
simple
.
Implicit
Types
Φ
:
resUR
→
nat
→
result
→
call_id_stack
→
result
→
call_id_stack
→
Prop
.
(
*
FIXME
:
does
this
[
apply
]
?
*
)
Lemma
sim_simplify
(
Φ
new
:
resUR
→
nat
→
result
→
call_id_stack
→
result
→
call_id_stack
→
Prop
)
...
...
@@ -37,7 +37,7 @@ Lemma sim_simplify
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
.
intros
H
Φ
HH
.
eapply
sim_local_body_post_mono
;
last
exact
:
HH
.
apply
H
Φ
.
Qed
.
...
...
@@ -66,6 +66,20 @@ Proof.
admit
.
Admitted
.
Lemma
sim_simple_bind
fs
ft
(
Ks
:
list
(
ectxi_language
.
ectx_item
(
bor_ectxi_lang
fs
)))
(
Kt
:
list
(
ectxi_language
.
ectx_item
(
bor_ectxi_lang
ft
)))
es
et
r
n
css
cst
Φ
:
r
⊨ˢ
{
n
,
fs
,
ft
}
(
es
,
css
)
≥
(
et
,
cst
)
:
(
λ
r
'
n
'
es
'
css
'
et
'
cst
'
,
r
'
⊨ˢ
{
n
'
,
fs
,
ft
}
(
fill
Ks
es
'
,
css
'
)
≥
(
fill
Kt
et
'
,
cst
'
)
:
Φ
)
→
r
⊨ˢ
{
n
,
fs
,
ft
}
(
fill
Ks
es
,
css
)
≥
(
fill
Kt
et
,
cst
)
:
Φ
.
Proof
.
intros
HH
σ
s
σ
t
<-<-
.
apply
sim_body_bind
.
eapply
sim_local_body_post_mono
;
last
exact
:
HH
.
clear
.
simpl
.
intros
r
n
vs
σ
s
vt
σ
t
HH
.
exact
:
HH
.
Qed
.
Lemma
sim_simple_init_call
fs
ft
r
n
es
css
et
cst
Φ
:
(
∀
c
:
call_id
,
let
r
'
:=
res_callState
c
(
csOwned
∅
)
in
...
...
theories/sim/tactics.v
View file @
aaa597f0
From
stbor
.
lang
Require
Export
lang
.
From
stbor
.
sim
Require
Export
simple
.
From
stbor
.
sim
Require
Import
body
.
Ltac
reshape_expr
e
tac
:=
...
...
@@ -31,6 +32,14 @@ Tactic Notation "sim_bind" open_constr(efocs) open_constr(efoct) :=
eapply
(
sim_body_bind
_
_
_
_
Ks
Kt
es
et
)
)
)
|
|-
_
⊨ˢ
{
_
,
_
,
_
}
(
?
es
,
_
)
≥
(
?
et
,
_
)
:
_
=>
reshape_expr
es
ltac
:
(
fun
Ks
es
=>
unify
es
efocs
;
reshape_expr
et
ltac
:
(
fun
Kt
et
=>
unify
et
efoct
;
eapply
(
sim_simple_bind
_
_
Ks
Kt
es
et
)
)
)
end
.
Tactic
Notation
"sim_apply"
open_constr
(
lem
)
:=
...
...
@@ -42,4 +51,11 @@ Tactic Notation "sim_apply" open_constr(lem) :=
eapply
lem
)
)
|
|-
_
⊨ˢ
{
_
,
_
,
_
}
(
?
es
,
_
)
≥
(
?
et
,
_
)
:
_
=>
reshape_expr
es
ltac
:
(
fun
Ks
es
=>
reshape_expr
et
ltac
:
(
fun
Kt
et
=>
eapply
(
sim_simple_bind
_
_
Ks
Kt
es
et
);
eapply
lem
)
)
end
.
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