Add a clean logger infrastructure.

[tatoo.git] / src / logger.ml

diff --git a/src/logger.ml b/src/logger.ml
new file mode 100644 (file)
index 0000000..aa9f6f5
--- /dev/null
+++ b/src/logger.ml
@@ -0,0 +1,54 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                               TAToo                                 *)
+(*                                                                     *)
+(*                     Kim Nguyen, LRI UMR8623                         *)
+(*                   Université Paris-Sud & CNRS                       *)
+(*                                                                     *)
+(*  Copyright 2010-2013 Université Paris-Sud and Centre National de la *)
+(*  Recherche Scientifique. All rights reserved.  This file is         *)
+(*  distributed under the terms of the GNU Lesser General Public       *)
+(*  License, with the special exception on linking described in file   *)
+(*  ../LICENSE.                                                        *)
+(*                                                                     *)
+(***********************************************************************)
+
+INCLUDE "utils.ml"
+open Format
+
+type level = [ `NORMAL (* regular output *)
+             | `STATS (* Statistics only given if -s *)
+             | `DEBUG] (* DEBUG STATEMENTS *)
+
+let string_of_level = function
+| `NORMAL -> "NORMAL"
+| `STATS -> "STATS"
+| `DEBUG -> "DEBUG"
+
+
+let _o = ref err_formatter
+
+let set_output o = _o := o
+
+IFDEF DEBUG
+THEN
+let debug = true
+ELSE
+let debug = false
+END
+
+let kont fmt = fprintf fmt "@]@."
+
+let msg level msg =
+  let do_ =
+    match level with
+      `NORMAL -> true
+    | `DEBUG when debug -> true
+    | `STATS when !Options.stats -> true
+    | _ -> false
+  in
+  if do_ then begin
+      fprintf !_o "@[%s: " (string_of_level level);
+      kfprintf kont !_o msg
+  end else
+      ifprintf !_o msg