Remove dead Sig_class/Sig_class_type variants

CHANGELOG.md

@@ -67,6 +67,8 @@
 - 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
+- Remove the dead `Sig_class`/`Sig_class_type` signature variants (OCaml class items, which ReScript cannot produce). https://github.com/rescript-lang/rescript/pull/8470
 
 # 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/create_interface.ml

@@ -263,12 +263,6 @@ let print_signature ~extractor ~signature =
       in
       Buffer.add_string buf (indent ^ new_item_str ^ "\n");
       process_signature ~indent items
-    | Sig_class _ :: items ->
-      (* not needed *)
-      process_signature ~indent items
-    | Sig_class_type _ :: items ->
-      (* not needed *)
-      process_signature ~indent items
     | [] -> ()
   and process_module_type ~indent (mt : Types.module_type) =
     match mt with

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/core/lam_print.ml

@@ -254,33 +254,6 @@ let flatten (lam : Lam.t) : (print_kind * Ident.t * Lam.t) list * Lam.t =
     aux (Ext_list.map bind_args (fun (id, l) -> (Recursive, id, l))) body
   | _ -> assert false
 
-(* let get_string ((id : Ident.t), (pos : int)) (env : Env.t) : string =
-   match  Env.find_module (Pident id) env with
-   | {md_type = Mty_signature signature  ; _ } ->
-    (* Env.prefix_idents, could be cached  *)
-    let serializable_sigs =
-      Ext_list.filter (fun x ->
-          match x with
-          | Sig_typext _
-          | Sig_module _
-          | Sig_class _ -> true
-          | Sig_value(_, {val_kind = Val_prim _}) -> false
-                           | Sig_value _ -> true
-                           | _ -> false
-                           ) signature  in
-                           (begin match Ext_list.nth_opt  serializable_sigs  pos  with
-                           | Some (Sig_value (i,_)
-                           | Sig_module (i,_,_)
-                           | Sig_typext (i,_,_)
-                           | Sig_modtype(i,_)
-                           | Sig_class (i,_,_)
-                           | Sig_class_type(i,_,_)
-                           | Sig_type(i,_,_)) -> i
-                           | None -> assert false
-                           end).name
-                           | _ -> assert false
-*)
-
 let lambda ppf v =
   let rec lam ppf (l : Lam.t) =
     match l with

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/gentype/translate_signature_from_types.ml

@@ -93,12 +93,6 @@ and translate_signature_item_from_types ~config ~output_file_relative ~resolver
   | Types.Sig_modtype _ ->
     log_not_implemented ("Sig_modtype " ^ __LOC__);
     Translation.empty
-  | Types.Sig_class _ ->
-    log_not_implemented ("Sig_class " ^ __LOC__);
-    Translation.empty
-  | Types.Sig_class_type _ ->
-    log_not_implemented ("Sig_class_type " ^ __LOC__);
-    Translation.empty
 
 (** Like translateSignature but from Types not Typedtree *)
 and translate_signature_from_types ~config ~output_file_relative ~resolver

compiler/gentype/translate_type_expr_from_types.ml

@@ -750,8 +750,7 @@ and signature_to_module_runtime_representation ~config ~type_vars_gen ~type_env
                }
              in
              (dependencies, [field])
-           | Types.Sig_type _ | Types.Sig_typext _ | Types.Sig_modtype _
-           | Types.Sig_class _ | Types.Sig_class_type _ ->
+           | Types.Sig_type _ | Types.Sig_typext _ | Types.Sig_modtype _ ->
              ([], []))
   in
   let dependencies, fields =

compiler/ml/btype.ml

@@ -335,8 +335,6 @@ let type_iterators =
     | Sig_typext (_, td, _) -> it.it_extension_constructor it td
     | Sig_module (_, md, _) -> it.it_module_declaration it md
     | Sig_modtype (_, mtd) -> it.it_modtype_declaration it mtd
-    | Sig_class () -> assert false
-    | Sig_class_type () -> assert false
   and it_value_description it vd = it.it_type_expr it vd.val_type
   and it_type_declaration it td =
     List.iter (it.it_type_expr it) td.type_params;

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)
 
@@ -1486,8 +1454,6 @@ let rec prefix_idents root pos sub = function
       prefix_idents root pos (Subst.add_modtype id (Mty_ident p) sub) rem
     in
     (p :: pl, final_sub)
-  | Sig_class _ :: _ -> assert false
-  | Sig_class_type _ :: _ -> assert false
 
 let prefix_idents root sub sg =
   if sub = Subst.identity then (
@@ -1583,19 +1549,16 @@ and components_of_module_maker (env, sub, path, mty) =
           let decl' = Subst.modtype_declaration sub decl in
           c.comp_modtypes <-
             Tbl.add (Ident.name id) (decl', nopos) c.comp_modtypes;
-          env := store_modtype id decl !env
-        | Sig_class () -> assert false
-        | Sig_class_type () -> assert false)
+          env := store_modtype id decl !env)
       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;
@@ -1829,8 +1792,6 @@ let add_item comp env =
   | Sig_typext (id, ext, _) -> add_extension ~check:false id ext env
   | Sig_module (id, md, _) -> add_module_declaration ~check:false id md env
   | Sig_modtype (id, decl) -> add_modtype id decl env
-  | Sig_class () -> env
-  | Sig_class_type () -> env
 
 let rec add_signature sg env =
   match sg with

compiler/ml/includemod.ml

@@ -126,20 +126,13 @@ let item_ident_name = function
   | Sig_typext (id, d, _) -> (id, d.ext_loc, Field_typext (Ident.name id))
   | Sig_module (id, d, _) -> (id, d.md_loc, Field_module (Ident.name id))
   | Sig_modtype (id, d) -> (id, d.mtd_loc, Field_modtype (Ident.name id))
-  | Sig_class () -> assert false
-  | Sig_class_type () -> assert false
 
 let is_runtime_component = function
   | Sig_value (_, {val_kind = Val_prim _})
   | Sig_type (_, _, _)
-  | Sig_modtype (_, _)
-  | Sig_class_type () ->
+  | Sig_modtype (_, _) ->
     false
-  | Sig_value (_, _)
-  | Sig_typext (_, _, _)
-  | Sig_module (_, _, _)
-  | Sig_class () ->
-    true
+  | Sig_value (_, _) | Sig_typext (_, _, _) | Sig_module (_, _, _) -> true
 
 (* Print a coercion *)
 
@@ -301,7 +294,6 @@ and signatures ~loc env cxt subst sig1 sig2 =
       | Sig_modtype (i, _)
       | Sig_type (i, _, _) ->
         Ident.name i
-      | Sig_class () | Sig_class_type () -> assert false
     in
     List.fold_right
       (fun item fields ->
@@ -360,8 +352,7 @@ and signatures ~loc env cxt subst sig1 sig2 =
           | Sig_module _ -> Subst.add_module id2 (Pident id1) subst
           | Sig_modtype _ ->
             Subst.add_modtype id2 (Mty_ident (Pident id1)) subst
-          | Sig_value _ | Sig_typext _ | Sig_class _ | Sig_class_type () ->
-            subst
+          | Sig_value _ | Sig_typext _ -> subst
         in
         pair_components new_subst ((item1, item2, pos1) :: paired) unpaired rem
       | exception Not_found ->
@@ -399,8 +390,6 @@ and signature_components ~loc old_env env cxt subst paired =
   | (Sig_modtype (id1, info1), Sig_modtype (_id2, info2), _pos) :: rem ->
     modtype_infos ~loc env cxt subst id1 info1 info2;
     comps_rec rem
-  | (Sig_class (), Sig_class (), _) :: _ -> assert false
-  | (Sig_class_type (), Sig_class_type (), _pos) :: _ -> assert false
   | _ -> assert false
 
 and module_declarations ~loc env cxt subst id1 md1 md2 =

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