+let w_compare s1 s2 =
+ let c = compare (List.length s1) (List.length s2) in
+ if c = 0 then compare s1 s2 else c
+;;
+
+exception Found of GL.V.t;;
+
+let rec iter n cgraph (canonical: w -> GL.V.t) =
+ print_endline ("STEP " ^ string_of_int n);
+ let nodes = GL.fold_vertex (fun n l -> n::l) cgraph [] in
+ let nodes = step (List.map List.hd nodes) in
+(*let nodes = [[C;M];[C;M;C;M];[C;M;C;M;C;M];[C;M;C;M;C;M;C;M];[C;M;C;M;C;M;C;M;C;M]] in*)
+(*let nodes = [[C;I;C;I;C;I]] in*)
+ (*let nodes = step (List.concat nodes) in*)
+(*List.iter (fun x -> prerr_endline ("#@ " ^ string_of_w x)) nodes;*)
+ let arcs = normalize canonical nodes in
+ iteri (fun (x,y) -> if x <> y then GL.add_edge cgraph x y) arcs;
+(*List.iter (fun (x,y) -> prerr_endline (string_of_eqclass x ^ " -> " ^ string_of_eqclass y)) arcs;*)
+
+ print_endline ("<scc>");
+ let classes,norm =
+ let module SCC = Graph.Components.Make(GL) in SCC.scc cgraph in
+ let xxx =
+ let module SCC = Graph.Components.Make(GL) in SCC.scc_array cgraph in
+ print_endline ("</scc>");
+ let get_canonical n =
+ try List.sort w_compare (List.concat (xxx.(norm n)))
+ with Not_found -> n
+ in
+ let nodes = GL.fold_vertex (fun n l -> n::l) cgraph [] in
+ print_endline "get_canonical";
+ let nodes = mapi (fun n -> n,get_canonical n) nodes in
+ print_endline "/get_canonical";
+ print_endline ("collapse " ^ string_of_int (List.length nodes));
+ iteri
+ (function (n,n') ->
+ let succ = GL.succ cgraph n in
+ let pred = GL.pred cgraph n in
+ GL.remove_vertex cgraph n;
+ let add_edge s t = if s <> t then GL.add_edge cgraph s t in
+ List.iter (fun s -> add_edge n' (get_canonical s)) succ;
+ List.iter (fun p -> add_edge (get_canonical p) n') pred)
+ nodes;
+ print_endline (string_of_int classes ^ " classes");
+ print_endline ("-----");
+ print_endline "visualize";
+ visualize cgraph;
+ print_endline ("/////");
+ GL.iter_vertex (fun l -> print_endline ("?" ^ string_of_eqclass l)) cgraph;
+ let canonical =
+ function (*_,_,*)w ->
+ try
+ GL.iter_vertex (fun l -> if List.mem w l then raise (Found l)) cgraph;
+ [w]
+ with
+ Found l -> l in
+ if n > 0 then
+ iter (n - 1) cgraph canonical
+ else
+ ()
+in
+ let cgraph = GL.create () in
+ GL.add_vertex cgraph [[]];
+ iter 9 cgraph (fun w(*(_,_,w)*) -> [w])