Commit 4ffd814d authored by Bruno Guillaume's avatar Bruno Guillaume

add list of rules applied in conll output

parent 1f2db265
......@@ -77,6 +77,13 @@ module String_ = struct
let re_match re s = (Str.string_match re s 0) && (Str.matched_string s = s)
let rev_concat sep l =
let rec loop = function
| [] -> ""
| [one] -> one
| h :: tail -> (loop tail) ^ sep ^ h in
loop l
end (* module String_ *)
(* ================================================================================ *)
......
......@@ -66,6 +66,8 @@ module String_: sig
(* [rm_peripheral_white s] returns the string [s] without any white space or tab
at the beginning or at the end of the string. *)
val rm_peripheral_white: string -> string
val rev_concat: string -> string list -> string
end (* module String_ *)
(* ================================================================================ *)
......
......@@ -232,9 +232,10 @@ module G_graph = struct
map: G_node.t Gid_map.t; (* node description *)
fusion: fusion_item list; (* the list of fusion word considered in UD conll *)
highest_index: int; (* the next free integer index *)
rules: string list;
}
let empty = { domain=None; meta=[]; map=Gid_map.empty; fusion=[]; highest_index=0; }
let empty = { domain=None; meta=[]; map=Gid_map.empty; fusion=[]; highest_index=0; rules=[]; }
let get_domain t = t.domain
......@@ -249,6 +250,10 @@ module G_graph = struct
let fold_gid fct t init =
Gid_map.fold (fun gid _ acc -> fct gid acc) t.map init
let push_rule rule_name t = { t with rules = rule_name :: t.rules }
let get_rules t = t.rules
(* is there an edge e out of node i ? *)
let edge_out graph node_id label_cst =
let domain = get_domain graph in
......@@ -344,7 +349,8 @@ module G_graph = struct
meta=gr_ast.Ast.meta;
map;
fusion = [];
highest_index = final_index - 1
highest_index = final_index - 1;
rules = [];
}
(* -------------------------------------------------------------------------------- *)
......@@ -471,7 +477,8 @@ module G_graph = struct
meta = conll.Conll.meta;
map = map_with_nl_nodes;
fusion;
highest_index = free_index -1
highest_index = free_index -1;
rules = [];
}
(* -------------------------------------------------------------------------------- *)
......@@ -534,7 +541,8 @@ module G_graph = struct
meta=[];
map=prec_loop map (List.rev !leaf_list);
fusion = [];
highest_index = !cpt
highest_index = !cpt;
rules = [];
}
(* -------------------------------------------------------------------------------- *)
......@@ -1113,9 +1121,11 @@ module G_graph = struct
Conll_types.Int_map.add (i+1) mwe acc
) Conll_types.Int_map.empty snl_nodes in
let rules = "# rules " ^ (String_.rev_concat "," graph.rules) in
{
Conll.file = None;
Conll.meta = graph.meta;
Conll.meta = graph.meta @ [rules];
lines;
multiwords = []; (* multiwords are handled by _UD_* features *)
mwes;
......
......@@ -98,6 +98,9 @@ module G_graph: sig
val get_highest: t -> int
val push_rule: string -> t -> t
val get_rules: t -> string list
(** [edge_out t id label_cst] returns true iff there is an out-edge from the node [id] with a label compatible with [label_cst] *)
val edge_out: t -> Gid.t -> Label_cst.t -> bool
......
......@@ -86,7 +86,7 @@ module Loader = struct
grs
with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.grs] %s" msg
let rec unfold_grs dir top new_ast_grs =
let rec unfold_grs dir top address new_ast_grs =
List.fold_left
(fun acc decl -> match decl with
| Ast.Import filename ->
......@@ -95,24 +95,24 @@ module Loader = struct
| Some x -> x
| None -> Error.build "Imported file must have the \".grs\" file extension" in
let sub = loc_grs real_file in
let unfolded_sub = unfold_grs (real_dir real_file) false sub in
let unfolded_sub = unfold_grs (real_dir real_file) false (address ^ pack_name ^ ".") sub in
Ast.Package (Loc.file filename, pack_name, unfolded_sub) :: acc
| Ast.Include filename ->
let real_file = Filename.concat dir filename in
let sub = loc_grs real_file in
let unfolded_sub = unfold_grs (real_dir real_file) top sub in
let unfolded_sub = unfold_grs (real_dir real_file) top address sub in
unfolded_sub @ acc
| Ast.Features _ when not top -> Error.build "Non top features declaration"
| Ast.Labels _ when not top -> Error.build "Non top labels declaration"
| Ast.Package (loc, name, decls) ->
Ast.Package (loc, name, unfold_grs dir top decls) :: acc
Ast.Package (loc, name, unfold_grs dir top (address ^ name ^ ".") decls) :: acc
| Ast.Rule ast_rule ->
Ast.Rule {ast_rule with Ast.rule_dir = Some dir} :: acc
Ast.Rule {ast_rule with Ast.rule_dir = Some dir; Ast.rule_id = address ^ ast_rule.Ast.rule_id} :: acc
| x -> x :: acc
) [] new_ast_grs
let grs file =
let final_grs = unfold_grs (real_dir file) true (loc_grs file) in
let final_grs = unfold_grs (real_dir file) true "" (loc_grs file) in
check_grs final_grs;
final_grs
......
......@@ -984,6 +984,7 @@ module Rule = struct
) matching_list in
List.map fst filtered_matching_list
(* ---------------------------------------------------------------------- *)
let onf_find cnode ?loc (matching, created_nodes) =
match cnode with
| Command.Pat pid ->
......@@ -1140,7 +1141,7 @@ module Rule = struct
(graph, [], false)
rule.commands in
if eff
then (Timeout.check (); incr_rules(); Some new_graph)
then (Timeout.check (); incr_rules(); Some (G_graph.push_rule (get_name rule) new_graph ))
else None
with Not_found -> (* raised by List.find, no matching apply *) None
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment