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
ba2fcff2
Commit
ba2fcff2
authored
Jul 01, 2016
by
Robbert Krebbers
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Same the same for the binary logrel on F_mu_ref_par.
parent
f69f3e5b
Changes
8
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
570 additions
and
940 deletions
+570
-940
F_mu_ref_par/context_refinement.v
F_mu_ref_par/context_refinement.v
+127
-134
F_mu_ref_par/examples/counter.v
F_mu_ref_par/examples/counter.v
+12
-11
F_mu_ref_par/examples/stack/refinement.v
F_mu_ref_par/examples/stack/refinement.v
+11
-11
F_mu_ref_par/examples/stack/stack_rules.v
F_mu_ref_par/examples/stack/stack_rules.v
+24
-42
F_mu_ref_par/fundamental_binary.v
F_mu_ref_par/fundamental_binary.v
+188
-270
F_mu_ref_par/logrel_binary.v
F_mu_ref_par/logrel_binary.v
+173
-430
F_mu_ref_par/logrel_unary.v
F_mu_ref_par/logrel_unary.v
+2
-2
F_mu_ref_par/soundness_binary.v
F_mu_ref_par/soundness_binary.v
+33
-40
No files found.
F_mu_ref_par/context_refinement.v
View file @
ba2fcff2
From
iris_logrel
.
F_mu_ref_par
Require
Export
fundamental_binary
.
Inductive
c
ontext
_item
:=
Inductive
c
tx
_item
:=
|
CTX_Lam
|
CTX_AppL
(
e2
:
expr
)
|
CTX_AppR
(
e1
:
expr
)
...
...
@@ -40,7 +40,7 @@ Inductive context_item :=
|
CTX_CAS_M
(
e0
:
expr
)
(
e2
:
expr
)
|
CTX_CAS_R
(
e0
:
expr
)
(
e1
:
expr
).
Fixpoint
fill_ctx_item
(
ctx
:
c
ontext
_item
)
(
e
:
expr
)
:
expr
:=
Fixpoint
fill_ctx_item
(
ctx
:
c
tx
_item
)
(
e
:
expr
)
:
expr
:=
match
ctx
with
|
CTX_Lam
=>
Lam
e
|
CTX_AppL
e2
=>
App
e
e2
...
...
@@ -73,142 +73,135 @@ Fixpoint fill_ctx_item (ctx : context_item) (e : expr) : expr :=
|
CTX_CAS_R
e0
e1
=>
CAS
e0
e1
e
end
.
Definition
c
ontext
:=
list
context
_item
.
Definition
c
tx
:=
list
ctx
_item
.
Definition
fill_ctx
(
K
:
c
ontext
)
(
e
:
expr
)
:
expr
:=
foldr
fill_ctx_item
e
K
.
Definition
fill_ctx
(
K
:
c
tx
)
(
e
:
expr
)
:
expr
:=
foldr
fill_ctx_item
e
K
.
Local
Open
Scope
bin_logrel_scope
.
(
**
typed
ctx
*
)
Inductive
typed_ctx_item
:
ctx_item
→
list
type
→
type
→
list
type
→
type
→
Prop
:=
|
TP_CTX_Lam
Γ
τ
τ'
:
typed_ctx_item
CTX_Lam
(
TArrow
τ
τ'
::
τ
::
Γ
)
τ'
Γ
(
TArrow
τ
τ'
)
|
TP_CTX_AppL
Γ
e2
τ
τ'
:
typed
Γ
e2
τ
→
typed_ctx_item
(
CTX_AppL
e2
)
Γ
(
TArrow
τ
τ'
)
Γ
τ'
|
TP_CTX_AppR
Γ
e1
τ
τ'
:
typed
Γ
e1
(
TArrow
τ
τ'
)
→
typed_ctx_item
(
CTX_AppR
e1
)
Γ
τ
Γ
τ'
|
TP_CTX_PairL
Γ
e2
τ
τ'
:
typed
Γ
e2
τ'
→
typed_ctx_item
(
CTX_PairL
e2
)
Γ
τ
Γ
(
TProd
τ
τ'
)
|
TP_CTX_PairR
Γ
e1
τ
τ'
:
typed
Γ
e1
τ
→
typed_ctx_item
(
CTX_PairR
e1
)
Γ
τ'
Γ
(
TProd
τ
τ'
)
|
TP_CTX_Fst
Γ
τ
τ'
:
typed_ctx_item
CTX_Fst
Γ
(
TProd
τ
τ'
)
Γ
τ
|
TP_CTX_Snd
Γ
τ
τ'
:
typed_ctx_item
CTX_Snd
Γ
(
TProd
τ
τ'
)
Γ
τ'
|
TP_CTX_InjL
Γ
τ
τ'
:
typed_ctx_item
CTX_InjL
Γ
τ
Γ
(
TSum
τ
τ'
)
|
TP_CTX_InjR
Γ
τ
τ'
:
typed_ctx_item
CTX_InjR
Γ
τ'
Γ
(
TSum
τ
τ'
)
|
TP_CTX_CaseL
Γ
e1
e2
τ
1
τ
2
τ'
:
typed
(
τ
1
::
Γ
)
e1
τ'
→
typed
(
τ
2
::
Γ
)
e2
τ'
→
typed_ctx_item
(
CTX_CaseL
e1
e2
)
Γ
(
TSum
τ
1
τ
2
)
Γ
τ'
|
TP_CTX_CaseM
Γ
e0
e2
τ
1
τ
2
τ'
:
typed
Γ
e0
(
TSum
τ
1
τ
2
)
→
typed
(
τ
2
::
Γ
)
e2
τ'
→
typed_ctx_item
(
CTX_CaseM
e0
e2
)
(
τ
1
::
Γ
)
τ'
Γ
τ'
|
TP_CTX_CaseR
Γ
e0
e1
τ
1
τ
2
τ'
:
typed
Γ
e0
(
TSum
τ
1
τ
2
)
→
typed
(
τ
1
::
Γ
)
e1
τ'
→
typed_ctx_item
(
CTX_CaseR
e0
e1
)
(
τ
2
::
Γ
)
τ'
Γ
τ'
|
TP_CTX_IfL
Γ
e1
e2
τ
:
typed
Γ
e1
τ
→
typed
Γ
e2
τ
→
typed_ctx_item
(
CTX_IfL
e1
e2
)
Γ
(
TBool
)
Γ
τ
|
TP_CTX_IfM
Γ
e0
e2
τ
:
typed
Γ
e0
(
TBool
)
→
typed
Γ
e2
τ
→
typed_ctx_item
(
CTX_IfM
e0
e2
)
Γ
τ
Γ
τ
|
TP_CTX_IfR
Γ
e0
e1
τ
:
typed
Γ
e0
(
TBool
)
→
typed
Γ
e1
τ
→
typed_ctx_item
(
CTX_IfR
e0
e1
)
Γ
τ
Γ
τ
|
TP_CTX_BinOpL
op
Γ
e2
:
typed
Γ
e2
TNat
→
typed_ctx_item
(
CTX_BinOpL
op
e2
)
Γ
TNat
Γ
(
binop_res_type
op
)
|
TP_CTX_BinOpR
op
e1
Γ
:
typed
Γ
e1
TNat
→
typed_ctx_item
(
CTX_BinOpR
op
e1
)
Γ
TNat
Γ
(
binop_res_type
op
)
|
TP_CTX_Fold
Γ
τ
:
typed_ctx_item
CTX_Fold
Γ
τ
.[(
TRec
τ
)
/
]
Γ
(
TRec
τ
)
|
TP_CTX_Unfold
Γ
τ
:
typed_ctx_item
CTX_Unfold
Γ
(
TRec
τ
)
Γ
τ
.[(
TRec
τ
)
/
]
|
TP_CTX_TLam
Γ
τ
:
typed_ctx_item
CTX_TLam
(
subst
(
ren
(
+
1
))
<
$
>
Γ
)
τ
Γ
(
TForall
τ
)
|
TP_CTX_TApp
Γ
τ
τ'
:
typed_ctx_item
CTX_TApp
Γ
(
TForall
τ
)
Γ
τ
.[
τ'
/
]
|
TP_CTX_Fork
Γ
:
typed_ctx_item
CTX_Fork
Γ
TUnit
Γ
TUnit
|
TPCTX_Alloc
Γ
τ
:
typed_ctx_item
CTX_Alloc
Γ
τ
Γ
(
Tref
τ
)
|
TP_CTX_Load
Γ
τ
:
typed_ctx_item
CTX_Load
Γ
(
Tref
τ
)
Γ
τ
|
TP_CTX_StoreL
Γ
e2
τ
:
typed
Γ
e2
τ
→
typed_ctx_item
(
CTX_StoreL
e2
)
Γ
(
Tref
τ
)
Γ
TUnit
|
TP_CTX_StoreR
Γ
e1
τ
:
typed
Γ
e1
(
Tref
τ
)
→
typed_ctx_item
(
CTX_StoreR
e1
)
Γ
τ
Γ
TUnit
|
TP_CTX_CasL
Γ
e1
e2
τ
:
EqType
τ
→
typed
Γ
e1
τ
→
typed
Γ
e2
τ
→
typed_ctx_item
(
CTX_CAS_L
e1
e2
)
Γ
(
Tref
τ
)
Γ
TBool
|
TP_CTX_CasM
Γ
e0
e2
τ
:
EqType
τ
→
typed
Γ
e0
(
Tref
τ
)
→
typed
Γ
e2
τ
→
typed_ctx_item
(
CTX_CAS_M
e0
e2
)
Γ
τ
Γ
TBool
|
TP_CTX_CasR
Γ
e0
e1
τ
:
EqType
τ
→
typed
Γ
e0
(
Tref
τ
)
→
typed
Γ
e1
τ
→
typed_ctx_item
(
CTX_CAS_R
e0
e1
)
Γ
τ
Γ
TBool
.
(
**
typed
context
*
)
Inductive
typed_context_item
:
context_item
→
list
type
→
type
→
list
type
→
type
→
Prop
:=
|
TP_CTX_Lam
:
∀
Γ
τ
τ'
,
typed_context_item
CTX_Lam
(
TArrow
τ
τ'
::
τ
::
Γ
)
τ'
Γ
(
TArrow
τ
τ'
)
|
TP_CTX_AppL
(
e2
:
expr
)
:
∀
Γ
τ
τ'
,
typed
Γ
e2
τ
→
typed_context_item
(
CTX_AppL
e2
)
Γ
(
TArrow
τ
τ'
)
Γ
τ'
|
TP_CTX_AppR
(
e1
:
expr
)
:
∀
Γ
τ
τ'
,
typed
Γ
e1
(
TArrow
τ
τ'
)
→
typed_context_item
(
CTX_AppR
e1
)
Γ
τ
Γ
τ'
|
TP_CTX_PairL
(
e2
:
expr
)
:
∀
Γ
τ
τ'
,
typed
Γ
e2
τ'
→
typed_context_item
(
CTX_PairL
e2
)
Γ
τ
Γ
(
TProd
τ
τ'
)
|
TP_CTX_PairR
(
e1
:
expr
)
:
∀
Γ
τ
τ'
,
typed
Γ
e1
τ
→
typed_context_item
(
CTX_PairR
e1
)
Γ
τ'
Γ
(
TProd
τ
τ'
)
|
TP_CTX_Fst
:
∀
Γ
τ
τ'
,
typed_context_item
CTX_Fst
Γ
(
TProd
τ
τ'
)
Γ
τ
|
TP_CTX_Snd
:
∀
Γ
τ
τ'
,
typed_context_item
CTX_Snd
Γ
(
TProd
τ
τ'
)
Γ
τ'
|
TP_CTX_InjL
:
∀
Γ
τ
τ'
,
typed_context_item
CTX_InjL
Γ
τ
Γ
(
TSum
τ
τ'
)
|
TP_CTX_InjR
:
∀
Γ
τ
τ'
,
typed_context_item
CTX_InjR
Γ
τ'
Γ
(
TSum
τ
τ'
)
|
TP_CTX_CaseL
(
e1
:
expr
)
(
e2
:
expr
)
:
∀
Γ
τ
1
τ
2
τ'
,
typed
(
τ
1
::
Γ
)
e1
τ'
→
typed
(
τ
2
::
Γ
)
e2
τ'
→
typed_context_item
(
CTX_CaseL
e1
e2
)
Γ
(
TSum
τ
1
τ
2
)
Γ
τ'
|
TP_CTX_CaseM
(
e0
:
expr
)
(
e2
:
expr
)
:
∀
Γ
τ
1
τ
2
τ'
,
typed
Γ
e0
(
TSum
τ
1
τ
2
)
→
typed
(
τ
2
::
Γ
)
e2
τ'
→
typed_context_item
(
CTX_CaseM
e0
e2
)
(
τ
1
::
Γ
)
τ'
Γ
τ'
|
TP_CTX_CaseR
(
e0
:
expr
)
(
e1
:
expr
)
:
∀
Γ
τ
1
τ
2
τ'
,
typed
Γ
e0
(
TSum
τ
1
τ
2
)
→
typed
(
τ
1
::
Γ
)
e1
τ'
→
typed_context_item
(
CTX_CaseR
e0
e1
)
(
τ
2
::
Γ
)
τ'
Γ
τ'
|
TP_CTX_IfL
(
e1
:
expr
)
(
e2
:
expr
)
:
∀
Γ
τ
,
typed
Γ
e1
τ
→
typed
Γ
e2
τ
→
typed_context_item
(
CTX_IfL
e1
e2
)
Γ
(
TBool
)
Γ
τ
|
TP_CTX_IfM
(
e0
:
expr
)
(
e2
:
expr
)
:
∀
Γ
τ
,
typed
Γ
e0
(
TBool
)
→
typed
Γ
e2
τ
→
typed_context_item
(
CTX_IfM
e0
e2
)
Γ
τ
Γ
τ
|
TP_CTX_IfR
(
e0
:
expr
)
(
e1
:
expr
)
:
∀
Γ
τ
,
typed
Γ
e0
(
TBool
)
→
typed
Γ
e1
τ
→
typed_context_item
(
CTX_IfR
e0
e1
)
Γ
τ
Γ
τ
|
TP_CTX_BinOpL
op
(
e2
:
expr
)
:
∀
Γ
,
typed
Γ
e2
TNat
→
typed_context_item
(
CTX_BinOpL
op
e2
)
Γ
TNat
Γ
(
binop_res_type
op
)
|
TP_CTX_BinOpR
op
(
e1
:
expr
)
:
∀
Γ
,
typed
Γ
e1
TNat
→
typed_context_item
(
CTX_BinOpR
op
e1
)
Γ
TNat
Γ
(
binop_res_type
op
)
|
TP_CTX_Fold
:
∀
Γ
τ
,
typed_context_item
CTX_Fold
Γ
τ
.[(
TRec
τ
)
/
]
Γ
(
TRec
τ
)
|
TP_CTX_Unfold
:
∀
Γ
τ
,
typed_context_item
CTX_Unfold
Γ
(
TRec
τ
)
Γ
τ
.[(
TRec
τ
)
/
]
|
TP_CTX_TLam
:
∀
Γ
τ
,
typed_context_item
CTX_TLam
(
map
(
λ
t
:
type
,
t
.[
ren
(
+
1
)])
Γ
)
τ
Γ
(
TForall
τ
)
|
TP_CTX_TApp
:
∀
Γ
τ
τ'
,
typed_context_item
CTX_TApp
Γ
(
TForall
τ
)
Γ
τ
.[
τ'
/
]
|
TP_CTX_Fork
:
∀
Γ
,
typed_context_item
CTX_Fork
Γ
TUnit
Γ
TUnit
|
TPCTX_Alloc
:
∀
Γ
τ
,
typed_context_item
CTX_Alloc
Γ
τ
Γ
(
Tref
τ
)
|
TP_CTX_Load
:
∀
Γ
τ
,
typed_context_item
CTX_Load
Γ
(
Tref
τ
)
Γ
τ
|
TP_CTX_StoreL
(
e2
:
expr
)
:
∀
Γ
τ
,
typed
Γ
e2
τ
→
typed_context_item
(
CTX_StoreL
e2
)
Γ
(
Tref
τ
)
Γ
TUnit
|
TP_CTX_StoreR
(
e1
:
expr
)
:
∀
Γ
τ
,
typed
Γ
e1
(
Tref
τ
)
→
typed_context_item
(
CTX_StoreR
e1
)
Γ
τ
Γ
TUnit
|
TP_CTX_CasL
(
e1
:
expr
)
(
e2
:
expr
)
:
∀
Γ
τ
,
EqType
τ
→
typed
Γ
e1
τ
→
typed
Γ
e2
τ
→
typed_context_item
(
CTX_CAS_L
e1
e2
)
Γ
(
Tref
τ
)
Γ
TBool
|
TP_CTX_CasM
(
e0
:
expr
)
(
e2
:
expr
)
:
∀
Γ
τ
,
EqType
τ
→
typed
Γ
e0
(
Tref
τ
)
→
typed
Γ
e2
τ
→
typed_context_item
(
CTX_CAS_M
e0
e2
)
Γ
τ
Γ
TBool
|
TP_CTX_CasR
(
e0
:
expr
)
(
e1
:
expr
)
:
∀
Γ
τ
,
EqType
τ
→
typed
Γ
e0
(
Tref
τ
)
→
typed
Γ
e1
τ
→
typed_context_item
(
CTX_CAS_R
e0
e1
)
Γ
τ
Γ
TBool
.
Lemma
typed_context_item_typed
k
Γ
τ
Γ'
τ'
e
:
typed
Γ
e
τ
→
typed_context_item
k
Γ
τ
Γ'
τ'
→
Lemma
typed_ctx_item_typed
k
Γ
τ
Γ'
τ'
e
:
typed
Γ
e
τ
→
typed_ctx_item
k
Γ
τ
Γ'
τ'
→
typed
Γ'
(
fill_ctx_item
k
e
)
τ'
.
Proof
.
in
tros
H1
H2
;
induction
H
2
;
simpl
;
eauto
using
typed
.
Qed
.
Proof
.
in
duction
2
;
simpl
;
eauto
using
typed
.
Qed
.
Inductive
typed_c
ontext
:
context
→
list
type
→
type
→
list
type
→
type
→
Prop
:=
Inductive
typed_c
tx
:
ctx
→
list
type
→
type
→
list
type
→
type
→
Prop
:=
|
TPCTX_nil
Γ
τ
:
typed_c
ontext
nil
Γ
τ
Γ
τ
typed_c
tx
nil
Γ
τ
Γ
τ
|
TPCTX_cons
Γ
1
τ
1
Γ
2
τ
2
Γ
3
τ
3
k
K
:
typed_c
ontext
_item
k
Γ
2
τ
2
Γ
3
τ
3
→
typed_c
ontext
K
Γ
1
τ
1
Γ
2
τ
2
→
typed_c
ontext
(
k
::
K
)
Γ
1
τ
1
Γ
3
τ
3.
typed_c
tx
_item
k
Γ
2
τ
2
Γ
3
τ
3
→
typed_c
tx
K
Γ
1
τ
1
Γ
2
τ
2
→
typed_c
tx
(
k
::
K
)
Γ
1
τ
1
Γ
3
τ
3.
Lemma
typed_context_typed
K
Γ
τ
Γ'
τ'
e
:
typed
Γ
e
τ
→
typed_context
K
Γ
τ
Γ'
τ'
→
typed
Γ'
(
fill_ctx
K
e
)
τ'
.
Proof
.
intros
H1
H2
;
induction
H2
;
simpl
;
eauto
using
typed_context_item_typed
.
Qed
.
Lemma
typed_ctx_typed
K
Γ
τ
Γ'
τ'
e
:
typed
Γ
e
τ
→
typed_ctx
K
Γ
τ
Γ'
τ'
→
typed
Γ'
(
fill_ctx
K
e
)
τ'
.
Proof
.
induction
2
;
simpl
;
eauto
using
typed_ctx_item_typed
.
Qed
.
Lemma
typed_c
ontext
_n_closed
K
Γ
τ
Γ'
τ'
e
:
(
∀
f
,
e
.[
base
.
iter
(
length
Γ
)
up
f
]
=
e
)
→
typed_c
ontext
K
Γ
τ
Γ'
τ'
→
Lemma
typed_c
tx
_n_closed
K
Γ
τ
Γ'
τ'
e
:
(
∀
f
,
e
.[
base
.
iter
(
length
Γ
)
up
f
]
=
e
)
→
typed_c
tx
K
Γ
τ
Γ'
τ'
→
∀
f
,
(
fill_ctx
K
e
).[
base
.
iter
(
length
Γ'
)
up
f
]
=
(
fill_ctx
K
e
).
Proof
.
intros
H1
H2
;
induction
H2
;
simpl
;
auto
.
(
induction
H
=>
f
)
;
asimpl
;
simpl
in
*
;
repeat
match
goal
with
H
:
_
|-
_
=>
rewrite
map_length
in
H
end
;
induction
H
=>
f
;
asimpl
;
simpl
in
*
;
repeat
match
goal
with
H
:
_
|-
_
=>
rewrite
f
map_length
in
H
end
;
try
f_equal
;
eauto
using
typed_n_closed
;
try
match
goal
with
H
:
_
|-
_
=>
eapply
(
typed_n_closed
_
_
_
H
)
end
.
Qed
.
Definition
context_refines
Γ
e
e
'
τ
:=
∀
K
,
typed_context
K
Γ
τ
[]
TUnit
→
∀
thp
h
v
,
rtc
step
([
fill_ctx
K
e
],
∅
)
((#
v
)
::
thp
,
h
)
→
∃
thp
'
h
'
v
'
,
rtc
step
([
fill_ctx
K
e
'
],
∅
)
((#
v
'
)
::
thp
'
,
h
'
).
Definition
ctx_refines
(
Γ
:
list
type
)
(
e
e
'
:
expr
)
(
τ
:
type
)
:=
∀
K
thp
σ
v
,
typed_ctx
K
Γ
τ
[]
TUnit
→
rtc
step
([
fill_ctx
K
e
],
∅
)
(#
v
::
thp
,
σ
)
→
∃
thp
'
σ'
v
'
,
rtc
step
([
fill_ctx
K
e
'
],
∅
)
(#
v
'
::
thp
'
,
σ'
).
Section
bin_log_related_under_typed_context
.
Context
{
Σ
:
gFunctors
}
{
iI
:
heapIG
Σ
}
{
iS
:
cfgSG
Σ
}
{
N
:
namespace
}
.
Implicit
Types
Δ
:
varC
-
n
>
bivalC
-
n
>
iPropG
lang
Σ
.
Section
bin_log_related_under_typed_ctx
.
Context
`
{
heapIG
Σ
,
cfgSG
Σ
}
{
N
:
namespace
}
.
Notation
D
:=
(
prodC
valC
valC
-
n
>
iPropG
lang
Σ
).
Implicit
Types
Δ
:
listC
D
.
Lemma
bin_log_related_under_typed_c
ontext
Γ
e
e
'
τ
Γ'
τ'
K
:
Lemma
bin_log_related_under_typed_c
tx
Γ
e
e
'
τ
Γ'
τ'
K
:
(
∀
f
,
e
.[
base
.
iter
(
length
Γ
)
up
f
]
=
e
)
→
(
∀
f
,
e
'
.[
base
.
iter
(
length
Γ
)
up
f
]
=
e
'
)
→
typed_context
K
Γ
τ
Γ'
τ'
→
(
∀
Δ
{
H
Δ
:
∀
x
vw
,
PersistentP
(
Δ
x
vw
)
}
,
@
bin_log_related
_
_
_
N
Δ
Γ
e
e
'
τ
H
Δ
)
→
∀
Δ
{
H
Δ
:
∀
x
vw
,
PersistentP
(
Δ
x
vw
)
}
,
@
bin_log_related
_
_
_
N
Δ
Γ'
(
fill_ctx
K
e
)
(
fill_ctx
K
e
'
)
τ'
H
Δ
.
typed_ctx
K
Γ
τ
Γ'
τ'
→
(
∀
Δ
(
H
Δ
:
ctx_PersistentP
Δ
),
@
bin_log_related
_
_
_
N
Δ
Γ
e
e
'
τ
)
→
∀
Δ
(
H
Δ
:
ctx_PersistentP
Δ
),
@
bin_log_related
_
_
_
N
Δ
Γ'
(
fill_ctx
K
e
)
(
fill_ctx
K
e
'
)
τ'
.
Proof
.
revert
Γ
τ
Γ'
τ'
e
e
'
.
induction
K
as
[
|
k
K
]
=>
Γ
τ
Γ'
τ'
e
e
'
H1
H2
;
simpl
.
...
...
@@ -218,7 +211,7 @@ Section bin_log_related_under_typed_context.
inversion
Hx1
;
subst
;
simpl
.
+
eapply
typed_binary_interp_Lam
;
eauto
;
match
goal
with
H
:
_
|-
_
=>
eapply
(
typed_c
ontext
_n_closed
_
_
_
_
_
_
_
H
)
H
:
_
|-
_
=>
eapply
(
typed_c
tx
_n_closed
_
_
_
_
_
_
_
H
)
end
.
+
eapply
typed_binary_interp_App
;
eauto
using
typed_binary_interp
.
+
eapply
typed_binary_interp_App
;
eauto
using
typed_binary_interp
.
...
...
@@ -229,7 +222,7 @@ Section bin_log_related_under_typed_context.
+
eapply
typed_binary_interp_InjL
;
eauto
.
+
eapply
typed_binary_interp_InjR
;
eauto
.
+
match
goal
with
H
:
typed_c
ontext
_item
_
_
_
_
_
|-
_
=>
inversion
H
;
subst
H
:
typed_c
tx
_item
_
_
_
_
_
|-
_
=>
inversion
H
;
subst
end
.
eapply
typed_binary_interp_Case
;
eauto
using
typed_binary_interp
;
...
...
@@ -237,7 +230,7 @@ Section bin_log_related_under_typed_context.
H
:
_
|-
_
=>
eapply
(
typed_n_closed
_
_
_
H
)
end
.
+
match
goal
with
H
:
typed_c
ontext
_item
_
_
_
_
_
|-
_
=>
inversion
H
;
subst
H
:
typed_c
tx
_item
_
_
_
_
_
|-
_
=>
inversion
H
;
subst
end
.
eapply
typed_binary_interp_Case
;
eauto
using
typed_binary_interp
;
...
...
@@ -245,10 +238,10 @@ Section bin_log_related_under_typed_context.
H
:
_
|-
_
=>
eapply
(
typed_n_closed
_
_
_
H
)
end
;
match
goal
with
H
:
_
|-
_
=>
eapply
(
typed_c
ontext
_n_closed
_
_
_
_
_
_
_
H
)
H
:
_
|-
_
=>
eapply
(
typed_c
tx
_n_closed
_
_
_
_
_
_
_
H
)
end
.
+
match
goal
with
H
:
typed_c
ontext
_item
_
_
_
_
_
|-
_
=>
inversion
H
;
subst
H
:
typed_c
tx
_item
_
_
_
_
_
|-
_
=>
inversion
H
;
subst
end
.
eapply
typed_binary_interp_Case
;
eauto
using
typed_binary_interp
;
...
...
@@ -256,25 +249,25 @@ Section bin_log_related_under_typed_context.
H
:
_
|-
_
=>
eapply
(
typed_n_closed
_
_
_
H
)
end
;
match
goal
with
H
:
_
|-
_
=>
eapply
(
typed_c
ontext
_n_closed
_
_
_
_
_
_
_
H
)
H
:
_
|-
_
=>
eapply
(
typed_c
tx
_n_closed
_
_
_
_
_
_
_
H
)
end
.
+
eapply
typed_binary_interp_If
;
eauto
using
typed_c
ontext
_typed
,
typed_binary_interp
.
eauto
using
typed_c
tx
_typed
,
typed_binary_interp
.
+
eapply
typed_binary_interp_If
;
eauto
using
typed_c
ontext
_typed
,
typed_binary_interp
.
eauto
using
typed_c
tx
_typed
,
typed_binary_interp
.
+
eapply
typed_binary_interp_If
;
eauto
using
typed_c
ontext
_typed
,
typed_binary_interp
.
eauto
using
typed_c
tx
_typed
,
typed_binary_interp
.
+
eapply
typed_binary_interp_nat_bin_op
;
eauto
using
typed_c
ontext
_typed
,
typed_binary_interp
.
eauto
using
typed_c
tx
_typed
,
typed_binary_interp
.
+
eapply
typed_binary_interp_nat_bin_op
;
eauto
using
typed_c
ontext
_typed
,
typed_binary_interp
.
eauto
using
typed_c
tx
_typed
,
typed_binary_interp
.
+
eapply
typed_binary_interp_Fold
;
eauto
.
+
eapply
typed_binary_interp_Unfold
;
eauto
.
+
eapply
typed_binary_interp_TLam
;
eauto
.
+
eapply
typed_binary_interp_TApp
;
trivial
.
+
eapply
typed_binary_interp_Fork
;
trivial
.
+
eapply
typed_binary_interp_Alloc
;
trivial
.
+
eapply
typed_binary_interp_Load
;
trivial
.
+
eapply
typed_binary_interp_TLam
;
eauto
with
typeclass_instances
.
+
eapply
typed_binary_interp_TApp
;
eauto
.
+
eapply
typed_binary_interp_Fork
;
eauto
.
+
eapply
typed_binary_interp_Alloc
;
eauto
.
+
eapply
typed_binary_interp_Load
;
eauto
.
+
eapply
typed_binary_interp_Store
;
eauto
using
typed_binary_interp
.
+
eapply
typed_binary_interp_Store
;
eauto
using
typed_binary_interp
.
+
eapply
typed_binary_interp_CAS
;
eauto
using
typed_binary_interp
.
...
...
@@ -282,4 +275,4 @@ Section bin_log_related_under_typed_context.
+
eapply
typed_binary_interp_CAS
;
eauto
using
typed_binary_interp
.
Unshelve
.
all
:
trivial
.
Qed
.
End
bin_log_related_under_typed_c
ontext
.
End
bin_log_related_under_typed_c
tx
.
F_mu_ref_par/examples/counter.v
View file @
ba2fcff2
...
...
@@ -35,8 +35,9 @@ Definition FG_counter : expr :=
App
(
Lam
(
FG_counter_body
(
Var
1
)))
(
Alloc
(
♯
0
)).
Section
CG_Counter
.
Context
{
Σ
:
gFunctors
}
{
iS
:
cfgSG
Σ
}
{
iI
:
heapIG
Σ
}
.
Implicit
Types
Δ
:
varC
-
n
>
bivalC
-
n
>
iPropG
lang
Σ
.
Context
`
{
iS
:
cfgSG
Σ
,
heapIG
Σ
}
.
Notation
D
:=
(
prodC
valC
valC
-
n
>
iPropG
lang
Σ
).
Implicit
Types
Δ
:
listC
D
.
(
*
Coarse
-
grained
increment
*
)
Lemma
CG_increment_type
x
Γ
:
...
...
@@ -50,7 +51,7 @@ Section CG_Counter.
Lemma
CG_increment_closed
(
x
:
expr
)
:
(
∀
f
,
x
.[
f
]
=
x
)
→
∀
f
,
(
CG_increment
x
).[
f
]
=
CG_increment
x
.
Proof
.
intros
H
f
.
unfold
CG_increment
.
asimpl
.
rewrite
?
H
;
trivial
.
Qed
.
Proof
.
intros
H
x
f
.
unfold
CG_increment
.
asimpl
.
rewrite
?
Hx
;
trivial
.
Qed
.
Lemma
CG_increment_subst
(
x
:
expr
)
f
:
(
CG_increment
x
).[
f
]
=
CG_increment
x
.[
f
].
...
...
@@ -221,7 +222,7 @@ Section CG_Counter.
Lemma
FG_increment_closed
(
x
:
expr
)
:
(
∀
f
,
x
.[
f
]
=
x
)
→
∀
f
,
(
FG_increment
x
).[
f
]
=
FG_increment
x
.
Proof
.
intros
H
f
.
asimpl
.
unfold
FG_increment
.
rewrite
?
H
;
trivial
.
Qed
.
Proof
.
intros
H
x
f
.
asimpl
.
unfold
FG_increment
.
rewrite
?
Hx
;
trivial
.
Qed
.
Lemma
FG_counter_body_type
x
Γ
:
typed
Γ
x
(
Tref
TNat
)
→
...
...
@@ -251,14 +252,14 @@ Section CG_Counter.
Lemma
FG_counter_closed
f
:
FG_counter
.[
f
]
=
FG_counter
.
Proof
.
asimpl
;
rewrite
counter_read_subst
;
by
asimpl
.
Qed
.
Lemma
FG_CG_counter_refinement
N
Δ
{
H
Δ
:
∀
x
v
,
PersistentP
(
Δ
x
v
)
}
:
Lemma
FG_CG_counter_refinement
N
Δ
{
H
Δ
:
ctx_PersistentP
Δ
}
:
@
bin_log_related
_
_
_
N
Δ
[]
FG_counter
CG_counter
(
TProd
(
TArrow
TUnit
TUnit
)
(
TArrow
TUnit
TNat
))
H
Δ
.
(
TProd
(
TArrow
TUnit
TUnit
)
(
TArrow
TUnit
TNat
)).
Proof
.
(
*
executing
the
preambles
*
)
intros
[
|
v
vs
]
Hlen
;
simplify_eq
.
intros
[
|
v
vs
]
ρ
j
K
[
=
]
.
cbn
-
[
FG_counter
CG_counter
].
iIntros
{
ρ
j
K
}
"(#Hheap & #Hspec & _ & Hj)"
.
iIntros
"(#Hheap & #Hspec & _ & Hj)"
.
rewrite
?
empty_env_subst
/
CG_counter
/
FG_counter
.
iPvs
(
steps_newlock
_
_
_
j
(
K
++
[
AppRCtx
(
LamV
_
)])
_
with
"[Hj]"
)
as
{
l
}
"[Hj Hl]"
;
eauto
.
...
...
@@ -358,11 +359,11 @@ End CG_Counter.
Definition
Σ
:=
#[
auth
.
authGF
heapUR
;
auth
.
authGF
cfgUR
].
Theorem
counter_c
ontext
_refinement
:
c
ontext
_refines
[]
FG_counter
CG_counter
Theorem
counter_c
tx
_refinement
:
c
tx
_refines
[]
FG_counter
CG_counter
(
TProd
(
TArrow
TUnit
TUnit
)
(
TArrow
TUnit
TNat
)).
Proof
.
eapply
(
@
Binary_S
oundness
Σ
);
eapply
(
@
binary_s
oundness
Σ
);
auto
using
FG_counter_closed
,
CG_counter_closed
,
FG_CG_counter_refinement
.
all:
typeclasses
eauto
.
Qed
.
F_mu_ref_par/examples/stack/refinement.v
View file @
ba2fcff2
...
...
@@ -6,11 +6,11 @@ From iris_logrel.F_mu_ref_par.examples.stack Require Import
From
iris
.
proofmode
Require
Import
invariants
ghost_ownership
tactics
.
Section
Stack_refinement
.
Context
{
Σ
:
gFunctors
}
{
iS
:
cfgSG
Σ
}
{
iI
:
heapIG
Σ
}
{
iSTK
:
authG
lang
Σ
stackUR
}
.
Implicit
Types
Δ
:
varC
-
n
>
bivalC
-
n
>
iPropG
lang
Σ
.
Context
`
{
cfgSG
Σ
,
heapIG
Σ
,
authG
lang
Σ
stackUR
}
.
Notation
D
:=
(
prodC
valC
valC
-
n
>
iPropG
lang
Σ
)
.
Implicit
Types
Δ
:
listC
D
.
Lemma
FG_CG_counter_refinement
N
Δ
{
H
Δ
:
∀
x
vw
,
PersistentP
(
Δ
x
vw
)
}
:
Lemma
FG_CG_counter_refinement
N
Δ
{
H
Δ
:
ctx_PersistentP
Δ
}
:
@
bin_log_related
_
_
_
N
Δ
[]
FG_stack
CG_stack
(
TForall
(
TProd
...
...
@@ -19,10 +19,10 @@ Section Stack_refinement.
(
TArrow
TUnit
(
TSum
TUnit
(
TVar
0
)))
)
(
TArrow
(
TArrow
(
TVar
0
)
TUnit
)
TUnit
)
))
H
Δ
.
)).
Proof
.
(
*
executing
the
preambles
*
)
iIntros
{
[
|??
]
[
=
]
ρ
j
K
}
"[#Hheap [#Hspec [_ Hj]]]"
.
iIntros
{
[
|??
]
ρ
j
K
[
=
]
}
"[#Hheap [#Hspec [_ Hj]]]"
.
cbn
-
[
FG_stack
CG_stack
].
rewrite
?
empty_env_subst
/
CG_stack
/
FG_stack
.
iApply
wp_value
;
eauto
.
...
...
@@ -64,7 +64,7 @@ Section Stack_refinement.
{
constructor
;
eauto
.
eapply
ucmra_unit_valid
.
}
set
(
istkG
:=
StackG
_
_
γ
).
change
γ
with
(
@
stack_name
_
istkG
).
change
iSTK
with
(
@
stack_inG
_
istkG
).
change
H1
with
(
@
stack_inG
_
istkG
).
clearbody
istkG
.
clear
γ
.
iAssert
(
@
stack_owns
_
istkG
_
∅
)
with
"[Hemp]"
as
"Hoe"
.
{
unfold
stack_owns
;
rewrite
big_sepM_empty
;
iFrame
"Hemp"
;
trivial
.
}
...
...
@@ -374,8 +374,8 @@ End Stack_refinement.
Definition
Σ
:=
#[
authGF
heapUR
;
authGF
cfgUR
;
authGF
stackUR
].
Theorem
stack_c
ontext
_refinement
:
c
ontext
_refines
[]
FG_stack
CG_stack
Theorem
stack_c
tx
_refinement
:
c
tx
_refines
[]
FG_stack
CG_stack
(
TForall
(
TProd
(
TProd
...
...
@@ -386,8 +386,8 @@ Theorem stack_context_refinement :
)
).
Proof
.
eapply
(
@
Binary_S
oundness
Σ
);
eapply
(
@
binary_s
oundness
Σ
);
eauto
using
FG_stack_closed
,
CG_stack_closed
.
all:
try
typeclasses
eauto
.
intros
.
apply
FG_CG_counter_refinement
.
intros
.
apply
FG_CG_counter_refinement
,
_
.
Qed
.
F_mu_ref_par/examples/stack/stack_rules.v
View file @
ba2fcff2
...
...
@@ -20,19 +20,17 @@ Class stackG Σ :=
StackG
{
stack_inG
:>
authG
lang
Σ
stackUR
;
stack_name
:
gname
}
.
Section
Rules
.
Context
{
Σ
:
gFunctors
}
{
istk
:
stackG
Σ
}
.
Context
`
{
stackG
Σ
}
.
Notation
D
:=
(
prodC
valC
valC
-
n
>
iPropG
lang
Σ
).
Definition
stack_mapsto
(
l
:
loc
)
(
v
:
val
)
:
iPropG
lang
Σ
:=
auth_own
stack_name
(
{
[
l
:=
DecAgree
v
]
}
)
.
auth_own
stack_name
{
[
l
:=
DecAgree
v
]
}
.
Notation
"l ↦ˢᵗᵏ v"
:=
(
stack_mapsto
l
v
)
(
at
level
20
)
:
uPred_scope
.
Lemma
stack_mapsto_dup
l
v
:
True
%
I
⊢
l
↦ˢᵗᵏ
v
-
★
(
l
↦ˢᵗᵏ
v
★
l
↦ˢᵗᵏ
v
)
.
Lemma
stack_mapsto_dup
l
v
:
l
↦ˢᵗᵏ
v
⊢
l
↦ˢᵗᵏ
v
★
l
↦ˢᵗᵏ
v
.
Proof
.
iIntros
"H"
.
unfold
stack_mapsto
,
auth_own
.
rewrite
-
own_op
-
auth_frag_op
.
rewrite
-
stackR_self_op
;
trivial
.
by
rewrite
/
stack_mapsto
/
auth_own
-
own_op
-
auth_frag_op
-
stackR_self_op
.
Qed
.
Lemma
stack_mapstos_agree
l
v
w
:
...
...
@@ -47,53 +45,37 @@ Section Rules.
cbv
-
[
decide
]
in
Hvalid
;
destruct
decide
;
trivial
.
Qed
.
Program
Definition
StackLink_pre
(
Q
:
bivalC
-
n
>
iPropG
lang
Σ
)
{
HQ
:
∀
vw
,
PersistentP
(
Q
vw
)
}
:
(
bivalC
-
n
>
iPropG
lang
Σ
)
-
n
>
bivalC
-
n
>
iPropG
lang
Σ
:=
λ
ne
P
v
,
Program
Definition
StackLink_pre
(
Q
:
D
)
:
D
-
n
>
D
:=
λ
ne
P
v
,
(
∃
l
w
,
v
.1
=
LocV
l
★
l
↦ˢᵗᵏ
w
★
((
w
=
InjLV
UnitV
∧
v
.2
=
FoldV
(
InjLV
UnitV
))
∨
(
∃
y1
z1
y2
z2
,
w
=
InjRV
(
PairV
y1
(
FoldV
z1
))
★
v
.2
=
FoldV
(
InjRV
(
PairV
y2
z2
))
★
Q
(
y1
,
y2
)
★
▷
P
(
z1
,
z2
))))
%
I
.
Next
Obligation
.
intros
Q
HQ
P
n
[
v1
v2
]
[
w1
w2
]
[
Hv1
Hv2
];
simpl
in
*
;
by
rewrite
Hv1
Hv2
.
Qed
.
Next
Obligation
.
solve_proper
.
Qed
.
Solve
Obligations
with
solve_proper
.
Global
Instance
StackLink_pre_contractive
Q
{
HQ
}
:
Contractive
(
@
StackLink_pre
Q
HQ
).
Global
Instance
StackLink_pre_contractive
Q
:
Contractive
(
StackLink_pre
Q
).
Proof
.
intros
n
P1
P2
HP
v
;
simpl
.
repeat
(
apply
exist_ne
=>
?
).
repeat
apply
sep_ne
;
trivial
.
rewrite
or_ne
;
trivial
.
repeat
(
apply
exist_ne
=>
?
).
repeat
apply
sep_ne
;
trivial
.
apply
later_contractive
=>
i
H
.
by
apply
HP
.
apply
later_contractive
=>
i
?
.
by
apply
HP
.
Qed
.
Definition
StackLink
Q
{
HQ
}
:=
fixpoint
(
@
StackLink_pre
Q
H
Q
).
Definition
StackLink
Q
:=
fixpoint
(
StackLink_pre
Q
).
Lemma
StackLink_unfold
Q
{
HQ
}
v
:
@
StackLink
Q
HQ
v
≡
(
∃
l
w
,
v
.1
=
LocV
l
★
l
↦ˢᵗᵏ
w
★
((
w
=
InjLV
UnitV
∧
v
.2
=
FoldV
(
InjLV
UnitV
))
∨
(
∃
y1
z1
y2
z2
,
(
w
=
InjRV
(
PairV
y1
(
FoldV
z1
)))
★
(
v
.2
=
FoldV
(
InjRV
(
PairV
y2
z2
)))
★
Q
(
y1
,
y2
)
★
▷
@
StackLink
Q
HQ
(
z1
,
z2
)
)
)
)
%
I
.
Proof
.
unfold
StackLink
at
1.
rewrite
fixpoint_unfold
;
trivial
.
Qed
.
Lemma
StackLink_unfold
Q
v
:
StackLink
Q
v
≡
(
∃
l
w
,
v
.1
=
LocV
l
★
l
↦ˢᵗᵏ
w
★
((
w
=
InjLV
UnitV
∧
v
.2
=
FoldV
(
InjLV
UnitV
))
∨
(
∃
y1
z1
y2
z2
,
w
=
InjRV
(
PairV
y1
(
FoldV
z1
))
★
v
.2
=
FoldV
(
InjRV
(
PairV
y2
z2
))
★
Q
(
y1
,
y2
)
★
▷
@
StackLink
Q
(
z1
,
z2
))))
%
I
.
Proof
.
by
rewrite
{
1
}/
StackLink
fixpoint_unfold
.
Qed
.
Global
Opaque
StackLink
.
(
*
So
that
we
can
only
use
the
unfold
above
.
*
)
Lemma
StackLink_dup
Q
{
HQ
}
v
:
@
StackLink
Q
HQ
v
⊢
@
StackLink
Q
HQ
v
★
@
StackLink
Q
H
Q
v
.
Lemma
StackLink_dup
(
Q
:
D
)
v
`
{
∀
vw
,
PersistentP
(
Q
vw
)
}
:
StackLink
Q
v
⊢
StackLink
Q
v
★
StackLink
Q
v
.
Proof
.
iIntros
"H"
.
iL
ö
b
{
v
}
as
"Hlat"
.
rewrite
StackLink_unfold
.
iDestruct
"H"
as
{
l
w
}
"[% [Hl Hr]]"
;
subst
.
...
...
@@ -113,8 +95,8 @@ Section Rules.
Lemma
stackR_valid
(
h
:
stackUR
)
(
i
:
loc
)
:
✓
h
→
h
!!
i
=
None
∨
∃
v
,
h
!!
i
=
Some
(
DecAgree
v
).
Proof
.
intros
H
;
specialize
(
H
i
).
match
type
of
H
with
intros
H
h
;
specialize
(
Hh
i
).
by
match
type
of
Hh
with
✓
?
A
=>
match
goal
with
|
|-
?
B
=
_
∨
(
∃
_
,
?
C
=
_
)
=>
change
B
with
A
;
change
C
with
A
;
...
...
@@ -182,10 +164,10 @@ Section Rules.
end
end
.
-
set
(
H5
:=
dec_agree_valid_op_eq
_
_
H4
);
clearbody
H5
.
subst
.
inversion
H
1
;
subst
.
inversion
H
3
;
subst
.
destruct
x
as
[
x
|
];
cbv
-
[
decide
];
try
destruct
decide
;
constructor
;
intuition
trivial
.
-
inversion
H
1
;