Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
R
ReLoC-v1
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
1
Issues
1
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Dan Frumin
ReLoC-v1
Commits
d488df51
Commit
d488df51
authored
Feb 27, 2017
by
Dan Frumin
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Finish the tp_ family of tactics for F_mu_ref_conc
parent
3a2c325a
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
91 additions
and
7 deletions
+91
-7
F_mu_ref_conc/tactics.v
F_mu_ref_conc/tactics.v
+91
-7
No files found.
F_mu_ref_conc/tactics.v
View file @
d488df51
...
@@ -90,6 +90,16 @@ Proof.
...
@@ -90,6 +90,16 @@ Proof.
rewrite
right_id
.
rewrite
H1
.
by
rewrite
uPred
.
wand_elim_r
.
rewrite
right_id
.
rewrite
H1
.
by
rewrite
uPred
.
wand_elim_r
.
Qed
.
Qed
.
Lemma
tac_tp_norm
`
{
heapIG
Σ
,
!
cfgSG
Σ
}
j
Δ
Δ'
i
p
(
e
:
expr
)
Q
:
envs_lookup
i
Δ
=
Some
(
p
,
j
⤇
e
)
%
I
→
envs_simple_replace
i
p
(
Esnoc
Enil
i
(
j
⤇
fill
[]
e
))
Δ
=
Some
Δ'
→
(
Δ'
⊢
Q
)
→
(
Δ
⊢
Q
).
Proof
.
simpl
.
intros
.
rewrite
envs_simple_replace_sound
//. simpl.
rewrite
right_id
.
rewrite
H2
.
by
rewrite
uPred
.
wand_elim_r
.
Qed
.
Ltac
tp_bind_helper
:=
Ltac
tp_bind_helper
:=
lazymatch
goal
with
lazymatch
goal
with
|
|-
fill
?
K
?
e
=
fill
_
?
efoc
=>
|
|-
fill
?
K
?
e
=
fill
_
?
efoc
=>
...
@@ -126,14 +136,20 @@ Lemma fill_nil e : fill [] e = e.
...
@@ -126,14 +136,20 @@ Lemma fill_nil e : fill [] e = e.
Proof
.
by
compute
.
Qed
.
Proof
.
by
compute
.
Qed
.
(
*
TODO
:
if
the
proposition
is
of
the
form
(
*
TODO
:
if
the
proposition
is
of
the
form
[
j
⤇
e
],
rewrite
it
to
[
j
⤇
fill
[]
e
]
using
fill_nil
above
[
j
⤇
e
],
rewrite
it
to
[
j
⤇
fill
[]
e
]
using
fill_nil
above
TODO:
this
is
quite
slow
*
)
*
)
Tactic
Notation
"tp_normalise"
constr
(
j
)
:=
Tactic
Notation
"tp_normalise"
constr
(
j
)
:=
iStartProof
;
iStartProof
;
eapply
(
tac_tp_bind
j
);
(
eapply
(
tac_tp_bind
j
);
[
iAssumptionCore
(
*
prove
the
lookup
*
)
[
iAssumptionCore
(
*
prove
the
lookup
*
)
|
by
(
rewrite
?
fill_app
);
simpl
(
*
do
actual
work
*
)
|
by
(
simpl
;
rewrite
?
fill_app
);
simpl
(
*
do
actual
work
*
)
|
env_cbv
;
reflexivity
|
env_cbv
;
reflexivity
|
(
*
new
goal
*
)].
|
(
*
new
goal
*
)]).
(
*
||
(
eapply
(
tac_tp_norm
j
);
*
)
(
*
[
iAssumptionCore
(
*
prove
the
lookup
*
)
*
)
(
*
|
env_cbv
;
reflexivity
*
)
(
*
|
(
*
new
goal
*
)]).
*
)
(
*
TODO
:
figure
out
why
the
envs_simple_replace_sound
lemma
is
not
(
*
TODO
:
figure
out
why
the
envs_simple_replace_sound
lemma
is
not
strong
enough
.
Try
to
see
whether
you
could
generalize
it
strong
enough
.
Try
to
see
whether
you
could
generalize
it
...
@@ -817,12 +833,69 @@ Tactic Notation "tp_fork" constr(j) "as" ident(j') constr(H) :=
...
@@ -817,12 +833,69 @@ Tactic Notation "tp_fork" constr(j) "as" ident(j') constr(H) :=
|
tp_bind_helper
|
tp_bind_helper
|
env_cbv
;
reflexivity
||
fail
"tp_fork: this should not happen"
|
env_cbv
;
reflexivity
||
fail
"tp_fork: this should not happen"
|
(
iIntros
(
j
'
)
||
fail
1
"tp_fork: "
j
'
" not fresh "
);
|
(
iIntros
(
j
'
)
||
fail
1
"tp_fork: "
j
'
" not fresh "
);
(
iIntros
H
||
fail
1
"tp_fork: "
H
" not fresh"
)
(
iIntros
H
||
fail
1
"tp_fork: "
H
" not fresh"
);
try
(
tp_normalise
j
'
)
(
*
new
goal
*
)];
try
(
tp_normalise
j
).
(
*
new
goal
*
)];
try
(
tp_normalise
j
).
Tactic
Notation
"tp_fork"
constr
(
j
)
"as"
ident
(
j
'
)
:=
Tactic
Notation
"tp_fork"
constr
(
j
)
"as"
ident
(
j
'
)
:=
let
H
:=
iFresh
in
tp_fork
j
as
j
'
H
.
let
H
:=
iFresh
in
tp_fork
j
as
j
'
H
.
Lemma
tac_tp_alloc
`
{
heapIG
Σ
,
!
cfgSG
Σ
}
j
Δ
1
Δ
2
E1
E2
ρ
i1
i2
p
K
K
'
e
e
'
v
Q
:
nclose
specN
⊆
E1
→
envs_lookup
i1
Δ
1
=
Some
(
p
,
spec_ctx
ρ
)
→
envs_lookup_delete
i2
Δ
1
=
Some
(
false
,
j
⤇
fill
K
e
,
Δ
2
)
%
I
→
fill
K
e
=
fill
K
'
(
Alloc
e
'
)
→
to_val
e
'
=
Some
v
→
(
Δ
2
⊢
(
∀
(
l
:
loc
),
(
l
↦ₛ
v
)
-
∗
|={
E1
,
E2
}=>
Q
)
%
I
)
→
(
Δ
1
⊢
|={
E1
,
E2
}=>
Q
).
Proof
.
intros
???
Hfill
?
HQ
.
rewrite
-
(
idemp
uPred_and
Δ
1
).
rewrite
{
2
}
(
envs_lookup_sound
'
Δ
1
_
).
2
:
exact
H1
.
rewrite
uPred
.
sep_elim_l
uPred
.
always_and_sep_r
comm
.
rewrite
envs_lookup_delete_sound
'
.
2
:
exact
H2
.
rewrite
Hfill
.
(
*
(
S
(
spec_ctx
ρ
)
(
S
(
j
=>
fill
)
(
S
(
l
↦
v
)
..)))
*
)
rewrite
(
assoc
_
(
spec_ctx
ρ
)
(
j
⤇
_
)
%
I
).
rewrite
step_alloc
//.
rewrite
-
(
fupd_trans
E1
E1
E2
).
rewrite
fupd_frame_r
.
apply
fupd_mono
.
rewrite
uPred
.
sep_exist_r
.
apply
uPred
.
exist_elim
.
intros
l
.
rewrite
(
comm
_
(
j
⤇
_
)
%
I
(
l
↦ₛ
_
)
%
I
).
rewrite
HQ
.
rewrite
(
comm
_
(
l
↦ₛ
_
)
%
I
).
rewrite
-
assoc
.
rewrite
(
uPred
.
forall_elim
l
).
rewrite
uPred
.
sep_elim_r
.
by
rewrite
uPred
.
wand_elim_r
.
Qed
.
Tactic
Notation
"tp_alloc"
constr
(
j
)
:=
iStartProof
;
eapply
(
tac_tp_alloc
j
);
[
solve_ndisj
||
fail
"tp_alloc: cannot prove 'nclose specN ⊆ ?'"
|
iAssumptionCore
||
fail
"tp_alloc: cannot find spec_ctx"
(
*
spec_ctx
*
)
|
iAssumptionCore
||
fail
"tp_alloc: cannot find '"
j
" ⤇ ?'"
|
tp_bind_helper
|
fast_done
||
fail
"tp_alloc: not a value"
|
(
*
new
goal
*
)];
try
(
tp_normalise
j
).
Tactic
Notation
"tp_alloc"
constr
(
j
)
"as"
ident
(
j
'
)
constr
(
H
)
:=
iStartProof
;
eapply
(
tac_tp_alloc
j
);
[
solve_ndisj
||
fail
"tp_alloc: cannot prove 'nclose specN ⊆ ?'"
|
iAssumptionCore
||
fail
"tp_alloc: cannot find spec_ctx"
(
*
spec_ctx
*
)
|
iAssumptionCore
||
fail
"tp_alloc: cannot find '"
j
" ⤇ ?'"
|
tp_bind_helper
|
fast_done
||
fail
"tp_alloc: not a value"
|
(
iIntros
(
j
'
)
||
fail
1
"tp_alloc: "
j
'
" not fresh "
);
(
iIntros
H
||
fail
1
"tp_alloc: "
H
" not fresh"
)
(
*
new
goal
*
)];
try
(
tp_normalise
j
).
Tactic
Notation
"tp_alloc"
constr
(
j
)
"as"
ident
(
j
'
)
:=
let
H
:=
iFresh
in
tp_alloc
j
as
j
'
H
.
Section
test
.
Section
test
.
Context
`
{
heapIG
Σ
,
!
cfgSG
Σ
}
.
Context
`
{
heapIG
Σ
,
!
cfgSG
Σ
}
.
...
@@ -831,6 +904,18 @@ Definition bot := App (TApp (TLam (Rec (App (Var 0) (Var 1))))) Unit.
...
@@ -831,6 +904,18 @@ Definition bot := App (TApp (TLam (Rec (App (Var 0) (Var 1))))) Unit.
Notation
Lam
e
:=
(
Rec
(
e
.[
ren
(
+
1
)])).
Notation
Lam
e
:=
(
Rec
(
e
.[
ren
(
+
1
)])).
Notation
LamV
e
:=
(
RecV
(
e
.[
ren
(
+
1
)])).
Notation
LamV
e
:=
(
RecV
(
e
.[
ren
(
+
1
)])).
Lemma
alloc_test
E
K
j
n
ρ
:
nclose
specN
⊆
E
→
j
⤇
fill
K
(
App
(
Lam
(
Store
(
Var
0
)
(#
n
(
n
+
10
))))
(
Alloc
(#
n
n
)))
-
∗
spec_ctx
ρ
={
E
}=
∗
True
.
Proof
.
iIntros
(
?
)
"Hj #?"
.
tp_alloc
j
.
iIntros
(
l
)
"Hl"
.
Undo
.
Undo
.
tp_alloc
j
as
l
.
Undo
.
tp_alloc
j
as
l
"Hl"
.
done
.
Qed
.
Lemma
test1
E1
j
K
l
n
ρ
:
Lemma
test1
E1
j
K
l
n
ρ
:
nclose
specN
⊆
E1
→
nclose
specN
⊆
E1
→
j
⤇
fill
K
(
App
(
Lam
(
Store
(
Loc
l
)
(
BinOp
Add
(
Nat
1
)
(
Var
0
))))
(
Load
(
Loc
l
)))
-
∗
j
⤇
fill
K
(
App
(
Lam
(
Store
(
Loc
l
)
(
BinOp
Add
(
Nat
1
)
(
Var
0
))))
(
Load
(
Loc
l
)))
-
∗
...
@@ -858,9 +943,8 @@ Proof.
...
@@ -858,9 +943,8 @@ Proof.
iIntros
(
?
)
"Hj #? Hl"
.
iIntros
(
?
)
"Hj #? Hl"
.
tp_fork
j
as
i
"Hi"
.
Undo
.
tp_fork
j
as
i
"Hi"
.
Undo
.
tp_fork
j
as
i
.
Undo
.
tp_fork
j
as
i
.
Undo
.
tp_fork
j
.
iIntros
(
i
)
"Hi"
.
tp_fork
j
.
iIntros
(
i
)
"Hi"
.
rewrite
-
(
fill_nil
(
Fork
_
)).
rewrite
-
(
fill_nil
(
Fork
_
)).
tp_fork
i
as
k
"Hk"
.
rewrite
-
(
fill_nil
(
App
_
_
)).
tp_fork
i
as
k
"Hk"
.
rewrite
-
(
fill_nil
(
App
_
_
)).
tp_cas_suc
k
.
(
*
TODO
:
tp_normalise
fails
here
,
as
fill
[...]
e
reduces
to
an
expression
without
an
outer
context
*
)
tp_cas_suc
k
.
(
*
TODO
:
tp_normalise
fails
here
,
as
fill
[...]
e
reduces
to
an
expression
without
an
outer
context
*
)
rewrite
/=
-
(
fill_nil
(
App
_
_
)).
rewrite
/=
-
(
fill_nil
(
App
_
_
)).
tp_if_true
k
.
rewrite
/=
-
(
fill_nil
(
App
_
_
)).
tp_if_true
k
.
rewrite
/=
-
(
fill_nil
(
App
_
_
)).
...
...
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