17 [C;M;I], Le, [M;I]; (* ??? *)
19 [I;M;C], Ge, [I;M]; (* ??? *)
27 let swap = function Le -> Ge | Ge -> Le;;
32 | M::tl -> new_dir (swap dir) tl
33 | (C|I)::tl -> new_dir dir tl
36 let string_of_dir = function Le -> "<=" | Ge -> ">=";;
40 (List.map (function I -> "i" | C -> "c" | M -> "-") w)
43 let string_of_eqclass eqc =
44 let eqc = List.sort compare eqc in
45 String.concat "=" (List.map string_of_w eqc)
48 let print = List.iter (fun eqc -> prerr_endline (string_of_eqclass eqc));;
52 let (@@) l1 ll2 = List.map (function l2 -> l1 @ l2) ll2;;
58 | he::tl -> aux (if List.mem he l then l else he::l) tl
63 let rec apply_rule_at_beginning (lhs,dir',rhs) (w,dir) =
70 | x::lhs,x'::w when x = x' -> aux (lhs,w)
71 | _,_ -> raise NoMatch
73 rhs @@ apply_rules (aux (lhs,w),new_dir dir lhs)
74 and apply_rules (w,_ as w_and_dir) =
81 (try apply_rule_at_beginning rule w_and_dir
89 let apply_rules (w,dir as w_and_dir) =
90 List.map (fun w' -> w,dir,w')
91 (uniq (apply_rules w_and_dir))
94 let step (l : w list) =
98 (function w -> List.map (fun x -> x@w) [[I];[C];(*[M];*)[]])
103 let rec aux avoid x y =
107 x=x' && dir = Le && not (List.mem z avoid) && aux (z::avoid) z y) rels
110 x=x' && dir = Ge && not (List.mem z avoid) && aux (z::avoid) z y) rels
115 let in_class rels eqc he =
118 | k::_ -> leq rels k he && leq rels he k
121 let add_class rels classes he =
122 let rec aux visited =
126 if in_class rels eqc he then
127 (he::eqc)::tl@visited
129 aux (eqc::visited) tl
134 let classify (l : w list) =
135 (*prerr_endline ("Classify: " ^ string_of_int (List.length l));*)
137 List.flatten (List.map (fun x -> apply_rules (x,Le) @ apply_rules (x,Ge)) l)
139 let rec aux classes =
142 | he::tl -> aux (add_class rels classes he) tl
149 (function (w,dir,w') ->
150 prerr_endline (string_of_w w ^ string_of_dir dir ^ string_of_w w'))
153 let print_graph' classes =
154 prerr_endline "=============================";
155 prerr_endline ("Numero di classi trovate: " ^ string_of_int (List.length classes));
156 List.iter (function eqc -> prerr_endline (string_of_eqclass eqc)) classes
160 print_graph' (classify l);
162 iter (n - 1) (step l)