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 []