simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-06 03:05:28 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

enable -safe-string on the whole project, with some linked refactorings

Browse source
This commit is contained in:
Simon Cruanes 2015-06-26 14:04:47 +02:00
parent 0ac0f89e93
commit 9f7be2ddc9
11 changed files with 70 additions and 73 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
_tags
View file

@ -4,4 +4,4 @@
<src/threads/*.ml{,i}>: thread
<src/core/CCVector.cmx>: inline(25)
<src/**/*.ml> and not <src/misc/*.ml>: warn_A, warn(-4), warn(-44)
true: no_alias_deps
true: no_alias_deps, safe_string

15
src/advanced/CCLinq.ml
View file

@ -942,20 +942,7 @@ end
module IO = struct
let _slurp with_input =
let l = lazy (
with_input
(fun ic ->
let buf_size = 256 in
let content = Buffer.create 120
and buf = String.make buf_size 'a' in
let rec next () =
let num = input ic buf 0 buf_size in
if num = 0
then Buffer.contents content (* EOF *)
else (Buffer.add_substring content buf 0 num; next ())
in next ()
)
) in
let l = lazy (with_input (fun ic -> CCIO.read_all ic)) in
lazy_ (return l)
let slurp ic = _slurp (fun f -> f ic)

27
src/advanced/CCMonadIO.ml.cppo
View file

@ -190,16 +190,7 @@ let rec _read_lines ic acc =
let read_lines ic = _read_lines ic []
let _read_all ic () =
let buf = Buffer.create 128 in
try
while true do
Buffer.add_channel buf ic 1024
done;
"" (* never returned *)
with End_of_file -> Buffer.contents buf
let read_all ic = Wrap(_read_all ic)
let read_all ic = Wrap(fun () -> CCIO.read_all ic)
let _open_out mode flags filename () =
open_out_gen flags mode filename
@ -216,7 +207,19 @@ let with_out_a ?mode ?(flags=[]) filename =
let _write oc s i len () = output oc s i len
let write oc s i len = Wrap (_write oc s i len)
let _write_str oc s () = output oc s 0 (String.length s)
#if OCAML_MAJOR >= 4 && OCAML_MINOR >= 2
let output_str_ = Pervasives.output_substring
#else
let output_str_ = Pervasives.output
#endif
let _write_str oc s () = output_str_ oc s 0 (String.length s)
let write_str oc s = Wrap (_write_str oc s)
let _write_line oc l () =
@ -517,3 +520,5 @@ end
module Raw = struct
let wrap f = Wrap f
end
(* vim:ft=ocaml: *)

2
src/core/CCRandom.ml
View file

@ -72,6 +72,8 @@ let small_float = float 100.0
let float_range i j st = i +. Random.State.float st (j-.i)
(* TODO: sample functions *)
let replicate n g st =
let rec aux acc n =
if n = 0 then acc else aux (g st :: acc) (n-1)

8
src/core/CCString.mli
View file

@ -45,6 +45,14 @@ module type S = sig
Compatible with the [-safe-string] option.
@raise Invalid_argument if indices are not valid *)
(*
val blit_immut : t -> int -> t -> int -> int -> string
(** Immutable version of {!blit}, returning a new string.
[blit a i b j len] is the same as [b], but in which
the range [j, ..., j+len] is replaced by [a.[i], ..., a.[i + len]].
@raise Invalid_argument if indices are not valid *)
*)
val fold : ('a -> char -> 'a) -> 'a -> t -> 'a
(** Fold on chars by increasing index.
@since 0.7 *)

1
src/data/CCDeque.ml
View file

@ -30,6 +30,7 @@ type 'a elt = {
mutable prev : 'a elt;
mutable next : 'a elt;
} (** A cell holding a single element *)
and 'a t = 'a elt option ref
(** The deque, a double linked list of cells *)

54
src/data/CCRingBuffer.ml
View file

@ -228,7 +228,7 @@ module MakeFromArray(A:Array.S) = struct
{ b with buf=A.copy b.buf; }
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -237,10 +237,10 @@ module MakeFromArray(A:Array.S) = struct
*)
(*$T
let b = Byte.of_array "abc" in \
let b = Byte.of_array (Bytes.of_string "abc") in \
let b' = Byte.copy b in \
Byte.clear b; \
Byte.to_array b' = "abc" && Byte.to_array b = ""
Byte.to_array b' = (Bytes.of_string "abc") && Byte.to_array b = Bytes.empty
*)
let capacity b =
@ -248,7 +248,7 @@ module MakeFromArray(A:Array.S) = struct
match len with 0 -> 0 | l -> l - 1
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -256,7 +256,7 @@ module MakeFromArray(A:Array.S) = struct
*)
(*$Q
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> let s = Bytes.of_string s in \
let i = abs i in \
let s_len = Bytes.length s in \
let b = Byte.create ~bounded:true i in \
@ -286,7 +286,7 @@ module MakeFromArray(A:Array.S) = struct
else (A.length b.buf - b.start) + b.stop
(*$Q
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> let s = Bytes.of_string s in \
let i = abs i in \
let s_len = Bytes.length s in \
let b = Byte.create i in \
@ -295,7 +295,7 @@ module MakeFromArray(A:Array.S) = struct
*)
(*$Q
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> let s = Bytes.of_string s in \
let i = abs i in \
let s_len = Bytes.length s in \
let b = Byte.create ~bounded:true i in \
@ -373,6 +373,7 @@ module MakeFromArray(A:Array.S) = struct
(*$Q
(Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
let s = Bytes.of_string s in let s' = Bytes.of_string s' in \
(let b = Byte.create 24 in \
Byte.blit_from b s 0 (Bytes.length s); \
Byte.blit_from b s' 0 (Bytes.length s'); \
@ -382,6 +383,7 @@ module MakeFromArray(A:Array.S) = struct
(*$Q
(Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
let s = Bytes.of_string s in let s' = Bytes.of_string s' in \
(let b = Byte.create ~bounded:true (Bytes.length s + Bytes.length s') in \
Byte.blit_from b s 0 (Bytes.length s); \
Byte.blit_from b s' 0 (Bytes.length s'); \
@ -410,7 +412,7 @@ module MakeFromArray(A:Array.S) = struct
end
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let b = Byte.create (Bytes.length s) in \
Byte.blit_from b s 0 (Bytes.length s); \
let to_buf = Bytes.create (Bytes.length s) in \
@ -424,7 +426,7 @@ module MakeFromArray(A:Array.S) = struct
()
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -438,7 +440,7 @@ module MakeFromArray(A:Array.S) = struct
b.buf <- A.empty
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -450,7 +452,7 @@ module MakeFromArray(A:Array.S) = struct
let is_empty b = b.start = b.stop
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -469,7 +471,7 @@ module MakeFromArray(A:Array.S) = struct
let take_front b = try Some (take_front_exn b) with Empty -> None
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -487,7 +489,7 @@ module MakeFromArray(A:Array.S) = struct
let take_back b = try Some (take_back_exn b) with Empty -> None
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -502,7 +504,7 @@ module MakeFromArray(A:Array.S) = struct
else b.start <- b.start + 1
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -517,7 +519,7 @@ module MakeFromArray(A:Array.S) = struct
else b.stop <- b.stop - 1
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -538,10 +540,12 @@ module MakeFromArray(A:Array.S) = struct
(*$Q
(Q.pair Q.printable_string Q.printable_string) (fun (s,s') -> \
let s = Bytes.of_string s in let s' = Bytes.of_string s' in \
(let b = Byte.create 24 in \
Byte.blit_from b s 0 (Bytes.length s); \
Byte.blit_from b s' 0 (Bytes.length s'); \
Byte.blit_from b "hello world" 0 (Bytes.length "hello world"); (* big enough *) \
let h = Bytes.of_string "hello world" in \
Byte.blit_from b h 0 (Bytes.length h); (* big enough *) \
let l = Byte.length b in let l' = l/2 in Byte.skip b l'; \
Byte.length b + l' = l))
*)
@ -563,7 +567,7 @@ module MakeFromArray(A:Array.S) = struct
)
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -593,7 +597,7 @@ module MakeFromArray(A:Array.S) = struct
(*$Q
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
let s = s ^ " " in \
let s = Bytes.of_string (s ^ " ") in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -610,7 +614,7 @@ module MakeFromArray(A:Array.S) = struct
(*$Q
(Q.pair Q.small_int Q.printable_string) (fun (i, s) -> \
let s = s ^ " " in \
let s = Bytes.of_string (s ^ " ") in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -628,13 +632,13 @@ module MakeFromArray(A:Array.S) = struct
build [] (len-1)
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
let l = Byte.to_list b in \
let explode s = let rec exp i l = \
if i < 0 then l else exp (i - 1) (s.[i] :: l) in \
if i < 0 then l else exp (i - 1) (Bytes.get s i :: l) in \
exp (Bytes.length s - 1) [] in \
explode s = l)
*)
@ -642,7 +646,7 @@ module MakeFromArray(A:Array.S) = struct
let push_back b e = blit_from b (A.make 1 e) 0 1
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -659,7 +663,7 @@ module MakeFromArray(A:Array.S) = struct
else A.get b.buf b.start
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -673,7 +677,7 @@ module MakeFromArray(A:Array.S) = struct
(if b.stop = 0 then capacity b - 1 else b.stop-1)
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let s_len = Bytes.length s in \
let b = Byte.create s_len in \
Byte.blit_from b s 0 s_len; \
@ -696,7 +700,7 @@ module MakeFromArray(A:Array.S) = struct
)
(*$Q
Q.printable_string (fun s -> \
Q.printable_string (fun s -> let s = Bytes.of_string s in \
let b = Byte.of_array s in let s' = Byte.to_array b in \
s = s')
*)

8
src/lwt/lwt_automaton.ml
View file

@ -60,7 +60,7 @@ module Unix = struct
Lwt.ignore_result (Lwt_unix.close fd);
`Stopped, [`Closed]
| `Active, `Write s ->
let fut = Lwt_unix.write fd s 0 (String.length s) in
let fut = Lwt_unix.write fd s 0 (Bytes.length s) in
(* propagate error *)
Lwt.on_failure fut (fun e -> Lwt.wakeup err_send e);
st, []
@ -68,15 +68,15 @@ module Unix = struct
st, [`Read s]
in
let a = Automaton.Instance.create ~f:transition `Active in
let buf = String.make 128 ' ' in
let buf = Bytes.make 128 ' ' in
(* read a string from buffer *)
let rec _read () =
if Automaton.Instance.state a = `Active
then Lwt_unix.read fd buf 0 (String.length buf) >>= fun n ->
then Lwt_unix.read fd buf 0 (Bytes.length buf) >>= fun n ->
begin if n = 0
then Automaton.Instance.send a `Stop
else
let s = String.sub buf 0 n in
let s = Bytes.sub_string buf 0 n in
Automaton.Instance.send a (`JustRead s)
end;
_read ()

2
src/lwt/lwt_automaton.mli
View file

@ -50,7 +50,7 @@ val next_transition :
module Unix : sig
val read_write : Lwt_unix.file_descr ->
( [ `Active | `Stopped | `Error of exn ]
, [ `Stop | `Write of string | `JustRead of string | `Failwith of exn ]
, [ `Stop | `Write of Bytes.t | `JustRead of string | `Failwith of exn ]
, [> `Read of string | `Closed | `Error of exn ]
) Automaton.Instance.t
(** Read and write on the given filedescriptor *)

4
src/sexp/CCSexpStream.ml
View file

@ -184,7 +184,7 @@ module Source = struct
)
let of_chan ?(bufsize=1024) ic =
let buf = String.make bufsize ' ' in
let buf = Bytes.make bufsize ' ' in
let i = ref 0 in
let n = ref 0 in
let stop = ref false in
@ -196,7 +196,7 @@ module Source = struct
n := input ic buf 0 bufsize;
if !n = 0 then (stop := true; NC_end) else next()
) else ( (* yield *)
let c = String.get buf !i in
let c = Bytes.get buf !i in
incr i;
NC_yield c
)

20
src/threads/CCFuture.ml
View file

@ -359,19 +359,7 @@ let choose futures =
Run cell
(** slurp the entire state of the file_descr into a string *)
let slurp i_chan =
let buf_size = 128 in
let state = Buffer.create 120
and buf = String.make 128 'a' in
let rec next () =
let num = input i_chan buf 0 buf_size in
if num = 0
then Buffer.contents state (* EOF *)
else (
Buffer.add_substring state buf 0 num;
next ()
)
in next ()
let slurp ic = CCIO.read_all_bytes ic
let read_chan ic = make1 slurp ic
@ -451,7 +439,7 @@ module Timer = struct
(** Wait for next event, run it, and loop *)
let serve timer =
let buf = String.make 1 '_' in
let buf = Bytes.make 1 '_' in
(* acquire lock, call [process_task] and do as it commands *)
let rec next () = match with_lock_ timer process_task with
| Loop -> next ()
@ -492,6 +480,8 @@ module Timer = struct
timer.thread <- Some t;
timer
let underscore_ = Bytes.make 1 '_'
(** [timerule_at s t act] will run [act] at the Unix echo [t] *)
let at timer time =
let now = Unix.gettimeofday () in
@ -510,7 +500,7 @@ module Timer = struct
timer.tasks <- TaskHeap.insert (time, cell) timer.tasks;
(* see if the timer thread needs to be awaken earlier *)
if time < next_time
then ignore (Unix.single_write timer.fifo_out "_" 0 1)
then ignore (Unix.single_write timer.fifo_out underscore_ 0 1)
);
Run cell
)