From a2b0d5cce6939194ec813fb535b30010e73e3d01 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Wed, 4 Dec 2024 08:44:06 +0100 Subject: [PATCH 1/4] AST cleanup: remove Pexp_object and Texp_object. --- analysis/reanalyze/src/Arnold.ml | 3 --- analysis/reanalyze/src/SideEffects.ml | 1 - analysis/src/Utils.ml | 1 - compiler/frontend/bs_ast_invariant.ml | 2 +- compiler/frontend/bs_ast_mapper.ml | 1 - compiler/ml/ast_iterator.ml | 1 - compiler/ml/ast_mapper.ml | 1 - compiler/ml/ast_mapper_to0.ml | 1 - compiler/ml/depend.ml | 1 - compiler/ml/parsetree.ml | 1 - compiler/ml/pprintast.ml | 4 +--- compiler/ml/printast.ml | 1 - compiler/ml/printtyped.ml | 1 - compiler/ml/rec_check.ml | 5 ++--- compiler/ml/tast_iterator.ml | 1 - compiler/ml/tast_mapper.ml | 1 - compiler/ml/translcore.ml | 1 - compiler/ml/typecore.ml | 3 --- compiler/ml/typedtree.ml | 1 - compiler/ml/typedtree.mli | 1 - compiler/ml/typedtreeIter.ml | 1 - compiler/ml/untypeast.ml | 1 - compiler/syntax/src/res_ast_debugger.ml | 1 - compiler/syntax/src/res_printer.ml | 1 - tests/tools_tests/ppx/TestPpx.res | 8 ++++++++ tests/tools_tests/src/expected/TestPpx.res.jsout | 8 ++++++++ 26 files changed, 20 insertions(+), 32 deletions(-) diff --git a/analysis/reanalyze/src/Arnold.ml b/analysis/reanalyze/src/Arnold.ml index 64f10b1f12..1cd72dd883 100644 --- a/analysis/reanalyze/src/Arnold.ml +++ b/analysis/reanalyze/src/Arnold.ml @@ -995,9 +995,6 @@ module Compile = struct | Texp_lazy _ -> notImplemented "Texp_lazy"; assert false - | Texp_object _ -> - notImplemented "Texp_letmodule"; - assert false | Texp_pack _ -> notImplemented "Texp_pack"; assert false diff --git a/analysis/reanalyze/src/SideEffects.ml b/analysis/reanalyze/src/SideEffects.ml index b226b4988d..23c4e40482 100644 --- a/analysis/reanalyze/src/SideEffects.ml +++ b/analysis/reanalyze/src/SideEffects.ml @@ -66,7 +66,6 @@ let rec exprNoSideEffects (expr : Typedtree.expression) = | Texp_setinstvar _ -> false | Texp_override _ -> false | Texp_letexception (_ec, e) -> e |> exprNoSideEffects - | Texp_object _ -> true | Texp_pack _ -> false | Texp_unreachable -> false | Texp_extension_constructor _ when true -> true diff --git a/analysis/src/Utils.ml b/analysis/src/Utils.ml index d136c181ae..1da46b3089 100644 --- a/analysis/src/Utils.ml +++ b/analysis/src/Utils.ml @@ -112,7 +112,6 @@ let identifyPexp pexp = | Pexp_assert _ -> "Pexp_assert" | Pexp_lazy _ -> "Pexp_lazy" | Pexp_poly _ -> "Pexp_poly" - | Pexp_object _ -> "Pexp_object" | Pexp_newtype _ -> "Pexp_newtype" | Pexp_pack _ -> "Pexp_pack" | Pexp_extension _ -> "Pexp_extension" diff --git a/compiler/frontend/bs_ast_invariant.ml b/compiler/frontend/bs_ast_invariant.ml index 9b5eb2994b..6870c6d160 100644 --- a/compiler/frontend/bs_ast_invariant.ml +++ b/compiler/frontend/bs_ast_invariant.ml @@ -94,7 +94,7 @@ let emit_external_warnings : iterator = (fun self ({pexp_loc = loc} as a) -> match a.pexp_desc with | Pexp_constant const -> check_constant loc const - | Pexp_object _ | Pexp_new _ -> + | Pexp_new _ -> Location.raise_errorf ~loc "OCaml style objects are not supported" | Pexp_variant (s, None) when Ext_string.is_valid_hash_number s -> ( try ignore (Ext_string.hash_number_as_i32_exn s : int32) diff --git a/compiler/frontend/bs_ast_mapper.ml b/compiler/frontend/bs_ast_mapper.ml index e37436ff95..c26b1c5adf 100644 --- a/compiler/frontend/bs_ast_mapper.ml +++ b/compiler/frontend/bs_ast_mapper.ml @@ -370,7 +370,6 @@ module E = struct | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) | Pexp_poly (e, t) -> poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) - | Pexp_object () -> assert false | Pexp_newtype (s, e) -> newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml index 4a136d983b..df650bcb13 100644 --- a/compiler/ml/ast_iterator.ml +++ b/compiler/ml/ast_iterator.ml @@ -352,7 +352,6 @@ module E = struct | Pexp_poly (e, t) -> sub.expr sub e; iter_opt (sub.typ sub) t - | Pexp_object () -> () | Pexp_newtype (_s, e) -> sub.expr sub e | Pexp_pack me -> sub.module_expr sub me | Pexp_open (_ovf, lid, e) -> diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index 40ee034a57..6d6879d0c5 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -333,7 +333,6 @@ module E = struct | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) | Pexp_poly (e, t) -> poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) - | Pexp_object () -> assert false | Pexp_newtype (s, e) -> newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index 1eedf1c1d7..badb3158ad 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -339,7 +339,6 @@ module E = struct | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) | Pexp_poly (e, t) -> poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) - | Pexp_object () -> assert false | Pexp_newtype (s, e) -> newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index 8e1c75aa20..fb299a5840 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -284,7 +284,6 @@ let rec add_expr bv exp = | Pexp_poly (e, t) -> add_expr bv e; add_opt add_type bv t - | Pexp_object () -> () | Pexp_newtype (_, e) -> add_expr bv e | Pexp_pack m -> add_module bv m | Pexp_open (_ovf, m, e) -> diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index 2193de9428..41fe010d24 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -300,7 +300,6 @@ and expression_desc = Can only be used as the expression under Cfk_concrete for methods (not values). *) - | Pexp_object of unit (* dummy AST node *) | Pexp_newtype of string loc * expression (* fun (type t) -> E *) | Pexp_pack of module_expr (* (module ME) diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index 9aca49766f..c43555f455 100644 --- a/compiler/ml/pprintast.ml +++ b/compiler/ml/pprintast.ml @@ -666,9 +666,7 @@ and expression ctxt f x = and expression1 ctxt f x = if x.pexp_attributes <> [] then expression ctxt f x - else match x.pexp_desc with - | Pexp_object () -> assert false - | _ -> expression2 ctxt f x + else expression2 ctxt f x (* used in [Pexp_apply] *) and expression2 ctxt f x = diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index 21e87aae9f..5be4ecfb01 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -334,7 +334,6 @@ and expression i ppf x = line i ppf "Pexp_poly\n"; expression i ppf e; option i core_type ppf cto - | Pexp_object () -> () | Pexp_newtype (s, e) -> line i ppf "Pexp_newtype \"%s\"\n" s.txt; expression i ppf e diff --git a/compiler/ml/printtyped.ml b/compiler/ml/printtyped.ml index b34db23013..be487ee196 100644 --- a/compiler/ml/printtyped.ml +++ b/compiler/ml/printtyped.ml @@ -372,7 +372,6 @@ and expression i ppf x = | Texp_lazy e -> line i ppf "Texp_lazy"; expression i ppf e - | Texp_object () -> () | Texp_pack me -> line i ppf "Texp_pack"; module_expr i ppf me diff --git a/compiler/ml/rec_check.ml b/compiler/ml/rec_check.ml index 061b9ed984..69a7786391 100644 --- a/compiler/ml/rec_check.ml +++ b/compiler/ml/rec_check.ml @@ -198,8 +198,8 @@ let rec classify_expression : Typedtree.expression -> sd = | Texp_ident _ | Texp_for _ | Texp_constant _ | Texp_new _ | Texp_instvar _ | Texp_tuple _ | Texp_array _ | Texp_construct _ | Texp_variant _ | Texp_record _ | Texp_setfield _ | Texp_while _ | Texp_setinstvar _ - | Texp_pack _ | Texp_object _ | Texp_function _ | Texp_lazy _ - | Texp_unreachable | Texp_extension_constructor _ -> + | Texp_pack _ | Texp_function _ | Texp_lazy _ | Texp_unreachable + | Texp_extension_constructor _ -> Static | Texp_apply ({exp_desc = Texp_ident (_, _, vd)}, _) when is_ref vd -> Static | Texp_apply _ | Texp_match _ | Texp_ifthenelse _ | Texp_send _ | Texp_field _ @@ -289,7 +289,6 @@ let rec expression : Env.env -> Typedtree.expression -> Use.t = | Texp_letexception (_, e) -> expression env e | Texp_assert e -> Use.inspect (expression env e) | Texp_pack m -> modexp env m - | Texp_object () -> assert false | Texp_try (e, cases) -> (* This is more permissive than the old check. *) let case env {Typedtree.c_rhs} = expression env c_rhs in diff --git a/compiler/ml/tast_iterator.ml b/compiler/ml/tast_iterator.ml index 97a2d31821..1a55e36ea8 100644 --- a/compiler/ml/tast_iterator.ml +++ b/compiler/ml/tast_iterator.ml @@ -210,7 +210,6 @@ let expr sub {exp_extra; exp_desc; exp_env; _} = sub.expr sub exp | Texp_assert exp -> sub.expr sub exp | Texp_lazy exp -> sub.expr sub exp - | Texp_object _ -> () | Texp_pack mexpr -> sub.module_expr sub mexpr | Texp_unreachable -> () | Texp_extension_constructor _ -> () diff --git a/compiler/ml/tast_mapper.ml b/compiler/ml/tast_mapper.ml index 7f5f55a016..f6e2f7a5bd 100644 --- a/compiler/ml/tast_mapper.ml +++ b/compiler/ml/tast_mapper.ml @@ -250,7 +250,6 @@ let expr sub x = Texp_letexception (sub.extension_constructor sub cd, sub.expr sub exp) | Texp_assert exp -> Texp_assert (sub.expr sub exp) | Texp_lazy exp -> Texp_lazy (sub.expr sub exp) - | Texp_object () -> Texp_object () | Texp_pack mexpr -> Texp_pack (sub.module_expr sub mexpr) | Texp_unreachable -> Texp_unreachable | Texp_extension_constructor _ as e -> e diff --git a/compiler/ml/translcore.ml b/compiler/ml/translcore.ml index aa902ee493..b649b0bbd1 100644 --- a/compiler/ml/translcore.ml +++ b/compiler/ml/translcore.ml @@ -986,7 +986,6 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda = optimize the translation just as Lazy.lazy_from_val would do *) Lprim (Pmakeblock Blk_lazy_general, [transl_exp e], e.exp_loc) - | Texp_object () -> assert false | Texp_unreachable -> raise (Error (e.exp_loc, Unreachable_reached)) and transl_list expr_list = List.map transl_exp expr_list diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 404bb70f7c..d461f39cc1 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -183,7 +183,6 @@ let iter_expression f e = | Pexp_letmodule (_, me, e) -> expr e; module_expr me - | Pexp_object _ -> assert false | Pexp_pack me -> module_expr me | Pexp_unreachable -> () and case {pc_lhs = _; pc_guard; pc_rhs} = @@ -1853,7 +1852,6 @@ let rec is_nonexpansive exp = | Texp_new _ -> assert false (* Note: nonexpansive only means no _observable_ side effects *) | Texp_lazy e -> is_nonexpansive e - | Texp_object () -> assert false | Texp_letmodule (_, _, mexp, e) -> is_nonexpansive_mod mexp && is_nonexpansive e | Texp_pack mexp -> is_nonexpansive_mod mexp @@ -3156,7 +3154,6 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp exp_attributes = sexp.pexp_attributes; exp_env = env; } - | Pexp_object _ -> assert false | Pexp_poly (sbody, sty) -> let ty, cty = match sty with diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml index 75a8f4d328..e4b1dfa73d 100644 --- a/compiler/ml/typedtree.ml +++ b/compiler/ml/typedtree.ml @@ -116,7 +116,6 @@ and expression_desc = | Texp_letexception of extension_constructor * expression | Texp_assert of expression | Texp_lazy of expression - | Texp_object of unit | Texp_pack of module_expr | Texp_unreachable | Texp_extension_constructor of Longident.t loc * Path.t diff --git a/compiler/ml/typedtree.mli b/compiler/ml/typedtree.mli index 0d86e70105..8a61648d22 100644 --- a/compiler/ml/typedtree.mli +++ b/compiler/ml/typedtree.mli @@ -218,7 +218,6 @@ and expression_desc = | Texp_letexception of extension_constructor * expression | Texp_assert of expression | Texp_lazy of expression - | Texp_object of unit | Texp_pack of module_expr | Texp_unreachable | Texp_extension_constructor of Longident.t loc * Path.t diff --git a/compiler/ml/typedtreeIter.ml b/compiler/ml/typedtreeIter.ml index 45d0506347..023bdae5b6 100644 --- a/compiler/ml/typedtreeIter.ml +++ b/compiler/ml/typedtreeIter.ml @@ -296,7 +296,6 @@ end = struct iter_expression exp | Texp_assert exp -> iter_expression exp | Texp_lazy exp -> iter_expression exp - | Texp_object () -> () | Texp_pack mexpr -> iter_module_expr mexpr | Texp_unreachable -> () | Texp_extension_constructor _ -> ()); diff --git a/compiler/ml/untypeast.ml b/compiler/ml/untypeast.ml index 92d174c844..c79e7a964f 100644 --- a/compiler/ml/untypeast.ml +++ b/compiler/ml/untypeast.ml @@ -394,7 +394,6 @@ let expression sub exp = Pexp_letexception (sub.extension_constructor sub ext, sub.expr sub exp) | Texp_assert exp -> Pexp_assert (sub.expr sub exp) | Texp_lazy exp -> Pexp_lazy (sub.expr sub exp) - | Texp_object () -> assert false | Texp_pack mexpr -> Pexp_pack (sub.module_expr sub mexpr) | Texp_unreachable -> Pexp_unreachable | Texp_extension_constructor (lid, _) -> diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml index aa944c3459..cbf2599310 100644 --- a/compiler/syntax/src/res_ast_debugger.ml +++ b/compiler/syntax/src/res_ast_debugger.ml @@ -702,7 +702,6 @@ module SexpAst = struct | Pexp_assert expr -> Sexp.list [Sexp.atom "Pexp_assert"; expression expr] | Pexp_lazy expr -> Sexp.list [Sexp.atom "Pexp_lazy"; expression expr] | Pexp_poly _ -> Sexp.list [Sexp.atom "Pexp_poly"] - | Pexp_object _ -> Sexp.list [Sexp.atom "Pexp_object"] | Pexp_newtype (lbl, expr) -> Sexp.list [Sexp.atom "Pexp_newtype"; string lbl.Asttypes.txt; expression expr] diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index 46ca96475f..cb3f77ad53 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -3420,7 +3420,6 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = | Pexp_setinstvar _ -> Doc.text "Pexp_setinstvar not implemented in printer" | Pexp_override _ -> Doc.text "Pexp_override not implemented in printer" | Pexp_poly _ -> Doc.text "Pexp_poly not implemented in printer" - | Pexp_object _ -> Doc.text "Pexp_object not implemented in printer" in let expr_with_await = if ParsetreeViewer.has_await_attribute e.pexp_attributes then diff --git a/tests/tools_tests/ppx/TestPpx.res b/tests/tools_tests/ppx/TestPpx.res index 7e7f4369c7..e72ab57267 100644 --- a/tests/tools_tests/ppx/TestPpx.res +++ b/tests/tools_tests/ppx/TestPpx.res @@ -4,3 +4,11 @@ type t = [#A | #B] let a: t = #A let b: t = #B + +module M = { + let v = 10 +} + +open M + +let vv = v diff --git a/tests/tools_tests/src/expected/TestPpx.res.jsout b/tests/tools_tests/src/expected/TestPpx.res.jsout index 54845d6992..f181aa2187 100644 --- a/tests/tools_tests/src/expected/TestPpx.res.jsout +++ b/tests/tools_tests/src/expected/TestPpx.res.jsout @@ -6,10 +6,18 @@ console.log("ppx test"); console.log("ppx test"); +let M = { + v: 10 +}; + let a = "A"; let b = "B"; +let vv = 10; + exports.a = a; exports.b = b; +exports.M = M; +exports.vv = vv; /* Not a pure module */ From ff9cf556090ad38415ad1a9b273ed608531d5730 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Wed, 4 Dec 2024 08:55:51 +0100 Subject: [PATCH 2/4] Remove unused Pexp_unreachable and Texp_unreachable. --- analysis/reanalyze/src/Arnold.ml | 3 - analysis/reanalyze/src/SideEffects.ml | 1 - analysis/src/Utils.ml | 1 - compiler/frontend/bs_ast_mapper.ml | 1 - compiler/ml/ast_helper.ml | 1 - compiler/ml/ast_helper.mli | 1 - compiler/ml/ast_iterator.ml | 1 - compiler/ml/ast_mapper.ml | 1 - compiler/ml/ast_mapper_from0.ml | 2 +- compiler/ml/ast_mapper_to0.ml | 1 - compiler/ml/depend.ml | 1 - compiler/ml/parmatch.ml | 88 +++++++++++-------------- compiler/ml/parsetree.ml | 4 +- compiler/ml/pprintast.ml | 1 - compiler/ml/printast.ml | 1 - compiler/ml/printtyped.ml | 1 - compiler/ml/rec_check.ml | 5 +- compiler/ml/tast_iterator.ml | 1 - compiler/ml/tast_mapper.ml | 1 - compiler/ml/translcore.ml | 16 +---- compiler/ml/typecore.ml | 12 ---- compiler/ml/typedtree.ml | 1 - compiler/ml/typedtree.mli | 1 - compiler/ml/typedtreeIter.ml | 1 - compiler/ml/untypeast.ml | 1 - compiler/syntax/src/res_ast_debugger.ml | 1 - compiler/syntax/src/res_printer.ml | 1 - 27 files changed, 47 insertions(+), 103 deletions(-) diff --git a/analysis/reanalyze/src/Arnold.ml b/analysis/reanalyze/src/Arnold.ml index 1cd72dd883..e5fb0b7a7d 100644 --- a/analysis/reanalyze/src/Arnold.ml +++ b/analysis/reanalyze/src/Arnold.ml @@ -998,9 +998,6 @@ module Compile = struct | Texp_pack _ -> notImplemented "Texp_pack"; assert false - | Texp_unreachable -> - notImplemented "Texp_unreachable"; - assert false | Texp_extension_constructor _ when true -> notImplemented "Texp_extension_constructor"; assert false diff --git a/analysis/reanalyze/src/SideEffects.ml b/analysis/reanalyze/src/SideEffects.ml index 23c4e40482..d028c4b20f 100644 --- a/analysis/reanalyze/src/SideEffects.ml +++ b/analysis/reanalyze/src/SideEffects.ml @@ -67,7 +67,6 @@ let rec exprNoSideEffects (expr : Typedtree.expression) = | Texp_override _ -> false | Texp_letexception (_ec, e) -> e |> exprNoSideEffects | Texp_pack _ -> false - | Texp_unreachable -> false | Texp_extension_constructor _ when true -> true | _ -> (* on ocaml 4.08: Texp_letop | Texp_open *) true diff --git a/analysis/src/Utils.ml b/analysis/src/Utils.ml index 1da46b3089..43117e4f78 100644 --- a/analysis/src/Utils.ml +++ b/analysis/src/Utils.ml @@ -116,7 +116,6 @@ let identifyPexp pexp = | Pexp_pack _ -> "Pexp_pack" | Pexp_extension _ -> "Pexp_extension" | Pexp_open _ -> "Pexp_open" - | Pexp_unreachable -> "Pexp_unreachable" let identifyPpat pat = match pat with diff --git a/compiler/frontend/bs_ast_mapper.ml b/compiler/frontend/bs_ast_mapper.ml index c26b1c5adf..e2a3889eba 100644 --- a/compiler/frontend/bs_ast_mapper.ml +++ b/compiler/frontend/bs_ast_mapper.ml @@ -376,7 +376,6 @@ module E = struct | Pexp_open (ovf, lid, e) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) - | Pexp_unreachable -> unreachable ~loc ~attrs () end module P = struct diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml index 9406274366..75a8bd8ca1 100644 --- a/compiler/ml/ast_helper.ml +++ b/compiler/ml/ast_helper.ml @@ -181,7 +181,6 @@ module Exp = struct let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) - let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable let case lhs ?guard rhs = {pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs} end diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli index 05fc814486..7019c2d2c1 100644 --- a/compiler/ml/ast_helper.mli +++ b/compiler/ml/ast_helper.mli @@ -202,7 +202,6 @@ module Exp : sig val open_ : ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression val extension : ?loc:loc -> ?attrs:attrs -> extension -> expression - val unreachable : ?loc:loc -> ?attrs:attrs -> unit -> expression val case : pattern -> ?guard:expression -> expression -> case end diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml index df650bcb13..d5ae6d8901 100644 --- a/compiler/ml/ast_iterator.ml +++ b/compiler/ml/ast_iterator.ml @@ -358,7 +358,6 @@ module E = struct iter_loc sub lid; sub.expr sub e | Pexp_extension x -> sub.extension sub x - | Pexp_unreachable -> () end module P = struct diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index 6d6879d0c5..90a5f395dc 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -339,7 +339,6 @@ module E = struct | Pexp_open (ovf, lid, e) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) - | Pexp_unreachable -> unreachable ~loc ~attrs () end module P = struct diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml index 867ec9714d..1891401baa 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -347,7 +347,7 @@ module E = struct | Pexp_open (ovf, lid, e) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) - | Pexp_unreachable -> unreachable ~loc ~attrs () + | Pexp_unreachable -> assert false end module P = struct diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index badb3158ad..c954017931 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -345,7 +345,6 @@ module E = struct | Pexp_open (ovf, lid, e) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) - | Pexp_unreachable -> unreachable ~loc ~attrs () end module P = struct diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index fb299a5840..8c894832b8 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -296,7 +296,6 @@ let rec add_expr bv exp = | Pstr_eval ({pexp_desc = Pexp_construct (c, None)}, _) -> add bv c | _ -> handle_extension e) | Pexp_extension e -> handle_extension e - | Pexp_unreachable -> () and add_cases bv cases = List.iter (add_case bv) cases diff --git a/compiler/ml/parmatch.ml b/compiler/ml/parmatch.ml index c3036b65e7..80c0d9e3bd 100644 --- a/compiler/ml/parmatch.ml +++ b/compiler/ml/parmatch.ml @@ -2179,64 +2179,54 @@ let do_check_fragile_gadt = do_check_fragile_param exhaust_gadt (********************************) let check_unused pred casel = - if - Warnings.is_active Warnings.Unused_match - || List.exists (fun c -> c.c_rhs.exp_desc = Texp_unreachable) casel - then + if Warnings.is_active Warnings.Unused_match then let rec do_rec pref = function | [] -> () - | {c_lhs = q; c_guard; c_rhs} :: rem -> + | {c_lhs = q; c_guard} :: rem -> let qs = [q] in (try let pss = get_mins le_pats (Ext_list.filter pref (compats qs)) in (* First look for redundant or partially redundant patterns *) let r = every_satisfiables (make_rows pss) (make_row qs) in - let refute = c_rhs.exp_desc = Texp_unreachable in (* Do not warn for unused [pat -> .] *) - if r = Unused && refute then () - else - let r = - (* Do not refine if there are no other lines *) - let skip = - r = Unused - || ((not refute) && pref = []) - || not (refute || Warnings.is_active Warnings.Unreachable_case) - in - if skip then r - else - (* Then look for empty patterns *) - let sfs = satisfiables pss qs in - if sfs = [] then Unused - else - let sfs = - List.map - (function - | [u] -> u - | _ -> assert false) - sfs - in - let u = orify_many sfs in - (*Format.eprintf "%a@." pretty_val u;*) - let pattern, constrs, labels = Conv.conv u in - let pattern = - {pattern with Parsetree.ppat_loc = q.pat_loc} - in - match pred refute constrs labels pattern with - | None when not refute -> - Location.prerr_warning q.pat_loc Warnings.Unreachable_case; - Used - | _ -> r + let r = + (* Do not refine if there are no other lines *) + let skip = + r = Unused || pref = [] + || not (Warnings.is_active Warnings.Unreachable_case) in - match r with - | Unused -> Location.prerr_warning q.pat_loc Warnings.Unused_match - | Upartial ps -> - ps - |> List.filter (fun p -> - not - (Variant_type_spread.is_pat_from_variant_spread_attr p)) - |> List.iter (fun p -> - Location.prerr_warning p.pat_loc Warnings.Unused_pat) - | Used -> () + if skip then r + else + (* Then look for empty patterns *) + let sfs = satisfiables pss qs in + if sfs = [] then Unused + else + let sfs = + List.map + (function + | [u] -> u + | _ -> assert false) + sfs + in + let u = orify_many sfs in + (*Format.eprintf "%a@." pretty_val u;*) + let pattern, constrs, labels = Conv.conv u in + let pattern = {pattern with Parsetree.ppat_loc = q.pat_loc} in + match pred false constrs labels pattern with + | None -> + Location.prerr_warning q.pat_loc Warnings.Unreachable_case; + Used + | _ -> r + in + match r with + | Unused -> Location.prerr_warning q.pat_loc Warnings.Unused_match + | Upartial ps -> + ps + |> List.filter (fun p -> + not (Variant_type_spread.is_pat_from_variant_spread_attr p)) + |> List.iter (fun p -> + Location.prerr_warning p.pat_loc Warnings.Unused_pat) + | Used -> () with Empty | Not_found | NoGuard -> assert false); if c_guard <> None then do_rec pref rem else do_rec ([q] :: pref) rem diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index 41fe010d24..3911b3f50c 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -310,8 +310,8 @@ and expression_desc = (* M.(E) let open M in E let! open M in E *) - | Pexp_extension of extension (* [%id] *) - | Pexp_unreachable + | Pexp_extension of extension +(* [%id] *) (* . *) and case = { diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index c43555f455..f4b5bd1a17 100644 --- a/compiler/ml/pprintast.ml +++ b/compiler/ml/pprintast.ml @@ -661,7 +661,6 @@ and expression ctxt f x = | Pexp_variant (l,Some eo) -> pp f "@[<2>`%s@;%a@]" l (simple_expr ctxt) eo | Pexp_extension e -> extension ctxt f e - | Pexp_unreachable -> pp f "." | _ -> expression1 ctxt f x and expression1 ctxt f x = diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index 5be4ecfb01..a60cbd8ab7 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -346,7 +346,6 @@ and expression i ppf x = | Pexp_extension (s, arg) -> line i ppf "Pexp_extension \"%s\"\n" s.txt; payload i ppf arg - | Pexp_unreachable -> line i ppf "Pexp_unreachable" and value_description i ppf x = line i ppf "value_description %a %a\n" fmt_string_loc x.pval_name fmt_location diff --git a/compiler/ml/printtyped.ml b/compiler/ml/printtyped.ml index be487ee196..cc5df3479a 100644 --- a/compiler/ml/printtyped.ml +++ b/compiler/ml/printtyped.ml @@ -375,7 +375,6 @@ and expression i ppf x = | Texp_pack me -> line i ppf "Texp_pack"; module_expr i ppf me - | Texp_unreachable -> line i ppf "Texp_unreachable" | Texp_extension_constructor (li, _) -> line i ppf "Texp_extension_constructor %a" fmt_longident li diff --git a/compiler/ml/rec_check.ml b/compiler/ml/rec_check.ml index 69a7786391..9296ad086b 100644 --- a/compiler/ml/rec_check.ml +++ b/compiler/ml/rec_check.ml @@ -198,8 +198,8 @@ let rec classify_expression : Typedtree.expression -> sd = | Texp_ident _ | Texp_for _ | Texp_constant _ | Texp_new _ | Texp_instvar _ | Texp_tuple _ | Texp_array _ | Texp_construct _ | Texp_variant _ | Texp_record _ | Texp_setfield _ | Texp_while _ | Texp_setinstvar _ - | Texp_pack _ | Texp_function _ | Texp_lazy _ | Texp_unreachable - | Texp_extension_constructor _ -> + | Texp_pack _ | Texp_function _ | Texp_lazy _ | Texp_extension_constructor _ + -> Static | Texp_apply ({exp_desc = Texp_ident (_, _, vd)}, _) when is_ref vd -> Static | Texp_apply _ | Texp_match _ | Texp_ifthenelse _ | Texp_send _ | Texp_field _ @@ -300,7 +300,6 @@ let rec expression : Env.env -> Typedtree.expression -> Use.t = match Typeopt.classify_lazy_argument e with | `Constant_or_function | `Identifier _ | `Float -> expression env e | `Other -> Use.delay (expression env e)) - | Texp_unreachable -> Use.empty | Texp_extension_constructor _ -> Use.empty and option : 'a. (Env.env -> 'a -> Use.t) -> Env.env -> 'a option -> Use.t = diff --git a/compiler/ml/tast_iterator.ml b/compiler/ml/tast_iterator.ml index 1a55e36ea8..481db7ef26 100644 --- a/compiler/ml/tast_iterator.ml +++ b/compiler/ml/tast_iterator.ml @@ -211,7 +211,6 @@ let expr sub {exp_extra; exp_desc; exp_env; _} = | Texp_assert exp -> sub.expr sub exp | Texp_lazy exp -> sub.expr sub exp | Texp_pack mexpr -> sub.module_expr sub mexpr - | Texp_unreachable -> () | Texp_extension_constructor _ -> () let package_type sub {pack_fields; _} = diff --git a/compiler/ml/tast_mapper.ml b/compiler/ml/tast_mapper.ml index f6e2f7a5bd..b5622baacc 100644 --- a/compiler/ml/tast_mapper.ml +++ b/compiler/ml/tast_mapper.ml @@ -251,7 +251,6 @@ let expr sub x = | Texp_assert exp -> Texp_assert (sub.expr sub exp) | Texp_lazy exp -> Texp_lazy (sub.expr sub exp) | Texp_pack mexpr -> Texp_pack (sub.module_expr sub mexpr) - | Texp_unreachable -> Texp_unreachable | Texp_extension_constructor _ as e -> e in {x with exp_extra; exp_desc; exp_env} diff --git a/compiler/ml/translcore.ml b/compiler/ml/translcore.ml index b649b0bbd1..27b8152d44 100644 --- a/compiler/ml/translcore.ml +++ b/compiler/ml/translcore.ml @@ -24,7 +24,7 @@ open Typedtree open Typeopt open Lambda -type error = Unknown_builtin_primitive of string | Unreachable_reached +type error = Unknown_builtin_primitive of string exception Error of Location.t * error @@ -986,7 +986,6 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda = optimize the translation just as Lazy.lazy_from_val would do *) Lprim (Pmakeblock Blk_lazy_general, [transl_exp e], e.exp_loc) - | Texp_unreachable -> raise (Error (e.exp_loc, Unreachable_reached)) and transl_list expr_list = List.map transl_exp expr_list @@ -998,11 +997,7 @@ and transl_guard guard rhs = and transl_case {c_lhs; c_guard; c_rhs} = (c_lhs, transl_guard c_guard c_rhs) -and transl_cases cases = - let cases = - Ext_list.filter cases (fun c -> c.c_rhs.exp_desc <> Texp_unreachable) - in - List.map transl_case cases +and transl_cases cases = List.map transl_case cases and transl_case_try {c_lhs; c_guard; c_rhs} = match c_lhs.pat_desc with @@ -1013,11 +1008,7 @@ and transl_case_try {c_lhs; c_guard; c_rhs} = (fun () -> Hashtbl.remove try_ids id) | _ -> (c_lhs, transl_guard c_guard c_rhs) -and transl_cases_try cases = - let cases = - Ext_list.filter cases (fun c -> c.c_rhs.exp_desc <> Texp_unreachable) - in - List.map transl_case_try cases +and transl_cases_try cases = List.map transl_case_try cases and transl_apply ?(inlined = Default_inline) ?(uncurried_partial_application = None) lam sargs loc = @@ -1342,7 +1333,6 @@ open Format let report_error ppf = function | Unknown_builtin_primitive prim_name -> fprintf ppf "Unknown builtin primitive \"%s\"" prim_name - | Unreachable_reached -> fprintf ppf "Unreachable expression was reached" let () = Location.register_error_of_exn (function diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index d461f39cc1..eb2fd7aa9f 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -184,7 +184,6 @@ let iter_expression f e = expr e; module_expr me | Pexp_pack me -> module_expr me - | Pexp_unreachable -> () and case {pc_lhs = _; pc_guard; pc_rhs} = may expr pc_guard; expr pc_rhs @@ -3299,16 +3298,6 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp | _ -> raise (Error (loc, env, Invalid_extension_constructor_payload))) | Pexp_extension ext -> raise (Error_forward (Builtin_attributes.error_of_extension ext)) - | Pexp_unreachable -> - re - { - exp_desc = Texp_unreachable; - exp_loc = loc; - exp_extra = []; - exp_type = instance env ty_expected; - exp_attributes = sexp.pexp_attributes; - exp_env = env; - } and type_function ?in_function loc attrs env ty_expected l caselist = let loc_fun, ty_fun = @@ -4014,7 +4003,6 @@ and type_cases ?root_type_clash_context ?in_function env ty_arg ty_res in let needs_exhaust_check = match caselist with - | [{pc_rhs = {pexp_desc = Pexp_unreachable}}] -> true | [{pc_lhs}] when is_var pc_lhs -> false | _ -> true in diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml index e4b1dfa73d..8713d6f3bd 100644 --- a/compiler/ml/typedtree.ml +++ b/compiler/ml/typedtree.ml @@ -117,7 +117,6 @@ and expression_desc = | Texp_assert of expression | Texp_lazy of expression | Texp_pack of module_expr - | Texp_unreachable | Texp_extension_constructor of Longident.t loc * Path.t and meth = Tmeth_name of string diff --git a/compiler/ml/typedtree.mli b/compiler/ml/typedtree.mli index 8a61648d22..9d57d2747d 100644 --- a/compiler/ml/typedtree.mli +++ b/compiler/ml/typedtree.mli @@ -219,7 +219,6 @@ and expression_desc = | Texp_assert of expression | Texp_lazy of expression | Texp_pack of module_expr - | Texp_unreachable | Texp_extension_constructor of Longident.t loc * Path.t and meth = Tmeth_name of string diff --git a/compiler/ml/typedtreeIter.ml b/compiler/ml/typedtreeIter.ml index 023bdae5b6..aef0f62491 100644 --- a/compiler/ml/typedtreeIter.ml +++ b/compiler/ml/typedtreeIter.ml @@ -297,7 +297,6 @@ end = struct | Texp_assert exp -> iter_expression exp | Texp_lazy exp -> iter_expression exp | Texp_pack mexpr -> iter_module_expr mexpr - | Texp_unreachable -> () | Texp_extension_constructor _ -> ()); Iter.leave_expression exp diff --git a/compiler/ml/untypeast.ml b/compiler/ml/untypeast.ml index c79e7a964f..c0760e2ed1 100644 --- a/compiler/ml/untypeast.ml +++ b/compiler/ml/untypeast.ml @@ -395,7 +395,6 @@ let expression sub exp = | Texp_assert exp -> Pexp_assert (sub.expr sub exp) | Texp_lazy exp -> Pexp_lazy (sub.expr sub exp) | Texp_pack mexpr -> Pexp_pack (sub.module_expr sub mexpr) - | Texp_unreachable -> Pexp_unreachable | Texp_extension_constructor (lid, _) -> Pexp_extension ( {txt = "ocaml.extension_constructor"; loc}, diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml index cbf2599310..5705563d4f 100644 --- a/compiler/syntax/src/res_ast_debugger.ml +++ b/compiler/syntax/src/res_ast_debugger.ml @@ -717,7 +717,6 @@ module SexpAst = struct ] | Pexp_extension ext -> Sexp.list [Sexp.atom "Pexp_extension"; extension ext] - | Pexp_unreachable -> Sexp.atom "Pexp_unreachable" in Sexp.list [Sexp.atom "expression"; desc] diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index cb3f77ad53..2d47833742 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -3190,7 +3190,6 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = else if ParsetreeViewer.is_binary_expression e then print_binary_expression ~state e cmt_tbl else print_pexp_apply ~state e cmt_tbl - | Pexp_unreachable -> Doc.dot | Pexp_field (expr, longident_loc) -> let lhs = let doc = print_expression_with_comments ~state expr cmt_tbl in From e1724db69bc9f94b72a3616eb069e7247bc0ee94 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Wed, 4 Dec 2024 08:58:54 +0100 Subject: [PATCH 3/4] small cleanup --- CHANGELOG.md | 1 + compiler/ml/parmatch.ml | 2 +- compiler/ml/parmatch.mli | 3 +-- compiler/ml/typecore.ml | 11 +++-------- 4 files changed, 6 insertions(+), 11 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 60e00efb5d..2d1196006f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -19,6 +19,7 @@ #### :house: Internal - Use latest compiler for tests. https://github.com/rescript-lang/rescript/pull/7186 - Added infra to modernise AST: theres' Parsetree, Parsetree0 (legacy), and conversion functions to keep compatibility with PPX. https://github.com/rescript-lang/rescript/pull/7185 +- Ast cleanup: remove exp object and exp unreachable. https://github.com/rescript-lang/rescript/pull/7189 # 12.0.0-alpha.5 diff --git a/compiler/ml/parmatch.ml b/compiler/ml/parmatch.ml index 80c0d9e3bd..64fcb67787 100644 --- a/compiler/ml/parmatch.ml +++ b/compiler/ml/parmatch.ml @@ -2212,7 +2212,7 @@ let check_unused pred casel = (*Format.eprintf "%a@." pretty_val u;*) let pattern, constrs, labels = Conv.conv u in let pattern = {pattern with Parsetree.ppat_loc = q.pat_loc} in - match pred false constrs labels pattern with + match pred constrs labels pattern with | None -> Location.prerr_warning q.pat_loc Warnings.Unreachable_case; Used diff --git a/compiler/ml/parmatch.mli b/compiler/ml/parmatch.mli index 1213d47831..c3fd33ea68 100644 --- a/compiler/ml/parmatch.mli +++ b/compiler/ml/parmatch.mli @@ -84,8 +84,7 @@ val check_partial_gadt : case list -> partial val check_unused : - (bool -> - (string, constructor_description) Hashtbl.t -> + ((string, constructor_description) Hashtbl.t -> (string, label_description) Hashtbl.t -> Parsetree.pattern -> pattern option) -> diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index eb2fd7aa9f..c5d1a7f8f7 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -1750,14 +1750,9 @@ let check_partial ?(lev = get_current_level ()) env expected_ty loc cases = let check_unused ?(lev = get_current_level ()) env expected_ty cases = Parmatch.check_unused - (fun refute constrs labels spat -> - match - partial_pred ~lev ~mode:Split_or ~explode:5 env expected_ty constrs - labels spat - with - | Some pat when refute -> - raise (Error (spat.ppat_loc, env, Unrefuted_pattern pat)) - | r -> r) + (fun constrs labels spat -> + partial_pred ~lev ~mode:Split_or ~explode:5 env expected_ty constrs labels + spat) cases let add_pattern_variables ?check ?check_as env = From 9105709d71ad2e12e7d52d1aba9be6567b59c186 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Wed, 4 Dec 2024 09:00:34 +0100 Subject: [PATCH 4/4] Update ast_helper0.ml --- compiler/ml/ast_helper0.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/ml/ast_helper0.ml b/compiler/ml/ast_helper0.ml index db575477b3..cc008b3d51 100644 --- a/compiler/ml/ast_helper0.ml +++ b/compiler/ml/ast_helper0.ml @@ -182,7 +182,6 @@ module Exp = struct let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) - let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable let case lhs ?guard rhs = {pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs} end