let get_loop_annots config edges_before s =
let add ca (assigns, loop_entry, loop_back , loop_core as acc) =
match ca.annot_content with
| AInvariant (b_list, true, inv) ->
begin match is_annot_for_config config edges_before s b_list with
| TBRok
| TBRpart
->
let loop_entry =
add_prop config loop_entry Agoal
(prepare_inv_establish config s ca inv ) in
let loop_back =
add_prop config loop_back Agoal
(prepare_inv_preserve config s ca inv ) in
let loop_core =
add_prop config loop_core Ahyp
(prepare_inv_fixpoint config s ca inv )
in assigns, loop_entry , loop_back , loop_core
| TBRhyp ->
let loop_core =
add_prop config loop_core Ahyp
(prepare_inv_fixpoint config s ca inv)
in assigns, loop_entry , loop_back , loop_core
| TBRno -> acc
end
| AVariant (v, None) ->
let kind = if cur_fct_default_bhv config then Agoal else Ahyp in
let vpos, vdecr = mk_variant_properties s v in
let vdecr = prepare_var_decr config s ca vdecr in
let loop_back = add_prop config loop_back kind vdecr in
let vpos = prepare_var_pos config s ca vpos in
let loop_back = add_prop config loop_back kind vpos in
assigns, loop_entry , loop_back , loop_core
| AVariant (_v, _rel) ->
Wp_parameters.warning "Ignoring loop variant with measure : %a"
!Ast_printer.d_code_annotation ca;
acc
| AAssigns (b_list, a) ->
let h_assigns, g_assigns = assigns in
let assigns = match is_annot_for_config config edges_before s b_list with
| TBRok | TBRpart -> a::h_assigns, a::g_assigns
| TBRhyp -> a::h_assigns, g_assigns
| TBRno -> assigns
in (assigns, loop_entry , loop_back , loop_core)
| _ -> acc
in
let do_annot a acc = match a with
| Before (User ca | AI (_, ca)) -> add ca acc
| After _ -> acc
in
let acc = (([],[]), empty_acc, empty_acc, empty_acc) in
let (h_assigns, g_assigns), loop_entry , loop_back , loop_core =
Annotations.single_fold_stmt do_annot s acc
in
let loop_back = add_loop_assigns config Agoal s g_assigns loop_back in
let loop_core = add_loop_assigns config Ahyp s h_assigns loop_core in
loop_entry , loop_back , loop_core