libgrew.ml 14.8 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
module Libgrew = struct
  let get_version () = VERSION

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

32 33
  let set_safe_commands flag = Grew_base.Global.safe_commands := flag

34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55
  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
56

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

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

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

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

bguillaum's avatar
bguillaum committed
80 81 82 83 84 85 86 87
end

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

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

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

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

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

Bruno Guillaume's avatar
Bruno Guillaume committed
106
  let to_json pattern graph t = Grew_rule.Rule.to_python pattern graph t
bguillaum's avatar
bguillaum committed
107 108 109 110 111 112 113 114 115 116 117
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
118
(** {2 Graph} *)
bguillaum's avatar
bguillaum committed
119 120
(* ==================================================================================================== *)
module Graph = struct
121
  type t = Grew_graph.G_graph.t
bguillaum's avatar
bguillaum committed
122

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

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

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

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

bguillaum's avatar
bguillaum committed
156
  let load ?domain file =
157
    Libgrew.handle ~name:"Graph.load_graph" ~file
bguillaum's avatar
bguillaum committed
158 159
      (fun () ->
        match Grew_base.File.get_suffix file with
bguillaum's avatar
bguillaum committed
160 161 162
        | Some ".gr" -> load_gr ?domain file
        | Some ".conll" -> load_conll ?domain file
        | Some ".br" | Some ".melt" -> load_brown ?domain file
163
        | Some ".cst" -> load_pst ?domain file
bguillaum's avatar
bguillaum committed
164 165 166 167
        | _ ->
            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
168
            | load_fct :: tail -> try load_fct ?domain file with _ -> loop tail in
169
            loop [load_gr; load_conll; load_brown; load_pst]
bguillaum's avatar
bguillaum committed
170
      ) ()
bguillaum's avatar
bguillaum committed
171

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

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

178
  let of_pst ?domain pst_string =
179
    Libgrew.handle ~name:"of_pst"
180
      (fun () ->
181 182 183 184 185
        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 =
186
    Libgrew.handle ~name:"of_pst"
187 188 189 190
      (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)
191 192
      ) ()

Bruno Guillaume's avatar
Bruno Guillaume committed
193 194 195
  let of_json json =
    Libgrew.handle ~name:"Graph.of_json" (fun () -> Grew_graph.G_graph.of_json json) ()

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

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

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

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

Bruno Guillaume's avatar
Bruno Guillaume committed
208 209 210
  let to_json graph =
    Libgrew.handle ~name:"Graph.to_json" (fun () -> Grew_graph.G_graph.to_json graph) ()

211
  let to_conll graph =
212
    Libgrew.handle ~name:"Graph.to_conll" (fun () -> Grew_graph.G_graph.to_conll graph) ()
213

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

217
  let to_sentence ?main_feat ?deco gr =
218
    Libgrew.handle ~name:"Graph.to_sentence"
bguillaum's avatar
bguillaum committed
219
      (fun () ->
220
        Grew_graph.G_graph.to_sentence ?main_feat ?deco gr
bguillaum's avatar
bguillaum committed
221
      ) ()
bguillaum's avatar
bguillaum committed
222

223
  let save_conll filename graph =
224
    Libgrew.handle ~name:"Graph.save_conll" (fun () ->
bguillaum's avatar
bguillaum committed
225
      let out_ch = open_out filename in
226
      fprintf out_ch "%s" (Grew_graph.G_graph.to_conll_string graph);
bguillaum's avatar
bguillaum committed
227
      close_out out_ch
bguillaum's avatar
bguillaum committed
228 229
    ) ()

230
  let search_pattern ?domain pattern graph =
231
    Libgrew.handle ~name:"Graph.search_pattern" (fun () ->
232 233
      Grew_rule.Rule.match_in_graph ?domain pattern graph
    ) ()
234

235
  let node_matching pattern graph matching =
236
    Libgrew.handle ~name:"Graph.node_matching" (fun () ->
237 238
      Grew_rule.Rule.node_matching pattern graph matching
    ) ()
bguillaum's avatar
bguillaum committed
239
end
240

bguillaum's avatar
bguillaum committed
241
(* ==================================================================================================== *)
242
(** {2 Graph Rewriting System} *)
bguillaum's avatar
bguillaum committed
243
(* ==================================================================================================== *)
244 245
module Old_grs = struct
  type t = Grew_grs.Old_grs.t
246

247
  let empty = Grew_grs.Old_grs.empty
248

bguillaum's avatar
bguillaum committed
249
  let load file =
250
    Libgrew.handle ~name:"Old_grs.load" ~file
bguillaum's avatar
bguillaum committed
251 252
      (fun () ->
        if not (Sys.file_exists file)
253
        then raise (Libgrew.Error ("File_not_found: " ^ file))
254
        else Grew_grs.Old_grs.build file
bguillaum's avatar
bguillaum committed
255
      ) ()
256

bguillaum's avatar
bguillaum committed
257
  let get_sequence_names grs =
258
    Libgrew.handle ~name:"Old_grs.get_sequence_names"
bguillaum's avatar
bguillaum committed
259
      (fun () ->
260
        Grew_grs.Old_grs.sequence_names grs
bguillaum's avatar
bguillaum committed
261
      ) ()
262

263
  let get_domain grs = Grew_grs.Old_grs.get_domain grs
264 265

  let to_json t =
266
    let json = Grew_grs.Old_grs.to_json t in
267
    Yojson.Basic.pretty_to_string json
bguillaum's avatar
bguillaum committed
268 269
end

270 271 272
(* ==================================================================================================== *)
(** {2 New Graph Rewriting System} *)
(* ==================================================================================================== *)
273 274
module Grs = struct
  type t = Grew_grs.Grs.t
275 276

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

  let load_old file =
283
    Libgrew.handle ~name:"Grs.load" ~file
Bruno Guillaume's avatar
Bruno Guillaume committed
284 285
      (fun () ->
        Grew_grs.Grs.load_old file
286
      ) ()
287 288

  let dump grs =
289
    Libgrew.handle ~name:"Grs.dump"
290
      (fun () ->
291
        Grew_grs.Grs.dump grs
292 293 294
      ) ()

  let domain grs =
295
    Libgrew.handle ~name:"Grs.domain"
296
      (fun () ->
297
        Grew_grs.Grs.domain grs
298
      ) ()
299

Bruno Guillaume's avatar
Bruno Guillaume committed
300 301 302 303 304
  let to_json grs =
    Libgrew.handle ~name:"Grs.to_json"
      (fun () ->
        Grew_grs.Grs.to_json grs
      ) ()
305 306

  let get_strat_list grs =
307
    Libgrew.handle ~name:"Grs.get_strat_list"
308
      (fun () ->
309
        Grew_grs.Grs.get_strat_list grs
310
        ) ()
311 312
end

bguillaum's avatar
bguillaum committed
313 314 315 316 317 318 319
(* ==================================================================================================== *)
(** {2 Rewrite} *)
(* ==================================================================================================== *)
module Rewrite = struct
  type display = Libgrew_types.rew_display
  type history = Grew_grs.Rewrite_history.t

320 321
  let size = Libgrew_types.rew_display_size

322 323 324
  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
325 326
  let set_debug_loop () = Grew_rule.Rule.set_debug_loop ()

327
  let old_old_display ~gr ~grs ~seq =
328
    Libgrew.handle ~name:"Rewrite.old_old_display" (fun () -> Grew_grs.Old_grs.build_rew_display grs seq gr) ()
329 330

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

333
  let display ~gr ~grs ~strat =
334
    Libgrew.handle ~name:"Rewrite.display" (fun () -> Grew_grs.Grs.wrd_rewrite grs strat gr) ()
335

bguillaum's avatar
bguillaum committed
336 337 338
  let set_timeout t = Grew_base.Timeout.timeout := t

  let rewrite ~gr ~grs ~seq =
339
    Libgrew.handle ~name:"Rewrite.rewrite" (fun () -> Grew_grs.Old_grs.rewrite grs seq gr) ()
340 341

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

344
  let simple_rewrite ~gr ~grs ~strat =
345
    Libgrew.handle ~name:"Rewrite.simple_rewrite" (fun () -> Grew_grs.Grs.gwh_simple_rewrite grs strat gr) ()
346

347
  let at_least_one ~grs ~strat =
348
    Libgrew.handle ~name:"Rewrite.at_least_one" (fun () -> Grew_grs.Grs.at_least_one grs strat) ()
349
  let at_most_one ~grs ~strat =
350
    Libgrew.handle ~name:"Rewrite.at_most_one" (fun () -> Grew_grs.Grs.at_most_one grs strat) ()
351

bguillaum's avatar
bguillaum committed
352
  let is_empty rh =
353
    Libgrew.handle ~name:"Rewrite.is_empty" (fun () -> Grew_grs.Rewrite_history.is_empty rh) ()
bguillaum's avatar
bguillaum committed
354 355

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

  let save_index ~dirname ~base_names =
359
    Libgrew.handle ~name:"Rewrite.save_index" (fun () ->
bguillaum's avatar
bguillaum committed
360
      let out_ch = open_out (Filename.concat dirname "index") in
361
      Array.iter (fun f -> fprintf out_ch "%s\n" f) base_names;
bguillaum's avatar
bguillaum committed
362
      close_out out_ch
363 364
    ) ()

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

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

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

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

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

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

383
  let conll_dep_string ?keep_empty_rh rew_hist =
384
    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
385
end