Commit 50268205 authored by bguillaum's avatar bguillaum

[libcaml-grew] emacs mode

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@6346 7838e531-6607-4d57-9587-6c381814729c
parent 90fb256c
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)
;;====================================================================
;; 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")
......@@ -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 "<div class=\"navbar\">%s<a href=\"index.html\">Up</a>%s</div><br/>"
(if previous <> "" then (Printf.sprintf "<a href=\"%s.html\">Sentence %d</a> -- " previous (nb_sentence-1)) else "")
(if next <> "" then (Printf.sprintf " -- <a href=\"%s.html\">Sentence %d</a>" 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 "
<div class=\"navbar\">%s<a href=\"index.html\">Up</a>%s</div><br/>"
(if previous <> "" then (Printf.sprintf "<a href=\"%s.html\">Sentence %d</a> -- " previous (nb_sentence-1)) else "")
(if next <> "" then (Printf.sprintf " -- <a href=\"%s.html\">Sentence %d</a>" next (nb_sentence+1)) else "")
in
let title = "Sentence "^(string_of_int nb_sentence) in
Printf.bprintf buff "%s\n" head;
Printf.bprintf buff "<b>GRS file</b>: <a href=\"file:///%s\">%s</a></h2><br/>\n" (Filename.concat (Filename.dirname output) (Filename.basename grs_file)) (Filename.basename grs_file);
Printf.bprintf buff "<b>Input file</b>: <a href=\"file:///%s\">%s</a></h2>\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 "
<div class=\"navbar\">%s<a href=\"index.html\">Up</a>%s</div><br/>"
(if previous <> "" then (Printf.sprintf "<a href=\"%s.html\">Sentence %d</a> -- " previous (nb_sentence-1)) else "")
(if next <> "" then (Printf.sprintf " -- <a href=\"%s.html\">Sentence %d</a>" next (nb_sentence+1)) else "") in
let title = "Sentence "^(string_of_int nb_sentence) in
Printf.bprintf buff "%s\n" head;
Printf.bprintf buff "<b>GRS file</b>: <a href=\"file:///%s\">%s</a></h2><br/>\n" (Filename.concat (Filename.dirname output) (Filename.basename grs_file)) (Filename.basename grs_file);
Printf.bprintf buff "<b>Input file</b>: <a href=\"file:///%s\">%s</a></h2>\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
......
......@@ -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
......
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