Commit c765e595 authored by Andrei Paskevich's avatar Andrei Paskevich

whyml: do not reprove invariants for reset variables

parent d3f911cd
...@@ -78,6 +78,19 @@ WhyML ...@@ -78,6 +78,19 @@ WhyML
require tedious checks pretty much everywhere in the code, require tedious checks pretty much everywhere in the code,
and they cannot be translated to OCaml. and they cannot be translated to OCaml.
- the following function is verifiable:
type dref 'a = {| mutable dcontents : ref 'a |}
let fn (dr : dref int) (r : ref int) =
{ !r = 0 } dr.dcontents <- r; dr.dcontents := 1 { !r = 0 }
Strictly speaking, this is benign, since r is reset by the
first assignement, and the corresponding reference cannot be
used anymore during the program execution. However, it would
be nice to forbid the use of reset regions in post-conditions,
unless they are put under "old".
syntax syntax
------ ------
......
...@@ -546,7 +546,7 @@ let l_pvset pvs lam = ...@@ -546,7 +546,7 @@ let l_pvset pvs lam =
(* check admissibility of consecutive events *) (* check admissibility of consecutive events *)
exception StaleRegion of expr * region * ident exception StaleRegion of expr * ident
exception GhostWrite of expr * region exception GhostWrite of expr * region
exception GhostRaise of expr * xsymbol exception GhostRaise of expr * xsymbol
...@@ -555,19 +555,10 @@ let check_reset e varm = ...@@ -555,19 +555,10 @@ let check_reset e varm =
as the result of the resetting expression. Otherwise, this is as the result of the resetting expression. Otherwise, this is
a freshness violation: some symbol defined earlier carries that a freshness violation: some symbol defined earlier carries that
region into the later code. *) region into the later code. *)
let check_reset r u = (* does r occur in varm? *) let check_id id vars = if eff_stale_region e.e_effect vars then
let check_id id s = (* does r occur among the regions of id? *) Loc.error ?loc:e.e_loc (StaleRegion (e,id)) in
let rec check_reg reg = if not (Mreg.is_empty e.e_effect.eff_resets) then
reg_equal r reg || match u with
| Some u when reg_equal u reg -> false
| _ -> Sreg.exists check_reg reg.reg_ity.ity_vars.vars_reg
in
if Sreg.exists check_reg s.vars_reg then
Loc.error ?loc:e.e_loc (StaleRegion (e,r,id))
in
Mid.iter check_id varm Mid.iter check_id varm
in
Mreg.iter check_reset e.e_effect.eff_resets
let check_ghost_write e eff = let check_ghost_write e eff =
(* If we make a ghost write, then the modified region cannot (* If we make a ghost write, then the modified region cannot
......
...@@ -217,7 +217,7 @@ val create_let_defn : preid -> expr -> let_defn ...@@ -217,7 +217,7 @@ val create_let_defn : preid -> expr -> let_defn
val create_fun_defn : preid -> lambda -> rec_defn val create_fun_defn : preid -> lambda -> rec_defn
val create_rec_defn : (psymbol * lambda) list -> rec_defn val create_rec_defn : (psymbol * lambda) list -> rec_defn
exception StaleRegion of expr * region * ident exception StaleRegion of expr * ident
(* freshness violation: a previously reset region is associated to an ident *) (* freshness violation: a previously reset region is associated to an ident *)
val e_let : let_defn -> expr -> expr val e_let : let_defn -> expr -> expr
......
...@@ -466,7 +466,7 @@ let () = Exn_printer.register ...@@ -466,7 +466,7 @@ let () = Exn_printer.register
| Mlw_expr.GhostRaise (_e, xs) -> | Mlw_expr.GhostRaise (_e, xs) ->
fprintf fmt "This expression raises a ghost exception %a \ fprintf fmt "This expression raises a ghost exception %a \
catched by a non-ghost code" print_xs xs catched by a non-ghost code" print_xs xs
| Mlw_expr.StaleRegion (_e, _reg, id) -> | Mlw_expr.StaleRegion (_e, id) ->
fprintf fmt "This expression prohibits further \ fprintf fmt "This expression prohibits further \
usage of variable %s" id.id_string usage of variable %s" id.id_string
| Mlw_expr.ValueExpected _e -> | Mlw_expr.ValueExpected _e ->
......
...@@ -699,6 +699,15 @@ let eff_filter vars e = ...@@ -699,6 +699,15 @@ let eff_filter vars e =
eff_resets = Mreg.mapi_filter reset e.eff_resets; eff_resets = Mreg.mapi_filter reset e.eff_resets;
} }
let eff_stale_region eff vars =
let check_reset r u =
let rec check_reg reg =
reg_equal r reg || match u with
| Some u when reg_equal u reg -> false
| _ -> Sreg.exists check_reg reg.reg_ity.ity_vars.vars_reg in
Sreg.exists check_reg vars.vars_reg in
Mreg.exists check_reset eff.eff_resets
(** specification *) (** specification *)
type pre = term (* precondition: pre_fmla *) type pre = term (* precondition: pre_fmla *)
......
...@@ -228,6 +228,8 @@ val eff_assign : effect -> ?ghost:bool -> region -> ity -> effect ...@@ -228,6 +228,8 @@ val eff_assign : effect -> ?ghost:bool -> region -> ity -> effect
val eff_remove_raise : effect -> xsymbol -> effect val eff_remove_raise : effect -> xsymbol -> effect
val eff_stale_region : effect -> varset -> bool
exception IllegalAlias of region exception IllegalAlias of region
val eff_full_inst : ity_subst -> effect -> effect val eff_full_inst : ity_subst -> effect -> effect
......
...@@ -669,8 +669,10 @@ let env_invariant lenv eff pvs = ...@@ -669,8 +669,10 @@ let env_invariant lenv eff pvs =
let ity = pv.pv_vtv.vtv_ity in let ity = pv.pv_vtv.vtv_ity in
let written r = reg_occurs r ity.ity_vars in let written r = reg_occurs r ity.ity_vars in
let inv = Mlw_wp.full_invariant lkn kn pv.pv_vs ity in let inv = Mlw_wp.full_invariant lkn kn pv.pv_vs ity in
t_and_simp pinv inv, let qinv = (* we reprove invariants for modified non-reset variables *)
if Sreg.exists written regs then t_and_simp qinv inv else qinv if Sreg.exists written regs && not (eff_stale_region eff ity.ity_vars)
then t_and_simp qinv inv else qinv in
t_and_simp pinv inv, qinv
in in
Spv.fold add_pv pvs (t_true,t_true) Spv.fold add_pv pvs (t_true,t_true)
......
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