diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/format.ml | 15 | ||||
| -rw-r--r-- | stdlib/printf.ml | 43 | ||||
| -rw-r--r-- | stdlib/printf.mli | 2 |
3 files changed, 23 insertions, 37 deletions
diff --git a/stdlib/format.ml b/stdlib/format.ml index 4e1b86485..eab4f575e 100644 --- a/stdlib/format.ml +++ b/stdlib/format.ml @@ -938,7 +938,7 @@ let fprintf_out str out ppf format = else match format.[i] with | '%' -> - Printf.scan_format format i cont_s cont_a cont_t + Printf.scan_format format i cont_s cont_a cont_t cont_f | '@' -> let i = succ i in if i >= limit then invalid_format format i else @@ -998,6 +998,8 @@ let fprintf_out str out ppf format = else printer ppf; doprn i + and cont_f i = + pp_print_flush ppf (); doprn i and get_int i c = if i >= limit then invalid_integer format i else @@ -1006,8 +1008,9 @@ let fprintf_out str out ppf format = | '%' -> let cont_s s i = c (format_int_of_string format i s) i and cont_a printer arg i = invalid_integer format i - and cont_t printer i = invalid_integer format i in - Printf.scan_format format i cont_s cont_a cont_t + and cont_t printer i = invalid_integer format i + and cont_f i = invalid_integer format i in + Printf.scan_format format i cont_s cont_a cont_t cont_f | _ -> let rec get j = if j >= limit then invalid_integer format j else @@ -1064,8 +1067,10 @@ let fprintf_out str out ppf format = let s = if str then (Obj.magic printer) () else exstring (fun ppf () -> printer ppf) () in - get (s :: s0 :: accu) i i in - Printf.scan_format format j cont_s cont_a cont_t + get (s :: s0 :: accu) i i + and cont_f i = + format_invalid_arg "bad tag name specification" format i in + Printf.scan_format format j cont_s cont_a cont_t cont_f | c -> get accu i (succ j) in get [] i i diff --git a/stdlib/printf.ml b/stdlib/printf.ml index e0f99ef7a..c8c336203 100644 --- a/stdlib/printf.ml +++ b/stdlib/printf.ml @@ -35,7 +35,7 @@ let parse_format format = parse true (succ i) | _ -> parse neg (succ i) in - try parse false 1 with Failure _ -> bad_format format 0 + try parse false 1 with Failure _ -> bad_format format 0 (* Pad a (sub) string into a blank string of length [p], on the right if [neg] is true, on the left otherwise. *) @@ -54,31 +54,6 @@ let format_string format s = let (p, neg) = parse_format format in pad_string ' ' p neg s 0 (String.length s) -(* Format a string given a %s format, e.g. %40s or %-20s. - To do: ignore other flags (#, +, etc)? *) - -let format_string format s = - let rec parse_format neg i = - if i >= String.length format then (0, neg) else - match String.unsafe_get format i with - | '1'..'9' -> - (int_of_string (String.sub format i (String.length format - i - 1)), - neg) - | '-' -> - parse_format true (succ i) - | _ -> - parse_format neg (succ i) in - let (p, neg) = - try parse_format false 1 with Failure _ -> bad_format format 0 in - if String.length s < p then begin - let res = String.make p ' ' in - if neg - then String.blit s 0 res 0 (String.length s) - else String.blit s 0 res (p - String.length s) (String.length s); - res - end else - s - (* Format a [%b] format: write a binary representation of an integer. *) let format_binary_int format n = let sharp = String.contains format '#' in @@ -97,7 +72,7 @@ let format_binary_int format n = match String.unsafe_get format i with | '0' -> '0' | '1' .. '9' -> ' ' - | _ -> find_pad_char (i + 1) len in + | _ -> find_pad_char (i + 1) len in let add_sharp s i = String.unsafe_set s i '0'; String.unsafe_set s (i + 1) 'b' in @@ -161,7 +136,7 @@ let format_int_with_conv conv fmt i = caught by the [_ -> bad_format] clauses below. Don't do this at home, kids. *) -let scan_format fmt pos cont_s cont_a cont_t = +let scan_format fmt pos cont_s cont_a cont_t cont_f = let rec scan_flags widths i = match String.unsafe_get fmt i with | '*' -> @@ -237,6 +212,8 @@ let scan_format fmt pos cont_s cont_a cont_t = | _ -> bad_format fmt pos end + | '$' -> + Obj.magic (cont_f (succ i)) | _ -> bad_format fmt pos in scan_flags [] (pos + 1) @@ -249,7 +226,7 @@ let fprintf chan fmt = let rec doprn i = if i >= len then Obj.magic () else match String.unsafe_get fmt i with - | '%' -> scan_format fmt i cont_s cont_a cont_t + | '%' -> scan_format fmt i cont_s cont_a cont_t cont_f | c -> output_char chan c; doprn (succ i) and cont_s s i = output_string chan s; doprn i @@ -257,6 +234,8 @@ let fprintf chan fmt = printer chan arg; doprn i and cont_t printer i = printer chan; doprn i + and cont_f i = + flush chan; doprn i in doprn 0 let printf fmt = fprintf stdout fmt @@ -273,7 +252,7 @@ let kprintf kont fmt = Obj.magic (kont res) end else match String.unsafe_get fmt i with - | '%' -> scan_format fmt i cont_s cont_a cont_t + | '%' -> scan_format fmt i cont_s cont_a cont_t cont_f | c -> Buffer.add_char dest c; doprn (succ i) and cont_s s i = Buffer.add_string dest s; doprn i @@ -281,6 +260,7 @@ let kprintf kont fmt = Buffer.add_string dest (printer () arg); doprn i and cont_t printer i = Buffer.add_string dest (printer ()); doprn i + and cont_f i = doprn i in doprn 0 let sprintf fmt = kprintf (fun x -> x) fmt;; @@ -291,7 +271,7 @@ let bprintf dest fmt = let rec doprn i = if i >= len then Obj.magic () else match String.unsafe_get fmt i with - | '%' -> scan_format fmt i cont_s cont_a cont_t + | '%' -> scan_format fmt i cont_s cont_a cont_t cont_f | c -> Buffer.add_char dest c; doprn (succ i) and cont_s s i = Buffer.add_string dest s; doprn i @@ -299,6 +279,7 @@ let bprintf dest fmt = printer dest arg; doprn i and cont_t printer i = printer dest; doprn i + and cont_f i = doprn i in doprn 0 diff --git a/stdlib/printf.mli b/stdlib/printf.mli index fac8a9fa5..1a19081fd 100644 --- a/stdlib/printf.mli +++ b/stdlib/printf.mli @@ -119,4 +119,4 @@ val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format -> 'b val scan_format : string -> int -> (string -> int -> 'a) -> ('b -> 'c -> int -> 'a) -> - ('e -> int -> 'a) -> 'a + ('e -> int -> 'a) -> (int -> 'a) -> 'a |