libgrew.ml 5.86 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
open Log
bguillaum's avatar
bguillaum committed
5
open Dep2pict
pj2m's avatar
pj2m committed
6

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


bguillaum's avatar
bguillaum committed
16

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

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

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

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

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

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

bguillaum's avatar
bguillaum committed
34
35
36
37
let load_grs ?doc_output_dir file =
  if not (Sys.file_exists file)
  then raise (File_dont_exists file)
  else
38
    try
bguillaum's avatar
bguillaum committed
39
      let grs_ast = Grew_parser.grs_of_file file in
bguillaum's avatar
bguillaum committed
40
      let grs = Grs.build grs_ast in
bguillaum's avatar
bguillaum committed
41
      (match doc_output_dir with
bguillaum's avatar
bguillaum committed
42
43
        | None -> ()
        | Some dir -> 
44
          Html.proceed file dir grs_ast;
bguillaum's avatar
bguillaum committed
45
46
47
48
49
50
51
52
          
          (* 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
bguillaum's avatar
bguillaum committed
53
54
      );
      grs
bguillaum's avatar
bguillaum committed
55
    with
bguillaum's avatar
bguillaum committed
56
57
    | 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
58
59
    | Grew_parser.Parse_error (msg,None) -> 
        raise (Parsing_err (sprintf "[file:%s] %s" file msg))
bguillaum's avatar
bguillaum committed
60
61
    | Error.Build (msg,loc) -> raise (Build (msg,loc))
    | Error.Bug (msg, loc) -> raise (Bug (msg,loc))
bguillaum's avatar
bguillaum committed
62
    | exc -> raise (Bug (sprintf "[Libgrew.load_grs] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
bguillaum's avatar
bguillaum committed
63

bguillaum's avatar
bguillaum committed
64
65
66
let to_sentence ?main_feat gr =
  let graph = gr.Instance.graph in
  G_graph.to_sentence ?main_feat graph
bguillaum's avatar
bguillaum committed
67

68
let get_sequence_names grs = Grs.sequence_names grs
bguillaum's avatar
bguillaum committed
69

pj2m's avatar
pj2m committed
70
71
let empty_gr = Instance.empty

bguillaum's avatar
bguillaum committed
72
let load_gr file =
73
74
  if (Sys.file_exists file) then (
    try
bguillaum's avatar
bguillaum committed
75
76
      let gr_ast = Grew_parser.gr_of_file file in
      Instance.build gr_ast
77
    with
bguillaum's avatar
bguillaum committed
78
79
    | 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
80
81
    | Grew_parser.Parse_error (msg,None) -> 
        raise (Parsing_err (sprintf "[file:%s] %s" file msg))
bguillaum's avatar
bguillaum committed
82
83
    | Error.Build (msg,loc) -> raise (Build (msg,loc))
    | Error.Bug (msg, loc) -> raise (Bug (msg,loc))
bguillaum's avatar
bguillaum committed
84
    | exc -> raise (Bug (sprintf "[Libgrew.load_gr] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
85
86
87
88

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

bguillaum's avatar
bguillaum committed
90
let load_conll file =
91
  try
bguillaum's avatar
bguillaum committed
92
93
94
    (* let lines = File.read file in *)
    (* Instance.of_conll (List.map Conll.parse lines) *)
    Instance.of_conll ~loc:(file,-1) (Conll.load file)
95
  with
bguillaum's avatar
bguillaum committed
96
97
    | 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
98
99
    | Grew_parser.Parse_error (msg,None) -> 
        raise (Parsing_err (sprintf "[file:%s] %s" file msg))
100
101
  | Error.Build (msg,loc) -> raise (Build (msg,loc))
  | Error.Bug (msg, loc) -> raise (Bug (msg,loc))
bguillaum's avatar
bguillaum committed
102
  | exc -> raise (Bug (sprintf "[Libgrew.load_conll] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118

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

119
let rewrite ~gr ~grs ~seq = 
120
  try Grs.rewrite grs seq gr
121
  with
bguillaum's avatar
bguillaum committed
122
123
  | Error.Run (msg,loc) -> raise (Run (msg,loc))
  | Error.Bug (msg, loc) -> raise (Bug (msg,loc))
bguillaum's avatar
bguillaum committed
124
  | exc -> raise (Bug (sprintf "[Libgrew.rewrite] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
125

bguillaum's avatar
bguillaum committed
126
let display ~gr ~grs ~seq =
127
  try Grs.build_rew_display grs seq gr
pj2m's avatar
pj2m committed
128
  with
bguillaum's avatar
bguillaum committed
129
130
  | Error.Run (msg,loc) -> raise (Run (msg,loc))
  | Error.Bug (msg, loc) -> raise (Bug (msg,loc))
131
  | Error.Build (msg, loc) -> raise (Build (msg,loc))
bguillaum's avatar
bguillaum committed
132
  | exc -> raise (Bug (sprintf "[Libgrew.display] UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
bguillaum's avatar
bguillaum committed
133
134
135

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

bguillaum's avatar
bguillaum committed
136
137
138
139
140
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

141
142
let save_gr base rew_hist = Rewrite_history.save_gr base rew_hist

bguillaum's avatar
bguillaum committed
143
let write_html 
144
145
146
    ?(no_init=false)
    ?(out_gr=false)
    ?main_feat 
bguillaum's avatar
bguillaum committed
147
    ~header
148
    ~graph_file
bguillaum's avatar
bguillaum committed
149
150
    rew_hist
    output_base =
151
IFDEF DEP2PICT THEN
152
  ignore (
bguillaum's avatar
bguillaum committed
153
  Rewrite_history.save_html 
154
155
    ?main_feat
    ~out_gr
bguillaum's avatar
bguillaum committed
156
157
    ~init_graph: (not no_init)
    ~header
158
    ~graph_file
bguillaum's avatar
bguillaum committed
159
160
    output_base rew_hist
    )
161
162
163
ELSE
    Log.critical "[write_html] The \"libcaml-grew\" library is compiled without Dep2pict"
ENDIF
164
165
166
167
168
169

let error_html 
    ?(no_init=false) ?main_feat 
    ~header
    msg ?init
    output_base =
170
IFDEF DEP2PICT THEN
171
172
173
174
175
176
177
  ignore (
  Rewrite_history.error_html 
    ?main_feat 
    ~init_graph: (not no_init)
    ~header
    output_base msg init
    )
178
ELSE
bguillaum's avatar
bguillaum committed
179
    Log.critical "[error_html] The \"libcaml-grew\" library is compiled without Dep2pict"
180
ENDIF
181

182
let make_index ~title ~grs_file ~html ~grs ~seq ~input_dir ~output_dir ~base_names  =
bguillaum's avatar
bguillaum committed
183
  let init = Corpus_stat.empty grs seq in
bguillaum's avatar
bguillaum committed
184
185
186
187
188
  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
189
  Corpus_stat.save_html title grs_file input_dir output_dir corpus_stat
bguillaum's avatar
bguillaum committed
190

pj2m's avatar
pj2m committed
191
192
let get_css_file = Filename.concat DATA_DIR "style.css"

bguillaum's avatar
bguillaum committed
193
let graph_of_instance instance = instance.Instance.graph