Reformulation of the user-facing slot-access API

- The internal [backtrace_slot] type is not exposed anymore, instead
  accessors function return orthogonal information
  (is_raise, location). This is both more extensible and more
  user-friendly.

- The [raw_backtrace_slot] is exposed separately as a low-level type
  that most users should never use. The unsafety of marshalling is
  documented. Instead of defining
  [raw_backtrace = raw_backtrace_slot array], I kept [raw_backtrace]
  an abstract type with [length] and [get] functions for
  random-access. This should allow us to change the implementation in
  the future to be more robust wrt. marshalling (boxing the trace in
  a Custom block, or even possibly the raw slots at access time).

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

stdlib/printexc.ml

@@ -106,24 +106,20 @@ let convert_raw_backtrace rbckt =
   try Some (Array.map convert_raw_backtrace_slot rbckt)
   with Failure _ -> None
 
-let format_backtrace_slot pos li =
-  let is_raise =
-    match li with
-    | Known_location(is_raise, _, _, _, _) -> is_raise
-    | Unknown_location(is_raise) -> is_raise in
-  let info =
+let format_backtrace_slot pos slot =
+  let info is_raise =
     if is_raise then
       if pos = 0 then "Raised at" else "Re-raised at"
     else
       if pos = 0 then "Raised by primitive operation at" else "Called from"
   in
-  match li with
+  match slot with
+  | Unknown_location true -> (* compiler-inserted re-raise, skipped *) None
+  | Unknown_location false ->
+      Some (sprintf "%s unknown location" (info false))
   | Known_location(is_raise, filename, lineno, startchar, endchar) ->
-      sprintf "%s file \"%s\", line %d, characters %d-%d"
-              info filename lineno startchar endchar
-  | Unknown_location(is_raise) ->
-      sprintf "%s unknown location"
-              info
+      Some (sprintf "%s file \"%s\", line %d, characters %d-%d"
+              (info is_raise) filename lineno startchar endchar)
 
 let print_exception_backtrace outchan backtrace =
   match backtrace with
@@ -132,8 +128,9 @@ let print_exception_backtrace outchan backtrace =
         "(Program not linked with -g, cannot print stack backtrace)\n"
   | Some a ->
       for i = 0 to Array.length a - 1 do
-        if a.(i) <> Unknown_location true then
-          fprintf outchan "%s\n" (format_backtrace_slot i a.(i))
+        match format_backtrace_slot i a.(i) with
+          | None -> ()
+          | Some str -> fprintf outchan "%s\n" str
       done
 
 let print_raw_backtrace outchan raw_backtrace =
@@ -150,14 +147,67 @@ let backtrace_to_string backtrace =
   | Some a ->
       let b = Buffer.create 1024 in
       for i = 0 to Array.length a - 1 do
-        if a.(i) <> Unknown_location true then
-          bprintf b "%s\n" (format_backtrace_slot i a.(i))
+        match format_backtrace_slot i a.(i) with
+          | None -> ()
+          | Some str -> bprintf b "%s\n" str
       done;
       Buffer.contents b
 
 let raw_backtrace_to_string raw_backtrace =
   backtrace_to_string (convert_raw_backtrace raw_backtrace)
 
+let backtrace_slot_is_raise = function
+  | Known_location(is_raise, _, _, _, _) -> is_raise
+  | Unknown_location(is_raise) -> is_raise
+
+type location = {
+  filename : string;
+  line_number : int;
+  start_char : int;
+  end_char : int;
+}
+
+let backtrace_slot_location = function
+  | Unknown_location _ -> None
+  | Known_location(_is_raise, filename, line_number,
+                   start_char, end_char) ->
+    Some {
+      filename;
+      line_number;
+      start_char;
+      end_char;
+    }
+
+let backtrace_slots raw_backtrace =
+  (* The documentation of this function guarantees that Some is
+     returned only if a part of the trace is usable. This gives us
+     a bit more work than just convert_raw_backtrace, but it makes the
+     API more user-friendly -- otherwise most users would have to
+     reimplement the "Program not linked with -g, sorry" logic
+     themselves. *)
+  match convert_raw_backtrace raw_backtrace with
+    | None -> None
+    | Some backtrace ->
+      let usable_slot = function
+        | Unknown_location _ -> false
+        | Known_location _ -> true in
+      let rec exists_usable = function
+        | (-1) -> false
+        | i -> usable_slot backtrace.(i) || exists_usable (i - 1) in
+      if exists_usable (Array.length backtrace - 1)
+      then Some backtrace
+      else None
+
+module Slot = struct
+  type t = backtrace_slot
+  let format = format_backtrace_slot
+  let is_raise = backtrace_slot_is_raise
+  let location = backtrace_slot_location
+end
+
+let raw_backtrace_length bckt = Array.length bckt
+let get_raw_backtrace_slot bckt i = Array.get bckt i
+
 (* confusingly named:
    returns the *string* corresponding to the global current backtrace *)
 let get_backtrace () =
@@ -169,10 +219,8 @@ external backtrace_status: unit -> bool = "caml_backtrace_status"
 let register_printer fn =
   printers := fn :: !printers
 
-
 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

stdlib/printexc.mli

@@ -85,25 +85,54 @@ val register_printer: (exn -> string option) -> unit
 
 (** {6 Raw backtraces} *)
 
-type raw_backtrace_slot
-type raw_backtrace = raw_backtrace_slot array
-
-(** The abstract type [raw_backtrace_slot] stores a slot of a backtrace in
+type raw_backtrace
+(** The abstract type [raw_backtrace] stores a backtrace in
     a low-level format, instead of directly exposing them as string as
     the [get_backtrace()] function does.
 
     This allows delaying the formatting of backtraces to when they are
-    actually printed, which might be useful if you record more
+    actually printed, which may be useful if you record more
     backtraces than you print.
 
-    Elements of type raw_backtrace_slot can be compared and hashed: when two
-    elements are equal, then they represent the same source location (the
-    converse is not necessarily true in presence of inlining, for example).
+    Raw backtraces cannot be marshalled. If you need marshalling, you
+    should use the array returned by the [backtrace_slots] function of
+    the next section.
+
+    @since 4.01.0
 *)
 
 val get_raw_backtrace: unit -> raw_backtrace
+(** [Printexc.get_raw_backtrace ()] returns the same exception
+    backtrace that [Printexc.print_backtrace] would print, but in
+    a raw format.
+
+    @since 4.01.0
+*)
+
 val print_raw_backtrace: out_channel -> raw_backtrace -> unit
+(** Print a raw backtrace in the same format
+    [Printexc.print_backtrace] uses.
+
+    @since 4.01.0
+*)
+
 val raw_backtrace_to_string: raw_backtrace -> string
+(** Return a string from a raw backtrace, in the same format
+    [Printexc.get_backtrace] uses.
+
+    @since 4.01.0
+*)
+
+(** {6 Current call stack} *)
+
+val get_callstack: int -> raw_backtrace
+(** [Printexc.get_callstack n] returns a description of the top of the
+    call stack on the current program point (for the current thread),
+    with at most [n] entries.  (Note: this function is not related to
+    exceptions at all, despite being part of the [Printexc] module.)
+
+    @since 4.01.0
+*)
 
 (** {6 Uncaught exceptions} *)
 
@@ -121,46 +150,120 @@ val set_uncaught_exception_handler: (exn -> raw_backtrace -> unit) -> unit
     @since 4.02.0
 *)
 
-(** {6 Backtrace slots processing} *)
 
-type backtrace_slot =
-  | Known_location of bool   (* is_raise *)
-                    * string (* filename *)
-                    * int    (* line number *)
-                    * int    (* start char *)
-                    * int    (* end char *)
-  | Unknown_location of bool (*is_raise*)
+(** {6 Manipulation of backtrace information}
+
+    Those function allow to traverse the slots of a raw backtrace,
+    extract information from them in a programmer-friendly format.
+*)
+
+type backtrace_slot
+(** The abstract type [backtrace_slot] represents a single slot of
+    a backtrace.
+
+    @since 4.02
+*)
+
+val backtrace_slots : raw_backtrace -> backtrace_slot array option
+(** Returns the slots of a raw backtrace, or [None] if none of them
+    contain useful information.
+
+    In the return array, the slot at index [0] corresponds to the most
+    recent function call, raise, or primitive [get_backtrace] call in
+    the trace.
+
+    Some possible reasons for returning [None] are as follow:
+    - none of the slots in the trace come from modules compiled with
+    debug information ([-g])
+    - the program is a bytecode program that has not been linked with
+    debug information enabled ([ocamlc -g])
+*)
+
+type location = {
+  filename : string;
+  line_number : int;
+  start_char : int;
+  end_char : int;
+}
+(** The type of location information found in backtraces. [start_char]
+    and [end_char] are positions relative to the beginning of the
+    line.
+
+    @since 4.02
+*)
+
+module Slot : sig
+  type t = backtrace_slot
+
+  val is_raise : t -> bool
+  (** [is_raise slot] is [true] when [slot] refers to a raising
+      point in the code, and [false] when it comes from a simple
+      function call.
+
+      @since 4.02
+  *)
+
+  val location : t -> location option
+  (** [location slot] returns the location information of the slot,
+      if available, and [None] otherwise.
+
+      Some possible reasons for failing to return a location are as follow:
+      - the slot corresponds to a compiler-inserted raise
+      - the slot corresponds to a part of the program that has not been
+      compiled with debug information ([-g])
 
-(** [convert_raw_backtrace_slot] converts one slot of a raw backtrace
-    to an Ocaml algebraic datatype representing to location
-    information in the source file.
+      @since 4.02
+  *)
 
-    Raises [Failure] if not able to load debug information.
+  val format : int -> t -> string option
+  (** [format pos slot] returns the string representation of [slot] as
+      [raw_backtrace_to_string] would format it, assuming it is the
+      [pos]-th element of the backtrace: the [0]-th element is
+      pretty-printed differently than the others.
+
+      Whole-backtrace printing functions also skip some uninformative
+      slots; in that case, [format pos slot] returns [None].
+
+      @since 4.02
+  *)
+end
+
+
+(** {6 Raw backtrace slots} *)
+
+type raw_backtrace_slot
+(** This type allows direct access to raw backtrace slots, without any
+    conversion in an OCaml-usable data-structure. Being
+    process-specific, they must absolutely not be marshalled, and are
+    unsafe to use for this reason (marshalling them may not fail, but
+    un-marshalling and using the result will result in
+    undefined behavior).
+
+    Elements of this type can still be compared and hashed: when two
+    elements are equal, then they represent the same source location
+    (the converse is not necessarily true in presence of inlining,
+    for example).
 *)
-val convert_raw_backtrace_slot: raw_backtrace_slot -> backtrace_slot
 
-(** [format_backtrace_slot pos slot] returns the string
-    representation of the backtrace slot [slot] as
-    [raw_backtrace_to_string] would format it, assuming it is the
-    [pos]-th element of the backtrace: the 0-th element is
-    pretty-printed differently than the other.
+val raw_backtrace_length : raw_backtrace -> int
+(** [raw_backtrace_length bckt] returns the number of slots in the
+    backtrace [bckt].
 
-    Note that Printexc's printing function will skip any slot equal to
-    [Unknown_location true]; you should as well if you wish to
-    reproduce its behavior.
+    @since 4.02
 *)
-val format_backtrace_slot : int -> backtrace_slot -> string
 
-(** {6 Current call stack} *)
+val get_raw_backtrace_slot : raw_backtrace -> int -> raw_backtrace_slot
+(** [get_slot bckt pos] returns the slot in position [pos] in the
+    backtrace [bckt].
 
-val get_callstack: int -> raw_backtrace
+    @since 4.02
+*)
 
-(** [Printexc.get_callstack n] returns a description of the top of the
-    call stack on the current program point (for the current thread),
-    with at most [n] entries.  (Note: this function is not related to
-    exceptions at all, despite being part of the [Printexc] module.)
+val convert_raw_backtrace_slot : raw_backtrace_slot -> backtrace_slot
+(** Extracts the user-friendly [backtrace_slot] from a low-level
+    [raw_backtrace_slot].
 
-    @since 4.01.0
+    @since 4.02
 *)
 
 

testsuite/tests/backtrace/backtrace_deprecated.ml

@@ -36,9 +36,9 @@ let run args =
     | None -> ()
     | Some trace ->
       Array.iteri
-        (fun i slot ->
-          if slot <> Printexc.Unknown_location true then
-            print_endline (Printexc.format_backtrace_slot i slot))
+        (fun i slot -> match Printexc.Slot.format i slot with
+          | None -> ()
+          | Some line -> print_endline line)
         trace
 
 let _ =