let rec ctrTest sub = function
| (Var n, Var m) ->
if n=m then
Equal
else
( match (valeur n sub, valeur m sub) with
| (Var n, Var m) -> if n=m then Equal else Uncertain
| (Var _, _) | (_, Var _) -> Uncertain
| et -> ctrTest sub et )
| (Var n, u) | (u, Var n) ->
(match valeur n sub with
| Var _ -> Uncertain
| v -> ctrTest sub (u,v) )
| (Uplet l1, Uplet l2) ->
let rec f = function
| (a::l1, b::l2) ->
(match ctrTest sub (a,b) with
| Equal -> f (l1,l2)
| res -> res )
| ([],[]) -> Equal
| _ -> NeverEqual
in
f (l1,l2)
| (Xor l1, Xor l2) ->
let rec f = function
| ((Var n)::l1, (Var m)::l2) ->
if n=m then f (l1,l2) else
(match (valeur n sub, valeur m sub) with
| (Var n, Var m) -> if n=m then f (l1,l2) else Uncertain
| (Var _, _) | (_, Var _) -> Uncertain
| (u,v) -> f (u::l1, v::l2) )
| ((Var n)::l1, l2) | (l2, (Var n)::l1) ->
(match valeur n sub with
| Var _ -> Uncertain
| t -> f (t::l1, l2) )
| ((PInv u)::l1, (PInv v)::l2) ->
(match (u,v) with
| (Var n, Var m) -> if n=m then f (l1,l2) else
(match (valeur n sub, valeur m sub) with
| (Var n, Var m) -> if n=m then f (l1,l2) else Uncertain
| (Var _, _) | (_, Var _) -> Uncertain
| (u,v) -> f ((PInv u)::l1, (PInv v)::l2) )
| (Var n, _) ->
(match valeur n sub with
| Var _ -> Uncertain
| t -> f ((PInv t)::l1, v::l2) )
| (_, Var n) ->
(match valeur n sub with
| Var _ -> Uncertain
| t -> f (u::l1, (PInv t)::l2) )
| _ -> if egal sub u v then f (l1,l2) else
(match (u,v) with
| (Xor _, _) | (_, Xor _) -> Uncertain
| (Atm _, _) | (_, Atm _) -> NeverEqual
| _ -> Uncertain ) (* This can be extended here. *)
)
| ((PInv u)::l1, l2) | (l2, (PInv u)::l1) ->
(match u with
| Var n -> (match valeur n sub with
| Var _ -> Uncertain
| t -> f ((PInv t)::l1, l2) )
| Xor _ -> Uncertain
| Atm _ -> NeverEqual
| _ -> Uncertain ) (* This can be extended here. *)
| ((Atm n)::_, (Atm m)::_) -> if n=m then Equal else NeverEqual
| ((Atm _)::_, _) | (_, (Atm _)::_) -> NeverEqual
| ((PCrypt (m1,k1))::l1, l2) | (l2, (PCrypt (m1,k1))::l1) ->
(match (l1,l2) with
| (_, (PCrypt (m2,k2))::l2) -> if (egal sub m1 m2) && (egal sub k1 k2)
then f (l1,l2)
else Uncertain
| ((PCrypt (_,_))::_, _) -> Uncertain (* Maybe expendable, but difficult, here. *)
| _ -> NeverEqual )
| ((SCrypt (m1,k1))::l1, l2) | (l2, (SCrypt (m1,k1))::l1) ->
(match (l1,l2) with
| (_, (SCrypt (m2,k2))::l2) -> if (egal sub m1 m2) && (egal sub k1 k2)
then f (l1,l2)
else Uncertain
| ((SCrypt (_,_))::_, _) -> Uncertain (* Maybe expendable, but difficult, here. *)
| _ -> NeverEqual )
| ((Uplet a)::l1, l2) | (l2, (Uplet a)::l1) ->
(match (l1,l2) with
| (_, (Uplet b)::l2) ->
(try if List.for_all2 (egal sub) a b then f (l1,l2) else Uncertain with
| _ -> Uncertain )
| ((Uplet _)::_, _) -> Uncertain (* Maybe expendable, but difficult, here. *)
| _ -> NeverEqual )
| ((Exp(u,a))::l1, (Exp(v,b))::l2) ->
(try if (egal sub u v) &&
(List.for_all2 (fun (t1,p1) (t2,p2) -> (p1=p2) && (egal sub t1 t2)) a b)
then f (l1,l2)
else Uncertain
with
| _ -> Uncertain )
| ((Exp(_,_))::[], []) | ([], (Exp(_,_))::[]) -> NeverEqual
| ((Exp(_,_))::_, []) | ([], (Exp(_,_))::_) -> Uncertain (* Maybe expendable, but difficult, here. *)
| ([],[]) -> Equal
| ((Xor _)::_, _) | (_, (Xor _)::_) -> (print_string "\nWARNING : Bug in ctrTest\n"; Uncertain)
in (* Impossible case thanks to normalisation. *)
f (l1,l2)
(* Rq : Ok for Xor because free variables appear first, then Xor and PInv, then Atm, etc... *)
(* The order in this matching must fit EXACTLY the order in comp ! *)
| (Exp(t1,l1), Exp(t2,l2)) ->
let x = ctrTest sub (t1,t2) in if x<>Equal then Uncertain else
let rec exists_unif = function (* Better : maybe_unif *)
| (_, []) -> false
| ((Var n, si1), l) -> ( match valeur n sub with Var _ -> true | t -> exists_unif ((t,si1),l) )
| ((Xor _, _), _) -> true
| ((PInv Var n, si1), l) -> ( match valeur n sub with Var _ -> true | t -> exists_unif ((PInv t,si1),l) )
| ((PInv Xor _, _), _) -> true
| ((PInv (PCrypt(_,_) as t1), si1 as a), (PInv (PCrypt(_,_) as t2), si2)::l)
| ((PInv (SCrypt(_,_) as t1), si1 as a), (PInv (SCrypt(_,_) as t2), si2)::l)
| ((PInv (Uplet _ as t1), si1 as a), (PInv (Uplet _ as t2), si2)::l)
| ((PInv (Exp(_,_) as t1), si1 as a), (PInv (Exp(_,_) as t2), si2)::l)
| ((PCrypt(_,_) as t1, si1 as a), (PCrypt(_,_) as t2, si2)::l)
| ((SCrypt(_,_) as t1, si1 as a), (SCrypt(_,_) as t2, si2)::l)
| ((Uplet _ as t1, si1 as a), (Uplet _ as t2, si2)::l)
| ((Exp(_,_) as t1, si1 as a), (Exp(_,_) as t2, si2)::l)
-> if (si1<>si2) && ((ctrTest sub (t1,t2)) <> NeverEqual) then true
else exists_unif (a,l)
| _ -> false in
let rec g = function
| Var n -> (match valeur n sub with Var _ -> 0 | t -> g t)
| Xor _ -> 0
| PInv t -> (g t) / 10
| Atm _ -> 10
| PCrypt(_,_) -> 20
| SCrypt(_,_) -> 30
| Uplet(_) -> 40
| Exp(_,_) -> 50 in
let rec f = function
| ([],[]) -> Equal
| (_, []) | ([], _) -> NeverEqual
| ((t1,si1 as a)::l1, (t2,si2 as b)::l2) ->
match (ctrTest sub (t1,t2), si1=si2) with
| Equal,true -> f (l1,l2)
| Uncertain,true -> Uncertain
| _ -> let g1 = g t1 and g2 = g t2 in
if ((exists_unif (a,l1)) && (g2 >= g1))
|| ((exists_unif (b,l2)) && (g1 >= g2))
then Uncertain
else NeverEqual
in f (l1,l2)
| (SCrypt(m1,k1),SCrypt(m2,k2))
| (PCrypt(m1,k1),PCrypt(m2,k2)) ->
( match ctrTest sub (m1,m2) with
| Equal -> ctrTest sub (k1,k2)
| NeverEqual -> NeverEqual
| Uncertain ->
match ctrTest sub (k1,k2) with
| NeverEqual -> NeverEqual
| _ -> Uncertain )
| (Atm n, Atm m ) -> if n=m then Equal else NeverEqual
| (PInv u, PInv v) -> ctrTest sub (u,v)
| ((Xor _ as u), t) | (t, (Xor _ as u)) -> ctrTest sub (u, Xor [t])
| (PInv Var n, t) | (t, PInv Var n) -> (match valeur n sub with
| Var _ | Xor _ -> Uncertain
| PInv tt -> ctrTest sub (tt,t)
| _ -> NeverEqual )
| (PInv Xor _, _) | (_, PInv Xor _) -> Uncertain
| (PInv (PInv u), v) | (u, PInv (PInv v)) -> ctrTest sub (u,v)
(*
| (Uplet _, PCrypt(_,_)) | (Uplet _, SCrypt(_,_)) | (Uplet _, Atm _) | (Uplet _, Exp(_,_)) | (Uplet _, PInv(Atm _))
| (Uplet _, PInv(Uplet _)) | (Uplet _, PInv(PCrypt(_,_))) | (Uplet _, PInv(SCrypt(_,_))) | (Uplet _, PInv(Exp(_,_)))
| (PCrypt(_,_) , Uplet _) | (PCrypt(_,_) , SCrypt(_,_)) | (PCrypt(_,_) , Atm _) | (PCrypt(_,_) , Exp(_,_)) | (PCrypt(_,_) , PInv(Atm _))
| (PCrypt(_,_) , PInv(Uplet _)) | (PCrypt(_,_) , PInv(PCrypt(_,_))) | (PCrypt(_,_) , PInv(SCrypt(_,_))) | (PCrypt(_,_) , PInv(Exp(_,_)))
| (SCrypt(_,_) , PCrypt(_,_)) | (SCrypt(_,_) , Uplet _) | (SCrypt(_,_) , Atm _) | (SCrypt(_,_) , Exp(_,_)) | (SCrypt(_,_) , PInv(Atm _))
| (SCrypt(_,_) , PInv(Uplet _)) | (SCrypt(_,_) , PInv(PCrypt(_,_))) | (SCrypt(_,_) , PInv(SCrypt(_,_))) | (SCrypt(_,_) , PInv(Exp(_,_)))
| (Atm _ , PCrypt(_,_)) | (Atm _ , SCrypt(_,_)) | (Atm _ , Uplet _) | (Atm _ , Exp(_,_)) | (Atm _ , PInv(Atm _))
| (Atm _ , PInv(Uplet _)) | (Atm _ , PInv(PCrypt(_,_))) | (Atm _ , PInv(SCrypt(_,_))) | (Atm _ , PInv(Exp(_,_)))
| (Exp(_,_) , PCrypt(_,_)) | (Exp(_,_) , SCrypt(_,_)) | (Exp(_,_) , Atm _) | (Exp(_,_) , Uplet _) | (Exp(_,_) , PInv(Atm _))
| (Exp(_,_) , PInv(Uplet _)) | (Exp(_,_) , PInv(PCrypt(_,_))) | (Exp(_,_) , PInv(SCrypt(_,_))) | (Exp(_,_) , PInv(Exp(_,_)))
| (PInv(Atm _) , PCrypt(_,_)) | (PInv(Atm _) , SCrypt(_,_)) | (PInv(Atm _) , Atm _) | (PInv(Atm _) , Exp(_,_)) | (PInv(Atm _) , Uplet _)
| (PInv(Uplet _) , Uplet _) | (PInv(Uplet _) , PCrypt(_,_)) | (PInv(Uplet _) , SCrypt(_,_)) | (PInv(Uplet _) , Atm _) | (PInv(Uplet _) , Exp(_,_))
| (PInv(PCrypt(_,_)) , Uplet _) | (PInv(PCrypt(_,_)) , PCrypt(_,_)) | (PInv(PCrypt(_,_)) , SCrypt(_,_)) | (PInv(PCrypt(_,_)) , Atm _) | (PInv(PCrypt(_,_)) , Exp(_,_))
| (PInv(SCrypt(_,_)) , Uplet _) | (PInv(SCrypt(_,_)) , PCrypt(_,_)) | (PInv(SCrypt(_,_)) , SCrypt(_,_)) | (PInv(SCrypt(_,_)) , Atm _) | (PInv(SCrypt(_,_)) , Exp(_,_))
| (PInv(Exp(_,_)) , Uplet _) | (PInv(Exp(_,_)) , PCrypt(_,_)) | (PInv(Exp(_,_)) , SCrypt(_,_)) | (PInv(Exp(_,_)) , Atm _) | (PInv(Exp(_,_)) , Exp(_,_))
-> NeverEqual (* This big matching must have the same effect as _ -> NeverEqual *)
*)
| _ -> NeverEqual
and ctrTest_exp sub (a,u) (b,v) =
if u<>v then NeverEqual else ctrTest sub (a,b)