From c7bca436d452c5bc9d0fc19ff4657544bb7901a7 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Sat, 15 Aug 2026 19:13:47 +0200 Subject: [PATCH 1/4] Remove unused compiler modules and declarations Signed-off-by: Christoph Knittel --- compiler/core/js_fold.ml | 311 ----------------------------- compiler/core/js_of_lam_option.ml | 2 - compiler/core/js_of_lam_option.mli | 2 - compiler/ext/misc.ml | 16 -- compiler/ext/misc.mli | 25 --- compiler/frontend/ast_exp.ml | 25 --- compiler/frontend/ast_exp.mli | 25 --- compiler/ml/ast_payload.ml | 2 - compiler/ml/ast_payload.mli | 2 - compiler/ml/ctype.ml | 21 -- compiler/ml/ctype.mli | 20 -- compiler/ml/location.ml | 8 - compiler/ml/typedecl.ml | 2 - compiler/ml/typedecl.mli | 2 - 14 files changed, 463 deletions(-) delete mode 100644 compiler/core/js_fold.ml delete mode 100644 compiler/frontend/ast_exp.ml delete mode 100644 compiler/frontend/ast_exp.mli diff --git a/compiler/core/js_fold.ml b/compiler/core/js_fold.ml deleted file mode 100644 index ebaccce531d..00000000000 --- a/compiler/core/js_fold.ml +++ /dev/null @@ -1,311 +0,0 @@ -(* Copyright (C) 2015- Hongbo Zhang, Authors of ReScript - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -open J - -let[@inline] unknown _self _ = _self - -let[@inline] option sub self v = - match v with - | None -> self - | Some x -> sub self x - -let rec list (sub : 'self_type -> 'a -> 'self_type) self v = - match v with - | [] -> self - | x :: xs -> - let self = sub self x in - list sub self xs - -class fold = - object (_self : 'self_type) - method list : 'a. ('self_type -> 'a -> 'self_type) -> 'a list -> 'self_type - = - fun _f_a -> function - | [] -> _self - | _x :: _x_i1 -> - let _self = _f_a _self _x in - let _self = _self#list _f_a _x_i1 in - _self - - method ident : ident -> 'self_type = unknown _self - - method module_id : module_id -> 'self_type = - fun {id = _x0; kind = _x1} -> - let _self = _self#ident _x0 in - _self - - method required_modules : required_modules -> 'self_type = - list (fun _self -> _self#module_id) _self - - method vident : vident -> 'self_type = - function - | Id _x0 -> - let _self = _self#ident _x0 in - _self - | Qualified (_x0, _x1) -> - let _self = _self#module_id _x0 in - _self - - method exception_ident : exception_ident -> 'self_type = _self#ident - - method for_ident : for_ident -> 'self_type = _self#ident - - method for_direction : for_direction -> 'self_type = unknown _self - - method property_map : property_map -> 'self_type = - list - (fun _self (_x0, _x1) -> - let _self = _self#expression _x1 in - _self) - _self - - method expression_desc : expression_desc -> 'self_type = - function - | Length _x0 -> _self#expression _x0 - | Is_null_or_undefined _x0 -> - let _self = _self#expression _x0 in - _self - | String_append (_x0, _x1) -> - let _self = _self#expression _x0 in - let _self = _self#expression _x1 in - _self - | Bool _ -> _self - | Typeof _x0 -> - let _self = _self#expression _x0 in - _self - | Js_not _x0 -> - let _self = _self#expression _x0 in - _self - | Js_bnot _x0 -> - let _self = _self#expression _x0 in - _self - | In (_x0, _x1) -> - let _self = _self#expression _x0 in - let _self = _self#expression _x1 in - _self - | Seq (_x0, _x1) -> - let _self = _self#expression _x0 in - let _self = _self#expression _x1 in - _self - | Cond (_x0, _x1, _x2) -> - let _self = _self#expression _x0 in - let _self = _self#expression _x1 in - let _self = _self#expression _x2 in - _self - | Bin (_x0, _x1, _x2) -> - let _self = _self#expression _x1 in - let _self = _self#expression _x2 in - _self - | FlatCall (_x0, _x1) -> - let _self = _self#expression _x0 in - let _self = _self#expression _x1 in - _self - | Call (_x0, _x1, _x2) -> - let _self = _self#expression _x0 in - let _self = list (fun _self -> _self#expression) _self _x1 in - _self - | Tagged_template (_x0, _x1, _x2) -> - let _self = _self#expression _x0 in - let _self = list (fun _self -> _self#expression) _self _x1 in - let _self = list (fun _self -> _self#expression) _self _x2 in - _self - | String_index (_x0, _x1) -> - let _self = _self#expression _x0 in - let _self = _self#expression _x1 in - _self - | Array_index (_x0, _x1) -> - let _self = _self#expression _x0 in - let _self = _self#expression _x1 in - _self - | Static_index (_x0, _x1, _x2) -> - let _self = _self#expression _x0 in - _self - | New (_x0, _x1) -> - let _self = _self#expression _x0 in - list (fun _self -> _self#expression) _self _x1 - | Var _x0 -> - let _self = _self#vident _x0 in - _self - | Fun {params = x1; body = x2} -> - let _self = list (fun _self -> _self#ident) _self x1 in - let _self = _self#block x2 in - _self - | Str _ -> _self - | Raw_js_code _ -> _self - | Array _x0 -> list (fun _self -> _self#expression) _self _x0 - | Optional_block (_x0, _x1) -> - let _self = _self#expression _x0 in - _self - | Caml_block (_x0, _x1, _x2, _x3) -> - let _self = list (fun _self -> _self#expression) _self _x0 in - let _self = _self#expression _x2 in - _self - | Caml_block_tag (_x0, _tag) -> - let _self = _self#expression _x0 in - _self - | Number _ -> _self - | Object (_x0, _x1) -> - let _self = option (fun _self -> _self#expression) _self _x0 in - let _self = _self#property_map _x1 in - _self - | Undefined _ -> _self - | Null -> _self - | Await _x0 -> - let _self = _self#expression _x0 in - _self - | Spread _x0 -> - let _self = _self#expression _x0 in - _self - | Record_rest (_x0, _x1) -> - let _self = _self#expression _x1 in - _self - - method for_ident_expression : for_ident_expression -> 'self_type = - _self#expression - - method finish_ident_expression : finish_ident_expression -> 'self_type = - _self#expression - - method case_clause : case_clause -> 'self_type = - fun { - switch_body = _x0; - should_break = _x1; - comment = _x2; - source_loc = _x3; - } -> - let _self = _self#block _x0 in - _self - - method string_clause : string_clause -> 'self_type = - fun (_x0, _x1) -> - let _self = _self#case_clause _x1 in - _self - - method int_clause : int_clause -> 'self_type = - fun (_x0, _x1) -> - let _self = _self#case_clause _x1 in - _self - - method statement_desc : statement_desc -> 'self_type = - function - | Block _x0 -> - let _self = _self#block _x0 in - _self - | Variable _x0 -> - let _self = _self#variable_declaration _x0 in - _self - | Exp _x0 -> - let _self = _self#expression _x0 in - _self - | If (_x0, _x1, _x2) -> - let _self = _self#expression _x0 in - let _self = _self#block _x1 in - let _self = _self#block _x2 in - _self - | While (_label, _x0, _x1) -> - let _self = _self#expression _x0 in - let _self = _self#block _x1 in - _self - | ForRange (_label, _x0, _x1, _x2, _x3, _x4) -> - let _self = - option (fun _self -> _self#for_ident_expression) _self _x0 - in - let _self = _self#finish_ident_expression _x1 in - let _self = _self#for_ident _x2 in - let _self = _self#for_direction _x3 in - let _self = _self#block _x4 in - _self - | ForOf (_label, _x0, _x1, _x2) -> - let _self = _self#for_ident _x0 in - let _self = _self#expression _x1 in - let _self = _self#block _x2 in - _self - | ForAwaitOf (_label, _x0, _x1, _x2) -> - let _self = _self#for_ident _x0 in - let _self = _self#expression _x1 in - let _self = _self#block _x2 in - _self - | Continue _ -> _self - | Break _ -> _self - | Return _x0 -> - let _self = _self#expression _x0 in - _self - | Int_switch (_x0, _x1, _x2) -> - let _self = _self#expression _x0 in - let _self = list (fun _self -> _self#int_clause) _self _x1 in - let _self = option (fun _self -> _self#block) _self _x2 in - _self - | String_switch (_x0, _x1, _x2) -> - let _self = _self#expression _x0 in - let _self = list (fun _self -> _self#string_clause) _self _x1 in - let _self = option (fun _self -> _self#block) _self _x2 in - _self - | Throw _x0 -> - let _self = _self#expression _x0 in - _self - | Try (_x0, _x1, _x2) -> - let _self = _self#block _x0 in - let _self = - option - (fun _self (_x0, _x1) -> - let _self = _self#exception_ident _x0 in - let _self = _self#block _x1 in - _self) - _self _x1 - in - let _self = option (fun _self -> _self#block) _self _x2 in - _self - | Debugger -> _self - - method expression : expression -> 'self_type = - fun {expression_desc = _x0; comment = _x1; source_loc = _x2} -> - let _self = _self#expression_desc _x0 in - _self - - method statement : statement -> 'self_type = - fun {statement_desc = _x0; comment = _x1; source_loc = _x2} -> - let _self = _self#statement_desc _x0 in - _self - - method variable_declaration : variable_declaration -> 'self_type = - fun {ident = _x0; value = _x1; property = _x2; ident_info = _x3} -> - let _self = _self#ident _x0 in - let _self = option (fun _self -> _self#expression) _self _x1 in - _self - - method block : block -> 'self_type = - list (fun _self -> _self#statement) _self - - method program : program -> 'self_type = - fun {block = _x0; exports = _x1; export_set = _x2} -> - let _self = _self#block _x0 in - _self - - method deps_program : deps_program -> 'self_type = - fun {program = _x0; modules = _x1; side_effect = _x2} -> - let _self = _self#program _x0 in - let _self = _self#required_modules _x1 in - _self - end diff --git a/compiler/core/js_of_lam_option.ml b/compiler/core/js_of_lam_option.ml index 61cbcae2723..73045ce5d3a 100644 --- a/compiler/core/js_of_lam_option.ml +++ b/compiler/core/js_of_lam_option.ml @@ -24,8 +24,6 @@ module E = Js_exp_make -type option_unwrap_time = Static_unwrapped | Runtime_maybe_unwrapped - (** Another way: {[ | Var _ -> diff --git a/compiler/core/js_of_lam_option.mli b/compiler/core/js_of_lam_option.mli index c09d0f5fdf8..e0798f29b11 100644 --- a/compiler/core/js_of_lam_option.mli +++ b/compiler/core/js_of_lam_option.mli @@ -22,8 +22,6 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type option_unwrap_time = Static_unwrapped | Runtime_maybe_unwrapped - val val_from_option : J.expression -> J.expression (** Given [Some a ], return [a] *) diff --git a/compiler/ext/misc.ml b/compiler/ext/misc.ml index 46f99d25d3c..18fcd9f8972 100644 --- a/compiler/ext/misc.ml +++ b/compiler/ext/misc.ml @@ -565,19 +565,3 @@ let delete_eol_spaces src = in let stop = loop 0 0 in Bytes.sub_string dst 0 stop - -type hook_info = {sourcefile: string} - -exception - HookExnWrapper of {error: exn; hook_name: string; hook_info: hook_info} - -exception HookExn of exn - -let raise_direct_hook_exn e = raise (HookExn e) - -module type HookSig = sig - type t - - val add_hook : string -> (hook_info -> t -> t) -> unit - val apply_hooks : hook_info -> t -> t -end diff --git a/compiler/ext/misc.mli b/compiler/ext/misc.mli index 6dc9294833a..0d63b96a31d 100644 --- a/compiler/ext/misc.mli +++ b/compiler/ext/misc.mli @@ -251,28 +251,3 @@ val delete_eol_spaces : string -> string (** [delete_eol_spaces s] returns a fresh copy of [s] with any end of line spaces removed. Intended to normalize the output of the toplevel for tests. *) - -(** {1 Hook machinery} - - Hooks machinery: - [add_hook name f] will register a function that will be called on the - argument of a later call to [apply_hooks]. Hooks are applied in the - lexicographical order of their names. -*) - -type hook_info = {sourcefile: string} - -exception - HookExnWrapper of {error: exn; hook_name: string; hook_info: hook_info} -(** An exception raised by a hook will be wrapped into a - [HookExnWrapper] constructor by the hook machinery. *) - -val raise_direct_hook_exn : exn -> 'a -(** A hook can use [raise_unwrapped_hook_exn] to raise an exception that will - not be wrapped into a {!HookExnWrapper}. *) - -module type HookSig = sig - type t - val add_hook : string -> (hook_info -> t -> t) -> unit - val apply_hooks : hook_info -> t -> t -end diff --git a/compiler/frontend/ast_exp.ml b/compiler/frontend/ast_exp.ml deleted file mode 100644 index e51ab5df6ad..00000000000 --- a/compiler/frontend/ast_exp.ml +++ /dev/null @@ -1,25 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -type t = Parsetree.expression diff --git a/compiler/frontend/ast_exp.mli b/compiler/frontend/ast_exp.mli deleted file mode 100644 index e51ab5df6ad..00000000000 --- a/compiler/frontend/ast_exp.mli +++ /dev/null @@ -1,25 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - -type t = Parsetree.expression diff --git a/compiler/ml/ast_payload.ml b/compiler/ml/ast_payload.ml index eb953cd5831..a8d175beab7 100644 --- a/compiler/ml/ast_payload.ml +++ b/compiler/ml/ast_payload.ml @@ -181,8 +181,6 @@ let as_ident (x : t) = type lid = string Asttypes.loc -type label_expr = lid * Parsetree.expression - type action = lid * Parsetree.expression option (** None means punning is hit {[ { x } ]} diff --git a/compiler/ml/ast_payload.mli b/compiler/ml/ast_payload.mli index 493ad8efb69..a8b291a5446 100644 --- a/compiler/ml/ast_payload.mli +++ b/compiler/ml/ast_payload.mli @@ -29,8 +29,6 @@ type t = Parsetree.payload type lid = string Asttypes.loc -type label_expr = lid * Parsetree.expression - type action = lid * Parsetree.expression option val is_single_string : t -> (string * string option) option diff --git a/compiler/ml/ctype.ml b/compiler/ml/ctype.ml index 4fd0d76abc6..ed0da2540c8 100644 --- a/compiler/ml/ctype.ml +++ b/compiler/ml/ctype.ml @@ -532,10 +532,6 @@ let closed_extension_constructor ext = unmark_extension_constructor ext; Some ty -type closed_class_failure = - | CC_Method of type_expr * bool * string * type_expr - | CC_Value of type_expr * bool * string * type_expr - (**********************) (* Type duplication *) (**********************) @@ -3293,23 +3289,6 @@ let equal env rename tyl1 tyl2 = (* Class type matching *) (*************************) -type class_match_failure = - | CM_Virtual_class - | CM_Parameter_arity_mismatch of int * int - | CM_Type_parameter_mismatch of Env.t * (type_expr * type_expr) list - | CM_Parameter_mismatch of Env.t * (type_expr * type_expr) list - | CM_Val_type_mismatch of string * Env.t * (type_expr * type_expr) list - | CM_Meth_type_mismatch of string * Env.t * (type_expr * type_expr) list - | CM_Non_mutable_value of string - | CM_Non_concrete_value of string - | CM_Missing_value of string - | CM_Missing_method of string - | CM_Hide_public of string - | CM_Hide_virtual of string * string - | CM_Public_method of string - | CM_Private_method of string - | CM_Virtual_method of string - (***************) (* Subtyping *) (***************) diff --git a/compiler/ml/ctype.mli b/compiler/ml/ctype.mli index 1e359ecc204..6ab84652a3e 100644 --- a/compiler/ml/ctype.mli +++ b/compiler/ml/ctype.mli @@ -267,22 +267,6 @@ val matches : Env.t -> type_expr -> type_expr -> bool (* Same as [moregeneral false], implemented using the two above functions and backtracking. Ignore levels *) -type class_match_failure = - | CM_Virtual_class - | CM_Parameter_arity_mismatch of int * int - | CM_Type_parameter_mismatch of Env.t * (type_expr * type_expr) list - | CM_Parameter_mismatch of Env.t * (type_expr * type_expr) list - | CM_Val_type_mismatch of string * Env.t * (type_expr * type_expr) list - | CM_Meth_type_mismatch of string * Env.t * (type_expr * type_expr) list - | CM_Non_mutable_value of string - | CM_Non_concrete_value of string - | CM_Missing_value of string - | CM_Missing_method of string - | CM_Hide_public of string - | CM_Hide_virtual of string * string - | CM_Public_method of string - | CM_Private_method of string - | CM_Virtual_method of string val equal : Env.t -> bool -> type_expr list -> type_expr list -> bool (* [equal env [x1...xn] tau [y1...yn] sigma] checks whether the parameterized types @@ -324,10 +308,6 @@ val free_variables : ?env:Env.t -> type_expr -> type_expr list val closed_type_decl : type_declaration -> type_expr option val closed_extension_constructor : extension_constructor -> type_expr option -type closed_class_failure = - | CC_Method of type_expr * bool * string * type_expr - | CC_Value of type_expr * bool * string * type_expr - val unalias : type_expr -> type_expr val arity : type_expr -> int (* Return the arity (as for curried functions) of the given type. *) diff --git a/compiler/ml/location.ml b/compiler/ml/location.ml index fa2e806db07..80d9da0d6d6 100644 --- a/compiler/ml/location.ml +++ b/compiler/ml/location.ml @@ -264,14 +264,6 @@ let () = register_error_of_exn (function | Sys_error msg -> Some (errorf ~loc:(in_file !input_name) "I/O error: %s" msg) - | Misc.HookExnWrapper {error = e; hook_name; hook_info = {Misc.sourcefile}} - -> - let sub = - match error_of_exn e with - | None | Some `Already_displayed -> error (Printexc.to_string e) - | Some (`Ok err) -> err - in - Some (errorf ~loc:(in_file sourcefile) "In hook %S:" hook_name ~sub:[sub]) | _ -> None) external reraise : exn -> 'a = "%reraise" diff --git a/compiler/ml/typedecl.ml b/compiler/ml/typedecl.ml index fcf55459313..6f9d47629ee 100644 --- a/compiler/ml/typedecl.ml +++ b/compiler/ml/typedecl.ml @@ -22,8 +22,6 @@ open Primitive open Types open Typetexp -type native_repr_kind = Unboxed | Untagged - type error = | Repeated_parameter | Duplicate_constructor of string diff --git a/compiler/ml/typedecl.mli b/compiler/ml/typedecl.mli index b9910bf8837..0ebc17cd9e1 100644 --- a/compiler/ml/typedecl.mli +++ b/compiler/ml/typedecl.mli @@ -64,8 +64,6 @@ val is_fixed_type : Parsetree.type_declaration -> bool val get_unboxed_type_representation : Env.t -> type_expr -> type_expr option val is_not_undefined_attr : Parsetree.attribute -> bool -type native_repr_kind = Unboxed | Untagged - type error exception Error of Location.t * error From ac9d1383872e46b737f4af89a37b3ed42c9daf47 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Sat, 15 Aug 2026 19:45:50 +0200 Subject: [PATCH 2/4] Remove unused compiler helpers Signed-off-by: Christoph Knittel --- compiler/common/js_config.ml | 1 - compiler/common/js_config.mli | 2 - compiler/core/js_cmj_format.ml | 7 - compiler/core/js_cmj_format.mli | 2 - compiler/core/js_dump.ml | 9 - compiler/core/js_exp_make.ml | 35 ---- compiler/core/js_exp_make.mli | 4 - compiler/core/js_of_lam_block.ml | 3 - compiler/core/js_of_lam_block.mli | 5 - compiler/core/js_of_lam_option.ml | 2 - compiler/core/js_of_lam_option.mli | 2 - compiler/core/js_of_lam_string.ml | 18 -- compiler/core/js_of_lam_string.mli | 2 - compiler/core/js_packages_info.ml | 34 ---- compiler/core/js_packages_info.mli | 4 - compiler/core/lam.ml | 158 ----------------- compiler/core/lam.mli | 2 - compiler/core/lam_arity.ml | 6 - compiler/core/lam_arity.mli | 2 - compiler/core/lam_check.ml | 1 - compiler/core/lam_compat.ml | 9 - compiler/core/lam_compat.mli | 2 - compiler/core/lam_iter.ml | 62 ------- compiler/core/lam_iter.mli | 2 - compiler/core/lam_pass_count.ml | 20 --- compiler/core/lam_pass_count.mli | 2 - compiler/core/lam_pass_lets_dce.ml | 1 - compiler/core/lam_print.ml | 2 - compiler/core/lam_print.mli | 2 - compiler/ext/bsc_args.ml | 2 - compiler/ext/bsc_args.mli | 2 - compiler/ext/ext_array.ml | 26 --- compiler/ext/ext_array.mli | 6 - compiler/ext/ext_buffer.ml | 46 ----- compiler/ext/ext_buffer.mli | 10 -- compiler/ext/ext_digest.ml | 2 - compiler/ext/ext_digest.mli | 2 - compiler/ext/ext_filename.ml | 8 - compiler/ext/ext_filename.mli | 3 - compiler/ext/ext_ident.ml | 8 - compiler/ext/ext_ident.mli | 4 - compiler/ext/ext_io.ml | 3 - compiler/ext/ext_io.mli | 2 - compiler/ext/ext_list.ml | 9 - compiler/ext/ext_list.mli | 6 - compiler/ext/ext_obj.ml | 6 - compiler/ext/ext_obj.mli | 4 - compiler/ext/ext_pp.ml | 4 - compiler/ext/ext_pp.mli | 4 - compiler/ext/ext_ref.ml | 43 ----- compiler/ext/ext_ref.mli | 15 -- compiler/ext/ext_string.ml | 33 ---- compiler/ext/ext_string.mli | 16 -- compiler/ext/ext_util.ml | 8 - compiler/ext/ext_util.mli | 2 - compiler/ext/js_reserved_map.ml | 15 -- compiler/ext/js_reserved_map.mli | 2 - compiler/ext/map_gen.ml | 5 - compiler/ext/map_gen.mli | 2 - compiler/ext/misc.ml | 163 ------------------ compiler/ext/misc.mli | 81 --------- compiler/ext/warnings.ml | 13 -- compiler/ext/warnings.mli | 4 - compiler/frontend/ast_compatible.ml | 36 ---- compiler/frontend/ast_compatible.mli | 16 -- compiler/frontend/ast_core_type.ml | 11 -- compiler/frontend/ast_core_type.mli | 8 - compiler/frontend/ast_external_mk.ml | 34 ---- compiler/frontend/ast_external_mk.mli | 10 -- compiler/frontend/ast_literal.ml | 6 - compiler/frontend/ast_literal.mli | 6 - compiler/frontend/ast_pat.ml | 19 --- compiler/frontend/ast_pat.mli | 6 - compiler/frontend/ast_polyvar.ml | 20 --- compiler/frontend/ast_polyvar.mli | 3 - compiler/frontend/ast_structure.ml | 2 - compiler/frontend/ast_structure.mli | 2 - compiler/frontend/ast_utf8_string_interp.ml | 5 - compiler/frontend/ast_utf8_string_interp.mli | 1 - compiler/ml/ast_mapper.ml | 9 - compiler/ml/ast_mapper.mli | 10 -- compiler/ml/ast_payload.ml | 26 --- compiler/ml/ast_payload.mli | 8 - compiler/ml/btype.ml | 2 - compiler/ml/btype.mli | 3 - compiler/ml/clflags.ml | 2 - compiler/ml/clflags.mli | 1 - compiler/ml/consistbl.ml | 8 - compiler/ml/consistbl.mli | 7 - compiler/ml/ctype.ml | 169 ------------------- compiler/ml/ctype.mli | 39 ----- compiler/ml/datarepr.ml | 14 -- compiler/ml/datarepr.mli | 5 - compiler/ml/depend.ml | 4 - compiler/ml/depend.mli | 3 - compiler/ml/env.ml | 25 --- compiler/ml/env.mli | 13 +- compiler/ml/matching.ml | 117 ------------- compiler/ml/matching.mli | 11 -- compiler/ml/pprintast.ml | 6 - compiler/ml/pprintast.mli | 1 - compiler/ml/predef.ml | 26 +-- compiler/ml/predef.mli | 12 -- compiler/ml/printtyp.ml | 5 - compiler/ml/printtyp.mli | 3 - compiler/ml/types.mli | 3 +- compiler/syntax/cli/res_cli.ml | 3 - compiler/syntax/src/res_doc.ml | 2 - compiler/syntax/src/res_doc.mli | 21 --- compiler/syntax/src/res_scanner.ml | 1 - compiler/syntax/src/res_scanner.mli | 3 - 111 files changed, 4 insertions(+), 1703 deletions(-) diff --git a/compiler/common/js_config.ml b/compiler/common/js_config.ml index bd73af9a595..93df8b3cde6 100644 --- a/compiler/common/js_config.ml +++ b/compiler/common/js_config.ml @@ -42,7 +42,6 @@ let check_lam = ref false let no_builtin_ppx = ref false let tool_name = "ReScript" let check_div_by_zero = ref true -let get_check_div_by_zero () = !check_div_by_zero let syntax_only = ref false let binary_ast = ref false let test_ast_conversion = ref false diff --git a/compiler/common/js_config.mli b/compiler/common/js_config.mli index ac242e5d6c1..2e8dc81a35b 100644 --- a/compiler/common/js_config.mli +++ b/compiler/common/js_config.mli @@ -61,8 +61,6 @@ val no_builtin_ppx : bool ref val check_div_by_zero : bool ref (** check-div-by-zero option *) -val get_check_div_by_zero : unit -> bool - val tool_name : string val syntax_only : bool ref diff --git a/compiler/core/js_cmj_format.ml b/compiler/core/js_cmj_format.ml index e17a41ef3e0..0956812bb0d 100644 --- a/compiler/core/js_cmj_format.ml +++ b/compiler/core/js_cmj_format.ml @@ -74,13 +74,6 @@ let from_file name : t = close_in ic; v -let from_file_with_digest name : t * Digest.t = - let ic = open_in_bin name in - let digest = Digest.input ic in - let v : t = input_value ic in - close_in ic; - (v, digest) - let from_string s : t = Marshal.from_string s Ext_digest.length let for_sure_not_changed (name : string) (header : string) = diff --git a/compiler/core/js_cmj_format.mli b/compiler/core/js_cmj_format.mli index d55872968f5..32c8c423e87 100644 --- a/compiler/core/js_cmj_format.mli +++ b/compiler/core/js_cmj_format.mli @@ -80,8 +80,6 @@ val single_na : arity val from_file : string -> t -val from_file_with_digest : string -> t * Digest.t - val from_string : string -> t (* diff --git a/compiler/core/js_dump.ml b/compiler/core/js_dump.ml index d486357a20d..1b2a17ad55b 100644 --- a/compiler/core/js_dump.ml +++ b/compiler/core/js_dump.ml @@ -175,15 +175,6 @@ let rec exp_need_paren ?(arrow = false) (e : J.expression) = | Optional_block (e, true) when arrow -> exp_need_paren ~arrow e | Optional_block _ -> false -(** Print as underscore for unused vars, may not be - needed in the future *) -(* let ipp_ident cxt f id (un_used : bool) = - Ext_pp_scope.ident cxt f ( - if un_used then - Ext_ident.make_unused () - else - id) *) - let pp_var_assign cxt f id = P.string f L.let_; P.space f; diff --git a/compiler/core/js_exp_make.ml b/compiler/core/js_exp_make.ml index 6196de4809d..e63e974f63b 100644 --- a/compiler/core/js_exp_make.ml +++ b/compiler/core/js_exp_make.ml @@ -583,44 +583,9 @@ let extension_access (e : t) name (pos : int32) : t = source_loc = None; } -let string_index ?comment (e0 : t) (e1 : t) : t = - match (e0.expression_desc, e1.expression_desc) with - | Str {txt}, Number (Int {i; _}) -> - (* Don't optimize {j||j} *) - let i = Int32.to_int i in - if i >= 0 && i < String.length txt then - (* TODO: check exception when i is out of range.. - RangeError? - *) - str (String.make 1 txt.[i]) - else {expression_desc = String_index (e0, e1); comment; source_loc = None} - | _ -> {expression_desc = String_index (e0, e1); comment; source_loc = None} - let assign ?comment e0 e1 : t = {expression_desc = Bin (Eq, e0, e1); comment; source_loc = None} -let assign_by_exp (e : t) index value : t = - match e.expression_desc with - | Array _ - (* - Temporary block -- address not held - Optimize cases like this which is really - rare {[ - (ref x) := 3 - ]} - *) - | Caml_block _ - when no_side_effect e && no_side_effect index -> - value - | _ -> - assign - { - expression_desc = Array_index (e, index); - comment = None; - source_loc = None; - } - value - let record_assign (e : t) (pos : int32) (name : string) (value : t) = match e.expression_desc with | Array _ diff --git a/compiler/core/js_exp_make.mli b/compiler/core/js_exp_make.mli index 5b98caf8c41..dad3c2daf2d 100644 --- a/compiler/core/js_exp_make.mli +++ b/compiler/core/js_exp_make.mli @@ -141,8 +141,6 @@ val string_append : ?comment:string -> t -> t -> t we can not tag [js] object, since it can be frozen *) -val string_index : ?comment:string -> t -> t -> t - val array_index : ?comment:string -> t -> t -> t val array_index_by_int : ?comment:string -> t -> Int32.t -> t @@ -165,8 +163,6 @@ val poly_var_value_access : t -> t val extension_assign : t -> int32 -> string -> t -> t -val assign_by_exp : t -> t -> t -> t - val assign : ?comment:string -> t -> t -> t val tag_type : Ast_untagged_variants.tag_type -> t diff --git a/compiler/core/js_of_lam_block.ml b/compiler/core/js_of_lam_block.ml index e694bd3c92f..1e9b5c5cee8 100644 --- a/compiler/core/js_of_lam_block.ml +++ b/compiler/core/js_of_lam_block.ml @@ -41,8 +41,6 @@ let field (field_info : Lam_compat.field_dbg_info) e (i : int32) = | Fld_record {name} -> E.record_access e name i | Fld_module {name} -> E.module_access e name i -let field_by_exp e i = E.array_index e i - let set_field (field_info : Lam_compat.set_field_dbg_info) e i e0 = match field_info with | Fld_record_extension_set name -> E.extension_assign e i name e0 @@ -50,4 +48,3 @@ let set_field (field_info : Lam_compat.set_field_dbg_info) e i e0 = E.record_assign e i name e0 (* This dynamism commes from oo compilaton, it should not happen in record *) -let set_field_by_exp self index value = E.assign_by_exp self index value diff --git a/compiler/core/js_of_lam_block.mli b/compiler/core/js_of_lam_block.mli index 903baa7ee47..4718461dfb6 100644 --- a/compiler/core/js_of_lam_block.mli +++ b/compiler/core/js_of_lam_block.mli @@ -33,14 +33,9 @@ val make_block : val field : Lam_compat.field_dbg_info -> J.expression -> int32 -> J.expression -val field_by_exp : J.expression -> J.expression -> J.expression - val set_field : Lam_compat.set_field_dbg_info -> J.expression -> int32 -> J.expression -> J.expression - -val set_field_by_exp : - J.expression -> J.expression -> J.expression -> J.expression diff --git a/compiler/core/js_of_lam_option.ml b/compiler/core/js_of_lam_option.ml index 73045ce5d3a..ef9afc1fa3e 100644 --- a/compiler/core/js_of_lam_option.ml +++ b/compiler/core/js_of_lam_option.ml @@ -101,6 +101,4 @@ let some = E.optional_block let null_to_opt e = E.econd (E.is_null e) none (some e) -let undef_to_opt e = E.econd (E.is_undef e) none (some e) - let null_undef_to_opt e = E.econd (E.is_null_undefined e) none (some e) diff --git a/compiler/core/js_of_lam_option.mli b/compiler/core/js_of_lam_option.mli index e0798f29b11..c4b6285099a 100644 --- a/compiler/core/js_of_lam_option.mli +++ b/compiler/core/js_of_lam_option.mli @@ -45,6 +45,4 @@ val is_not_none : J.expression -> J.expression val null_to_opt : J.expression -> J.expression -val undef_to_opt : J.expression -> J.expression - val null_undef_to_opt : J.expression -> J.expression diff --git a/compiler/core/js_of_lam_string.ml b/compiler/core/js_of_lam_string.ml index 765a9d3ee71..86a4836c47f 100644 --- a/compiler/core/js_of_lam_string.ml +++ b/compiler/core/js_of_lam_string.ml @@ -32,21 +32,3 @@ module E = Js_exp_make let const_char (i : int) = E.int ~c:i (Int32.of_int @@ i) (* string [s[i]] expects to return a [ocaml_char] *) -let ref_string e e1 = E.string_index e e1 - -(** - Note that [String.fromCharCode] also works, but it only - work for small arrays, however, for {bytes_to_string} it is likely the bytes - will become big - {[ - String.fromCharCode.apply(null,[87,97]) - "Wa" - String.fromCharCode(87,97) - "Wa" - ]} - This does not work for large arrays - {[ - String.fromCharCode.apply(null, prim = Array[1048576]) - Maxiume call stack size exceeded - ]} -*) diff --git a/compiler/core/js_of_lam_string.mli b/compiler/core/js_of_lam_string.mli index 68feda72ad2..1d6624270a0 100644 --- a/compiler/core/js_of_lam_string.mli +++ b/compiler/core/js_of_lam_string.mli @@ -28,6 +28,4 @@ [string] is Immutable, so there is not [set_string] method *) -val ref_string : J.expression -> J.expression -> J.expression - val const_char : int -> J.expression diff --git a/compiler/core/js_packages_info.ml b/compiler/core/js_packages_info.ml index dccb649c5a6..a757d3f5ea6 100644 --- a/compiler/core/js_packages_info.ml +++ b/compiler/core/js_packages_info.ml @@ -88,35 +88,12 @@ let from_name (name : string) : t = let is_empty (x : t) = x.name = Pkg_empty -let string_of_module_system (ms : module_system) = - match ms with - | Commonjs -> "CommonJS" - | Esmodule -> "ESModule" - let module_system_of_string package_name : module_system option = match package_name with | "commonjs" -> Some Commonjs | "esmodule" -> Some Esmodule | _ -> None -let dump_package_info (fmt : Format.formatter) - ({module_system = ms; path = name; suffix} : package_info) = - Format.fprintf fmt "@[%s@ %s@ %s@]" (string_of_module_system ms) name suffix - -let dump_package_name fmt (x : package_name) = - match x with - | Pkg_empty -> Format.fprintf fmt "@empty_pkg@" - | Pkg_normal s -> Format.pp_print_string fmt s - | Pkg_runtime -> Format.pp_print_string fmt "@runtime" - -let dump_packages_info (fmt : Format.formatter) - ({name; module_systems = ls} : t) = - Format.fprintf fmt "@[%a;@ @[%a@]@]" dump_package_name name - (Format.pp_print_list - ~pp_sep:(fun fmt () -> Format.pp_print_space fmt ()) - dump_package_info) - ls - type package_found_info = { rel_path: string; pkg_rel_path: string; @@ -156,20 +133,9 @@ let query_package_infos ({name; module_systems} : t) Package_found {rel_path; pkg_rel_path; suffix = k.suffix} | None -> Package_not_found) -let get_js_path (x : t) (module_system : module_system) : string = - match - Ext_list.find_first x.module_systems (fun k -> - compatible k.module_system module_system) - with - | Some k -> k.path - | None -> assert false - (* for a single pass compilation, [output_dir] can be cached *) -let get_output_dir (info : t) ~package_dir module_system = - Filename.concat package_dir (get_js_path info module_system) - let add_npm_package_path (packages_info : t) (s : string) : t = if is_empty packages_info then Bsc_args.bad_arg "Set package name first using -bs-package-name" diff --git a/compiler/core/js_packages_info.mli b/compiler/core/js_packages_info.mli index 6e5c551df88..78c77b7a707 100644 --- a/compiler/core/js_packages_info.mli +++ b/compiler/core/js_packages_info.mli @@ -48,8 +48,6 @@ val from_name : string -> t val is_empty : t -> bool -val dump_packages_info : Format.formatter -> t -> unit - val add_npm_package_path : t -> string -> t (** used by command line option e.g [-bs-package-output commonjs:xx/path] @@ -66,8 +64,6 @@ type info_query = | Package_not_found | Package_found of package_found_info -val get_output_dir : t -> package_dir:string -> module_system -> string - val query_package_infos : t -> module_system -> info_query (** Note here we compare the package info by order in theory, we can compare it by set semantics diff --git a/compiler/core/lam.ml b/compiler/core/lam.ml index d987065b664..019d2334587 100644 --- a/compiler/core/lam.ml +++ b/compiler/core/lam.ml @@ -115,166 +115,8 @@ module Types = struct (* | Lsend of Lam_compat.meth_kind * t * t * t list * Location.t *) end -module X = struct - type lambda_switch = Types.lambda_switch = { - sw_consts_full: bool; - sw_consts: (int * t) list; - sw_blocks_full: bool; - sw_blocks: (int * t) list; - sw_failaction: t option; - sw_names: Ast_untagged_variants.switch_names option; - } - - and prim_info = Types.prim_info = { - primitive: Lam_primitive.t; - args: t list; - loc: Location.t; - } - - and apply = Types.apply = { - ap_func: t; - ap_args: t list; - ap_info: ap_info; - ap_transformed_jsx: bool; - } - - and lfunction = Types.lfunction = { - arity: int; - params: ident list; - body: t; - attr: Lambda.function_attribute; - loc: Location.t; - } - - and t = Types.t = - | Lvar of ident - | Lglobal_module of ident * bool - | Lconst of Lam_constant.t - | Lapply of apply - | Lfunction of lfunction - | Llet of Lam_compat.let_kind * ident * t * t - | Lletrec of (ident * t) list * t - | Lprim of prim_info - | Lswitch of t * lambda_switch - | Lstringswitch of t * (string * t) list * t option - | Lstaticraise of int * t list - | Lstaticcatch of t * (int * ident list) * t - | Ltrywith of t * ident * t - | Lifthenelse of t * t * t - | Lsequence of t * t - | Lbreak - | Lcontinue - | Lwhile of t * t - | Lfor of ident * t * t * Asttypes.direction_flag * t - | Lfor_of of ident * t * t - | Lfor_await_of of ident * t * t - | Lassign of ident * t - (* | Lsend of Lam_compat.meth_kind * t * t * t list * Location.t *) -end - include Types -(** apply [f] to direct successor which has type [Lam.t] *) - -let inner_map (l : t) (f : t -> X.t) : X.t = - match l with - | Lvar (_ : ident) | Lconst (_ : Lam_constant.t) -> ((* Obj.magic *) l : X.t) - | Lapply {ap_func; ap_args; ap_info; ap_transformed_jsx} -> - let ap_func = f ap_func in - let ap_args = Ext_list.map ap_args f in - Lapply {ap_func; ap_args; ap_info; ap_transformed_jsx} - | Lfunction {body; arity; params; attr; loc} -> - let body = f body in - Lfunction {body; arity; params; attr; loc} - | Llet (str, id, arg, body) -> - let arg = f arg in - let body = f body in - Llet (str, id, arg, body) - | Lletrec (decl, body) -> - let body = f body in - let decl = Ext_list.map_snd decl f in - Lletrec (decl, body) - | Lglobal_module _ -> (l : X.t) - | Lprim {args; primitive; loc} -> - let args = Ext_list.map args f in - Lprim {args; primitive; loc} - | Lswitch - ( arg, - { - sw_consts; - sw_consts_full; - sw_blocks; - sw_blocks_full; - sw_failaction; - sw_names; - } ) -> - let arg = f arg in - let sw_consts = Ext_list.map_snd sw_consts f in - let sw_blocks = Ext_list.map_snd sw_blocks f in - let sw_failaction = Ext_option.map sw_failaction f in - Lswitch - ( arg, - { - sw_consts; - sw_blocks; - sw_failaction; - sw_blocks_full; - sw_consts_full; - sw_names; - } ) - | Lstringswitch (arg, cases, default) -> - let arg = f arg in - let cases = Ext_list.map_snd cases f in - let default = Ext_option.map default f in - Lstringswitch (arg, cases, default) - | Lstaticraise (id, args) -> - let args = Ext_list.map args f in - Lstaticraise (id, args) - | Lstaticcatch (e1, vars, e2) -> - let e1 = f e1 in - let e2 = f e2 in - Lstaticcatch (e1, vars, e2) - | Ltrywith (e1, exn, e2) -> - let e1 = f e1 in - let e2 = f e2 in - Ltrywith (e1, exn, e2) - | Lifthenelse (e1, e2, e3) -> - let e1 = f e1 in - let e2 = f e2 in - let e3 = f e3 in - Lifthenelse (e1, e2, e3) - | Lsequence (e1, e2) -> - let e1 = f e1 in - let e2 = f e2 in - Lsequence (e1, e2) - | Lbreak -> Lbreak - | Lcontinue -> Lcontinue - | Lwhile (e1, e2) -> - let e1 = f e1 in - let e2 = f e2 in - Lwhile (e1, e2) - | Lfor (v, e1, e2, dir, e3) -> - let e1 = f e1 in - let e2 = f e2 in - let e3 = f e3 in - Lfor (v, e1, e2, dir, e3) - | Lfor_of (v, e1, e2) -> - let e1 = f e1 in - let e2 = f e2 in - Lfor_of (v, e1, e2) - | Lfor_await_of (v, e1, e2) -> - let e1 = f e1 in - let e2 = f e2 in - Lfor_await_of (v, e1, e2) - | Lassign (id, e) -> - let e = f e in - Lassign (id, e) -(* | Lsend (k, met, obj, args, loc) -> - let met = f met in - let obj = f obj in - let args = Ext_list.map args f in - Lsend(k,met,obj,args,loc) *) - exception Not_simple_form (** diff --git a/compiler/core/lam.mli b/compiler/core/lam.mli index 0bd2897fec1..dbd026c6fd1 100644 --- a/compiler/core/lam.mli +++ b/compiler/core/lam.mli @@ -92,8 +92,6 @@ and t = private we should use record for trivial debugger info *) -val inner_map : t -> (t -> t) -> t - val handle_bs_non_obj_ffi : ?transformed_jsx:bool -> External_arg_spec.params -> diff --git a/compiler/core/lam_arity.ml b/compiler/core/lam_arity.ml index 7998426f08d..de1b375b160 100644 --- a/compiler/core/lam_arity.ml +++ b/compiler/core/lam_arity.ml @@ -56,12 +56,6 @@ let print (fmt : Format.formatter) (x : t) = if tail then pp fmt "@ *"; pp fmt "]@]" -let print_arities_tbl (fmt : Format.formatter) - (arities_tbl : (Ident.t, t ref) Hashtbl.t) = - Hashtbl.fold - (fun (i : Ident.t) (v : t ref) _ -> pp fmt "@[%s -> %a@]@." i.name print !v) - arities_tbl () - let merge (n : int) (x : t) : t = match x with | Arity_na -> Arity_info ([n], false) diff --git a/compiler/core/lam_arity.mli b/compiler/core/lam_arity.mli index 29772c0dd42..e8b9da3b525 100644 --- a/compiler/core/lam_arity.mli +++ b/compiler/core/lam_arity.mli @@ -36,8 +36,6 @@ val equal : t -> t -> bool val print : Format.formatter -> t -> unit -val print_arities_tbl : Format.formatter -> (Ident.t, t ref) Hashtbl.t -> unit - val merge : int -> t -> t val non_function_arity_info : t diff --git a/compiler/core/lam_check.ml b/compiler/core/lam_check.ml index db9bc92e43c..3411c304736 100644 --- a/compiler/core/lam_check.ml +++ b/compiler/core/lam_check.ml @@ -45,7 +45,6 @@ let check ~file ~pass lam = success := false) else Hash_set_ident.add defined_variables id in - (* TODO: replaced by a slow version of {!Lam_iter.inner_iter} *) let rec check_list xs (cxt : Set_int.t) = Ext_list.iter xs (fun x -> check_staticfails x cxt) and check_list_snd : 'a. ('a * Lam.t) list -> _ -> unit = diff --git a/compiler/core/lam_compat.ml b/compiler/core/lam_compat.ml index 65615c53220..7df7e27eed7 100644 --- a/compiler/core/lam_compat.ml +++ b/compiler/core/lam_compat.ml @@ -51,15 +51,6 @@ let cmp_float (cmp : comparison) (a : float) b : bool = | Clt -> a < b | Cge -> a >= b -let cmp_int (cmp : comparison) (a : int) b : bool = - match cmp with - | Ceq -> a = b - | Cneq -> a <> b - | Cgt -> a > b - | Cle -> a <= b - | Clt -> a < b - | Cge -> a >= b - type let_kind = Lambda.let_kind = Strict | Alias | StrictOpt | Variable type field_dbg_info = Lambda.field_dbg_info = diff --git a/compiler/core/lam_compat.mli b/compiler/core/lam_compat.mli index 1082b9d3ee0..00f15725e63 100644 --- a/compiler/core/lam_compat.mli +++ b/compiler/core/lam_compat.mli @@ -49,6 +49,4 @@ val cmp_int32 : comparison -> int32 -> int32 -> bool val cmp_float : comparison -> float -> float -> bool -val cmp_int : comparison -> int -> int -> bool - val eq_comparison : comparison -> comparison -> bool diff --git a/compiler/core/lam_iter.ml b/compiler/core/lam_iter.ml index eae83894b77..f5902d82faa 100644 --- a/compiler/core/lam_iter.ml +++ b/compiler/core/lam_iter.ml @@ -26,68 +26,6 @@ type t = Lam.t type ident = Ident.t -let inner_iter (l : t) (f : t -> unit) : unit = - match l with - | Lvar (_ : ident) | Lconst (_ : Lam_constant.t) -> () - | Lapply {ap_func; ap_args; ap_info = _} -> - f ap_func; - List.iter f ap_args - | Lfunction {body; arity = _; params = _} -> f body - | Llet (_str, _id, arg, body) -> - f arg; - f body - | Lletrec (decl, body) -> - f body; - Ext_list.iter_snd decl f - | Lswitch - ( arg, - { - sw_consts; - sw_consts_full = _; - sw_blocks; - sw_blocks_full = _; - sw_failaction; - } ) -> - f arg; - Ext_list.iter_snd sw_consts f; - Ext_list.iter_snd sw_blocks f; - Ext_option.iter sw_failaction f - | Lstringswitch (arg, cases, default) -> - f arg; - Ext_list.iter_snd cases f; - Ext_option.iter default f - | Lglobal_module _ -> () - | Lprim {args; primitive = _; loc = _} -> List.iter f args - | Lstaticraise (_id, args) -> List.iter f args - | Lstaticcatch (e1, _vars, e2) -> - f e1; - f e2 - | Ltrywith (e1, _exn, e2) -> - f e1; - f e2 - | Lifthenelse (e1, e2, e3) -> - f e1; - f e2; - f e3 - | Lsequence (e1, e2) -> - f e1; - f e2 - | Lbreak | Lcontinue -> () - | Lwhile (e1, e2) -> - f e1; - f e2 - | Lfor (_v, e1, e2, _dir, e3) -> - f e1; - f e2; - f e3 - | Lfor_of (_v, e1, e2) -> - f e1; - f e2 - | Lfor_await_of (_v, e1, e2) -> - f e1; - f e2 - | Lassign (_id, e) -> f e - let inner_exists (l : t) (f : t -> bool) : bool = match l with | Lvar (_ : ident) | Lglobal_module _ | Lconst (_ : Lam_constant.t) -> false diff --git a/compiler/core/lam_iter.mli b/compiler/core/lam_iter.mli index fd52fcf9cc3..0077b5a860d 100644 --- a/compiler/core/lam_iter.mli +++ b/compiler/core/lam_iter.mli @@ -22,6 +22,4 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val inner_iter : Lam.t -> (Lam.t -> unit) -> unit - val inner_exists : Lam.t -> (Lam.t -> bool) -> bool diff --git a/compiler/core/lam_pass_count.ml b/compiler/core/lam_pass_count.ml index 53bdf406ddf..2577fcd5baa 100644 --- a/compiler/core/lam_pass_count.ml +++ b/compiler/core/lam_pass_count.ml @@ -36,26 +36,6 @@ let absorb_info (x : used_info) (y : used_info) = x.times <- x0 + y0; if captured then x.captured <- true -let pp_info fmt (x : used_info) = - Format.fprintf fmt "(:%d)" x.captured x.times - -let pp_occ_tbl fmt tbl = - Hash_ident.iter tbl (fun k v -> - Format.fprintf fmt "@[%a@ %a@]@." Ident.print k pp_info v) - -(* The global table [occ] associates to each let-bound identifier - the number of its uses (as a reference): - - 0 if never used - - 1 if used exactly once in and not under a lambda or within a loop - - when under a lambda, - - it's probably a closure - - within a loop - - update reference, - niether is good for inlining - - > 1 if used several times or under a lambda or within a loop. - The local table [bv] associates to each locally-let-bound variable - its reference count, as above. [bv] is enriched at let bindings - but emptied when crossing lambdas and loops. *) let collect_occurs lam : occ_tbl = let occ : occ_tbl = Hash_ident.create 83 in diff --git a/compiler/core/lam_pass_count.mli b/compiler/core/lam_pass_count.mli index 547551b0dc6..727aaa40cf5 100644 --- a/compiler/core/lam_pass_count.mli +++ b/compiler/core/lam_pass_count.mli @@ -26,5 +26,3 @@ type occ_tbl = used_info Hash_ident.t val dummy_info : unit -> used_info val collect_occurs : Lam.t -> occ_tbl - -val pp_occ_tbl : Format.formatter -> occ_tbl -> unit diff --git a/compiler/core/lam_pass_lets_dce.ml b/compiler/core/lam_pass_lets_dce.ml index 9f14f0bede3..e662b7ecb4b 100644 --- a/compiler/core/lam_pass_lets_dce.ml +++ b/compiler/core/lam_pass_lets_dce.ml @@ -219,5 +219,4 @@ let apply_lets occ lambda = let simplify_lets (lam : Lam.t) : Lam.t = let occ = Lam_pass_count.collect_occurs lam in - (* Ext_log.dwarn ~__POS__ "@[%a@]@." Lam_pass_count.pp_occ_tbl occ ; *) apply_lets occ lam diff --git a/compiler/core/lam_print.ml b/compiler/core/lam_print.ml index 023fdb1edb9..3c9122fba00 100644 --- a/compiler/core/lam_print.ml +++ b/compiler/core/lam_print.ml @@ -468,5 +468,3 @@ let serialize (filename : string) (lam : Lam.t) : unit = Format.set_margin old let lambda_to_string = Format.asprintf "%a" lambda - -let primitive_to_string = Format.asprintf "%a" primitive diff --git a/compiler/core/lam_print.mli b/compiler/core/lam_print.mli index 383013368f4..f8b6fda4975 100644 --- a/compiler/core/lam_print.mli +++ b/compiler/core/lam_print.mli @@ -29,5 +29,3 @@ val primitive : Format.formatter -> Lam_primitive.t -> unit val serialize : string -> Lam.t -> unit val lambda_to_string : Lam.t -> string - -val primitive_to_string : Lam_primitive.t -> string diff --git a/compiler/ext/bsc_args.ml b/compiler/ext/bsc_args.ml index 1f907eb26b7..08e7a8a7ab2 100644 --- a/compiler/ext/bsc_args.ml +++ b/compiler/ext/bsc_args.ml @@ -22,8 +22,6 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type anon_fun = rev_args:string list -> unit - type string_action = | String_call of (string -> unit) | String_set of string ref diff --git a/compiler/ext/bsc_args.mli b/compiler/ext/bsc_args.mli index 05bf9e66cca..fb09acd479b 100644 --- a/compiler/ext/bsc_args.mli +++ b/compiler/ext/bsc_args.mli @@ -22,8 +22,6 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type anon_fun = rev_args:string list -> unit - type string_action = | String_call of (string -> unit) | String_set of string ref diff --git a/compiler/ext/ext_array.ml b/compiler/ext/ext_array.ml index 9a416e5b0ab..2535addcb20 100644 --- a/compiler/ext/ext_array.ml +++ b/compiler/ext/ext_array.ml @@ -119,8 +119,6 @@ let rec tolist_aux a f i res = | Some v -> v :: res | None -> res) -let to_list_map a f = tolist_aux a f (Array.length a - 1) [] - let to_list_map_acc a acc f = tolist_aux a f (Array.length a - 1) acc let of_list_map a f = @@ -171,27 +169,6 @@ let of_list_map a f = in fill 5 tl -(** - {[ - # rfind_with_index [|1;2;3|] (=) 2;; - - : int = 1 - # rfind_with_index [|1;2;3|] (=) 1;; - - : int = 0 - # rfind_with_index [|1;2;3|] (=) 3;; - - : int = 2 - # rfind_with_index [|1;2;3|] (=) 4;; - - : int = -1 - ]} -*) -let rfind_with_index arr cmp v = - let len = Array.length arr in - let rec aux i = - if i < 0 then i - else if cmp (Array.unsafe_get arr i) v then i - else aux (i - 1) - in - aux (len - 1) - type 'a split = No_split | Split of 'a array * 'a array let find_with_index arr cmp v = @@ -266,6 +243,3 @@ let fold_left a x f = r := f !r (unsafe_get a i) done; !r - -let get_or arr i cb = - if i >= 0 && i < Array.length arr then Array.unsafe_get arr i else cb () diff --git a/compiler/ext/ext_array.mli b/compiler/ext/ext_array.mli index b55bd1a09e7..0f0eb4dfa38 100644 --- a/compiler/ext/ext_array.mli +++ b/compiler/ext/ext_array.mli @@ -43,14 +43,10 @@ val map2i : (int -> 'a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array val to_list_f : 'a array -> ('a -> 'b) -> 'b list -val to_list_map : 'a array -> ('a -> 'b option) -> 'b list - val to_list_map_acc : 'a array -> 'b list -> ('a -> 'b option) -> 'b list val of_list_map : 'a list -> ('a -> 'b) -> 'b array -val rfind_with_index : 'a array -> ('a -> 'b -> bool) -> 'b -> int - type 'a split = No_split | Split of 'a array * 'a array val find_and_split : 'a array -> ('a -> 'b -> bool) -> 'b -> 'a split @@ -68,5 +64,3 @@ val map : 'a array -> ('a -> 'b) -> 'b array val iter : 'a array -> ('a -> unit) -> unit val fold_left : 'b array -> 'a -> ('a -> 'b -> 'a) -> 'a - -val get_or : 'a array -> int -> (unit -> 'a) -> 'a diff --git a/compiler/ext/ext_buffer.ml b/compiler/ext/ext_buffer.ml index b88b3b8b8c6..88df4bbcdeb 100644 --- a/compiler/ext/ext_buffer.ml +++ b/compiler/ext/ext_buffer.ml @@ -123,10 +123,6 @@ let add_char_string b c s = let output_buffer oc b = output oc b.buffer 0 b.position -external unsafe_string : bytes -> int -> int -> Digest.t = "caml_md5_string" - -let digest b = unsafe_string b.buffer 0 b.position - let rec not_equal_aux (b : bytes) (s : string) i len = if i >= len then false else @@ -143,45 +139,3 @@ let not_equal (b : t) (s : string) = It could be one byte, two bytes, three bytes and four bytes TODO: inline for better performance *) -let add_int_1 (b : t) (x : int) = - let c = Char.unsafe_chr (x land 0xff) in - let pos = b.position in - if pos >= b.length then resize b 1; - Bytes.unsafe_set b.buffer pos c; - b.position <- pos + 1 - -let add_int_2 (b : t) (x : int) = - let c1 = Char.unsafe_chr (x land 0xff) in - let c2 = Char.unsafe_chr ((x lsr 8) land 0xff) in - let pos = b.position in - if pos + 1 >= b.length then resize b 2; - let b_buffer = b.buffer in - Bytes.unsafe_set b_buffer pos c1; - Bytes.unsafe_set b_buffer (pos + 1) c2; - b.position <- pos + 2 - -let add_int_3 (b : t) (x : int) = - let c1 = Char.unsafe_chr (x land 0xff) in - let c2 = Char.unsafe_chr ((x lsr 8) land 0xff) in - let c3 = Char.unsafe_chr ((x lsr 16) land 0xff) in - let pos = b.position in - if pos + 2 >= b.length then resize b 3; - let b_buffer = b.buffer in - Bytes.unsafe_set b_buffer pos c1; - Bytes.unsafe_set b_buffer (pos + 1) c2; - Bytes.unsafe_set b_buffer (pos + 2) c3; - b.position <- pos + 3 - -let add_int_4 (b : t) (x : int) = - let c1 = Char.unsafe_chr (x land 0xff) in - let c2 = Char.unsafe_chr ((x lsr 8) land 0xff) in - let c3 = Char.unsafe_chr ((x lsr 16) land 0xff) in - let c4 = Char.unsafe_chr ((x lsr 24) land 0xff) in - let pos = b.position in - if pos + 3 >= b.length then resize b 4; - let b_buffer = b.buffer in - Bytes.unsafe_set b_buffer pos c1; - Bytes.unsafe_set b_buffer (pos + 1) c2; - Bytes.unsafe_set b_buffer (pos + 2) c3; - Bytes.unsafe_set b_buffer (pos + 3) c4; - b.position <- pos + 4 diff --git a/compiler/ext/ext_buffer.mli b/compiler/ext/ext_buffer.mli index e42861df887..0271495642d 100644 --- a/compiler/ext/ext_buffer.mli +++ b/compiler/ext/ext_buffer.mli @@ -83,18 +83,8 @@ val output_buffer : out_channel -> t -> unit (** [output_buffer oc b] writes the current contents of buffer [b] on the output channel [oc]. *) -val digest : t -> Digest.t - val not_equal : t -> string -> bool -val add_int_1 : t -> int -> unit - -val add_int_2 : t -> int -> unit - -val add_int_3 : t -> int -> unit - -val add_int_4 : t -> int -> unit - val add_string_char : t -> string -> char -> unit val add_char_string : t -> char -> string -> unit diff --git a/compiler/ext/ext_digest.ml b/compiler/ext/ext_digest.ml index b2143a3bba5..a0a53e599f4 100644 --- a/compiler/ext/ext_digest.ml +++ b/compiler/ext/ext_digest.ml @@ -23,5 +23,3 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) let length = 16 - -let hex_length = 32 diff --git a/compiler/ext/ext_digest.mli b/compiler/ext/ext_digest.mli index 150f643444c..2f1808a79be 100644 --- a/compiler/ext/ext_digest.mli +++ b/compiler/ext/ext_digest.mli @@ -23,5 +23,3 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) val length : int - -val hex_length : int diff --git a/compiler/ext/ext_filename.ml b/compiler/ext/ext_filename.ml index fd7c64c4267..b095eabecfa 100644 --- a/compiler/ext/ext_filename.ml +++ b/compiler/ext/ext_filename.ml @@ -28,14 +28,6 @@ let is_dir_sep_win_cygwin c = c = '/' || c = '\\' || c = ':' let is_dir_sep = if Sys.unix then is_dir_sep_unix else is_dir_sep_win_cygwin -let chop_extension_maybe name = - let rec search_dot i = - if i < 0 || is_dir_sep (String.unsafe_get name i) then name - else if String.unsafe_get name i = '.' then String.sub name 0 i - else search_dot (i - 1) - in - search_dot (String.length name - 1) - let get_extension_maybe name = let name_len = String.length name in let rec search_dot name i name_len = diff --git a/compiler/ext/ext_filename.mli b/compiler/ext/ext_filename.mli index 5c678310b9e..94e64be9d98 100644 --- a/compiler/ext/ext_filename.mli +++ b/compiler/ext/ext_filename.mli @@ -33,9 +33,6 @@ val is_dir_sep : char -> bool -val chop_extension_maybe : string -> string - -(* return an empty string if no extension found *) val get_extension_maybe : string -> string val new_extension : string -> string -> string diff --git a/compiler/ext/ext_ident.ml b/compiler/ext/ext_ident.ml index a7a2f3bec14..d29ad4ca30c 100644 --- a/compiler/ext/ext_ident.ml +++ b/compiler/ext/ext_ident.ml @@ -38,8 +38,6 @@ let is_js (i : Ident.t) = i.flags land js_flag <> 0 let is_js_or_global (i : Ident.t) = i.flags land (8 lor 1) <> 0 -let is_js_object (i : Ident.t) = i.flags land js_object_flag <> 0 - let make_js_object (i : Ident.t) = i.flags <- i.flags lor js_object_flag (* It's a js function hard coded by js api, so when printing, @@ -138,12 +136,6 @@ let convert (name : string) = which would result in different signature files - other solution: use lazy values *) -let make_unused () = create "_" - -(* Has to be total order, [x < y] - and [x > y] should be consistent - flags are not relevant here -*) let compare (x : Ident.t) (y : Ident.t) = let u = x.stamp - y.stamp in if u = 0 then Ext_string.compare x.name y.name else u diff --git a/compiler/ext/ext_ident.mli b/compiler/ext/ext_ident.mli index 446ce8fb881..970db727801 100644 --- a/compiler/ext/ext_ident.mli +++ b/compiler/ext/ext_ident.mli @@ -26,8 +26,6 @@ val is_js : Ident.t -> bool -val is_js_object : Ident.t -> bool - val create_js : string -> Ident.t (** create identifiers for predefined [js] global variables *) @@ -37,8 +35,6 @@ val make_js_object : Ident.t -> unit val create_tmp : ?name:string -> unit -> Ident.t -val make_unused : unit -> Ident.t - val is_uident : string -> bool val is_uppercase_exotic : string -> bool diff --git a/compiler/ext/ext_io.ml b/compiler/ext/ext_io.ml index ffb84a49d93..0ba82d5fc28 100644 --- a/compiler/ext/ext_io.ml +++ b/compiler/ext/ext_io.ml @@ -40,9 +40,6 @@ let rev_lines_of_chann chan = in loop [] chan -let rev_lines_of_file file = - Ext_pervasives.finally ~clean:close_in (open_in_bin file) rev_lines_of_chann - let write_file f content = Ext_pervasives.finally ~clean:close_out (open_out_bin f) (fun oc -> output_string oc content) diff --git a/compiler/ext/ext_io.mli b/compiler/ext/ext_io.mli index edbebfca7cd..17edaaf379d 100644 --- a/compiler/ext/ext_io.mli +++ b/compiler/ext/ext_io.mli @@ -24,8 +24,6 @@ val load_file : string -> string -val rev_lines_of_file : string -> string list - val rev_lines_of_chann : in_channel -> string list val write_file : string -> string -> unit diff --git a/compiler/ext/ext_list.ml b/compiler/ext/ext_list.ml index e7681aee305..05d9826ab22 100644 --- a/compiler/ext/ext_list.ml +++ b/compiler/ext/ext_list.ml @@ -75,10 +75,6 @@ let rec arr_list_combine_unsafe arr l i j acc f = | h :: tl -> (f arr.!(i), h) :: arr_list_combine_unsafe arr tl (i + 1) j acc f -let combine_array_append arr l acc f = - let len = Array.length arr in - arr_list_combine_unsafe arr l 0 len acc f - let combine_array arr l f = let len = Array.length arr in arr_list_combine_unsafe arr l 0 len [] f @@ -746,11 +742,6 @@ let rec fold_left l accu f = | [] -> accu | a :: l -> fold_left l (f accu a) f -let reduce_from_left lst fn = - match lst with - | first :: rest -> fold_left rest first fn - | _ -> invalid_arg "Ext_list.reduce_from_left" - let rec fold_left2 l1 l2 accu f = match (l1, l2) with | [], [] -> accu diff --git a/compiler/ext/ext_list.mli b/compiler/ext/ext_list.mli index c5e65149e96..add2b277351 100644 --- a/compiler/ext/ext_list.mli +++ b/compiler/ext/ext_list.mli @@ -28,9 +28,6 @@ val map_combine : 'a list -> 'b list -> ('a -> 'c) -> ('c * 'b) list val combine_array : 'a array -> 'b list -> ('a -> 'c) -> ('c * 'b) list -val combine_array_append : - 'a array -> 'b list -> ('c * 'b) list -> ('a -> 'c) -> ('c * 'b) list - val has_string : string list -> string -> bool val map_split_opt : @@ -189,9 +186,6 @@ val for_all2_no_exn : 'a list -> 'b list -> ('a -> 'b -> bool) -> bool val split_map : 'a list -> ('a -> 'b * 'c) -> 'b list * 'c list (** [f] is applied follow the list order *) -val reduce_from_left : 'a list -> ('a -> 'a -> 'a) -> 'a -(** [fn] is applied from left to right *) - val sort_via_array : 'a list -> ('a -> 'a -> int) -> 'a list val sort_via_arrayf : 'a list -> ('a -> 'a -> int) -> ('a -> 'b) -> 'b list diff --git a/compiler/ext/ext_obj.ml b/compiler/ext/ext_obj.ml index c81e86f232f..ae11db924b6 100644 --- a/compiler/ext/ext_obj.ml +++ b/compiler/ext/ext_obj.ml @@ -100,12 +100,6 @@ let rec dump r = let dump v = dump (Obj.repr v) -let dump_endline ?(__LOC__ = "") v = - print_endline __LOC__; - print_endline (dump v) - -let pp_any fmt v = Format.fprintf fmt "@[%s@]" (dump v) - let bt () = let raw_bt = Printexc.backtrace_slots (Printexc.get_raw_backtrace ()) in match raw_bt with diff --git a/compiler/ext/ext_obj.mli b/compiler/ext/ext_obj.mli index dddf4735ab2..3dc59084e87 100644 --- a/compiler/ext/ext_obj.mli +++ b/compiler/ext/ext_obj.mli @@ -23,8 +23,4 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) val dump : 'a -> string -val dump_endline : ?__LOC__:string -> 'a -> unit - -val pp_any : Format.formatter -> 'a -> unit - val bt : unit -> unit diff --git a/compiler/ext/ext_pp.ml b/compiler/ext/ext_pp.ml index d45f558eed4..b3b28a576c9 100644 --- a/compiler/ext/ext_pp.ml +++ b/compiler/ext/ext_pp.ml @@ -28,8 +28,6 @@ module L = struct let indent_str = " " end -let indent_length = String.length L.indent_str - type t = { output_string: string -> unit; output_char: char -> unit; @@ -144,8 +142,6 @@ let force_newline t = let space t = string t L.space -let nspace t n = string t (String.make n ' ') - let group t i action = if i = 0 then action () else diff --git a/compiler/ext/ext_pp.mli b/compiler/ext/ext_pp.mli index 4990abe7515..670010d7cbd 100644 --- a/compiler/ext/ext_pp.mli +++ b/compiler/ext/ext_pp.mli @@ -35,14 +35,10 @@ type t } *) -val indent_length : int - val string : t -> string -> unit val space : t -> unit -val nspace : t -> int -> unit - val group : t -> int -> (unit -> 'a) -> 'a (** [group] will record current indentation and indent futher diff --git a/compiler/ext/ext_ref.ml b/compiler/ext/ext_ref.ml index e0afb7892d0..3550d4fc67d 100644 --- a/compiler/ext/ext_ref.ml +++ b/compiler/ext/ext_ref.ml @@ -22,13 +22,6 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -let non_exn_protect r v body = - let old = !r in - r := v; - let res = body () in - r := old; - res - let protect r v body = let old = !r in try @@ -39,39 +32,3 @@ let protect r v body = with x -> r := old; raise x - -let non_exn_protect2 r1 r2 v1 v2 body = - let old1 = !r1 in - let old2 = !r2 in - r1 := v1; - r2 := v2; - let res = body () in - r1 := old1; - r2 := old2; - res - -let protect2 r1 r2 v1 v2 body = - let old1 = !r1 in - let old2 = !r2 in - try - r1 := v1; - r2 := v2; - let res = body () in - r1 := old1; - r2 := old2; - res - with x -> - r1 := old1; - r2 := old2; - raise x - -let protect_list rvs body = - let olds = Ext_list.map rvs (fun (x, _) -> !x) in - let () = List.iter (fun (x, y) -> x := y) rvs in - try - let res = body () in - List.iter2 (fun (x, _) old -> x := old) rvs olds; - res - with e -> - List.iter2 (fun (x, _) old -> x := old) rvs olds; - raise e diff --git a/compiler/ext/ext_ref.mli b/compiler/ext/ext_ref.mli index 94a47dcf08d..8ca93af1e91 100644 --- a/compiler/ext/ext_ref.mli +++ b/compiler/ext/ext_ref.mli @@ -22,19 +22,4 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** [non_exn_protect ref value f] assusme [f()] - would not raise -*) - -val non_exn_protect : 'a ref -> 'a -> (unit -> 'b) -> 'b - val protect : 'a ref -> 'a -> (unit -> 'b) -> 'b - -val protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c - -val non_exn_protect2 : 'a ref -> 'b ref -> 'a -> 'b -> (unit -> 'c) -> 'c -(** [non_exn_protect2 refa refb va vb f ] - assume [f ()] would not raise -*) - -val protect_list : ('a ref * 'a) list -> (unit -> 'b) -> 'b diff --git a/compiler/ext/ext_string.ml b/compiler/ext/ext_string.ml index ec564df90b4..d153efadf39 100644 --- a/compiler/ext/ext_string.ml +++ b/compiler/ext/ext_string.ml @@ -66,9 +66,6 @@ let trim s = let split ?keep_empty str on = if str = "" then [] else split_by ?keep_empty (fun x -> (x : char) = on) str -let quick_split_by_ws str : string list = - split_by ~keep_empty:false (fun x -> x = '\t' || x = '\n' || x = ' ') str - let starts_with s beg = let beg_len = String.length beg in let s_len = String.length s in @@ -265,12 +262,6 @@ let rec unsafe_no_char_idx x ch i last_idx = unsafe_no_char_idx x ch (i + 1) last_idx else i -let no_char x ch i len : bool = - let str_len = String.length x in - if i < 0 || i >= str_len || len >= str_len then - invalid_arg "Ext_string.no_char" - else unsafe_no_char x ch i len - let no_slash x = unsafe_no_char x '/' 0 (String.length x - 1) let no_slash_idx x = unsafe_no_char_idx x '/' 0 (String.length x - 1) @@ -379,10 +370,6 @@ let inter3 a b c = concat5 a single_space b single_space c let inter4 a b c d = concat_array single_space [|a; b; c; d|] -let parent_dir_lit = ".." -let current_dir_lit = "." - -(* reference {!Bytes.unppercase} *) let capitalize_ascii (s : string) : string = if String.length s = 0 then s else @@ -425,26 +412,6 @@ let lowercase_ascii = String.lowercase_ascii external ( .![] ) : string -> int -> int = "%string_unsafe_get" -let get_int_1_unsafe (x : string) off : int = x.![off] - -let get_int_2_unsafe (x : string) off : int = x.![off] lor (x.![off + 1] lsl 8) - -let get_int_3_unsafe (x : string) off : int = - x.![off] lor (x.![off + 1] lsl 8) lor (x.![off + 2] lsl 16) - -let get_int_4_unsafe (x : string) off : int = - x.![off] - lor (x.![off + 1] lsl 8) - lor (x.![off + 2] lsl 16) - lor (x.![off + 3] lsl 24) - -let get_1_2_3_4 (x : string) ~off len : int = - if len = 1 then get_int_1_unsafe x off - else if len = 2 then get_int_2_unsafe x off - else if len = 3 then get_int_3_unsafe x off - else if len = 4 then get_int_4_unsafe x off - else assert false - let unsafe_sub x offs len = let b = Bytes.create len in Ext_bytes.unsafe_blit_string x offs b 0 len; diff --git a/compiler/ext/ext_string.mli b/compiler/ext/ext_string.mli index 20fdf3e49b6..698ce05256c 100644 --- a/compiler/ext/ext_string.mli +++ b/compiler/ext/ext_string.mli @@ -34,9 +34,6 @@ val trim : string -> string val split : ?keep_empty:bool -> string -> char -> string list (** default is false *) -val quick_split_by_ws : string -> string list -(** split by space chars for quick scripting *) - val starts_with : string -> string -> bool val ends_with_index : string -> string -> int @@ -117,8 +114,6 @@ val rindex_neg : string -> char -> int val rindex_opt : string -> char -> int option -val no_char : string -> char -> int -> int -> bool - val no_slash : string -> bool val no_slash_idx : string -> int @@ -147,9 +142,6 @@ val concat_array : string -> string array -> string val single_colon : string -val parent_dir_lit : string -val current_dir_lit : string - val capitalize_ascii : string -> string val capitalize_sub : string -> int -> string @@ -158,14 +150,6 @@ val uncapitalize_ascii : string -> string val lowercase_ascii : string -> string -(** Play parity to {!Ext_buffer.add_int_1} *) -(* val get_int_1 : string -> int -> int - val get_int_2 : string -> int -> int - val get_int_3 : string -> int -> int - val get_int_4 : string -> int -> int *) - -val get_1_2_3_4 : string -> off:int -> int -> int - val unsafe_sub : string -> int -> int -> string val is_valid_hash_number : string -> bool diff --git a/compiler/ext/ext_util.ml b/compiler/ext/ext_util.ml index 58b8ad2a177..0b6ca038895 100644 --- a/compiler/ext/ext_util.ml +++ b/compiler/ext/ext_util.ml @@ -33,14 +33,6 @@ let rec power_2_above x n = else if x * 2 > Sys.max_array_length then x else power_2_above (x * 2) n -let stats_to_string - ({num_bindings; num_buckets; max_bucket_length; bucket_histogram} : - Hashtbl.statistics) = - Printf.sprintf "bindings: %d,buckets: %d, longest: %d, hist:[%s]" num_bindings - num_buckets max_bucket_length - (String.concat "," - (Array.to_list (Array.map string_of_int bucket_histogram))) - let string_of_int_as_char (i : int) : string = if i <= 255 && i >= 0 then Format.asprintf "%C" (Char.unsafe_chr i) else diff --git a/compiler/ext/ext_util.mli b/compiler/ext/ext_util.mli index 720e5b19b24..ab641063ef3 100644 --- a/compiler/ext/ext_util.mli +++ b/compiler/ext/ext_util.mli @@ -24,6 +24,4 @@ val power_2_above : int -> int -> int -val stats_to_string : Hashtbl.statistics -> string - val string_of_int_as_char : int -> string diff --git a/compiler/ext/js_reserved_map.ml b/compiler/ext/js_reserved_map.ml index 9950bf89ca1..927640eacf7 100644 --- a/compiler/ext/js_reserved_map.ml +++ b/compiler/ext/js_reserved_map.ml @@ -102,21 +102,6 @@ let js_keywords = let is_js_keyword s = STbl.mem js_keywords s -(** Identifiers with special meanings. - - They can have different meanings depending on the context when used as identifier names, so it should be done carefully. - - See https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Lexical_grammar#identifiers_with_special_meanings - - However, these names are actually used with no problems today. (Except `arguments` and `eval`) - *) -let js_special_words = - STbl.of_array - [|"arguments"; "as"; "async"; "eval"; "from"; "get"; "of"; "set"|] - -let is_js_special_word s = STbl.mem js_special_words s - -(** Identifier names _might_ need to care about *) let js_globals = STbl.of_array [| diff --git a/compiler/ext/js_reserved_map.mli b/compiler/ext/js_reserved_map.mli index 5ee19826fae..25b0e10fd19 100644 --- a/compiler/ext/js_reserved_map.mli +++ b/compiler/ext/js_reserved_map.mli @@ -24,6 +24,4 @@ val is_js_keyword : string -> bool -val is_js_special_word : string -> bool - val is_js_global : string -> bool diff --git a/compiler/ext/map_gen.ml b/compiler/ext/map_gen.ml index 7c8af834dd3..8e4597a9220 100644 --- a/compiler/ext/map_gen.ml +++ b/compiler/ext/map_gen.ml @@ -281,11 +281,6 @@ let concat t1 t2 = let x, d = min_binding_exn t2 in join t1 x d (remove_min_binding t2) -let concat_or_join t1 v d t2 = - match d with - | Some d -> join t1 v d t2 - | None -> concat t1 t2 - module type S = sig type key diff --git a/compiler/ext/map_gen.mli b/compiler/ext/map_gen.mli index c5038ffc42f..dbed5417c05 100644 --- a/compiler/ext/map_gen.mli +++ b/compiler/ext/map_gen.mli @@ -50,8 +50,6 @@ val join : ('a, 'b) t -> 'a -> 'b -> ('a, 'b) t -> ('a, 'b) t val concat : ('a, 'b) t -> ('a, 'b) t -> ('a, 'b) t -val concat_or_join : ('a, 'b) t -> 'a -> 'b option -> ('a, 'b) t -> ('a, 'b) t - module type S = sig type key diff --git a/compiler/ext/misc.ml b/compiler/ext/misc.ml index 18fcd9f8972..ce5dcc12074 100644 --- a/compiler/ext/misc.ml +++ b/compiler/ext/misc.ml @@ -22,10 +22,6 @@ let fatal_error msg = prerr_endline msg; raise Fatal_error -let fatal_errorf fmt = Format.kasprintf fatal_error fmt - -(* Exceptions *) - let try_finally work cleanup = let result = try work () @@ -89,35 +85,6 @@ let may_map = Stdlib.Option.map (* File functions *) -let find_in_path path name = - if not (Filename.is_implicit name) then - if Sys.file_exists name then name else raise Not_found - else - let rec try_dir = function - | [] -> raise Not_found - | dir :: rem -> - let fullname = Filename.concat dir name in - if Sys.file_exists fullname then fullname else try_dir rem - in - try_dir path - -let find_in_path_rel path name = - let rec simplify s = - let open Filename in - let base = basename s in - let dir = dirname s in - if dir = s then dir - else if base = current_dir_name then simplify dir - else concat (simplify dir) base - in - let rec try_dir = function - | [] -> raise Not_found - | dir :: rem -> - let fullname = simplify (Filename.concat dir name) in - if Sys.file_exists fullname then fullname else try_dir rem - in - try_dir path - let find_in_path_uncap path name = let uname = String.uncapitalize_ascii name in let rec try_dir = function @@ -153,42 +120,6 @@ let create_hashtable init = (* File copy *) -let copy_file ic oc = - let buff = Bytes.create 0x1000 in - let rec copy () = - let n = input ic buff 0 0x1000 in - if n = 0 then () - else ( - output oc buff 0 n; - copy ()) - in - copy () - -let copy_file_chunk ic oc len = - let buff = Bytes.create 0x1000 in - let rec copy n = - if n <= 0 then () - else - let r = input ic buff 0 (min n 0x1000) in - if r = 0 then raise End_of_file - else ( - output oc buff 0 r; - copy (n - r)) - in - copy len - -let string_of_file ic = - let b = Buffer.create 0x10000 in - let buff = Bytes.create 0x1000 in - let rec copy () = - let n = input ic buff 0 0x1000 in - if n = 0 then Buffer.contents b - else ( - Buffer.add_subbytes b buff 0 n; - copy ()) - in - copy () - let output_to_bin_file_directly filename fn = let oc = open_out_bin filename in match fn filename oc with @@ -233,17 +164,6 @@ let output_to_file_via_temporary ?(mode = [Open_text]) filename fn = let rec log2 n = if n <= 1 then 0 else 1 + log2 (n asr 1) -let align n a = if n >= 0 then (n + a - 1) land -a else n land -a - -let no_overflow_add a b = a lxor b lor (a lxor lnot (a + b)) < 0 - -let no_overflow_sub a b = a lxor lnot b lor (b lxor (a - b)) < 0 - -let no_overflow_mul a b = b <> 0 && a * b / b = a - -let no_overflow_lsl a k = - 0 <= k && k < Sys.word_size && min_int asr k <= a && a <= max_int asr k - module Int_literal_converter = struct (* To convert integer literals, allowing max_int + 1 (PR#4210) *) let cvt_int_aux str neg of_string = @@ -266,58 +186,12 @@ let chop_extensions file = else Filename.concat dirname basename with Not_found -> file -let search_substring pat str start = - let rec search i j = - if j >= String.length pat then i - else if i + j >= String.length str then raise Not_found - else if str.[i + j] = pat.[j] then search i (j + 1) - else search (i + 1) 0 - in - search start 0 - -let replace_substring ~before ~after str = - let rec search acc curr = - match search_substring before str curr with - | next -> - let prefix = String.sub str curr (next - curr) in - search (prefix :: acc) (next + String.length before) - | exception Not_found -> - let suffix = String.sub str curr (String.length str - curr) in - List.rev (suffix :: acc) - in - String.concat after (search [] 0) - -let rev_split_words s = - let rec split1 res i = - if i >= String.length s then res - else - match s.[i] with - | ' ' | '\t' | '\r' | '\n' -> split1 res (i + 1) - | _ -> split2 res i (i + 1) - and split2 res i j = - if j >= String.length s then String.sub s i (j - i) :: res - else - match s.[j] with - | ' ' | '\t' | '\r' | '\n' -> - split1 (String.sub s i (j - i) :: res) (j + 1) - | _ -> split2 res i (j + 1) - in - split1 [] 0 - let get_ref r = let v = !r in r := []; v let fst3 (x, _, _) = x -let snd3 (_, x, _) = x -let thd3 (_, _, x) = x - -let fst4 (x, _, _, _) = x -let snd4 (_, x, _, _) = x -let thd4 (_, _, x, _) = x -let for4 (_, _, _, x) = x - let edit_distance a b cutoff = let la, lb = (String.length a, String.length b) in let cutoff = @@ -397,10 +271,6 @@ let did_you_mean ppf get_choices = (if rest = [] then "" else " or ") last -let cut_at s c = - let pos = String.index s c in - (String.sub s 0 pos, String.sub s (pos + 1) (String.length s - pos - 1)) - module String_set = Set.Make (struct type t = string let compare = compare @@ -454,11 +324,6 @@ module Color = struct {warning = [Bold; FG Magenta]; error = [Bold; FG Red]; loc = [Bold]} let cur_styles = ref default_styles - let get_styles () = !cur_styles - let set_styles s = cur_styles := s - - (* map a tag to a style, if the tag is known. - @raise Not_found otherwise *) let style_of_tag s = match s with | Format.String_tag "error" -> !cur_styles.error @@ -537,31 +402,3 @@ let normalise_eol s = if s.[i] <> '\r' then Buffer.add_char b s.[i] done; Buffer.contents b - -let delete_eol_spaces src = - let len_src = String.length src in - let dst = Bytes.create len_src in - let rec loop i_src i_dst = - if i_src = len_src then i_dst - else - match src.[i_src] with - | ' ' | '\t' -> loop_spaces 1 (i_src + 1) i_dst - | c -> - Bytes.set dst i_dst c; - loop (i_src + 1) (i_dst + 1) - and loop_spaces spaces i_src i_dst = - if i_src = len_src then i_dst - else - match src.[i_src] with - | ' ' | '\t' -> loop_spaces (spaces + 1) (i_src + 1) i_dst - | '\n' -> - Bytes.set dst i_dst '\n'; - loop (i_src + 1) (i_dst + 1) - | _ -> - for n = 0 to spaces do - Bytes.set dst (i_dst + n) src.[i_src - spaces + n] - done; - loop (i_src + 1) (i_dst + spaces + 1) - in - let stop = loop 0 0 in - Bytes.sub_string dst 0 stop diff --git a/compiler/ext/misc.mli b/compiler/ext/misc.mli index 0d63b96a31d..b054fb380d8 100644 --- a/compiler/ext/misc.mli +++ b/compiler/ext/misc.mli @@ -16,7 +16,6 @@ (* Miscellaneous useful types and functions *) val fatal_error : string -> 'a -val fatal_errorf : ('a, Format.formatter, unit, 'b) format4 -> 'a exception Fatal_error val try_finally : (unit -> 'a) -> (unit -> unit) -> 'a @@ -53,12 +52,6 @@ val protect_refs : ref_and_value list -> (unit -> 'a) -> 'a while executing [f]. The previous contents of the references is restored even if [f] raises an exception. *) -val find_in_path : string list -> string -> string -(* Search a file in a list of directories. *) - -val find_in_path_rel : string list -> string -> string -(* Search a relative file in a list of directories. *) - val find_in_path_uncap : string list -> string -> string (* Same, but search also for uncapitalized name, i.e. if name is Foo.ml, allow /path/Foo.ml and /path/foo.ml @@ -75,19 +68,6 @@ val create_hashtable : ('a * 'b) array -> ('a, 'b) Hashtbl.t (* Create a hashtable of the given size and fills it with the given bindings. *) -val copy_file : in_channel -> out_channel -> unit -(* [copy_file ic oc] reads the contents of file [ic] and copies - them to [oc]. It stops when encountering EOF on [ic]. *) - -val copy_file_chunk : in_channel -> out_channel -> int -> unit -(* [copy_file_chunk ic oc n] reads [n] bytes from [ic] and copies - them to [oc]. It raises [End_of_file] when encountering - EOF on [ic]. *) - -val string_of_file : in_channel -> string -(* [string_of_file ic] reads the contents of file [ic] and copies - them to a string. It stops when encountering EOF on [ic]. *) - val output_to_bin_file_directly : string -> (string -> out_channel -> 'a) -> 'a val output_to_file_via_temporary : @@ -103,26 +83,6 @@ val log2 : int -> int (* [log2 n] returns [s] such that [n = 1 lsl s] if [n] is a power of 2*) -val align : int -> int -> int -(* [align n a] rounds [n] upwards to a multiple of [a] - (a power of 2). *) - -val no_overflow_add : int -> int -> bool -(* [no_overflow_add n1 n2] returns [true] if the computation of - [n1 + n2] does not overflow. *) - -val no_overflow_sub : int -> int -> bool -(* [no_overflow_sub n1 n2] returns [true] if the computation of - [n1 - n2] does not overflow. *) - -val no_overflow_mul : int -> int -> bool -(* [no_overflow_mul n1 n2] returns [true] if the computation of - [n1 * n2] does not overflow. *) - -val no_overflow_lsl : int -> int -> bool -(* [no_overflow_lsl n k] returns [true] if the computation of - [n lsl k] does not overflow. *) - module Int_literal_converter : sig val int : string -> int val int32 : string -> int32 @@ -136,33 +96,11 @@ val chop_extensions : string -> string Return the given name if it does not contain an extension. *) -val search_substring : string -> string -> int -> int -(* [search_substring pat str start] returns the position of the first - occurrence of string [pat] in string [str]. Search starts - at offset [start] in [str]. Raise [Not_found] if [pat] - does not occur. *) - -val replace_substring : before:string -> after:string -> string -> string -(* [replace_substring ~before ~after str] replaces all - occurrences of [before] with [after] in [str] and returns - the resulting string. *) - -val rev_split_words : string -> string list -(* [rev_split_words s] splits [s] in blank-separated words, and returns - the list of words in reverse order. *) - val get_ref : 'a list ref -> 'a list (* [get_ref lr] returns the content of the list reference [lr] and reset its content to the empty list. *) val fst3 : 'a * 'b * 'c -> 'a -val snd3 : 'a * 'b * 'c -> 'b -val thd3 : 'a * 'b * 'c -> 'c - -val fst4 : 'a * 'b * 'c * 'd -> 'a -val snd4 : 'a * 'b * 'c * 'd -> 'b -val thd4 : 'a * 'b * 'c * 'd -> 'c -val for4 : 'a * 'b * 'c * 'd -> 'd val edit_distance : string -> string -> int -> int option (** [edit_distance a b cutoff] computes the edit distance between @@ -195,17 +133,6 @@ val did_you_mean : Format.formatter -> (unit -> string list) -> unit the failure even if producing the hint is slow. *) -val cut_at : string -> char -> string * string -(** [String.cut_at s c] returns a pair containing the sub-string before - the first occurrence of [c] in [s], and the sub-string after the - first occurrence of [c] in [s]. - [let (before, after) = String.cut_at s c in - before ^ String.make 1 c ^ after] is the identity if [s] contains [c]. - - Raise [Not_found] if the character does not appear in the string - @since 4.01 -*) - module String_set : Set.S with type elt = string module String_map : Map.S with type key = string (* TODO: replace all custom instantiations of StringSet/StringMap in various @@ -228,9 +155,6 @@ module Color : sig type styles = {error: style list; warning: style list; loc: style list} val default_styles : styles - val get_styles : unit -> styles - val set_styles : styles -> unit - type setting = Auto | Always | Never val setup : setting option -> unit @@ -246,8 +170,3 @@ val normalise_eol : string -> string (** [normalise_eol s] returns a fresh copy of [s] with any '\r' characters removed. Intended for pre-processing text which will subsequently be printed on a channel which performs EOL transformations (i.e. Windows) *) - -val delete_eol_spaces : string -> string -(** [delete_eol_spaces s] returns a fresh copy of [s] with any end of - line spaces removed. Intended to normalize the output of the - toplevel for tests. *) diff --git a/compiler/ext/warnings.ml b/compiler/ext/warnings.ml index c41ef0f8e7b..7bc8af3714a 100644 --- a/compiler/ext/warnings.ml +++ b/compiler/ext/warnings.ml @@ -189,19 +189,6 @@ let is_active x = (not !disabled) && !current.active.(number x) let is_error x = (not !disabled) && !current.error.(number x) -let mk_lazy f = - let state = backup () in - lazy - (let prev = backup () in - restore state; - try - let r = f () in - restore prev; - r - with exn -> - restore prev; - raise exn) - let parse_opt error active flags s = let set i = flags.(i) <- true in let clear i = flags.(i) <- false in diff --git a/compiler/ext/warnings.mli b/compiler/ext/warnings.mli index 9514ea21e6d..7a34634e582 100644 --- a/compiler/ext/warnings.mli +++ b/compiler/ext/warnings.mli @@ -101,10 +101,6 @@ val backup : unit -> state val restore : state -> unit -val mk_lazy : (unit -> 'a) -> 'a Lazy.t -(** Like [Lazy.of_fun], but the function is applied with - the warning settings at the time [mk_lazy] is called. *) - val has_warnings : bool ref val nerrors : int ref diff --git a/compiler/frontend/ast_compatible.ml b/compiler/frontend/ast_compatible.ml index 8d6ac2d4277..55a898b333c 100644 --- a/compiler/frontend/ast_compatible.ml +++ b/compiler/frontend/ast_compatible.ml @@ -73,20 +73,6 @@ let app2 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 : expression = }; } -let app3 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 arg3 : expression = - { - pexp_loc = loc; - pexp_attributes = attrs; - pexp_desc = - Pexp_apply - { - funct = fn; - args = [(Nolabel, arg1); (Nolabel, arg2); (Nolabel, arg3)]; - partial = false; - transformed_jsx = false; - }; - } - let fun_ ?(loc = default_loc) ?(attrs = []) ?(async = false) ~arity pat exp = { pexp_loc = loc; @@ -103,21 +89,6 @@ let fun_ ?(loc = default_loc) ?(attrs = []) ?(async = false) ~arity pat exp = }; } -let const_exp_string ?(loc = default_loc) ?(attrs = []) ?delimiter (s : string) - : expression = - { - pexp_loc = loc; - pexp_attributes = attrs; - pexp_desc = Pexp_constant (Pconst_string (s, delimiter)); - } - -let const_exp_int ?(loc = default_loc) ?(attrs = []) (s : int) : expression = - { - pexp_loc = loc; - pexp_attributes = attrs; - pexp_desc = Pexp_constant (Pconst_integer (string_of_int s, None)); - } - let apply_labels ?(loc = default_loc) ?(attrs = []) fn (args : (string * expression) list) : expression = { @@ -150,13 +121,6 @@ let rec_type_sig ?(loc = default_loc) rf tds : signature_item = tds) } *) -let const_exp_int_list_as_array xs = - Ast_helper.Exp.array (Ext_list.map xs (fun x -> const_exp_int x)) - -(* let const_exp_string_list_as_array xs = - Ast_helper.Exp.array - (Ext_list.map xs (fun x -> const_exp_string x ) ) *) - type object_field = Parsetree.object_field let object_field l attrs ty = Parsetree.Otag (l, attrs, ty) diff --git a/compiler/frontend/ast_compatible.mli b/compiler/frontend/ast_compatible.mli index 77f6e686704..eaf359e4a1e 100644 --- a/compiler/frontend/ast_compatible.mli +++ b/compiler/frontend/ast_compatible.mli @@ -28,13 +28,6 @@ type attrs = Parsetree.attribute list open Parsetree -val const_exp_string : - ?loc:Location.t -> ?attrs:attrs -> ?delimiter:string -> string -> expression - -val const_exp_int : ?loc:Location.t -> ?attrs:attrs -> int -> expression - -val const_exp_int_list_as_array : int list -> expression - val apply_simple : ?loc:Location.t -> ?attrs:attrs -> expression -> expression list -> expression @@ -49,15 +42,6 @@ val app2 : expression -> expression -val app3 : - ?loc:Location.t -> - ?attrs:attrs -> - expression -> - expression -> - expression -> - expression -> - expression - val apply_labels : ?loc:Location.t -> ?attrs:attrs -> diff --git a/compiler/frontend/ast_core_type.ml b/compiler/frontend/ast_core_type.ml index ee05b07ef8b..cac1e1e2c18 100644 --- a/compiler/frontend/ast_core_type.ml +++ b/compiler/frontend/ast_core_type.ml @@ -119,11 +119,6 @@ let rec get_uncurry_arity_aux (ty : t) acc = {[ unit -> 'a1 -> a2']} arity 2 {[ 'a1 -> 'a2 -> ... 'aN -> 'b ]} return arity N *) -let get_uncurry_arity (ty : t) = - match ty.ptyp_desc with - | Ptyp_arrow {ret = rest} -> Some (get_uncurry_arity_aux rest 1) - | _ -> None - let get_curry_arity (ty : t) = match ty.ptyp_desc with | Ptyp_arrow {arity = Some arity} -> arity @@ -150,9 +145,3 @@ let list_of_arrow (ty : t) : t * Parsetree.arg list = | _ -> (ty, List.rev acc) in aux ty [] - -let add_last_obj (ty : t) (obj : t) = - let result, params = list_of_arrow ty in - Typ.arrows ~loc:obj.ptyp_loc - (params @ [{lbl = Nolabel; typ = obj; attrs = []}]) - result diff --git a/compiler/frontend/ast_core_type.mli b/compiler/frontend/ast_core_type.mli index 82f04e828b6..80c1843149f 100644 --- a/compiler/frontend/ast_core_type.mli +++ b/compiler/frontend/ast_core_type.mli @@ -41,15 +41,7 @@ val make_obj : loc:Location.t -> Parsetree.object_field list -> t val is_user_option : t -> bool -val get_uncurry_arity : t -> int option -(** - returns 0 when it can not tell arity from the syntax - None -- means not a function -*) - val list_of_arrow : t -> t * Parsetree.arg list (** fails when Ptyp_poly *) -val add_last_obj : t -> t -> t - val is_arity_one : t -> bool diff --git a/compiler/frontend/ast_external_mk.ml b/compiler/frontend/ast_external_mk.ml index 3ec65e16124..2bc325e24b5 100644 --- a/compiler/frontend/ast_external_mk.ml +++ b/compiler/frontend/ast_external_mk.ml @@ -94,37 +94,3 @@ let local_external_obj loc ?(pval_attributes = []) ~pval_prim ~pval_type } : Parsetree.expression) args ~loc ) - -let local_extern_cont_to_obj loc ?(pval_attributes = []) ~pval_prim ~pval_type - ?(local_module_name = "J") ?(local_fun_name = "unsafe_expr") - (cb : Parsetree.expression -> 'a) : Parsetree.expression_desc = - Pexp_letmodule - ( {txt = local_module_name; loc}, - { - pmod_desc = - Pmod_structure - [ - { - pstr_desc = - Pstr_primitive - { - pval_name = {txt = local_fun_name; loc}; - pval_type; - pval_loc = loc; - pval_prim; - pval_attributes; - }; - pstr_loc = loc; - }; - ]; - pmod_loc = loc; - pmod_attributes = []; - }, - cb - { - pexp_desc = - Pexp_ident - {txt = Ldot (Lident local_module_name, local_fun_name); loc}; - pexp_attributes = []; - pexp_loc = loc; - } ) diff --git a/compiler/frontend/ast_external_mk.mli b/compiler/frontend/ast_external_mk.mli index 550bb3aa8d1..8c7beb300fa 100644 --- a/compiler/frontend/ast_external_mk.mli +++ b/compiler/frontend/ast_external_mk.mli @@ -52,13 +52,3 @@ val local_external_obj : (string * Parsetree.expression) list -> (* [ (label, exp )]*) Parsetree.expression_desc - -val local_extern_cont_to_obj : - Location.t -> - ?pval_attributes:Parsetree.attributes -> - pval_prim:string list -> - pval_type:Parsetree.core_type -> - ?local_module_name:string -> - ?local_fun_name:string -> - (Parsetree.expression -> Parsetree.expression) -> - Parsetree.expression_desc diff --git a/compiler/frontend/ast_literal.ml b/compiler/frontend/ast_literal.ml index 9115caba978..97ff7c1c56d 100644 --- a/compiler/frontend/ast_literal.ml +++ b/compiler/frontend/ast_literal.ml @@ -28,10 +28,6 @@ let predef_prefix_ident : Longident.t = Lident "*predef*" let predef_option : Longident.t = Ldot (predef_prefix_ident, "option") -let predef_some : Longident.t = Ldot (predef_prefix_ident, "Some") - -let predef_none : Longident.t = Ldot (predef_prefix_ident, "None") - module Lid = struct type t = Longident.t @@ -55,8 +51,6 @@ module Lid = struct let method_callback : t = Ldot (js_extern, "Callback") - let ignore_id : t = Ldot (pervasives, "ignore") - let hidden_field n : t = Lident ("I" ^ n) let js_null : t = Ldot (Ldot (Lident "Stdlib", "Null"), "t") diff --git a/compiler/frontend/ast_literal.mli b/compiler/frontend/ast_literal.mli index 32d3e9ca3df..59a4b1428bb 100644 --- a/compiler/frontend/ast_literal.mli +++ b/compiler/frontend/ast_literal.mli @@ -26,10 +26,6 @@ type 'a lit = ?loc:Location.t -> unit -> 'a val predef_option : Longident.t -val predef_some : Longident.t - -val predef_none : Longident.t - module Lid : sig type t = Longident.t @@ -49,8 +45,6 @@ module Lid : sig val hidden_field : string -> t - val ignore_id : t - val js_null : t val js_undefined : t diff --git a/compiler/frontend/ast_pat.ml b/compiler/frontend/ast_pat.ml index 12b99ace36f..7cea97c972f 100644 --- a/compiler/frontend/ast_pat.ml +++ b/compiler/frontend/ast_pat.ml @@ -24,25 +24,6 @@ type t = Parsetree.pattern -let is_unit_cont ~yes ~no (p : t) = - match p with - | {ppat_desc = Ppat_construct ({txt = Lident "()"}, None)} -> yes - | _ -> no - -(** [arity_of_fun pat e] tells the arity of - expression [fun pat -> e] -*) -let arity_of_fun (pat : Parsetree.pattern) (e : Parsetree.expression) = - let rec aux (e : Parsetree.expression) = - match e.pexp_desc with - | Pexp_fun {rhs = e} -> 1 + aux e (*FIXME error on optional*) - (* | Pexp_fun _ - -> Location.raise_errorf - ~loc:e.pexp_loc "Label is not allowed in JS object" *) - | _ -> 0 - in - is_unit_cont ~yes:0 ~no:1 pat + aux e - let rec labels_of_fun (e : Parsetree.expression) = match e.pexp_desc with | Pexp_fun {arg_label = l; rhs = e} -> l :: labels_of_fun e diff --git a/compiler/frontend/ast_pat.mli b/compiler/frontend/ast_pat.mli index 3689c09fc50..dc96ce0831d 100644 --- a/compiler/frontend/ast_pat.mli +++ b/compiler/frontend/ast_pat.mli @@ -24,12 +24,6 @@ type t = Parsetree.pattern -val is_unit_cont : yes:'a -> no:'a -> t -> 'a - -val arity_of_fun : t -> Parsetree.expression -> int -(** [arity_of_fun pat e] tells the arity of - expression [fun pat -> e]*) - val labels_of_fun : Parsetree.expression -> Asttypes.arg_label list val is_single_variable_pattern_conservative : t -> string option diff --git a/compiler/frontend/ast_polyvar.ml b/compiler/frontend/ast_polyvar.ml index 5d04a5beb89..43e74636bf1 100644 --- a/compiler/frontend/ast_polyvar.ml +++ b/compiler/frontend/ast_polyvar.ml @@ -41,26 +41,6 @@ let map_row_fields_into_ints ptyp_loc (row_fields : Parsetree.row_field list) = the underlying representation may change due to unbox *) -let map_constructor_declarations_into_ints - (row_fields : Parsetree.constructor_declaration list) = - let mark = ref `nothing in - let _, acc = - Ext_list.fold_left row_fields (0, []) (fun (i, acc) rtag -> - let attrs = rtag.pcd_attributes in - match Ast_attributes.iter_process_bs_int_as attrs with - | Some j -> - if j <> i then if i = 0 then mark := `offset j else mark := `complex; - (j + 1, j :: acc) - | None -> (i + 1, i :: acc)) - in - match !mark with - | `nothing -> `Offset 0 - | `offset j -> `Offset j - | `complex -> `New (List.rev acc) - -(** It also check in-consistency of cases like - {[ [`a | `c of int ] ]} -*) let map_row_fields_into_strings ptyp_loc (row_fields : Parsetree.row_field list) : External_arg_spec.attr = let has_bs_as = ref false in diff --git a/compiler/frontend/ast_polyvar.mli b/compiler/frontend/ast_polyvar.mli index af509f56aa8..814e670b9a0 100644 --- a/compiler/frontend/ast_polyvar.mli +++ b/compiler/frontend/ast_polyvar.mli @@ -26,9 +26,6 @@ val map_row_fields_into_ints : Location.t -> Parsetree.row_field list -> (string * int) list (** side effect: it will mark used attributes `as` *) -val map_constructor_declarations_into_ints : - Parsetree.constructor_declaration list -> [`Offset of int | `New of int list] - val map_row_fields_into_strings : Location.t -> Parsetree.row_field list -> External_arg_spec.attr diff --git a/compiler/frontend/ast_structure.ml b/compiler/frontend/ast_structure.ml index b4152e884e3..844232d9378 100644 --- a/compiler/frontend/ast_structure.ml +++ b/compiler/frontend/ast_structure.ml @@ -49,5 +49,3 @@ let constraint_ ?(loc = Location.none) (stru : t) (sign : Ast_signature.t) = Str.include_ ~loc (Incl.mk ~loc (Mod.constraint_ ~loc (Mod.structure ~loc stru) (Mty.signature ~loc sign))) - -let dummy_item loc : item = Str.eval ~loc (Ast_literal.val_unit ~loc ()) diff --git a/compiler/frontend/ast_structure.mli b/compiler/frontend/ast_structure.mli index 240cbc3ee9e..dd0a406c56d 100644 --- a/compiler/frontend/ast_structure.mli +++ b/compiler/frontend/ast_structure.mli @@ -36,5 +36,3 @@ val fuse_all : ?loc:Ast_helper.loc -> t -> item item *) val constraint_ : ?loc:Ast_helper.loc -> t -> Ast_signature.t -> item - -val dummy_item : Location.t -> item diff --git a/compiler/frontend/ast_utf8_string_interp.ml b/compiler/frontend/ast_utf8_string_interp.ml index e3e65018a77..7c9a92d9da9 100644 --- a/compiler/frontend/ast_utf8_string_interp.ml +++ b/compiler/frontend/ast_utf8_string_interp.ml @@ -287,7 +287,6 @@ module Delim = struct | _ -> Unrecognized let escaped_j_delimiter = "*j" (* not user level syntax allowed *) - let escaped_back_quote_delimiter = "bq" let some_escaped_back_quote_delimiter = Some "bq" let some_escaped_j_delimiter = Some escaped_j_delimiter end @@ -334,8 +333,4 @@ let transform_pat (p : Parsetree.pattern) s delim : Parsetree.pattern = } | Unrecognized -> p -let is_unicode_string opt = - Ext_string.equal opt Delim.escaped_j_delimiter - || Ext_string.equal opt Delim.escaped_back_quote_delimiter - let parse_processed_delim = Delim.parse_processed diff --git a/compiler/frontend/ast_utf8_string_interp.mli b/compiler/frontend/ast_utf8_string_interp.mli index bc0b13c93ee..a09698ddb5d 100644 --- a/compiler/frontend/ast_utf8_string_interp.mli +++ b/compiler/frontend/ast_utf8_string_interp.mli @@ -58,5 +58,4 @@ val transform_test : string -> segment list val transform_exp : Parsetree.expression -> string -> string -> Parsetree.expression val transform_pat : Parsetree.pattern -> string -> string -> Parsetree.pattern -val is_unicode_string : string -> bool val parse_processed_delim : string option -> External_arg_spec.delim option diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index 8e06c7729eb..5ec5c766030 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -536,10 +536,6 @@ let rec extension_of_error {loc; msg; if_highlight; sub} = ] @ List.map (fun ext -> Str.extension (extension_of_error ext)) sub) ) -let attribute_of_warning loc s = - ( {loc; txt = "ocaml.ppwarning"}, - PStr [Str.eval ~loc (Exp.constant (Pconst_string (s, None)))] ) - module String_map = Map.Make (struct type t = string let compare = compare @@ -547,11 +543,6 @@ end) let cookies = ref String_map.empty -let get_cookie k = - try Some (String_map.find k !cookies) with Not_found -> None - -let set_cookie k v = cookies := String_map.add k v !cookies - let tool_name_ref = ref "_none_" let tool_name () = !tool_name_ref diff --git a/compiler/ml/ast_mapper.mli b/compiler/ml/ast_mapper.mli index 745fdb8d20a..49bdde1d7e0 100644 --- a/compiler/ml/ast_mapper.mli +++ b/compiler/ml/ast_mapper.mli @@ -150,13 +150,6 @@ val extension_of_error : Location.error -> extension inserted in a generated Parsetree. The compiler will be responsible for reporting the error. *) -val attribute_of_warning : Location.t -> string -> attribute -(** Encode a warning message into an 'ocaml.ppwarning' attribute which can be - inserted in a generated Parsetree. The compiler will be - responsible for reporting the warning. *) - -(** {1 Helper functions to call external mappers} *) - val add_ppx_context_str : tool_name:string -> Parsetree.structure -> Parsetree.structure (** Extract information from the current environment and encode it @@ -183,6 +176,3 @@ val drop_ppx_context_sig : (** Cookies are used to pass information from a ppx processor to a further invocation of itself, when called from the OCaml toplevel (or other tools that support cookies). *) - -val set_cookie : string -> Parsetree.expression -> unit -val get_cookie : string -> Parsetree.expression option diff --git a/compiler/ml/ast_payload.ml b/compiler/ml/ast_payload.ml index a8d175beab7..c2b69891a95 100644 --- a/compiler/ml/ast_payload.ml +++ b/compiler/ml/ast_payload.ml @@ -39,21 +39,6 @@ let is_single_string (x : t) = Some (name, dec) | _ -> None -let is_single_string_as_ast (x : t) : Parsetree.expression option = - match x with - (*TODO also need detect empty phrase case *) - | PStr - [ - { - pstr_desc = - Pstr_eval - (({pexp_desc = Pexp_constant (Pconst_string (_, _)); _} as e), _); - _; - }; - ] -> - Some e - | _ -> None - let is_single_int (x : t) : int option = match x with | PStr @@ -168,17 +153,6 @@ let raw_as_string_exp_exn ~(kind : Js_raw_info.raw_kind) ?is_function (x : t) : Some {e with pexp_desc = Pexp_constant (Pconst_string (str, None))} | _ -> None -let as_core_type loc (x : t) = - match x with - | PTyp x -> x - | _ -> Location.raise_errorf ~loc "except a core type" - -let as_ident (x : t) = - match x with - | PStr [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_ident ident}, _)}] -> - Some ident - | _ -> None - type lid = string Asttypes.loc type action = lid * Parsetree.expression option diff --git a/compiler/ml/ast_payload.mli b/compiler/ml/ast_payload.mli index a8b291a5446..d3103a30f6c 100644 --- a/compiler/ml/ast_payload.mli +++ b/compiler/ml/ast_payload.mli @@ -33,8 +33,6 @@ type action = lid * Parsetree.expression option val is_single_string : t -> (string * string option) option -val is_single_string_as_ast : t -> Parsetree.expression option - val is_single_int : t -> int option val is_single_float : t -> string option @@ -52,12 +50,6 @@ val raw_as_string_exp_exn : Parsetree.expression option (** Convert %raw into expression *) -val as_core_type : Location.t -> t -> Parsetree.core_type - -(* val as_empty_structure : t -> bool *) -val as_ident : t -> Longident.t Asttypes.loc option - -(* val raw_string_payload : Location.t -> string -> t *) val assert_strings : Location.t -> t -> string list (** as a record or empty diff --git a/compiler/ml/btype.ml b/compiler/ml/btype.ml index 31efeab2cff..f389add14f2 100644 --- a/compiler/ml/btype.ml +++ b/compiler/ml/btype.ml @@ -476,8 +476,6 @@ let mark_type_node ty = let ty = repr ty in if ty.level >= lowest_level then ty.level <- pivot_level - ty.level -let mark_type_params ty = iter_type_expr mark_type ty - let type_iterators = let it_type_expr it ty = let ty = repr ty in diff --git a/compiler/ml/btype.mli b/compiler/ml/btype.mli index d4ae22fff54..fb5edad6101 100644 --- a/compiler/ml/btype.mli +++ b/compiler/ml/btype.mli @@ -151,9 +151,6 @@ val mark_type : type_expr -> unit val mark_type_node : type_expr -> unit (* Mark a type node (but not its sons) *) -val mark_type_params : type_expr -> unit -(* Mark the sons of a type node *) - val unmark_type : type_expr -> unit val unmark_type_decl : type_declaration -> unit val unmark_extension_constructor : extension_constructor -> unit diff --git a/compiler/ml/clflags.ml b/compiler/ml/clflags.ml index f0cd88115e7..b9bc75c61fb 100644 --- a/compiler/ml/clflags.ml +++ b/compiler/ml/clflags.ml @@ -36,8 +36,6 @@ and dump_typedtree = ref false (* -dtypedtree *) and dump_rawlambda = ref false (* -drawlambda *) -and dump_lambda = ref false (* -dlambda *) - and only_parse = ref false (* -only-parse *) and editor_mode = ref false (* -editor-mode *) diff --git a/compiler/ml/clflags.mli b/compiler/ml/clflags.mli index 0cb5f1ea3e5..c597b2a2d6a 100644 --- a/compiler/ml/clflags.mli +++ b/compiler/ml/clflags.mli @@ -20,7 +20,6 @@ val dump_source : bool ref val dump_parsetree : bool ref val dump_typedtree : bool ref val dump_rawlambda : bool ref -val dump_lambda : bool ref val dont_write_files : bool ref val keep_locs : bool ref val only_parse : bool ref diff --git a/compiler/ml/consistbl.ml b/compiler/ml/consistbl.ml index 37047a26287..02510bb650e 100644 --- a/compiler/ml/consistbl.ml +++ b/compiler/ml/consistbl.ml @@ -23,20 +23,12 @@ let clear = Hashtbl.clear exception Inconsistency of string * string * string -exception Not_available of string - let check tbl name crc source = try let old_crc, old_source = Hashtbl.find tbl name in if crc <> old_crc then raise (Inconsistency (name, source, old_source)) with Not_found -> Hashtbl.add tbl name (crc, source) -let check_noadd tbl name crc source = - try - let old_crc, old_source = Hashtbl.find tbl name in - if crc <> old_crc then raise (Inconsistency (name, source, old_source)) - with Not_found -> raise (Not_available name) - let set tbl name crc source = Hashtbl.add tbl name (crc, source) let source tbl name = snd (Hashtbl.find tbl name) diff --git a/compiler/ml/consistbl.mli b/compiler/ml/consistbl.mli index cfee26f5d26..29303b53c96 100644 --- a/compiler/ml/consistbl.mli +++ b/compiler/ml/consistbl.mli @@ -29,10 +29,6 @@ val check : t -> string -> Digest.t -> string -> unit [source] is the name of the file from which the information comes from. This is used for error reporting. *) -val check_noadd : t -> string -> Digest.t -> string -> unit -(* Same as [check], but raise [Not_available] if no CRC was previously - associated with [name]. *) - val set : t -> string -> Digest.t -> string -> unit (* [set tbl name crc source] forcefully associates [name] with [crc] in [tbl], even if [name] already had a different CRC @@ -57,6 +53,3 @@ exception Inconsistency of string * string * string First string is the name of the compilation unit. Second string is the source that caused the inconsistency. Third string is the source that set the CRC. *) - -exception Not_available of string -(* Raised by [check_noadd] when a name doesn't have an associated CRC. *) diff --git a/compiler/ml/ctype.ml b/compiler/ml/ctype.ml index ed0da2540c8..bc9cff521d7 100644 --- a/compiler/ml/ctype.ml +++ b/compiler/ml/ctype.ml @@ -128,12 +128,6 @@ let begin_def () = saved_level := (!current_level, !nongen_level) :: !saved_level; incr current_level; nongen_level := !current_level -let begin_class_def () = - saved_level := (!current_level, !nongen_level) :: !saved_level; - incr current_level -let raise_nongen_level () = - saved_level := (!current_level, !nongen_level) :: !saved_level; - nongen_level := !current_level let end_def () = let cl, nl = List.hd !saved_level in saved_level := List.tl !saved_level; @@ -330,69 +324,6 @@ let concrete_object ty = (**** Close an object ****) -let close_object ty = - let rec close ty = - let ty = repr ty in - match ty.desc with - | Tvar _ -> link_type ty (newty2 ty.level Tnil) - | Tfield (_, _, _, ty') -> close ty' - | _ -> assert false - in - match (repr ty).desc with - | Tobject (ty, _) -> close ty - | _ -> assert false - -(**** Row variable of an object type ****) - -let row_variable ty = - let rec find ty = - let ty = repr ty in - match ty.desc with - | Tfield (_, _, _, ty) -> find ty - | Tvar _ -> ty - | _ -> assert false - in - match (repr ty).desc with - | Tobject (fi, _) -> find fi - | _ -> assert false - -(**** Object name manipulation ****) -(* +++ Bientot obsolete *) - -let set_object_name id rv params ty = - match (repr ty).desc with - | Tobject (_fi, nm) -> set_name nm (Some (Path.Pident id, rv :: params)) - | _ -> assert false - -let remove_object_name ty = - match (repr ty).desc with - | Tobject (_, nm) -> set_name nm None - | Tconstr (_, _, _) -> () - | _ -> fatal_error "Ctype.remove_object_name" - -(**** Hiding of private methods ****) - -let hide_private_methods ty = - match (repr ty).desc with - | Tobject (fi, nm) -> - nm := None; - let fl, _ = flatten_fields fi in - List.iter - (function - | _, k, _ -> ( - match field_kind_repr k with - | Fvar r -> set_kind r Fabsent - | _ -> ())) - fl - | _ -> assert false - -(*******************************) -(* Operations on class types *) -(*******************************) - -(*******************************************) -(* Miscellaneous operations on row types *) -(*******************************************) type row_fields = (Asttypes.label * Types.row_field) list type row_pairs = (Asttypes.label * Types.row_field * Types.row_field) list let sort_row_fields : row_fields -> row_fields = @@ -720,57 +651,12 @@ let generalize_expansive env ty = try generalize_expansive env !nongen_level (Hashtbl.create 7) ty with Unify ([(_, ty')] as tr) -> raise (Unify ((ty, ty') :: tr)) -let generalize_global ty = generalize_structure !global_level ty let generalize_structure ty = generalize_structure !current_level ty (* Correct the levels of type [ty]. *) let correct_levels ty = duplicate_type ty (* Only generalize the type ty0 in ty *) -let limited_generalize ty0 ty = - let ty0 = repr ty0 in - - let graph = Hashtbl.create 17 in - let idx = ref lowest_level in - let roots = ref [] in - - let rec inverse pty ty = - let ty = repr ty in - if ty.level > !current_level || ty.level = generic_level then ( - decr idx; - Hashtbl.add graph !idx (ty, ref pty); - if ty.level = generic_level || ty == ty0 then roots := ty :: !roots; - set_level ty !idx; - iter_type_expr (inverse [ty]) ty) - else if ty.level < lowest_level then - let _, parents = Hashtbl.find graph ty.level in - parents := pty @ !parents - and generalize_parents ty = - let idx = ty.level in - if idx <> generic_level then ( - set_level ty generic_level; - List.iter generalize_parents !(snd (Hashtbl.find graph idx)); - (* Special case for rows: must generalize the row variable *) - match ty.desc with - | Tvariant row -> - let more = row_more row in - let lv = more.level in - if (lv < lowest_level || lv > !current_level) && lv <> generic_level - then set_level more generic_level - | _ -> ()) - in - - inverse [] ty; - if ty0.level < lowest_level then iter_type_expr (inverse []) ty0; - List.iter generalize_parents !roots; - Hashtbl.iter - (fun _ (ty, _) -> - if ty.level <> generic_level then set_level ty !current_level) - graph - -(* Compute statically the free univars of all nodes in a type *) -(* This avoids doing it repeatedly during instantiation *) - type inv_type_expr = { inv_type: type_expr; mutable inv_parents: inv_type_expr list; @@ -990,13 +876,6 @@ let instance_def sch = cleanup_types (); ty -let generic_instance env sch = - let old = !current_level in - current_level := generic_level; - let ty = instance env sch in - current_level := old; - ty - let instance_list env schl = let env = gadt_env env in let tyl = List.map (fun t -> copy ?env t) schl in @@ -1062,13 +941,6 @@ let instance_parameterized_type ?keep_names sch_args sch = cleanup_types (); (ty_args, ty) -let instance_parameterized_type_2 sch_args sch_lst sch = - let ty_args = List.map simple_copy sch_args in - let ty_lst = List.map simple_copy sch_lst in - let ty = copy sch in - cleanup_types (); - (ty_args, ty_lst, ty) - let map_kind f = function | Type_abstract -> Type_abstract | Type_open -> Type_open @@ -2816,25 +2688,6 @@ let filter_method env name priv ty = | Tobject (f, _) -> filter_method_field env name priv f | _ -> raise (Unify []) -let check_filter_method env name priv ty = - ignore (filter_method env name priv ty) - -let filter_self_method env lab priv meths ty = - let ty' = filter_method env lab priv ty in - try Meths.find lab !meths - with Not_found -> - let pair = (Ident.create lab, ty') in - meths := Meths.add lab pair !meths; - pair - -(***********************************) -(* Matching between type schemes *) -(***********************************) - -(* - Update the level of [ty]. First check that the levels of generic - variables from the subject are not lowered. -*) let moregen_occur env level ty = let rec occur ty = let ty = repr ty in @@ -4349,28 +4202,6 @@ let nondep_extension_constructor env mid ext = clear_hash (); raise Not_found -(* collapse conjunctive types in class parameters *) -let rec collapse_conj env visited ty = - let ty = repr ty in - if List.memq ty visited then () - else - let visited = ty :: visited in - match ty.desc with - | Tvariant row -> - let row = row_repr row in - List.iter - (fun (_l, fi) -> - match row_field_repr fi with - | Reither (c, t1 :: (_ :: _ as tl), m, e) -> - List.iter (unify env t1) tl; - set_row_field e (Reither (c, [t1], m, ref None)) - | _ -> ()) - row.row_fields; - iter_row (collapse_conj env visited) row - | _ -> iter_type_expr (collapse_conj env visited) ty - -let collapse_conj_params env params = List.iter (collapse_conj env []) params - let same_constr env t1 t2 = let t1 = expand_head env t1 in let t2 = expand_head env t2 in diff --git a/compiler/ml/ctype.mli b/compiler/ml/ctype.mli index 6ab84652a3e..aa9cd39bae4 100644 --- a/compiler/ml/ctype.mli +++ b/compiler/ml/ctype.mli @@ -67,8 +67,6 @@ val begin_def : unit -> unit val end_def : unit -> unit (* Lower the variable level by one at the end of a definition *) -val begin_class_def : unit -> unit -val raise_nongen_level : unit -> unit val reset_global_level : unit -> unit (* Reset the global level before typing an expression *) @@ -115,14 +113,6 @@ val associate_fields : * (string * field_kind * type_expr) list * (string * field_kind * type_expr) list val opened_object : type_expr -> bool -val close_object : type_expr -> unit -val row_variable : type_expr -> type_expr -(* Return the row variable of an open object type *) - -val set_object_name : - Ident.t -> type_expr -> type_expr list -> type_expr -> unit -val remove_object_name : type_expr -> unit -val hide_private_methods : type_expr -> unit val find_cltype_for_path : Env.t -> Path.t -> type_declaration * type_expr val lid_of_path : ?hash:string -> Path.t -> Longident.t @@ -143,20 +133,12 @@ val generalize_expansive : Env.t -> type_expr -> unit (* Generalize the covariant part of a type, making contravariant branches non-generalizable *) -val generalize_global : type_expr -> unit -(* Generalize the structure of a type, lowering variables - to !global_level *) - val generalize_structure : type_expr -> unit (* Same, but variables are only lowered to !current_level *) val correct_levels : type_expr -> type_expr (* Returns a copy with decreasing levels *) -val limited_generalize : type_expr -> type_expr -> unit -(* Only generalize some part of the type - Make the remaining of the type non-generalizable *) - val instance : ?partial:bool -> Env.t -> type_expr -> type_expr (* Take an instance of a type scheme *) @@ -166,9 +148,6 @@ val instance : ?partial:bool -> Env.t -> type_expr -> type_expr val instance_def : type_expr -> type_expr (* use defaults *) -val generic_instance : Env.t -> type_expr -> type_expr -(* Same as instance, but new nodes at generic_level *) - val instance_list : Env.t -> type_expr list -> type_expr list (* Take an instance of a list of type schemes *) @@ -180,11 +159,6 @@ val instance_constructor : val instance_parameterized_type : ?keep_names:bool -> type_expr list -> type_expr -> type_expr list * type_expr -val instance_parameterized_type_2 : - type_expr list -> - type_expr list -> - type_expr -> - type_expr list * type_expr list * type_expr val instance_declaration : type_declaration -> type_declaration val instance_poly : ?keep_names:bool -> @@ -242,18 +216,8 @@ val filter_arrow : val filter_method : Env.t -> string -> private_flag -> type_expr -> type_expr (* A special case of unification (with {m : 'a; 'b}). *) -val check_filter_method : Env.t -> string -> private_flag -> type_expr -> unit -(* A special case of unification (with {m : 'a; 'b}), returning unit. *) - val occur_in : Env.t -> type_expr -> type_expr -> bool val deep_occur : type_expr -> type_expr -> bool -val filter_self_method : - Env.t -> - string -> - private_flag -> - (Ident.t * type_expr) Meths.t ref -> - type_expr -> - Ident.t * type_expr val moregeneral : Env.t -> bool -> type_expr -> type_expr -> bool (* Check if the first type scheme is more general than the second. *) @@ -312,9 +276,6 @@ val unalias : type_expr -> type_expr val arity : type_expr -> int (* Return the arity (as for curried functions) of the given type. *) -val collapse_conj_params : Env.t -> type_expr list -> unit -(* Collapse conjunctive types in class parameters *) - val get_current_level : unit -> int val wrap_trace_gadt_instances : Env.t -> ('a -> 'b) -> 'a -> 'b val reset_reified_var_counter : unit -> unit diff --git a/compiler/ml/datarepr.ml b/compiler/ml/datarepr.ml index 44e2ba9afa2..a33e2c57f19 100644 --- a/compiler/ml/datarepr.ml +++ b/compiler/ml/datarepr.ml @@ -256,20 +256,6 @@ let label_descrs ty_res lbls repres priv = in describe_labels 0 lbls -exception Constr_not_found - -let rec find_constr tag num_const num_nonconst = function - | [] -> raise Constr_not_found - | ({cd_args = Cstr_tuple []; _} as c) :: rem -> - if Types.equal_tag tag (Cstr_constant num_const) then c - else find_constr tag (num_const + 1) num_nonconst rem - | c :: rem -> - if Types.equal_tag tag (Cstr_block num_nonconst) || tag = Cstr_unboxed then - c - else find_constr tag num_const (num_nonconst + 1) rem - -let find_constr_by_tag tag cstrlist = find_constr tag 0 0 cstrlist - let constructors_of_type ty_path decl = match decl.type_kind with | Type_variant cstrs -> constructor_descrs ty_path decl cstrs diff --git a/compiler/ml/datarepr.mli b/compiler/ml/datarepr.mli index 47113d87e8e..9161eb77ac9 100644 --- a/compiler/ml/datarepr.mli +++ b/compiler/ml/datarepr.mli @@ -27,11 +27,6 @@ val labels_of_type : val constructors_of_type : Path.t -> type_declaration -> (Ident.t * constructor_description) list -exception Constr_not_found - -val find_constr_by_tag : - constructor_tag -> constructor_declaration list -> constructor_declaration - val constructor_existentials : constructor_arguments -> type_expr option -> type_expr list * type_expr list (** Takes [cd_args] and [cd_res] from a [constructor_declaration] and diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index 8a3680bb183..efa9c71721a 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -18,8 +18,6 @@ open Location open Longident open Parsetree -let pp_deps = ref [] - module String_set = Set.Make (struct type t = string let compare = compare @@ -519,5 +517,3 @@ and add_struct_item (bv, m) item : _ String_map.t * _ String_map.t = and add_implementation bv l = if !Clflags.transparent_modules then ignore (add_structure_binding bv l) else ignore (add_structure bv l) - -and add_implementation_binding bv l = snd (add_structure_binding bv l) diff --git a/compiler/ml/depend.mli b/compiler/ml/depend.mli index aa41f121e5e..5684d2a6473 100644 --- a/compiler/ml/depend.mli +++ b/compiler/ml/depend.mli @@ -27,13 +27,10 @@ val weaken_map : String_set.t -> map_tree -> map_tree val free_structure_names : String_set.t ref (* dependencies found by preprocessing tools (plugins) *) -val pp_deps : string list ref - val open_module : bound_map -> Longident.t -> bound_map val add_signature : bound_map -> Parsetree.signature -> unit val add_implementation : bound_map -> Parsetree.structure -> unit -val add_implementation_binding : bound_map -> Parsetree.structure -> bound_map val add_signature_binding : bound_map -> Parsetree.signature -> bound_map diff --git a/compiler/ml/env.ml b/compiler/ml/env.ml index ba57ce091cd..ce0403c9317 100644 --- a/compiler/ml/env.ml +++ b/compiler/ml/env.ml @@ -1225,14 +1225,6 @@ let mark_constructor usage env name desc = let ty_name = Path.last ty_path in mark_constructor_used usage env ty_name ty_decl name -let lookup_label ?loc lid env = - match lookup_all_labels ?loc lid env with - | [] -> raise Not_found - | (desc, use) :: _ -> - mark_type_path env (ty_path desc.lbl_res); - use (); - desc - let lookup_all_labels ?loc lid env = try let lbls = lookup_all_labels ?loc lid env in @@ -1770,8 +1762,6 @@ let enter_value ?check = enter (store_value ?check) and enter_type = enter (store_type ~check:true) -and enter_extension = enter (store_extension ~check:true) - and enter_module_declaration ?arg id md env = add_module_declaration ?arg ~check:true id md env (* let (id, env) = enter store_module name md env in @@ -1880,15 +1870,6 @@ let read_signature modname filename = (* Return the CRC of the interface of the given compilation unit *) -let crc_of_unit name = - let ps = find_pers_struct name in - let crco = try List.assoc name ps.ps_crcs with Not_found -> assert false in - match crco with - | None -> assert false - | Some crc -> crc - -(* Return the list of imported interfaces with their CRCs *) - let imports () = let dont_record_crc_unit = !Clflags.dont_record_crc_unit in match dont_record_crc_unit with @@ -2052,12 +2033,6 @@ let keep_only_summary env = last_reduced_env := new_env; new_env -let env_of_only_summary env_from_summary env = - let new_env = env_from_summary env.summary Subst.identity in - {new_env with local_constraints = env.local_constraints; flags = env.flags} - -(* Error report *) - open Format (* taken from https://github.com/rescript-lang/ocaml/blob/d4144647d1bf9bc7dc3aadc24c25a7efa3a67915/typing/env.ml#L1842 *) diff --git a/compiler/ml/env.mli b/compiler/ml/env.mli index 66b8e3192b4..584a6e05c31 100644 --- a/compiler/ml/env.mli +++ b/compiler/ml/env.mli @@ -101,7 +101,6 @@ val lookup_all_constructors : Longident.t -> t -> (constructor_description * (unit -> unit)) list -val lookup_label : ?loc:Location.t -> Longident.t -> t -> label_description val lookup_all_labels : ?loc:Location.t -> Longident.t -> @@ -164,7 +163,6 @@ val enter_value : t -> Ident.t * t val enter_type : string -> type_declaration -> t -> Ident.t * t -val enter_extension : string -> extension_constructor -> t -> Ident.t * t val enter_module : ?arg:bool -> string -> module_type -> t -> Ident.t * t val enter_module_declaration : ?arg:bool -> Ident.t -> module_declaration -> t -> t @@ -207,10 +205,6 @@ val save_signature_with_imports : (* Return the CRC of the interface of the given compilation unit *) -val crc_of_unit : string -> Digest.t - -(* Return the set of compilation units imported, with their CRC *) - val imports : unit -> (string * Digest.t option) list (* Direct access to the table of imported compilation units with their CRC *) @@ -224,14 +218,9 @@ val add_import : string -> unit val summary : t -> summary (* Return an equivalent environment where all fields have been reset, - except the summary. The initial environment can be rebuilt from the - summary, using Envaux.env_of_only_summary. *) + except the summary. *) val keep_only_summary : t -> t -val env_of_only_summary : (summary -> Subst.t -> t) -> t -> t - -(* Error report *) - type error = | Illegal_renaming of string * string * string | Inconsistent_import of string * string * string diff --git a/compiler/ml/matching.ml b/compiler/ml/matching.ml index eccb49475a0..f49dfc7d27f 100644 --- a/compiler/ml/matching.ml +++ b/compiler/ml/matching.ml @@ -448,14 +448,6 @@ end) let make_exit i = Lstaticraise (i, []) -(* Introduce a catch, if worth it *) -let make_catch d k = - match d with - | Lstaticraise (_, []) -> k d - | _ -> - let e = next_raise_count () in - Lstaticcatch (k (make_exit e), (e, []), d) - (* Introduce a catch, if worth it, delayed version *) let rec as_simple_exit = function | Lstaticraise (i, []) -> Some i @@ -1539,97 +1531,7 @@ let make_array_matching p def ctx = function let divide_array ctx pm = divide make_array_matching ( = ) get_key_array get_args_array ctx pm -(* - Specific string test sequence - Will be called by the bytecode compiler, from bytegen.ml. - The strategy is first dichotomic search (we perform 3-way tests - with compare_string), then sequence of equality tests - when there are less then T=strings_test_threshold static strings to match. - - Increasing T entails (slightly) less code, decreasing T - (slightly) favors runtime speed. - T=8 looks a decent tradeoff. -*) - -(* Utilities *) - -let strings_test_threshold = 8 - -let bind_sw arg k = - match arg with - | Lvar _ -> k arg - | _ -> - let id = Ident.create "switch" in - Llet (Strict, Pgenval, id, arg, k (Lvar id)) - -(* Sequential equality tests *) - -let make_string_test_sequence loc arg sw d = - let d, sw = - match d with - | None -> ( - match sw with - | (_, d) :: sw -> (d, sw) - | [] -> assert false) - | Some d -> (d, sw) - in - bind_sw arg (fun arg -> - List.fold_right - (fun (s, lam) k -> - Lifthenelse - ( Lprim (Pstringcomp Cneq, [arg; Lconst (Const_immstring s)], loc), - k, - lam )) - sw d) - -let rec split k xs = - match xs with - | [] -> assert false - | x0 :: xs -> - if k <= 1 then ([], x0, xs) - else - let xs, y0, ys = split (k - 2) xs in - (x0 :: xs, y0, ys) - -let zero_lam = Lconst (Const_base (Const_int 0)) - -let tree_way_test loc arg lt eq gt = - Lifthenelse - ( Lprim (Pintcomp Clt, [arg; zero_lam], loc), - lt, - Lifthenelse (Lprim (Pintcomp Clt, [zero_lam; arg], loc), gt, eq) ) - -(* Dichotomic tree *) - -let rec do_make_string_test_tree loc arg sw delta d = - let len = List.length sw in - if len <= strings_test_threshold + delta then - make_string_test_sequence loc arg sw d - else - let lt, (s, act), gt = split len sw in - bind_sw - (Lprim (Pstringcomp Ceq, [arg; Lconst (Const_immstring s)], loc)) - (fun r -> - tree_way_test loc r - (do_make_string_test_tree loc arg lt delta d) - act - (do_make_string_test_tree loc arg gt delta d)) - (* Entry point *) -let expand_stringswitch loc arg sw d = - match d with - | None -> bind_sw arg (fun arg -> do_make_string_test_tree loc arg sw 0 None) - | Some e -> - bind_sw arg (fun arg -> - make_catch e (fun d -> do_make_string_test_tree loc arg sw 1 (Some d))) - -(**********************) -(* Generic test trees *) -(**********************) - -(* Sharing *) - -(* Add handler, if shared *) let handle_shared () = let hs = ref (fun x -> x) in let handle_shared act = @@ -2701,7 +2603,6 @@ let check_partial is_mutable pat_act_list = function then Partial else Total -let check_partial_list = check_partial (List.exists is_mutable) let check_partial = check_partial is_mutable (* have toplevel handler when appropriate *) @@ -2838,24 +2739,6 @@ let for_let loc param pat body = (* Handling of tupled functions and matchings *) (* Easy case since variables are available *) -let for_tupled_function loc paraml pats_act_list partial = - let partial = check_partial_list pats_act_list partial in - let raise_num = next_raise_count () in - let omegas = [List.map (fun _ -> omega) paraml] in - let pm = - { - cases = pats_act_list; - args = List.map (fun id -> (Lvar id, Strict)) paraml; - default = [(omegas, raise_num)]; - } - in - try - let lambda, total = - compile_match None partial (start_ctx (List.length paraml)) pm - in - check_total total lambda raise_num (partial_function loc) - with Unused -> partial_function loc () - let flatten_pattern size p = match p.pat_desc with | Tpat_tuple args -> args diff --git a/compiler/ml/matching.mli b/compiler/ml/matching.mli index 43d1d2cec3c..8ad736202fe 100644 --- a/compiler/ml/matching.mli +++ b/compiler/ml/matching.mli @@ -56,21 +56,10 @@ val for_let : Location.t -> lambda -> pattern -> lambda -> lambda val for_multiple_match : Location.t -> lambda list -> (pattern * lambda) list -> partial -> lambda -val for_tupled_function : - Location.t -> - Ident.t list -> - (pattern list * lambda) list -> - partial -> - lambda - exception Cannot_flatten val flatten_pattern : int -> pattern -> pattern list (* Expand stringswitch to string test tree *) -val expand_stringswitch : - Location.t -> lambda -> (string * lambda) list -> lambda option -> lambda - -(* To be set by Lam_compile *) val names_from_construct_pattern : (pattern -> Ast_untagged_variants.switch_names option) ref diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index 4e9d81ae716..f3ba343e9f7 100644 --- a/compiler/ml/pprintast.ml +++ b/compiler/ml/pprintast.ml @@ -1373,12 +1373,6 @@ let string_of_expression x = expression f x; flush_str_formatter () -let string_of_structure x = - ignore (flush_str_formatter ()); - let f = str_formatter in - structure reset_ctxt f x; - flush_str_formatter () - let core_type = core_type reset_ctxt let pattern = pattern reset_ctxt let signature = signature reset_ctxt diff --git a/compiler/ml/pprintast.mli b/compiler/ml/pprintast.mli index fb26664584f..bbb8dd7a9ee 100644 --- a/compiler/ml/pprintast.mli +++ b/compiler/ml/pprintast.mli @@ -22,5 +22,4 @@ val core_type : Format.formatter -> Parsetree.core_type -> unit val pattern : Format.formatter -> Parsetree.pattern -> unit val signature : Format.formatter -> Parsetree.signature -> unit val structure : Format.formatter -> Parsetree.structure -> unit -val string_of_structure : Parsetree.structure -> string val string_of_int_as_char : int -> string diff --git a/compiler/ml/predef.ml b/compiler/ml/predef.ml index 348cb1ce337..00812b11a31 100644 --- a/compiler/ml/predef.ml +++ b/compiler/ml/predef.ml @@ -139,10 +139,6 @@ and type_list t = newgenty (Tconstr (path_list, [t], ref Mnil)) and type_option t = newgenty (Tconstr (path_option, [t], ref Mnil)) -and type_result t1 t2 = newgenty (Tconstr (path_result, [t1; t2], ref Mnil)) - -and type_dict t = newgenty (Tconstr (path_dict, [t], ref Mnil)) - and type_bigint = newgenty (Tconstr (path_bigint, [], ref Mnil)) and type_string = newgenty (Tconstr (path_string, [], ref Mnil)) @@ -178,25 +174,10 @@ and ident_assert_failure = ident_create_predef_exn "Assert_failure" and ident_undefined_recursive_module = ident_create_predef_exn "Undefined_recursive_module" -let all_predef_exns = - [ - ident_match_failure; - ident_invalid_argument; - ident_failure; - ident_js_exn; - ident_not_found; - ident_end_of_file; - ident_division_by_zero; - ident_assert_failure; - ident_undefined_recursive_module; - ] - let path_match_failure = Pident ident_match_failure and path_assert_failure = Pident ident_assert_failure -and path_undefined_recursive_module = Pident ident_undefined_recursive_module - let decl_abstr = { type_params = []; @@ -436,11 +417,8 @@ let build_initial_env add_type add_exception empty_env = in add_type ident_char decl_type_char common -let builtin_values = - List.map - (fun id -> - Ident.make_global id; - (Ident.name id, id)) +let () = + List.iter Ident.make_global [ ident_match_failure; ident_invalid_argument; diff --git a/compiler/ml/predef.mli b/compiler/ml/predef.mli index 802be290dee..7ff4173c2d3 100644 --- a/compiler/ml/predef.mli +++ b/compiler/ml/predef.mli @@ -29,9 +29,6 @@ val type_iterable : type_expr -> type_expr val type_async_iterable : type_expr -> type_expr val type_list : type_expr -> type_expr val type_option : type_expr -> type_expr -val type_result : type_expr -> type_expr -> type_expr -val type_dict : type_expr -> type_expr - val type_bigint : type_expr val type_extension_constructor : type_expr @@ -57,12 +54,6 @@ val path_tagged_template : Path.t val path_match_failure : Path.t val path_assert_failure : Path.t -val path_undefined_recursive_module : Path.t - -(* To build the initial environment. Since there is a nasty mutual - recursion between predef and env, we break it by parameterizing - over Env.t, Env.add_type and Env.add_extension. *) - val build_initial_env : (Ident.t -> type_declaration -> 'a -> 'a) -> (Ident.t -> extension_constructor -> 'a -> 'a) -> @@ -71,7 +62,6 @@ val build_initial_env : (* To initialize linker tables *) -val builtin_values : (string * Ident.t) list val builtin_idents : (string * Ident.t) list val ident_division_by_zero : Ident.t @@ -80,8 +70,6 @@ val ident_division_by_zero : Ident.t The [Ident.t] for division by zero is also exported explicitly so flambda can generate code to raise it. *) -val all_predef_exns : Ident.t list - type test = For_sure_yes | For_sure_no | NA val type_is_builtin_path_but_option : Path.t -> test diff --git a/compiler/ml/printtyp.ml b/compiler/ml/printtyp.ml index d38e26bbae6..d2f00712bbc 100644 --- a/compiler/ml/printtyp.ml +++ b/compiler/ml/printtyp.ml @@ -962,11 +962,6 @@ and type_scheme ppf ty = typexp true ppf ty (* Maxence *) -let type_scheme_max ?(b_reset_names = true) ppf ty = - if b_reset_names then reset_names (); - typexp true ppf ty -(* End Maxence *) - let tree_of_type_scheme ty = reset_and_mark_loops ty; tree_of_typexp true ty diff --git a/compiler/ml/printtyp.mli b/compiler/ml/printtyp.mli index 0fe84f38f1a..cc7af05150f 100644 --- a/compiler/ml/printtyp.mli +++ b/compiler/ml/printtyp.mli @@ -47,9 +47,6 @@ val type_scheme : formatter -> type_expr -> unit (* Maxence *) val reset_names : unit -> unit -val type_scheme_max : ?b_reset_names:bool -> formatter -> type_expr -> unit - -(* End Maxence *) val tree_of_value_description : Ident.t -> value_description -> out_sig_item val value_description : Ident.t -> formatter -> value_description -> unit val tree_of_type_declaration : diff --git a/compiler/ml/types.mli b/compiler/ml/types.mli index 36386aacc85..c8de510f22c 100644 --- a/compiler/ml/types.mli +++ b/compiler/ml/types.mli @@ -79,8 +79,7 @@ and type_desc = [Tobject (_, `Some (`A.ct', [t1;...;tn]')] ==> [(t1, ..., tn) A.ct]. where A.ct is the type of some class. - There are also special cases for so-called "class-types", cf. [Typeclass] - and [Ctype.set_object_name]: + There are also special cases for so-called "class-types", cf. [Typeclass]: [Tobject (Tfield(_,_,...(Tfield(_,_,rv)...), Some(`A.#ct`, [rv;t1;...;tn])] diff --git a/compiler/syntax/cli/res_cli.ml b/compiler/syntax/cli/res_cli.ml index 17234927076..dae94cd7ccd 100644 --- a/compiler/syntax/cli/res_cli.ml +++ b/compiler/syntax/cli/res_cli.ml @@ -76,9 +76,6 @@ module Color = struct let cur_styles = ref default_styles - (* let get_styles () = !cur_styles *) - (* let set_styles s = cur_styles := s *) - (* map a tag to a style, if the tag is known. @raise Not_found otherwise *) let style_of_tag s = diff --git a/compiler/syntax/src/res_doc.ml b/compiler/syntax/src/res_doc.ml index b56c2bee202..655522c158e 100644 --- a/compiler/syntax/src/res_doc.ml +++ b/compiler/syntax/src/res_doc.ml @@ -70,8 +70,6 @@ let question = Text "?" let tilde = Text "~" let equal = Text "=" let trailing_comma = if_breaks comma nil -let double_quote = Text "\"" - let propagate_forced_breaks doc = let rec walk doc = match doc with diff --git a/compiler/syntax/src/res_doc.mli b/compiler/syntax/src/res_doc.mli index 763c202202f..e236f1a0285 100644 --- a/compiler/syntax/src/res_doc.mli +++ b/compiler/syntax/src/res_doc.mli @@ -40,27 +40,6 @@ val question : t val tilde : t val equal : t val trailing_comma : t -val double_quote : t [@@live] - -(* - * `willBreak doc` checks whether `doc` contains forced line breaks. - * This is more or less a "workaround" to make the parent of a `customLayout` break. - * Forced breaks are not propagated through `customLayout`; otherwise we would always - * get the last layout the algorithm tries… - * This might result into some weird layouts: - * [fn(x => { - * let _ = x - * }), fn(y => { - * let _ = y - * }), fn(z => { - * let _ = z - * })] - * The `[` and `]` would be a lot better broken out. - * Although the layout of `fn(x => {...})` is correct, we need to break its parent (the array). - * `willBreak` can be used in this scenario to check if the `fn…` contains any forced breaks. - * The consumer can then manually insert a `breakParent` doc, to manually propagate the - * force breaks from bottom to top. - *) val will_break : t -> bool val to_string : width:int -> t -> string diff --git a/compiler/syntax/src/res_scanner.ml b/compiler/syntax/src/res_scanner.ml index 82fbeb533bf..67be55fdc5d 100644 --- a/compiler/syntax/src/res_scanner.ml +++ b/compiler/syntax/src/res_scanner.ml @@ -148,7 +148,6 @@ let peek_char scanner target_char = in skip_whitespace_and_check scanner.offset -let peek_minus scanner = peek_char scanner '-' let peek_slash scanner = peek_char scanner '/' let make ~filename src = diff --git a/compiler/syntax/src/res_scanner.mli b/compiler/syntax/src/res_scanner.mli index cbb78fad4bd..1b60980ad27 100644 --- a/compiler/syntax/src/res_scanner.mli +++ b/compiler/syntax/src/res_scanner.mli @@ -35,7 +35,4 @@ val scan_template_literal_token : val scan_regex : t -> Lexing.position * Lexing.position * Res_token.t (* Look ahead to see if the next non-whitespace character is a minus *) -val peek_minus : t -> bool - -(* Look ahead to see if the next non-whitespace character is a slash *) val peek_slash : t -> bool From 46db9c6751c36620fe0b6f6cd19956537b3f3bbd Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Sat, 15 Aug 2026 20:19:36 +0200 Subject: [PATCH 3/4] Remove unused compiler variants and fields Signed-off-by: Christoph Knittel --- compiler/core/js_cmj_load.ml | 13 ------------- compiler/depends/bs_exception.ml | 20 -------------------- compiler/depends/bs_exception.mli | 13 ------------- compiler/ml/includecore.mli | 4 ---- compiler/ml/typedecl.ml | 1 - compiler/ml/typedtree.ml | 4 ---- compiler/ml/typedtree.mli | 4 ---- compiler/ml/typemod.ml | 1 - compiler/ml/typetexp.ml | 12 ++---------- tests/ERROR_VARIANTS.md | 5 ----- 10 files changed, 2 insertions(+), 75 deletions(-) diff --git a/compiler/core/js_cmj_load.ml b/compiler/core/js_cmj_load.ml index e00f9cfe020..97ef4443492 100644 --- a/compiler/core/js_cmj_load.ml +++ b/compiler/core/js_cmj_load.ml @@ -27,19 +27,6 @@ make sure that the distributed files are platform independent *) -(* - let load_unit_no_file unit_name : Js_cmj_format.cmj_load_info = - let file = unit_name ^ Literals.suffix_cmj in - match Config_util.find_opt file with - | Some f - -> - {package_path = - (** hacking relying on the convention of pkg/lib/ocaml/xx.cmj*) - Filename.dirname (Filename.dirname (Filename.dirname f)); - cmj_table = Js_cmj_format.from_file f} - | None -> - Bs_exception.error (Cmj_not_found unit_name) *) - let load_unit_with_file unit_name : Js_cmj_format.cmj_load_info = let file = unit_name ^ Literals.suffix_cmj in match Config_util.find_opt file with diff --git a/compiler/depends/bs_exception.ml b/compiler/depends/bs_exception.ml index bd1e498d9c1..7f2d34f7094 100644 --- a/compiler/depends/bs_exception.ml +++ b/compiler/depends/bs_exception.ml @@ -25,12 +25,7 @@ type error = | Cmj_not_found of string | Js_not_found of string - | Bs_cyclic_depends of string list - | Bs_duplicated_module of string * string | Bs_duplicate_exports of string (* gpr_974 *) - | Bs_package_not_found of string - | Bs_main_not_exist of string - | Bs_invalid_path of string | Missing_ml_dependency of string | Dependency_script_module_dependent_not of string (** TODO: we need add location handling *) @@ -52,22 +47,7 @@ let report_error ppf = function s | Js_not_found s -> Format.fprintf ppf "%s not found, needed in script mode " s - | Bs_cyclic_depends str -> - Format.fprintf ppf "Cyclic depends : @[%a@]" - (Format.pp_print_list ~pp_sep:Format.pp_print_space Format.pp_print_string) - str | Bs_duplicate_exports str -> Format.fprintf ppf "%s is exported twice" str - | Bs_duplicated_module (a, b) -> - Format.fprintf ppf - "The build system does not support two files with same names yet %s, %s" a - b - | Bs_main_not_exist main -> Format.fprintf ppf "File %s not found " main - | Bs_package_not_found package -> - Format.fprintf ppf - "Package %s not found or %s/lib/ocaml does not exist or set \ - npm_config_prefix correctly" - package package - | Bs_invalid_path path -> Format.pp_print_string ppf ("Invalid path: " ^ path) let () = Location.register_error_of_exn (function diff --git a/compiler/depends/bs_exception.mli b/compiler/depends/bs_exception.mli index 53efde0a03b..73fdc1d3ace 100644 --- a/compiler/depends/bs_exception.mli +++ b/compiler/depends/bs_exception.mli @@ -25,21 +25,8 @@ type error = | Cmj_not_found of string | Js_not_found of string - | Bs_cyclic_depends of string list - | Bs_duplicated_module of string * string | Bs_duplicate_exports of string (* gpr_974 *) - | Bs_package_not_found of string - | Bs_main_not_exist of string - | Bs_invalid_path of string | Missing_ml_dependency of string | Dependency_script_module_dependent_not of string -(* -TODO: In the futrue, we should refine dependency [bsb] -should not rely on such exception, it should have its own exception handling -*) - -(* exception Error of error *) - -(* val report_error : Format.formatter -> error -> unit *) val error : error -> 'a diff --git a/compiler/ml/includecore.mli b/compiler/ml/includecore.mli index aec316d449f..565de90075d 100644 --- a/compiler/ml/includecore.mli +++ b/compiler/ml/includecore.mli @@ -64,10 +64,6 @@ val extension_constructors : extension_constructor -> extension_constructor -> bool -(* -val class_types: - Env.t -> class_type -> class_type -> bool -*) val report_type_mismatch : string -> string -> string -> Format.formatter -> type_mismatch list -> unit diff --git a/compiler/ml/typedecl.ml b/compiler/ml/typedecl.ml index 6f9d47629ee..fbb56973583 100644 --- a/compiler/ml/typedecl.ml +++ b/compiler/ml/typedecl.ml @@ -1826,7 +1826,6 @@ let transl_type_extension extend env loc styext = let tyext = { tyext_path = type_path; - tyext_txt = styext.ptyext_path; tyext_params = ttype_params; tyext_constructors = constructors; tyext_private = styext.ptyext_private; diff --git a/compiler/ml/typedtree.ml b/compiler/ml/typedtree.ml index 93da90b39f6..3711715c412 100644 --- a/compiler/ml/typedtree.ml +++ b/compiler/ml/typedtree.ml @@ -289,7 +289,6 @@ and open_description = { open_path: Path.t; open_txt: Longident.t loc; open_override: override_flag; - open_loc: Location.t; open_attributes: attribute list; } @@ -335,8 +334,6 @@ and core_type_desc = and package_type = { pack_path: Path.t; pack_fields: (Longident.t loc * core_type) list; - pack_type: Types.module_type; - pack_txt: Longident.t loc; } and row_field = @@ -401,7 +398,6 @@ and constructor_arguments = and type_extension = { tyext_path: Path.t; - tyext_txt: Longident.t loc; tyext_params: (core_type * variance) list; tyext_constructors: extension_constructor list; tyext_private: private_flag; diff --git a/compiler/ml/typedtree.mli b/compiler/ml/typedtree.mli index 6261f8d039f..a8da19b7a45 100644 --- a/compiler/ml/typedtree.mli +++ b/compiler/ml/typedtree.mli @@ -395,7 +395,6 @@ and open_description = { open_path: Path.t; open_txt: Longident.t loc; open_override: override_flag; - open_loc: Location.t; open_attributes: attribute list; } @@ -441,8 +440,6 @@ and core_type_desc = and package_type = { pack_path: Path.t; pack_fields: (Longident.t loc * core_type) list; - pack_type: Types.module_type; - pack_txt: Longident.t loc; } and row_field = @@ -507,7 +504,6 @@ and constructor_arguments = and type_extension = { tyext_path: Path.t; - tyext_txt: Longident.t loc; tyext_params: (core_type * variance) list; tyext_constructors: extension_constructor list; tyext_private: private_flag; diff --git a/compiler/ml/typemod.ml b/compiler/ml/typemod.ml index bca0a511986..b35814fe62c 100644 --- a/compiler/ml/typemod.ml +++ b/compiler/ml/typemod.ml @@ -105,7 +105,6 @@ let type_open ?toplevel env sod = open_path = path; open_txt = sod.popen_lid; open_attributes = sod.popen_attributes; - open_loc = sod.popen_loc; } in (path, newenv, od) diff --git a/compiler/ml/typetexp.ml b/compiler/ml/typetexp.ml index f47c1f554c2..17c7c8274b9 100644 --- a/compiler/ml/typetexp.ml +++ b/compiler/ml/typetexp.ml @@ -529,7 +529,7 @@ and transl_type_aux env policy styp = | Ptyp_package (p, l) -> let l, mty = create_package_mty true styp.ptyp_loc env (p, l) in let z = narrow () in - let mty = !transl_modtype env mty in + ignore (!transl_modtype env mty); widen z; let ptys = List.map (fun (s, pty) -> (s, transl_type env policy pty)) l in let path = !transl_modtype_longident styp.ptyp_loc env p.txt in @@ -540,15 +540,7 @@ and transl_type_aux env policy styp = List.map (fun (s, _pty) -> s.txt) l, List.map (fun (_, cty) -> cty.ctyp_type) ptys )) in - ctyp - (Ttyp_package - { - pack_path = path; - pack_type = mty.mty_type; - pack_fields = ptys; - pack_txt = p; - }) - ty + ctyp (Ttyp_package {pack_path = path; pack_fields = ptys}) ty | Ptyp_extension ext -> raise (Error_forward (Builtin_attributes.error_of_extension ext)) diff --git a/tests/ERROR_VARIANTS.md b/tests/ERROR_VARIANTS.md index 7af547fd113..f22efc29f25 100644 --- a/tests/ERROR_VARIANTS.md +++ b/tests/ERROR_VARIANTS.md @@ -460,12 +460,7 @@ Build / dependency errors. Mostly need the `rescript build` runtime to fire — |---|---|---|---| | `Cmj_not_found` | ☐ (needs build harness) | — | Missing `.cmj` from a dependent module. Reachable from `rescript build` but not from raw `bsc`. | | `Js_not_found` | ✓ | implicitly — bypassed via `-bs-cmi-only` in `super_errors_multi` runner. Not a fixture, but the harness commit documents the workaround. | | -| `Bs_cyclic_depends` | ☐ (needs build harness) | — | Cycle across compilation units; the dependency graph that detects this is owned by `rewatch` / `bsb`, not raw `bsc`. | -| `Bs_duplicated_module` | ☐ (needs build harness) | — | Same module name in two source paths under a single package. | | `Bs_duplicate_exports` | ☐ (needs build harness) | — | Same export emitted twice across compilation units. | -| `Bs_package_not_found` | ☐ (needs build harness) | — | `rescript.json`-referenced package not resolvable. | -| `Bs_main_not_exist` | ☐ (needs build harness) | — | `rescript.json` `main` entry missing. | -| `Bs_invalid_path` | ☐ (needs build harness) | — | `-I` / source path with invalid form. | | `Missing_ml_dependency` | ☐ (needs build harness) | — | Compile-time missing dependency from a `.cmj` lookup table. | | `Dependency_script_module_dependent_not` | ☐ (needs build harness) | — | `core/platform/native/js_name_of_module_id.ml:99`. **Reachable** when a dependent module is in script mode (`Package_script`) but the current module is in package mode (`Package_found _`). Legacy script-vs-package interaction; needs `rescript.json` harness. | From 488c3b66880c9bbce30c3f70abafc17b01127c2c Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Sun, 16 Aug 2026 19:40:25 +0200 Subject: [PATCH 4/4] Add changelog entry Signed-off-by: Christoph Knittel --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2fb9c18002e..c8fc4e07038 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -37,6 +37,7 @@ #### :house: Internal +- Remove unused compiler IR definitions, modules, helpers, error variants, and Typedtree fields. https://github.com/rescript-lang/rescript/pull/8551 https://github.com/rescript-lang/rescript/pull/8555 - Add the `-check-lam` compiler option, enable Lambda invariant checking in compiler tests, and remove build-profile-dependent checking. https://github.com/rescript-lang/rescript/pull/8534 - Replace `-bs-diagnose` with `-debug-ir` and make IR diagnostic artifacts deterministic, compilation-local, and easy to clean. https://github.com/rescript-lang/rescript/pull/8535 - Replace CPPO-based browser conditionals with Dune-selected native and playground compiler implementations. https://github.com/rescript-lang/rescript/pull/8541