Commit 5741e6ef authored by Bruno Guillaume's avatar Bruno Guillaume
Browse files

Prepend_feats

parent c7fa64a4
......@@ -307,6 +307,8 @@ module Ast = struct
| Qfn_or_lex_item pointed -> sprintf "%s.%s" (fst pointed) (snd pointed)
| String_item s -> sprintf "\"%s\"" s
type side = Prepend | Append
type u_command =
| Del_edge_expl of (Id.name * Id.name * edge_label)
| Del_edge_name of string
......@@ -327,8 +329,8 @@ module Ast = struct
| Del_feat of feature_ident
| Update_feat of feature_ident * concat_item list
(* Append_feats (src, tar, regexp, separator)*)
| Append_feats of (Id.name * Id.name * string * string)
(* Concat_feats (side, src, tar, regexp, separator)*)
| Concat_feats of (side * Id.name * Id.name * string * string)
| Unorder of Id.name
| Insert_before of (Id.name * Id.name)
......@@ -362,10 +364,14 @@ module Ast = struct
sprintf "%s.%s = %s" act_id feat_name (List_.to_string string_of_concat_item " + " item_list)
| Del_feat (act_id, feat_name) ->
sprintf "del_feat %s.%s" act_id feat_name
| Append_feats (src, tar, regexp, "") ->
| Concat_feats (Append, src, tar, regexp, "") ->
sprintf "append_feats %s =%s=> %s" src regexp tar
| Append_feats (src, tar, regexp, separator) ->
| Concat_feats (Append, src, tar, regexp, separator) ->
sprintf "append_feats \"%s\" %s =%s=> %s" separator src regexp tar
| Concat_feats (Prepend, src, tar, regexp, "") ->
sprintf "prepend_feats %s =%s=> %s" src regexp tar
| Concat_feats (Prepend, src, tar, regexp, separator) ->
sprintf "prepend_feats \"%s\" %s =%s=> %s" separator src regexp tar
| Unorder n -> sprintf "unorder %s" n
| Insert_before (n1,n2) -> sprintf "insert %s :< %s" n1 n2
| Insert_after (n1,n2) -> sprintf "insert %s :> %s" n1 n2
......
......@@ -171,6 +171,8 @@ module Ast : sig
| Qfn_or_lex_item of (string * string)
| String_item of string
type side = Prepend | Append
type u_command =
| Del_edge_expl of (Id.name * Id.name * edge_label)
| Del_edge_name of string
......@@ -192,7 +194,7 @@ module Ast : sig
| Del_feat of feature_ident
| Update_feat of feature_ident * concat_item list
| Append_feats of (Id.name * Id.name * string * string)
| Concat_feats of (side * Id.name * Id.name * string * string)
| Unorder of Id.name
| Insert_before of (Id.name * Id.name)
......
......@@ -65,7 +65,7 @@ module Command = struct
| SHIFT_EDGE of (command_node * command_node * Label_cst.t)
| SHIFT_IN of (command_node * command_node * Label_cst.t)
| SHIFT_OUT of (command_node * command_node * Label_cst.t)
| APPEND_FEATS of (command_node * command_node * string * string)
| CONCAT_FEATS of (Ast.side * command_node * command_node * string * string)
| UNORDER of command_node
| INSERT_BEFORE of (command_node * command_node)
| INSERT_AFTER of (command_node * command_node)
......@@ -182,8 +182,8 @@ module Command = struct
("feat_name", `String feat_name)
]
)]
| APPEND_FEATS (src, tar, regexp, separator) ->
`Assoc [("appen_feats",
| CONCAT_FEATS (side, src, tar, regexp, separator) ->
`Assoc [((match side with Append -> "appen_feats" | Prepend -> "prepend"),
`Assoc [
("src", command_node_to_json src);
("tar", command_node_to_json tar);
......@@ -289,10 +289,10 @@ module Command = struct
| _ -> Error.build ~loc "Unknwon identifier \"%s\"" node_or_edge_id
end
| (Ast.Append_feats ((src_id, tar_id, regexp, separator)), loc) ->
| (Ast.Concat_feats ((side, src_id, tar_id, regexp, separator)), loc) ->
check_node_id loc src_id kni;
check_node_id loc tar_id kni;
((APPEND_FEATS (cn_of_node_id src_id, cn_of_node_id tar_id, regexp, separator), loc), (kni, kei))
((CONCAT_FEATS (side, cn_of_node_id src_id, cn_of_node_id tar_id, regexp, separator), loc), (kni, kei))
| (Ast.Unorder node_n, loc) ->
check_node_id loc node_n kni;
......
......@@ -45,7 +45,7 @@ module Command : sig
| SHIFT_EDGE of (command_node * command_node * Label_cst.t)
| SHIFT_IN of (command_node * command_node * Label_cst.t)
| SHIFT_OUT of (command_node * command_node * Label_cst.t)
| APPEND_FEATS of (command_node * command_node * string * string)
| CONCAT_FEATS of (Ast.side * command_node * command_node * string * string)
| UNORDER of command_node
| INSERT_BEFORE of (command_node * command_node)
| INSERT_AFTER of (command_node * command_node)
......
......@@ -216,13 +216,14 @@ module G_fs = struct
let pst_node ?loc upos = [("upos", Feature_value.build_value ?loc "upos" upos)]
(* ---------------------------------------------------------------------- *)
let concat_values ?loc separator v1 v2 =
match (v1, v2) with
| (String v1, String v2) -> String (v1 ^ separator ^ v2)
let concat_values ?loc side separator v1 v2 =
match (side, v1, v2) with
| (Ast.Append, String v1, String v2) -> String (v1 ^ separator ^ v2)
| (Ast.Prepend, String v1, String v2) -> String (v2 ^ separator ^ v1)
| _ -> Error.run "Cannot concat numerical values"
(* ---------------------------------------------------------------------- *)
let append_feats_opt ?loc src tar separator regexp =
let concat_feats_opt ?loc side src tar separator regexp =
match List.filter
(fun (feature_name,_) ->
match feature_name with
......@@ -236,7 +237,7 @@ module G_fs = struct
match List_.sort_assoc_opt feat tar with
| None -> (set_value ?loc feat value acc_tar, (feat, value)::acc_updated_feats)
| Some v ->
let new_value = concat_values ?loc separator v value in
let new_value = concat_values ?loc side separator v value in
(set_value ?loc feat new_value acc_tar, (feat, new_value)::acc_updated_feats)
) (tar,[]) sub_src in
Some (new_tar, updated_feats)
......
......@@ -70,7 +70,7 @@ module G_fs: sig
val pst_leaf: ?loc:Loc.t -> string -> t
val pst_node: ?loc:Loc.t -> string -> t
val append_feats_opt: ?loc:Loc.t -> t -> t -> string -> string -> (t * (string * feature_value) list) option
val concat_feats_opt: ?loc:Loc.t -> Ast.side -> t -> t -> string -> string -> (t * (string * feature_value) list) option
val to_raw: t -> (string * string) list
end (* module G_fs *)
......
......@@ -1075,10 +1075,10 @@ module G_graph = struct
{ graph with map = Gid_map.add node_id new_node graph.map }
(* -------------------------------------------------------------------------------- *)
let append_feats_opt ?loc graph src_id tar_id separator regexp =
let concat_feats_opt ?loc graph side src_id tar_id separator regexp =
let src_node = Gid_map.find src_id graph.map in
let tar_node = Gid_map.find tar_id graph.map in
match G_node.append_feats_opt ?loc src_node tar_node separator regexp with
match G_node.concat_feats_opt ?loc side src_node tar_node separator regexp with
| Some (new_tar_node, updated_feats) ->
Some ({ graph with map = Gid_map.add tar_id new_tar_node graph.map }, updated_feats)
| None -> None
......
......@@ -207,11 +207,11 @@ module G_graph: sig
with feature name [tar_feat_name] to be [value]. *)
val update_feat: ?loc:Loc.t -> t -> Gid.t -> string -> feature_value -> t
(** [append_feats_opt graph src_id tar_id separator regexp] copy all feats of nodes [src_id] that match [regexp] to the node [tar_id].
(** [concat_feats_opt graph side src_id tar_id separator regexp] copy all feats of nodes [src_id] that match [regexp] to the node [tar_id].
If a feature of the same name already exists in [tar_id], the two values are concatenated (separated by [separator]).
The output is [None] if no changes are made on [tar_id], [Some (new_graph, trace)] else where [trace] is the list of updated features in [tar_id]
*)
val append_feats_opt: ?loc:Loc.t -> t -> Gid.t -> Gid.t -> string -> string -> (t * (string * feature_value) list) option
val concat_feats_opt: ?loc:Loc.t -> t -> Ast.side -> Gid.t -> Gid.t -> string -> string -> (t * (string * feature_value) list) option
(** [del_feat_opt graph node_id feat_name] returns [graph] where the feat [feat_name] of [node_id] is deleted
If the feature is not present, [None] is returned. *)
......
......@@ -195,6 +195,7 @@ and standard target = parse
| "add_node" { ADD_NODE }
| "del_feat" { DEL_FEAT }
| "append_feats" { APPEND_FEATS }
| "prepend_feats" { PREPEND_FEATS }
| "unorder" { UNORDER }
| "insert" { INSERT }
......
......@@ -114,10 +114,10 @@ module G_node = struct
let rename mapping n = {n with next = Massoc_gid.rename mapping n.next}
let append_feats_opt ?loc src tar separator regexp =
let concat_feats_opt ?loc side src tar separator regexp =
let src_fs = get_fs src in
let tar_fs = get_fs tar in
match G_fs.append_feats_opt ?loc src_fs tar_fs separator regexp with
match G_fs.concat_feats_opt ?loc side src_fs tar_fs separator regexp with
| Some (new_tar_fs, updated_feats) -> Some (set_fs new_tar_fs tar, updated_feats)
| None -> None
......
......@@ -65,7 +65,7 @@ module G_node: sig
val rename: (Gid.t * Gid.t) list -> t -> t
val append_feats_opt: ?loc:Loc.t -> t -> t -> string -> string -> (t * (string * feature_value) list) option
val concat_feats_opt: ?loc:Loc.t -> Ast.side -> t -> t -> string -> string -> (t * (string * feature_value) list) option
val shift: string -> int -> t -> t
val unshift: string -> t -> t
......
......@@ -98,6 +98,7 @@ let localize t = (t,get_loc ())
%token ADD_NODE /* add_node */
%token DEL_FEAT /* del_feat */
%token APPEND_FEATS /* append_feats */
%token PREPEND_FEATS /* append_feats */
%token UNORDER /* unorder */
%token INSERT /* insert */
......@@ -780,19 +781,35 @@ command:
/* append_feats M ==> N */
| APPEND_FEATS src_loc=simple_id_with_loc ARROW tar=simple_id
{ let (src,loc) = src_loc in (Ast.Append_feats (src, tar, ".*", ""), loc) }
{ let (src,loc) = src_loc in (Ast.Concat_feats (Append, src, tar, ".*", ""), loc) }
/* append_feats M ==> N */
| PREPEND_FEATS src_loc=simple_id_with_loc ARROW tar=simple_id
{ let (src,loc) = src_loc in (Ast.Concat_feats (Prepend, src, tar, ".*", ""), loc) }
/* append_feats "+" M ==> N */
| APPEND_FEATS sep=STRING src_loc=simple_id_with_loc ARROW tar=simple_id
{ let (src,loc) = src_loc in (Ast.Append_feats (src, tar, ".*", sep), loc) }
{ let (src,loc) = src_loc in (Ast.Concat_feats (Append, src, tar, ".*", sep), loc) }
/* append_feats "+" M ==> N */
| PREPEND_FEATS sep=STRING src_loc=simple_id_with_loc ARROW tar=simple_id
{ let (src,loc) = src_loc in (Ast.Concat_feats (Prepend, src, tar, ".*", sep), loc) }
/* append_feats M =[re"_MISC_.*"]=> N */
| APPEND_FEATS src_loc=simple_id_with_loc ARROW_LEFT regexp=REGEXP ARROW_RIGHT tar=simple_id
{ let (src,loc) = src_loc in (Ast.Append_feats (src, tar, regexp, ""), loc) }
{ let (src,loc) = src_loc in (Ast.Concat_feats (Append, src, tar, regexp, ""), loc) }
/* append_feats M =[re"_MISC_.*"]=> N */
| PREPEND_FEATS src_loc=simple_id_with_loc ARROW_LEFT regexp=REGEXP ARROW_RIGHT tar=simple_id
{ let (src,loc) = src_loc in (Ast.Concat_feats (Prepend, src, tar, regexp, ""), loc) }
/* append_feats "+" M =[re"_MISC_.*"]=> N */
| APPEND_FEATS sep=STRING src_loc=simple_id_with_loc ARROW_LEFT regexp=REGEXP ARROW_RIGHT tar=simple_id
{ let (src,loc) = src_loc in (Ast.Append_feats (src, tar, regexp, sep), loc) }
{ let (src,loc) = src_loc in (Ast.Concat_feats (Append, src, tar, regexp, sep), loc) }
/* append_feats "+" M =[re"_MISC_.*"]=> N */
| PREPEND_FEATS sep=STRING src_loc=simple_id_with_loc ARROW_LEFT regexp=REGEXP ARROW_RIGHT tar=simple_id
{ let (src,loc) = src_loc in (Ast.Concat_feats (Prepend, src, tar, regexp, sep), loc) }
/* unorder N */
| UNORDER node_id_loc=simple_id_with_loc
......
......@@ -1221,11 +1221,11 @@ module Rule = struct
let new_graph = G_graph.update_feat ~loc state.graph tar_gid tar_feat_name new_feature_value in
{state with graph = new_graph; effective = true}
| Command.APPEND_FEATS (src_cn, tar_cn, regexp, separator) ->
| Command.CONCAT_FEATS (side, src_cn, tar_cn, regexp, separator) ->
let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in
(match G_graph.append_feats_opt state.graph src_gid tar_gid separator regexp with
| None when !Global.safe_commands -> Error.run ~loc "APPEND_FEATS uneffective"
(match G_graph.concat_feats_opt state.graph side src_gid tar_gid separator regexp with
| None when !Global.safe_commands -> Error.run ~loc "CONCAT_FEATS uneffective"
| None -> state
| Some (new_graph,_) -> {state with graph = new_graph; effective = true}
)
......@@ -1708,12 +1708,12 @@ module Rule = struct
end
end
| Command.APPEND_FEATS (src_cn, tar_cn, regexp, separator) ->
| Command.CONCAT_FEATS (side, src_cn, tar_cn, regexp, separator) ->
let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in
begin
match G_graph.append_feats_opt gwh.Graph_with_history.graph src_gid tar_gid separator regexp with
| None when !Global.safe_commands -> Error.run ~loc "APPEND_FEATS uneffective"
match G_graph.concat_feats_opt gwh.Graph_with_history.graph side src_gid tar_gid separator regexp with
| None when !Global.safe_commands -> Error.run ~loc "CONCAT_FEATS uneffective"
| None -> Graph_with_history_set.singleton gwh
| Some (new_graph, updated_edges) ->
Graph_with_history_set.singleton { gwh with
......
Supports Markdown
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