Commit 1f2db265 authored by Bruno Guillaume's avatar Bruno Guillaume

take projectivity into account in matching function

parent 69c6ba82
...@@ -389,6 +389,7 @@ module Rule = struct ...@@ -389,6 +389,7 @@ module Rule = struct
(* a [pattern] is described by the positive basic and a list of negative basics. *) (* a [pattern] is described by the positive basic and a list of negative basics. *)
type pattern = { type pattern = {
global: string list;
pos: basic; pos: basic;
negs: basic list; negs: basic list;
} }
...@@ -530,7 +531,7 @@ module Rule = struct ...@@ -530,7 +531,7 @@ module Rule = struct
) ([],1) pattern.Ast.pat_negs in ) ([],1) pattern.Ast.pat_negs in
{ {
name = rule_ast.Ast.rule_id; name = rule_ast.Ast.rule_id;
pattern = { pos; negs; }; pattern = { pos; negs; global=pattern.Ast.pat_glob; };
commands = build_commands ?domain lexicons pos pos_table rule_ast.Ast.commands; commands = build_commands ?domain lexicons pos pos_table rule_ast.Ast.commands;
loc = rule_ast.Ast.rule_loc; loc = rule_ast.Ast.rule_loc;
lexicons; lexicons;
...@@ -546,7 +547,7 @@ module Rule = struct ...@@ -546,7 +547,7 @@ module Rule = struct
P_fs.Fail_unif (* Skip the without parts that are incompatible with the match part *) P_fs.Fail_unif (* Skip the without parts that are incompatible with the match part *)
(fun basic_ast -> build_neg_basic ?domain lexicons pos_table basic_ast) (fun basic_ast -> build_neg_basic ?domain lexicons pos_table basic_ast)
n_pattern.Ast.pat_negs in n_pattern.Ast.pat_negs in
{ pos; negs; } { pos; negs; global=pattern_ast.pat_glob; }
(* ====================================================================== *) (* ====================================================================== *)
type matching = { type matching = {
...@@ -939,31 +940,49 @@ module Rule = struct ...@@ -939,31 +940,49 @@ module Rule = struct
| _ -> false | _ -> false
(* ---------------------------------------------------------------------- *) (* ---------------------------------------------------------------------- *)
let match_in_graph ?domain ?lexicons {pos; negs} graph = let match_in_graph ?domain ?lexicons { global; pos; negs } graph =
let casted_graph = G_graph.cast ?domain graph in let casted_graph = G_graph.cast ?domain graph in
let pos_graph = pos.graph in
(* get the list of partial matching for positive part of the pattern *) let rec match_global = function
let matching_list = | [] -> true
| "is_projective" :: tail ->
extend_matching begin
?domain match G_graph.is_projective graph with
(pos_graph,P_graph.empty) | Some _ -> false
casted_graph | None -> match_global tail
(init ?lexicons pos) in end
| "is_not_projective" :: tail ->
let filtered_matching_list = begin
List.filter match G_graph.is_projective graph with
(fun (sub, already_matched_gids) -> | Some _ -> match_global tail
List.for_all | None -> false
(fun without -> end
let neg_graph = without.graph in | x :: tail -> Error.build "Unknown global requirement \"%s\"" x in
let new_partial_matching = update_partial pos_graph without (sub, already_matched_gids) in
fulfill ?domain (pos_graph,neg_graph) graph new_partial_matching if not (match_global global)
) negs then []
) matching_list in else
let pos_graph = pos.graph in
List.map fst filtered_matching_list
(* get the list of partial matching for positive part of the pattern *)
let matching_list =
extend_matching
?domain
(pos_graph,P_graph.empty)
casted_graph
(init ?lexicons pos) in
let filtered_matching_list =
List.filter
(fun (sub, already_matched_gids) ->
List.for_all
(fun without ->
let neg_graph = without.graph in
let new_partial_matching = update_partial pos_graph without (sub, already_matched_gids) in
fulfill ?domain (pos_graph,neg_graph) graph new_partial_matching
) negs
) matching_list in
List.map fst filtered_matching_list
let onf_find cnode ?loc (matching, created_nodes) = let onf_find cnode ?loc (matching, created_nodes) =
match cnode with match cnode with
......
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