aboutsummaryrefslogtreecommitdiff
path: root/ide
diff options
context:
space:
mode:
authorPierre Corbineau2014-12-16 15:59:52 +0100
committerPierre Corbineau2014-12-16 16:01:25 +0100
commit8029f7555f9c6f201cc70b5ecc538b11a861f0aa (patch)
treec750b3ea7cafd5ec2176866bbd16208e5335978a /ide
parentd4f5bdd6f7304fac541bb5f4555ecdd6aa42699a (diff)
parentf88cce2698da000ab9054da31330db70997a41a4 (diff)
fix bug #2447 in congruence
Diffstat (limited to 'ide')
-rw-r--r--ide/ide_slave.ml10
-rw-r--r--ide/interface.mli2
-rw-r--r--ide/xmlprotocol.ml1
3 files changed, 7 insertions, 6 deletions
diff --git a/ide/ide_slave.ml b/ide/ide_slave.ml
index b4757c8f76..3d2676f14e 100644
--- a/ide/ide_slave.ml
+++ b/ide/ide_slave.ml
@@ -322,7 +322,7 @@ let about () = {
Interface.compile_date = Coq_config.compile_date;
}
-let handle_exn e =
+let handle_exn (e, info) =
let dummy = Stateid.dummy in
let loc_of e = match Loc.get_loc e with
| Some loc when not (Loc.is_ghost loc) -> Some (Loc.unloc loc)
@@ -332,9 +332,9 @@ let handle_exn e =
| Errors.Drop -> dummy, None, "Drop is not allowed by coqide!"
| Errors.Quit -> dummy, None, "Quit is not allowed by coqide!"
| e ->
- match Stateid.get e with
- | Some (valid, _) -> valid, loc_of e, mk_msg e
- | None -> dummy, loc_of e, mk_msg e
+ match Stateid.get info with
+ | Some (valid, _) -> valid, loc_of info, mk_msg e
+ | None -> dummy, loc_of info, mk_msg e
let init =
let initialized = ref false in
@@ -421,7 +421,7 @@ let print_xml =
fun oc xml ->
Mutex.lock m;
try Xml_printer.print oc xml; Mutex.unlock m
- with e -> let e = Errors.push e in Mutex.unlock m; raise e
+ with e -> let e = Errors.push e in Mutex.unlock m; iraise e
let slave_logger xml_oc level message =
diff --git a/ide/interface.mli b/ide/interface.mli
index 77a875b7d2..cbaa027508 100644
--- a/ide/interface.mli
+++ b/ide/interface.mli
@@ -200,7 +200,7 @@ type init_rty = state_id
type about_sty = unit
type about_rty = coq_info
-type handle_exn_sty = exn
+type handle_exn_sty = Exninfo.iexn
type handle_exn_rty = state_id * location * string
(* Retrocompatibility stuff *)
diff --git a/ide/xmlprotocol.ml b/ide/xmlprotocol.ml
index da0bcaf0b9..0cd7e7b818 100644
--- a/ide/xmlprotocol.ml
+++ b/ide/xmlprotocol.ml
@@ -578,6 +578,7 @@ let abstract_eval_call handler (c : 'a call) : 'a value =
| PrintAst x -> mkGood (handler.print_ast x)
| Annotate x -> mkGood (handler.annotate x)
with any ->
+ let any = Errors.push any in
Fail (handler.handle_exn any)
(** brain dead code, edit if protocol messages are added/removed *)