Commit 806136f8 authored by Bruno Guillaume's avatar Bruno Guillaume

add syntax from add_edge with feature structure

parent 0dac1448
......@@ -263,6 +263,7 @@ module Ast = struct
| Del_edge_name of string
| Add_edge of (Id.name * Id.name * edge_label)
| Add_edge_expl of (Id.name * Id.name * string)
| Add_edge_items of (Id.name * Id.name * (string * string) list)
(* 4 args: source, target, labels, flag true iff negative cst *)
| Shift_in of (Id.name * Id.name * edge_label_cst)
......@@ -287,6 +288,8 @@ module Ast = struct
sprintf "add_edge %s -[%s]-> %s" n1 label n2
| Add_edge_expl (n1,n2,name) ->
sprintf "add_edge %s: %s -> %s" name n1 n2
| Add_edge_items (n1,n2,items) ->
sprintf "add_edge %s -[%s]-> %s" n1 (String.concat "," (List.map (fun (x,y) -> x^"="^y) items)) n2
| Shift_in (n1,n2,edge_label_cst) ->
sprintf "shift_in %s =%s=> %s" n1 (string_of_edge_label_cst edge_label_cst) n2
......
......@@ -152,6 +152,7 @@ module Ast : sig
| Del_edge_name of string
| Add_edge of (Id.name * Id.name * edge_label)
| Add_edge_expl of (Id.name * Id.name * string)
| Add_edge_items of (Id.name * Id.name * (string * string) list)
(* 4 args: source, target, labels, flag true iff negative cst *)
| Shift_in of (Id.name * Id.name * edge_label_cst)
......
......@@ -51,6 +51,7 @@ module Command = struct
| DEL_EDGE_NAME of string
| ADD_EDGE of (command_node * command_node * G_edge.t)
| ADD_EDGE_EXPL of (command_node * command_node * string)
| ADD_EDGE_ITEMS of (command_node * command_node * (string * string) list)
| DEL_FEAT of (command_node * string)
| UPDATE_FEAT of (command_node * string * item list)
(* *)
......@@ -93,6 +94,7 @@ module Command = struct
]
)]
| ADD_EDGE_ITEMS _ -> failwith "TODO"
| DEL_FEAT (cn, feature_name) ->
`Assoc [("del_feat",
`Assoc [
......@@ -192,6 +194,11 @@ module Command = struct
check_node_id loc node_j kni;
((ADD_EDGE_EXPL (cn_of_node_id node_i, cn_of_node_id node_j, name), loc), (kni, kei))
| (Ast.Add_edge_items (node_i, node_j, items), loc) ->
check_node_id loc node_i kni;
check_node_id loc node_j kni;
((ADD_EDGE_ITEMS (cn_of_node_id node_i, cn_of_node_id node_j, items), loc), (kni, kei))
| (Ast.Shift_edge (node_i, node_j, label_cst), loc) ->
check_node_id loc node_i kni;
check_node_id loc node_j kni;
......
......@@ -31,6 +31,7 @@ module Command : sig
| DEL_EDGE_NAME of string
| ADD_EDGE of (command_node * command_node * G_edge.t)
| ADD_EDGE_EXPL of (command_node * command_node * string)
| ADD_EDGE_ITEMS of (command_node * command_node * (string * string) list)
| DEL_FEAT of (command_node * string)
| UPDATE_FEAT of (command_node * string * item list)
......
......@@ -20,10 +20,31 @@ open Grew_domain
module G_edge = struct
type t = (string * string) list
let from_items l = List.sort (fun (x,_) (y,_) -> Pervasives.compare x y) l
let get_sub = List_.sort_assoc
let to_string ?domain edge =
String.concat "," (List.map (fun (x,y) -> x^"="^y) edge)
let is_void ?domain edge = failwith "TODO [G_edge.is_void]"
exception Not_conll of string
let to_conll ?domain edge =
let rec loop i acc = function
| [] -> acc
| [("kind","surf")] -> "S" :: acc
| [("kind","deep")] -> "D" :: acc
| [("kind","enhanced")] -> "E" :: acc
| (n,v)::t ->
if n = string_of_int i
then loop (i+1) (acc @ [v]) t
else raise (Not_conll (to_string ?domain edge)) in
try String.concat ":" (loop 1 [] edge)
with Not_conll s ->
Log.fwarning "[G_edge.to_conll] cannot write conll edge from \"%s\"" s;
s
(* TODO check if useful or remove *)
let is_void ?domain edge = false
let get_style ?domain edge = Label_domain.default
......@@ -35,6 +56,8 @@ module G_edge = struct
let style = get_style ?domain t in
Label_domain.to_dot ~deco style
let to_dep ?domain ?(deco=false) t = sprintf "{ label=\"%s\" }" (to_conll t)
let split l = CCList.mapi
(fun i elt -> (string_of_int (i+1), elt)) l
......@@ -127,8 +150,8 @@ module Label_cst = struct
| Atom_list l -> List.for_all (match_atom g_label) l
let build_atom = function
| Ast.Atom_eq (name, atoms) -> Eq (name, atoms)
| Ast.Atom_diseq (name, atoms) -> Diseq (name, atoms)
| Ast.Atom_eq (name, atoms) -> Eq (name, List.sort Pervasives.compare atoms)
| Ast.Atom_diseq (name, atoms) -> Diseq (name, List.sort Pervasives.compare atoms)
| Ast.Atom_absent name -> Absent name
let build ?loc ?domain = function
......
......@@ -18,8 +18,14 @@ open Grew_domain
module G_edge: sig
type t
val from_items: (string * string) list -> t
val to_string: ?domain:Domain.t -> t -> string
val to_conll: ?domain:Domain.t -> t -> string
val get_sub: string -> t -> string option
val is_void: ?domain: Domain.t -> t -> bool
val to_dep: ?domain: Domain.t -> ?deco:bool -> t -> string
......
......@@ -1037,7 +1037,7 @@ module G_graph = struct
Massoc_gid.fold
(fun acc2 tar_gid edge ->
let old = try Gid_map.find tar_gid acc2 with Not_found -> [] in
Gid_map.add tar_gid ((sprintf "%g" src_num, G_edge.to_string ?domain edge)::old) acc2
Gid_map.add tar_gid ((sprintf "%g" src_num, G_edge.to_conll ?domain edge)::old) acc2
) acc (G_node.get_next node)
) nodes Gid_map.empty in
......@@ -1103,7 +1103,7 @@ module G_graph = struct
| Ordered f -> int_of_float f
| _ -> Error.run "[G_graph.to_conll] nl_node going to Unordered node" in
let head_proj = CCList.find_map
(fun e -> int_of_string_opt (G_edge.to_string ?domain e))
(fun e -> int_of_string_opt (G_edge.to_conll ?domain e))
(Massoc_gid.assoc head_gid nexts) in
let items = List.fold_left
(fun acc gid ->
......@@ -1111,7 +1111,7 @@ module G_graph = struct
| Ordered f -> int_of_float f
| _ -> Error.run "[G_graph.to_conll] nl_node going to Unordered node" in
let proj = CCList.find_map
(fun e -> int_of_string_opt (G_edge.to_string ?domain e))
(fun e -> int_of_string_opt (G_edge.to_conll ?domain e))
(Massoc_gid.assoc gid nexts) in
Id_with_proj_set.add ((pos,None), proj) acc
) Id_with_proj_set.empty tail_gids in
......
......@@ -140,6 +140,7 @@ and label_parser target = parse
| ',' { COMMA }
| '|' { PIPE }
| '/' { SLASH }
| '*' { STAR }
| '=' { EQUAL }
| "!" { BANG }
......
......@@ -338,6 +338,7 @@ edge_item:
label_atom:
| name=simple_id_or_float EQUAL l=separated_nonempty_list(PIPE,edge_item) { Ast.Atom_eq (name, l)}
| name=simple_id_or_float EQUAL STAR { Ast.Atom_diseq (name, [])}
| name=simple_id_or_float DISEQUAL l=separated_nonempty_list(PIPE,edge_item) { Ast.Atom_diseq (name, l)}
| BANG name=simple_id_or_float { Ast.Atom_absent name }
......@@ -610,6 +611,9 @@ node_features:
commands:
| COMMANDS x=delimited(LACC,separated_nonempty_list_final_opt(SEMIC,command),RACC) { x }
sub_edges:
| name=simple_id_or_float EQUAL value=edge_item { (name, value) }
command:
/* del_edge e */
| DEL_EDGE n_loc=simple_id_with_loc
......@@ -627,6 +631,10 @@ command:
| ADD_EDGE id_loc=simple_id_with_loc DDOT src=simple_id EDGE tar=simple_id
{ let (id,loc) = id_loc in (Ast.Add_edge_expl (src, tar, id), loc) }
/* add_edge m -[1=obj, 2=e.2]-> n */
| ADD_EDGE src_loc=simple_id_with_loc label=delimited(LTR_EDGE_LEFT,separated_list_final_opt(COMMA,sub_edges),LTR_EDGE_RIGHT) tar=simple_id
{ let (src,loc) = src_loc in (Ast.Add_edge_items (src, tar, label), loc) }
/* shift_in m ==> n */
| SHIFT_IN src_loc=simple_id_with_loc ARROW tar=simple_id
{ let (src,loc) = src_loc in (Ast.Shift_in (src, tar, Ast.Neg_list []), loc) }
......
......@@ -1026,6 +1026,32 @@ module Rule = struct
| Some new_graph -> (new_graph, created_nodes, true)
end
| Command.ADD_EDGE_ITEMS (src_cn,tar_cn,items) ->
let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in
let direct_items = List.map (fun (name, value) ->
match Str.bounded_split (Str.regexp_string ".") value 2
with
| [id; nam] ->
begin
match List.assoc_opt id matching.e_match with
| None -> (name, value)
| Some (_,matched_edge,_) ->
match G_edge.get_sub nam matched_edge with
| Some new_value -> (name, new_value)
| None -> Error.run "ADD_EDGE_ITEMS: no items named '%s' in matched node '%s'" nam id
end
| _ -> (name, value)
) items in
let edge = G_edge.from_items direct_items in
begin
match G_graph.add_edge graph src_gid edge tar_gid with
| None when !Global.safe_commands ->
Error.run "ADD_EDGE_EXPL: the edge '%s' already exists %s" (G_edge.to_string ?domain edge) (Loc.to_string loc)
| None -> (graph, created_nodes, eff)
| Some new_graph -> (new_graph, created_nodes, true)
end
| Command.DEL_EDGE_EXPL (src_cn,tar_cn,edge) ->
let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in
......@@ -1237,6 +1263,36 @@ module Rule = struct
}
end
| Command.ADD_EDGE_ITEMS (src_cn,tar_cn,items) ->
let src_gid = node_find src_cn in
let tar_gid = node_find tar_cn in
let direct_items = List.map (fun (name, value) ->
match Str.bounded_split (Str.regexp_string ".") value 2
with
| [id; nam] ->
begin
match List.assoc_opt id matching.e_match with
| None -> (name, value)
| Some (_,matched_edge,_) ->
match G_edge.get_sub nam matched_edge with
| Some new_value -> (name, new_value)
| None -> Error.run "ADD_EDGE_ITEMS: no items named '%s' in matched node '%s'" nam id
end
| _ -> (name, value)
) items in
let edge = G_edge.from_items direct_items in
begin
match G_graph.add_edge gwh.Graph_with_history.graph src_gid edge tar_gid with
| None when !Global.safe_commands ->
Error.run "ADD_EDGE_EXPL: the edge '%s' already exists %s" (G_edge.to_string ?domain edge) (Loc.to_string loc)
| None -> Graph_with_history_set.singleton gwh
| Some new_graph -> Graph_with_history_set.singleton
{gwh with
Graph_with_history.graph = new_graph;
delta = Delta.add_edge src_gid edge tar_gid gwh.Graph_with_history.delta;
}
end
| Command.DEL_EDGE_EXPL (src_cn,tar_cn,edge) ->
let src_gid = node_find src_cn in
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