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
Open sidebar
Why3
why3
Commits
853deb85
Commit
853deb85
authored
Sep 11, 2014
by
Andrei Paskevich
Browse files
Ity: effect instantiation
parent
e017894d
Changes
2
Hide whitespace changes
Inline
Sidebyside
Showing
2 changed files
with
29 additions
and
47 deletions
+29
47
src/mlw/ity.ml
src/mlw/ity.ml
+28
43
src/mlw/ity.mli
src/mlw/ity.mli
+1
4
No files found.
src/mlw/ity.ml
View file @
853deb85
...
...
@@ 720,53 +720,38 @@ let refresh_of_effect e =
Mtv
.
fold
add_rfr
sbst
rfr
)
e
.
eff_writes
Mreg
.
empty
in
{
e
with
eff_resets
=
Mreg
.
union
merge_covers
e
.
eff_resets
rfr
}
(*
exception
IllegalAlias
of
region
let
eff_full_inst
sbs
e
=
(* modified or reset regions in e *)
let wrt = Mreg.map (Util.const ()) e.eff_writes in
let rst = Mreg.map (Util.const ()) e.eff_resets in
let wrt = Sreg.union wrt rst in
let aff = Sreg.fold (fun r acc >
Sreg.add (ity_full_inst sbs r) acc) wrt Sreg.empty in
let check_inst v ity acc =
let i = ity_var_unsafe v in
match i.ity_node with
 Ityvar _ > Sreg.iter (fun r >
if ity_r_occurs r ity then raise (IllegalAlias r)) aff

(* readonly regions in e *)
let ro = Sreg.diff (Mreg.map (Util.const ()) s) wr in
(* all modified or reset regions are instantiated into distinct regions *)
let add_affected reg acc =
let reg = ity_full_inst sbs reg in
Sreg.add_new (IllegalAlias reg) reg acc in
let wrt = Sreg.fold add_affected wrt Sreg.empty in
(* all readonly regions are instantiated outside wr *)
let add_readonly r =
let r = Mreg.find r s in if Sreg.mem r wr then raise (IllegalAlias r) in
Sreg.iter add_readonly ro;
(* calculate instantiated effect *)
let add_sreg r acc = Sreg.add (Mreg.find r s) acc in
let add_mreg r v acc =
Mreg.add (Mreg.find r s) (Opt.map (fun v > Mreg.find v s) v) acc in
(* compute compared type variables *)
let add_stv tv acc =
let ity = Mtv.find tv sbs.ity_subst_tv in
let check () _ = raise (IllegalCompar (tv,ity)) in
ity_s_fold check (fun () _ > ()) () ity;
Stv.union acc ity.ity_vars.vars_tv in
{ e with
eff_writes = Sreg.fold add_sreg e.eff_writes Sreg.empty;
eff_ghostw = Sreg.fold add_sreg e.eff_ghostw Sreg.empty;
eff_resets = Mreg.fold add_mreg e.eff_resets Mreg.empty;
eff_compar = Stv.fold add_stv e.eff_compar Stv.empty;
}
(* all modified or reset regions in e must be instantiated
into distinct regions *)
let
inst
fn
src
=
Mreg
.
fold
(
fun
r
v
acc
>
let
r
=
ity_full_inst
sbs
r
in
Mreg
.
add_new
(
IllegalAlias
r
)
r
(
fn
v
)
acc
)
src
Mreg
.
empty
in
let
writes
=
inst
(
fun
fld
>
fld
)
e
.
eff_writes
in
let
resets
=
inst
(
inst
(
fun
()
>
()
))
e
.
eff_resets
in
let
impact
=
Mreg
.
merge
(
fun
r
fld
cvr
>
match
fld
,
cvr
with

Some
_
,
Some
_
>
raise
(
IllegalAlias
r
)

_
>
Some
()
)
writes
resets
in
(* all type variables must be instantiated into types that are
not affected by the effect, and all unaffected regions must
be instantiated into regions outside [impact].
Now, every region in the instantiated execution is either
brought in by the type substitution and thus is unaffected,
or instantiates one of the original regions and is affected
if and only if the original one is. *)
let
check_inst
v
dst
=
match
ity_var_unsafe
v
with

{
ity_node
=
Ityvar
_
}
>
Sreg
.
iter
(
fun
r
>
if
ity_r_occurs
r
dst
then
raise
(
IllegalAlias
r
))
impact

reg
when
Mreg
.
mem
reg
e
.
eff_writes
>
()

reg
when
Mreg
.
mem
reg
e
.
eff_resets
>
()

_
when
Sreg
.
mem
dst
impact
>
raise
(
IllegalAlias
dst
)

_
>
()
in
Mtv
.
iter
check_inst
sbs
;
{
e
with
eff_writes
=
writes
;
eff_resets
=
resets
}
(*
let eff_filter vars e =
let check r = reg_occurs r vars in
let reset r = function
...
...
src/mlw/ity.mli
View file @
853deb85
...
...
@@ 229,14 +229,11 @@ val eff_assign : effect > (region * pvsymbol * ity) list > effect
val
refresh_of_effect
:
effect
>
effect
(*
val eff_stale_region : effect > varset > bool
exception
IllegalAlias
of
region
exception GhostDiverg
val
eff_full_inst
:
ity
Mtv
.
t
>
effect
>
effect
(*
(** {2 Specification} *)
type pre = term (** precondition: pre_fmla *)
...
...
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