let rec add_elem (to_purify : bool) (var_number : int) (ter : term) (subst : t_subst) :
t_subst =
let g_Base ee = (ee,false)
in
let g_Uplet var_nn lt ee =
match ee with
| (n,Uplet l) -> ((n, Uplet (replace var_nn lt l)),false)
| _ -> (ee,false)
in
let g_PInv nn t ee =
match ee with (* Here n:PubKey => m:PubKey => t:PubKey *)
| (n,PInv (Var m)) -> if m <> nn then (ee,false) else ((n,t), true)
| _ -> (ee,false)
in
let valeur2 n ls1 ls2 =
match valeur_elem n ls1 with
| Var m as t -> if m=n then valeur_elem n ls2 else t
| t -> t
in
(* lst : modified elements in the substitution to be evaluated.
tas : part of the substitution already computed. *)
let rec f (nn,tt,sub,g as elem) lst tas = function
| (n,Var m as ee)::fin ->
if m=nn then
let ee = (n,tt) in
f elem (ee::lst) (ee::tas) fin
else
f elem lst (ee::tas) fin
| (n,Xor l)::fin ->
( match norm_Xor (fun s t -> (t,s)) (sub,FreeVar 0,[]) l with
(* Rq : The new subst. is equal to sub since l is already purified. *)
| ([Var m],_) ->
let t = valeur2 m tas fin in
f elem ((n,t)::lst) ((n,t)::tas) fin
| ([t],_) -> f elem ((n,t)::lst) ((n,t)::tas) fin
| ([],_) -> f elem ((n,Atm 0)::lst) ((n,Atm 0)::tas) fin
| (l,_) -> f elem lst ((n,Xor l)::tas) fin
)
| (n,Exp(t,l))::fin ->
( match norm_Exp (fun s t -> (t,s)) (sub,FreeVar 0,[]) t l with
(* Rq : The new subst. is equal to sub since t and l are already purified. *)
| (Exp(_,_) as t,_) -> f elem lst ((n,t)::tas) fin
| (t, _) -> f elem ((n,t)::lst) ((n,t)::tas) fin
)
| ee::fin ->
let (e2,b) = g ee in
( match e2 with
| (n, Var m) ->
let t = valeur2 m tas fin in
f elem (if b then (n,t)::lst else lst) ((n,t)::tas) fin
| _ -> f elem (if b then e2::lst else lst) (e2::tas) fin
)
| _ ->
(match lst with
| (nn,(Uplet(lt) as tt))::fin ->
f (nn,tt,tas, g_Uplet (Var nn) lt ) fin [] tas
| (nn,(PInv(t) as tt))::fin ->
f (nn,tt,tas, g_PInv nn t ) fin [] tas
| (nn,tt)::fin ->
f (nn,tt,tas, g_Base ) fin [] tas
| [] ->
tas
)
in
let (tt,(ls,fv,ctr as s)) =
if to_purify then
val_purify subst ter
else
match ter with
| Var(n) -> (valeur n subst, subst)
| _ -> (ter,subst)
in
if tt = (Var var_number) then
s
else
if (not (acceptable_value s var_number tt)) then
(* But, a value failing to this test has a second chance : if
t=PInv(y) with y of type 0 (i.e. any mesage), then maybe
adding y = PInv(x) instead would work. HUM : I do not see
why there is not the same case for Xor: if t=Xor(y,z,...)
with y and z of type 0, we could try y=Xor(x,...) or
z=Xor(x,...). And even both if one fail with No_Solution.
This has to be checked. *)
match tt with
| PInv Var m ->
(match valeur m s with
| Var m ->
if var_type m = 0 then
add_elem false m (PInv (Var var_number)) s
else
raise No_Solution
| _ -> raise No_Solution
)
(* Added for bug correction. Check for Pb. *)
| Var m ->
(match valeur m s with
| Var m ->
if var_type m = 0 then
add_elem false m (Var var_number) s
else
raise No_Solution
| _ -> raise No_Solution
)
| Xor _ -> raise (NeedXorUnification (var_number, tt, s))
| _ -> raise No_Solution
else
(* Second, the main condition is that x \not\in s(t). This is
tested by ", or recursive in english, i.e. true iff
" appear in the argument, w.r.t ". *)
(* if (recursif s var_number (liste_var [] [tt])) then *)
(* raise No_Solution *)
(* New version : the main condition is that x \not\in s(t). This
is tested by contains_var, i.e. raise No_Solution iff " appear in
the argument, w.r.t ", outside a Xor; " if we need to
call the unification algorithm modulo Xor because x appear under
a Xor only; and " iff x do not appear in s(t). *)
if contains_var s var_number false [] [tt] then
raise (NeedXorUnification (var_number, tt, s))
else
(* When all these conditions are ok, we can start the
simplification > of ". This is the function " that do this. This
function pass over > the substitution, using it's argument
" to > normalize the parts that need to be. Rq :
The Xor is normalized > anyway, due to it's properties. Maybe we can
be more efficient here. > Arguments : ". > - " is the part of the substitution that still
need to be checked. > - " is the part of the substitution that
has been checked. We move > elements from subst to tas. > - " is
the list of changes in the substitution that require to repass > over
all the substitution again. It's a list of (variable, value). We add >
an element (x,t) in lst when the new value of t can produce simpli- >
fications in other variables values, i.e. when the new value of x
belong > to a different purification class than the old one. On the
other hand, > when we know that a value change connot have
side-effects, we do not > add it to lst. > > Initially, lst is
[var_number,tt], i.e. the first change in ". Also, " > contain
" and the new value x=t. In order to run, " must know > the
" adapted to x=t. Since " can compute > this
itself, the initial value of " is an empty set to force " > to
compute extract the first element of lst (i.e. x=t) and compute > the
corresponding element ". No need to > write this
code twice. :) > So, the initial value (0,Atm 0,[],fun x -> (x,false))
is just fake. >
*)
add_ctr ( (f (0,Atm 0,[],fun x -> (x,false))
[var_number,tt]
((var_number,tt)::ls)
[]),
fv,
[]
) ctr