Skip to content

GitLab

L
libcaml-grew
Commit a27a6aae authored by bguillaum's avatar bguillaum
Browse files
Options

The label_domain is encoded in GRS and is not anymore a global variable WARNING: breaks libgrew.mli 

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8833 7838e531-6607-4d57-9587-6c381814729c
parent f09d5e0d
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 371 additions and 348 deletions
src/grew_command.ml
View file @ a27a6aae
......@@ -65,7 +65,7 @@ module Command = struct
| H_MERGE_NODE of (Gid.t * Gid.t)
| H_ACT_NODE of (Gid.t * string)
let build domain ?param (kai, kei) table locals suffixes ast_command =
let build domain label_domain ?param (kai, kei) table locals suffixes ast_command =
(* kai stands for "known act ident", kei for "known edge ident" *)
let pid_of_act_id loc = function
......@@ -95,7 +95,7 @@ module Command = struct
| (Ast.Del_edge_expl (act_i, act_j, lab), loc) ->
check_act_id loc act_i kai;
check_act_id loc act_j kai;
let edge = G_edge.make ~loc ~locals lab in
let edge = G_edge.make ~loc label_domain ~locals lab in
((DEL_EDGE_EXPL (pid_of_act_id loc act_i, pid_of_act_id loc act_j, edge), loc), (kai, kei))
| (Ast.Del_edge_name id, loc) ->
......@@ -105,23 +105,23 @@ module Command = struct
| (Ast.Add_edge (act_i, act_j, lab), loc) ->
check_act_id loc act_i kai;
check_act_id loc act_j kai;
let edge = G_edge.make ~loc ~locals lab in
let edge = G_edge.make ~loc label_domain ~locals lab in
((ADD_EDGE (pid_of_act_id loc act_i, pid_of_act_id loc act_j, edge), loc), (kai, kei))
| (Ast.Shift_edge (act_i, act_j, label_cst), loc) ->
check_act_id loc act_i kai;
check_act_id loc act_j kai;
((SHIFT_EDGE (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build ~loc ~locals label_cst), loc), (kai, kei))
((SHIFT_EDGE (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build ~loc label_domain ~locals label_cst), loc), (kai, kei))
| (Ast.Shift_in (act_i, act_j, label_cst), loc) ->
check_act_id loc act_i kai;
check_act_id loc act_j kai;
((SHIFT_IN (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build ~loc ~locals label_cst), loc), (kai, kei))
((SHIFT_IN (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build label_domain ~loc ~locals label_cst), loc), (kai, kei))
| (Ast.Shift_out (act_i, act_j, label_cst), loc) ->
check_act_id loc act_i kai;
check_act_id loc act_j kai;
((SHIFT_OUT (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build ~loc ~locals label_cst), loc), (kai, kei))
((SHIFT_OUT (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build label_domain ~loc ~locals label_cst), loc), (kai, kei))
| (Ast.Merge_node (act_i, act_j), loc) ->
check_act_id loc act_i kai;
......@@ -133,7 +133,7 @@ module Command = struct
if List.mem (Ast.No_sharp new_id) kai
then Error.build ~loc "Node identifier \"%s\" is already used" new_id;
let edge = G_edge.make ~loc ~locals label in
let edge = G_edge.make ~loc label_domain ~locals label in
begin
try
(
......@@ -146,7 +146,7 @@ module Command = struct
)
with not_found ->
Log.fcritical "[GRS] tries to build a command New_neighbour (%s) on node %s which is not in the pattern %s"
(G_edge.to_string edge)
(G_edge.to_string label_domain edge)
(Ast.base_command_node_ident ancestor)
(Loc.to_string loc)
end
......
src/grew_command.mli
View file @ a27a6aae
......@@ -59,6 +59,7 @@ module Command : sig
val build:
Domain.t ->
Label.domain ->
?param: (string list * string list) ->
(Ast.command_node_ident list * string list) ->
Id.table ->
......
src/grew_edge.ml
View file @ a27a6aae
......@@ -19,18 +19,18 @@ open Grew_ast
module G_edge = struct
type t = Label.t
let to_string ?(locals=[||]) t = Label.to_string ~locals t
let to_string label_domain ?(locals=[||]) t = Label.to_string label_domain ~locals t
let make ?loc ?(locals=[||]) string = Label.from_string ?loc ~locals string
let make ?loc label_domain ?(locals=[||]) string = Label.from_string ?loc label_domain ~locals string
let build ?locals (ast_edge, loc) =
let build label_domain ?locals (ast_edge, loc) =
match ast_edge.Ast.edge_label_cst with
| ([one], false) -> Label.from_string ~loc ?locals one
| ([one], false) -> Label.from_string ~loc label_domain ?locals one
| (_, true) -> Error.build "Negative edge spec are forbidden in graphs%s" (Loc.to_string loc)
| (_, false) -> Error.build "Only atomic edge valus are allowed in graphs%s" (Loc.to_string loc)
let to_dep ?(deco=false) t = Label.to_dep ~deco t
let to_dot ?(deco=false) t = Label.to_dot ~deco t
let to_dep label_domain ?(deco=false) t = Label.to_dep label_domain ~deco t
let to_dot label_domain ?(deco=false) t = Label.to_dot label_domain ~deco t
let color_of_option = function
| [] -> None
......@@ -48,41 +48,41 @@ module P_edge = struct
let get_id t = t.id
let build ?locals (ast_edge, loc) =
let build label_domain ?locals (ast_edge, loc) =
{ id = ast_edge.Ast.edge_id;
u_label = Label_cst.build ~loc ?locals ast_edge.Ast.edge_label_cst
u_label = Label_cst.build ~loc label_domain ?locals ast_edge.Ast.edge_label_cst
}
let to_string t =
let to_string label_domain t =
match t.id with
| None -> Label_cst.to_string t.u_label
| Some i -> sprintf "%s:%s" i (Label_cst.to_string t.u_label)
| None -> Label_cst.to_string label_domain t.u_label
| Some i -> sprintf "%s:%s" i (Label_cst.to_string label_domain t.u_label)
type edge_matcher =
| Fail
| Ok of Label.t
| Binds of string * Label.t list
let match_ pattern_edge graph_label =
let match_ label_domain pattern_edge graph_label =
match pattern_edge with
| {id = Some i; u_label = Label_cst.Pos l} when Label.match_list l graph_label -> Binds (i, [graph_label])
| {id = None; u_label = Label_cst.Pos l} when Label.match_list l graph_label -> Ok graph_label
| {id = Some i; u_label = Label_cst.Neg l} when not (Label.match_list l graph_label) -> Binds (i, [graph_label])
| {id = None; u_label = Label_cst.Neg l} when not (Label.match_list l graph_label) -> Ok graph_label
| {id = Some i; u_label = Label_cst.Pos l} when Label.match_list label_domain l graph_label -> Binds (i, [graph_label])
| {id = None; u_label = Label_cst.Pos l} when Label.match_list label_domain l graph_label -> Ok graph_label
| {id = Some i; u_label = Label_cst.Neg l} when not (Label.match_list label_domain l graph_label) -> Binds (i, [graph_label])
| {id = None; u_label = Label_cst.Neg l} when not (Label.match_list label_domain l graph_label) -> Ok graph_label
| _ -> Fail
let match_list pattern_edge graph_edge_list =
let match_list label_domain pattern_edge graph_edge_list =
match pattern_edge with
| {id = None; u_label = Label_cst.Pos l} when List.exists (fun label -> Label.match_list l label) graph_edge_list ->
| {id = None; u_label = Label_cst.Pos l} when List.exists (fun label -> Label.match_list label_domain l label) graph_edge_list ->
Ok (List.hd graph_edge_list)
| {id = None; u_label = Label_cst.Neg l} when List.exists (fun label -> not (Label.match_list l label)) graph_edge_list ->
| {id = None; u_label = Label_cst.Neg l} when List.exists (fun label -> not (Label.match_list label_domain l label)) graph_edge_list ->
Ok (List.hd graph_edge_list)
| {id = Some i; u_label = Label_cst.Pos l} ->
(match List.filter (fun label -> Label.match_list l label) graph_edge_list with
(match List.filter (fun label -> Label.match_list label_domain l label) graph_edge_list with
| [] -> Fail
| list -> Binds (i, list))
| {id = Some i; u_label = Label_cst.Neg l} ->
(match List.filter (fun label -> not (Label.match_list l label)) graph_edge_list with
(match List.filter (fun label -> not (Label.match_list label_domain l label)) graph_edge_list with
| [] -> Fail
| list -> Binds (i, list))
| _ -> Fail
......
src/grew_edge.mli
View file @ a27a6aae
......@@ -18,14 +18,14 @@ open Grew_ast
module G_edge: sig
type t = Label.t
val to_string: ?locals:Label.decl array -> t -> string
val to_string: Label.domain -> ?locals:Label.decl array -> t -> string
val make: ?loc:Loc.t -> ?locals:Label.decl array -> string -> t
val make: ?loc:Loc.t -> Label.domain -> ?locals:Label.decl array -> string -> t
val build: ?locals:Label.decl array -> Ast.edge -> t
val build: Label.domain -> ?locals:Label.decl array -> Ast.edge -> t
val to_dot: ?deco:bool -> t -> string
val to_dep: ?deco:bool -> t -> string
val to_dot: Label.domain -> ?deco:bool -> t -> string
val to_dep: Label.domain -> ?deco:bool -> t -> string
end (* module G_edge *)
(* ================================================================================ *)
......@@ -38,16 +38,16 @@ module P_edge: sig
val get_id: t -> string option
val to_string: t -> string
val to_string: Label.domain -> t -> string
val build: ?locals:Label.decl array -> Ast.edge -> t
val build: Label.domain -> ?locals:Label.decl array -> Ast.edge -> t
type edge_matcher =
| Fail
| Ok of Label.t
| Binds of string * Label.t list
val match_: t -> G_edge.t -> edge_matcher
val match_: Label.domain -> t -> G_edge.t -> edge_matcher
val match_list: t -> G_edge.t list -> edge_matcher
val match_list: Label.domain -> t -> G_edge.t list -> edge_matcher
end (* module P_edge *)
src/grew_graph.ml
View file @ a27a6aae
This diff is collapsed.
src/grew_graph.mli
View file @ a27a6aae
......@@ -54,6 +54,7 @@ module P_graph: sig
val build:
Domain.t ->
Label.domain ->
?pat_vars: string list ->
?locals: Label.decl array ->
Ast.node list ->
......@@ -62,6 +63,7 @@ module P_graph: sig
val build_extension:
Domain.t ->
Label.domain ->
?pat_vars: string list ->
?locals: Label.decl array ->
Id.table ->
......@@ -91,8 +93,8 @@ module G_graph: sig
(** raise ??? *)
val max_binding: t -> int
(** [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
(** [edge_out label_domain 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: Label.domain -> t -> Gid.t -> Label_cst.t -> bool
(** [get_annot_info graph] searches for exactly one node with an annot-feature (with name starting with "__").
It returns the annot-feature name without the prefix "__" together with the position.
......@@ -103,15 +105,15 @@ module G_graph: sig
(* Build functions *)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
val build: Domain.t -> ?locals: Label.decl array -> Ast.gr -> t
val build: Domain.t -> Label.domain -> ?locals: Label.decl array -> Ast.gr -> t
val of_conll: ?loc:Loc.t -> Domain.t -> Conll.t -> t
val of_conll: ?loc:Loc.t -> Domain.t -> Label.domain -> Conll.t -> t
(** input : "Le/DET/le petit/ADJ/petit chat/NC/chat dort/V/dormir ./PONCT/."
It supposes that "SUC" is defined in current relations *)
val of_brown: Domain.t -> ?sentid: string -> string -> t
val of_brown: Domain.t -> Label.domain -> ?sentid: string -> string -> t
val of_xml: Domain.t -> Xml.xml -> t
val of_xml: Domain.t -> Label.domain -> Xml.xml -> t
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
(* Update functions *)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
......@@ -127,25 +129,25 @@ module G_graph: sig
(** [del_edge ?edge_ident loc graph id_src label id_tar] removes the edge (id_src -[label]-> id_tar) from graph.
Log.critical if the edge is not in graph *)
val del_edge: ?edge_ident: string -> Loc.t -> t -> Gid.t -> G_edge.t -> Gid.t -> t
val del_edge: Label.domain -> ?edge_ident: string -> Loc.t -> t -> Gid.t -> G_edge.t -> Gid.t -> t
(** [del_node graph id] remove node [id] from [graph], with all its incoming and outcoming edges.
[graph] is unchanged if the node is not in it. *)
val del_node: t -> Gid.t -> t
val add_neighbour: Loc.t -> t -> Gid.t -> G_edge.t -> (Gid.t * t)
val add_neighbour: Loc.t -> Label.domain -> t -> Gid.t -> G_edge.t -> (Gid.t * t)
val activate: Loc.t -> Gid.t -> string -> t -> (Gid.t * t)
val merge_node: Loc.t -> t -> Gid.t -> Gid.t -> t option
val merge_node: Loc.t -> Label.domain -> t -> Gid.t -> Gid.t -> t option
(** move all in arcs to id_src are moved to in arcs on node id_tar from graph, with all its incoming edges *)
val shift_in: Loc.t -> Gid.t -> Gid.t -> Label_cst.t -> t -> t
val shift_in: Loc.t -> Label.domain -> Gid.t -> Gid.t -> Label_cst.t -> t -> t
(** move all out-edges from id_src are moved to out-edges out off node id_tar *)
val shift_out: Loc.t -> Gid.t -> Gid.t -> Label_cst.t -> t -> t
val shift_out: Loc.t -> Label.domain -> Gid.t -> Gid.t -> Label_cst.t -> t -> t
(** move all incident arcs from/to id_src are moved to incident arcs on node id_tar from graph, with all its incoming and outcoming edges *)
val shift_edges: Loc.t -> Gid.t -> Gid.t -> Label_cst.t -> t -> t
val shift_edges: Loc.t -> Label.domain -> Gid.t -> Gid.t -> Label_cst.t -> t -> t
(** [update_feat domain tar_id tar_feat_name concat_items] sets the feature of the node [tar_id]
with feature name [tar_feat_name] to be the contatenation of values described by the [concat_items].
......@@ -161,13 +163,13 @@ module G_graph: sig
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
(* Output functions *)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
val to_gr: t -> string
val to_dot: ?main_feat:string -> ?deco:G_deco.t -> t -> string
val to_gr: Label.domain -> t -> string
val to_dot: Label.domain -> ?main_feat:string -> ?deco:G_deco.t -> t -> string
val to_sentence: ?main_feat:string -> t -> string
val to_dep: ?filter : string list -> ?main_feat:string -> ?deco:G_deco.t -> t -> string
val to_conll: t -> string
val to_dep: Label.domain -> ?filter : string list -> ?main_feat:string -> ?deco:G_deco.t -> t -> string
val to_conll: Label.domain -> t -> string
val to_raw: t ->
val to_raw: Label.domain -> t ->
(string * string) list *
(string * string) list list *
(int * string * int) list
......
src/grew_grs.ml
View file @ a27a6aae
......@@ -38,11 +38,11 @@ module Rewrite_history = struct
| { good_nf = [] } -> 0 (* dead branch *)
| { good_nf = l} -> List.fold_left (fun acc t -> acc + (num_sol t)) 0 l
let save_nfs ?filter ?main_feat ~dot base_name t =
let save_nfs label_domain ?filter ?main_feat ~dot base_name t =
let rec loop file_name rules t =
match (t.good_nf, t.bad_nf) with
| [],[] when dot -> Instance.save_dot_png ?filter ?main_feat file_name t.instance; [rules, file_name]
| [],[] -> ignore (Instance.save_dep_png ?filter ?main_feat file_name t.instance); [rules, file_name]
| [],[] when dot -> Instance.save_dot_png label_domain ?filter ?main_feat file_name t.instance; [rules, file_name]
| [],[] -> ignore (Instance.save_dep_png label_domain ?filter ?main_feat file_name t.instance); [rules, file_name]
| [],_ -> []
| l, _ ->
List_.foldi_left
......@@ -57,78 +57,78 @@ module Rewrite_history = struct
[] l
in loop base_name [] t
let save_gr base t =
let save_gr label_domain base t =
let rec loop file_name t =
match (t.good_nf, t.bad_nf) with
| [],[] -> File.write (Instance.to_gr t.instance) (file_name^".gr")
| [],[] -> File.write (Instance.to_gr label_domain t.instance) (file_name^".gr")
| l, _ -> List.iteri (fun i son -> loop (sprintf "%s_%d" file_name i) son) l
in loop base t
let save_conll base t =
let save_conll label_domain base t =
let rec loop file_name t =
match (t.good_nf, t.bad_nf) with
| [],[] -> File.write (Instance.to_conll t.instance) (file_name^".conll")
| [],[] -> File.write (Instance.to_conll label_domain t.instance) (file_name^".conll")
| l, _ -> List.iteri (fun i son -> loop (sprintf "%s_%d" file_name i) son) l
in loop base t
let save_full_conll base t =
let save_full_conll label_domain base t =
let cpt = ref 0 in
let rec loop t =
match (t.good_nf, t.bad_nf) with
| [],[] ->
File.write (Instance.to_conll t.instance) (sprintf "%s__%d.conll" base !cpt);
File.write (Instance.to_conll label_domain t.instance) (sprintf "%s__%d.conll" base !cpt);
incr cpt
| l, _ -> List.iter loop l
in loop t; !cpt
(* suppose that all modules are confluent and produced exacly one normal form *)
let save_det_gr base t =
let save_det_gr label_domain base t =
let rec loop t =
match (t.good_nf, t.bad_nf) with
| [],[] -> File.write (Instance.to_gr t.instance) (base^".gr")
| [],[] -> File.write (Instance.to_gr label_domain t.instance) (base^".gr")
| [one], [] -> loop one
| _ -> Error.run "[save_det_gr] Not a single rewriting"
in loop t
let save_annot out_dir base_name t =
let save_annot label_domain out_dir base_name t =
List.mapi
(fun i alts ->
match alts.good_nf with
| [alt_1; alt_2] ->
let a = sprintf "%s_%d_A" base_name i in
let b = sprintf "%s_%d_B" base_name i in
let hpa = Instance.save_dep_svg (Filename.concat out_dir a) alt_1.instance in
let hpb = Instance.save_dep_svg (Filename.concat out_dir b) alt_2.instance in
let hpa = Instance.save_dep_svg label_domain (Filename.concat out_dir a) alt_1.instance in
let hpb = Instance.save_dep_svg label_domain (Filename.concat out_dir b) alt_2.instance in
let (afn,apos) = G_graph.get_annot_info alt_1.instance.Instance.graph
and (bfn,bpos) = G_graph.get_annot_info alt_2.instance.Instance.graph in
(base_name,i,(afn,apos),(bfn,bpos),(hpa,hpb))
| _ -> Error.run "Not two alternatives in an annotation rewriting in %s" base_name
) t.good_nf
let save_det_conll ?header base t =
let save_det_conll label_domain ?header base t =
let rec loop t =
match (t.good_nf, t.bad_nf) with
| ([],[]) ->
let output =
match header with
| Some h -> sprintf "%% %s\n%s" h (Instance.to_conll t.instance)
| None -> Instance.to_conll t.instance in
| Some h -> sprintf "%% %s\n%s" h (Instance.to_conll label_domain t.instance)
| None -> Instance.to_conll label_domain t.instance in
File.write output (base^".conll")
| ([one], []) -> loop one
| _ -> Error.run "[save_det_conll] Not a single rewriting"
in loop t
let det_dep_string t =
let det_dep_string label_domain t =
let rec loop t =
match (t.good_nf, t.bad_nf) with
| [],[] ->
let graph = t.instance.Instance.graph in
Some (G_graph.to_dep graph)
Some (G_graph.to_dep label_domain graph)
| [one], [] -> loop one
| _ -> None
in loop t
let conll_dep_string ?(keep_empty_rh=false) t =
let conll_dep_string label_domain ?(keep_empty_rh=false) t =
if (not keep_empty_rh) && is_empty t
then None
else
......@@ -136,7 +136,7 @@ module Rewrite_history = struct
match (t.good_nf, t.bad_nf) with
| [],[] ->
let graph = t.instance.Instance.graph in
Some (G_graph.to_conll graph)
Some (G_graph.to_conll label_domain graph)
| [one], [] -> loop one
| _ -> None
in loop t
......@@ -163,11 +163,11 @@ module Modul = struct
| r::tail -> loop ((Rule.get_name r) :: already_defined) tail in
loop [] t.rules
let build domain ast_module =
let build domain label_domain ast_module =
let locals = Array.of_list ast_module.Ast.local_labels in
Array.sort compare locals;
let suffixes = ast_module.Ast.suffixes in
let rules_or_filters = List.map (Rule.build domain ~locals suffixes ast_module.Ast.mod_dir) ast_module.Ast.rules in
let rules_or_filters = List.map (Rule.build domain label_domain ~locals suffixes ast_module.Ast.mod_dir) ast_module.Ast.rules in
let (filters, rules) = List.partition Rule.is_filter rules_or_filters in
let modul =
{
......@@ -219,6 +219,7 @@ module Grs = struct
type t = {
domain: Domain.t;
label_domain: Label.domain;
labels: Label.t list; (* the list of global edge labels *)
modules: Modul.t list; (* the ordered list of modules used from rewriting *)
sequences: Sequence.t list;
......@@ -230,10 +231,10 @@ module Grs = struct
let get_ast t = t.ast
let get_filename t = t.filename
let get_domain t = t.domain
let get_label_domain t = t.label_domain
let sequence_names t = List.map (fun s -> s.Sequence.name) t.sequences
let empty = {domain=Domain.empty; labels=[]; modules=[]; sequences=[]; ast=Ast.empty_grs; filename=""; }
let empty = {domain=Domain.empty; label_domain = Label.empty_domain; labels=[]; modules=[]; sequences=[]; ast=Ast.empty_grs; filename=""; }
let check t =
(* check for duplicate modules *)
......@@ -255,12 +256,12 @@ module Grs = struct
let build filename =
let ast = Loader.grs filename in
let domain = Domain.build ast.Ast.domain in
Label.init ast.Ast.labels;
let modules = List.map (Modul.build domain) ast.Ast.modules in
let label_domain = Label.build ast.Ast.labels in
let modules = List.map (Modul.build domain label_domain) ast.Ast.modules in
let grs = {
domain;
labels = List.map (fun (l,_) -> Label.from_string l) ast.Ast.labels;
label_domain;
labels = List.map (fun (l,_) -> Label.from_string label_domain l) ast.Ast.labels;
sequences = List.map (Sequence.build modules) ast.Ast.sequences;
modules; ast; filename;
} in
......@@ -295,6 +296,7 @@ module Grs = struct
let (good_set, bad_set) =
Rule.normalize
grs.domain
grs.label_domain
next.Modul.name
~confluent: next.Modul.confluent
next.Modul.rules
......@@ -322,6 +324,7 @@ module Grs = struct
let (good_set, bad_set) =
Rule.normalize
grs.domain
grs.label_domain
next.Modul.name
~confluent: next.Modul.confluent
next.Modul.rules
......
src/grew_grs.mli
View file @ a27a6aae
......@@ -32,6 +32,7 @@ module Rewrite_history: sig
- returns a list of couples (rules, file)
*)
val save_nfs:
Label.domain ->
?filter: string list ->
?main_feat: string ->
dot: bool ->
......@@ -40,26 +41,26 @@ module Rewrite_history: sig
((string * string list) list * string) list
(** [save_annot out_dir base_name t] writes a set of svg_file for an annotation folder. *)
val save_annot: string -> string -> t -> (string * int * (string*float) * (string*float) * (float option * float option)) list
val save_annot: Label.domain -> string -> string -> t -> (string * int * (string*float) * (string*float) * (float option * float option)) list
(** [save_gr base_name t] saves one gr_file for each normal form defined in [t].
Output files are named according to [base_name] and the Gorn adress in the rewriting tree. *)
val save_gr: string -> t -> unit
val save_conll: string -> t -> unit
val save_gr: Label.domain -> string -> t -> unit
val save_conll: Label.domain -> string -> t -> unit
(** [save_full_conll base_name t] saves one conll_file for each normal form defined in [t].
Output files are named according to [base_name] and a secondary index after "__".
The number of conll file produced is returned. *)
val save_full_conll: string -> t -> int
val save_full_conll: Label.domain -> string -> t -> int
(** [save_det_gr base_name t] supposes that the current GRS is deterministic.
It writes exactly one output file named [base_name].gr with the unique normal form. *)
val save_det_gr: string -> t -> unit
val save_det_conll: ?header:string -> string -> t -> unit
val save_det_gr: Label.domain ->string -> t -> unit
val save_det_conll: Label.domain -> ?header:string -> string -> t -> unit
val det_dep_string: t -> string option
val det_dep_string: Label.domain -> t -> string option
val conll_dep_string: ?keep_empty_rh:bool -> t -> string option
val conll_dep_string: Label.domain -> ?keep_empty_rh:bool -> t -> string option
end (* module Rewrite_history *)
(* ================================================================================ *)
......@@ -86,6 +87,7 @@ module Grs: sig
val get_ast: t -> Ast.grs
val get_domain: t -> Domain.t
val get_label_domain: t -> Label.domain
val get_filename: t -> string
......
src/grew_html.ml
View file @ a27a6aae
......@@ -525,7 +525,7 @@ end (* module Html_doc *)
(* ================================================================================ *)
module Html_rh = struct
let build ?filter ?main_feat ?(dot=false) ?(init_graph=true) ?(out_gr=false) ?header ?graph_file prefix t =
let build label_domain ?filter ?main_feat ?(dot=false) ?(init_graph=true) ?(out_gr=false) ?header ?graph_file prefix t =
(* remove files from previous runs *)
let _ = Unix.system (sprintf "rm -f %s*.html" prefix) in
......@@ -534,10 +534,10 @@ module Html_rh = struct
(
if init_graph
then ignore (Instance.save_dep_png ?filter ?main_feat prefix t.Rewrite_history.instance)
then ignore (Instance.save_dep_png label_domain ?filter ?main_feat prefix t.Rewrite_history.instance)
);
let nf_files = Rewrite_history.save_nfs ?filter ?main_feat ~dot prefix t in
let nf_files = Rewrite_history.save_nfs label_domain ?filter ?main_feat ~dot prefix t in
let l = List.length nf_files in
......@@ -624,15 +624,15 @@ module Html_rh = struct
let error ?main_feat ?(dot=false) ?(init_graph=true) ?header prefix msg graph_opt =
let error label_domain ?main_feat ?(dot=false) ?(init_graph=true) ?header prefix msg graph_opt =
(* remove files from previous runs *)
let _ = Unix.system (sprintf "rm -f %s*.html" prefix) in
let _ = Unix.system (sprintf "rm -f %s*.dep" prefix) in
let _ = Unix.system (sprintf "rm -f %s*.png" prefix) in
(match graph_opt, init_graph with
| (Some graph, true) when dot -> Instance.save_dot_png ?main_feat prefix (Instance.from_graph graph)
| (Some graph, true) -> ignore (Instance.save_dep_png ?main_feat prefix (Instance.from_graph graph))
| (Some graph, true) when dot -> Instance.save_dot_png label_domain ?main_feat prefix (Instance.from_graph graph)
| (Some graph, true) -> ignore (Instance.save_dep_png label_domain ?main_feat prefix (Instance.from_graph graph))
| _ -> ()
);
......@@ -1040,13 +1040,13 @@ module Html_annot = struct
sprintf "<script type=\"text/JavaScript\" src=\"%s\"></script>" (Filename.concat static_dir "annot.js")
]
let build ~title static_dir annot_dir bn_rh_list =
let build label_domain ~title static_dir annot_dir bn_rh_list =
let alt_list = List_.flat_map
(fun (base_name, rew_hist) ->
List.mapi
(fun i alt ->
(sprintf "%s_%d" base_name i, alt)
) (Rewrite_history.save_annot annot_dir base_name rew_hist)
) (Rewrite_history.save_annot label_domain annot_dir base_name rew_hist)
) bn_rh_list in
let db_buff = Buffer.create 32 in
......
src/grew_html.mli
View file @ a27a6aae
......@@ -8,7 +8,7 @@
(* Authors: see AUTHORS file *)
(**********************************************************************************)
open Grew_types
open Grew_rule
open Grew_grs
open Grew_graph
......@@ -28,6 +28,7 @@ end (* module Html_sentences *)
module Html_rh: sig
val build:
Label.domain ->
?filter: string list ->
?main_feat: string ->
?dot: bool ->
......@@ -40,6 +41,7 @@ module Html_rh: sig
unit
val error:
Label.domain ->
?main_feat: string ->
?dot: bool ->