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
0
Issues
0
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
Rice Wine
Iris
Commits
90c6d1b9
Commit
90c6d1b9
authored
Jan 30, 2016
by
Ralf Jung
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
add <= to our language
parent
1aa86df2
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
43 additions
and
1 deletion
+43
-1
barrier/heap_lang.v
barrier/heap_lang.v
+13
-1
barrier/lifting.v
barrier/lifting.v
+30
-0
No files found.
barrier/heap_lang.v
View file @
90c6d1b9
...
...
@@ -9,9 +9,10 @@ Inductive expr :=
|
Var
(
x
:
var
)
|
Rec
(
e
:
{
bind
2
of
expr
})
(* These are recursive lambdas. The *inner* binder is the recursive call! *)
|
App
(
e1
e2
:
expr
)
(* Natural numbers *)
(* RJ TODO: Either add minus and le, or replace Plus by a NatCase : nat -> () + nat *)
(* Natural numbers *)
|
LitNat
(
n
:
nat
)
|
Plus
(
e1
e2
:
expr
)
|
Le
(
e1
e2
:
expr
)
(* Unit *)
|
LitUnit
(* Products *)
...
...
@@ -40,6 +41,7 @@ Instance SubstLemmas_expr : SubstLemmas expr. derive. Qed.
Definition
Lam
(
e
:
{
bind
expr
})
:
=
Rec
(
e
.[
ren
(+
1
)]).
Definition
Let
(
e1
:
expr
)
(
e2
:
{
bind
expr
})
:
=
App
(
Lam
e2
)
e1
.
Definition
Seq
(
e1
e2
:
expr
)
:
=
Let
e1
(
e2
.[
ren
(+
1
)]).
Definition
If
(
e0
e1
e2
:
expr
)
:
=
Case
e0
(
e1
.[
ren
(+
1
)])
(
e2
.[
ren
(+
1
)]).
Inductive
value
:
=
|
RecV
(
e
:
{
bind
2
of
expr
})
...
...
@@ -122,6 +124,8 @@ Inductive ectx :=
|
AppRCtx
(
v1
:
value
)
(
K2
:
ectx
)
|
PlusLCtx
(
K1
:
ectx
)
(
e2
:
expr
)
|
PlusRCtx
(
v1
:
value
)
(
K2
:
ectx
)
|
LeLCtx
(
K1
:
ectx
)
(
e2
:
expr
)
|
LeRCtx
(
v1
:
value
)
(
K2
:
ectx
)
|
PairLCtx
(
K1
:
ectx
)
(
e2
:
expr
)
|
PairRCtx
(
v1
:
value
)
(
K2
:
ectx
)
|
FstCtx
(
K
:
ectx
)
...
...
@@ -145,6 +149,8 @@ Fixpoint fill (K : ectx) (e : expr) :=
|
AppRCtx
v1
K2
=>
App
(
v2e
v1
)
(
fill
K2
e
)
|
PlusLCtx
K1
e2
=>
Plus
(
fill
K1
e
)
e2
|
PlusRCtx
v1
K2
=>
Plus
(
v2e
v1
)
(
fill
K2
e
)
|
LeLCtx
K1
e2
=>
Le
(
fill
K1
e
)
e2
|
LeRCtx
v1
K2
=>
Le
(
v2e
v1
)
(
fill
K2
e
)
|
PairLCtx
K1
e2
=>
Pair
(
fill
K1
e
)
e2
|
PairRCtx
v1
K2
=>
Pair
(
v2e
v1
)
(
fill
K2
e
)
|
FstCtx
K
=>
Fst
(
fill
K
e
)
...
...
@@ -168,6 +174,8 @@ Fixpoint comp_ctx (Ko : ectx) (Ki : ectx) :=
|
AppRCtx
v1
K2
=>
AppRCtx
v1
(
comp_ctx
K2
Ki
)
|
PlusLCtx
K1
e2
=>
PlusLCtx
(
comp_ctx
K1
Ki
)
e2
|
PlusRCtx
v1
K2
=>
PlusRCtx
v1
(
comp_ctx
K2
Ki
)
|
LeLCtx
K1
e2
=>
LeLCtx
(
comp_ctx
K1
Ki
)
e2
|
LeRCtx
v1
K2
=>
LeRCtx
v1
(
comp_ctx
K2
Ki
)
|
PairLCtx
K1
e2
=>
PairLCtx
(
comp_ctx
K1
Ki
)
e2
|
PairRCtx
v1
K2
=>
PairRCtx
v1
(
comp_ctx
K2
Ki
)
|
FstCtx
K
=>
FstCtx
(
comp_ctx
K
Ki
)
...
...
@@ -240,6 +248,10 @@ Inductive prim_step : expr -> state -> expr -> state -> option expr -> Prop :=
prim_step
(
App
(
Rec
e1
)
e2
)
σ
(
e1
.[(
Rec
e1
),
e2
/])
σ
None
|
PlusS
n1
n2
σ
:
prim_step
(
Plus
(
LitNat
n1
)
(
LitNat
n2
))
σ
(
LitNat
(
n1
+
n2
))
σ
None
|
LeTrueS
n1
n2
σ
(
Hle
:
n1
≤
n2
)
:
prim_step
(
Le
(
LitNat
n1
)
(
LitNat
n2
))
σ
LitTrue
σ
None
|
LeFalseS
n1
n2
σ
(
Hle
:
n1
>
n2
)
:
prim_step
(
Le
(
LitNat
n1
)
(
LitNat
n2
))
σ
LitFalse
σ
None
|
FstS
e1
v1
e2
v2
σ
(
Hv1
:
e2v
e1
=
Some
v1
)
(
Hv2
:
e2v
e2
=
Some
v2
)
:
prim_step
(
Fst
(
Pair
e1
e2
))
σ
e1
σ
None
|
SndS
e1
v1
e2
v2
σ
(
Hv1
:
e2v
e1
=
Some
v1
)
(
Hv2
:
e2v
e2
=
Some
v2
)
:
...
...
barrier/lifting.v
View file @
90c6d1b9
...
...
@@ -252,6 +252,36 @@ Proof.
rewrite
-
wp_value'
;
last
reflexivity
;
done
.
Qed
.
Lemma
wp_le_true
n1
n2
E
Q
:
n1
≤
n2
→
▷
Q
LitTrueV
⊑
wp
(
Σ
:
=
Σ
)
E
(
Le
(
LitNat
n1
)
(
LitNat
n2
))
Q
.
Proof
.
intros
Hle
.
etransitivity
;
last
eapply
wp_lift_pure_step
with
(
φ
:
=
λ
e'
,
e'
=
LitTrue
)
;
last
first
.
-
intros
?
?
?
?
Hstep
.
inversion_clear
Hstep
;
first
done
.
exfalso
.
eapply
le_not_gt
with
(
n
:
=
n1
)
;
eassumption
.
-
intros
?.
do
3
eexists
.
econstructor
;
done
.
-
reflexivity
.
-
apply
later_mono
,
forall_intro
=>
e2
.
apply
impl_intro_l
.
apply
const_elim_l
=>->.
rewrite
-
wp_value'
;
last
reflexivity
;
done
.
Qed
.
Lemma
wp_le_false
n1
n2
E
Q
:
n1
>
n2
→
▷
Q
LitFalseV
⊑
wp
(
Σ
:
=
Σ
)
E
(
Le
(
LitNat
n1
)
(
LitNat
n2
))
Q
.
Proof
.
intros
Hle
.
etransitivity
;
last
eapply
wp_lift_pure_step
with
(
φ
:
=
λ
e'
,
e'
=
LitFalse
)
;
last
first
.
-
intros
?
?
?
?
Hstep
.
inversion_clear
Hstep
;
last
done
.
exfalso
.
eapply
le_not_gt
with
(
n
:
=
n1
)
;
eassumption
.
-
intros
?.
do
3
eexists
.
econstructor
;
done
.
-
reflexivity
.
-
apply
later_mono
,
forall_intro
=>
e2
.
apply
impl_intro_l
.
apply
const_elim_l
=>->.
rewrite
-
wp_value'
;
last
reflexivity
;
done
.
Qed
.
Lemma
wp_fst
e1
v1
e2
v2
E
Q
:
e2v
e1
=
Some
v1
→
e2v
e2
=
Some
v2
→
▷
Q
v1
⊑
wp
(
Σ
:
=
Σ
)
E
(
Fst
(
Pair
e1
e2
))
Q
.
...
...
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