Attention une mise à jour du serveur va être effectuée le vendredi 16 avril entre 12h et 12h30. Cette mise à jour va générer une interruption du service de quelques minutes.

Commit d1bdd7f2 authored by bguillaum's avatar bguillaum

New type Domain.t to generalize Feature_domain and Label.domain.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8837 7838e531-6607-4d57-9587-6c381814729c
parent c107b8b4
......@@ -169,7 +169,7 @@ module Command = struct
if feat_name = "position"
then Error.build ~loc "Illegal del_feat command: the 'position' feature cannot be deleted";
check_act_id loc act_id kai;
Feature_domain.check_feature_name ~loc domain feat_name;
Domain.check_feature_name ~loc domain feat_name;
((DEL_FEAT (pid_of_act_id loc act_id, feat_name), loc), (kai, kei))
| (Ast.Update_feat ((act_id, feat_name), ast_items), loc) ->
......@@ -178,7 +178,7 @@ module Command = struct
(function
| Ast.Qfn_item (node_id,feature_name) ->
check_node_id loc node_id kai;
Feature_domain.check_feature_name ~loc domain feature_name;
Domain.check_feature_name ~loc domain feature_name;
Feat (pid_of_node_id loc node_id, feature_name)
| Ast.String_item s -> String s
| Ast.Param_item var ->
......@@ -192,9 +192,9 @@ module Command = struct
) ast_items in
(* check for consistency *)
(match items with
| _ when Feature_domain.is_open domain feat_name -> ()
| _ when Domain.is_open_feature domain feat_name -> ()
| [Param_out _] -> () (* TODO: check that lexical parameters are compatible with the feature domain *)
| [String s] -> Feature_domain.check_feature ~loc domain feat_name s
| [String s] -> Domain.check_feature ~loc domain feat_name s
| [Feat (_,fn)] -> ()
| _ -> Error.build ~loc "[Update_feat] Only open features can be modified with the concat operator '+' but \"%s\" is not declared as an open feature" feat_name);
((UPDATE_FEAT (pid_of_act_id loc act_id, feat_name, items), loc), (kai, kei))
......
......@@ -58,8 +58,8 @@ module Command : sig
| H_ACT_NODE of (Gid.t * string)
val build:
Feature_domain.t ->
Label_domain.t ->
Domain.t ->
Domain.t ->
?param: (string list * string list) ->
(Ast.command_node_ident list * string list) ->
Id.table ->
......
......@@ -18,14 +18,14 @@ open Grew_ast
module G_edge: sig
type t = Label.t
val to_string: Label_domain.t -> ?locals:Label_domain.decl array -> t -> string
val to_string: Domain.t -> ?locals:Label_domain.decl array -> t -> string
val make: ?loc:Loc.t -> Label_domain.t -> ?locals:Label_domain.decl array -> string -> t
val make: ?loc:Loc.t -> Domain.t -> ?locals:Label_domain.decl array -> string -> t
val build: Label_domain.t -> ?locals:Label_domain.decl array -> Ast.edge -> t
val build: Domain.t -> ?locals:Label_domain.decl array -> Ast.edge -> t
val to_dot: Label_domain.t -> ?deco:bool -> t -> string
val to_dep: Label_domain.t -> ?deco:bool -> t -> string
val to_dot: Domain.t -> ?deco:bool -> t -> string
val to_dep: Domain.t -> ?deco:bool -> t -> string
end (* module G_edge *)
(* ================================================================================ *)
......@@ -38,16 +38,16 @@ module P_edge: sig
val get_id: t -> string option
val to_string: Label_domain.t -> t -> string
val to_string: Domain.t -> t -> string
val build: Label_domain.t -> ?locals:Label_domain.decl array -> Ast.edge -> t
val build: Domain.t -> ?locals:Label_domain.decl array -> Ast.edge -> t
type edge_matcher =
| Fail
| Ok of Label.t
| Binds of string * Label.t list
val match_: Label_domain.t -> t -> G_edge.t -> edge_matcher
val match_: Domain.t -> t -> G_edge.t -> edge_matcher
val match_list: Label_domain.t -> t -> G_edge.t list -> edge_matcher
val match_list: Domain.t -> t -> G_edge.t list -> edge_matcher
end (* module P_edge *)
......@@ -35,7 +35,7 @@ module G_feature = struct
let build domain = function
| ({Ast.kind=Ast.Equality [atom]; name=name},loc) ->
(name, Feature_domain.build_value ~loc domain name atom)
(name, Feature_value.build_value ~loc domain name atom)
| _ -> Error.build "Illegal feature declaration in Graph (must be '=' and atomic)"
let to_string (feat_name, feat_val) = sprintf "%s=%s" feat_name (string_of_value feat_val)
......@@ -132,12 +132,12 @@ module P_feature = struct
let build domain ?pat_vars = function
| ({Ast.kind=Ast.Absent; name=name}, loc) ->
Feature_domain.check_feature_name ~loc domain name;
Domain.check_feature_name ~loc domain name;
(name, {cst=Absent;in_param=[];})
| ({Ast.kind=Ast.Equality unsorted_values; name=name}, loc) ->
let values = Feature_domain.build_disj ~loc domain name unsorted_values in (name, {cst=Equal values;in_param=[];})
let values = Feature_value.build_disj ~loc domain name unsorted_values in (name, {cst=Equal values;in_param=[];})
| ({Ast.kind=Ast.Disequality unsorted_values; name=name}, loc) ->
let values = Feature_domain.build_disj ~loc domain name unsorted_values in (name, {cst=Different values;in_param=[];})
let values = Feature_value.build_disj ~loc domain name unsorted_values in (name, {cst=Different values;in_param=[];})
| ({Ast.kind=Ast.Equal_param var; name=name}, loc) ->
begin
match pat_vars with
......@@ -162,7 +162,7 @@ module G_fs = struct
(* ---------------------------------------------------------------------- *)
let set_feat ?loc domain feature_name atom t =
let new_value = Feature_domain.build_value ?loc domain feature_name atom in
let new_value = Feature_value.build_value ?loc domain feature_name atom in
let rec loop = function
| [] -> [(feature_name, new_value)]
| ((fn,_)::_) as t when feature_name < fn -> (feature_name, new_value)::t
......@@ -210,15 +210,15 @@ module G_fs = struct
(* ---------------------------------------------------------------------- *)
let of_conll ?loc domain line =
let raw_list0 =
("phon", Feature_domain.build_value ?loc domain "phon" line.Conll.phon)
:: ("cat", Feature_domain.build_value ?loc domain "cat" line.Conll.pos1)
:: (List.map (fun (f,v) -> (f, Feature_domain.build_value ?loc domain f v)) line.Conll.morph) in
("phon", Feature_value.build_value ?loc domain "phon" line.Conll.phon)
:: ("cat", Feature_value.build_value ?loc domain "cat" line.Conll.pos1)
:: (List.map (fun (f,v) -> (f, Feature_value.build_value ?loc domain f v)) line.Conll.morph) in
let raw_list1 = match line.Conll.pos2 with
| "" | "_" -> raw_list0
| s -> ("pos", Feature_domain.build_value ?loc domain "pos" s) :: raw_list0 in
| s -> ("pos", Feature_value.build_value ?loc domain "pos" s) :: raw_list0 in
let raw_list2 = match line.Conll.lemma with
| "" | "_" -> raw_list1
| s -> ("lemma", Feature_domain.build_value ?loc domain "lemma" s) :: raw_list1 in
| s -> ("lemma", Feature_value.build_value ?loc domain "lemma" s) :: raw_list1 in
List.sort G_feature.compare raw_list2
(* ---------------------------------------------------------------------- *)
......
......@@ -21,7 +21,7 @@ module G_fs: sig
(** [set_feat domain feature_name atom t] adds the feature ([feature_name],[atom]) in [t].
If [t] already contains a feature named [feature_name], the old value is erased by the new one. *)
val set_feat: ?loc:Loc.t -> Feature_domain.t -> feature_name -> string -> t -> t
val set_feat: ?loc:Loc.t -> Domain.t -> feature_name -> string -> t -> t
(** [del_feat feature_name t] remove the feature with name [feature_name] in [t].
If [t] does not contain such a feature, [t] is returned unchanged. *)
......@@ -46,9 +46,9 @@ module G_fs: sig
val to_string: t -> string
val build: Feature_domain.t -> Ast.feature list -> t
val build: Domain.t -> Ast.feature list -> t
val of_conll: ?loc:Loc.t -> Feature_domain.t -> Conll.line -> t
val of_conll: ?loc:Loc.t -> Domain.t -> Conll.line -> t
(** [unif t1 t2] returns [Some t] if [t] is the unification of two graph feature structures
[None] is returned if the two feature structures cannot be unified. *)
......@@ -62,7 +62,7 @@ module P_fs: sig
val empty: t
val build: Feature_domain.t -> ?pat_vars: string list -> Ast.feature list -> t
val build: Domain.t -> ?pat_vars: string list -> Ast.feature list -> t
val to_string: t -> string
......
......@@ -53,7 +53,7 @@ module P_graph = struct
(pid, fs)
(* -------------------------------------------------------------------------------- *)
let build domain label_domain ?pat_vars ?(locals=[||]) (full_node_list : Ast.node list) full_edge_list =
let build domain ?pat_vars ?(locals=[||]) (full_node_list : Ast.node list) full_edge_list =
(* NB: insert searches for a previous node with the Same name and uses unification rather than constraint *)
(* NB: insertion of new node at the end of the list: not efficient but graph building is not the hard part. *)
......@@ -87,11 +87,11 @@ module P_graph = struct
(fun acc (ast_edge, loc) ->
let i1 = Id.build ~loc ast_edge.Ast.src pos_table in
let i2 = Id.build ~loc ast_edge.Ast.tar pos_table in
let edge = P_edge.build label_domain ~locals (ast_edge, loc) in
let edge = P_edge.build domain ~locals (ast_edge, loc) in
(match map_add_edge acc (Pid.Pos i1) edge (Pid.Pos i2) with
| Some g -> g
| None -> Error.build "[GRS] [Graph.build] try to build a graph with twice the same edge %s %s"
(P_edge.to_string label_domain edge)
(P_edge.to_string domain edge)
(Loc.to_string loc)
)
) map_without_edges full_edge_list in
......@@ -108,7 +108,7 @@ module P_graph = struct
(* -------------------------------------------------------------------------------- *)
(* It may raise [P_fs.Fail_unif] in case of contradiction on constraints *)
let build_extension domain label_domain ?pat_vars ?(locals=[||]) pos_table full_node_list full_edge_list =
let build_extension domain ?pat_vars ?(locals=[||]) pos_table full_node_list full_edge_list =
let built_nodes = List.map (P_node.build domain ?pat_vars) full_node_list in
......@@ -154,7 +154,7 @@ module P_graph = struct
match Id.build_opt tar pos_table with
| Some i -> Pid.Pos i
| None -> Pid.Neg (Id.build ~loc tar new_table) in
let edge = P_edge.build label_domain ~locals (ast_edge, loc) in
let edge = P_edge.build domain ~locals (ast_edge, loc) in
match map_add_edge acc i1 edge i2 with
| Some map -> map
| None -> Log.fbug "[GRS] [Graph.build_extension] add_edge cannot fail in pattern extension"; exit 2
......@@ -262,9 +262,9 @@ module G_graph = struct
in loop 0
(* is there an edge e out of node i ? *)
let edge_out label_domain graph node_id label_cst =
let edge_out domain graph node_id label_cst =
let node = Gid_map.find node_id graph.map in
Massoc_gid.exists (fun _ e -> Label_cst.match_ label_domain e label_cst) (G_node.get_next node)
Massoc_gid.exists (fun _ e -> Label_cst.match_ domain e label_cst) (G_node.get_next node)
let get_annot_info graph =
let annot_info =
......@@ -295,7 +295,7 @@ module G_graph = struct
| None -> None
(* -------------------------------------------------------------------------------- *)
let build domain label_domain ?(locals=[||]) gr_ast =
let build domain ?(locals=[||]) gr_ast =
let full_node_list = gr_ast.Ast.nodes
and full_edge_list = gr_ast.Ast.edges in
......@@ -329,11 +329,11 @@ module G_graph = struct
(fun acc (ast_edge, loc) ->
let i1 = Id.build ~loc ast_edge.Ast.src table in
let i2 = Id.build ~loc ast_edge.Ast.tar table in
let edge = G_edge.build label_domain ~locals (ast_edge, loc) in
let edge = G_edge.build domain ~locals (ast_edge, loc) in
(match map_add_edge acc (Gid.Old i1) edge (Gid.Old i2) with
| Some g -> g
| None -> Error.build "[GRS] [Graph.build] try to build a graph with twice the same edge %s %s"
(G_edge.to_string label_domain edge)
(G_edge.to_string domain edge)
(Loc.to_string loc)
)
) map_without_edges full_edge_list in
......@@ -343,7 +343,7 @@ module G_graph = struct
(* -------------------------------------------------------------------------------- *)
let of_conll ?loc domain label_domain (meta, lines, range_lines) =
let of_conll ?loc domain (meta, lines, range_lines) =
let sorted_lines = Conll.root :: (List.sort Conll.compare lines) in
let gtable = (Array.of_list (List.map (fun line -> line.Conll.num) sorted_lines), string_of_int) in
......@@ -363,11 +363,11 @@ module G_graph = struct
List.fold_left
(fun acc2 (gov, dep_lab) ->
let gov_id = Id.gbuild ?loc gov gtable in
let edge = G_edge.make label_domain ?loc dep_lab in
let edge = G_edge.make domain ?loc dep_lab in
(match map_add_edge acc2 (Gid.Old gov_id) edge (Gid.Old dep_id) with
| Some g -> g
| None -> Error.build "[GRS] [Graph.of_conll] try to build a graph with twice the same edge %s %s"
(G_edge.to_string label_domain edge)
(G_edge.to_string domain edge)
(match loc with Some l -> Loc.to_string l | None -> "")
)
) acc line.Conll.deps
......@@ -386,7 +386,7 @@ module G_graph = struct
(* -------------------------------------------------------------------------------- *)
(** input : "Le/DET/le petit/ADJ/petit chat/NC/chat dort/V/dormir ./PONCT/." *)
let of_brown domain label_domain ?sentid brown =
let of_brown domain ?sentid brown =
let units = Str.split (Str.regexp " ") brown in
let conll_lines = List.mapi
(fun i item -> match Str.full_split (Str.regexp "/[A-Z'+'']+/") item with
......@@ -407,7 +407,7 @@ module G_graph = struct
}
| _ -> Error.build "[Graph.of_brown] Cannot parse Brown item >>>%s<<< (expected \"phon/POS/lemma\")" item
) units in
of_conll domain label_domain ([], conll_lines, [])
of_conll domain ([], conll_lines, [])
(* -------------------------------------------------------------------------------- *)
let opt_att atts name =
......@@ -416,7 +416,7 @@ module G_graph = struct
(* -------------------------------------------------------------------------------- *)
(** [of_xml d_xml] loads a graph in the xml format: [d_xml] must be a <D> xml element *)
let of_xml domain label_domain d_xml =
let of_xml domain d_xml =
match d_xml with
| Xml.Element ("D", _, t_or_r_list) ->
let (t_list, r_list) = List.partition (function Xml.Element ("T",_,_) -> true | _ -> false) t_or_r_list in
......@@ -448,7 +448,7 @@ module G_graph = struct
let gid_src = String_map.find src mapping in
let old_node = Gid_map.find gid_src acc in
let new_map =
match G_node.add_edge (G_edge.make label_domain label) gid_tar old_node with
match G_node.add_edge (G_edge.make domain label) gid_tar old_node with
| Some new_node -> Gid_map.add gid_src new_node acc
| None -> Log.critical "[G_graph.of_xml] Fail to add edge" in
new_map
......@@ -458,7 +458,7 @@ module G_graph = struct
| _ -> Log.critical "[G_graph.of_xml] Not a <D> tag"
(* -------------------------------------------------------------------------------- *)
let del_edge label_domain ?edge_ident loc graph id_src label id_tar =
let del_edge domain ?edge_ident loc graph id_src label id_tar =
let node_src =
try Gid_map.find id_src graph.map
with Not_found ->
......@@ -466,7 +466,7 @@ module G_graph = struct
| None -> Log.fcritical "[RUN] Some edge refers to a dead node, please report"
| Some id -> Error.run ~loc "[Graph.del_edge] cannot find source node of edge \"%s\"" id in
try {graph with map = Gid_map.add id_src (G_node.remove id_tar label node_src) graph.map}
with Not_found -> Error.run ~loc "[Graph.del_edge] cannot find edge '%s'" (G_edge.to_string label_domain label)
with Not_found -> Error.run ~loc "[Graph.del_edge] cannot find edge '%s'" (G_edge.to_string domain label)
(* -------------------------------------------------------------------------------- *)
let del_node graph node_id =
......@@ -493,7 +493,7 @@ module G_graph = struct
(index, {graph with map = new_map})
(* -------------------------------------------------------------------------------- *)
let add_neighbour loc label_domain graph node_id label =
let add_neighbour loc domain graph node_id label =
let index = match node_id with
| Gid.Old id ->
(match Label.to_int label with
......@@ -503,7 +503,7 @@ module G_graph = struct
| Gid.New _ | Gid.Act _ -> Error.run ~loc "[Graph.add_neighbour] try to add neighbour node to a neighbour node" in
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_domain label);
then Error.run ~loc "[Graph.add_neighbour] try to build twice the \"same\" neighbour node (with label '%s')" (Label.to_string domain label);
let node = Gid_map.find node_id graph.map in
(* put the new node on the right of its "parent" *)
......@@ -515,7 +515,7 @@ module G_graph = struct
(* -------------------------------------------------------------------------------- *)
(* move out-edges (which respect cst [labels,neg]) from id_src are moved to out-edges out off node id_tar *)
let shift_out loc label_domain src_gid tar_gid label_cst graph =
let shift_out loc domain src_gid tar_gid label_cst graph =
let src_node = Gid_map.find src_gid graph.map in
let tar_node = Gid_map.find tar_gid graph.map in
......@@ -526,18 +526,18 @@ module G_graph = struct
let src_tar_edges = Massoc_gid.assoc tar_gid src_next in
let _ =
try
let loop_edge = List.find (fun edge -> Label_cst.match_ label_domain edge label_cst) src_tar_edges in
Error.run ~loc "The shfit_out command tries to build a loop (with label %s)" (Label.to_string label_domain loop_edge)
let loop_edge = List.find (fun edge -> Label_cst.match_ domain edge label_cst) src_tar_edges in
Error.run ~loc "The shfit_out command tries to build a loop (with label %s)" (Label.to_string domain loop_edge)
with Not_found -> () in
let (new_src_next,new_tar_next) =
Massoc_gid.fold
(fun (acc_src_next,acc_tar_next) next_gid edge ->
if Label_cst.match_ label_domain edge label_cst
if Label_cst.match_ domain edge label_cst
then
match Massoc_gid.add next_gid edge acc_tar_next with
| Some new_acc_tar_next -> (Massoc_gid.remove next_gid edge acc_src_next, new_acc_tar_next)
| None -> Error.run ~loc "The [shift_out] command tries to build a duplicate edge (with label \"%s\")" (Label.to_string label_domain edge)
| None -> Error.run ~loc "The [shift_out] command tries to build a duplicate edge (with label \"%s\")" (Label.to_string domain edge)
else (acc_src_next,acc_tar_next)
)
......@@ -550,7 +550,7 @@ module G_graph = struct
}
(* -------------------------------------------------------------------------------- *)
let shift_in loc label_domain src_gid tar_gid label_cst graph =
let shift_in loc domain src_gid tar_gid label_cst graph =
let tar_node = Gid_map.find tar_gid graph.map in
let tar_next = G_node.get_next tar_node in
......@@ -558,8 +558,8 @@ module G_graph = struct
let tar_src_edges = Massoc_gid.assoc src_gid tar_next in
let _ =
try
let loop_edge = List.find (fun edge -> Label_cst.match_ label_domain edge label_cst) tar_src_edges in
Error.run ~loc "The [shift_in] command tries to build a loop (with label \"%s\")" (Label.to_string label_domain loop_edge)
let loop_edge = List.find (fun edge -> Label_cst.match_ domain edge label_cst) tar_src_edges in
Error.run ~loc "The [shift_in] command tries to build a loop (with label \"%s\")" (Label.to_string domain loop_edge)
with Not_found -> () in
{ graph with map =
......@@ -573,10 +573,10 @@ module G_graph = struct
let (new_node_src_edges, new_node_tar_edges) =
List.fold_left
(fun (acc_node_src_edges,acc_node_tar_edges) edge ->
if Label_cst.match_ label_domain edge label_cst
if Label_cst.match_ domain edge label_cst
then
match List_.usort_insert edge acc_node_tar_edges with
| None -> Error.run ~loc "The [shift_in] command tries to build a duplicate edge (with label \"%s\")" (Label.to_string label_domain edge)
| None -> Error.run ~loc "The [shift_in] command tries to build a duplicate edge (with label \"%s\")" (Label.to_string domain edge)
| Some l -> (List_.usort_remove edge acc_node_src_edges, l)
else (acc_node_src_edges,acc_node_tar_edges)
)
......@@ -590,14 +590,14 @@ module G_graph = struct
}
(* -------------------------------------------------------------------------------- *)
let shift_edges loc label_domain src_gid tar_gid label_cst graph =
let shift_edges loc domain src_gid tar_gid label_cst graph =
graph
|> (shift_in loc label_domain src_gid tar_gid label_cst)
|> (shift_out loc label_domain src_gid tar_gid label_cst)
|> (shift_in loc domain src_gid tar_gid label_cst)
|> (shift_out loc domain src_gid tar_gid label_cst)
(* -------------------------------------------------------------------------------- *)
let merge_node loc label_domain graph src_gid tar_gid =
let se_graph = shift_edges loc label_domain src_gid tar_gid Label_cst.all graph in
let merge_node loc domain graph src_gid tar_gid =
let se_graph = shift_edges loc domain src_gid tar_gid Label_cst.all graph in
let src_node = Gid_map.find src_gid se_graph.map in
let tar_node = Gid_map.find tar_gid se_graph.map in
......@@ -647,7 +647,7 @@ module G_graph = struct
{ graph with map = Gid_map.add node_id (G_node.set_fs new_fs node) graph.map }
(* -------------------------------------------------------------------------------- *)
let to_gr label_domain graph =
let to_gr domain graph =
let buff = Buffer.create 32 in
bprintf buff "graph {\n";
......@@ -677,7 +677,7 @@ module G_graph = struct
(fun (id,node) ->
Massoc_gid.iter
(fun tar edge ->
bprintf buff " N_%s -[%s]-> N_%s;\n" (Gid.to_string id) (G_edge.to_string label_domain edge) (Gid.to_string tar)
bprintf buff " N_%s -[%s]-> N_%s;\n" (Gid.to_string id) (G_edge.to_string domain edge) (Gid.to_string tar)
) (G_node.get_next node)
) sorted_nodes;
......@@ -710,7 +710,7 @@ module G_graph = struct
]
(* -------------------------------------------------------------------------------- *)
let to_dep label_domain ?filter ?main_feat ?(deco=G_deco.empty) graph =
let to_dep domain ?filter ?main_feat ?(deco=G_deco.empty) graph =
let nodes = Gid_map.fold (fun id elt acc -> (id,elt)::acc) graph.map [] in
let snodes = List.sort (fun (_,n1) (_,n2) -> G_node.position_comp n1 n2) nodes in
......@@ -739,7 +739,7 @@ module G_graph = struct
Massoc_gid.iter
(fun tar g_edge ->
let deco = List.mem (gid,g_edge,tar) deco.G_deco.edges in
bprintf buff "N_%s -> N_%s %s\n" (Gid.to_string gid) (Gid.to_string tar) (G_edge.to_dep label_domain ~deco g_edge)
bprintf buff "N_%s -> N_%s %s\n" (Gid.to_string gid) (Gid.to_string tar) (G_edge.to_dep domain ~deco g_edge)
) (G_node.get_next elt)
) graph.map;
......@@ -747,7 +747,7 @@ module G_graph = struct
Buffer.contents buff
(* -------------------------------------------------------------------------------- *)
let to_dot label_domain ?main_feat ?(deco=G_deco.empty) graph =
let to_dot domain ?main_feat ?(deco=G_deco.empty) graph =
let buff = Buffer.create 32 in
bprintf buff "digraph G {\n";
......@@ -773,7 +773,7 @@ module G_graph = struct
Massoc_gid.iter
(fun tar g_edge ->
let deco = List.mem (id,g_edge,tar) deco.G_deco.edges in
bprintf buff " N_%s -> N_%s%s\n" (Gid.to_string id) (Gid.to_string tar) (G_edge.to_dot label_domain ~deco g_edge)
bprintf buff " N_%s -> N_%s%s\n" (Gid.to_string id) (Gid.to_string tar) (G_edge.to_dot domain ~deco g_edge)
) (G_node.get_next node)
) graph.map;
......@@ -781,7 +781,7 @@ module G_graph = struct
Buffer.contents buff
(* -------------------------------------------------------------------------------- *)
let to_raw label_domain graph =
let to_raw domain graph =
let nodes = Gid_map.fold (fun id elt acc -> (id,elt)::acc) graph.map [] in
let snodes = List.sort (fun (_,n1) (_,n2) -> G_node.position_comp n1 n2) nodes in
let raw_nodes = List.map (fun (gid,node) -> (gid, G_fs.to_raw (G_node.get_fs node))) snodes in
......@@ -792,7 +792,7 @@ module G_graph = struct
(fun src_gid node ->
Massoc_gid.iter
(fun tar_gid edge ->
edge_list := (get_num src_gid, G_edge.to_string label_domain edge, get_num tar_gid) :: !edge_list
edge_list := (get_num src_gid, G_edge.to_string domain edge, get_num tar_gid) :: !edge_list
)
(G_node.get_next node)
)
......@@ -800,7 +800,7 @@ module G_graph = struct
(graph.meta, List.map snd raw_nodes, !edge_list)
(* -------------------------------------------------------------------------------- *)
let to_conll label_domain graph =
let to_conll domain graph =
let nodes = Gid_map.fold
(fun gid node acc -> (gid,node)::acc)
graph.map [] in
......@@ -827,7 +827,7 @@ module G_graph = struct
Massoc_gid.fold
(fun acc2 tar_gid edge ->
let old = try Gid_map.find tar_gid acc2 with Not_found -> [] in
Gid_map.add tar_gid ((sprintf "%g" src_num, G_edge.to_string label_domain edge)::old) acc2
Gid_map.add tar_gid ((sprintf "%g" src_num, G_edge.to_string domain edge)::old) acc2
) acc (G_node.get_next node)
) graph.map Gid_map.empty in
......
......@@ -53,8 +53,7 @@ module P_graph: sig
}
val build:
Feature_domain.t ->
Label_domain.t ->
Domain.t ->
?pat_vars: string list ->
?locals: Label_domain.decl array ->
Ast.node list ->
......@@ -62,8 +61,7 @@ module P_graph: sig
(t * Id.table)
val build_extension:
Feature_domain.t ->
Label_domain.t ->
Domain.t ->
?pat_vars: string list ->
?locals: Label_domain.decl array ->
Id.table ->
......@@ -94,7 +92,7 @@ module G_graph: sig
val max_binding: t -> int
(** [edge_out label_domain t id label_cst] returns true iff there is an out-edge from the node [id] with a label compatible with [label_cst] *)
val edge_out: Label_domain.t -> t -> Gid.t -> Label_cst.t -> bool
val edge_out: Domain.t -> t -> Gid.t -> Label_cst.t -> bool
(** [get_annot_info graph] searches for exactly one node with an annot-feature (with name starting with "__").
It returns the annot-feature name without the prefix "__" together with the position.
......@@ -105,15 +103,15 @@ module G_graph: sig
(* Build functions *)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
val build: Feature_domain.t -> Label_domain.t -> ?locals: Label_domain.decl array -> Ast.gr -> t
val build: Domain.t -> ?locals: Label_domain.decl array -> Ast.gr -> t
val of_conll: ?loc:Loc.t -> Feature_domain.t -> Label_domain.t -> Conll.t -> t
val of_conll: ?loc:Loc.t -> Domain.t -> Conll.t -> t
(** input : "Le/DET/le petit/ADJ/petit chat/NC/chat dort/V/dormir ./PONCT/."
It supposes that "SUC" is defined in current relations *)
val of_brown: Feature_domain.t -> Label_domain.t -> ?sentid: string -> string -> t
val of_brown: Domain.t -> ?sentid: string -> string -> t
val of_xml: Feature_domain.t -> Label_domain.t -> Xml.xml -> t
val of_xml: Domain.t -> Xml.xml -> t
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
(* Update functions *)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
......@@ -129,32 +127,32 @@ module G_graph: sig
(** [del_edge ?edge_ident loc graph id_src label id_tar] removes the edge (id_src -[label]-> id_tar) from graph.
Log.critical if the edge is not in graph *)
val del_edge: Label_domain.t -> ?edge_ident: string -> Loc.t -> t -> Gid.t -> G_edge.t -> Gid.t -> t
val del_edge: Domain.t -> ?edge_ident: string -> Loc.t -> t -> Gid.t -> G_edge.t -> Gid.t -> t
(** [del_node graph id] remove node [id] from [graph], with all its incoming and outcoming edges.
[graph] is unchanged if the node is not in it. *)
val del_node: t -> Gid.t -> t
val add_neighbour: Loc.t -> Label_domain.t -> t -> Gid.t -> G_edge.t -> (Gid.t * t)
val add_neighbour: Loc.t -> Domain.t -> t -> Gid.t -> G_edge.t -> (Gid.t * t)
val activate: Loc.t -> Gid.t -> string -> t -> (Gid.t * t)
val merge_node: Loc.t -> Label_domain.t -> t -> Gid.t -> Gid.t -> t option
val merge_node: Loc.t -> Domain.t -> t -> Gid.t -> Gid.t -> t option
(** move all in arcs to id_src are moved to in arcs on node id_tar from graph, with all its incoming edges *)
val shift_in: Loc.t -> Label_domain.t -> Gid.t -> Gid.t -> Label_cst.t -> t -> t
val shift_in: Loc.t -> Domain.t -> Gid.t -> Gid.t -> Label_cst.t -> t -> t
(** move all out-edges from id_src are moved to out-edges out off node id_tar *)
val shift_out: Loc.t -> Label_domain.t -> Gid.t -> Gid.t -> Label_cst.t -> t -> t
val shift_out: Loc.t -> Domain.t -> Gid.t -> Gid.t -> Label_cst.t -> t -> t
(** move all incident arcs from/to id_src are moved to incident arcs on node id_tar from graph, with all its incoming and outcoming edges *)
val shift_edges: Loc.t -> Label_domain.t -> Gid.t -> Gid.t -> Label_cst.t -> t -> t
val shift_edges: Loc.t -> Domain.t -> Gid.t -> Gid.t -> Label_cst.t -> t -> t
(** [update_feat domain 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].
It returns both the new graph and the new feature value produced as the second element *)
val update_feat: ?loc:Loc.t -> Feature_domain.t -> t -> Gid.t -> string -> Concat_item.t list -> (t * string)
val update_feat: ?loc:Loc.t -> Domain.t -> t -> Gid.t -> string -> Concat_item.t list -> (t * string)
val set_feat: ?loc:Loc.t -> Feature_domain.t -> t -> Gid.t -> string -> string -> t
val set_feat: ?loc:Loc.t -> Domain.t -> t -> Gid.t -> string -> string -> t
(** [del_feat graph node_id feat_name] returns [graph] where the feat [feat_name] of [node_id] is deleted
If the feature is not present, [graph] is returned. *)
......@@ -163,13 +161,13 @@ module G_graph: sig
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
(* Output functions *)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
val to_gr: Label_domain.t -> t -> string
val to_dot: Label_domain.t -> ?main_feat:string -> ?deco:G_deco.t -> t -> string