let check_all specif =
let generic_role_check role role_name =
check_duplication role;
List.iter
(fun init_predicates ->
let handle_error f t =
try f t
with
Undefined_var s ->
add_sem_error
(11,s,role_name,"","init state","")
| Undefined_const s ->
Error_handler.displayWarning
7 (s^" in init state of role "^role_name)
in
check_predicate_vars handle_error init_predicates;
let handle_error f t =
try f t
with
Error ->
add_sem_error
(12,"",role_name,"","init state","")
| Invalid_build s ->
add_sem_error
(5,s^"i",role_name,"","","")
in
check_equal handle_error init_predicates)
role#get_init;
List.iter
(fun pr ->
let handle_error f t =
try f t
with
Undefined_var s ->
add_sem_error
(11,s,role_name,"","accept state","")
| Undefined_const s ->
Error_handler.displayWarning
7 (s^" in accept state of role "^role_name)
in
check_predicate_vars handle_error pr)
role#get_accept;
let handle_error f t =
try f t
with
Undefined_var s ->
add_sem_error
(11,s,role_name,"","intruder knowledge declaration","")
| Undefined_const s ->
Error_handler.displayWarning
7 (s^" in intruder knowledge declaration of role "^role_name)
| Error ->
add_sem_error
(12,"",role_name,"","intruder knowledge declaration","")
in
List.iter (check_var handle_error) role#get_knowledge
in
List.iter
(function
Basic(basic_role) ->
let name = Globals.string_id#get_name basic_role#get_name in
generic_role_check basic_role name;
let actions = basic_role#get_actions in
let check_transition =
(fun (is_action,tr) ->
let name_tr = Globals.string_id#get_name tr#get_label in
let handle_error f t =
try
f t
with
Undefined_var s -> add_sem_error(11,s,name,name_tr,"","")
| Undefined_const s ->
Error_handler.displayWarning
7 (s^" in transition "^name_tr^" of role "^name)
| Invalid_transition -> add_sem_error(4,"",name,name_tr,"","")
| Invalid_build s -> add_sem_error(5,s^"t",name,name_tr,"","")
| Error_start -> add_sem_error(10,"",name,name_tr,"","")
in
let rec check_atoms = function
Not(p) ->
check_atoms p
| New(t) ->
check_var handle_error (Base(Var(t)))
| Equal(t1,t2) ->
check_var handle_error t1;
check_var handle_error t2;
check_cons handle_error t1;
check_cons handle_error t2
| Leq(t1,t2)
| In(t1,t2) ->
check_var handle_error t1;
check_var handle_error t2;
check_cons handle_error t1;
check_cons handle_error t2
| Event(Const(i),lt) ->
List.iter (check_var handle_error) lt;
check_cons handle_error (Base(Const(i)));
List.iter (check_cons handle_error) lt
| Event(t,lt) ->
check_var handle_error (Base t);
List.iter (check_var handle_error) lt;
check_cons handle_error (Base t);
List.iter (check_cons handle_error) lt
in
List.iter
(fun state ->
check_atoms state;
check_start handle_error state)
(tr#get_lhs@tr#get_rhs);
if is_action then
check_no_event_in_lhs ("role "^name^", transition "^name_tr) tr
else
check_event_in_lhs ("role "^name^", transition "^name_tr) tr)
in
List.iter check_transition actions;
| Composition(composition_role) ->
let name = Globals.string_id#get_name composition_role#get_name in
let comp = composition_role#get_composition in
let handle_multi_dec multi_call =
let term = multi_call#get_term in
let var_list = pair_to_list term in
let type_list =
match (type_table#get_type (multi_call#get_set)) with
Function(in_type,[out_type]) ->
[in_type]@(pair_to_list out_type)
| Set([elem_type]) ->
pair_to_list elem_type
| _ -> [Base(Message)]
in
let handle_error f t =
try f t
with
Undefined_var s ->
add_sem_error
(11,s,name,"","multi parallel composition","")
| Undefined_const s ->
Error_handler.displayWarning
7 (s^" in multi parallel composition of role "^name)
| Error ->
add_sem_error
(12,"",name,"","multi parallel composition","")
in
List.iter (check_var handle_error) var_list;
List.iter2
(fun var tp ->
ignore
(Globals.type_table#register_type
(match var with
Base(Var i) -> i
| _ ->
Error_handler.displayWarning
2 "handle_multi_dec";
0)
tp))
var_list type_list;
check_cons
(fun f t ->
try f t
with
Invalid_argument _ ->
add_sem_error (15,"",name,"","",""))
term;
in
let rec scan_composition = function
Call(c) ->
let name_cal = Globals.string_id#get_name c#get_role in
let handle_error f t =
try
f t
with
Undefined_var s ->
add_sem_error(11,s,name,"","",name_cal)
| Undefined_const s ->
Error_handler.displayWarning
7 (s^" in Call "^name_cal^" of role "^name)
| Undefined_role s ->
add_sem_error(0,"",s,"","","")
| No_function s ->
add_sem_error(1,s,name,"","",name_cal)
| Invalid_build s ->
add_sem_error(5,s^"c",name,"","",name_cal)
| Error_parameters s ->
add_sem_error(2,s,name,"","",name_cal)
in
List.iter
(fun term ->
check_var handle_error term;
check_cons handle_error term)
c#get_args;
handle_error (check_args c) specif
| MultiPar(multi_call,composition) ->
handle_multi_dec multi_call;
scan_composition composition
| Sequential(t1,t2)
| Parallel(t1,t2) ->
scan_composition t1;
scan_composition t2
| Empty ->
()
in
try
generic_role_check composition_role name;
scan_composition comp
with
Undefined_var s -> add_sem_error(11,s,name,"","","")
| Invalid_build s -> add_sem_error(5,s,name,"","",""))
specif#get_roles;
let t = Globals.string_id#get_tab_string_to_id in
Hashtbl.iter
(fun (st,idrole1) idst ->
try
(let type_idst = Globals.type_table#get_type idst in
Hashtbl.iter
(fun (st2,idrole2) idst2 ->
if (st = st2) && (idrole1 < idrole2) then
try
(let type_idst2 = Globals.type_table#get_type idst2 in
if not (compatible_types (type_idst,type_idst2)) then
add_sem_error(18,st, (try Globals.string_id#get_name idrole1 with _ -> ""),
(try Globals.string_id#get_name idrole2 with _ -> ""),"",""))
with Not_found -> ())
t)
with Not_found -> ())
t;
check_goals specif#get_goals;
if (!list_of_errors <> []) then
(List.iter Error_handler.handleSemanticError !list_of_errors;
if !debug_level >= 5 then
Utils_debug.dump();
exit(-1))