Commit 255cf00f authored by bguillaum's avatar bguillaum

Negative edge constraint are available in out-edge (N -[^mod]-> *) and in-edge...

Negative edge constraint are available in out-edge (N -[^mod]-> *) and in-edge (* -[^mod]-> N) constraints

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8634 7838e531-6607-4d57-9587-6c381814729c
parent cc323538
......@@ -141,10 +141,8 @@ module Ast = struct
| Ge -> "≥"
type u_const =
| Start of Id.name * edge_label list (* (source, labels) *)
| Cst_out of Id.name
| End of Id.name * edge_label list (* (target, labels) *)
| Cst_in of Id.name
| Cst_out of Id.name * edge_label_cst
| Cst_in of Id.name * edge_label_cst
| Feature_eq of feature_ident * feature_ident
| Feature_diseq of feature_ident * feature_ident
| Feature_ineq of ineq * feature_ident * feature_ident
......
......@@ -91,10 +91,8 @@ module Ast : sig
val string_of_ineq: ineq -> string
type u_const =
| Start of Id.name * edge_label list (* (source, labels) *)
| Cst_out of Id.name
| End of Id.name * edge_label list (* (target, labels) *)
| Cst_in of Id.name
| Cst_out of Id.name * edge_label_cst
| Cst_in of Id.name * edge_label_cst
| Feature_eq of feature_ident * feature_ident
| Feature_diseq of feature_ident * feature_ident
| Feature_ineq of ineq * feature_ident * feature_ident
......
......@@ -116,13 +116,20 @@ module Html_doc = struct
let buff_html_const buff (u_const,_) =
bprintf buff " ";
(match u_const with
| Ast.Start (ident,labels) ->
bprintf buff "%s -[%s]-> *" ident (List_.to_string (fun x->x) "|" labels)
| Ast.Cst_out ident ->
| Ast.Cst_out (ident, ([],false)) ->
bprintf buff "%s -> *" ident
| Ast.End (ident,labels) ->
| Ast.Cst_out (ident, (labels,false)) ->
bprintf buff "%s -[%s]-> *" ident (List_.to_string (fun x->x) "|" labels)
| Ast.Cst_out (ident, (labels,true)) ->
bprintf buff "%s -[^%s]-> *" ident (List_.to_string (fun x->x) "|" labels)
| Ast.Cst_in (ident, ([],false)) ->
bprintf buff "* -> %s" ident
| Ast.Cst_in (ident, (labels,false)) ->
bprintf buff "* -[%s]-> %s" (List_.to_string (fun x->x) "|" labels) ident
| Ast.Cst_in ident -> bprintf buff "* -> %s" ident
| Ast.Cst_in (ident, (labels,true)) ->
bprintf buff "* -[^%s]-> %s" (List_.to_string (fun x->x) "|" labels) ident
| Ast.Feature_eq (feat_id_l, feat_id_r) ->
bprintf buff "%s = %s" (Ast.dump_feature_ident feat_id_l) (Ast.dump_feature_ident feat_id_r);
| Ast.Feature_diseq (feat_id_l, feat_id_r) ->
......
......@@ -107,14 +107,10 @@ module Rule = struct
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
match const with
| (Ast.Start (id, labels), loc) ->
Cst_out (pid_of_name loc id, Label_cst.build ~loc ?locals (labels, false))
| (Ast.Cst_out id, loc) ->
Cst_out (pid_of_name loc id, Label_cst.all)
| (Ast.End (id, labels),loc) ->
Cst_in (pid_of_name loc id, Label_cst.build ~loc ?locals (labels, false))
| (Ast.Cst_in id, loc) ->
Cst_in (pid_of_name loc id, Label_cst.all)
| (Ast.Cst_out (id,label_cst), loc) ->
Cst_out (pid_of_name loc id, Label_cst.build ~loc ?locals label_cst)
| (Ast.Cst_in (id,label_cst), loc) ->
Cst_in (pid_of_name loc id, Label_cst.build ~loc ?locals label_cst)
| (Ast.Feature_eq ((node_name1, feat_name1), (node_name2, feat_name2)), loc) ->
Feature_eq (pid_of_name loc node_name1, feat_name1, pid_of_name loc node_name2, feat_name2)
......@@ -146,14 +142,10 @@ module Rule = struct
| Some i -> Pid.Pos i
| None -> Pid.Neg (Id.build ~loc node_name neg_table) in
match const with
| (Ast.Start (id, labels),loc) ->
Cst_out (pid_of_name loc id, Label_cst.build ~loc ?locals (labels, false))
| (Ast.Cst_out id, loc) ->
Cst_out (pid_of_name loc id, Label_cst.all)
| (Ast.End (id, labels),loc) ->
Cst_in (pid_of_name loc id, Label_cst.build ~loc ?locals (labels, false))
| (Ast.Cst_in id, loc) ->
Cst_in (pid_of_name loc id, Label_cst.all)
| (Ast.Cst_out (id,label_cst), loc) ->
Cst_out (pid_of_name loc id, Label_cst.build ~loc ?locals label_cst)
| (Ast.Cst_in (id,label_cst), loc) ->
Cst_in (pid_of_name loc id, Label_cst.build ~loc ?locals label_cst)
| (Ast.Feature_eq (feat_id1, feat_id2), loc) ->
let (node_name1, feat_name1) = feat_id1
......
......@@ -421,8 +421,8 @@ pat_edge_or_const:
{ let (n1,loc) = n1_loc in
match (n1,n2) with
| ("*", "*") -> Error.build ~loc "Source and target cannot be both underspecified"
| ("*", _) -> Pat_const (Ast.Cst_in n2, loc)
| (_, "*") -> Pat_const (Ast.Cst_out n1, loc)
| ("*", _) -> Pat_const (Ast.Cst_in (n2,([],true)), loc)
| (_, "*") -> Pat_const (Ast.Cst_out (n1,([],true)), loc)
| _ -> Pat_edge ({Ast.edge_id = None; src=n1; edge_label_cst=([],true); tar=n2}, loc)
}
......@@ -433,8 +433,8 @@ pat_edge_or_const:
{ let (n1,loc) = n1_loc in
match (n1,n2) with
| ("*", "*") -> Error.build ~loc "Source and target cannot be both underspecified"
| ("*", _) -> Pat_const (Ast.End (n2,labels), loc)
| (_, "*") -> Pat_const (Ast.Start (n1,labels), loc)
| ("*", _) -> Pat_const (Ast.Cst_in (n2,(labels,false)), loc)
| (_, "*") -> Pat_const (Ast.Cst_out (n1,(labels,false)), loc)
| _ -> Pat_edge ({Ast.edge_id = None; src=n1; edge_label_cst=(labels,false); tar=n2}, loc) }
(* "A -[^X|Y]-> B"*)
......@@ -442,8 +442,8 @@ pat_edge_or_const:
{ let (n1,loc) = n1_loc in
match (n1,n2) with
| ("*", "*") -> Error.build ~loc "Source and target cannot be both underspecified"
| ("*", _)
| (_, "*") -> Error.bug ~loc "Not implemented: pat edge constraint with negative labels"
| ("*", _) -> Pat_const (Ast.Cst_in (n2,(labels,true)), loc)
| (_, "*") -> Pat_const (Ast.Cst_out (n1,(labels,true)), loc)
| _ -> Pat_edge ({Ast.edge_id = None; src=n1; edge_label_cst=(labels,true); tar=n2}, loc) }
(* "X.cat = Y.cat" *)
......
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