Skip to content

Remove some dead code. #7312

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 8 commits into from
Feb 25, 2025
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
52 changes: 0 additions & 52 deletions compiler/ml/typetexp.ml
Original file line number Diff line number Diff line change
Expand Up @@ -30,9 +30,6 @@ type error =
| Unbound_type_constructor of Longident.t
| Unbound_type_constructor_2 of Path.t
| Type_arity_mismatch of Longident.t * int * int
| Bound_type_variable of string
| Recursive_type
| Unbound_row_variable of Longident.t
| Type_mismatch of (type_expr * type_expr) list
| Alias_type_mismatch of (type_expr * type_expr) list
| Present_has_conjunction of string
Expand Down Expand Up @@ -131,7 +128,6 @@ let find_constructor =
let find_all_constructors =
find_component Env.lookup_all_constructors (fun lid ->
Unbound_constructor lid)
let find_label = find_component Env.lookup_label (fun lid -> Unbound_label lid)
let find_all_labels =
find_component Env.lookup_all_labels (fun lid -> Unbound_label lid)

Expand Down Expand Up @@ -232,11 +228,6 @@ let validate_name = function
let new_global_var ?name () = new_global_var ?name:(validate_name name) ()
let newvar ?name () = newvar ?name:(validate_name name) ()

let type_variable loc name =
try Tbl.find name !type_variables
with Not_found ->
raise (Error (loc, Env.empty, Unbound_type_variable ("'" ^ name)))

let transl_type_param env styp =
let loc = styp.ptyp_loc in
match styp.ptyp_desc with
Expand Down Expand Up @@ -668,8 +659,6 @@ let make_fixed_univars ty =
make_fixed_univars ty;
Btype.unmark_type ty

let create_package_mty = create_package_mty false

let globalize_used_variables env fixed =
let r = ref [] in
Tbl.iter
Expand Down Expand Up @@ -709,40 +698,6 @@ let transl_simple_type env fixed styp =
make_fixed_univars typ.ctyp_type;
typ

let transl_simple_type_univars env styp =
univars := [];
used_variables := Tbl.empty;
pre_univars := [];
begin_def ();
let typ = transl_type env Univars styp in
(* Only keep already global variables in used_variables *)
let new_variables = !used_variables in
used_variables := Tbl.empty;
Tbl.iter
(fun name p ->
if Tbl.mem name !type_variables then
used_variables := Tbl.add name p !used_variables)
new_variables;
globalize_used_variables env false ();
end_def ();
generalize typ.ctyp_type;
let univs =
List.fold_left
(fun acc v ->
let v = repr v in
match v.desc with
| Tvar name when v.level = Btype.generic_level ->
v.desc <- Tunivar name;
v :: acc
| _ -> acc)
[] !pre_univars
in
make_fixed_univars typ.ctyp_type;
{
typ with
ctyp_type = instance env (Btype.newgenty (Tpoly (typ.ctyp_type, univs)));
}

let transl_simple_type_delayed env styp =
univars := [];
used_variables := Tbl.empty;
Expand Down Expand Up @@ -836,13 +791,6 @@ let report_error env ppf = function
"@[The type constructor %a@ expects %i argument(s),@ but is here \
applied to %i argument(s)@]"
longident lid expected provided
| Bound_type_variable name ->
fprintf ppf "Already bound type parameter '%s" name
| Recursive_type -> fprintf ppf "This type is recursive"
| Unbound_row_variable lid ->
(* we don't use "spellcheck" here: this error is not raised
anywhere so it's unclear how it should be handled *)
fprintf ppf "Unbound row variable in #%a" longident lid
| Type_mismatch trace ->
Printtyp.report_unification_error ppf Env.empty trace
(function
Expand Down
23 changes: 0 additions & 23 deletions compiler/ml/typetexp.mli
Original file line number Diff line number Diff line change
Expand Up @@ -19,16 +19,13 @@ open Types

val transl_simple_type :
Env.t -> bool -> Parsetree.core_type -> Typedtree.core_type
val transl_simple_type_univars :
Env.t -> Parsetree.core_type -> Typedtree.core_type
val transl_simple_type_delayed :
Env.t -> Parsetree.core_type -> Typedtree.core_type * (unit -> unit)
(* Translate a type, but leave type variables unbound. Returns
the type and a function that binds the type variable. *)

val transl_type_scheme : Env.t -> Parsetree.core_type -> Typedtree.core_type
val reset_type_variables : unit -> unit
val type_variable : Location.t -> string -> type_expr
val transl_type_param : Env.t -> Parsetree.core_type -> Typedtree.core_type

type variable_context
Expand All @@ -42,9 +39,6 @@ type error =
| Unbound_type_constructor of Longident.t
| Unbound_type_constructor_2 of Path.t
| Type_arity_mismatch of Longident.t * int * int
| Bound_type_variable of string
| Recursive_type
| Unbound_row_variable of Longident.t
| Type_mismatch of (type_expr * type_expr) list
| Alias_type_mismatch of (type_expr * type_expr) list
| Present_has_conjunction of string
Expand Down Expand Up @@ -80,11 +74,6 @@ val transl_modtype_longident :
val transl_modtype :
(* from Typemod *)
(Env.t -> Parsetree.module_type -> Typedtree.module_type) ref
val create_package_mty :
Location.t ->
Env.t ->
Parsetree.package_type ->
(Longident.t Asttypes.loc * Parsetree.core_type) list * Parsetree.module_type

val find_type : Env.t -> Location.t -> Longident.t -> Path.t * type_declaration
val find_constructor :
Expand All @@ -94,7 +83,6 @@ val find_all_constructors :
Location.t ->
Longident.t ->
(constructor_description * (unit -> unit)) list
val find_label : Env.t -> Location.t -> Longident.t -> label_description
val find_all_labels :
Env.t ->
Location.t ->
Expand All @@ -110,14 +98,3 @@ val find_modtype :

val unbound_constructor_error : Env.t -> Longident.t Location.loc -> 'a
val unbound_label_error : Env.t -> Longident.t Location.loc -> 'a

val spellcheck :
Format.formatter ->
(('a -> 'a list -> 'a list) ->
Longident.t option ->
'b ->
'c list ->
string list) ->
'b ->
Longident.t ->
unit
4 changes: 0 additions & 4 deletions compiler/ml/variant_coercion.ml
Original file line number Diff line number Diff line change
Expand Up @@ -21,10 +21,6 @@ let variant_has_catch_all_case

constructors |> List.exists has_catch_all_string_case

let variant_has_relevant_primitive_catch_all
(constructors : Types.constructor_declaration list) =
variant_has_catch_all_case constructors can_coerce_primitive

(* Checks if every case of the variant has the same runtime representation as the target type. *)
let variant_has_same_runtime_representation_as_target ~(target_path : Path.t)
~unboxed (constructors : Types.constructor_declaration list) =
Expand Down
Loading