let check_args call specif =
let list_role =specif#get_roles in
let r =
let rec find_role = function
[] ->
raise (Undefined_role (Globals.string_id#get_name(call#get_role)))
| head::rest ->
(match head with
Basic(t) ->
if t#get_name =call#get_role then head
else find_role rest
| Composition(t) ->
if t#get_name =call#get_role then head
else find_role rest)
in
find_role list_role
in
let list_param =
match r with
Basic(basic_role) -> basic_role#get_param
| Composition(composition_role) -> composition_role#get_param
in
let list_args = call#get_args in
let rec is_type_correct arg param_type =
(always_compatible_types param_type)
||
match arg with
Base(Var(id))
| Base(Const(id))
| Prime(Var(id))->
(try
let arg_type = Globals.type_table#get_type id in
compatible_types (arg_type,param_type)
with Not_found ->
ignore (Globals.type_table#register_type id param_type);
true)
| Function(term,la) ->
let term_type =
(match term with
Base(Var(n))
| Base(Const(n))
| Prime(Var(n)) ->
Globals.type_table#get_type n
| _ -> raise (No_function ""))
in
(match term_type with
Base(Hash_func) ->
(try (compare_types arg param_type; true)
with _ -> false)
| Function(r,lp) ->
(compatible_types (r,param_type))
&&
(let rec check_each_arg = function
(a1::la1,p2::lp2) ->
(is_type_correct a1 p2)
&& (check_each_arg (la1,lp2))
| ([],[]) -> true
| _ -> invalid_arg "check_args: incorrect number of arguments"
in
check_each_arg (la,lp))
| _ -> false)
| Set(la) ->
(match param_type with
Function(u,lp) ->
let rec check_each_arg = function
(Pair(a1,la1),p2::lp2) ->
(is_type_correct a1 p2)
&& (check_each_arg (la1,lp2))
| (a1,[]) ->
(is_type_correct a1 u)
| _ -> invalid_arg "check_args: incorrect number of arguments"
in
List.fold_left
(fun b a ->
(check_each_arg (a,lp)) && b)
true la
| Set(lp) ->
List.fold_left2
(fun b a p ->
(is_type_correct a p) && b)
true la lp
| _ ->
false)
| Cons(e,s)
| Delete(e,s) ->
(match param_type with
Set([]) -> true
| Set(t::_) ->
(is_type_correct s param_type)
&& (is_type_correct e t)
| _ -> false)
| _ ->
(match (arg,param_type) with
Inv(t1),Inv(t2) ->
is_type_correct t1 t2
| Pair(t1,t2),Pair(t3,t4) ->
(is_type_correct t1 t3) && (is_type_correct t2 t4)
| Scrypt(t1,t2),Scrypt(t3,t4) ->
(is_type_correct t1 t3) && (is_type_correct t2 t4)
| Crypt(t1,t2),Crypt(t3,t4) ->
(is_type_correct t1 t3) && (is_type_correct t2 t4)
| _,_ -> false)
in
try
let n = ref 0 in
List.iter2
(fun par arg ->
n := !n + 1;
if not (is_type_correct arg (par#get_type)) then
raise (Error_parameters (string_of_int !n)))
list_param list_args;
with Invalid_argument _ -> raise (Error_parameters ("-1"))