Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Marianna Rapoport
iris-coq
Commits
e4763d5e
Commit
e4763d5e
authored
Feb 04, 2016
by
Robbert Krebbers
Browse files
No longer require iFunctor to have an identity element.
parent
de806528
Changes
7
Hide whitespace changes
Inline
Side-by-side
program_logic/adequacy.v
View file @
e4763d5e
...
...
@@ -72,9 +72,9 @@ Lemma ht_adequacy_own Q e1 t2 σ1 m σ2 :
wsat
3
coPset_all
σ
2
(
big_op
rs2
).
Proof
.
intros
Hv
?
[
k
?]%
rtc_nsteps
.
eapply
ht_adequacy_steps
with
(
r1
:
=
(
Res
∅
(
Excl
σ
1
)
m
))
;
eauto
;
[|].
eapply
ht_adequacy_steps
with
(
r1
:
=
(
Res
∅
(
Excl
σ
1
)
(
Some
m
)
))
;
eauto
;
[|].
{
by
rewrite
Nat
.
add_comm
;
apply
wsat_init
,
cmra_valid_validN
.
}
exists
(
Res
∅
(
Excl
σ
1
)
∅
),
(
Res
∅
∅
m
)
;
split_ands
.
exists
(
Res
∅
(
Excl
σ
1
)
∅
),
(
Res
∅
∅
(
Some
m
)
)
;
split_ands
.
*
by
rewrite
Res_op
?left_id
?right_id
.
*
by
rewrite
/
uPred_holds
/=.
*
by
apply
ownG_spec
.
...
...
program_logic/functor.v
View file @
e4763d5e
...
...
@@ -2,8 +2,6 @@ Require Export algebra.cmra.
Structure
iFunctor
:
=
IFunctor
{
ifunctor_car
:
>
cofeT
→
cmraT
;
ifunctor_empty
A
:
Empty
(
ifunctor_car
A
)
;
ifunctor_identity
A
:
CMRAIdentity
(
ifunctor_car
A
)
;
ifunctor_map
{
A
B
}
(
f
:
A
-
n
>
B
)
:
ifunctor_car
A
-
n
>
ifunctor_car
B
;
ifunctor_map_ne
{
A
B
}
n
:
Proper
(
dist
n
==>
dist
n
)
(@
ifunctor_map
A
B
)
;
ifunctor_map_id
{
A
:
cofeT
}
(
x
:
ifunctor_car
A
)
:
ifunctor_map
cid
x
≡
x
;
...
...
@@ -11,7 +9,6 @@ Structure iFunctor := IFunctor {
ifunctor_map
(
g
◎
f
)
x
≡
ifunctor_map
g
(
ifunctor_map
f
x
)
;
ifunctor_map_mono
{
A
B
}
(
f
:
A
-
n
>
B
)
:
CMRAMonotone
(
ifunctor_map
f
)
}.
Existing
Instances
ifunctor_empty
ifunctor_identity
.
Existing
Instances
ifunctor_map_ne
ifunctor_map_mono
.
Lemma
ifunctor_map_ext
(
Σ
:
iFunctor
)
{
A
B
}
(
f
g
:
A
-
n
>
B
)
m
:
...
...
program_logic/ownership.v
View file @
e4763d5e
...
...
@@ -4,7 +4,7 @@ Definition inv {Λ Σ} (i : positive) (P : iProp Λ Σ) : iProp Λ Σ :=
uPred_own
(
Res
{[
i
↦
to_agree
(
Later
(
iProp_unfold
P
))
]}
∅
∅
).
Arguments
inv
{
_
_
}
_
_
%
I
.
Definition
ownP
{
Λ
Σ
}
(
σ
:
state
Λ
)
:
iProp
Λ
Σ
:
=
uPred_own
(
Res
∅
(
Excl
σ
)
∅
).
Definition
ownG
{
Λ
Σ
}
(
m
:
iGst
Λ
Σ
)
:
iProp
Λ
Σ
:
=
uPred_own
(
Res
∅
∅
m
).
Definition
ownG
{
Λ
Σ
}
(
m
:
iGst
Λ
Σ
)
:
iProp
Λ
Σ
:
=
uPred_own
(
Res
∅
∅
(
Some
m
)
).
Instance
:
Params
(@
inv
)
3
.
Instance
:
Params
(@
ownP
)
2
.
Instance
:
Params
(@
ownG
)
2
.
...
...
@@ -53,7 +53,7 @@ Proof. by rewrite /ownG -uPred.own_op Res_op !(left_id _ _). Qed.
Lemma
always_ownG_unit
m
:
(
□
ownG
(
unit
m
))%
I
≡
ownG
(
unit
m
).
Proof
.
apply
uPred
.
always_own
.
by
rewrite
Res_unit
!
cmra_unit_empty
cmra_unit_idempotent
.
by
rewrite
Res_unit
!
cmra_unit_empty
-{
2
}(
cmra_unit_idempotent
m
)
.
Qed
.
Lemma
ownG_valid
m
:
(
ownG
m
)
⊑
(
✓
m
).
Proof
.
by
rewrite
/
ownG
uPred
.
own_valid
;
apply
uPred
.
valid_mono
=>
n
[?
[]].
Qed
.
...
...
@@ -78,7 +78,7 @@ Proof.
intros
(?&?&?)
;
rewrite
/
uPred_holds
/=
res_includedN
/=
Excl_includedN
//.
naive_solver
(
apply
cmra_empty_leastN
).
Qed
.
Lemma
ownG_spec
r
n
m
:
(
ownG
m
)
n
r
↔
m
≼
{
n
}
gst
r
.
Lemma
ownG_spec
r
n
m
:
(
ownG
m
)
n
r
↔
Some
m
≼
{
n
}
gst
r
.
Proof
.
rewrite
/
uPred_holds
/=
res_includedN
;
naive_solver
(
apply
cmra_empty_leastN
).
Qed
.
...
...
program_logic/pviewshifts.v
View file @
e4763d5e
...
...
@@ -100,8 +100,8 @@ Lemma pvs_updateP E m (P : iGst Λ Σ → Prop) :
m
~~>
:
P
→
ownG
m
⊑
pvs
E
E
(
∃
m'
,
■
P
m'
∧
ownG
m'
).
Proof
.
intros
Hup
r
[|
n
]
?
Hinv
%
ownG_spec
rf
[|
k
]
Ef
σ
???
;
try
lia
.
destruct
(
wsat_update_gst
k
(
E
∪
Ef
)
σ
r
rf
m
P
)
as
(
m'
&?&?)
;
eauto
using
cmra_includedN_le
.
destruct
(
wsat_update_gst
k
(
E
∪
Ef
)
σ
r
rf
m
P
)
as
(
m'
&?&?)
;
auto
.
{
apply
cmra_includedN_le
with
(
S
n
)
;
auto
.
}
by
exists
(
update_gst
m'
r
)
;
split
;
[
exists
m'
;
split
;
[|
apply
ownG_spec
]|].
Qed
.
Lemma
pvs_alloc
E
P
:
¬
set_finite
E
→
▷
P
⊑
pvs
E
E
(
∃
i
,
■
(
i
∈
E
)
∧
inv
i
P
).
...
...
program_logic/resources.v
View file @
e4763d5e
...
...
@@ -4,7 +4,7 @@ Require Export program_logic.language program_logic.functor.
Record
res
(
Λ
:
language
)
(
Σ
:
iFunctor
)
(
A
:
cofeT
)
:
=
Res
{
wld
:
mapRA
positive
(
agreeRA
A
)
;
pst
:
exclRA
(
istateC
Λ
)
;
gst
:
Σ
A
;
gst
:
optionRA
(
Σ
A
)
;
}.
Add
Printing
Constructor
res
.
Arguments
Res
{
_
_
_
}
_
_
_
.
...
...
@@ -136,7 +136,7 @@ Qed.
Definition
update_pst
(
σ
:
state
Λ
)
(
r
:
res
Λ
Σ
A
)
:
res
Λ
Σ
A
:
=
Res
(
wld
r
)
(
Excl
σ
)
(
gst
r
).
Definition
update_gst
(
m
:
Σ
A
)
(
r
:
res
Λ
Σ
A
)
:
res
Λ
Σ
A
:
=
Res
(
wld
r
)
(
pst
r
)
m
.
Res
(
wld
r
)
(
pst
r
)
(
Some
m
)
.
Lemma
wld_validN
n
r
:
✓
{
n
}
r
→
✓
{
n
}
(
wld
r
).
Proof
.
by
intros
(?&?&?).
Qed
.
...
...
@@ -167,9 +167,9 @@ Arguments resC : clear implicits.
Arguments
resRA
:
clear
implicits
.
Definition
res_map
{
Λ
Σ
A
B
}
(
f
:
A
-
n
>
B
)
(
r
:
res
Λ
Σ
A
)
:
res
Λ
Σ
B
:
=
Res
(
agree_map
f
<$>
(
wld
r
)
)
Res
(
agree_map
f
<$>
wld
r
)
(
pst
r
)
(
ifunctor_map
Σ
f
(
gst
r
)
)
.
(
ifunctor_map
Σ
f
<$>
gst
r
).
Instance
res_map_ne
Λ
Σ
(
A
B
:
cofeT
)
(
f
:
A
-
n
>
B
)
:
(
∀
n
,
Proper
(
dist
n
==>
dist
n
)
f
)
→
∀
n
,
Proper
(
dist
n
==>
dist
n
)
(@
res_map
Λ
Σ
_
_
f
).
...
...
@@ -178,23 +178,25 @@ Lemma res_map_id {Λ Σ A} (r : res Λ Σ A) : res_map cid r ≡ r.
Proof
.
constructor
;
simpl
;
[|
done
|].
*
rewrite
-{
2
}(
map_fmap_id
(
wld
r
))
;
apply
map_fmap_setoid_ext
=>
i
y
?
/=.
by
rewrite
-{
2
}(
agree_map_id
y
)
;
apply
agree_map_ext
=>
y'
/=.
*
by
rewrite
-{
2
}(
ifunctor_map_id
Σ
(
gst
r
))
;
apply
ifunctor_map_ext
=>
m
/=.
by
rewrite
-{
2
}(
agree_map_id
y
)
;
apply
agree_map_ext
.
*
rewrite
-{
2
}(
option_fmap_id
(
gst
r
))
;
apply
option_fmap_setoid_ext
=>
m
/=.
by
rewrite
-{
2
}(
ifunctor_map_id
Σ
m
)
;
apply
ifunctor_map_ext
.
Qed
.
Lemma
res_map_compose
{
Λ
Σ
A
B
C
}
(
f
:
A
-
n
>
B
)
(
g
:
B
-
n
>
C
)
(
r
:
res
Λ
Σ
A
)
:
res_map
(
g
◎
f
)
r
≡
res_map
g
(
res_map
f
r
).
Proof
.
constructor
;
simpl
;
[|
done
|].
*
rewrite
-
map_fmap_compose
;
apply
map_fmap_setoid_ext
=>
i
y
_
/=.
by
rewrite
-
agree_map_compose
;
apply
agree_map_ext
=>
y'
/=.
*
by
rewrite
-
ifunctor_map_compose
;
apply
ifunctor_map_ext
=>
m
/=.
by
rewrite
-
agree_map_compose
;
apply
agree_map_ext
.
*
rewrite
-
option_fmap_compose
;
apply
option_fmap_setoid_ext
=>
m
/=.
by
rewrite
-
ifunctor_map_compose
;
apply
ifunctor_map_ext
.
Qed
.
Lemma
res_map_ext
{
Λ
Σ
A
B
}
(
f
g
:
A
-
n
>
B
)
(
r
:
res
Λ
Σ
A
)
:
(
∀
x
,
f
x
≡
g
x
)
→
res_map
f
r
≡
res_map
g
r
.
Proof
.
intros
Hfg
;
split
;
simpl
;
auto
.
*
by
apply
map_fmap_setoid_ext
=>
i
x
?
;
apply
agree_map_ext
.
*
by
apply
ifunctor_map_ext
.
*
by
apply
option_fmap_setoid_ext
=>
m
;
apply
ifunctor_map_ext
.
Qed
.
Instance
res_map_cmra_monotone
{
Λ
Σ
}
{
A
B
:
cofeT
}
(
f
:
A
-
n
>
B
)
:
CMRAMonotone
(@
res_map
Λ
Σ
_
_
f
).
...
...
@@ -211,5 +213,5 @@ Instance resC_map_ne {Λ Σ A B} n :
Proof
.
intros
f
g
Hfg
r
;
split
;
simpl
;
auto
.
*
by
apply
(
mapC_map_ne
_
(
agreeC_map
f
)
(
agreeC_map
g
)),
agreeC_map_ne
.
*
by
apply
ifunctor_map_ne
.
*
by
apply
optionC_map_ne
,
ifunctor_map_ne
.
Qed
.
program_logic/tests.v
View file @
e4763d5e
...
...
@@ -3,5 +3,5 @@ Require Import program_logic.model.
Module
ModelTest
.
(* Make sure we got the notations right. *)
Definition
iResTest
{
Λ
:
language
}
{
Σ
:
iFunctor
}
(
w
:
iWld
Λ
Σ
)
(
p
:
iPst
Λ
)
(
g
:
iGst
Λ
Σ
)
:
iRes
Λ
Σ
:
=
Res
w
p
g
.
(
w
:
iWld
Λ
Σ
)
(
p
:
iPst
Λ
)
(
g
:
iGst
Λ
Σ
)
:
iRes
Λ
Σ
:
=
Res
w
p
(
Some
g
)
.
End
ModelTest
.
program_logic/wsat.v
View file @
e4763d5e
...
...
@@ -33,6 +33,7 @@ Implicit Types r : iRes Λ Σ.
Implicit
Types
rs
:
gmap
positive
(
iRes
Λ
Σ
).
Implicit
Types
P
:
iProp
Λ
Σ
.
Implicit
Types
m
:
iGst
Λ
Σ
.
Implicit
Types
mm
:
option
(
iGst
Λ
Σ
).
Instance
wsat_ne'
:
Proper
(
dist
n
==>
impl
)
(@
wsat
Λ
Σ
n
E
σ
).
Proof
.
...
...
@@ -66,7 +67,7 @@ Proof.
destruct
n
;
[
done
|
intros
[
rs
?]].
eapply
cmra_validN_op_l
,
wsat_pre_valid
;
eauto
.
Qed
.
Lemma
wsat_init
k
E
σ
m
:
✓
{
S
k
}
m
→
wsat
(
S
k
)
E
σ
(
Res
∅
(
Excl
σ
)
m
).
Lemma
wsat_init
k
E
σ
m
m
:
✓
{
S
k
}
m
m
→
wsat
(
S
k
)
E
σ
(
Res
∅
(
Excl
σ
)
m
m
).
Proof
.
intros
Hv
.
exists
∅
;
constructor
;
auto
.
*
rewrite
big_opM_empty
right_id
.
...
...
@@ -125,12 +126,12 @@ Proof.
by
constructor
;
split_ands'
;
try
(
rewrite
/=
-
associative
Hpst'
).
Qed
.
Lemma
wsat_update_gst
n
E
σ
r
rf
m1
(
P
:
iGst
Λ
Σ
→
Prop
)
:
m1
≼
{
S
n
}
gst
r
→
m1
~~>
:
P
→
Some
m1
≼
{
S
n
}
gst
r
→
m1
~~>
:
P
→
wsat
(
S
n
)
E
σ
(
r
⋅
rf
)
→
∃
m2
,
wsat
(
S
n
)
E
σ
(
update_gst
m2
r
⋅
rf
)
∧
P
m2
.
Proof
.
intros
[
mf
Hr
]
Hup
[
rs
[(?&?&?)
H
σ
HE
Hwld
]].
destruct
(
Hup
(
mf
⋅
gst
(
rf
⋅
big_opM
rs
))
n
)
as
(
m2
&?&
Hval'
).
{
by
rewrite
/=
(
associative
_
m1
)
-
Hr
(
associative
_
)
.
}
intros
[
mf
Hr
]
Hup
%
option_updateP'
[
rs
[(?&?&?)
H
σ
HE
Hwld
]].
destruct
(
Hup
(
mf
⋅
gst
(
rf
⋅
big_opM
rs
))
n
)
as
(
[
m2
|]
&?&
Hval'
)
;
try
done
.
{
by
rewrite
/=
(
associative
_
(
Some
m1
)
)
-
Hr
associative
.
}
exists
m2
;
split
;
[
exists
rs
;
split
;
split_ands'
;
auto
|
done
].
Qed
.
Lemma
wsat_alloc
n
E1
E2
σ
r
P
rP
:
...
...
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