Skip to content
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

Remove some dead code. #7312

Merged
merged 8 commits into from
Feb 25, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
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
2 changes: 1 addition & 1 deletion compiler/core/js_of_lam_block.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 1 addition & 2 deletions compiler/core/lam_analysis.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 1 addition & 2 deletions compiler/core/lam_compat.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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; _}
Expand Down
1 change: 0 additions & 1 deletion compiler/core/lam_compat.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
10 changes: 0 additions & 10 deletions compiler/core/lam_compile_primitive.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
1 change: 0 additions & 1 deletion compiler/core/lam_constant_convert.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
10 changes: 2 additions & 8 deletions compiler/core/lam_convert.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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 *)

Expand Down
10 changes: 4 additions & 6 deletions compiler/core/lam_primitive.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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
Expand Down
1 change: 0 additions & 1 deletion compiler/core/lam_primitive.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down
1 change: 0 additions & 1 deletion compiler/core/lam_print.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
9 changes: 3 additions & 6 deletions compiler/ml/datarepr.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
| [] -> []
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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;
Expand Down
9 changes: 0 additions & 9 deletions compiler/ml/env.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
3 changes: 0 additions & 3 deletions compiler/ml/env.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down
3 changes: 0 additions & 3 deletions compiler/ml/error_message_utils.ml
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,6 @@ type type_clash_statement = FunctionCall
type type_clash_context =
| SetRecordField
| ArrayValue
| FunctionReturn
| MaybeUnwrapOption
| IfCondition
| IfReturn
Expand Down Expand Up @@ -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:"

Expand Down
Loading
Loading