summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPierre Weis <Pierre.Weis@inria.fr>2006-11-17 08:34:05 +0000
committerPierre Weis <Pierre.Weis@inria.fr>2006-11-17 08:34:05 +0000
commit236baa6ee4d44d7abc654d2bfbe073a5e5c2f0b0 (patch)
tree3c1bb51dd08b3725bd1a6face869ac3f5c89d092
parentb6fa9a252954a61188034279c031ae1910fc8b6d (diff)
downloadocaml-236baa6ee4d44d7abc654d2bfbe073a5e5c2f0b0.tar.gz
Encapsulation of system specific exports in module Printf.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7735 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
-rw-r--r--stdlib/format.ml23
-rw-r--r--stdlib/printf.ml114
-rw-r--r--stdlib/printf.mli104
-rw-r--r--stdlib/scanf.ml375
-rw-r--r--typing/typecore.ml2
5 files changed, 336 insertions, 282 deletions
diff --git a/stdlib/format.ml b/stdlib/format.ml
index f5deb0674a..ca31832e89 100644
--- a/stdlib/format.ml
+++ b/stdlib/format.ml
@@ -910,7 +910,8 @@ and set_tags =
**************************************************************)
-module Sformat = Printf.Sformat;;
+module Sformat = Printf.CamlinternalPr.Sformat;;
+module Tformat = Printf.CamlinternalPr.Tformat;;
(* Error messages when processing formats. *)
@@ -1000,7 +1001,7 @@ let mkprintf to_s get_out =
if i >= len then Obj.magic (k ppf) else
match Sformat.get fmt i with
| '%' ->
- Printf.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
+ Tformat.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
| '@' ->
let i = succ i in
if i >= len then invalid_format fmt i else
@@ -1075,7 +1076,7 @@ let mkprintf to_s get_out =
and cont_t n printer i = invalid_integer fmt i
and cont_f n i = invalid_integer fmt i
and cont_m n sfmt i = invalid_integer fmt i in
- Printf.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
+ Tformat.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
| _ ->
let rec get j =
if j >= len then invalid_integer fmt j else
@@ -1084,7 +1085,7 @@ let mkprintf to_s get_out =
| _ ->
let size =
if j = i then size_of_int 0 else
- let s = Sformat.sub fmt i (j - i) in
+ let s = Sformat.sub fmt (Sformat.index_of_int i) (j - i) in
format_int_of_string fmt j s in
c size n j in
get i
@@ -1121,11 +1122,11 @@ let mkprintf to_s get_out =
and get_tag_name n i c =
let rec get accu n i j =
if j >= len
- then c (implode_rev (Sformat.sub fmt i (j - i)) accu) n j else
+ then c (implode_rev (Sformat.sub fmt (Sformat.index_of_int i) (j - i)) accu) n j else
match Sformat.get fmt j with
- | '>' -> c (implode_rev (Sformat.sub fmt i (j - i)) accu) n j
+ | '>' -> c (implode_rev (Sformat.sub fmt (Sformat.index_of_int i) (j - i)) accu) n j
| '%' ->
- let s0 = Sformat.sub fmt i (j - i) in
+ let s0 = Sformat.sub fmt (Sformat.index_of_int i) (j - i) in
let cont_s n s i = get (s :: s0 :: accu) n i i
and cont_a n printer arg i =
let s =
@@ -1143,7 +1144,7 @@ let mkprintf to_s get_out =
format_invalid_arg "bad tag name specification" fmt i
and cont_m n sfmt i =
format_invalid_arg "bad tag name specification" fmt i in
- Printf.scan_format fmt v n j cont_s cont_a cont_t cont_f cont_m
+ Tformat.scan_format fmt v n j cont_s cont_a cont_t cont_f cont_m
| c -> get accu n i (succ j) in
get [] n i i
@@ -1180,9 +1181,9 @@ let mkprintf to_s get_out =
get_tag_name n (succ i) got_name
| c -> pp_open_tag ppf ""; doprn n i in
- doprn (Printf.index_of_int 0) 0 in
+ doprn (Sformat.index_of_int 0) 0 in
- Printf.kapr kpr fmt in
+ Tformat.kapr kpr fmt in
kprintf;;
@@ -1193,7 +1194,7 @@ let mkprintf to_s get_out =
**************************************************************)
let kfprintf k ppf = mkprintf false (fun _ -> ppf) k;;
-let ifprintf ppf = Printf.kapr (fun _ -> Obj.magic ignore);;
+let ifprintf ppf = Tformat.kapr (fun _ -> Obj.magic ignore);;
let fprintf ppf = kfprintf ignore ppf;;
let printf fmt = fprintf std_formatter fmt;;
diff --git a/stdlib/printf.ml b/stdlib/printf.ml
index 34e3813ac7..f4a27ca521 100644
--- a/stdlib/printf.ml
+++ b/stdlib/printf.ml
@@ -25,27 +25,33 @@ external format_int64: string -> int64 -> string
= "caml_int64_format"
module Sformat = struct
- external unsafe_to_string : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
- = "%identity"
+
+ type index;;
+
+ external unsafe_index_of_int : int -> index = "%identity";;
+ let index_of_int i =
+ if i >= 0 then unsafe_index_of_int i
+ else failwith ("index_of_int: negative argument " ^ string_of_int i);;
+ external int_of_index : index -> int = "%identity";;
+
+ let add_int_index i idx = index_of_int (i + int_of_index idx);;
+ let succ_index = add_int_index 1;;
+ (* Litteral position are one-based (hence pred p instead of p). *)
+ let index_of_litteral_position p = index_of_int (pred p);;
+
external length : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int
- = "%string_length"
+ = "%string_length";;
external get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
- = "%string_safe_get"
+ = "%string_safe_get";;
external unsafe_get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
- = "%string_unsafe_get"
- let sub fmt idx len = String.sub (unsafe_to_string fmt) idx len
- let to_string fmt = sub fmt 0 (length fmt)
-end;;
-
-type index;;
-
-external index_of_int : int -> index = "%identity";;
-external int_of_index : index -> int = "%identity";;
+ = "%string_unsafe_get";;
+ external unsafe_to_string : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
+ = "%identity";;
+ let sub fmt idx len =
+ String.sub (unsafe_to_string fmt) (int_of_index idx) len;;
+ let to_string fmt = sub fmt (unsafe_index_of_int 0) (length fmt);;
-let add_int_index i idx = index_of_int (i + int_of_index idx);;
-let succ_index = add_int_index 1;;
-(* Litteral position are one-based (hence pred p instead of p). *)
-let index_of_litteral_position p = index_of_int (pred p);;
+end;;
let bad_conversion sfmt i c =
invalid_arg
@@ -60,19 +66,19 @@ let incomplete_format fmt =
("printf: premature end of format string ``" ^
Sformat.to_string fmt ^ "''");;
-(* Parses a format to return the specified length and the padding direction. *)
-let parse_string_format sfmt =
+(* Parses a string conversion to return the specified length and the padding direction. *)
+let parse_string_conversion sfmt =
let rec parse neg i =
if i >= String.length sfmt then (0, neg) else
match String.unsafe_get sfmt i with
| '1'..'9' ->
- (int_of_string
- (String.sub sfmt i (String.length sfmt - i - 1)),
- neg)
+ (int_of_string
+ (String.sub sfmt i (String.length sfmt - i - 1)),
+ neg)
| '-' ->
- parse true (succ i)
+ parse true (succ i)
| _ ->
- parse neg (succ i) in
+ parse neg (succ i) in
try parse false 1 with Failure _ -> bad_conversion sfmt 0 's'
(* Pad a (sub) string into a blank string of length [p],
@@ -89,7 +95,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_string_format sfmt in
+ let (p, neg) = parse_string_conversion sfmt in
pad_string ' ' p neg s 0 (String.length s);;
(* Extract a format string out of [fmt] between [start] and [stop] inclusive.
@@ -235,11 +241,15 @@ let summarize_format_type fmt =
iter_on_format_args fmt add_conv add_char;
Buffer.contents b;;
-type ac = {
- mutable ac_rglr : int;
- mutable ac_skip : int;
- mutable ac_rdrs : int;
-};;
+module Ac = struct
+ type ac = {
+ mutable ac_rglr : int;
+ mutable ac_skip : int;
+ mutable ac_rdrs : int;
+ }
+end;;
+
+open Ac;;
(* Computes the number of arguments of a format (including flag
arguments if any). *)
@@ -315,7 +325,7 @@ let kapr kpr fmt =
loop 0 [];;
type positional_specification =
- | Spec_none | Spec_index of index;;
+ | Spec_none | Spec_index of Sformat.index;;
(* To scan an optional positional parameter specification,
i.e. an integer followed by a [$].
@@ -335,7 +345,7 @@ let scan_positional_spec fmt got_spec n i =
| '$' ->
if accu = 0
then failwith "printf: bad positional specification (0)." else
- got_spec (Spec_index (index_of_litteral_position accu)) (succ j)
+ got_spec (Spec_index (Sformat.index_of_litteral_position accu)) (succ j)
(* Not a positional specification. *)
| _ -> got_spec Spec_none i in
get_int_litteral (int_of_char d - 48) (succ i)
@@ -346,8 +356,8 @@ let scan_positional_spec fmt got_spec n i =
positional specification. *)
let next_index spec n =
match spec with
- | Spec_none -> succ_index n
- | Spec_index p -> n;;
+ | Spec_none -> Sformat.succ_index n
+ | Spec_index _ -> n;;
(* Get the position of the actual argument to printf, according to its
optional positional specification. *)
@@ -378,7 +388,8 @@ 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.(Sformat.int_of_index (get_index spec n))) in
let rec scan_positional n widths i =
let got_spec spec i = scan_flags spec n widths i in
@@ -432,7 +443,7 @@ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
(* If the printer spec is Spec_none, go on as usual.
If the printer spec is Spec_index p,
printer's argument spec is Spec_index (succ_index p). *)
- let n = succ_index (get_index spec n) in
+ let n = Sformat.succ_index (get_index spec n) in
let arg = get_arg Spec_none n in
cont_a (next_index spec n) printer arg (succ i)
| 't' ->
@@ -511,12 +522,12 @@ let mkprintf to_s get_out outc outs flush k fmt =
and cont_f n i =
flush out; doprn n i
and cont_m n xf i =
- let m = add_int_index (count_arguments_of_format xf) n in
+ let m = Sformat.add_int_index (count_arguments_of_format xf) n in
pr (Obj.magic (fun _ -> doprn m i)) n xf v in
doprn n 0 in
- let kpr = pr k (index_of_int 0) in
+ let kpr = pr k (Sformat.index_of_int 0) in
kapr kpr fmt;;
@@ -549,3 +560,30 @@ let ksprintf k =
let kprintf = ksprintf;;
let sprintf fmt = ksprintf (fun s -> s) fmt;;
+
+module CamlinternalPr = struct
+
+ module Sformat = Sformat;;
+
+ module Tformat = struct
+
+ type ac =
+ Ac.ac = {
+ mutable ac_rglr : int;
+ mutable ac_skip : int;
+ mutable ac_rdrs : int;
+ };;
+
+ let ac_of_format = ac_of_format;;
+
+ let sub_format = sub_format;;
+
+ let summarize_format_type = summarize_format_type;;
+
+ let scan_format = scan_format;;
+
+ let kapr = kapr;;
+
+ end;;
+
+end;;
diff --git a/stdlib/printf.mli b/stdlib/printf.mli
index e197a48216..e8bd7d6c92 100644
--- a/stdlib/printf.mli
+++ b/stdlib/printf.mli
@@ -147,48 +147,62 @@ val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;;
(**/**)
(* For system use only. Don't call directly. *)
-type index;;
-
-external index_of_int : int -> index = "%identity";;
-
-type ac = {
- mutable ac_rglr : int;
- mutable ac_skip : int;
- mutable ac_rdrs : int;
-};;
-
-val ac_of_format : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> ac;;
-
-module Sformat : sig
- external unsafe_to_string : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
- = "%identity"
- external length : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int
- = "%string_length"
- external get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
- = "%string_safe_get"
- external unsafe_get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
- = "%string_unsafe_get"
- val sub : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> int -> string
- val to_string : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
-end
-
-val scan_format : ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
- 'g array ->
- index ->
- int ->
- (index -> string -> int -> 'h) ->
- (index -> 'i -> 'j -> int -> 'h) ->
- (index -> 'k -> int -> 'h) ->
- (index -> int -> 'h) ->
- (index -> ('l, 'm, 'n, 'o, 'p, 'q) format6 -> int -> 'h) -> 'h
-
-val sub_format :
- (('a, 'b, 'c, 'd, 'e, 'f) format6 -> int) ->
- (('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char -> int) ->
- char -> ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> int
-
-val summarize_format_type : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
-
-val kapr :
- (('a, 'b, 'c, 'd, 'e, 'f) format6 -> Obj.t array -> 'g) ->
- ('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g
+
+module CamlinternalPr : sig
+
+ module Sformat : sig
+ type index;;
+
+ val index_of_int : int -> index;;
+ external int_of_index : index -> int = "%identity";;
+ external unsafe_index_of_int : int -> index = "%identity";;
+
+ val succ_index : index -> index;;
+
+ val sub : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> index -> int -> string;;
+ val to_string : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string;;
+ external length : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int
+ = "%string_length";;
+ external get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
+ = "%string_safe_get";;
+ external unsafe_to_string : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
+ = "%identity";;
+ external unsafe_get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
+ = "%string_unsafe_get";;
+
+ end;;
+
+ module Tformat : sig
+
+ type ac = {
+ mutable ac_rglr : int;
+ mutable ac_skip : int;
+ mutable ac_rdrs : int;
+ };;
+
+ val ac_of_format : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> ac;;
+
+ val sub_format :
+ (('a, 'b, 'c, 'd, 'e, 'f) format6 -> int) ->
+ (('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char -> int) ->
+ char -> ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> int
+
+ val summarize_format_type : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
+
+ val scan_format : ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+ 'g array ->
+ Sformat.index ->
+ int ->
+ (Sformat.index -> string -> int -> 'h) ->
+ (Sformat.index -> 'i -> 'j -> int -> 'h) ->
+ (Sformat.index -> 'k -> int -> 'h) ->
+ (Sformat.index -> int -> 'h) ->
+ (Sformat.index -> ('l, 'm, 'n, 'o, 'p, 'q) format6 -> int -> 'h) -> 'h
+
+ val kapr :
+ (('a, 'b, 'c, 'd, 'e, 'f) format6 -> Obj.t array -> 'g) ->
+ ('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g
+ end;;
+
+end;;
+
diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml
index 0cbb70c3cc..a32a48b3f5 100644
--- a/stdlib/scanf.ml
+++ b/stdlib/scanf.ml
@@ -306,11 +306,9 @@ end;;
(* Formatted input functions. *)
-type ('a, 'b, 'c, 'd) tscanf =
+type ('a, 'b, 'c, 'd) scanner =
('a, Scanning.scanbuf, 'b, 'c, 'a -> 'd, 'd) format6 -> 'c;;
-module Sformat = Printf.Sformat;;
-
external string_to_format :
string -> ('a, 'b, 'c, 'd, 'e, 'f) format6 = "%identity";;
@@ -329,6 +327,9 @@ let scanf_bad_input ib = function
bad_input (Printf.sprintf "scanf: bad input at char number %i: %s" i s)
| x -> raise x;;
+module Sformat = Printf.CamlinternalPr.Sformat;;
+module Tformat = Printf.CamlinternalPr.Tformat;;
+
let bad_conversion fmt i c =
invalid_arg
(Printf.sprintf
@@ -351,8 +352,8 @@ let format_mismatch fmt1 fmt2 ib =
(* Checking that 2 format string are type compatible. *)
let compatible_format_type fmt1 fmt2 =
- Printf.summarize_format_type (string_to_format fmt1) =
- Printf.summarize_format_type (string_to_format fmt2);;
+ Tformat.summarize_format_type (string_to_format fmt1) =
+ Tformat.summarize_format_type (string_to_format fmt2);;
(* Checking that [c] is indeed in the input, then skips it.
In this case, the character c has been explicitely specified in the
@@ -445,11 +446,11 @@ let rec scan_decimal_digits max ib =
if Scanning.eof ib then max else
match c with
| '0' .. '9' as c ->
- let max = Scanning.store_char ib c max in
- scan_decimal_digits max ib
+ let max = Scanning.store_char ib c max in
+ scan_decimal_digits max ib
| '_' ->
- let max = Scanning.ignore_char ib max in
- scan_decimal_digits max ib
+ let max = Scanning.ignore_char ib max in
+ scan_decimal_digits max ib
| _ -> max;;
let scan_decimal_digits_plus max ib =
@@ -469,11 +470,11 @@ let scan_digits_plus digitp max ib =
if Scanning.eof ib then max else
match c with
| c when digitp c ->
- let max = Scanning.store_char ib c max in
- scan_digits max
+ let max = Scanning.store_char ib c max in
+ scan_digits max
| '_' ->
- let max = Scanning.ignore_char ib max in
- scan_digits max
+ let max = Scanning.ignore_char ib max in
+ scan_digits max
| _ -> max in
let c = Scanning.checked_peek_char ib in
@@ -521,15 +522,15 @@ let scan_optionally_signed_decimal_int max ib =
let scan_unsigned_int max ib =
match Scanning.checked_peek_char ib with
| '0' as c ->
- let max = Scanning.store_char ib c max in
- if max = 0 then max else
- let c = Scanning.peek_char ib in
- if Scanning.eof ib then max else
- begin match c with
- | 'x' | 'X' -> scan_hexadecimal_int (Scanning.store_char ib c max) ib
- | 'o' -> scan_octal_int (Scanning.store_char ib c max) ib
- | 'b' -> scan_binary_int (Scanning.store_char ib c max) ib
- | c -> scan_decimal_digits max ib end
+ let max = Scanning.store_char ib c max in
+ if max = 0 then max else
+ let c = Scanning.peek_char ib in
+ if Scanning.eof ib then max else
+ begin match c with
+ | 'x' | 'X' -> scan_hexadecimal_int (Scanning.store_char ib c max) ib
+ | 'o' -> scan_octal_int (Scanning.store_char ib c max) ib
+ | 'b' -> scan_binary_int (Scanning.store_char ib c max) ib
+ | c -> scan_decimal_digits max ib end
| c -> scan_unsigned_decimal_int max ib;;
let scan_optionally_signed_int max ib =
@@ -564,7 +565,7 @@ let scan_exp_part max ib =
if Scanning.eof ib then max else
match c with
| 'e' | 'E' as c ->
- scan_optionally_signed_decimal_int (Scanning.store_char ib c max) ib
+ scan_optionally_signed_decimal_int (Scanning.store_char ib c max) ib
| _ -> max;;
(* Scan the integer part of a floating point number, (not using the
@@ -582,9 +583,9 @@ let scan_float max ib =
if Scanning.eof ib then max else
match c with
| '.' ->
- let max = Scanning.store_char ib c max in
- let max = scan_frac_part max ib in
- scan_exp_part max ib
+ let max = Scanning.store_char ib c max in
+ let max = scan_frac_part max ib in
+ scan_exp_part max ib
| c -> scan_exp_part max ib;;
let scan_Float max ib =
@@ -594,11 +595,11 @@ let scan_Float max ib =
if Scanning.eof ib then bad_float () else
match c with
| '.' ->
- let max = Scanning.store_char ib c max in
- let max = scan_frac_part max ib in
- scan_exp_part max ib
+ let max = Scanning.store_char ib c max in
+ let max = scan_frac_part max ib in
+ scan_exp_part max ib
| 'e' | 'E' ->
- scan_exp_part max ib
+ scan_exp_part max ib
| c -> bad_float ();;
(* Scan a regular string: stops when encountering a space or one of the
@@ -626,7 +627,7 @@ let char_for_backslash = function
| 'r' -> '\013'
| 'b' -> '\008'
| 't' -> '\009'
- | c -> c
+ | c -> c;;
(* The integer value corresponding to the facial value of a valid
decimal digit character. *)
@@ -649,17 +650,17 @@ let scan_backslash_char max ib =
if Scanning.eof ib then bad_input "a char" else
match c with
| '\\' | '\'' | '"' | 'n' | 't' | 'b' | 'r' (* '"' helping Emacs *) ->
- Scanning.store_char ib (char_for_backslash c) max
+ Scanning.store_char ib (char_for_backslash c) max
| '0' .. '9' as c ->
- let get_digit () =
- let c = Scanning.next_char ib in
- match c with
- | '0' .. '9' as c -> c
- | c -> bad_input_escape c in
- let c0 = c in
- let c1 = get_digit () in
- let c2 = get_digit () in
- Scanning.store_char ib (char_for_decimal_code c0 c1 c2) (max - 2)
+ let get_digit () =
+ let c = Scanning.next_char ib in
+ match c with
+ | '0' .. '9' as c -> c
+ | c -> bad_input_escape c in
+ let c0 = c in
+ let c1 = get_digit () in
+ let c2 = get_digit () in
+ Scanning.store_char ib (char_for_decimal_code c0 c1 c2) (max - 2)
| c -> bad_input_char c;;
let scan_Char max ib =
@@ -682,11 +683,11 @@ let scan_String max ib =
if Scanning.eof ib then bad_input "a string" else
match c, s with
| '"', true (* '"' helping Emacs *) ->
- loop false (Scanning.ignore_char ib max)
+ loop false (Scanning.ignore_char ib max)
| '"', false (* '"' helping Emacs *) ->
- Scanning.ignore_char ib max
+ Scanning.ignore_char ib max
| '\\', false ->
- skip_spaces true (Scanning.ignore_char ib max)
+ skip_spaces true (Scanning.ignore_char ib max)
| c, false -> loop false (Scanning.store_char ib c max)
| c, _ -> bad_input_char c
and skip_spaces s max =
@@ -696,7 +697,7 @@ let scan_String max ib =
match c, s with
| '\n', true
| ' ', false ->
- skip_spaces false (Scanning.ignore_char ib max)
+ skip_spaces false (Scanning.ignore_char ib max)
| '\\', false -> loop false max
| c, false -> loop false (Scanning.store_char ib c max)
| _, _ -> loop false (scan_backslash_char (max - 1) ib) in
@@ -737,12 +738,12 @@ let read_char_set fmt i =
if i > lim then incomplete_format fmt else
match Sformat.get fmt i with
| '^' ->
- let i = succ i in
- let j = find_set i in
- j, Neg_set (Sformat.sub fmt i (j - i))
+ let i = succ i in
+ let j = find_set i in
+ j, Neg_set (Sformat.sub fmt (Sformat.index_of_int i) (j - i))
| _ ->
- let j = find_set i in
- j, Pos_set (Sformat.sub fmt i (j - i));;
+ let j = find_set i in
+ j, Pos_set (Sformat.sub fmt (Sformat.index_of_int i) (j - i));;
(* Char sets are now represented as bitvects that are represented as
byte strings. *)
@@ -788,18 +789,18 @@ let make_char_bit_vect bit set =
if i <= lim then
match set.[i] with
| '-' when rp ->
- (* 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 = 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 (succ i)
+ (* 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 = 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 (succ i)
| c ->
- set_bit_of_range r (int_of_char set.[i]) bit;
- loop bit true (succ i) in
+ set_bit_of_range r (int_of_char set.[i]) bit;
+ loop bit true (succ i) in
loop bit false 0;
r;;
@@ -813,35 +814,35 @@ let make_pred bit set stp =
let make_setp stp char_set =
match char_set with
| Pos_set set ->
- begin match String.length set with
- | 0 -> (fun c -> 0)
- | 1 ->
- let p = set.[0] in
- (fun c -> if c == p then 1 else 0)
- | 2 ->
- let p1 = set.[0] and p2 = set.[1] in
- (fun c -> if c == p1 || c == p2 then 1 else 0)
- | 3 ->
- let p1 = set.[0] and p2 = set.[1] and p3 = set.[2] in
- if p2 = '-' then make_pred 1 set stp else
- (fun c -> if c == p1 || c == p2 || c == p3 then 1 else 0)
- | n -> make_pred 1 set stp
- end
+ begin match String.length set with
+ | 0 -> (fun c -> 0)
+ | 1 ->
+ let p = set.[0] in
+ (fun c -> if c == p then 1 else 0)
+ | 2 ->
+ let p1 = set.[0] and p2 = set.[1] in
+ (fun c -> if c == p1 || c == p2 then 1 else 0)
+ | 3 ->
+ let p1 = set.[0] and p2 = set.[1] and p3 = set.[2] in
+ if p2 = '-' then make_pred 1 set stp else
+ (fun c -> if c == p1 || c == p2 || c == p3 then 1 else 0)
+ | n -> make_pred 1 set stp
+ end
| Neg_set set ->
- begin match String.length set with
- | 0 -> (fun c -> 1)
- | 1 ->
- let p = set.[0] in
- (fun c -> if c != p then 1 else 0)
- | 2 ->
- let p1 = set.[0] and p2 = set.[1] in
- (fun c -> if c != p1 && c != p2 then 1 else 0)
- | 3 ->
- let p1 = set.[0] and p2 = set.[1] and p3 = set.[2] in
- if p2 = '-' then make_pred 0 set stp else
- (fun c -> if c != p1 && c != p2 && c != p3 then 1 else 0)
- | n -> make_pred 0 set stp
- end;;
+ begin match String.length set with
+ | 0 -> (fun c -> 1)
+ | 1 ->
+ let p = set.[0] in
+ (fun c -> if c != p then 1 else 0)
+ | 2 ->
+ let p1 = set.[0] and p2 = set.[1] in
+ (fun c -> if c != p1 && c != p2 then 1 else 0)
+ | 3 ->
+ let p1 = set.[0] and p2 = set.[1] and p3 = set.[2] in
+ if p2 = '-' then make_pred 0 set stp else
+ (fun c -> if c != p1 && c != p2 && c != p3 then 1 else 0)
+ | n -> make_pred 0 set stp
+ end;;
let setp_table = Hashtbl.create 7;;
@@ -849,17 +850,17 @@ let add_setp stp char_set setp =
let char_set_tbl =
try Hashtbl.find setp_table char_set with
| Not_found ->
- let char_set_tbl = Hashtbl.create 3 in
- Hashtbl.add setp_table char_set char_set_tbl;
- char_set_tbl in
+ let char_set_tbl = Hashtbl.create 3 in
+ Hashtbl.add setp_table char_set char_set_tbl;
+ char_set_tbl in
Hashtbl.add char_set_tbl stp setp;;
let find_setp stp char_set =
try Hashtbl.find (Hashtbl.find setp_table char_set) stp with
| Not_found ->
- let setp = make_setp stp char_set in
- add_setp stp char_set setp;
- setp;;
+ let setp = make_setp stp char_set in
+ add_setp stp char_set setp;
+ setp;;
let scan_chars_in_char_set stp char_set max ib =
let rec loop_pos1 cp1 max =
@@ -915,19 +916,19 @@ let scan_chars_in_char_set stp char_set max ib =
let max =
match char_set with
| Pos_set set ->
- begin match String.length set with
- | 0 -> loop (fun c -> 0) max
- | 1 -> loop_pos1 set.[0] max
- | 2 -> loop_pos2 set.[0] set.[1] max
- | 3 when set.[1] != '-' -> loop_pos3 set.[0] set.[1] set.[2] max
- | n -> loop (find_setp stp char_set) max end
+ begin match String.length set with
+ | 0 -> loop (fun c -> 0) max
+ | 1 -> loop_pos1 set.[0] max
+ | 2 -> loop_pos2 set.[0] set.[1] max
+ | 3 when set.[1] != '-' -> loop_pos3 set.[0] set.[1] set.[2] max
+ | n -> loop (find_setp stp char_set) max end
| Neg_set set ->
- begin match String.length set with
- | 0 -> loop (fun c -> 1) max
- | 1 -> loop_neg1 set.[0] max
- | 2 -> loop_neg2 set.[0] set.[1] max
- | 3 when set.[1] != '-' -> loop_neg3 set.[0] set.[1] set.[2] max
- | n -> loop (find_setp stp char_set) max end in
+ begin match String.length set with
+ | 0 -> loop (fun c -> 1) max
+ | 1 -> loop_neg1 set.[0] max
+ | 2 -> loop_neg2 set.[0] set.[1] max
+ | 3 when set.[1] != '-' -> loop_neg3 set.[0] set.[1] set.[2] max
+ | n -> loop (find_setp stp char_set) max end in
ignore_stoppers stp ib;
max;;
@@ -973,8 +974,8 @@ let list_iter_i f l =
aborts and applies the scanning buffer and a string that explains
the error to the error handling function [ef] (the error continuation). *)
let ascanf sc fmt =
- let ac = Printf.ac_of_format fmt in
- match ac.Printf.ac_rdrs with
+ let ac = Tformat.ac_of_format fmt in
+ match ac.Tformat.ac_rdrs with
| 0 -> Obj.magic (fun f -> sc fmt [||] f)
| 1 -> Obj.magic (fun x f -> sc fmt [| Obj.repr x |] f)
| 2 -> Obj.magic (fun x y f -> sc fmt [| Obj.repr x; Obj.repr y; |] f)
@@ -1005,107 +1006,107 @@ let scan_format ib ef fmt v f =
match Sformat.get fmt i with
| ' ' -> skip_whites ib; scan_fmt ir f (succ i)
| '%' ->
- if i > lim then incomplete_format fmt else
- scan_conversion false max_int ir f (succ i)
+ if i > lim then incomplete_format fmt else
+ scan_conversion false max_int ir f (succ i)
| '@' ->
- let i = succ i in
- if i > lim then incomplete_format fmt else begin
- check_char ib (Sformat.get fmt i);
- scan_fmt ir f (succ i) end
+ let i = succ i in
+ if i > lim then incomplete_format fmt else begin
+ check_char ib (Sformat.get fmt i);
+ scan_fmt ir f (succ i) end
| c -> check_char ib c; scan_fmt ir f (succ i)
and scan_conversion skip max ir 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 ir f (succ i)
+ check_char ib conv; scan_fmt ir f (succ i)
| 's' ->
- let i, stp = scan_fmt_stoppers (succ i) in
- let _x = scan_string stp max ib in
- scan_fmt ir (stack f (token_string ib)) (succ i)
+ let i, stp = scan_fmt_stoppers (succ i) in
+ let _x = scan_string stp max ib in
+ scan_fmt ir (stack f (token_string ib)) (succ i)
| 'S' ->
- let _x = scan_String max ib in
- scan_fmt ir (stack f (token_string ib)) (succ i)
+ let _x = scan_String max ib in
+ scan_fmt ir (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 ir (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 ir (stack f (token_string ib)) (succ i)
| 'c' when max = 0 ->
- let c = Scanning.checked_peek_char ib in
- scan_fmt ir (stack f c) (succ i)
+ let c = Scanning.checked_peek_char ib in
+ scan_fmt ir (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 ir (stack f (token_char ib)) (succ i)
+ 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 ir (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 ir (stack f (token_int conv ib)) (succ i)
+ let _x = scan_int_conv conv max ib in
+ scan_fmt ir (stack f (token_int conv ib)) (succ i)
| 'N' as conv ->
- scan_fmt ir (stack f (get_count conv ib)) (succ i)
+ scan_fmt ir (stack f (get_count conv ib)) (succ i)
| 'f' | 'e' | 'E' | 'g' | 'G' ->
- let _x = scan_float max ib in
- scan_fmt ir (stack f (token_float ib)) (succ i)
+ let _x = scan_float max ib in
+ scan_fmt ir (stack f (token_float ib)) (succ i)
| 'F' ->
- let _x = scan_Float max ib in
- scan_fmt ir (stack f (token_float ib)) (succ i)
+ let _x = scan_Float max ib in
+ scan_fmt ir (stack f (token_float ib)) (succ i)
| 'B' | 'b' ->
- let _x = scan_bool max ib in
- scan_fmt ir (stack f (token_bool ib)) (succ i)
+ let _x = scan_bool max ib in
+ scan_fmt ir (stack f (token_bool ib)) (succ i)
| 'r' ->
- if ir > limr then assert false else
- let token = Obj.magic v.(ir) ib in
- scan_fmt (succ ir) (stack f token) (succ i)
+ if ir > limr then assert false else
+ let token = Obj.magic v.(ir) ib in
+ scan_fmt (succ ir) (stack f token) (succ i)
| 'l' | 'n' | 'L' as conv ->
- let i = succ i in
- if i > lim then scan_fmt ir (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). *)
- | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv ->
- let _x = scan_int_conv conv max ib in
- (* Look back to the character that triggered the integer conversion
- (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 ir (stack f (token_int32 conv ib)) (succ i)
- | 'n' -> scan_fmt ir (stack f (token_nativeint conv ib)) (succ i)
- | _ -> scan_fmt ir (stack f (token_int64 conv ib)) (succ i) end
- (* This is not an integer conversion, but a regular %l, %n or %L. *)
- | _ -> scan_fmt ir (stack f (get_count conv ib)) i end
+ let i = succ i in
+ if i > lim then scan_fmt ir (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). *)
+ | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv ->
+ let _x = scan_int_conv conv max ib in
+ (* Look back to the character that triggered the integer conversion
+ (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 ir (stack f (token_int32 conv ib)) (succ i)
+ | 'n' -> scan_fmt ir (stack f (token_nativeint conv ib)) (succ i)
+ | _ -> scan_fmt ir (stack f (token_int64 conv ib)) (succ i) end
+ (* This is not an integer conversion, but a regular %l, %n or %L. *)
+ | _ -> scan_fmt ir (stack f (get_count conv ib)) i end
| '!' ->
- if Scanning.end_of_input ib then scan_fmt ir f (succ i)
- else bad_input "end of input not found"
+ if Scanning.end_of_input ib then scan_fmt ir f (succ i)
+ else bad_input "end of input not found"
| '_' ->
- if i > lim then incomplete_format fmt else
- scan_conversion true max ir f (succ i)
+ if i > lim then incomplete_format fmt else
+ scan_conversion true max ir 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 (succ i)
- | _ -> accu, i in
- let max, i = read_width (int_value_of_char conv) (succ i) in
- if i > lim then incomplete_format fmt else begin
+ let rec read_width accu i =
+ if i > lim then accu, i else
match Sformat.get fmt i with
- | '.' ->
- let p, i = read_width 0 (succ i) in
- scan_conversion skip (succ (max + p)) ir f i
- | _ -> scan_conversion skip max ir f i end
+ | '0' .. '9' as c ->
+ let accu = 10 * accu + int_value_of_char c in
+ read_width accu (succ i)
+ | _ -> accu, i 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 (succ i) in
+ scan_conversion skip (succ (max + p)) ir f i
+ | _ -> scan_conversion skip max ir f i end
| '(' | '{' as conv (* ')' '}' *) ->
- let i = succ i in
- let j =
- Printf.sub_format
- incomplete_format bad_conversion conv fmt i in
- let mf = Sformat.sub fmt i (j - 2 - i) in
- let _x = scan_String max ib in
- let rf = token_string ib in
- if not (compatible_format_type rf mf) then format_mismatch rf mf ib else
- if conv = '{' (* '}' *) then scan_fmt ir (stack f rf) j else
- let nf = scan_fmt ir (Obj.magic rf) 0 in
- scan_fmt ir (stack f nf) j
+ let i = succ i in
+ let j =
+ Tformat.sub_format
+ incomplete_format bad_conversion conv fmt i in
+ let mf = Sformat.sub fmt (Sformat.index_of_int i) (j - 2 - i) in
+ let _x = scan_String max ib in
+ let rf = token_string ib in
+ if not (compatible_format_type rf mf) then format_mismatch rf mf ib else
+ if conv = '{' (* '}' *) then scan_fmt ir (stack f rf) j else
+ let nf = scan_fmt ir (Obj.magic rf) 0 in
+ scan_fmt ir (stack f nf) j
| c -> bad_conversion fmt i c
and scan_fmt_stoppers i =
@@ -1120,7 +1121,7 @@ let scan_format ib ef fmt v f =
let v =
try scan_fmt 0 (fun () -> f) 0 with
| (Scan_failure _ | Failure _ | End_of_file) as exc ->
- stack (delay ef ib) exc in
+ stack (delay ef ib) exc in
return v;;
let mkscanf ib ef fmt =
diff --git a/typing/typecore.ml b/typing/typecore.ml
index a7a1387546..99150e186e 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -756,7 +756,7 @@ let type_format loc fmt =
let j = j + 1 in
if j >= len then incomplete_format fmt else
let sj =
- Printf.sub_format
+ Printf.CamlinternalPr.Tformat.sub_format
(fun fmt -> incomplete_format (format_to_string fmt))
(fun fmt -> bad_conversion (format_to_string fmt))
c (string_to_format fmt) j in