Commit e3dc9704 authored by bguillaum's avatar bguillaum

fix catching problem

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@6696 7838e531-6607-4d57-9587-6c381814729c
parent cc101f3c
......@@ -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" "bad_labels" "sequences" "commands" "graph" "confluent");;keywords
'("features" "module" "rule" "match" "without" "labels" "bad_labels" "sequences" "commands" "graph" "confluent" "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)
......@@ -17,7 +17,10 @@
;; ("$[a-zA-Z0-9_àéèçâôûêäïüö'\-]+" . font-lock-constant-face);;params inside
("del_edge" . font-lock-constant-face)
("add_edge" . font-lock-constant-face)
("merge" . font-lock-constant-face)
("shift" . font-lock-constant-face)
("shift_in" . font-lock-constant-face)
("shift_out" . font-lock-constant-face)
("del_node" . font-lock-constant-face)
("add_node" . font-lock-constant-face)
("del_feat" . font-lock-constant-face)
......
......@@ -364,11 +364,12 @@ module Massoc = struct
let exists fct t = List.exists (fun (key,list) -> List.exists (fun value -> fct key value) list) t
end
exception Build of (string * Loc.t option)
exception Run of (string * Loc.t option)
exception Bug of (string * Loc.t option)
module Error = struct
exception Build of (string * Loc.t option)
exception Run of (string * Loc.t option)
exception Bug of (string * Loc.t option)
let build_ ?loc message =
Log.fmessage "[%s] %s" (match loc with None -> "?" | Some x -> Loc.to_string x) message;
raise (Build (message, loc))
......
......@@ -112,12 +112,13 @@ module Massoc: sig
val exists: (int -> 'a -> bool) -> 'a t -> bool
end
exception Build of (string * Loc.t option)
exception Run of (string * Loc.t option)
exception Bug of (string * Loc.t option)
module Error: sig
exception Build of (string * Loc.t option)
exception Run of (string * Loc.t option)
exception Bug of (string * Loc.t option)
val build: ?loc: Loc.t -> ('a, unit, string, 'b) format4 -> 'a
val run: ?loc: Loc.t -> ('a, unit, string, 'b) format4 -> 'a
val bug: ?loc: Loc.t -> ('a, unit, string, 'b) format4 -> 'a
......
......@@ -41,8 +41,8 @@ let load_grs ?doc_output_dir file =
Grs.build ast
with
| Grew_parser.Parse_error msg -> raise (Parsing_err msg)
| Build (msg,loc) -> raise (Build (msg,loc))
| Bug (msg, loc) -> raise (Bug (msg,loc))
| Error.Build (msg,loc) -> raise (Build (msg,loc))
| Error.Bug (msg, loc) -> raise (Bug (msg,loc))
| exc -> raise (Bug (sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
......@@ -58,8 +58,8 @@ let load_gr file =
Instance.build ast
with
| Grew_parser.Parse_error msg -> raise (Parsing_err msg)
| Build (msg,loc) -> raise (Build (msg,loc))
| Bug (msg, loc) -> raise (Bug (msg,loc))
| Error.Build (msg,loc) -> raise (Build (msg,loc))
| Error.Bug (msg, loc) -> raise (Bug (msg,loc))
| exc -> raise (Bug (sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
) else (
......@@ -69,16 +69,16 @@ let load_gr file =
let rewrite ~gr ~grs ~seq =
try Grs.rewrite grs seq gr
with
| Run (msg,loc) -> raise (Run (msg,loc))
| Bug (msg, loc) -> raise (Bug (msg,loc))
| Error.Run (msg,loc) -> raise (Run (msg,loc))
| Error.Bug (msg, loc) -> raise (Bug (msg,loc))
| exc -> raise (Bug (sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
let display ~gr ~grs ~seq =
try Grs.build_rew_display grs seq gr
with
| Run (msg,loc) -> raise (Run (msg,loc))
| Bug (msg, loc) -> raise (Bug (msg,loc))
| Error.Run (msg,loc) -> raise (Run (msg,loc))
| Error.Bug (msg, loc) -> raise (Bug (msg,loc))
| exc -> raise (Bug (sprintf "UNCATCHED EXCEPTION: %s" (Printexc.to_string exc), None))
......
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