diff options
Diffstat (limited to 'stdlib/format.ml')
| -rw-r--r-- | stdlib/format.ml | 168 |
1 files changed, 161 insertions, 7 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;; |