MAJ terminée. Nous sommes passés en version 14.6.2 . Pour consulter les "releases notes" associées c'est ici :

https://about.gitlab.com/releases/2022/01/11/security-release-gitlab-14-6-2-released/
https://about.gitlab.com/releases/2022/01/04/gitlab-14-6-1-released/

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 ...@@ -11,10 +11,6 @@ WhyML
Should they be always reset at the last arrow? What if they are Should they be always reset at the last arrow? What if they are
already reset at some earlier arrows, should we reset them again? 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 - current WP does not respect the lexical scope. In the program
let r = create 0 in let r = create 0 in
......
...@@ -116,7 +116,7 @@ let print_effect fmt eff = ...@@ -116,7 +116,7 @@ let print_effect fmt eff =
let print_reset r = function let print_reset r = function
| None -> print_reg "fresh" r | None -> print_reg "fresh" r
| Some u -> | 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
in in
Sreg.iter (print_reg "read") eff.eff_reads; Sreg.iter (print_reg "read") eff.eff_reads;
Sreg.iter (print_reg "write") eff.eff_writes; Sreg.iter (print_reg "write") eff.eff_writes;
......
...@@ -520,8 +520,13 @@ let eff_is_empty e = ...@@ -520,8 +520,13 @@ let eff_is_empty e =
Sexn.is_empty e.eff_ghostx && Sexn.is_empty e.eff_ghostx &&
Mreg.is_empty e.eff_resets Mreg.is_empty e.eff_resets
let join_reset _key v1 v2 = let join_reset _key v1 v2 = match v1, v2 with
Some (if option_eq reg_equal v1 v2 then v1 else None) | 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 = { let eff_union x y = {
eff_reads = Sreg.union x.eff_reads y.eff_reads; 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 } ...@@ -559,6 +564,12 @@ let eff_reset e r = { e with eff_resets = Mreg.add r None e.eff_resets }
exception IllegalAlias of region 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 eff_assign e ?(ghost=false) r ty =
let e = eff_write e ~ghost r in let e = eff_write e ~ghost r in
let sub = ity_match ity_subst_empty r.reg_ity ty 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 ...@@ -217,6 +217,7 @@ val eff_write : effect -> ?ghost:bool -> region -> effect
val eff_raise : effect -> ?ghost:bool -> xsymbol -> effect val eff_raise : effect -> ?ghost:bool -> xsymbol -> effect
val eff_reset : effect -> region -> 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_assign : effect -> ?ghost:bool -> region -> ity -> effect
val eff_remove_raise : effect -> xsymbol -> effect val eff_remove_raise : effect -> xsymbol -> effect
......
...@@ -817,6 +817,15 @@ let rec type_c lenv gh svs vars dtyc = ...@@ -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 and add_ity ity eff = Sreg.fold add_reg ity.ity_vars.vars_reg eff in
add_ity v.vtv_ity eff add_ity v.vtv_ity eff
| VTarrow _ -> eff in | 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 = { let spec = {
c_pre = create_pre lenv dtyc.dc_pre; c_pre = create_pre lenv dtyc.dc_pre;
c_effect = eff; 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