let get_if_reactions role_id hlpsl_reactions gids session_id goals =
let player_id = Utils.find_player_in_role role_id in
let gids =
let gid_player = ref 0 in
let rec delete_player = function
i::li ->
let name = global_var_id#get_name_of i in
if (name = player_id) then
(gid_player := i;
li)
else i::(delete_player li)
| _ -> []
in
let gids' = delete_player gids in
!gid_player::gids'
in
let generic_state_vars =
List.map
(fun x -> Base (Var (global_var_id#get_name_of x))) gids
in
List.flatten
(List.map
(fun hlpsl_reaction ->
if (!debug_level >= 4) then
(prerr_string "% initial gids:";
List.iter (fun i -> prerr_string " "; prerr_term (Base(Var(global_var_id#get_name_of i)))) gids;
prerr_newline());
let lhs = hlpsl_reaction#get_lhs in
let rhs = hlpsl_reaction#get_rhs in
let (current_state_terms,lhs,rhs) =
update_dummy_vars lhs rhs gids
in
if (!debug_level >= 4) then
(prerr_string "% current_state_terms:";
List.iter (fun i -> prerr_string " "; prerr_term i) current_state_terms;
prerr_newline());
let (subst,lhs_cond,lhs_msg) = get_if_lhs lhs in
if (!debug_level >= 4) then
(prerr_string " get_if_lhs:";
List.iter (fun (i,j) -> prerr_string " "; prerr_term i; prerr_string "<-"; prerr_term j) subst;
prerr_newline();
prerr_string " cond:";
List.iter (fun i -> prerr_string " "; prerr_if_term "t" i) lhs_cond;
prerr_newline();
prerr_string " msg:";
List.iter (fun i -> prerr_string " "; prerr_if_term "t" i) lhs_msg;
prerr_newline());
let exists_var_list = get_real_fresh_terms lhs rhs in
let current_state_terms = update_vars_with_cond subst current_state_terms in
if (!debug_level >= 4) then
(prerr_string " update_vars_with_cond:";
List.iter (fun i -> prerr_string " "; prerr_term i) current_state_terms;
prerr_newline());
let if_var_list = ref (get_step_var_list current_state_terms (ref [])) in
let if_lhs =
(State(string_id#get_name role_id,
session_id,
current_state_terms))
::lhs_msg
in
let rhs_msg = get_iknows rhs
in
let rhs_cond = get_if_cond rhs in
let current_state_terms =
update_received_fresh_terms generic_state_vars lhs current_state_terms
in
if (!debug_level >= 4) then
(prerr_string " update_received_fresh_terms: ";
List.iter (fun i -> prerr_string " "; prerr_term i) current_state_terms;
prerr_newline());
let current_state_terms =
update_fresh_terms exists_var_list generic_state_vars current_state_terms
in
if (!debug_level >= 4) then
(prerr_string " update_fresh_terms: ";
List.iter (fun i -> prerr_string " "; prerr_term i) current_state_terms;
prerr_newline());
let (subst2,current_state_terms) =
update_rhs_primed_vars subst rhs current_state_terms generic_state_vars
in
if (!debug_level >= 4) then
(prerr_string " update_rhs_primed_vars: ";
List.iter (fun (i,j) -> prerr_string " "; prerr_term i; prerr_string "<-"; prerr_term j) subst2;
prerr_newline();
prerr_string " ";
List.iter (fun i -> prerr_string " "; prerr_term i) current_state_terms;
prerr_newline());
let rhs_msg = update_rhs_atoms subst2 rhs_msg in
let rhs_cond = update_rhs_atoms subst2 rhs_cond in
if_var_list :=
get_step_var_list current_state_terms
if_var_list;
let (deleteFacts,rhs_cond) =
List.fold_left
(fun (d,r) s ->
match s with
Ifdelete _ -> (d@[s],r)
| _ -> (d,r@[s]))
([],[]) rhs_cond
and (inFacts,lhs_cond) =
List.fold_left
(fun (d,r) s ->
match s with
Ifcontains _ -> (d@[s],r)
| _ -> (d,r@[s]))
([],[]) lhs_cond
in
let if_rhs =
(State(string_id#get_name role_id,
session_id,
current_state_terms))
::rhs_msg@rhs_cond
in
let if_reactions =
if deleteFacts = [] then
[new basic_if_rule (if_lhs@inFacts) (if_rhs@inFacts) lhs_cond !if_var_list exists_var_list]
else
let rec combineAllDeletions lf lc rf = function
(Ifdelete(s1,s2) as s)::ls ->
if inFacts = [] then
(combineAllDeletions (remove_duplicate (lf@[s])) lc rf ls)
@ (combineAllDeletions lf (remove_duplicate (lc@[Ifnot(s)])) rf ls)
else
let rec combineAllIns lf lc rf = function
(Ifcontains(t1,t2) as t)::lt ->
let iss1equalt1 = (s1 = t1)
and iss2equalt2 = (s2 = t2)
and s1equalt1 = Ifequal(s1,t1)
and s2equalt2 = Ifequal(s2,t2)
in
(combineAllIns (remove_duplicate (lf@[s]))
(remove_duplicate (lc
@ (if iss1equalt1 then [] else [s1equalt1])
@ (if iss2equalt2 then [] else [s2equalt2])))
rf lt)
@ (if iss1equalt1 then []
else
combineAllIns (remove_duplicate (lf@[s;t]))
(remove_duplicate (lc@[Ifnot(s1equalt1)]))
(remove_duplicate (rf@[t]))
lt)
@ (if iss2equalt2 then []
else
combineAllIns (remove_duplicate (lf@[s;t]))
(remove_duplicate (lc@[Ifnot(s2equalt2)]))
(remove_duplicate (rf@[t]))
lt)
@ (if iss1equalt1 && iss2equalt2 then []
else
combineAllIns (remove_duplicate (lf@[t]))
(remove_duplicate (lc@[Ifnot(s)]))
(remove_duplicate (rf@[t]))
lt)
| _ ->
combineAllDeletions lf lc rf ls
in
combineAllIns lf lc rf inFacts
| _ ->
if List.exists (fun p -> List.mem (Ifnot(p)) lc) lf then
[]
else
[new basic_if_rule lf rf lc !if_var_list exists_var_list]
in
combineAllDeletions if_lhs lhs_cond if_rhs deleteFacts
in
List.map
(fun if_reaction ->
(role_id,((hlpsl_reaction#get_label),if_reaction)))
if_reactions)
hlpsl_reactions)