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

Lexicons.t

parent 30a2f529
......@@ -88,13 +88,8 @@ module P_fs: sig
exception Fail
(** [match_ ?param p_fs g_fs] tries to match the pattern fs [p_fs] with the graph fs [g_fs].
If [param] is [None], it returns [None] if matching succeeds and else raise [Fail].
If [param] is [Some p], it returns [Some p'] if matching succeeds and else raise [Fail].
*)
val match_:
?lexicons:(string * Grew_types.Lexicon.t) list ->
t -> G_fs.t -> (string * Grew_types.Lexicon.t) list
(** [match_ ?lexicons p_fs g_fs] tries to match the pattern fs [p_fs] with the graph fs [g_fs]. *)
val match_: ?lexicons:Lexicons.t -> t -> G_fs.t -> Lexicons.t
(** [check_position ?parma position pfs] checks wheter [pfs] is compatible with a node at [position].
It returns [true] iff [pfs] has no requirement about position ok if the requirement is satisfied. *)
......
......@@ -106,9 +106,7 @@ module P_node: sig
val add_edge: P_edge.t -> Pid.t -> t -> t option
val match_:
?lexicons:(string * Grew_types.Lexicon.t) list ->
t -> G_node.t -> (string * Grew_types.Lexicon.t) list
val match_: ?lexicons:Lexicons.t -> t -> G_node.t -> Lexicons.t
val compare_pos: t -> t -> int
end
......
......@@ -221,7 +221,7 @@ module Rule = struct
]
]
let build_pos_constraint ?domain (lexicons : (string * Lexicon.t) list) pos_table const =
let build_pos_constraint ?domain ?lexicons pos_table const =
let pid_of_name loc node_name = Pid.Pos (Id.build ~loc node_name pos_table) in
match const with
| (Ast.Cst_out (id,label_cst), loc) ->
......@@ -294,13 +294,13 @@ module Rule = struct
("constraints", `List (List.map (const_to_json ?domain) basic.constraints));
]
let build_pos_basic ?domain lexicons ?pat_vars basic_ast =
let build_pos_basic ?domain ?lexicons ?pat_vars basic_ast =
let (graph, pos_table) =
P_graph.build ?domain ?pat_vars basic_ast.Ast.pat_nodes basic_ast.Ast.pat_edges in
(
{
graph = graph;
constraints = List.map (build_pos_constraint ?domain lexicons pos_table) basic_ast.Ast.pat_const
constraints = List.map (build_pos_constraint ?domain ?lexicons pos_table) basic_ast.Ast.pat_const
},
pos_table
)
......@@ -408,7 +408,7 @@ module Rule = struct
pattern: pattern;
commands: Command.t list;
param: Lex_par.t * string list; (* ([],[]) if None *)
lexicons: (string * Lexicon.t) list;
lexicons: Lexicons.t;
loc: Loc.t;
}
......@@ -522,8 +522,7 @@ module Rule = struct
| Some d -> d
| None -> deprecated_dir in
let (lexicons : (string * Lexicon.t) list) =
List.fold_left (fun acc (name,lex) ->
let lexicons = List.fold_left (fun acc (name,lex) ->
try
let prev = List.assoc name acc in
(name, (Lexicon.union prev (build_lex lex))) :: (List.remove_assoc name acc)
......@@ -561,7 +560,7 @@ module Rule = struct
let pattern = Ast.normalize_pattern rule_ast.Ast.pattern in
let (pos, pos_table) =
try build_pos_basic ?domain lexicons ~pat_vars pattern.Ast.pat_pos
try build_pos_basic ?domain ~lexicons:lexicons ~pat_vars pattern.Ast.pat_pos
with P_fs.Fail_unif ->
Error.build ~loc:rule_ast.Ast.rule_loc
"[Rule.build] in rule \"%s\": feature structures declared in the \"match\" clause are inconsistent"
......@@ -584,10 +583,10 @@ module Rule = struct
param = (param, pat_vars);
}
let build_pattern ?domain lexicons pattern_ast =
let build_pattern ?domain ?lexicons pattern_ast =
let n_pattern = Ast.normalize_pattern pattern_ast in
let (pos, pos_table) =
try build_pos_basic ?domain lexicons n_pattern.Ast.pat_pos
try build_pos_basic ?domain ?lexicons n_pattern.Ast.pat_pos
with P_fs.Fail_unif -> Error.build "feature structures declared in the \"match\" clause are inconsistent " in
let negs =
List_.try_map
......@@ -601,7 +600,7 @@ module Rule = struct
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) *)
m_param: Lex_par.t option;
l_param: (string * Lexicon.t) list;
l_param: Lexicons.t;
}
......@@ -624,7 +623,7 @@ module Rule = struct
(P_node.get_name pnode, G_node.get_float gnode) :: acc
) n_match []
let empty_matching lexicons param = { n_match = Pid_map.empty; e_match = []; m_param = param; l_param = lexicons;}
let empty_matching ?(lexicons=[]) param = { n_match = Pid_map.empty; e_match = []; m_param = param; l_param = lexicons;}
let e_comp (e1,_) (e2,_) = compare e1 e2
......@@ -687,7 +686,7 @@ module Rule = struct
- the ?domain of the pattern P is the disjoint union of ?domain([sub]) and [unmatched_nodes]
*)
(* ---------------------------------------------------------------------- *)
let init lexicons param basic =
let init ?lexicons param basic =
let roots = P_graph.roots basic.graph in
let node_list = Pid_map.fold (fun pid _ acc -> pid::acc) basic.graph [] in
......@@ -700,7 +699,7 @@ module Rule = struct
| false, true -> 1
| _ -> 0) node_list in
{ sub = empty_matching lexicons param;
{ sub = empty_matching ?lexicons param;
unmatched_nodes = sorted_node_list;
unmatched_edges = [];
already_matched_gids = [];
......@@ -1214,17 +1213,18 @@ module Rule = struct
| _ -> false
(* ---------------------------------------------------------------------- *)
let match_in_graph ?domain ?(lexicons=[]) ?param (pos, negs) graph =
let match_in_graph ?domain ?lexicons ?param (pos, negs) graph =
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 matching_list =
extend_matching
?domain
(pos_graph,P_graph.empty)
casted_graph
(init lexicons param pos) in
(init ?lexicons param pos) in
let filtered_matching_list =
List.filter
......@@ -1286,7 +1286,7 @@ module Rule = struct
?domain
(pos.graph,P_graph.empty)
instance.Instance.graph
(init rule.lexicons (Some (fst rule.param)) pos) in
(init ~lexicons:rule.lexicons (Some (fst rule.param)) pos) in
try
let (first_matching_where_all_witout_are_fulfilled,_) =
List.find
......@@ -1384,7 +1384,8 @@ module Rule = struct
?domain
(pos.graph,P_graph.empty)
instance.Instance.graph
(init rule.lexicons (Some (fst rule.param)) pos) in
(init ~lexicons:rule.lexicons (Some (fst rule.param)) pos) in
try
let (first_matching_where_all_witout_are_fulfilled,_) =
List.find
......@@ -1568,7 +1569,7 @@ module Rule = struct
?domain
(pos.graph,P_graph.empty)
graph
(init rule.lexicons (Some (fst rule.param)) pos) in
(init ~lexicons:rule.lexicons (Some (fst rule.param)) pos) in
try
let (first_matching_where_all_witout_are_fulfilled,_) =
List.find
......@@ -1602,7 +1603,6 @@ module Rule = struct
let rec wrd_apply ?domain rule (graph, big_step_opt) =
let (pos,negs) = rule.pattern in
(* get the list of partial matching for positive part of the pattern *)
......@@ -1611,7 +1611,7 @@ module Rule = struct
?domain
(pos.graph,P_graph.empty)
graph
(init rule.lexicons (Some (fst rule.param)) pos) in
(init ~lexicons:rule.lexicons (Some (fst rule.param)) pos) in
try
let (first_matching_where_all_witout_are_fulfilled,_) =
List.find
......
......@@ -104,13 +104,13 @@ module Rule : sig
val to_python: pattern -> G_graph.t -> matching -> json
val build_pattern: ?domain:Domain.t -> (string * Lexicon.t) list -> Ast.pattern -> pattern
val build_pattern: ?domain:Domain.t -> ?lexicons: Lexicons.t -> Ast.pattern -> pattern
(** [node_matching pattern graph matching] return a assoc list (pid_name, gid.position) *)
val node_matching: pattern -> G_graph.t -> matching -> (string * float) list
(** [match_in_graph rule graph] returns the list of matching of the pattern of the rule into the graph *)
val match_in_graph: ?domain:Domain.t -> ?lexicons: (string * Lexicon.t) list -> ?param:Lex_par.t -> pattern -> G_graph.t -> matching list
val match_in_graph: ?domain:Domain.t -> ?lexicons: Lexicons.t -> ?param:Lex_par.t -> pattern -> G_graph.t -> matching list
(** [match_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! *)
......
......@@ -240,6 +240,10 @@ module Lexicon = struct
| l -> String.concat "/" l
end (* module Lexicon *)
(* ================================================================================ *)
module Lexicons = struct
type t = (string * Lexicon.t) list
end
(* ================================================================================ *)
module Concat_item = struct
type t =
......
......@@ -142,6 +142,11 @@ module Lexicon : sig
val read_multi: string -> t -> string
end (* module Lexicon *)
(* ================================================================================ *)
module Lexicons : sig
type t = (string * Lexicon.t) list
end
(* ================================================================================ *)
module Concat_item : sig
type t =
......
......@@ -86,10 +86,10 @@ module Pattern = struct
type t = Grew_rule.Rule.pattern
let load ?domain file =
Libgrew.handle ~name:"Pattern.load" (fun () -> Grew_rule.Rule.build_pattern ?domain [] (Grew_loader.Loader.pattern file)) ()
Libgrew.handle ~name:"Pattern.load" (fun () -> Grew_rule.Rule.build_pattern ?domain (Grew_loader.Loader.pattern file)) ()
let parse ?domain desc =
Libgrew.handle ~name:"Pattern.load" (fun () -> Grew_rule.Rule.build_pattern ?domain [] (Grew_loader.Parser.pattern desc)) ()
Libgrew.handle ~name:"Pattern.load" (fun () -> Grew_rule.Rule.build_pattern ?domain (Grew_loader.Parser.pattern desc)) ()
let pid_name_list pattern =
Libgrew.handle ~name:"Pattern.pid_lits"
......
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