-let normalize to_be_considered_and_now candidate set =
- let rec aux =
- function
- [] -> raise Not_found
- | (repr,others,leq,geq) as eqclass :: tl ->
- if test to_be_considered_and_now set Equal candidate repr then
- (repr,others@[candidate],leq,geq)::tl
- else
- eqclass::(aux tl)
+let remove node = List.filter (fun node' -> node <=> node');;
+
+let add_leq_arc ((_,_,leq,_) as node) ((_,_,_,geq') as node') =
+ leq := node' :: !leq;
+ geq' := node :: !geq'
+;;
+
+let add_geq_arc ((_,_,_,geq) as node) ((_,_,leq',_) as node') =
+ geq := node' :: !geq;
+ leq' := node :: !leq'
+;;
+
+let remove_leq_arc ((_,_,leq,_) as node) ((_,_,_,geq') as node') =
+ leq := remove node' !leq;
+ geq' := remove node !geq'
+;;
+
+let remove_geq_arc ((_,_,_,geq) as node) ((_,_,leq',_) as node') =
+ geq := remove node' !geq;
+ leq' := remove node !leq'
+;;
+
+let leq_transitive_closure node node' =
+ add_leq_arc node node';
+ let rec remove_transitive_arcs ((_,_,_,geq) as node) (_,_,leq',_) =
+ let rec remove_arcs_to_ascendents =
+ function
+ [] -> ()
+ | (_,_,leq,_) as node'::tl ->
+ remove_leq_arc node node';
+ remove_arcs_to_ascendents (!leq@tl)
+ in
+ remove_arcs_to_ascendents !leq';
+ List.iter (function son -> remove_transitive_arcs son node) !geq