Add syntax for generative functor application (#11984)

Previously, writing [F ()] was the same as writing
[F (struct end)], even though the latter looks like the
use of an applicative functor, not a generative one.

This commit, originally written by Frédéric Bour <fred@tarides.com>,
adds new syntax to our AST to represent generative functor
application and propagates this change throughout the compiler.

In addition, it adds a new warning, 73, to report when a user
has written [F (struct end)] but should now update to [F ()].

Co-authored-by: Frédéric Bour <fred@tarides.com>

9 files changed, 25 insertions, 10 deletions

diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml
index a1da7df974..0dc64eb5f6 100644
--- a/parsing/ast_helper.ml
+++ b/parsing/ast_helper.ml
@@ -245,8 +245,8 @@ module Mty = struct
 end
 
 module Mod = struct
-let mk ?(loc = !default_loc) ?(attrs = []) d =
-  {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs}
+  let mk ?(loc = !default_loc) ?(attrs = []) d =
+    {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs}
   let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]}
 
   let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x)
@@ -254,6 +254,7 @@ let mk ?(loc = !default_loc) ?(attrs = []) d =
   let functor_ ?loc ?attrs arg body =
     mk ?loc ?attrs (Pmod_functor (arg, body))
   let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2))
+  let apply_unit ?loc ?attrs m1 = mk ?loc ?attrs (Pmod_apply_unit m1)
   let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty))
   let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e)
   let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a)
diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli
index 8e778e8c43..f2ad365faf 100644
--- a/parsing/ast_helper.mli
+++ b/parsing/ast_helper.mli
@@ -270,6 +270,7 @@ module Mod:
       functor_parameter -> module_expr -> module_expr
     val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr ->
       module_expr
+    val apply_unit: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr
     val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type ->
       module_expr
     val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr
diff --git a/parsing/ast_iterator.ml b/parsing/ast_iterator.ml
index 468baedce0..8371bb10bf 100644
--- a/parsing/ast_iterator.ml
+++ b/parsing/ast_iterator.ml
@@ -313,7 +313,10 @@ module M = struct
         iter_functor_param sub param;
         sub.module_expr sub body
     | Pmod_apply (m1, m2) ->
-        sub.module_expr sub m1; sub.module_expr sub m2
+        sub.module_expr sub m1;
+        sub.module_expr sub m2
+    | Pmod_apply_unit m1 ->
+        sub.module_expr sub m1
     | Pmod_constraint (m, mty) ->
         sub.module_expr sub m; sub.module_type sub mty
     | Pmod_unpack e -> sub.expr sub e
diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
index 23e206ad74..3f1248f3c8 100644
--- a/parsing/ast_mapper.ml
+++ b/parsing/ast_mapper.ml
@@ -350,6 +350,8 @@ module M = struct
           (sub.module_expr sub body)
     | Pmod_apply (m1, m2) ->
         apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2)
+    | Pmod_apply_unit m1 ->
+        apply_unit ~loc ~attrs (sub.module_expr sub m1)
     | Pmod_constraint (m, mty) ->
         constraint_ ~loc ~attrs (sub.module_expr sub m)
                     (sub.module_type sub mty)
diff --git a/parsing/depend.ml b/parsing/depend.ml
index 55b4f410cd..a07cb1dce7 100644
--- a/parsing/depend.ml
+++ b/parsing/depend.ml
@@ -436,8 +436,11 @@ and add_module_expr bv modl =
           | Some name -> String.Map.add name bound bv
       in
       add_module_expr bv modl
-  | Pmod_apply(mod1, mod2) ->
-      add_module_expr bv mod1; add_module_expr bv mod2
+  | Pmod_apply (mod1, mod2) ->
+      add_module_expr bv mod1;
+      add_module_expr bv mod2
+  | Pmod_apply_unit mod1 ->
+      add_module_expr bv mod1
   | Pmod_constraint(modl, mty) ->
       add_module_expr bv modl; add_modtype bv mty
   | Pmod_unpack(e) ->
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 65f68f9946..2c39996263 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -1325,10 +1325,9 @@ module_expr:
     | (* In a functor application, the actual argument must be parenthesized. *)
       me1 = module_expr me2 = paren_module_expr
         { Pmod_apply(me1, me2) }
-    | (* Application to unit is sugar for application to an empty structure. *)
-      me1 = module_expr LPAREN RPAREN
-        { (* TODO review mkmod location *)
-          Pmod_apply(me1, mkmod ~loc:$sloc (Pmod_structure [])) }
+    | (* Functor applied to unit. *)
+      me = module_expr LPAREN RPAREN
+        { Pmod_apply_unit me }
     | (* An extension. *)
       ex = extension
         { Pmod_extension ex }
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index d0e64bd4fd..80a796befd 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -960,7 +960,8 @@ and module_expr_desc =
   | Pmod_structure of structure  (** [struct ... end] *)
   | Pmod_functor of functor_parameter * module_expr
       (** [functor(X : MT1) -> ME] *)
-  | Pmod_apply of module_expr * module_expr  (** [ME1(ME2)] *)
+  | Pmod_apply of module_expr * module_expr (** [ME1(ME2)] *)
+  | Pmod_apply_unit of module_expr (** [ME1()] *)
   | Pmod_constraint of module_expr * module_type  (** [(ME : MT)] *)
   | Pmod_unpack of expression  (** [(val E)] *)
   | Pmod_extension of extension  (** [[%id]] *)
diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index f87de0f439..6154911d47 100644
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -1223,6 +1223,8 @@ and module_expr ctxt f x =
     | Pmod_apply (me1, me2) ->
         pp f "(%a)(%a)" (module_expr ctxt) me1 (module_expr ctxt) me2
         (* Cf: #7200 *)
+    | Pmod_apply_unit me1 ->
+        pp f "(%a)()" (module_expr ctxt) me1
     | Pmod_unpack e ->
         pp f "(val@ %a)" (expression ctxt) e
     | Pmod_extension e -> extension ctxt f e
diff --git a/parsing/printast.ml b/parsing/printast.ml
index a566f3452b..3ee93a05ce 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -787,6 +787,9 @@ and module_expr i ppf x =
       line i ppf "Pmod_apply\n";
       module_expr i ppf me1;
       module_expr i ppf me2;
+  | Pmod_apply_unit me1 ->
+      line i ppf "Pmod_apply_unit\n";
+      module_expr i ppf me1
   | Pmod_constraint (me, mt) ->
       line i ppf "Pmod_constraint\n";
       module_expr i ppf me;