diff --git a/src/grew_graph.ml b/src/grew_graph.ml index 38f22945c5e8d451bb9d82b5f56c93c70bed17ad..dc124619825d6083a7f09c3aafde2d713d9a6392 100644 --- a/src/grew_graph.ml +++ b/src/grew_graph.ml @@ -1286,12 +1286,16 @@ The algorithm is modified: Tree detection is easier (is_tree <=> back_edges=0 and nontree_edges=0 *) (* --------------------------------------------------------------- *) + let dfs_debug = false + let get_roots graph = let non_roots = Gid_map.fold (fun gid node acc -> Massoc_gid.fold_on_list ( - fun acc2 next_gid _ -> Gid_set.add next_gid acc2 + fun acc2 next_gid _ -> + if dfs_debug then printf " %s ---> %s\n%!" (Gid.to_string gid) (Gid.to_string next_gid); + Gid_set.add next_gid acc2 ) acc (G_node.get_next node) ) graph.map Gid_set.empty in let roots = @@ -1313,6 +1317,12 @@ Tree detection is easier (is_tree <=> back_edges=0 and nontree_edges=0 nontree_edges: (Gid.t * Gid.t) list; } + type dfs_output = { + forest: bool; + tree: bool; + cyclic: bool; + } + let depth_first_search graph = let info = ref {intervals=Gid_map.empty; back_edges=[]; nontree_edges=[];} in let clock = ref 0 in @@ -1334,31 +1344,48 @@ Tree detection is easier (is_tree <=> back_edges=0 and nontree_edges=0 | _ -> assert false in let roots = get_roots graph in - Printf.printf "|roots| = %d\n" (Gid_set.cardinal roots); + let nb_roots = Gid_set.cardinal roots in + if dfs_debug then Printf.printf "|roots| = %d\n" nb_roots; Gid_set.iter (fun gid -> - Printf.printf " -----> explore %s\n" (Gid.to_string gid); + if dfs_debug then Printf.printf " -----> explore %s\n" (Gid.to_string gid); explore gid ) roots; - Printf.printf "======== Intervals =======\n"; - Gid_map.iter (fun gid node -> - match Gid_map.find_opt gid !info.intervals with - | None -> Printf.printf "None! %s" (Gid.to_string gid) - | Some (Pre _) -> Printf.printf "Pre! %s" (Gid.to_string gid) - | Some (Pre_post (i,j)) -> + if dfs_debug then + begin + Printf.printf "======== Intervals =======\n"; + Gid_map.iter (fun gid node -> + match Gid_map.find_opt gid !info.intervals with + | None -> Printf.printf "None! %s" (Gid.to_string gid) + | Some (Pre _) -> Printf.printf "Pre! %s" (Gid.to_string gid) + | Some (Pre_post (i,j)) -> Printf.printf "%s --> [%d,%d] --> %s\n" (Gid.to_string gid) i j (G_fs.to_string (G_node.get_fs node)) - ) graph.map; + ) graph.map; - Printf.printf "======== Back_edges =======\n"; - List.iter (fun (gid1, gid2) -> - Printf.printf "%s --> %s\n" (Gid.to_string gid1) (Gid.to_string gid2) - ) !info.back_edges; + Printf.printf "======== Back_edges =======\n"; + List.iter (fun (gid1, gid2) -> + Printf.printf "%s --> %s\n" (Gid.to_string gid1) (Gid.to_string gid2) + ) !info.back_edges; - Printf.printf "======== nontree_edges =======\n"; - List.iter (fun (gid1, gid2) -> - Printf.printf "%s --> %s\n" (Gid.to_string gid1) (Gid.to_string gid2) - ) !info.nontree_edges + Printf.printf "======== nontree_edges =======\n"; + List.iter (fun (gid1, gid2) -> + Printf.printf "%s --> %s\n" (Gid.to_string gid1) (Gid.to_string gid2) + ) !info.nontree_edges + end; + + if Gid_map.cardinal !info.intervals < Gid_map.cardinal graph.map + then + begin + if dfs_debug then printf "Not covered\n%!"; + { forest = false; tree = false; cyclic = true} + end + else + { + forest = !info.nontree_edges = [] && !info.back_edges = []; + tree = !info.nontree_edges = [] && !info.back_edges = [] && nb_roots = 1; + cyclic = !info.back_edges <> []; + } end (* module G_graph *) diff --git a/src/grew_graph.mli b/src/grew_graph.mli index 27c45391919fe68b8342185ed229847bdf300d78..b59bb61ec24494ca97c748ed20f750d2f5d99541 100644 --- a/src/grew_graph.mli +++ b/src/grew_graph.mli @@ -213,7 +213,13 @@ module G_graph: sig val is_projective: t -> (Gid.t * Gid.t) option - val depth_first_search: t -> unit + type dfs_output = { + forest: bool; + tree: bool; + cyclic: bool; + } + + val depth_first_search: t -> dfs_output end (* module G_graph *) (* ================================================================================ *) diff --git a/src/grew_rule.ml b/src/grew_rule.ml index 739c50b899eb8331a88bfc045b47477698a1f291..40c9d831ab79b2cb58b06cd6483dd79edf748ef8 100644 --- a/src/grew_rule.ml +++ b/src/grew_rule.ml @@ -947,21 +947,47 @@ module Rule = struct let match_in_graph ?domain ?lexicons { global; pos; negs } graph = let casted_graph = G_graph.cast ?domain graph in - let rec match_global = function + let match_global = function | [] -> true - | "is_projective" :: tail -> - begin - match G_graph.is_projective graph with - | Some _ -> false - | None -> match_global tail - end - | "is_not_projective" :: tail -> - begin - match G_graph.is_projective graph with - | Some _ -> match_global tail - | None -> false - end - | x :: tail -> Error.build "Unknown global requirement \"%s\"" x in + | ["is_projective"] -> G_graph.is_projective graph = None + | ["is_not_projective"] -> G_graph.is_projective graph <> None + | l -> + let dfs = G_graph.depth_first_search graph in + let rec loop = function + | [] -> true + | "is_projective" :: tail -> + begin + match G_graph.is_projective graph with + | Some _ -> false + | None -> loop tail + end + | "is_not_projective" :: tail -> + begin + match G_graph.is_projective graph with + | Some _ -> loop tail + | None -> false + end + + | "is_tree" :: tail when dfs.tree -> loop tail + | "is_tree" :: _ -> false + + | "is_not_tree" :: tail when not dfs.tree -> loop tail + | "is_not_tree" :: _ -> false + + | "is_forest" :: tail when dfs.forest -> loop tail + | "is_forest" :: _ -> false + + | "is_not_forest" :: tail when not dfs.forest -> loop tail + | "is_not_forest" :: _ -> false + + | "is_cyclic" :: tail when dfs.cyclic -> loop tail + | "is_cyclic" :: _ -> false + + | "is_not_cyclic" :: tail when not dfs.cyclic -> loop tail + | "is_not_cyclic" :: _ -> false + + | x :: tail -> Error.build "Unknown global requirement \"%s\"" x in + loop l in if not (match_global global) then []