Also enable more warnings in stdlib/ and fix them.

Author: alainfrisch

stdlib/Makefile.shared

@@ -20,8 +20,8 @@ TARGET_BINDIR ?= $(BINDIR)
 
 COMPILER=../ocamlc
 CAMLC=$(CAMLRUN) $(COMPILER)
-COMPFLAGS=-strict-sequence -w +32+33..39 -g -warn-error A -bin-annot -nostdlib \
-          -safe-string
+COMPFLAGS=-strict-sequence -absname -w +a-4-9-41-42-44-45-48 -g -warn-error A -bin-annot -nostdlib \
+          -safe-string -strict-formats
 ifeq "$(FLAMBDA)" "true"
 OPTCOMPFLAGS=-O3
 else

stdlib/arg.ml

@@ -53,7 +53,7 @@ open Printf
 let rec assoc3 x l =
   match l with
   | [] -> raise Not_found
-  | (y1, y2, y3) :: t when y1 = x -> y2
+  | (y1, y2, _) :: _ when y1 = x -> y2
   | _ :: t -> assoc3 x t
 ;;
 
@@ -293,7 +293,7 @@ let add_padding len ksd =
       (* Do not pad undocumented options, so that they still don't show up when
        * run through [usage] or [parse]. *)
       ksd
-  | (kwd, (Symbol (l, _) as spec), msg) ->
+  | (kwd, (Symbol _ as spec), msg) ->
       let cutcol = second_word msg in
       let spaces = String.make ((max 0 (len - cutcol)) + 3) ' ' in
       (kwd, spec, "\n" ^ spaces ^ msg)

stdlib/arg.mli

@@ -143,7 +143,7 @@ val usage_string : (key * spec * doc) list -> usage_msg -> string
 (** Returns the message that would have been printed by {!Arg.usage},
     if provided with the same parameters. *)
 
-val align: ?limit: int -> (key * spec * doc) list -> (key * spec * doc) list;;
+val align: ?limit: int -> (key * spec * doc) list -> (key * spec * doc) list
 (** Align the documentation strings by inserting spaces at the first
     space, according to the length of the keyword.  Use a
     space as the first character in a doc string if you want to

stdlib/array.ml

@@ -131,7 +131,7 @@ let to_list a =
 (* Cannot use List.length here because the List module depends on Array. *)
 let rec list_length accu = function
   | [] -> accu
-  | h::t -> list_length (succ accu) t
+  | _::t -> list_length (succ accu) t
 ;;
 
 let of_list = function

stdlib/camlinternalFormatBasics.ml

@@ -540,7 +540,7 @@ let rec erase_rel : type a b c d e f g h i j k l .
     Bool_ty (erase_rel rest)
   | Format_arg_ty (ty, rest) ->
     Format_arg_ty (ty, erase_rel rest)
-  | Format_subst_ty (ty1, ty2, rest) ->
+  | Format_subst_ty (ty1, _ty2, rest) ->
     Format_subst_ty (ty1, ty1, erase_rel rest)
   | Alpha_ty rest ->
     Alpha_ty (erase_rel rest)

stdlib/camlinternalMod.ml

@@ -71,4 +71,4 @@ let rec update_mod shape o n =
       for i = 0 to Array.length comps - 1 do
         update_mod comps.(i) (Obj.field o i) (Obj.field n i)
       done
-  | Value v -> () (* the value is already there *)
+  | Value _ -> () (* the value is already there *)

stdlib/camlinternalOO.ml

@@ -457,20 +457,20 @@ let lookup_tables root keys =
 
 (**** builtin methods ****)
 
-let get_const x = ret (fun obj -> x)
+let get_const x = ret (fun _obj -> x)
 let get_var n   = ret (fun obj -> Array.unsafe_get obj n)
 let get_env e n =
   ret (fun obj ->
     Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n)
 let get_meth n  = ret (fun obj -> sendself obj n)
 let set_var n   = ret (fun obj x -> Array.unsafe_set obj n x)
-let app_const f x = ret (fun obj -> f x)
+let app_const f x = ret (fun _obj -> f x)
 let app_var f n   = ret (fun obj -> f (Array.unsafe_get obj n))
 let app_env f e n =
   ret (fun obj ->
     f (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n))
 let app_meth f n  = ret (fun obj -> f (sendself obj n))
-let app_const_const f x y = ret (fun obj -> f x y)
+let app_const_const f x y = ret (fun _obj -> f x y)
 let app_const_var f x n   = ret (fun obj -> f x (Array.unsafe_get obj n))
 let app_const_meth f x n = ret (fun obj -> f x (sendself obj n))
 let app_var_const f n x = ret (fun obj -> f (Array.unsafe_get obj n) x)

stdlib/ephemeron.ml

@@ -55,7 +55,7 @@ module GenHashTable = struct
 
     and 'a bucketlist =
     | Empty
-    | Cons of int (** hash of the key *) * 'a H.container * 'a bucketlist
+    | Cons of int (* hash of the key *) * 'a H.container * 'a bucketlist
 
     (** the hash of the key is kept in order to test the equality of the hash
       before the key. Same reason as for Weak.Make *)
@@ -167,7 +167,7 @@ module GenHashTable = struct
             | ETrue -> h.size <- h.size - 1; next
             | EFalse -> Cons(hk, c, remove_bucket next)
             | EDead ->
-                (** The dead key is automatically removed. It is acceptable
+                (* The dead key is automatically removed. It is acceptable
                     for this function since it already removes a binding *)
                 h.size <- h.size - 1;
                 remove_bucket next
@@ -188,7 +188,7 @@ module GenHashTable = struct
           | ETrue ->
               begin match H.get_data c with
               | None ->
-                  (** This case is not impossible because the gc can run between
+                  (* This case is not impossible because the gc can run between
                       H.equal and H.get_data *)
                   find_rec key hkey rest
               | Some d -> d
@@ -202,7 +202,7 @@ module GenHashTable = struct
 
     let find h key =
       let hkey = H.hash h.seed key in
-      (** TODO inline 3 iterations *)
+      (* TODO inline 3 iterations *)
       find_rec key hkey (h.data.(key_index h hkey))
 
     let find_all h key =
@@ -256,7 +256,7 @@ module GenHashTable = struct
           | ETrue -> true
           | EFalse | EDead -> mem_in_bucket rest
           end
-      | Cons(hk, c, rest) -> mem_in_bucket rest in
+      | Cons(_hk, _c, rest) -> mem_in_bucket rest in
       mem_in_bucket h.data.(key_index h hkey)
 
     let iter f h =
@@ -401,7 +401,7 @@ module K1 = struct
         c
       let hash = H.hash
       let equal c k =
-        (** {!get_key_copy} is not used because the equality of the user can be
+        (* {!get_key_copy} is not used because the equality of the user can be
             the physical equality *)
         match get_key c with
         | None -> GenHashTable.EDead
@@ -421,7 +421,7 @@ module K1 = struct
     include MakeSeeded(struct
         type t = H.t
         let equal = H.equal
-        let hash (seed: int) x = H.hash x
+        let hash (_seed: int) x = H.hash x
       end)
     let create sz = create ~random:false sz
   end
@@ -504,12 +504,12 @@ module K2 = struct
         (struct
           type t = H1.t
           let equal = H1.equal
-          let hash (seed: int) x = H1.hash x
+          let hash (_seed: int) x = H1.hash x
         end)
         (struct
           type t = H2.t
           let equal = H2.equal
-          let hash (seed: int) x = H2.hash x
+          let hash (_seed: int) x = H2.hash x
         end)
     let create sz = create ~random:false sz
   end
@@ -609,7 +609,7 @@ module Kn = struct
     include MakeSeeded(struct
         type t = H.t
         let equal = H.equal
-        let hash (seed: int) x = H.hash x
+        let hash (_seed: int) x = H.hash x
       end)
     let create sz = create ~random:false sz
   end

stdlib/ephemeron.mli

@@ -80,6 +80,7 @@ module type S = sig
 
   val clean: 'a t -> unit
   (** remove all dead bindings. Done automatically during automatic resizing. *)
+
   val stats_alive: 'a t -> Hashtbl.statistics
   (** same as {!Hashtbl.SeededS.stats} but only count the alive bindings *)
 end
@@ -93,6 +94,7 @@ module type SeededS = sig
   include Hashtbl.SeededS
   val clean: 'a t -> unit
   (** remove all dead bindings. Done automatically during automatic resizing. *)
+
   val stats_alive: 'a t -> Hashtbl.statistics
   (** same as {!Hashtbl.SeededS.stats} but only count the alive bindings *)
 end
@@ -192,43 +194,58 @@ module K2 : sig
 
   val get_key1: ('k1,'k2,'d) t -> 'k1 option
   (** Same as {!Ephemeron.K1.get_key} *)
+
   val get_key1_copy: ('k1,'k2,'d) t -> 'k1 option
   (** Same as {!Ephemeron.K1.get_key_copy} *)
+
   val set_key1: ('k1,'k2,'d) t -> 'k1 -> unit
   (** Same as {!Ephemeron.K1.set_key} *)
+
   val unset_key1: ('k1,'k2,'d) t -> unit
   (** Same as {!Ephemeron.K1.unset_key} *)
+
   val check_key1: ('k1,'k2,'d) t ->  bool
   (** Same as {!Ephemeron.K1.check_key} *)
 
   val get_key2: ('k1,'k2,'d) t -> 'k2 option
   (** Same as {!Ephemeron.K1.get_key} *)
+
   val get_key2_copy: ('k1,'k2,'d) t -> 'k2 option
   (** Same as {!Ephemeron.K1.get_key_copy} *)
+
   val set_key2: ('k1,'k2,'d) t -> 'k2 -> unit
   (** Same as {!Ephemeron.K1.get_key} *)
+
   val unset_key2: ('k1,'k2,'d) t -> unit
   (** Same as {!Ephemeron.K1.unset_key} *)
+
   val check_key2: ('k1,'k2,'d) t -> bool
   (** Same as {!Ephemeron.K1.check_key} *)
 
-  val blit_key1  : ('k1,_,_) t -> ('k1,_,_) t -> unit
+  val blit_key1: ('k1,_,_) t -> ('k1,_,_) t -> unit
   (** Same as {!Ephemeron.K1.blit_key} *)
-  val blit_key2  : (_,'k2,_) t -> (_,'k2,_) t -> unit
+
+  val blit_key2: (_,'k2,_) t -> (_,'k2,_) t -> unit
   (** Same as {!Ephemeron.K1.blit_key} *)
-  val blit_key12 : ('k1,'k2,_) t -> ('k1,'k2,_) t -> unit
+
+  val blit_key12: ('k1,'k2,_) t -> ('k1,'k2,_) t -> unit
   (** Same as {!Ephemeron.K1.blit_key} *)
 
   val get_data: ('k1,'k2,'d) t -> 'd option
   (** Same as {!Ephemeron.K1.get_data} *)
+
   val get_data_copy: ('k1,'k2,'d) t -> 'd option
   (** Same as {!Ephemeron.K1.get_data_copy} *)
+
   val set_data: ('k1,'k2,'d) t -> 'd -> unit
   (** Same as {!Ephemeron.K1.set_data} *)
+
   val unset_data: ('k1,'k2,'d) t -> unit
   (** Same as {!Ephemeron.K1.unset_data} *)
+
   val check_data: ('k1,'k2,'d) t -> bool
   (** Same as {!Ephemeron.K1.check_data} *)
+
   val blit_data: ('k1,'k2,'d) t -> ('k1,'k2,'d) t -> unit
   (** Same as {!Ephemeron.K1.blit_data} *)
 
@@ -256,28 +273,37 @@ module Kn : sig
 
   val get_key: ('k,'d) t -> int -> 'k option
   (** Same as {!Ephemeron.K1.get_key} *)
+
   val get_key_copy: ('k,'d) t -> int -> 'k option
   (** Same as {!Ephemeron.K1.get_key_copy} *)
+
   val set_key: ('k,'d) t -> int -> 'k -> unit
   (** Same as {!Ephemeron.K1.set_key} *)
+
   val unset_key: ('k,'d) t -> int -> unit
   (** Same as {!Ephemeron.K1.unset_key} *)
+
   val check_key: ('k,'d) t -> int ->  bool
   (** Same as {!Ephemeron.K1.check_key} *)
 
-  val blit_key  : ('k,_) t -> int -> ('k,_) t -> int -> int -> unit
+  val blit_key: ('k,_) t -> int -> ('k,_) t -> int -> int -> unit
   (** Same as {!Ephemeron.K1.blit_key} *)
 
   val get_data: ('k,'d) t -> 'd option
   (** Same as {!Ephemeron.K1.get_data} *)
+
   val get_data_copy: ('k,'d) t -> 'd option
   (** Same as {!Ephemeron.K1.get_data_copy} *)
+
   val set_data: ('k,'d) t -> 'd -> unit
   (** Same as {!Ephemeron.K1.set_data} *)
+
   val unset_data: ('k,'d) t -> unit
   (** Same as {!Ephemeron.K1.unset_data} *)
+
   val check_data: ('k,'d) t -> bool
   (** Same as {!Ephemeron.K1.check_data} *)
+
   val blit_data: ('k,'d) t -> ('k,'d) t -> unit
   (** Same as {!Ephemeron.K1.blit_data} *)
 
@@ -307,11 +333,13 @@ module GenHashTable: sig
   sig
     type t
     (** keys *)
+
     type 'a container
     (** contains keys and the associated data *)
 
     val hash: int -> t -> int
     (** same as {!Hashtbl.SeededHashedType} *)
+
     val equal: 'a container -> t -> equal
     (** equality predicate used to compare a key with the one in a
         container. Can return [EDead] if the keys in the container are
@@ -320,12 +348,16 @@ module GenHashTable: sig
     val create: t -> 'a -> 'a container
     (** [create key data] creates a container from
         some initials keys and one data *)
+
     val get_key: 'a container -> t option
     (** [get_key cont] returns the keys if they are all alive *)
+
     val get_data: 'a container -> 'a option
     (** [get_data cont] return the data if it is alive *)
+
     val set_key_data: 'a container -> t -> 'a -> unit
     (** [set_key_data cont] modify the key and data *)
+
     val check_key: 'a container -> bool
     (** [check_key cont] checks if all the keys contained in the data
         are alive *)

stdlib/filename.ml

@@ -130,7 +130,7 @@ module Win32 = struct
         match s.[i] with
         | '\"' -> add_bs (2*n+1); Buffer.add_char b '\"'; loop (i+1);
         | '\\' -> loop_bs (n+1) (i+1);
-        | c    -> add_bs n; loop i
+        | _    -> add_bs n; loop i
       end
     and add_bs n = for _j = 1 to n do Buffer.add_char b '\\'; done
     in
@@ -151,7 +151,7 @@ module Win32 = struct
     let dir = generic_dirname is_dir_sep current_dir_name path in
     drive ^ dir
   let basename s =
-    let (drive, path) = drive_and_path s in
+    let (_drive, path) = drive_and_path s in
     generic_basename is_dir_sep current_dir_name path
 end
 

stdlib/gc.mli

@@ -180,7 +180,7 @@ external set : control -> unit = "caml_gc_set"
 external minor : unit -> unit = "caml_gc_minor"
 (** Trigger a minor collection. *)
 
-external major_slice : int -> int = "caml_gc_major_slice";;
+external major_slice : int -> int = "caml_gc_major_slice"
 (** [major_slice n]
     Do a minor collection and a slice of major collection. [n] is the
     size of the slice: the GC will do enough work to free (on average)
@@ -290,7 +290,7 @@ val finalise : ('a -> unit) -> 'a -> unit
    heap-allocated and non-constant except when the length argument is [0].
 *)
 
-val finalise_release : unit -> unit;;
+val finalise_release : unit -> unit
 (** A finalisation function may call [finalise_release] to tell the
     GC that it can launch the next finalisation function without waiting
     for the current one to return. *)

stdlib/genlex.ml

@@ -184,18 +184,18 @@ let make_lexer keywords =
     match Stream.peek strm__ with
       Some '(' -> Stream.junk strm__; maybe_nested_comment strm__
     | Some '*' -> Stream.junk strm__; maybe_end_comment strm__
-    | Some c -> Stream.junk strm__; comment strm__
+    | Some _ -> Stream.junk strm__; comment strm__
     | _ -> raise Stream.Failure
   and maybe_nested_comment (strm__ : _ Stream.t) =
     match Stream.peek strm__ with
       Some '*' -> Stream.junk strm__; let s = strm__ in comment s; comment s
-    | Some c -> Stream.junk strm__; comment strm__
+    | Some _ -> Stream.junk strm__; comment strm__
     | _ -> raise Stream.Failure
   and maybe_end_comment (strm__ : _ Stream.t) =
     match Stream.peek strm__ with
       Some ')' -> Stream.junk strm__; ()
     | Some '*' -> Stream.junk strm__; maybe_end_comment strm__
-    | Some c -> Stream.junk strm__; comment strm__
+    | Some _ -> Stream.junk strm__; comment strm__
     | _ -> raise Stream.Failure
   in
-  fun input -> Stream.from (fun count -> next_token input)
+  fun input -> Stream.from (fun _count -> next_token input)