Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Why3
why3
Commits
9f39433d
Commit
9f39433d
authored
Sep 26, 2011
by
Andrei Paskevich
Browse files
WP: preserve absurd in boolean simplification
parent
0cefbf9d
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/programs/pgm_wp.ml
View file @
9f39433d
...
...
@@ -413,6 +413,9 @@ let t_True env = fs_app (find_ls ~pure:true env "True") [] (ty_bool env)
let
t_False
env
=
fs_app
(
find_ls
~
pure
:
true
env
"False"
)
[]
(
ty_bool
env
)
let
mk_t_if
env
f
=
t_if
f
(
t_True
env
)
(
t_False
env
)
let
ls_absurd
=
create_lsymbol
(
id_fresh
"absurd"
)
[]
None
let
t_absurd
=
ps_app
ls_absurd
[]
(*
env : module_uc
rm : Spv.t Mreg.t (maps regions to pvsymbol sets)
...
...
@@ -518,7 +521,7 @@ and wp_desc env rm e q = match e.expr_desc with
let
t
=
t_var
x
.
pv_pure
in
wp_label
e
(
t_case
t
(
List
.
map
branch
bl
))
|
Eabsurd
->
wp_label
e
t_
false
wp_label
e
t_
absurd
|
Eraise
(
x
,
None
)
->
(* $wp(raise E, _, R) = R$ *)
let
_
,
ql
=
q
in
...
...
@@ -689,18 +692,27 @@ let rec remove_at f = match f.t_node with
|
_
->
t_map
remove_at
f
(* replace t_absurd with t_false *)
let
rec
unabsurd
f
=
match
f
.
t_node
with
|
Tapp
(
ls
,
[]
)
when
ls_equal
ls
ls_absurd
->
t_label_copy
f
t_false
|
_
->
t_map
unabsurd
f
let
add_wp_decl
ps
f
uc
=
(* prepare a proposition symbol *)
let
name
=
ps
.
ps_pure
.
ls_name
in
let
s
=
"WP_"
^
name
.
id_string
in
let
label
=
(
"expl:"
^
name
.
id_string
)
::
ps
.
ps_pure
.
ls_name
.
id_label
in
let
label
=
(
"expl:"
^
name
.
id_string
)
::
name
.
id_label
in
let
id
=
id_fresh
~
label
?
loc
:
name
.
id_loc
s
in
let
f
=
bool_to_prop
uc
(
remove_at
f
)
in
let
pr
=
create_prsymbol
id
in
(* prepare the VC formula *)
let
km
=
get_known
(
pure_uc
uc
)
in
let
f
=
remove_at
f
in
let
f
=
bool_to_prop
uc
f
in
let
f
=
eval_match
~
inline
:
inline_nonrec_linear
km
f
in
let
f
=
unabsurd
f
in
(* printf "wp: f=%a@." print_term f; *)
let
pr
=
create_prsymbol
id
in
let
d
=
create_prop_decl
Pgoal
pr
f
in
add_pure_decl
d
uc
...
...
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