Remove the unreachable Longident.Lapply constructor

CHANGELOG.md

@@ -67,6 +67,7 @@
 - Analysis refactor: remove global state `Shared_types.state`. https://github.com/rescript-lang/rescript/pull/8465
 - Refactor analysis CLI helpers to use source input. https://github.com/rescript-lang/rescript/pull/8466
 - Include syntax, gentype, analysis, tools, and reanalyze tests in coverage reports. https://github.com/rescript-lang/rescript/pull/8467
+- Remove the unreachable `Longident.Lapply` constructor (OCaml's applicative-functor path syntax `F(X).t`, which ReScript's grammar cannot produce). https://github.com/rescript-lang/rescript/pull/8469
 
 # 13.0.0-alpha.4
 

analysis/src/completion_front_end.ml

@@ -1322,7 +1322,6 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
                   }
               in
               set_result (Cpath context_path)
-            | Lapply _ -> ()
           else if Loc.end_ e.pexp_loc = pos_before_cursor then
             match expr_to_context_path ~in_jsx_context:!in_jsx_context e with
             | Some context_path ->

analysis/src/process_extra.ml

@@ -81,11 +81,9 @@ let handle_constructor txt =
   match txt with
   | Longident.Lident name -> name
   | Ldot (_left, name) -> name
-  | Lapply (_, _) -> assert false
 
 let rec lid_is_complex (lid : Longident.t) =
   match lid with
-  | Lapply _ -> true
   | Ldot (lid, _) -> lid_is_complex lid
   | _ -> false
 

analysis/src/semantic_tokens.ml

@@ -127,7 +127,6 @@ let emit_longident ?(backwards = false) ?(jsx = false)
     match lid with
     | Longident.Lident txt -> txt :: acc
     | Ldot (lid, txt) -> flatten (txt :: acc) lid
-    | _ -> acc
   in
   let rec loop pos segments =
     match segments with

analysis/src/utils.ml

@@ -77,7 +77,6 @@ let flatten_long_ident ?(jsx = false) ?(cut_at_offset = None) lid =
       else if jsx && txt = "createElement" then (path, offset)
       else if txt = "_" then (extend_path "" path, offset + 1)
       else (extend_path txt path, offset + 1 + String.length txt)
-    | Lapply _ -> ([], 0)
   in
   let path, _ = loop lid in
   List.rev path
@@ -169,7 +168,6 @@ let rec get_unqualified_name txt =
   match txt with
   | Longident.Lident field_name -> field_name
   | Ldot (t, _) -> get_unqualified_name t
-  | _ -> ""
 
 let indent n text =
   let spaces = String.make n ' ' in

compiler/frontend/ast_util.ml

@@ -36,7 +36,7 @@ let record_as_js_object loc (self : Bs_ast_mapper.mapper)
           ( {Asttypes.loc; txt = x} :: labels,
             (x, self.expr self e) :: args,
             i + 1 )
-        | Ldot _ | Lapply _ -> Location.raise_errorf ~loc "invalid js label ")
+        | Ldot _ -> Location.raise_errorf ~loc "invalid js label ")
   in
   Ast_external_mk.local_external_obj loc
     ~pval_prim:(Ast_external_process.pval_prim_of_labels labels)

compiler/ml/ctype.ml

@@ -2113,7 +2113,6 @@ let rec concat_longident lid1 =
   function
   | Lident s -> Ldot (lid1, s)
   | Ldot (lid2, s) -> Ldot (concat_longident lid1 lid2, s)
-  | Lapply (lid2, lid) -> Lapply (concat_longident lid1 lid2, lid)
 
 let nondep_instance env level id ty =
   let ty = !nondep_type' env id ty in
@@ -3353,8 +3352,12 @@ let memq_warn t visited =
 let rec lid_of_path ?(hash = "") = function
   | Path.Pident id -> Longident.Lident (hash ^ Ident.name id)
   | Path.Pdot (p1, s, _) -> Longident.Ldot (lid_of_path p1, hash ^ s)
-  | Path.Papply (p1, p2) ->
-    Longident.Lapply (lid_of_path ~hash p1, lid_of_path p2)
+  (* Applicative-functor application paths (Path.Papply) are produced
+     internally (applicative functors are on by default) even though ReScript's
+     surface syntax cannot reference such a path directly. Render the
+     application by name (e.g. "F(Arg)") rather than aborting, so any diagnostic
+     that reaches here degrades gracefully instead of crashing the compiler. *)
+  | Path.Papply _ as p -> Longident.Lident (hash ^ Path.name p)
 
 let find_cltype_for_path env p =
   let cl_path = Env.lookup_type (lid_of_path ~hash:"#" p) env in

compiler/ml/depend.ml

@@ -55,7 +55,6 @@ let rec lookup_map lid m =
   match lid with
   | Lident s -> String_map.find s m
   | Ldot (l, s) -> String_map.find s (get_map (lookup_map l m))
-  | Lapply _ -> raise Not_found
 
 (* Collect free module identifiers in the a.s.t. *)
 
@@ -73,9 +72,6 @@ let rec add_path bv ?(p = []) = function
       prerr_endline "";*)
     add_names free
   | Ldot (l, s) -> add_path bv ~p:(s :: p) l
-  | Lapply (l1, l2) ->
-    add_path bv l1;
-    add_path bv l2
 
 let open_module bv lid =
   match lookup_map lid bv with

compiler/ml/env.ml

@@ -432,7 +432,6 @@ and structure_components = {
 
 and functor_components = {
   fcomp_param: Ident.t; (* Formal parameter *)
-  fcomp_arg: module_type option; (* Argument signature *)
   fcomp_res: module_type; (* Result signature *)
   fcomp_cache: (Path.t, module_components) Hashtbl.t; (* For memoization *)
   fcomp_subst_cache: (Path.t, module_type) Hashtbl.t;
@@ -1013,20 +1012,6 @@ let rec lookup_module_descr_aux ?loc lid env =
       let descr, pos = Tbl.find_str s c.comp_components in
       (Pdot (p, s, pos), descr)
     | Functor_comps _ -> raise Not_found)
-  | Lapply (l1, l2) -> (
-    let p1, desc1 = lookup_module_descr ?loc l1 env in
-    let p2 = lookup_module ~load:true ?loc l2 env in
-    let {md_type = mty2} = find_module p2 env in
-    match get_components desc1 with
-    | Functor_comps f ->
-      let loc =
-        match loc with
-        | Some l -> l
-        | None -> Location.none
-      in
-      Misc.may (!check_modtype_inclusion ~loc env mty2 p2) f.fcomp_arg;
-      (Papply (p1, p2), !components_of_functor_appl' f env p1 p2)
-    | Structure_comps _ -> raise Not_found)
 
 and lookup_module_descr ?loc lid env =
   let ((p, comps) as res) = lookup_module_descr_aux ?loc lid env in
@@ -1073,21 +1058,6 @@ and lookup_module ~load ?loc lid env : Path.t =
       report_deprecated ?loc p comps.deprecated;
       p
     | Functor_comps _ -> raise Not_found)
-  | Lapply (l1, l2) -> (
-    let p1, desc1 = lookup_module_descr ?loc l1 env in
-    let p2 = lookup_module ~load:true ?loc l2 env in
-    let {md_type = mty2} = find_module p2 env in
-    let p = Papply (p1, p2) in
-    match get_components desc1 with
-    | Functor_comps f ->
-      let loc =
-        match loc with
-        | Some l -> l
-        | None -> Location.none
-      in
-      Misc.may (!check_modtype_inclusion ~loc env mty2 p2) f.fcomp_arg;
-      p
-    | Structure_comps _ -> raise Not_found)
 
 let lookup proj1 proj2 ?loc lid env =
   match lid with
@@ -1099,7 +1069,6 @@ let lookup proj1 proj2 ?loc lid env =
       let data, pos = Tbl.find_str s (proj2 c) in
       (Pdot (p, s, pos), data)
     | Functor_comps _ -> raise Not_found)
-  | Lapply _ -> raise Not_found
 
 let lookup_all_simple proj1 proj2 shadow ?loc lid env =
   match lid with
@@ -1119,7 +1088,6 @@ let lookup_all_simple proj1 proj2 shadow ?loc lid env =
       let comps = try Tbl.find_str s (proj2 c) with Not_found -> [] in
       List.map (fun data -> (data, fun () -> ())) comps
     | Functor_comps _ -> raise Not_found)
-  | Lapply _ -> raise Not_found
 
 let has_local_constraints env = not (Path_map.is_empty env.local_constraints)
 
@@ -1588,14 +1556,13 @@ and components_of_module_maker (env, sub, path, mty) =
         | Sig_class_type () -> assert false)
       sg pl;
     Some (Structure_comps c)
-  | Mty_functor (param, ty_arg, ty_res) ->
+  | Mty_functor (param, _ty_arg, ty_res) ->
     Some
       (Functor_comps
          {
            fcomp_param = param;
-           (* fcomp_arg and fcomp_res must be prefixed eagerly, because
-              they are interpreted in the outer environment *)
-           fcomp_arg = may_map (Subst.modtype sub) ty_arg;
+           (* fcomp_res must be prefixed eagerly, because it is interpreted
+              in the outer environment *)
            fcomp_res = Subst.modtype sub ty_res;
            fcomp_cache = Hashtbl.create 17;
            fcomp_subst_cache = Hashtbl.create 17;

compiler/ml/longident.ml

@@ -13,7 +13,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-type t = Lident of string | Ldot of t * string | Lapply of t * t
+type t = Lident of string | Ldot of t * string
 let rec cmp : t -> t -> int =
  fun a b ->
   if a == b then 0
@@ -26,24 +26,16 @@ let rec cmp : t -> t -> int =
       match cmp a c with
       | 0 -> compare b d
       | n -> n)
-    | Ldot _, _ -> -1
-    | _, Ldot _ -> 1
-    | Lapply (a, b), Lapply (c, d) -> (
-      match cmp a c with
-      | 0 -> cmp b d
-      | n -> n)
 
 let rec flat accu = function
   | Lident s -> s :: accu
   | Ldot (lid, s) -> flat (s :: accu) lid
-  | Lapply (_, _) -> Misc.fatal_error "Longident.flat"
 
 let flatten lid = flat [] lid
 
 let last = function
   | Lident s -> s
   | Ldot (_, s) -> s
-  | Lapply (_, _) -> Misc.fatal_error "Longident.last"
 
 let rec split_at_dots s pos =
   try

compiler/ml/longident.mli

@@ -15,7 +15,7 @@
 
 (** Long identifiers, used in parsetree. *)
 
-type t = Lident of string | Ldot of t * string | Lapply of t * t
+type t = Lident of string | Ldot of t * string
 
 val cmp : t -> t -> int
 val flatten : t -> string list

compiler/ml/pprintast.ml

@@ -238,7 +238,6 @@ let paren :
 let rec longident f = function
   | Lident s -> protect_ident f s
   | Ldot (y, s) -> protect_longident f longident y s
-  | Lapply (y, s) -> pp f "%a(%a)" longident y longident s
 
 let longident_loc f x = pp f "%a" longident x.txt
 

compiler/ml/printast.ml

@@ -36,8 +36,6 @@ let rec fmt_longident_aux f x =
   match x with
   | Longident.Lident s -> fprintf f "%s" s
   | Longident.Ldot (y, s) -> fprintf f "%a.%s" fmt_longident_aux y s
-  | Longident.Lapply (y, z) ->
-    fprintf f "%a(%a)" fmt_longident_aux y fmt_longident_aux z
 
 let fmt_longident_loc f (x : Longident.t loc) =
   fprintf f "\"%a\" %a" fmt_longident_aux x.txt fmt_location x.loc

compiler/ml/printtyp.ml

@@ -35,7 +35,6 @@ let print_res_poly_identifier : (string -> string) ref =
 let rec longident ppf = function
   | Lident s -> pp_print_string ppf s
   | Ldot (p, s) -> fprintf ppf "%a.%s" longident p s
-  | Lapply (p1, p2) -> fprintf ppf "%a(%a)" longident p1 longident p2
 
 (* Print an identifier *)
 

compiler/ml/printtyped.ml

@@ -34,8 +34,6 @@ let rec fmt_longident_aux f x =
   match x with
   | Longident.Lident s -> fprintf f "%s" s
   | Longident.Ldot (y, s) -> fprintf f "%a.%s" fmt_longident_aux y s
-  | Longident.Lapply (y, z) ->
-    fprintf f "%a(%a)" fmt_longident_aux y fmt_longident_aux z
 
 let fmt_longident f x = fprintf f "\"%a\"" fmt_longident_aux x.txt
 

compiler/ml/typemod.ml

@@ -1696,7 +1696,6 @@ let type_package env m p nl =
   let rec mkpath mp = function
     | Lident name -> Pdot (mp, name, nopos)
     | Ldot (m, name) -> Pdot (mkpath mp m, name, nopos)
-    | _ -> assert false
   in
   let tl' =
     List.map

compiler/ml/typetexp.ml

@@ -81,28 +81,7 @@ let rec narrow_unbound_lid_error : 'a. _ -> _ -> _ -> _ -> 'a =
       raise (Error (loc, env, Access_functor_as_structure mlid))
     | Mty_alias (_, p) ->
       raise (Error (loc, env, Cannot_scrape_alias (mlid, p)))
-    | _ -> ())
-  | Longident.Lapply (flid, mlid) -> (
-    check_module flid;
-    let fmd = Env.find_module (Env.lookup_module ~load:true flid env) env in
-    (match Env.scrape_alias env fmd.md_type with
-    | Mty_signature _ ->
-      (* unreachable: this branch handles Longident.Lapply paths, but
-         Lapply has no construction site in compiler/syntax/src/ — ReScript's
-         type-level applicative-functor syntax (OCaml's M(X).t) isn't part
-         of the grammar *)
-      assert false
-    | Mty_alias (_, p) ->
-      raise (Error (loc, env, Cannot_scrape_alias (flid, p)))
-    | _ -> ());
-    check_module mlid;
-    let mmd = Env.find_module (Env.lookup_module ~load:true mlid env) env in
-    match Env.scrape_alias env mmd.md_type with
-    | Mty_alias (_, p) ->
-      raise (Error (loc, env, Cannot_scrape_alias (mlid, p)))
-    | _ ->
-      (* unreachable: same Lapply path as above *)
-      assert false));
+    | _ -> ()));
   raise (Error (loc, env, make_error lid))
 
 let find_component (lookup : ?loc:_ -> _) make_error env loc lid =
@@ -746,7 +725,6 @@ let super_spellcheck ppf fold env lid =
     Misc.spellcheck env name
   in
   match lid with
-  | Longident.Lapply _ -> false
   | Longident.Lident s -> did_you_mean ppf (fun _ -> choices None s)
   | Longident.Ldot (r, s) -> did_you_mean ppf (fun _ -> choices (Some r) s)
 
@@ -756,7 +734,6 @@ let spellcheck ppf fold env lid =
     Misc.spellcheck env name
   in
   match lid with
-  | Longident.Lapply _ -> ()
   | Longident.Lident s -> Misc.did_you_mean ppf (fun () -> choices ~path:None s)
   | Longident.Ldot (r, s) ->
     Misc.did_you_mean ppf (fun () -> choices ~path:(Some r) s)

compiler/syntax/src/res_ast_debugger.ml

@@ -76,8 +76,6 @@ module Sexp_ast = struct
       | Longident.Lident ident -> Sexp.list [Sexp.atom "Lident"; string ident]
       | Longident.Ldot (lident, txt) ->
         Sexp.list [Sexp.atom "Ldot"; loop lident; string txt]
-      | Longident.Lapply (l1, l2) ->
-        Sexp.list [Sexp.atom "Lapply"; loop l1; loop l2]
     in
     Sexp.list [Sexp.atom "longident"; loop l]
 

compiler/syntax/src/res_printer.ml

@@ -416,10 +416,6 @@ let print_listi ~get_loc ~nodes ~print ?(ignore_empty_lines = false)
 let rec print_longident_aux accu = function
   | Longident.Lident s -> Doc.text s :: accu
   | Ldot (lid, s) -> print_longident_aux (Doc.text s :: accu) lid
-  | Lapply (lid1, lid2) ->
-    let d1 = Doc.join ~sep:Doc.dot (print_longident_aux [] lid1) in
-    let d2 = Doc.join ~sep:Doc.dot (print_longident_aux [] lid2) in
-    Doc.concat [d1; Doc.lparen; d2; Doc.rparen] :: accu
 
 let print_longident = function
   | Longident.Lident txt -> Doc.text txt
@@ -529,30 +525,22 @@ let pending_inline_record_definitions inline_record_definitions =
       else None)
 
 let print_lident l =
-  let flat_lid_opt lid =
+  let flat_lid lid =
     let rec flat accu = function
-      | Longident.Lident s -> Some (s :: accu)
+      | Longident.Lident s -> s :: accu
       | Ldot (lid, s) -> flat (s :: accu) lid
-      | Lapply (_, _) -> None
     in
     flat [] lid
   in
   match l with
   | Longident.Lident txt -> print_ident_like txt
   | Longident.Ldot (path, txt) ->
-    let doc =
-      match flat_lid_opt path with
-      | Some txts ->
-        Doc.concat
-          [
-            Doc.join ~sep:Doc.dot (List.map Doc.text txts);
-            Doc.dot;
-            print_ident_like txt;
-          ]
-      | None -> Doc.text "printLident: Longident.Lapply is not supported"
-    in
-    doc
-  | Lapply (_, _) -> Doc.text "printLident: Longident.Lapply is not supported"
+    Doc.concat
+      [
+        Doc.join ~sep:Doc.dot (List.map Doc.text (flat_lid path));
+        Doc.dot;
+        print_ident_like txt;
+      ]
 
 let print_longident_location l cmt_tbl =
   let doc = print_longident l.Location.txt in

tests/build_tests/super_errors/expected/functor_application_type_mismatch.res.expected

@@ -0,0 +1,14 @@
+
+  We've found a bug for you!
+  /.../fixtures/functor_application_type_mismatch.res:20:18-29
+
+  18 │ // confirming neither hits the assert false left in Ctype.lid_of_path a
+     │ fter
+  19 │ // removing the unreachable Longident.Lapply constructor.
+  20 │ let bad: App.t = "not an int"
+  21 │ 
+
+  This has type: string
+  But it's expected to have type: App.t (defined as int)
+
+  You can convert string to int with Int.fromString.