Commit 971d5500 authored by bguillaum's avatar bguillaum

move from 'int' to 'Gid.t'/'Pid.t'... it compiles

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@7419 7838e531-6607-4d57-9587-6c381814729c
parent c00c6e36
*.cmo
*.cmi
*.o
*.cmx
*.annot
*.a
*.cma
*.cmxa
Makefile
confdefs.h
config.log
config.status
# file generated by the Makefile !
libgrew.mli
...@@ -7,8 +7,8 @@ open Grew_edge ...@@ -7,8 +7,8 @@ open Grew_edge
open Grew_fs open Grew_fs
module Command = struct module Command = struct
type pid = int (* the int in the pattern *) type pid = Pid.t
type gid = int (* the int in the graph *) type gid = Gid.t
type cnode = (* a command node is either: *) type cnode = (* a command node is either: *)
| Pid of pid (* a node identified in the pattern *) | Pid of pid (* a node identified in the pattern *)
......
...@@ -3,8 +3,8 @@ open Grew_utils ...@@ -3,8 +3,8 @@ open Grew_utils
open Grew_edge open Grew_edge
module Command : sig module Command : sig
type pid = int (* the int in the pattern *) type pid = Pid.t
type gid = int (* the int in the graph *) type gid = Gid.t
type cnode = (* a command node is either: *) type cnode = (* a command node is either: *)
| Pid of pid (* a node identified in the pattern *) | Pid of pid (* a node identified in the pattern *)
......
...@@ -10,16 +10,26 @@ open Grew_command ...@@ -10,16 +10,26 @@ open Grew_command
(* ================================================================================ *) (* ================================================================================ *)
module Deco = struct module P_deco = struct
type t = type t =
{ nodes: int list; { nodes: Pid.t list;
edges: (int * G_edge.t * int) list; edges: (Pid.t * P_edge.t * Pid.t) list;
} }
let empty = {nodes=[]; edges=[]} let empty = {nodes=[]; edges=[]}
end end
(* ================================================================================ *) (* ================================================================================ *)
(* ================================================================================ *)
module G_deco = struct
type t =
{ nodes: Gid.t list;
edges: (Gid.t * G_edge.t * Gid.t) list;
}
let empty = {nodes=[]; edges=[]}
end
(* ================================================================================ *)
(* ================================================================================ *) (* ================================================================================ *)
module P_graph = struct module P_graph = struct
...@@ -230,7 +240,7 @@ module G_graph = struct ...@@ -230,7 +240,7 @@ module G_graph = struct
let table = Array.of_list sorted_ids in let table = Array.of_list sorted_ids in
(* the nodes, in the same order *) (* the nodes, in the same order *)
let map_without_edges = List_.foldi_left (fun i acc elt -> Gid_map.add i elt acc) Gid_map.empty node_list in let map_without_edges = List_.foldi_left (fun i acc elt -> Gid_map.add (Gid.Old i) elt acc) Gid_map.empty node_list in
let map = let map =
List.fold_left List.fold_left
...@@ -238,7 +248,7 @@ module G_graph = struct ...@@ -238,7 +248,7 @@ module G_graph = struct
let i1 = Id.build ~loc ast_edge.Ast.src table in let i1 = Id.build ~loc ast_edge.Ast.src table in
let i2 = Id.build ~loc ast_edge.Ast.tar table in let i2 = Id.build ~loc ast_edge.Ast.tar table in
let edge = G_edge.build ~locals (ast_edge, loc) in let edge = G_edge.build ~locals (ast_edge, loc) in
(match map_add_edge acc i1 edge i2 with (match map_add_edge acc (Gid.Old i1) edge (Gid.Old i2) with
| Some g -> g | Some g -> g
| None -> Error.build "[GRS] [Graph.build] try to build a graph with twice the same edge %s %s" | None -> Error.build "[GRS] [Graph.build] try to build a graph with twice the same edge %s %s"
(G_edge.to_string edge) (G_edge.to_string edge)
...@@ -254,7 +264,7 @@ module G_graph = struct ...@@ -254,7 +264,7 @@ module G_graph = struct
let nodes = let nodes =
List.fold_left List.fold_left
(fun acc line -> (fun acc line ->
Gid_map.add line.Conll.num (G_node.of_conll line) acc) Gid_map.add (Gid.Old line.Conll.num) (G_node.of_conll line) acc)
Gid_map.empty lines in Gid_map.empty lines in
let nodes_with_edges = let nodes_with_edges =
...@@ -267,12 +277,12 @@ module G_graph = struct ...@@ -267,12 +277,12 @@ module G_graph = struct
then acc then acc
else else
let gov_node = let gov_node =
try Gid_map.find line.Conll.gov acc try Gid_map.find (Gid.Old line.Conll.gov) acc
with Not_found -> with Not_found ->
Error.build ?loc "[G_graph.of_conll] the line refers to unknown gov %d" line.Conll.gov in Error.build ?loc "[G_graph.of_conll] the line refers to unknown gov %d" line.Conll.gov in
match G_node.add_edge (G_edge.make ?loc line.Conll.dep_lab) line.Conll.num gov_node with match G_node.add_edge (G_edge.make ?loc line.Conll.dep_lab) (Gid.Old line.Conll.num) gov_node with
| None -> acc | None -> acc
| Some new_node -> Gid_map.add line.Conll.gov new_node acc | Some new_node -> Gid_map.add (Gid.Old line.Conll.gov) new_node acc
) nodes lines in ) nodes lines in
{map = nodes_with_edges; lub=1+(Gid_map.fold (fun _ _ acc -> acc+1) nodes_with_edges 0)} {map = nodes_with_edges; lub=1+(Gid_map.fold (fun _ _ acc -> acc+1) nodes_with_edges 0)}
...@@ -326,12 +336,15 @@ module G_graph = struct ...@@ -326,12 +336,15 @@ module G_graph = struct
let add_neighbour loc graph node_id label = let add_neighbour loc graph node_id label =
(* index is a new number (higher then lub and uniquely defined by (node_id,label) *) (* index is a new number (higher then lub and uniquely defined by (node_id,label) *)
let index = graph.lub + ((Label.to_int label) * graph.lub) + node_id in (* let index = graph.lub + ((Label.to_int label) * graph.lub) + node_id in *)
let index = match node_id with
| Gid.Old id -> Gid.New (id, Label.to_int label)
| Gid.New _ -> Error.run ~loc "[Graph.add_neighbour] try to add neighbour node to a neighbour node" in
if Gid_map.mem index graph.map if Gid_map.mem index graph.map
then Error.run ~loc "[Graph.add_neighbour] try to build twice the \"same\" neighbour node (with label '%s')" (Label.to_string label); then Error.run ~loc "[Graph.add_neighbour] try to build twice the \"same\" neighbour node (with label '%s')" (Label.to_string label);
let node = Gid_map.find node_id graph.map in let node = Gid_map.find node_id graph.map in
(* put the new node on the right of its "parent" *) (* put the new node on the right of its "parent" *)
let new_graph = {graph with map = Gid_map.add index (G_node.build_neighbour node) graph.map} in let new_graph = {graph with map = Gid_map.add index (G_node.build_neighbour node) graph.map} in
...@@ -345,7 +358,7 @@ module G_graph = struct ...@@ -345,7 +358,7 @@ module G_graph = struct
let shift_in loc graph src_gid tar_gid = let shift_in loc graph src_gid tar_gid =
let tar_node = Gid_map.find tar_gid graph.map in let tar_node = Gid_map.find tar_gid graph.map in
if Massoc.mem_key src_gid (G_node.get_next tar_node) if Massoc_gid.mem_key src_gid (G_node.get_next tar_node)
then Error.run ~loc "[Graph.shift_in] dependency from tar to src"; then Error.run ~loc "[Graph.shift_in] dependency from tar to src";
let new_map = let new_map =
...@@ -363,7 +376,7 @@ module G_graph = struct ...@@ -363,7 +376,7 @@ module G_graph = struct
let src_node = Gid_map.find src_gid graph.map in let src_node = Gid_map.find src_gid graph.map in
let tar_node = Gid_map.find tar_gid graph.map in let tar_node = Gid_map.find tar_gid graph.map in
if Massoc.mem_key tar_gid (G_node.get_next src_node) if Massoc_gid.mem_key tar_gid (G_node.get_next src_node)
then Error.run ~loc "[Graph.shift_out] dependency from src to tar"; then Error.run ~loc "[Graph.shift_out] dependency from src to tar";
let new_map = let new_map =
...@@ -386,10 +399,10 @@ module G_graph = struct ...@@ -386,10 +399,10 @@ module G_graph = struct
let src_node = Gid_map.find src_gid graph.map in let src_node = Gid_map.find src_gid graph.map in
let tar_node = Gid_map.find tar_gid graph.map in let tar_node = Gid_map.find tar_gid graph.map in
if Massoc.mem_key tar_gid (G_node.get_next src_node) if Massoc_gid.mem_key tar_gid (G_node.get_next src_node)
then Error.run ~loc "[Graph.shift_edges] dependency from src to tar"; then Error.run ~loc "[Graph.shift_edges] dependency from src to tar";
if Massoc.mem_key src_gid (G_node.get_next tar_node) if Massoc_gid.mem_key src_gid (G_node.get_next tar_node)
then Error.run ~loc "[Graph.shift_edges] dependency from tar to src"; then Error.run ~loc "[Graph.shift_edges] dependency from tar to src";
let new_map = let new_map =
...@@ -464,14 +477,14 @@ module G_graph = struct ...@@ -464,14 +477,14 @@ module G_graph = struct
(* list of the nodes *) (* list of the nodes *)
Gid_map.iter Gid_map.iter
(fun id node -> (fun id node ->
bprintf buff "N%d %s;\n" id (G_node.to_gr node) bprintf buff "N_%s %s;\n" (Gid.to_string id) (G_node.to_gr node)
) graph.map; ) graph.map;
(* list of the edges *) (* list of the edges *)
Gid_map.iter Gid_map.iter
(fun id node -> (fun id node ->
Massoc.iter Massoc_gid.iter
(fun tar edge -> (fun tar edge ->
bprintf buff "N%d -[%s]-> N%d;\n" id (G_edge.to_string edge) tar bprintf buff "N_%s -[%s]-> N_%s;\n" (Gid.to_string id) (G_edge.to_string edge) (Gid.to_string tar)
) (G_node.get_next node) ) (G_node.get_next node)
) graph.map; ) graph.map;
...@@ -502,7 +515,7 @@ module G_graph = struct ...@@ -502,7 +515,7 @@ module G_graph = struct
"\\\"", "\""; "\\\"", "\"";
] ]
let to_dep ?main_feat ?(deco=Deco.empty) graph = let to_dep ?main_feat ?(deco=G_deco.empty) graph =
let buff = Buffer.create 32 in let buff = Buffer.create 32 in
bprintf buff "[GRAPH] { opacity=0; scale = 200; fontname=\"Arial\"; }\n"; bprintf buff "[GRAPH] { opacity=0; scale = 200; fontname=\"Arial\"; }\n";
...@@ -513,27 +526,27 @@ module G_graph = struct ...@@ -513,27 +526,27 @@ module G_graph = struct
List.iter List.iter
(fun (id, node) -> (fun (id, node) ->
if List.mem id deco.Deco.nodes if List.mem id deco.G_deco.nodes
then bprintf buff then bprintf buff
"N%d { %sforecolor=red; subcolor=red; }\n" id (G_fs.to_dep ?main_feat (G_node.get_fs node)) "N_%s { %sforecolor=red; subcolor=red; }\n" (Gid.to_string id) (G_fs.to_dep ?main_feat (G_node.get_fs node))
else bprintf buff else bprintf buff
"N%d { %s }\n" id (G_fs.to_dep ?main_feat (G_node.get_fs node)) "N_%s { %s }\n" (Gid.to_string id) (G_fs.to_dep ?main_feat (G_node.get_fs node))
) snodes; ) snodes;
bprintf buff "} \n"; bprintf buff "} \n";
bprintf buff "[EDGES] { \n"; bprintf buff "[EDGES] { \n";
Gid_map.iter Gid_map.iter
(fun gid elt -> (fun gid elt ->
Massoc.iter Massoc_gid.iter
(fun tar g_edge -> (fun tar g_edge ->
let deco = List.mem (gid,g_edge,tar) deco.Deco.edges in let deco = List.mem (gid,g_edge,tar) deco.G_deco.edges in
bprintf buff "N%d -> N%d %s\n" gid tar (G_edge.to_dep ~deco g_edge) bprintf buff "N_%s -> N_%s %s\n" (Gid.to_string gid) (Gid.to_string tar) (G_edge.to_dep ~deco g_edge)
) (G_node.get_next elt) ) (G_node.get_next elt)
) graph.map; ) graph.map;
bprintf buff "} \n"; bprintf buff "} \n";
Buffer.contents buff Buffer.contents buff
let to_dot ?main_feat ?(deco=Deco.empty) graph = let to_dot ?main_feat ?(deco=G_deco.empty) graph =
let buff = Buffer.create 32 in let buff = Buffer.create 32 in
bprintf buff "digraph G {\n"; bprintf buff "digraph G {\n";
...@@ -543,18 +556,18 @@ module G_graph = struct ...@@ -543,18 +556,18 @@ module G_graph = struct
(* list of the nodes *) (* list of the nodes *)
Gid_map.iter Gid_map.iter
(fun id node -> (fun id node ->
bprintf buff " N%d [label=\"%s\", color=%s]\n" bprintf buff " N_%s [label=\"%s\", color=%s]\n"
id (Gid.to_string id)
(G_fs.to_dot ?main_feat (G_node.get_fs node)) (G_fs.to_dot ?main_feat (G_node.get_fs node))
(if List.mem id deco.Deco.nodes then "red" else "black") (if List.mem id deco.G_deco.nodes then "red" else "black")
) graph.map; ) graph.map;
(* list of the edges *) (* list of the edges *)
Gid_map.iter Gid_map.iter
(fun id node -> (fun id node ->
Massoc.iter Massoc_gid.iter
(fun tar g_edge -> (fun tar g_edge ->
let deco = List.mem (id,g_edge,tar) deco.Deco.edges in let deco = List.mem (id,g_edge,tar) deco.G_deco.edges in
bprintf buff " N%d -> N%d%s\n" id tar (G_edge.to_dot ~deco g_edge) bprintf buff " N_%s -> N_%s%s\n" (Gid.to_string id) (Gid.to_string tar) (G_edge.to_dot ~deco g_edge)
) (G_node.get_next node) ) (G_node.get_next node)
) graph.map; ) graph.map;
...@@ -566,7 +579,7 @@ module G_graph = struct ...@@ -566,7 +579,7 @@ module G_graph = struct
(* is there an edge e out of node i ? *) (* is there an edge e out of node i ? *)
let edge_out graph node_id p_edge = let edge_out graph node_id p_edge =
let node = Gid_map.find node_id graph.map in let node = Gid_map.find node_id graph.map in
Massoc.exists (fun _ e -> P_edge.compatible p_edge e) (G_node.get_next node) Massoc_gid.exists (fun _ e -> P_edge.compatible p_edge e) (G_node.get_next node)
end (* module G_graph *) end (* module G_graph *)
(* ================================================================================ *) (* ================================================================================ *)
...@@ -5,14 +5,29 @@ open Grew_node ...@@ -5,14 +5,29 @@ open Grew_node
open Grew_utils open Grew_utils
open Grew_command open Grew_command
module Deco: sig (* ================================================================================ *)
module P_deco: sig
type t = type t =
{ nodes: int list; { nodes: Pid.t list;
edges: (int * Label.t * int) list; edges: (Pid.t * P_edge.t * Pid.t) list;
} }
val empty:t
end
(* ================================================================================ *)
(* ================================================================================ *)
module G_deco: sig
type t =
{ nodes: Gid.t list;
edges: (Gid.t * G_edge.t * Gid.t) list;
}
val empty:t val empty:t
end end
(* ================================================================================ *)
(* ================================================================================ *)
module P_graph: sig module P_graph: sig
type t = P_node.t Pid_map.t type t = P_node.t Pid_map.t
...@@ -41,6 +56,7 @@ module P_graph: sig ...@@ -41,6 +56,7 @@ module P_graph: sig
val roots: t -> Pid.t list val roots: t -> Pid.t list
end end
(* ================================================================================ *)
...@@ -64,37 +80,37 @@ module G_graph: sig ...@@ -64,37 +80,37 @@ module G_graph: sig
val of_conll: ?loc:Loc.t -> Conll.line list -> t val of_conll: ?loc:Loc.t -> Conll.line list -> t
val to_gr: t -> string val to_gr: t -> string
val to_dot: ?main_feat:string -> ?deco:Deco.t -> t -> string val to_dot: ?main_feat:string -> ?deco:G_deco.t -> t -> string
val to_sentence: ?main_feat:string -> t -> string val to_sentence: ?main_feat:string -> t -> string
val to_dep: ?main_feat:string -> ?deco:Deco.t -> t -> string val to_dep: ?main_feat:string -> ?deco:G_deco.t -> t -> string
type concat_item = type concat_item =
| Feat of (Gid.t * string) | Feat of (Gid.t * string)
| String of string | String of string
val add_edge: t -> int -> G_edge.t -> int -> t option val add_edge: t -> Gid.t -> G_edge.t -> Gid.t -> t option
val del_edge : ?edge_ident: string -> Loc.t -> t -> int -> G_edge.t -> int -> t val del_edge : ?edge_ident: string -> Loc.t -> t -> Gid.t -> G_edge.t -> Gid.t -> t
val del_node : t -> int -> t val del_node : t -> Gid.t -> t
val add_neighbour : Loc.t -> t -> int -> G_edge.t -> (int * t) val add_neighbour : Loc.t -> t -> Gid.t -> G_edge.t -> (Gid.t * t)
val merge_node : Loc.t -> t -> int -> int -> t option val merge_node : Loc.t -> t -> Gid.t -> Gid.t -> t option
val shift_in : Loc.t -> t -> int -> int -> t val shift_in : Loc.t -> t -> Gid.t -> Gid.t -> t
val shift_out : Loc.t -> t -> int -> int -> t val shift_out : Loc.t -> t -> Gid.t -> Gid.t -> t
val shift_edges : Loc.t -> t -> int -> int -> t val shift_edges : Loc.t -> t -> Gid.t -> Gid.t -> t
(** [update_feat tar_id tar_feat_name concat_items] sets the feature of the node [tar_id] (** [update_feat tar_id tar_feat_name concat_items] sets the feature of the node [tar_id]
with feature name [tar_feat_name] to be the contatenation of values described by the [concat_items]. with feature name [tar_feat_name] to be the contatenation of values described by the [concat_items].
It returns both the new graph and the new feature value produced as the second element *) It returns both the new graph and the new feature value produced as the second element *)
val update_feat: ?loc:Loc.t -> t -> int -> string -> concat_item list -> (t * string) val update_feat: ?loc:Loc.t -> t -> Gid.t -> string -> concat_item list -> (t * string)
val set_feat: ?loc:Loc.t -> t -> int -> string -> string -> t val set_feat: ?loc:Loc.t -> t -> Gid.t -> string -> string -> t
val del_feat: t -> int -> string -> t val del_feat: t -> Gid.t -> string -> t
(** [edge_out t id edge] returns true iff there is an out-edge from the node [id] with a label compatible with [edge] *) (** [edge_out t id edge] returns true iff there is an out-edge from the node [id] with a label compatible with [edge] *)
val edge_out: t -> int -> P_edge.t -> bool val edge_out: t -> Gid.t -> P_edge.t -> bool
val equals: t -> t -> bool val equals: t -> t -> bool
......
...@@ -10,7 +10,7 @@ module G_node = struct ...@@ -10,7 +10,7 @@ module G_node = struct
type t = { type t = {
fs: G_fs.t; fs: G_fs.t;
pos: int option; pos: int option;
next: G_edge.t Massoc.t; next: G_edge.t Massoc_gid.t;
} }
let get_fs t = t.fs let get_fs t = t.fs
...@@ -18,12 +18,12 @@ module G_node = struct ...@@ -18,12 +18,12 @@ module G_node = struct
let set_fs t fs = {t with fs = fs} let set_fs t fs = {t with fs = fs}
let empty = { fs = G_fs.empty; pos = None; next = Massoc.empty } let empty = { fs = G_fs.empty; pos = None; next = Massoc_gid.empty }
let to_string t = let to_string t =
Printf.sprintf " fs=[%s]\n next=%s\n" Printf.sprintf " fs=[%s]\n next=%s\n"
(G_fs.to_string t.fs) (G_fs.to_string t.fs)
(Massoc.to_string G_edge.to_string t.next) (Massoc_gid.to_string G_edge.to_string t.next)
let to_gr t = let to_gr t =
sprintf "%s [%s] " sprintf "%s [%s] "
...@@ -31,7 +31,7 @@ module G_node = struct ...@@ -31,7 +31,7 @@ module G_node = struct
(G_fs.to_gr t.fs) (G_fs.to_gr t.fs)
let add_edge g_edge gid_tar t = let add_edge g_edge gid_tar t =
match Massoc.add gid_tar g_edge t.next with match Massoc_gid.add gid_tar g_edge t.next with
| Some l -> Some {t with next = l} | Some l -> Some {t with next = l}
| None -> None | None -> None
...@@ -39,30 +39,30 @@ module G_node = struct ...@@ -39,30 +39,30 @@ module G_node = struct
(ast_node.Ast.node_id, (ast_node.Ast.node_id,
{ fs = G_fs.build ast_node.Ast.fs; { fs = G_fs.build ast_node.Ast.fs;
pos = ast_node.Ast.position; pos = ast_node.Ast.position;
next = Massoc.empty; next = Massoc_gid.empty;
} ) } )
let of_conll line = { let of_conll line = {
fs = G_fs.of_conll line; fs = G_fs.of_conll line;
pos = Some line.Conll.num; pos = Some line.Conll.num;
next = Massoc.empty; next = Massoc_gid.empty;
} }
let remove id_tar label t = {t with next = Massoc.remove id_tar label t.next} let remove (id_tar : Gid.t) label t = {t with next = Massoc_gid.remove id_tar label t.next}
let remove_key node_id t = let remove_key node_id t =
try {t with next = Massoc.remove_key node_id t.next} with Not_found -> t try {t with next = Massoc_gid.remove_key node_id t.next} with Not_found -> t
let merge_key ?(strict=false) src_id tar_id t = let merge_key ?(strict=false) src_id tar_id t =
try Some {t with next = Massoc.merge_key src_id tar_id t.next} try Some {t with next = Massoc_gid.merge_key src_id tar_id t.next}
with Massoc.Duplicate -> if strict then None else Some t with Massoc_gid.Duplicate -> if strict then None else Some t
let shift_out ?(strict=false) src_t tar_t = let shift_out ?(strict=false) src_t tar_t =
try Some {tar_t with next = Massoc.disjoint_union src_t.next tar_t.next} try Some {tar_t with next = Massoc_gid.disjoint_union src_t.next tar_t.next}
with Massoc.Not_disjoint -> if strict then None else Some tar_t with Massoc_gid.Not_disjoint -> if strict then None else Some tar_t
let rm_out_edges t = {t with next = Massoc.empty} let rm_out_edges t = {t with next = Massoc_gid.empty}
let build_neighbour t = {empty with pos = match t.pos with Some x -> Some (x+1) | None -> None} let build_neighbour t = {empty with pos = match t.pos with Some x -> Some (x+1) | None -> None}
......
...@@ -13,21 +13,21 @@ module G_node: sig ...@@ -13,21 +13,21 @@ module G_node: sig
val to_gr: t -> string val to_gr: t -> string
val get_fs: t -> G_fs.t val get_fs: t -> G_fs.t
val get_next: t -> G_edge.t Massoc.t val get_next: t -> G_edge.t Massoc_gid.t
val set_fs: t -> G_fs.t -> t val set_fs: t -> G_fs.t -> t
(* FIXME move Gid up and replace int by Gid.t *) (* FIXME move Gid up and replace int by Gid.t *)
val remove: int -> G_edge.t -> t -> t val remove: Gid.t -> G_edge.t -> t -> t
val remove_key: int -> t -> t val remove_key: Gid.t -> t -> t
val merge_key: ?strict:bool -> int -> int -> t -> t option val merge_key: ?strict:bool -> Gid.t -> Gid.t -> t -> t option
val shift_out: ?strict:bool -> t -> t -> t option val shift_out: ?strict:bool -> t -> t -> t option
val rm_out_edges: t -> t val rm_out_edges: t -> t
val add_edge: G_edge.t -> int -> t -> t option val add_edge: G_edge.t -> Gid.t -> t -> t option
val build: Ast.node -> (Id.name * t) val build: Ast.node -> (Id.name * t)
val of_conll: Conll.line -> t