Commit ae932a6b authored by bguillaum's avatar bguillaum

naming of basic VS pattern

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8457 7838e531-6607-4d57-9587-6c381814729c
parent 5b11f235
......@@ -36,7 +36,7 @@ module Ast = struct
let simple_id_of_ci ci = match ci with
| No_sharp s -> get_single s
| Sharp _ -> Error.build "The identifier '%s' must be basic (without '#' symbol)" (complex_id_to_string ci)
| Sharp _ -> Error.build "The identifier '%s' must be simple (without '#' symbol)" (complex_id_to_string ci)
let is_simple = function
| No_sharp s when List.length (dot_split s) = 1 -> true
| _ -> false
......@@ -138,7 +138,7 @@ module Ast = struct
| Feature_ineq of ineq * simple_qfn * simple_qfn
type const = u_const * Loc.t
type pattern = {
type basic = {
pat_nodes: node list;
pat_edges: edge list;
pat_const: const list;
......@@ -177,8 +177,8 @@ module Ast = struct
*)
type rule = {
rule_id:Id.name;
pos_pattern: pattern;
neg_patterns: pattern list;
pos_basic: basic;
neg_basics: basic list;
commands: command list;
param: (string list * string list) option;
lp: string list option;
......@@ -230,4 +230,12 @@ module Ast = struct
}
let empty_grs = { domain = []; labels = []; modules = []; sequences= [] }
(* type for the grep mode *)
type isolated_pattern = {
isol_pos: basic;
isol_negs: basic list;
}
end (* module Ast *)
......@@ -86,7 +86,7 @@ module Ast : sig
| Feature_ineq of ineq * simple_qfn * simple_qfn
type const = u_const * Loc.t
type pattern = {
type basic = {
pat_nodes: node list;
pat_edges: edge list;
pat_const: const list;
......@@ -115,8 +115,8 @@ module Ast : sig
type rule = {
rule_id:Id.name;
pos_pattern: pattern;
neg_patterns: pattern list;
pos_basic: basic;
neg_basics: basic list;
commands: command list;
param: (string list * string list) option; (* (files, vars) *)
lp: string list option; (* lexical parameters in the file *)
......@@ -168,4 +168,10 @@ module Ast : sig
}
val empty_grs: grs
(* type for the grep mode *)
type isolated_pattern = {
isol_pos: basic;
isol_negs: basic list;
}
end (* module Ast *)
......@@ -48,7 +48,7 @@ end
(* ================================================================================ *)
(* [File] basic functions to read/write file *)
(* [File] functions to read/write file *)
module File: sig
(** [write data file_name] write [data] in file named [file_name] *)
val write: string -> string -> unit
......
......@@ -170,7 +170,7 @@ module Command = struct
check_act_id loc act_id kai;
let items = List.map
(function
(* special case of a basic identifier understood as a string *)
(* special case of a simple identifier understood as a string *)
| Ast.Qfn_item ci when Ast.is_simple ci -> String (Ast.complex_id_to_string ci)
| Ast.Qfn_item ci ->
let (act_id,feature_name) = Ast.act_qfn_of_ci ci in
......
......@@ -96,8 +96,8 @@ module P_graph = struct
(* -------------------------------------------------------------------------------- *)
(* a type for extension of graph: a former graph exists:
in grew the former is a positive pattern and an extension is a "without" *)
(* a type for extension of graph (a former graph exists):
in grew the former is a positive basic and an extension is a negative basic ("without") *)
type extension = {
ext_map: P_node.t Pid_map.t; (* node description for new nodes and for edge "Old -> New" *)
old_map: P_node.t Pid_map.t; (* a partial map for new constraints on old nodes "Old [...]" *)
......@@ -149,7 +149,7 @@ module P_graph = struct
let edge = P_edge.build ~locals (ast_edge, loc) in
match map_add_edge acc i1 edge i2 with
| Some map -> map
| None -> Log.fbug "[GRS] [Graph.build_extension] add_edge cannot fail in pattern extension (1)"; exit 2
| None -> Log.fbug "[GRS] [Graph.build_extension] add_edge cannot fail in pattern extension"; exit 2
) ext_map_without_edges full_edge_list in
({ext_map = ext_map_with_all_edges; old_map = old_map_without_edges}, new_table)
......
......@@ -116,18 +116,18 @@ module Html_doc = struct
);
bprintf buff "\n"
let buff_html_pos_pattern buff pos_pattern =
let buff_html_pos_basic buff pos_basic =
bprintf buff " <font color=\"purple\">match</font> <b>{</b>\n";
List.iter (buff_html_node buff) pos_pattern.Ast.pat_nodes;
List.iter (buff_html_edge buff) pos_pattern.Ast.pat_edges;
List.iter (buff_html_const buff) pos_pattern.Ast.pat_const;
List.iter (buff_html_node buff) pos_basic.Ast.pat_nodes;
List.iter (buff_html_edge buff) pos_basic.Ast.pat_edges;
List.iter (buff_html_const buff) pos_basic.Ast.pat_const;
bprintf buff " <b>}</b>\n"
let buff_html_neg_pattern buff neg_pattern =
let buff_html_neg_basic buff neg_basic =
bprintf buff " <font color=\"purple\">without</font> <b>{</b>\n";
List.iter (buff_html_node buff) neg_pattern.Ast.pat_nodes;
List.iter (buff_html_edge buff) neg_pattern.Ast.pat_edges;
List.iter (buff_html_const buff) neg_pattern.Ast.pat_const;
List.iter (buff_html_node buff) neg_basic.Ast.pat_nodes;
List.iter (buff_html_edge buff) neg_basic.Ast.pat_edges;
List.iter (buff_html_const buff) neg_basic.Ast.pat_const;
bprintf buff " <b>}</b>\n"
let to_html_rules rules =
......@@ -151,10 +151,10 @@ module Html_doc = struct
);
(* the match part *)
buff_html_pos_pattern buff rule.Ast.pos_pattern;
buff_html_pos_basic buff rule.Ast.pos_basic;
(* the without parts *)
List.iter (buff_html_neg_pattern buff) rule.Ast.neg_patterns;
List.iter (buff_html_neg_basic buff) rule.Ast.neg_basics;
(* the commands part *)
(match rule.Ast.commands with
......
......@@ -102,7 +102,7 @@ module Rule = struct
| Feature_diseq of Pid.t * string * Pid.t * string
| Feature_ineq of Ast.ineq * Pid.t * string * Pid.t * string
| Filter of Pid.t * P_fs.t (* used when a without impose a fs on a node defined by the match pattern *)
| Filter of Pid.t * P_fs.t (* used when a without impose a fs on a node defined by the match basic *)
let build_pos_constraint ?locals pos_table const =
let pid_of_name loc node_name = Pid.Pos (Id.build ~loc node_name pos_table) in
......@@ -123,18 +123,18 @@ module Rule = struct
| (Ast.Feature_ineq (ineq, (node_name1, feat_name1), (node_name2, feat_name2)), loc) ->
Feature_ineq (ineq, pid_of_name loc node_name1, feat_name1, pid_of_name loc node_name2, feat_name2)
type pattern = {
type basic = {
graph: P_graph.t;
constraints: const list;
}
let build_pos_pattern ?pat_vars ?(locals=[||]) pattern_ast =
let build_pos_basic ?pat_vars ?(locals=[||]) basic_ast =
let (graph, pos_table) =
P_graph.build ?pat_vars ~locals pattern_ast.Ast.pat_nodes pattern_ast.Ast.pat_edges in
P_graph.build ?pat_vars ~locals basic_ast.Ast.pat_nodes basic_ast.Ast.pat_edges in
(
{
graph = graph;
constraints = List.map (build_pos_constraint ~locals pos_table) pattern_ast.Ast.pat_const
constraints = List.map (build_pos_constraint ~locals pos_table) basic_ast.Ast.pat_const
},
pos_table
)
......@@ -169,27 +169,27 @@ module Rule = struct
and (node_name2, feat_name2) = qfn2 in
Feature_ineq (ineq, pid_of_name loc node_name1, feat_name1, pid_of_name loc node_name2, feat_name2)
let build_neg_pattern ?(locals=[||]) pos_table pattern_ast =
let build_neg_basic ?(locals=[||]) pos_table basic_ast =
let (extension, neg_table) =
P_graph.build_extension ~locals pos_table pattern_ast.Ast.pat_nodes pattern_ast.Ast.pat_edges in
P_graph.build_extension ~locals pos_table basic_ast.Ast.pat_nodes basic_ast.Ast.pat_edges in
let filters = Pid_map.fold (fun id node acc -> Filter (id, P_node.get_fs node) :: acc) extension.P_graph.old_map [] in
{
graph = extension.P_graph.ext_map;
constraints = filters @ List.map (build_neg_constraint ~locals pos_table neg_table) pattern_ast.Ast.pat_const ;
constraints = filters @ List.map (build_neg_constraint ~locals pos_table neg_table) basic_ast.Ast.pat_const ;
}
let get_edge_ids pattern =
let get_edge_ids basic =
Pid_map.fold
(fun _ node acc ->
Massoc_pid.fold
(fun acc2 _ edge -> match P_edge.get_id edge with None -> acc2 | Some id -> id::acc2)
acc (P_node.get_next node)
) pattern.graph []
) basic.graph []
type t = {
name: string;
pos: pattern;
neg: pattern list;
pos: basic;
neg: basic list;
commands: Command.t list;
param: Lex_par.t option;
param_names: (string list * string list);
......@@ -315,22 +315,30 @@ module Rule = struct
files in
(Some param, pat_vars, cmd_vars) in
let (pos, pos_table) = build_pos_pattern ~pat_vars ~locals rule_ast.Ast.pos_pattern in
let (pos, pos_table) = build_pos_basic ~pat_vars ~locals rule_ast.Ast.pos_basic in
{
name = rule_ast.Ast.rule_id;
pos = pos;
neg = List.map (fun pattern_ast -> build_neg_pattern ~locals pos_table pattern_ast) rule_ast.Ast.neg_patterns;
neg = List.map (fun basic_ast -> build_neg_basic ~locals pos_table basic_ast) rule_ast.Ast.neg_basics;
commands = build_commands ~param:(pat_vars,cmd_vars) ~locals suffixes pos pos_table rule_ast.Ast.commands;
loc = rule_ast.Ast.rule_loc;
param = param;
param_names = (pat_vars,cmd_vars)
}
(* an isolated_pattern is a couple (pos, neg list) *)
type isolated_pattern = basic * basic list
let build_isolated_pattern isol_ast =
let (pos, pos_table) = build_pos_basic isol_ast.Ast.isol_pos in
let negs = List.map (fun basic_ast -> build_neg_basic pos_table basic_ast) isol_ast.Ast.isol_negs in
(pos, negs)
(* ====================================================================== *)
type matching = {
n_match: Gid.t Pid_map.t; (* partial fct: pattern nodes |--> graph nodes *)
e_match: (string*(Gid.t*Label.t*Gid.t)) list; (* edge matching: edge ident |--> (src,label,tar) *)
a_match: (Gid.t*Label.t*Gid.t) list; (* anonymous edge mached *)
a_match: (Gid.t*Label.t*Gid.t) list; (* anonymous edge matched *)
m_param: Lex_par.t option;
}
......@@ -404,10 +412,10 @@ module Rule = struct
- the domain of the pattern P is the disjoint union of domain([sub]) and [unmatched_nodes]
*)
(* ---------------------------------------------------------------------- *)
let init param pattern =
let roots = P_graph.roots pattern.graph in
let init param basic =
let roots = P_graph.roots basic.graph in
let node_list = Pid_map.fold (fun pid _ acc -> pid::acc) pattern.graph [] in
let node_list = Pid_map.fold (fun pid _ acc -> pid::acc) basic.graph [] in
(* put all roots in the front of the list to speed up the algo *)
let sorted_node_list =
......@@ -421,7 +429,7 @@ module Rule = struct
unmatched_nodes = sorted_node_list;
unmatched_edges = [];
already_matched_gids = [];
check = pattern.constraints;
check = basic.constraints;
}
(* ---------------------------------------------------------------------- *)
......@@ -541,7 +549,6 @@ module Rule = struct
let g_node = try G_graph.find gid graph with Not_found -> failwith "INS" in
try
let new_param = P_node.match_ ?param: partial.sub.m_param p_node g_node in
(* add all out-edges from pid in pattern *)
......@@ -799,7 +806,7 @@ module Rule = struct
(* ---------------------------------------------------------------------- *)
let fulfill (pos_graph,neg_graph) graph new_partial_matching =
match extend_matching (pos_graph, neg_graph) graph new_partial_matching with
| [] -> true (* the without pattern in not found -> OK *)
| [] -> true (* the without basic in not found -> OK *)
| x -> false
......
......@@ -36,7 +36,7 @@ module Instance : sig
val rev_steps: t -> t
(** [flatten inst] returns a fresh representation of the graph where gid created by node
activation are map to basic gid. Graphs are flattened after each module. *)
activation are map to elementary gid. Graphs are flattened after each module. *)
val flatten: t -> t
(** [to_gr t] returns a string which contains the "gr" code of the current graph *)
......@@ -70,7 +70,7 @@ module Rule : sig
(** [is_filter t] returns [true] iff the rule [t] is a filter rule. *)
val is_filter: t -> bool
(** [to_dep t] returns a string in the [dep] language describing the pattern. *)
(** [to_dep t] returns a string in the [dep] language describing the match basic of the rule *)
val to_dep: t -> string
(** [build ?local dir ast_rule] returns the Rule.t value corresponding to [ast_rule].
......@@ -87,6 +87,14 @@ module Rule : sig
Instance.t ->
Instance_set.t * Instance_set.t
(** the type matching encodes the graph morphism from a pattern to a graph *)
(* NB: it was made public for the grep mode *)
type matching
(** [match_in_graph rule graph] returns the list of matching of the pattern of the rule into the graph *)
val match_in_graph: t -> G_graph.t -> matching list
(** [up_deco rule matching] builds the decoration of the [graph] illustrating the given [matching] of the [rule] *)
(* NB: it can be computed independly from the graph itself! *)
val up_deco: t -> matching -> G_deco.t
end (* module Rule *)
......@@ -268,3 +268,6 @@ let to_gr_graph graph =
let to_conll_graph graph =
handle ~name:"to_conll_graph" (fun () -> G_graph.to_conll graph) ()
let load_pattern file =
handle ~name:"load_pattern" (fun () -> Grew_parser.load_isolated_pattern file) ()
\ No newline at end of file
......@@ -88,7 +88,7 @@ val of_conll: string -> (int * string) list -> Instance.t
val xml_graph: Xml.xml -> Instance.t
(** [raw_graph instance] returns all graph information with a triple of basic caml types:
(** [raw_graph instance] returns all graph information with a triple of elementary caml types:
- the meta data
- the list of node (node is a list of feature (feature is string * string))
- the list of edge (src, label, tar) where src and tar refers to the position in the node list
......
......@@ -103,6 +103,7 @@ let localize t = (t,get_loc ())
%start <Grew_ast.Ast.grs> grs
%start <Grew_ast.Ast.gr> gr
%start <Grew_ast.Ast.module_or_include list> included
%start <Grew_ast.Ast.isolated_pattern> isolated_pattern
%%
......@@ -279,8 +280,8 @@ rule:
| doc=option(COMMENT) RULE id_loc=simple_id_with_loc LACC p=pos_item n=list(neg_item) cmds=commands RACC
{
{ Ast.rule_id = fst id_loc;
pos_pattern = p;
neg_patterns = n;
pos_basic = p;
neg_basics = n;
commands = cmds;
param = None;
lp = None;
......@@ -291,8 +292,8 @@ rule:
| doc=option(COMMENT) LEX_RULE id_loc=simple_id_with_loc param=option(param) LACC p=pos_item n=list(neg_item) cmds=commands RACC lp=option(lp)
{
{ Ast.rule_id = fst id_loc;
pos_pattern = p;
neg_patterns = n;
pos_basic = p;
neg_basics = n;
commands = cmds;
param = param;
lp = lp;
......@@ -303,8 +304,8 @@ rule:
| doc=option(COMMENT) FILTER id_loc=simple_id_with_loc LACC p=pos_item n=list(neg_item) RACC
{
{ Ast.rule_id = fst id_loc;
pos_pattern = p;
neg_patterns = n;
pos_basic = p;
neg_basics = n;
commands = [];
param = None;
lp = None;
......@@ -519,4 +520,11 @@ sequence:
seq_loc = (!Parser_global.current_file,snd id_loc);
}
}
/*=============================================================================================*/
/* ISOLATED PATTERN (grep mode) */
/*=============================================================================================*/
isolated_pattern:
| p=pos_item n=list(neg_item) { {Ast.isol_pos=p; isol_negs=n} }
%%
......@@ -95,4 +95,16 @@ module Grew_parser = struct
close_in in_ch;
gr
with Sys_error msg-> raise (Parse_error (msg, None))
(* ------------------------------------------------------------------------------------------*)
let load_isolated_pattern file =
try
Parser_global.init file;
let in_ch = open_in file in
let lexbuf = Lexing.from_channel in_ch in
let gr = parse_handle file (Gr_grs_parser.isolated_pattern Lexer.global) lexbuf in
close_in in_ch;
gr
with Sys_error msg-> raise (Parse_error (msg, None))
end
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