typecore dce

Author: cristianoc

compiler/ml/typecore.ml

@@ -69,7 +69,6 @@ type error =
   | Exception_pattern_below_toplevel
   | Inlined_record_escape
   | Inlined_record_expected
-  | Unrefuted_pattern of pattern
   | Invalid_extension_constructor_payload
   | Not_an_extension_constructor
   | Literal_overflow of string
@@ -1997,19 +1996,6 @@ let generalizable level ty =
     false
 
 (* Helpers for packaged modules. *)
-let create_package_type loc env (p, l) =
-  let s = !Typetexp.transl_modtype_longident loc env p in
-  let fields =
-    List.map
-      (fun (name, ct) -> (name, Typetexp.transl_simple_type env false ct))
-      l
-  in
-  let ty =
-    newty
-      (Tpackage
-         (s, List.map fst l, List.map (fun (_, cty) -> cty.ctyp_type) fields))
-  in
-  (s, fields, ty)
 
 let wrap_unpacks sexp unpacks =
   let open Ast_helper in
@@ -4154,12 +4140,6 @@ let type_binding env rec_flag spat_sexp_list scope =
   in
   (pat_exp_list, new_env)
 
-let type_let env rec_flag spat_sexp_list scope =
-  let pat_exp_list, new_env, _unpacks =
-    type_let env rec_flag spat_sexp_list scope false
-  in
-  (pat_exp_list, new_env)
-
 (* Typing of toplevel expressions *)
 
 let type_expression env sexp =
@@ -4436,10 +4416,6 @@ let report_error env ppf error =
        escape.@]"
   | Inlined_record_expected ->
     fprintf ppf "@[This constructor expects an inlined record argument.@]"
-  | Unrefuted_pattern pat ->
-    fprintf ppf "@[%s@ %s@ %a@]" "This match case could not be refuted."
-      "Here is an example of a value that would reach it:" Parmatch.top_pretty
-      pat
   | Invalid_extension_constructor_payload ->
     fprintf ppf
       "Invalid [%%extension_constructor] payload, a constructor is expected."
@@ -4477,8 +4453,6 @@ let report_error env ppf error =
     fprintf ppf
       "Direct field access on a dict is not supported. Use Dict.get instead."
 
-let super_report_error_no_wrap_printing_env = report_error
-
 let report_error env ppf err =
   Printtyp.wrap_printing_env env (fun () -> report_error env ppf err)
 
@@ -4489,7 +4463,4 @@ let () =
     | Error_forward err -> Some err
     | _ -> None)
 
-(* drop ?recarg argument from the external API *)
-let type_expect ?in_function env e ty = type_expect ?in_function env e ty
 let type_exp env e = type_exp env e
-let type_argument env e t1 t2 = type_argument env e t1 t2

compiler/ml/typecore.mli

@@ -27,12 +27,6 @@ val type_binding :
   Parsetree.value_binding list ->
   Annot.ident option ->
   Typedtree.value_binding list * Env.t
-val type_let :
-  Env.t ->
-  rec_flag ->
-  Parsetree.value_binding list ->
-  Annot.ident option ->
-  Typedtree.value_binding list * Env.t
 val type_expression : Env.t -> Parsetree.expression -> Typedtree.expression
 val check_partial :
   ?lev:int ->
@@ -41,20 +35,8 @@ val check_partial :
   Location.t ->
   Typedtree.case list ->
   Typedtree.partial
-val type_expect :
-  ?in_function:Location.t * type_expr ->
-  Env.t ->
-  Parsetree.expression ->
-  type_expr ->
-  Typedtree.expression
 val type_exp : Env.t -> Parsetree.expression -> Typedtree.expression
 val type_approx : Env.t -> Parsetree.expression -> type_expr
-val type_argument :
-  Env.t ->
-  Parsetree.expression ->
-  type_expr ->
-  type_expr ->
-  Typedtree.expression
 
 val option_some : Typedtree.expression -> Typedtree.expression
 val option_none : type_expr -> Location.t -> Typedtree.expression
@@ -112,7 +94,6 @@ type error =
   | Exception_pattern_below_toplevel
   | Inlined_record_escape
   | Inlined_record_expected
-  | Unrefuted_pattern of Typedtree.pattern
   | Invalid_extension_constructor_payload
   | Not_an_extension_constructor
   | Literal_overflow of string
@@ -126,9 +107,6 @@ type error =
 exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error
 
-val super_report_error_no_wrap_printing_env :
-  Env.t -> formatter -> error -> unit
-
 val report_error : Env.t -> formatter -> error -> unit
 (* Deprecated.  Use Location.{error_of_exn, report_error}. *)
 
@@ -154,10 +132,4 @@ val type_package :
   Typedtree.module_expr * type_expr list)
   ref
 
-val create_package_type :
-  Location.t ->
-  Env.t ->
-  Longident.t * (Longident.t * Parsetree.core_type) list ->
-  Path.t * (Longident.t * Typedtree.core_type) list * Types.type_expr
-
 val constant : Parsetree.constant -> (Asttypes.constant, error) result

compiler/ml/typemod.ml

@@ -1790,12 +1790,6 @@ let type_implementation_more ?check_exists sourcefile outputprefix modulename
       (Some sourcefile) initial_env None;
     raise e
 
-let type_implementation sourcefile outputprefix modulename initial_env ast =
-  let a, b, _, _ =
-    type_implementation_more sourcefile outputprefix modulename initial_env ast
-  in
-  (a, b)
-
 let save_signature modname tsg outputprefix source_file initial_env cmi =
   Cmt_format.save_cmt (outputprefix ^ ".cmti") modname
     (Cmt_format.Interface tsg) (Some source_file) initial_env (Some cmi)
@@ -1900,8 +1894,6 @@ let report_error ppf = function
   | Cannot_scrape_alias p ->
     fprintf ppf "This is an alias for module %a, which is missing" path p
 
-let super_report_error_no_wrap_printing_env = report_error
-
 let report_error env ppf err =
   Printtyp.wrap_printing_env env (fun () -> report_error ppf err)
 

compiler/ml/typemod.mli

@@ -38,14 +38,6 @@ val type_implementation_more :
   Parsetree.structure ->
   Typedtree.structure * Typedtree.module_coercion * Env.t * Types.signature
 
-val type_implementation :
-  string ->
-  string ->
-  string ->
-  Env.t ->
-  Parsetree.structure ->
-  Typedtree.structure * Typedtree.module_coercion
-
 val transl_signature : Env.t -> Parsetree.signature -> Typedtree.signature
 val check_nongen_schemes : Env.t -> Types.signature -> unit
 val type_open_ :
@@ -96,6 +88,4 @@ type error =
 exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error
 
-val super_report_error_no_wrap_printing_env : formatter -> error -> unit
-
 val report_error : Env.t -> formatter -> error -> unit

compiler/ml/typeopt.ml

@@ -108,8 +108,6 @@ let is_base_type env ty base_ty_path =
 let maybe_pointer_type env ty =
   if Ctype.maybe_pointer_type env ty then Pointer else Immediate
 
-let maybe_pointer exp = maybe_pointer_type exp.exp_env exp.exp_type
-
 type classification =
   | Int
   | Float

compiler/ml/typeopt.mli

@@ -20,7 +20,6 @@ val is_function_type :
 val is_base_type : Env.t -> Types.type_expr -> Path.t -> bool
 
 val maybe_pointer_type : Env.t -> Types.type_expr -> Lambda.immediate_or_pointer
-val maybe_pointer : Typedtree.expression -> Lambda.immediate_or_pointer
 
 val classify_lazy_argument :
   Typedtree.expression ->