let quantify_assigns assigns p =
let mem_i = MV.fresh_mem () in
let add_asgn (m, outs) asgn = match fst asgn with
| Location { it_content = { term_node = Tempty_set } }
| Nothing -> Wp_parameters.debug ~level:2 "process assign : nothing@.";
(m, outs)
| Location { it_content = lv} ->
match lv.term_node with
| TLval tlval ->
begin try
let out_ltype = lv.term_type in
let out_type = Types.mk_ltype out_ltype in
let out_var = Fol.fresh_named_var "out" out_type in
let lval = !Db.Properties.Interp.term_lval_to_lval tlval in
let addr = lval_addr lval in
let addr =
MV.subst_exp_mem (Lazy.force MV.cur_mem_var) mem_i addr
in
Wp_parameters.debug ~level:2 "process assign %a as %a@."
!Ast_printer.d_lval lval Why_output.pp_var out_var;
let m = M.mem_update m out_ltype addr (Fol.Tvar out_var) in
(m, out_var::outs)
with e ->
let str = Pretty_utils.sfprintf "%a"
(Cil.defaultCilPrinter#pAssigns "") asgn in
let msg = "this assigns term is not handled yet: "^str in
match e with Invalid_argument m
| Calculus.InvalidModel m
| Types.Unsupported m
-> MV.abort (msg^"("^m^")")
| _ -> assert false
end
| Tat ({term_node =
TLval (TResult _, TNoOffset)} , LogicLabel "Post")
-> (m, outs)
| _ ->
let str = Pretty_utils.sfprintf "%a"
(Cil.defaultCilPrinter#pAssigns "") asgn in
MV.abort ("assigns term is not a lvalue :"^str)
in
let m, outs = match assigns with
| [] ->
Wp_parameters.feedback ~level:2
"No assigns clause : quantify whole memory @.";
let m = MV.fresh_mem () in (Fol.Tvar m, [m])
| _ ->
try List.fold_left add_asgn (Lazy.force MV.cur_mem, []) assigns
with Calculus.InvalidModel m ->
begin
Wp_parameters.warning "assigns: %s (don't use assigns)@." m;
Wp_parameters.feedback ~level:2
"Assigns clause problem : quantify whole memory @.";
let m = MV.fresh_mem () in (Fol.Tvar m, [m])
end
in
let p =
Fol.let_pred M.prop_in_data ~fresh:true (Lazy.force MV.cur_mem_var) m p
in
let p = MV.subst_pred_mem mem_i (Lazy.force MV.cur_mem_var) p in
let quantif p out = Fol.forall_pred M.prop_in_data ~fresh:false out p in
let p = List.fold_left quantif p outs in
p