Skip to content

GitLab

L
libcaml-grew
Commit 292f1c9a authored by Bruno Guillaume's avatar Bruno Guillaume
Browse files
Options

remove filters

parent c99807c1
Hide whitespace changes
Inline Side-by-side
Showing with 48 additions and 132 deletions
misc/emacs/grew.el
View file @ 292f1c9a
......@@ -6,7 +6,7 @@
(require 'generic-x) ;;pour Emacs OK, mais semble ne pas marcher avec XEmacs
(define-generic-mode 'grew-mode
'("%");;comments
'("features" "module" "rule" "match" "without" "labels" "sequences" "commands" "graph" "confluent" "deterministic" "include" "filter");;keywords
'("features" "module" "rule" "match" "without" "labels" "sequences" "commands" "graph" "confluent" "deterministic" "include");;keywords
'(
;; ("class\\s (\*\*)* +\\(\\sw[a-zA-Z0-9_.-]*\\)" 1 'font-lock-type-face);noms de classes
;; ("\?[a-zA-Z0-9]+" . font-lock-variable-name-face)
......
misc/geshi/grew.php
View file @ 292f1c9a
......@@ -24,7 +24,7 @@ $language_data = array (
),
2 => array('del_edge', 'add_edge', 'del_node', 'add_node', 'del_feat', 'add', 'shift', 'shift_in', 'shift_out', 'activate'
),
3 => array('rule', 'lex_rule', 'module', 'filter', 'labels', 'bad_labels', 'sequences', 'features')
3 => array('rule', 'lex_rule', 'module', 'labels', 'sequences', 'features')
),
'SYMBOLS' => array(
'{', '}',';','-','=','<','>',','
......
src/grew_ast.ml
View file @ 292f1c9a
......@@ -325,7 +325,6 @@ module Ast = struct
(* the [rule] type is used for 3 kinds of module items:
- rule { param=None; ... }
- lex_rule
- filter { param=None; commands=[]; ... }
*)
type rule = {
rule_id:Id.name;
......
src/grew_grs.ml
View file @ 292f1c9a
......@@ -28,29 +28,25 @@ module Rewrite_history = struct
instance: Instance.t;
module_name: string;
good_nf: t list;
bad_nf: Instance.t list;
}
let rec get_graphs = function
| { good_nf = []; bad_nf = []; instance } -> [instance.Instance.graph]
| { good_nf = [] } -> []
| { good_nf = []; instance } -> [instance.Instance.graph]
| { good_nf = l} -> List_.flat_map get_graphs l
let rec is_empty t =
(t.instance.Instance.rules = []) && List.for_all is_empty t.good_nf
let rec num_sol = function
| { good_nf = []; bad_nf = [] } -> 1
| { good_nf = [] } -> 0 (* dead branch *)
| { good_nf = [] } -> 1
| { good_nf = l} -> List.fold_left (fun acc t -> acc + (num_sol t)) 0 l
let save_nfs ?domain ?filter ?main_feat ~dot base_name t =
let rec loop file_name rules t =
match (t.good_nf, t.bad_nf) with
| [],[] when dot -> Instance.save_dot_png ?domain ?filter ?main_feat file_name t.instance; [rules, file_name]
| [],[] -> ignore (Instance.save_dep_png ?domain ?filter ?main_feat file_name t.instance); [rules, file_name]
| [],_ -> []
| l, _ ->
match t.good_nf with
| [] when dot -> Instance.save_dot_png ?domain ?filter ?main_feat file_name t.instance; [rules, file_name]
| [] -> ignore (Instance.save_dep_png ?domain ?filter ?main_feat file_name t.instance); [rules, file_name]
| l ->
List_.foldi_left
(fun i acc son ->
(* Instance.save_dep_png ?main_feat (sprintf "%s_%d" file_name i) son.instance; *)
......@@ -65,34 +61,34 @@ module Rewrite_history = struct
let save_gr ?domain base t =
let rec loop file_name t =
match (t.good_nf, t.bad_nf) with
| [],[] -> File.write (Instance.to_gr ?domain t.instance) (file_name^".gr")
| l, _ -> List.iteri (fun i son -> loop (sprintf "%s_%d" file_name i) son) l
match t.good_nf with
| [] -> File.write (Instance.to_gr ?domain t.instance) (file_name^".gr")
| l -> List.iteri (fun i son -> loop (sprintf "%s_%d" file_name i) son) l
in loop base t
let save_conll ?domain base t =
let rec loop file_name t =
match (t.good_nf, t.bad_nf) with
| [],[] -> File.write (Instance.to_conll_string ?domain t.instance) (file_name^".conll")
| l, _ -> List.iteri (fun i son -> loop (sprintf "%s_%d" file_name i) son) l
match t.good_nf with
| [] -> File.write (Instance.to_conll_string ?domain t.instance) (file_name^".conll")
| l -> List.iteri (fun i son -> loop (sprintf "%s_%d" file_name i) son) l
in loop base t
let save_full_conll ?domain base t =
let cpt = ref 0 in
let rec loop t =
match (t.good_nf, t.bad_nf) with
| [],[] ->
match t.good_nf with
| [] ->
File.write (Instance.to_conll_string ?domain t.instance) (sprintf "%s__%d.conll" base !cpt);
incr cpt
| l, _ -> List.iter loop l
| l -> List.iter loop l
in loop t; !cpt
(* suppose that all modules are deterministic and produced exacly one normal form *)
let save_det_gr ?domain base t =
let rec loop t =
match (t.good_nf, t.bad_nf) with
| [],[] -> File.write (Instance.to_gr ?domain t.instance) (base^".gr")
| [one], [] -> loop one
match t.good_nf with
| [] -> File.write (Instance.to_gr ?domain t.instance) (base^".gr")
| [one] -> loop one
| _ -> Error.run "[save_det_gr] Not a single rewriting"
in loop t
......@@ -113,24 +109,24 @@ module Rewrite_history = struct
let save_det_conll ?domain ?header base t =
let rec loop t =
match (t.good_nf, t.bad_nf) with
| ([],[]) ->
match t.good_nf with
| [] ->
let output =
match header with
| Some h -> sprintf "%% %s\n%s" h (Instance.to_conll_string ?domain t.instance)
| None -> Instance.to_conll_string ?domain t.instance in
File.write output (base^".conll")
| ([one], []) -> loop one
| [one] -> loop one
| _ -> Error.run "[save_det_conll] Not a single rewriting"
in loop t
let det_dep_string ?domain t =
let rec loop t =
match (t.good_nf, t.bad_nf) with
| [],[] ->
match t.good_nf with
| [] ->
let graph = t.instance.Instance.graph in
Some (G_graph.to_dep ?domain graph)
| [one], [] -> loop one
| [one] -> loop one
| _ -> None
in loop t
......@@ -139,11 +135,11 @@ module Rewrite_history = struct
then None
else
let rec loop t =
match (t.good_nf, t.bad_nf) with
| [],[] ->
match t.good_nf with
| [] ->
let graph = t.instance.Instance.graph in
Some (G_graph.to_conll_string ?domain graph)
| [one], [] -> loop one
| [one] -> loop one
| _ -> None
in loop t
end (* module Rewrite_history *)
......@@ -154,7 +150,6 @@ module Modul = struct
name: string;
local_labels: (string * string list) array;
rules: Rule.t list;
filters: Rule.t list;
deterministic: bool;
loc: Loc.t;
}
......@@ -178,14 +173,12 @@ module Modul = struct
let build ?domain ast_module =
let locals = Array.of_list ast_module.Ast.local_labels in
Array.sort compare locals;
let rules_or_filters = List.map (Rule.build ?domain ~locals ast_module.Ast.mod_dir) ast_module.Ast.rules in
let (filters, rules) = List.partition Rule.is_filter rules_or_filters in
let rules = List.map (Rule.build ?domain ~locals ast_module.Ast.mod_dir) ast_module.Ast.rules in
let modul =
{
name = ast_module.Ast.module_id;
local_labels = locals;
rules;
filters;
deterministic = ast_module.Ast.deterministic;
loc = ast_module.Ast.mod_loc;
} in
......@@ -281,26 +274,23 @@ module Grs = struct
let rec old_loop instance module_list =
match module_list with
| [] -> {Rewrite_history.instance = instance; module_name = ""; good_nf = []; bad_nf = []; }
| [] -> {Rewrite_history.instance = instance; module_name = ""; good_nf = []; }
| module_name :: tail ->
let next =
try List.find (fun m -> m.Modul.name=module_name) grs.modules
with Not_found -> Log.fcritical "No module named '%s'" module_name in
let (good_set, bad_set) =
let good_set =
Rule.normalize
?domain: grs.domain
next.Modul.name
~deterministic: next.Modul.deterministic
next.Modul.rules
next.Modul.filters
(Instance.refresh instance) in
let good_list = Instance_set.elements good_set
and bad_list = Instance_set.elements bad_set in
let good_list = Instance_set.elements good_set in
{
Rewrite_history.instance = instance;
module_name = next.Modul.name;
good_nf = List.map (fun i -> old_loop i tail) good_list;
bad_nf = bad_list;
} in
let loop instance def =
......@@ -473,16 +463,14 @@ module Grs = struct
let next =
try List.find (fun m -> m.Modul.name=next_name) grs.modules
with Not_found -> Log.fcritical "No module named '%s'" next_name in
let (good_set, bad_set) =
let good_set =
Rule.normalize
?domain: grs.domain
next.Modul.name
~deterministic: next.Modul.deterministic
next.Modul.rules
next.Modul.filters
(Instance.refresh instance) in
let inst_list = Instance_set.elements good_set
(* and bad_list = Instance_set.elements bad_set *) in
let inst_list = Instance_set.elements good_set in
match inst_list with
| [{Instance.big_step = None}] ->
......@@ -603,10 +591,4 @@ module Grs = struct
List.iter (fun rule -> fct modul.Modul.name rule) modul.Modul.rules
) grs.modules
(* ---------------------------------------------------------------------------------------------------- *)
let filter_iter fct grs =
List.iter
(fun modul ->
List.iter (fun filter -> fct modul.Modul.name filter) modul.Modul.filters
) grs.modules
end (* module Grs *)
src/grew_grs.mli
View file @ 292f1c9a
......@@ -21,7 +21,6 @@ module Rewrite_history: sig
instance: Instance.t;
module_name: string;
good_nf: t list;
bad_nf: Instance.t list;
}
val get_graphs: t -> G_graph.t list
......@@ -72,7 +71,6 @@ module Modul: sig
name: string;
local_labels: (string * string list) array;
rules: Rule.t list;
filters: Rule.t list;
deterministic: bool;
loc: Loc.t;
}
......@@ -110,7 +108,6 @@ module Grs: sig
val build_rew_display: t -> string -> G_graph.t -> Libgrew_types.rew_display
val rule_iter: (string -> Rule.t -> unit) -> t -> unit
val filter_iter: (string -> Rule.t -> unit) -> t -> unit
(* val modules_of_sequence: t -> string -> Modul.t list*)
......
src/grew_html.ml
View file @ 292f1c9a
......@@ -147,8 +147,6 @@ module Html_doc = struct
(fun rule ->
(* the first line: (lex_)rule / filter *)
(match (rule.Ast.commands, rule.Ast.param) with
| ([], None) ->
bprintf buff "<font color=\"purple\">filter</font> %s <b>{</b>\n" rule.Ast.rule_id
| (_,None) ->
bprintf buff "<font color=\"purple\">rule</font> %s <b>{</b>\n" rule.Ast.rule_id
| (_,Some (files, vars)) ->
......@@ -168,12 +166,9 @@ module Html_doc = struct
List.iter (buff_html_neg_basic buff) rule.Ast.pattern.Ast.pat_negs;
(* the commands part *)
(match rule.Ast.commands with
| [] -> () (* filter *)
| list ->
bprintf buff " <font color=\"purple\">commands</font> <b>{</b>\n";
List.iter (buff_html_command buff) list;
bprintf buff " <b>}</b>\n");
bprintf buff " <font color=\"purple\">commands</font> <b>{</b>\n";
List.iter (buff_html_command buff) rule.Ast.commands;
bprintf buff " <b>}</b>\n";
bprintf buff "<b>}</b>\n";
) rules;
......@@ -751,10 +746,9 @@ module Gr_stat = struct
let from_rew_history rew_history =
let rec loop prev_module rh =
let sub_stat =
match (rh.Rewrite_history.good_nf, rh.Rewrite_history.bad_nf) with
| [],[] -> Some (String_map.empty)
| [], _ -> None
| l, _ ->
match rh.Rewrite_history.good_nf with
| [] -> Some (String_map.empty)
| l ->
match List_.opt_map (loop (Some rh.Rewrite_history.module_name)) l with
| [] -> None
| h::t -> Some (List.fold_left min_max_stat h t) in
......
src/grew_lexer.mll
View file @ 292f1c9a
......@@ -178,7 +178,6 @@ and standard target = parse
| "deterministic" { DETERMINISTIC }
| "rule" { RULE }
| "lex_rule" { Log.fwarning "%s \"lex_rule\" is deprecated, please use \"rule\" instead" (Global.loc_string ()); RULE }
| "filter" { FILTER }
| "sequences" { SEQUENCES }
| "pick" { PICK }
......
src/grew_parser.mly
View file @ 292f1c9a
......@@ -81,7 +81,6 @@ let localize t = (t,get_loc ())
%token MODULE /* module */
%token DETERMINISTIC /* deterministic (of deprecated confluent) */
%token RULE /* rule */
%token FILTER /* filter */
%token SEQUENCES /* sequences */
%token GRAPH /* graph */
......@@ -348,17 +347,6 @@ rule:
rule_loc = snd id_loc;
}
}
| 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;
pattern = Ast.complete_pattern { Ast.pat_pos = p; Ast.pat_negs = n };
commands = [];
param = None;
lex_par = None;
rule_doc = begin match doc with Some d -> d | None -> [] end;
rule_loc = snd id_loc;
}
}
lex_par:
| lex_par = LEX_PAR { lex_par }
......
src/grew_rule.ml
View file @ 292f1c9a
......@@ -381,8 +381,6 @@ module Rule = struct
let get_loc t = t.loc
let is_filter t = t.commands = []
let to_json ?domain t =
let param_json = match t.param with
| None -> []
......@@ -1252,35 +1250,6 @@ module Rule = struct
then Log.fwarning "In module \"%s\", %d nf are produced, only %d different ones" modul_name nfs_card reduced_nfs_card;
reduced_nfs
(* ---------------------------------------------------------------------- *)
(* [filter_instance instance filters] return a boolean:
- true iff the instance does NOT match any pattern in [filters] *)
let filter_instance ?domain filters instance =
let rec loop = function
| [] -> true (* no more filter to check *)
| filter::filter_tail ->
let (pos,negs) = filter.pattern in
(* get the list of partial matching for positive part of the pattern *)
let matching_list =
extend_matching
?domain
(pos.graph,P_graph.empty)
instance.Instance.graph
(init filter.param pos) in
if List.exists
(fun (sub, already_matched_gids) ->
List.for_all
(fun neg ->
let new_partial_matching = update_partial pos.graph neg (sub, already_matched_gids) in
fulfill ?domain (pos.graph,neg.graph) instance.Instance.graph new_partial_matching
) negs
) matching_list
then (* one of the matching can be extended *) false
else loop filter_tail in
loop filters
(* ---------------------------------------------------------------------- *)
let rec conf_normalize ?domain modul_name instance rules =
match conf_one_step ?domain modul_name instance rules with
......@@ -1288,15 +1257,8 @@ module Rule = struct
| None -> Instance.rev_steps instance
(* ---------------------------------------------------------------------- *)
let normalize ?domain modul_name ?(deterministic=false) rules filters instance =
let normalize ?domain modul_name ?(deterministic=false) rules instance =
if deterministic
then
let output = conf_normalize ?domain modul_name instance rules in
if filter_instance ?domain filters output
then (Instance_set.singleton output, Instance_set.empty)
else (Instance_set.empty, Instance_set.singleton output)
else
let output_set = normalize_instance ?domain modul_name instance rules in
let (good_set, bad_set) = Instance_set.partition (filter_instance ?domain filters) output_set in
(good_set, bad_set)
then Instance_set.singleton (conf_normalize ?domain modul_name instance rules)
else normalize_instance ?domain modul_name instance rules
end (* module Rule *)
src/grew_rule.mli
View file @ 292f1c9a
......@@ -75,9 +75,6 @@ module Rule : sig
(** [get_loc t] returns the file location of the rule [t]. *)
val get_loc: t -> Loc.t
(** [is_filter t] returns [true] iff the rule [t] is a filter rule. *)
val is_filter: t -> bool
val to_json: ?domain:Domain.t -> t -> Yojson.Basic.json
(** [to_dep t] returns a string in the [dep] language describing the match basic of the rule *)
......@@ -87,16 +84,15 @@ module Rule : sig
[dir] is used for localisation of lp files *)
val build: ?domain:Domain.t -> ?locals:Label_domain.decl array -> string -> Ast.rule -> t
(** [normalize domain module_name ?deterministic rule_list filter_list instance] returns two sets of good normal forms and bad normal forms *)
(** [normalize domain module_name ?deterministic rule_list instance] returns a set of normal forms *)
(* raise Stop if some command fails to apply *)
val normalize:
?domain:Domain.t ->
string -> (* module name *)
?deterministic:bool ->
t list -> (* rule list *)
t list -> (* filter list *)
Instance.t ->
Instance_set.t * Instance_set.t
Instance_set.t
val one_step: ?domain: Domain.t -> string -> Instance.t -> t list -> Instance_set.t
val conf_one_step: ?domain: Domain.t -> string -> Instance.t -> t list -> Instance.t option
......
src/libgrew.ml
View file @ 292f1c9a
......@@ -251,14 +251,13 @@ module Grs = struct
(fun () ->
Grew_html.Html_doc.build ~corpus ~dep:true dir grs;
(* draw pattern graphs for all rules and all filters *)
(* draw pattern graphs for all rules *)
let fct module_ rule_ =
let dep_code = Grew_rule.Rule.to_dep ?domain:(Grew_grs.Grs.get_domain grs) rule_ in
let dep_png_file = sprintf "%s/%s_%s-patt.png" dir module_ (Grew_rule.Rule.get_name rule_) in
let d2p = Dep2pict.Dep2pict.from_dep ~dep:dep_code in
Dep2pict.Dep2pict.save_png ~filename:dep_png_file d2p in
Grew_grs.Grs.rule_iter fct grs;
Grew_grs.Grs.filter_iter fct grs
Grew_grs.Grs.rule_iter fct grs
) ()
let get_domain grs = Grew_grs.Grs.get_domain grs
......
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