let group_intersect (graph : graph)
(source : nodeid)
(target : nodeid) : unit =
let source_node = find_node graph source in
let target_node = find_node graph target in
let source_lang = source_node.lang in
let target_lang = target_node.lang in
let (visited : trans_list_id hashset) = create 5 in
let visit x = add visited x in
let visited x = mem visited x in
let has_epsilon nfa (q1,q2) =
let table = which_states ~create:false nfa.epsilon q1 in
mem table q2
in
let convert_trans (l : trans_list ref ref)
(t : (state, state list) Hashtbl.t)
(nfa : nfa) : unit =
let conv x = try Some (Hashtbl.find t x) with Not_found -> None in
let rec list_prod (l1 : 'a list) (l2 : 'b list) : ('a * 'b) list =
match l1 with
| x :: xs -> (List.map (fun y -> (x,y)) l2) @ (list_prod xs l2)
| _ -> [] in
let update_entry acc (x,y) = match (conv x, conv y) with
| Some x', Some y' -> (list_prod x' y') @ acc
| _, _ -> acc in
let updated_list = List.fold_left update_entry [] (snd !(!l)) in
let updated_list = List.filter (has_epsilon nfa) updated_list in
!l := (fst !(!l), updated_list) in
let maybe_convert x mapping nfa =
if not (visited (fst !(!x))) then
(visit (fst !(!x));
convert_trans x mapping nfa) in
let handle_trans mapping nfa (lhs_trans, id, rhs_trans) =
maybe_convert lhs_trans mapping nfa;
maybe_convert rhs_trans mapping nfa in
let _ = match source_node.lang with
| Unrestricted
| Machine _ -> ()
| SuperMachine _
| SubMachine _ -> raise (IllegalLangOp "group_intersect source check") in
match source_lang, target_lang with
| Unrestricted, _ -> ()
| _, Unrestricted -> ()
| Machine m1, Machine m2 ->
target_node.lang <- simple_intersect source_node.lang target_node.lang
| SuperMachine (ms, trans), Machine mm
| Machine mm, SuperMachine (ms, trans) ->
let istates = from_list (ref_flatten trans) in
let mapping, newmachine = intersect ms mm istates in
List.iter (handle_trans mapping newmachine) trans;
target_node.lang <- SuperMachine (newmachine, trans);
| _ -> raise (IllegalLangOp "group_intersect")