+ (* TASSI: here we should think of a smarted data structure *)
+ module type Collector = sig
+ type t
+ val empty : t
+ val union : t -> t -> t
+ val inter : t -> t -> data list
+ val to_list : t -> data list
+ end
+ module Collector : Collector with type t = S.t = struct
+ type t = S.t
+ let union = S.union
+ let empty = S.empty
+
+ let merge l =
+ let rec aux s w = function
+ | [] -> [s,w]
+ | (t, wt)::tl when w = wt -> aux (A.union s t) w tl
+ | (t, wt)::tl -> (s, w) :: aux t wt tl
+ in
+ match l with
+ | [] -> []
+ | (s, w) :: l -> aux s w l
+
+ let rec undup ~eq = function
+ | [] -> []
+ | x :: tl -> x :: undup ~eq (List.filter (fun y -> not(eq x y)) tl)
+
+ let to_list t =
+ undup ~eq:(fun x y -> A.equal (A.singleton x) (A.singleton y))
+ (List.flatten (List.map
+ (fun x,_ -> A.elements x) (merge (S.elements t))))
+
+ let inter t1 t2 =
+ let l1 = merge (S.elements t1) in
+ let l2 = merge (S.elements t2) in
+ let res =
+ List.flatten
+ (List.map
+ (fun s, w ->
+ HExtlib.filter_map (fun x ->
+ try Some (x, w + snd (List.find (fun (s,w) -> A.mem x s) l2))
+ with Not_found -> None)
+ (A.elements s))
+ l1)
+ in
+ undup ~eq:(fun x y -> A.equal (A.singleton x) (A.singleton y))
+ (List.map fst (List.sort (fun (_,x) (_,y) -> y - x) res))
+ end
+