let group_concat (graph : graph)
(lhs : nodeid)
(rhs : nodeid)
(target : nodeid) : unit =
let ntl () = ref (ref (new_trans_list ())) in
let unpack_lang (node : node) : Nfa.nfa * (supermapping list) =
match node.lang with
| Unrestricted -> let m = new_sigmastar () in
node.lang <- Machine m;
(m, [( ntl(), node.id, ntl() )])
| Machine m ->
(m, [( ntl(), node.id, ntl() )])
| SuperMachine (m, trans) ->
(m, trans)
| SubMachine (m,_) ->
(m, [( ntl(), node.id, ntl() )]) in
let get_istates lang = match lang with
| Machine m
| SubMachine (m, _) -> [m.s; m.f]
| SuperMachine (m, trans) -> m.s::m.f::(ref_flatten trans)
| _ -> raise (IllegalLangOp "group_concat > get_istates")
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 convert_trans (l : trans_list ref ref)
(t : (state, state) Hashtbl.t) : unit =
let conv x = try Hashtbl.find t x with
Not_found -> raise (LangOpFail "convert_trans") in
let conv_trans acc (q1, q2) = (conv q1, conv q2)::acc in
let id, transitions = fst !(!l), snd !(!l) in
!l := (id, List.fold_left conv_trans [] transitions) in
let maybe_convert x mapping =
if not (visited (fst !(!x))) then
(visit (fst !(!x));
convert_trans x mapping) in
let handle_trans mapping old (lhs_trans, id, rhs_trans) =
let id_node = find_node graph id in
let depmap = match id_node.lang with
| SubMachine (_, mapping) -> mapping
| _ -> raise (IllegalLangOp "group_concat > handle_trans") in
Hashtbl.remove depmap old;
Hashtbl.replace depmap target (lhs_trans, rhs_trans);
maybe_convert lhs_trans mapping;
maybe_convert rhs_trans mapping in
let machine_to_sub node left right = match node.lang with
| Machine m
| SuperMachine (m,_ ) ->
let table = Hashtbl.create 1 in
Hashtbl.replace table target (left, right);
node.lang <- SubMachine (m,table)
| SubMachine (_, table) ->
Hashtbl.replace table target (left,right);
Hashtbl.remove table lhs;
| _ -> raise (IllegalLangOp "group_concat > machine_to_sub") in
let lhs_node = find_node graph lhs in
let rhs_node = find_node graph rhs in
let target_node = find_node graph target in
let _ = match target_node.lang with
| Unrestricted -> ()
| _ -> raise (IllegalLangOp "group_concat target check")
in
let lhs_machine, lhs_trans = unpack_lang lhs_node in
let rhs_machine, rhs_trans = unpack_lang rhs_node in
let lhs_istates = from_list (get_istates lhs_node.lang) in
let rhs_istates = from_list (get_istates rhs_node.lang) in
let lhs_map, rhs_map, new_machine = concat lhs_machine rhs_machine
lhs_istates rhs_istates in
let lhsq x = try Hashtbl.find lhs_map x with _ -> raise (LangOpFail "lhsq") in
let rhsq x = try Hashtbl.find rhs_map x with _ -> raise (LangOpFail "rhsq") in
let middle_trans = (new_trans_list_id (),
[ (lhsq lhs_machine.f, rhsq rhs_machine.s) ]) in
let (lhs_first,_,lhs_last) = try List.hd (List.rev lhs_trans)
with _ -> raise (LangOpFail "lhs_trans") in
let (rhs_first,_,rhs_last) = try List.hd rhs_trans
with _ -> raise (LangOpFail "rhs_trans") in
let new_trans = lhs_trans @ rhs_trans in
visit (fst middle_trans);
machine_to_sub lhs_node lhs_first lhs_last;
machine_to_sub rhs_node rhs_first rhs_last;
!lhs_last := middle_trans;
!rhs_first := middle_trans;
List.iter (handle_trans lhs_map lhs) lhs_trans;
List.iter (handle_trans rhs_map rhs) rhs_trans;
target_node.lang <- SuperMachine (new_machine, new_trans)