summaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/.depend16
-rwxr-xr-xstdlib/Compflags2
-rw-r--r--stdlib/pervasives.ml2
-rw-r--r--stdlib/pervasives.mli13
-rw-r--r--stdlib/printexc.ml3
-rw-r--r--stdlib/printexc.mli15
-rw-r--r--stdlib/printf.ml16
-rw-r--r--stdlib/queue.ml13
-rw-r--r--stdlib/queue.mli4
-rw-r--r--stdlib/stream.ml104
-rw-r--r--stdlib/stream.mli7
11 files changed, 107 insertions, 88 deletions
diff --git a/stdlib/.depend b/stdlib/.depend
index b8a837dbef..326959e43a 100644
--- a/stdlib/.depend
+++ b/stdlib/.depend
@@ -116,10 +116,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 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
+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
queue.cmo : obj.cmi queue.cmi
queue.cmx : obj.cmx queue.cmi
random.cmo : string.cmi pervasives.cmi nativeint.cmi int64.cmi int32.cmi \
@@ -226,10 +226,10 @@ pervasives.cmo : pervasives.cmi
pervasives.p.cmx : pervasives.cmi
printexc.cmo : printf.cmi obj.cmi buffer.cmi array.cmi printexc.cmi
printexc.p.cmx : printf.p.cmx obj.p.cmx buffer.p.cmx array.p.cmx printexc.cmi
-printf.cmo : string.cmi pervasives.cmi obj.cmi list.cmi char.cmi buffer.cmi \
- array.cmi printf.cmi
-printf.p.cmx : string.p.cmx pervasives.p.cmx obj.p.cmx list.p.cmx char.p.cmx buffer.p.cmx \
- array.p.cmx printf.cmi
+printf.cmo : string.cmi obj.cmi list.cmi char.cmi buffer.cmi array.cmi \
+ printf.cmi
+printf.p.cmx : string.p.cmx obj.p.cmx list.p.cmx char.p.cmx buffer.p.cmx array.p.cmx \
+ printf.cmi
queue.cmo : obj.cmi queue.cmi
queue.p.cmx : obj.p.cmx queue.cmi
random.cmo : string.cmi pervasives.cmi nativeint.cmi int64.cmi int32.cmi \
diff --git a/stdlib/Compflags b/stdlib/Compflags
index 283c7402fd..707487fd02 100755
--- a/stdlib/Compflags
+++ b/stdlib/Compflags
@@ -16,6 +16,8 @@ case $1 in
pervasives.cm[iox]|pervasives.p.cmx) echo ' -nopervasives';;
camlinternalOO.cmi) echo ' -nopervasives';;
camlinternalOO.cmx|camlinternalOO.p.cmx) echo ' -inline 0';;
+ buffer.cmx|buffer.p.cmx) echo ' -inline 3';;
+ # make sure add_char is inlined (PR#5872)
buffer.cm[io]|printf.cm[io]|format.cm[io]|scanf.cm[io]) echo ' -w A';;
scanf.cmx|scanf.p.cmx) echo ' -inline 9';;
arrayLabels.cm[ox]|arrayLabels.p.cmx) echo ' -nolabels';;
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
index 1640c203df..61fab1e0f3 100644
--- a/stdlib/pervasives.ml
+++ b/stdlib/pervasives.ml
@@ -24,7 +24,7 @@ exception Exit
(* Composition operators *)
-external (|>) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
(* Comparisons *)
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index ea92cf89fd..bab296a466 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -36,7 +36,7 @@ val failwith : string -> 'a
exception Exit
(** The [Exit] exception is not raised by any library function. It is
- provided for use in your programs.*)
+ provided for use in your programs. *)
(** {6 Comparisons} *)
@@ -138,7 +138,7 @@ external ( or ) : bool -> bool -> bool = "%sequor"
(** {6 Composition operators} *)
-external (|>) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
(** Reverse-application operator: [x |> f |> g] is exactly equivalent
to [g (f (x))].
@since 4.01
@@ -625,8 +625,7 @@ val open_out : string -> out_channel
(** Open the named file for writing, and return a new output channel
on that file, positionned at the beginning of the file. The
file is truncated to zero length if it already exists. It
- is created if it does not already exists.
- Raise [Sys_error] if the file could not be opened. *)
+ is created if it does not already exists. *)
val open_out_bin : string -> out_channel
(** Same as {!Pervasives.open_out}, but the file is opened in binary mode,
@@ -726,8 +725,7 @@ val set_binary_mode_out : out_channel -> bool -> unit
val open_in : string -> in_channel
(** Open the named file for reading, and return a new input channel
- on that file, positionned at the beginning of the file.
- Raise [Sys_error] if the file could not be opened. *)
+ on that file, positionned at the beginning of the file. *)
val open_in_bin : string -> in_channel
(** Same as {!Pervasives.open_in}, but the file is opened in binary mode,
@@ -816,8 +814,7 @@ val close_in : in_channel -> unit
(** Close the given channel. Input functions raise a [Sys_error]
exception when they are applied to a closed input channel,
except [close_in], which does nothing when applied to an already
- closed channel. Note that [close_in] may raise [Sys_error] if
- the operating system signals an error. *)
+ closed channel. *)
val close_in_noerr : in_channel -> unit
(** Same as [close_in], but ignore all errors. *)
diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml
index a36e2d4e34..3324f6c4fa 100644
--- a/stdlib/printexc.ml
+++ b/stdlib/printexc.ml
@@ -165,3 +165,6 @@ external backtrace_status: unit -> bool = "caml_backtrace_status"
let register_printer fn =
printers := fn :: !printers
+
+
+external get_callstack: int -> raw_backtrace = "caml_get_current_callstack"
diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli
index b653265521..773fed814e 100644
--- a/stdlib/printexc.mli
+++ b/stdlib/printexc.mli
@@ -11,7 +11,7 @@
(* *)
(***********************************************************************)
-(** Facilities for printing exceptions. *)
+(** Facilities for printing exceptions and inspecting current call stack. *)
val to_string: exn -> string
(** [Printexc.to_string e] returns a string representation of
@@ -99,3 +99,16 @@ type raw_backtrace
val get_raw_backtrace: unit -> raw_backtrace
val print_raw_backtrace: out_channel -> raw_backtrace -> unit
val raw_backtrace_to_string: raw_backtrace -> string
+
+
+(** {6 Current call stack} *)
+
+val get_callstack: int -> raw_backtrace
+
+(** [Printexc.get_callstack n] returns a description of the top of the
+ call stack on the current program point (for the current thread),
+ with at most [n] entries. (Note: this function is not related to
+ exceptions at all, despite being part of the [Printexc] module.)
+
+ @since 4.01.0
+*)
diff --git a/stdlib/printf.ml b/stdlib/printf.ml
index 2fa14bbfc6..3801692047 100644
--- a/stdlib/printf.ml
+++ b/stdlib/printf.ml
@@ -454,10 +454,13 @@ let format_float_lexeme =
valid_float_loop 0 in
(fun sfmt x ->
- let s = format_float sfmt x in
match classify_float x with
- | FP_normal | FP_subnormal | FP_zero -> make_valid_float_lexeme s
- | FP_nan | FP_infinite -> s)
+ | FP_normal | FP_subnormal | FP_zero ->
+ make_valid_float_lexeme (format_float sfmt x)
+ | FP_infinite ->
+ if x < 0.0 then "neg_infinity" else "infinity"
+ | FP_nan ->
+ "nan")
;;
(* Decode a format string and act on it.
@@ -540,8 +543,11 @@ 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 =
- if widths = [] then Pervasives.string_of_float x else
- format_float_lexeme (extract_format_float conv fmt pos i widths) x in
+ format_float_lexeme
+ (if widths = []
+ then "%.12g"
+ else 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
diff --git a/stdlib/queue.ml b/stdlib/queue.ml
index 6d82d25933..fb920d8c9c 100644
--- a/stdlib/queue.ml
+++ b/stdlib/queue.ml
@@ -107,14 +107,15 @@ let copy q =
next = tail'
} in
- let rec copy cell =
- if cell == tail then tail'
- else {
+ let rec copy prev cell =
+ if cell != tail
+ then let res = {
content = cell.content;
- next = copy cell.next
- } in
+ next = tail'
+ } in prev.next <- res;
+ copy res cell.next in
- tail'.next <- copy tail.next;
+ copy tail' tail.next;
{
length = q.length;
tail = tail'
diff --git a/stdlib/queue.mli b/stdlib/queue.mli
index 354271237d..55e8988329 100644
--- a/stdlib/queue.mli
+++ b/stdlib/queue.mli
@@ -14,6 +14,10 @@
(** First-in first-out queues.
This module implements queues (FIFOs), with in-place modification.
+
+ {b Warning} This module is not thread-safe: each {!Queue.t} value
+ must be protected from concurrent access (e.g. with a {!Mutex.t}).
+ Failure to do so can lead to a crash.
*)
type 'a t
diff --git a/stdlib/stream.ml b/stdlib/stream.ml
index 99d4bb22ce..753bce0056 100644
--- a/stdlib/stream.ml
+++ b/stdlib/stream.ml
@@ -19,8 +19,8 @@ type 'a t = { count : int; data : 'a data }
and 'a data =
Sempty
| Scons of 'a * 'a data
- | Sapp of 'a data * 'a t
- | Slazy of 'a t Lazy.t
+ | Sapp of 'a data * 'a data
+ | Slazy of 'a data Lazy.t
| Sgen of 'a gen
| Sbuffio of buffio
and 'a gen = { mutable curr : 'a option option; func : int -> 'a option }
@@ -40,37 +40,26 @@ let fill_buff b =
b.len <- input b.ic b.buff 0 (String.length b.buff); b.ind <- 0
;;
-let rec get_data s d = match d with
- (* Only return a "forced stream", that is either Sempty or
- Scons(a,_). If d is a generator or a buffer, the item a is seen as
- extracted from the generator/buffer.
-
- Forcing also updates the "count" field of the delayed stream,
- in the Sapp and Slazy cases (see slazy/lapp implementation below). *)
+let rec get_data count d = match d with
+ (* Returns either Sempty or Scons(a, _) even when d is a generator
+ or a buffer. In those cases, the item a is seen as extracted from
+ the generator/buffer.
+ The count parameter is used for calling `Sgen-functions'. *)
Sempty | Scons (_, _) -> d
- | Sapp (d1, s2) ->
- begin match get_data s d1 with
- Scons (a, d11) -> Scons (a, Sapp (d11, s2))
- | Sempty ->
- set_count s s2.count;
- get_data s s2.data
+ | Sapp (d1, d2) ->
+ begin match get_data count d1 with
+ Scons (a, d11) -> Scons (a, Sapp (d11, d2))
+ | Sempty -> get_data count d2
| _ -> assert false
end
- | Sgen {curr = Some None; _ } -> Sempty
- | Sgen ({curr = Some(Some a); _ } as g) ->
+ | Sgen {curr = Some None; func = _ } -> Sempty
+ | Sgen ({curr = Some(Some a); func = f} as g) ->
g.curr <- None; Scons(a, d)
- | Sgen ({curr = None; _} as g) ->
- (* Warning: anyone using g thinks that an item has been read *)
- begin match g.func s.count with
+ | Sgen g ->
+ begin match g.func count with
None -> g.curr <- Some(None); Sempty
- | Some a ->
- (* One must not update g.curr here, because there Scons(a,d)
- result of get_data, if the outer stream s was a Sapp, will
- be used to update the outer stream to Scons(a,s): there is
- already a memoization process at the outer layer. If g.curr
- was updated here, the saved element would be produced twice,
- once by the outer layer, once by Sgen/g.curr. *)
- Scons(a, d)
+ | Some a -> Scons(a, d)
+ (* Warning: anyone using g thinks that an item has been read *)
end
| Sbuffio b ->
if b.ind >= b.len then fill_buff b;
@@ -78,10 +67,7 @@ let rec get_data s d = match d with
let r = Obj.magic (String.unsafe_get b.buff b.ind) in
(* Warning: anyone using g thinks that an item has been read *)
b.ind <- succ b.ind; Scons(r, d)
- | Slazy f ->
- let s2 = Lazy.force f in
- set_count s s2.count;
- get_data s s2.data
+ | Slazy f -> get_data count (Lazy.force f)
;;
let rec peek s =
@@ -90,20 +76,14 @@ let rec peek s =
Sempty -> None
| Scons (a, _) -> Some a
| Sapp (_, _) ->
- begin match get_data s s.data with
- | Scons(a, _) as d -> set_data s d; Some a
+ begin match get_data s.count s.data with
+ Scons(a, _) as d -> set_data s d; Some a
| Sempty -> None
| _ -> assert false
end
- | Slazy f ->
- let s2 = Lazy.force f in
- set_count s s2.count;
- set_data s s2.data;
- peek s
- | Sgen {curr = Some a; _ } -> a
- | Sgen ({curr = None; _ } as g) ->
- let x = g.func s.count in
- g.curr <- Some x; x
+ | Slazy f -> set_data s (Lazy.force f); peek s
+ | Sgen {curr = Some a} -> a
+ | Sgen g -> let x = g.func s.count in g.curr <- Some x; x
| Sbuffio b ->
if b.ind >= b.len then fill_buff b;
if b.len == 0 then begin set_data s Sempty; None end
@@ -165,7 +145,18 @@ let of_list l =
;;
let of_string s =
- from (fun c -> if c < String.length s then Some s.[c] else None)
+ let count = ref 0 in
+ from (fun _ ->
+ (* We cannot use the index passed by the [from] function directly
+ because it returns the current stream count, with absolutely no
+ guarantee that it will start from 0. For example, in the case
+ of [Stream.icons 'c' (Stream.from_string "ab")], the first
+ access to the string will be made with count [1] already.
+ *)
+ let c = !count in
+ if c < String.length s
+ then (incr count; Some s.[c])
+ else None)
;;
let of_channel ic =
@@ -175,21 +166,18 @@ let of_channel ic =
(* Stream expressions builders *)
-(* In the slazy and lapp case, we can't statically predict the value
- of the "count" field. We put a dummy 0 value, which will be updated
- when the parameter stream is forced (see update code in [get_data]
- and [peek]). *)
-
+let iapp i s = {count = 0; data = Sapp (i.data, s.data)};;
+let icons i s = {count = 0; data = Scons (i, s.data)};;
let ising i = {count = 0; data = Scons (i, Sempty)};;
-let icons i s = {count = s.count - 1; data = Scons (i, s.data)};;
-let iapp i s = {count = i.count; data = Sapp (i.data, s)};;
-let sempty = {count = 0; data = Sempty};;
-let slazy f = {count = 0; data = Slazy (lazy (f()))};;
+let lapp f s =
+ {count = 0; data = Slazy (lazy(Sapp ((f ()).data, s.data)))}
+;;
+let lcons f s = {count = 0; data = Slazy (lazy(Scons (f (), s.data)))};;
+let lsing f = {count = 0; data = Slazy (lazy(Scons (f (), Sempty)))};;
-let lsing f = {count = 0; data = Slazy (lazy (ising (f())))};;
-let lcons f s = {count = 0; data = Slazy (lazy (icons (f()) s))};;
-let lapp f s = {count = 0; data = Slazy (lazy(iapp (f()) s))};;
+let sempty = {count = 0; data = Sempty};;
+let slazy f = {count = 0; data = Slazy (lazy(f ()).data)};;
(* For debugging use *)
@@ -209,11 +197,11 @@ and dump_data f =
print_string ", ";
dump_data f d;
print_string ")"
- | Sapp (d1, s2) ->
+ | Sapp (d1, d2) ->
print_string "Sapp (";
dump_data f d1;
print_string ", ";
- dump f s2;
+ dump_data f d2;
print_string ")"
| Slazy _ -> print_string "Slazy"
| Sgen _ -> print_string "Sgen"
diff --git a/stdlib/stream.mli b/stdlib/stream.mli
index 1098a27650..aeb0da1e87 100644
--- a/stdlib/stream.mli
+++ b/stdlib/stream.mli
@@ -32,7 +32,12 @@ val from : (int -> 'a option) -> 'a t
To create a new stream element, the function [f] is called with
the current stream count. The user function [f] must return either
[Some <value>] for a value or [None] to specify the end of the
- stream. *)
+ stream.
+
+ Do note that the indices passed to [f] may not start at [0] in the
+ general case. For example, [[< '0; '1; Stream.from f >]] would call
+ [f] the first time with count [2].
+*)
val of_list : 'a list -> 'a t
(** Return the stream holding the elements of the list in the same
View Lorry Controller Status