Ast cleanup exp object, exp unreachable

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
 

analysis/reanalyze/src/Arnold.ml

@@ -995,15 +995,9 @@ module Compile = struct
     | Texp_lazy _ ->
       notImplemented "Texp_lazy";
       assert false
-    | Texp_object _ ->
-      notImplemented "Texp_letmodule";
-      assert false
     | 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

analysis/reanalyze/src/SideEffects.ml

@@ -66,9 +66,7 @@ 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
   | _ -> (* on ocaml 4.08: Texp_letop | Texp_open *) true
 

analysis/src/Utils.ml

@@ -112,12 +112,10 @@ 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"
   | Pexp_open _ -> "Pexp_open"
-  | Pexp_unreachable -> "Pexp_unreachable"
 
 let identifyPpat pat =
   match pat with

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)

compiler/frontend/bs_ast_mapper.ml

@@ -370,14 +370,12 @@ 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)
     | 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

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

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

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

compiler/ml/ast_iterator.ml

@@ -352,14 +352,12 @@ 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) ->
       iter_loc sub lid;
       sub.expr sub e
     | Pexp_extension x -> sub.extension sub x
-    | Pexp_unreachable -> ()
 end
 
 module P = struct

compiler/ml/ast_mapper.ml

@@ -333,14 +333,12 @@ 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)
     | 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

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

compiler/ml/ast_mapper_to0.ml

@@ -339,14 +339,12 @@ 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)
     | 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

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) ->
@@ -297,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
 

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 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

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) ->

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)
@@ -311,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 = {

compiler/ml/pprintast.ml

@@ -661,14 +661,11 @@ 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 =
   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 =

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
@@ -347,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

compiler/ml/printtyped.ml

@@ -372,11 +372,9 @@ 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
-  | Texp_unreachable -> line i ppf "Texp_unreachable"
   | Texp_extension_constructor (li, _) ->
     line i ppf "Texp_extension_constructor %a" fmt_longident li
 

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_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
@@ -301,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 =

compiler/ml/tast_iterator.ml

@@ -210,9 +210,7 @@ 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 _ -> ()
 
 let package_type sub {pack_fields; _} =

compiler/ml/tast_mapper.ml

@@ -250,9 +250,7 @@ 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
   in
   {x with exp_extra; exp_desc; exp_env}