Allow functors without parameters

lib/module.ml

@@ -344,8 +344,10 @@ let rec add_to_env env foreign (mname, m) =
                     | Error () -> raise (Error (loc, "Cannot add module")))
                 | Some cached ->
                     Env.add_module ~key (envmodule_of_cached mname cached) env)
-            | Mapplied_functor (loc, key, p, m) ->
-                register_applied_functor env loc key p m
+            | Mapplied_functor (loc, key, p, m) -> (
+                match register_applied_functor env loc key p m with
+                | Ok env -> env
+                | Error () -> raise (Error (loc, "Cannot apply functor")))
             | Mfunctor (loc, key, ps, items, m) -> (
                 let mname = Path.append key mname in
                 match register_functor env loc mname ps items m with
@@ -493,21 +495,20 @@ and register_functor env loc mname params body modul : (Env.t, unit) Result.t =
     Ok env
 
 and register_applied_functor env loc key mname modul =
-  (* It's okay to apply a functor multiple times *)
-  let cached =
-    match Hashtbl.find_opt module_cache mname with
-    | Some cached -> envmodule_of_cached mname cached
-    | None ->
-        let scope = make_scope env loc None mname modul in
-        (* Externals need to be added again with the correct user name *)
-        List.iter
-          (function Mext (_, t, n, c) -> add_ext_item ~mname t n c | _ -> ())
-          modul.i;
-        let cached = Cached (Clocal mname, scope, modul) in
-        Hashtbl.add module_cache mname cached;
-        envmodule_of_cached mname cached
-  in
-  Env.add_module ~key cached env
+  (* Modules must be unique *)
+  if Hashtbl.mem module_cache mname then Error ()
+  else
+    let cached =
+      let scope = make_scope env loc None mname modul in
+      (* Externals need to be added again with the correct user name *)
+      List.iter
+        (function Mext (_, t, n, c) -> add_ext_item ~mname t n c | _ -> ())
+        modul.i;
+      let cached = Cached (Clocal mname, scope, modul) in
+      Hashtbl.add module_cache mname cached;
+      envmodule_of_cached mname cached
+    in
+    Ok (Env.add_module ~key cached env)
 
 let find_module env loc name =
   (* We first search the env for local modules. Then we try read the module the normal way *)

lib/module.mli

@@ -60,7 +60,7 @@ val register_functor :
   (Env.t, unit) result
 
 val register_applied_functor :
-  Env.t -> Ast.loc -> string -> Path.t -> t -> Env.t
+  Env.t -> Ast.loc -> string -> Path.t -> t -> (Env.t, unit) result
 
 val poly_funcs : (Path.t * Typed_tree.toplevel_item) list ref
 val paths : string list ref

lib/parser.mly

@@ -168,7 +168,7 @@ path_with_loc:
   | path = use_path { $loc, path }
 
 functor_:
-  | Functor; name = module_decl; Lpar; params = separated_nonempty_list(Comma, functor_param); Rpar;
+  | Functor; name = module_decl; Lpar; params = separated_list(Comma, functor_param); Rpar;
     Lcurly; items = separated_nonempty_list(Semicolon, top_item); Rcurly
     { Functor (name, params, items) }
 

lib/typing/typing.ml

@@ -1817,7 +1817,16 @@ and convert_prog env items modul =
             let moditems = List.map (fun item -> (applied_name, item)) body in
             let items = Tl_module moditems :: items in
             let env =
-              Module.register_applied_functor env loc id applied_name modul
+              match
+                Module.register_applied_functor env loc id applied_name modul
+              with
+              | Ok env -> env
+              | Error () ->
+                  let msg =
+                    Printf.sprintf
+                      "Module names must be unique. %s exists already" id
+                  in
+                  raise (Error (loc, msg))
             in
 
             check_module_annot env loc ~mname:applied_name modul annot;