Commit a0980a1b authored by bguillaum's avatar bguillaum

add locations in Bug exception

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@6328 7838e531-6607-4d57-9587-6c381814729c
parent 18314bff
......@@ -16,7 +16,7 @@ exception File_dont_exists of string
exception Build of string * (string * int) option
exception Run of string * (string * int) option
exception Bug of string
exception Bug of string * (string * int) option
type grs = Grs.t
type gr = Instance.t
......@@ -34,8 +34,8 @@ let grs file doc_output_dir =
with
| Grew_parser.Parse_error msg -> raise (Parsing_err msg)
| Utils.Build (msg,loc) -> raise (Build (msg,loc))
| Utils.Bug msg -> raise (Bug msg)
| exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc)))
| Utils.Bug (msg, loc) -> raise (Bug (msg,loc))
| exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
) else (
raise (File_dont_exists file)
)
......@@ -54,8 +54,8 @@ let gr file =
with
| Grew_parser.Parse_error msg -> raise (Parsing_err msg)
| Utils.Build (msg,loc) -> raise (Build (msg,loc))
| Utils.Bug msg -> raise (Bug msg)
| exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc)))
| Utils.Bug (msg, loc) -> raise (Bug (msg,loc))
| exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
) else (
raise (File_dont_exists file)
......@@ -66,14 +66,15 @@ let rewrite ~gr ~grs ~seq =
Grs.build_rew_display grs seq gr
with
| Utils.Run (msg,loc) -> raise (Run (msg,loc))
| Utils.Bug msg -> raise (Bug msg)
| exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc)))
| Utils.Bug (msg, loc) -> raise (Bug (msg,loc))
| exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
let rewrite_to_html ?main_feat input_dir grs output_dir no_init current_grs_file current_grs seq title =
let rewrite_to_html_intern ?(no_init=false) grs_file grs seq input output nb_sentence previous next =
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 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 "")
......@@ -201,7 +202,11 @@ let rewrite_to_html ?main_feat input_dir grs output_dir no_init current_grs_file
close_out out_ch;
()
with
| Utils.Run (msg,loc) -> raise (Run (msg,loc))
| Utils.Bug (msg, loc) -> raise (Bug (msg,loc))
| exc -> raise (Bug (Printf.sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
let get_css_file = Filename.concat DATA_DIR "style.css"
......
......@@ -15,7 +15,7 @@ exception Build of string * (string * int) option
(** raised during rewriting when a command is undefined *)
exception Run of string * (string * int) option
exception Bug of string
exception Bug of string * (string * int) option
(**/**)
type grs = Grs.t
......
......@@ -151,14 +151,14 @@ module Rule = struct
Deco.edges = List.fold_left (fun acc (_,edge) -> edge::acc) matching.a_match matching.e_match;
}
let find cnode (matching, created_nodes) =
let find cnode ?loc (matching, created_nodes) =
match cnode with
| Command.Pid pid ->
(try IntMap.find pid matching.n_match
with Not_found -> Error.bug "Inconsistent matching pid '%d' not found" pid)
with Not_found -> Error.bug ?loc "Inconsistent matching pid '%d' not found" pid)
| Command.New name ->
try List.assoc name created_nodes
with Not_found -> Error.run "Identifier '%s' not found" name
with Not_found -> Error.run ?loc "Identifier '%s' not found" name
let down_deco (matching,created_nodes) commands =
......@@ -328,7 +328,7 @@ exception Command_execution_fail
(** [apply_command instance matching created_nodes command] returns [(new_instance, new_created_nodes)] *)
let apply_command (command,loc) instance matching created_nodes =
let node_find cnode = find cnode (matching, created_nodes) in
let node_find cnode = find ~loc cnode (matching, created_nodes) in
match command with
| Command.ADD_EDGE (src_cn,tar_cn,edge) ->
......
......@@ -348,7 +348,7 @@ end
exception Build of (string * Loc.t option)
exception Run of (string * Loc.t option)
exception Bug of string
exception Bug of (string * Loc.t option)
module Error = struct
let build_ ?loc message =
......@@ -359,8 +359,8 @@ module Error = struct
let run_ ?loc message = raise (Run (message, loc))
let run ?loc = Printf.ksprintf (run_ ?loc)
let bug_ message = raise (Bug message)
let bug x = Printf.ksprintf bug_ x
let bug_ ?loc message = raise (Bug (message, loc))
let bug ?loc = Printf.ksprintf (bug_ ?loc)
end
......
......@@ -110,12 +110,13 @@ end
exception Build of (string * Loc.t option)
exception Run of (string * Loc.t option)
exception Bug of string
exception Bug of (string * Loc.t option)
module Error: sig
val build: ?loc: Loc.t -> ('a, unit, string, 'b) format4 -> 'a
val run: ?loc: Loc.t -> ('a, unit, string, 'b) format4 -> 'a
val bug: ('a, unit, string, 'b) format4 -> 'a
val bug: ?loc: Loc.t -> ('a, unit, string, 'b) format4 -> 'a
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