From 9f7be2ddc994d8ffbb82be390e8caca1c9075fd3 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 26 Jun 2015 14:04:47 +0200 Subject: [PATCH] enable `-safe-string` on the whole project, with some linked refactorings --- _tags | 2 +- src/advanced/CCLinq.ml | 15 +--------- src/advanced/CCMonadIO.ml.cppo | 27 ++++++++++------- src/core/CCRandom.ml | 2 ++ src/core/CCString.mli | 8 +++++ src/data/CCDeque.ml | 1 + src/data/CCRingBuffer.ml | 54 ++++++++++++++++++---------------- src/lwt/lwt_automaton.ml | 8 ++--- src/lwt/lwt_automaton.mli | 2 +- src/sexp/CCSexpStream.ml | 4 +-- src/threads/CCFuture.ml | 20 ++++--------- 11 files changed, 70 insertions(+), 73 deletions(-) diff --git a/_tags b/_tags index 5308fabb..f2f6e473 100644 --- a/_tags +++ b/_tags @@ -4,4 +4,4 @@ : thread : inline(25) and not : warn_A, warn(-4), warn(-44) -true: no_alias_deps +true: no_alias_deps, safe_string diff --git a/src/advanced/CCLinq.ml b/src/advanced/CCLinq.ml index 6bbccd6f..7da7ccda 100644 --- a/src/advanced/CCLinq.ml +++ b/src/advanced/CCLinq.ml @@ -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) diff --git a/src/advanced/CCMonadIO.ml.cppo b/src/advanced/CCMonadIO.ml.cppo index 961880e5..fe081527 100644 --- a/src/advanced/CCMonadIO.ml.cppo +++ b/src/advanced/CCMonadIO.ml.cppo @@ -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: *) diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index 12d970e1..9a0f597f 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -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) diff --git a/src/core/CCString.mli b/src/core/CCString.mli index acd9ab5e..416ead7d 100644 --- a/src/core/CCString.mli +++ b/src/core/CCString.mli @@ -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 *) diff --git a/src/data/CCDeque.ml b/src/data/CCDeque.ml index cc83f425..48d05e4d 100644 --- a/src/data/CCDeque.ml +++ b/src/data/CCDeque.ml @@ -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 *) diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml index c72141d8..91baf4dc 100644 --- a/src/data/CCRingBuffer.ml +++ b/src/data/CCRingBuffer.ml @@ -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') *) diff --git a/src/lwt/lwt_automaton.ml b/src/lwt/lwt_automaton.ml index 2f8d98f1..017951d8 100644 --- a/src/lwt/lwt_automaton.ml +++ b/src/lwt/lwt_automaton.ml @@ -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 () diff --git a/src/lwt/lwt_automaton.mli b/src/lwt/lwt_automaton.mli index daa03517..b3d4e585 100644 --- a/src/lwt/lwt_automaton.mli +++ b/src/lwt/lwt_automaton.mli @@ -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 *) diff --git a/src/sexp/CCSexpStream.ml b/src/sexp/CCSexpStream.ml index 38f25c15..ff7f76d0 100644 --- a/src/sexp/CCSexpStream.ml +++ b/src/sexp/CCSexpStream.ml @@ -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 ) diff --git a/src/threads/CCFuture.ml b/src/threads/CCFuture.ml index 8860cc5b..19b62dc5 100644 --- a/src/threads/CCFuture.ml +++ b/src/threads/CCFuture.ml @@ -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 )