From 24b441579cfdee4644363da5071bce5107bd73e1 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 8 Nov 2014 01:28:42 +0100 Subject: [PATCH] removed many warnings --- core/CCArray.ml | 6 +++--- core/CCError.ml | 4 ++-- core/CCFQueue.ml | 8 ++++---- core/CCFlatHashtbl.ml | 2 +- core/CCGen.ml | 20 ++++++++++---------- core/CCIO.ml | 2 +- core/CCKTree.ml | 6 +++--- core/CCMultiMap.ml | 6 +++--- core/CCMultiSet.ml | 8 ++++---- core/CCPersistentHashtbl.ml | 2 +- core/CCPrint.ml | 8 ++++---- core/CCTrie.ml | 4 ++-- core/CCVector.ml | 2 +- misc/json.ml | 4 ++-- misc/printBox.ml | 28 ++++++++++++++-------------- misc/printBox.mli | 2 +- tests/test_levenshtein.ml | 6 +++--- 17 files changed, 59 insertions(+), 59 deletions(-) diff --git a/core/CCArray.ml b/core/CCArray.ml index d91f555b..c10a9ee2 100644 --- a/core/CCArray.ml +++ b/core/CCArray.ml @@ -225,7 +225,7 @@ let _shuffle _rand_int a i j = let _choose a i j st = if i>=j then raise Not_found; - a.(i+Random.int (j-i)) + a.(i+Random.State.int st (j-i)) let _pp ~sep pp_item buf a i j = for k = i to j - 1 do @@ -283,7 +283,7 @@ let iteri = Array.iteri let blit = Array.blit let reverse_in_place a = - _reverse_in_place a 0 (Array.length a) + _reverse_in_place a 0 ~len:(Array.length a) (*$T reverse_in_place [| |]; true @@ -464,7 +464,7 @@ module Sub = struct let copy a = Array.sub a.arr a.i (length a) - let sub a i len = make a.arr (a.i + i) len + let sub a i len = make a.arr ~len:(a.i + i) len let equal eq a b = length a = length b && _equal eq a.arr a.i a.j b.arr b.i b.j diff --git a/core/CCError.ml b/core/CCError.ml index abe716f7..79c555e1 100644 --- a/core/CCError.ml +++ b/core/CCError.ml @@ -170,7 +170,7 @@ let choose l = (* print errors on the buffer *) let rec print buf l = match l with | `Ok _ :: _ -> assert false - | (`Error x)::((y::xs) as l) -> + | (`Error x)::((_::_) as l) -> Buffer.add_string buf x; Buffer.add_string buf ", "; print buf l @@ -205,7 +205,7 @@ module Traverse(M : MONAD) = struct let sequence_m m = map_m (fun x->x) m let fold_m f acc e = match e with - | `Error s -> M.return acc + | `Error _ -> M.return acc | `Ok x -> f acc x >>= fun y -> M.return y let rec retry_m n f = match n with diff --git a/core/CCFQueue.ml b/core/CCFQueue.ml index 41df1639..04122478 100644 --- a/core/CCFQueue.ml +++ b/core/CCFQueue.ml @@ -68,7 +68,7 @@ let rec cons : 'a. 'a -> 'a t -> 'a t | Shallow (Two (y,z)) -> Shallow (Three (x,y,z)) | Shallow (Three (y,z,z')) -> _deep 4 (Two (x,y)) _empty (Two (z,z')) - | Deep (_, Zero, middle, tl) -> assert false + | Deep (_, Zero, _middle, _tl) -> assert false | Deep (n,One y, middle, tl) -> _deep (n+1) (Two (x,y)) middle tl | Deep (n,Two (y,z), middle, tl) -> _deep (n+1)(Three (x,y,z)) middle tl | Deep (n,Three (y,z,z'), lazy q', tail) -> @@ -81,7 +81,7 @@ let rec snoc : 'a. 'a t -> 'a -> 'a t | Shallow (Two (y,z)) -> Shallow (Three (y,z,x)) | Shallow (Three (y,z,z')) -> _deep 4 (Two (y,z)) _empty (Two (z',x)) - | Deep (_,hd, middle, Zero) -> assert false + | Deep (_,_hd, _middle, Zero) -> assert false | Deep (n,hd, middle, One y) -> _deep (n+1) hd middle (Two(y,x)) | Deep (n,hd, middle, Two (y,z)) -> _deep (n+1) hd middle (Three(y,z,x)) | Deep (n,hd, lazy q', Three (y,z,z')) -> @@ -131,7 +131,7 @@ let rec take_back_exn : 'a. 'a t -> 'a t * 'a | Shallow (One x) -> empty, x | Shallow (Two (x,y)) -> _single x, y | Shallow (Three (x,y,z)) -> Shallow (Two(x,y)), z - | Deep (_, hd, middle, Zero) -> assert false + | Deep (_, _hd, _middle, Zero) -> assert false | Deep (n, hd, lazy q', One x) -> if is_empty q' then Shallow hd, x @@ -206,7 +206,7 @@ let rec nth_exn : 'a. int -> 'a t -> 'a | 1, Shallow (Three (_,x,_)) -> x | 2, Shallow (Three (_,_,x)) -> x | _, Shallow _ -> raise Not_found - | _, Deep (n, l, q, r) -> + | _, Deep (_, l, q, r) -> if i<_size_digit l then _nth_digit i l else diff --git a/core/CCFlatHashtbl.ml b/core/CCFlatHashtbl.ml index 5de3a2a2..904c482c 100644 --- a/core/CCFlatHashtbl.ml +++ b/core/CCFlatHashtbl.ml @@ -170,7 +170,7 @@ module Make(X : HASHABLE) = struct | Empty -> () | Key (_, _, h_k) when _dib tbl h_k i = 0 -> () (* stop *) - | Key (k, v, h_k) as bucket -> + | Key (_k, _v, h_k) as bucket -> assert (_dib tbl h_k i > 0); (* shift backward *) tbl.arr.(_pred tbl i) <- bucket; diff --git a/core/CCGen.ml b/core/CCGen.ml index a2db99d7..533e016f 100644 --- a/core/CCGen.ml +++ b/core/CCGen.ml @@ -201,7 +201,7 @@ module type S = sig [e1, e2, ... ] picks elements in [e1], [e2], in [e3], [e1], [e2] .... Once a generator is empty, it is skipped; when they are all empty, and none remains in the input, - their merge is also empty. + their merge is also empty. For instance, [merge [1;3;5] [2;4;6]] will be, in disorder, [1;2;3;4;5;6]. *) val intersection : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t @@ -384,7 +384,7 @@ let reduce f g = let acc = match g () with | None -> raise (Invalid_argument "reduce") | Some x -> x - in + in fold f acc g (* Dual of {!fold}, with a deconstructing operation *) @@ -671,7 +671,7 @@ let drop_while p gen = | Yield -> begin match gen () with | None -> state := Stop; None - | (Some x) as res -> res + | Some _ as res -> res end in next @@ -1088,7 +1088,7 @@ let sorted_merge_n ?(cmp=Pervasives.compare) l = let round_robin ?(n=2) gen = (* array of queues, together with their index *) - let qs = Array.init n (fun i -> Queue.create ()) in + let qs = Array.init n (fun _ -> Queue.create ()) in let cur = ref 0 in (* get next element for the i-th queue *) let rec next i = @@ -1128,7 +1128,7 @@ let round_robin ?(n=2) gen = when they are consumed evenly *) let tee ?(n=2) gen = (* array of queues, together with their index *) - let qs = Array.init n (fun i -> Queue.create ()) in + let qs = Array.init n (fun _ -> Queue.create ()) in let finished = ref false in (* is [gen] exhausted? *) (* get next element for the i-th queue *) let rec next i = @@ -1139,7 +1139,7 @@ let tee ?(n=2) gen = else Queue.pop qs.(i) (* consume one more element *) and get_next i = match gen() with - | (Some x) as res -> + | Some _ as res -> for j = 0 to n-1 do if j <> i then Queue.push res qs.(j) done; @@ -1158,7 +1158,7 @@ let tee ?(n=2) gen = module InterleaveState = struct type 'a t = - | Only of 'a gen + | Only of 'a gen | Both of 'a gen * 'a gen * bool ref | Stop end @@ -1487,7 +1487,7 @@ module Restart = struct let repeat x () = repeat x - let unfold f acc () = unfold f acc + let unfold f acc () = unfold f acc let init ?limit f () = init ?limit f @@ -1625,7 +1625,7 @@ module Restart = struct let of_list l () = of_list l let to_rev_list e = to_rev_list (e ()) - + let to_list e = to_list (e ()) let to_array e = to_array (e ()) @@ -1678,7 +1678,7 @@ module MList = struct then begin prev := cur; fill next Nil - end else fill prev cur + end else fill prev cur in fill start !start ; !start diff --git a/core/CCIO.ml b/core/CCIO.ml index 07d36922..26645d5c 100644 --- a/core/CCIO.ml +++ b/core/CCIO.ml @@ -415,7 +415,7 @@ module Seq = struct try _yield (input_line ic) with End_of_file -> _stop() - let words g = + let words _g = failwith "words: not implemented yet" (* TODO: state machine that goes: - 0: read input chunk diff --git a/core/CCKTree.ml b/core/CCKTree.ml index b6cff1e4..e18c89c7 100644 --- a/core/CCKTree.ml +++ b/core/CCKTree.ml @@ -199,14 +199,14 @@ module Dot = struct let mk_id format = let buf = Buffer.create 64 in Printf.kbprintf - (fun fmt -> `Id (Buffer.contents buf)) + (fun _ -> `Id (Buffer.contents buf)) buf format let mk_label format = let buf = Buffer.create 64 in Printf.kbprintf - (fun fmt -> `Label(Buffer.contents buf)) + (fun _ -> `Label(Buffer.contents buf)) buf format @@ -287,6 +287,6 @@ module Dot = struct Printf.bprintf buf "}\n"; () - let pp_single name buf t = pp buf (singleton name t) + let pp_single name buf t = pp buf (singleton ~name t) end diff --git a/core/CCMultiMap.ml b/core/CCMultiMap.ml index 29be19a8..83d19d24 100644 --- a/core/CCMultiMap.ml +++ b/core/CCMultiMap.ml @@ -167,7 +167,7 @@ module Make(K : OrderedType)(V : OrderedType) = struct let union m1 m2 = M.merge - (fun k v1 v2 -> match v1, v2 with + (fun _k v1 v2 -> match v1, v2 with | None, None -> None | Some set1, Some set2 -> Some (S.union set1 set2) | Some set, None @@ -176,7 +176,7 @@ module Make(K : OrderedType)(V : OrderedType) = struct let inter m1 m2 = M.merge - (fun k v1 v2 -> match v1, v2 with + (fun _k v1 v2 -> match v1, v2 with | None, _ | _, None -> None | Some set1, Some set2 -> @@ -188,7 +188,7 @@ module Make(K : OrderedType)(V : OrderedType) = struct let diff m1 m2 = M.merge - (fun k v1 v2 -> match v1, v2 with + (fun _k v1 v2 -> match v1, v2 with | None, _ -> None | Some set, None -> Some set | Some set1, Some set2 -> diff --git a/core/CCMultiSet.ml b/core/CCMultiSet.ml index 2a0b2747..8e840586 100644 --- a/core/CCMultiSet.ml +++ b/core/CCMultiSet.ml @@ -117,7 +117,7 @@ module Make(O : Set.OrderedType) = struct let union m1 m2 = M.merge - (fun x n1 n2 -> match n1, n2 with + (fun _x n1 n2 -> match n1, n2 with | None, None -> assert false | Some n, None | None, Some n -> Some n @@ -134,7 +134,7 @@ module Make(O : Set.OrderedType) = struct let intersection m1 m2 = M.merge - (fun x n1 n2 -> match n1, n2 with + (fun _x n1 n2 -> match n1, n2 with | None, None -> assert false | Some _, None | None, Some _ -> None @@ -143,10 +143,10 @@ module Make(O : Set.OrderedType) = struct let diff m1 m2 = M.merge - (fun x n1 n2 -> match n1, n2 with + (fun _x n1 n2 -> match n1, n2 with | None, None -> assert false | Some n1, None -> Some n1 - | None, Some n2 -> None + | None, Some _n2 -> None | Some n1, Some n2 -> if n1 > n2 then Some (n1 - n2) diff --git a/core/CCPersistentHashtbl.ml b/core/CCPersistentHashtbl.ml index 70c4df91..878f76ba 100644 --- a/core/CCPersistentHashtbl.ml +++ b/core/CCPersistentHashtbl.ml @@ -294,7 +294,7 @@ module Make(H : HashedType) : S with type key = H.t = struct (fun k v2 -> if not (mem t1 k) then match f k None (Some v2) with | None -> () - | Some v' -> Table.replace tbl k v2); + | Some _ -> Table.replace tbl k v2); ref (Table tbl) let add_seq init seq = diff --git a/core/CCPrint.ml b/core/CCPrint.ml index b8e8851f..8ccde136 100644 --- a/core/CCPrint.ml +++ b/core/CCPrint.ml @@ -38,7 +38,7 @@ type 'a t = Buffer.t -> 'a -> unit (** {2 Combinators} *) -let silent buf _ = () +let silent _buf _ = () let unit buf () = Buffer.add_string buf "()" let int buf i = Buffer.add_string buf (string_of_int i) @@ -49,7 +49,7 @@ let float buf f = Buffer.add_string buf (string_of_float f) let list ?(start="[") ?(stop="]") ?(sep=", ") pp buf l = let rec pp_list l = match l with - | x::((y::xs) as l) -> + | x::((_::_) as l) -> pp buf x; Buffer.add_string buf sep; pp_list l @@ -116,14 +116,14 @@ let to_string pp x = let sprintf format = let buffer = Buffer.create 64 in Printf.kbprintf - (fun fmt -> Buffer.contents buffer) + (fun _fmt -> Buffer.contents buffer) buffer format let fprintf oc format = let buffer = Buffer.create 64 in Printf.kbprintf - (fun fmt -> Buffer.output_buffer oc buffer) + (fun _fmt -> Buffer.output_buffer oc buffer) buffer format diff --git a/core/CCTrie.ml b/core/CCTrie.ml index c4900000..2956fe2f 100644 --- a/core/CCTrie.ml +++ b/core/CCTrie.ml @@ -211,7 +211,7 @@ module Make(W : WORD) = struct let _remove_sub c t = match t with | Empty -> t | Path ([], _) -> assert false - | Path (c'::l, t') -> + | Path (c'::_, _) -> if W.compare c c' = 0 then Empty else t @@ -357,7 +357,7 @@ module Make(W : WORD) = struct | Some v -> f acc v in M.fold - (fun c t' acc -> fold_values f acc t') + (fun _c t' acc -> fold_values f acc t') map acc let iter_values f t = fold_values (fun () x -> f x) () t diff --git a/core/CCVector.ml b/core/CCVector.ml index c7f4b9f2..b4f3c4f7 100644 --- a/core/CCVector.ml +++ b/core/CCVector.ml @@ -437,7 +437,7 @@ let of_array a = let of_list l = match l with | [] -> create() - | x::l' -> + | x::_ -> let v = create_with ~capacity:(List.length l + 5) x in List.iter (push v) l; v diff --git a/misc/json.ml b/misc/json.ml index e0893414..051434ff 100644 --- a/misc/json.ml +++ b/misc/json.ml @@ -79,7 +79,6 @@ let parse chars = read_list (t::acc) (* next *) | Some (Genlex.Kwd "]") -> read_list (t::acc) (* next *) - | Some (Genlex.Kwd "]") -> List.rev acc (* yield *) | _ -> raise (Stream.Error "expected ','")) and read_pairs acc = match peek tokens with @@ -163,7 +162,8 @@ let rec pp fmt t = let to_string t = let buf = Buffer.create 16 in - Format.bprintf buf "%a@?" pp t; + let fmt = Format.formatter_of_buffer buf in + Format.fprintf fmt "%a@?" pp t; Buffer.contents buf (** {2 Utils *) diff --git a/misc/printBox.ml b/misc/printBox.ml index 6d0feca4..34141af2 100644 --- a/misc/printBox.ml +++ b/misc/printBox.ml @@ -36,7 +36,7 @@ let _minus pos1 pos2 = _move pos1 (- pos2.x) (- pos2.y) let _move_x pos x = _move pos x 0 let _move_y pos y = _move pos 0 y -let _string_len = ref String.length +let _string_len = ref Bytes.length let set_string_len f = _string_len := f @@ -61,11 +61,11 @@ module Output = struct mutable buf_len : int; } and buf_line = { - mutable bl_str : string; + mutable bl_str : Bytes.t; mutable bl_len : int; } - let _make_line _ = {bl_str=""; bl_len=0} + let _make_line _ = {bl_str=Bytes.empty; bl_len=0} let _ensure_lines buf i = if i >= Array.length buf.buf_lines @@ -78,8 +78,8 @@ module Output = struct let _ensure_line line i = if i >= !_string_len line.bl_str then ( - let str' = String.make (2 * i + 5) ' ' in - String.blit line.bl_str 0 str' 0 line.bl_len; + let str' = Bytes.make (2 * i + 5) ' ' in + Bytes.blit line.bl_str 0 str' 0 line.bl_len; line.bl_str <- str'; ) @@ -88,7 +88,7 @@ module Output = struct _ensure_line buf.buf_lines.(pos.y) pos.x; buf.buf_len <- max buf.buf_len (pos.y+1); let line = buf.buf_lines.(pos.y) in - line.bl_str.[pos.x] <- c; + Bytes.set line.bl_str pos.x c; line.bl_len <- max line.bl_len (pos.x+1) let _buf_put_sub_string buf pos s s_i s_len = @@ -100,7 +100,7 @@ module Output = struct line.bl_len <- max line.bl_len (pos.x+s_len) let _buf_put_string buf pos s = - _buf_put_sub_string buf pos s 0 (!_string_len s) + _buf_put_sub_string buf pos s 0 (!_string_len (Bytes.unsafe_of_string s)) (* create a new buffer *) let make_buffer () = @@ -121,7 +121,7 @@ module Output = struct for i = 0 to buf.buf_len - 1 do for k = 1 to indent do Buffer.add_char buffer ' ' done; let line = buf.buf_lines.(i) in - Buffer.add_substring buffer line.bl_str 0 line.bl_len; + Buffer.add_substring buffer (Bytes.unsafe_to_string line.bl_str) 0 line.bl_len; Buffer.add_char buffer '\n'; done; Buffer.contents buffer @@ -238,7 +238,7 @@ module Box = struct | Empty -> origin | Text l -> let width = List.fold_left - (fun acc line -> max acc (!_string_len line)) 0 l + (fun acc line -> max acc (!_string_len (Bytes.unsafe_of_string line))) 0 l in { x=width; y=List.length l; } | Frame t -> @@ -337,7 +337,7 @@ let tree ?(indent=1) node children = let children = List.filter (function - | {Box.shape=Box.Empty} -> false + | {Box.shape=Box.Empty; _} -> false | _ -> true ) children in @@ -384,10 +384,10 @@ let rec _render ?(offset=origin) ?expected_size ~out b pos = Output.put_char out (_move pos (x+1) (y+1)) '+'; Output.put_char out (_move pos 0 (y+1)) '+'; Output.put_char out (_move pos (x+1) 0) '+'; - _write_hline out (_move_x pos 1) x; - _write_hline out (_move pos 1 (y+1)) x; - _write_vline out (_move_y pos 1) y; - _write_vline out (_move pos (x+1) 1) y; + _write_hline ~out (_move_x pos 1) x; + _write_hline ~out (_move pos 1 (y+1)) x; + _write_vline ~out (_move_y pos 1) y; + _write_vline ~out (_move pos (x+1) 1) y; _render ~out b' (_move pos 1 1) | Box.Pad (dim, b') -> let expected_size = Box.size b in diff --git a/misc/printBox.mli b/misc/printBox.mli index ca325fca..30cb3d4f 100644 --- a/misc/printBox.mli +++ b/misc/printBox.mli @@ -72,7 +72,7 @@ we go toward the bottom (same order as a printer) *) val origin : position (** Initial position *) -val set_string_len : (string -> int) -> unit +val set_string_len : (Bytes.t -> int) -> unit (** Set which function is used to compute string length. Typically to be used with a unicode-sensitive length function *) diff --git a/tests/test_levenshtein.ml b/tests/test_levenshtein.ml index ff6aed45..52ecd20a 100644 --- a/tests/test_levenshtein.ml +++ b/tests/test_levenshtein.ml @@ -26,10 +26,10 @@ let test_mutation = return (s,i,c) ) in let test (s,i,c) = - let s' = String.copy s in - s'.[i] <- c; + let s' = Bytes.of_string s in + Bytes.set s' i c; let a = Levenshtein.of_string ~limit:1 s in - Levenshtein.match_with a s' + Levenshtein.match_with a (Bytes.to_string s') in let name = "mutating s.[i] into s' still accepted by automaton(s)" in QCheck.mk_test ~name ~size:(fun (s,_,_)->String.length s) gen test