let insert_lst (agent1 : string) (agent2 : string) : unit =
let index = ref 0 in
if(agent1<>"" || agent2<>"") then(
List.iter
(fun e -> let(sender,receiver,_) = actionTreatment e in
if(sender=agent1 || sender=agent2 || receiver=agent1 || receiver=agent2)
then (incomming_events := remove_index (!index) (!incomming_events) ; Listbox.delete lst ~first:(`Num (!index)) ~last:(`Num (!index)) )
else index:=1+(!index) )
(!incomming_events)
)
else (Listbox.delete lst ~first:(`Num 0) ~last:`End ; incomming_events := [] );
let not_contains_match_value state =
not(List.mem false (List.map is_a_var (cdr (decompose ("x("^state^")")))) )
in
let all_actions = ref [] in
let lock = ref false in
List.iter
(fun (name,id,statesL,actionsL) ->
let ag1 = (get_name_in_session name id) in
List.iter
(fun (state,exec) ->
List.iter
(fun (initial,_,final) ->
if((findState final)=state && (( ( (!exec)=true || (findIknows final)="" ) && (rcv_stack_is_empty ag1 state)) || ((!exec)=false && (List.mem (findIknows final)(get_message_stack ag1 state)))) && (operations_test_treatment_right ag1 state) && (operations_test_treatment_left ag1 state)) then(
List.iter
(fun (name2,id2,statesL2,actionsL2) ->
let ag2 = (get_name_in_session name2 id2) in
if((name<>name2 || id<>id2) && (agent1="" || agent2="" || agent1=ag1 || agent2=ag2 || agent2=ag1 || agent1=ag2)) then(
let prefix = ((get_name_in_session name id)^" -> "^(get_name_in_session name2 id2)^" : ") in
List.iter
(fun (state2,exec2) ->
if(operations_test_treatment_right ag2 state2)
then(
List.iter
(fun (initial2,_,final2) ->
lock:=false;
local_variable_change:=[];
if(state2<>(findState initial2) && match_state ag2 state2 ag2 (findState initial2))
then(ignore(assign_var_of_state ag2 state2 (get_name_in_session name2 id2) (findState initial2)) ; clear_message_story () ; lock:=true; );
(* prerr_string("^(get_name_in_session name id)^"^(get_name_in_session name2 id2)^"^(findIknows initial2) ^"^(findIknows final)^"^string_of_bool((match_message (get_name_in_session name id)(findState final)(findIknows final) (get_name_in_session name2 id2)(findState initial2)(findIknows initial2)))); *)
if(
(( ( (!exec2)=false || (not_contains_match_value (findState initial2)) )
&& (rcv_stack_is_empty ag2 state2)) || (List.mem (findIknows initial2)(get_rcv_stack ag2 state2)))
&& ((!lock) || state2=(findState initial2) || (match_state ag2 state2 ag2 (findState initial2))
|| state2="" )
&& (match_message ag1 (findState final)(findIknows final) ag2 (findState initial2)(findIknows initial2)) )
then
(
ignore(assign_var ag1 (findState final)(findIknows final) ag2 (findState initial2)(findIknows initial2));
lock:=true;
if (operations_test_treatment_left ag2 (findState final2))
then(
let ic = prefix^(transcript_sender (findIknows final)) in
if(not(List.mem ic (!all_actions)))
then( all_actions:=(ic::(!all_actions));
incomming_events := (prefix^"x("^(findIknows final)^","^((findIknows initial2))^")")::(!incomming_events);
Listbox.insert lst ~index:(`Num 0)~texts:[(replace "_new" "" ic)]);)
);
if(!lock) then (previous_message_story () ; remove_local_variable_change() );
)actionsL2;
)
)(!statesL2)
)
)(!automate))
)actionsL
)(!statesL);
)(!automate);
(* (List.iter
(fun (name,id,statesL,actionsL) ->
prerr_string ((get_name_in_session name id)^");
(List.iter (fun (state2,exec2) -> prerr_string (state2^"^(string_of_bool (!exec2))^")) !statesL);
(List.iter
(fun (initial,((tg,ag),(td,ad)),final) -> prerr_string ((findState initial)^"^(findIknows initial)^"^(list2string " tg)^"^(list2string " ag)^"^(list2string " td)^"^(list2string " ad)^"^(findState final)^"^(findIknows final)^"))
actionsL);
) (!automate));
prerr_string ";
*)
(** schedule the elements in the list box lst and in the list !incomming_events *) |
index:=0;
let tmp = ref [] in
List.iter (fun e -> tmp:=(e,(Listbox.get lst ~index:(`Num (!index))))::(!tmp); index:=1+(!index)) (!incomming_events);
Listbox.delete lst ~first:(`Num 0) ~last:`End;
tmp := List.sort compare (!tmp);
tmp := List.rev !tmp;
incomming_events := [];
List.iter (fun (e,l) -> incomming_events:=e::(!incomming_events) ; Listbox.insert lst ~index:(`Num 0) ~texts:[l]) (!tmp);
(* if( (!all_actions) = [])
then (
let match_and_assign_with_one_state name_in_session state actionsL =
let list2state l = List.fold_left (fun a b -> a^"^b) (car l) (cdr l) in
let rec without_match ls1 ls2 res1 res2 =
match ls1 with [] -> (List.rev res1, List.rev res2)
|(x1::l1) -> match ls2 with [] -> (List.rev res1, List.rev res2)
|(x2::l2) -> if(x1=x2) then without_match l1 l2 (x1::res1) (x2::res2)
else if(is_a_var x2) then without_match l1 l2 (x1::res1) (x2::res2)
else if((is_a_value x1)&&(is_a_value x2)) then without_match l1 l2 res1 res2
else (["],["])
in
let rec aux l =
match l with [] -> ()
|(((x,_),_,_)::ls) ->
let (s1,s2) = without_match (cdr (decompose ("^state^" ))) (cdr (decompose ("^x^" ))) [] [] in
let r1 = list2state s1 in
let r2 = list2state s2 in
if(match_state name_in_session r1 name_in_session r2 )
(*clear_message_story () ;*)then ignore(assign_var_of_state name_in_session r1 name_in_session r2)
else aux ls;
in aux actionsL
in
List.iter
(fun (name,id,statesL,actionsL) ->
let name_in_session = get_name_in_session name id in
List.iter (fun (state,_) -> ignore(match_and_assign_with_one_state name_in_session state actionsL) ) !statesL
)
(!automate)
);*)
local_variable_change:=[]