Attention une mise à jour du service Gitlab va être effectuée le mardi 14 décembre entre 13h30 et 14h00. Cette mise à jour va générer une interruption du service dont nous ne maîtrisons pas complètement la durée mais qui ne devrait pas excéder quelques minutes.

Commit 05583b01 authored by Andrei Paskevich's avatar Andrei Paskevich
Browse files

whyml: refresh unmodified subregions in abstract parameters

parent 16351b6f
......@@ -11,10 +11,6 @@ WhyML
Should they be always reset at the last arrow? What if they are
already reset at some earlier arrows, should we reset them again?
- in "val" and "any", when a region rho is written into, but some
subregion rho' of rho is not, should we reset rho' under rho?
In Mlw_typing or in Mlw_expr?
- current WP does not respect the lexical scope. In the program
let r = create 0 in
......@@ -116,7 +116,7 @@ let print_effect fmt eff =
let print_reset r = function
| None -> print_reg "fresh" r
| Some u ->
fprintf fmt "{reset %a@ under %a}@ " print_regty r print_regty u
fprintf fmt "{refresh %a@ under %a}@ " print_regty r print_regty u
Sreg.iter (print_reg "read") eff.eff_reads;
Sreg.iter (print_reg "write") eff.eff_writes;
......@@ -520,8 +520,13 @@ let eff_is_empty e =
Sexn.is_empty e.eff_ghostx &&
Mreg.is_empty e.eff_resets
let join_reset _key v1 v2 =
Some (if option_eq reg_equal v1 v2 then v1 else None)
let join_reset _key v1 v2 = match v1, v2 with
| Some r1, Some r2 ->
if reg_equal r1 r2 then Some v1 else
if reg_occurs r1 r2.reg_ity.ity_vars then Some v2 else
if reg_occurs r2 r1.reg_ity.ity_vars then Some v1 else
Some None
| _ -> Some None
let eff_union x y = {
eff_reads = Sreg.union x.eff_reads y.eff_reads;
......@@ -559,6 +564,12 @@ let eff_reset e r = { e with eff_resets = Mreg.add r None e.eff_resets }
exception IllegalAlias of region
let eff_refresh e r u =
if not (reg_occurs r u.reg_ity.ity_vars) then
invalid_arg "Mlw_ty.eff_refresh";
let reset = Mreg.singleton r (Some u) in
{ e with eff_resets = Mreg.union join_reset e.eff_resets reset }
let eff_assign e ?(ghost=false) r ty =
let e = eff_write e ~ghost r in
let sub = ity_match ity_subst_empty r.reg_ity ty in
......@@ -217,6 +217,7 @@ val eff_write : effect -> ?ghost:bool -> region -> effect
val eff_raise : effect -> ?ghost:bool -> xsymbol -> effect
val eff_reset : effect -> region -> effect
val eff_refresh : effect -> region -> region -> effect
val eff_assign : effect -> ?ghost:bool -> region -> ity -> effect
val eff_remove_raise : effect -> xsymbol -> effect
......@@ -817,6 +817,15 @@ let rec type_c lenv gh svs vars dtyc =
and add_ity ity eff = Sreg.fold add_reg ity.ity_vars.vars_reg eff in
add_ity v.vtv_ity eff
| VTarrow _ -> eff in
(* refresh every unmodified subregion of a modified region *)
let writes = Sreg.union eff.eff_writes eff.eff_ghostw in
let check u eff =
let rec sub_reg r eff =
if Sreg.mem r writes then eff else sub_vars r (eff_refresh eff r u)
and sub_vars r eff = Sreg.fold sub_reg r.reg_ity.ity_vars.vars_reg eff in
sub_vars u eff in
let eff = Sreg.fold check writes eff in
(* create the spec *)
let spec = {
c_pre = create_pre lenv dtyc.dc_pre;
c_effect = eff;
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment