Improve error for ill-typed functor application

1 files changed, 19 insertions, 2 deletions

diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index 7dc205d7ec..90dc46c4f5 100644
--- a/typing/typetexp.ml
+++ b/typing/typetexp.ml
@@ -52,6 +52,7 @@ type error =
   | Ill_typed_functor_application of Longident.t
   | Illegal_reference_to_recursive_module
   | Access_functor_as_structure of Longident.t
+  | Apply_structure_as_functor of Longident.t
   | Cannot_scrape_alias of Longident.t * Path.t
 
 exception Error of Location.t * Env.t * error
@@ -204,7 +205,7 @@ let rec narrow_unbound_lid_error : 'a. _ -> _ -> _ -> _ -> 'a =
       check_module mlid;
       let md = Env.find_module (Env.lookup_module true mlid env) env in
       begin match Env.scrape_alias env md.md_type with
-        Mty_functor _ ->
+      | Mty_functor _ ->
           raise (Error (loc, env, Access_functor_as_structure mlid))
       | Mty_alias p ->
           raise (Error (loc, env, Cannot_scrape_alias(mlid, p)))
@@ -212,8 +213,22 @@ let rec narrow_unbound_lid_error : 'a. _ -> _ -> _ -> _ -> 'a =
       end
   | Longident.Lapply (flid, mlid) ->
       check_module flid;
+      let fmd = Env.find_module (Env.lookup_module true flid env) env in
+      begin match Env.scrape_alias env fmd.md_type with
+      | Mty_signature _ ->
+          raise (Error (loc, env, Apply_structure_as_functor flid))
+      | Mty_alias p ->
+          raise (Error (loc, env, Cannot_scrape_alias(flid, p)))
+      | _ -> ()
+      end;
+      let mmd = Env.find_module (Env.lookup_module true mlid env) env in
       check_module mlid;
-      raise (Error (loc, env, Ill_typed_functor_application lid))
+      begin match Env.scrape_alias env mmd.md_type with
+      | Mty_alias p ->
+          raise (Error (loc, env, Cannot_scrape_alias(mlid, p)))
+      | _ ->
+          raise (Error (loc, env, Ill_typed_functor_application lid))
+      end
   end;
   raise (Error (loc, env, make_error lid))
 
@@ -1001,6 +1016,8 @@ let report_error env ppf = function
       fprintf ppf "Illegal recursive module reference"
   | Access_functor_as_structure lid ->
       fprintf ppf "The module %a is a functor, not a structure" longident lid
+  | Apply_structure_as_functor lid ->
+      fprintf ppf "The module %a is a structure, not a functor" longident lid
   | Cannot_scrape_alias(lid, p) ->
       fprintf ppf
         "The module %a is an alias for module %a, which is missing"