let add_region_assigns env pid label kind assigned wp =
let from = Clabels.c_label label in
let pool = fst env in
let goal = ref NoAssigns in
on_context env "add_assigns" wp Keep_opened (Goal_assigns goal)
(fun env _noassigns prop ->
if assigned = [] then prop
else
try
let asgned = assigned_for_assigns_goal kind from env assigned in
let region = List.fold_left
(fun re a ->
let rx = WpModel.region_assigned a in
WpModel.region_union re rx)
(WpModel.region_empty()) asgned
in
let xs,bindings,global = WpModel.region_fingerprint pool region in
goal := RegionAssigns {
r_pid = pid ;
r_label = from ;
r_global = global ;
r_vars = xs ;
r_effect = 0 ;
r_locals = [] ;
} ;
F.p_implies bindings (region_assigns 0)
with e ->
let (source,reason) = Wp_error.protect e in
Datalib.Collector.add_warning
~severe:true ~source ~reason
"Goal %a can not be translated"
WpAnnot.pp_id pid ;
F.p_false)