summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/printf.ml22
-rw-r--r--stdlib/printf.mli2
-rw-r--r--stdlib/scanf.ml33
-rw-r--r--stdlib/scanf.mli6
-rw-r--r--typing/typecore.ml79
5 files changed, 83 insertions, 59 deletions
diff --git a/stdlib/printf.ml b/stdlib/printf.ml
index 4866dc8852..e0f99ef7ad 100644
--- a/stdlib/printf.ml
+++ b/stdlib/printf.ml
@@ -138,6 +138,12 @@ let extract_format fmt start stop widths =
Buffer.add_char b c; fill_format (succ i) w
in fill_format start (List.rev widths)
+let format_int_with_conv conv fmt i =
+ match conv with
+ | 'b' -> format_binary_int fmt i
+ | 'n' | 'N' -> fmt.[String.length fmt - 1] <- 'u'; format_int fmt i
+ | _ -> format_int fmt i
+
(* Decode a %format and act on it.
[fmt] is the printf format style, and [pos] points to a [%] character.
After consuming the appropriate number of arguments and formatting
@@ -178,13 +184,11 @@ let scan_format fmt pos cont_s cont_a cont_t =
if conv = 'c'
then cont_s (String.make 1 c) (succ i)
else cont_s ("'" ^ Char.escaped c ^ "'") (succ i))
- | 'b' | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' as conv ->
+ | 'b' | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' | 'N' as conv ->
Obj.magic(fun (n: int) ->
- cont_s (
- if conv = 'b'
- then format_binary_int (extract_format fmt pos i widths) n
- else format_int (extract_format fmt pos i widths) n)
- (succ i))
+ cont_s (format_int_with_conv conv
+ (extract_format fmt pos i widths) n)
+ (succ i))
| 'f' | 'e' | 'E' | 'g' | 'G' | 'F' as conv ->
Obj.magic(fun (f: float) ->
let s =
@@ -218,7 +222,11 @@ let scan_format fmt pos cont_s cont_a cont_t =
n)
(i + 2))
| _ ->
- bad_format fmt pos
+ Obj.magic(fun (n: int) ->
+ cont_s (format_int_with_conv 'n'
+ (extract_format fmt pos i widths)
+ n)
+ (succ i))
end
| 'L' ->
begin match String.unsafe_get fmt (succ i) with
diff --git a/stdlib/printf.mli b/stdlib/printf.mli
index 225fc105b1..fac8a9fa52 100644
--- a/stdlib/printf.mli
+++ b/stdlib/printf.mli
@@ -28,7 +28,7 @@ val fprintf : out_channel -> ('a, out_channel, unit, unit) format -> 'a
Conversion specifications consist in the [%] character, followed
by optional flags and field widths, followed by one or two conversion
character. The conversion characters and their meanings are:
- - [d] or [i]: convert an integer argument to signed decimal.
+ - [d], [i], [n], or [N]: convert an integer argument to signed decimal.
- [u]: convert an integer argument to unsigned decimal.
- [x]: convert an integer argument to unsigned hexadecimal,
using lowercase letters.
diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml
index 5b062dccc7..54610f9e04 100644
--- a/stdlib/scanf.ml
+++ b/stdlib/scanf.ml
@@ -65,6 +65,10 @@ val end_of_input : scanbuf -> bool;;
(** [Scanning.end_of_input scanbuf] tests the end of input condition
of the given buffer. *)
+val begin_of_input : scanbuf -> bool;;
+(** [Scanning.begin_of_input scanbuf] tests the begin of input condition
+ of the given buffer. *)
+
val from_string : string -> scanbuf;;
val from_channel : in_channel -> scanbuf;;
val from_function : (unit -> char) -> scanbuf;;
@@ -110,6 +114,7 @@ let cautious_peek_char ib =
let peek_char ib = ib.cur_char;;
let end_of_input ib = ib.eof;;
+let begin_of_input ib = ib.bof;;
let char_count ib = ib.char_count;;
let reset_token ib = Buffer.reset ib.tokbuf;;
@@ -134,7 +139,7 @@ let create next =
cur_char = '\000';
char_count = 0;
get_next_char = next;
- tokbuf = Buffer.create 10;
+ tokbuf = Buffer.create 1024;
token_count = 0;
} in
ib;;
@@ -182,15 +187,14 @@ let bad_format fmt i fc =
(* Checking that the current char is indeed one of range, then skip it. *)
let check_char_in ib range =
let ci = Scanning.checked_peek_char ib in
- if List.mem ci range then Scanning.next_char ib
- else bad_input
- (Printf.sprintf "looking for one of %s, found %c" "a range" ci);;
+ if List.mem ci range then Scanning.next_char ib else
+ bad_input (Printf.sprintf "looking for one of %s, found %c" "a range" ci);;
(* Checking that [c] is indeed in the input, then skip it. *)
let check_char ib c =
let ci = Scanning.checked_peek_char ib in
- if ci = c then Scanning.next_char ib
- else bad_input (Printf.sprintf "looking for %c, found %c" c ci);;
+ if ci = c then Scanning.next_char ib else
+ bad_input (Printf.sprintf "looking for %c, found %c" c ci);;
(* Extracting tokens from ouput token buffer. *)
@@ -371,8 +375,7 @@ let scan_string stp max ib =
loop (Scanning.store_char ib c max) in
let max = loop max in
if stp <> [] then check_char_in ib stp;
- max
-;;
+ max;;
(* Scan a char: peek strictly one character in the input, whatsoever. *)
let scan_char max ib =
@@ -623,19 +626,25 @@ let kscanf ib ef fmt f =
| 'B' ->
let x = scan_bool max ib in
scan_fmt (stack f (token_bool ib)) (i + 1)
+ | 'n' when i = lim ->
+ let x = Scanning.char_count ib in
+ scan_fmt (stack f x) (i + 1)
| 'l' | 'n' | 'L' as t ->
let i = i + 1 in
- if i > lim then bad_format fmt (i - 1) t else begin
- match fmt.[i] with
+ if i > lim then bad_format fmt (i - 1) t else
+ begin match fmt.[i] with
| 'b' | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv ->
let x = scan_int conv max ib in
begin match t with
| 'l' -> scan_fmt (stack f (token_int32 conv ib)) (i + 1)
| 'L' -> scan_fmt (stack f (token_int64 conv ib)) (i + 1)
| _ -> scan_fmt (stack f (token_nativeint conv ib)) (i + 1) end
- | c -> bad_format fmt i c end
+ | c ->
+ let x = Scanning.char_count ib in
+ scan_fmt (stack f x) i
+ end
| 'N' ->
- let x = Scanning.char_count ib in
+ let x = Scanning.token_count ib in
scan_fmt (stack f x) (i + 1)
| 'r' ->
Obj.magic (fun reader arg ->
diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli
index 101b8e1de1..4d740dd55b 100644
--- a/stdlib/scanf.mli
+++ b/stdlib/scanf.mli
@@ -45,6 +45,9 @@ val from_function : (unit -> char) -> scanbuf;;
val end_of_input : scanbuf -> bool;;
(** [Scanning.end_of_input scanbuf] tests the end of input condition
of the given buffer. *)
+val begin_of_input : scanbuf -> bool;;
+(** [Scanning.begin_of_input scanbuf] tests the begin of input condition
+ of the given buffer. *)
end;;
@@ -114,7 +117,8 @@ val bscanf :
first character of the range (or just after the [^] in case of
range negation); hence [\[\]\]] matches a [\]] character and
[\[^\]\]] matches any character that is not [\]].
- - [N]: applies [f] to the number of characters read so far.
+ - [n]: applies [f] to the number of characters read so far.
+ - [N]: applies [f] to the number of tokens read so far.
- [%]: matches one [%] character in the input.
The field widths are composed of an optional integer literal
diff --git a/typing/typecore.ml b/typing/typecore.ml
index d6db977f2b..f6411f6012 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -574,7 +574,7 @@ let type_format loc fmt =
let incomplete i =
raise (Error (loc, Bad_format (String.sub fmt i (len - i)))) in
let rec scan_format i =
- if i >= len then ty_result else
+ if i >= len then ty_aresult, ty_result else
match fmt.[i] with
| '%' -> scan_flags i (i+1)
| _ -> scan_format (i+1)
@@ -586,7 +586,9 @@ let type_format loc fmt =
and scan_width i j =
if j >= len then incomplete i else
match fmt.[j] with
- | '*' -> ty_arrow Predef.type_int (scan_dot i (j+1))
+ | '*' ->
+ let ty_aresult, ty_result = scan_dot i (j+1) in
+ ty_aresult, ty_arrow Predef.type_int ty_result
| '.' -> scan_precision i (j+1)
| _ -> scan_fixed_width i j
and scan_fixed_width i j =
@@ -603,63 +605,64 @@ let type_format loc fmt =
and scan_precision i j =
if j >= len then incomplete i else
match fmt.[j] with
- | '*' -> ty_arrow Predef.type_int (scan_conversion i (j+1))
+ | '*' ->
+ let ty_aresult, ty_result = scan_conversion i (j+1) in
+ ty_aresult, ty_arrow Predef.type_int ty_result
| _ -> scan_fixed_precision i j
and scan_fixed_precision i j =
if j >= len then incomplete i else
match fmt.[j] with
| '0' .. '9' | '-' | '+' -> scan_fixed_precision i (j+1)
| _ -> scan_conversion i j
+
+ and conversion j ty_arg =
+ let ty_aresult, ty_result = scan_format (j+1) in
+ ty_aresult, ty_arrow ty_arg ty_result
+
and scan_conversion i j =
if j >= len then incomplete i else
match fmt.[j] with
| '%' -> scan_format (j+1)
- | 's' | 'S' | '[' ->
- ty_arrow Predef.type_string (scan_format (j+1))
- | 'c' | 'C' ->
- ty_arrow Predef.type_char (scan_format (j+1))
+ | 's' | 'S' | '[' -> conversion j Predef.type_string
+ | 'c' | 'C' -> conversion j Predef.type_char
| 'b' | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' | 'N' ->
- ty_arrow Predef.type_int (scan_format (j+1))
- | 'f' | 'e' | 'E' | 'g' | 'G' | 'F' ->
- ty_arrow Predef.type_float (scan_format (j+1))
- | 'B' ->
- ty_arrow Predef.type_bool (scan_format (j+1))
+ conversion j Predef.type_int
+ | 'f' | 'e' | 'E' | 'g' | 'G' | 'F' -> conversion j Predef.type_float
+ | 'B' -> conversion j Predef.type_bool
| 'a' ->
let ty_arg = newvar() in
- ty_arrow (ty_arrow ty_input (ty_arrow ty_arg ty_aresult))
- (ty_arrow ty_arg (scan_format (j+1)))
- | 't' ->
- ty_arrow (ty_arrow ty_input ty_aresult) (scan_format (j+1))
- | 'l' ->
- if j+1 >= len then incomplete i else begin
- match fmt.[j+1] with
- | 'b' | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
- ty_arrow Predef.type_int32 (scan_format (j+2))
- | c ->
- raise(Error(loc, Bad_format(String.sub fmt i (j-i+2))))
- end
- | 'n' ->
- if j+1 >= len then incomplete i else begin
- match fmt.[j+1] with
- | 'b' | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
- ty_arrow Predef.type_nativeint (scan_format (j+2))
- | c ->
- raise(Error(loc, Bad_format(String.sub fmt i (j-i+2))))
- end
- | 'L' ->
- if j+1 >= len then incomplete i else begin
- match fmt.[j+1] with
+ let ty_a = ty_arrow ty_input (ty_arrow ty_arg ty_aresult) in
+ let ty_aresult, ty_result = conversion j ty_arg in
+ ty_aresult, ty_arrow ty_a ty_result
+ | 'r' ->
+ let ty_res = newvar() in
+ let ty_r = ty_arrow ty_input ty_res in
+ let ty_aresult, ty_result = conversion j ty_res in
+ ty_arrow ty_r ty_aresult, ty_result
+ | 't' -> conversion j (ty_arrow ty_input ty_aresult)
+ | 'n' when j + 1 = len -> conversion j Predef.type_int
+ | 'l' | 'n' | 'L' as conv ->
+ let j = j + 1 in
+ if j >= len then incomplete i else begin
+ match fmt.[j] with
| 'b' | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
- ty_arrow Predef.type_int64 (scan_format (j+2))
+ let ty_arg =
+ match conv with
+ | 'l' -> Predef.type_int32
+ | 'n' -> Predef.type_nativeint
+ | _ -> Predef.type_int64 in
+ conversion j ty_arg
| c ->
- raise(Error(loc, Bad_format(String.sub fmt i (j-i+2))))
+ if conv = 'n' then conversion (j - 1) Predef.type_int else
+ raise(Error(loc, Bad_format(String.sub fmt i (j-i))))
end
| c ->
raise(Error(loc, Bad_format(String.sub fmt i (j-i+1))))
in
+ let ty_ares, ty_res = scan_format 0 in
newty
(Tconstr(Predef.path_format,
- [scan_format 0; ty_input; ty_aresult; ty_result],
+ [ty_res; ty_input; ty_ares; ty_result],
ref Mnil))
(* Approximate the type of an expression, for better recursion *)
View Lorry Controller Status