Commit cc323538 authored by bguillaum's avatar bguillaum

change const type in Rule module

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8633 7838e531-6607-4d57-9587-6c381814729c
parent 2c5bb671
......@@ -48,10 +48,6 @@ module P_edge = struct
let get_id t = t.id
let make ?loc ?(id=None) ?(neg=false) ?(locals=[||]) = function
| l when neg -> {id=id; u_label=Label_cst.Neg (List.sort compare (List.map (Label.from_string ?loc ~locals) l))}
| l -> {id=id; u_label=Label_cst.Pos (List.sort compare (List.map (Label.from_string ?loc ~locals) l))}
let build ?locals (ast_edge, loc) =
{ id = ast_edge.Ast.edge_id;
u_label = Label_cst.build ~loc ?locals ast_edge.Ast.edge_label_cst
......@@ -62,8 +58,6 @@ module P_edge = struct
| None -> Label_cst.to_string t.u_label
| Some i -> sprintf "%s:%s" i (Label_cst.to_string t.u_label)
let compatible t g_edge = Label_cst.match_ g_edge t.u_label
type edge_matcher =
| Fail
| Ok of Label.t
......
......@@ -42,16 +42,6 @@ module P_edge: sig
val build: ?locals:Label.decl array -> Ast.edge -> t
val make:
?loc:Loc.t ->
?id: string option ->
?neg:bool ->
?locals:Label.decl array ->
string list ->
t
val compatible: t -> G_edge.t -> bool
type edge_matcher =
| Fail
| Ok of Label.t
......
......@@ -261,9 +261,9 @@ module G_graph = struct
in loop 0
(* is there an edge e out of node i ? *)
let edge_out graph node_id p_edge =
let edge_out graph node_id label_cst =
let node = Gid_map.find node_id graph.map in
Massoc_gid.exists (fun _ e -> P_edge.compatible p_edge e) (G_node.get_next node)
Massoc_gid.exists (fun _ e -> Label_cst.match_ e label_cst) (G_node.get_next node)
let get_annot_info graph =
let annot_info =
......
......@@ -89,8 +89,8 @@ module G_graph: sig
(** raise ??? *)
val max_binding: t -> int
(** [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 -> Gid.t -> P_edge.t -> bool
(** [edge_out t id label_cst] returns true iff there is an out-edge from the node [id] with a label compatible with [label_cst] *)
val edge_out: t -> Gid.t -> Label_cst.t -> bool
(** [get_annot_info graph] searches for exactly one node with an annot-feature (with name starting with "__").
It returns the annot-feature name without the prefix "__" together with the position.
......
......@@ -96,8 +96,8 @@ module Rule = struct
let max_depth = ref 500
type const =
| Cst_out of Pid.t * P_edge.t
| Cst_in of Pid.t * P_edge.t
| Cst_out of Pid.t * Label_cst.t
| Cst_in of Pid.t * Label_cst.t
| Feature_eq of Pid.t * string * Pid.t * string
| Feature_diseq of Pid.t * string * Pid.t * string
......@@ -108,13 +108,13 @@ module Rule = struct
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, P_edge.make ~loc ?locals labels)
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, P_edge.all)
Cst_out (pid_of_name loc id, Label_cst.all)
| (Ast.End (id, labels),loc) ->
Cst_in (pid_of_name loc id, P_edge.make ~loc ?locals labels)
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, P_edge.all)
Cst_in (pid_of_name loc id, Label_cst.all)
| (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)
......@@ -147,13 +147,13 @@ module Rule = struct
| 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, P_edge.make ~loc ?locals labels)
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, P_edge.all)
Cst_out (pid_of_name loc id, Label_cst.all)
| (Ast.End (id, labels),loc) ->
Cst_in (pid_of_name loc id, P_edge.make ~loc ?locals labels)
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, P_edge.all)
Cst_in (pid_of_name loc id, Label_cst.all)
| (Ast.Feature_eq (feat_id1, feat_id2), loc) ->
let (node_name1, feat_name1) = feat_id1
......@@ -254,12 +254,12 @@ module Rule = struct
List_.iteri
(fun i cst ->
match cst with
| Cst_out (pid, edge) ->
| Cst_out (pid, label_cst) ->
bprintf buff " N_%s -> C_%d {label = \"%s\"; style=dot; bottom; color=green;}\n"
(Pid.to_id pid) i (P_edge.to_string edge)
| Cst_in (pid, edge) ->
(Pid.to_id pid) i (Label_cst.to_string label_cst)
| Cst_in (pid, label_cst) ->
bprintf buff " C_%d -> N_%s {label = \"%s\"; style=dot; bottom; color=green;}\n"
i (Pid.to_id pid) (P_edge.to_string edge)
i (Pid.to_id pid) (Label_cst.to_string label_cst)
| _ -> ()
) pos_basic.constraints;
bprintf buff "}\n";
......@@ -454,16 +454,16 @@ module Rule = struct
| feat_name -> G_fs.get_float_feat feat_name (G_node.get_fs (get_node pid)) in
match cst with
| Cst_out (pid,edge) ->
| Cst_out (pid,label_cst) ->
let gid = Pid_map.find pid matching.n_match in
if G_graph.edge_out graph gid edge
if G_graph.edge_out graph gid label_cst
then matching
else raise Fail
| Cst_in (pid,edge) ->
| Cst_in (pid,label_cst) ->
let gid = Pid_map.find pid matching.n_match in
if G_graph.node_exists
(fun node ->
List.exists (fun e -> P_edge.compatible edge e) (Massoc_gid.assoc gid (G_node.get_next node))
List.exists (fun e -> Label_cst.match_ e label_cst) (Massoc_gid.assoc gid (G_node.get_next node))
) graph
then matching
else raise Fail
......
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