Skip to content
GitLab
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
08c883d6
Commit
08c883d6
authored
Apr 26, 2012
by
Andrei Paskevich
Browse files
whyml: application
parent
2a1ef857
Changes
2
Hide whitespace changes
Inline
Side-by-side
src/whyml/mlw_expr.ml
View file @
08c883d6
...
...
@@ -111,6 +111,7 @@ type expr = {
and
expr_node
=
|
Elogic
of
term
|
Evalue
of
pvsymbol
|
Earrow
of
pasymbol
|
Einst
of
psymbol
*
ity_subst
|
Eapp
of
pasymbol
*
pvsymbol
...
...
@@ -184,7 +185,7 @@ let add_expr_regs m e =
Mid
.
union
(
fun
_
s1
s2
->
Some
(
Sreg
.
union
s1
s2
))
m
e
.
e_regs
let
e_value
pv
=
{
(
e_dummy
(
E
logic
(
t_var
pv
.
pv_vs
)
)
(
VTvalue
pv
.
pv_vtv
))
with
{
(
e_dummy
(
E
value
pv
)
(
VTvalue
pv
.
pv_vtv
))
with
e_tvs
=
add_pv_tvs
Mid
.
empty
pv
;
e_regs
=
add_pv_regs
Mid
.
empty
pv
;
}
...
...
@@ -248,7 +249,7 @@ let e_let ({ let_var = lv ; let_expr = d } as ld) e =
let
tvs
=
Mid
.
remove
id
e
.
e_tvs
in
let
regs
=
Mid
.
remove
id
e
.
e_regs
in
(* If we reset some region in the first expression d, then it may only
p
ccur in the second expression e in association to pv. Otherwise,
o
ccur in the second expression e in association to pv. Otherwise,
this is a freshness violation: some symbol defined earlier carries
that region into e. *)
(* FIXME? bad complexity, we should be able to do better *)
...
...
@@ -281,6 +282,46 @@ let e_let ({ let_var = lv ; let_expr = d } as ld) e =
e_tvs
=
add_expr_tvs
tvs
d
;
e_regs
=
add_expr_regs
regs
d
;
}
exception
ValueExpected
of
expr
exception
ArrowExpected
of
expr
(* We adopt right-to-left evaluation order so that expression
get_ref (create_ref 5)
produces
let pv : ref<ro> int =
let pv1 : int = Elogic 5 in
let pa1 : int -> ref<ro> int = Einst create_ref in
Eapp pa1 pv1 [reset ro]
in
let pa : ref<ro> int -> int = Einst get_ref in
Eapp pa pv [read ro]
which is ok. If pa is computed before pv, then Eapp pa pv would
violate the freshness of ro. *)
let
e_eapp
e
el
=
let
rec
app
=
function
|
[]
->
e
|
e
::
el
->
let
left
pv
=
match
app
el
with
|
{
e_node
=
Earrow
pa
}
->
e_app
pa
pv
|
e
->
let
ld
=
create_let_defn
(
id_fresh
"o"
)
e
in
let
pa
=
match
ld
.
let_var
with
|
LetV
_
->
raise
(
ArrowExpected
e
)
|
LetA
pa
->
pa
in
e_let
ld
(
e_app
pa
pv
)
in
begin
match
e
.
e_node
with
|
Evalue
pv
->
left
pv
|
_
->
let
ld
=
create_let_defn
(
id_fresh
"o"
)
e
in
let
pv
=
match
ld
.
let_var
with
|
LetA
_
->
raise
(
ValueExpected
e
)
|
LetV
pv
->
pv
in
left
pv
end
in
app
(
List
.
rev
el
)
(*
- A "proper type" of a vty [v] is [v] with empty specification
(effect/pre/post/xpost). Basically, it is formed from pv_ity's
...
...
src/whyml/mlw_expr.mli
View file @
08c883d6
...
...
@@ -115,6 +115,7 @@ type expr = private {
and
expr_node
=
private
|
Elogic
of
term
|
Evalue
of
pvsymbol
|
Earrow
of
pasymbol
|
Einst
of
psymbol
*
ity_subst
|
Eapp
of
pasymbol
*
pvsymbol
...
...
@@ -170,6 +171,8 @@ exception GhostRaise of expr * xsymbol
val
e_app
:
pasymbol
->
pvsymbol
->
expr
val
e_eapp
:
expr
->
expr
list
->
expr
val
create_let_defn
:
preid
->
expr
->
let_defn
exception
StaleRegion
of
region
*
ident
*
expr
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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