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
I
Iris
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
116
Issues
116
List
Boards
Labels
Service Desk
Milestones
Merge Requests
23
Merge Requests
23
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Iris
Iris
Commits
83e59d25
Commit
83e59d25
authored
Aug 13, 2019
by
Ralf Jung
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'ralf/array' into 'master'
Move array stuff to own file See merge request
iris/iris!299
parents
b300eb97
784e2431
Pipeline
#19002
passed with stage
in 14 minutes and 34 seconds
Changes
6
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
288 additions
and
190 deletions
+288
-190
_CoqProject
_CoqProject
+1
-0
tests/heap_lang.ref
tests/heap_lang.ref
+10
-0
tests/heap_lang.v
tests/heap_lang.v
+9
-0
theories/heap_lang/array.v
theories/heap_lang/array.v
+235
-0
theories/heap_lang/lifting.v
theories/heap_lang/lifting.v
+32
-189
theories/heap_lang/proofmode.v
theories/heap_lang/proofmode.v
+1
-1
No files found.
_CoqProject
View file @
83e59d25
...
@@ -100,6 +100,7 @@ theories/heap_lang/lang.v
...
@@ -100,6 +100,7 @@ theories/heap_lang/lang.v
theories/heap_lang/metatheory.v
theories/heap_lang/metatheory.v
theories/heap_lang/tactics.v
theories/heap_lang/tactics.v
theories/heap_lang/lifting.v
theories/heap_lang/lifting.v
theories/heap_lang/array.v
theories/heap_lang/notation.v
theories/heap_lang/notation.v
theories/heap_lang/proofmode.v
theories/heap_lang/proofmode.v
theories/heap_lang/adequacy.v
theories/heap_lang/adequacy.v
...
...
tests/heap_lang.ref
View file @
83e59d25
...
@@ -86,6 +86,16 @@ Tactic failure: wp_pure: cannot find ?y in (Var "x") or
...
@@ -86,6 +86,16 @@ Tactic failure: wp_pure: cannot find ?y in (Var "x") or
--------------------------------------∗
--------------------------------------∗
WP "x" {{ _, True }}
WP "x" {{ _, True }}
The command has indeed failed with message:
In nested Ltac calls to "iIntros (constr)", "iIntros_go",
"iDestructHyp (constr) as (constr)",
"<iris.proofmode.ltac_tactics.iDestructHypFindPat>",
"<iris.proofmode.ltac_tactics.iDestructHypGo>" and
"iAndDestruct (constr) as (constr) (constr)", last call failed.
Tactic failure: iAndDestruct: cannot destruct (l ↦∗ (vs1 ++ vs2))%I.
The command has indeed failed with message:
Ltac call to "iSplitL (constr)" failed.
Tactic failure: iSplitL: (l ↦∗ (vs1 ++ vs2))%I not a separating conjunction.
1 subgoal
1 subgoal
Σ : gFunctors
Σ : gFunctors
...
...
tests/heap_lang.v
View file @
83e59d25
...
@@ -155,6 +155,15 @@ Section tests.
...
@@ -155,6 +155,15 @@ Section tests.
by
iApply
"HΦ"
.
by
iApply
"HΦ"
.
Qed
.
Qed
.
Lemma
test_array_app
l
vs1
vs2
:
l
↦∗
(
vs1
++
vs2
)
-
∗
l
↦∗
(
vs1
++
vs2
).
Proof
.
Fail
iIntros
"[H1 H2]"
.
(* this should, one day, split at the fraction. *)
iIntros
"H"
.
iDestruct
(
array_app
with
"H"
)
as
"[H1 H2]"
.
Fail
iSplitL
"H1"
.
iApply
array_app
.
iSplitL
"H1"
;
done
.
Qed
.
End
tests
.
End
tests
.
Section
printing_tests
.
Section
printing_tests
.
...
...
theories/heap_lang/array.v
0 → 100644
View file @
83e59d25
From
iris
.
program_logic
Require
Export
weakestpre
.
From
iris
.
heap_lang
Require
Export
lifting
.
From
iris
.
heap_lang
Require
Import
tactics
notation
.
From
iris
.
proofmode
Require
Import
tactics
.
From
stdpp
Require
Import
fin_maps
.
Set
Default
Proof
Using
"Type"
.
(** This file defines the [array] connective, a version of [mapsto] that works
with lists of values. It also contains array versions of the basic heap
operations of HeapLand. *)
Definition
array
`
{!
heapG
Σ
}
(
l
:
loc
)
(
vs
:
list
val
)
:
iProp
Σ
:
=
([
∗
list
]
i
↦
v
∈
vs
,
(
l
+
ₗ
i
)
↦
v
)%
I
.
Notation
"l ↦∗ vs"
:
=
(
array
l
vs
)
(
at
level
20
,
format
"l ↦∗ vs"
)
:
bi_scope
.
(** We have no [FromSep] or [IntoSep] instances to remain forwards compatible
with a fractional array assertion, that will split the fraction, not the
list. *)
Section
lifting
.
Context
`
{!
heapG
Σ
}.
Implicit
Types
P
Q
:
iProp
Σ
.
Implicit
Types
Φ
:
val
→
iProp
Σ
.
Implicit
Types
σ
:
state
.
Implicit
Types
v
:
val
.
Implicit
Types
vs
:
list
val
.
Implicit
Types
l
:
loc
.
Implicit
Types
sz
off
:
nat
.
Global
Instance
array_timeless
l
vs
:
Timeless
(
array
l
vs
)
:
=
_
.
Lemma
array_nil
l
:
l
↦∗
[]
⊣
⊢
emp
.
Proof
.
by
rewrite
/
array
.
Qed
.
Lemma
array_singleton
l
v
:
l
↦∗
[
v
]
⊣
⊢
l
↦
v
.
Proof
.
by
rewrite
/
array
/=
right_id
loc_add_0
.
Qed
.
Lemma
array_app
l
vs
ws
:
l
↦∗
(
vs
++
ws
)
⊣
⊢
l
↦∗
vs
∗
(
l
+
ₗ
length
vs
)
↦∗
ws
.
Proof
.
rewrite
/
array
big_sepL_app
.
setoid_rewrite
Nat2Z
.
inj_add
.
by
setoid_rewrite
loc_add_assoc
.
Qed
.
Lemma
array_cons
l
v
vs
:
l
↦∗
(
v
::
vs
)
⊣
⊢
l
↦
v
∗
(
l
+
ₗ
1
)
↦∗
vs
.
Proof
.
rewrite
/
array
big_sepL_cons
loc_add_0
.
setoid_rewrite
loc_add_assoc
.
setoid_rewrite
Nat2Z
.
inj_succ
.
by
setoid_rewrite
Z
.
add_1_l
.
Qed
.
Lemma
update_array
l
vs
off
v
:
vs
!!
off
=
Some
v
→
(
l
↦∗
vs
-
∗
((
l
+
ₗ
off
)
↦
v
∗
∀
v'
,
(
l
+
ₗ
off
)
↦
v'
-
∗
l
↦∗
<[
off
:
=
v'
]>
vs
))%
I
.
Proof
.
iIntros
(
Hlookup
)
"Hl"
.
rewrite
-[
X
in
(
l
↦∗
X
)%
I
](
take_drop_middle
_
off
v
)
;
last
done
.
iDestruct
(
array_app
with
"Hl"
)
as
"[Hl1 Hl]"
.
iDestruct
(
array_cons
with
"Hl"
)
as
"[Hl2 Hl3]"
.
assert
(
off
<
length
vs
)%
nat
as
H
by
(
apply
lookup_lt_is_Some
;
by
eexists
).
rewrite
take_length
min_l
;
last
by
lia
.
iFrame
"Hl2"
.
iIntros
(
w
)
"Hl2"
.
clear
Hlookup
.
assert
(<[
off
:
=
w
]>
vs
!!
off
=
Some
w
)
as
Hlookup
.
{
apply
list_lookup_insert
.
lia
.
}
rewrite
-[
in
(
l
↦∗
<[
off
:
=
w
]>
vs
)%
I
](
take_drop_middle
(<[
off
:
=
w
]>
vs
)
off
w
Hlookup
).
iApply
array_app
.
rewrite
take_insert
;
last
by
lia
.
iFrame
.
iApply
array_cons
.
rewrite
take_length
min_l
;
last
by
lia
.
iFrame
.
rewrite
drop_insert
;
last
by
lia
.
done
.
Qed
.
(** Allocation *)
Lemma
mapsto_seq_array
l
v
n
:
([
∗
list
]
i
∈
seq
0
n
,
(
l
+
ₗ
(
i
:
nat
))
↦
v
)
-
∗
l
↦∗
replicate
n
v
.
Proof
.
rewrite
/
array
.
iInduction
n
as
[|
n'
]
"IH"
forall
(
l
)
;
simpl
.
{
done
.
}
iIntros
"[$ Hl]"
.
rewrite
-
fmap_seq
big_sepL_fmap
.
setoid_rewrite
Nat2Z
.
inj_succ
.
setoid_rewrite
<-
Z
.
add_1_l
.
setoid_rewrite
<-
loc_add_assoc
.
iApply
"IH"
.
done
.
Qed
.
Lemma
wp_allocN
s
E
v
n
:
0
<
n
→
{{{
True
}}}
AllocN
(
Val
$
LitV
$
LitInt
$
n
)
(
Val
v
)
@
s
;
E
{{{
l
,
RET
LitV
(
LitLoc
l
)
;
l
↦∗
replicate
(
Z
.
to_nat
n
)
v
∗
[
∗
list
]
i
∈
seq
0
(
Z
.
to_nat
n
),
meta_token
(
l
+
ₗ
(
i
:
nat
))
⊤
}}}.
Proof
.
iIntros
(
Hzs
Φ
)
"_ HΦ"
.
iApply
wp_allocN_seq
;
[
done
..|].
iNext
.
iIntros
(
l
)
"Hlm"
.
iApply
"HΦ"
.
iDestruct
(
big_sepL_sep
with
"Hlm"
)
as
"[Hl $]"
.
by
iApply
mapsto_seq_array
.
Qed
.
Lemma
twp_allocN
s
E
v
n
:
0
<
n
→
[[{
True
}]]
AllocN
(
Val
$
LitV
$
LitInt
$
n
)
(
Val
v
)
@
s
;
E
[[{
l
,
RET
LitV
(
LitLoc
l
)
;
l
↦∗
replicate
(
Z
.
to_nat
n
)
v
∗
[
∗
list
]
i
∈
seq
0
(
Z
.
to_nat
n
),
meta_token
(
l
+
ₗ
(
i
:
nat
))
⊤
}]].
Proof
.
iIntros
(
Hzs
Φ
)
"_ HΦ"
.
iApply
twp_allocN_seq
;
[
done
..|].
iIntros
(
l
)
"Hlm"
.
iApply
"HΦ"
.
iDestruct
(
big_sepL_sep
with
"Hlm"
)
as
"[Hl $]"
.
by
iApply
mapsto_seq_array
.
Qed
.
Lemma
wp_allocN_vec
s
E
v
n
:
0
<
n
→
{{{
True
}}}
AllocN
#
n
v
@
s
;
E
{{{
l
,
RET
#
l
;
l
↦∗
vreplicate
(
Z
.
to_nat
n
)
v
∗
[
∗
list
]
i
∈
seq
0
(
Z
.
to_nat
n
),
meta_token
(
l
+
ₗ
(
i
:
nat
))
⊤
}}}.
Proof
.
iIntros
(
Hzs
Φ
)
"_ HΦ"
.
iApply
wp_allocN
;
[
lia
|
done
|
..
].
iNext
.
iIntros
(
l
)
"[Hl Hm]"
.
iApply
"HΦ"
.
rewrite
vec_to_list_replicate
.
iFrame
.
Qed
.
Lemma
twp_allocN_vec
s
E
v
n
:
0
<
n
→
[[{
True
}]]
AllocN
#
n
v
@
s
;
E
[[{
l
,
RET
#
l
;
l
↦∗
vreplicate
(
Z
.
to_nat
n
)
v
∗
[
∗
list
]
i
∈
seq
0
(
Z
.
to_nat
n
),
meta_token
(
l
+
ₗ
(
i
:
nat
))
⊤
}]].
Proof
.
iIntros
(
Hzs
Φ
)
"_ HΦ"
.
iApply
twp_allocN
;
[
lia
|
done
|
..
].
iIntros
(
l
)
"[Hl Hm]"
.
iApply
"HΦ"
.
rewrite
vec_to_list_replicate
.
iFrame
.
Qed
.
(** Access to array elements *)
Lemma
wp_load_offset
s
E
l
off
vs
v
:
vs
!!
off
=
Some
v
→
{{{
▷
l
↦∗
vs
}}}
!
#(
l
+
ₗ
off
)
@
s
;
E
{{{
RET
v
;
l
↦∗
vs
}}}.
Proof
.
iIntros
(
Hlookup
Φ
)
"Hl HΦ"
.
iDestruct
(
update_array
l
_
_
_
Hlookup
with
"Hl"
)
as
"[Hl1 Hl2]"
.
iApply
(
wp_load
with
"Hl1"
).
iIntros
"!> Hl1"
.
iApply
"HΦ"
.
iDestruct
(
"Hl2"
$!
v
)
as
"Hl2"
.
rewrite
list_insert_id
;
last
done
.
iApply
"Hl2"
.
iApply
"Hl1"
.
Qed
.
Lemma
wp_load_offset_vec
s
E
l
sz
(
off
:
fin
sz
)
(
vs
:
vec
val
sz
)
:
{{{
▷
l
↦∗
vs
}}}
!
#(
l
+
ₗ
off
)
@
s
;
E
{{{
RET
vs
!!!
off
;
l
↦∗
vs
}}}.
Proof
.
apply
wp_load_offset
.
by
apply
vlookup_lookup
.
Qed
.
Lemma
wp_store_offset
s
E
l
off
vs
v
:
is_Some
(
vs
!!
off
)
→
{{{
▷
l
↦∗
vs
}}}
#(
l
+
ₗ
off
)
<-
v
@
s
;
E
{{{
RET
#()
;
l
↦∗
<[
off
:
=
v
]>
vs
}}}.
Proof
.
iIntros
([
w
Hlookup
]
Φ
)
">Hl HΦ"
.
iDestruct
(
update_array
l
_
_
_
Hlookup
with
"Hl"
)
as
"[Hl1 Hl2]"
.
iApply
(
wp_store
with
"Hl1"
).
iNext
.
iIntros
"Hl1"
.
iApply
"HΦ"
.
iApply
"Hl2"
.
iApply
"Hl1"
.
Qed
.
Lemma
wp_store_offset_vec
s
E
l
sz
(
off
:
fin
sz
)
(
vs
:
vec
val
sz
)
v
:
{{{
▷
l
↦∗
vs
}}}
#(
l
+
ₗ
off
)
<-
v
@
s
;
E
{{{
RET
#()
;
l
↦∗
vinsert
off
v
vs
}}}.
Proof
.
setoid_rewrite
vec_to_list_insert
.
apply
wp_store_offset
.
eexists
.
by
apply
vlookup_lookup
.
Qed
.
Lemma
wp_cmpxchg_suc_offset
s
E
l
off
vs
v'
v1
v2
:
vs
!!
off
=
Some
v'
→
v'
=
v1
→
vals_compare_safe
v'
v1
→
{{{
▷
l
↦∗
vs
}}}
CmpXchg
#(
l
+
ₗ
off
)
v1
v2
@
s
;
E
{{{
RET
(
v'
,
#
true
)
;
l
↦∗
<[
off
:
=
v2
]>
vs
}}}.
Proof
.
iIntros
(
Hlookup
??
Φ
)
"Hl HΦ"
.
iDestruct
(
update_array
l
_
_
_
Hlookup
with
"Hl"
)
as
"[Hl1 Hl2]"
.
iApply
(
wp_cmpxchg_suc
with
"Hl1"
)
;
[
done
..|].
iNext
.
iIntros
"Hl1"
.
iApply
"HΦ"
.
iApply
"Hl2"
.
iApply
"Hl1"
.
Qed
.
Lemma
wp_cmpxchg_suc_offset_vec
s
E
l
sz
(
off
:
fin
sz
)
(
vs
:
vec
val
sz
)
v1
v2
:
vs
!!!
off
=
v1
→
vals_compare_safe
(
vs
!!!
off
)
v1
→
{{{
▷
l
↦∗
vs
}}}
CmpXchg
#(
l
+
ₗ
off
)
v1
v2
@
s
;
E
{{{
RET
(
vs
!!!
off
,
#
true
)
;
l
↦∗
vinsert
off
v2
vs
}}}.
Proof
.
intros
.
setoid_rewrite
vec_to_list_insert
.
eapply
wp_cmpxchg_suc_offset
=>
//.
by
apply
vlookup_lookup
.
Qed
.
Lemma
wp_cmpxchg_fail_offset
s
E
l
off
vs
v0
v1
v2
:
vs
!!
off
=
Some
v0
→
v0
≠
v1
→
vals_compare_safe
v0
v1
→
{{{
▷
l
↦∗
vs
}}}
CmpXchg
#(
l
+
ₗ
off
)
v1
v2
@
s
;
E
{{{
RET
(
v0
,
#
false
)
;
l
↦∗
vs
}}}.
Proof
.
iIntros
(
Hlookup
HNEq
Hcmp
Φ
)
">Hl HΦ"
.
iDestruct
(
update_array
l
_
_
_
Hlookup
with
"Hl"
)
as
"[Hl1 Hl2]"
.
iApply
(
wp_cmpxchg_fail
with
"Hl1"
)
;
first
done
.
{
destruct
Hcmp
;
by
[
left
|
right
].
}
iIntros
"!> Hl1"
.
iApply
"HΦ"
.
iDestruct
(
"Hl2"
$!
v0
)
as
"Hl2"
.
rewrite
list_insert_id
;
last
done
.
iApply
"Hl2"
.
iApply
"Hl1"
.
Qed
.
Lemma
wp_cmpxchg_fail_offset_vec
s
E
l
sz
(
off
:
fin
sz
)
(
vs
:
vec
val
sz
)
v1
v2
:
vs
!!!
off
≠
v1
→
vals_compare_safe
(
vs
!!!
off
)
v1
→
{{{
▷
l
↦∗
vs
}}}
CmpXchg
#(
l
+
ₗ
off
)
v1
v2
@
s
;
E
{{{
RET
(
vs
!!!
off
,
#
false
)
;
l
↦∗
vs
}}}.
Proof
.
intros
.
eapply
wp_cmpxchg_fail_offset
=>
//.
by
apply
vlookup_lookup
.
Qed
.
Lemma
wp_faa_offset
s
E
l
off
vs
(
i1
i2
:
Z
)
:
vs
!!
off
=
Some
#
i1
→
{{{
▷
l
↦∗
vs
}}}
FAA
#(
l
+
ₗ
off
)
#
i2
@
s
;
E
{{{
RET
LitV
(
LitInt
i1
)
;
l
↦∗
<[
off
:
=#(
i1
+
i2
)]>
vs
}}}.
Proof
.
iIntros
(
Hlookup
Φ
)
"Hl HΦ"
.
iDestruct
(
update_array
l
_
_
_
Hlookup
with
"Hl"
)
as
"[Hl1 Hl2]"
.
iApply
(
wp_faa
with
"Hl1"
).
iNext
.
iIntros
"Hl1"
.
iApply
"HΦ"
.
iApply
"Hl2"
.
iApply
"Hl1"
.
Qed
.
Lemma
wp_faa_offset_vec
s
E
l
sz
(
off
:
fin
sz
)
(
vs
:
vec
val
sz
)
(
i1
i2
:
Z
)
:
vs
!!!
off
=
#
i1
→
{{{
▷
l
↦∗
vs
}}}
FAA
#(
l
+
ₗ
off
)
#
i2
@
s
;
E
{{{
RET
LitV
(
LitInt
i1
)
;
l
↦∗
vinsert
off
#(
i1
+
i2
)
vs
}}}.
Proof
.
intros
.
setoid_rewrite
vec_to_list_insert
.
apply
wp_faa_offset
=>
//.
by
apply
vlookup_lookup
.
Qed
.
End
lifting
.
Typeclasses
Opaque
array
.
theories/heap_lang/lifting.v
View file @
83e59d25
...
@@ -31,11 +31,6 @@ Notation "l ↦{ q } -" := (∃ v, l ↦{q} v)%I
...
@@ -31,11 +31,6 @@ Notation "l ↦{ q } -" := (∃ v, l ↦{q} v)%I
(
at
level
20
,
q
at
level
50
,
format
"l ↦{ q } -"
)
:
bi_scope
.
(
at
level
20
,
q
at
level
50
,
format
"l ↦{ q } -"
)
:
bi_scope
.
Notation
"l ↦ -"
:
=
(
l
↦
{
1
}
-)%
I
(
at
level
20
)
:
bi_scope
.
Notation
"l ↦ -"
:
=
(
l
↦
{
1
}
-)%
I
(
at
level
20
)
:
bi_scope
.
Definition
array
`
{!
heapG
Σ
}
(
l
:
loc
)
(
vs
:
list
val
)
:
iProp
Σ
:
=
([
∗
list
]
i
↦
v
∈
vs
,
(
l
+
ₗ
i
)
↦
v
)%
I
.
Notation
"l ↦∗ vs"
:
=
(
array
l
vs
)
(
at
level
20
,
format
"l ↦∗ vs"
)
:
bi_scope
.
(** The tactic [inv_head_step] performs inversion on hypotheses of the shape
(** The tactic [inv_head_step] performs inversion on hypotheses of the shape
[head_step]. The tactic will discharge head-reductions starting from values, and
[head_step]. The tactic will discharge head-reductions starting from values, and
simplifies hypothesis related to conversions from and to values, and finite map
simplifies hypothesis related to conversions from and to values, and finite map
...
@@ -204,9 +199,7 @@ Implicit Types Φ : val → iProp Σ.
...
@@ -204,9 +199,7 @@ Implicit Types Φ : val → iProp Σ.
Implicit
Types
efs
:
list
expr
.
Implicit
Types
efs
:
list
expr
.
Implicit
Types
σ
:
state
.
Implicit
Types
σ
:
state
.
Implicit
Types
v
:
val
.
Implicit
Types
v
:
val
.
Implicit
Types
vs
:
list
val
.
Implicit
Types
l
:
loc
.
Implicit
Types
l
:
loc
.
Implicit
Types
sz
off
:
nat
.
(** Fork: Not using Texan triples to avoid some unnecessary [True] *)
(** Fork: Not using Texan triples to avoid some unnecessary [True] *)
Lemma
wp_fork
s
E
e
Φ
:
Lemma
wp_fork
s
E
e
Φ
:
...
@@ -225,43 +218,10 @@ Proof.
...
@@ -225,43 +218,10 @@ Proof.
iIntros
(
κ
v2
σ
2
efs
Hstep
)
;
inv_head_step
.
by
iFrame
.
iIntros
(
κ
v2
σ
2
efs
Hstep
)
;
inv_head_step
.
by
iFrame
.
Qed
.
Qed
.
Lemma
array_nil
l
:
l
↦∗
[]
⊣
⊢
emp
.
(** Heap *)
Proof
.
by
rewrite
/
array
.
Qed
.
(** The "proper" [allocN] are derived in [array]. *)
Lemma
array_singleton
l
v
:
l
↦∗
[
v
]
⊣
⊢
l
↦
v
.
Proof
.
by
rewrite
/
array
/=
right_id
loc_add_0
.
Qed
.
Lemma
array_app
l
vs
ws
:
l
↦∗
(
vs
++
ws
)
⊣
⊢
l
↦∗
vs
∗
(
l
+
ₗ
length
vs
)
↦∗
ws
.
Proof
.
rewrite
/
array
big_sepL_app
.
setoid_rewrite
Nat2Z
.
inj_add
.
by
setoid_rewrite
loc_add_assoc
.
Qed
.
Lemma
array_cons
l
v
vs
:
l
↦∗
(
v
::
vs
)
⊣
⊢
l
↦
v
∗
(
l
+
ₗ
1
)
↦∗
vs
.
Proof
.
rewrite
/
array
big_sepL_cons
loc_add_0
.
setoid_rewrite
loc_add_assoc
.
setoid_rewrite
Nat2Z
.
inj_succ
.
by
setoid_rewrite
Z
.
add_1_l
.
Qed
.
Lemma
heap_array_to_array
l
vs
:
([
∗
map
]
l'
↦
v
∈
heap_array
l
vs
,
l'
↦
v
)
-
∗
l
↦∗
vs
.
Proof
.
iIntros
"Hvs"
.
iInduction
vs
as
[|
v
vs
]
"IH"
forall
(
l
)
;
simpl
.
{
by
rewrite
/
array
.
}
rewrite
big_opM_union
;
last
first
.
{
apply
map_disjoint_spec
=>
l'
v1
v2
/
lookup_singleton_Some
[->
_
].
intros
(
j
&?&
Hjl
&
_
)%
heap_array_lookup
.
rewrite
loc_add_assoc
-{
1
}[
l'
]
loc_add_0
in
Hjl
.
simplify_eq
;
lia
.
}
rewrite
array_cons
.
rewrite
big_opM_singleton
;
iDestruct
"Hvs"
as
"[$ Hvs]"
.
by
iApply
"IH"
.
Qed
.
Lemma
heap_array_to_seq_meta
l
vs
n
:
Lemma
heap_array_to_seq_meta
l
vs
(
n
:
nat
)
:
length
vs
=
n
→
length
vs
=
n
→
([
∗
map
]
l'
↦
_
∈
heap_array
l
vs
,
meta_token
l'
⊤
)
-
∗
([
∗
map
]
l'
↦
_
∈
heap_array
l
vs
,
meta_token
l'
⊤
)
-
∗
[
∗
list
]
i
∈
seq
0
n
,
meta_token
(
l
+
ₗ
(
i
:
nat
))
⊤
.
[
∗
list
]
i
∈
seq
0
n
,
meta_token
(
l
+
ₗ
(
i
:
nat
))
⊤
.
...
@@ -277,31 +237,27 @@ Proof.
...
@@ -277,31 +237,27 @@ Proof.
rewrite
big_opM_singleton
;
iDestruct
"Hvs"
as
"[$ Hvs]"
.
by
iApply
"IH"
.
rewrite
big_opM_singleton
;
iDestruct
"Hvs"
as
"[$ Hvs]"
.
by
iApply
"IH"
.
Qed
.
Qed
.
Lemma
update_array
l
vs
off
v
:
Lemma
heap_array_to_seq_mapsto
l
v
(
n
:
nat
)
:
vs
!!
off
=
Some
v
→
([
∗
map
]
l'
↦
v
∈
heap_array
l
(
replicate
n
v
),
l'
↦
v
)
-
∗
(
l
↦∗
vs
-
∗
((
l
+
ₗ
off
)
↦
v
∗
∀
v'
,
(
l
+
ₗ
off
)
↦
v'
-
∗
l
↦∗
<[
off
:
=
v'
]>
vs
))%
I
.
[
∗
list
]
i
∈
seq
0
n
,
(
l
+
ₗ
(
i
:
nat
))
↦
v
.
Proof
.
Proof
.
iIntros
(
Hlookup
)
"Hl"
.
iIntros
"Hvs"
.
iInduction
n
as
[|
n
]
"IH"
forall
(
l
)
;
simpl
.
rewrite
-[
X
in
(
l
↦∗
X
)%
I
](
take_drop_middle
_
off
v
)
;
last
done
.
{
done
.
}
iDestruct
(
array_app
with
"Hl"
)
as
"[Hl1 Hl]"
.
rewrite
big_opM_union
;
last
first
.
iDestruct
(
array_cons
with
"Hl"
)
as
"[Hl2 Hl3]"
.
{
apply
map_disjoint_spec
=>
l'
v1
v2
/
lookup_singleton_Some
[->
_
].
assert
(
off
<
length
vs
)%
nat
as
H
by
(
apply
lookup_lt_is_Some
;
by
eexists
).
intros
(
j
&?&
Hjl
&
_
)%
heap_array_lookup
.
rewrite
take_length
min_l
;
last
by
lia
.
iFrame
"Hl2"
.
rewrite
loc_add_assoc
-{
1
}[
l'
]
loc_add_0
in
Hjl
.
simplify_eq
;
lia
.
}
iIntros
(
w
)
"Hl2"
.
rewrite
loc_add_0
-
fmap_seq
big_sepL_fmap
.
clear
Hlookup
.
assert
(<[
off
:
=
w
]>
vs
!!
off
=
Some
w
)
as
Hlookup
.
setoid_rewrite
Nat2Z
.
inj_succ
.
setoid_rewrite
<-
Z
.
add_1_l
.
{
apply
list_lookup_insert
.
lia
.
}
setoid_rewrite
<-
loc_add_assoc
.
rewrite
-[
in
(
l
↦∗
<[
off
:
=
w
]>
vs
)%
I
](
take_drop_middle
(<[
off
:
=
w
]>
vs
)
off
w
Hlookup
).
rewrite
big_opM_singleton
;
iDestruct
"Hvs"
as
"[$ Hvs]"
.
by
iApply
"IH"
.
iApply
array_app
.
rewrite
take_insert
;
last
by
lia
.
iFrame
.
iApply
array_cons
.
rewrite
take_length
min_l
;
last
by
lia
.
iFrame
.
rewrite
drop_insert
;
last
by
lia
.
done
.
Qed
.
Qed
.
(** Heap *)
Lemma
wp_allocN_seq
s
E
v
n
:
Lemma
wp_allocN
s
E
v
n
:
0
<
n
→
0
<
n
→
{{{
True
}}}
AllocN
(
Val
$
LitV
$
LitInt
$
n
)
(
Val
v
)
@
s
;
E
{{{
True
}}}
AllocN
(
Val
$
LitV
$
LitInt
$
n
)
(
Val
v
)
@
s
;
E
{{{
l
,
RET
LitV
(
LitLoc
l
)
;
l
↦∗
replicate
(
Z
.
to_nat
n
)
v
∗
{{{
l
,
RET
LitV
(
LitLoc
l
)
;
[
∗
list
]
i
∈
seq
0
(
Z
.
to_nat
n
),
[
∗
list
]
i
∈
seq
0
(
Z
.
to_nat
n
),
meta_token
(
l
+
ₗ
(
i
:
nat
))
⊤
}}}.
(
l
+
ₗ
(
i
:
nat
))
↦
v
∗
meta_token
(
l
+
ₗ
(
i
:
nat
))
⊤
}}}.
Proof
.
Proof
.
iIntros
(
Hn
Φ
)
"_ HΦ"
.
iApply
wp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
Hn
Φ
)
"_ HΦ"
.
iApply
wp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
σ
1
κ
κ
s
k
)
"[Hσ Hκs] !>"
;
iSplit
;
first
by
auto
with
lia
.
iIntros
(
σ
1
κ
κ
s
k
)
"[Hσ Hκs] !>"
;
iSplit
;
first
by
auto
with
lia
.
...
@@ -309,15 +265,16 @@ Proof.
...
@@ -309,15 +265,16 @@ Proof.
iMod
(@
gen_heap_alloc_gen
with
"Hσ"
)
as
"(Hσ & Hl & Hm)"
.
iMod
(@
gen_heap_alloc_gen
with
"Hσ"
)
as
"(Hσ & Hl & Hm)"
.
{
apply
(
heap_array_map_disjoint
_
l
(
replicate
(
Z
.
to_nat
n
)
v
))
;
eauto
.
{
apply
(
heap_array_map_disjoint
_
l
(
replicate
(
Z
.
to_nat
n
)
v
))
;
eauto
.
rewrite
replicate_length
Z2Nat
.
id
;
auto
with
lia
.
}
rewrite
replicate_length
Z2Nat
.
id
;
auto
with
lia
.
}
iModIntro
;
iSplit
;
first
done
.
iFrame
"Hσ Hκs"
.
iApply
"HΦ"
.
iSplitL
"Hl"
.
iModIntro
;
iSplit
;
first
done
.
iFrame
"Hσ Hκs"
.
iApply
"HΦ"
.
-
by
iApply
heap_array_to_array
.
iApply
big_sepL_sep
.
iSplitL
"Hl"
.
-
by
iApply
heap_array_to_seq_mapsto
.
-
iApply
(
heap_array_to_seq_meta
with
"Hm"
).
by
rewrite
replicate_length
.
-
iApply
(
heap_array_to_seq_meta
with
"Hm"
).
by
rewrite
replicate_length
.
Qed
.
Qed
.
Lemma
twp_allocN
s
E
v
n
:
Lemma
twp_allocN
_seq
s
E
v
n
:
0
<
n
→
0
<
n
→
[[{
True
}]]
AllocN
(
Val
$
LitV
$
LitInt
$
n
)
(
Val
v
)
@
s
;
E
[[{
True
}]]
AllocN
(
Val
$
LitV
$
LitInt
$
n
)
(
Val
v
)
@
s
;
E
[[{
l
,
RET
LitV
(
LitLoc
l
)
;
l
↦∗
replicate
(
Z
.
to_nat
n
)
v
∗
[[{
l
,
RET
LitV
(
LitLoc
l
)
;
[
∗
list
]
i
∈
seq
0
(
Z
.
to_nat
n
),
[
∗
list
]
i
∈
seq
0
(
Z
.
to_nat
n
),
meta_token
(
l
+
ₗ
(
i
:
nat
))
⊤
}]].
(
l
+
ₗ
(
i
:
nat
))
↦
v
∗
meta_token
(
l
+
ₗ
(
i
:
nat
))
⊤
}]].
Proof
.
Proof
.
iIntros
(
Hn
Φ
)
"_ HΦ"
.
iApply
twp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
Hn
Φ
)
"_ HΦ"
.
iApply
twp_lift_atomic_head_step_no_fork
;
auto
.
iIntros
(
σ
1
κ
s
k
)
"[Hσ Hκs] !>"
;
iSplit
;
first
by
destruct
n
;
auto
with
lia
.
iIntros
(
σ
1
κ
s
k
)
"[Hσ Hκs] !>"
;
iSplit
;
first
by
destruct
n
;
auto
with
lia
.
...
@@ -325,24 +282,23 @@ Proof.
...
@@ -325,24 +282,23 @@ Proof.
iMod
(@
gen_heap_alloc_gen
with
"Hσ"
)
as
"(Hσ & Hl & Hm)"
.
iMod
(@
gen_heap_alloc_gen
with
"Hσ"
)
as
"(Hσ & Hl & Hm)"
.
{
apply
(
heap_array_map_disjoint
_
l
(
replicate
(
Z
.
to_nat
n
)
v
))
;
eauto
.
{
apply
(
heap_array_map_disjoint
_
l
(
replicate
(
Z
.
to_nat
n
)
v
))
;
eauto
.
rewrite
replicate_length
Z2Nat
.
id
;
auto
with
lia
.
}
rewrite
replicate_length
Z2Nat
.
id
;
auto
with
lia
.
}
iModIntro
;
do
2
(
iSplit
;
first
done
).
iFrame
"Hσ Hκs"
.
iApply
"HΦ"
.
iSplitL
"Hl"
.
iModIntro
;
do
2
(
iSplit
;
first
done
).
iFrame
"Hσ Hκs"
.
iApply
"HΦ"
.
-
by
iApply
heap_array_to_array
.
iApply
big_sepL_sep
.
iSplitL
"Hl"
.
-
by
iApply
heap_array_to_seq_mapsto
.
-
iApply
(
heap_array_to_seq_meta
with
"Hm"
).
by
rewrite
replicate_length
.
-
iApply
(
heap_array_to_seq_meta
with
"Hm"
).
by
rewrite
replicate_length
.
Qed
.
Qed
.
Lemma
wp_alloc
s
E
v
:
Lemma
wp_alloc
s
E
v
:
{{{
True
}}}
Alloc
(
Val
v
)
@
s
;
E
{{{
l
,
RET
LitV
(
LitLoc
l
)
;
l
↦
v
∗
meta_token
l
⊤
}}}.
{{{
True
}}}
Alloc
(
Val
v
)
@
s
;
E
{{{
l
,
RET
LitV
(
LitLoc
l
)
;
l
↦
v
∗
meta_token
l
⊤
}}}.
Proof
.
Proof
.
iIntros
(
Φ
)
"_ HΦ"
.
iApply
wp_allocN
;
auto
with
lia
.
iIntros
(
Φ
)
"_ HΦ"
.
iApply
wp_allocN_seq
;
auto
with
lia
.
iIntros
"!>"
(
l
)
"/= (? & ? & _)"
.
iIntros
"!>"
(
l
)
"/= (? & _)"
.
rewrite
loc_add_0
.
iApply
"HΦ"
;
iFrame
.
rewrite
array_singleton
loc_add_0
.
iApply
"HΦ"
;
iFrame
.
Qed
.
Qed
.
Lemma
twp_alloc
s
E
v
:
Lemma
twp_alloc
s
E
v
:
[[{
True
}]]
Alloc
(
Val
v
)
@
s
;
E
[[{
l
,
RET
LitV
(
LitLoc
l
)
;
l
↦
v
∗
meta_token
l
⊤
}]].
[[{
True
}]]
Alloc
(
Val
v
)
@
s
;
E
[[{
l
,
RET
LitV
(
LitLoc
l
)
;
l
↦
v
∗
meta_token
l
⊤
}]].
Proof
.
Proof
.
iIntros
(
Φ
)
"_ HΦ"
.
iApply
twp_allocN
;
auto
with
lia
.
iIntros
(
Φ
)
"_ HΦ"
.
iApply
twp_allocN_seq
;
auto
with
lia
.
iIntros
(
l
)
"/= (? & ? & _)"
.
iIntros
(
l
)
"/= (? & _)"
.
rewrite
loc_add_0
.
iApply
"HΦ"
;
iFrame
.
rewrite
array_singleton
loc_add_0
.
iApply
"HΦ"
;
iFrame
.
Qed
.
Qed
.
Lemma
wp_load
s
E
l
q
v
:
Lemma
wp_load
s
E
l
q
v
:
...
@@ -569,117 +525,4 @@ Proof.
...
@@ -569,117 +525,4 @@ Proof.
iIntros
(
pvs'
->)
"Hp"
.
iApply
"HΦ"
.
eauto
with
iFrame
.
iIntros
(
pvs'
->)
"Hp"
.
iApply
"HΦ"
.
eauto
with
iFrame
.
Qed
.
Qed
.
(** Array lemmas *)
Lemma
wp_allocN_vec
s
E
v
n
:
0
<
n
→
{{{
True
}}}
AllocN
#
n
v
@
s
;
E
{{{
l
,
RET
#
l
;
l
↦∗
vreplicate
(
Z
.
to_nat
n
)
v
∗
[
∗
list
]
i
∈
seq
0
(
Z
.
to_nat
n
),
meta_token
(
l
+
ₗ
(
i
:
nat
))
⊤
}}}.
Proof
.
iIntros
(
Hzs
Φ
)
"_ HΦ"
.
iApply
wp_allocN
;
[
lia
|
done
|
..
].
iNext
.
iIntros
(
l
)
"[Hl Hm]"
.
iApply
"HΦ"
.
rewrite
vec_to_list_replicate
.
iFrame
.
Qed
.
Lemma
wp_load_offset
s
E
l
off
vs
v
:
vs
!!
off
=
Some
v
→
{{{
▷
l
↦∗
vs
}}}
!
#(
l
+
ₗ
off
)
@
s
;
E
{{{
RET
v
;
l
↦∗
vs
}}}.
Proof
.
iIntros
(
Hlookup
Φ
)
"Hl HΦ"
.
iDestruct
(
update_array
l
_
_
_
Hlookup
with
"Hl"
)
as
"[Hl1 Hl2]"
.
iApply
(
wp_load
with
"Hl1"
).
iIntros
"!> Hl1"
.
iApply
"HΦ"
.
iDestruct
(
"Hl2"
$!
v
)
as
"Hl2"
.
rewrite
list_insert_id
;
last
done
.
iApply
"Hl2"
.
iApply
"Hl1"
.
Qed
.
Lemma
wp_load_offset_vec
s
E
l
sz
(
off
:
fin
sz
)
(
vs
:
vec
val
sz
)
:
{{{
▷
l
↦∗
vs
}}}
!
#(
l
+
ₗ
off
)
@
s
;
E
{{{
RET
vs
!!!
off
;
l
↦∗
vs
}}}.
Proof
.
apply
wp_load_offset
.
by
apply
vlookup_lookup
.
Qed
.
Lemma
wp_store_offset
s
E
l
off
vs
v
:
is_Some
(
vs
!!
off
)
→
{{{
▷
l
↦∗
vs
}}}
#(
l
+
ₗ
off
)
<-
v
@
s
;
E
{{{
RET
#()
;
l
↦∗
<[
off
:
=
v
]>
vs
}}}.
Proof
.
iIntros
([
w
Hlookup
]
Φ
)
">Hl HΦ"
.
iDestruct
(
update_array
l
_
_
_
Hlookup
with
"Hl"
)
as
"[Hl1 Hl2]"
.
iApply
(
wp_store
with
"Hl1"
).
iNext
.
iIntros
"Hl1"
.
iApply
"HΦ"
.
iApply
"Hl2"
.
iApply
"Hl1"
.
Qed
.
Lemma
wp_store_offset_vec
s
E
l
sz
(
off
:
fin
sz
)
(
vs
:
vec
val
sz
)
v
:
{{{
▷
l
↦∗
vs
}}}
#(
l
+
ₗ
off
)
<-
v
@
s
;
E
{{{
RET
#()
;
l
↦∗
vinsert
off
v
vs
}}}.
Proof
.
setoid_rewrite
vec_to_list_insert
.
apply
wp_store_offset
.
eexists
.
by
apply
vlookup_lookup
.
Qed
.
Lemma
wp_cmpxchg_suc_offset
s
E
l
off
vs
v'
v1
v2
:
vs
!!
off
=
Some
v'
→