Skip to content

GitLab

L
libcaml-grew
Commit 1c4b5064 authored by bguillaum's avatar bguillaum
Browse files
Options

a new concat command which subsumes new_feat, add_feat and concat feat 

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@6683 7838e531-6607-4d57-9587-6c381814729c
parent 7dab3424
Hide whitespace changes
Inline Side-by-side
Showing with 100 additions and 129 deletions
config/Makefile.in
View file @ 1c4b5064
......@@ -28,7 +28,7 @@ INFO = @INFO@
OCAMLFIND_DIR=`ocamlfind printconf destdir`
VERSION = 0.9.2
VERSION = 0.9.3
cleanup:
rm -rf *.cmo *.cmx *.cmi *.annot *.o *.*~
......
src/ast.ml
View file @ 1c4b5064
......@@ -58,6 +58,10 @@ type graph = {
edge: edge list;
}
type concat_item =
| Feat_item of string
| String_item of string
type u_command =
| Del_edge_expl of (Id.name * Id.name * string)
| Del_edge_name of string
......@@ -67,11 +71,10 @@ type u_command =
| New_neighbour of (Id.name * Id.name * string)
| Del_node of Id.name
| New_feat of string * string
| Copy_feat of string * string
| Concat_feat of string * string * string
| Del_feat of string
| Update_feat of string * concat_item list
type command = u_command * Loc.t
type rule = {
......@@ -129,6 +132,10 @@ type gr = {
module AST_HTML = struct
let feat_values_tab_to_html = List_.to_string (fun x->x) " | "
let string_of_concat_item = function
| Feat_item f -> f
| String_item s -> sprintf "\"%s\"" s
let buff_html_command ?(li_html=false) buff (u_command,_) =
bprintf buff " ";
......@@ -141,9 +148,7 @@ module AST_HTML = struct
| Merge_node (n1,n2) -> bprintf buff "merge %s ==> %s" n1 n2
| New_neighbour (n1,n2,label) -> bprintf buff "add_node %s: <-[%s]- %s \n" n1 label n2
| Del_node n -> bprintf buff "del_node %s" n
| New_feat (feat,value) -> bprintf buff "%s = %s" feat value
| Copy_feat (f1,f2) -> bprintf buff "%s = %s" f1 f2
| Concat_feat (f1,f2,f3) -> bprintf buff "%s = %s + %s" f1 f2 f3
| Update_feat (f,item_list) -> bprintf buff "%s = %s" f (List_.to_string string_of_concat_item " + " item_list)
| Del_feat feat -> bprintf buff "del_feat %s" feat);
if li_html then bprintf buff "</li>\n" else bprintf buff ";\n"
......
src/ast.mli
View file @ 1c4b5064
......@@ -51,6 +51,9 @@ type pattern = {
pat_const: const list;
}
type concat_item =
| Feat_item of string
| String_item of string
type u_command =
| Del_edge_expl of (Id.name * Id.name * string)
......@@ -61,11 +64,10 @@ type u_command =
| New_neighbour of (Id.name * Id.name * string)
| Del_node of Id.name
| New_feat of string * string
| Copy_feat of string * string
| Concat_feat of string * string * string
| Del_feat of string
| Update_feat of string * concat_item list
type command = u_command * Loc.t
type rule = {
rule_id:Id.name;
......
src/command.ml
View file @ 1c4b5064
......@@ -14,16 +14,18 @@ module Command = struct
| Pid of pid (* a node identified in the pattern *)
| New of string (* a node introduced by a new_neighbour *)
type item =
| Feat of (cnode * string)
| String of string
(* the command in pattern *)
type p =
| DEL_NODE of cnode
| DEL_EDGE_EXPL of (cnode * cnode *Edge.t)
| DEL_EDGE_NAME of string
| ADD_EDGE of (cnode * cnode * Edge.t)
| COPY_FEAT of (cnode * cnode * string * string)
| CONCAT_FEAT of (cnode * cnode * cnode * string * string * string)
| ADD_FEAT of (cnode * string * string)
| DEL_FEAT of (cnode * string)
| UPDATE_FEAT of (cnode * string * item list)
| NEW_NEIGHBOUR of (string * Edge.t * pid)
| SHIFT_EDGE of (cnode * cnode)
| MERGE_NODE of (cnode * cnode)
......@@ -36,18 +38,12 @@ module Command = struct
| H_DEL_EDGE_EXPL of (gid * gid *Edge.t)
| H_DEL_EDGE_NAME of string
| H_ADD_EDGE of (gid * gid * Edge.t)
| H_COPY_FEAT of (gid * gid * string * string)
| H_CONCAT_FEAT of (gid * gid * gid * string * string * string)
| H_ADD_FEAT of (gid * string * string)
| H_DEL_FEAT of (gid *string)
| H_UPDATE_FEAT of (gid * string * string)
| H_NEW_NEIGHBOUR of (string * Edge.t * gid)
| H_SHIFT_EDGE of (gid * gid)
| H_MERGE_NODE of (gid * gid)
let parse_feat loc string_feat =
match Str.split (Str.regexp "\\.") string_feat with
| [node; feat_name] -> (node, feat_name)
| _ -> Log.fcritical "[GRS] \"%s\" is not a feature %s" string_feat (Loc.to_string loc)
let build ?domain table locals ast_command =
let get_pid node_name =
......@@ -55,6 +51,11 @@ module Command = struct
| Some id -> Pid id
| None -> New node_name in
let parse_feat loc string_feat =
match Str.split (Str.regexp "\\.") string_feat with
| [node; feat_name] -> (get_pid node, feat_name)
| _ -> Log.fcritical "[GRS] \"%s\" is not a feature %s" string_feat (Loc.to_string loc) in
match ast_command with
| (Ast.Del_edge_expl (i, j, lab), loc) ->
let edge = Edge.make ~locals [lab] in
......@@ -87,22 +88,17 @@ module Command = struct
| (Ast.Del_node n, loc) ->
(DEL_NODE (get_pid n), loc)
| (Ast.New_feat (feat, value), loc) ->
let (node, feat_name) = parse_feat loc feat in
(ADD_FEAT (get_pid node, feat_name, value), loc)
| (Ast.Copy_feat (feat1, feat2), loc) ->
let (node_1, feat_name_1) = parse_feat loc feat1
and (node_2, feat_name_2) = parse_feat loc feat2 in
(COPY_FEAT (get_pid node_1, get_pid node_2, feat_name_1, feat_name_2), loc)
| (Ast.Del_feat (feat), loc) ->
let (node_pid, feat_name) = parse_feat loc feat in
(DEL_FEAT (node_pid, feat_name), loc)
| (Ast.Concat_feat (feat1, feat2, feat3), loc) ->
let (node_1, feat_name_1) = parse_feat loc feat1
and (node_2, feat_name_2) = parse_feat loc feat2
and (node_3, feat_name_3) = parse_feat loc feat3 in
(CONCAT_FEAT (get_pid node_1, get_pid node_2, get_pid node_3, feat_name_1, feat_name_2, feat_name_3), loc)
| (Ast.Update_feat (feat, ast_items), loc) ->
let (node_pid, feat_name) = parse_feat loc feat in
let items = List.map
(function
| Ast.Feat_item feat -> Feat (parse_feat loc feat)
| Ast.String_item s -> String s)
ast_items in
(UPDATE_FEAT (node_pid, feat_name, items), loc)
| (Ast.Del_feat (feat), loc) ->
let (node, feat_name) = parse_feat loc feat in
(DEL_FEAT (get_pid node, feat_name), loc)
end
src/command.mli
View file @ 1c4b5064
......@@ -10,15 +10,17 @@ module Command : sig
| Pid of pid (* a node identified in the pattern *)
| New of string (* a node introduced by a new_neighbour *)
type item =
| Feat of (cnode * string)
| String of string
type p =
| DEL_NODE of cnode
| DEL_EDGE_EXPL of (cnode * cnode *Edge.t)
| DEL_EDGE_NAME of string
| ADD_EDGE of (cnode * cnode * Edge.t)
| COPY_FEAT of (cnode * cnode * string * string)
| CONCAT_FEAT of (cnode * cnode * cnode * string * string * string)
| ADD_FEAT of (cnode * string * string)
| DEL_FEAT of (cnode *string)
| DEL_FEAT of (cnode * string)
| UPDATE_FEAT of (cnode * string * item list)
| NEW_NEIGHBOUR of (string * Edge.t * pid)
| SHIFT_EDGE of (cnode * cnode)
| MERGE_NODE of (cnode * cnode)
......@@ -30,10 +32,8 @@ module Command : sig
| H_DEL_EDGE_EXPL of (gid * gid *Edge.t)
| H_DEL_EDGE_NAME of string
| H_ADD_EDGE of (gid * gid * Edge.t)
| H_COPY_FEAT of (gid * gid * string * string)
| H_CONCAT_FEAT of (gid * gid * gid * string * string * string)
| H_ADD_FEAT of (gid * string * string)
| H_DEL_FEAT of (gid *string)
| H_UPDATE_FEAT of (gid * string * string)
| H_NEW_NEIGHBOUR of (string * Edge.t * gid)
| H_SHIFT_EDGE of (gid * gid)
| H_MERGE_NODE of (gid * gid)
......
src/graph.ml
View file @ 1c4b5064
......@@ -26,6 +26,11 @@ module Graph = struct
let empty = {map = IntMap.empty; lub = 0}
type gid = int
type concat_item =
| Feat of (gid * string)
| String of string
let find node_id graph = IntMap.find node_id graph.map
let map_add_edge map id_src label id_tar =
......@@ -329,49 +334,27 @@ module Graph = struct
(IntMap.remove src_gid se_graph.map) in
Some {se_graph with map = new_map}
| None -> None
(* TODO: with copy_feat from different feature name, correctness of fs wrt domain can be broken: add the check against domain *)
let copy_feat graph tar_id src_id tar_feat_name src_feat_name =
let src = IntMap.find src_id graph.map in
let tar = IntMap.find tar_id graph.map in
let new_f =
try Feature_structure.set_feat tar_feat_name
(Feature_structure.get src_feat_name src.Node.fs) tar.Node.fs
with Not_found -> Log.fcritical "[RUN] [Graph.copy_feat] no feature \"%s\" in node \"%s\"" src_feat_name (Node.to_string src) in
{graph with map = IntMap.add tar_id {tar with Node.fs = new_f} graph.map}
(* FIXME: check consistency wrt the domain *)
let concat_feat graph tar_id src1_id src2_id tar_feat_name src1_feat_name src2_feat_name =
let update_feat graph tar_id tar_feat_name item_list =
let tar = IntMap.find tar_id graph.map in
let src1 = IntMap.find src1_id graph.map in
let src2 = IntMap.find src2_id graph.map in
let value1_opt =
try Feature_structure.get_atom src1_feat_name src1.Node.fs
with Not_found ->
Log.fcritical "[RUN] [Graph.concat_feat] no feature \"%s\" in node \"%s\""
src1_feat_name (Node.to_string src1) in
let value2_opt =
try Feature_structure.get_atom src2_feat_name src2.Node.fs
with Not_found ->
Log.fcritical "[RUN] [Graph.concat_feat] no feature \"%s\" in node \"%s\""
src2_feat_name (Node.to_string src2) in
match (value1_opt, value2_opt) with
| Some value1, Some value2 ->
let new_f = Feature_structure.set_feat tar_feat_name [value1 ^ " + " ^ value2] tar.Node.fs in
{graph with map = IntMap.add tar_id {tar with Node.fs = new_f} graph.map}
| _ -> Log.fcritical "[BUG] [Graph.concat_feat] Feature not atomic"
let add_feat graph node_id feat_name feat_value =
let node = IntMap.find node_id graph.map in
let new_fs = Feature_structure.set_feat feat_name [feat_value] node.Node.fs in
{graph with map = IntMap.add node_id {node with Node.fs = new_fs} graph.map}
let strings_to_concat =
List.map
(function
| Feat (node_gid, feat_name) ->
let node = IntMap.find node_gid graph.map in
(try
match Feature_structure.get_atom feat_name node.Node.fs with
| Some atom -> atom
| None -> Log.fcritical "[BUG] [Graph.update_feat] Feature not atomic"
with Not_found ->
Log.fcritical "[RUN] [Graph.update_feat] no feature \"%s\" in node \"%s\""
feat_name (Node.to_string node))
| String s -> s
) item_list in
let new_feature_value = List_.to_string (fun s->s) "" strings_to_concat in
let new_f = Feature_structure.set_feat tar_feat_name [new_feature_value] tar.Node.fs in
({graph with map = IntMap.add tar_id {tar with Node.fs = new_f} graph.map}, new_feature_value)
(** [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. *)
......
src/graph.mli
View file @ 1c4b5064
......@@ -19,6 +19,12 @@ module Graph : sig
lub: int; (* least upper bound *)
}
type gid = int
type concat_item =
| Feat of (gid * string)
| String of string
val empty: t
val build:
......@@ -55,14 +61,11 @@ module Graph : sig
val merge_node : Loc.t -> t -> int -> int -> t option
val shift_edges : Loc.t -> t -> int -> int -> t
(** [cpy_feat tar_id src_id tar_feat_name src_feat_name] copy the feature value associated with [src_feat_name] from
the node [src_id] to the node [tar_id] with feature name [tar_feat_name] *)
val copy_feat : t -> int -> int -> string -> string -> t
val concat_feat : t -> int -> int -> int -> string -> string -> string -> t
(** [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].
It returns both the new graph and the new feature value produced as the second element *)
val update_feat : t -> int -> string -> concat_item list -> (t * string)
val add_feat : t -> int -> string -> string -> t
val del_feat : t -> int -> string -> t
val equals : t -> t -> bool
......
src/parser/gr_grs_parser.mly
View file @ 1c4b5064
......@@ -434,12 +434,13 @@ command:
{ localize (New_neighbour (n1,n2,label)) }
| DEL_FEAT feat = FEAT
{ localize (Del_feat feat) }
| feat1 = FEAT EQUAL feat2 = FEAT PLUS feat3 = FEAT
{ localize (Concat_feat (feat1, feat2, feat3)) }
| feat1 = FEAT EQUAL feat2 = FEAT
{ localize (Copy_feat (feat1, feat2)) }
| feat = FEAT EQUAL value = feature_value
{ localize (New_feat (feat, value)) }
| feat = FEAT EQUAL items = separated_nonempty_list (PLUS, concat_item)
{ localize (Update_feat (feat, items)) }
concat_item:
| feat = FEAT { Feat_item feat }
| s = IDENT { String_item s }
| s = STRING { String_item s }
/*=============================================================================================*/
/* */
......
src/rule.ml
View file @ 1c4b5064
......@@ -176,9 +176,7 @@ module Rule = struct
{
Deco.nodes = List.fold_left
(fun acc -> function
| (Command.COPY_FEAT (tar_cn,_,_,_),loc)
| (Command.ADD_FEAT (tar_cn,_,_),loc)
| (Command.DEL_FEAT (tar_cn,_),loc)
| (Command.UPDATE_FEAT (tar_cn,_,_),loc)
| (Command.SHIFT_EDGE (_,tar_cn),loc) ->
(find tar_cn (matching, created_nodes)) :: acc
| _ -> acc
......@@ -398,41 +396,24 @@ module Rule = struct
| None -> raise Command_execution_fail
)
| Command.COPY_FEAT (tar_cn,src_cn,tar_feat_name, src_feat_name) ->
let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in
(
{instance with
Instance.graph = Graph.copy_feat instance.Instance.graph tar_gid src_gid tar_feat_name src_feat_name;
commands = List_.sort_insert (Command.H_COPY_FEAT (tar_gid,src_gid,tar_feat_name,src_feat_name)) instance.Instance.commands
},
created_nodes
)
| Command.CONCAT_FEAT (tar_cn,src1_cn,src2_cn,tar_feat_name, src1_feat_name, src2_feat_name) ->
let src1_gid = node_find src1_cn in
let src2_gid = node_find src2_cn in
| Command.UPDATE_FEAT (tar_cn,tar_feat_name, item_list) ->
let tar_gid = node_find tar_cn in
let rule_items = List.map
(function
| Command.Feat (cnode, feat_name) -> Graph.Feat (node_find cnode, feat_name)
| Command.String s -> Graph.String s
) item_list in
let (new_graph, new_feature_value) =
Graph.update_feat instance.Instance.graph tar_gid tar_feat_name rule_items in
(
{instance with
Instance.graph = Graph.concat_feat
instance.Instance.graph tar_gid src1_gid src2_gid tar_feat_name src1_feat_name src2_feat_name;
commands = List_.sort_insert
(Command.H_CONCAT_FEAT (tar_gid,src1_gid,src2_gid,tar_feat_name,src1_feat_name,src2_feat_name))
{instance with
Instance.graph = new_graph;
commands = List_.sort_insert
(Command.H_UPDATE_FEAT (tar_gid,tar_feat_name,new_feature_value))
instance.Instance.commands
},
created_nodes
)
| Command.ADD_FEAT (tar_cn,feat_name, feat_value) ->
let tar_gid = node_find tar_cn in
(
{instance with
Instance.graph = Graph.add_feat instance.Instance.graph tar_gid feat_name feat_value;
commands = List_.sort_insert (Command.H_ADD_FEAT (tar_gid,feat_name,feat_value)) instance.Instance.commands
},
created_nodes
)
)
| Command.DEL_FEAT (tar_cn,feat_name) ->
let tar_gid = node_find tar_cn 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