1995-08-09 08:06:35 -07:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Objective Caml *)
|
1995-08-09 08:06:35 -07:00
|
|
|
(* *)
|
|
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
1999-11-17 10:59:06 -08:00
|
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
2001-12-07 05:41:02 -08:00
|
|
|
(* under the terms of the GNU Library General Public License, with *)
|
|
|
|
(* the special exception on linking described in file ../LICENSE. *)
|
1995-08-09 08:06:35 -07:00
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
2001-10-28 06:21:27 -08:00
|
|
|
(** Formatted output functions. *)
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2003-07-05 04:13:24 -07:00
|
|
|
val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a
|
2001-10-26 15:38:48 -07:00
|
|
|
(** [fprintf outchan format arg1 ... argN] formats the arguments
|
|
|
|
[arg1] to [argN] according to the format string [format],
|
|
|
|
and outputs the resulting string on the channel [outchan].
|
|
|
|
|
|
|
|
The format is a character string which contains two types of
|
|
|
|
objects: plain characters, which are simply copied to the
|
|
|
|
output channel, and conversion specifications, each of which
|
|
|
|
causes conversion and printing of one argument.
|
|
|
|
|
|
|
|
Conversion specifications consist in the [%] character, followed
|
2001-10-28 06:21:27 -08:00
|
|
|
by optional flags and field widths, followed by one or two conversion
|
2001-10-26 15:38:48 -07:00
|
|
|
character. The conversion characters and their meanings are:
|
2004-10-04 13:18:17 -07:00
|
|
|
- [d], [i], [n], [l], [L], or [N]: convert an integer argument to
|
|
|
|
signed decimal.
|
2002-05-12 11:37:49 -07:00
|
|
|
- [u]: convert an integer argument to unsigned decimal.
|
2001-10-26 15:38:48 -07:00
|
|
|
- [x]: convert an integer argument to unsigned hexadecimal,
|
|
|
|
using lowercase letters.
|
|
|
|
- [X]: convert an integer argument to unsigned hexadecimal,
|
|
|
|
using uppercase letters.
|
|
|
|
- [o]: convert an integer argument to unsigned octal.
|
2002-05-12 11:37:49 -07:00
|
|
|
- [s]: insert a string argument.
|
2002-06-26 07:52:34 -07:00
|
|
|
- [S]: insert a string argument in Caml syntax (double quotes, escapes).
|
2002-05-12 11:37:49 -07:00
|
|
|
- [c]: insert a character argument.
|
2002-06-26 07:52:34 -07:00
|
|
|
- [C]: insert a character argument in Caml syntax (single quotes, escapes).
|
2001-10-26 15:38:48 -07:00
|
|
|
- [f]: convert a floating-point argument to decimal notation,
|
2002-05-12 11:37:49 -07:00
|
|
|
in the style [dddd.ddd].
|
2002-09-05 03:27:34 -07:00
|
|
|
- [F]: convert a floating-point argument in Caml syntax ([dddd.ddd]
|
|
|
|
with a mandatory [.]).
|
2001-10-26 15:38:48 -07:00
|
|
|
- [e] or [E]: convert a floating-point argument to decimal notation,
|
2002-05-12 11:37:49 -07:00
|
|
|
in the style [d.ddd e+-dd] (mantissa and exponent).
|
2001-10-26 15:38:48 -07:00
|
|
|
- [g] or [G]: convert a floating-point argument to decimal notation,
|
2002-05-12 11:37:49 -07:00
|
|
|
in style [f] or [e], [E] (whichever is more compact).
|
2002-09-05 03:27:34 -07:00
|
|
|
- [B]: convert a boolean argument to the string [true] or [false]
|
2003-07-01 09:30:12 -07:00
|
|
|
- [b]: convert a boolean argument (for backward compatibility; do not
|
|
|
|
use in new programs).
|
2002-07-28 14:46:07 -07:00
|
|
|
- [ld], [li], [lu], [lx], [lX], [lo]: convert an [int32] argument to
|
2001-10-28 06:21:27 -08:00
|
|
|
the format specified by the second letter (decimal, hexadecimal, etc).
|
|
|
|
- [nd], [ni], [nu], [nx], [nX], [no]: convert a [nativeint] argument to
|
|
|
|
the format specified by the second letter.
|
|
|
|
- [Ld], [Li], [Lu], [Lx], [LX], [Lo]: convert an [int64] argument to
|
|
|
|
the format specified by the second letter.
|
2001-10-26 15:38:48 -07:00
|
|
|
- [a]: user-defined printer. Takes two arguments and apply the first
|
|
|
|
one to [outchan] (the current output channel) and to the second
|
|
|
|
argument. The first argument must therefore have type
|
|
|
|
[out_channel -> 'b -> unit] and the second ['b].
|
|
|
|
The output produced by the function is therefore inserted
|
|
|
|
in the output of [fprintf] at the current point.
|
|
|
|
- [t]: same as [%a], but takes only one argument (with type
|
|
|
|
[out_channel -> unit]) and apply it to [outchan].
|
2004-09-22 02:17:21 -07:00
|
|
|
- [\{ fmt %\}]: convert a format string argument to its minimal
|
|
|
|
specification. The argument must match the internal format string
|
2004-11-16 02:25:59 -08:00
|
|
|
specification [fmt] that enumerates the conversion specification
|
|
|
|
sequence that defines the format type of the argument.
|
2004-09-22 02:17:21 -07:00
|
|
|
- [\( fmt %\)]: printing format insertion. This convertion takes a
|
|
|
|
format string argument and substitutes it to the specification
|
|
|
|
[fmt] to print the following arguments.
|
2003-04-28 02:44:21 -07:00
|
|
|
- [!]: take no argument and flush the output.
|
2001-10-26 15:38:48 -07:00
|
|
|
- [%]: take no argument and output one [%] character.
|
2001-10-28 06:21:27 -08:00
|
|
|
|
|
|
|
The optional flags include:
|
|
|
|
- [-]: left-justify the output (default is right justification).
|
2002-05-25 01:37:33 -07:00
|
|
|
- [0]: for numerical conversions, pad with zeroes instead of spaces.
|
2001-10-28 06:21:27 -08:00
|
|
|
- [+]: for numerical conversions, prefix number with a [+] sign if positive.
|
|
|
|
- space: for numerical conversions, prefix number with a space if positive.
|
|
|
|
- [#]: request an alternate formatting style for numbers.
|
|
|
|
|
|
|
|
The field widths are composed of an optional integer literal
|
|
|
|
indicating the minimal width of the result, possibly followed by
|
|
|
|
a dot [.] and another integer literal indicating how many digits
|
|
|
|
follow the decimal point in the [%f], [%e], and [%E] conversions.
|
|
|
|
For instance, [%6d] prints an integer, prefixing it with spaces to
|
|
|
|
fill at least 6 characters; and [%.4f] prints a float with 4
|
|
|
|
fractional digits. Each or both of the integer literals can also be
|
|
|
|
specified as a [*], in which case an extra integer argument is taken
|
|
|
|
to specify the corresponding width or precision.
|
2001-10-26 15:38:48 -07:00
|
|
|
|
|
|
|
Warning: if too few arguments are provided,
|
|
|
|
for instance because the [printf] function is partially
|
|
|
|
applied, the format is immediately printed up to
|
|
|
|
the conversion of the first missing argument; printing
|
|
|
|
will then resume when the missing arguments are provided.
|
|
|
|
For example, [List.iter (printf "x=%d y=%d " 1) [2;3]]
|
|
|
|
prints [x=1 y=2 3] instead of the expected
|
|
|
|
[x=1 y=2 x=1 y=3]. To get the expected behavior, do
|
|
|
|
[List.iter (fun y -> printf "x=%d y=%d " 1 y) [2;3]]. *)
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2003-07-05 04:13:24 -07:00
|
|
|
val printf : ('a, out_channel, unit) format -> 'a
|
2001-10-26 15:38:48 -07:00
|
|
|
(** Same as {!Printf.fprintf}, but output on [stdout]. *)
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2003-07-05 04:13:24 -07:00
|
|
|
val eprintf : ('a, out_channel, unit) format -> 'a
|
2001-10-26 15:38:48 -07:00
|
|
|
(** Same as {!Printf.fprintf}, but output on [stderr]. *)
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2003-07-05 04:13:24 -07:00
|
|
|
val sprintf : ('a, unit, string) format -> 'a
|
2001-10-26 15:38:48 -07:00
|
|
|
(** Same as {!Printf.fprintf}, but instead of printing on an output channel,
|
|
|
|
return a string containing the result of formatting
|
|
|
|
the arguments. *)
|
1999-02-25 02:26:38 -08:00
|
|
|
|
2003-07-05 04:13:24 -07:00
|
|
|
val bprintf : Buffer.t -> ('a, Buffer.t, unit) format -> 'a
|
2001-10-26 15:38:48 -07:00
|
|
|
(** Same as {!Printf.fprintf}, but instead of printing on an output channel,
|
|
|
|
append the formatted arguments to the given extensible buffer
|
|
|
|
(see module {!Buffer}). *)
|
1999-02-25 02:26:38 -08:00
|
|
|
|
2003-07-05 04:13:24 -07:00
|
|
|
val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b
|
2002-03-21 08:10:36 -08:00
|
|
|
(** [kprintf k format arguments] is the same as [sprintf format arguments],
|
|
|
|
except that the resulting string is passed as argument to [k]; the
|
|
|
|
result of [k] is then returned as the result of [kprintf]. *)
|
2002-03-13 06:08:10 -08:00
|
|
|
|
2001-10-30 08:52:04 -08:00
|
|
|
(**/**)
|
2001-10-28 06:21:27 -08:00
|
|
|
|
|
|
|
(* For system use only. Don't call directly. *)
|
|
|
|
|
2001-12-03 14:16:03 -08:00
|
|
|
val scan_format :
|
2004-09-22 02:17:21 -07:00
|
|
|
string -> int -> (string -> int -> 'a) -> ('b -> 'c -> int -> 'd) ->
|
|
|
|
('e -> int -> 'f) -> (int -> 'g) ->
|
|
|
|
(('h, 'i, 'j, 'k) format4 -> int -> 'a) -> 'a
|
|
|
|
|
2004-12-06 22:18:14 -08:00
|
|
|
val sub_format :
|
|
|
|
(string -> int) -> (string -> int -> char -> int) ->
|
|
|
|
char -> string -> int -> int
|
|
|
|
val summarize_format_type : string -> string
|