user-exposed abstract type for raw backtraces in Printexc.ml (original patch from Jacques-Henri Jourdan)

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

2 files changed, 48 insertions, 6 deletions

diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml
index be1d8f0f8..a36e2d4e3 100644
--- a/stdlib/printexc.ml
+++ b/stdlib/printexc.ml
@@ -79,6 +79,11 @@ let catch fct arg =
     eprintf "Uncaught exception: %s\n" (to_string x);
     exit 2
 
+type raw_backtrace
+
+external get_raw_backtrace:
+  unit -> raw_backtrace = "caml_get_exception_raw_backtrace"
+
 type loc_info =
   | Known_location of bool   (* is_raise *)
                     * string (* filename *)
@@ -90,8 +95,10 @@ type loc_info =
 (* to avoid warning *)
 let _ = [Known_location (false, "", 0, 0, 0); Unknown_location false]
 
-external get_exception_backtrace:
-  unit -> loc_info array option = "caml_get_exception_backtrace"
+type backtrace = loc_info array
+
+external convert_raw_backtrace:
+  raw_backtrace -> backtrace option = "caml_convert_raw_backtrace"
 
 let format_loc_info pos li =
   let is_raise =
@@ -112,8 +119,8 @@ let format_loc_info pos li =
       sprintf "%s unknown location"
               info
 
-let print_backtrace outchan =
-  match get_exception_backtrace() with
+let print_exception_backtrace outchan backtrace =
+  match backtrace with
   | None ->
       fprintf outchan
         "(Program not linked with -g, cannot print stack backtrace)\n"
@@ -123,8 +130,15 @@ let print_backtrace outchan =
           fprintf outchan "%s\n" (format_loc_info i a.(i))
       done
 
-let get_backtrace () =
-  match get_exception_backtrace() with
+let print_raw_backtrace outchan raw_backtrace =
+  print_exception_backtrace outchan (convert_raw_backtrace raw_backtrace)
+
+(* confusingly named: prints the global current backtrace *)
+let print_backtrace outchan =
+  print_raw_backtrace outchan (get_raw_backtrace ())
+
+let backtrace_to_string backtrace =
+  match backtrace with
   | None ->
      "(Program not linked with -g, cannot print stack backtrace)\n"
   | Some a ->
@@ -135,6 +149,17 @@ let get_backtrace () =
       done;
       Buffer.contents b
 
+let raw_backtrace_to_string raw_backtrace =
+  backtrace_to_string (convert_raw_backtrace raw_backtrace)
+
+(* confusingly named:
+   returns the *string* corresponding to the global current backtrace *)
+let get_backtrace () =
+  (* we could use the caml_get_exception_backtrace primitive here, but
+     we hope to deprecate it so it's better to just compose the
+     raw stuff *)
+  backtrace_to_string (convert_raw_backtrace (get_raw_backtrace ()))
+
 external record_backtrace: bool -> unit = "caml_record_backtrace"
 external backtrace_status: unit -> bool = "caml_backtrace_status"
 
diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli
index 829530fac..b65326552 100644
--- a/stdlib/printexc.mli
+++ b/stdlib/printexc.mli
@@ -82,3 +82,20 @@ val register_printer: (exn -> string option) -> unit
     the backtrace if it has itself raised an exception before.
     @since 3.11.2
 *)
+
+(** {6 Raw backtraces} *)
+
+type raw_backtrace
+
+(** The abstract type [backtrace] stores exception backtraces in
+    a low-level format, instead of directly exposing them as string as
+    the [get_backtrace()] function does.
+
+    This allows to pay the performance overhead of representation
+    conversion and formatting only at printing time, which is useful
+    if you want to record more backtrace than you actually print.
+*)
+
+val get_raw_backtrace: unit -> raw_backtrace
+val print_raw_backtrace: out_channel -> raw_backtrace -> unit
+val raw_backtrace_to_string: raw_backtrace -> string