* Type of Graph.node_matching changed!

New ordering of graph nodes (two subsets) 

src/grew_fs.ml

@@ -382,11 +382,14 @@ module P_fs = struct
 
   let check_position ?param position t =
     try
-      match List.assoc "position" t with
-        | {P_feature.cst=P_feature.Equal pos_list; in_param=[]} -> List.mem (Float position) pos_list
-        | {P_feature.cst=P_feature.Different pos_list; in_param=[]} -> not (List.mem (Float position) pos_list)
-        | {P_feature.cst=P_feature.Absent} -> false
-        | _ -> Error.bug "Position can't be parametrized"
+      match (List.assoc "position" t, position) with
+      | ({P_feature.cst=P_feature.Equal pos_list; in_param=[]}, Some p) -> List.mem (Float p) pos_list
+      | ({P_feature.cst=P_feature.Equal pos_list; in_param=[]}, None) -> false
+      | ({P_feature.cst=P_feature.Different pos_list; in_param=[]}, Some p) -> not (List.mem (Float p) pos_list)
+      | ({P_feature.cst=P_feature.Different pos_list; in_param=[]}, None) -> false
+      | ({P_feature.cst=P_feature.Absent}, Some _) -> false
+      | ({P_feature.cst=P_feature.Absent}, None) -> true
+      | _ -> Error.bug "Position can't be parametrized"
     with Not_found -> true
 
   let build ?domain ?pat_vars ast_fs =

src/grew_fs.mli

@@ -97,7 +97,7 @@ module P_fs: sig
 
   (** [check_position ?parma position pfs] checks wheter [pfs] is compatible with a node at [position].
       It returns [true] iff [pfs] has no requirement about position ok if the requirement is satisfied. *)
-  val check_position: ?param:Lex_par.t -> float -> t -> bool
+  val check_position: ?param:Lex_par.t -> float option -> t -> bool
 
   exception Fail_unif
 

src/grew_graph.ml

@@ -296,8 +296,8 @@ module G_graph = struct
     let node = Gid_map.find node_id graph.map in
     Massoc_gid.exists (fun _ e -> Label_cst.match_ ?domain label_cst e) (G_node.get_next node)
 
-  let get_annot_info graph =
-    let annot_info =
+  let get_annot_info graph = failwith "Unused function !"
+    (* let annot_info =
       Gid_map.fold
         (fun _ node acc ->
           match (G_node.get_annot_info node, acc) with
@@ -307,7 +307,7 @@ module G_graph = struct
         ) graph.map None in
     match annot_info with
       | Some x -> x
-      | None -> Error.build "[G_node.get_annot_info] No nodes with annot info"
+      | None -> Error.build "[G_node.get_annot_info] No nodes with annot info" *)
 
   (* -------------------------------------------------------------------------------- *)
   let map_add_edge_opt map id_src label id_tar =
@@ -350,7 +350,7 @@ module G_graph = struct
         else
           let (new_tail, table) = loop (node_id :: already_bound) (index+1) (Some index) tail in
           let succ = if tail = [] then None else Some (index+1) in
-          let new_node = G_node.build ?domain ?prec ?succ index (ast_node, loc) in
+          let new_node = G_node.build ?domain ?prec ?succ ~position:(float index) (ast_node, loc) in
             (
               Gid_map.add index new_node new_tail,
               (node_id,index)::table
@@ -529,54 +529,62 @@ module G_graph = struct
     { graph with map = new_map }
 
   (* -------------------------------------------------------------------------------- *)
-  let insert ?domain id1 id2 graph =
+  let insert 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_pos = match (G_node.get_position node1, G_node.get_position node2) with
+    | (G_node.Ordered pos1, G_node.Ordered pos2) -> (pos1 +. pos2) /. 2.
+    | _ -> Error.run "Try to insert into non ordered nodes" in
     let new_gid = graph.highest_index + 1 in
     let map = graph.map
-      |> (Gid_map.add new_gid (G_node.fresh ?domain ~prec:id1 ~succ:id2 new_pos))
+      |> (Gid_map.add new_gid (G_node.fresh ~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_gid })
 
   (* -------------------------------------------------------------------------------- *)
-  let append ?domain id graph =
+  let append 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_pos = match G_node.get_position node with
+    | G_node.Ordered pos -> pos +. 1.
+    | _ -> Error.run "Try to append into non ordered nodes" in
     let new_gid = graph.highest_index + 1 in
     let map = graph.map
-      |> (Gid_map.add new_gid (G_node.fresh ?domain ~prec:id new_pos))
+      |> (Gid_map.add new_gid (G_node.fresh ~prec:id new_pos))
       |> (Gid_map.add id (G_node.set_succ new_gid node)) in
     (new_gid, { graph with map; highest_index = new_gid })
 
   (* -------------------------------------------------------------------------------- *)
-  let prepend ?domain id graph =
+  let prepend 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_pos = match G_node.get_position node with
+    | G_node.Ordered pos -> pos -. 1.
+    | _ -> Error.run "Try to prepend into non ordered nodes" in
     let new_gid = graph.highest_index + 1 in
     let map = graph.map
-      |> (Gid_map.add new_gid (G_node.fresh ?domain ~succ:id new_pos))
+      |> (Gid_map.add new_gid (G_node.fresh ~succ:id new_pos))
       |> (Gid_map.add id (G_node.set_prec new_gid node)) in
     (new_gid, { graph with map; highest_index = new_gid })
 
   (* -------------------------------------------------------------------------------- *)
-  let add_after loc ?domain node_id graph =
+  let add_after 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
+    | Some gid_succ -> insert node_id gid_succ graph
+    | None -> append node_id graph
 
   (* -------------------------------------------------------------------------------- *)
-  let add_before loc ?domain node_id graph =
+  let add_before 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
+    | Some gid_prec -> insert gid_prec node_id graph
+    | None -> prepend node_id graph
+
+  (* -------------------------------------------------------------------------------- *)
+  let add_unordered graph =
+    let new_gid = graph.highest_index + 1 in
+    let map = Gid_map.add new_gid (G_node.fresh_unordered ()) graph.map in
+    (new_gid, { graph with map; highest_index = new_gid })
 
   (* -------------------------------------------------------------------------------- *)
   (* move out-edges (which respect cst [labels,neg]) from id_src are moved to out-edges out off node id_tar *)
@@ -661,7 +669,11 @@ module G_graph = struct
         (function
           | Concat_item.Feat (node_gid, "position") ->
             let node = Gid_map.find node_gid graph.map in
-            sprintf "%g" (G_node.get_position node)
+            begin
+              match G_node.get_position node with
+              | G_node.Ordered p -> sprintf "%g" p
+              | _ -> Error.run ?loc "Try to read position of an unordered node"
+            end
           | Concat_item.Feat (node_gid, feat_name) ->
             let node = Gid_map.find node_gid graph.map in
             (match G_fs.get_string_atom feat_name (G_node.get_fs node) with
@@ -760,7 +772,8 @@ module G_graph = struct
       (fun (id, node) ->
         let decorated_feat = try List.assoc id deco.G_deco.nodes with Not_found -> ("",[]) in
         let fs = G_node.get_fs node in
-        let dep_fs = G_fs.to_dep ~decorated_feat ~position:(G_node.get_position node) ?filter ?main_feat fs in
+        let pos= match G_node.get_position node with G_node.Ordered x -> Some x | _ -> None in
+        let dep_fs = G_fs.to_dep ~decorated_feat ?position:pos ?filter ?main_feat fs in
 
         let style = match G_fs.get_string_atom "void" fs with
           | Some "y" -> "; forecolor=red; subcolor=red; "
@@ -884,7 +897,7 @@ module G_graph = struct
       let gnode = List.assoc gid snodes in
       if G_node.is_conll_root gnode
       then 0.
-      else G_node.get_position (List.assoc gid snodes) in
+      else G_node.get_float (List.assoc gid snodes) in
 
     (* Warning: [govs_labs] maps [gid]s to [num]s *)
     let govs_labs =

src/grew_graph.mli

@@ -137,8 +137,9 @@ module G_graph: sig
       [graph] is unchanged if the node is not in it. *)
   val del_node: t -> Gid.t -> t
 
-  val add_before: Loc.t -> ?domain:Domain.t -> Gid.t -> t -> (Gid.t * t)
-  val add_after: Loc.t -> ?domain:Domain.t -> Gid.t -> t -> (Gid.t * t)
+  val add_before: Gid.t -> t -> (Gid.t * t)
+  val add_after: Gid.t -> t -> (Gid.t * t)
+  val add_unordered: t -> (Gid.t * t)
 
   (** move all in arcs to id_src are moved to in arcs on node id_tar from graph, with all its incoming edges *)
   val shift_in: Loc.t -> ?domain:Domain.t -> Gid.t -> Gid.t -> (Gid.t -> bool) -> Label_cst.t -> t -> t

src/grew_node.ml

@@ -20,13 +20,17 @@ open Grew_fs
 
 (* ================================================================================ *)
 module G_node = struct
+  type position =
+  | Ordered of float
+  | Unordered of int
+
   type t = {
       name: Id.name option;
       fs: G_fs.t;
       next: G_edge.t Massoc_gid.t;
       succ: Gid.t option;
       prec: Gid.t option;
-      position: float;
+      position: position;
       conll_root: bool;
       efs: (string * string) list;
     }
@@ -38,7 +42,9 @@ module G_node = struct
   let set_next next t = {t with next }
 
   let get_position t = t.position
-  let set_position position t = { t with position }
+  let set_position p t = { t with position = Ordered p }
+
+  let get_float t = match t.position with Ordered p -> p | Unordered i -> float i
 
   let get_prec t = t.prec
   let get_succ t = t.succ
@@ -53,7 +59,7 @@ module G_node = struct
     | Some n -> n
     | None -> sprintf "_%s_" (Gid.to_string gid)
 
-  let empty = { name=None; fs = G_fs.empty; next = Massoc_gid.empty; succ = None; prec = None; position = -1.; conll_root=false; efs=[] }
+  let empty = { name=None; fs = G_fs.empty; next = Massoc_gid.empty; succ = None; prec = None; position = Unordered 0; conll_root=false; efs=[] }
 
   let is_conll_root t = t.conll_root
 
@@ -75,9 +81,13 @@ module G_node = struct
 
   let get_annot_info t = G_fs.get_annot_info t.fs
 
-  let build ?domain ?prec ?succ position (ast_node, loc) =
+  let current_index = ref 0
+  let fresh_index () = decr current_index; !current_index
+
+  let build ?domain ?prec ?succ ?position (ast_node, loc) =
     let fs = G_fs.build ?domain ast_node.Ast.fs in
-    { empty with name=Some ast_node.Ast.node_id; fs; position = float_of_int position; prec; succ }
+    let pos = match position with None -> Unordered (fresh_index ()) | Some p -> Ordered p in
+    { empty with name=Some ast_node.Ast.node_id; fs; position = pos; prec; succ }
 
   let float_of_conll_id = function
   | (i,None) -> float i
@@ -87,14 +97,15 @@ module G_node = struct
   let of_conll ?loc ?prec ?succ ?domain line =
     if line = Conll.root
     then { empty with conll_root=true; succ}
-    else { empty with fs = G_fs.of_conll ?loc ?domain line; position = float_of_conll_id line.Conll.id; prec; succ; efs=line.Conll.efs }
+    else { empty with fs = G_fs.of_conll ?loc ?domain line; position = Ordered (float_of_conll_id line.Conll.id); prec; succ; efs=line.Conll.efs }
 
   let pst_leaf ?loc ?domain phon position =
-    { empty with fs = G_fs.pst_leaf ?loc ?domain phon; position = float position }
+    { empty with fs = G_fs.pst_leaf ?loc ?domain phon; position = Ordered (float position) }
   let pst_node ?loc ?domain cat position =
-    { empty with fs = G_fs.pst_node ?loc ?domain cat; position = float position }
+    { empty with fs = G_fs.pst_node ?loc ?domain cat; position = Ordered (float position) } (* TODO : change to Unordered *)
 
-  let fresh ?domain ?prec ?succ position = { empty with position; prec; succ }
+  let fresh ?prec ?succ pos = { empty with position = Ordered pos; prec; succ }
+  let fresh_unordered () = { empty with position = Unordered (fresh_index ())}
 
   let remove (id_tar : Gid.t) label t = {t with next = Massoc_gid.remove id_tar label t.next}
 
@@ -169,9 +180,12 @@ module P_node = struct
 
   let match_ ?param p_node g_node =
     (* (match param with None -> printf "<None>" | Some p -> printf "<Some>"; Lex_par.dump p); *)
-    if P_fs.check_position ?param (G_node.get_position g_node) p_node.fs
-    then P_fs.match_ ?param p_node.fs (G_node.get_fs g_node)
-    else raise P_fs.Fail
+    match G_node.get_position g_node with
+    | G_node.Unordered _ -> None
+    | G_node.Ordered p ->
+      if P_fs.check_position ?param (Some p) p_node.fs
+      then P_fs.match_ ?param p_node.fs (G_node.get_fs g_node)
+      else raise P_fs.Fail
 
   let compare_pos t1 t2 = Pervasives.compare t1.loc t2.loc
 end (* module P_node *)

src/grew_node.mli

@@ -19,6 +19,11 @@ open Grew_ast
 
 (* ================================================================================ *)
 module G_node: sig
+  type position =
+  | Ordered of float
+  | Unordered of int
+
+
   type t
 
   val empty: t
@@ -40,6 +45,10 @@ module G_node: sig
 
   val set_fs: G_fs.t -> t -> t
   val set_position: float -> t -> t
+  val get_position: t -> position
+  val get_float: t -> float
+
+
   val set_next: G_edge.t Massoc_gid.t -> t -> t
 
   val get_name: Gid.t -> t -> string
@@ -57,14 +66,16 @@ module G_node: sig
   val rm_out_edges: t -> t
 
   val add_edge: G_edge.t -> Gid.t -> t -> t option
-  val build: ?domain:Domain.t -> ?prec:Gid.t -> ?succ:Gid.t -> int -> Ast.node -> t
+
+
+  val build: ?domain:Domain.t -> ?prec:Gid.t -> ?succ:Gid.t -> ?position:float -> Ast.node -> t
   val of_conll: ?loc:Loc.t -> ?prec:Gid.t -> ?succ:Gid.t -> ?domain:Domain.t -> Conll.line -> t
   val pst_leaf: ?loc:Loc.t -> ?domain:Domain.t -> string -> int -> t
   val pst_node: ?loc:Loc.t -> ?domain:Domain.t -> string -> int -> t
 
-  val fresh: ?domain:Domain.t -> ?prec:Gid.t -> ?succ:Gid.t -> float -> t
+  val fresh: ?prec:Gid.t -> ?succ:Gid.t -> float -> t
+  val fresh_unordered: unit -> t
 
-  val get_position: t -> float
 
   val position_comp: t -> t -> int
 

src/grew_rule.ml

@@ -594,7 +594,7 @@ module Rule = struct
       (fun pid gid acc ->
         let pnode = P_graph.find pid (fst pattern).graph in
         let gnode = G_graph.find gid graph in
-        (P_node.get_name pnode, int_of_float (G_node.get_position gnode)) :: acc
+        (P_node.get_name pnode, G_node.get_float gnode) :: acc
       ) n_match []
 
   let empty_matching param = { n_match = Pid_map.empty; e_match = []; m_param = param;}
@@ -684,10 +684,20 @@ module Rule = struct
   let apply_cst ?domain graph matching cst =
     let get_node pid = G_graph.find (Pid_map.find pid matching.n_match) graph in
     let get_string_feat pid = function
-      | "position" -> Some (sprintf "%g" (G_node.get_position (get_node pid)))
+      | "position" ->
+        begin
+          match G_node.get_position (get_node pid) with
+          | G_node.Ordered f -> Some (sprintf "%g" f)
+          | _ -> Error.run "Cannot read position of an unordered node"
+        end
       | feat_name -> G_fs.get_string_atom feat_name (G_node.get_fs (get_node pid)) in
     let get_float_feat pid = function
-      | "position" -> Some (G_node.get_position (get_node pid))
+      | "position" ->
+        begin
+          match G_node.get_position (get_node pid) with
+          | G_node.Ordered f -> Some f
+          | _ -> Error.run "Cannot read position of an unordered node"
+        end
       | feat_name -> G_fs.get_float_feat feat_name (G_node.get_fs (get_node pid)) in
 
     match cst with
@@ -1002,33 +1012,32 @@ module Rule = struct
 
     | Command.NEW_AFTER (created_name,base_cn) ->
         let base_gid = node_find base_cn in
-        let (new_gid,new_graph) = G_graph.add_after loc ?domain base_gid instance.Instance.graph in
+        let (new_gid,new_graph) = G_graph.add_after base_gid instance.Instance.graph in
         (
          {instance with
           Instance.graph = new_graph;
-          history = List_.sort_insert (Command.H_NEW_AFTER (created_name,new_gid)) instance.Instance.history;
+          history = List_.sort_insert (Command.H_NEW_AFTER (created_name,base_gid)) instance.Instance.history;
         },
          (created_name,new_gid) :: created_nodes
         )
 
     | Command.NEW_NODE (created_name) ->
-        let base_gid = G_graph.get_highest instance.Instance.graph in
-        let (new_gid,new_graph) = G_graph.add_after loc ?domain base_gid instance.Instance.graph in
+        let (new_gid,new_graph) = G_graph.add_unordered instance.Instance.graph in
         (
          {instance with
           Instance.graph = new_graph;
-          history = List_.sort_insert (Command.H_NEW_AFTER (created_name,new_gid)) instance.Instance.history;
+          history = List_.sort_insert (Command.H_NEW_NODE created_name) instance.Instance.history;
         },
          (created_name,new_gid) :: created_nodes
         )
 
     | Command.NEW_BEFORE (created_name,base_cn) ->
         let base_gid = node_find base_cn in
-        let (new_gid,new_graph) = G_graph.add_before loc ?domain base_gid instance.Instance.graph in
+        let (new_gid,new_graph) = G_graph.add_before base_gid instance.Instance.graph in
         (
          {instance with
           Instance.graph = new_graph;
-          history = List_.sort_insert (Command.H_NEW_BEFORE (created_name,new_gid)) instance.Instance.history;
+          history = List_.sort_insert (Command.H_NEW_BEFORE (created_name,base_gid)) instance.Instance.history;
         },
          (created_name,new_gid) :: created_nodes
         )
@@ -1317,8 +1326,4 @@ module Rule = struct
             Some (apply_rule ?domain instance first_matching_where_all_witout_are_fulfilled rule)
           with Not_found -> None
 
-
-
-
-
 end (* module Rule *)

src/grew_rule.mli

@@ -109,7 +109,7 @@ module Rule : sig
   val build_pattern: ?domain:Domain.t -> Ast.pattern -> pattern
 
   (** [node_matching pattern graph matching] return a assoc list (pid_name, gid.position) *)
-  val node_matching: pattern -> G_graph.t -> matching -> (string * int) list
+  val node_matching: pattern -> G_graph.t -> matching -> (string * float) list
 
   (** [match_in_graph rule graph] returns the list of matching of the pattern of the rule into the graph *)
   val match_in_graph: ?domain:Domain.t -> ?param:Lex_par.t -> pattern -> G_graph.t -> matching list

src/libgrew.mli

@@ -100,7 +100,7 @@ module Graph : sig
   (** [search_pattern pattern graph] returns the list of the possible matching of [pattern] in [graph] *)
   val search_pattern: ?domain:Domain.t -> Pattern.t -> t -> Matching.t list
 
-  val node_matching: Pattern.t -> t -> Matching.t -> (string * int) list
+  val node_matching: Pattern.t -> t -> Matching.t -> (string * float) list
 end
 
 (* ==================================================================================================== *)