diff --git a/emacs/README b/emacs/README
new file mode 100644
index 0000000000000000000000000000000000000000..143e3baf142a5f310c8dc1f734d4ffb15dfe0352
--- /dev/null
+++ b/emacs/README
@@ -0,0 +1,8 @@
+To install the grew mode for emacs put the lines below (change *** by the appropriate dir) in some emacs init file (like ~/.emacs)
+
+;; mode pour grew
+(load-file "***/grew.el")
+(setq auto-mode-alist
+ (cons '("\\.lex$" . grew-mode) auto-mode-alist))
+(autoload 'grew-mode "grew" "Major mode for editing grew files." t)
+
diff --git a/emacs/grew.el b/emacs/grew.el
new file mode 100644
index 0000000000000000000000000000000000000000..37230572975553901e2f109991de86df5da87036
--- /dev/null
+++ b/emacs/grew.el
@@ -0,0 +1,31 @@
+;;====================================================================
+;; Grew mode
+;; Mode used to write Grew with emacs (highlight)
+;; see: https://gforge.inria.fr/projects/lexicomp/
+
+(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" "bad_labels" "sequences" "commands" "graph" "confluent");;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)
+;; ("\![a-zA-Z0-9]+" . font-lock-constant-face)
+;; ("\(\\(\\sw[a-zA-Z0-9_.-]*\\(,\\sw[a-zA-Z0-9_.-]*\\)*\\)\)" 1 font-lock-constant-face);;params & node props
+;; ("$\\(\\sw*\\)*" . font-lock-constant-face);;params inside
+
+;; ("$[a-zA-Z0-9_àéèçâôûêäïüö'\-]+" . font-lock-constant-face);;params inside
+ ("del_edge" . font-lock-constant-face)
+ ("add_edge" . font-lock-constant-face)
+ ("shift" . font-lock-constant-face)
+ ("del_node" . font-lock-constant-face)
+ ("add_node" . font-lock-constant-face)
+ ("del_feat" . font-lock-constant-face)
+ ("@[a-zA-Z0-9_]+" . font-lock-variable-name-face)
+
+
+
+ )
+ '(".grs\\'") ;;file extension
+ nil
+ "Major mode for grew file")
diff --git a/src/libgrew.ml b/src/libgrew.ml
index 5a4cf8076dadce72f57853b87b6d07cd643d0105..21eceeefa025b330c926b3328c4453ede5cbf999 100644
--- a/src/libgrew.ml
+++ b/src/libgrew.ml
@@ -73,46 +73,33 @@ let rewrite ~gr ~grs ~seq =
let rewrite_to_html ?main_feat input_dir grs output_dir no_init current_grs_file current_grs seq title =
try
let rewrite_to_html_intern ?(no_init=false) grs_file grs seq input output nb_sentence previous next =
-
let buff = Buffer.create 16 in
-
- let head = Printf.sprintf "
"
- (if previous <> "" then (Printf.sprintf "Sentence %d -- " previous (nb_sentence-1)) else "")
- (if next <> "" then (Printf.sprintf " -- Sentence %d" next (nb_sentence+1)) else "")
- in
- let title = "Sentence "^(string_of_int nb_sentence) in
-
- let buff = Buffer.create 16 in
-
- let head = Printf.sprintf "
-
"
- (if previous <> "" then (Printf.sprintf "Sentence %d -- " previous (nb_sentence-1)) else "")
- (if next <> "" then (Printf.sprintf " -- Sentence %d" next (nb_sentence+1)) else "")
- in
-
- let title = "Sentence "^(string_of_int nb_sentence) in
-
- Printf.bprintf buff "%s\n" head;
- Printf.bprintf buff "GRS file: %s
\n" (Filename.concat (Filename.dirname output) (Filename.basename grs_file)) (Filename.basename grs_file);
- Printf.bprintf buff "Input file: %s\n" (Filename.concat (Filename.dirname output) (Filename.basename input)) (Filename.basename input);
- ignore(Sys.command(Printf.sprintf "cp %s %s" input (Filename.concat (Filename.dirname output) (Filename.basename input))));
-
- let init =
- let ast_gr =
- Grew_parser.parse_file_to_gr input in
- (* Checker.check_gr ast_gr; *)
- Instance.build ast_gr
- in
- let rew_hist = Grs.rewrite grs seq init in
- (* let _ = Grs.build_rew_display grs seq init in *)
- let stats = if (no_init) then (
- Rewrite_history.save_html ~mode:Rewrite_history.Only_nfs ~header:(Buffer.contents buff) ~title output rew_hist
- ) else (
- Rewrite_history.save_html ~mode:Rewrite_history.Normal ~header:(Buffer.contents buff) ~title output rew_hist
- ) in
- stats
- in
+ let head = Printf.sprintf "
+
"
+ (if previous <> "" then (Printf.sprintf "Sentence %d -- " previous (nb_sentence-1)) else "")
+ (if next <> "" then (Printf.sprintf " -- Sentence %d" next (nb_sentence+1)) else "") in
+
+ let title = "Sentence "^(string_of_int nb_sentence) in
+
+ Printf.bprintf buff "%s\n" head;
+ Printf.bprintf buff "GRS file: %s
\n" (Filename.concat (Filename.dirname output) (Filename.basename grs_file)) (Filename.basename grs_file);
+ Printf.bprintf buff "Input file: %s\n" (Filename.concat (Filename.dirname output) (Filename.basename input)) (Filename.basename input);
+ ignore(Sys.command(Printf.sprintf "cp %s %s" input (Filename.concat (Filename.dirname output) (Filename.basename input))));
+
+ let init =
+ let ast_gr =
+ Grew_parser.parse_file_to_gr input in
+ (* Checker.check_gr ast_gr; *)
+ Instance.build ast_gr
+ in
+ let rew_hist = Grs.rewrite grs seq init in
+ (* let _ = Grs.build_rew_display grs seq init in *)
+ let stats =
+ if no_init
+ then Rewrite_history.save_html ?main_feat ~mode:Rewrite_history.Only_nfs ~header:(Buffer.contents buff) ~title output rew_hist
+ else Rewrite_history.save_html ?main_feat ~mode:Rewrite_history.Normal ~header:(Buffer.contents buff) ~title output rew_hist in
+ stats in
(* get ALL gr files *)
let gr_files = Array.to_list (Sys.readdir input_dir) in
diff --git a/src/rule.ml b/src/rule.ml
index db4cc24d2952e95be88c90357aeb2cc4f7b29633..ff285fb1e755053dc3cc5d73cc2dee6c2e41a167 100644
--- a/src/rule.ml
+++ b/src/rule.ml
@@ -139,10 +139,10 @@ module Rule = struct
a_match = match1.a_match @ match2.a_match;
}
- let e_match_add edge_id matching =
+ let e_match_add ?pos edge_id matching =
match List_.usort_insert ~compare:e_comp edge_id matching.e_match with
| Some new_e_match -> { matching with e_match = new_e_match }
- | None -> Log.fcritical "The edge identifier '%s' is binded twice in the same pattern" (fst edge_id)
+ | None -> Error.bug "The edge identifier '%s' is binded twice in the same pattern" (fst edge_id)
let a_match_add edge matching = {matching with a_match = edge::matching.a_match }
@@ -241,7 +241,7 @@ module Rule = struct
(* returns all extension of the partial input matching *)
- let rec extend_matching (pos,neg) (graph:Graph.t) (partial:partial) =
+ let rec extend_matching (positive,neg) (graph:Graph.t) (partial:partial) =
match (partial.unmatched_edges, partial.unmatched_nodes) with
| [], [] ->
(* (\* DEBUG *\) Printf.printf "==<1>==\n%!"; *)
@@ -267,7 +267,7 @@ module Rule = struct
(fun label ->
{partial with sub = e_match_add (id,(src_gid,label,tar_gid)) partial.sub; unmatched_edges = tail_ue }
) labels
- in List_.flat_map (extend_matching (pos,neg) graph) new_partials
+ in List_.flat_map (extend_matching (positive,neg) graph) new_partials
with Not_found -> (* p_edge goes to an unmatched node *)
let candidates = (* candidates (of type (gid, matching)) for m(tar_pid) = gid) with new partial matching m *)
let src_gid = IntMap.find src_pid partial.sub.n_match in
@@ -281,27 +281,27 @@ module Rule = struct
(gid_next, a_match_add (src_gid, label, gid_next) partial.sub) :: acc
| Edge.Binds (id,[label]) -> (* g_edge fits with an extended matching *)
(gid_next, e_match_add (id, (src_gid, label, gid_next)) partial.sub) :: acc
- | _ -> Log.critical "Edge.match_ must return exactly one label"
+ | _ -> Error.bug "Edge.match_ must return exactly one label"
) [] src_gnode.Node.next in
List_.flat_map
(fun (gid_next, matching) ->
- extend_matching_from (pos,neg) graph tar_pid gid_next
+ extend_matching_from (positive,neg) graph tar_pid gid_next
{partial with sub=matching; unmatched_edges = tail_ue}
) candidates
end
| [], pid :: _ ->
IntMap.fold
(fun gid _ acc ->
- (extend_matching_from (pos,neg) graph pid gid partial) @ acc
+ (extend_matching_from (positive,neg) graph pid gid partial) @ acc
) graph.Graph.map []
- and extend_matching_from (pos,neg) (graph:Graph.t) pid gid partial =
+ and extend_matching_from (positive,neg) (graph:Graph.t) pid gid partial =
if List.mem gid partial.already_matched_gids
then [] (* the required association pid -> gid is not injective *)
else
let p_node =
if pid >= 0
- then try Graph.find pid pos with Not_found -> failwith "POS"
+ then try Graph.find pid positive with Not_found -> failwith "POS"
else try Graph.find pid neg with Not_found -> failwith "NEG" in
let g_node = try Graph.find gid graph with Not_found -> failwith "INS" in
if not (Node.is_a p_node g_node)
@@ -319,7 +319,7 @@ module Rule = struct
already_matched_gids = gid :: partial.already_matched_gids;
sub = {partial.sub with n_match = IntMap.add pid gid partial.sub.n_match};
} in
- extend_matching (pos,neg) graph new_partial
+ extend_matching (positive,neg) graph new_partial
@@ -362,7 +362,7 @@ let apply_command (command,loc) instance matching created_nodes =
| Command.DEL_EDGE_NAME edge_ident ->
let (src_gid,label,tar_gid) =
try List.assoc edge_ident matching.e_match
- with Not_found -> Log.fcritical "The edge identifier '%s' is undefined %s" edge_ident (Loc.to_string loc) in
+ with Not_found -> Error.bug "The edge identifier '%s' is undefined %s" edge_ident (Loc.to_string loc) in
let edge = Edge.of_label label in
(
{instance with