Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Why3
why3
Commits
13d2d1bd
Commit
13d2d1bd
authored
Aug 24, 2012
by
Jean-Christophe Filliâtre
Browse files
ghostify ghost arguments
parent
dee9fd28
Changes
3
Hide whitespace changes
Inline
Side-by-side
src/whyml/mlw_expr.ml
View file @
13d2d1bd
...
...
@@ -705,6 +705,8 @@ let e_plapp pls el ity =
|
None
->
t_if_simp
t
t_bool_true
t_bool_false
in
let
evtv
=
vtv_of_expr
e
in
let
ghost
=
ghost
||
(
evtv
.
vtv_ghost
&&
not
vtv
.
vtv_ghost
)
in
if
vtv
.
vtv_ghost
&&
not
evtv
.
vtv_ghost
then
Loc
.
errorm
"non-ghost value passed as a ghost argument"
;
let
eff
=
eff_union
eff
e
.
e_effect
in
let
sbs
=
ity_match
sbs
vtv
.
vtv_ity
evtv
.
vtv_ity
in
app
(
t
::
tl
)
(
add_e_vars
e
varm
)
ghost
eff
sbs
vtvl
argl
...
...
@@ -716,6 +718,8 @@ let e_plapp pls el ity =
let
sbs
=
ity_match
sbs
vtv
.
vtv_ity
pv
.
pv_vtv
.
vtv_ity
in
app
(
t
::
tl
)
(
add_pv_vars
pv
varm
)
ghost
eff
sbs
vtvl
argl
in
if
vtv
.
vtv_ghost
&&
not
(
vty_ghost
e
.
e_vty
)
then
Loc
.
errorm
"non-ghost value passed as a ghost argument"
;
on_value
apply_to_pv
e
in
let
vtvl
=
List
.
rev
pls
.
pl_args
in
...
...
src/whyml/mlw_ty.ml
View file @
13d2d1bd
...
...
@@ -999,6 +999,8 @@ let vta_app vta pv =
|
vty
->
vty
in
let
result
=
vty_subst
vta
.
vta_result
in
let
spec
=
spec_subst
sbs
vta
.
vta_spec
in
if
not
vtv
.
vtv_ghost
&&
arg
.
pv_vtv
.
vtv_ghost
then
Loc
.
errorm
"non-ghost value passed as a ghost argument"
;
let
ghost
=
vta
.
vta_ghost
||
(
vtv
.
vtv_ghost
&&
not
arg
.
pv_vtv
.
vtv_ghost
)
in
if
rest
=
[]
then
spec
,
(
if
ghost
then
vty_ghostify
result
else
result
)
else
spec_empty
ty_unit
,
VTarrow
(
vty_arrow_unsafe
rest
~
ghost
~
spec
result
)
src/whyml/mlw_typing.ml
View file @
13d2d1bd
...
...
@@ -950,6 +950,22 @@ let vty_ghostify gh vty =
let
e_ghostify
gh
e
=
if
gh
&&
not
(
vty_ghost
e
.
e_vty
)
then
e_ghost
e
else
e
let
e_app_gh
e
el
=
let
rec
decomp
=
function
|
VTvalue
_
->
[]
|
VTarrow
a
->
a
.
vta_args
@
decomp
a
.
vta_result
in
let
rec
ghostify
=
function
|
_
,
[]
->
[]
|
[]
,
_
->
assert
false
|
pv
::
pvl
,
e
::
el
->
e_ghostify
pv
.
pv_vtv
.
vtv_ghost
e
::
ghostify
(
pvl
,
el
)
in
e_app
e
(
ghostify
(
decomp
e
.
e_vty
,
el
))
let
e_plapp_gh
pl
el
ity
=
let
ghostify
vtv
e
=
e_ghostify
vtv
.
vtv_ghost
e
in
e_plapp
pl
(
List
.
map2
ghostify
pl
.
pl_args
el
)
ity
let
rec
expr
lenv
de
=
let
loc
=
de
.
de_loc
in
let
e
=
Loc
.
try3
loc
expr_desc
lenv
loc
de
in
...
...
@@ -1019,9 +1035,9 @@ and expr_desc lenv loc de = match de.de_desc with
|
DEapply
(
de1
,
del
)
->
let
el
=
List
.
map
(
expr
lenv
)
del
in
begin
match
de1
.
de_desc
with
|
DEglobal_pl
pls
->
e_plapp
pls
el
(
ity_of_dity
(
snd
de
.
de_type
))
|
DEglobal_ls
ls
->
e_lapp
ls
el
(
ity_of_dity
(
snd
de
.
de_type
))
|
_
->
e_app
(
expr
lenv
de1
)
el
|
DEglobal_pl
pls
->
e_plapp
_gh
pls
el
(
ity_of_dity
(
snd
de
.
de_type
))
|
DEglobal_ls
ls
->
e_lapp
ls
el
(
ity_of_dity
(
snd
de
.
de_type
))
|
_
->
e_app
_gh
(
expr
lenv
de1
)
el
end
|
DEglobal_pv
pv
->
e_value
pv
...
...
Write
Preview
Supports
Markdown
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