diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/format.ml | 168 | ||||
| -rw-r--r-- | stdlib/format.mli | 45 |
2 files changed, 201 insertions, 12 deletions
diff --git a/stdlib/format.ml b/stdlib/format.ml index 8302fbde0..dd949761e 100644 --- a/stdlib/format.ml +++ b/stdlib/format.ml @@ -358,7 +358,7 @@ let scan_push state b tok = the user may set the depth bound pp_max_boxes any text nested deeper is printed as the character the ellipsis *) -let pp_open_box state indent br_ty = +let pp_open_box_gen state indent br_ty = state.pp_curr_depth <- state.pp_curr_depth + 1; if state.pp_curr_depth < state.pp_max_boxes then (scan_push state false @@ -383,7 +383,7 @@ let pp_close_box state () = pp_enqueue state {elem_size = 0; token = Pp_end; length = 0}; set_size state true; set_size state false end; - state.pp_curr_depth <- state.pp_curr_depth - 1 + state.pp_curr_depth <- state.pp_curr_depth - 1; end;; (* Initialize pretty-printer. *) @@ -434,12 +434,12 @@ let pp_print_char state c = let s = String.create 1 in s.[0] <- c; pp_print_as state 1 s;; (* Opening boxes *) -let pp_open_hbox state () = pp_open_box state 0 Pp_hbox -and pp_open_vbox state indent = pp_open_box state indent Pp_vbox +let pp_open_hbox state () = pp_open_box_gen state 0 Pp_hbox +and pp_open_vbox state indent = pp_open_box_gen state indent Pp_vbox -and pp_open_hvbox state indent = pp_open_box state indent Pp_hvbox -and pp_open_hovbox state indent = pp_open_box state indent Pp_hovbox -and pp_open_box state indent = pp_open_box state indent Pp_box;; +and pp_open_hvbox state indent = pp_open_box_gen state indent Pp_hvbox +and pp_open_hovbox state indent = pp_open_box_gen state indent Pp_hovbox +and pp_open_box state indent = pp_open_box_gen state indent Pp_box;; (* Print a new line after printing all queued text (same for print_flush but without a newline) *) @@ -626,5 +626,159 @@ and set_formatter_output_functions = and get_formatter_output_functions = pp_get_formatter_output_functions std_formatter;; +external format_int: string -> int -> string = "format_int" +external format_float: string -> float -> string = "format_float" + +let fprintf ppf format = + let format = (Obj.magic format : string) in + let limit = String.length format in + + let rec doprn i = + if i >= limit then + Obj.magic () + else + match format.[i] with + | '@' -> + let j = succ i in + if j >= limit then invalid_arg ("fprintf: unknown format") else + begin match format.[j] with + | '@' -> + pp_print_char ppf '@'; + doprn (succ j) + | '[' -> + let j = do_pp_open ppf (i + 2) in + doprn j + | ']' -> + pp_close_box ppf (); + doprn (succ j) + | ' ' -> + pp_print_space ppf (); + doprn (succ j) + | ',' -> + pp_print_cut ppf (); + doprn (succ j) + | '.' -> + pp_print_newline ppf (); + doprn (succ j) + | ';' -> + pp_force_newline ppf (); + doprn (succ j) + | _ -> invalid_arg ("fprintf: unknown format") end + | '%' -> + let j = skip_args (succ i) in + begin match format.[j] with + | '%' -> + pp_print_char ppf '%'; + doprn (succ j) + | 's' -> + Obj.magic(fun s -> + if j <= i+1 then + pp_print_string ppf s + else begin + let p = + try + int_of_string (String.sub format (i+1) (j-i-1)) + with _ -> + invalid_arg "fprintf: bad %s format" in + if p > 0 && String.length s < p then begin + pp_print_string ppf + (String.make (p - String.length s) ' '); + pp_print_string ppf s + end else if p < 0 && String.length s < -p then begin + pp_print_string ppf s; + pp_print_string ppf + (String.make (-p - String.length s) ' ') + end else + pp_print_string ppf s + end; + doprn (succ j)) + | 'c' -> + Obj.magic(fun c -> + pp_print_char ppf c; + doprn (succ j)) + | 'd' | 'o' | 'x' | 'X' | 'u' -> + Obj.magic(fun n -> + pp_print_string ppf + (format_int (String.sub format i (j-i+1)) n); + doprn (succ j)) + | 'f' | 'e' | 'E' | 'g' | 'G' -> + Obj.magic(fun f -> + pp_print_string ppf + (format_float (String.sub format i (j-i+1)) f); + doprn (succ j)) + | 'b' -> + Obj.magic(fun b -> + pp_print_string ppf (string_of_bool b); + doprn(succ j)) + | 'a' -> + Obj.magic(fun printer arg -> + printer ppf arg; + doprn(succ j)) + | 't' -> + Obj.magic(fun printer -> + printer ppf; + doprn(succ j)) + | c -> + invalid_arg ("fprintf: unknown format") + end + | c -> pp_print_char ppf c; doprn (succ i) + + and skip_args j = + match format.[j] with + | '0' .. '9' | ' ' | '.' | '-' -> skip_args (succ j) + | c -> j + + and get_box_size i = + match format.[i] with + | ' ' -> get_box_size (i + 1) + | c -> + let rec get_size j = + match format.[j] with + | '0' .. '9' | '-' -> get_size (succ j) + | '>' -> + if j = i then 0, succ j else + begin try int_of_string (String.sub format i (j-i)), succ j + with Failure _ -> invalid_arg "fprintf: bad box format" end + | c -> invalid_arg "fprintf: bad box format" in + get_size i + + and get_box_kind j = + if j >= limit then Pp_box, j else + match format.[j] with + | 'h' -> + let j = succ j in + if j >= limit then Pp_hbox, j else + begin match format.[j] with + | 'o' -> + let j = succ j in + if j >= limit + then invalid_arg "fprintf: bad box format" else + begin match format.[j] with + | 'v' -> Pp_hovbox, succ j + | _ -> invalid_arg "fprintf: bad box format" end + | 'v' -> Pp_hvbox, succ j + | c -> Pp_hbox, j + end + | 'b' -> Pp_box, succ j + | 'v' -> Pp_vbox, succ j + | _ -> Pp_box, j + + and do_pp_open ppf i = + if i >= limit + then begin pp_open_box_gen ppf 0 Pp_box; i end else + match format.[i] with + | '<' -> + let k,j = get_box_kind (succ i) in + let size,j = get_box_size j in + pp_open_box_gen ppf size k; + j + | c -> pp_open_box_gen ppf 0 Pp_box; i + + in doprn 0 +;; + +let printf f = fprintf std_formatter f;; +let eprintf f = fprintf err_formatter f;; + let _ = at_exit print_flush;; diff --git a/stdlib/format.mli b/stdlib/format.mli index d49da5c22..80c3708a5 100644 --- a/stdlib/format.mli +++ b/stdlib/format.mli @@ -19,17 +19,22 @@ structure. *) (* Rule of thumb for casual users: - use simple boxes (as obtained by [open_box 0]); - use simple break hints (as obtained by [print_cut ()] that outputs a +- use simple boxes (as obtained by [open_box 0]); +- use simple break hints (as obtained by [print_cut ()] that outputs a simple break hint, or by [print_space ()] that ouputs a space indicating a break hint); - once a box is opened, display its material with basic printing +- once a box is opened, display its material with basic printing functions (e. g. [print_int] and [print_string]); - when the material for a box has been printed, call [close_box ()] to +- when the material for a box has been printed, call [close_box ()] to close the box; - at the end of your routine, evaluate [print_newline ()] to close +- at the end of your routine, evaluate [print_newline ()] to close all remaining boxes and flush the pretty-printer. *) +(* You may alternatively consider this module as providing an extension to the + [printf] facility: you can simply add pretty-printing annotations to your + regular printf formats, as explained below in the documentation of + the function [fprintf]. *) + (* The behaviour of pretty-printing commands is unspecified if there is no opened pretty-printing box. Each box opened via one of the [open_] functions below must be closed using [close_box] @@ -291,3 +296,33 @@ val pp_get_formatter_output_functions : operating on the standard formatter are defined via partial evaluation of these primitives. For instance, [print_string] is equal to [pp_print_string std_formatter]. *) + +val fprintf : formatter -> ('a, formatter, unit) format -> 'a;; + (* [fprintf ff format arg1 ... argN] formats the arguments + [arg1] to [argN] according to the format string [format], + and outputs the resulting string on the formatter [ff]. + The format is a character string which contains three types of + objects: plain characters and conversion specifications as + specified in the [printf] module, and pretty-printing + indications. + The pretty-printing indication characters are introduced by + a [@] character, and their meanings are: +- [\[]: open a pretty-printing box. The type and offset of the + box may be optionally specified with the following syntax: + the [<] character, followed by an optional box type indication, + then an optional integer offset, and the closing [>] character. + Box type is one of [h], [v], [hv], or [hov], + which stand respectively for an horizontal, vertical, + ``horizontal-vertical'' and ``horizontal or vertical'' box. +- [\]]: close the most recently opened pretty-printing box. +- [,]: output a good break as with [print_cut ()]. +- [ ]: output a space, as with [print_space ()]. +- [;]: force a newline, as with [force_newline ()]. +- [.]: flush the pretty printer as with [print_newline ()]. +- [@]: a plain [@] character. *) + +val printf : ('a, formatter, unit) format -> 'a;; + (* Same as [fprintf], but output on [std_formatter]. *) +val eprintf: ('a, formatter, unit) format -> 'a;; + (* Same as [fprintf], but output on [err_formatter]. *) + |