let to_unify_format_reciever (name : string) (mess : string) (untyped_variable : bool) : (string * string) * Types_unify.term =
let give_unify_type type_automat =
if(type_automat="message" || (decompose type_automat)<>[]) then 0
else if(Hashtbl.mem automate_types_to_unify_types type_automat) then (Hashtbl.find automate_types_to_unify_types type_automat)
else (id_type := 1+ (!id_type) ; Hashtbl.add automate_types_to_unify_types type_automat (!id_type) ; (!id_type) )
in
let add mess1 mess2 =
let display_mess2 = display mess2 in
if(((snd mess1)<>"") && not(Hashtbl.mem automtat_to_unify_format mess1 ) )
then(
Hashtbl.add automtat_to_unify_format mess1 (display_mess2,mess2);
);
if(((snd mess1)<>"") && not(Hashtbl.mem unify_format_to_automat display_mess2) )
then(
Hashtbl.add unify_format_to_automat display_mess2 mess1;
);
(mess1,mess2)
in
let add_var e =
let h = (Hashtbl.find_all automtat_to_unify_format (name,e) ) in
if(h<>[]) then ((name,e),(snd (car h)))
else ( id_var_atom := 1+(!id_var_atom) ;
add (name,e) (x (!id_var_atom))
)
in
let add_atom e =
let h = (Hashtbl.find_all automtat_to_unify_format ("_",e) ) in
if(h<>[]) then(("_",e),(snd (car h)))
else ( id_var_atom := 1+(!id_var_atom) ;
add ("_",e) (a (!id_var_atom))
)
in
let add_var_typed e t =
let h = (Hashtbl.find_all automtat_to_unify_format (name,e) ) in
if(h<>[]) then((name,e),(snd (car h)))
else ( id_var_atom := 1+(!id_var_atom) ;
add (name,e) (xt (!id_var_atom) t)
)
in
let add_atom_typed e t =
let h = (Hashtbl.find_all automtat_to_unify_format ("_",e) ) in
if(h<>[]) then(("_",e),(snd (car h)))
else ( id_var_atom := 1+(!id_var_atom) ;
add ("_",e) (at (!id_var_atom) t)
)
in
let rec aux mess =
let hmess = Hashtbl.find_all automtat_to_unify_format (name,mess) in
if(hmess<>[]) then ((name,mess), (snd (car hmess)))
else(
if ( (is_a_value mess)) then (add_atom mess)
else if (untyped_variable &&(is_a_test_var mess)) then (
let value = (get_value_of_var name mess) in
if((decompose value)<>[]) then (
let ((_,m01),m02) = aux value in
add (name,m01) m02
)
else add_atom value
)
else if (untyped_variable &&(is_a_var mess)) then (add_var mess)
else if (is_a_value mess) then (add_atom_typed (get_name_of_var mess) (give_unify_type (get_type mess)))
else if (is_a_test_var mess) then (
let value = (get_value_of_var name mess) in
if((decompose value)<>[]) then (
let ((_,m01),m02) = aux value in
add (name,m01) m02
)
else add_atom_typed value (give_unify_type (get_type (get_name_of_var mess)))
)
else if (is_a_var mess) then (add_var_typed (get_name_of_var mess) (give_unify_type (get_type (get_name_of_var mess))))
else
let l_mess = decompose mess in
if(l_mess=[]) then (add_var mess)
else
(if((car l_mess)="pair") then (
let l = List.map aux (cdr l_mess) in
let l_fst = List.map (fun e -> snd (fst e)) l in
let l_snd = List.map snd l in
add (name, ("pair("^(list2string "," l_fst)^")"))
(Uplet l_snd)
)
else if((car l_mess)="scrypt") then (
let ((_,m01),m02) = aux (cadr l_mess) in
let ((_,m11),m12) = aux (caddr l_mess) in
add (name, ("scrypt("^m01^","^m11^")"))
(SCrypt (m12, m02))
)
else if((car l_mess)="crypt") then (
let ((_,m01),m02) = aux (cadr l_mess) in
let ((_,m11),m12) = aux (caddr l_mess) in
add (name, ("crypt("^m01^","^m11^")"))
(PCrypt (m12, m02))
)
else if((car l_mess)="inv") then (
let ((_,m01),m02) = aux (cadr l_mess) in
add (name, ("inv("^m01^")"))
(PInv (m02))
)
else if((car l_mess)="xor") then (
let l = List.map aux (cdr l_mess) in
let l_fst = List.map (fun e -> snd (fst e)) l in
let l_snd = List.map snd l in
add (name, ("xor("^(list2string "," l_fst)^")"))
(Xor (l_snd))
)
else if((car l_mess)="exp") then (
let l = List.map aux (cdr l_mess) in
let l_fst = List.map (fun e -> snd (fst e)) l in
let l_snd = List.map snd l in
add (name, ("exp("^(list2string "," l_fst)^")"))
(Exp ((car l_snd), (List.map (fun ((_,a),e) -> if(a.[0]='-') then (e, Neg) else (e, Pos) )(cdr l))))
)
else if((car l_mess)="apply") then (
let l = List.map aux (cdr l_mess) in
let l_fst = List.map (fun e -> snd (fst e)) l in
let l_snd = List.map snd l in
add (name, ("apply("^(list2string "," l_fst)^")"))
(SCrypt ((Uplet (cdr l_snd)), (car l_snd)))
)
else (
let l = List.map aux l_mess in
let l_fst = List.map (fun e -> snd (fst e)) l in
let l_snd = List.map snd l in
add (name, ((car l_fst)^"("^(list2string "," (cdr l_fst))^")"))
(PCrypt ((Uplet (cdr l_snd)), (car l_snd)))
)
)
);
in
aux mess