let mk_behavior ~loc auto event (st_status,tr_status) state =
Aorai_option.debug "analysis of state %s (%d out of %d)"
state.Promelaast.name state.nums (Array.length st_status);
if st_status.(state.nums) then begin
Aorai_option.debug "state %s is reachable" state.Promelaast.name;
let my_trans = Path_analysis.get_transitions_to_state state auto in
let rec treat_trans ((in_assumes, out_assumes, action_bhvs) as acc) l =
match l with
| [] -> acc
| trans :: tl ->
let consider, others =
List.partition (fun x -> x.start.nums = trans.start.nums) tl
in
let start = is_state_pred trans.start in
let not_start = is_out_of_state_pred trans.start in
let in_guard, out_guard, my_action_bhvs =
List.fold_left
(fun (in_guard, out_guard, action_bhvs) trans ->
Aorai_option.debug "examining transition %d (out of %d)"
trans.numt (Array.length tr_status);
let (cond,actions) = trans.cross in
Aorai_option.debug "transition %d is active" trans.numt;
let guard =
crosscond_to_pred ~event cond
(Data_for_aorai.get_logic_var Data_for_aorai.curOp)
(Data_for_aorai.get_logic_var Data_for_aorai.curOpStatus)
in
let my_in_guard,my_out_guard =
match state.multi_state with
| None -> guard, Logic_const.pnot ~loc guard
| Some (_,aux) ->
let set =
find_pebble_origin Logic_const.here_label actions
in
pebble_guard ~loc set aux guard,
pebble_guard_neg ~loc set aux guard
in
let out_guard =
Logic_const.pand ~loc (out_guard, my_out_guard)
in
let in_guard, action_bhvs =
match actions with
| [] ->
(Logic_const.por ~loc (in_guard,my_in_guard),
action_bhvs)
| _ ->
let name =
Printf.sprintf "buch_state_%s_in_%d"
state.name (List.length action_bhvs)
in
Aorai_option.debug "Name is %s" name;
let assumes = [
Logic_const.new_predicate
(Logic_const.pand ~loc (start,my_in_guard))
]
in
let post_cond =
Normal,
Logic_const.new_predicate (is_state_pred state)
in
let treat_one_action acc a =
let posts = mk_action ~loc a in
match state.multi_state with
| None ->
acc @
List.map
(fun x ->
(Normal, Logic_const.new_predicate x))
posts
| Some (_,aux) ->
let set =
find_pebble_origin
Logic_const.pre_label actions
in
acc @
List.map
(fun x ->
(Normal,
Logic_const.new_predicate
(pebble_post ~loc set aux x)))
posts
in
let post_cond =
List.fold_left treat_one_action [post_cond] actions
in
let bhv =
Cil.mk_behavior ~name ~assumes ~post_cond ()
in
in_guard, bhv :: action_bhvs
in
in_guard, out_guard, action_bhvs)
(pfalse,ptrue,action_bhvs) (trans::consider)
in
treat_trans
(Logic_const.por ~loc
(in_assumes, (Logic_const.pand ~loc (start, in_guard))),
Logic_const.pand ~loc
(out_assumes,
(Logic_const.por ~loc (not_start, out_guard))),
my_action_bhvs
)
others
in
let my_trans = List.filter (fun x -> tr_status.(x.numt)) my_trans in
let in_assumes, out_assumes, action_behaviors =
treat_trans (pfalse, ptrue, []) my_trans
in
let behaviors =
if Logic_utils.is_trivially_false in_assumes then action_behaviors
else begin
let behavior_in =
Cil.mk_behavior
~name:(Printf.sprintf "buch_state_%s_in" state.Promelaast.name)
~assumes:[Logic_const.new_predicate in_assumes]
~post_cond:
[Normal, Logic_const.new_predicate (is_state_pred state)]
()
in behavior_in :: action_behaviors
end
in
let behaviors =
add_behavior_pebble_actions ~loc event behaviors state my_trans
in
let behaviors =
if Logic_utils.is_trivially_false out_assumes then behaviors
else begin
let post_cond =
match state.multi_state with
| None -> []
| Some (set,_) ->
let set =
Data_for_aorai.pebble_set_at set Logic_const.here_label
in [Normal,
Logic_const.new_predicate
(Logic_const.prel ~loc
(Req,set,
Logic_const.term ~loc Tempty_set set.term_type))]
in
let post_cond =
(Normal, (Logic_const.new_predicate (is_out_of_state_pred state)))
:: post_cond
in
let behavior_out =
Cil.mk_behavior
~name:(Printf.sprintf "buch_state_%s_out" state.Promelaast.name)
~assumes:[Logic_const.new_predicate out_assumes]
~post_cond ()
in behavior_out :: behaviors
end
in
List.rev behaviors
end else begin
Aorai_option.debug "state %s is not reachable" state.Promelaast.name;
let name = Printf.sprintf "buch_state_%s_out" state.Promelaast.name in
let post_cond =
match state.multi_state with
| None -> []
| Some (set,_) ->
let set =
Data_for_aorai.pebble_set_at set Logic_const.here_label
in [Normal,
Logic_const.new_predicate
(Logic_const.prel ~loc
(Req,set,
Logic_const.term ~loc Tempty_set set.term_type))]
in
let post_cond =
(Normal, Logic_const.new_predicate (is_out_of_state_pred state))
::post_cond
in
[mk_behavior ~name ~post_cond ()]
end