Commit fca40fa8 authored by bguillaum's avatar bguillaum

catch some Not_found

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@6686 7838e531-6607-4d57-9587-6c381814729c
parent 765c19a0
open Printf
open Log
open Utils
open Grew_parser
open Checker
open Graph
open Rule
open Grs
let _ = Log.set_active_levels [`WARNING; `MESSAGE]
let _ = Log.set_write_to_log_file false
let _ = Log.set_show_time true
let absolute s =
if Filename.is_relative s
then Filename.concat (Sys.getcwd ()) s
else s
let interactive = ref false
let out_file = ref None
let usage = "Usage: grew [-dep <ext>|-png <ext>|-html] <option> input_file"
let head = ref ""
let title = ref ""
let input_file = ref ""
let grs_file = ref ""
let sequence = ref ""
let _ =
Arg.parse
[
"-grs", Arg.String (fun s -> grs_file := absolute s), " <file> select the GRS file";
"-seq", Arg.String (fun s -> sequence := s), " <string> select the module sequence to use for rewriting";
"-head", Arg.String (fun s -> head := s), " set an header for the html output)";
"-title", Arg.String (fun s -> title := s), " set an title for the html output)";
"-o", Arg.String (fun s -> out_file := Some s ), " base name used for output files";
"-debug", Arg.Unit (fun () -> Log.set_active_levels [`DEBUG; `MESSAGE; `INFO; `WARNING];), " turn the debug mode on";
"-verbose", Arg.Unit (fun () -> Log.set_active_levels [`MESSAGE; `INFO; `WARNING];), " turn the verbose mode on";
"-silent", Arg.Unit (fun () -> Log.set_active_levels [];), " hide warnings";
"-i", Arg.Unit (fun () -> interactive := true), " Interactive mode";
]
(fun file -> input_file := file)
usage
let load_grs () =
match !grs_file with
| "" -> Log.critical "No grs file defined, Abort"
| file ->
let ast = Grew_parser.parse_file_to_grs file in
(* Checker.check_grs ast; *)
Grs.build ast
let load_graph file =
let ast_gr = Grew_parser.parse_file_to_gr file in
(* Checker.check_gr ast_gr; *)
Instance.build ast_gr
let rewrite ?(head = "") ?(title = "") grs seq input output =
let buff = Buffer.create 16 in
bprintf buff "%s\n" head;
bprintf buff "<h2>GRS file: <a href=\"file:///%s\">%s</a></h2>\n" !grs_file (Filename.basename !grs_file);
bprintf buff "<h2>Input file: <a href=\"file:///%s\">%s</a></h2>\n" input (Filename.basename input);
let init = load_graph input in
let rew_hist = Grs.rewrite grs seq init in
(* let _ = Grs.build_rew_display grs seq init in *)
Rewrite_history.save_html ~mode:Rewrite_history.Normal ~header:(Buffer.contents buff) ~title output rew_hist
let _ =
try
match !input_file with
| "" ->
(* Printf.printf "==============================\n%!"; *)
(* let xxx = Lexing.from_string "without { A -> B }" in *)
(* let _ = Gr_grs_parser.neg_item Lexer.global xxx in *)
()
(* Log.fcritical "[GREW] No input file given\n%s\n" usage *)
| file ->
let grs = load_grs () in
let seq = !sequence in
if !interactive
then
try
while true do
let l = read_line () in
match Str.split (Str.regexp_string "##") l with
| [head; title; in_file; out_file] -> rewrite ~head ~title grs seq in_file out_file
| _ -> Log.fcritical "[GREW]: CANNOT understand request line >>>%s<<<%!" l
done
with End_of_file -> Log.message "[GREW] Bye !!%!\n"; exit 0
else
(match !out_file with
| None -> ()
| Some output -> rewrite grs seq file (Filename.chop_suffix output ".html")
)
with
(* | Checker.Module_already_defined (m,(file,line)) -> *)
(* Log.fcritical "[GRS] Module '%s' already defined (file: %s, line: %d)!" m file line *)
(* | Checker.Rule_already_defined (m,r,(file,line)) -> *)
(* Log.fcritical "[GRS] Rule '%s.%s' already defined (file: %s, line: %d)!" m r file line *)
(* | Checker.Invalid_feature (mname,(mfile,mline),rname,(rfile,rline),nodename,(nfile,nline),fname,file,line) -> *)
(* Log.fcritical "[GRS] Invalid feature '%s' (file: %s, line: %d)\nIn node '%s' (file: %s, line: %d)\nIn rule '%s' (file: %s, line: %d)\nIn module '%s' (file: %s, line: %d)" *)
(* fname file line *)
(* nodename nfile nline *)
(* rname rfile rline *)
(* mname mfile mline *)
(* | Checker.Node_already_defined (mname,(mfile,mline),rname,(rfile,rline),nodename,(nfile,nline)) -> *)
(* Log.fcritical "[GRS] Node '%s' already defined (file: %s, line: %d)\nIn rule '%s' (file: %s, line: %d)\nIn module '%s' (file: %s, line: %d)" *)
(* nodename nfile nline *)
(* rname rfile rline *)
(* mname mfile mline *)
(* | Checker.Edge_already_defined (mname,(mfile,mline),rname,(rfile,rline),eid,(efile,eline)) -> *)
(* Log.fcritical "[GRS] Edge '%s' already defined (file: %s, line: %d)\nIn rule '%s' (file: %s, line: %d)\nIn module '%s' (file: %s, line: %d)" *)
(* eid efile eline *)
(* rname rfile rline *)
(* mname mfile mline *)
(* | Checker.Node_not_defined (mname,(mfile,mline),rname,(rfile,rline),eid,(efile,eline),nodename) -> *)
(* Log.fcritical "[GRS] The node '%s' isn't defined%s (file: %s, line: %d)\nIn rule '%s' (file: %s, line: %d)\nIn module '%s' (file: %s, line: %d)" *)
(* nodename *)
(* (match eid with Some id -> " in edge '"^id^"'" | None -> "") efile eline *)
(* rname rfile rline *)
(* mname mfile mline *)
(* | Checker.Unavailable_label (mname,(mfile,mline),rname,(rfile,rline),eid,(efile,eline),label) -> *)
(* Log.fcritical "[GRS] The label '%s' is unavailable%s (file: %s, line: %d)\nIn rule '%s' (file: %s, line: %d)\nIn module '%s' (file: %s, line: %d)" *)
(* label *)
(* (match eid with Some id -> " in edge '"^id^"'" | None -> "") efile eline *)
(* rname rfile rline *)
(* mname mfile mline *)
(* | Checker.Forbidden_label (mname,(mfile,mline),rname,(rfile,rline),eid,(efile,eline),label) -> *)
(* Log.fcritical "[GRS] The label '%s' is forbidden%s (file: %s, line: %d)\nIn rule '%s' (file: %s, line: %d)\nIn module '%s' (file: %s, line: %d)" *)
(* label *)
(* (match eid with Some id -> " in edge '"^id^"'" | None -> "") efile eline *)
(* rname rfile rline *)
(* mname mfile mline *)
(* | Checker.Undefined_module (sname,(sfile,sline),mname) -> *)
(* Log.fcritical "[GRS] Undefined module '%s' in sequence '%s' (file: %s, line: %d)" *)
(* mname *)
(* sname sfile sline *)
| Grew_parser.Parse_error msg ->
Log.fcritical "[GRS] %s" msg
| exc -> Log.fbug "uncaught exception '%s'" (Printexc.to_string exc); exit 2
......@@ -51,15 +51,15 @@ module Feature_structure = struct
let empty = []
let rec get name = function
| [] -> raise Not_found
| Feature.Equal (n,l) :: _ when n=name -> l
| [] -> None
| Feature.Equal (n,l) :: _ when n=name -> Some l
| Feature.Equal (n,l) :: t when n<name -> get name t
| Feature.Equal _ :: _ -> raise Not_found
| Feature.Different _ :: _ -> failwith "[Feature_structure.get] this fs contains 'Different' constructor"
| Feature.Equal _ :: _ -> None
| Feature.Different _ :: _ -> Log.critical "[Feature_structure.get] this fs contains 'Different' constructor"
let get_atom name t =
match get name t with
| [one] -> Some one
| Some [one] -> Some one
| _ -> None
let string_of_feature = function
......
......@@ -9,7 +9,7 @@ module Feature_structure: sig
val build: ?domain:Ast.domain -> Ast.feature list -> t
val get: string -> t -> string list
val get: string -> t -> string list option
val get_atom: string -> t -> string option
......
......@@ -32,7 +32,9 @@ module Grew_parser = struct
try
Parser_global.current_file := file;
Parser_global.current_line := 0;
let res = Gr_grs_parser.grs_with_include Lexer.global to_parse in close_in in_ch; res
let res = Gr_grs_parser.grs_with_include Lexer.global to_parse in
close_in in_ch;
res
with
| Lexer.Error msg -> raise (Parse_error msg)
| Gr_grs_parser.Error ->
......@@ -54,11 +56,8 @@ module Grew_parser = struct
try
Parser_global.current_file := file;
Parser_global.current_line := 0;
let res = Gr_grs_parser.included Lexer.global to_parse in close_in in_ch;
Printf.printf "=======================================================\n";
List.iter
(fun m -> Printf.printf "module %s --> %d rules\n" m.module_id (List.length m.rules)) res;
Printf.printf "=======================================================\n";
let res = Gr_grs_parser.included Lexer.global to_parse in
close_in in_ch;
res
with
| Lexer.Error msg -> raise (Parse_error msg)
......
......@@ -242,7 +242,10 @@ module Rule = struct
| Feature_eq (pid1, feat_name1, pid2, feat_name2) ->
let gnode1 = IntMap.find (IntMap.find pid1 matching.n_match) graph.Graph.map in
let gnode2 = IntMap.find (IntMap.find pid2 matching.n_match) graph.Graph.map in
Feature_structure.get feat_name1 gnode1.Node.fs = Feature_structure.get feat_name2 gnode2.Node.fs
(match (Feature_structure.get feat_name1 gnode1.Node.fs,
Feature_structure.get feat_name2 gnode2.Node.fs) with
| Some fv1, Some fv2 when fv1 = fv2 -> true
| _ -> false)
| Filter (pid, fs) ->
let gid = IntMap.find pid matching.n_match in
let gnode = IntMap.find gid graph.Graph.map in
......
open Grew_parser
open Checker
open HTMLer
let test =
let gr_file_to_parse = ref None in
let file_to_parse = ref None in
let file_to_check = ref None in
let html_out_dir = ref None in
let args = [
"-test_gr_parser", Arg.String (fun s -> gr_file_to_parse := Some s), "<file> the gr file to parse";
"-test_grs_parser", Arg.String (fun s -> file_to_parse := Some s), "<file> the grs file to parse";
"-test_grs_check", Arg.String (fun s -> file_to_check := Some s), "<file> the grs file to parse+check";
"-test_grs_html_out_dir", Arg.String (fun s -> html_out_dir := Some s), "<out_dir> the dir where to put html files\n"
] in
Arg.parse args (fun opt -> ()) "\n\nTest options";
begin
match !gr_file_to_parse with
| Some file ->
begin try
let ast = Grew_parser.parse_file_to_gr file in
(* begin try *)
(* Checker.check_gr ast *)
(* with *)
(* | Checker.Node_already_defined_in_graph (id,(file,line)) -> *)
(* Printf.printf "Node '%s' already defined (file: %s, line: %d)!" id file line; *)
(* exit 1 *)
(* | Checker.Index_already_defined_in_graph (id,(file,line)) -> *)
(* Printf.printf "Index '%s' already defined (file: %s, line: %d)!" id file line; *)
(* exit 1 *)
(* | Checker.Edge_already_defined_in_graph (n1,n2,(file,line)) -> *)
(* Printf.printf "Edge '%s->%s' already defined (file: %s, line: %d)!" n1 n2 file line; *)
(* exit 1 *)
(* end; *)
(* Printf.printf "%s\n%!" (Ast.Grew_string.to_string_gr ast);*)
(* Printf.printf "%s\n%!" (Ast.Grew_dot.to_dot_gr ast);*)
(* Printf.printf "%s\n%!" (Ast.Grew_dep2pict.to_dep2pict_gr ast)*)
()
with Grew_parser.Parse_error msg ->
Printf.eprintf "%s\n%!" msg; exit 1
end;
exit 0;
| None -> ()
end;
begin
match !file_to_parse with
| None -> ()
| Some file ->
try
let ast = Grew_parser.parse_file_to_grs file in
begin
match !html_out_dir with
| None -> ()
| Some d -> HTMLer.proceed d ast;
end
with Grew_parser.Parse_error msg ->
Printf.eprintf "%s\n%!" msg; exit 1
end;
begin
match !file_to_check with
| None -> ()
| Some file ->
try
let ast = Grew_parser.parse_file_to_grs file in ()
(* try *)
(* Checker.check_grs ast *)
(* with *)
(* | Checker.Module_already_defined (m,(file,line)) -> *)
(* Printf.printf "Module '%s' already defined (file: %s, line: %d)!" m file line *)
(* | Checker.Rule_already_defined (m,r,(file,line)) -> *)
(* Printf.printf "Rule '%s.%s' already defined (file: %s, line: %d)!" m r file line *)
(* | Checker.Invalid_feature (mname,(mfile,mline),rname,(rfile,rline),nodename,(nfile,nline),fname,file,line) -> *)
(* Printf.printf "Invalid feature '%s' (file: %s, line: %d)\nIn node '%s' (file: %s, line: %d)\nIn rule '%s' (file: %s, line: %d)\nIn module '%s' (file: %s, line: %d)\n" *)
(* fname file line *)
(* nodename nfile nline *)
(* rname rfile rline *)
(* mname mfile mline *)
(* | Checker.Node_already_defined (mname,(mfile,mline),rname,(rfile,rline),nodename,(nfile,nline)) -> *)
(* Printf.printf "Node '%s' already defined (file: %s, line: %d)\nIn rule '%s' (file: %s, line: %d)\nIn module '%s' (file: %s, line: %d)\n" *)
(* nodename nfile nline *)
(* rname rfile rline *)
(* mname mfile mline *)
(* | Checker.Edge_already_defined (mname,(mfile,mline),rname,(rfile,rline),eid,(efile,eline)) -> *)
(* Printf.printf "Edge '%s' already defined (file: %s, line: %d)\nIn rule '%s' (file: %s, line: %d)\nIn module '%s' (file: %s, line: %d)\n" *)
(* eid efile eline *)
(* rname rfile rline *)
(* mname mfile mline *)
(* | Checker.Node_not_defined (mname,(mfile,mline),rname,(rfile,rline),eid,(efile,eline),nodename) -> *)
(* Printf.printf "The node '%s' isn't defined%s (file: %s, line: %d)\nIn rule '%s' (file: %s, line: %d)\nIn module '%s' (file: %s, line: %d)\n" *)
(* nodename *)
(* (match eid with Some id -> " in edge '"^id^"'" | None -> "") efile eline *)
(* rname rfile rline *)
(* mname mfile mline *)
(* | Checker.Unavailable_label (mname,(mfile,mline),rname,(rfile,rline),eid,(efile,eline),label) -> *)
(* Printf.printf "The label '%s' is unavailable%s (file: %s, line: %d)\nIn rule '%s' (file: %s, line: %d)\nIn module '%s' (file: %s, line: %d)\n" *)
(* label *)
(* (match eid with Some id -> " in edge '"^id^"'" | None -> "") efile eline *)
(* rname rfile rline *)
(* mname mfile mline *)
(* | Checker.Forbidden_label (mname,(mfile,mline),rname,(rfile,rline),eid,(efile,eline),label) -> *)
(* Printf.printf "The label '%s' is forbidden%s (file: %s, line: %d)\nIn rule '%s' (file: %s, line: %d)\nIn module '%s' (file: %s, line: %d)\n" *)
(* label *)
(* (match eid with Some id -> " in edge '"^id^"'" | None -> "") efile eline *)
(* rname rfile rline *)
(* mname mfile mline *)
(* | Checker.Undefined_module (sname,(sfile,sline),mname) -> *)
(* Printf.printf "Undefined module '%s' in sequence '%s' (file: %s, line: %d)" *)
(* mname *)
(* sname sfile sline *)
with Grew_parser.Parse_error msg ->
Printf.eprintf "%s\n%!" msg; exit 1
end;
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