add function Matching.to_python, add G_node.get_name

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@9111 7838e531-6607-4d57-9587-6c381814729c

src/grew_graph.ml

@@ -298,7 +298,7 @@ module G_graph = struct
         else
           let (new_tail, table) = loop (node_id :: already_bound) (index+1) (Some index) tail in
           let succ = if tail = [] then None else Some (index+1) in
-          let (_,new_node) = G_node.build ?domain ?prec ?succ index (ast_node, loc) in
+          let new_node = G_node.build ?domain ?prec ?succ index (ast_node, loc) in
             (
               Gid_map.add index new_node new_tail,
               (node_id,index)::table

src/grew_loader.ml

@@ -35,7 +35,7 @@ module Loader = struct
       let grs = parse_handle file (Grew_parser.grs_wi Grew_lexer.global) lexbuf in
       close_in in_ch;
       grs
-    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.parse_file_to_grs_wi] %s" msg
+    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.parse_file_to_grs_wi] %s" msg
 
   (* ------------------------------------------------------------------------------------------*)
   let parse_file_to_module_list file =
@@ -46,7 +46,7 @@ module Loader = struct
       let module_list = parse_handle file (Grew_parser.included Grew_lexer.global) lexbuf in
       close_in in_ch;
       module_list
-    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.parse_file_to_module_list] %s" msg
+    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.parse_file_to_module_list] %s" msg
 
   (* ------------------------------------------------------------------------------------------*)
   let domain file =
@@ -57,7 +57,7 @@ module Loader = struct
       let gr = parse_handle file (Grew_parser.domain Grew_lexer.global) lexbuf in
       close_in in_ch;
       gr
-    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.domain] %s" msg
+    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.domain] %s" msg
 
   (* ------------------------------------------------------------------------------------------*)
   (**
@@ -98,7 +98,7 @@ module Loader = struct
       let gr = parse_handle file (Grew_parser.gr Grew_lexer.global) lexbuf in
       close_in in_ch;
       gr
-    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.gr] %s" msg
+    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.gr] %s" msg
 
 
   (* ------------------------------------------------------------------------------------------*)
@@ -107,10 +107,10 @@ module Loader = struct
       Global.init file;
       let in_ch = open_in file in
       let lexbuf = Lexing.from_channel in_ch in
-      let gr = parse_handle file (Grew_parser.pattern Grew_lexer.global) lexbuf in
+      let pattern = parse_handle file (Grew_parser.pattern Grew_lexer.global) lexbuf in
       close_in in_ch;
-      gr
-    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.pattern] %s" msg
+      pattern
+    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.pattern] %s" msg
 
   (* ------------------------------------------------------------------------------------------*)
   let phrase_structure_tree file =
@@ -121,7 +121,7 @@ module Loader = struct
       let graph = parse_handle file (Grew_parser.phrase_structure_tree Grew_lexer.const) lexbuf in
       close_in in_ch;
       graph
-    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.phrase_structure_tree] %s" msg
+    with Sys_error msg -> Error.parse ~loc:(Loc.file file) "[Grew_loader.Loader.phrase_structure_tree] %s" msg
 
 end (* module Loader *)
 
@@ -130,11 +130,11 @@ module Parser = struct
   (* ------------------------------------------------------------------------------------------*)
   let gr gr_string =
     try
-      Global.init "from_string";
+      Global.init "Not a file";
       let lexbuf = Lexing.from_string gr_string in
       let gr = parse_handle "Not a file" (Grew_parser.gr Grew_lexer.global) lexbuf in
       gr
-    with Sys_error msg -> Error.parse "[Grew_parser.gr] %s" msg
+    with Sys_error msg -> Error.parse "[Grew_loader.Parser.gr] %s" msg
 
   (* ------------------------------------------------------------------------------------------*)
   let phrase_structure_tree s =
@@ -143,6 +143,15 @@ module Parser = struct
       let lexbuf = Lexing.from_string s in
       let graph = parse_handle "Not a file" (Grew_parser.phrase_structure_tree Grew_lexer.const) lexbuf in
       graph
-    with Sys_error msg -> Error.parse "[Grew_parser.phrase_structure_tree] %s" msg
+    with Sys_error msg -> Error.parse "[Grew_loader.Parser.phrase_structure_tree] %s" msg
+
+  (* ------------------------------------------------------------------------------------------*)
+  let pattern desc =
+    try
+      Global.init "Not a file";
+      let lexbuf = Lexing.from_string desc in
+      let pattern = parse_handle "Not a file" (Grew_parser.pattern Grew_lexer.global) lexbuf in
+      pattern
+    with Sys_error msg -> Error.parse "[Grew_loader.Parser.pattern] %s" msg
 
 end

src/grew_loader.mli

@@ -28,4 +28,6 @@ module Parser : sig
   val gr: string -> Ast.gr
 
   val phrase_structure_tree: string -> Ast.pst
+
+  val pattern: string -> Ast.pattern
 end
\ No newline at end of file

src/grew_node.ml

@@ -21,6 +21,7 @@ open Grew_fs
 (* ================================================================================ *)
 module G_node = struct
   type t = {
+      name: Id.name option;
       fs: G_fs.t;
       next: G_edge.t Massoc_gid.t;
       succ: Gid.t option;
@@ -47,7 +48,11 @@ module G_node = struct
   let remove_succ t = { t with succ = None }
   let remove_prec t = { t with prec = None }
 
-  let empty = { fs = G_fs.empty; next = Massoc_gid.empty; succ = None; prec = None; position = -1.; conll_root=false }
+  let get_name gid t = match t.name with
+    | Some n -> n
+    | None -> sprintf "_%s_" (Gid.to_string gid) 
+
+  let empty = { name=None; fs = G_fs.empty; next = Massoc_gid.empty; succ = None; prec = None; position = -1.; conll_root=false }
 
   let is_conll_root t = t.conll_root
 
@@ -67,7 +72,7 @@ module G_node = struct
 
   let build ?domain ?prec ?succ position (ast_node, loc) =
     let fs = G_fs.build ?domain ast_node.Ast.fs in
-    (ast_node.Ast.node_id, { empty with fs; position = float_of_int position; prec; succ })
+    { empty with name=Some ast_node.Ast.node_id; fs; position = float_of_int position; prec; succ }
 
   let of_conll ?loc ?prec ?succ ?domain line =
     if line = Conll.root

src/grew_node.mli

@@ -41,6 +41,8 @@ module G_node: sig
   val set_position: float -> t -> t
   val set_next: G_edge.t Massoc_gid.t -> t -> t
 
+  val get_name: Gid.t -> t -> string
+
   val is_conll_root: t -> bool
 
   val remove: Gid.t -> G_edge.t -> t -> t
@@ -53,7 +55,7 @@ module G_node: sig
   val rm_out_edges: t -> t
 
   val add_edge: G_edge.t -> Gid.t -> t -> t option
-  val build: ?domain:Domain.t -> ?prec:Gid.t -> ?succ:Gid.t -> int -> Ast.node -> (Id.name * t)
+  val build: ?domain:Domain.t -> ?prec:Gid.t -> ?succ:Gid.t -> int -> Ast.node -> t
   val of_conll: ?loc:Loc.t -> ?prec:Gid.t -> ?succ:Gid.t -> ?domain:Domain.t -> Conll.line -> t
   val pst_leaf: ?loc:Loc.t -> ?domain:Domain.t -> string -> int -> t
   val pst_node: ?loc:Loc.t -> ?domain:Domain.t -> string -> int -> t

src/grew_rule.ml

@@ -438,6 +438,28 @@ module Rule = struct
       m_param: Lex_par.t option;
     }
 
+  let to_python pattern graph m =
+
+    let node_name gid =
+      let gnode = G_graph.find gid graph in
+      G_node.get_name gid gnode in
+    let buff = Buffer.create 32 in
+    bprintf buff "%s" "{ ";
+
+    Pid_map.iter
+      (fun pid gid ->
+        let pnode = P_graph.find pid (fst pattern).graph in
+        bprintf buff "\"%s\":\"%s\", " (P_node.get_name pnode) (node_name gid)
+      ) m.n_match;
+
+    List.iter
+      (fun (id, (src,lab,tar)) ->
+        bprintf buff "\"%s\":\"%s/%s:%s/%s\", " id (node_name src) id (Label.to_string lab) (node_name tar)
+      ) m.e_match;
+
+    bprintf buff "%s" "}";
+    Buffer.contents buff
+
   let node_matching pattern graph { n_match } =
     Pid_map.fold
       (fun pid gid acc ->

src/grew_rule.mli

@@ -103,6 +103,9 @@ module Rule : sig
   type matching
   type pattern
 
+
+  val to_python: pattern -> G_graph.t -> matching -> string
+
   val build_pattern: ?domain:Domain.t -> Ast.pattern -> pattern
 
   (** [node_matching pattern graph matching] return a assoc list (pid_name, gid.position) *)

src/libgrew.ml

@@ -73,6 +73,9 @@ module Pattern = struct
 
   let load ?domain file =
   handle ~name:"Pattern.load" (fun () -> Grew_rule.Rule.build_pattern ?domain (Grew_loader.Loader.pattern file)) ()
+
+  let parse ?domain desc =
+  handle ~name:"Pattern.load" (fun () -> Grew_rule.Rule.build_pattern ?domain (Grew_loader.Parser.pattern desc)) ()
 end
 
 (* ==================================================================================================== *)
@@ -80,6 +83,8 @@ end
 (* ==================================================================================================== *)
 module Matching = struct
   type t = Grew_rule.Rule.matching
+
+  let to_python pattern graph t = Grew_rule.Rule.to_python pattern graph t
 end
 
 (* ==================================================================================================== *)

src/libgrew.mli

@@ -53,6 +53,9 @@ module Pattern : sig
 
   (** [load_pattern domain filename] returns the pattern described in the file *)
   val load: ?domain:Domain.t -> string -> t
+
+  (** [load_pattern domain description] returns the pattern described in the [descriprion] string *)
+  val parse: ?domain:Domain.t -> string -> t
 end
 
 (* ==================================================================================================== *)
@@ -60,6 +63,8 @@ end
 (* ==================================================================================================== *)
 module Matching: sig
   type t
+
+  val to_python: Pattern.t -> Grew_graph.G_graph.t -> t -> string
 end
 
 (* ==================================================================================================== *)