PR#8891: used as a base for other PRspr8891

24 files changed, 126 insertions, 46 deletions

diff --git a/Changes b/Changes
index b10f4ff4d6..6b65274498 100644
--- a/Changes
+++ b/Changes
@@ -172,6 +172,9 @@ Working version
 - #8885: Warn about unused local modules
   (Thomas Refis, review by Alain Frisch)
 
+- #8891: Warn about unused functor parameters
+  (Thomas Refis, review by ...)
+
 ### Build system:
 
 - #8650: ensure that "make" variables are defined before use;
diff --git a/Makefile b/Makefile
index 0338197a97..0f02314be5 100644
--- a/Makefile
+++ b/Makefile
@@ -1087,7 +1087,8 @@ include Makefile.menhir
 parsing/camlinternalMenhirLib.ml: boot/menhir/menhirLib.ml
 	cp $< $@
 parsing/camlinternalMenhirLib.mli: boot/menhir/menhirLib.mli
-	cp $< $@
+	echo '[@@@ocaml.warning "-67"]' > $@
+	cat $< >> $@
 
 # Copy parsing/parser.ml from boot/
 
diff --git a/asmcomp/strmatch.mli b/asmcomp/strmatch.mli
index bf63d99033..8c4c63eb02 100644
--- a/asmcomp/strmatch.mli
+++ b/asmcomp/strmatch.mli
@@ -23,7 +23,7 @@ module type I = sig
           Cmm.expression
 end
 
-module Make(I:I) : sig
+module Make(_:I) : sig
   (* Compile stringswitch (arg,cases,d)
      Note: cases should not contain string duplicates *)
   val compile : Debuginfo.t -> Cmm.expression (* arg *)
diff --git a/driver/main_args.mli b/driver/main_args.mli
index 7bc082f887..3f5b9d7167 100644
--- a/driver/main_args.mli
+++ b/driver/main_args.mli
@@ -250,11 +250,11 @@ module type Arg_list = sig
     val list : (string * Arg.spec * string) list
 end;;
 
-module Make_bytecomp_options (F : Bytecomp_options) : Arg_list;;
-module Make_bytetop_options (F : Bytetop_options) : Arg_list;;
-module Make_optcomp_options (F : Optcomp_options) : Arg_list;;
-module Make_opttop_options (F : Opttop_options) : Arg_list;;
-module Make_ocamldoc_options (F : Ocamldoc_options) : Arg_list;;
+module Make_bytecomp_options : Bytecomp_options -> Arg_list;;
+module Make_bytetop_options : Bytetop_options -> Arg_list;;
+module Make_optcomp_options : Optcomp_options -> Arg_list;;
+module Make_opttop_options : Opttop_options -> Arg_list;;
+module Make_ocamldoc_options : Ocamldoc_options -> Arg_list;;
 
 (** [options_with_command_line_syntax options r] returns [options2] that behaves
     like [options], but additionally pushes command line argument on [r] (quoted
diff --git a/middle_end/flambda/augment_specialised_args.mli b/middle_end/flambda/augment_specialised_args.mli
index 5c48a12652..910a2d1532 100644
--- a/middle_end/flambda/augment_specialised_args.mli
+++ b/middle_end/flambda/augment_specialised_args.mli
@@ -48,7 +48,7 @@ module type S = sig
     -> What_to_specialise.t
 end
 
-module Make (T : S) : sig
+module Make (_ : S) : sig
   (** [duplicate_function] should be
       [Inline_and_simplify.duplicate_function]. *)
   val rewrite_set_of_closures
diff --git a/middle_end/flambda/base_types/id_types.ml b/middle_end/flambda/base_types/id_types.ml
index 6d2e274311..c9a77adc38 100644
--- a/middle_end/flambda/base_types/id_types.ml
+++ b/middle_end/flambda/base_types/id_types.ml
@@ -40,7 +40,7 @@ module type UnitId = sig
   val unit : t -> Compilation_unit.t
 end
 
-module Id(E:sig end) : Id = struct
+module Id() : Id = struct
   type t = int * string
   let empty_string = ""
   let create = let r = ref 0 in
diff --git a/middle_end/flambda/base_types/id_types.mli b/middle_end/flambda/base_types/id_types.mli
index 48ca037caf..78ca75a8be 100644
--- a/middle_end/flambda/base_types/id_types.mli
+++ b/middle_end/flambda/base_types/id_types.mli
@@ -46,11 +46,9 @@ sig
   val unit : t -> Compilation_unit.t
 end
 
-(** If applied generatively, i.e. [Id(struct end)], creates a new type
-    of identifiers. *)
-module Id : functor (E : sig end) -> Id
+module Id () : Id
 
 module UnitId :
-  functor (Id : Id) ->
+  Id ->
   functor (Compilation_unit : Identifiable.Thing) ->
     UnitId with module Compilation_unit := Compilation_unit
diff --git a/ocamldoc/odoc_ast.mli b/ocamldoc/odoc_ast.mli
index fc1c0eb7c2..754800d984 100644
--- a/ocamldoc/odoc_ast.mli
+++ b/ocamldoc/odoc_ast.mli
@@ -90,7 +90,7 @@ module Typedtree_search :
    The module uses the module {!Odoc_sig.Analyser}.
    @param My_ir The module used to retrieve comments and special comments.*)
 module Analyser :
-  functor (My_ir : Odoc_sig.Info_retriever) ->
+  Odoc_sig.Info_retriever ->
     sig
       (** This function takes a file name, a file containing the code and
          the typed tree obtained from the compiler.
diff --git a/ocamldoc/odoc_gen.ml b/ocamldoc/odoc_gen.ml
index 8ea2c94777..152c241430 100644
--- a/ocamldoc/odoc_gen.ml
+++ b/ocamldoc/odoc_gen.ml
@@ -26,12 +26,12 @@ module Base_generator : Base = struct
   class generator : doc_generator = object method generate _ = () end
   end;;
 
-module type Base_functor = functor (G: Base) -> Base
-module type Html_functor = functor (G: Odoc_html.Html_generator) -> Odoc_html.Html_generator
-module type Latex_functor = functor (G: Odoc_latex.Latex_generator) -> Odoc_latex.Latex_generator
-module type Texi_functor = functor (G: Odoc_texi.Texi_generator) -> Odoc_texi.Texi_generator
-module type Man_functor = functor (G: Odoc_man.Man_generator) -> Odoc_man.Man_generator
-module type Dot_functor = functor (G: Odoc_dot.Dot_generator) -> Odoc_dot.Dot_generator
+module type Base_functor = Base -> Base
+module type Html_functor = Odoc_html.Html_generator -> Odoc_html.Html_generator
+module type Latex_functor = Odoc_latex.Latex_generator -> Odoc_latex.Latex_generator
+module type Texi_functor = Odoc_texi.Texi_generator -> Odoc_texi.Texi_generator
+module type Man_functor = Odoc_man.Man_generator -> Odoc_man.Man_generator
+module type Dot_functor = Odoc_dot.Dot_generator -> Odoc_dot.Dot_generator
 
 type generator =
   | Html of (module Odoc_html.Html_generator)
diff --git a/ocamldoc/odoc_gen.mli b/ocamldoc/odoc_gen.mli
index ba74da89f9..0bc723cc63 100644
--- a/ocamldoc/odoc_gen.mli
+++ b/ocamldoc/odoc_gen.mli
@@ -26,12 +26,12 @@ module type Base = sig
 
 module Base_generator : Base
 
-module type Base_functor = functor (P: Base) -> Base
-module type Html_functor = functor (G: Odoc_html.Html_generator) -> Odoc_html.Html_generator
-module type Latex_functor = functor (G: Odoc_latex.Latex_generator) -> Odoc_latex.Latex_generator
-module type Texi_functor = functor (G: Odoc_texi.Texi_generator) -> Odoc_texi.Texi_generator
-module type Man_functor = functor (G: Odoc_man.Man_generator) -> Odoc_man.Man_generator
-module type Dot_functor = functor (G: Odoc_dot.Dot_generator) -> Odoc_dot.Dot_generator
+module type Base_functor = Base -> Base
+module type Html_functor = Odoc_html.Html_generator -> Odoc_html.Html_generator
+module type Latex_functor = Odoc_latex.Latex_generator -> Odoc_latex.Latex_generator
+module type Texi_functor = Odoc_texi.Texi_generator -> Odoc_texi.Texi_generator
+module type Man_functor = Odoc_man.Man_generator -> Odoc_man.Man_generator
+module type Dot_functor = Odoc_dot.Dot_generator -> Odoc_dot.Dot_generator
 
 (** Various ways to create a generator. *)
 type generator =
diff --git a/ocamldoc/odoc_sig.mli b/ocamldoc/odoc_sig.mli
index ac26bc8b49..78d774dedf 100644
--- a/ocamldoc/odoc_sig.mli
+++ b/ocamldoc/odoc_sig.mli
@@ -110,7 +110,7 @@ module type Info_retriever =
   end
 
 module Analyser :
-  functor (My_ir : Info_retriever) ->
+  Info_retriever ->
     sig
       (** This variable is used to load a file as a string and retrieve characters from it.*)
       val file : string ref
diff --git a/otherlibs/dynlink/dynlink_common.mli b/otherlibs/dynlink/dynlink_common.mli
index a92012493a..c6f92d05cd 100644
--- a/otherlibs/dynlink/dynlink_common.mli
+++ b/otherlibs/dynlink/dynlink_common.mli
@@ -19,7 +19,7 @@
 
 (** Construction of dynlink functionality given the platform-specific code. *)
 
-module Make (P : Dynlink_platform_intf.S) : sig
+module Make (_ : Dynlink_platform_intf.S) : sig
   val is_native : bool
   val loadfile : string -> unit
   val loadfile_private : string -> unit
diff --git a/testsuite/tests/typing-warnings/ocamltests b/testsuite/tests/typing-warnings/ocamltests
index 0c983b6b96..6f022b5f04 100644
--- a/testsuite/tests/typing-warnings/ocamltests
+++ b/testsuite/tests/typing-warnings/ocamltests
@@ -11,6 +11,7 @@ pr7261.ml
 pr7297.ml
 pr7553.ml
 records.ml
+unused_functor_parameter.ml
 unused_rec.ml
 unused_types.ml
 open_warnings.ml
diff --git a/testsuite/tests/typing-warnings/unused_functor_parameter.ml b/testsuite/tests/typing-warnings/unused_functor_parameter.ml
new file mode 100644
index 0000000000..c8691af992
--- /dev/null
+++ b/testsuite/tests/typing-warnings/unused_functor_parameter.ml
@@ -0,0 +1,33 @@
+(* TEST
+   flags = " -w A "
+   * expect
+*)
+
+module Foo(Unused : sig end) = struct end;;
+[%%expect {|
+Line 1, characters 11-17:
+1 | module Foo(Unused : sig end) = struct end;;
+               ^^^^^^
+Warning 60: unused module Unused.
+module Foo : functor (Unused : sig end) -> sig end
+|}]
+
+module type S = functor (Unused : sig end) -> sig end;;
+[%%expect {|
+Line 1, characters 25-31:
+1 | module type S = functor (Unused : sig end) -> sig end;;
+                             ^^^^^^
+Warning 67: unused functor parameter Unused.
+module type S = functor (Unused : sig end) -> sig end
+|}]
+
+module type S = sig
+  module M (Unused : sig end) : sig end
+end;;
+[%%expect{|
+Line 2, characters 12-18:
+2 |   module M (Unused : sig end) : sig end
+                ^^^^^^
+Warning 67: unused functor parameter Unused.
+module type S = sig module M : functor (Unused : sig end) -> sig end end
+|}]
diff --git a/testsuite/tests/warnings/w32.compilers.reference b/testsuite/tests/warnings/w32.compilers.reference
index 6b4abe2bc8..6cf44b0b50 100644
--- a/testsuite/tests/warnings/w32.compilers.reference
+++ b/testsuite/tests/warnings/w32.compilers.reference
@@ -1,3 +1,15 @@
+File "w32.mli", line 12, characters 10-11:
+12 | module F (X : sig val x : int end) : sig end
+               ^
+Warning 67: unused functor parameter X.
+File "w32.mli", line 14, characters 10-11:
+14 | module G (X : sig val x : int end) : sig end
+               ^
+Warning 67: unused functor parameter X.
+File "w32.mli", line 16, characters 10-11:
+16 | module H (X : sig val x : int end) : sig val x : int end
+               ^
+Warning 67: unused functor parameter X.
 File "w32.ml", line 40, characters 24-25:
 40 | let[@warning "-32"] rec q x = x
                              ^
@@ -61,6 +73,10 @@ File "w32.ml", line 63, characters 18-29:
 63 | module F (X : sig val x : int end) = struct end
                        ^^^^^^^^^^^
 Warning 32: unused value x.
+File "w32.ml", line 63, characters 10-11:
+63 | module F (X : sig val x : int end) = struct end
+               ^
+Warning 60: unused module X.
 File "w32.ml", line 65, characters 18-29:
 65 | module G (X : sig val x : int end) = X
                        ^^^^^^^^^^^
diff --git a/testsuite/tests/warnings/w32b.compilers.reference b/testsuite/tests/warnings/w32b.compilers.reference
index 5266ba186a..79ba5c8527 100644
--- a/testsuite/tests/warnings/w32b.compilers.reference
+++ b/testsuite/tests/warnings/w32b.compilers.reference
@@ -2,3 +2,7 @@ File "w32b.ml", line 13, characters 18-24:
 13 | module Q (M : sig type t end) = struct end
                        ^^^^^^
 Warning 34: unused type t.
+File "w32b.ml", line 13, characters 10-11:
+13 | module Q (M : sig type t end) = struct end
+               ^
+Warning 60: unused module M.
diff --git a/testsuite/tests/warnings/w53.ml b/testsuite/tests/warnings/w53.ml
index 4efdc2ab15..63a0a83bec 100644
--- a/testsuite/tests/warnings/w53.ml
+++ b/testsuite/tests/warnings/w53.ml
@@ -1,6 +1,6 @@
 (* TEST
 
-flags = "-w A"
+flags = "-w A-60"
 
 * setup-ocamlc.byte-build-env
 ** ocamlc.byte
diff --git a/testsuite/tests/warnings/w60.ml b/testsuite/tests/warnings/w60.ml
index 08d3ecd3db..2e59615cca 100644
--- a/testsuite/tests/warnings/w60.ml
+++ b/testsuite/tests/warnings/w60.ml
@@ -1,6 +1,6 @@
 (* TEST
 
-flags = "-w A"
+flags = "-w A-67"
 
 * setup-ocamlc.byte-build-env
 ** ocamlc.byte
diff --git a/toplevel/genprintval.mli b/toplevel/genprintval.mli
index a74de583f0..7e150fc845 100644
--- a/toplevel/genprintval.mli
+++ b/toplevel/genprintval.mli
@@ -69,5 +69,5 @@ module type S =
           Env.t -> t -> type_expr -> Outcometree.out_value
   end
 
-module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) :
+module Make(O : OBJ)(_ : EVALPATH with type valu = O.t) :
          (S with type t = O.t)
diff --git a/typing/env.ml b/typing/env.ml
index 54cbd3c54a..203d3c8911 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -1553,7 +1553,7 @@ let rec components_of_module_maker
             c.comp_modules <-
               NameMap.add (Ident.name id) mda c.comp_modules;
             env :=
-              store_module ~freshening_sub ~check:false id addr pres md !env
+              store_module ~freshening_sub ~check:None id addr pres md !env
         | Sig_modtype(id, decl, _) ->
             let fresh_decl =
               (* the fresh_decl is only going in the local temporary env, and
@@ -1722,9 +1722,7 @@ and store_extension ~check id addr ext env =
 
 and store_module ~check ~freshening_sub id addr presence md env =
   let loc = md.md_loc in
-  if check then
-    check_usage loc id (fun s -> Warnings.Unused_module s)
-      module_declarations;
+  Option.iter (fun f -> check_usage loc id f module_declarations) check;
   let alerts = Builtin_attributes.alerts_of_attrs md.md_attributes in
   let module_decl_lazy =
     match freshening_sub with
@@ -1815,6 +1813,14 @@ and add_extension ~check id ext env =
   store_extension ~check id addr ext env
 
 and add_module_declaration ?(arg=false) ~check id presence md env =
+  let check =
+    if not check then
+      None
+    else if arg && is_in_signature env then
+      Some (fun s -> Warnings.Unused_functor_parameter s)
+    else
+      Some (fun s -> Warnings.Unused_module s)
+  in
   let addr = module_declaration_address env id presence md in
   let env = store_module ~freshening_sub:None ~check id addr presence md env in
   if arg then add_functor_arg id env else env
diff --git a/typing/parmatch.mli b/typing/parmatch.mli
index 000b02b4dd..72d2ffe3eb 100644
--- a/typing/parmatch.mli
+++ b/typing/parmatch.mli
@@ -48,7 +48,7 @@ val le_pats : pattern list -> pattern list -> bool
 (** Exported compatibility functor, abstracted over constructor equality *)
 module Compat :
   functor
-    (Constr: sig
+    (_ : sig
       val equal :
           Types.constructor_description ->
             Types.constructor_description ->
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 0f3170f60d..90fd6a5d96 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -1147,8 +1147,14 @@ and transl_modtype_aux env smty =
             | Some name ->
               let scope = Ctype.create_scope () in
               let id, newenv =
-                Env.enter_module ~scope ~arg:true name Mp_present arg.mty_type
-                  env
+                let arg_md =
+                  { md_type = arg.mty_type;
+                    md_attributes = [];
+                    md_loc = param.loc;
+                  }
+                in
+                Env.enter_module_declaration ~scope ~arg:true name Mp_present
+                  arg_md env
               in
               Some id, newenv
           in
@@ -1479,7 +1485,9 @@ and transl_modtype_decl names env pmtd =
 
 and transl_modtype_decl_aux names env
     {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} =
-  let tmty = Option.map (transl_modtype env) pmtd_type in
+  let tmty =
+    Option.map (transl_modtype (Env.in_signature true env)) pmtd_type
+  in
   let decl =
     {
      Types.mtd_type=Option.map (fun t -> t.mty_type) tmty;
@@ -1893,20 +1901,26 @@ and type_module_aux ~alias sttn funct_body anchor env smod =
       let t_arg, ty_arg, newenv, funct_body =
         match arg_opt with
         | Unit -> Unit, Types.Unit, env, false
-        | Named (name, smty) ->
+        | Named (param, smty) ->
           let mty = transl_modtype_functor_arg env smty in
           let scope = Ctype.create_scope () in
           let (id, newenv) =
-            match name.txt with
+            match param.txt with
             | None -> None, env
             | Some name ->
+              let arg_md =
+                { md_type = mty.mty_type;
+                  md_attributes = [];
+                  md_loc = param.loc;
+                }
+              in
               let id, newenv =
-                Env.enter_module ~scope ~arg:true name Mp_present mty.mty_type
-                  env
+                Env.enter_module_declaration ~scope ~arg:true name Mp_present
+                  arg_md env
               in
               Some id, newenv
           in
-          Named (id, name, mty), Types.Named (id, mty.mty_type), newenv, true
+          Named (id, param, mty), Types.Named (id, mty.mty_type), newenv, true
       in
       let body = type_module sttn funct_body None newenv sbody in
       rm { mod_desc = Tmod_functor(t_arg, body);
diff --git a/utils/warnings.ml b/utils/warnings.ml
index 9b1959835e..2b335d3c60 100644
--- a/utils/warnings.ml
+++ b/utils/warnings.ml
@@ -91,6 +91,7 @@ type t =
   | Unsafe_without_parsing                  (* 64 *)
   | Redefining_unit of string               (* 65 *)
   | Unused_open_bang of string              (* 66 *)
+  | Unused_functor_parameter of string      (* 67 *)
 ;;
 
 (* If you remove a warning, leave a hole in the numbering.  NEVER change
@@ -168,9 +169,10 @@ let number = function
   | Unsafe_without_parsing -> 64
   | Redefining_unit _ -> 65
   | Unused_open_bang _ -> 66
+  | Unused_functor_parameter _ -> 67
 ;;
 
-let last_warning_number = 66
+let last_warning_number = 67
 ;;
 
 (* Must be the max number returned by the [number] function. *)
@@ -391,7 +393,7 @@ let parse_options errflag s =
   current := {(!current) with error; active}
 
 (* 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..42-44-45-48-50-60-66";;
+let defaults_w = "+a-4-6-7-9-27-29-32..42-44-45-48-50-60-66-67";;
 let defaults_warn_error = "-a+31";;
 
 let () = parse_options false defaults_w;;
@@ -628,6 +630,7 @@ let message = function
         "This type declaration is defining a new '()' constructor\n\
          which shadows the existing one.\n\
          Hint: Did you mean 'type %s = unit'?" name
+  | Unused_functor_parameter s -> "unused functor parameter " ^ s ^ "."
 ;;
 
 let nerrors = ref 0;;
diff --git a/utils/warnings.mli b/utils/warnings.mli
index 4fe4964f71..b80ab34cbb 100644
--- a/utils/warnings.mli
+++ b/utils/warnings.mli
@@ -93,6 +93,7 @@ type t =
   | Unsafe_without_parsing                  (* 64 *)
   | Redefining_unit of string               (* 65 *)
   | Unused_open_bang of string              (* 66 *)
+  | Unused_functor_parameter of string      (* 67 *)
 ;;
 
 type alert = {kind:string; message:string; def:loc; use:loc}