Commit 9b3924eb authored by Bruno Guillaume's avatar Bruno Guillaume

Fix rule access in subpackages

parent ef7b1ceb
...@@ -4,7 +4,7 @@ ...@@ -4,7 +4,7 @@
* add UPDATE_EDGE_FEAT handling * add UPDATE_EDGE_FEAT handling
# 1.3.0 (2019/06/24) # 1.3.0 (2019/06/24)
* Add support of "@alpha" extention in edges * Add support of "@alpha" extension in edges
* Add a default “empty.grs” * Add a default “empty.grs”
* Review ordering of node * Review ordering of node
* Add Multigraph management (for grew_server) * Add Multigraph management (for grew_server)
......
...@@ -326,6 +326,7 @@ module Ast = struct ...@@ -326,6 +326,7 @@ module Ast = struct
rule_doc: string list; rule_doc: string list;
rule_loc: Loc.t; rule_loc: Loc.t;
rule_dir: string option; (* the real folder where the file is defined *) rule_dir: string option; (* the real folder where the file is defined *)
rule_path: string;
} }
(* [label_spec] is the type for a label declaration: the name and a list of display options *) (* [label_spec] is the type for a label declaration: the name and a list of display options *)
......
...@@ -189,6 +189,7 @@ module Ast : sig ...@@ -189,6 +189,7 @@ module Ast : sig
rule_doc:string list; rule_doc:string list;
rule_loc: Loc.t; rule_loc: Loc.t;
rule_dir: string option; (* the real folder where the file is defined *) rule_dir: string option; (* the real folder where the file is defined *)
rule_path: string;
} }
type label_spec = string * string list type label_spec = string * string list
......
...@@ -279,7 +279,11 @@ module G_graph = struct ...@@ -279,7 +279,11 @@ module G_graph = struct
{ t with rules = String_map.add rule_name (old+1) t.rules } { t with rules = String_map.add rule_name (old+1) t.rules }
else t else t
let get_rules t = t.rules let string_rules t =
String_map.fold
(fun k v acc ->
sprintf "%s:%d; %s" k v acc
) t.rules ""
(* is there an edge e out of node i ? *) (* is there an edge e out of node i ? *)
let edge_out graph node_id label_cst = let edge_out graph node_id label_cst =
...@@ -1152,153 +1156,13 @@ module G_graph = struct ...@@ -1152,153 +1156,13 @@ module G_graph = struct
with Skip -> (num,acc) with Skip -> (num,acc)
) graph.map (1,Conll_types.Int_map.empty) in ) graph.map (1,Conll_types.Int_map.empty) in
{ Conll.void with Conll.meta = graph.meta; lines; mwes; } let meta =
if !Global.track_rules
then graph.meta @ ["# rules = " ^ (string_rules graph)]
else graph.meta in
(* { Conll.void with Conll.meta = meta; lines; mwes; }
(* -------------------------------------------------------------------------------- *)
let to_conll_old graph =
let domain = get_domain graph in
(* split lexical // non-lexical nodes *)
let (nodes, nl_nodes) = Gid_map.fold
(fun id elt (acc1, acc2) ->
if is_non_lexical_node elt
then (acc1, (id,elt)::acc2)
else ((id,elt)::acc1, acc2)
) graph.map ([],[]) in
(* sort nodes wrt position *)
let snodes = List.sort (fun (_,n1) (_,n2) -> G_node.position_comp n1 n2) nodes in
(* renumbering of nodes to have a consecutive sequence of int 1 --> n, in case of node deletion or addition *)
(* TODO: take into account empty nodes *)
let snodes = List.mapi
(fun i (gid,node) -> (gid, G_node.set_position (float i) node)
) snodes in
let get_num gid =
let gnode = List.assoc gid snodes in
if G_node.is_conll_root gnode
then 0.
else G_node.get_float (List.assoc gid snodes) in
(* Warning: [govs_labs] maps [gid]s to [num]s *)
let govs_labs =
List.fold_right
(fun (src_gid, node) acc ->
let src_num = get_num src_gid in
Massoc_gid.fold
(fun acc2 tar_gid edge ->
let old = try Gid_map.find tar_gid acc2 with Not_found -> [] in
Gid_map.add tar_gid ((sprintf "%g" src_num, G_edge.to_string ?domain edge)::old) acc2
) acc (G_node.get_next node)
) nodes Gid_map.empty in
let lines = List_.opt_map
(fun (gid,node) ->
if G_node.is_conll_root node
then None
else
let gov_labs = try Gid_map.find gid govs_labs with Not_found -> [] in
let sorted_gov_labs =
List.sort
(fun (g1,l1) (g2,l2) ->
if l1 <> "" && l1.[0] <> 'I' && l1.[0] <> 'D' && l1.[0] <> 'E'
then -1
else if l2 <> "" && l2.[0] <> 'I' && l2.[0] <> 'D' && l2.[0] <> 'E'
then 1
else
match compare (String_.to_float g1) (String_.to_float g2) with
| 0 -> compare l1 l2
| x -> x
) gov_labs in
let id_of_gid gid = Conll.Id.of_string (string_of_float (get_num gid)) in
let fs = G_node.get_fs node in
Some {
Conll.line_num = 0;
id = id_of_gid gid;
form = (match G_fs.get_string_atom "form" fs with Some p -> p | None -> "_");
lemma = (match G_fs.get_string_atom "lemma" fs with Some p -> p | None -> "_");
upos = (match G_fs.get_string_atom "upos" fs with Some p -> p | None -> "_");
xpos = (match G_fs.get_string_atom "xpos" fs with Some p -> p | None -> "_");
feats = (G_fs.to_conll ~exclude: ["form"; "lemma"; "upos"; "xpos"; "position"] fs);
deps = List.map (fun (gov,lab) -> ( Conll.Id.of_string gov, lab)) sorted_gov_labs;
efs = G_node.get_efs node;
} ) snodes in
let snl_nodes = List.sort (fun (gid1,_) (gid2,_) -> Pervasives.compare gid1 gid2) nl_nodes in
let mwes = List_.foldi_left
(fun i acc (_,nl_node) ->
let fs = G_node.get_fs nl_node in
let kind = match G_fs.get_string_atom "kind" fs with
| Some "NE" -> Mwe.Ne
| Some "MWE" -> Mwe.Mwe
| _ -> Error.run "[G_graph.to_conll] cannot interpreted kind" in
let nexts = G_node.get_next nl_node in
let next_list =
List.sort_uniq
(fun gid1 gid2 ->
let n1 = List.assoc gid1 nodes
and n2 = List.assoc gid2 nodes in
match (G_node.get_position n1, G_node.get_position n2) with
| (Some i, Some j) -> Pervasives.compare i j
| _ -> 0
)
(Massoc_gid.fold (fun acc2 k _ -> k::acc2) [] nexts) in
match next_list with
| [] -> Error.bug "[G_graph.to_conll] mwe node with no next node"
| head_gid::tail_gids ->
let head_pos = match G_node.get_position (List.assoc head_gid snodes) with
| Some f -> int_of_float f
| None -> Error.run "[G_graph.to_conll] nl_node going to Unordered node" in
let head_proj = CCList.find_map
(fun e -> int_of_string_opt (G_edge.to_string ?domain e))
(Massoc_gid.assoc head_gid nexts) in
let items = List.fold_left
(fun acc gid ->
let pos = match G_node.get_position (List.assoc gid snodes) with
| Some f -> int_of_float f
| None -> Error.run "[G_graph.to_conll] nl_node going to Unordered node" in
let proj = CCList.find_map
(fun e -> int_of_string_opt (G_edge.to_string ?domain e))
(Massoc_gid.assoc gid nexts) in
Id_with_proj_set.add ((pos,None), proj) acc
) Id_with_proj_set.empty tail_gids in
let mwe = {
Mwe.kind;
Mwe.mwepos = G_fs.get_string_atom "mwepos" fs;
Mwe.label = G_fs.get_string_atom "label" fs;
Mwe.criterion = G_fs.get_string_atom "criterion" fs;
first = ((head_pos, None),head_proj);
items;
} in
Conll_types.Int_map.add (i+1) mwe acc
) Conll_types.Int_map.empty snl_nodes in
let text_rules = String_map.fold (fun rule_name occurrences acc ->
match acc with
| "" -> Printf.sprintf "%s[%d]" rule_name occurrences
| _ -> Printf.sprintf "%s[%d];%s" rule_name occurrences acc
) graph.rules "" in
let rules = match text_rules with
| "" -> []
| _ -> ["# rules " ^ text_rules] in
{
Conll.file = None;
Conll.meta = graph.meta @ rules;
lines;
multiwords = []; (* multiwords are handled by _UD_* features *)
mwes;
}
*)
let to_conll_string ?cupt graph = let to_conll_string ?cupt graph =
let conll = to_conll graph in let conll = to_conll graph in
Conll.to_string ?cupt (Conll.normalize_multiwords conll) Conll.to_string ?cupt (Conll.normalize_multiwords conll)
......
...@@ -49,6 +49,11 @@ module Grs = struct ...@@ -49,6 +49,11 @@ module Grs = struct
| Strategy (name, strat) -> `Assoc [("strat_name", `String name); ("strat_def", Ast.strat_to_json strat)] | Strategy (name, strat) -> `Assoc [("strat_name", `String name); ("strat_def", Ast.strat_to_json strat)]
| Package (name, decl_list) -> `Assoc [("package_name", `String name); "decls", `List (List.map (decl_to_json ?domain) decl_list)] | Package (name, decl_list) -> `Assoc [("package_name", `String name); "decls", `List (List.map (decl_to_json ?domain) decl_list)]
let decl_to_string ?domain = function
| Rule r -> sprintf "RULE: %s" (Rule.get_name r)
| Strategy (name, strat) -> sprintf "STRAT: %s" (name)
| Package (name, decl_list) -> sprintf "PACK: %s" (name)
let to_json t = let to_json t =
match t.domain with match t.domain with
| None -> `Assoc [ | None -> `Assoc [
...@@ -141,7 +146,11 @@ module Grs = struct ...@@ -141,7 +146,11 @@ module Grs = struct
| Top of decl list | Top of decl list
| Pack of (decl list * pointed) (* (content, mother package) *) | Pack of (decl list * pointed) (* (content, mother package) *)
let rec dump_pointed = function
| Top l -> printf "TOP: %s\n" (String.concat "+" (List.map decl_to_string l))
| Pack (l, pointed) ->
printf "PACK: %s\nMOTHER --> " (String.concat "+" (List.map decl_to_string l));
dump_pointed pointed
......
...@@ -79,7 +79,7 @@ module Loader = struct ...@@ -79,7 +79,7 @@ module Loader = struct
grs grs
with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.grs] %s" msg with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.grs] %s" msg
let rec unfold_grs dir top address new_ast_grs = let rec unfold_grs dir top path new_ast_grs =
List.fold_left List.fold_left
(fun acc decl -> match decl with (fun acc decl -> match decl with
| Ast.Import filename -> | Ast.Import filename ->
...@@ -88,19 +88,19 @@ module Loader = struct ...@@ -88,19 +88,19 @@ module Loader = struct
| Some x -> x | Some x -> x
| None -> Error.build "Imported file must have the \".grs\" file extension" in | None -> Error.build "Imported file must have the \".grs\" file extension" in
let sub = loc_grs real_file in let sub = loc_grs real_file in
let unfolded_sub = unfold_grs (real_dir real_file) false (address ^ pack_name ^ ".") sub in let unfolded_sub = unfold_grs (real_dir real_file) false (path ^ pack_name ^ ".") sub in
Ast.Package (Loc.file filename, pack_name, unfolded_sub) :: acc Ast.Package (Loc.file filename, pack_name, unfolded_sub) :: acc
| Ast.Include filename -> | Ast.Include filename ->
let real_file = Filename.concat dir filename in let real_file = Filename.concat dir filename in
let sub = loc_grs real_file in let sub = loc_grs real_file in
let unfolded_sub = unfold_grs (real_dir real_file) top address sub in let unfolded_sub = unfold_grs (real_dir real_file) top path sub in
unfolded_sub @ acc unfolded_sub @ acc
| Ast.Features _ when not top -> Error.build "Non top features declaration" | Ast.Features _ when not top -> Error.build "Non top features declaration"
| Ast.Labels _ when not top -> Error.build "Non top labels declaration" | Ast.Labels _ when not top -> Error.build "Non top labels declaration"
| Ast.Package (loc, name, decls) -> | Ast.Package (loc, name, decls) ->
Ast.Package (loc, name, unfold_grs dir top (address ^ name ^ ".") decls) :: acc Ast.Package (loc, name, unfold_grs dir top (path ^ name ^ ".") decls) :: acc
| Ast.Rule ast_rule -> | Ast.Rule ast_rule ->
Ast.Rule {ast_rule with Ast.rule_dir = Some dir; Ast.rule_id = address ^ ast_rule.Ast.rule_id} :: acc Ast.Rule {ast_rule with Ast.rule_dir = Some dir; Ast.rule_path = path} :: acc
| x -> x :: acc | x -> x :: acc
) [] new_ast_grs ) [] new_ast_grs
......
...@@ -299,6 +299,7 @@ rule: ...@@ -299,6 +299,7 @@ rule:
rule_doc = begin match doc with Some d -> d | None -> [] end; rule_doc = begin match doc with Some d -> d | None -> [] end;
rule_loc = snd id_loc; rule_loc = snd id_loc;
rule_dir = None; rule_dir = None;
rule_path = "";
} }
} }
......
...@@ -448,10 +448,13 @@ module Rule = struct ...@@ -448,10 +448,13 @@ module Rule = struct
commands: Command.t list; commands: Command.t list;
lexicons: Lexicons.t; lexicons: Lexicons.t;
loc: Loc.t; loc: Loc.t;
path: string;
} }
let get_name t = t.name let get_name t = t.name
let get_long_name t = t.path ^ t.name
let get_loc t = t.loc let get_loc t = t.loc
let to_json ?domain t = let to_json ?domain t =
...@@ -581,6 +584,7 @@ module Rule = struct ...@@ -581,6 +584,7 @@ module Rule = struct
commands = build_commands ?domain lexicons pos pos_table rule_ast.Ast.commands; commands = build_commands ?domain lexicons pos pos_table rule_ast.Ast.commands;
loc = rule_ast.Ast.rule_loc; loc = rule_ast.Ast.rule_loc;
lexicons; lexicons;
path = rule_ast.Ast.rule_path;
} }
let build_pattern ?domain ?(lexicons=[]) pattern_ast = let build_pattern ?domain ?(lexicons=[]) pattern_ast =
...@@ -1343,7 +1347,7 @@ module Rule = struct ...@@ -1343,7 +1347,7 @@ module Rule = struct
} }
rule.commands in rule.commands in
if final_state.effective if final_state.effective
then (Timeout.check (); incr_rules(); Some (G_graph.push_rule (get_name rule) final_state.graph)) then (Timeout.check (); incr_rules(); Some (G_graph.push_rule (get_long_name rule) final_state.graph))
else None else None
let rec wrd_apply ?domain rule (graph, big_step_opt) = let rec wrd_apply ?domain rule (graph, big_step_opt) =
...@@ -1706,7 +1710,7 @@ module Rule = struct ...@@ -1706,7 +1710,7 @@ module Rule = struct
try try
let new_gwh = loop_command init_gwh rule.commands in let new_gwh = loop_command init_gwh rule.commands in
Timeout.check (); incr_rules(); Timeout.check (); incr_rules();
Some {new_gwh with graph = G_graph.push_rule (get_name rule) new_gwh.graph } Some {new_gwh with graph = G_graph.push_rule (get_long_name rule) new_gwh.graph }
with Dead_lock -> loop_matching tail (* failed to apply all commands -> move to the next matching *) with Dead_lock -> loop_matching tail (* failed to apply all commands -> move to the next matching *)
else loop_matching tail (* some neg part prevents rule app -> move to the next matching *) else loop_matching tail (* some neg part prevents rule app -> move to the next matching *)
in loop_matching matching_list in loop_matching matching_list
......
...@@ -31,6 +31,8 @@ module Rule : sig ...@@ -31,6 +31,8 @@ module Rule : sig
(** [get_name t] returns the name of the rule [t]. *) (** [get_name t] returns the name of the rule [t]. *)
val get_name: t -> string val get_name: t -> string
val get_long_name: t -> string
(** [get_loc t] returns the file location of the rule [t]. *) (** [get_loc t] returns the file location of the rule [t]. *)
val get_loc: t -> Loc.t val get_loc: t -> Loc.t
......
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