Commit 7ed094dd authored by bguillaum's avatar bguillaum

version 0.14 of libcamlgrew and grewui: improve configure (without dep2pict)...

version 0.14 of libcamlgrew and grewui:  improve configure (without dep2pict) end add dot output in corpus/cluster mode

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@7325 7838e531-6607-4d57-9587-6c381814729c
parent b27a1450
VERSION = 0.13
VERSION = 0.14
INSTALL_DIR_LIB = @OCAMLLIB@
INSTALL_DIR = @prefix@/bin/
......
......@@ -263,11 +263,7 @@ GREW_RULE_CMO = $(GREW_RULE_DEP:%=%.cmo)
GREW_RULE_CMX = $(GREW_RULE_DEP:%=%.cmx)
grew_rule.cmi: $(GREW_RULE_CMI) grew_rule.mli
ifeq (@DEP2PICT@,no)
$(OCAMLC) -c -pp 'camlp4o pa_macro.cmo' grew_rule.mli
else
$(OCAMLC) -c -pp 'camlp4o pa_macro.cmo -DDEP2PICT' grew_rule.mli
endif
$(OCAMLC) -c grew_rule.mli
grew_rule.cmo: $(GREW_RULE_CMO) grew_rule.cmi grew_rule.ml
ifeq (@DEP2PICT@,no)
......@@ -292,25 +288,13 @@ GREW_GRS_CMO = $(GREW_GRS_DEP:%=%.cmo)
GREW_GRS_CMX = $(GREW_GRS_DEP:%=%.cmx)
grew_grs.cmi: $(GREW_GRS_CMI) grew_grs.mli
ifeq (@DEP2PICT@,no)
$(OCAMLC) -c -pp 'camlp4o pa_macro.cmo' grew_grs.mli
else
$(OCAMLC) -c -pp 'camlp4o pa_macro.cmo -DDEP2PICT' grew_grs.mli
endif
$(OCAMLC) -c grew_grs.mli
grew_grs.cmo: $(GREW_GRS_CMO) grew_grs.cmi grew_grs.ml
ifeq (@DEP2PICT@,no)
$(OCAMLC) $(BYTE_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\"' -c $(DEPENDS_DIR) grew_grs.ml
else
$(OCAMLC) $(BYTE_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\" -DDEP2PICT' -c $(DEPENDS_DIR) grew_grs.ml
endif
grew_grs.cmx: $(GREW_GRS_CMX) grew_grs.cmi grew_grs.ml
ifeq (@DEP2PICT@,no)
$(OCAMLOPT) $(OPT_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\"' -c $(DEPENDS_DIR) grew_grs.ml
else
$(OCAMLOPT) $(OPT_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\" -DDEP2PICT' -c $(DEPENDS_DIR) grew_grs.ml
endif
################################################################################
# others
......
......@@ -27,15 +27,15 @@ module Rewrite_history = struct
| { good_nf = [] } -> 0 (* dead branch *)
| { good_nf = l} -> List.fold_left (fun acc t -> acc + (num_sol t)) 0 l
IFDEF DEP2PICT THEN
(** [save_nfs ?main_feat base_name t] does two things:
- write PNG files of normal forms
- returns a list of couples (rules, file)
*)
let save_nfs ?main_feat base_name t =
let save_nfs ?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 ?main_feat file_name t.instance; [rules, file_name]
| [],[] -> Instance.save_dep_png ?main_feat file_name t.instance; [rules, file_name]
| [],_ -> []
| l, _ ->
......@@ -51,13 +51,15 @@ module Rewrite_history = struct
[] l
in loop base_name [] t
let error_html ?main_feat ?(init_graph=true) ?header prefix msg inst_opt =
let error_html ?main_feat ?(dot=false) ?(init_graph=true) ?header prefix msg inst_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 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
| _ -> ()
);
......@@ -87,7 +89,7 @@ module Rewrite_history = struct
| l, _ -> List_.iteri (fun i son -> loop (sprintf "%s_%d" file_name i) son) l
in loop base t
let save_html ?main_feat ?(init_graph=true) ?(out_gr=false) ?header ~graph_file prefix t =
let save_html ?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
let _ = Unix.system (sprintf "rm -f %s*.dep" prefix) in
......@@ -95,7 +97,7 @@ module Rewrite_history = struct
(if init_graph then Instance.save_dep_png ?main_feat prefix t.instance);
let nf_files = save_nfs ?main_feat prefix t in
let nf_files = save_nfs ?main_feat ~dot prefix t in
let l = List.length nf_files in
......@@ -156,11 +158,9 @@ module Rewrite_history = struct
rules_list;
fprintf html_ch " </div>\n"
) nf_files;
Html.leave html_ch;
close_out html_ch
ENDIF
end
......
......@@ -14,11 +14,19 @@ module Rewrite_history: sig
val is_empty: t -> bool
IFDEF DEP2PICT THEN
val error_html: ?main_feat:string -> ?init_graph:bool -> ?header:string -> string -> string -> Instance.t option -> unit
val error_html:
?main_feat: string ->
?dot: bool ->
?init_graph:bool ->
?header:string ->
string ->
string ->
Instance.t option ->
unit
val save_html:
?main_feat:string ->
?main_feat: string ->
?dot: bool ->
?init_graph:bool ->
?out_gr:bool ->
?header:string ->
......@@ -26,7 +34,6 @@ IFDEF DEP2PICT THEN
string ->
t ->
unit
ENDIF
val save_gr: string -> t -> unit
end
......
open Printf
open Dep2pict
open Grew_utils
open Grew_ast
......@@ -177,10 +176,9 @@ module Html = struct
wnl "</html>";
Buffer.contents buff
let rule_page_text prev next rule_ module_ =
let rule_page_text ~dep prev next rule_ module_ =
let rid = rule_.Ast.rule_id in
let mid = module_.Ast.module_id in
let dep_pattern_file = sprintf "%s_%s-patt.png" mid rid in
let buff = Buffer.create 32 in
let wnl fmt = Printf.ksprintf (fun x -> Printf.bprintf buff "%s\n" x) fmt in
......@@ -203,10 +201,14 @@ module Html = struct
w "%s" (to_html_rules [rule_]);
wnl "</pre>";
wnl "<h6>Pattern</h6>";
wnl "<pre>";
w "<IMG src=\"%s\">" dep_pattern_file;
wnl "</pre>";
if dep
then
begin
wnl "<h6>Pattern</h6>";
wnl "<pre>";
w "<IMG src=\"%s\">" (sprintf "%s_%s-patt.png" mid rid);
wnl "</pre>"
end;
let output_table args lines =
wnl " <table border=\"1\" cellspacing=\"0\" cellpadding=\"3\">";
......@@ -330,8 +332,8 @@ module Html = struct
wnl "</html>";
Buffer.contents buff
let proceed file output_dir ast =
(* dep is a flag which is true iff dep file are shown in doc (iff dep2pict is available) *)
let proceed ~dep file output_dir ast =
ignore(Sys.command ("rm -rf "^output_dir));
ignore(Sys.command ("mkdir "^output_dir));
ignore(Sys.command ("cp "^DATA_DIR^"/style.css "^output_dir));
......@@ -413,7 +415,8 @@ module Html = struct
let page = Filename.concat output_dir (modules_array.(i).Ast.module_id^"_"^rules_array.(j).Ast.rule_id^".html") in
let page_out_ch = open_out page in
output_string page_out_ch
(rule_page_text
(rule_page_text
~dep
(try Some (rules_array.(j-1).Ast.rule_id) with _ -> None)
(try Some (rules_array.(j+1).Ast.rule_id) with _ -> None)
rules_array.(j)
......
......@@ -2,5 +2,5 @@ open Grew_ast
module Html :
sig
val proceed : string -> string -> Ast.grs -> unit
val proceed : dep:bool -> string -> string -> Ast.grs -> unit
end
......@@ -9,11 +9,6 @@ open Grew_node
open Grew_command
open Grew_graph
IFDEF DEP2PICT THEN
open Dep2pict
ENDIF
(* ================================================================================ *)
module Instance = struct
type t = {
......@@ -49,9 +44,14 @@ module Instance = struct
let to_gr t = G_graph.to_gr t.graph
let save_dot_png ?main_feat base t =
ignore (Grew_utils.png_file_from_dot (G_graph.to_dot ?main_feat t.graph) (base^".png"))
IFDEF DEP2PICT THEN
let save_dep_png ?main_feat base t =
ignore (Dep2pict.fromDepStringToPng (G_graph.to_dep ?main_feat t.graph) (base^".png"))
let save_dep_png ?main_feat base t =
ignore (Dep2pict.Dep2pict.fromDepStringToPng (G_graph.to_dep ?main_feat t.graph) (base^".png"))
ELSE
let save_dep_png ?main_feat base t = ()
ENDIF
end (* module Instance *)
......
......@@ -28,10 +28,15 @@ module Instance : sig
val to_gr: t -> string
IFDEF DEP2PICT THEN
(* [save_dep_png base t] writes a file "base.png" with the dep representation of [t] *)
(* [save_dep_png base t] writes a file "base.png" with the dep representation of [t].
NB: if the Dep2pict is not available, nothing is done *)
val save_dep_png: ?main_feat: string -> string -> t -> unit
ENDIF
(* [save_dot_png base t] writes a file "base.png" with the dot representation of [t] *)
val save_dot_png: ?main_feat: string -> string -> t -> unit
end
module Instance_set : Set.S with type elt = Instance.t
......
......@@ -7,6 +7,16 @@ module StringMap = Map.Make (String)
module IntSet = Set.Make (struct type t = int let compare = Pervasives.compare end)
module IntMap = Map.Make (struct type t = int let compare = Pervasives.compare end)
let png_file_from_dot dot output_file =
let temp_file_name,out_ch = Filename.open_temp_file ~mode:[Open_rdonly;Open_wronly;Open_text] "grewui_" ".dot" in
fprintf out_ch "%s" dot;
close_out out_ch;
ignore(Sys.command(sprintf "dot -Tpng -o %s %s " output_file temp_file_name))
(* ================================================================================ *)
module Loc = struct
type t = string * int
......
......@@ -6,6 +6,8 @@ module IntSet : Set.S with type elt = int
module IntMap : Map.S with type key = int
val png_file_from_dot: string -> string -> unit
(* ================================================================================ *)
(* [Loc] general module to describe errors location: (file name, line number in file) *)
module Loc: sig
......
......@@ -2,7 +2,6 @@ include Grew_types
open Printf
open Log
open Dep2pict
open Grew_utils
open Grew_graph
......@@ -31,6 +30,22 @@ let empty_grs = Grs.empty
let set_timeout t = Timeout.timeout := t
IFDEF DEP2PICT THEN
let build_doc file dir grs_ast grs =
Html.proceed ~dep:true file dir grs_ast;
(* draw pattern graphs for all rules and all filters *)
let fct module_ rule_ =
let dep_code = Rule.to_dep rule_ in
let dep_svg_file = sprintf "%s/%s_%s-patt.png" dir module_ (Rule.get_name rule_) in
ignore (Dep2pict.Dep2pict.fromDepStringToPng dep_code dep_svg_file) in
Grs.rule_iter fct grs;
Grs.filter_iter fct grs
ELSE
let build_doc file dir grs_ast grs =
Html.proceed ~dep:false file dir grs_ast
END
let load_grs ?doc_output_dir file =
if not (Sys.file_exists file)
then raise (File_dont_exists file)
......@@ -40,17 +55,7 @@ let load_grs ?doc_output_dir file =
let grs = Grs.build grs_ast in
(match doc_output_dir with
| None -> ()
| Some dir ->
Html.proceed file dir grs_ast;
(* draw pattern graphs for all rules and all filters *)
let fct module_ rule_ =
let dep_code = Rule.to_dep rule_ in
let dep_svg_file = sprintf "%s/%s_%s-patt.png" dir module_ (Rule.get_name rule_) in
ignore (Dep2pict.fromDepStringToPng dep_code dep_svg_file) in
Grs.rule_iter fct grs;
Grs.filter_iter fct grs
);
| Some dir -> build_doc file dir grs_ast grs);
grs
with
| Grew_parser.Parse_error (msg,Some (sub_file,l)) ->
......@@ -138,46 +143,45 @@ let save_index ~dirname ~base_names =
List.iter (fun f -> fprintf out_ch "%s\n" f) base_names;
close_out out_ch
let save_gr base rew_hist = Rewrite_history.save_gr base rew_hist
let save_gr base rew_hist =
Rewrite_history.save_gr base rew_hist
let write_html
?(no_init=false)
?(out_gr=false)
?main_feat
?dot
~header
~graph_file
rew_hist
output_base =
IFDEF DEP2PICT THEN
ignore (
Rewrite_history.save_html
?main_feat
?dot
~out_gr
~init_graph: (not no_init)
~header
~graph_file
output_base rew_hist
)
ELSE
Log.critical "[write_html] The \"libcaml-grew\" library is compiled without Dep2pict"
ENDIF
let error_html
?(no_init=false) ?main_feat
?(no_init=false)
?main_feat
?dot
~header
msg ?init
msg
?init
output_base =
IFDEF DEP2PICT THEN
ignore (
Rewrite_history.error_html
?main_feat
?main_feat
?dot
~init_graph: (not no_init)
~header
output_base msg init
)
ELSE
Log.critical "[error_html] The \"libcaml-grew\" library is compiled without Dep2pict"
ENDIF
let make_index ~title ~grs_file ~html ~grs ~seq ~input_dir ~output_dir ~base_names =
let init = Corpus_stat.empty grs seq in
......
......@@ -62,15 +62,23 @@ val load_graph: string -> Instance.t
val save_index: dirname:string -> base_names: string list -> unit
val write_html:
?no_init:bool ->
?out_gr:bool ->
?main_feat:string ->
?no_init: bool ->
?out_gr: bool ->
?main_feat: string ->
?dot: bool ->
header: string ->
graph_file: string ->
Rewrite_history.t -> string -> unit
val error_html:
?no_init:bool -> ?main_feat:string -> header: string -> string -> ?init:Instance.t -> string -> unit
?no_init:bool ->
?main_feat:string ->
?dot: bool ->
header: string ->
string ->
?init:Instance.t ->
string ->
unit
val make_index:
title: string ->
......
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