Commit c1144628 authored by bguillaum's avatar bguillaum

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
parent 6a2327b3
......@@ -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)
......
......@@ -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
......
......@@ -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 ->
......
......@@ -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
......
......@@ -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
......
This diff is collapsed.
......@@ -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 *)
......
......@@ -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)
......
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