libgrew.ml 7.13 KB
Newer Older
pj2m's avatar
pj2m committed
1 2
include Grew_types

bguillaum's avatar
bguillaum committed
3
open Printf
pj2m's avatar
pj2m committed
4 5
open Log

6
open Grew_fs
bguillaum's avatar
bguillaum committed
7 8 9 10 11
open Grew_utils
open Grew_graph
open Grew_rule
open Grew_grs

pj2m's avatar
pj2m committed
12
open Grew_parser
bguillaum's avatar
bguillaum committed
13
open Grew_html
pj2m's avatar
pj2m committed
14 15


16 17 18 19 20 21
let css_file = Filename.concat DATA_DIR "style.css"

let empty_grs = Grs.empty

let set_timeout t = Timeout.timeout := t

bguillaum's avatar
bguillaum committed
22

pj2m's avatar
pj2m committed
23 24
exception File_dont_exists of string

bguillaum's avatar
bguillaum committed
25
exception Parsing_err of string
pj2m's avatar
pj2m committed
26 27
exception Build of string * (string * int) option
exception Run of string * (string * int) option
bguillaum's avatar
bguillaum committed
28
exception Bug of string * (string * int) option
pj2m's avatar
pj2m committed
29

30 31 32 33 34 35 36 37 38 39 40
let handle ?(name="") ?(file="No file defined") fct () =
  (* Printf.printf " ==========> %s ...%!" name; *)
  try fct () with
    | Grew_parser.Parse_error (msg,Some (sub_file,l)) ->
        raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg))
    | Grew_parser.Parse_error (msg,None) ->
        raise (Parsing_err (sprintf "[file:%s] %s" file msg))
    | Error.Build (msg,loc) -> raise (Build (msg,loc))
    | Error.Bug (msg, loc) -> raise (Bug (msg,loc))
    | Error.Run (msg, loc) -> raise (Run (msg,loc))
    | exc -> raise (Bug (sprintf "[Libgrew.%s] UNCATCHED EXCEPTION: %s" name (Printexc.to_string exc), None))
pj2m's avatar
pj2m committed
41

bguillaum's avatar
bguillaum committed
42

43 44
let is_empty rh =
  handle ~name:"num_sol" (fun () -> Rewrite_history.is_empty rh) ()
bguillaum's avatar
bguillaum committed
45

46 47
let num_sol rh =
  handle ~name:"num_sol" (fun () -> Rewrite_history.num_sol rh) ()
pj2m's avatar
pj2m committed
48

bguillaum's avatar
bguillaum committed
49

50 51
IFDEF DEP2PICT THEN
let build_doc file dir grs_ast grs =
52 53 54 55 56 57 58 59 60 61 62 63
  handle ~name:"build_doc [with Dep2pict]" ~file
    (fun () ->
      Html_doc.build ~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
    ) ()
64 65
ELSE
let build_doc file dir grs_ast grs =
66
  handle ~name:"build_doc [without Dep2pict]" (fun () -> Html_doc.build ~dep:false file dir grs_ast) ()
67 68
END

bguillaum's avatar
bguillaum committed
69
let load_grs ?doc_output_dir file =
70 71 72 73 74 75 76 77 78 79 80 81
  handle ~name:"load_grs" ~file
    (fun () ->
      if not (Sys.file_exists file)
      then raise (File_dont_exists file)
      else
        let grs_ast = Grew_parser.grs_of_file file in
        let grs = Grs.build grs_ast in
        (match doc_output_dir with
          | None -> ()
          | Some dir -> build_doc file dir grs_ast grs);
        grs
    ) ()
bguillaum's avatar
bguillaum committed
82

bguillaum's avatar
bguillaum committed
83
let to_sentence ?main_feat gr =
84 85 86 87 88 89 90 91 92 93 94
  handle ~name:"to_sentence"
    (fun () ->
      let graph = gr.Instance.graph in
      G_graph.to_sentence ?main_feat graph
    ) ()

let get_sequence_names grs =
  handle ~name:"get_sequence_names"
    (fun () ->
      Grs.sequence_names grs
    ) ()
bguillaum's avatar
bguillaum committed
95 96

let load_gr file =
97 98 99 100 101
  if not (Sys.file_exists file)
  then raise (File_dont_exists file)
  else
    handle ~name:"load_gr" ~file
      (fun () ->
bguillaum's avatar
bguillaum committed
102 103
        let gr_ast = Grew_parser.gr_of_file file in
        Instance.from_graph (G_graph.build gr_ast)
104
      ) ()
pj2m's avatar
pj2m committed
105

bguillaum's avatar
bguillaum committed
106
let load_conll file =
107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
  handle ~name:"load_conll" ~file
    (fun () ->
      let graph = G_graph.of_conll ~loc:(file,-1) (Conll.load file) in
      Instance.from_graph graph
    ) ()

let load_graph file =
  handle ~name:"load_graph" ~file
    (fun () ->
      if Filename.check_suffix file ".gr"
      then load_gr file
      else if Filename.check_suffix file ".conll"
      then load_conll file
      else
        begin
          Log.fwarning "Unknown file format for input graph '%s', try to guess..." file;
          try load_gr file with
              Parsing_err _ ->
                try load_conll file with
                    Parsing_err _ ->
                      Log.fcritical "[Libgrew.load_graph] Cannot guess input file format of file '%s'. Use .gr or .conll file extension" file
        end
    ) ()
130

bguillaum's avatar
bguillaum committed
131
let xml_graph xml =
132
  handle ~name:"xml_graph" (fun () -> Instance.from_graph (G_graph.of_xml xml)) ()
bguillaum's avatar
bguillaum committed
133

bguillaum's avatar
bguillaum committed
134
let raw_graph instance =
135
  handle ~name:"raw_graph" (fun () -> G_graph.to_raw instance.Instance.graph) ()
bguillaum's avatar
bguillaum committed
136

137 138
let rewrite ~gr ~grs ~seq =
  handle ~name:"rewrite" (fun () -> Grs.rewrite grs seq gr) ()
139

bguillaum's avatar
bguillaum committed
140
let display ~gr ~grs ~seq =
141
  handle ~name:"display" (fun () -> Grs.build_rew_display grs seq gr) ()
bguillaum's avatar
bguillaum committed
142

143 144
let write_stat filename rew_hist =
  handle ~name:"write_stat" (fun () -> Gr_stat.save filename (Gr_stat.from_rew_history rew_hist)) ()
bguillaum's avatar
bguillaum committed
145

bguillaum's avatar
bguillaum committed
146
let save_index ~dirname ~base_names =
147 148 149 150 151
  handle ~name:"save_index" (fun () ->
    let out_ch = open_out (Filename.concat dirname "index") in
    List.iter (fun f -> fprintf out_ch "%s\n" f) base_names;
    close_out out_ch
  ) ()
bguillaum's avatar
bguillaum committed
152
let save_graph_conll filename graph =
153 154 155 156 157
  handle ~name:"save_graph_conll" (fun () ->
    let out_ch = open_out filename in
    fprintf out_ch "%s" (Instance.to_conll graph);
    close_out out_ch
  ) ()
bguillaum's avatar
bguillaum committed
158

159 160
let save_gr base rew_hist =
  handle ~name:"save_gr" (fun () -> Rewrite_history.save_gr base rew_hist) ()
161

162 163
let save_conll base rew_hist =
  handle ~name:"save_conll" (fun () -> Rewrite_history.save_conll base rew_hist) ()
bguillaum's avatar
bguillaum committed
164

165 166
let save_det_gr base rew_hist =
  handle ~name:"save_det_gr" (fun () -> Rewrite_history.save_det_gr base rew_hist) ()
bguillaum's avatar
bguillaum committed
167

168 169
let save_det_conll ?header base rew_hist =
  handle ~name:"save_det_conll" (fun () -> Rewrite_history.save_det_conll ?header base rew_hist) ()
170

171 172
let det_dep_string rew_hist =
  handle ~name:"det_dep_string" (fun () -> Rewrite_history.det_dep_string rew_hist) ()
bguillaum's avatar
bguillaum committed
173

bguillaum's avatar
bguillaum committed
174
let write_html 
175 176
    ?(no_init=false)
    ?(out_gr=false)
177 178
    ?filter
    ?main_feat
179
    ?dot
bguillaum's avatar
bguillaum committed
180
    ~header
181
    ~graph_file
bguillaum's avatar
bguillaum committed
182 183
    rew_hist
    output_base =
184 185 186 187 188 189 190 191 192 193 194
  handle ~name:"write_html" (fun () ->
    ignore (
      Html_rh.build
        ?filter
        ?main_feat
        ?dot
        ~out_gr
        ~init_graph: (not no_init)
        ~header
        ~graph_file
        output_base rew_hist
bguillaum's avatar
bguillaum committed
195
    )
196
  ) ()
197 198

let error_html 
199 200 201
    ?(no_init=false) 
    ?main_feat 
    ?dot
202
    ~header
203 204
    msg 
    ?init
205
    output_base =
206 207 208 209 210 211 212 213
  handle ~name:"error_html" (fun () ->
    ignore (
      Html_rh.error
        ?main_feat
        ?dot
        ~init_graph: (not no_init)
        ~header
        output_base msg init
214
    )
215
  ) ()
216

217
let make_index ~title ~grs_file ~html ~grs ~seq ~input_dir ~output_dir ~base_names  =
218 219 220 221 222 223 224 225 226 227 228 229 230 231 232
  handle ~name:"make_index" (fun () ->
    let init = Corpus_stat.empty grs seq in
    let corpus_stat =
      List.fold_left
        (fun acc base_name ->
          Corpus_stat.add_gr_stat base_name (Gr_stat.load (Filename.concat output_dir (base_name^".stat"))) acc
        ) init base_names in
    Corpus_stat.save_html title grs_file input_dir output_dir corpus_stat
  ) ()

let html_sentences ~title = handle ~name:"html_sentences" (fun () -> Html_sentences.build ~title) ()

let graph_of_instance instance = handle ~name:"graph_of_instance" (fun () -> instance.Instance.graph) ()

let feature_names () =  handle ~name:"feature_names" (fun () -> Domain.feature_names ()) ()
bguillaum's avatar
bguillaum committed
233

234 235
let to_dot_graph ?main_feat ?(deco=G_deco.empty) graph =
  handle ~name:"to_dot_graph" (fun () -> G_graph.to_dot ?main_feat graph ~deco) ()
bguillaum's avatar
bguillaum committed
236

237 238
let to_dep_graph ?filter ?main_feat ?(deco=G_deco.empty) graph =
  handle ~name:"to_dep_graph" (fun () -> G_graph.to_dep ?filter ?main_feat ~deco graph) ()
pj2m's avatar
pj2m committed
239

240 241
let to_gr_graph graph =
  handle ~name:"to_gr_graph" (fun () -> G_graph.to_gr graph) ()
242

243 244
let to_conll_graph graph =
  handle ~name:"to_conll_graph" (fun () -> G_graph.to_conll graph) ()