let unfold_instances main_call =
let basic_roles_encontered = ref [] in
let rec unfold_instances_rec some_composition_type prev_role_instance =
let handle_multi_call composition_over composition_expression =
let session_id = prev_role_instance#get_session_Id in
let set_of_composition = composition_over#get_set in
let set_value = get_set_if_value session_id set_of_composition in
let set_of_composition_instance =
match set_value with
If_set(l) ->
List.map
(function
| If_set u ->
if (!debug_level >= 2) then
(prerr_string " it contains the term ";
Interface.prerr_ground_if_value (If_set u);
prerr_newline());
u
| If_pair(_) as p ->
ifpair_to_list p
| wrong ->
(displayWarning 0
("Instantiations.unfold_instances: a set used for composition does not contain lists, it contains the term "
^(Interface.ground_if_value_to_string wrong));
raise Not_found))
l
| _ ->
displayWarning 0 "Instantiations.unfold_instances: value pointed to by the set pointer is not a set";
raise Not_found
in
let variable_list_in_term_type =
pair_to_list composition_over#get_term
in
let variable_list_in_global_id =
List.map
(variable_in_term_type_to_variable_global_id session_id)
variable_list_in_term_type
in
if set_of_composition_instance = [] then
(displayWarning 0 "Instantiations.unfold_instances: empty set/list in parallel composition!";
None)
else
let treat_one_instance instance =
List.iter2
(fun global_id if_value_term ->
ignore
(Globals.value_table#set_value
(memory_map#get_map global_id)
if_value_term))
variable_list_in_global_id instance;
let t = unfold_instances_rec composition_expression prev_role_instance in
t
in
let lt =
List.fold_left
(fun lt instance ->
(match treat_one_instance instance with
None -> lt
| Par(l) -> lt@l
| t -> lt@[t]))
[] set_of_composition_instance
in
if List.length lt = 0 then None
else if List.length lt = 1 then List.hd lt
else Par(lt)
in
match some_composition_type with
MultiPar (multi_call,composition) ->
if (!debug_level >= 2) then
prerr_endline "%% MultiPar...";
let t = handle_multi_call multi_call composition in
if (!debug_level >= 2) then
prerr_endline "%% End MultiPar...";
t
| Sequential(type1,type2) ->
displayWarning 1 "Instantiation.unfold_instances: sequential composition";
if (!debug_level >= 2) then
prerr_endline "%% Sequential...";
let t1 = unfold_instances_rec type1 prev_role_instance in
let t2 = unfold_instances_rec type2 prev_role_instance in
if (!debug_level >= 2) then
prerr_endline "%% End Sequential...";
(match t1,t2 with
_,None -> t1
| None,_ -> t2
| Seq(l1),Seq(l2) -> Seq(l1@l2)
| Seq(l1),_ -> Seq(l1@[t2])
| _,Seq(l2) -> Seq(t1::l2)
| _ -> Seq([t1;t2]))
| Parallel(type1,type2) ->
if (!debug_level >= 2) then
prerr_endline "%% Parallel...";
let t1 = unfold_instances_rec type1 prev_role_instance in
let t2 = unfold_instances_rec type2 prev_role_instance in
if (!debug_level >= 2) then
prerr_endline "%% End Parallel...";
(match t1,t2 with
_,None -> t1
| None,_ -> t2
| Par(l1),Par(l2) -> Par(l1@l2)
| Par(l1),_ -> Par(l1@[t2])
| _,Par(l2) -> Par(t1::l2)
| _ -> Par([t1;t2]))
| Call(calltyp) ->
(if (!debug_level >= 2) then
prerr_string "%%% Call...";
let roleinstance = (new Types.role_instance calltyp) in
let session_id = roleinstance#get_session_Id in
if (!debug_level >= 2) then
prerr_string ((string_of_int session_id)^"..."^(string_of_int calltyp#get_role)^"...");
let prev_session_id = prev_role_instance#get_session_Id in
let role_id = calltyp#get_role in
let (is_basic_role,basic_role,comp_role,role_found) =
match (find_role role_id) with
Basic br ->
(true,br,!dummy_composition_role,(br :> Types.generic_hlpsl_role))
| Composition br ->
(false,!dummy_basic_hlpsl_role,br,(br :> Types.generic_hlpsl_role))
in
if (!debug_level >= 2) then
prerr_endline (Globals.string_id#get_name (role_found#get_name));
let all_param =
compute_assignation_list
(calltyp#get_args)
(List.map (fun x -> x#get_id) role_found#get_param)
session_id
prev_session_id
in
let effective_param =
filter_args
(if is_basic_role then
not_excluded_type
else (fun _ -> true))
all_param
in
let (param_gids,call_args) =
List.split effective_param
in
let local_gids =
compute_initial_infos
role_found
session_id
in
compute_knowledge_given_to_intruder role_found session_id;
if is_basic_role then
(
roleinstance#set_variable_instances (param_gids @ local_gids);
if (played_by_intruder basic_role session_id) then
(if (!debug_level >= 2) then
prerr_endline ("% Role played by the intruder: "
^(string_id#get_name role_found#get_name)))
else
(if (!debug_level >= 2) then
prerr_endline ("% Role not played by the intruder: "
^(string_id#get_name role_found#get_name));
if (!debug_level >= 2) then
prerr_string "% Creation of the SID variable...";
let sid = make_sid_variable session_id role_found#get_name in
roleinstance#set_variable_instances
(Utils.remove_duplicate
(((Globals.global_var_id#get_id_of
session_id
(basic_role#get_player))
::(roleinstance#get_variable_instances))
@[sid]));
if (!debug_level >= 2) then
prerr_endline " ok.";
if (!debug_level >= 2) then
prerr_string "% Creation of the initial state...";
let init_state =
[ State((string_id#get_name (roleinstance#get_name)),
(roleinstance#get_session_Id),
List.map
(fun x -> Base(Var(x)))
roleinstance#get_variable_instances)
]
in
if (!debug_level >= 2) then
prerr_endline " ok.";
if (!debug_level >= 2) then
prerr_endline "% Creation of the (re)actions list...";
let actions_list =
if List.mem (basic_role#get_name) !basic_roles_encontered then
(if (!debug_level >= 2) then
prerr_endline "% -> already encountered.";
[])
else
get_if_reactions
(basic_role#get_name)
(List.map snd basic_role#get_actions)
(roleinstance#get_variable_instances)
session_id
!goals
in
if (!debug_level >= 2) then
prerr_endline "% -> (re)actions list ok.";
if (!debug_level >= 2) then
prerr_string "% Setting the global variables...";
roleinstance#set_initial_state init_state;
roleinstance#set_actions actions_list;
basic_role_instances :=
!basic_role_instances @ [(session_id,roleinstance)];
if (!debug_level >= 2) then
prerr_endline " ok.";
if (!debug_level >= 2) then
prerr_endline
("%%% End of treatment of the basic role "^
(Globals.string_id#get_name (role_found#get_name))));
Inst(session_id))
else
(
roleinstance#set_variable_instances (param_gids @ local_gids);
if (!debug_level >= 2) then
prerr_endline
("%%% End of treatment of composition role "^
(string_id#get_name role_found#get_name));
unfold_instances_rec (comp_role#get_composition) roleinstance))
| Empty -> None
in
unfold_instances_rec main_call (new role_instance (new Types.call_type 0 []))