let multi_transition (initial : string * string list) (cond : string list) (exists_var_list : string list) (final : string * string list) :
((string * string) *
((string list * string list) * (string list * string list)) *
(string * string)) list =
let var_new s =
let res = ref s in
List.iter (fun v -> res := (replace (","^v^",") (","^v^"_new,") (!res))) exists_var_list;
!res
in
let var_new_iknows s =
let res = ref s in
List.iter
(fun v ->
if ((!res)=v) then res := ((!res)^"_new")
else(
res := (replace (","^v^")") (","^v^"_new)") (!res));
res := (replace ("("^v^",") ("("^v^"_new,") (!res));
res := (replace (","^v^",") (","^v^"_new,") (!res))
)
)
exists_var_list;
!res
in
let replace_head head l =
if(l<>[]) then (head^"("^(list2string "," (cdr l))^")")
else head
in
let rec find_iknows_contains_left l_snd l_other iknows test affectation =
match l_snd with [] -> (List.rev iknows,
List.rev test,
List.rev affectation)
|(x::ls) -> let d = decompose x in
if(d<>[])
then(
let dd = decompose (cadr d) in
if((car d) = "iknows" )
then find_iknows_contains_left ls l_other (x::iknows) test affectation
else if((car d) = "contains" && not(List.mem x l_other))
then find_iknows_contains_left ls l_other iknows (x::test) ((replace_head "delete" d)::affectation)
else if((car d) = "contains" && (List.mem x l_other) && not(List.mem x test))
then find_iknows_contains_left ls l_other iknows (x::test) affectation
else if ((car d)="not" && (car dd)="contains" && not(List.mem (cadr d) l_other))
then find_iknows_contains_left ls l_other iknows test ((replace_head "delete" dd)::affectation)
else if((car d) = "leq" || (car d) = "equal" || (car d) = "idequal" || (car d) = "not")
then find_iknows_contains_left ls l_other iknows (x::test) affectation
else if((car d)<>"secret" && (car d)<>"witness" && (car d)<>"request")
then find_iknows_contains_left ls l_other (x::iknows) test affectation
else find_iknows_contains_left ls l_other iknows test affectation
)
else find_iknows_contains_left ls l_other (x::iknows) test affectation;
in
let rec find_iknows_contains_right l_snd l_other iknows test affectation =
match l_snd with [] -> (List.rev iknows,
List.rev test,
List.rev affectation)
|(x::ls) -> let d = decompose x in
if(d<>[])
then(
if((car d) = "iknows" )
then find_iknows_contains_right ls l_other (x::iknows) test affectation
else if((car d) = "contains" && not(List.mem x l_other))
then find_iknows_contains_right ls l_other iknows test ((replace_head "cons" d)::affectation)
else if((car d) = "contains" && (List.mem x l_other) && not(List.mem x test))
then find_iknows_contains_right ls l_other iknows (x::test) affectation
else if((car d) = "leq" || (car d) = "equal" || (car d) = "idequal" || (car d) = "not")
then find_iknows_contains_right ls l_other iknows (x::test) affectation
else if((car d)<>"secret" && (car d)<>"witness" && (car d)<>"request")
then find_iknows_contains_right ls l_other (x::iknows) test affectation
else find_iknows_contains_right ls l_other iknows test affectation
)
else find_iknows_contains_right ls l_other (x::iknows) test affectation;
in
let fst_final_new = var_new (fst final) in
let (iknows_initial, op_test_initial, op_affectation_initial) = find_iknows_contains_left ((snd initial)@cond) (snd final) [] [] [] in
let (iknows_final, op_test_final, op_affectation_final) = find_iknows_contains_right (snd final) ((snd initial)@cond) [] [] [] in
let iknows_final0 = if(iknows_final<>[]) then iknows_final else [""] in
let iknows_initial0 = if(iknows_initial<>[]) then iknows_initial else [""] in
List.flatten (List.map
(fun x -> (List.map (fun y -> ((fst(initial), x),((op_test_initial,op_affectation_initial),(op_test_final,op_affectation_final)),(fst_final_new, (var_new_iknows y) ))) iknows_final0))
iknows_initial0)