Add two functions to get the exception slot id and name from an exception value.

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/raise_variants@14240 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

2 files changed, 33 insertions, 0 deletions

diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml
index db22ce357c..9f20c7b464 100644
--- a/stdlib/printexc.ml
+++ b/stdlib/printexc.ml
@@ -171,3 +171,16 @@ let register_printer fn =
 
 
 external get_callstack: int -> raw_backtrace = "caml_get_current_callstack"
+
+
+let exn_slot x =
+  let x = Obj.repr x in
+  if Obj.tag x = 0 then Obj.field x 0 else x
+
+let exn_slot_id x =
+  let slot = exn_slot x in
+  (Obj.obj (Obj.field slot 1) : int)
+
+let exn_slot_name x =
+  let slot = exn_slot x in
+  (Obj.obj (Obj.field slot 0) : string)
diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli
index 773fed814e..07391d5269 100644
--- a/stdlib/printexc.mli
+++ b/stdlib/printexc.mli
@@ -112,3 +112,23 @@ val get_callstack: int -> raw_backtrace
 
     @since 4.01.0
 *)
+
+
+(** {6 Exception slots} *)
+
+val exn_slot_id: exn -> int
+(** [Printexc.exn_slot_id] returns an integer which uniquely identifies
+    the constructor used to create the exception value [exn]
+    (in the current runtime).
+
+    @since 4.02.0
+*)
+
+val exn_slot_name: exn -> string
+(** [Printexc.exn_slot_id exn] returns the internal name of the constructor
+    used to create the exception value [exn].
+
+    @since 4.02.0
+*)
+
+