Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
why3
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
119
Issues
119
List
Boards
Labels
Service Desk
Milestones
Merge Requests
16
Merge Requests
16
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
Why3
why3
Commits
a3bb9642
Commit
a3bb9642
authored
Jul 12, 2012
by
Asma Tafat-Bouzid
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
preuves avec typage
parent
04fe976c
Changes
6
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
1698 additions
and
512 deletions
+1698
-512
examples/hoare_logic/blocking_semantics/blocking_semantics_WP_progress_1.v
...gic/blocking_semantics/blocking_semantics_WP_progress_1.v
+68
-74
examples/hoare_logic/blocking_semantics/why3session.xml
examples/hoare_logic/blocking_semantics/why3session.xml
+1
-1
examples/hoare_logic/blocking_semantics2.mlw
examples/hoare_logic/blocking_semantics2.mlw
+129
-37
examples/hoare_logic/blocking_semantics2/blocking_semantics2_WP_bool_value_1.v
...blocking_semantics2/blocking_semantics2_WP_bool_value_1.v
+273
-283
examples/hoare_logic/blocking_semantics2/blocking_semantics2_WP_progress_1.v
...c/blocking_semantics2/blocking_semantics2_WP_progress_1.v
+461
-117
examples/hoare_logic/blocking_semantics2/why3session.xml
examples/hoare_logic/blocking_semantics2/why3session.xml
+766
-0
No files found.
examples/hoare_logic/blocking_semantics/blocking_semantics_WP_progress_1.v
View file @
a3bb9642
...
...
@@ -213,9 +213,9 @@ Unset Implicit Arguments.
Axiom
subst_fresh
:
forall
(
f
:
fmla
)
(
x
:
ident
)
(
v
:
ident
),
(
fresh_in_fmla
x
f
)
->
((
subst
f
x
v
)
=
f
).
Axiom
let_subst
:
forall
(
t
:
term
)
(
f
:
fmla
)
(
x
:
ident
)
(
id
:
ident
)
(
id
qt
:
ident
),
((
subst
(
Flet
x
t
f
)
id
id
qt
)
=
(
Flet
x
(
subst_term
t
id
idqt
)
(
subst
f
id
id
qt
))).
Axiom
let_subst
:
forall
(
t
:
term
)
(
f
:
fmla
)
(
x
:
ident
)
(
id
:
ident
)
(
id
'
:
ident
),
((
subst
(
Flet
x
t
f
)
id
id
'
)
=
(
Flet
x
(
subst_term
t
id
id
'
)
(
subst
f
id
id
'
))).
Axiom
eval_subst
:
forall
(
f
:
fmla
)
(
sigma
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
x
:
ident
)
(
v
:
ident
),
(
fresh_in_fmla
v
f
)
->
...
...
@@ -235,9 +235,9 @@ Axiom eval_change_free : forall (f:fmla) (sigma:(map ident value)) (pi:(list
Definition
valid_fmla
(
p
:
fmla
)
:
Prop
:=
forall
(
sigma
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
)),
(
eval_fmla
sigma
pi
p
).
Axiom
let_equiv
:
forall
(
id
:
ident
)
(
id
qt
:
ident
)
(
t
:
term
)
(
f
:
fmla
),
Axiom
let_equiv
:
forall
(
id
:
ident
)
(
id
'
:
ident
)
(
t
:
term
)
(
f
:
fmla
),
forall
(
sigma
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
)),
(
eval_fmla
sigma
pi
(
Flet
id
qt
t
(
subst
f
id
idqt
)))
->
(
eval_fmla
sigma
pi
(
eval_fmla
sigma
pi
(
Flet
id
'
t
(
subst
f
id
id
'
)))
->
(
eval_fmla
sigma
pi
(
Flet
id
t
f
)).
(
*
Why3
assumption
*
)
...
...
@@ -282,50 +282,49 @@ Inductive one_step : (map ident value) -> (list (ident* value)%type) -> expr
|
one_step_deref
:
forall
(
sigma
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
v
:
ident
),
(
one_step
sigma
pi
(
Ederef
v
)
sigma
pi
(
Evalue
(
get
sigma
v
)))
|
one_step_bin_ctxt1
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
qt
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
qt
:
(
list
(
ident
*
value
)
%
type
))
(
op
:
operator
)
(
e1
:
expr
)
(
e1
qt
:
expr
)
(
e2
:
expr
),
(
one_step
sigma
pi
e1
sigma
qt
piqt
e1qt
)
->
(
one_step
sigma
pi
(
Ebin
e1
op
e2
)
sigmaqt
piqt
(
Ebin
e1qt
op
e2
))
|
one_step_bin_ctxt2
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
qt
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
qt
:
(
list
(
ident
*
value
)
%
type
))
(
op
:
operator
)
(
v1
:
value
)
(
e2
:
expr
)
(
e2
qt
:
expr
),
(
one_step
sigma
pi
e2
sigma
qt
piqt
e2qt
)
->
(
one_step
sigma
pi
(
Ebin
(
Evalue
v1
)
op
e2
)
sigma
qt
piqt
(
Ebin
(
Evalue
v1
)
op
e2qt
))
|
one_step_bin_value
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
qt
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
qt
:
(
list
(
ident
*
|
one_step_bin_ctxt1
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
'
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
'
:
(
list
(
ident
*
value
)
%
type
))
(
op
:
operator
)
(
e1
:
expr
)
(
e1
'
:
expr
)
(
e2
:
expr
),
(
one_step
sigma
pi
e1
sigma
'
pi
'
e1
'
)
->
(
one_step
sigma
pi
(
Ebin
e1
op
e2
)
sigma
'
pi
'
(
Ebin
e1
'
op
e2
))
|
one_step_bin_ctxt2
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
'
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
'
:
(
list
(
ident
*
value
)
%
type
))
(
op
:
operator
)
(
v1
:
value
)
(
e2
:
expr
)
(
e2
'
:
expr
),
(
one_step
sigma
pi
e2
sigma
'
pi
'
e2
'
)
->
(
one_step
sigma
pi
(
Ebin
(
Evalue
v1
)
op
e2
)
sigma
'
pi
'
(
Ebin
(
Evalue
v1
)
op
e2
'
))
|
one_step_bin_value
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
'
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
'
:
(
list
(
ident
*
value
)
%
type
))
(
op
:
operator
)
(
v1
:
value
)
(
v2
:
value
),
(
one_step
sigma
pi
(
Ebin
(
Evalue
v1
)
op
(
Evalue
v2
))
sigma
qt
piqt
(
Evalue
(
eval_bin
v1
op
(
Ebin
(
Evalue
v1
)
op
(
Evalue
v2
))
sigma
'
pi
'
(
Evalue
(
eval_bin
v1
op
v2
)))
|
one_step_assign_ctxt
:
forall
(
sigma
:
(
map
ident
value
))
(
sigmaqt
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
piqt
:
(
list
(
ident
*
value
)
%
type
))
(
x
:
ident
)
(
e
:
expr
)
(
eqt
:
expr
),
(
one_step
sigma
pi
e
sigmaqt
piqt
eqt
)
->
(
one_step
sigma
pi
(
Eassign
x
e
)
sigmaqt
piqt
(
Eassign
x
eqt
))
|
one_step_assign_ctxt
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
'
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
'
:
(
list
(
ident
*
value
)
%
type
))
(
x
:
ident
)
(
e
:
expr
)
(
e
'
:
expr
),
(
one_step
sigma
pi
e
sigma
'
pi
'
e
'
)
->
(
one_step
sigma
pi
(
Eassign
x
e
)
sigma
'
pi
'
(
Eassign
x
e
'
))
|
one_step_assign_value
:
forall
(
sigma
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
x
:
ident
)
(
v
:
value
),
(
one_step
sigma
pi
(
Eassign
x
(
Evalue
v
))
(
set
sigma
x
v
)
pi
(
Evalue
Vvoid
))
|
one_step_seq_ctxt
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
qt
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
qt
:
(
list
(
ident
*
value
)
%
type
))
(
e1
:
expr
)
(
e1
qt
:
expr
)
(
e2
:
expr
),
(
one_step
sigma
pi
e1
sigma
qt
piqt
e1qt
)
->
(
one_step
sigma
pi
(
Eseq
e1
e2
)
sigmaqt
piqt
(
Eseq
e1qt
e2
))
|
one_step_seq_ctxt
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
'
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
'
:
(
list
(
ident
*
value
)
%
type
))
(
e1
:
expr
)
(
e1
'
:
expr
)
(
e2
:
expr
),
(
one_step
sigma
pi
e1
sigma
'
pi
'
e1
'
)
->
(
one_step
sigma
pi
(
Eseq
e1
e2
)
sigma
'
pi
'
(
Eseq
e1
'
e2
))
|
one_step_seq_value
:
forall
(
sigma
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
e
:
expr
),
(
one_step
sigma
pi
(
Eseq
(
Evalue
Vvoid
)
e
)
sigma
pi
e
)
|
one_step_let_ctxt
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
qt
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
qt
:
(
list
(
ident
*
value
)
%
type
))
(
id
:
ident
)
(
e1
:
expr
)
(
e1
qt
:
expr
)
(
e2
:
expr
),
(
one_step
sigma
pi
e1
sigma
qt
piqt
e1qt
)
->
(
one_step
sigma
pi
(
Elet
id
e
1
e2
)
sigmaqt
piqt
(
Elet
id
e1qt
e2
))
|
one_step_let_ctxt
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
'
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
'
:
(
list
(
ident
*
value
)
%
type
))
(
id
:
ident
)
(
e1
:
expr
)
(
e1
'
:
expr
)
(
e2
:
expr
),
(
one_step
sigma
pi
e1
sigma
'
pi
'
e1
'
)
->
(
one_step
sigma
pi
(
Elet
id
e1
e
2
)
sigma
'
pi
'
(
Elet
id
e1
'
e2
))
|
one_step_let_value
:
forall
(
sigma
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
id
:
ident
)
(
v
:
value
)
(
e
:
expr
),
(
one_step
sigma
pi
(
Elet
id
(
Evalue
v
)
e
)
sigma
(
Cons
(
id
,
v
)
pi
)
e
)
|
one_step_if_ctxt
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
qt
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
qt
:
(
list
(
ident
*
value
)
%
type
))
(
e1
:
expr
)
(
e1
qt
:
expr
)
(
e2
:
expr
)
(
e3
:
expr
),
(
one_step
sigma
pi
e1
sigmaqt
piqt
e1qt
)
->
(
one_step
sigma
pi
(
Eif
e1
e2
e3
)
sigmaqt
piqt
(
Eif
e1qt
e2
e3
))
|
one_step_if_ctxt
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
'
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
'
:
(
list
(
ident
*
value
)
%
type
))
(
e1
:
expr
)
(
e1
'
:
expr
)
(
e2
:
expr
)
(
e3
:
expr
),
(
one_step
sigma
pi
e1
sigma
'
pi
'
e1
'
)
->
(
one_step
sigma
pi
(
Eif
e1
e2
e3
)
sigma
'
pi
'
(
Eif
e1
'
e2
e3
))
|
one_step_if_true
:
forall
(
sigma
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
e1
:
expr
)
(
e2
:
expr
),
(
one_step
sigma
pi
(
Eif
(
Evalue
(
Vbool
true
))
e1
e2
)
sigma
pi
e1
)
...
...
@@ -375,26 +374,25 @@ Axiom many_steps_let : forall (sigma1:(map ident value)) (sigma3:(map ident
n1
)
/
\
((
many_steps
sigma2
(
Cons
(
id
,
v1
)
pi2
)
e2
sigma3
pi3
(
Evalue
v2
)
n2
)
/
\
(
n
=
((
1
%
Z
+
n1
)
%
Z
+
n2
)
%
Z
)).
Axiom
one_step_change_free
:
forall
(
e
:
expr
)
(
e
qt
:
expr
)
(
sigma
:
(
map
ident
value
))
(
sigma
qt
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
qt
:
(
list
(
ident
*
value
)
%
type
))
(
id
:
ident
)
(
v
:
value
),
(
fresh_in_expr
id
e
)
->
((
one_step
sigma
(
Cons
(
id
,
v
)
pi
)
e
sigma
qt
piqt
eqt
)
->
(
one_step
sigma
pi
e
sigma
qt
piqt
eqt
)).
Axiom
one_step_change_free
:
forall
(
e
:
expr
)
(
e
'
:
expr
)
(
sigma
:
(
map
ident
value
))
(
sigma
'
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
'
:
(
list
(
ident
*
value
)
%
type
))
(
id
:
ident
)
(
v
:
value
),
(
fresh_in_expr
id
e
)
->
((
one_step
sigma
(
Cons
(
id
,
v
)
pi
)
e
sigma
'
pi
'
e
'
)
->
(
one_step
sigma
pi
e
sigma
'
pi
'
e
'
)).
(
*
Why3
assumption
*
)
Definition
valid_triple
(
p
:
fmla
)
(
e
:
expr
)
(
q
:
fmla
)
:
Prop
:=
forall
(
sigma
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
)),
(
eval_fmla
sigma
pi
p
)
->
forall
(
sigma
qt
:
(
map
ident
value
))
(
piqt
:
(
list
(
ident
*
value
)
%
type
))
(
v
:
value
)
(
n
:
Z
),
(
many_steps
sigma
pi
e
sigma
qt
piqt
(
Evalue
v
)
n
)
->
(
eval_fmla
sigma
qt
(
Cons
(
result
,
v
)
piqt
)
q
).
forall
(
sigma
'
:
(
map
ident
value
))
(
pi
'
:
(
list
(
ident
*
value
)
%
type
))
(
v
:
value
)
(
n
:
Z
),
(
many_steps
sigma
pi
e
sigma
'
pi
'
(
Evalue
v
)
n
)
->
(
eval_fmla
sigma
'
(
Cons
(
result
,
v
)
pi
'
)
q
).
(
*
Why3
assumption
*
)
Definition
total_valid_triple
(
p
:
fmla
)
(
e
:
expr
)
(
q
:
fmla
)
:
Prop
:=
forall
(
sigma
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
)),
(
eval_fmla
sigma
pi
p
)
->
exists
sigmaqt
:
(
map
ident
value
),
exists
piqt
:
(
list
(
ident
*
value
)
%
type
),
exists
v
:
value
,
exists
n
:
Z
,
(
many_steps
sigma
pi
e
sigmaqt
piqt
(
Evalue
v
)
n
)
/
\
(
eval_fmla
sigmaqt
(
Cons
(
result
,
v
)
piqt
)
q
).
(
eval_fmla
sigma
pi
p
)
->
exists
sigma
'
:
(
map
ident
value
),
exists
pi
'
:
(
list
(
ident
*
value
)
%
type
),
exists
v
:
value
,
exists
n
:
Z
,
(
many_steps
sigma
pi
e
sigma
'
pi
'
(
Evalue
v
)
n
)
/
\
(
eval_fmla
sigma
'
(
Cons
(
result
,
v
)
pi
'
)
q
).
Parameter
set1
:
forall
(
a
:
Type
),
Type
.
...
...
@@ -478,9 +476,9 @@ Unset Contextual Implicit.
Axiom
all_def
:
forall
(
a
:
Type
),
forall
(
x
:
a
),
(
mem
x
(
all
:
(
set1
a
))).
(
*
Why3
assumption
*
)
Definition
assigns
(
sigma
:
(
map
ident
value
))
(
a
:
(
set1
ident
))
(
sigma
qt
:
(
map
Definition
assigns
(
sigma
:
(
map
ident
value
))
(
a
:
(
set1
ident
))
(
sigma
'
:
(
map
ident
value
))
:
Prop
:=
forall
(
i
:
ident
),
(
~
(
mem
i
a
))
->
((
get
sigma
i
)
=
(
get
sigma
qt
i
)).
i
)
=
(
get
sigma
'
i
)).
Axiom
assigns_refl
:
forall
(
sigma
:
(
map
ident
value
))
(
a
:
(
set1
ident
)),
(
assigns
sigma
a
sigma
).
...
...
@@ -489,13 +487,13 @@ Axiom assigns_trans : forall (sigma1:(map ident value)) (sigma2:(map ident
value
))
(
sigma3
:
(
map
ident
value
))
(
a
:
(
set1
ident
)),
((
assigns
sigma1
a
sigma2
)
/
\
(
assigns
sigma2
a
sigma3
))
->
(
assigns
sigma1
a
sigma3
).
Axiom
assigns_union_left
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
qt
:
(
map
Axiom
assigns_union_left
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
'
:
(
map
ident
value
))
(
s1
:
(
set1
ident
))
(
s2
:
(
set1
ident
)),
(
assigns
sigma
s1
sigma
qt
)
->
(
assigns
sigma
(
union
s1
s2
)
sigmaqt
).
sigma
'
)
->
(
assigns
sigma
(
union
s1
s2
)
sigma
'
).
Axiom
assigns_union_right
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
qt
:
(
map
Axiom
assigns_union_right
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
'
:
(
map
ident
value
))
(
s1
:
(
set1
ident
))
(
s2
:
(
set1
ident
)),
(
assigns
sigma
s2
sigma
qt
)
->
(
assigns
sigma
(
union
s1
s2
)
sigmaqt
).
sigma
'
)
->
(
assigns
sigma
(
union
s1
s2
)
sigma
'
).
(
*
Why3
assumption
*
)
Set
Implicit
Arguments
.
...
...
@@ -533,11 +531,11 @@ Fixpoint wp(e:expr) (q:fmla) {struct e}: fmla :=
|
(
Eseq
e1
e2
)
=>
(
wp
e1
(
wp
e2
q
))
|
(
Elet
id
e1
e2
)
=>
(
wp
e1
(
Flet
id
(
Tvar
result
)
(
wp
e2
q
)))
|
(
Ebin
e1
op
e2
)
=>
let
t1
:=
(
fresh_from
q
e
)
in
let
t2
:=
(
fresh_from
(
Fand
(
Fterm
(
Tvar
t1
))
q
)
e
)
in
let
q
qt
:=
(
Flet
result
(
fresh_from
(
Fand
(
Fterm
(
Tvar
t1
))
q
)
e
)
in
let
q
'
:=
(
Flet
result
(
Tbin
(
Tvar
t1
)
op
(
Tvar
t2
))
q
)
in
let
f
:=
(
wp
e2
(
Flet
t2
(
Tvar
result
)
q
qt
))
in
(
wp
e1
(
Flet
t1
(
Tvar
result
)
f
))
|
(
Eassign
x
e1
)
=>
let
id
:=
(
fresh_from
q
e1
)
in
let
q
qt
:=
(
Flet
result
(
Tvalue
Vvoid
)
q
)
in
(
wp
e1
(
Flet
id
(
Tvar
result
)
(
subst
q
qt
x
id
)))
(
Tvar
result
)
q
'
))
in
(
wp
e1
(
Flet
t1
(
Tvar
result
)
f
))
|
(
Eassign
x
e1
)
=>
let
id
:=
(
fresh_from
q
e1
)
in
let
q
'
:=
(
Flet
result
(
Tvalue
Vvoid
)
q
)
in
(
wp
e1
(
Flet
id
(
Tvar
result
)
(
subst
q
'
x
id
)))
|
(
Eif
e1
e2
e3
)
=>
let
f
:=
(
Fand
(
Fimplies
(
Fterm
(
Tvar
result
))
(
wp
e2
q
))
(
Fimplies
(
Fnot
(
Fterm
(
Tvar
result
)))
(
wp
e3
q
)))
in
(
wp
e1
f
)
|
(
Ewhile
cond
inv
body
)
=>
(
Fand
inv
(
abstract_effects
body
(
wp
cond
...
...
@@ -546,9 +544,9 @@ Fixpoint wp(e:expr) (q:fmla) {struct e}: fmla :=
end
.
Unset
Implicit
Arguments
.
Axiom
wp_subst
:
forall
(
e
:
expr
)
(
q
:
fmla
)
(
id
:
ident
)
(
id
qt
:
ident
),
(
fresh_in_expr
id
e
)
->
((
subst
(
wp
e
q
)
id
id
qt
)
=
(
wp
e
(
subst
q
id
id
qt
))).
Axiom
wp_subst
:
forall
(
e
:
expr
)
(
q
:
fmla
)
(
id
:
ident
)
(
id
'
:
ident
),
(
fresh_in_expr
id
e
)
->
((
subst
(
wp
e
q
)
id
id
'
)
=
(
wp
e
(
subst
q
id
id
'
))).
Axiom
wp_implies
:
forall
(
p
:
fmla
)
(
q
:
fmla
),
(
forall
(
sigma
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
)),
(
eval_fmla
sigma
pi
p
)
->
...
...
@@ -560,11 +558,10 @@ Axiom wp_conj : forall (sigma:(map ident value)) (pi:(list (ident*
value
)
%
type
))
(
e
:
expr
)
(
p
:
fmla
)
(
q
:
fmla
),
(
eval_fmla
sigma
pi
(
wp
e
(
Fand
p
q
)))
<->
((
eval_fmla
sigma
pi
(
wp
e
p
))
/
\
(
eval_fmla
sigma
pi
(
wp
e
q
))).
Axiom
wp_reduction
:
forall
(
sigma
:
(
map
ident
value
))
(
sigmaqt
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
piqt
:
(
list
(
ident
*
value
)
%
type
))
(
e
:
expr
)
(
eqt
:
expr
),
(
one_step
sigma
pi
e
sigmaqt
piqt
eqt
)
->
forall
(
q
:
fmla
),
(
eval_fmla
sigma
pi
(
wp
e
q
))
->
(
eval_fmla
sigmaqt
piqt
(
wp
eqt
q
)).
Axiom
wp_reduction
:
forall
(
sigma
:
(
map
ident
value
))
(
sigma
'
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
pi
'
:
(
list
(
ident
*
value
)
%
type
))
(
e
:
expr
)
(
e
'
:
expr
),
(
one_step
sigma
pi
e
sigma
'
pi
'
e
'
)
->
forall
(
q
:
fmla
),
(
eval_fmla
sigma
pi
(
wp
e
q
))
->
(
eval_fmla
sigma
'
pi
'
(
wp
e
'
q
)).
(
*
Why3
assumption
*
)
Definition
not_a_value
(
e
:
expr
)
:
Prop
:=
...
...
@@ -579,9 +576,8 @@ Axiom decide_value : forall (e:expr), (not_a_value e) \/ exists v:value,
(
*
Why3
goal
*
)
Theorem
progress
:
forall
(
e
:
expr
)
(
sigma
:
(
map
ident
value
))
(
pi
:
(
list
(
ident
*
value
)
%
type
))
(
q
:
fmla
),
((
eval_fmla
sigma
pi
(
wp
e
q
))
/
\
(
not_a_value
e
))
->
exists
sigmaqt
:
(
map
ident
value
),
exists
piqt
:
(
list
(
ident
*
value
)
%
type
),
exists
eqt
:
expr
,
(
one_step
sigma
pi
e
sigmaqt
piqt
eqt
).
(
not_a_value
e
))
->
exists
sigma
'
:
(
map
ident
value
),
exists
pi
'
:
(
list
(
ident
*
value
)
%
type
),
exists
e
'
:
expr
,
(
one_step
sigma
pi
e
sigma
'
pi
'
e
'
).
induction
e
.
simpl
;
tauto
.
...
...
@@ -748,6 +744,4 @@ eexists.
eexists
.
eapply
one_step_while
;
auto
.
Qed
.
Qed
.
\ No newline at end of file
examples/hoare_logic/blocking_semantics/why3session.xml
View file @
a3bb9642
...
...
@@ -902,7 +902,7 @@
edited=
"blocking_semantics_WP_progress_1.v"
obsolete=
"false"
archived=
"false"
>
<result
status=
"valid"
time=
"0.7
4
"
/>
<result
status=
"valid"
time=
"0.7
6
"
/>
</proof>
</goal>
</theory>
...
...
examples/hoare_logic/blocking_semantics2.mlw
View file @
a3bb9642
...
...
@@ -29,12 +29,14 @@ type ident
constant result : ident
(** Terms *)
type term =
| Tvalue value
| Tvar ident
| Tderef mident
| Tbin term operator term
(** Formulas *)
type fmla =
| Fterm term
| Fand fmla fmla
...
...
@@ -43,6 +45,19 @@ type fmla =
| Flet ident term fmla (* let id = term in fmla *)
| Fforall ident datatype fmla (* forall id : ty, fmla *)
(** Expressions *)
type expr =
| Evalue value
| Ebin expr operator expr
| Evar ident
| Ederef mident
| Eassign mident expr
| Eseq expr expr
| Elet ident expr expr
| Eif expr expr expr
| Eassert fmla
| Ewhile expr fmla expr (* while cond invariant inv body *)
(** Typing *)
function type_value (v:value) : datatype =
...
...
@@ -69,15 +84,104 @@ type type_env = IdMap.map mident datatype (* map global mutable variables to th
function get_reftype (i:mident) (e:type_env) : datatype = IdMap.get e i
inductive type_term type_env type_stack term datatype =
| Type_value : forall sigma: type_env, pi:type_stack, v:value. type_term sigma pi (Tvalue v) (type_value v)
| Type_var : forall sigma: type_env, pi:type_stack, v: ident, ty:datatype.
(get_vartype v pi = ty) -> type_term sigma pi (Tvar v) (ty)
| Type_deref : forall sigma: type_env, pi:type_stack, v: mident, ty:datatype.
(get_reftype v sigma = ty) -> type_term sigma pi (Tderef v) (ty)
| Type_bin : forall sigma: type_env, pi:type_stack, t1 t2 : term, op:operator, ty1 ty2 ty:datatype.
(type_term sigma pi t1 ty1) /\
(type_term sigma pi t2 ty2) /\
(type_operator op ty1 ty2 ty) -> type_term sigma pi (Tbin t1 op t2) ty
| Type_value :
forall sigma: type_env, pi:type_stack, v:value.
type_term sigma pi (Tvalue v) (type_value v)
| Type_var :
forall sigma: type_env, pi:type_stack, v: ident, ty:datatype.
(get_vartype v pi = ty) -> type_term sigma pi (Tvar v) ty
| Type_deref :
forall sigma: type_env, pi:type_stack, v: mident, ty:datatype.
(get_reftype v sigma = ty) -> type_term sigma pi (Tderef v) ty
| Type_bin :
forall sigma: type_env, pi:type_stack, t1 t2 : term, op:operator, ty1 ty2 ty:datatype.
type_term sigma pi t1 ty1 ->
type_term sigma pi t2 ty2 ->
type_operator op ty1 ty2 ty -> type_term sigma pi (Tbin t1 op t2) ty
inductive type_fmla type_env type_stack fmla =
| Type_term :
forall sigma: type_env, pi:type_stack, t:term.
type_term sigma pi t TYbool ->
type_fmla sigma pi (Fterm t)
| Type_conj :
forall sigma: type_env, pi:type_stack, f1 f2:fmla.
type_fmla sigma pi f1 ->
type_fmla sigma pi f2 ->
type_fmla sigma pi (Fand f1 f2)
| Type_neg :
forall sigma: type_env, pi:type_stack, f:fmla.
type_fmla sigma pi f ->
type_fmla sigma pi (Fnot f)
| Type_implies :
forall sigma: type_env, pi:type_stack, f1 f2:fmla.
type_fmla sigma pi f1 ->
type_fmla sigma pi f2 ->
type_fmla sigma pi (Fimplies f1 f2)
| Type_let :
forall sigma: type_env, pi:type_stack, x:ident, t:term, f:fmla, ty:datatype.
type_term sigma pi t ty ->
type_fmla sigma (Cons (x,ty) pi) f ->
type_fmla sigma pi (Flet x t f)
| Type_forall1 :
forall sigma: type_env, pi:type_stack, x:ident, f:fmla.
type_fmla sigma (Cons (x,TYint) pi) f ->
type_fmla sigma pi (Fforall x TYint f)
| Type_forall2 :
forall sigma: type_env, pi:type_stack, x:ident, f:fmla.
type_fmla sigma (Cons (x,TYbool) pi) f ->
type_fmla sigma pi (Fforall x TYbool f)
| Type_forall3:
forall sigma: type_env, pi:type_stack, x:ident, f:fmla.
type_fmla sigma (Cons (x,TYunit) pi) f ->
type_fmla sigma pi (Fforall x TYunit f)
inductive type_expr type_env type_stack expr datatype =
| Type_evalue :
forall sigma: type_env, pi:type_stack, v:value.
type_expr sigma pi (Evalue v) (type_value v)
| Type_evar :
forall sigma: type_env, pi:type_stack, v:ident, ty:datatype.
(get_vartype v pi = ty) -> type_expr sigma pi (Evar v) ty
| Type_ederef :
forall sigma: type_env, pi:type_stack, v:mident, ty:datatype.
(get_reftype v sigma = ty) -> type_expr sigma pi (Ederef v) ty
| Type_ebin :
forall sigma: type_env, pi:type_stack, e1 e2:expr, op:operator, ty1 ty2 ty:datatype.
type_expr sigma pi e1 ty1 ->
type_expr sigma pi e2 ty2 ->
type_operator op ty1 ty2 ty -> type_expr sigma pi (Ebin e1 op e2) ty
| Type_eseq :
forall sigma: type_env, pi:type_stack, e1 e2:expr, op:operator, ty:datatype.
type_expr sigma pi e1 TYunit ->
type_expr sigma pi e2 ty ->
type_expr sigma pi (Eseq e1 e2) ty
| Type_eassigns :
forall sigma: type_env, pi:type_stack, x:mident, e:expr, ty:datatype.
(get_reftype x sigma = ty) ->
type_expr sigma pi e ty ->
type_expr sigma pi (Eassign x e) TYunit
| Type_elet :
forall sigma: type_env, pi:type_stack, x:ident, e1 e2:expr, ty1 ty2 ty:datatype.
type_expr sigma pi e1 ty1 ->
type_expr sigma (Cons (x,ty2) pi) e2 ty2 ->
type_expr sigma pi (Elet x e1 e2) ty2
| Type_eif :
forall sigma: type_env, pi:type_stack, e1 e2 e3:expr, ty:datatype.
type_expr sigma pi e1 TYbool ->
type_expr sigma pi e2 ty ->
type_expr sigma pi e3 ty ->
type_expr sigma pi (Eif e1 e2 e3) ty
| Type_eassert :
forall sigma: type_env, pi:type_stack, p:fmla, ty:datatype.
type_fmla sigma pi p ->
type_expr sigma pi (Eassert p) TYbool
| Type_ewhile :
forall sigma: type_env, pi:type_stack, guard body:expr, inv:fmla, ty:datatype.
type_fmla sigma pi inv ->
type_expr sigma pi guard TYbool ->
type_expr sigma pi body TYunit ->
type_expr sigma pi (Ewhile guard inv body) TYunit
(** Operational semantic *)
type env = IdMap.map mident value (* map global mutable variables to their value *)
...
...
@@ -216,12 +320,12 @@ lemma subst_fresh :
lemma let_subst:
forall t:term, f:fmla, x id':ident, id :mident.
subst (Flet x t f) id id' = Flet x (subst_term t id id') (
subst f id id')
msubst (Flet x t f) id id' = Flet x (msubst_term t id id') (m
subst f id id')
lemma eval_subst:
forall f:fmla, sigma:env, pi:stack, x:mident, v:ident.
fresh_in_fmla v f ->
(eval_fmla sigma pi (subst f x v) <->
(eval_fmla sigma pi (
m
subst f x v) <->
eval_fmla (IdMap.set sigma x (get_stack v pi)) pi f)
lemma eval_swap:
...
...
@@ -240,25 +344,11 @@ lemma eval_change_free :
predicate valid_fmla (p:fmla) = forall sigma:env, pi:stack. eval_fmla sigma pi p
(** let id' = t in f[id <- id'] <=> let id = t in f*)
(* lemma let_equiv : *)
(* forall id:ident, id':ident, t:term, f:fmla. *)
(* forall sigma:env, pi:stack. *)
(* eval_fmla sigma pi (Flet id' t (subst f id id')) *)
(* -> eval_fmla sigma pi (Flet id t f) *)
(* expressions *)
type expr =
| Evalue value
| Ebin expr operator expr
| Evar ident
| Ederef mident
| Eassign mident expr
| Eseq expr expr
| Elet ident expr expr
| Eif expr expr expr
| Eassert fmla
| Ewhile expr fmla expr (* while cond invariant inv body *)
lemma let_equiv :
forall id:ident, id':ident, t:term, f:fmla.
forall sigma:env, pi:stack.
eval_fmla sigma pi (Flet id' t (subst f id id'))
-> eval_fmla sigma pi (Flet id t f)
predicate fresh_in_expr (id:ident) (e:expr) =
match e with
...
...
@@ -490,7 +580,7 @@ lemma value_rule:
lemma assign_rule:
forall p q:fmla, x:mident, e:expr.
valid_triple p e (subst q x result) ->
valid_triple p e (
m
subst q x result) ->
valid_triple p (Eassign x e) q
lemma seq_rule:
...
...
@@ -614,7 +704,7 @@ predicate expr_writes (e:expr) (w:Set.set mident) =
| Eassign x e ->
let id = fresh_from q e in
let q' = Flet result (Tvalue Vvoid) q in
wp e (Flet id (Tvar result) (subst q' x id))
wp e (Flet id (Tvar result) (
m
subst q' x id))
| Eif e1 e2 e3 ->
let f =
Fand (Fimplies (Fterm (Tvar result)) (wp e2 q))
...
...
@@ -669,13 +759,15 @@ predicate expr_writes (e:expr) (w:Set.set mident) =
forall e:expr. not (is_value e) \/ exists v:value. e = Evalue v
lemma bool_value:
forall e:expr. type_expr sigmat pit e TYbool -> is_value e ->
(e = Tvalue True) \/ (e = Tvalue False).
forall e:expr, sigmat: type_env, pit:type_stack.
type_expr sigmat pit e TYbool -> is_value e ->
(e = Evalue (Vbool Bool.False)) \/ (e = Evalue (Vbool Bool.True))
lemma progress:
forall e:expr, sigma:env, pi:stack, sigmat: type_env, pit: type_stack, ty: datatype, q:fmla.
type_expr sigmat pit e ty -> type_fmla sigmat (Cons(result, ty) pit) q
eval_fmla sigma pi (wp e q) -> not_a_value e ->
type_expr sigmat pit e ty ->
type_fmla sigmat (Cons(result, ty) pit) q ->
eval_fmla sigma pi (wp e q) -> not is_value e ->
exists sigma':env, pi':stack, e':expr.
one_step sigma pi e sigma' pi' e'
...
...
@@ -962,7 +1054,7 @@ end
(***
Local Variables:
compile-command: "why3ide blocking_semantics.mlw"
compile-command: "why3ide blocking_semantics
2
.mlw"
End:
*)
examples/hoare_logic/blocking_semantics2/blocking_semantics2_WP_
progress_2
.v
→
examples/hoare_logic/blocking_semantics2/blocking_semantics2_WP_
bool_value_1
.v
View file @
a3bb9642
This diff is collapsed.
Click to expand it.
examples/hoare_logic/blocking_semantics2/blocking_semantics2_WP_progress_1.v
View file @
a3bb9642
This diff is collapsed.
Click to expand it.
examples/hoare_logic/blocking_semantics2/why3session.xml
0 → 100644
View file @
a3bb9642
This diff is collapsed.
Click to expand it.
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