diff options
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/scanf.ml | 43 | ||||
| -rw-r--r-- | stdlib/scanf.mli | 17 | ||||
| -rw-r--r-- | stdlib/sys.ml | 2 |
3 files changed, 47 insertions, 15 deletions
diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml index 1789ff4aa..5070e30ba 100644 --- a/stdlib/scanf.ml +++ b/stdlib/scanf.ml @@ -114,7 +114,7 @@ type file_name = string;; type scanbuf = { mutable eof : bool; mutable current_char : char; - mutable current_char_valid : bool; + mutable current_char_is_valid : bool; mutable char_count : int; mutable line_count : int; mutable token_count : int; @@ -132,19 +132,19 @@ let next_char ib = try let c = ib.get_next_char () in ib.current_char <- c; - ib.current_char_valid <- true; + ib.current_char_is_valid <- true; ib.char_count <- ib.char_count + 1; if c == '\n' then ib.line_count <- ib.line_count + 1; c with | End_of_file -> let c = null_char in ib.current_char <- c; - ib.current_char_valid <- false; + ib.current_char_is_valid <- false; ib.eof <- true; c;; let peek_char ib = - if ib.current_char_valid then ib.current_char else next_char ib;; + if ib.current_char_is_valid then ib.current_char else next_char ib;; (* Returns a valid current char for the input buffer. In particular no irrelevant null character (as set by [next_char] in case of end @@ -167,7 +167,7 @@ let name_of_input ib = ib.file_name;; let char_count ib = ib.char_count;; let line_count ib = ib.line_count;; let reset_token ib = Buffer.reset ib.tokbuf;; -let invalidate_current_char ib = ib.current_char_valid <- false;; +let invalidate_current_char ib = ib.current_char_is_valid <- false;; let token ib = let tokbuf = ib.tokbuf in @@ -193,7 +193,7 @@ let default_token_buffer_size = 1024;; let create fname next = { eof = false; current_char = '\000'; - current_char_valid = false; + current_char_is_valid = false; char_count = 0; line_count = 0; token_count = 0; @@ -275,11 +275,15 @@ let incomplete_format fmt = let bad_float () = bad_input "no dot or exponent part found in float token";; +let format_mismatch_err fmt1 fmt2 = + Printf.sprintf "format read %S does not match specification %S" fmt1 fmt2;; + let format_mismatch fmt1 fmt2 ib = - let err = - Printf.sprintf - "format read %S does not match specification %S" fmt2 fmt1 in - scanf_bad_input ib (Scan_failure err);; + scanf_bad_input ib (Scan_failure (format_mismatch_err fmt1 fmt2));; + +(* Checking that 2 format string are type compatible. *) +let compatible_format_type fmt1 fmt2 = + Printf.summarize_format_type fmt1 = Printf.summarize_format_type fmt2;; (* Checking that [c] is indeed in the input, then skips it. In this case, the character c has been explicitely specified in the @@ -872,6 +876,8 @@ let rec skip_whites ib = external format_to_string : ('a, 'b, 'c, 'd) format4 -> string = "%identity";; +external string_to_format : + string -> ('a, 'b, 'c, 'd) format4 = "%identity";; (* The [kscanf] main scanning function. It takes as arguments: @@ -993,8 +999,8 @@ let kscanf ib ef fmt f = let mf = String.sub fmt i (j - i - 2) in let _x = scan_String max ib in let rf = token_string ib in - if Printf.summarize_format_type mf <> - Printf.summarize_format_type rf then format_mismatch mf rf ib else + if not (compatible_format_type mf rf) + then format_mismatch rf mf ib else if conv = '{' then scan_fmt (stack f rf) j else let nf = scan_fmt (Obj.magic rf) 0 in scan_fmt (stack f nf) j @@ -1022,3 +1028,16 @@ let fscanf ic = bscanf (Scanning.from_channel ic);; let sscanf s = bscanf (Scanning.from_string s);; let scanf fmt = bscanf Scanning.stdib fmt;; + +let bscanf_format ib fmt2 f = + let fmt1 = ignore (scan_String max_int ib); token_string ib in + let fmt2 = format_to_string fmt2 in + if compatible_format_type fmt1 fmt2 + then let fresh_fmt = String.copy fmt1 in f (string_to_format fresh_fmt) + else format_mismatch fmt1 fmt2 ib;; + +let sscanf_format s fmt = + let fmt = format_to_string fmt in + if compatible_format_type s fmt + then let fresh_fmt = String.copy s in string_to_format fresh_fmt + else bad_input (format_mismatch_err s fmt);; diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli index 8f7d89cf2..4f830e67c 100644 --- a/stdlib/scanf.mli +++ b/stdlib/scanf.mli @@ -77,8 +77,8 @@ exception Scan_failure of string;; val bscanf : Scanning.scanbuf -> ('a, Scanning.scanbuf, 'b) format -> 'a -> 'b;; -(** [bscanf ib format f] reads tokens from the scanning buffer [ib] according - to the format string [format], converts these tokens to values, and +(** [bscanf ib fmt f] reads tokens from the scanning buffer [ib] according + to the format string [fmt], converts these tokens to values, and applies the function [f] to these values. The result of this application of [f] is the result of the whole construct. @@ -254,3 +254,16 @@ val kscanf : some conversion fails, the scanning function aborts and applies the error handling function [ef] to the scanning buffer and the exception that aborted the scanning process. *) + +val bscanf_format : + Scanning.scanbuf -> ('a, 'b, 'c, 'd) format4 -> + (('a, 'b, 'c, 'd) format4 -> 'e) -> 'e;; +(** [bscanf_format ib fmt f] reads a [format] argument to the format + specified by the second argument. The [format] argument read in + buffer [ib] must have the same type as [fmt]. *) + +val sscanf_format : + string -> ('a, 'b, 'c, 'd) format4 -> ('a, 'b, 'c, 'd) format4;; +(** [sscanf_format ib fmt f] reads a [format] argument to the format + specified by the second argument and returns it. The [format] + argument read in string [s] must have the same type as [fmt]. *) diff --git a/stdlib/sys.ml b/stdlib/sys.ml index aef1060ba..ab5052a85 100644 --- a/stdlib/sys.ml +++ b/stdlib/sys.ml @@ -78,4 +78,4 @@ let catch_break on = (* OCaml version string, must be in the format described in sys.mli. *) -let ocaml_version = "3.09+dev31 (2005-09-20)";; +let ocaml_version = "3.09+dev32 (2005-09-20)";; |