let update_rhs_primed_vars subst rhs cst gsv =
(*BUG: this substitution may contain different assignments of the same variable! *)
(*** old version (May 3, 2005) ***
let new_subst =
(List.fold_left
(fun l -> function
Equal(Prime(t1),Cons(_,t2))
| Equal(Prime(t1),Delete(_,t2))
| Equal(Prime(t1),t2) ->
if (List.exists
(function
(Prime(tt1),_) ->
t1=tt1
| _ -> false)
l) then
(displayWarning 10
("
^(term_to_string (Prime(t1))));
l)
else
let l2 = (Prime(t1), apply_subst l t2)
in
(List.map
(fun (s,t) ->
(s, apply_subst l2 t))
l)
@ l2
| _ -> l)
subst rhs)
in
***) |
let new_subst =
let rec compute_subst l = function
Equal(Prime(t1),
Cons(_,(Cons(_)|Delete(_) as t2)))::l2
| Equal(Prime(t1),
Delete(_,(Cons(_)|Delete(_) as t2)))::l2 ->
compute_subst l (Equal(Prime(t1),t2)::l2)
| Equal(Prime(t1),Cons(_,t2))::l2
| Equal(Prime(t1),Delete(_,t2))::l2 ->
compute_subst
(let l' = [(Prime(t1), apply_subst l t2)] in
(List.map
(fun (s,t) ->
(s, apply_subst l' t))
l)
@ l')
l2
| Equal(Prime(t1),t2)::l2 ->
compute_subst
(if (List.exists
(function
(Prime(tt1),_) ->
t1=tt1
| _ -> false)
l) then
(displayWarning 10
("multiple assignment of variable "
^(term_to_string (Prime(t1))));
l)
else
let l' = [(Prime(t1), apply_subst l t2)]
in
(List.map
(fun (s,t) ->
(s, apply_subst l' t))
l)
@ l')
l2
| _::l2 -> compute_subst l l2
| [] -> l
in
compute_subst subst rhs
in
let if_equal_terms =
List.map
(function
(Prime(v),t) -> (Base(v),t)
| p -> p)
(List.fold_left
(fun l -> function
(Prime(v),_) as p ->
(List.filter
(function
(Base(v2),_) -> v<>v2
| _ -> true)
l)
@[p]
| (Base(v),_) as p ->
if List.exists
(function
(Prime(v2),_) -> v=v2
| _ -> false)
l then
l
else
l@[p]
| p -> l@[p])
[] new_subst)
in
(new_subst,
List.map2
(fun current_state_term generic_state_term ->
try (List.assoc generic_state_term if_equal_terms)
with Not_found -> current_state_term)
cst gsv)