Commit 48b71885 authored by bguillaum's avatar bguillaum

Make domain optional

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@9065 7838e531-6607-4d57-9587-6c381814729c
parent 3cff195e
...@@ -72,7 +72,7 @@ module Command = struct ...@@ -72,7 +72,7 @@ module Command = struct
| H_MERGE_NODE of (Gid.t * Gid.t) | H_MERGE_NODE of (Gid.t * Gid.t)
let build domain label_domain ?param (kai, kei) table locals ast_command = let build ?domain ?param (kai, kei) table locals ast_command =
(* kai stands for "known act ident", kei for "known edge ident" *) (* kai stands for "known act ident", kei for "known edge ident" *)
let pid_of_act_id loc node_name = let pid_of_act_id loc node_name =
...@@ -95,7 +95,7 @@ module Command = struct ...@@ -95,7 +95,7 @@ module Command = struct
| (Ast.Del_edge_expl (act_i, act_j, lab), loc) -> | (Ast.Del_edge_expl (act_i, act_j, lab), loc) ->
check_node_id loc act_i kai; check_node_id loc act_i kai;
check_node_id loc act_j kai; check_node_id loc act_j kai;
let edge = G_edge.make ~loc label_domain lab in let edge = G_edge.make ~loc ?domain lab in
((DEL_EDGE_EXPL (pid_of_act_id loc act_i, pid_of_act_id loc act_j, edge), loc), (kai, kei)) ((DEL_EDGE_EXPL (pid_of_act_id loc act_i, pid_of_act_id loc act_j, edge), loc), (kai, kei))
| (Ast.Del_edge_name id, loc) -> | (Ast.Del_edge_name id, loc) ->
...@@ -105,23 +105,23 @@ module Command = struct ...@@ -105,23 +105,23 @@ module Command = struct
| (Ast.Add_edge (act_i, act_j, lab), loc) -> | (Ast.Add_edge (act_i, act_j, lab), loc) ->
check_node_id loc act_i kai; check_node_id loc act_i kai;
check_node_id loc act_j kai; check_node_id loc act_j kai;
let edge = G_edge.make ~loc label_domain lab in let edge = G_edge.make ~loc ?domain lab in
((ADD_EDGE (pid_of_act_id loc act_i, pid_of_act_id loc act_j, edge), loc), (kai, kei)) ((ADD_EDGE (pid_of_act_id loc act_i, pid_of_act_id loc act_j, edge), loc), (kai, kei))
| (Ast.Shift_edge (act_i, act_j, label_cst), loc) -> | (Ast.Shift_edge (act_i, act_j, label_cst), loc) ->
check_node_id loc act_i kai; check_node_id loc act_i kai;
check_node_id loc act_j kai; check_node_id loc act_j kai;
((SHIFT_EDGE (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build ~loc label_domain label_cst), loc), (kai, kei)) ((SHIFT_EDGE (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build ~loc ?domain label_cst), loc), (kai, kei))
| (Ast.Shift_in (act_i, act_j, label_cst), loc) -> | (Ast.Shift_in (act_i, act_j, label_cst), loc) ->
check_node_id loc act_i kai; check_node_id loc act_i kai;
check_node_id loc act_j kai; check_node_id loc act_j kai;
((SHIFT_IN (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build label_domain ~loc label_cst), loc), (kai, kei)) ((SHIFT_IN (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build ?domain ~loc label_cst), loc), (kai, kei))
| (Ast.Shift_out (act_i, act_j, label_cst), loc) -> | (Ast.Shift_out (act_i, act_j, label_cst), loc) ->
check_node_id loc act_i kai; check_node_id loc act_i kai;
check_node_id loc act_j kai; check_node_id loc act_j kai;
((SHIFT_OUT (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build label_domain ~loc label_cst), loc), (kai, kei)) ((SHIFT_OUT (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build ?domain ~loc label_cst), loc), (kai, kei))
| (Ast.Merge_node (act_i, act_j), loc) -> | (Ast.Merge_node (act_i, act_j), loc) ->
check_node_id loc act_i kai; check_node_id loc act_i kai;
...@@ -133,7 +133,7 @@ module Command = struct ...@@ -133,7 +133,7 @@ module Command = struct
if List.mem new_id kai if List.mem new_id kai
then Error.build ~loc "Node identifier \"%s\" is already used" new_id; then Error.build ~loc "Node identifier \"%s\" is already used" new_id;
let edge = G_edge.make ~loc label_domain label in let edge = G_edge.make ~loc ?domain label in
begin begin
try try
( (
...@@ -146,7 +146,7 @@ module Command = struct ...@@ -146,7 +146,7 @@ module Command = struct
) )
with Not_found -> with Not_found ->
Log.fcritical "[GRS] tries to build a command New_neighbour (%s) on node %s which is not in the pattern %s" Log.fcritical "[GRS] tries to build a command New_neighbour (%s) on node %s which is not in the pattern %s"
(G_edge.to_string label_domain edge) (G_edge.to_string ?domain edge)
ancestor ancestor
(Loc.to_string loc) (Loc.to_string loc)
end end
...@@ -176,7 +176,7 @@ module Command = struct ...@@ -176,7 +176,7 @@ module Command = struct
if feat_name = "position" if feat_name = "position"
then Error.build ~loc "Illegal del_feat command: the 'position' feature cannot be deleted"; then Error.build ~loc "Illegal del_feat command: the 'position' feature cannot be deleted";
check_node_id loc act_id kai; check_node_id loc act_id kai;
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)) ((DEL_FEAT (pid_of_act_id loc act_id, feat_name), loc), (kai, kei))
| (Ast.Update_feat ((act_id, feat_name), ast_items), loc) -> | (Ast.Update_feat ((act_id, feat_name), ast_items), loc) ->
...@@ -185,7 +185,7 @@ module Command = struct ...@@ -185,7 +185,7 @@ module Command = struct
(function (function
| Ast.Qfn_item (node_id,feature_name) -> | Ast.Qfn_item (node_id,feature_name) ->
check_node_id loc node_id kai; check_node_id loc node_id kai;
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) Feat (pid_of_node_id loc node_id, feature_name)
| Ast.String_item s -> String s | Ast.String_item s -> String s
| Ast.Param_item var -> | Ast.Param_item var ->
...@@ -199,9 +199,9 @@ module Command = struct ...@@ -199,9 +199,9 @@ module Command = struct
) ast_items in ) ast_items in
(* check for consistency *) (* check for consistency *)
(match items with (match items with
| _ when Domain.is_open_feature domain feat_name -> () | _ when Domain.is_open_feature ?domain feat_name -> ()
| [Param_out _] -> () (* TODO: check that lexical parameters are compatible with the feature domain *) | [Param_out _] -> () (* TODO: check that lexical parameters are compatible with the feature domain *)
| [String s] -> Domain.check_feature ~loc domain feat_name s | [String s] -> Domain.check_feature ~loc ?domain feat_name s
| [Feat (_,fn)] -> () | [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); | _ -> 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)) ((UPDATE_FEAT (pid_of_act_id loc act_id, feat_name, items), loc), (kai, kei))
......
...@@ -64,8 +64,7 @@ module Command : sig ...@@ -64,8 +64,7 @@ module Command : sig
| H_MERGE_NODE of (Gid.t * Gid.t) | H_MERGE_NODE of (Gid.t * Gid.t)
val build: val build:
Domain.t -> ?domain: Domain.t ->
Domain.t ->
?param: (string list * string list) -> ?param: (string list * string list) ->
(Id.name list * string list) -> (Id.name list * string list) ->
Id.table -> Id.table ->
......
...@@ -23,21 +23,21 @@ module Label_cst = struct ...@@ -23,21 +23,21 @@ module Label_cst = struct
| Neg of Label.t list | Neg of Label.t list
| Regexp of (Str.regexp * string) | Regexp of (Str.regexp * string)
let to_string label_domain = function let to_string ?domain = function
| Pos l -> (List_.to_string (Label.to_string label_domain) "|" l) | Pos l -> (List_.to_string (Label.to_string ?domain) "|" l)
| Neg l -> "^"^(List_.to_string (Label.to_string label_domain) "|" l) | Neg l -> "^"^(List_.to_string (Label.to_string ?domain) "|" l)
| Regexp (_,re) -> "re\""^re^"\"" | Regexp (_,re) -> "re\""^re^"\""
let all = Neg [] let all = Neg []
let match_ label_domain cst g_label = match cst with let match_ ?domain cst g_label = match cst with
| Pos labels -> Label.match_list labels g_label | Pos labels -> Label.match_list labels g_label
| Neg labels -> not (Label.match_list labels g_label) | Neg labels -> not (Label.match_list labels g_label)
| Regexp (re,_) -> String_.re_match re (Label.to_string label_domain g_label) | Regexp (re,_) -> String_.re_match re (Label.to_string ?domain g_label)
let build ?loc label_domain = function let build ?loc ?domain = function
| Ast.Neg_list p_labels -> Neg (List.sort compare (List.map (Label.from_string ?loc label_domain) p_labels)) | Ast.Neg_list p_labels -> Neg (List.sort compare (List.map (Label.from_string ?loc ?domain) p_labels))
| Ast.Pos_list p_labels -> Pos (List.sort compare (List.map (Label.from_string ?loc label_domain) p_labels)) | Ast.Pos_list p_labels -> Pos (List.sort compare (List.map (Label.from_string ?loc ?domain) p_labels))
| Ast.Regexp re -> Regexp (Str.regexp re, re) | Ast.Regexp re -> Regexp (Str.regexp re, re)
end (* module Label_cst *) end (* module Label_cst *)
...@@ -45,20 +45,20 @@ end (* module Label_cst *) ...@@ -45,20 +45,20 @@ end (* module Label_cst *)
module G_edge = struct module G_edge = struct
type t = Label.t type t = Label.t
let to_string label_domain t = Label.to_string label_domain t let to_string ?domain t = Label.to_string ?domain t
let make ?loc label_domain string = Label.from_string ?loc label_domain string let make ?loc ?domain string = Label.from_string ?loc ?domain string
let build label_domain (ast_edge, loc) = let build ?domain (ast_edge, loc) =
match ast_edge.Ast.edge_label_cst with match ast_edge.Ast.edge_label_cst with
| Ast.Pos_list [one] -> Label.from_string ~loc label_domain one | Ast.Pos_list [one] -> Label.from_string ~loc ?domain one
| Ast.Neg_list _ -> Error.build "Negative edge spec are forbidden in graphs%s" (Loc.to_string loc) | Ast.Neg_list _ -> Error.build "Negative edge spec are forbidden in graphs%s" (Loc.to_string loc)
| Ast.Pos_list _ -> Error.build "Only atomic edge values are allowed in graphs%s" (Loc.to_string loc) | Ast.Pos_list _ -> Error.build "Only atomic edge values are allowed in graphs%s" (Loc.to_string loc)
| Ast.Regexp _ -> Error.build "Regexp are not allowed in graphs%s" (Loc.to_string loc) | Ast.Regexp _ -> Error.build "Regexp are not allowed in graphs%s" (Loc.to_string loc)
let is_void label_domain t = Label.is_void label_domain t let is_void ?domain t = Label.is_void ?domain t
let to_dep label_domain ?(deco=false) t = Label.to_dep label_domain ~deco t let to_dep ?domain ?(deco=false) t = Label.to_dep ?domain ~deco t
let to_dot label_domain ?(deco=false) t = Label.to_dot label_domain ~deco t let to_dot ?domain ?(deco=false) t = Label.to_dot ?domain ~deco t
let color_of_option = function let color_of_option = function
| [] -> None | [] -> None
...@@ -76,34 +76,34 @@ module P_edge = struct ...@@ -76,34 +76,34 @@ module P_edge = struct
let get_id t = t.id let get_id t = t.id
let build label_domain (ast_edge, loc) = let build ?domain (ast_edge, loc) =
{ id = ast_edge.Ast.edge_id; { id = ast_edge.Ast.edge_id;
label_cst = Label_cst.build ~loc label_domain ast_edge.Ast.edge_label_cst label_cst = Label_cst.build ~loc ?domain ast_edge.Ast.edge_label_cst
} }
let to_string label_domain t = let to_string ?domain t =
match t.id with match t.id with
| None -> Label_cst.to_string label_domain t.label_cst | None -> Label_cst.to_string ?domain t.label_cst
| Some i -> sprintf "%s:%s" i (Label_cst.to_string label_domain t.label_cst) | Some i -> sprintf "%s:%s" i (Label_cst.to_string ?domain t.label_cst)
type edge_matcher = type edge_matcher =
| Fail | Fail
| Ok of Label.t | Ok of Label.t
| Binds of string * Label.t list | Binds of string * Label.t list
let match_ label_domain p_edge g_edge = let match_ ?domain p_edge g_edge =
match p_edge with match p_edge with
| {id = None; label_cst } when Label_cst.match_ label_domain label_cst g_edge -> Ok g_edge | {id = None; label_cst } when Label_cst.match_ ?domain label_cst g_edge -> Ok g_edge
| {id = Some i; label_cst } when Label_cst.match_ label_domain label_cst g_edge -> Binds (i, [g_edge]) | {id = Some i; label_cst } when Label_cst.match_ ?domain label_cst g_edge -> Binds (i, [g_edge])
| _ -> Fail | _ -> Fail
let match_list label_domain p_edge g_edge_list = let match_list ?domain p_edge g_edge_list =
match p_edge with match p_edge with
| {id = None; label_cst} when List.exists (fun g_edge -> Label_cst.match_ label_domain label_cst g_edge) g_edge_list -> | {id = None; label_cst} when List.exists (fun g_edge -> Label_cst.match_ ?domain label_cst g_edge) g_edge_list ->
Ok (List.hd g_edge_list) Ok (List.hd g_edge_list)
| {id = None} -> Fail | {id = None} -> Fail
| {id = Some i; label_cst } -> | {id = Some i; label_cst } ->
( match List.filter (fun g_edge -> Label_cst.match_ label_domain label_cst g_edge) g_edge_list with ( match List.filter (fun g_edge -> Label_cst.match_ ?domain label_cst g_edge) g_edge_list with
| [] -> Fail | [] -> Fail
| list -> Binds (i, list) | list -> Binds (i, list)
) )
......
...@@ -21,10 +21,10 @@ module Label_cst : sig ...@@ -21,10 +21,10 @@ module Label_cst : sig
| Neg of Label.t list | Neg of Label.t list
| Regexp of (Str.regexp * string) | Regexp of (Str.regexp * string)
val to_string: Domain.t -> t -> string val to_string: ?domain:Domain.t -> t -> string
val all: t val all: t
val match_: Domain.t -> t -> Label.t -> bool val match_: ?domain:Domain.t -> t -> Label.t -> bool
val build: ?loc:Loc.t -> Domain.t -> Ast.edge_label_cst -> t val build: ?loc:Loc.t -> ?domain:Domain.t -> Ast.edge_label_cst -> t
end (* module Label_cst *) end (* module Label_cst *)
...@@ -33,15 +33,15 @@ end (* module Label_cst *) ...@@ -33,15 +33,15 @@ end (* module Label_cst *)
module G_edge: sig module G_edge: sig
type t = Label.t type t = Label.t
val to_string: Domain.t -> t -> string val to_string: ?domain:Domain.t -> t -> string
val make: ?loc:Loc.t -> Domain.t -> string -> t val make: ?loc:Loc.t -> ?domain:Domain.t -> string -> t
val build: Domain.t -> Ast.edge -> t val build: ?domain:Domain.t -> Ast.edge -> t
val is_void: Domain.t -> t -> bool val is_void: ?domain:Domain.t -> t -> bool
val to_dot: Domain.t -> ?deco:bool -> t -> string val to_dot: ?domain:Domain.t -> ?deco:bool -> t -> string
val to_dep: Domain.t -> ?deco:bool -> t -> string val to_dep: ?domain:Domain.t -> ?deco:bool -> t -> string
end (* module G_edge *) end (* module G_edge *)
(* ================================================================================ *) (* ================================================================================ *)
...@@ -54,16 +54,16 @@ module P_edge: sig ...@@ -54,16 +54,16 @@ module P_edge: sig
val get_id: t -> string option val get_id: t -> string option
val to_string: Domain.t -> t -> string val to_string: ?domain:Domain.t -> t -> string
val build: Domain.t -> Ast.edge -> t val build: ?domain:Domain.t -> Ast.edge -> t
type edge_matcher = type edge_matcher =
| Fail | Fail
| Ok of Label.t | Ok of Label.t
| Binds of string * Label.t list | Binds of string * Label.t list
val match_: Domain.t -> t -> G_edge.t -> edge_matcher val match_: ?domain:Domain.t -> t -> G_edge.t -> edge_matcher
val match_list: Domain.t -> t -> G_edge.t list -> edge_matcher val match_list: ?domain:Domain.t -> t -> G_edge.t list -> edge_matcher
end (* module P_edge *) end (* module P_edge *)
...@@ -36,9 +36,9 @@ module G_feature = struct ...@@ -36,9 +36,9 @@ module G_feature = struct
| (None, Some j) -> 1 | (None, Some j) -> 1
| (None, None) -> Pervasives.compare name1 name2 | (None, None) -> Pervasives.compare name1 name2
let build domain = function let build ?domain = function
| ({Ast.kind=Ast.Equality [atom]; name=name},loc) -> | ({Ast.kind=Ast.Equality [atom]; name=name},loc) ->
(name, Feature_value.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)" | _ -> 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) let to_string (feat_name, feat_val) = sprintf "%s=%s" feat_name (string_of_value feat_val)
...@@ -134,14 +134,14 @@ module P_feature = struct ...@@ -134,14 +134,14 @@ module P_feature = struct
| _ -> Error.bug "[P_feature.to_string] multiple parameters are not handled" | _ -> Error.bug "[P_feature.to_string] multiple parameters are not handled"
let build domain ?pat_vars = function let build ?domain ?pat_vars = function
| ({Ast.kind=Ast.Absent; name=name}, loc) -> | ({Ast.kind=Ast.Absent; name=name}, loc) ->
Domain.check_feature_name ~loc domain name; Domain.check_feature_name ~loc ?domain name;
(name, {cst=Absent;in_param=[];}) (name, {cst=Absent;in_param=[];})
| ({Ast.kind=Ast.Equality unsorted_values; name=name}, loc) -> | ({Ast.kind=Ast.Equality unsorted_values; name=name}, loc) ->
let values = Feature_value.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) -> | ({Ast.kind=Ast.Disequality unsorted_values; name=name}, loc) ->
let values = Feature_value.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) -> | ({Ast.kind=Ast.Equal_param var; name=name}, loc) ->
begin begin
match pat_vars with match pat_vars with
...@@ -165,8 +165,8 @@ module G_fs = struct ...@@ -165,8 +165,8 @@ module G_fs = struct
let empty = [] let empty = []
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
let set_feat ?loc domain feature_name atom t = let set_feat ?loc ?domain feature_name atom t =
let new_value = Feature_value.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 let rec loop = function
| [] -> [(feature_name, new_value)] | [] -> [(feature_name, new_value)]
| ((fn,_)::_) as t when feature_name < fn -> (feature_name, new_value)::t | ((fn,_)::_) as t when feature_name < fn -> (feature_name, new_value)::t
...@@ -207,22 +207,22 @@ module G_fs = struct ...@@ -207,22 +207,22 @@ module G_fs = struct
let to_gr t = List_.to_string G_feature.to_gr ", " t let to_gr t = List_.to_string G_feature.to_gr ", " t
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
let build domain ast_fs = let build ?domain ast_fs =
let unsorted = List.map (fun feat -> G_feature.build domain feat) ast_fs in let unsorted = List.map (fun feat -> G_feature.build ?domain feat) ast_fs in
List.sort G_feature.compare unsorted List.sort G_feature.compare unsorted
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
let of_conll ?loc domain line = let of_conll ?loc ?domain line =
let raw_list0 = let raw_list0 =
("phon", Feature_value.build_value ?loc domain "phon" line.Conll.form) ("phon", Feature_value.build_value ?loc ?domain "phon" line.Conll.form)
:: ("cat", Feature_value.build_value ?loc domain "cat" line.Conll.upos) :: ("cat", Feature_value.build_value ?loc ?domain "cat" line.Conll.upos)
:: (List.map (fun (f,v) -> (f, Feature_value.build_value ?loc domain f v)) line.Conll.feats) in :: (List.map (fun (f,v) -> (f, Feature_value.build_value ?loc ?domain f v)) line.Conll.feats) in
let raw_list1 = match line.Conll.xpos with let raw_list1 = match line.Conll.xpos with
| "" | "_" -> raw_list0 | "" | "_" -> raw_list0
| s -> ("pos", Feature_value.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 let raw_list2 = match line.Conll.lemma with
| "" | "_" -> raw_list1 | "" | "_" -> raw_list1
| s -> ("lemma", Feature_value.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 List.sort G_feature.compare raw_list2
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
...@@ -357,8 +357,8 @@ module P_fs = struct ...@@ -357,8 +357,8 @@ module P_fs = struct
| _ -> Error.bug "Position can't be parametrized" | _ -> Error.bug "Position can't be parametrized"
with Not_found -> true with Not_found -> true
let build domain ?pat_vars ast_fs = let build ?domain ?pat_vars ast_fs =
let unsorted = List.map (P_feature.build domain ?pat_vars) ast_fs in let unsorted = List.map (P_feature.build ?domain ?pat_vars) ast_fs in
List.sort P_feature.compare unsorted List.sort P_feature.compare unsorted
let feat_list t = List.map P_feature.get_name t let feat_list t = List.map P_feature.get_name t
......
...@@ -23,7 +23,7 @@ module G_fs: sig ...@@ -23,7 +23,7 @@ module G_fs: sig
(** [set_feat domain feature_name atom t] adds the feature ([feature_name],[atom]) in [t]. (** [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. *) If [t] already contains a feature named [feature_name], the old value is erased by the new one. *)
val set_feat: ?loc:Loc.t -> Domain.t -> feature_name -> string -> t -> t val set_feat: ?loc:Loc.t -> ?domain:Domain.t -> feature_name -> string -> t -> t
(** [del_feat feature_name t] remove the feature with name [feature_name] in [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. *) If [t] does not contain such a feature, [t] is returned unchanged. *)
...@@ -48,9 +48,9 @@ module G_fs: sig ...@@ -48,9 +48,9 @@ module G_fs: sig
val to_string: t -> string val to_string: t -> string
val build: Domain.t -> Ast.feature list -> t val build: ?domain:Domain.t -> Ast.feature list -> t
val of_conll: ?loc:Loc.t -> Domain.t -> Conll.line -> t val of_conll: ?loc:Loc.t -> ?domain:Domain.t -> Conll.line -> t
(** [unif t1 t2] returns [Some t] if [t] is the unification of two graph feature structures (** [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. *) [None] is returned if the two feature structures cannot be unified. *)
...@@ -64,7 +64,7 @@ module P_fs: sig ...@@ -64,7 +64,7 @@ module P_fs: sig
val empty: t val empty: t
val build: Domain.t -> ?pat_vars: string list -> Ast.feature list -> t val build: ?domain:Domain.t -> ?pat_vars: string list -> Ast.feature list -> t
val to_string: t -> string val to_string: t -> string
......
This diff is collapsed.
...@@ -56,7 +56,7 @@ module P_graph: sig ...@@ -56,7 +56,7 @@ module P_graph: sig
(** It raises [P_fs.Fail_unif] exception in case of inconsistent feature structures. *) (** It raises [P_fs.Fail_unif] exception in case of inconsistent feature structures. *)
val build: val build:
Domain.t -> ?domain:Domain.t ->
?pat_vars: string list -> ?pat_vars: string list ->
?locals: Label_domain.decl array -> ?locals: Label_domain.decl array ->
Ast.node list -> Ast.node list ->
...@@ -65,7 +65,7 @@ module P_graph: sig ...@@ -65,7 +65,7 @@ module P_graph: sig
(** It raises [P_fs.Fail_unif] exception in case of inconsistent feature structures. *) (** It raises [P_fs.Fail_unif] exception in case of inconsistent feature structures. *)
val build_extension: val build_extension:
Domain.t -> ?domain:Domain.t ->
?pat_vars: string list -> ?pat_vars: string list ->
?locals: Label_domain.decl array -> ?locals: Label_domain.decl array ->
Id.table -> Id.table ->
...@@ -93,7 +93,7 @@ module G_graph: sig ...@@ -93,7 +93,7 @@ module G_graph: sig
val get_highest: t -> int val get_highest: 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] *) (** [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: Domain.t -> t -> Gid.t -> Label_cst.t -> bool val edge_out: ?domain: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 "__"). (** [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. It returns the annot-feature name without the prefix "__" together with the position.
...@@ -104,15 +104,15 @@ module G_graph: sig ...@@ -104,15 +104,15 @@ module G_graph: sig
(* Build functions *) (* Build functions *)
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *) (* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
val build: Domain.t -> ?grewpy: bool -> ?locals: Label_domain.decl array -> Ast.gr -> t val build: ?domain:Domain.t -> ?grewpy: bool -> ?locals: Label_domain.decl array -> Ast.gr -> t
val of_conll: Domain.t -> Conll.t -> t val of_conll: ?domain:Domain.t -> Conll.t -> t