-let combine_classes l =
- let rec aux acc =
- function
- [] -> acc
- | he::tl -> aux (combine_class_with_classes he acc) tl
- in
- aux [] l
-;;
-
-let step (s : eqclass list) =
- let ns = ref [] in
- List.iter (function eqc -> ns := eqc::!ns) s;
- List.iter
- (function eqc ->
- List.iter
- (function x ->
- let eqc = simplify ([x] @@ eqc) in
- if not (List.exists (fun eqc' -> eqc === eqc') !ns) then
- ns := eqc::!ns
- ) [I;C;M]
- ) s;
- combine_classes !ns
-;;
-
-let classes = step (step (step (step [[[]]]))) in
- prerr_endline ("Numero di classi trovate: " ^ string_of_int (List.length classes));
- print classes
+let normalize_and_describe norm =
+ let cache = Hashtbl.create 5393 in
+ let canonicals = Hashtbl.create 5393 in
+ let descriptions = Hashtbl.create 5393 in
+ (function v ->
+ let normalized = norm v in
+ let dsc =
+ match G.V.label v with
+ [d] -> d
+ | _ -> assert false
+ in
+ if not (List.mem dsc (Hashtbl.find_all cache normalized)) then
+ Hashtbl.add cache normalized dsc;
+ normalized),
+ (function () ->
+ let vertexes = uniq (Hashtbl.fold (fun k _ l -> k::l) cache []) in
+ let xx =
+ mapi
+ (fun v -> v, List.sort w_compare (Hashtbl.find_all cache v)) vertexes in
+ iteri (function (_,w::_) -> Hashtbl.add canonicals w () | _ -> ()) xx;
+ let is_not_redundant =
+ function
+ [] | [_] -> true
+ | _::w ->
+ try Hashtbl.find canonicals w; true with Not_found -> false
+ in
+ iteri
+ (function (v,x) ->
+ Hashtbl.add descriptions v ((List.filter is_not_redundant x) : eqclass)) xx),
+ Hashtbl.find descriptions
+;;
+
+let classify arcs =
+ print_endline (string_of_int (List.length arcs) ^ " arcs to be classified");
+ let mk_vertex = mk_vertex () in
+ let graph = G.create () in
+ let varcs = mapi (fun (x,y) -> mk_vertex x,mk_vertex y) arcs in
+ iteri (fun (x,y) -> G.add_edge graph x y) varcs;
+ print_endline ("<scc>");
+ let classes,norm =
+ let module SCC = Graph.Components.Make(G) in SCC.scc graph in
+ print_endline (string_of_int classes ^ " classes");
+ print_endline ("-----");
+ norm,varcs
+;;
+
+let analyze (norm,arcs) =
+ print_endline ("building class graph (" ^ string_of_int (List.length arcs) ^ ")");
+ let normalize,finish,describe = normalize_and_describe norm in
+ let arcs =
+ uniq (mapi (fun (x,y) -> normalize x,normalize y) arcs) in
+ print_endline "finish";
+ finish ();
+ let cgraph = G.create () in
+ let mk_vertex = mk_vertex () in
+ List.iter
+ (function (x,y) ->
+ if x <> y then
+ G.add_edge cgraph (mk_vertex (describe x)) (mk_vertex (describe y))) arcs;
+ print_endline "visualize";
+ visualize cgraph;
+ print_endline ("/////");
+;;
+
+let rec iter n l =
+ let pkg = classify (normalize l) in
+ if n > 0 then
+ iter (n - 1) (step l)
+ else
+ analyze pkg
+in
+ iter 10 [[]]