libgrew.ml 14.5 KB
Newer Older
bguillaum's avatar
bguillaum committed
1 2 3 4 5 6 7 8 9 10
(**********************************************************************************)
(*    Libcaml-grew - a Graph Rewriting library dedicated to NLP applications      *)
(*                                                                                *)
(*    Copyright 2011-2013 Inria, Université de Lorraine                           *)
(*                                                                                *)
(*    Webpage: http://grew.loria.fr                                               *)
(*    License: CeCILL (see LICENSE folder or "http://www.cecill.info")            *)
(*    Authors: see AUTHORS file                                                   *)
(**********************************************************************************)

bguillaum's avatar
bguillaum committed
11
open Printf
pj2m's avatar
pj2m committed
12
open Log
13
open Conll
pj2m's avatar
pj2m committed
14

bguillaum's avatar
bguillaum committed
15

bguillaum's avatar
bguillaum committed
16
(* ==================================================================================================== *)
bguillaum's avatar
bguillaum committed
17
(** {2 Location} *)
bguillaum's avatar
bguillaum committed
18 19 20 21 22 23 24
(* ==================================================================================================== *)
module Loc = struct
  type t = Grew_base.Loc.t
  let to_string = Grew_base.Loc.to_string
end

(* ==================================================================================================== *)
bguillaum's avatar
bguillaum committed
25
(** {2 Exceptions} *)
bguillaum's avatar
bguillaum committed
26
(* ==================================================================================================== *)
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
module Libgrew = struct
  let get_version () = VERSION

  let set_debug_mode flag = Grew_base.Global.debug := flag

  exception Error of string
  exception Bug of string

  let handle ?(name="") ?(file="No file defined") fct () =
    try fct () with
      (* Raise again already caught exceptions *)
      | Error msg -> raise (Error msg)
      | Bug msg -> raise (Bug msg)

      (* Catch new exceptions *)
      | Grew_base.Error.Parse (msg, Some loc) -> raise (Error (sprintf "%s %s" (Grew_base.Loc.to_string loc) msg))
      | Grew_base.Error.Parse (msg, None) -> raise (Error (sprintf "%s" msg))
      | Grew_base.Error.Build (msg, Some loc) -> raise (Error (sprintf "%s %s" (Grew_base.Loc.to_string loc) msg))
      | Grew_base.Error.Build (msg, None) -> raise (Error (sprintf "%s" msg))
      | Grew_base.Error.Run (msg, Some loc) -> raise (Error (sprintf "%s %s" (Grew_base.Loc.to_string loc) msg))
      | Grew_base.Error.Run (msg, None) -> raise (Error (sprintf "%s" msg))
      | Conll_types.Error msg -> raise (Error (sprintf "Conll error: %s" (Yojson.Basic.to_string msg)))

      | Grew_base.Error.Bug (msg, Some loc) -> raise (Bug (sprintf "%s %s" (Grew_base.Loc.to_string loc) msg))
      | Grew_base.Error.Bug (msg, None) -> raise (Bug (sprintf "%s" msg))
      | exc -> raise (Bug (sprintf "[Libgrew.%s] UNCAUGHT EXCEPTION: %s" name (Printexc.to_string exc)))
end
bguillaum's avatar
bguillaum committed
54

bguillaum's avatar
bguillaum committed
55
(* ==================================================================================================== *)
56
(** {2 Domain} *)
bguillaum's avatar
bguillaum committed
57 58
(* ==================================================================================================== *)
module Domain = struct
59
  type t = Grew_domain.Domain.t
60

61
  let load filename =
62
    Libgrew.handle ~name:"Domain.load"
63 64
      (fun () ->
      let ast = Grew_loader.Loader.domain filename in
65
      Grew_grs.Old_grs.domain_build ast
66 67 68
      ) ()

  let feature_names domain =
69
    Libgrew.handle ~name:"Domain.feature_names"
70 71
      (fun () -> Grew_domain.Domain.feature_names domain)
      ()
72 73

  let dump domain =
74
    Libgrew.handle ~name:"Domain.dump"
75 76 77
      (fun () -> Grew_domain.Domain.dump domain)
      ()

bguillaum's avatar
bguillaum committed
78 79 80 81 82 83 84 85
end

(* ==================================================================================================== *)
(** {2 Patterns} *)
(* ==================================================================================================== *)
module Pattern = struct
  type t = Grew_rule.Rule.pattern

bguillaum's avatar
bguillaum committed
86
  let load ?domain file =
87
  Libgrew.handle ~name:"Pattern.load" (fun () -> Grew_rule.Rule.build_pattern ?domain (Grew_loader.Loader.pattern file)) ()
88 89

  let parse ?domain desc =
90
  Libgrew.handle ~name:"Pattern.load" (fun () -> Grew_rule.Rule.build_pattern ?domain (Grew_loader.Parser.pattern desc)) ()
91

92
  let pid_name_list pattern =
93
  Libgrew.handle ~name:"Pattern.pid_lits"
94
    (fun () -> List.map (fun x -> x) (Grew_rule.Rule.pid_name_list pattern)
95
    ) ()
bguillaum's avatar
bguillaum committed
96 97 98 99 100 101 102
end

(* ==================================================================================================== *)
(** {2 Matching} *)
(* ==================================================================================================== *)
module Matching = struct
  type t = Grew_rule.Rule.matching
103 104

  let to_python pattern graph t = Grew_rule.Rule.to_python pattern graph t
bguillaum's avatar
bguillaum committed
105 106 107 108 109 110 111 112 113 114 115
end

(* ==================================================================================================== *)
(** {2 Deco} *)
(* ==================================================================================================== *)
module Deco = struct
  type t = Grew_graph.G_deco.t
  let build pattern matching = Grew_rule.Rule.match_deco pattern matching
end

(* ==================================================================================================== *)
bguillaum's avatar
bguillaum committed
116
(** {2 Graph} *)
bguillaum's avatar
bguillaum committed
117 118
(* ==================================================================================================== *)
module Graph = struct
119
  type t = Grew_graph.G_graph.t
bguillaum's avatar
bguillaum committed
120

bguillaum's avatar
bguillaum committed
121
  let load_gr ?domain file =
bguillaum's avatar
bguillaum committed
122
    if not (Sys.file_exists file)
123
    then raise (Libgrew.Error ("File_not_found: " ^ file))
bguillaum's avatar
bguillaum committed
124
    else
125
      Libgrew.handle ~name:"Graph.load_gr" ~file
bguillaum's avatar
bguillaum committed
126 127
        (fun () ->
          let gr_ast = Grew_loader.Loader.gr file in
bguillaum's avatar
bguillaum committed
128
          Grew_graph.G_graph.build ?domain gr_ast
bguillaum's avatar
bguillaum committed
129
        ) ()
bguillaum's avatar
bguillaum committed
130

bguillaum's avatar
bguillaum committed
131
  let load_conll ?domain file =
132
    Libgrew.handle ~name:"Graph.load_conll" ~file
133
      (fun () ->
bguillaum's avatar
bguillaum committed
134
        Grew_graph.G_graph.of_conll ?domain (Conll.load file)
135
      ) ()
pj2m's avatar
pj2m committed
136

bguillaum's avatar
bguillaum committed
137
  let load_brown ?domain file =
138
    Libgrew.handle ~name:"Graph.load_brown"
bguillaum's avatar
bguillaum committed
139 140
      (fun () ->
        let brown = Grew_base.File.load file in
bguillaum's avatar
bguillaum committed
141
        Grew_graph.G_graph.of_brown ?domain brown
bguillaum's avatar
bguillaum committed
142
      ) ()
143

144
  let load_pst ?domain file =
145
    if not (Sys.file_exists file)
146
    then raise (Libgrew.Error ("File_not_found: " ^ file))
147
    else
148
      Libgrew.handle ~name:"load_pst" ~file
149
        (fun () ->
150 151
          let const_ast = Grew_loader.Loader.phrase_structure_tree file in
          Grew_graph.G_graph.of_pst ?domain const_ast
152 153
        ) ()

bguillaum's avatar
bguillaum committed
154
  let load ?domain file =
155
    Libgrew.handle ~name:"Graph.load_graph" ~file
bguillaum's avatar
bguillaum committed
156 157
      (fun () ->
        match Grew_base.File.get_suffix file with
bguillaum's avatar
bguillaum committed
158 159 160
        | Some ".gr" -> load_gr ?domain file
        | Some ".conll" -> load_conll ?domain file
        | Some ".br" | Some ".melt" -> load_brown ?domain file
161
        | Some ".cst" -> load_pst ?domain file
bguillaum's avatar
bguillaum committed
162 163 164 165
        | _ ->
            Log.fwarning "Unknown file format for input graph '%s', try to guess..." file;
            let rec loop = function
            | [] -> Log.fcritical "[Libgrew.load_graph] Cannot guess input file format of file '%s'. Use .gr or .conll file extension" file
bguillaum's avatar
bguillaum committed
166
            | load_fct :: tail -> try load_fct ?domain file with _ -> loop tail in
167
            loop [load_gr; load_conll; load_brown; load_pst]
bguillaum's avatar
bguillaum committed
168
      ) ()
bguillaum's avatar
bguillaum committed
169

bguillaum's avatar
bguillaum committed
170
  let of_gr ?domain ?(grewpy=false) gr_string =
171
    Libgrew.handle ~name:"Graph.of_gr" (fun () -> Grew_graph.G_graph.build ?domain ~grewpy (Grew_loader.Parser.gr gr_string)) ()
172

bguillaum's avatar
bguillaum committed
173
  let of_conll ?domain conll =
174
    Libgrew.handle ~name:"Graph.of_conll" (fun () -> Grew_graph.G_graph.of_conll ?domain conll) ()
175

176
  let of_pst ?domain pst_string =
177
    Libgrew.handle ~name:"of_pst"
178
      (fun () ->
179 180 181 182 183
        let pst_ast = Grew_loader.Parser.phrase_structure_tree pst_string in
        (Grew_graph.G_graph.of_pst ?domain pst_ast)
      ) ()

  let sentence_of_pst ?domain pst_string =
184
    Libgrew.handle ~name:"of_pst"
185 186 187 188
      (fun () ->
        let pst_ast = Grew_loader.Parser.phrase_structure_tree pst_string in
        let word_list = Grew_ast.Ast.word_list pst_ast in
        Sentence.fr_clean_spaces (String.concat " " word_list)
189 190
      ) ()

bguillaum's avatar
bguillaum committed
191
  let of_brown ?domain ?sentid brown =
192
    Libgrew.handle ~name:"Graph.of_brown" (fun () -> Grew_graph.G_graph.of_brown ?domain ?sentid brown) ()
bguillaum's avatar
bguillaum committed
193

194
  let to_dot ?main_feat ?(deco=Grew_graph.G_deco.empty) graph =
195
    Libgrew.handle ~name:"Graph.to_dot" (fun () -> Grew_graph.G_graph.to_dot ?main_feat graph ~deco) ()
bguillaum's avatar
bguillaum committed
196

197
  let to_dep ?filter ?main_feat ?(deco=Grew_graph.G_deco.empty) graph =
198
    Libgrew.handle ~name:"Graph.to_dep" (fun () -> Grew_graph.G_graph.to_dep ?filter ?main_feat ~deco graph) ()
bguillaum's avatar
bguillaum committed
199

200
  let to_gr graph =
201
    Libgrew.handle ~name:"Graph.to_gr" (fun () -> Grew_graph.G_graph.to_gr graph) ()
bguillaum's avatar
bguillaum committed
202

203
  let to_conll graph =
204
    Libgrew.handle ~name:"Graph.to_conll" (fun () -> Grew_graph.G_graph.to_conll graph) ()
205

206
  let to_conll_string graph =
207
    Libgrew.handle ~name:"Graph.to_conll_string" (fun () -> Grew_graph.G_graph.to_conll_string graph) ()
bguillaum's avatar
bguillaum committed
208

209
  let to_sentence ?main_feat ?deco gr =
210
    Libgrew.handle ~name:"Graph.to_sentence"
bguillaum's avatar
bguillaum committed
211
      (fun () ->
212
        Grew_graph.G_graph.to_sentence ?main_feat ?deco gr
bguillaum's avatar
bguillaum committed
213
      ) ()
bguillaum's avatar
bguillaum committed
214

215
  let save_conll filename graph =
216
    Libgrew.handle ~name:"Graph.save_conll" (fun () ->
bguillaum's avatar
bguillaum committed
217
      let out_ch = open_out filename in
218
      fprintf out_ch "%s" (Grew_graph.G_graph.to_conll_string graph);
bguillaum's avatar
bguillaum committed
219
      close_out out_ch
bguillaum's avatar
bguillaum committed
220 221
    ) ()

222
  let search_pattern ?domain pattern graph =
223
    Libgrew.handle ~name:"Graph.search_pattern" (fun () ->
224 225
      Grew_rule.Rule.match_in_graph ?domain pattern graph
    ) ()
226

227
  let node_matching pattern graph matching =
228
    Libgrew.handle ~name:"Graph.node_matching" (fun () ->
229 230
      Grew_rule.Rule.node_matching pattern graph matching
    ) ()
bguillaum's avatar
bguillaum committed
231
end
232

bguillaum's avatar
bguillaum committed
233
(* ==================================================================================================== *)
234
(** {2 Graph Rewriting System} *)
bguillaum's avatar
bguillaum committed
235
(* ==================================================================================================== *)
236 237
module Old_grs = struct
  type t = Grew_grs.Old_grs.t
238

239
  let empty = Grew_grs.Old_grs.empty
240

bguillaum's avatar
bguillaum committed
241
  let load file =
242
    Libgrew.handle ~name:"Old_grs.load" ~file
bguillaum's avatar
bguillaum committed
243 244
      (fun () ->
        if not (Sys.file_exists file)
245
        then raise (Libgrew.Error ("File_not_found: " ^ file))
246
        else Grew_grs.Old_grs.build file
bguillaum's avatar
bguillaum committed
247
      ) ()
248

bguillaum's avatar
bguillaum committed
249
  let get_sequence_names grs =
250
    Libgrew.handle ~name:"Old_grs.get_sequence_names"
bguillaum's avatar
bguillaum committed
251
      (fun () ->
252
        Grew_grs.Old_grs.sequence_names grs
bguillaum's avatar
bguillaum committed
253
      ) ()
254

255
  let get_domain grs = Grew_grs.Old_grs.get_domain grs
256 257

  let to_json t =
258
    let json = Grew_grs.Old_grs.to_json t in
259
    Yojson.Basic.pretty_to_string json
bguillaum's avatar
bguillaum committed
260 261
end

262 263 264
(* ==================================================================================================== *)
(** {2 New Graph Rewriting System} *)
(* ==================================================================================================== *)
265 266
module Grs = struct
  type t = Grew_grs.Grs.t
267 268

  let load file =
269
    Libgrew.handle ~name:"Grs.load" ~file
270
      (fun () ->
Bruno Guillaume's avatar
Bruno Guillaume committed
271 272 273 274
        Grew_grs.Grs.load file
      ) ()

  let load_old file =
275
    Libgrew.handle ~name:"Grs.load" ~file
Bruno Guillaume's avatar
Bruno Guillaume committed
276 277
      (fun () ->
        Grew_grs.Grs.load_old file
278
      ) ()
279 280

  let dump grs =
281
    Libgrew.handle ~name:"Grs.dump"
282
      (fun () ->
283
        Grew_grs.Grs.dump grs
284 285 286
      ) ()

  let domain grs =
287
    Libgrew.handle ~name:"Grs.domain"
288
      (fun () ->
289
        Grew_grs.Grs.domain grs
290
      ) ()
291

Bruno Guillaume's avatar
Bruno Guillaume committed
292 293 294
  let to_json t =
    let json = Grew_grs.Grs.to_json t in
      Yojson.Basic.pretty_to_string json
295 296

  let get_strat_list grs =
297
    Libgrew.handle ~name:"Grs.get_strat_list"
298
      (fun () ->
299
        Grew_grs.Grs.get_strat_list grs
300
        ) ()
301 302
end

bguillaum's avatar
bguillaum committed
303 304 305 306 307 308 309
(* ==================================================================================================== *)
(** {2 Rewrite} *)
(* ==================================================================================================== *)
module Rewrite = struct
  type display = Libgrew_types.rew_display
  type history = Grew_grs.Rewrite_history.t

310 311
  let size = Libgrew_types.rew_display_size

312 313 314
  let set_max_depth_det value = Grew_rule.Rule.set_max_depth_det value
  let set_max_depth_non_det value = Grew_rule.Rule.set_max_depth_non_det value

bguillaum's avatar
bguillaum committed
315 316
  let set_debug_loop () = Grew_rule.Rule.set_debug_loop ()

317
  let old_old_display ~gr ~grs ~seq =
318
    Libgrew.handle ~name:"Rewrite.old_old_display" (fun () -> Grew_grs.Old_grs.build_rew_display grs seq gr) ()
319 320

  let old_display ~gr ~grs ~strat =
321
    Libgrew.handle ~name:"Rewrite.old_display" (fun () -> Grew_grs.Grs.det_rew_display grs strat gr) ()
bguillaum's avatar
bguillaum committed
322

323
  let display ~gr ~grs ~strat =
324
    Libgrew.handle ~name:"Rewrite.display" (fun () -> Grew_grs.Grs.wrd_rewrite grs strat gr) ()
325

bguillaum's avatar
bguillaum committed
326 327 328
  let set_timeout t = Grew_base.Timeout.timeout := t

  let rewrite ~gr ~grs ~seq =
329
    Libgrew.handle ~name:"Rewrite.rewrite" (fun () -> Grew_grs.Old_grs.rewrite grs seq gr) ()
330 331

  let old_simple_rewrite ~gr ~grs ~strat =
332
    Libgrew.handle ~name:"Rewrite.old_simple_rewrite" (fun () -> Grew_grs.Old_grs.simple_rewrite grs strat gr) ()
bguillaum's avatar
bguillaum committed
333

334
  let simple_rewrite ~gr ~grs ~strat =
335
    Libgrew.handle ~name:"Rewrite.simple_rewrite" (fun () -> Grew_grs.Grs.gwh_simple_rewrite grs strat gr) ()
336

337
  let at_least_one ~grs ~strat =
338
    Libgrew.handle ~name:"Rewrite.at_least_one" (fun () -> Grew_grs.Grs.at_least_one grs strat) ()
339
  let at_most_one ~grs ~strat =
340
    Libgrew.handle ~name:"Rewrite.at_most_one" (fun () -> Grew_grs.Grs.at_most_one grs strat) ()
341

bguillaum's avatar
bguillaum committed
342
  let is_empty rh =
343
    Libgrew.handle ~name:"Rewrite.is_empty" (fun () -> Grew_grs.Rewrite_history.is_empty rh) ()
bguillaum's avatar
bguillaum committed
344 345

  let num_sol rh =
346
    Libgrew.handle ~name:"Rewrite.num_sol" (fun () -> Grew_grs.Rewrite_history.num_sol rh) ()
bguillaum's avatar
bguillaum committed
347 348

  let save_index ~dirname ~base_names =
349
    Libgrew.handle ~name:"Rewrite.save_index" (fun () ->
bguillaum's avatar
bguillaum committed
350
      let out_ch = open_out (Filename.concat dirname "index") in
351
      Array.iter (fun f -> fprintf out_ch "%s\n" f) base_names;
bguillaum's avatar
bguillaum committed
352
      close_out out_ch
353 354
    ) ()

355
  let save_gr base rew_hist =
356
    Libgrew.handle ~name:"Rewrite.save_gr" (fun () -> Grew_grs.Rewrite_history.save_gr base rew_hist) ()
bguillaum's avatar
bguillaum committed
357

358
  let save_conll base rew_hist =
359
    Libgrew.handle ~name:"Rewrite.save_conll" (fun () -> Grew_grs.Rewrite_history.save_conll base rew_hist) ()
bguillaum's avatar
bguillaum committed
360

361
  let save_full_conll base rew_hist =
362
    Libgrew.handle ~name:"Rewrite.save_full_conll" (fun () -> Grew_grs.Rewrite_history.save_full_conll base rew_hist) ()
bguillaum's avatar
bguillaum committed
363

364
  let save_det_gr base rew_hist =
365
    Libgrew.handle ~name:"Rewrite.save_det_gr" (fun () -> Grew_grs.Rewrite_history.save_det_gr base rew_hist) ()
bguillaum's avatar
bguillaum committed
366

367
  let save_det_conll ?header base rew_hist =
368
    Libgrew.handle ~name:"Rewrite.save_det_conll" (fun () -> Grew_grs.Rewrite_history.save_det_conll ?header base rew_hist) ()
bguillaum's avatar
bguillaum committed
369

370
  let det_dep_string rew_hist =
371
    Libgrew.handle ~name:"Rewrite.det_dep_string" (fun () -> Grew_grs.Rewrite_history.det_dep_string rew_hist) ()
bguillaum's avatar
bguillaum committed
372

373
  let conll_dep_string ?keep_empty_rh rew_hist =
374
    Libgrew.handle ~name:"Rewrite.conll_dep_string" (fun () -> Grew_grs.Rewrite_history.conll_dep_string ?keep_empty_rh rew_hist) ()
bguillaum's avatar
bguillaum committed
375
end