libgrew.ml 5.16 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

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

pj2m's avatar
pj2m committed
11 12 13 14
open Grew_parser
open HTMLer


bguillaum's avatar
bguillaum committed
15

pj2m's avatar
pj2m committed
16 17
exception File_dont_exists of string

bguillaum's avatar
bguillaum committed
18
exception Parsing_err of string
pj2m's avatar
pj2m committed
19 20
exception Build of string * (string * int) option
exception Run of string * (string * int) option
bguillaum's avatar
bguillaum committed
21
exception Bug of string * (string * int) option
pj2m's avatar
pj2m committed
22 23 24

type grs = Grs.t
type gr = Instance.t
bguillaum's avatar
bguillaum committed
25
type rew_history = Rewrite_history.t
pj2m's avatar
pj2m committed
26

bguillaum's avatar
bguillaum committed
27 28
let is_empty = Rewrite_history.is_empty

pj2m's avatar
pj2m committed
29 30
let empty_grs = Grs.empty

bguillaum's avatar
bguillaum committed
31 32
let set_timeout t = Timeout.timeout := t

bguillaum's avatar
bguillaum committed
33 34 35 36
let load_grs ?doc_output_dir file =
  if not (Sys.file_exists file)
  then raise (File_dont_exists file)
  else
37
    try
bguillaum's avatar
bguillaum committed
38
      let grs_ast = Grew_parser.grs_of_file file in
bguillaum's avatar
bguillaum committed
39 40
      (match doc_output_dir with
      | None -> ()
bguillaum's avatar
bguillaum committed
41 42
      | Some dir -> HTMLer.proceed dir grs_ast);
      Grs.build grs_ast
bguillaum's avatar
bguillaum committed
43
    with
bguillaum's avatar
bguillaum committed
44 45
    | Grew_parser.Parse_error (msg,Some (sub_file,l)) -> 
        raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg))
bguillaum's avatar
bguillaum committed
46 47
    | Grew_parser.Parse_error (msg,None) -> 
        raise (Parsing_err (sprintf "[file:%s] %s" file msg))
bguillaum's avatar
bguillaum committed
48 49
    | Error.Build (msg,loc) -> raise (Build (msg,loc))
    | Error.Bug (msg, loc) -> raise (Bug (msg,loc))
bguillaum's avatar
bguillaum committed
50
    | exc -> raise (Bug (sprintf "[Libgrew.load_grs] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
bguillaum's avatar
bguillaum committed
51 52


53
let get_sequence_names grs = Grs.sequence_names grs
bguillaum's avatar
bguillaum committed
54

pj2m's avatar
pj2m committed
55 56
let empty_gr = Instance.empty

bguillaum's avatar
bguillaum committed
57
let load_gr file =
58 59
  if (Sys.file_exists file) then (
    try
bguillaum's avatar
bguillaum committed
60 61
      let gr_ast = Grew_parser.gr_of_file file in
      Instance.build gr_ast
62
    with
bguillaum's avatar
bguillaum committed
63 64
    | Grew_parser.Parse_error (msg,Some (sub_file,l)) -> 
        raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg))
bguillaum's avatar
bguillaum committed
65 66
    | Grew_parser.Parse_error (msg,None) -> 
        raise (Parsing_err (sprintf "[file:%s] %s" file msg))
bguillaum's avatar
bguillaum committed
67 68
    | Error.Build (msg,loc) -> raise (Build (msg,loc))
    | Error.Bug (msg, loc) -> raise (Bug (msg,loc))
bguillaum's avatar
bguillaum committed
69
    | exc -> raise (Bug (sprintf "[Libgrew.load_gr] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
70 71 72 73

   ) else (
    raise (File_dont_exists file)
   )
pj2m's avatar
pj2m committed
74

bguillaum's avatar
bguillaum committed
75
let load_conll file =
76
  try
bguillaum's avatar
bguillaum committed
77 78 79
    (* let lines = File.read file in *)
    (* Instance.of_conll (List.map Conll.parse lines) *)
    Instance.of_conll ~loc:(file,-1) (Conll.load file)
80
  with
bguillaum's avatar
bguillaum committed
81 82
    | Grew_parser.Parse_error (msg,Some (sub_file,l)) -> 
        raise (Parsing_err (sprintf "[file:%s, line:%d] %s" sub_file l msg))
bguillaum's avatar
bguillaum committed
83 84
    | Grew_parser.Parse_error (msg,None) -> 
        raise (Parsing_err (sprintf "[file:%s] %s" file msg))
85 86
  | Error.Build (msg,loc) -> raise (Build (msg,loc))
  | Error.Bug (msg, loc) -> raise (Bug (msg,loc))
bguillaum's avatar
bguillaum committed
87
  | exc -> raise (Bug (sprintf "[Libgrew.load_conll] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103

let load_graph file = 
  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

bguillaum's avatar
bguillaum committed
104

105
let rewrite ~gr ~grs ~seq = 
106
  try Grs.rewrite grs seq gr
107
  with
bguillaum's avatar
bguillaum committed
108 109
  | Error.Run (msg,loc) -> raise (Run (msg,loc))
  | Error.Bug (msg, loc) -> raise (Bug (msg,loc))
bguillaum's avatar
bguillaum committed
110
  | exc -> raise (Bug (sprintf "[Libgrew.rewrite] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
111

bguillaum's avatar
bguillaum committed
112
let display ~gr ~grs ~seq =
113
  try Grs.build_rew_display grs seq gr
pj2m's avatar
pj2m committed
114
  with
bguillaum's avatar
bguillaum committed
115 116
  | Error.Run (msg,loc) -> raise (Run (msg,loc))
  | Error.Bug (msg, loc) -> raise (Bug (msg,loc))
117
  | Error.Build (msg, loc) -> raise (Build (msg,loc))
bguillaum's avatar
bguillaum committed
118
  | exc -> raise (Bug (sprintf "[Libgrew.display] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
bguillaum's avatar
bguillaum committed
119 120 121

let write_stat filename rew_hist = Gr_stat.save filename (Gr_stat.from_rew_history rew_hist) 

bguillaum's avatar
bguillaum committed
122 123 124 125 126
let save_index ~dirname ~base_names =
  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
127 128 129 130 131
let write_html 
    ?(no_init=false) ?main_feat 
    ~header
    rew_hist
    output_base =
132
IFDEF DEP2PICT THEN
133
  ignore (
bguillaum's avatar
bguillaum committed
134 135 136 137 138 139
  Rewrite_history.save_html 
    ?main_feat 
    ~init_graph: (not no_init)
    ~header
    output_base rew_hist
    )
140 141 142
ELSE
    Log.critical "[write_html] The \"libcaml-grew\" library is compiled without Dep2pict"
ENDIF
143 144 145 146 147 148

let error_html 
    ?(no_init=false) ?main_feat 
    ~header
    msg ?init
    output_base =
149
IFDEF DEP2PICT THEN
150 151 152 153 154 155 156
  ignore (
  Rewrite_history.error_html 
    ?main_feat 
    ~init_graph: (not no_init)
    ~header
    output_base msg init
    )
157
ELSE
bguillaum's avatar
bguillaum committed
158
    Log.critical "[error_html] The \"libcaml-grew\" library is compiled without Dep2pict"
159
ENDIF
160

bguillaum's avatar
bguillaum committed
161 162
let make_index ~title ~grs_file ~html ~grs ~seq ~output_dir ~base_names  =
  let init = Corpus_stat.empty grs seq in
bguillaum's avatar
bguillaum committed
163 164 165 166 167 168 169
  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 html output_dir corpus_stat

pj2m's avatar
pj2m committed
170 171
let get_css_file = Filename.concat DATA_DIR "style.css"

172
let graph_of_instance instance = instance.Instance.graph