Attention une mise à jour du serveur va être effectuée le lundi 17 mai entre 13h et 13h30. Cette mise à jour va générer une interruption du service de quelques minutes.

Commit 5699a5ca authored by bguillaum's avatar bguillaum

add functions for the -annot mode

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8124 7838e531-6607-4d57-9587-6c381814729c
parent f3631754
......@@ -4,28 +4,21 @@ open Printf
open Grew_utils
open Grew_ast
let rm_first_char = function "" -> "" | s -> String.sub s 1 ((String.length s) - 1)
(* ================================================================================ *)
module Label = struct
(* [decl] is the type for a label declaration: the name and a list of display options *)
type decl = string * string list
(* Global names and display options are recorded in two aligned arrays *)
(** Global names and display styles are recorded in two aligned arrays *)
let full = ref None
let options = ref [||]
(* Internal representation of labels *)
(** Internal representation of labels *)
type t =
| Global of int
| Local of int
| No_domain of string
(* [init string_edge_list] updates global arrays [full] and [options] *)
let init string_edge_list =
let slist = List.sort (fun (x,_) (y,_) -> compare x y) string_edge_list in
let (labels, opts) = List.split slist in
full := Some (Array.of_list labels);
options := Array.of_list opts
| Global of int (* globally defined labels: their names are in the [full] array *)
| Local of int (* locally defined labels: names array should be provided! UNTESTED *)
| No_domain of string (* out of domain label: name in not constrained *)
(** [to_string t] returns a string for the label *)
let to_string ?(locals=[||]) t =
match (!full, t) with
| (_, No_domain s) -> s
......@@ -37,6 +30,79 @@ module Label = struct
| Global i -> Some i
| _ -> None
(** describe the display style of a label *)
type line = Solid | Dot | Dash
type style = {
text: string;
bottom: bool;
color: string option;
bgcolor: string option;
line: line;
}
(** The [default] style value *)
let default = { text="UNSET"; bottom=false; color=None; bgcolor=None; line=Solid }
let styles = ref ([||] : style array)
let get_style = function
| Global i -> !styles.(i)
| Local i -> Log.warning "Style of locally defined labels is not implemented"; default
| No_domain s -> { default with text=s }
(** Computes the style of a label from its options and maybe its shape (like I:...). *)
let parse_option string_label options =
let init_style = match Str.bounded_split (Str.regexp ":") string_label 2 with
| ["S"; l] -> {default with text=l; color=Some "red"}
| ["D"; l] -> {default with text=l; color=Some "blue"; bottom=true}
| ["I"; l] -> {default with text=l; color=Some "grey"}
| _ -> {default with text=string_label} in
List.fold_left
(fun acc_style -> function
| "@bottom" -> {acc_style with bottom=true}
| "@dash" -> {acc_style with line=Dash}
| "@dot" -> {acc_style with line=Dot}
| s when String.length s > 4 && String.sub s 0 4 = "@bg_" ->
let color = String.sub s 4 ((String.length s) - 4) in
{acc_style with bgcolor=Some color}
| s -> {acc_style with color=Some (rm_first_char s)}
) init_style options
(** [decl] is the type for a label declaration: the name and a list of display styles *)
type decl = string * string list
(* [init decl_list] updates global arrays [full] and [styles] *)
let init decl_list =
let slist = List.sort (fun (x,_) (y,_) -> compare x y) decl_list in
let (labels, opts) = List.split slist in
let labels_array = Array.of_list labels in
full := Some labels_array;
styles := Array.mapi (fun i opt -> parse_option labels_array.(i) opt) (Array.of_list opts)
let to_dep ?(deco=false) t =
let style = get_style t in
let dep_items =
(if style.bottom then ["bottom"] else [])
@ (match style.color with Some c -> ["color="^c; "forecolor="^c] | None -> [])
@ (match style.bgcolor with Some c -> ["bgcolor="^c] | None -> [])
@ (match style.line with
| Dot -> ["style=dot"]
| Dash -> ["style=dash"]
| Solid when deco -> ["style=dot"]
| Solid -> []) in
sprintf "{ label = \"%s\"; %s}" style.text (String.concat "; " dep_items)
let to_dot ?(deco=false) t =
let style = get_style t in
let dot_items =
(match style.color with Some c -> ["color="^c; "fontcolor="^c] | None -> [])
@ (match style.line with
| Dot -> ["style=dotted"]
| Dash -> ["style=dashed"]
| Solid when deco -> ["style=dotted"]
| Solid -> []) in
sprintf "[label=\"%s\", %s}" style.text (String.concat ", " dot_items)
let from_string ?loc ?(locals=[||]) string =
match !full with
| None -> No_domain string
......@@ -45,10 +111,6 @@ module Label = struct
with Not_found ->
try Local (Array_.dicho_find_assoc string locals)
with Not_found -> Error.build "[Label.from_string] unknown edge label '%s'" string
let get_options = function
| Global l -> !options.(l)
| _ -> []
end (* module Label *)
......@@ -68,37 +130,14 @@ module G_edge = struct
| (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 rm_first_char = function "" -> "" | s -> String.sub s 1 ((String.length s) - 1)
let to_dep ?(deco=false) t = Label.to_dep ~deco t
let to_dot ?(deco=false) t = Label.to_dot ~deco t
let color_of_option = function
| [] -> None
| c::_ -> Some (rm_first_char c)
let to_dot ?(deco=false) l =
match color_of_option (Label.get_options l) with
| None -> Printf.sprintf "[label=\"%s\", color=%s]" (Label.to_string l) (if deco then "red" else "black")
| Some c -> Printf.sprintf "[label=\"%s\", fontcolor=%s, color=%s]" (Label.to_string l) c (if deco then "red" else "black")
let position_of_option options =
if List.mem "@bottom" options
then "bottom; "
else ""
let to_dep ?(deco=false) l =
let string = Label.to_string l in
let options = Label.get_options l in
let (prefix, label) = match Str.bounded_split (Str.regexp ":") string 2 with
| ["S"; l] -> (Some "S", l)
| ["D"; l] -> (Some "D", l)
| _ -> (None, string) in
let pos = if List.mem "@bottom" options || prefix = Some "D" then "; bottom" else "" in
let style = if deco then "; style=dot" else "" in
let color = match (List.filter (fun x -> x <> "@bottom") options, prefix) with
| (c::_, _) -> let col = rm_first_char c in sprintf "; color=%s; forecolor=%s" col col
| ([], Some "S") -> "; color=red; forecolor=red"
| ([], Some "D") -> "; color=blue; forecolor=blue"
| _ -> "" in
sprintf "{ label = \"%s\"%s%s%s}" label pos style color
end (* module G_edge *)
......
......@@ -156,6 +156,12 @@ module G_fs = struct
let get_atom = List_.sort_assoc
let get_annot_info fs =
match List.filter (fun (fn,value) -> String.length fn > 1 && String.sub fn 0 2 = "__") fs with
| [] -> None
| [(fn,value)] -> Some (fn,conll_string_of_value value)
| _ -> Error.build "[Fs.get_annot_info] More than one annot feature in the same feature structure"
let get_string_atom feat_name t =
match List_.sort_assoc feat_name t with
| None -> None
......
......@@ -35,6 +35,11 @@ module G_fs: sig
val to_raw: t -> (string * string) list
val to_conll: ?exclude: string list -> t -> string
(** [get_annot_info fs] searches for a feature with name starting with "__".
It returns the feature_name and the string representation of its feature value.
raise an [Build] exception if there is more than one such feature. *)
val get_annot_info: t -> (string * string) option
val to_string: t -> string
val build: Ast.feature list -> t
......
......@@ -236,6 +236,19 @@ module G_graph = struct
let node = Gid_map.find node_id graph.map in
Massoc_gid.exists (fun _ e -> P_edge.compatible p_edge e) (G_node.get_next node)
let get_annot_info graph =
let annot_info =
Gid_map.fold
(fun _ node acc ->
match (G_node.get_annot_info node, acc) with
| (None,_) -> acc
| (Some (f,v), None) -> Some (f,v,G_node.get_position node)
| (Some _, Some _) -> Error.build "[G_node.get_annot_info] Two nodes with annot info"
) graph.map None in
match annot_info with
| Some x -> x
| None -> Error.build "[G_node.get_annot_info] No nodes with annot info"
(* -------------------------------------------------------------------------------- *)
let map_add_edge map id_src label id_tar =
let node_src =
......
......@@ -88,6 +88,7 @@ module G_graph: sig
(** [edge_out t id edge] returns true iff there is an out-edge from the node [id] with a label compatible with [edge] *)
val edge_out: t -> Gid.t -> P_edge.t -> bool
val get_annot_info: t -> (string * string * float)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
(* Build functions *)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
......
......@@ -31,7 +31,7 @@ module Rewrite_history = struct
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]
| [],[] -> Instance.save_dep_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]
| [],_ -> []
| l, _ ->
List_.foldi_left
......@@ -69,6 +69,21 @@ module Rewrite_history = struct
| _ -> Error.run "Not a single rewriting"
in loop t
let save_annot 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 (afn,afv,apos) = G_graph.get_annot_info alt_1.instance.Instance.graph
and (bfn,bfv,bpos) = G_graph.get_annot_info alt_2.instance.Instance.graph in
(base_name,i,(afn,afv,apos),(bfn,bfv,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 rec loop t =
match (t.good_nf, t.bad_nf) with
......
......@@ -27,6 +27,9 @@ module Rewrite_history: sig
t ->
((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*string*float) * (string*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
......
......@@ -8,7 +8,7 @@ open Grew_rule
open Grew_grs
let html_header ?title buff =
let html_header ?css_file ?title ?(add_lines=[]) buff =
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
wnl "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">";
......@@ -16,11 +16,15 @@ let html_header ?title buff =
wnl "<html>";
wnl " <head>";
wnl " <meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">";
wnl " <link rel=\"stylesheet\" href=\"style.css\" type=\"text/css\">";
(match css_file with
| Some file -> wnl " <link rel=\"stylesheet\" href=\"%s\" type=\"text/css\">" file
| None -> ()
);
(match title with
| Some t -> wnl " <title>%s</title>" (Str.global_replace (Str.regexp "#") " " t)
| None -> ()
);
List.iter (fun line -> wnl " %s" line) add_lines;
wnl " </head>";
(* ====================================================================================================*)
......@@ -177,7 +181,7 @@ module Html_doc = struct
let w fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s" x) fmt in
let title = sprintf "Grew -- Module %s" module_.Ast.module_id in
html_header ~title buff;
html_header ~css_file:"style.css" ~title buff;
wnl " <body>";
if corpus
......@@ -215,7 +219,7 @@ module Html_doc = struct
let w fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s" x) fmt in
let title = sprintf "Grew -- Rule %s/%s" mid rid in
html_header ~title buff;
html_header ~css_file:"style.css" ~title buff;
wnl " <body>";
if corpus
......@@ -288,7 +292,7 @@ module Html_doc = struct
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Grew -- List of sequences" in
html_header ~title buff;
html_header ~css_file:"style.css" ~title buff;
wnl " <body>";
if corpus
......@@ -317,7 +321,7 @@ module Html_doc = struct
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Grew -- Index of modules" in
html_header ~title buff;
html_header ~css_file:"style.css" ~title buff;
wnl " <body>";
wnl " <div class=\"navbar\">&nbsp;<a href=\"index.html\">Up</a></div>";
......@@ -348,7 +352,7 @@ module Html_doc = struct
let w fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s" x) fmt in
let title = sprintf "Grew -- Features domain" in
html_header ~title buff;
html_header ~css_file:"style.css" ~title buff;
wnl " <body>";
if corpus
......@@ -398,7 +402,7 @@ module Html_doc = struct
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Grew -- Graph Rewriting System: %s" (Filename.basename filename) in
html_header ~title buff;
html_header ~css_file:"style.css" ~title buff;
wnl " <body>";
if corpus
......@@ -482,7 +486,6 @@ module Html_doc = struct
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 =
......@@ -491,7 +494,10 @@ module Html_rh = struct
let _ = Unix.system (sprintf "rm -f %s*.dep" prefix) in
let _ = Unix.system (sprintf "rm -f %s*.png" prefix) in
(if init_graph then Instance.save_dep_png ?filter ?main_feat prefix t.Rewrite_history.instance);
(
if init_graph
then ignore (Instance.save_dep_png ?filter ?main_feat prefix t.Rewrite_history.instance)
);
let nf_files = Rewrite_history.save_nfs ?filter ?main_feat ~dot prefix t in
......@@ -503,7 +509,7 @@ module Html_rh = struct
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Sentence: %s --- %d Normal form%s" local l (if l>1 then "s" else "") in
html_header ~title buff;
html_header ~css_file:"style.css" ~title buff;
wnl "<body>";
wnl "<a href=\"sentences.html\">Sentences</a> -- <a href=\"index.html\">Rewriting stats</a> -- <a href=\"doc/index.html\">GRS documentation</a>";
......@@ -588,7 +594,7 @@ module Html_rh = struct
(match inst_opt, init_graph with
| (Some inst, true) when dot -> Instance.save_dot_png ?main_feat prefix inst
| (Some inst, true) -> Instance.save_dep_png ?main_feat prefix inst
| (Some inst, true) -> ignore (Instance.save_dep_png ?main_feat prefix inst)
| _ -> ()
);
......@@ -598,7 +604,7 @@ module Html_rh = struct
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Sentence: %s --- ERROR" local in
html_header ~title buff;
html_header ~css_file:"style.css" ~title buff;
wnl "<body>";
wnl "<a href=\"sentences.html\">Sentences</a> -- <a href=\"index.html\">Rewriting stats</a> -- <a href=\"doc/index.html\">GRS documentation</a>";
......@@ -618,14 +624,15 @@ module Html_rh = struct
let out_ch = open_out (sprintf "%s.html" prefix) in
fprintf out_ch "%s" (Buffer.contents buff);
close_out out_ch
end
end (* module Html_rh *)
(* ====================================================================================================*)
module Html_sentences = struct
let build ~title output_dir sentences =
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
html_header ~title buff;
html_header ~css_file:"style.css" ~title buff;
wnl " <body>";
wnl "Sentences -- <a href=\"index.html\">Rewriting stats</a> -- <a href=\"doc/index.html\">GRS documentation</a>";
......@@ -658,7 +665,7 @@ end (* module Html_sentences *)
(* ====================================================================================================*)
module Gr_stat = struct
(** the type [gr] stores the stats for the rewriting of one gr file *)
......@@ -774,6 +781,7 @@ module Gr_stat = struct
with Sys_error msg -> Error (sprintf "Sys_error: %s" msg)
end (* module Gr_stat *)
(* ====================================================================================================*)
module Corpus_stat = struct
(** the [t] type stores stats for a corpus of gr_files *)
(*
......@@ -877,7 +885,7 @@ module Corpus_stat = struct
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let w fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s" x) fmt in
html_header ~title buff;
html_header ~css_file:"style.css" ~title buff;
wnl "<a href=\"sentences.html\">Sentences</a> -- Rewriting stats -- <a href=\"doc/index.html\">GRS documentation</a>";
......@@ -989,3 +997,133 @@ module Corpus_stat = struct
close_out out_ch
end (* module Stat *)
(* ==================================================================================================== *)
module Html_annot = struct
let script_lines static_dir = [
"<script src=\"http://ajax.googleapis.com/ajax/libs/jquery/1.8.0/jquery.min.js\"></script>";
sprintf "<script type=\"text/JavaScript\" src=\"%s\"></script>" (Filename.concat static_dir "annot.js")
]
let build 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)
) bn_rh_list in
let db_buff = Buffer.create 32 in
let len = List.length alt_list in
let cpt = ref 0 in
List_.prev_next_iter
(fun ?prev ?next (base_name,(sentid,i,(afn,afv,apos),(bfn,bfv,bpos),(hpa,hpb))) ->
incr cpt;
let init_pos = match (hpa,hpb) with
| (Some p, Some q) -> max 0. ((min p q) -. 500.)
| (Some p, None) | (None, Some p) -> max 0. (p -. 500.)
| _ -> 0. in
(* all entries are "skipped" by default *)
bprintf db_buff "N%s\n" base_name;
let a = sprintf "%s_%d_A" sentid i
and b = sprintf "%s_%d_B" sentid i in
let next_php = match next with
| None -> "index.php"
| Some (bn,_) -> bn^".php" in
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Annotation Hit: %d/%d (%s)" !cpt len base_name in
wnl "<?php require '%s'; ?>" (Filename.concat static_dir "record_choice.php");
wnl "<?php require '%s'; ?>" (Filename.concat static_dir "annot_utils.php");
html_header ~css_file:(Filename.concat static_dir "annot.css") ~add_lines:(script_lines static_dir) ~title buff;
wnl "<body onload=\"set_view_pos(%g);\">" init_pos;
wnl "<h2>%s</h2>" title;
wnl "<div id=\"top\"><embed src=\"%s.svg\" type=\"image/svg+xml\"/></div>" a;
wnl "<div id=\"bottom\"><embed src=\"%s.svg\" type=\"image/svg+xml\"/></div>" b;
wnl "";
wnl "<div id=\"middle\">";
wnl "<table>";
wnl "<tr>";
wnl "<td><form action=\"index.php\"><input type=\"submit\" value=\"Index\"></form></td>";
wnl "<td>";
wnl "<form action=\"%s\" method=\"post\">" next_php;
wnl "<input type=\"hidden\" name=\"to_log\" value=\"%s#%s#%s#%g\" />" sentid afn afv apos;
wnl "<input type=\"hidden\" name=\"hit_id\" value=\"%s_%d\" />" sentid i;
wnl "<input type=\"hidden\" name=\"choice\" value=\"U\" />";
wnl "<input type=\"submit\" value=\"Choose Up\" >";
wnl "</form>";
wnl "</td>";
wnl "<td/>"; (* empty upper right *)
wnl "</tr>";
wnl "";
wnl "<tr>";
(match prev with
| Some (bn,_) -> wnl "<td><form action=\"%s.php\"><input type=\"submit\" value=\"<--Prev--\"></form></td>" bn
| None -> wnl "<td> <form> <input type=\"submit\" value=\"<--Prev--\" disabled> </form> </td>";
);
wnl "<td>";
wnl "<form action=\"%s\" method=\"post\">" next_php;
wnl "<input type=\"hidden\" name=\"to_log\" value=\"No_choice\" />";
wnl "<input type=\"hidden\" name=\"hit_id\" value=\"%s_%d\" />" sentid i;
wnl "<input type=\"hidden\" name=\"choice\" value=\"N\" />";
wnl "<input type=\"submit\" value=\"Don't choose\" >";
wnl "</form>";
wnl "</td>";
(match next with
| Some (bn,_) -> wnl "<td><form action=\"%s.php\"><input type=\"submit\" value=\"--Next-->\"></form></td>" bn
| None -> wnl "<td> <form> <input type=\"submit\" value=\"--Next-->\" disabled> </form> </td>";
);
wnl "</tr>";
wnl "";
wnl "<tr>";
wnl "<td/>"; (* empty lower left *)
wnl "<td>";
wnl "<form action=\"%s\" method=\"post\">" next_php;
wnl "<input type=\"hidden\" name=\"to_log\" value=\"%s#%s#%s#%g\" />" sentid bfn bfv bpos;
wnl "<input type=\"hidden\" name=\"hit_id\" value=\"%s_%d\" />" sentid i;
wnl "<input type=\"hidden\" name=\"choice\" value=\"D\" />";
wnl "<input type=\"submit\" value=\"Choose Down\" >";
wnl "</form>";
wnl "</td>";
wnl "<td/>"; (* empty lower right *)
wnl "</tr>";
wnl "</table>";
wnl "</div>";
wnl "<?php highlight(\"%s_%d\") ?>" sentid i;
wnl "</body>";
wnl "</html>";
let out_ch = open_out (sprintf "%s.php" (Filename.concat annot_dir base_name)) in
fprintf out_ch "%s" (Buffer.contents buff);
close_out out_ch
) alt_list;
printf "--------------> annot_dir=%s\n" annot_dir;
let out_ch = open_out (Filename.concat annot_dir "status.db") in
fprintf out_ch "%s" (Buffer.contents db_buff);
close_out out_ch;
(* creation of the file index.php *)
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
let title = sprintf "Annotation task: TODO" in
wnl "<?php require '%s'; ?>" (Filename.concat static_dir "record_choice.php");
wnl "<?php require '%s'; ?>" (Filename.concat static_dir "annot_utils.php");
html_header ~css_file:(Filename.concat static_dir "annot.css") ~add_lines:(script_lines static_dir) ~title buff;
wnl "<h2>%s</h2>" title;
wnl "<?php index_table() ?>";
let out_ch = open_out (Filename.concat annot_dir "index.php") in
fprintf out_ch "%s" (Buffer.contents buff);
close_out out_ch;
()
end (* module Html_annot *)
......@@ -61,3 +61,7 @@ module Corpus_stat: sig
output_dir:string ->
t -> unit
end
module Html_annot: sig
val build: string -> string -> (string * Rewrite_history.t) list -> unit
end
......@@ -40,6 +40,8 @@ module G_node = struct
| Some l -> Some {t with next = l}
| None -> None
let get_annot_info t = G_fs.get_annot_info t.fs
let build ?def_position (ast_node, loc) =
let fs = G_fs.build ast_node.Ast.fs in
let position = match (ast_node.Ast.position, def_position) with
......
......@@ -37,6 +37,8 @@ module G_node: sig
val position_comp: t -> t -> int
val get_annot_info: t -> (string * string) option
val build_neighbour: t -> t
val rename: (Gid.t * Gid.t) list -> t -> t
......
......@@ -58,9 +58,20 @@ module Instance = struct
IFDEF DEP2PICT THEN
let save_dep_png ?filter ?main_feat base t =
ignore (Dep2pict.Dep2pict.fromDepStringToPng (G_graph.to_dep ?filter ?main_feat t.graph) (base^".png"))