libgrew.ml 14 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
let libgrew_debug_mode () = Grew_base.Global.debug := true
bguillaum's avatar
bguillaum committed
16
let get_version () = VERSION
bguillaum's avatar
bguillaum committed
17

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

(* ==================================================================================================== *)
bguillaum's avatar
bguillaum committed
27
(** {2 Exceptions} *)
bguillaum's avatar
bguillaum committed
28
(* ==================================================================================================== *)
29 30
exception Error of string
exception Bug of string
pj2m's avatar
pj2m committed
31

32 33
let handle ?(name="") ?(file="No file defined") fct () =
  try fct () with
bguillaum's avatar
typo  
bguillaum committed
34
    (* Raise again already caught exceptions *)
35 36
    | Error msg -> raise (Error msg)
    | Bug msg -> raise (Bug msg)
37 38

    (* Catch new exceptions *)
39 40 41 42 43 44
    | 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))
Bruno Guillaume's avatar
Bruno Guillaume committed
45
    | Conll_types.Error msg -> raise (Error (sprintf "Conll error: %s" (Yojson.Basic.to_string msg)))
46

47
    | Grew_base.Error.Bug (msg, Some loc) -> raise (Bug (sprintf "%s %s" (Grew_base.Loc.to_string loc) msg))
48 49
    | 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)))
pj2m's avatar
pj2m committed
50

bguillaum's avatar
bguillaum committed
51

bguillaum's avatar
bguillaum committed
52
(* ==================================================================================================== *)
53
(** {2 Domain} *)
bguillaum's avatar
bguillaum committed
54 55
(* ==================================================================================================== *)
module Domain = struct
56
  type t = Grew_domain.Domain.t
57

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

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

  let dump domain =
    handle ~name:"Domain.dump"
      (fun () -> Grew_domain.Domain.dump domain)
      ()

bguillaum's avatar
bguillaum committed
75 76 77 78 79 80 81 82
end

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

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

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

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

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

  let to_python pattern graph t = Grew_rule.Rule.to_python pattern graph t
bguillaum's avatar
bguillaum committed
102 103 104 105 106 107 108 109 110 111 112
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
113
(** {2 Graph} *)
bguillaum's avatar
bguillaum committed
114 115 116 117 118 119
(* ==================================================================================================== *)
module Graph = struct


type t = Grew_graph.G_graph.t

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

238
  let empty = Grew_grs.Old_grs.empty
239

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

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

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

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

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

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

  let load_old file =
    handle ~name:"Grs.load" ~file
      (fun () ->
        Grew_grs.Grs.load_old file
277
      ) ()
278 279

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

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

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

  let get_strat_list grs =
296
    handle ~name:"Grs.get_strat_list"
297
      (fun () ->
298
        Grew_grs.Grs.get_strat_list grs
299 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 318
  let old_display ~gr ~grs ~seq =
    handle ~name:"Rewrite.old_display" (fun () -> Grew_grs.Old_grs.build_rew_display grs seq gr) ()
bguillaum's avatar
bguillaum committed
319

320 321
  let display ~gr ~grs ~strat =
    handle ~name:"Rewrite.display" (fun () -> Grew_grs.Grs.det_rew_display grs strat gr) ()
322

bguillaum's avatar
bguillaum committed
323 324 325
  let set_timeout t = Grew_base.Timeout.timeout := t

  let rewrite ~gr ~grs ~seq =
326 327 328 329
    handle ~name:"Rewrite.rewrite" (fun () -> Grew_grs.Old_grs.rewrite grs seq gr) ()

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

331 332 333
  let simple_rewrite ~gr ~grs ~strat =
    handle ~name:"Rewrite.simple_rewrite" (fun () -> Grew_grs.Grs.simple_rewrite grs strat gr) ()

334
  let at_least_one ~grs ~strat =
335
    handle ~name:"Rewrite.at_least_one" (fun () -> Grew_grs.Grs.at_least_one grs strat) ()
336
  let at_most_one ~grs ~strat =
337
    handle ~name:"Rewrite.at_most_one" (fun () -> Grew_grs.Grs.at_most_one grs strat) ()
338

Bruno Guillaume's avatar
Bruno Guillaume committed
339

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

  let num_sol rh =
    handle ~name:"Rewrite.num_sol" (fun () -> Grew_grs.Rewrite_history.num_sol rh) ()

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

bguillaum's avatar
bguillaum committed
353 354
  let save_gr ?domain base rew_hist =
    handle ~name:"Rewrite.save_gr" (fun () -> Grew_grs.Rewrite_history.save_gr ?domain base rew_hist) ()
bguillaum's avatar
bguillaum committed
355

bguillaum's avatar
bguillaum committed
356 357
  let save_conll ?domain base rew_hist =
    handle ~name:"Rewrite.save_conll" (fun () -> Grew_grs.Rewrite_history.save_conll ?domain base rew_hist) ()
bguillaum's avatar
bguillaum committed
358

bguillaum's avatar
bguillaum committed
359 360
  let save_full_conll ?domain base rew_hist =
    handle ~name:"Rewrite.save_full_conll" (fun () -> Grew_grs.Rewrite_history.save_full_conll ?domain base rew_hist) ()
bguillaum's avatar
bguillaum committed
361

bguillaum's avatar
bguillaum committed
362 363
  let save_det_gr ?domain base rew_hist =
    handle ~name:"Rewrite.save_det_gr" (fun () -> Grew_grs.Rewrite_history.save_det_gr ?domain base rew_hist) ()
bguillaum's avatar
bguillaum committed
364

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

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

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