new type Pid.t … it compiles

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

src/grew_command.ml

@@ -53,7 +53,7 @@ module Command  = struct
   let build ?param (kni, kei) table locals ast_command = 
     let get_pid node_name =
       match Id.build_opt node_name table with
-      | Some id -> Pid id
+      | Some id -> Pid (Pid.Pos id)
       | None -> New node_name in
 
     let check_node loc node_id kni = 
@@ -101,7 +101,15 @@ module Command  = struct
         then Error.build ~loc "Node identifier \"%s\" is already used" name_created;
 	let edge = G_edge.make ~locals label in
 	begin
-	  try ((NEW_NEIGHBOUR (name_created, edge, Id.build ~loc ancestor table), loc), (name_created::kni, kei))
+	  try
+            (
+              (NEW_NEIGHBOUR
+                 (name_created,
+                  edge,
+                  Pid.Pos (Id.build ~loc ancestor table)
+                 ), loc),
+              (name_created::kni, kei)
+            )
 	  with Not_found -> 
 	    Log.fcritical "[GRS] tries to build a command New_neighbour (%s) on node %s which is not in the pattern %s"
 	      (G_edge.to_string edge)

src/grew_graph.ml

@@ -87,7 +87,9 @@ module P_graph = struct
     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 -> Pid_map.add i elt acc) Pid_map.empty node_list in
+    let map_without_edges = List_.foldi_left 
+      (fun i acc elt -> Pid_map.add (Pid.Pos i) elt acc) 
+      Pid_map.empty node_list in
 
     let (map : t) =
       List.fold_left
@@ -95,7 +97,7 @@ module P_graph = struct
 	  let i1 = Id.build ~loc ast_edge.Ast.src table in
 	  let i2 = Id.build ~loc ast_edge.Ast.tar table in
 	  let edge = P_edge.build ~locals (ast_edge, loc) in
-	  (match map_add_edge acc i1 edge i2 with
+	  (match map_add_edge acc (Pid.Pos i1) edge (Pid.Pos i2) with
 	  | Some g -> g
 	  | None -> Error.build "[GRS] [Graph.build] try to build a graph with twice the same edge %s %s"
                 (P_edge.to_string edge)
@@ -132,13 +134,13 @@ module P_graph = struct
     (* the nodes, in the same order stored with index -1, -2, ... -N *)
     let ext_map_without_edges =
       List_.foldi_left
-	(fun i acc elt -> Pid_map.add (-i-1) elt acc)
+	(fun i acc elt -> Pid_map.add (Pid.Neg i) elt acc)
 	Pid_map.empty
 	new_node_list in
 
     let old_map_without_edges =
       List.fold_left
-	(fun acc (id,node) -> Pid_map.add (Array_.dicho_find id old_table) node acc)
+	(fun acc (id,node) -> Pid_map.add (Pid.Pos (Array_.dicho_find id old_table)) node acc)
 	Pid_map.empty
 	old_nodes in
 
@@ -146,11 +148,13 @@ module P_graph = struct
       List.fold_left
 	(fun acc (ast_edge, loc) ->
 	  let i1 =
-	    match Id.build_opt ast_edge.Ast.src old_table
-	    with Some i -> i | None -> -1-(Id.build ~loc ast_edge.Ast.src new_table) in
+	    match Id.build_opt ast_edge.Ast.src old_table with
+              | Some i -> Pid.Pos i
+              | None -> Pid.Neg (Id.build ~loc ast_edge.Ast.src new_table) in
 	  let i2 =
-	    match Id.build_opt ast_edge.Ast.tar old_table
-	    with Some i -> i | None -> -1-(Id.build ~loc ast_edge.Ast.tar new_table) in
+	    match Id.build_opt ast_edge.Ast.tar old_table with
+              | Some i -> Pid.Pos i 
+              | None -> Pid.Neg (Id.build ~loc ast_edge.Ast.tar new_table) in
 	  let edge = P_edge.build ~locals (ast_edge, loc) in
 	  match map_add_edge acc i1 edge i2 with
 	  | Some map -> map
@@ -171,21 +175,21 @@ module P_graph = struct
     let not_root =
       Pid_map.fold
 	(fun _ node acc ->
-	  Massoc.fold_left
+	  Massoc_pid.fold
 	    (fun acc2 tar _ ->
 	      if !tree_prop
 	      then
-		if IntSet.mem tar acc2
+		if Pid_set.mem tar acc2
 		then (tree_prop := false; acc2)
-		else IntSet.add tar acc2
-	      else IntSet.add tar acc2
+		else Pid_set.add tar acc2
+	      else Pid_set.add tar acc2
 	    ) acc (P_node.get_next node)
-	) graph IntSet.empty in
+	) graph Pid_set.empty in
 
     let roots =
       Pid_map.fold
 	(fun id _ acc ->
-	  if IntSet.mem id not_root
+	  if Pid_set.mem id not_root
 	  then acc
 	  else id::acc
 	) graph [] in

src/grew_graph.mli

@@ -44,7 +44,7 @@ module P_graph: sig
       ?locals: Label.decl array -> 
       Ast.node list -> 
       Ast.edge list -> 
-	(t * Id.table * (Id.t * P_fs.t) list )
+	(t * Id.table * (Pid.t * P_fs.t) list )
 
   val build_extension:
       ?locals: Label.decl array -> 

src/grew_node.ml

@@ -76,7 +76,7 @@ module P_node = struct
   type t = {
       name: Id.name;
       fs: P_fs.t;
-      next: P_edge.t Massoc.t;
+      next: P_edge.t Massoc_pid.t;
       loc: Loc.t option;
     }
 
@@ -86,19 +86,19 @@ module P_node = struct
 
   let unif_fs fs t = { t with fs = P_fs.unif fs t.fs }
 
-  let empty = { fs = P_fs.empty; next = Massoc.empty; name = ""; loc=None   }
+  let empty = { fs = P_fs.empty; next = Massoc_pid.empty; name = ""; loc=None   }
         
   let build ?pat_vars (ast_node, loc) =
     (ast_node.Ast.node_id, 
      { 
        name = ast_node.Ast.node_id;
        fs = P_fs.build ?pat_vars ast_node.Ast.fs;
-       next = Massoc.empty;
+       next = Massoc_pid.empty;
        loc = Some loc;
      } )
 
   let add_edge p_edge pid_tar t =
-    match Massoc.add pid_tar p_edge t.next with
+    match Massoc_pid.add pid_tar p_edge t.next with
     | Some l -> Some {t with next = l}
     | None -> None
 

src/grew_node.mli

@@ -45,14 +45,14 @@ module P_node: sig
 
   val get_name: t -> Id.name
   val get_fs: t -> P_fs.t
-  val get_next: t -> P_edge.t Massoc.t
+  val get_next: t -> P_edge.t Massoc_pid.t
 
   (** [unif_fs fs t] replaces the feature structure of the node by node.fs unif fs *)
   val unif_fs: P_fs.t -> t -> t
 
   val build: ?pat_vars: string list -> Ast.node -> (Id.name * t)
 
-  val add_edge: P_edge.t -> int -> t -> t option
+  val add_edge: P_edge.t -> Pid.t -> t -> t option
 
   val match_: ?param: Lex_par.t -> t -> G_node.t -> Lex_par.t option
 

src/grew_utils.ml

@@ -73,8 +73,18 @@ module File = struct
 
 (* ================================================================================ *)
 module Pid = struct
-  type t = int
+  (* type t = int *)
+  type t = Pos of int | Neg of int
+
   let compare = Pervasives.compare
+
+  let to_id = function
+    | Pos i -> sprintf "p_%d" i
+    | Neg i -> sprintf "n_%d" i
+
+  let to_string = function
+    | Pos i -> sprintf "Pos %d" i
+    | Neg i -> sprintf "Neg %d" i
 end (* module Pid *)
 
 (* ================================================================================ *)
@@ -94,17 +104,20 @@ module Pid_map =
         false
       with True -> true
 
-    let range key_set m = 
-      IntSet.fold (fun k s -> (IntSet.add (find k m) s)) key_set IntSet.empty
+    (* let range key_set m =  *)
+    (*   IntSet.fold (fun k s -> (IntSet.add (find k m) s)) key_set IntSet.empty *)
 
-    let keys m = 
-      fold (fun k v s -> (IntSet.add k s)) m IntSet.empty
+    (* let keys m =  *)
+    (*   fold (fun k v s -> (IntSet.add k s)) m IntSet.empty *)
 
     (* union of two maps*)
     let union_map m m' = fold (fun k v m'' -> (add k v m'')) m m'
 
   end (* module Pid_map *)
 
+(* ================================================================================ *)
+module Pid_set = Set.Make (Pid)
+
 (* ================================================================================ *)
 module Gid = struct
   type t =
@@ -480,6 +493,9 @@ end (* module Massoc_make *)
 (* ================================================================================ *)
 module Massoc_gid = Massoc_make (Gid)
 
+(* ================================================================================ *)
+module Massoc_pid = Massoc_make (Pid)
+
 (* ================================================================================ *)
 module Massoc = struct
   (* Massoc is implemented with caml lists *)

src/grew_utils.mli

@@ -34,16 +34,24 @@ end
 
 (* ================================================================================ *)
 (* [Pid] describes identifier used in pattern graphs *)
-module Pid : sig type t = int end
+module Pid : sig
+  type t = Pos of int | Neg of int
+  val to_id: t -> string
+  val to_string: t -> string
+end
 
 (* ================================================================================ *)
 (* [Pid_map] is the map used in pattern graphs *)
 module Pid_map : sig
-  include Map.S with type key = int
+  include Map.S with type key = Pid.t
 
   val exists: (key -> 'a -> bool) -> 'a t -> bool
 end
 
+(* ================================================================================ *)
+(* [Pid_set] *)
+module Pid_set : Set.S with type elt = Pid.t
+
 (* ================================================================================ *)
 (* [Gid] describes identifier used in full graphs *)
 module Gid : sig
@@ -234,6 +242,8 @@ end
     
 module Massoc_gid : S with type key = Gid.t
 
+module Massoc_pid : S with type key = Pid.t
+
 
 module Error: sig
   exception Build of (string * Loc.t option)