Commit 971d5500 authored by bguillaum's avatar bguillaum

move from 'int' to 'Gid.t'/'Pid.t'... it compiles

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@7419 7838e531-6607-4d57-9587-6c381814729c
parent c00c6e36
*.cmo
*.cmi
*.o
*.cmx
*.annot
*.a
*.cma
*.cmxa
Makefile
confdefs.h
config.log
config.status
# file generated by the Makefile !
libgrew.mli
......@@ -7,8 +7,8 @@ open Grew_edge
open Grew_fs
module Command = struct
type pid = int (* the int in the pattern *)
type gid = int (* the int in the graph *)
type pid = Pid.t
type gid = Gid.t
type cnode = (* a command node is either: *)
| Pid of pid (* a node identified in the pattern *)
......
......@@ -3,8 +3,8 @@ open Grew_utils
open Grew_edge
module Command : sig
type pid = int (* the int in the pattern *)
type gid = int (* the int in the graph *)
type pid = Pid.t
type gid = Gid.t
type cnode = (* a command node is either: *)
| Pid of pid (* a node identified in the pattern *)
......
This diff is collapsed.
......@@ -5,14 +5,29 @@ open Grew_node
open Grew_utils
open Grew_command
module Deco: sig
type t =
{ nodes: int list;
edges: (int * Label.t * int) list;
(* ================================================================================ *)
module P_deco: sig
type t =
{ nodes: Pid.t list;
edges: (Pid.t * P_edge.t * Pid.t) list;
}
val empty:t
end
(* ================================================================================ *)
(* ================================================================================ *)
module G_deco: sig
type t =
{ nodes: Gid.t list;
edges: (Gid.t * G_edge.t * Gid.t) list;
}
val empty:t
end
(* ================================================================================ *)
(* ================================================================================ *)
module P_graph: sig
type t = P_node.t Pid_map.t
......@@ -41,6 +56,7 @@ module P_graph: sig
val roots: t -> Pid.t list
end
(* ================================================================================ *)
......@@ -64,37 +80,37 @@ module G_graph: sig
val of_conll: ?loc:Loc.t -> Conll.line list -> t
val to_gr: t -> string
val to_dot: ?main_feat:string -> ?deco:Deco.t -> t -> string
val to_dot: ?main_feat:string -> ?deco:G_deco.t -> t -> string
val to_sentence: ?main_feat:string -> t -> string
val to_dep: ?main_feat:string -> ?deco:Deco.t -> t -> string
val to_dep: ?main_feat:string -> ?deco:G_deco.t -> t -> string
type concat_item =
| Feat of (Gid.t * string)
| String of string
val add_edge: t -> int -> G_edge.t -> int -> t option
val del_edge : ?edge_ident: string -> Loc.t -> t -> int -> G_edge.t -> int -> t
val del_node : t -> int -> t
val add_edge: t -> Gid.t -> G_edge.t -> Gid.t -> t option
val del_edge : ?edge_ident: string -> Loc.t -> t -> Gid.t -> G_edge.t -> Gid.t -> t
val del_node : t -> Gid.t -> t
val add_neighbour : Loc.t -> t -> int -> G_edge.t -> (int * t)
val merge_node : Loc.t -> t -> int -> int -> t option
val add_neighbour : Loc.t -> t -> Gid.t -> G_edge.t -> (Gid.t * t)
val merge_node : Loc.t -> t -> Gid.t -> Gid.t -> t option
val shift_in : Loc.t -> t -> int -> int -> t
val shift_out : Loc.t -> t -> int -> int -> t
val shift_edges : Loc.t -> t -> int -> int -> t
val shift_in : Loc.t -> t -> Gid.t -> Gid.t -> t
val shift_out : Loc.t -> t -> Gid.t -> Gid.t -> t
val shift_edges : Loc.t -> t -> Gid.t -> Gid.t -> t
(** [update_feat tar_id tar_feat_name concat_items] sets the feature of the node [tar_id]
with feature name [tar_feat_name] to be the contatenation of values described by the [concat_items].
It returns both the new graph and the new feature value produced as the second element *)
val update_feat: ?loc:Loc.t -> t -> int -> string -> concat_item list -> (t * string)
val update_feat: ?loc:Loc.t -> t -> Gid.t -> string -> concat_item list -> (t * string)
val set_feat: ?loc:Loc.t -> t -> int -> string -> string -> t
val set_feat: ?loc:Loc.t -> t -> Gid.t -> string -> string -> t
val del_feat: t -> int -> string -> t
val del_feat: t -> Gid.t -> string -> t
(** [edge_out t id edge] returns true iff there is an out-edge from the node [id] with a label compatible with [edge] *)
val edge_out: t -> int -> P_edge.t -> bool
val edge_out: t -> Gid.t -> P_edge.t -> bool
val equals: t -> t -> bool
......
......@@ -10,7 +10,7 @@ module G_node = struct
type t = {
fs: G_fs.t;
pos: int option;
next: G_edge.t Massoc.t;
next: G_edge.t Massoc_gid.t;
}
let get_fs t = t.fs
......@@ -18,12 +18,12 @@ module G_node = struct
let set_fs t fs = {t with fs = fs}
let empty = { fs = G_fs.empty; pos = None; next = Massoc.empty }
let empty = { fs = G_fs.empty; pos = None; next = Massoc_gid.empty }
let to_string t =
Printf.sprintf " fs=[%s]\n next=%s\n"
(G_fs.to_string t.fs)
(Massoc.to_string G_edge.to_string t.next)
(Massoc_gid.to_string G_edge.to_string t.next)
let to_gr t =
sprintf "%s [%s] "
......@@ -31,7 +31,7 @@ module G_node = struct
(G_fs.to_gr t.fs)
let add_edge g_edge gid_tar t =
match Massoc.add gid_tar g_edge t.next with
match Massoc_gid.add gid_tar g_edge t.next with
| Some l -> Some {t with next = l}
| None -> None
......@@ -39,30 +39,30 @@ module G_node = struct
(ast_node.Ast.node_id,
{ fs = G_fs.build ast_node.Ast.fs;
pos = ast_node.Ast.position;
next = Massoc.empty;
next = Massoc_gid.empty;
} )
let of_conll line = {
fs = G_fs.of_conll line;
pos = Some line.Conll.num;
next = Massoc.empty;
next = Massoc_gid.empty;
}
let remove id_tar label t = {t with next = Massoc.remove id_tar label t.next}
let remove (id_tar : Gid.t) label t = {t with next = Massoc_gid.remove id_tar label t.next}
let remove_key node_id t =
try {t with next = Massoc.remove_key node_id t.next} with Not_found -> t
try {t with next = Massoc_gid.remove_key node_id t.next} with Not_found -> t
let merge_key ?(strict=false) src_id tar_id t =
try Some {t with next = Massoc.merge_key src_id tar_id t.next}
with Massoc.Duplicate -> if strict then None else Some t
try Some {t with next = Massoc_gid.merge_key src_id tar_id t.next}
with Massoc_gid.Duplicate -> if strict then None else Some t
let shift_out ?(strict=false) src_t tar_t =
try Some {tar_t with next = Massoc.disjoint_union src_t.next tar_t.next}
with Massoc.Not_disjoint -> if strict then None else Some tar_t
try Some {tar_t with next = Massoc_gid.disjoint_union src_t.next tar_t.next}
with Massoc_gid.Not_disjoint -> if strict then None else Some tar_t
let rm_out_edges t = {t with next = Massoc.empty}
let rm_out_edges t = {t with next = Massoc_gid.empty}
let build_neighbour t = {empty with pos = match t.pos with Some x -> Some (x+1) | None -> None}
......
......@@ -13,21 +13,21 @@ module G_node: sig
val to_gr: t -> string
val get_fs: t -> G_fs.t
val get_next: t -> G_edge.t Massoc.t
val get_next: t -> G_edge.t Massoc_gid.t
val set_fs: t -> G_fs.t -> t
(* FIXME move Gid up and replace int by Gid.t *)
val remove: int -> G_edge.t -> t -> t
val remove: Gid.t -> G_edge.t -> t -> t
val remove_key: int -> t -> t
val remove_key: Gid.t -> t -> t
val merge_key: ?strict:bool -> int -> int -> t -> t option
val merge_key: ?strict:bool -> Gid.t -> Gid.t -> t -> t option
val shift_out: ?strict:bool -> t -> t -> t option
val rm_out_edges: t -> t
val add_edge: G_edge.t -> int -> t -> t option
val add_edge: G_edge.t -> Gid.t -> t -> t option
val build: Ast.node -> (Id.name * t)
val of_conll: Conll.line -> t
......
......@@ -63,7 +63,7 @@ module Rule = struct
type pid = Pid.t
(* the [gid] type is used for graph identifier *)
type gid = int
type gid = Gid.t
(* the rewriting depth is bounded to stop rewriting when the system is not terminating *)
let max_depth = ref 500
......@@ -280,8 +280,8 @@ module Rule = struct
let a_match_add edge matching = {matching with a_match = edge::matching.a_match }
let up_deco matching =
{ Deco.nodes = Pid_map.fold (fun _ gid acc -> gid::acc) matching.n_match [];
Deco.edges = List.fold_left (fun acc (_,edge) -> edge::acc) matching.a_match matching.e_match;
{ G_deco.nodes = Pid_map.fold (fun _ gid acc -> gid::acc) matching.n_match [];
G_deco.edges = List.fold_left (fun acc (_,edge) -> edge::acc) matching.a_match matching.e_match;
}
let find cnode ?loc (matching, created_nodes) =
......@@ -296,14 +296,14 @@ module Rule = struct
let down_deco (matching,created_nodes) commands =
{
Deco.nodes = List.fold_left
G_deco.nodes = List.fold_left
(fun acc -> function
| (Command.UPDATE_FEAT (tar_cn,_,_),loc)
| (Command.SHIFT_EDGE (_,tar_cn),loc) ->
(find tar_cn (matching, created_nodes)) :: acc
| _ -> acc
) [] commands;
Deco.edges = List.fold_left
G_deco.edges = List.fold_left
(fun acc -> function
| (Command.ADD_EDGE (src_cn,tar_cn,edge),loc) ->
(find src_cn (matching, created_nodes), edge, find tar_cn (matching, created_nodes)) :: acc
......@@ -364,7 +364,7 @@ module Rule = struct
let gid = Pid_map.find pid matching.n_match in
gid_map_exists (* should be Gid_map.exists with ocaml 3.12 *)
(fun _ node ->
List.exists (fun e -> P_edge.compatible edge e) (Massoc.assoc gid (G_node.get_next node))
List.exists (fun e -> P_edge.compatible edge e) (Massoc_gid.assoc gid (G_node.get_next node))
) graph.G_graph.map
| Feature_eq (pid1, feat_name1, pid2, feat_name2) ->
let gnode1 = Gid_map.find (Pid_map.find pid1 matching.n_match) graph.G_graph.map in
......@@ -393,7 +393,7 @@ module Rule = struct
let src_gid = Pid_map.find src_pid partial.sub.n_match in
let tar_gid = Pid_map.find tar_pid partial.sub.n_match in
let src_gnode = G_graph.find src_gid graph in
let g_edges = Massoc.assoc tar_gid (G_node.get_next src_gnode) in
let g_edges = Massoc_gid.assoc tar_gid (G_node.get_next src_gnode) in
match P_edge.match_list p_edge g_edges with
| P_edge.Fail -> (* no good edge in graph for this pattern edge -> stop here *)
......@@ -410,7 +410,7 @@ module Rule = struct
let candidates = (* candidates (of type (gid, matching)) for m(tar_pid) = gid) with new partial matching m *)
let src_gid = Pid_map.find src_pid partial.sub.n_match in
let src_gnode = G_graph.find src_gid graph in
Massoc.fold_left
Massoc_gid.fold
(fun acc gid_next g_edge ->
match P_edge.match_ p_edge g_edge with
| P_edge.Fail -> (* g_edge does not fit, no new candidate *)
......
open Grew_graph
type graph = G_graph.t
type deco = Deco.t
type deco = G_deco.t
type module_name = string
type rule_app = {
rule_name: string;
up: Deco.t;
down: Deco.t;
up: G_deco.t;
down: G_deco.t;
}
(* the main type for display the result of a rewriting *)
......@@ -24,6 +24,6 @@ and big_step = {
small_step: (G_graph.t * rule_app) list;
}
let to_dot_graph ?main_feat ?(deco=Deco.empty) graph = G_graph.to_dot ?main_feat graph ~deco
let to_dep_graph ?main_feat ?(deco=Deco.empty) graph = G_graph.to_dep ?main_feat ~deco graph
let to_dot_graph ?main_feat ?(deco=G_deco.empty) graph = G_graph.to_dot ?main_feat graph ~deco
let to_dep_graph ?main_feat ?(deco=G_deco.empty) graph = G_graph.to_dep ?main_feat ~deco graph
let to_gr_graph graph = G_graph.to_gr graph
......@@ -4,7 +4,7 @@ open Grew_graph
(**/**)
type graph = G_graph.t
type deco = Deco.t
type deco = G_deco.t
(**/**)
type module_name = string
......
......@@ -104,28 +104,6 @@ module Pid_map =
(* union of two maps*)
let union_map m m' = fold (fun k v m'' -> (add k v m'')) m m'
exception MatchNotInjective
(*
* union of two injective maps having different ranges :
* \forall x \neq y \in m: m(x) \neq m(y)
* \forall x' \neq y' \in m': m'(x) \neq m'(y)W
* \forall x \in m /\ m': m(x) = m'(x)
* \forall x \in m : x \not\in\m' => \forall y \in m' m(x) \neq m'(y)
*)
let union_if m m' =
let keys_m = keys m in
let keys_m' = keys m' in
let inter_keys = IntSet.inter keys_m keys_m' in
if IntSet.for_all (fun elt -> (find elt m) = (find elt m')) inter_keys
then
let keys_s_m' = IntSet.diff keys_m' inter_keys in
let range_m = range keys_m m in
let range_m' = range keys_s_m' m' in
if (IntSet.inter range_m range_m') = IntSet.empty
then union_map m m'
else raise MatchNotInjective
else raise MatchNotInjective
end (* module Pid_map *)
(* ================================================================================ *)
......@@ -133,8 +111,15 @@ module Pid_map =
(* ================================================================================ *)
module Gid = struct
type t = int
type t =
| Old of int
| New of int * int (* identifier for "created nodes" *)
let compare = Pervasives.compare
let to_string = function
| Old i -> sprintf "%d" i
| New (i,j) -> sprintf"%d__%d" i j
end
module Gid_map = Map.Make (Gid)
......@@ -361,6 +346,141 @@ module List_ = struct
)
end
module type OrderedType =
sig
type t
val compare: t -> t -> int
end
module type S =
sig
type key
type +'a t
val empty: 'a t
(* an empty list returned if the key is undefined *)
val assoc: key -> 'a t -> 'a list
val is_empty: 'a t -> bool
val to_string: ('a -> string) -> 'a t -> string
val iter: (key -> 'a -> unit) -> 'a t -> unit
val add: key -> 'a -> 'a t -> 'a t option
val fold: ('b -> key -> 'a -> 'b) -> 'b -> 'a t -> 'b
(* raise Not_found if no (key,elt) *)
val remove: key -> 'a -> 'a t -> 'a t
(* raise Not_found if no (key,elt) *)
val remove_key: key -> 'a t -> 'a t
(* [mem key value t ] test if the couple (key, value) is in the massoc [t]. *)
val mem: key -> 'a -> 'a t -> bool
(* mem_key key t] tests is [key] is associated to at least one value in [t]. *)
val mem_key: key -> 'a t -> bool
exception Not_disjoint
val disjoint_union: 'a t -> 'a t -> 'a t
exception Duplicate
val merge_key: key -> key -> 'a t -> 'a t
val exists: (key -> 'a -> bool) -> 'a t -> bool
end
module Massoc_make (Ord: OrderedType) = struct
module M = Map.Make (Ord)
type key = Ord.t
type 'a t = ('a list) M.t
let empty = M.empty
let is_empty t = (t=empty)
let assoc key t =
try M.find key t
with Not_found -> []
let to_string _ _ = failwith "Not implemted"
let iter fct t =
M.iter
(fun key list -> List.iter (fun elt -> fct key elt) list
) t
let add key elt t =
try
let list = M.find key t in
match List_.usort_insert elt list with
| Some l -> Some (M.add key l t)
| None -> None
with Not_found -> Some (M.add key [elt] t)
let fold fct init t =
M.fold
(fun key list acc ->
List.fold_left
(fun acc2 elt ->
fct acc2 key elt)
acc list)
t init
(* Not found raised in the value is not defined *)
let remove key value t =
match M.find key t with
| [one] when one=value -> M.remove key t
| old -> M.add key (List_.usort_remove value old) t
let rec remove_key key t = M.remove key t
let rec mem key value t =
try List_.sort_mem value (M.find key t)
with Not_found -> false
let rec mem_key key t = M.mem key t
exception Not_disjoint
let disjoint_union t1 t2 =
M.fold
(fun key list acc ->
try
let old = M.find key acc in
M.add key (List_.sort_disjoint_union list old) acc
with
| Not_found -> M.add key list acc
| List_.Not_disjoint -> raise Not_disjoint
) t1 t2
exception Duplicate
let merge_key i j t =
try
let old_i = M.find i t in
let old_j = try M.find j t with Not_found -> [] in
M.add j (List_.sort_disjoint_union old_i old_j) (M.remove i t)
with
| Not_found -> (* no key i *) t
| List_.Not_disjoint -> raise Duplicate
let exists fct t =
M.exists
(fun key list ->
List.exists (fun elt -> fct key elt) list
) t
end (* module Massoc_make *)
module Massoc_gid = Massoc_make (Gid)
module Massoc = struct
(* Massoc is implemented with caml lists *)
......@@ -458,7 +578,7 @@ module Massoc = struct
let exists fct t = List.exists (fun (key,list) -> List.exists (fun value -> fct key value) list) t
end
end (* module Massoc *)
module Error = struct
......@@ -478,8 +598,6 @@ module Error = struct
let bug ?loc = Printf.ksprintf (bug_ ?loc)
end
module Id = struct
type name = string
......
......@@ -40,14 +40,19 @@ module Pid : sig type t = int end
(* [Pid_map] is the map used in pattern graphs *)
module Pid_map : sig
include Map.S with type key = int
exception MatchNotInjective
val exists: (key -> 'a -> bool) -> 'a t -> bool
val union_if: int t -> int t -> int t
end
(* ================================================================================ *)
(* [Gid] describes identifier used in full graphs *)
module Gid : sig type t = int end
module Gid : sig
type t =
| Old of int
| New of int * int (* identifier for "created nodes" *)
val to_string: t -> string
end
(* ================================================================================ *)
(* [Gid_map] is the map used in full graphs *)
......@@ -124,6 +129,67 @@ module List_: sig
val foldi_left: (int -> 'a -> 'b -> 'a) -> 'a -> 'b list -> 'a
end
module type OrderedType =
sig
type t
(** The type of the map keys. *)
val compare : t -> t -> int
(** A total ordering function over the keys.
This is a two-argument function [f] such that
[f e1 e2] is zero if the keys [e1] and [e2] are equal,
[f e1 e2] is strictly negative if [e1] is smaller than [e2],
and [f e1 e2] is strictly positive if [e1] is greater than [e2].
Example: a suitable ordering function is the generic structural
comparison function {!Pervasives.compare}. *)
end
(** Input signature of the functor {!Map.Make}. *)
module type S =
sig
type key
type +'a t
val empty: 'a t
(* an empty list returned if the key is undefined *)
val assoc: key -> 'a t -> 'a list
val is_empty: 'a t -> bool
val to_string: ('a -> string) -> 'a t -> string
val iter: (key -> 'a -> unit) -> 'a t -> unit
val add: key -> 'a -> 'a t -> 'a t option
val fold: ('b -> key -> 'a -> 'b) -> 'b -> 'a t -> 'b
(* raise Not_found if no (key,elt) *)
val remove: key -> 'a -> 'a t -> 'a t
(* raise Not_found if no (key,elt) *)
val remove_key: key -> 'a t -> 'a t
(* [mem key value t ] test if the couple (key, value) is in the massoc [t]. *)
val mem: key -> 'a -> 'a t -> bool
(* mem_key key t] tests is [key] is associated to at least one value in [t]. *)
val mem_key: key -> 'a t -> bool
exception Not_disjoint
val disjoint_union: 'a t -> 'a t -> 'a t
exception Duplicate
val merge_key: key -> key -> 'a t -> 'a t
val exists: (key -> 'a -> bool) -> 'a t -> bool
end
module Massoc_make (Ord : OrderedType) : S with type key = Ord.t
(* ================================================================================ *)
(* module Massoc implements multi-association data: keys are (hardly coded as) int and the same key can be
associated with a set of values *)
......@@ -147,7 +213,7 @@ module Massoc: sig
(* raise Not_found if no (key,elt) *)
val remove: int -> 'a -> 'a t -> 'a t
(* raise Not_found if no (key,elt) *)
val remove_key: int -> 'a t -> 'a t
......@@ -166,6 +232,7 @@ module Massoc: sig
val exists: (int -> 'a -> bool) -> 'a t -> bool
end
module Massoc_gid : S with type key = Gid.t
module Error: sig
......@@ -210,7 +277,7 @@ module Conll: sig
gov: int;
dep_lab: string;
}
val load: string -> line list
end
......
# generated ml files
gr_grs_parser.ml
gr_grs_parser.mli
lexer.ml
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