Commit 4546ba7f authored by bguillaum's avatar bguillaum

add the concat command

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@6660 7838e531-6607-4d57-9587-6c381814729c
parent 4ea50a49
......@@ -88,7 +88,7 @@ td.first_stats {
td.total {
background-color: #DDDDDD;
border-right-width: 1px; r
border-right-width: 1px;
border-right-style:dotted;
border-right-color:black;
border-bottom-width: 1px;
......
......@@ -41,7 +41,9 @@ type edge = u_edge * Loc.t
type u_const =
| Start of Id.name * string list (* (source, labels) *)
| No_out of Id.name
| End of Id.name * string list (* (target, labels) *)
| No_in of Id.name
type const = u_const * Loc.t
......@@ -68,6 +70,7 @@ type command =
| New_feat of string * string
| Copy_feat of string * string
| Concat_feat of string * string * string
| Del_feat of string
......@@ -221,6 +224,9 @@ module AST_HTML = struct
| (Copy_feat (f1,f2))::t ->
" "^f1^"="^f2^" ;\n"^
compute t
| (Concat_feat (f1,f2,f3))::t ->
" "^f1^"="^f2^"+"^f3^" ;\n"^
compute t
| (Del_feat (feat))::t ->
" del_feat "^feat^" ;\n"^
compute t
......@@ -264,6 +270,9 @@ module AST_HTML = struct
| (Copy_feat (f1,f2))::t ->
"<li>"^f1^" = "^f2^" ;</li>"^
compute t
| (Concat_feat (f1,f2,f3))::t ->
"<li>"^f1^"="^f2^"+"^f3^" ;</li>"^
compute t
| (Del_feat (feat))::t ->
"<li>del_feat "^feat^" ;</li>"^
compute t
......@@ -304,7 +313,9 @@ module AST_HTML = struct
let pat_const_to_string pc =
match pc with
| Start (id,labels) -> " "^id^" -["^(tab_to_html_pipe labels)^"]-> *\n"
| No_out id -> " "^id^" -> *\n"
| End (id,labels) -> " * -["^(tab_to_html_pipe labels)^"]-> "^id^"\n"
| No_in id -> " * -> "^id^"\n"
let rec to_html_const pat_const =
match pat_const with
......
......@@ -39,7 +39,9 @@ type edge = u_edge * Loc.t
type u_const =
| Start of Id.name * string list (* (source, labels) *)
| No_out of Id.name
| End of Id.name * string list (* (target, labels) *)
| No_in of Id.name
type const = u_const * Loc.t
......@@ -61,6 +63,7 @@ type command =
| New_feat of string * string
| Copy_feat of string * string
| Concat_feat of string * string * string
| Del_feat of string
type rule = {
......
......@@ -21,8 +21,9 @@ module Command = struct
| 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)
| NEW_NEIGHBOUR of (string * Edge.t * pid)
| SHIFT_EDGE of (cnode * cnode)
| MERGE_NODE of (cnode * cnode)
......@@ -36,13 +37,18 @@ module Command = struct
| 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_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 =
match Id.build_opt node_name table with
......@@ -82,32 +88,21 @@ module Command = struct
(DEL_NODE (get_pid n), loc)
| (Ast.New_feat (feat, value), loc) ->
begin
match (Str.split (Str.regexp "\\.") feat ) with
| [node; feat_name] ->
Feature.check ?domain loc feat_name [value];
(ADD_FEAT (get_pid node, feat_name, value), loc)
| _ -> Log.fcritical "[GRS] \"%s\" is not a valid feature %s" feat (Loc.to_string loc)
end
let (node, feat_name) = parse_feat loc feat in
(ADD_FEAT (get_pid node, feat_name, value), loc)
| (Ast.Copy_feat (feat1, feat2), loc) ->
begin
match Str.split (Str.regexp "\\.") feat1 with
| [node_1; feat_name_1] ->
begin
match Str.split (Str.regexp "\\.") feat2 with
| [node_2; feat_name_2] (* when feat_name_1 = feat_name_2 *) ->
(COPY_FEAT (get_pid node_1, get_pid node_2, feat_name_1, feat_name_2), loc)
(* | [node_2; feat_name_2] -> Log.fcritical "[GRS] Copy feat through different feature name not implemented %s" (Loc.to_string loc) *)
| _ -> Log.fcritical "[GRS] \"%s\" is not a feature %s" feat2 (Loc.to_string loc)
end
| _ -> Log.fcritical "[GRS] \"%s\" is not a feature %s" feat1 (Loc.to_string loc)
end
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.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.Del_feat (feat), loc) ->
begin
match Str.split (Str.regexp "\\.") feat with
| [node; feat_name] -> (DEL_FEAT (get_pid node, feat_name), loc)
| _ -> Log.fcritical "[GRS] \"%s\" is not a feature %s" feat (Loc.to_string loc)
end
let (node, feat_name) = parse_feat loc feat in
(DEL_FEAT (get_pid node, feat_name), loc)
end
......@@ -16,6 +16,7 @@ module Command : sig
| 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)
| NEW_NEIGHBOUR of (string * Edge.t * pid)
......@@ -30,6 +31,7 @@ module Command : sig
| 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_NEW_NEIGHBOUR of (string * Edge.t * gid)
......
......@@ -304,16 +304,44 @@ module Graph = struct
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 cpy_feat graph src_id tar_id src_feat_name tar_feat_name =
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.cpy_feat] no feature \"%s\" in node \"%s\"" src_feat_name (Node.to_string src) in
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 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
......
......@@ -54,15 +54,19 @@ module Graph : sig
val merge_node : Loc.t -> t -> int -> int -> t option
val shift_edges : Loc.t -> t -> int -> int -> t
(** [cpy_feat src_id tar_id src_feat_name tar_feat_name] copy the feature value associated with [src_feat_name] from
(** [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 cpy_feat : t -> int -> int -> string -> string -> t
val copy_feat : t -> int -> int -> string -> string -> t
val concat_feat : t -> int -> int -> int -> string -> string -> string -> t
val add_feat : t -> int -> string -> string -> t
val del_feat : t -> int -> string -> t
val equals : t -> t -> bool
(** [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 -> Edge.t -> bool
val roots: t -> int list
......
......@@ -42,6 +42,8 @@ module Edge = struct
under_label: under_label;
}
let all = {id=None; under_label=Neg []}
let compare = Pervasives.compare
let make ?(id=None) ?(neg=false) ?(locals=[||]) = function
......
......@@ -20,6 +20,9 @@ module Edge : sig
val as_label: t -> Label.t
val of_label: Label.t -> t
(* [all] is the joker pattern edge *)
val all: t
val make:
?id: string option ->
?neg:bool ->
......
......@@ -56,6 +56,11 @@ module Feature_structure = struct
| Feature.Equal _ :: _ -> raise Not_found
| Feature.Different _ :: _ -> failwith "[Feature_structure.get] this fs contains 'Different' constructor"
let get_atom name t =
match get name t with
| [one] -> Some one
| _ -> None
let string_of_feature = function
| Feature.Equal (feat_name, atoms) ->
Printf.sprintf "%s=%s" feat_name
......
......@@ -7,8 +7,12 @@ end
module Feature_structure: sig
type t
val build: ?domain:Ast.domain -> Ast.feature list -> t
val get: string -> t -> string list
val build: ?domain:Ast.domain -> Ast.feature list -> t
val get: string -> t -> string list
val get_atom: string -> t -> string option
val empty: t
val to_string: t -> string
val to_dep: ?main_feat: string -> t -> string
......
......@@ -412,8 +412,8 @@ module Corpus_stat = struct
);
incr counter;
if html
then tmp := sprintf "%s\n <a href=\"%s.html\">%s</a> &nbsp; &nbsp;" !tmp h h
else tmp := sprintf "%s\n %s &nbsp; &nbsp;" !tmp h
then tmp := sprintf "%s\n <a href=\"%s.html\">%s</a>&nbsp;&nbsp;" !tmp h h
else tmp := sprintf "%s\n %s&nbsp;&nbsp;" !tmp h
);
compute t
in compute (List.rev file_list);
......
......@@ -27,6 +27,7 @@ let localize t = (t,get_loc ())
%token COMA /* , */
%token SEMIC /* ; */
%token STAR /* * */
%token PLUS /* + */
%token EQUAL /* = */
%token DISEQUAL /* <> */
%token PIPE /* | */
......@@ -343,32 +344,26 @@ feature_value:
full_edge:
(* "e: A -> B" *)
| id = edge_id n1 = IDENT GOTO_NODE n2 = IDENT
(* { (Some id, (n1,n2,true,[]),(!Parser_global.current_file,!Parser_global.current_line+1)) } *)
{ localize ({edge_id = Some id; src=n1; edge_labels=[]; tar=n2; negative=true}) }
{ localize ({edge_id = Some id; src=n1; edge_labels=[]; tar=n2; negative=true}) }
(* "A -> B" *)
| n1 = IDENT GOTO_NODE n2 = IDENT
(* { (None, (n1,n2,true,[]),(!Parser_global.current_file,!Parser_global.current_line+1)) } *)
{ localize ({edge_id = None; src=n1; edge_labels=[]; tar=n2; negative=true}) }
{ localize ({edge_id = None; src=n1; edge_labels=[]; tar=n2; negative=true}) }
(* "e: A -[^X|Y]-> B" *)
| id = edge_id n1 = IDENT labels = delimited(LTR_EDGE_LEFT_NEG,separated_nonempty_list(PIPE,IDENT),LTR_EDGE_RIGHT) n2 = IDENT
(* { (Some id, (n1,n2,true,labels),(!Parser_global.current_file,!Parser_global.current_line+1)) } *)
{ localize ({edge_id = Some id; src=n1; edge_labels=labels; tar=n2; negative=true}) }
{ localize ({edge_id = Some id; src=n1; edge_labels=labels; tar=n2; negative=true}) }
(* "A -[^X|Y]-> B"*)
| n1 = IDENT labels = delimited(LTR_EDGE_LEFT_NEG,separated_nonempty_list(PIPE,IDENT),LTR_EDGE_RIGHT) n2 = IDENT
(* { (None, (n1,n2,true,labels),(!Parser_global.current_file,!Parser_global.current_line+1)) } *)
{ localize ({edge_id = None; src=n1; edge_labels=labels; tar=n2; negative=true}) }
(* "e: A -[X|Y]-> B" *)
| id = edge_id n1 = IDENT labels = delimited(LTR_EDGE_LEFT,separated_nonempty_list(PIPE,IDENT),LTR_EDGE_RIGHT) n2 = IDENT
(* { (Some id, (n1,n2,false,labels),(!Parser_global.current_file,!Parser_global.current_line+1)) } *)
{ localize ({edge_id = Some id; src=n1; edge_labels=labels; tar=n2; negative=false}) }
(* "A -[X|Y]-> B" *)
| n1 = IDENT labels = delimited(LTR_EDGE_LEFT,separated_nonempty_list(PIPE,IDENT),LTR_EDGE_RIGHT) n2 = IDENT
(* { (None, (n1,n2,false,labels),(!Parser_global.current_file,!Parser_global.current_line+1)) } *)
{ localize ({edge_id = None; src=n1; edge_labels=labels; tar=n2; negative=false}) }
......@@ -377,11 +372,21 @@ edge_id:
full_const:
(* "A -[X|Y]-> *" *)
| n1 = IDENT labels = delimited(LTR_EDGE_LEFT,separated_nonempty_list(PIPE,IDENT),LTR_EDGE_RIGHT) STAR
{ localize (Start (n1,labels)) }
(* "A -> *" *)
| n1 = IDENT GOTO_NODE STAR
{ localize (No_out n1) }
(* "* -[X|Y]-> A" *)
| STAR labels = delimited(LTR_EDGE_LEFT,separated_nonempty_list(PIPE,IDENT),LTR_EDGE_RIGHT) n2 = IDENT
{ localize (End (n2,labels)) }
(* "* -> A" *)
| STAR GOTO_NODE n2 = IDENT
{ localize (No_in n2) }
/*=============================================================================================*/
/* */
......@@ -429,6 +434,8 @@ 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
......
......@@ -87,6 +87,7 @@ and global = parse
| ':' { DDOT }
| ';' { SEMIC }
| ',' { COMA }
| '+' { PLUS }
| '*' { STAR }
| '=' { EQUAL }
| "<>" { DISEQUAL }
......
......@@ -69,7 +69,9 @@ module Rule = struct
let build_constraint ?locals table = function
| (Ast.Start (node_name, labels), loc) -> No_out (Id.build ~loc node_name table, Edge.make ?locals labels)
| (Ast.No_out node_name, loc) -> No_out (Id.build ~loc node_name table, Edge.all)
| (Ast.End (node_name, labels),loc) -> No_in (Id.build ~loc node_name table, Edge.make ?locals labels)
| (Ast.No_in node_name, loc) -> No_in (Id.build ~loc node_name table, Edge.all)
type pattern =
{ graph: Graph.t;
......@@ -92,7 +94,9 @@ module Rule = struct
match Id.build_opt string_id pos_table with Some i -> i | None -> -1-(Id.build ~loc string_id neg_table) in
match const with
| (Ast.Start (node_name, labels),loc) -> No_out (id_build loc node_name, Edge.make ?locals labels)
| (Ast.No_out node_name, loc) -> No_out (id_build loc node_name, Edge.all)
| (Ast.End (node_name, labels),loc) -> No_in (id_build loc node_name, Edge.make ?locals labels)
| (Ast.No_in node_name, loc) -> No_in (id_build loc node_name, Edge.all)
let build_neg_pattern ?domain ?(locals=[||]) pos_table pattern_ast =
let (extension, neg_table) =
......@@ -233,21 +237,11 @@ module Rule = struct
List.exists (fun e -> Edge.compatible edge e) (Massoc.assoc gid node.Node.next)
) graph.Graph.map
| Filter (pid, fs) ->
(* (\* DEBUG *\) Printf.printf "==<Filter>==%!"; *)
let gid = IntMap.find pid matching.n_match in
let gnode = IntMap.find gid graph.Graph.map in
(* (\* DEBUG *\) let res = *)
Feature_structure.filter fs gnode.Node.fs
(* (\* DEBUG *\) in *)
(* (\* DEBUG *\) *)
(* (\* DEBUG *\) Printf.printf " %b\n%!" res; *)
(* (\* DEBUG *\) Printf.printf " fs = %s\n" (Feature_structure.to_string fs); *)
(* (\* DEBUG *\) Printf.printf " gnode.Node.fs = %s\n" (Feature_structure.to_string gnode.Node.fs); *)
(* (\* DEBUG *\) res *)
(* (\* DEBUG *\) *)
(* returns all extension of the partial input matching *)
(* returns all extension of the partial input matching *)
let rec extend_matching (positive,neg) (graph:Graph.t) (partial:partial) =
match (partial.unmatched_edges, partial.unmatched_nodes) with
| [], [] ->
......@@ -409,12 +403,27 @@ module Rule = struct
let tar_gid = node_find tar_cn in
(
{instance with
Instance.graph = Graph.cpy_feat instance.Instance.graph src_gid tar_gid src_feat_name tar_feat_name;
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
let tar_gid = node_find tar_cn 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.Instance.commands
},
created_nodes
)
| Command.ADD_FEAT (tar_cn,feat_name, feat_value) ->
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