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
Show 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 =
...
@@ 720,53 +720,38 @@ let refresh_of_effect e =
Mtv
.
fold
add_rfr
sbst
rfr
)
e
.
eff_writes
Mreg
.
empty
in
Mtv
.
fold
add_rfr
sbst
rfr
)
e
.
eff_writes
Mreg
.
empty
in
{
e
with
eff_resets
=
Mreg
.
union
merge_covers
e
.
eff_resets
rfr
}
{
e
with
eff_resets
=
Mreg
.
union
merge_covers
e
.
eff_resets
rfr
}
(*
exception
IllegalAlias
of
region
exception
IllegalAlias
of
region
let
eff_full_inst
sbs
e
=
let
eff_full_inst
sbs
e
=
(* modified or reset regions in e *)
(* all modified or reset regions in e must be instantiated
let wrt = Mreg.map (Util.const ()) e.eff_writes in
into distinct regions *)
let rst = Mreg.map (Util.const ()) e.eff_resets in
let
inst
fn
src
=
Mreg
.
fold
(
fun
r
v
acc
>
let wrt = Sreg.union wrt rst in
let
r
=
ity_full_inst
sbs
r
in
Mreg
.
add_new
(
IllegalAlias
r
)
r
(
fn
v
)
acc
)
src
Mreg
.
empty
in
let aff = Sreg.fold (fun r acc >
let
writes
=
inst
(
fun
fld
>
fld
)
e
.
eff_writes
in
Sreg.add (ity_full_inst sbs r) acc) wrt Sreg.empty in
let
resets
=
inst
(
inst
(
fun
()
>
()
))
e
.
eff_resets
in
let
impact
=
Mreg
.
merge
(
fun
r
fld
cvr
>
match
fld
,
cvr
with
let check_inst v ity acc =

Some
_
,
Some
_
>
raise
(
IllegalAlias
r
)
let i = ity_var_unsafe v in

_
>
Some
()
)
writes
resets
in
match i.ity_node with
(* all type variables must be instantiated into types that are
 Ityvar _ > Sreg.iter (fun r >
not affected by the effect, and all unaffected regions must
if ity_r_occurs r ity then raise (IllegalAlias r)) aff
be instantiated into regions outside [impact].

Now, every region in the instantiated execution is either
(* readonly regions in e *)
brought in by the type substitution and thus is unaffected,
let ro = Sreg.diff (Mreg.map (Util.const ()) s) wr in
or instantiates one of the original regions and is affected
(* all modified or reset regions are instantiated into distinct regions *)
if and only if the original one is. *)
let add_affected reg acc =
let
check_inst
v
dst
=
match
ity_var_unsafe
v
with
let reg = ity_full_inst sbs reg in

{
ity_node
=
Ityvar
_
}
>
Sreg
.
iter
(
fun
r
>
Sreg.add_new (IllegalAlias reg) reg acc in
if
ity_r_occurs
r
dst
then
raise
(
IllegalAlias
r
))
impact
let wrt = Sreg.fold add_affected wrt Sreg.empty in

reg
when
Mreg
.
mem
reg
e
.
eff_writes
>
()
(* all readonly regions are instantiated outside wr *)

reg
when
Mreg
.
mem
reg
e
.
eff_resets
>
()
let add_readonly r =

_
when
Sreg
.
mem
dst
impact
>
raise
(
IllegalAlias
dst
)
let r = Mreg.find r s in if Sreg.mem r wr then raise (IllegalAlias r) in

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