diff options
Diffstat (limited to 'utils')
| -rw-r--r-- | utils/formatmsg.ml | 52 | ||||
| -rw-r--r-- | utils/formatmsg.mli | 37 | ||||
| -rw-r--r-- | utils/tbl.ml | 2 |
3 files changed, 90 insertions, 1 deletions
diff --git a/utils/formatmsg.ml b/utils/formatmsg.ml new file mode 100644 index 000000000..f9618653b --- /dev/null +++ b/utils/formatmsg.ml @@ -0,0 +1,52 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy and Jerome Vouillon, projet Cristal, INRIA Rocquencourt*) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Formatter used for printing the compiler messages *) + +open Format + +let fmt = ref std_formatter + +let open_hbox () = pp_open_hbox !fmt () +let open_vbox n = pp_open_vbox !fmt n +let open_hvbox n = pp_open_hvbox !fmt n +let open_hovbox n = pp_open_hovbox !fmt n +let open_box n = pp_open_box !fmt n +let close_box () = pp_close_box !fmt () +let print_string s = pp_print_string !fmt s +let print_as n s = pp_print_as !fmt n s +let print_int n = pp_print_int !fmt n +let print_float f = pp_print_float !fmt f +let print_char c = pp_print_char !fmt c +let print_bool b = pp_print_bool !fmt b +let print_break n1 n2 = pp_print_break !fmt n1 n2 +let print_cut () = pp_print_cut !fmt () +let print_space () = pp_print_space !fmt () +let force_newline () = pp_force_newline !fmt () +let print_flush () = pp_print_flush !fmt () +let print_newline () = pp_print_newline !fmt () +let printf f = fprintf !fmt f + +let set_output f = fmt := f + +let with_output_to f fn = + let oldf = !fmt in + fmt := f; + try + fn (); + fmt := oldf + with x -> + fmt := oldf; + raise x + + diff --git a/utils/formatmsg.mli b/utils/formatmsg.mli new file mode 100644 index 000000000..be724ea39 --- /dev/null +++ b/utils/formatmsg.mli @@ -0,0 +1,37 @@ +(***********************************************************************) +(* *) +(* Objective Caml *) +(* *) +(* Xavier Leroy and Jerome Vouillon, projet Cristal, INRIA Rocquencourt*) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Formatter used for printing the compiler messages *) + +val open_hbox : unit -> unit +val open_vbox : int -> unit +val open_hvbox : int -> unit +val open_hovbox : int -> unit +val open_box : int -> unit +val close_box : unit -> unit +val print_string : string -> unit +val print_as : int -> string -> unit +val print_int : int -> unit +val print_float : float -> unit +val print_char : char -> unit +val print_bool : bool -> unit +val print_break : int -> int -> unit +val print_cut : unit -> unit +val print_space : unit -> unit +val force_newline : unit -> unit +val print_flush : unit -> unit +val print_newline : unit -> unit +val printf : ('a, Format.formatter, unit) format -> 'a;; + +val set_output : Format.formatter -> unit +val with_output_to : Format.formatter -> (unit -> 'a) -> unit diff --git a/utils/tbl.ml b/utils/tbl.ml index b1c709bf9..81310d477 100644 --- a/utils/tbl.ml +++ b/utils/tbl.ml @@ -94,7 +94,7 @@ let rec iter f = function | Node(l, v, d, r, _) -> iter f l; f v d; iter f r -open Format +open Formatmsg let print print_key print_data tbl = open_hvbox 2; |