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
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 106

  let to_python 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
      ) ()

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

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

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

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

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

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

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

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

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

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

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

241
  let empty = Grew_grs.Old_grs.empty
242

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

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

257
  let get_domain grs = Grew_grs.Old_grs.get_domain grs
258 259

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

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

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

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

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

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

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

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

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

312 313
  let size = Libgrew_types.rew_display_size

314 315 316
  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
317 318
  let set_debug_loop () = Grew_rule.Rule.set_debug_loop ()

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

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

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

bguillaum's avatar
bguillaum committed
328 329 330
  let set_timeout t = Grew_base.Timeout.timeout := t

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

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

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

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

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

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

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

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

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

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

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

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

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

375
  let conll_dep_string ?keep_empty_rh rew_hist =
376
    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
377
end