Commit 170ce1dc authored by Andrei Paskevich's avatar Andrei Paskevich

Fast WP: fix the handling of "abstract"

Submitted by Johannes Kanig
parent de46b1a1
...@@ -1044,6 +1044,11 @@ module Subst : sig ...@@ -1044,6 +1044,11 @@ module Subst : sig
(s',f) is the new state [s'] and a formula [f] which defines the new (s',f) is the new state [s'] and a formula [f] which defines the new
values in [s'] with respect to the input state [s]. *) values in [s'] with respect to the input state [s]. *)
val extract_glue : wp_env -> Sreg.t -> t -> t -> term
(* The formula [extract_glue env regs s1 s2] expresses what has not changed
between [s1] and [s2], concerning program variables. The set of
*)
val merge : t -> t -> t -> t * term * term val merge : t -> t -> t -> t * term * term
(* Given a start state and two states that parted from there, return a new (* Given a start state and two states that parted from there, return a new
"join" state and two formulas. The first formula links the first branch "join" state and two formulas. The first formula links the first branch
...@@ -1073,15 +1078,15 @@ end = struct ...@@ -1073,15 +1078,15 @@ end = struct
} }
(* a substitution or state knows the current variables to use for each region (* a substitution or state knows the current variables to use for each region
and each mutable program variable. *) and each mutable program variable. *)
(* the reg_names field is a simple name hint; a mapping reg |-> name means
that [name] should be used as a base for new variables in region [reg].
This mapping is not required to be complete for regions. *)
type t = type t =
{ now : subst; { now : subst;
other : subst Mvs.t; other : subst Mvs.t;
reg_names : vsymbol Mreg.t; reg_names : vsymbol Mreg.t;
} }
(* the reg_names field is a simple name hint; a mapping reg |-> name means
that [name] should be used as a base for new variables in region [reg].
This mapping is not required to be complete for regions. *)
(* the actual state knows not only the current state, but also all labeled (* the actual state knows not only the current state, but also all labeled
past states. *) past states. *)
...@@ -1106,13 +1111,11 @@ end = struct ...@@ -1106,13 +1111,11 @@ end = struct
belonging to this program variable are also added to the state, if not belonging to this program variable are also added to the state, if not
already there. Note that [add_pvar] doesn't really change the state, already there. Note that [add_pvar] doesn't really change the state,
only adds new knowledge. *) only adds new knowledge. *)
(* for simple variables (1 variable = 1 mutable region), we register the (* for simple variables (1 variable = 1 mutable region), we do not
variable name as a name hint for the region. Also, we enter a introduce a new program variable each time, instead we use directly the
dummy program variable in the substitution map, so that we know that we [update_var] term. See also [havoc]. This is a heuristics which assumes
have to do something with this variable, but still know it is a program that in this case, the program variable would be an overhead. In
variable. Previously, we did not enter it at all in the map, which made particular for simple references it is an important optimization. *)
us forget to substitute it.
See also [havoc], [merge] and [term]. *)
let ity = pv.pv_ity in let ity = pv.pv_ity in
if ity_immutable ity then s if ity_immutable ity then s
else else
...@@ -1164,8 +1167,8 @@ end = struct ...@@ -1164,8 +1167,8 @@ end = struct
Mreg.add reg (fresh_var_from_region s.reg_names reg) acc) Mreg.add reg (fresh_var_from_region s.reg_names reg) acc)
regset s.now.subst_regions in regset s.now.subst_regions in
let touched_regs = Mreg.set_inter regs regset in let touched_regs = Mreg.set_inter regs regset in
(* We special case simple variables, when the mapping is the dummy (* We special case simple variables: no new variable is introduced for the
* variable. So no new names/equations are introduced for those. *) * program variable, we directly use the "update_var" term. *)
let vars, f = Mvs.fold (fun vs _ ((acc_vars, acc_f) as acc) -> let vars, f = Mvs.fold (fun vs _ ((acc_vars, acc_f) as acc) ->
if pv_is_touched_by_regions vs regset then begin if pv_is_touched_by_regions vs regset then begin
let new_term = update_var env touched_regs vs in let new_term = update_var env touched_regs vs in
...@@ -1189,9 +1192,7 @@ end = struct ...@@ -1189,9 +1192,7 @@ end = struct
"current" substitution accordingly. *) "current" substitution accordingly. *)
match t.t_node with match t.t_node with
| Tvar vs -> | Tvar vs ->
(* the normal case here is to replace the program variable [vs] by its (* We simply replace the program variable [vs] by its "now" value. *)
"now" value. The special case is where it is a simple variable; we
directly insert the "update" term here. *)
begin try Mvs.find vs s.now.subst_vars begin try Mvs.find vs s.now.subst_vars
with Not_found -> t with Not_found -> t
end end
...@@ -1219,6 +1220,22 @@ end = struct ...@@ -1219,6 +1220,22 @@ end = struct
| _ -> | _ ->
t_map (term s) t t_map (term s) t
let extract_glue env regions s1 s2 =
(* we are only interested in "now" program vars *)
let touched_regions =
Mreg.filter (fun r _ -> Sreg.mem r regions) s2.now.subst_regions in
let s1 = s1.now.subst_vars and s2 = s2.now.subst_vars in
(* We iterate over the first state, because the second one potentially
* contains more variables *)
Mvs.fold
(fun var old_f acc ->
let f = Mvs.find var s2 in
if t_equal f old_f || is_simple_var var <> None then acc
else
let new_value = update_var env touched_regions var in
t_and_simp acc (t_equ_simp f new_value)
) s1 t_true
let subst_inter a b = let subst_inter a b =
(* compute the intersection of two substitutions. *) (* compute the intersection of two substitutions. *)
{ subst_vars = Mvs.set_inter a.subst_vars b.subst_vars; { subst_vars = Mvs.set_inter a.subst_vars b.subst_vars;
...@@ -1684,9 +1701,6 @@ and fast_wp_desc (env : wp_env) (s : Subst.t) (r : res_type) (e : expr) ...@@ -1684,9 +1701,6 @@ and fast_wp_desc (env : wp_env) (s : Subst.t) (r : res_type) (e : expr)
for the exceptions that are actually listed. *) for the exceptions that are actually listed. *)
let wp1_exn_filtered = let wp1_exn_filtered =
Mexn.filter (fun ex _ -> Mexn.mem ex xpost) wp1.exn in Mexn.filter (fun ex _ -> Mexn.mem ex xpost) wp1.exn in
(* ??? the glue is missing in this call to apply_state_to_post. This
means that "abstract" also forgets which immutable *components* are
not modified. To be fixed. *)
let xq = Mexn.mapi (fun ex q -> Mexn.find ex xresult, q.ne) xpost in let xq = Mexn.mapi (fun ex q -> Mexn.find ex xresult, q.ne) xpost in
wp_nimplies wp1.post.ne wp1_exn_filtered ((result, post.ne), xq) wp_nimplies wp1.post.ne wp1_exn_filtered ((result, post.ne), xq)
in in
...@@ -1698,6 +1712,9 @@ and fast_wp_desc (env : wp_env) (s : Subst.t) (r : res_type) (e : expr) ...@@ -1698,6 +1712,9 @@ and fast_wp_desc (env : wp_env) (s : Subst.t) (r : res_type) (e : expr)
if Mexn.mem ex acc then acc if Mexn.mem ex acc then acc
else Mexn.add ex post acc) else Mexn.add ex post acc)
wp1.exn xpost in wp1.exn xpost in
let regs = regs_of_writes e1.e_effect in
let glue = Subst.extract_glue env regs pre_abstr_state wp1.post.s in
let post = { post with ne = t_and_simp glue post.ne } in
let ok = t_and_simp_l [wp1.ok; (Subst.term s spec.c_pre); ok_post] in let ok = t_and_simp_l [wp1.ok; (Subst.term s spec.c_pre); ok_post] in
{ ok = wp_label e ok; { ok = wp_label e ok;
post = post; post = post;
......
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