Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Code review before adding new typing of format string. 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7396 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Pierre Weis 2006-05-04 12:52:22 +00:00
parent a8ac504984
commit cf0590146f
4 changed files with 113 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
stdlib/format.ml
View File

@ -965,15 +965,18 @@ let implode_rev s0 = function
| [] -> s0
| l -> String.concat "" (List.rev (s0 :: l));;
(* [fprintf_out] is the printf-like function generator: given the
(* [mkprintf] is the printf-like function generator: given the
- [to_s] flag that tells if we are printing into a string,
- the [get_out] function that has to be called at the end of formatting,
it generates a [fprintf] function that takes as arguments a [ppf]
formatter and a printing format to print the rest of arguments
according to the format.
- the [get_out] function that has to be called to get a [ppf] function to
output onto.
It generates a [kprintf] function that takes as arguments a [k]
continuation function to be called at the end of formatting,
and a printing format string to print the rest of the arguments
according to the format string.
Regular [fprintf]-like functions of this module are obtained via partial
applications of [fprintf_out]. *)
applications of [mkprintf]. *)
let mkprintf to_s get_out =
let rec kprintf k fmt =
let len = Sformat.length fmt in

93
stdlib/printf.ml
View File

@ -61,7 +61,7 @@ let incomplete_format fmt =
Sformat.to_string fmt ^ "''");;
(* Parses a format to return the specified length and the padding direction. *)
let parse_format sfmt =
let parse_string_format sfmt =
let rec parse neg i =
if i >= String.length sfmt then (0, neg) else
match String.unsafe_get sfmt i with
@ -89,7 +89,7 @@ let pad_string pad_char p neg s i len =
(* Format a string given a %s format, e.g. %40s or %-20s.
To do: ignore other flags (#, +, etc)? *)
let format_string sfmt s =
let (p, neg) = parse_format sfmt in
let (p, neg) = parse_string_format sfmt in
pad_string ' ' p neg s 0 (String.length s);;
(* Extract a format string out of [fmt] between [start] and [stop] inclusive.
@ -127,7 +127,7 @@ let extract_format_int conv fmt start stop widths =
let sfmt = extract_format fmt start stop widths in
match conv with
| 'n' | 'N' ->
sfmt. [String.length sfmt - 1] <- 'u';
sfmt.[String.length sfmt - 1] <- 'u';
sfmt
| _ -> sfmt;;
@ -181,17 +181,17 @@ let iter_on_format_args fmt add_conv add_char =
| '%' | '!' -> succ i
| 's' | 'S' | '[' -> add_conv skip i 's'
| 'c' | 'C' -> add_conv skip i 'c'
| 'd' | 'i' | 'o' | 'x' | 'X' | 'u' | 'N' -> add_conv skip i 'i'
| 'd' | 'i' |'o' | 'u' | 'x' | 'X' | 'N' -> add_conv skip i 'i'
| 'f' | 'e' | 'E' | 'g' | 'G' | 'F' -> add_conv skip i 'f'
| 'B' | 'b' -> add_conv skip i 'B'
| 'a' | 't' as conv -> add_conv skip i conv
| 'l' | 'n' | 'L' as conv ->
let j = succ i in
if j > lim then add_conv skip i 'i' else begin
match Sformat.get fmt j with
| 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
add_char (add_conv skip i conv) 'i'
| c -> add_conv skip i 'i' end
let j = succ i in
if j > lim then add_conv skip i 'i' else begin
match Sformat.get fmt j with
| 'd' | 'i' | 'o' | 'u' | 'x' | 'X' ->
add_char (add_conv skip i conv) 'i'
| c -> add_conv skip i 'i' end
| '{' as conv ->
(* Just get a regular argument, skipping the specification. *)
let i = add_conv skip i conv in
@ -220,8 +220,8 @@ let iter_on_format_args fmt add_conv add_char =
(* Returns a string that summarizes the typing information that a given
format string contains.
It also checks the well-formedness of the format string.
For instance, [summarize_format_type "A number %d\n"] is "%i". *)
For instance, [summarize_format_type "A number %d\n"] is "%i".
It also checks the well-formedness of the format string. *)
let summarize_format_type fmt =
let len = Sformat.length fmt in
let b = Buffer.create len in
@ -296,14 +296,15 @@ let kapr kpr fmt =
else Obj.magic (fun x -> loop (succ i) (x :: args)) in
loop 0 [];;
type param_spec = Spec_none | Spec_index of index;;
type positional_specification =
| Spec_none | Spec_index of index;;
(* To scan an optional positional parameter specification,
i.e. an integer followed by a $.
We do not support *$ specifications, since this would lead to type checking
problems: the type would be dependant of the {\em value} of an integer
argument to printf. *)
let scan_positional_spec fmt got_pos n i =
let scan_positional_spec fmt got_spec n i =
match Sformat.unsafe_get fmt i with
| '0'..'9' as d ->
let rec get_int_litteral accu j =
@ -313,12 +314,12 @@ let scan_positional_spec fmt got_pos n i =
| '$' ->
if accu = 0
then failwith "printf: bad positional specification (0)." else
got_pos (Spec_index (index_of_litteral_position accu)) (succ j)
got_spec (Spec_index (index_of_litteral_position accu)) (succ j)
(* Not a positional specification. *)
| _ -> got_pos Spec_none i in
| _ -> got_spec Spec_none i in
get_int_litteral (int_of_char d - 48) (succ i)
(* No positional specification. *)
| _ -> got_pos Spec_none i;;
| _ -> got_spec Spec_none i;;
(* Get the position of the next argument to printf, according to the given
positional specification. *)
@ -338,13 +339,15 @@ let get_index spec n =
[fmt] is the printf format string, and [pos] points to a [%] character.
After consuming the appropriate number of arguments and formatting
them, one of the five continuations is called:
[cont_s] for outputting a string (args: string, next pos)
[cont_a] for performing a %a action (args: fn, arg, next pos)
[cont_t] for performing a %t action (args: fn, next pos)
[cont_f] for performing a flush action
[cont_m] for performing a %( action (args: sfmt, next pos)
[cont_s] for outputting a string (args: arg num, string, next pos)
[cont_a] for performing a %a action (args: arg num, fn, arg, next pos)
[cont_t] for performing a %t action (args: arg num, fn, next pos)
[cont_f] for performing a flush action (args: arg num, next pos)
[cont_m] for performing a %( action (args: arg num, sfmt, next pos)
"arg num" is the index in array args of the next argument to printf.
"next pos" is the position in [fmt] of the first character following
the %format in [fmt]. *)
the %conversion specification in [fmt]. *)
(* Note: here, rather than test explicitly against [Sformat.length fmt]
to detect the end of the format, we use [Sformat.unsafe_get] and
@ -354,19 +357,19 @@ let get_index spec n =
Don't do this at home, kids. *)
let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
let get_arg spec n = Obj.magic args.(int_of_index (get_index spec n)) in
let get_arg spec n = Obj.magic (args.(int_of_index (get_index spec n))) in
let rec scan_positional n widths i =
let got_pos spec i = scan_flags spec n widths i in
scan_positional_spec fmt got_pos n i
let got_spec spec i = scan_flags spec n widths i in
scan_positional_spec fmt got_spec n i
and scan_flags spec n widths i =
match Sformat.unsafe_get fmt i with
| '*' ->
let got_pos wspec i =
let got_spec wspec i =
let (width : int) = get_arg wspec n in
scan_flags spec (next_index wspec n) (width :: widths) i in
scan_positional_spec fmt got_pos n (succ i)
scan_positional_spec fmt got_spec n (succ i)
| '0'..'9'
| '.' | '#' | '-' | ' ' | '+' -> scan_flags spec n widths (succ i)
| _ -> scan_conv spec n widths i
@ -388,17 +391,18 @@ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
let s =
if conv = 'c' then String.make 1 x else "'" ^ Char.escaped x ^ "'" in
cont_s (next_index spec n) s (succ i)
| 'd' | 'i' | 'o' | 'x' | 'X' | 'u' | 'N' as conv ->
| 'd' | 'i' | 'o' | 'u' | 'x' | 'X' | 'N' as conv ->
let (x : int) = get_arg spec n in
let s =
format_int (extract_format_int conv fmt pos i widths) x in
cont_s (next_index spec n) s (succ i)
| 'f' | 'e' | 'E' | 'g' | 'G' | 'F' as conv ->
| 'f' | 'e' | 'E' | 'g' | 'G' ->
let (x : float) = get_arg spec n in
let s =
if conv = 'F' then string_of_float x else
format_float (extract_format fmt pos i widths) x in
let s = format_float (extract_format fmt pos i widths) x in
cont_s (next_index spec n) s (succ i)
| 'F' ->
let (x : float) = get_arg spec n in
cont_s (next_index spec n) (string_of_float x) (succ i)
| 'B' | 'b' ->
let (x : bool) = get_arg spec n in
cont_s (next_index spec n) (string_of_bool x) (succ i)
@ -415,19 +419,20 @@ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
cont_t (next_index spec n) printer (succ i)
| 'l' | 'n' | 'L' as conv ->
begin match Sformat.unsafe_get fmt (succ i) with
| 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
| 'd' | 'i' | 'o' | 'u' | 'x' | 'X' ->
let i = succ i in
let s =
match conv with
| 'l' ->
let (x : int32) = get_arg spec n in
format_int32 (extract_format fmt pos (succ i) widths) x
format_int32 (extract_format fmt pos i widths) x
| 'n' ->
let (x : nativeint) = get_arg spec n in
format_nativeint (extract_format fmt pos (succ i) widths) x
format_nativeint (extract_format fmt pos i widths) x
| _ ->
let (x : int64) = get_arg spec n in
format_int64 (extract_format fmt pos (succ i) widths) x in
cont_s (next_index spec n) s (i + 2)
format_int64 (extract_format fmt pos i widths) x in
cont_s (next_index spec n) s (succ i)
| _ ->
let (x : int) = get_arg spec n in
let s = format_int (extract_format_int 'n' fmt pos i widths) x in
@ -495,14 +500,14 @@ let mkprintf to_s get_out outc outs flush k fmt =
kapr kpr fmt;;
let kfprintf k oc =
mkprintf false (fun _ -> oc) output_char output_string flush k
let fprintf oc = kfprintf ignore oc
let printf fmt = fprintf stdout fmt
let eprintf fmt = fprintf stderr fmt
mkprintf false (fun _ -> oc) output_char output_string flush k;;
let fprintf oc = kfprintf ignore oc;;
let printf fmt = fprintf stdout fmt;;
let eprintf fmt = fprintf stderr fmt;;
let kbprintf k b =
mkprintf false (fun _ -> b) Buffer.add_char Buffer.add_string ignore k
let bprintf b = kbprintf ignore b
mkprintf false (fun _ -> b) Buffer.add_char Buffer.add_string ignore k;;
let bprintf b = kbprintf ignore b;;
let get_buff fmt =
let len = 2 * Sformat.length fmt in

6
stdlib/printf.mli
View File

@ -123,6 +123,7 @@ val bprintf : Buffer.t -> ('a, Buffer.t, unit) format -> 'a
append the formatted arguments to the given extensible buffer
(see module {!Buffer}). *)
(** Formatted output functions with continuations. *)
val kfprintf : (out_channel -> 'a) -> out_channel ->
('b, out_channel, unit, 'a) format4 -> 'b;;
(** Same as [fprintf], but instead of returning immediately,
@ -132,6 +133,11 @@ val ksprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;;
(** Same as [sprintf] above, but instead of returning the string,
passes it to the first argument. *)
val kbprintf : (Buffer.t -> 'a) -> Buffer.t ->
('b, Buffer.t, unit, 'a) format4 -> 'b;;
(** Same as [bprintf], but instead of returning immediately,
passes the buffer to its first argument at the end of printing. *)
val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;;
(** A deprecated synonym for [ksprintf]. *)

97
stdlib/scanf.ml
View File

@ -133,8 +133,8 @@ let next_char ib =
let c = ib.get_next_char () in
ib.current_char <- c;
ib.current_char_is_valid <- true;
ib.char_count <- ib.char_count + 1;
if c == '\n' then ib.line_count <- ib.line_count + 1;
ib.char_count <- succ ib.char_count;
if c == '\n' then ib.line_count <- succ ib.line_count;
c with
| End_of_file ->
let c = null_char in
@ -173,7 +173,7 @@ let token ib =
let tokbuf = ib.tokbuf in
let tok = Buffer.contents tokbuf in
Buffer.clear tokbuf;
ib.token_count <- ib.token_count + 1;
ib.token_count <- succ ib.token_count;
tok;;
let token_count ib = ib.token_count;;
@ -709,18 +709,18 @@ let read_char_set fmt i =
if j > lim then incomplete_format fmt else
match Sformat.get fmt j with
| ']' -> j
| c -> find_in_set (j + 1)
| c -> find_in_set (succ j)
and find_set i =
if i > lim then incomplete_format fmt else
match Sformat.get fmt i with
| ']' -> find_in_set (i + 1)
| ']' -> find_in_set (succ i)
| c -> find_in_set i in
if i > lim then incomplete_format fmt else
match Sformat.get fmt i with
| '^' ->
let i = i + 1 in
let i = succ i in
let j = find_set i in
j, Neg_set (Sformat.sub fmt i (j - i))
| _ ->
@ -774,15 +774,15 @@ let make_char_bit_vect bit set =
(* if i = 0 then rp is false (since the initial call is
loop bit false 0). Hence i >= 1 and the following is safe. *)
let c1 = set.[i - 1] in
let i = i + 1 in
let i = succ i in
if i > lim then loop bit false (i - 1) else
let c2 = set.[i] in
for j = int_of_char c1 to int_of_char c2 do
set_bit_of_range r j bit done;
loop bit false (i + 1)
loop bit false (succ i)
| c ->
set_bit_of_range r (int_of_char set.[i]) bit;
loop bit true (i + 1) in
loop bit true (succ i) in
loop bit false 0;
r;;
@ -960,56 +960,58 @@ let kscanf ib ef fmt f =
let rec scan_fmt f i =
if i > lim then f else
match Sformat.get fmt i with
| ' ' -> skip_whites ib; scan_fmt f (i + 1)
| ' ' -> skip_whites ib; scan_fmt f (succ i)
| '%' ->
if i > lim then incomplete_format fmt else
scan_conversion false max_int f (i + 1)
scan_conversion false max_int f (succ i)
| '@' ->
let i = i + 1 in
let i = succ i in
if i > lim then incomplete_format fmt else begin
check_char ib (Sformat.get fmt i);
scan_fmt f (i + 1) end
| c -> check_char ib c; scan_fmt f (i + 1)
scan_fmt f (succ i) end
| c -> check_char ib c; scan_fmt f (succ i)
and scan_conversion skip max f i =
let stack = if skip then no_stack else stack in
match Sformat.get fmt i with
| '%' as conv ->
check_char ib conv; scan_fmt f (i + 1)
check_char ib conv; scan_fmt f (succ i)
| 's' ->
let i, stp = scan_fmt_stoppers (succ i) in
let _x = scan_string stp max ib in
scan_fmt (stack f (token_string ib)) (succ i)
| 'S' ->
let _x = scan_String max ib in
scan_fmt (stack f (token_string ib)) (succ i)
| '[' ->
let i, char_set = read_char_set fmt (succ i) in
let i, stp = scan_fmt_stoppers (succ i) in
let _x = scan_chars_in_char_set stp char_set max ib in
scan_fmt (stack f (token_string ib)) (succ i)
| 'c' when max = 0 ->
let c = Scanning.checked_peek_char ib in
scan_fmt (stack f c) (i + 1)
scan_fmt (stack f c) (succ i)
| 'c' | 'C' as conv ->
if max <> 1 && max <> max_int then bad_conversion fmt i conv else
let _x =
if conv = 'c' then scan_char max ib else scan_Char max ib in
scan_fmt (stack f (token_char ib)) (i + 1)
scan_fmt (stack f (token_char ib)) (succ i)
| 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv ->
let _x = scan_int_conv conv max ib in
scan_fmt (stack f (token_int conv ib)) (i + 1)
| 'f' | 'g' | 'G' | 'e' | 'E' ->
scan_fmt (stack f (token_int conv ib)) (succ i)
| 'N' as conv ->
scan_fmt (stack f (get_count conv ib)) (succ i)
| 'f' | 'e' | 'E' | 'g' | 'G' ->
let _x = scan_float max ib in
scan_fmt (stack f (token_float ib)) (i + 1)
scan_fmt (stack f (token_float ib)) (succ i)
| 'F' ->
let _x = scan_Float max ib in
scan_fmt (stack f (token_float ib)) (i + 1)
| 's' ->
let i, stp = scan_fmt_stoppers (i + 1) in
let _x = scan_string stp max ib in
scan_fmt (stack f (token_string ib)) (i + 1)
| '[' ->
let i, char_set = read_char_set fmt (i + 1) in
let i, stp = scan_fmt_stoppers (i + 1) in
let _x = scan_chars_in_char_set stp char_set max ib in
scan_fmt (stack f (token_string ib)) (i + 1)
| 'S' ->
let _x = scan_String max ib in
scan_fmt (stack f (token_string ib)) (i + 1)
scan_fmt (stack f (token_float ib)) (succ i)
| 'B' | 'b' ->
let _x = scan_bool max ib in
scan_fmt (stack f (token_bool ib)) (i + 1)
scan_fmt (stack f (token_bool ib)) (succ i)
| 'l' | 'n' | 'L' as conv ->
let i = i + 1 in
let i = succ i in
if i > lim then scan_fmt (stack f (get_count conv ib)) i else begin
match Sformat.get fmt i with
(* This is in fact an integer conversion (e.g. %ld, %ni, or %Lo). *)
@ -1019,38 +1021,37 @@ let kscanf ib ef fmt f =
(this character is either 'l', 'n' or 'L'), to find the
conversion to apply to the integer token read. *)
begin match Sformat.get fmt (i - 1) with
| 'l' -> scan_fmt (stack f (token_int32 conv ib)) (i + 1)
| 'n' -> scan_fmt (stack f (token_nativeint conv ib)) (i + 1)
| _ -> scan_fmt (stack f (token_int64 conv ib)) (i + 1) end
| 'l' -> scan_fmt (stack f (token_int32 conv ib)) (succ i)
| 'n' -> scan_fmt (stack f (token_nativeint conv ib)) (succ i)
| _ -> scan_fmt (stack f (token_int64 conv ib)) (succ i) end
(* This is not an integer conversion, but a regular %l, %n or %L. *)
| _ -> scan_fmt (stack f (get_count conv ib)) i end
| 'N' as conv ->
scan_fmt (stack f (get_count conv ib)) (i + 1)
| '!' ->
if Scanning.end_of_input ib then scan_fmt f (i + 1)
if Scanning.end_of_input ib then scan_fmt f (succ i)
else bad_input "end of input not found"
| '_' ->
if i > lim then incomplete_format fmt else
scan_conversion true max f (i + 1)
scan_conversion true max f (succ i)
| '0' .. '9' as conv ->
let rec read_width accu i =
if i > lim then accu, i else
match Sformat.get fmt i with
| '0' .. '9' as c ->
let accu = 10 * accu + int_value_of_char c in
read_width accu (i + 1)
read_width accu (succ i)
| _ -> accu, i in
let max, i = read_width (int_value_of_char conv) (i + 1) in
let max, i = read_width (int_value_of_char conv) (succ i) in
if i > lim then incomplete_format fmt else begin
match Sformat.get fmt i with
| '.' ->
let p, i = read_width 0 (i + 1) in
scan_conversion skip (max + p + 1) f i
let p, i = read_width 0 (succ i) in
scan_conversion skip (succ (max + p)) f i
| _ -> scan_conversion skip max f i end
| '(' | '{' as conv ->
let i = succ i in
let j =
Printf.sub_format incomplete_format bad_conversion conv fmt i + 1 in
Printf.sub_format
incomplete_format bad_conversion conv fmt (succ i) in
let mf = Sformat.sub fmt i (j - i - 2) in
let _x = scan_String max ib in
let rf = token_string ib in
@ -1064,7 +1065,7 @@ let kscanf ib ef fmt f =
and scan_fmt_stoppers i =
if i > lim then i - 1, [] else
match Sformat.get fmt i with
| '@' when i < lim -> let i = i + 1 in i, [Sformat.get fmt i]
| '@' when i < lim -> let i = succ i in i, [Sformat.get fmt i]
| '@' when i = lim -> incomplete_format fmt
| _ -> i - 1, [] in