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