summaryrefslogtreecommitdiffstats
path: root/stdlib/printexc.ml
diff options
context:
space:
mode:
authorDamien Doligez <damien.doligez-inria.fr>2010-01-20 16:26:46 +0000
committerDamien Doligez <damien.doligez-inria.fr>2010-01-20 16:26:46 +0000
commitbdc0fadee2dc9669818955486b4c3497016edda5 (patch)
tree48047d836d903e84f7e0ae6d74613c2247c4fc81 /stdlib/printexc.ml
parent8cd4fc63907a541d05f31a740632948d453f69f9 (diff)
merge changes from release/3.11.1 to release/3.11.2
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@9540 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'stdlib/printexc.ml')
-rw-r--r--stdlib/printexc.ml17
1 files changed, 14 insertions, 3 deletions
diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml
index f06717c27..11e7d4fd6 100644
--- a/stdlib/printexc.ml
+++ b/stdlib/printexc.ml
@@ -15,6 +15,8 @@
open Printf;;
+let printers = ref []
+
let locfmt = format_of_string "File \"%s\", line %d, characters %d-%d: %s";;
let field x i =
@@ -48,9 +50,16 @@ let to_string = function
| Assert_failure(file, line, char) ->
sprintf locfmt file line char (char+6) "Assertion failed"
| x ->
- let x = Obj.repr x in
- let constructor = (Obj.magic(Obj.field (Obj.field x 0) 0) : string) in
- constructor ^ (fields x)
+ let rec conv = function
+ | hd :: tl ->
+ (match try hd x with _ -> None with
+ | Some s -> s
+ | None -> conv tl)
+ | [] ->
+ let x = Obj.repr x in
+ let constructor = (Obj.magic(Obj.field (Obj.field x 0) 0) : string) in
+ constructor ^ (fields x) in
+ conv !printers
;;
let print fct arg =
@@ -125,3 +134,5 @@ let get_backtrace () =
external record_backtrace: bool -> unit = "caml_record_backtrace"
external backtrace_status: unit -> bool = "caml_backtrace_status"
+let register_printer fn =
+ printers := fn :: !printers