From 516e6503b320e32e520d0616c85b9ecc571b6b60 Mon Sep 17 00:00:00 2001 From: Jono Prest <65739024+JonoPrest@users.noreply.github.com> Date: Fri, 12 Jun 2026 12:40:00 +0200 Subject: [PATCH 1/2] Remove the unreachable Longident.Lapply constructor (#8469) * Remove the unreachable Longident.Lapply constructor Longident.Lapply is the parsetree form of OCaml's applicative-functor path syntax (F(X).t), where a functor is applied inline inside an identifier path. ReScript's grammar has no such production: functor application is only a module expression (module M = F(X)), which the type checker resolves to Path.Papply, never a Longident.Lapply. The parser never builds Lapply, so every match on it was dead (assert false / fatal_error / raise Not_found / defensive printer fallbacks). Remove the constructor and all its handling across the type checker, printers, depend, and analysis. The sole construction site was Ctype.lid_of_path (Path.Papply -> Longident.Lapply); since no Papply flows into that type-path conversion, replace it with assert false, matching the existing Papply -> assert false invariants. Removing the Env.lookup_module Lapply arms also left functor_components.fcomp_arg write-only, so drop that field too. Add a super_errors fixture exercising functor application plus a type-path error, confirming the functor machinery and error printing are unchanged. * Update changelog * Format functor fixture and refresh super_errors snapshot * lid_of_path: render Papply paths gracefully instead of asserting Applicative functors are on by default, so Path.Papply paths are produced internally (typemod path_of_module, Mtype.strengthen) even though ReScript source cannot reference such a path directly. Replace the assert false in Ctype.lid_of_path's Papply arm (introduced when removing Longident.Lapply) with a graceful Lident rendering via Path.name, so any diagnostic that ever reaches it degrades to a readable name (e.g. F(Arg)) instead of aborting the compiler. Add an ounit test that calls Ctype.lid_of_path on a synthetic Papply path (unreachable from source, so exercised directly) to lock in the graceful behavior. --- CHANGELOG.md | 1 + analysis/src/completion_front_end.ml | 1 - analysis/src/process_extra.ml | 2 - analysis/src/semantic_tokens.ml | 1 - analysis/src/utils.ml | 2 - compiler/frontend/ast_util.ml | 2 +- compiler/ml/ctype.ml | 9 +++-- compiler/ml/depend.ml | 4 -- compiler/ml/env.ml | 39 ++----------------- compiler/ml/longident.ml | 10 +---- compiler/ml/longident.mli | 2 +- compiler/ml/pprintast.ml | 1 - compiler/ml/printast.ml | 2 - compiler/ml/printtyp.ml | 1 - compiler/ml/printtyped.ml | 2 - compiler/ml/typemod.ml | 1 - compiler/ml/typetexp.ml | 25 +----------- compiler/syntax/src/res_ast_debugger.ml | 2 - compiler/syntax/src/res_printer.ml | 28 ++++--------- ...tor_application_type_mismatch.res.expected | 14 +++++++ .../functor_application_type_mismatch.res | 20 ++++++++++ tests/ounit_tests/ounit_lid_of_path_tests.ml | 22 +++++++++++ tests/ounit_tests/ounit_tests_main.ml | 1 + 23 files changed, 79 insertions(+), 113 deletions(-) create mode 100644 tests/build_tests/super_errors/expected/functor_application_type_mismatch.res.expected create mode 100644 tests/build_tests/super_errors/fixtures/functor_application_type_mismatch.res create mode 100644 tests/ounit_tests/ounit_lid_of_path_tests.ml diff --git a/CHANGELOG.md b/CHANGELOG.md index 72740c033b7..070c866edc8 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/analysis/src/completion_front_end.ml b/analysis/src/completion_front_end.ml index 481c7a0d3f5..aeaf7657903 100644 --- a/analysis/src/completion_front_end.ml +++ b/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 -> diff --git a/analysis/src/process_extra.ml b/analysis/src/process_extra.ml index 0c44d934f34..fcd5c8e1f1d 100644 --- a/analysis/src/process_extra.ml +++ b/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 diff --git a/analysis/src/semantic_tokens.ml b/analysis/src/semantic_tokens.ml index 10532f81ee6..92b3afe8369 100644 --- a/analysis/src/semantic_tokens.ml +++ b/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 diff --git a/analysis/src/utils.ml b/analysis/src/utils.ml index 18a26e3241b..94736c41c27 100644 --- a/analysis/src/utils.ml +++ b/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 diff --git a/compiler/frontend/ast_util.ml b/compiler/frontend/ast_util.ml index f5814164fa9..798b6f4717b 100644 --- a/compiler/frontend/ast_util.ml +++ b/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) diff --git a/compiler/ml/ctype.ml b/compiler/ml/ctype.ml index 32deb499be0..b07920b6493 100644 --- a/compiler/ml/ctype.ml +++ b/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 diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index 3b00ff9e5a3..3a13d4ac003 100644 --- a/compiler/ml/depend.ml +++ b/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 diff --git a/compiler/ml/env.ml b/compiler/ml/env.ml index 0626ba55520..a64f79185f5 100644 --- a/compiler/ml/env.ml +++ b/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; diff --git a/compiler/ml/longident.ml b/compiler/ml/longident.ml index 721a1310553..3ea191d3ed5 100644 --- a/compiler/ml/longident.ml +++ b/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 diff --git a/compiler/ml/longident.mli b/compiler/ml/longident.mli index 26ed938e846..51ddc2746c2 100644 --- a/compiler/ml/longident.mli +++ b/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 diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index a2f0fd45305..10025b0e0e7 100644 --- a/compiler/ml/pprintast.ml +++ b/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 diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index f583acef641..5aae8263738 100644 --- a/compiler/ml/printast.ml +++ b/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 diff --git a/compiler/ml/printtyp.ml b/compiler/ml/printtyp.ml index da6a3b25b16..6dabdb5f611 100644 --- a/compiler/ml/printtyp.ml +++ b/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 *) diff --git a/compiler/ml/printtyped.ml b/compiler/ml/printtyped.ml index 0c30f5eb1fe..f8bfaa170f2 100644 --- a/compiler/ml/printtyped.ml +++ b/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 diff --git a/compiler/ml/typemod.ml b/compiler/ml/typemod.ml index 7abdb05d434..bca0a511986 100644 --- a/compiler/ml/typemod.ml +++ b/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 diff --git a/compiler/ml/typetexp.ml b/compiler/ml/typetexp.ml index afee8118be6..4e8617b863b 100644 --- a/compiler/ml/typetexp.ml +++ b/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) diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml index ff5b1a42c1c..6749355ea3e 100644 --- a/compiler/syntax/src/res_ast_debugger.ml +++ b/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] diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index 1e9a3f5a735..6c47f99bfb2 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/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 diff --git a/tests/build_tests/super_errors/expected/functor_application_type_mismatch.res.expected b/tests/build_tests/super_errors/expected/functor_application_type_mismatch.res.expected new file mode 100644 index 00000000000..9341a4e475f --- /dev/null +++ b/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. \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/functor_application_type_mismatch.res b/tests/build_tests/super_errors/fixtures/functor_application_type_mismatch.res new file mode 100644 index 00000000000..7d7cda3460a --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/functor_application_type_mismatch.res @@ -0,0 +1,20 @@ +module type S = { + type t +} + +module F = (X: S) => { + type t = X.t + let make = (x: X.t): X.t => x +} + +module IntS = { + type t = int +} + +module App = F(IntS) + +// Type error on a value whose type lives behind a functor-application path. +// Exercises functor application (Path.Papply) and type-path error printing, +// confirming neither hits the assert false left in Ctype.lid_of_path after +// removing the unreachable Longident.Lapply constructor. +let bad: App.t = "not an int" diff --git a/tests/ounit_tests/ounit_lid_of_path_tests.ml b/tests/ounit_tests/ounit_lid_of_path_tests.ml new file mode 100644 index 00000000000..f9767631d59 --- /dev/null +++ b/tests/ounit_tests/ounit_lid_of_path_tests.ml @@ -0,0 +1,22 @@ +let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: )) +let ( =~ ) = OUnit.assert_equal + +(* [Ctype.lid_of_path] must render applicative-functor application paths + ([Path.Papply]) gracefully rather than aborting. Such paths are produced + internally (applicative functors are on by default), but ReScript source + cannot reference one, so the branch is unreachable end-to-end and is + exercised here directly with a synthetic path. *) +let papply () = + Path.Papply (Path.Pident (Ident.create "F"), Path.Pident (Ident.create "Arg")) + +let suites = + __FILE__ + >::: [ + (* F(Arg) renders to a single Lident, no crash *) + ( __LOC__ >:: fun _ -> + Ctype.lid_of_path (papply ()) =~ Longident.Lident "F(Arg)" ); + (* F(Arg).t renders to Ldot of that Lident *) + ( __LOC__ >:: fun _ -> + Ctype.lid_of_path (Path.Pdot (papply (), "t", 0)) + =~ Longident.Ldot (Longident.Lident "F(Arg)", "t") ); + ] diff --git a/tests/ounit_tests/ounit_tests_main.ml b/tests/ounit_tests/ounit_tests_main.ml index 7147844c6e7..aefc3f3abe2 100644 --- a/tests/ounit_tests/ounit_tests_main.ml +++ b/tests/ounit_tests/ounit_tests_main.ml @@ -14,6 +14,7 @@ let suites = Ounit_string_tests.suites; Ounit_int_vec_tests.suites; Ounit_ident_mask_tests.suites; + Ounit_lid_of_path_tests.suites; Ounit_utf8_test.suites; Ounit_unicode_tests.suites; Ounit_util_tests.suites; From 4c4b30831dd09fa63201df6ab75ac5cb1063d84c Mon Sep 17 00:00:00 2001 From: Jono Prest Date: Thu, 11 Jun 2026 14:45:36 +0000 Subject: [PATCH 2/2] Remove dead Sig_class and Sig_class_type signature variants Types.signature_item carried Sig_class and Sig_class_type (OCaml class / class-type items, each `of unit` dummy AST nodes). ReScript has no classes, so the parser and type checker never construct them; every match arm was assert false / identity / skip. Remove both variants and all their handling across the type system (btype, subst, env, mtype, includemod, printtyp, translmod, transl_recmodule), gentype, and analysis. Also drop the stale commented-out get_string block in lam_print.ml referencing the old 3-arg Sig_class form, and simplify the now-trivial filter_rem_sig. The frozen parsetree0 Pstr_class/Psig_class dummies are independent and left untouched. --- CHANGELOG.md | 1 + analysis/src/create_interface.ml | 6 ----- compiler/core/lam_print.ml | 27 ------------------- .../gentype/translate_signature_from_types.ml | 6 ----- .../gentype/translate_type_expr_from_types.ml | 3 +-- compiler/ml/btype.ml | 2 -- compiler/ml/env.ml | 8 +----- compiler/ml/includemod.ml | 17 +++--------- compiler/ml/mtype.ml | 21 +++++---------- compiler/ml/printtyp.ml | 7 +---- compiler/ml/subst.ml | 4 --- compiler/ml/transl_recmodule.ml | 2 -- compiler/ml/translmod.ml | 1 - compiler/ml/types.ml | 2 -- compiler/ml/types.mli | 2 -- 15 files changed, 13 insertions(+), 96 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 070c866edc8..e17f2cbc3f8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -68,6 +68,7 @@ - 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 diff --git a/analysis/src/create_interface.ml b/analysis/src/create_interface.ml index 506b52cc778..e9eee9575c4 100644 --- a/analysis/src/create_interface.ml +++ b/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 diff --git a/compiler/core/lam_print.ml b/compiler/core/lam_print.ml index 9408b11aea4..e5224c5f30e 100644 --- a/compiler/core/lam_print.ml +++ b/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 diff --git a/compiler/gentype/translate_signature_from_types.ml b/compiler/gentype/translate_signature_from_types.ml index 51921291521..72102774f85 100644 --- a/compiler/gentype/translate_signature_from_types.ml +++ b/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 diff --git a/compiler/gentype/translate_type_expr_from_types.ml b/compiler/gentype/translate_type_expr_from_types.ml index f88aedc2f56..96dd88cabe0 100644 --- a/compiler/gentype/translate_type_expr_from_types.ml +++ b/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 = diff --git a/compiler/ml/btype.ml b/compiler/ml/btype.ml index dc72b0578f4..1eeed117f44 100644 --- a/compiler/ml/btype.ml +++ b/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; diff --git a/compiler/ml/env.ml b/compiler/ml/env.ml index a64f79185f5..ba57ce091cd 100644 --- a/compiler/ml/env.ml +++ b/compiler/ml/env.ml @@ -1454,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 ( @@ -1551,9 +1549,7 @@ 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) -> @@ -1796,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 diff --git a/compiler/ml/includemod.ml b/compiler/ml/includemod.ml index d4c01d405e5..bd2e430030e 100644 --- a/compiler/ml/includemod.ml +++ b/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 = diff --git a/compiler/ml/mtype.ml b/compiler/ml/mtype.ml index 4ed00e0054e..f6f243ade16 100644 --- a/compiler/ml/mtype.ml +++ b/compiler/ml/mtype.ml @@ -89,11 +89,7 @@ and strengthen_sig ~aliasable env sg p pos = in Sig_modtype (id, newdecl) :: strengthen_sig ~aliasable (Env.add_modtype id decl env) rem p pos - (* Need to add the module type in case it is manifest *) - | (Sig_class _ as sigelt) :: rem -> - sigelt :: strengthen_sig ~aliasable env rem p (pos + 1) - | (Sig_class_type _ as sigelt) :: rem -> - sigelt :: strengthen_sig ~aliasable env rem p pos +(* Need to add the module type in case it is manifest *) and strengthen_decl ~aliasable env md p = match md.md_type with @@ -160,9 +156,7 @@ let nondep_supertype env mid mty = {mtd_type = None; mtd_loc = Location.none; mtd_attributes = []} ) :: rem' - | _ -> raise Not_found)) - | Sig_class () -> assert false - | Sig_class_type () -> assert false) + | _ -> raise Not_found))) and nondep_modtype_decl env mtd = {mtd with mtd_type = Misc.may_map (nondep_mty env Strict) mtd.mtd_type} in @@ -229,8 +223,7 @@ and type_paths_sig env p pos sg = p (pos + 1) rem | Sig_modtype (id, decl) :: rem -> type_paths_sig (Env.add_modtype id decl env) p pos rem - | (Sig_typext _ | Sig_class _) :: rem -> type_paths_sig env p (pos + 1) rem - | Sig_class_type _ :: rem -> type_paths_sig env p pos rem + | Sig_typext _ :: rem -> type_paths_sig env p (pos + 1) rem let rec no_code_needed env mty = match scrape env mty with @@ -252,9 +245,8 @@ and no_code_needed_sig env sg = && no_code_needed_sig (Env.add_module_declaration ~check:false id md env) rem - | (Sig_type _ | Sig_modtype _ | Sig_class_type _) :: rem -> - no_code_needed_sig env rem - | (Sig_typext _ | Sig_class _) :: _ -> false + | (Sig_type _ | Sig_modtype _) :: rem -> no_code_needed_sig env rem + | Sig_typext _ :: _ -> false (* Check whether a module type may return types *) @@ -286,8 +278,7 @@ and contains_type_item env = function is kept local to expressions. *) raise Exit | Sig_module (_, {md_type = mty}, _) -> contains_type env mty - | Sig_value _ | Sig_type _ | Sig_typext _ | Sig_class _ | Sig_class_type _ -> - () + | Sig_value _ | Sig_type _ | Sig_typext _ -> () let contains_type env mty = try diff --git a/compiler/ml/printtyp.ml b/compiler/ml/printtyp.ml index 6dabdb5f611..f1bfdd22609 100644 --- a/compiler/ml/printtyp.ml +++ b/compiler/ml/printtyp.ml @@ -1071,10 +1071,7 @@ let wrap_env fenv ftree arg = set_printing_env env; tree -let filter_rem_sig item rem = - match (item, rem) with - | Sig_class_type _, tydecl1 :: tydecl2 :: rem -> ([tydecl1; tydecl2], rem) - | _ -> ([], rem) +let filter_rem_sig _item rem = ([], rem) let dummy = { @@ -1161,8 +1158,6 @@ and trees_of_sigitem = function in [tree_of_module id md.md_type rs ~ellipsis] | Sig_modtype (id, decl) -> [tree_of_modtype_declaration id decl] - | Sig_class () -> [] - | Sig_class_type () -> [] and tree_of_modtype_declaration id decl = let mty = diff --git a/compiler/ml/subst.ml b/compiler/ml/subst.ml index 6956e90d496..9eeceac118a 100644 --- a/compiler/ml/subst.ml +++ b/compiler/ml/subst.ml @@ -337,11 +337,9 @@ let rec rename_bound_idents s idents = function rename_bound_idents (add_modtype id (Mty_ident (Pident id')) s) (id' :: idents) sg - | Sig_class_type () :: _ -> assert false | (Sig_value (id, _) | Sig_typext (id, _, _)) :: sg -> let id' = Ident.rename id in rename_bound_idents s (id' :: idents) sg - | Sig_class _ :: _ -> assert false let rec modtype s = function | Mty_ident p as mty -> ( match p with @@ -371,8 +369,6 @@ and signature_component s comp newid = Sig_typext (newid, extension_constructor s ext, es) | Sig_module (_id, d, rs) -> Sig_module (newid, module_declaration s d, rs) | Sig_modtype (_id, d) -> Sig_modtype (newid, modtype_declaration s d) - | Sig_class () -> Sig_class () - | Sig_class_type () -> Sig_class_type () and module_declaration s decl = { diff --git a/compiler/ml/transl_recmodule.ml b/compiler/ml/transl_recmodule.ml index 77617eda5d6..f19f827aa74 100644 --- a/compiler/ml/transl_recmodule.ml +++ b/compiler/ml/transl_recmodule.ml @@ -80,8 +80,6 @@ let init_shape modl = rem | Sig_modtype (id, minfo) :: rem -> init_shape_struct (Env.add_modtype id minfo env) rem - | Sig_class _ :: _ -> assert false - | Sig_class_type _ :: rem -> init_shape_struct env rem in try Some diff --git a/compiler/ml/translmod.ml b/compiler/ml/translmod.ml index 7e846adbb6f..aaf83129678 100644 --- a/compiler/ml/translmod.ml +++ b/compiler/ml/translmod.ml @@ -195,7 +195,6 @@ let rec bound_value_identifiers : Types.signature_item list -> Ident.t list = id :: bound_value_identifiers rem | Sig_typext (id, _, _) :: rem -> id :: bound_value_identifiers rem | Sig_module (id, _, _) :: rem -> id :: bound_value_identifiers rem - | Sig_class _ :: _ -> assert false | _ :: rem -> bound_value_identifiers rem (* Compile one or more functors, merging curried functors to produce diff --git a/compiler/ml/types.ml b/compiler/ml/types.ml index 9f443f3c5ff..c6b26198039 100644 --- a/compiler/ml/types.ml +++ b/compiler/ml/types.ml @@ -226,8 +226,6 @@ and signature_item = | Sig_typext of Ident.t * extension_constructor * ext_status | Sig_module of Ident.t * module_declaration * rec_status | Sig_modtype of Ident.t * modtype_declaration - | Sig_class of unit - | Sig_class_type of unit (* Dummy AST node *) and module_declaration = { md_type: module_type; diff --git a/compiler/ml/types.mli b/compiler/ml/types.mli index 598030ff12e..2ceef397d29 100644 --- a/compiler/ml/types.mli +++ b/compiler/ml/types.mli @@ -357,8 +357,6 @@ and signature_item = | Sig_typext of Ident.t * extension_constructor * ext_status | Sig_module of Ident.t * module_declaration * rec_status | Sig_modtype of Ident.t * modtype_declaration - | Sig_class of unit - | Sig_class_type of unit (* Dummy AST node *) and module_declaration = { md_type: module_type;