Detect (and fix some) useless recursive flags.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@12500 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

4 files changed, 18 insertions, 7 deletions

diff --git a/man/ocamlc.m b/man/ocamlc.m
index c26d29ca5..819597ca3 100644
--- a/man/ocamlc.m
+++ b/man/ocamlc.m
@@ -747,7 +747,7 @@ mentioned here corresponds to the empty set.
 
 .IP
 The default setting is
-.BR \-w\ +a\-4\-6\-9\-27\-29\-32..37 .
+.BR \-w\ +a\-4\-6\-9\-27\-29\-32..39 .
 Note that warnings
 .BR 5 \ and \ 10
 are not always triggered, depending on the internals of the type checker.
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 020adcb8d..584392443 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -2817,8 +2817,10 @@ and type_let ?(check = fun s -> Warnings.Unused_var s)
     if is_recursive then new_env else env in
 
   let current_slot = ref None in
+  let rec_needed = ref false in
   let warn_unused =
-    Warnings.is_active (check "") || Warnings.is_active (check_strict "") in
+    Warnings.is_active (check "") || Warnings.is_active (check_strict "") || (is_recursive && (Warnings.is_active Warnings.Unused_rec_flag))
+  in
   let pat_slot_list =
     (* Algorithm to detect unused declarations in recursive bindings:
        - During type checking of the definitions, we capture the 'value_used'
@@ -2826,7 +2828,7 @@ and type_let ?(check = fun s -> Warnings.Unused_var s)
          to the current definition (!current_slot).
          In effect, this creates a dependency graph between definitions.
 
-       - After type checking the definition (!current_slot = Mone),
+       - After type checking the definition (!current_slot = None),
          when one of the bound identifier is effectively used, we trigger
          again all the events recorded in the corresponding slot.
          The effect is to traverse the transitive closure of the graph created
@@ -2860,7 +2862,7 @@ and type_let ?(check = fun s -> Warnings.Unused_var s)
                 name vd
                 (fun () ->
                   match !current_slot with
-                  | Some slot -> slot := (name, vd) :: !slot
+                  | Some slot -> slot := (name, vd) :: !slot; rec_needed := true
                   | None ->
                       List.iter
                         (fun (name, vd) -> Env.mark_value_used name vd)
@@ -2896,6 +2898,9 @@ and type_let ?(check = fun s -> Warnings.Unused_var s)
         | _ -> type_expect exp_env sexp pat.pat_type)
       spat_sexp_list pat_slot_list in
   current_slot := None;
+  if is_recursive && not !rec_needed && Warnings.is_active Warnings.Unused_rec_flag then
+    Location.prerr_warning (fst (List.hd spat_sexp_list)).ppat_loc
+      Warnings.Unused_rec_flag;
   List.iter2
     (fun pat exp -> ignore(Parmatch.check_partial pat.pat_loc [pat, exp]))
     pat_list exp_list;
diff --git a/utils/warnings.ml b/utils/warnings.ml
index 0a950923d..e44874031 100644
--- a/utils/warnings.ml
+++ b/utils/warnings.ml
@@ -58,6 +58,7 @@ type t =
   | Unused_ancestor of string               (* 36 *)
   | Unused_constructor of string * bool * bool  (* 37 *)
   | Unused_exception of string * bool       (* 38 *)
+  | Unused_rec_flag                         (* 39 *)
 ;;
 
 (* If you remove a warning, leave a hole in the numbering.  NEVER change
@@ -105,9 +106,10 @@ let number = function
   | Unused_ancestor _ -> 36
   | Unused_constructor _ -> 37
   | Unused_exception _ -> 38
+  | Unused_rec_flag -> 39
 ;;
 
-let last_warning_number = 38;;
+let last_warning_number = 39
 (* Must be the max number returned by the [number] function. *)
 
 let letter = function
@@ -123,7 +125,7 @@ let letter = function
   | 'h' -> []
   | 'i' -> []
   | 'j' -> []
-  | 'k' -> [32; 33; 34; 35; 36; 37; 38]
+  | 'k' -> [32; 33; 34; 35; 36; 37; 38; 39]
   | 'l' -> [6]
   | 'm' -> [7]
   | 'n' -> []
@@ -202,7 +204,7 @@ let parse_opt flags s =
 let parse_options errflag s = parse_opt (if errflag then error else active) s;;
 
 (* If you change these, don't forget to change them in man/ocamlc.m *)
-let defaults_w = "+a-4-6-7-9-27-29-32..38";;
+let defaults_w = "+a-4-6-7-9-27-29-32..39";;
 let defaults_warn_error = "-a";;
 
 let () = parse_options false defaults_w;;
@@ -300,6 +302,8 @@ let message = function
       "exception constructor " ^ s ^
       " is never raised or used to build values.\n\
         (However, this constructor appears in patterns.)"
+  | Unused_rec_flag ->
+      "unused rec flag."
 ;;
 
 let nerrors = ref 0;;
@@ -384,6 +388,7 @@ let descriptions =
    36, "Unused ancestor variable.";
    37, "Unused constructor.";
    38, "Unused exception constructor.";
+   39, "Unused rec flag.";
   ]
 ;;
 
diff --git a/utils/warnings.mli b/utils/warnings.mli
index c7542af8c..fbffb33df 100644
--- a/utils/warnings.mli
+++ b/utils/warnings.mli
@@ -53,6 +53,7 @@ type t =
   | Unused_ancestor of string               (* 36 *)
   | Unused_constructor of string * bool * bool  (* 37 *)
   | Unused_exception of string * bool       (* 38 *)
+  | Unused_rec_flag                         (* 39 *)
 ;;
 
 val parse_options : bool -> string -> unit;;