Remove some dead code. (#7312)

Author: cristianoc

compiler/core/js_of_lam_block.ml

@@ -33,7 +33,7 @@ let make_block mutable_flag (tag_info : Lam_tag_info.t) tag args =
 
 let field (field_info : Lam_compat.field_dbg_info) e (i : int32) =
   match field_info with
-  | Fld_tuple | Fld_array ->
+  | Fld_tuple ->
     E.array_index_by_int ?comment:(Lam_compat.str_of_field_info field_info) e i
   | Fld_poly_var_content -> E.poly_var_value_access e
   | Fld_poly_var_tag -> E.poly_var_tag_access e

compiler/core/lam_analysis.ml

@@ -97,8 +97,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
     (* TODO *)
     | Praw_js_code _
     (* byte swap *)
-    | Parraysets | Parraysetu | Poffsetref _ | Praise | Plazyforce | Psetfield _
-      ->
+    | Parraysets | Parraysetu | Poffsetref _ | Praise | Psetfield _ ->
       false)
   | Llet (_, _, arg, body) -> no_side_effects arg && no_side_effects body
   | Lswitch (_, _) -> false

compiler/core/lam_compat.ml

@@ -73,11 +73,10 @@ type field_dbg_info = Lambda.field_dbg_info =
   | Fld_extension
   | Fld_variant
   | Fld_cons
-  | Fld_array
 
 let str_of_field_info (x : field_dbg_info) : string option =
   match x with
-  | Fld_array | Fld_extension | Fld_variant | Fld_cons | Fld_poly_var_tag
+  | Fld_extension | Fld_variant | Fld_cons | Fld_poly_var_tag
   | Fld_poly_var_content | Fld_tuple ->
     None
   | Fld_record {name; _}

compiler/core/lam_compat.mli

@@ -37,7 +37,6 @@ type field_dbg_info = Lambda.field_dbg_info =
   | Fld_extension
   | Fld_variant
   | Fld_cons
-  | Fld_array
 
 val str_of_field_info : field_dbg_info -> string option
 

compiler/core/lam_compile_primitive.ml

@@ -605,13 +605,3 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
     match args with
     | [e1] -> E.runtime_call Primitive_modules.hash "hash_final_mix" args
     | _ -> assert false)
-  | Plazyforce
-  (* FIXME: we don't inline lazy force or at least
-     let buckle handle it
-  *)
-  (* let parm = Ident.create "prim" in
-     Lfunction(Curried, [parm],
-               Matching.inline_lazy_force (Lvar parm) Location.none)
-     It is inlined, this should not appear here *)
-    ->
-    assert false

compiler/core/lam_constant_convert.ml

@@ -63,7 +63,6 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t =
       if Ext_string.is_valid_hash_number name then
         Const_int {i = Ext_string.hash_number_as_i32_exn name; comment = None}
       else Const_pointer name)
-  | Const_float_array s -> assert false
   | Const_immstring s -> Const_string {s; unicode = false}
   | Const_block (t, xs) -> (
     let tag = Lambda.tag_of_tag_info t in

compiler/core/lam_convert.ml

@@ -229,7 +229,6 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
   | Pfield (id, info) -> prim ~primitive:(Pfield (id, info)) ~args loc
   | Psetfield (id, info) -> prim ~primitive:(Psetfield (id, info)) ~args loc
   | Pduprecord -> prim ~primitive:Pduprecord ~args loc
-  | Plazyforce -> prim ~primitive:Plazyforce ~args loc
   | Praise _ -> prim ~primitive:Praise ~args loc
   | Pobjcomp x -> prim ~primitive:(Pobjcomp x) ~args loc
   | Pobjorder -> prim ~primitive:Pobjorder ~args loc
@@ -248,8 +247,8 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
   | Paddint -> prim ~primitive:Paddint ~args loc
   | Psubint -> prim ~primitive:Psubint ~args loc
   | Pmulint -> prim ~primitive:Pmulint ~args loc
-  | Pdivint _is_safe (*FIXME*) -> prim ~primitive:Pdivint ~args loc
-  | Pmodint _is_safe (*FIXME*) -> prim ~primitive:Pmodint ~args loc
+  | Pdivint -> prim ~primitive:Pdivint ~args loc
+  | Pmodint -> prim ~primitive:Pmodint ~args loc
   | Pandint -> prim ~primitive:Pandint ~args loc
   | Porint -> prim ~primitive:Porint ~args loc
   | Pxorint -> prim ~primitive:Pxorint ~args loc
@@ -334,11 +333,6 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
   | Pjs_fn_make arity -> prim ~primitive:(Pjs_fn_make arity) ~args loc
   | Pjs_fn_make_unit -> prim ~primitive:Pjs_fn_make_unit ~args loc
   | Pjs_fn_method -> prim ~primitive:Pjs_fn_method ~args loc
-  | Pjs_unsafe_downgrade ->
-    let primitive : Lam_primitive.t =
-      Pjs_unsafe_downgrade {name = Ext_string.empty; setter = false}
-    in
-    prim ~primitive ~args loc
 
 (* Does not exist since we compile array in js backend unlike native backend *)
 

compiler/core/lam_primitive.ml

@@ -40,8 +40,6 @@ type t =
   | Psetfield of int * Lam_compat.set_field_dbg_info
   (* could have field info at least for record *)
   | Pduprecord
-  (* Force lazy values *)
-  | Plazyforce
   (* External call *)
   | Pjs_call of {
       prim_name: string;
@@ -222,10 +220,10 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
   | Pjs_apply | Pjs_runtime_apply | Pval_from_option | Pval_from_option_not_nest
   | Pundefined_to_opt | Pnull_to_opt | Pnull_undefined_to_opt | Pis_null
   | Pis_not_none | Psome | Psome_not_nest | Pis_undefined | Pis_null_undefined
-  | Pimport | Ptypeof | Pfn_arity | Plazyforce | Pis_poly_var_block | Pdebugger
-  | Pinit_mod | Pupdate_mod | Pduprecord | Pmakearray | Parraylength
-  | Parrayrefu | Parraysetu | Parrayrefs | Parraysets | Pjs_fn_make_unit
-  | Pjs_fn_method | Phash | Phash_mixstring | Phash_mixint | Phash_finalmix ->
+  | Pimport | Ptypeof | Pfn_arity | Pis_poly_var_block | Pdebugger | Pinit_mod
+  | Pupdate_mod | Pduprecord | Pmakearray | Parraylength | Parrayrefu
+  | Parraysetu | Parrayrefs | Parraysets | Pjs_fn_make_unit | Pjs_fn_method
+  | Phash | Phash_mixstring | Phash_mixint | Phash_finalmix ->
     rhs = lhs
   | Pcreate_extension a -> (
     match rhs with

compiler/core/lam_primitive.mli

@@ -36,7 +36,6 @@ type t =
   | Pfield of int * Lambda.field_dbg_info
   | Psetfield of int * Lambda.set_field_dbg_info
   | Pduprecord
-  | Plazyforce
   | Pjs_call of {
       (* Location.t *  [loc] is passed down *)
       prim_name: string;

compiler/core/lam_print.ml

@@ -82,7 +82,6 @@ let primitive ppf (prim : Lam_primitive.t) =
     let instr = "setfield " in
     fprintf ppf "%s%i" instr n
   | Pduprecord -> fprintf ppf "duprecord"
-  | Plazyforce -> fprintf ppf "force"
   | Pjs_call {prim_name} -> fprintf ppf "%s[js]" prim_name
   | Pjs_object_create _ -> fprintf ppf "[js.obj]"
   | Praise -> fprintf ppf "raise"

compiler/ml/datarepr.ml

@@ -101,11 +101,10 @@ let constructor_has_optional_shape
 
 let constructor_descrs ty_path decl cstrs =
   let ty_res = newgenconstr ty_path decl.type_params in
-  let num_consts = ref 0 and num_nonconsts = ref 0 and num_normal = ref 0 in
+  let num_consts = ref 0 and num_nonconsts = ref 0 in
   List.iter
-    (fun {cd_args; cd_res; _} ->
-      if cd_args = Cstr_tuple [] then incr num_consts else incr num_nonconsts;
-      if cd_res = None then incr num_normal)
+    (fun {cd_args; _} ->
+      if cd_args = Cstr_tuple [] then incr num_consts else incr num_nonconsts)
     cstrs;
   let rec describe_constructors idx_const idx_nonconst = function
     | [] -> []
@@ -154,7 +153,6 @@ let constructor_descrs ty_path decl cstrs =
           cstr_tag = tag;
           cstr_consts = !num_consts;
           cstr_nonconsts = !num_nonconsts;
-          cstr_normal = !num_normal;
           cstr_private = decl.type_private;
           cstr_generalized = cd_res <> None;
           cstr_loc = cd_loc;
@@ -208,7 +206,6 @@ let extension_descr path_ext ext =
     cstr_consts = -1;
     cstr_nonconsts = -1;
     cstr_private = ext.ext_private;
-    cstr_normal = -1;
     cstr_generalized = ext.ext_ret_type <> None;
     cstr_loc = ext.ext_loc;
     cstr_attributes = ext.ext_attributes;

compiler/ml/env.ml

@@ -57,7 +57,6 @@ let prefixed_sg = Hashtbl.create 113
 type error =
   | Illegal_renaming of string * string * string
   | Inconsistent_import of string * string * string
-  | Need_recursive_types of string * string
   | Missing_module of Location.t * Path.t * Path.t
   | Illegal_value_name of Location.t * string
 
@@ -147,8 +146,6 @@ type summary =
   | Env_extension of summary * Ident.t * extension_constructor
   | Env_module of summary * Ident.t * module_declaration
   | Env_modtype of summary * Ident.t * modtype_declaration
-  | Env_class of unit
-  | Env_cltype of unit
   | Env_open of summary * Path.t
   | Env_functor_arg of summary * Ident.t
   | Env_constraints of summary * type_declaration PathMap.t
@@ -732,8 +729,6 @@ let check_pers_struct name =
           " %a@ contains the compiled interface for @ %s when %s was expected"
           Location.print_filename filename ps_name name
       | Inconsistent_import _ -> assert false
-      | Need_recursive_types (name, _) ->
-        Format.sprintf "%s uses recursive types" name
       | Missing_module _ -> assert false
       | Illegal_value_name _ -> assert false
     in
@@ -2129,10 +2124,6 @@ let report_error ppf = function
       "@[<hov>The files %a@ and %a@ make inconsistent assumptions@ over \
        interface %s@]"
       Location.print_filename source1 Location.print_filename source2 name
-  | Need_recursive_types (import, export) ->
-    fprintf ppf
-      "@[<hov>Unit %s imports from %s, which uses recursive types.@ %s@]" export
-      import "The compilation flag -rectypes is required"
   | Missing_module (_, path1, path2) ->
     fprintf ppf "@[@[<hov>";
     if Path.same path1 path2 then

compiler/ml/env.mli

@@ -27,8 +27,6 @@ type summary =
   | Env_extension of summary * Ident.t * extension_constructor
   | Env_module of summary * Ident.t * module_declaration
   | Env_modtype of summary * Ident.t * modtype_declaration
-  | Env_class of unit
-  | Env_cltype of unit
   | Env_open of summary * Path.t
   | Env_functor_arg of summary * Ident.t
   | Env_constraints of summary * type_declaration PathMap.t
@@ -239,7 +237,6 @@ val env_of_only_summary : (summary -> Subst.t -> t) -> t -> t
 type error =
   | Illegal_renaming of string * string * string
   | Inconsistent_import of string * string * string
-  | Need_recursive_types of string * string
   | Missing_module of Location.t * Path.t * Path.t
   | Illegal_value_name of Location.t * string
 

compiler/ml/error_message_utils.ml

@@ -5,7 +5,6 @@ type type_clash_statement = FunctionCall
 type type_clash_context =
   | SetRecordField
   | ArrayValue
-  | FunctionReturn
   | MaybeUnwrapOption
   | IfCondition
   | IfReturn
@@ -53,8 +52,6 @@ let error_expected_type_text ppf type_clash_context =
     fprintf ppf
       "But it's being used with the @{<info>%s@} operator, which works on:"
       operator
-  | Some FunctionReturn ->
-    fprintf ppf "But this function is expecting you to return:"
   | Some StringConcat -> fprintf ppf "But string concatenation is expecting:"
   | _ -> fprintf ppf "But it's expected to have type:"