Commit 833e58f5 authored by bguillaum's avatar bguillaum

complete pattern with implicit nodes

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8894 7838e531-6607-4d57-9587-6c381814729c
parent b2d6a671
......@@ -168,6 +168,41 @@ module Ast = struct
pat_negs: basic list;
}
let add_implicit_node loc aux name pat_nodes =
if (List.exists (fun ({node_id},_) -> node_id=name) pat_nodes)
|| (List.exists (fun ({node_id},_) -> node_id=name) aux)
then pat_nodes
else ({node_id=name; position=None; fs=[]}, loc) :: pat_nodes
let complete_basic aux {pat_nodes; pat_edges; pat_const} =
let pat_nodes_2 = List.fold_left
(fun acc ({src; tar}, loc) ->
acc
|> (add_implicit_node loc aux src)
|> (add_implicit_node loc aux tar)
) pat_nodes pat_edges in
let pat_nodes_3 = List.fold_left
(fun acc (u_const, loc) -> match u_const with
| Feature_eq ((name1,_), (name2,_))
| Feature_diseq ((name1,_), (name2,_))
| Feature_ineq (_, (name1,_), (name2,_)) ->
acc
|> (add_implicit_node loc aux name1)
|> (add_implicit_node loc aux name2)
| Feature_ineq_cst (_, (name1,_), _) ->
add_implicit_node loc aux name1 acc
| _ -> acc
) pat_nodes_2 pat_const in
{pat_nodes=pat_nodes_3; pat_edges; pat_const}
let complete_pattern pattern =
let new_pat_pos = complete_basic [] pattern.pat_pos in
let aux = new_pat_pos.pat_nodes in
let new_pat_negs = List.map (complete_basic aux) pattern.pat_negs in
{ pat_pos = new_pat_pos; pat_negs = new_pat_negs;}
type graph = {
nodes: (Id.name * node) list;
edge: edge list;
......@@ -204,11 +239,10 @@ module Ast = struct
*)
type rule = {
rule_id:Id.name;
pos_basic: basic;
neg_basics: basic list;
pattern: pattern;
commands: command list;
param: (string list * string list) option;
lex_par: string list option;
param: (string list * string list) option; (* (files, vars) *)
lex_par: string list option; (* lexical parameters in the file *)
rule_doc:string list;
rule_loc: Loc.t;
}
......
......@@ -111,6 +111,8 @@ module Ast : sig
pat_negs: basic list;
}
val complete_pattern : pattern -> pattern
type concat_item =
| Qfn_item of feature_ident
| String_item of string
......@@ -137,8 +139,7 @@ module Ast : sig
type rule = {
rule_id:Id.name;
pos_basic: basic;
neg_basics: basic list;
pattern: pattern;
commands: command list;
param: (string list * string list) option; (* (files, vars) *)
lex_par: string list option; (* lexical parameters in the file *)
......
......@@ -176,10 +176,10 @@ module Html_doc = struct
);
(* the match part *)
buff_html_pos_basic buff rule.Ast.pos_basic;
buff_html_pos_basic buff rule.Ast.pattern.Ast.pat_pos;
(* the without parts *)
List.iter (buff_html_neg_basic buff) rule.Ast.neg_basics;
List.iter (buff_html_neg_basic buff) rule.Ast.pattern.Ast.pat_negs;
(* the commands part *)
(match rule.Ast.commands with
......
......@@ -325,8 +325,7 @@ 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_basic = p;
neg_basics = n;
pattern = Ast.complete_pattern { Ast.pat_pos = p; Ast.pat_negs = n };
commands = cmds;
param = None;
lex_par = None;
......@@ -337,8 +336,7 @@ rule:
| doc=option(COMMENT) LEX_RULE id_loc=simple_id_with_loc param=param LACC p=pos_item n=list(neg_item) cmds=commands RACC lex_par=option(lex_par)
{
{ Ast.rule_id = fst id_loc;
pos_basic = p;
neg_basics = n;
pattern = Ast.complete_pattern { Ast.pat_pos = p; Ast.pat_negs = n };
commands = cmds;
param = Some param;
lex_par = lex_par;
......@@ -349,8 +347,7 @@ 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_basic = p;
neg_basics = n;
pattern = Ast.complete_pattern { Ast.pat_pos = p; Ast.pat_negs = n };
commands = [];
param = None;
lex_par = None;
......@@ -657,5 +654,5 @@ op_seq:
/* ISOLATED PATTERN (grep mode) */
/*=============================================================================================*/
pattern:
| p=pos_item n=list(neg_item) EOF { {Ast.pat_pos=p; pat_negs=n} }
| p=pos_item n=list(neg_item) EOF { Ast.complete_pattern {Ast.pat_pos=p; pat_negs=n} }
%%
......@@ -353,7 +353,7 @@ module Rule = struct
| _ -> ()
);
let (pos, pos_table) = build_pos_basic domain ~pat_vars ~locals rule_ast.Ast.pos_basic in
let (pos, pos_table) = build_pos_basic domain ~pat_vars ~locals rule_ast.Ast.pattern.Ast.pat_pos in
let (negs,_) =
List.fold_left
(fun (acc,pos) basic_ast ->
......@@ -362,7 +362,7 @@ module Rule = struct
Log.fwarning "In rule \"%s\" [%s], the wihtout number %d cannot be satisfied, it is skipped"
rule_ast.Ast.rule_id (Loc.to_string rule_ast.Ast.rule_loc) pos;
(acc, pos+1)
) ([],1) rule_ast.Ast.neg_basics in
) ([],1) rule_ast.Ast.pattern.Ast.pat_negs in
{
name = rule_ast.Ast.rule_id;
pattern = (pos, negs);
......
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