New declaration of add_node

PREC and SUCC rels printed only in debug mode

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8965 7838e531-6607-4d57-9587-6c381814729c

src/grew_ast.ml

@@ -188,6 +188,11 @@ module Ast = struct
     | String_item of string
     | Param_item of string
 
+  let string_of_concat_item = function
+    | Qfn_item id -> sprintf "%s" (dump_feature_ident id)
+    | String_item s -> sprintf "\"%s\"" s
+    | Param_item var -> sprintf "%s" var
+
   type u_command =
     | Del_edge_expl of (Id.name * Id.name * edge_label)
     | Del_edge_name of string
@@ -200,12 +205,61 @@ module Ast = struct
 
     | Merge_node of (Id.name * Id.name)
     | New_neighbour of (Id.name * Id.name * edge_label)
+    | New_node of Id.name
+    | New_before of (Id.name * Id.name)
+    | New_after of (Id.name * Id.name)
+
     | Del_node of Id.name
 
     | Del_feat of feature_ident
     | Update_feat of feature_ident * concat_item list
   type command = u_command * Loc.t
 
+  let string_of_u_command u_command = match u_command with
+    | Del_edge_expl (n1,n2,label) ->
+      sprintf "del_edge %s -[%s]-> %s" n1 label n2
+    | Del_edge_name name -> sprintf "del_edge %s" name
+    | Add_edge (n1,n2,label) ->
+      sprintf "add_edge %s -[%s]-> %s" n1 label n2
+
+    | Shift_in (n1,n2,([],true)) ->
+      sprintf "shift_in %s ==> %s" n1 n2
+    | Shift_in (n1,n2,(labels,false)) ->
+      sprintf "shift_in %s =[%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
+    | Shift_in (n1,n2,(labels,true)) ->
+      sprintf "shift_in %s =[^%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
+
+    | Shift_out (n1,n2,([],true)) ->
+      sprintf "shift_out %s ==> %s" n1 n2
+    | Shift_out (n1,n2,(labels,false)) ->
+      sprintf "shift_out %s =[%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
+    | Shift_out (n1,n2,(labels,true)) ->
+      sprintf "shift_out %s =[^%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
+
+    | Shift_edge (n1,n2,([],true)) ->
+      sprintf "shift %s ==> %s" n1 n2
+    | Shift_edge (n1,n2,(labels,false)) ->
+      sprintf "shift %s =[%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
+    | Shift_edge (n1,n2,(labels,true)) ->
+      sprintf "shift %s =[^%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
+
+    | Merge_node (n1,n2) -> sprintf "merge %s ==> %s" n1 n2
+    | New_neighbour (n1,n2,label) -> sprintf "add_node %s: <-[%s]- %s" n1 label n2
+    | New_node (n) -> sprintf "add_node %s" n
+    | New_before (n1,n2) -> sprintf "add_node %s :< %s" n1 n2
+    | New_after (n1,n2) -> sprintf "add_node %s :> %s" n1 n2
+    | Del_node act_id -> sprintf "del_node %s" act_id
+    | Update_feat ((act_id, feat_name),item_list) ->
+      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
+
+  let rec replace_new_neighbour = function
+  | [] -> []
+  | (New_neighbour (new_name, old_name, edge),loc) :: tail ->
+    (New_after (new_name, old_name),loc) :: (Add_edge (old_name, new_name, edge),loc) :: (replace_new_neighbour tail)
+  | head :: tail -> head :: (replace_new_neighbour tail)
+
   (* the [rule] type is used for 3 kinds of module items:
      - rule     { param=None; ... }
      - lex_rule

src/grew_ast.mli

@@ -123,12 +123,22 @@ module Ast : sig
 
     | Merge_node of (Id.name * Id.name)
     | New_neighbour of (Id.name * Id.name * edge_label)
+
+    | New_node of Id.name
+    | New_before of (Id.name * Id.name)
+    | New_after of (Id.name * Id.name)
+
     | Del_node of Id.name
 
     | Del_feat of feature_ident
     | Update_feat of feature_ident * concat_item list
+  val string_of_u_command:  u_command -> string
   type command = u_command * Loc.t
 
+
+
+  val replace_new_neighbour: command list -> command list
+
   type rule = {
       rule_id:Id.name;
       pattern: pattern;

src/grew_base.ml

@@ -601,6 +601,7 @@ module Global = struct
   let current_file = ref "Not a file"
   let current_line = ref 1
   let label_flag = ref false
+  let debug = ref false
 
   let init file =
     current_file := file;

src/grew_base.mli

@@ -277,4 +277,6 @@ module Global: sig
   val current_line: int ref
   val init: string -> unit
   val label_flag: bool ref
+
+  val debug: bool ref
 end

src/grew_command.ml

@@ -40,6 +40,11 @@ module Command  = struct
     | DEL_FEAT of (command_node * string)
     | UPDATE_FEAT of (command_node * string * item list)
     | NEW_NEIGHBOUR of (string * G_edge.t * Pid.t) (* TODO: remove *)
+
+    | NEW_NODE of string
+    | NEW_BEFORE of (string * command_node)
+    | NEW_AFTER of (string * command_node)
+
     | 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)
@@ -56,11 +61,17 @@ module Command  = struct
     | H_DEL_FEAT of (Gid.t * string)
     | H_UPDATE_FEAT of (Gid.t * string * string)
     | H_NEW_NEIGHBOUR of (string * G_edge.t * Gid.t) (* TODO: remove *)
+
+    | H_NEW_NODE of string
+    | H_NEW_BEFORE of (string * Gid.t)
+    | H_NEW_AFTER of (string * Gid.t)
+
     | H_SHIFT_EDGE of (Gid.t * Gid.t)
     | H_SHIFT_IN of (Gid.t * Gid.t)
     | H_SHIFT_OUT of (Gid.t * Gid.t)
     | H_MERGE_NODE of (Gid.t * Gid.t)
 
+
   let build domain label_domain ?param (kai, kei) table locals ast_command =
     (* kai stands for "known act ident", kei for "known edge ident" *)
 
@@ -140,6 +151,23 @@ module Command  = struct
 	             (Loc.to_string loc)
 	        end
 
+      | (Ast.New_node new_id, loc) ->
+          if List.mem new_id kai
+          then Error.build ~loc "Node identifier \"%s\" is already used" new_id;
+          (((NEW_NODE new_id), loc),(new_id::kai, kei))
+
+      | (Ast.New_before (new_id, old_id), loc) ->
+          check_node_id loc old_id kai;
+          if List.mem new_id kai
+          then Error.build ~loc "Node identifier \"%s\" is already used" new_id;
+          ((NEW_BEFORE (new_id,pid_of_act_id loc old_id), loc),(new_id::kai, kei))
+
+      | (Ast.New_after (new_id, old_id), loc) ->
+          check_node_id loc old_id kai;
+          if List.mem new_id kai
+          then Error.build ~loc "Node identifier \"%s\" is already used" new_id;
+          ((NEW_AFTER (new_id,pid_of_act_id loc old_id), loc),(new_id::kai, kei))
+
       | (Ast.Del_node act_n, loc) ->
           check_node_id loc act_n kai;
           ((DEL_NODE (pid_of_act_id loc act_n), loc), (List_.rm act_n kai, kei))

src/grew_command.mli

@@ -34,6 +34,11 @@ module Command : sig
     | DEL_FEAT of (command_node * string)
     | UPDATE_FEAT of (command_node * string * item list)
     | NEW_NEIGHBOUR of (string * G_edge.t * Pid.t)
+
+    | NEW_NODE of string
+    | NEW_BEFORE of (string * command_node)
+    | NEW_AFTER of (string * command_node)
+
     | 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)
@@ -48,6 +53,11 @@ module Command : sig
     | H_DEL_FEAT of (Gid.t *string)
     | H_UPDATE_FEAT of (Gid.t * string * string)
     | H_NEW_NEIGHBOUR of (string * G_edge.t * Gid.t)
+
+    | H_NEW_NODE of string
+    | H_NEW_BEFORE of (string * Gid.t)
+    | H_NEW_AFTER of (string * Gid.t)
+
     | H_SHIFT_EDGE of (Gid.t * Gid.t)
     | H_SHIFT_IN of (Gid.t * Gid.t)
     | H_SHIFT_OUT of (Gid.t * Gid.t)

src/grew_fs.ml

@@ -306,8 +306,8 @@ module G_fs = struct
       | [] -> "_"
       | l ->  String.concat "#" l in
 
-    let last = match (filter, position) with
-      | (Some l, Some f) when List.mem "position" l && f > 0. -> [G_feature.to_string ("position", Float f)]
+    let last = match (!Global.debug, position) with
+      | (true, Some f) -> [(G_feature.to_string ("position", Float f))^":B:lightblue"]
       | _ -> [] in
 
     let lines = List.fold_left

src/grew_graph.ml

@@ -209,12 +209,13 @@ end (* module G_deco *)
 (* ================================================================================ *)
 module G_graph = struct
   type t = {
-    meta: string list; (* meta-informations *)
-    map: G_node.t Gid_map.t;      (* node description *)
+    meta: string list;                       (* meta-informations *)
+    map: G_node.t Gid_map.t;                 (* node description *)
     fusion: (Gid.t * (Gid.t * string)) list; (* the list of fusion word considered in UD conll *)
+    highest_index: int;                      (* the next free interger index *)
   }
 
-  let empty = {meta=[]; map=Gid_map.empty; fusion=[]}
+  let empty = {meta=[]; map=Gid_map.empty; fusion=[]; highest_index=0; }
 
   (* ---------------------------------------------------------------------- *)
   let rename mapping graph =
@@ -239,6 +240,7 @@ module G_graph = struct
         ) t.map (0, []) in
         rename mapping t
 
+  let get_highest g = g.highest_index
 
   let find node_id graph = Gid_map.find node_id graph.map
 
@@ -254,13 +256,6 @@ module G_graph = struct
       | (Gid.Old i,_) -> i
       | _ -> Error.bug "[G_graph.max_binding]"
 
-  let list_num test =
-    let rec loop n = function
-      | [] -> raise Not_found
-      | x::_ when test x -> n
-      | _::t -> loop (n+1) t
-    in loop 0
-
   (* is there an edge e out of node i ? *)
   let edge_out domain graph node_id label_cst =
     let node = Gid_map.find node_id graph.map in
@@ -299,36 +294,29 @@ module G_graph = struct
     let full_node_list = gr_ast.Ast.nodes
     and full_edge_list = gr_ast.Ast.edges in
 
-    let next_free_position = ref 1. in
-
-    let named_nodes =
-      let rec loop already_bound = function
-        | [] -> []
-        | (ast_node, loc) :: tail ->
-          let node_id = ast_node.Ast.node_id in
-          if List.mem node_id already_bound
-          then Error.build "[GRS] [Graph.build] try to build a graph with twice the same node id '%s'" node_id
-          else
-            let (new_id,new_node) = G_node.build domain ~def_position:!next_free_position (ast_node, loc) in
-            next_free_position := 1. +. (max !next_free_position (G_node.get_position new_node));
-            let new_tail = loop (node_id :: already_bound) tail in
-            (new_id,new_node) :: new_tail in
-      loop [] full_node_list in
+    let rec loop already_bound index prec = function
+      | [] -> (Gid_map.empty,[])
 
-    let sorted_nodes = List.sort (fun (id1,_) (id2,_) -> Pervasives.compare id1 id2) named_nodes in
-    let (sorted_ids, node_list) = List.split sorted_nodes in
+      | (ast_node, loc)::tail ->
+        let node_id = ast_node.Ast.node_id in
+        if List.mem node_id already_bound
+        then Error.build ~loc "[GRS] [Graph.build] try to build a graph with twice the same node id '%s'" node_id
+        else
+          let (new_tail, table) = loop (node_id :: already_bound) (index+1) (Some (Gid.Old index)) tail in
+          let succ = if tail = [] then None else Some (Gid.Old (index+1)) in
+          let (_,new_node) = G_node.build domain ?prec ?succ index (ast_node, loc) in
+            (
+              Gid_map.add (Gid.Old index) new_node new_tail,
+              (node_id,index)::table
+            ) in
 
-    (* table contains the sorted list of node ids *)
-    let table = Array.of_list sorted_ids in
-
-    (* the nodes, in the same order *)
-    let map_without_edges = List_.foldi_left (fun i acc elt -> Gid_map.add (Gid.Old i) elt acc) Gid_map.empty node_list in
+    let (map_without_edges, table) = loop [] 0 None full_node_list in
 
     let map =
       List.fold_left
         (fun acc (ast_edge, loc) ->
-          let i1 = Id.build ~loc ast_edge.Ast.src table in
-          let i2 = Id.build ~loc ast_edge.Ast.tar table in
+          let i1 = List.assoc ast_edge.Ast.src table in
+          let i2 = List.assoc ast_edge.Ast.tar table in
           let edge = G_edge.build domain ~locals (ast_edge, loc) in
           (match map_add_edge acc (Gid.Old i1) edge (Gid.Old i2) with
             | Some g -> g
@@ -338,7 +326,7 @@ module G_graph = struct
           )
         ) map_without_edges full_edge_list in
 
-    {meta=gr_ast.Ast.meta; map=map; fusion = []}
+    {meta=gr_ast.Ast.meta; map=map; fusion = []; highest_index = (List.length full_node_list) -1}
 
 
 
@@ -389,7 +377,7 @@ module G_graph = struct
               )
           ) conll.Conll.multiwords in
 
-    {meta = conll.Conll.meta; map=map_with_edges; fusion}
+    {meta = conll.Conll.meta; map=map_with_edges; fusion; highest_index= (List.length sorted_lines) -1 }
 
   (* -------------------------------------------------------------------------------- *)
   (** input : "Le/DET/le petit/ADJ/petit chat/NC/chat dort/V/dormir ./PONCT/." *)
@@ -421,48 +409,9 @@ module G_graph = struct
     try Some (List.assoc name atts)
     with Not_found -> None
 
- (* -------------------------------------------------------------------------------- *)
- (** [of_xml d_xml] loads a graph in the xml format: [d_xml] must be a <D> xml element *)
-  let of_xml domain d_xml =
-    match d_xml with
-      | Xml.Element ("D", _, t_or_r_list) ->
-        let (t_list, r_list) = List.partition (function Xml.Element ("T",_,_) -> true | _ -> false) t_or_r_list in
-        let (nodes_without_edges, mapping) =
-          List_.foldi_left
-            (fun i (acc, acc_map) t_xml ->
-              match t_xml with
-                | Xml.Element ("T", t_atts, [Xml.PCData phon]) ->
-                  let id = List.assoc "id" t_atts in
-                  let other_feats = List.filter (fun (n,_) -> not (List.mem n ["id"; "start"; "end"; "label"])) t_atts in
-                  let new_fs =
-                    List.fold_left
-                      (fun acc2 (fn,fv) -> G_fs.set_feat domain fn fv acc2)
-                      G_fs.empty
-                      (("phon", phon) :: ("cat", (List.assoc "label" t_atts)) :: other_feats) in
-                  let new_node = G_node.set_fs new_fs (G_node.set_position (float i) G_node.empty) in
-                  (Gid_map.add (Gid.Old i) new_node acc, String_map.add id (Gid.Old i) acc_map)
-                | _ -> Log.critical "[G_graph.of_xml] Not a wellformed <T> tag"
-            ) (Gid_map.empty, String_map.empty) t_list in
-        let final_map =
-          List.fold_left
-            (fun acc r_xml ->
-              match r_xml with
-                | Xml.Element ("R", r_atts, _) ->
-                  let src = List.assoc "from" r_atts
-                  and tar = List.assoc "to" r_atts
-                  and label = List.assoc "label" r_atts in
-                  let gid_tar = String_map.find tar mapping in
-                  let gid_src = String_map.find src mapping in
-                  let old_node = Gid_map.find gid_src acc in
-                  let new_map =
-                    match G_node.add_edge (G_edge.make domain label) gid_tar old_node with
-                      | Some new_node -> Gid_map.add gid_src new_node acc
-                      | None -> Log.critical "[G_graph.of_xml] Fail to add edge" in
-                  new_map
-                | _ -> Log.critical "[G_graph.of_xml] Not a wellformed <R> tag"
-            ) nodes_without_edges r_list in
-        {meta=[]; map=final_map; fusion=[]}
-      | _ -> Log.critical "[G_graph.of_xml] Not a <D> tag"
+  (* -------------------------------------------------------------------------------- *)
+  (** [of_xml d_xml] loads a graph in the xml format: [d_xml] must be a <D> xml element *)
+  let of_xml domain d_xml = failwith "of_xml not available"
 
   (* -------------------------------------------------------------------------------- *)
   let del_edge domain ?edge_ident loc graph id_src label id_tar =
@@ -507,6 +456,59 @@ module G_graph = struct
       | Some g -> (index, {graph with map = g})
       | None -> Log.bug "[Graph.add_neighbour] add_edge must not fail"; exit 1
 
+  (* -------------------------------------------------------------------------------- *)
+  let insert domain id1 id2 graph =
+    let node1 = Gid_map.find id1 graph.map in
+    let node2 = Gid_map.find id2 graph.map in
+    let pos1 = G_node.get_position node1 in
+    let pos2 = G_node.get_position node2 in
+    let new_pos= (pos1 +. pos2) /. 2. in
+    let new_index = graph.highest_index + 1 in
+    let new_gid = Gid.Old new_index in
+    let map = graph.map
+      |> (Gid_map.add new_gid (G_node.fresh domain ~prec:id1 ~succ:id2 new_pos))
+      |> (Gid_map.add id1 (G_node.set_succ new_gid node1))
+      |> (Gid_map.add id2 (G_node.set_prec new_gid node2)) in
+    (new_gid, { graph with map; highest_index = new_index })
+
+  (* -------------------------------------------------------------------------------- *)
+  let append domain id graph =
+    let node = Gid_map.find id graph.map in
+    let pos = G_node.get_position node in
+    let new_pos= pos +. 1. in
+    let new_index = graph.highest_index + 1 in
+    let new_gid = Gid.Old new_index in
+    let map = graph.map
+      |> (Gid_map.add new_gid (G_node.fresh domain ~prec:id new_pos))
+      |> (Gid_map.add id (G_node.set_succ new_gid node)) in
+    (new_gid, { graph with map; highest_index = new_index })
+
+  (* -------------------------------------------------------------------------------- *)
+  let prepend domain id graph =
+    let node = Gid_map.find id graph.map in
+    let pos = G_node.get_position node in
+    let new_pos= pos -. 1. in
+    let new_index = graph.highest_index + 1 in
+    let new_gid = Gid.Old new_index in
+    let map = graph.map
+      |> (Gid_map.add new_gid (G_node.fresh domain ~succ:id new_pos))
+      |> (Gid_map.add id (G_node.set_prec new_gid node)) in
+    (new_gid, { graph with map; highest_index = new_index })
+
+  (* -------------------------------------------------------------------------------- *)
+  let add_after loc domain node_id graph =
+    let node = Gid_map.find node_id graph.map in
+    match G_node.get_succ node with
+    | Some gid_succ -> insert domain node_id gid_succ graph
+    | None -> append domain node_id graph
+
+  (* -------------------------------------------------------------------------------- *)
+  let add_before loc domain node_id graph =
+    let node = Gid_map.find node_id graph.map in
+    match G_node.get_prec node with
+    | Some gid_prec -> insert domain gid_prec node_id graph
+    | None -> prepend domain node_id graph
+
   (* -------------------------------------------------------------------------------- *)
   (* move out-edges (which respect cst [labels,neg]) from id_src are moved to out-edges out off node id_tar *)
   let shift_out loc domain src_gid tar_gid label_cst graph =
@@ -722,26 +724,32 @@ module G_graph = struct
         let style = match G_fs.get_string_atom "void" fs with
           | Some "y" -> "; forecolor=red; subcolor=red; "
           | _ -> "" in
-        bprintf buff "N_%s { %s%s }\n" (Gid.to_string id) dep_fs style
+
+        bprintf buff "N_%s { %s%s }\n"
+          (Gid.to_string id)
+          dep_fs
+          style
       ) snodes;
     bprintf buff "} \n";
 
     (* edges *)
     bprintf buff "[EDGES] { \n";
 
-    List.iter
-      (fun (id, node) ->
-        begin
-          match G_node.get_prec node with
-          | None -> ()
-          | Some p -> bprintf buff "N_%s -> N_%s { label=\"__PREC__\"; bottom; style=dot}\n" (Gid.to_string id) (Gid.to_string p)
-        end;
-        begin
-          match G_node.get_succ node with
-          | None -> ()
-          | Some s -> bprintf buff "N_%s -> N_%s { label=\"__SUCC__\"; bottom; style=dot}\n" (Gid.to_string id) (Gid.to_string s)
-        end
-      ) snodes;
+    if !Global.debug
+    then
+      List.iter
+        (fun (id, node) ->
+          begin
+            match G_node.get_prec node with
+            | None -> ()
+            | Some p -> bprintf buff "N_%s -> N_%s { label=\"__PREC__\"; bottom; style=dot; color=lightblue; forecolor=lightblue; }\n" (Gid.to_string id) (Gid.to_string p)
+          end;
+          begin
+            match G_node.get_succ node with
+            | None -> ()
+            | Some s -> bprintf buff "N_%s -> N_%s { label=\"__SUCC__\"; bottom; style=dot; color=lightblue; forecolor=lightblue; }\n" (Gid.to_string id) (Gid.to_string s)
+          end
+        ) snodes;
 
     Gid_map.iter
       (fun gid elt ->
@@ -790,6 +798,13 @@ module G_graph = struct
     Buffer.contents buff
 
   (* -------------------------------------------------------------------------------- *)
+  let list_num test =
+    let rec loop n = function
+      | [] -> raise Not_found
+      | x::_ when test x -> n
+      | _::t -> loop (n+1) t
+    in loop 0
+
   let to_raw domain graph =
     let nodes = Gid_map.fold (fun id elt acc -> (id,elt)::acc) graph.map [] in
     let snodes = List.sort (fun (_,n1) (_,n2) -> G_node.position_comp n1 n2) nodes in

src/grew_graph.mli

@@ -90,7 +90,9 @@ module G_graph: sig
 
   val normalize: t -> t
 
-  (** raise ??? *)
+  val get_highest: t -> int
+
+    (** TODO REMOVE  ??? *)
   val max_binding: t -> int
 
   (** [edge_out label_domain t id label_cst] returns true iff there is an out-edge from the node [id] with a label compatible with [label_cst] *)
@@ -137,6 +139,9 @@ module G_graph: sig
 
   val add_neighbour: Loc.t -> Domain.t -> t -> Gid.t -> G_edge.t -> (Gid.t * t)
 
+  val add_before: Loc.t -> Domain.t -> Gid.t -> t -> (Gid.t * t)
+  val add_after: Loc.t -> Domain.t -> Gid.t -> t -> (Gid.t * t)
+
   val merge_node: Loc.t -> Domain.t -> t -> Gid.t -> Gid.t -> t option
 
   (** move all in arcs to id_src are moved to in arcs on node id_tar from graph, with all its incoming edges *)

src/grew_html.ml

@@ -49,42 +49,7 @@ module Html_doc = struct
   let buff_html_command ?(li_html=false) buff (u_command,_) =
     bprintf buff "      ";
     if li_html then bprintf buff "<li>";
-    (match u_command with
-    | Ast.Del_edge_expl (n1,n2,label) ->
-      bprintf buff "del_edge %s -[%s]-> %s" n1 label n2
-    | Ast.Del_edge_name name -> bprintf buff "del_edge %s" name
-    | Ast.Add_edge (n1,n2,label) ->
-      bprintf buff "add_edge %s -[%s]-> %s" n1 label n2
-
-    | Ast.Shift_in (n1,n2,([],true)) ->
-      bprintf buff "shift_in %s ==> %s" n1 n2
-    | Ast.Shift_in (n1,n2,(labels,false)) ->
-      bprintf buff "shift_in %s =[%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
-    | Ast.Shift_in (n1,n2,(labels,true)) ->
-      bprintf buff "shift_in %s =[^%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
-
-    | Ast.Shift_out (n1,n2,([],true)) ->
-      bprintf buff "shift_out %s ==> %s" n1 n2
-    | Ast.Shift_out (n1,n2,(labels,false)) ->
-      bprintf buff "shift_out %s =[%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
-    | Ast.Shift_out (n1,n2,(labels,true)) ->
-      bprintf buff "shift_out %s =[^%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
-
-    | Ast.Shift_edge (n1,n2,([],true)) ->
-      bprintf buff "shift %s ==> %s" n1 n2
-    | Ast.Shift_edge (n1,n2,(labels,false)) ->
-      bprintf buff "shift %s =[%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
-    | Ast.Shift_edge (n1,n2,(labels,true)) ->
-      bprintf buff "shift %s =[^%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
-
-    | Ast.Merge_node (n1,n2) -> bprintf buff "merge %s ==> %s" n1 n2
-    | Ast.New_neighbour (n1,n2,label) -> bprintf buff "add_node %s: <-[%s]- %s" n1 label n2
-    | Ast.Del_node act_id -> bprintf buff "del_node %s" act_id
-    | Ast.Update_feat ((act_id, feat_name),item_list) ->
-      bprintf buff "%s.%s = %s" act_id feat_name (List_.to_string string_of_concat_item " + " item_list)
-    | Ast.Del_feat (act_id, feat_name) ->
-      bprintf buff "del_feat %s.%s" act_id feat_name
-    );
+    bprintf buff "%s" (Ast.string_of_u_command u_command);
     if li_html then bprintf buff "</li>\n" else bprintf buff ";\n"
 
   let html_feature (u_feature,_) =

src/grew_lexer.mll

@@ -206,6 +206,10 @@ and standard target = parse
 
 | "<<"       { LPREC }
 | ">>"       { LSUCC }
+
+| ":<"         { BEFORE }
+| ":>"         { AFTER }
+
 | "<"        { LT }
 | ">"        { GT }
 | "<=" | "≤" { LE }

src/grew_node.ml

@@ -41,6 +41,9 @@ module G_node = struct
   let get_prec t = t.prec
   let get_succ t = t.succ
 
+  let set_succ id t = { t with succ = Some id }
+  let set_prec id t = { t with prec = Some id }
+
   let empty = { fs = G_fs.empty; next = Massoc_gid.empty; succ = None; prec = None; position = -1.; conll_root=false }
 
   let is_conll_root t = t.conll_root
@@ -61,19 +64,17 @@ module G_node = struct
 
   let get_annot_info t = G_fs.get_annot_info t.fs
 
-  let build domain ?def_position (ast_node, loc) =
+  let build domain ?prec ?succ position (ast_node, loc) =
     let fs = G_fs.build domain ast_node.Ast.fs in
-    let position = match (ast_node.Ast.position, def_position) with
-      | (Some position, _) -> position
-      | (None, Some position) -> position
-      | (None, None) -> Error.bug "Cannot build a node without position" in
-    (ast_node.Ast.node_id, { empty with fs; position })
+    (ast_node.Ast.node_id, { empty with fs; position = float_of_int position; prec; succ })
 
   let of_conll ?loc ?prec ?succ domain line =
     if line = Conll.root
     then { empty with conll_root=true }