let check_postconditions kf kinstr ~result ~slevel header ~init_state ~active_behaviors ~post_state kind behaviors =
let fused_init = State_set.join init_state in
let e_post =
lazy (env_post_f ~post:(State_set.join post_state) ~pre:fused_init)
in
let incorporate_behavior state b =
if b.b_post_cond = [] then state
else
let header = header ^ ActiveBehaviors.header b in
let posts = List.filter (fun (x,_) -> x = kind) b.b_post_cond in
let update_status st post =
let ip = Property.ip_of_ensures kf kinstr b post in
emit_status ip st
in
match ActiveBehaviors.active active_behaviors b with
| True ->
List.fold_left
(fun acc (_,{ip_content=pred;ip_loc=loc} as post) ->
let source = fst loc in
if State_set.is_empty acc then
(Value_parameters.result ~once:true ~source
"%s: no state left to evaluate postcondition, status not computed.%t"
header pp_callstack;
acc)
else
let pred = Ast_info.predicate loc pred in
let res = fold_join_predicate State_set.fold
(fun state ->
let env = env_post_f ~post:state ~pre:fused_init in
eval_predicate ~result env pred) acc
in
Value_parameters.result ~once:true ~source
"%s: postcondition got status %a.%t"
header pretty_predicate_value res pp_callstack;
match res with
| False ->
update_status Property_status.False_if_reachable post;
State_set.empty
| True ->
update_status Property_status.True post;
reduce_by_disjunction ~result ~env:!!e_post acc slevel pred
| Unknown ->
update_status Property_status.Dont_know post;
reduce_by_disjunction ~result ~env:!!e_post acc slevel pred
) state posts
| Unknown ->
List.fold_left
(fun acc (_,{ip_content=pred;ip_loc=loc} as post) ->
let source = fst loc in
if State_set.is_empty acc then
(Value_parameters.result ~once:true ~source
"%s: no state left to evaluate postcondition, status not computed.%t"
header pp_callstack;
acc)
else
let pred = Ast_info.predicate loc pred in
let res = fold_join_predicate State_set.fold
(fun state ->
let env = env_post_f ~post:state ~pre:fused_init in
eval_predicate ~result env pred)
acc
in
Value_parameters.result ~once:true ~source
"%s: postcondition got status %a.%t"
header pretty_predicate_value res pp_callstack;
match res with
| Unknown | False ->
update_status Property_status.Dont_know post;
Value_parameters.result ~once:true ~source
"%s: postcondition got status %a, but it is unknown if the behavior is active.%t"
header pretty_predicate_value res pp_callstack;
state
| True ->
update_status Property_status.True post;
Value_parameters.result ~once:true ~source
"%s: postcondition got status %a, but it is unknown if the behavior is active.%t"
header pretty_predicate_value res pp_callstack;
state
) state posts
| False ->
(match posts with
| [] -> ()
| (_,{ip_loc=(source,_)})::_ ->
Value_parameters.result ~once:true ~source
"%s: assumes got status invalid; post-condition not evaluated.%t"
header pp_callstack);
state
in
List.fold_left incorporate_behavior post_state behaviors