summaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/.cvsignore1
-rw-r--r--stdlib/.depend36
-rw-r--r--stdlib/buffer.ml8
-rw-r--r--stdlib/buffer.mli9
-rw-r--r--stdlib/filename.ml12
-rw-r--r--stdlib/filename.mli9
-rw-r--r--stdlib/format.mli128
-rw-r--r--stdlib/obj.ml3
-rw-r--r--stdlib/obj.mli5
-rw-r--r--stdlib/pervasives.ml5
-rw-r--r--stdlib/pervasives.mli14
-rw-r--r--stdlib/printexc.ml17
-rw-r--r--stdlib/printexc.mli10
-rw-r--r--stdlib/printf.ml52
-rw-r--r--stdlib/printf.mli1
-rw-r--r--stdlib/scanf.ml268
-rw-r--r--stdlib/scanf.mli24
-rw-r--r--stdlib/stdlib.mllib67
18 files changed, 389 insertions, 280 deletions
diff --git a/stdlib/.cvsignore b/stdlib/.cvsignore
index 343f6abd6a..6aa0cd421b 100644
--- a/stdlib/.cvsignore
+++ b/stdlib/.cvsignore
@@ -4,3 +4,4 @@ labelled-*
caml
*.annot
sys.ml
+*.a
diff --git a/stdlib/.depend b/stdlib/.depend
index faa3382181..5e8aefbba4 100644
--- a/stdlib/.depend
+++ b/stdlib/.depend
@@ -1,6 +1,6 @@
arg.cmi:
-array.cmi:
arrayLabels.cmi:
+array.cmi:
buffer.cmi:
callback.cmi:
camlinternalLazy.cmi:
@@ -10,7 +10,7 @@ char.cmi:
complex.cmi:
digest.cmi:
filename.cmi:
-format.cmi: buffer.cmi
+format.cmi: pervasives.cmi buffer.cmi
gc.cmi:
genlex.cmi: stream.cmi
hashtbl.cmi:
@@ -18,8 +18,8 @@ int32.cmi:
int64.cmi:
lazy.cmi:
lexing.cmi:
-list.cmi:
listLabels.cmi:
+list.cmi:
map.cmi:
marshal.cmi:
moreLabels.cmi: set.cmi map.cmi hashtbl.cmi
@@ -38,16 +38,16 @@ sort.cmi:
stack.cmi:
stdLabels.cmi:
stream.cmi:
-string.cmi:
stringLabels.cmi:
+string.cmi:
sys.cmi:
weak.cmi: hashtbl.cmi
arg.cmo: sys.cmi string.cmi printf.cmi list.cmi buffer.cmi array.cmi arg.cmi
arg.cmx: sys.cmx string.cmx printf.cmx list.cmx buffer.cmx array.cmx arg.cmi
-array.cmo: array.cmi
-array.cmx: array.cmi
arrayLabels.cmo: array.cmi arrayLabels.cmi
arrayLabels.cmx: array.cmx arrayLabels.cmi
+array.cmo: array.cmi
+array.cmx: array.cmi
buffer.cmo: sys.cmi string.cmi buffer.cmi
buffer.cmx: sys.cmx string.cmx buffer.cmi
callback.cmo: obj.cmi callback.cmi
@@ -86,10 +86,10 @@ lazy.cmo: obj.cmi camlinternalLazy.cmi lazy.cmi
lazy.cmx: obj.cmx camlinternalLazy.cmx lazy.cmi
lexing.cmo: sys.cmi string.cmi array.cmi lexing.cmi
lexing.cmx: sys.cmx string.cmx array.cmx lexing.cmi
-list.cmo: list.cmi
-list.cmx: list.cmi
listLabels.cmo: list.cmi listLabels.cmi
listLabels.cmx: list.cmx listLabels.cmi
+list.cmo: list.cmi
+list.cmx: list.cmi
map.cmo: map.cmi
map.cmx: map.cmi
marshal.cmo: string.cmi marshal.cmi
@@ -98,8 +98,8 @@ moreLabels.cmo: set.cmi map.cmi hashtbl.cmi moreLabels.cmi
moreLabels.cmx: set.cmx map.cmx hashtbl.cmx moreLabels.cmi
nativeint.cmo: sys.cmi pervasives.cmi nativeint.cmi
nativeint.cmx: sys.cmx pervasives.cmx nativeint.cmi
-obj.cmo: marshal.cmi obj.cmi
-obj.cmx: marshal.cmx obj.cmi
+obj.cmo: marshal.cmi array.cmi obj.cmi
+obj.cmx: marshal.cmx array.cmx obj.cmi
oo.cmo: camlinternalOO.cmi oo.cmi
oo.cmx: camlinternalOO.cmx oo.cmi
parsing.cmo: obj.cmi lexing.cmi array.cmi parsing.cmi
@@ -108,10 +108,10 @@ pervasives.cmo: pervasives.cmi
pervasives.cmx: pervasives.cmi
printexc.cmo: printf.cmi obj.cmi buffer.cmi array.cmi printexc.cmi
printexc.cmx: printf.cmx obj.cmx buffer.cmx array.cmx printexc.cmi
-printf.cmo: string.cmi obj.cmi list.cmi char.cmi buffer.cmi array.cmi \
- printf.cmi
-printf.cmx: string.cmx obj.cmx list.cmx char.cmx buffer.cmx array.cmx \
- printf.cmi
+printf.cmo: string.cmi pervasives.cmi obj.cmi list.cmi char.cmi buffer.cmi \
+ array.cmi printf.cmi
+printf.cmx: string.cmx pervasives.cmx obj.cmx list.cmx char.cmx buffer.cmx \
+ array.cmx printf.cmi
queue.cmo: obj.cmi queue.cmi
queue.cmx: obj.cmx queue.cmi
random.cmo: string.cmi pervasives.cmi nativeint.cmi int64.cmi int32.cmi \
@@ -128,16 +128,16 @@ sort.cmo: array.cmi sort.cmi
sort.cmx: array.cmx sort.cmi
stack.cmo: list.cmi stack.cmi
stack.cmx: list.cmx stack.cmi
-stdLabels.cmo: stringLabels.cmi listLabels.cmi arrayLabels.cmi stdLabels.cmi
-stdLabels.cmx: stringLabels.cmx listLabels.cmx arrayLabels.cmx stdLabels.cmi
std_exit.cmo:
std_exit.cmx:
+stdLabels.cmo: stringLabels.cmi listLabels.cmi arrayLabels.cmi stdLabels.cmi
+stdLabels.cmx: stringLabels.cmx listLabels.cmx arrayLabels.cmx stdLabels.cmi
stream.cmo: string.cmi obj.cmi list.cmi lazy.cmi stream.cmi
stream.cmx: string.cmx obj.cmx list.cmx lazy.cmx stream.cmi
-string.cmo: pervasives.cmi list.cmi char.cmi string.cmi
-string.cmx: pervasives.cmx list.cmx char.cmx string.cmi
stringLabels.cmo: string.cmi stringLabels.cmi
stringLabels.cmx: string.cmx stringLabels.cmi
+string.cmo: pervasives.cmi list.cmi char.cmi string.cmi
+string.cmx: pervasives.cmx list.cmx char.cmx string.cmi
sys.cmo: sys.cmi
sys.cmx: sys.cmi
weak.cmo: sys.cmi obj.cmi hashtbl.cmi array.cmi weak.cmi
diff --git a/stdlib/buffer.ml b/stdlib/buffer.ml
index 8dfe875993..0888409813 100644
--- a/stdlib/buffer.ml
+++ b/stdlib/buffer.ml
@@ -39,6 +39,14 @@ let sub b ofs len =
end
;;
+let blit src srcoff dst dstoff len =
+ if len < 0 || srcoff < 0 || srcoff > src.position - len
+ || dstoff < 0 || dstoff > (String.length dst) - len
+ then invalid_arg "Buffer.blit"
+ else
+ String.blit src.buffer srcoff dst dstoff len
+;;
+
let nth b ofs =
if ofs < 0 || ofs >= b.position then
invalid_arg "Buffer.nth"
diff --git a/stdlib/buffer.mli b/stdlib/buffer.mli
index d7afbb1833..32d15349e4 100644
--- a/stdlib/buffer.mli
+++ b/stdlib/buffer.mli
@@ -48,6 +48,15 @@ current contents of the buffer [b] starting at offset [off] of length
[len] bytes. May raise [Invalid_argument] if out of bounds request. The
buffer itself is unaffected. *)
+val blit : t -> int -> string -> int -> int -> unit
+(** [Buffer.blit src srcoff dst dstoff len] copies [len] characters from
+ the current contents of the buffer [src], starting at offset [srcoff]
+ to string [dst], starting at character [dstoff].
+
+ Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid
+ substring of [src], or if [dstoff] and [len] do not designate a valid
+ substring of [dst]. *)
+
val nth : t -> int -> char
(** get the n-th character of the buffer. Raise [Invalid_argument] if
index out of bounds *)
diff --git a/stdlib/filename.ml b/stdlib/filename.ml
index d3a68cf632..e11f1e3304 100644
--- a/stdlib/filename.ml
+++ b/stdlib/filename.ml
@@ -194,14 +194,14 @@ external close_desc: int -> unit = "caml_sys_close"
let prng = Random.State.make_self_init ();;
-let temp_file_name prefix suffix =
+let temp_file_name temp_dir prefix suffix =
let rnd = (Random.State.bits prng) land 0xFFFFFF in
- concat temp_dir_name (Printf.sprintf "%s%06x%s" prefix rnd suffix)
+ concat temp_dir (Printf.sprintf "%s%06x%s" prefix rnd suffix)
;;
-let temp_file prefix suffix =
+let temp_file ?(temp_dir=temp_dir_name) prefix suffix =
let rec try_name counter =
- let name = temp_file_name prefix suffix in
+ let name = temp_file_name temp_dir prefix suffix in
try
close_desc(open_desc name [Open_wronly; Open_creat; Open_excl] 0o600);
name
@@ -209,9 +209,9 @@ let temp_file prefix suffix =
if counter >= 1000 then raise e else try_name (counter + 1)
in try_name 0
-let open_temp_file ?(mode = [Open_text]) prefix suffix =
+let open_temp_file ?(mode = [Open_text]) ?(temp_dir=temp_dir_name) prefix suffix =
let rec try_name counter =
- let name = temp_file_name prefix suffix in
+ let name = temp_file_name temp_dir prefix suffix in
try
(name,
open_out_gen (Open_wronly::Open_creat::Open_excl::mode) 0o600 name)
diff --git a/stdlib/filename.mli b/stdlib/filename.mli
index 3a968e0a1f..e016609527 100644
--- a/stdlib/filename.mli
+++ b/stdlib/filename.mli
@@ -22,6 +22,9 @@ val parent_dir_name : string
(** The conventional name for the parent of the current directory
(e.g. [..] in Unix). *)
+val dir_sep : string
+(** The directory separator (e.g. [/] in Unix). *)
+
val concat : string -> string -> string
(** [concat dir file] returns a file name that designates file
[file] in directory [dir]. *)
@@ -68,11 +71,13 @@ val basename : string -> string
val dirname : string -> string
(** See {!Filename.basename}. *)
-val temp_file : string -> string -> string
+val temp_file : ?temp_dir: string -> string -> string -> string
(** [temp_file prefix suffix] returns the name of a
fresh temporary file in the temporary directory.
The base name of the temporary file is formed by concatenating
[prefix], then a suitably chosen integer number, then [suffix].
+ The optional argument [temp_dir] indicates the temporary directory
+ to use, defaulting to {!Filename.temp_dir_name}.
The temporary file is created empty, with permissions [0o600]
(readable and writable only by the file owner). The file is
guaranteed to be different from any other file that existed when
@@ -80,7 +85,7 @@ val temp_file : string -> string -> string
*)
val open_temp_file :
- ?mode: open_flag list -> string -> string -> string * out_channel
+ ?mode: open_flag list -> ?temp_dir: string -> string -> string -> string * out_channel
(** Same as {!Filename.temp_file}, but returns both the name of a fresh
temporary file, and an output channel opened (atomically) on
this file. This function is more secure than [temp_file]: there
diff --git a/stdlib/format.mli b/stdlib/format.mli
index dcb2ad4700..e805d83ce0 100644
--- a/stdlib/format.mli
+++ b/stdlib/format.mli
@@ -72,7 +72,6 @@
the evaluation order of printing commands.
*)
-
(** {6 Boxes} *)
val open_box : int -> unit;;
@@ -112,7 +111,6 @@ val print_char : char -> unit;;
val print_bool : bool -> unit;;
(** Prints a boolean in the current box. *)
-
(** {6 Break hints} *)
val print_space : unit -> unit;;
@@ -156,7 +154,6 @@ val print_if_newline : unit -> unit;;
has just been split. Otherwise, ignore the next formatting
command. *)
-
(** {6 Margin} *)
val set_margin : int -> unit;;
@@ -170,7 +167,6 @@ val set_margin : int -> unit;;
val get_margin : unit -> int;;
(** Returns the position of the right margin. *)
-
(** {6 Maximum indentation limit} *)
val set_max_indent : int -> unit;;
@@ -201,7 +197,6 @@ val get_max_boxes : unit -> int;;
val over_max_boxes : unit -> bool;;
(** Tests if the maximum number of boxes allowed have already been opened. *)
-
(** {6 Advanced formatting} *)
val open_hbox : unit -> unit;;
@@ -235,7 +230,6 @@ val open_hovbox : int -> unit;;
When a new line is printed in the box, [d] is added to the
current indentation. *)
-
(** {6 Tabulations} *)
val open_tbox : unit -> unit;;
@@ -260,8 +254,7 @@ val set_tab : unit -> unit;;
(** Sets a tabulation mark at the current insertion point. *)
val print_tab : unit -> unit;;
-(** [print_tab ()] is equivalent to [print_tbreak (0,0)]. *)
-
+(** [print_tab ()] is equivalent to [print_tbreak 0 0]. *)
(** {6 Ellipsis} *)
@@ -272,14 +265,13 @@ val set_ellipsis_text : string -> unit;;
val get_ellipsis_text : unit -> string;;
(** Return the text of the ellipsis. *)
-
-(** {6 Tags} *)
+(** {6 Semantics Tags} *)
type tag = string;;
-(** Tags are used to decorate printed entities for user's defined
- purposes, e.g. setting font and giving size indications for a
- display device, or marking delimitations of semantics entities
+(** {i Semantics tags} (or simply {e tags}) are used to decorate printed
+ entities for user's defined purposes, e.g. setting font and giving size
+ indications for a display device, or marking delimitation of semantics entities
(e.g. HTML or TeX elements or terminal escape sequences).
By default, those tags do not influence line breaking calculation:
@@ -293,7 +285,7 @@ type tag = string;;
material or richer decorated output depending on the treatment of
tags. By default, tags are not active, hence the output is not
decorated with tag information. Once [set_tags] is set to [true],
- the pretty printer engine honors tags and decorates the output
+ the pretty printer engine honours tags and decorates the output
accordingly.
When a tag has been opened (or closed), it is both and successively
@@ -345,10 +337,9 @@ val get_print_tags : unit -> bool;;
val get_mark_tags : unit -> bool;;
(** Return the current status of tags printing and tags marking. *)
+(** {6 Redirecting the standard formatter output} *)
-(** {6 Redirecting formatter output} *)
-
-val set_formatter_out_channel : out_channel -> unit;;
+val set_formatter_out_channel : Pervasives.out_channel -> unit;;
(** Redirect the pretty-printer output to the given channel. *)
val set_formatter_output_functions :
@@ -356,17 +347,56 @@ val set_formatter_output_functions :
(** [set_formatter_output_functions out flush] redirects the
pretty-printer output to the functions [out] and [flush].
- The [out] function performs the pretty-printer output. It is called
+ The [out] function performs the pretty-printer string output. It is called
with a string [s], a start position [p], and a number of characters
[n]; it is supposed to output characters [p] to [p + n - 1] of
[s]. The [flush] function is called whenever the pretty-printer is
- flushed using [print_flush] or [print_newline]. *)
+ flushed (via conversion [%!], pretty-printing indications [@?] or [@.],
+ or using low level function [print_flush] or [print_newline]). *)
val get_formatter_output_functions :
unit -> (string -> int -> int -> unit) * (unit -> unit);;
(** Return the current output functions of the pretty-printer. *)
-(** {6 Changing the meaning of printing tags} *)
+(** {6 Changing the meaning of standard formatter pretty printing} *)
+
+(** The [Format] module is versatile enough to let you completely redefine
+ the meaning of pretty printing: you may provide your own functions to define
+ how to handle indentation, line breaking, and even printing of all the
+ characters that have to be printed! *)
+
+val set_all_formatter_output_functions :
+ out:(string -> int -> int -> unit) ->
+ flush:(unit -> unit) ->
+ newline:(unit -> unit) ->
+ spaces:(int -> unit) ->
+ unit;;
+(** [set_all_formatter_output_functions out flush outnewline outspace]
+ redirects the pretty-printer output to the functions [out] and
+ [flush] as described in [set_formatter_output_functions]. In
+ addition, the pretty-printer function that outputs a newline is set
+ to the function [outnewline] and the function that outputs
+ indentation spaces is set to the function [outspace].
+
+ This way, you can change the meaning of indentation (which can be
+ something else than just printing space characters) and the
+ meaning of new lines opening (which can be connected to any other
+ action needed by the application at hand). The two functions
+ [outspace] and [outnewline] are normally connected to [out] and
+ [flush]: respective default values for [outspace] and [outnewline]
+ are [out (String.make n ' ') 0 n] and [out "\n" 0 1]. *)
+
+val get_all_formatter_output_functions :
+ unit ->
+ (string -> int -> int -> unit) *
+ (unit -> unit) *
+ (unit -> unit) *
+ (int -> unit);;
+(** Return the current output functions of the pretty-printer,
+ including line breaking and indentation functions. Useful to record the
+ current setting and restore it afterwards. *)
+
+(** {6 Changing the meaning of printing semantics tags} *)
type formatter_tag_functions = {
mark_open_tag : tag -> string;
@@ -403,56 +433,22 @@ val get_formatter_tag_functions :
unit -> formatter_tag_functions;;
(** Return the current tag functions of the pretty-printer. *)
-(** {6 Changing the meaning of pretty printing (indentation, line breaking,
- and printing material)} *)
-
-val set_all_formatter_output_functions :
- out:(string -> int -> int -> unit) ->
- flush:(unit -> unit) ->
- newline:(unit -> unit) ->
- spaces:(int -> unit) ->
- unit;;
-(** [set_all_formatter_output_functions out flush outnewline outspace]
- redirects the pretty-printer output to the functions [out] and
- [flush] as described in [set_formatter_output_functions]. In
- addition, the pretty-printer function that outputs a newline is set
- to the function [outnewline] and the function that outputs
- indentation spaces is set to the function [outspace].
-
- This way, you can change the meaning of indentation (which can be
- something else than just printing space characters) and the
- meaning of new lines opening (which can be connected to any other
- action needed by the application at hand). The two functions
- [outspace] and [outnewline] are normally connected to [out] and
- [flush]: respective default values for [outspace] and [outnewline]
- are [out (String.make n ' ') 0 n] and [out "\n" 0 1]. *)
-
-val get_all_formatter_output_functions :
- unit ->
- (string -> int -> int -> unit) *
- (unit -> unit) *
- (unit -> unit) *
- (int -> unit);;
-(** Return the current output functions of the pretty-printer,
- including line breaking and indentation functions. *)
-
-
(** {6 Multiple formatted output} *)
type formatter;;
(** Abstract data type corresponding to a pretty-printer (also called a
- formatter) and all its machinery.
- Defining new pretty-printers permits the output of
- material in parallel on several channels.
- Parameters of a pretty-printer are local to this pretty-printer:
- margin, maximum indentation limit, maximum number of boxes
- simultaneously opened, ellipsis, and so on, are specific to
- each pretty-printer and may be fixed independently.
- Given an output channel [oc], a new formatter writing to
- that channel is obtained by calling [formatter_of_out_channel oc].
- Alternatively, the [make_formatter] function allocates a new
- formatter with explicit output and flushing functions
- (convenient to output material to strings for instance). *)
+ formatter) and all its machinery.
+ Defining new pretty-printers permits the output of
+ material in parallel on several channels.
+ Parameters of a pretty-printer are local to this pretty-printer:
+ margin, maximum indentation limit, maximum number of boxes
+ simultaneously opened, ellipsis, and so on, are specific to
+ each pretty-printer and may be fixed independently.
+ Given an output channel [oc], a new formatter writing to
+ that channel is obtained by calling [formatter_of_out_channel oc].
+ Alternatively, the [make_formatter] function allocates a new
+ formatter with explicit output and flushing functions
+ (convenient to output material to strings for instance). *)
val formatter_of_out_channel : out_channel -> formatter;;
(** [formatter_of_out_channel oc] returns a new formatter that
diff --git a/stdlib/obj.ml b/stdlib/obj.ml
index 9685be38ff..922febd65c 100644
--- a/stdlib/obj.ml
+++ b/stdlib/obj.ml
@@ -27,9 +27,12 @@ external set_tag : t -> int -> unit = "caml_obj_set_tag"
external size : t -> int = "%obj_size"
external field : t -> int -> t = "%obj_field"
external set_field : t -> int -> t -> unit = "%obj_set_field"
+let double_field x i = Array.get (obj x : float array) i
+let set_double_field x i v = Array.set (obj x : float array) i v
external new_block : int -> int -> t = "caml_obj_block"
external dup : t -> t = "caml_obj_dup"
external truncate : t -> int -> unit = "caml_obj_truncate"
+external add_offset : t -> int -> t = "caml_obj_add_offset"
let marshal (obj : t) =
Marshal.to_string obj []
diff --git a/stdlib/obj.mli b/stdlib/obj.mli
index a35b119bde..34b78fdb4a 100644
--- a/stdlib/obj.mli
+++ b/stdlib/obj.mli
@@ -28,11 +28,14 @@ external is_int : t -> bool = "%obj_is_int"
external tag : t -> int = "caml_obj_tag"
external set_tag : t -> int -> unit = "caml_obj_set_tag"
external size : t -> int = "%obj_size"
-external truncate : t -> int -> unit = "caml_obj_truncate"
external field : t -> int -> t = "%obj_field"
external set_field : t -> int -> t -> unit = "%obj_set_field"
+val double_field : t -> int -> float
+val set_double_field : t -> int -> float -> unit
external new_block : int -> int -> t = "caml_obj_block"
external dup : t -> t = "caml_obj_dup"
+external truncate : t -> int -> unit = "caml_obj_truncate"
+external add_offset : t -> int -> t = "caml_obj_add_offset"
val lazy_tag : int
val closure_tag : int
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
index 9e34cf2fd4..7cc4ba6144 100644
--- a/stdlib/pervasives.ml
+++ b/stdlib/pervasives.ml
@@ -398,7 +398,7 @@ external incr: int ref -> unit = "%incr"
external decr: int ref -> unit = "%decr"
(* Formats *)
-type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
+type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
@@ -416,7 +416,8 @@ let (( ^^ ) :
('f, 'b, 'c, 'e, 'g, 'h) format6 ->
('a, 'b, 'c, 'd, 'g, 'h) format6) =
fun fmt1 fmt2 ->
- string_to_format (format_to_string fmt1 ^ format_to_string fmt2);;
+ string_to_format (format_to_string fmt1 ^ "%," ^ format_to_string fmt2)
+;;
let string_of_format fmt =
let s = format_to_string fmt in
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index 97ee3c94b8..c788901ce0 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -71,7 +71,7 @@ external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
The ordering is compatible with [(=)]. As in the case
of [(=)], mutable structures are compared by contents.
Comparison between functional values raises [Invalid_argument].
- Comparison between cyclic structures does not terminate. *)
+ Comparison between cyclic structures may not terminate. *)
external compare : 'a -> 'a -> int = "%compare"
(** [compare x y] returns [0] if [x] is equal to [y],
@@ -93,10 +93,14 @@ external compare : 'a -> 'a -> int = "%compare"
the {!List.sort} and {!Array.sort} functions. *)
val min : 'a -> 'a -> 'a
-(** Return the smaller of the two arguments. *)
+(** Return the smaller of the two arguments.
+ The result is unspecified if one of the arguments contains
+ the float value [nan]. *)
val max : 'a -> 'a -> 'a
-(** Return the greater of the two arguments. *)
+(** Return the greater of the two arguments.
+ The result is unspecified if one of the arguments contains
+ the float value [nan]. *)
external ( == ) : 'a -> 'a -> bool = "%eq"
(** [e1 == e2] tests for physical equality of [e1] and [e2].
@@ -226,8 +230,8 @@ external ( asr ) : int -> int -> int = "%asrint"
[neg_infinity] for [-1.0 /. 0.0], and [nan] (``not a number'')
for [0.0 /. 0.0]. These special numbers then propagate through
floating-point computations as expected: for instance,
- [1.0 /. infinity] is [0.0], and any operation with [nan] as
- argument returns [nan] as result.
+ [1.0 /. infinity] is [0.0], and any arithmetic operation with [nan]
+ as argument returns [nan] as result.
*)
external ( ~-. ) : float -> float = "%negfloat"
diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml
index f06717c274..11e7d4fd6e 100644
--- a/stdlib/printexc.ml
+++ b/stdlib/printexc.ml
@@ -15,6 +15,8 @@
open Printf;;
+let printers = ref []
+
let locfmt = format_of_string "File \"%s\", line %d, characters %d-%d: %s";;
let field x i =
@@ -48,9 +50,16 @@ let to_string = function
| Assert_failure(file, line, char) ->
sprintf locfmt file line char (char+6) "Assertion failed"
| x ->
- let x = Obj.repr x in
- let constructor = (Obj.magic(Obj.field (Obj.field x 0) 0) : string) in
- constructor ^ (fields x)
+ let rec conv = function
+ | hd :: tl ->
+ (match try hd x with _ -> None with
+ | Some s -> s
+ | None -> conv tl)
+ | [] ->
+ let x = Obj.repr x in
+ let constructor = (Obj.magic(Obj.field (Obj.field x 0) 0) : string) in
+ constructor ^ (fields x) in
+ conv !printers
;;
let print fct arg =
@@ -125,3 +134,5 @@ let get_backtrace () =
external record_backtrace: bool -> unit = "caml_record_backtrace"
external backtrace_status: unit -> bool = "caml_backtrace_status"
+let register_printer fn =
+ printers := fn :: !printers
diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli
index a3ae6ba7b4..99729e10fd 100644
--- a/stdlib/printexc.mli
+++ b/stdlib/printexc.mli
@@ -57,3 +57,13 @@ val record_backtrace: bool -> unit
val backtrace_status: unit -> bool
(** [Printexc.backtrace_status()] returns [true] if exception
backtraces are currently recorded, [false] if not. *)
+
+val register_printer : (exn -> string option) -> unit
+(** [Printexc.register_printer fn] registers [fn] as an exception printer.
+ The printer should return [None] if it does not know how to convert
+ the passed exception, and [Some s] with [s] the resulting string if
+ it can convert the passed exception.
+ When converting an exception into a string, the printers will be invoked
+ in the reverse order of their registrations, until a printer returns
+ a [Some s] value (if no such printer exists, the runtime will use a
+ generic printer). *)
diff --git a/stdlib/printf.ml b/stdlib/printf.ml
index a061af7359..6bdd1c15a8 100644
--- a/stdlib/printf.ml
+++ b/stdlib/printf.ml
@@ -39,8 +39,8 @@ module Sformat = struct
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);;
+ (* Literal position are one-based (hence pred p instead of p). *)
+ let index_of_literal_position p = index_of_int (pred p);;
external length : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int
= "%string_length"
@@ -122,12 +122,12 @@ let extract_format fmt start stop widths =
let skip_positional_spec start =
match Sformat.unsafe_get fmt start with
| '0'..'9' ->
- let rec skip_int_litteral i =
+ let rec skip_int_literal i =
match Sformat.unsafe_get fmt i with
- | '0'..'9' -> skip_int_litteral (succ i)
+ | '0'..'9' -> skip_int_literal (succ i)
| '$' -> succ i
| _ -> start in
- skip_int_litteral (succ start)
+ skip_int_literal (succ start)
| _ -> start in
let start = skip_positional_spec (succ start) in
let b = Buffer.create (stop - start + 10) in
@@ -140,7 +140,7 @@ let extract_format fmt start stop widths =
let i = skip_positional_spec (succ i) in
fill_format i t
| ('*', []) ->
- assert false (* should not happen *)
+ assert false (* Should not happen since this is ill-typed. *)
| (c, _) ->
Buffer.add_char b c;
fill_format (succ i) widths in
@@ -161,7 +161,7 @@ let extract_format_float conv fmt start stop widths =
let sfmt = extract_format fmt start stop widths in
match conv with
| 'F' ->
- sfmt.[String.length sfmt - 1] <- 'f';
+ sfmt.[String.length sfmt - 1] <- 'g';
sfmt
| _ -> sfmt
;;
@@ -169,7 +169,7 @@ let extract_format_float conv fmt start stop widths =
(* Returns the position of the next character following the meta format
string, starting from position [i], inside a given format [fmt].
According to the character [conv], the meta format string is
- enclosed by the delimitors %{ and %} (when [conv = '{']) or %( and
+ enclosed by the delimiters %{ and %} (when [conv = '{']) or %( and
%) (when [conv = '(']). Hence, [sub_format] returns the index of
the character following the [')'] or ['}'] that ends the meta format,
according to the character [conv]. *)
@@ -215,7 +215,7 @@ let iter_on_format_args fmt add_conv add_char =
and scan_conv skip i =
if i > lim then incomplete_format fmt else
match Sformat.unsafe_get fmt i with
- | '%' | '!' -> succ i
+ | '%' | '!' | ',' -> succ i
| 's' | 'S' | '[' -> add_conv skip i 's'
| 'c' | 'C' -> add_conv skip i 'c'
| 'd' | 'i' |'o' | 'u' | 'x' | 'X' | 'N' -> add_conv skip i 'i'
@@ -307,6 +307,7 @@ let ac_of_format fmt =
let count_arguments_of_format fmt =
let ac = ac_of_format fmt in
+ (* For printing only regular arguments have to be counted. *)
ac.ac_rglr
;;
@@ -384,7 +385,7 @@ type positional_specification =
Unfortunately, the type of a parameter specified via a [*$] positional
specification should be the type of the corresponding argument to
- [printf], hence this sould be the type of the $n$-th argument to [printf]
+ [printf], hence this should be the type of the $n$-th argument to [printf]
with $n$ being the {\em value} of the integer argument defining [*]; we
clearly cannot statically guess the value of this parameter in the general
case. Put it another way: this means type dependency, which is completely
@@ -393,19 +394,19 @@ type positional_specification =
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 =
+ let rec get_int_literal accu j =
match Sformat.unsafe_get fmt j with
| '0'..'9' as d ->
- get_int_litteral (10 * accu + (int_of_char d - 48)) (succ j)
+ get_int_literal (10 * accu + (int_of_char d - 48)) (succ j)
| '$' ->
if accu = 0 then
failwith "printf: bad positional specification (0)." else
- got_spec (Spec_index (Sformat.index_of_litteral_position accu)) (succ j)
+ got_spec (Spec_index (Sformat.index_of_literal_position accu)) (succ j)
(* Not a positional specification: tell so the caller, and go back to
scanning the format from the original [i] position we were called at
first. *)
| _ -> got_spec Spec_none i in
- get_int_litteral (int_of_char d - 48) (succ i)
+ get_int_literal (int_of_char d - 48) (succ i)
(* No positional specification: tell so the caller, and go back to scanning
the format from the original [i] position. *)
| _ -> got_spec Spec_none i
@@ -427,15 +428,12 @@ let get_index spec n =
| Spec_index p -> p
;;
-(* Format a float argument as a valid Caml lexem. *)
-let format_float_lexem =
- let valid_float_lexem sfmt s =
+(* Format a float argument as a valid Caml lexeme. *)
+let format_float_lexeme =
+ let valid_float_lexeme sfmt s =
let l = String.length s in
if l = 0 then "nan" else
- let add_dot sfmt s =
- if s.[0] = ' ' || s.[0] = '+' || s.[0] = '0'
- then String.sub s 1 (l - 1) ^ "."
- else String.sub s 0 (l - 1) ^ "." in
+ let add_dot sfmt s = s ^ "." in
let rec loop i =
if i >= l then add_dot sfmt s else
@@ -448,7 +446,7 @@ let format_float_lexem =
(fun sfmt x ->
let s = format_float sfmt x in
match classify_float x with
- | FP_normal | FP_subnormal | FP_zero -> valid_float_lexem sfmt s
+ | FP_normal | FP_subnormal | FP_zero -> valid_float_lexeme sfmt s
| FP_nan | FP_infinite -> s)
;;
@@ -470,8 +468,8 @@ let format_float_lexem =
(* Note: here, rather than test explicitly against [Sformat.length fmt]
to detect the end of the format, we use [Sformat.unsafe_get] and
- rely on the fact that we'll get a "nul" character if we access
- one past the end of the string. These "nul" characters are then
+ rely on the fact that we'll get a "null" character if we access
+ one past the end of the string. These "null" characters are then
caught by the [_ -> bad_conversion] clauses below.
Don't do this at home, kids. *)
let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
@@ -502,7 +500,7 @@ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
let (x : string) = get_arg spec n in
let x = if conv = 's' then x else "\"" ^ String.escaped x ^ "\"" in
let s =
- (* optimize for common case %s *)
+ (* Optimize for common case %s *)
if i = succ pos then x else
format_string (extract_format fmt pos i widths) x in
cont_s (next_index spec n) s (succ i)
@@ -523,7 +521,8 @@ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
| 'F' as conv ->
let (x : float) = get_arg spec n in
let s =
- format_float_lexem (extract_format_float conv fmt pos i widths) x in
+ if widths = [] then Pervasives.string_of_float x else
+ format_float_lexeme (extract_format_float conv fmt pos i widths) x in
cont_s (next_index spec n) s (succ i)
| 'B' | 'b' ->
let (x : bool) = get_arg spec n in
@@ -560,6 +559,7 @@ let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
let s = format_int (extract_format_int 'n' fmt pos i widths) x in
cont_s (next_index spec n) s (succ i)
end
+ | ',' -> cont_s n "" (succ i)
| '!' -> cont_f n (succ i)
| '{' | '(' as conv (* ')' '}' *) ->
let (xf : ('a, 'b, 'c, 'd, 'e, 'f) format6) = get_arg spec n in
diff --git a/stdlib/printf.mli b/stdlib/printf.mli
index 059779922b..43106505a3 100644
--- a/stdlib/printf.mli
+++ b/stdlib/printf.mli
@@ -78,6 +78,7 @@ val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a
type as [fmt].
- [!]: take no argument and flush the output.
- [%]: take no argument and output one [%] character.
+ - [,]: the no-op delimiter for conversion specifications.
The optional [flags] are:
- [-]: left-justify the output (default is right justification).
diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml
index 88a0f97f82..7cd018d3fb 100644
--- a/stdlib/scanf.ml
+++ b/stdlib/scanf.ml
@@ -47,16 +47,16 @@ val checked_peek_char : scanbuf -> char;;
input buffer has reached an end of file, the function raises exception
[End_of_file]. *)
-val store_char : scanbuf -> char -> int -> int;;
-(* [Scanning.store_char ib c lim] adds [c] to the token buffer
+val store_char : int -> scanbuf -> char -> int;;
+(* [Scanning.store_char lim ib c] adds [c] to the token buffer
of the scanning buffer. It also advances the scanning buffer for one
character and returns [lim - 1], indicating the new limit
for the length of the current token. *)
-val skip_char : scanbuf -> int -> int;;
-(* [Scanning.skip_char ib lim] ignores the current character. *)
+val skip_char : int -> scanbuf -> int;;
+(* [Scanning.skip_char lim ib] ignores the current character. *)
-val ignore_char : scanbuf -> int -> int;;
+val ignore_char : int -> scanbuf -> int;;
(* [Scanning.ignore_char ib lim] ignores the current character and
decrements the limit. *)
@@ -186,16 +186,16 @@ let token ib =
let token_count ib = ib.token_count;;
-let skip_char ib max =
+let skip_char max ib =
invalidate_current_char ib;
max
;;
-let ignore_char ib max = skip_char ib (max - 1);;
+let ignore_char max ib = skip_char (max - 1) ib;;
-let store_char ib c max =
+let store_char max ib c =
Buffer.add_char ib.tokbuf c;
- ignore_char ib max
+ ignore_char max ib
;;
let default_token_buffer_size = 1024;;
@@ -379,8 +379,8 @@ let incomplete_format fmt =
(Sformat.to_string fmt))
;;
-let bad_float () = bad_input "no dot or exponent part found in
-float token"
+let bad_float () =
+ bad_input "no dot or exponent part found in float token"
;;
let character_mismatch_err c ci =
@@ -407,11 +407,18 @@ let compatible_format_type fmt1 fmt2 =
In this case, the character c has been explicitely specified in the
format as being mandatory in the input; hence we should fail with
End_of_file in case of end_of_input.
- That's why we use checked_peek_char here. *)
-let check_char ib c =
+ That's why we use checked_peek_char here.
+ We are also careful to treat "\r\n" in the input as a end of line marker: it
+ always matches a '\n' specification in the input format string.
+ *)
+let rec check_char ib c =
let ci = Scanning.checked_peek_char ib in
- if ci = c then Scanning.invalidate_current_char ib else
- character_mismatch c ci
+ if ci = c then Scanning.invalidate_current_char ib else begin
+ match ci with
+ | '\r' when c = '\n' ->
+ Scanning.invalidate_current_char ib; check_char ib '\n'
+ | _ -> character_mismatch c ci
+ end
;;
(* Checks that the current char is indeed one of the stopper characters,
@@ -500,10 +507,10 @@ 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
+ let max = Scanning.store_char max ib c in
scan_decimal_digits max ib
| '_' ->
- let max = Scanning.ignore_char ib max in
+ let max = Scanning.ignore_char max ib in
scan_decimal_digits max ib
| _ -> max
;;
@@ -512,7 +519,7 @@ let scan_decimal_digits_plus max ib =
let c = Scanning.checked_peek_char ib in
match c with
| '0' .. '9' ->
- let max = Scanning.store_char ib c max in
+ let max = Scanning.store_char max ib c in
scan_decimal_digits max ib
| c -> bad_input_char c
;;
@@ -526,16 +533,16 @@ 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
+ let max = Scanning.store_char max ib c in
scan_digits max
| '_' ->
- let max = Scanning.ignore_char ib max in
+ let max = Scanning.ignore_char max ib in
scan_digits max
| _ -> max in
let c = Scanning.checked_peek_char ib in
if digitp c then
- let max = Scanning.store_char ib c max in
+ let max = Scanning.store_char max ib c in
scan_digits max
else bad_input_char c
;;
@@ -567,8 +574,8 @@ let scan_unsigned_decimal_int = scan_decimal_digits_plus;;
let scan_sign max ib =
let c = Scanning.checked_peek_char ib in
match c with
- | '+' -> Scanning.store_char ib c max
- | '-' -> Scanning.store_char ib c max
+ | '+' -> Scanning.store_char max ib c
+ | '-' -> Scanning.store_char max ib c
| c -> max
;;
@@ -584,14 +591,14 @@ 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
+ let max = Scanning.store_char max ib c 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
+ | 'x' | 'X' -> scan_hexadecimal_int (Scanning.store_char max ib c) ib
+ | 'o' -> scan_octal_int (Scanning.store_char max ib c) ib
+ | 'b' -> scan_binary_int (Scanning.store_char max ib c) ib
| c -> scan_decimal_digits max ib end
| c -> scan_unsigned_decimal_int max ib
;;
@@ -620,7 +627,7 @@ let scan_frac_part max ib =
if Scanning.eof ib then max else
match c with
| '0' .. '9' as c ->
- scan_decimal_digits (Scanning.store_char ib c max) ib
+ scan_decimal_digits (Scanning.store_char max ib c) ib
| _ -> max
;;
@@ -631,7 +638,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 max ib c) ib
| _ -> max
;;
@@ -651,7 +658,7 @@ 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 = Scanning.store_char max ib c in
let max = scan_frac_part max ib in
scan_exp_part max ib
| c -> scan_exp_part max ib
@@ -664,7 +671,7 @@ 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 = Scanning.store_char max ib c in
let max = scan_frac_part max ib in
scan_exp_part max ib
| 'e' | 'E' ->
@@ -683,15 +690,15 @@ let scan_string stp max ib =
if stp = [] then
match c with
| ' ' | '\t' | '\n' | '\r' -> max
- | c -> loop (Scanning.store_char ib c max) else
- if List.memq c stp then Scanning.skip_char ib max else
- loop (Scanning.store_char ib c max) in
+ | c -> loop (Scanning.store_char max ib c) else
+ if List.memq c stp then Scanning.skip_char max ib else
+ loop (Scanning.store_char max ib c) in
loop max
;;
(* Scan a char: peek strictly one character in the input, whatsoever. *)
let scan_char max ib =
- Scanning.store_char ib (Scanning.checked_peek_char ib) max
+ Scanning.store_char max ib (Scanning.checked_peek_char ib)
;;
let char_for_backslash = function
@@ -704,27 +711,58 @@ let char_for_backslash = function
(* The integer value corresponding to the facial value of a valid
decimal digit character. *)
-let int_value_of_char c = int_of_char c - 48;;
+let decimal_value_of_char c = int_of_char c - int_of_char '0';;
let char_for_decimal_code c0 c1 c2 =
let c =
- 100 * int_value_of_char c0 +
- 10 * int_value_of_char c1 +
- int_value_of_char c2 in
+ 100 * decimal_value_of_char c0 +
+ 10 * decimal_value_of_char c1 +
+ decimal_value_of_char c2 in
if c < 0 || c > 255
then bad_input (Printf.sprintf "bad char \\%c%c%c" c0 c1 c2)
else char_of_int c
;;
+(* The integer value corresponding to the facial value of a valid
+ hexadecimal digit character. *)
+let hexadecimal_value_of_char c =
+ let d = int_of_char c in
+ (* Could also be:
+ if d <= int_of_char '9' then d - int_of_char '0' else
+ if d <= int_of_char 'F' then 10 + d - int_of_char 'A' else
+ if d <= int_of_char 'f' then 10 + d - int_of_char 'a' else assert false
+ *)
+ if d >= int_of_char 'a' then
+ d - 87 (* 10 + int_of_char c - int_of_char 'a' *) else
+ if d >= int_of_char 'A' then
+ d - 55 (* 10 + int_of_char c - int_of_char 'A' *) else
+ d - int_of_char '0'
+;;
+
+let char_for_hexadecimal_code c1 c2 =
+ let c =
+ 16 * hexadecimal_value_of_char c1 +
+ hexadecimal_value_of_char c2 in
+ if c < 0 || c > 255
+ then bad_input (Printf.sprintf "bad char \\%c%c" c1 c2)
+ else char_of_int c
+;;
+
(* Called when encountering '\\' as starter of a char.
Stops before the corresponding '\''. *)
-let scan_backslash_char max ib =
- if max = 0 then bad_input "a char" else
+let check_next_char message max ib =
+ if max = 0 then bad_input message else
let c = Scanning.peek_char ib in
- 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
+ if Scanning.eof ib then bad_input message else c
+;;
+
+let check_next_char_for_char = check_next_char "a char";;
+let check_next_char_for_string = check_next_char "a string";;
+
+let scan_backslash_char max ib =
+ match check_next_char_for_char max ib with
+ | '\\' | '\'' | '\"' | 'n' | 't' | 'b' | 'r' as c ->
+ Scanning.store_char max ib (char_for_backslash c)
| '0' .. '9' as c ->
let get_digit () =
let c = Scanning.next_char ib in
@@ -734,57 +772,69 @@ let scan_backslash_char max ib =
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)
+ Scanning.store_char (max - 2) ib (char_for_decimal_code c0 c1 c2)
+ | 'x' ->
+ let get_digit () =
+ let c = Scanning.next_char ib in
+ match c with
+ | '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' as c -> c
+ | c -> bad_input_escape c in
+ let c1 = get_digit () in
+ let c2 = get_digit () in
+ Scanning.store_char (max - 2) ib (char_for_hexadecimal_code c1 c2)
| c -> bad_input_char c
;;
let scan_Char max ib =
- let rec loop s max =
- if max = 0 then bad_input "a char" else
- let c = Scanning.checked_peek_char ib in
- if Scanning.eof ib then bad_input "a char" else
- match c, s with
- (* Looking for the '\'' at the beginning of the delimited char. *)
- | '\'', 3 -> loop 2 (Scanning.ignore_char ib max)
- (* Looking for the '\'' at the end of the delimited char. *)
- | '\'', 1 -> Scanning.ignore_char ib max
- (* Any other char at the beginning or end of the delimited char should be
- '\''. *)
- | c, (3 | 1) -> character_mismatch '\'' c
- (* Found a '\\': check and read this escape char. *)
- | '\\', 2 -> loop 1 (scan_backslash_char (Scanning.ignore_char ib max) ib)
- (* The regular case, remember the char, then look for the terminal '\\'. *)
- | c, 2 -> loop 1 (Scanning.store_char ib c max)
- (* Any other case is an error, *)
- | c, _ -> bad_input_char c in
- loop 3 max
+
+ let rec find_start max =
+ match check_next_char_for_char max ib with
+ | '\'' -> find_char (Scanning.ignore_char max ib)
+ | c -> character_mismatch '\'' c
+
+ and find_char max =
+ match check_next_char_for_char max ib with
+ | '\\' -> find_stop (scan_backslash_char (Scanning.ignore_char max ib) ib)
+ | c -> find_stop (Scanning.store_char max ib c)
+
+ and find_stop max =
+ match check_next_char_for_char max ib with
+ | '\'' -> Scanning.ignore_char max ib
+ | c -> character_mismatch '\'' c in
+
+ find_start max
;;
let scan_String max ib =
- let rec loop s max =
- if max = 0 then bad_input "a string" else
- let c = Scanning.checked_peek_char ib in
- if Scanning.eof ib then bad_input "a string" else
- match c, s with
- | '"', true (* '"' helping Emacs *) ->
- loop false (Scanning.ignore_char ib max)
- | '"', false (* '"' helping Emacs *) ->
- Scanning.ignore_char ib max
- | '\\', false ->
- 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 =
- if max = 0 then bad_input "a string" else
- let c = Scanning.checked_peek_char ib in
- if Scanning.eof ib then bad_input "a string" else
- match c, s with
- | '\n', true
- | ' ', false ->
- skip_spaces false (Scanning.ignore_char ib max)
- | c, false -> loop false max
- | _, _ -> loop false (scan_backslash_char (max - 1) ib) in
- loop true max
+
+ let rec find_start max =
+ match check_next_char_for_string max ib with
+ | '\"' -> find_stop (Scanning.ignore_char max ib)
+ | c -> character_mismatch '\"' c
+
+ and find_stop max =
+ match check_next_char_for_string max ib with
+ | '\"' -> Scanning.ignore_char max ib
+ | '\\' -> scan_backslash (Scanning.ignore_char max ib)
+ | c -> find_stop (Scanning.store_char max ib c)
+
+ and scan_backslash max =
+ match check_next_char_for_string max ib with
+ | '\r' -> skip_newline (Scanning.ignore_char max ib)
+ | '\n' -> skip_spaces (Scanning.ignore_char max ib)
+ | c -> find_stop (scan_backslash_char max ib)
+
+ and skip_newline max =
+ match check_next_char_for_string max ib with
+ | '\n' -> skip_spaces (Scanning.ignore_char max ib)
+ | _ -> find_stop (Scanning.store_char max ib '\r')
+
+ and skip_spaces max =
+ match check_next_char_for_string max ib with
+ | ' ' -> skip_spaces (Scanning.ignore_char max ib)
+ | _ -> find_stop max in
+
+ find_start max
;;
let scan_bool max ib =
@@ -964,49 +1014,49 @@ let scan_chars_in_char_set stp char_set max ib =
let c = Scanning.peek_char ib in
if Scanning.eof ib then max else
if c == cp1
- then loop_pos1 cp1 (Scanning.store_char ib c max)
+ then loop_pos1 cp1 (Scanning.store_char max ib c)
else max
and loop_pos2 cp1 cp2 max =
if max = 0 then max else
let c = Scanning.peek_char ib in
if Scanning.eof ib then max else
if c == cp1 || c == cp2
- then loop_pos2 cp1 cp2 (Scanning.store_char ib c max)
+ then loop_pos2 cp1 cp2 (Scanning.store_char max ib c)
else max
and loop_pos3 cp1 cp2 cp3 max =
if max = 0 then max else
let c = Scanning.peek_char ib in
if Scanning.eof ib then max else
if c == cp1 || c == cp2 || c == cp3
- then loop_pos3 cp1 cp2 cp3 (Scanning.store_char ib c max)
+ then loop_pos3 cp1 cp2 cp3 (Scanning.store_char max ib c)
else max
and loop_neg1 cp1 max =
if max = 0 then max else
let c = Scanning.peek_char ib in
if Scanning.eof ib then max else
if c != cp1
- then loop_neg1 cp1 (Scanning.store_char ib c max)
+ then loop_neg1 cp1 (Scanning.store_char max ib c)
else max
and loop_neg2 cp1 cp2 max =
if max = 0 then max else
let c = Scanning.peek_char ib in
if Scanning.eof ib then max else
if c != cp1 && c != cp2
- then loop_neg2 cp1 cp2 (Scanning.store_char ib c max)
+ then loop_neg2 cp1 cp2 (Scanning.store_char max ib c)
else max
and loop_neg3 cp1 cp2 cp3 max =
if max = 0 then max else
let c = Scanning.peek_char ib in
if Scanning.eof ib then max else
if c != cp1 && c != cp2 && c != cp3
- then loop_neg3 cp1 cp2 cp3 (Scanning.store_char ib c max)
+ then loop_neg3 cp1 cp2 cp3 (Scanning.store_char max ib c)
else max
and loop setp max =
if max = 0 then max else
let c = Scanning.peek_char ib in
if Scanning.eof ib then max else
if setp c == 1
- then loop setp (Scanning.store_char ib c max)
+ then loop setp (Scanning.store_char max ib c)
else max in
let max =
@@ -1175,25 +1225,27 @@ let scan_format ib ef fmt rv f =
if ir > limr then assert false else
let token = Obj.magic rv.(ir) ib in
scan_fmt (succ ir) (stack f token) (succ i)
- | 'l' | 'n' | 'L' as conv ->
+ | 'l' | 'n' | 'L' as conv0 ->
let i = succ i in
- if i > lim then scan_fmt ir (stack f (get_count conv ib)) i else begin
+ if i > lim then scan_fmt ir (stack f (get_count conv0 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
+ | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv1 ->
+ let _x = scan_int_conv conv1 max ib in
(* Look back to the character that triggered the integer conversion
- (this character is either 'l', 'n' or 'L'), to find the
+ (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
+ begin match conv0 with
+ | 'l' -> scan_fmt ir (stack f (token_int32 conv1 ib)) (succ i)
+ | 'n' -> scan_fmt ir (stack f (token_nativeint conv1 ib)) (succ i)
+ | _ -> scan_fmt ir (stack f (token_int64 conv1 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
+ | _ -> scan_fmt ir (stack f (get_count conv0 ib)) i end
| '!' ->
if Scanning.end_of_input ib then scan_fmt ir f (succ i)
else bad_input "end of input not found"
+ | ',' ->
+ scan_fmt ir f (succ i)
| '_' ->
if i > lim then incomplete_format fmt else
scan_conversion true max ir f (succ i)
@@ -1202,10 +1254,10 @@ let scan_format ib ef fmt rv f =
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
+ let accu = 10 * accu + decimal_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
+ let max, i = read_width (decimal_value_of_char conv) (succ i) in
if i > lim then incomplete_format fmt else begin
match Sformat.get fmt i with
| '.' ->
diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli
index f3049f91eb..65217fc393 100644
--- a/stdlib/scanf.mli
+++ b/stdlib/scanf.mli
@@ -69,7 +69,7 @@
However, it is also largely different, simpler, and yet more powerful:
the formatted input functions are higher-order functionals and the
parameter passing mechanism is just the regular function application not
- the variable assigment based mechanism which is typical for formatted
+ the variable assignment based mechanism which is typical for formatted
input in imperative languages; the Caml format strings also feature
useful additions to easily define complex tokens; as expected within a
functional programming language, the formatted input functions also
@@ -197,16 +197,19 @@ val bscanf : Scanning.scanbuf -> ('a, 'b, 'c, 'd) scanner;;
(** {7 The space character in format strings} *)
(** As mentioned above, a plain character in the format string is just
- matched with the characters of the input; however, one character is a
- special exception to this simple rule: the space character (ASCII code
- 32) does not match a single space character, but any amount of
+ matched with the next character of the input; however, two characters are
+ special exceptions to this rule: the space character ([' '] or ASCII code
+ 32) and the line feed character (['\n'] or ASCII code 10).
+ A space does not match a single space character, but any amount of
``whitespace'' in the input. More precisely, a space inside the format
string matches {e any number} of tab, space, line feed and carriage
- return characters.
+ return characters. Similarly, a line feed character in the format string
+ matches either a single line feed or a carriage return followed by a line
+ feed.
Matching {e any} amount of whitespace, a space in the format string
also matches no amount of whitespace at all; hence, the call [bscanf ib
- "Price = %d $" (fun p -> p)] succeds and returns [1] when reading an
+ "Price = %d $" (fun p -> p)] succeeds and returns [1] when reading an
input with various whitespace in it, such as [Price = 1 $],
[Price = 1 $], or even [Price=1$]. *)
@@ -287,6 +290,7 @@ val bscanf : Scanning.scanbuf -> ('a, 'b, 'c, 'd) scanner;;
- [N] or [L]: returns the number of tokens read so far.
- [!]: matches the end of input condition.
- [%]: matches one [%] character in the input.
+ - [,]: the no-op delimiter for conversion specifications.
Following the [%] character that introduces a conversion, there may be
the special flag [_]: the conversion that follows occurs as usual,
@@ -303,7 +307,7 @@ val bscanf : Scanning.scanbuf -> ('a, 'b, 'c, 'd) scanner;;
Notes:
- - as mentioned above, a [%s] convertion always succeeds, even if there is
+ - as mentioned above, a [%s] conversion always succeeds, even if there is
nothing to read in the input: it simply returns [""].
- in addition to the relevant digits, ['_'] characters may appear
@@ -361,7 +365,7 @@ val bscanf : Scanning.scanbuf -> ('a, 'b, 'c, 'd) scanner;;
[End_of_file]: if the end of input is reached the conversion succeeds and
simply returns the characters read so far, or [""] if none were read. *)
-(** {6 Specialized formatted input functions} *)
+(** {6 Specialised formatted input functions} *)
val fscanf : in_channel -> ('a, 'b, 'c, 'd) scanner;;
(** Same as {!Scanf.bscanf}, but reads from the given channel.
@@ -373,7 +377,7 @@ val fscanf : in_channel -> ('a, 'b, 'c, 'd) scanner;;
primitives on the channel (reading characters, seeking the reading
position, and so on).
- As a consequence, never mixt direct low level reading and high level
+ As a consequence, never mix direct low level reading and high level
scanning from the same input channel. *)
val sscanf : string -> ('a, 'b, 'c, 'd) scanner;;
@@ -397,7 +401,7 @@ val kscanf :
val bscanf_format :
Scanning.scanbuf -> ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
(('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g;;
-(** [bscanf_format ib fmt f] reads a format string token from the scannning
+(** [bscanf_format ib fmt f] reads a format string token from the scanning
buffer [ib], according to the given format string [fmt], and applies [f] to
the resulting format string value.
Raise [Scan_failure] if the format string value read does not have the
diff --git a/stdlib/stdlib.mllib b/stdlib/stdlib.mllib
index 9f835c6fa6..91265e5da9 100644
--- a/stdlib/stdlib.mllib
+++ b/stdlib/stdlib.mllib
@@ -1,48 +1,49 @@
-# This file lists all standard library modules.
+# This file lists all standard library modules
+# (in the same order as Makefile.shared).
# It is used in particular to know what to expunge in toplevels.
# $Id$
Pervasives
-Arg
Array
-ArrayLabels
-Buffer
-Callback
-CamlinternalLazy
-CamlinternalMod
-CamlinternalOO
+List
Char
-Complex
-Digest
-Filename
-Format
-Gc
-Genlex
+String
+Sys
Hashtbl
+Sort
+Marshal
+Obj
Int32
Int64
-Lazy
-Lexing
-List
-ListLabels
-Map
-Marshal
-MoreLabels
Nativeint
-Obj
-Oo
+Lexing
Parsing
-Printexc
-Printf
-Queue
-Random
-Scanf
Set
-Sort
+Map
Stack
-StdLabels
+Queue
+CamlinternalLazy
+Lazy
Stream
-String
-StringLabels
-Sys
+Buffer
+Printf
+Format
+Scanf
+Arg
+Printexc
+Gc
+Digest
+Random
+Callback
+CamlinternalOO
+Oo
+CamlinternalMod
+Genlex
Weak
+Filename
+Complex
+ArrayLabels
+ListLabels
+StringLabels
+MoreLabels
+StdLabels
View Lorry Controller Status