Commit b2904594 authored by bguillaum's avatar bguillaum

0.16.1: fix lack of checking

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@7583 7838e531-6607-4d57-9587-6c381814729c
parent 39319d87
VERSION = 0.16.0 VERSION = 0.16.1
INSTALL_DIR_LIB = @OCAMLLIB@ INSTALL_DIR_LIB = @OCAMLLIB@
INSTALL_DIR = @prefix@/bin/ INSTALL_DIR = @prefix@/bin/
......
...@@ -19,32 +19,12 @@ module Domain = struct ...@@ -19,32 +19,12 @@ module Domain = struct
let init ast_domain = current := Some ast_domain let init ast_domain = current := Some ast_domain
let check ?loc name values =
if name.[0] <> '_'
then
match (name.[0], !current) with
| ('_', _)
| (_,None) -> ()
| (_, Some d) ->
let rec loop = function
| [] -> Error.build ?loc "[GRS] Unknown feature name '%s'" name
| ((Ast.Open n)::_) when n = name -> ()
| ((Ast.Closed (n,vs))::_) when n = name ->
(match List_.sort_diff values vs with
| [] -> ()
| l -> Error.build ?loc "Unknown feature values '%s' for feature name '%s'"
(List_.to_string (fun x->x) ", " l)
name
)
| _::t -> loop t in
loop d
let build ?loc name unsorted_values = let build ?loc name unsorted_values =
let values = List.sort Pervasives.compare unsorted_values in let values = List.sort Pervasives.compare unsorted_values in
match (name.[0], !current) with match (name.[0], !current) with
| ('_', _) | ('_', _) (* no check on feat_name starting with '_' *)
| (_, None) -> List.map (fun s -> String s) values (* no check on feat_name starting with '_' *) | (_, None) -> List.map (fun s -> String s) values (* no domain defined *)
| (_, Some d) -> | (_, Some dom) ->
let rec loop = function let rec loop = function
| [] -> Error.build ?loc "[GRS] Unknown feature name '%s'" name | [] -> Error.build ?loc "[GRS] Unknown feature name '%s'" name
| ((Ast.Open n)::_) when n = name -> | ((Ast.Open n)::_) when n = name ->
...@@ -60,7 +40,7 @@ module Domain = struct ...@@ -60,7 +40,7 @@ module Domain = struct
name name
) )
| _::t -> loop t in | _::t -> loop t in
loop d loop dom
let build_one ?loc name value = let build_one ?loc name value =
match build ?loc name [value] with match build ?loc name [value] with
...@@ -79,25 +59,18 @@ module G_feature = struct ...@@ -79,25 +59,18 @@ module G_feature = struct
let build (x : Ast.feature) = match x with let build (x : Ast.feature) = match x with
| ({Ast.kind=Ast.Equality [atom]; name=name},loc) -> | ({Ast.kind=Ast.Equality [atom]; name=name},loc) ->
(* Domain.check ~loc name [atom]; *)
(* (name, atom) *)
(name, Domain.build_one ~loc name atom) (name, Domain.build_one ~loc 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)
let to_gr (feat_name, feat_val) = let to_gr (feat_name, feat_val) = sprintf "%s=%s" feat_name (string_of_value feat_val)
match feat_val with
| String s -> sprintf "%s=\"%s\"" feat_name s
| Int i -> sprintf "%s=\"%d\"" feat_name i
let to_dot (feat_name, feat_val) = let to_dot (feat_name, feat_val) =
match feat_val with let string_val = string_of_value feat_val in
| Int i -> sprintf "%s=%d" feat_name i match Str.split (Str.regexp ":C:") string_val with
| String s -> | [] -> Error.bug "[G_feature.to_dot] feature value '%s'" string_val
match Str.split (Str.regexp ":C:") s with | fv::_ -> sprintf "%s=%s" feat_name fv
| [] -> Error.bug "[G_feature.to_dot] feature value '%s'" s
| fv::_ -> sprintf "%s=%s" feat_name fv
end end
(* ==================================================================================================== *) (* ==================================================================================================== *)
...@@ -136,14 +109,8 @@ module P_feature = struct ...@@ -136,14 +109,8 @@ module P_feature = struct
let build ?pat_vars = function let build ?pat_vars = function
| ({Ast.kind=Ast.Equality unsorted_values; name=name}, loc) -> | ({Ast.kind=Ast.Equality unsorted_values; name=name}, loc) ->
let values = Domain.build ~loc name unsorted_values in (name, Equal values) let values = Domain.build ~loc name unsorted_values in (name, Equal values)
(* let values = List.sort Pervasives.compare unsorted_values in *)
(* Domain.check ~loc name values; *)
(* (name, Equal values) *)
| ({Ast.kind=Ast.Disequality unsorted_values; name=name}, loc) -> | ({Ast.kind=Ast.Disequality unsorted_values; name=name}, loc) ->
let values = Domain.build ~loc name unsorted_values in (name, Different values) let values = Domain.build ~loc name unsorted_values in (name, Different values)
(* let values = List.sort Pervasives.compare unsorted_values in *)
(* Domain.check ~loc name values; *)
(* (name, Different values) *)
| ({Ast.kind=Ast.Param var; name=name}, loc) -> | ({Ast.kind=Ast.Param var; name=name}, loc) ->
match pat_vars with match pat_vars with
| None -> Error.bug ~loc "[P_feature.build] param '%s' in an unparametrized rule" var | None -> Error.bug ~loc "[P_feature.build] param '%s' in an unparametrized rule" var
...@@ -164,7 +131,6 @@ module G_fs = struct ...@@ -164,7 +131,6 @@ module G_fs = struct
let set_feat ?loc feature_name atom t = let set_feat ?loc feature_name atom t =
let new_value = Domain.build_one ?loc feature_name atom in let new_value = Domain.build_one ?loc feature_name atom in
(* Domain.check ?loc feature_name [atom]; *)
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
...@@ -196,12 +162,12 @@ module G_fs = struct ...@@ -196,12 +162,12 @@ module G_fs = struct
let of_conll line = let of_conll line =
let unsorted = let unsorted =
("phon", String line.Conll.phon) ("phon", Domain.build_one "phon" line.Conll.phon)
:: ("lemma", String line.Conll.lemma) :: ("lemma", Domain.build_one "lemma" line.Conll.lemma)
:: ("cat", String line.Conll.pos1) :: ("cat", Domain.build_one "cat" line.Conll.pos1)
:: ("pos", String line.Conll.pos2) :: ("pos", Domain.build_one "pos" line.Conll.pos2)
:: ("position", Int line.Conll.num) :: ("position", Domain.build_one "position" (string_of_int line.Conll.num))
:: (List.map (fun (f,v) -> (f, String v)) line.Conll.morph) in :: (List.map (fun (f,v) -> (f, Domain.build_one f v)) line.Conll.morph) in
List.sort G_feature.compare unsorted List.sort G_feature.compare unsorted
exception Fail_unif exception Fail_unif
......
...@@ -483,7 +483,7 @@ module G_graph = struct ...@@ -483,7 +483,7 @@ module G_graph = struct
let node = Gid_map.find node_gid graph.map in let node = Gid_map.find node_gid graph.map in
(match G_fs.get_string_atom feat_name (G_node.get_fs node) with (match G_fs.get_string_atom feat_name (G_node.get_fs node) with
| Some atom -> atom | Some atom -> atom
| None -> Error.run ?loc "Some feature (named \"%s\") is not defined" feat_name | None -> Error.run ?loc "Cannot update_feat, some feature (named \"%s\") is not defined" feat_name
) )
| Concat_item.String s -> s | Concat_item.String s -> s
) item_list in ) item_list in
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment