aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorEmilio Jesus Gallego Arias2020-01-08 18:48:51 +0100
committerEmilio Jesus Gallego Arias2020-01-15 18:10:08 +0100
commitc825bc9caf3abb9610310b79f9420688f06bdf54 (patch)
tree0719927c9e16fe3f969c02c172f189714846166f /lib
parenta8cb0bb1cbdf304da81dc292c9fddf361207142e (diff)
[ocaml] Remove Custom Backtrace module in favor of OCaml's
As suggested by Pierre-Marie Pédrot, this is a more conservative version of #8771 . In this commit, we replace Coq's custom backtrace type with OCaml `Printexc.raw_backtrace`; this seems to already give some improvements in terms of backtraces [see below] and removes quite a bit of code. Main difference in terms of API is that backtraces become now first-class in `Exninfo`, and we seek to consolidate thus the exception-related APIs in that module. We also fix a bug in `vernac.ml` where the backtrace captured was the one of `edit_at`. Closes #6446 Example with backtrace from https://github.com/coq/coq/issues/11366 Old: ``` raise @ file "stdlib.ml", line 33, characters 17-33 frame @ file "pretyping/coercion.ml", line 406, characters 24-68 frame @ file "list.ml", line 117, characters 24-34 frame @ file "pretyping/coercion.ml", line 393, characters 4-1004 frame @ file "pretyping/coercion.ml", line 450, characters 12-40 raise @ unknown frame @ file "pretyping/coercion.ml", line 464, characters 6-46 raise @ unknown frame @ file "pretyping/pretyping.ml", line 839, characters 33-95 frame @ file "pretyping/pretyping.ml", line 875, characters 50-94 frame @ file "pretyping/pretyping.ml", line 1280, characters 2-81 frame @ file "pretyping/pretyping.ml", line 1342, characters 20-71 frame @ file "vernac/vernacentries.ml", line 1579, characters 17-48 frame @ file "vernac/vernacentries.ml", line 2215, characters 8-49 frame @ file "vernac/vernacinterp.ml", line 45, characters 4-13 ... ``` New: ``` Raised at file "stdlib.ml", line 33, characters 17-33 Called from file "pretyping/coercion.ml", line 406, characters 24-68 Called from file "list.ml", line 117, characters 24-34 Called from file "pretyping/coercion.ml", line 393, characters 4-1004 Called from file "pretyping/coercion.ml", line 450, characters 12-40 Called from file "pretyping/coercion.ml", line 464, characters 6-46 Called from file "pretyping/pretyping.ml", line 839, characters 33-95 Called from file "pretyping/pretyping.ml", line 875, characters 50-94 Called from file "pretyping/pretyping.ml" (inlined), line 1280, characters 2-81 Called from file "pretyping/pretyping.ml", line 1294, characters 21-94 Called from file "pretyping/pretyping.ml", line 1342, characters 20-71 Called from file "vernac/vernacentries.ml", line 1579, characters 17-48 Called from file "vernac/vernacentries.ml", line 2215, characters 8-49 Called from file "vernac/vernacinterp.ml", line 45, characters 4-13 ... ```
Diffstat (limited to 'lib')
-rw-r--r--lib/cErrors.ml8
-rw-r--r--lib/control.ml6
-rw-r--r--lib/flags.ml4
-rw-r--r--lib/pp.ml2
4 files changed, 9 insertions, 11 deletions
diff --git a/lib/cErrors.ml b/lib/cErrors.ml
index b9735d0579..9f496f5845 100644
--- a/lib/cErrors.ml
+++ b/lib/cErrors.ml
@@ -12,7 +12,7 @@ open Pp
(** Aliases *)
-let push = Backtrace.add_backtrace
+let push = Exninfo.capture
(* Errors *)
@@ -51,12 +51,10 @@ let raw_anomaly e = match e with
| _ ->
str "Uncaught exception " ++ str (Printexc.to_string e) ++ str "."
-let print_backtrace e = match Backtrace.get_backtrace e with
+let print_backtrace e = match Exninfo.get_backtrace e with
| None -> mt ()
| Some bt ->
- let bt = Backtrace.repr bt in
- let pr_frame f = str (Backtrace.print_frame f) in
- let bt = prlist_with_sep fnl pr_frame bt in
+ let bt = str (Exninfo.backtrace_to_string bt) in
fnl () ++ hov 0 bt
let print_anomaly askreport e =
diff --git a/lib/control.ml b/lib/control.ml
index 7d54838df8..e67e88ee95 100644
--- a/lib/control.ml
+++ b/lib/control.ml
@@ -38,7 +38,7 @@ let unix_timeout n f x e =
restore_timeout ();
res
with e ->
- let e = Backtrace.add_backtrace e in
+ let e = Exninfo.capture e in
restore_timeout ();
Exninfo.iraise e
@@ -76,7 +76,7 @@ let windows_timeout n f x e =
else raise e
| e ->
let () = killed := true in
- let e = Backtrace.add_backtrace e in
+ let e = Exninfo.capture e in
Exninfo.iraise e
type timeout = { timeout : 'a 'b. int -> ('a -> 'b) -> 'a -> exn -> 'b }
@@ -102,7 +102,7 @@ let protect_sigalrm f x =
| true, Sys.Signal_handle f -> f Sys.sigalrm; res
| _, _ -> res
with e ->
- let e = Backtrace.add_backtrace e in
+ let e = Exninfo.capture e in
Sys.set_signal Sys.sigalrm old_handler;
Exninfo.iraise e
with Invalid_argument _ -> (* This happens on Windows, as handling SIGALRM does not seem supported *)
diff --git a/lib/flags.ml b/lib/flags.ml
index b87ba46634..ad48024761 100644
--- a/lib/flags.ml
+++ b/lib/flags.ml
@@ -19,7 +19,7 @@ let with_modified_ref ?(restore=true) r nf f x =
if restore || pre == !r then r := old_ref;
res
with reraise ->
- let reraise = Backtrace.add_backtrace reraise in
+ let reraise = Exninfo.capture reraise in
r := old_ref;
Exninfo.iraise reraise
@@ -37,7 +37,7 @@ let with_options ol f x =
let r = f x in
let () = List.iter2 (:=) ol vl in r
with reraise ->
- let reraise = Backtrace.add_backtrace reraise in
+ let reraise = Exninfo.capture reraise in
let () = List.iter2 (:=) ol vl in
Exninfo.iraise reraise
diff --git a/lib/pp.ml b/lib/pp.ml
index 3e9ab2a82b..1bd160dcda 100644
--- a/lib/pp.ml
+++ b/lib/pp.ml
@@ -203,7 +203,7 @@ let pp_with ft pp =
in
try pp_cmd pp
with reraise ->
- let reraise = Backtrace.add_backtrace reraise in
+ let reraise = Exninfo.capture reraise in
let () = Format.pp_print_flush ft () in
Exninfo.iraise reraise