From d74e520ce702f316494099f016cd35d77c8f82c6 Mon Sep 17 00:00:00 2001
From: ygrek <ygrek@autistici.org>
Date: Tue, 5 Nov 2013 16:18:29 +0100
Subject: [PATCH] printexc2: reduce complexity, drop unused code

---
 src/utils/cdk/printexc2.ml  |   79 +-----------------------------------------
 src/utils/cdk/printexc2.mli |   31 ++---------------
 2 files changed, 5 insertions(+), 105 deletions(-)

diff --git a/src/utils/cdk/printexc2.ml b/src/utils/cdk/printexc2.ml
index 31c034c..865c8bd 100644
--- a/src/utils/cdk/printexc2.ml
+++ b/src/utils/cdk/printexc2.ml
@@ -20,69 +20,9 @@
 open Printf2
 open Printf
 
-let locfmt =
-  Obj.magic (match Sys.os_type with
-  | "MacOS" -> "File \"%s\"; line %d; characters %d to %d ### %s"
-  | _ -> "File \"%s\", line %d, characters %d-%d: %s")
-;;
-
-let field x i =
-  let f = Obj.field x i in
-  if not (Obj.is_block f) then
-    sprintf "%d" (Obj.magic f : int)           (* can also be a char *)
-  else if Obj.tag f = Obj.string_tag then
-    sprintf "\"%s\"" (String.escaped (Obj.magic f : string))
-  else if Obj.tag f = Obj.double_tag then
-    string_of_float (Obj.magic f : float)
-  else
-    "_"
-;;
-let rec other_fields x i =
-  if i >= Obj.size x then ""
-  else sprintf ", %s%s" (field x i) (other_fields x (i+1))
-;;
-let fields x =
-  match Obj.size x with
-  | 0 -> ""
-  | 1 -> ""
-  | 2 -> sprintf "(%s)" (field x 1)
-  | n -> sprintf "(%s%s)" (field x 1) (other_fields x 2)
-;;
-
-let printers = ref []
-
-let rec check exn printers =
-  match printers with
-    [] -> raise Not_found
-  | printer :: printers ->
-      try printer exn with _ ->
-          check exn printers
-
 let to_string = function
-  | Out_of_memory -> "Out of memory";
-  | Stack_overflow -> "Stack overflow";
-  | Match_failure(file, first_char, last_char) ->
-      sprintf locfmt file 0 first_char last_char "Pattern matching failed";
-  | Assert_failure(file, first_char, last_char) ->
-      sprintf locfmt file 0 first_char last_char "Assertion failed";
-  | x ->
-      try
-        check x !printers
-      with _ ->
-      let x = Obj.repr x in
-      let constructor = (Obj.magic(Obj.field (Obj.field x 0) 0) : string) in
-      constructor ^ (fields x)
-;;
-
-let print fct arg =
-  try
-    fct arg
-  with x ->
-    eprintf "Uncaught exception: %s\n" (to_string x);
-    flush stderr;
-    raise x
-
-let register_exn f = printers := f :: !printers
+  | Unix.Unix_error (e, f, arg) -> sprintf "%s failed%s: %s" f (if arg = "" then "" else " on " ^ arg) (Unix.error_message e)
+  | exn -> Printexc.to_string exn
 
 let catch s f x =
   try f x with
@@ -93,18 +33,3 @@ let catch2 s f x y =
   try f x y with
     e -> 
       lprintf_nl "Uncaught exception in %s: %s" s (to_string e)
-
-let vcatchexn s f =
-  try Some (f ()) with
-    e -> 
-      lprintf_nl "Uncaught exception in %s: %s" s (to_string e);
-      None
-
-let _ =
-  register_exn (fun e ->
-      match e with
-        Unix.Unix_error (e, f, arg) ->
-          Printf.sprintf "%s failed%s: %s" f (if arg = "" then "" else
-              " on " ^ arg) (Unix.error_message e)
-          | _ -> raise e
-  )
diff --git a/src/utils/cdk/printexc2.mli b/src/utils/cdk/printexc2.mli
index 0e4af3b..287faf4 100644
--- a/src/utils/cdk/printexc2.mli
+++ b/src/utils/cdk/printexc2.mli
@@ -20,36 +20,11 @@
 (* Module [Printexc2]: facilities for printing exceptions *)
 
 val to_string : exn -> string
-        (* [Printexc2.to_string e] returns a string representation of
-           the exception [e]. *)
+(** [Printexc2.to_string e] returns a string representation of the exception [e]. *)
 
-val printers : (exn -> string) list ref
-  
-
-val print: ('a -> 'b) -> 'a -> 'b
-        (* [Printexc2.print fn x] applies [fn] to [x] and returns the result.
-           If the evaluation of [fn x] raises any exception, the
-           name of the exception is printed on standard error output,
-           and the exception is raised again.
-           The typical use is to catch and report exceptions that
-           escape a function application. *)
-
-val register_exn : (exn -> string) -> unit
-(*d [register_exn printer] registers a printer for user-defined 
-exceptions. [printer] is a function which takes an exception as argument
-and converts it to a string. If it cannot convert the exception, it should
-raise it again. *)
-  
 val catch : string -> ('a -> unit) -> 'a -> unit
 val catch2 : string -> ('a -> 'b -> unit) -> 'a -> 'b -> unit
-(*d [catch msg f x] executes the function [f] and returns unit. If an 
-exception is raised during the execution of [f], the message [msg] is 
+(** [catch msg f x] executes the function [f] and returns unit. If an 
+    exception is raised during the execution of [f], the message [msg] is 
     printed on standard output with the exception using [printexn], and unit
     is returned. *)
-
-val vcatchexn : string -> (unit -> 'a) -> 'a option
-(*d [vcatchexn msg f] executes the function [f] and returns (Some [v]) if 
-[v] is the value returned by [f]. If an 
-exception is raised during the execution of [f], the message is printed
-    on standard output with the exception using [printexn], and 
-  None is returned. *)
-- 
1.7.6.6.GIT

