From f4684b2695aff625d1e6fb13a66908678ef749af Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 2 Oct 2026 06:56:50 +0200 Subject: [PATCH 01/32] Remove unused constants from Literals 31 constants in compiler/ext/literals.ml (js_array_ctor, prim, param, the fn_run/method_run family, node_modules, package_json, the .a/.cmo/.cma/ .cmx/.cmxa/.mll/.cmt/.cmti/.d/.gen.js/.gen.tsx suffixes, esmodule, commonjs, unused_attribute, sourcedirs_meta and others) had no reference: no file names them as Literals.x or L.x, and nothing opens Literals. Signed-off-by: Cristiano Calcagno Co-Authored-By: Claude Opus 5.5 --- compiler/ext/literals.ml | 65 ---------------------------------------- 1 file changed, 65 deletions(-) diff --git a/compiler/ext/literals.ml b/compiler/ext/literals.ml index 9f6e9ce70e..756b757e39 100644 --- a/compiler/ext/literals.ml +++ b/compiler/ext/literals.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. *) -let js_array_ctor = "Array" - let js_type_number = "number" let js_type_string = "string" @@ -32,89 +30,28 @@ let js_type_object = "object" let js_type_boolean = "boolean" -let js_undefined = "undefined" - -let js_prop_length = "length" - -let prim = "prim" - -let param = "param" - -let partial_arg = "partial_arg" - let tmp = "tmp" let create = "create" (* {!Caml_exceptions.create}*) -let runtime = "runtime" (* runtime directory *) - -let stdlib = "stdlib" - let debugger = "debugger" -let fn_run = "fn_run" - -let method_run = "method_run" - -let fn_method = "fn_method" - -let fn_mk = "fn_mk" -(*let js_fn_runmethod = "js_fn_runmethod"*) - -(** nodejs *) -let node_modules = "node_modules" - -let node_modules_length = String.length "node_modules" - -let package_json = "package.json" - -(* Name of the library file created for each external dependency. *) -let library_file = "lib" - -let suffix_a = ".a" - let suffix_cmj = ".cmj" -let suffix_cmo = ".cmo" - -let suffix_cma = ".cma" - let suffix_cmi = ".cmi" -let suffix_cmx = ".cmx" - -let suffix_cmxa = ".cmxa" - -let suffix_mll = ".mll" - let suffix_res = ".res" let suffix_resi = ".resi" let suffix_mlmap = ".mlmap" -let suffix_cmt = ".cmt" - -let suffix_cmti = ".cmti" - let suffix_ast = ".ast" let suffix_iast = ".iast" -let suffix_d = ".d" - let suffix_js = ".js" -let suffix_gen_js = ".gen.js" - -let suffix_gen_tsx = ".gen.tsx" - -let esmodule = "esmodule" - -let commonjs = "commonjs" - -let unused_attribute = "Unused attribute " - (** Used when produce node compatible paths *) let node_sep = "/" @@ -125,8 +62,6 @@ let node_current = "." let gentype_import1 = "genType.import" let gentype_import2 = "gentype.import" -let sourcedirs_meta = ".sourcedirs.json" - (* Note the build system should check the validity of filenames espeically, it should not contain '-' *) From 7365c27c9434395c8dea49899b85beff54a0e113 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 2 Oct 2026 06:56:51 +0200 Subject: [PATCH 02/32] Remove unused functions from ext utility modules Ext_array (reverse_in_place, filter, filter_map, filter_mapi, range, map2i, is_empty), Ext_list (map_split_opt, map2i, filter_map2, find_def, mem_string, drop), Ext_string (repeat, rindex_opt, lowercase_ascii, unsafe_sub), Ext_buffer.clear, Ext_char.valid_hex, Ext_fmt.invalid_argf, Ext_obj.bt, Ext_pp_scope.print and Hash_set_poly (clear, reset, iter, to_list) had no caller outside their own definitions; with them go the helper rindex_rec_opt and the Ext_char comment about a Char.escaped backport the module does not contain. Signed-off-by: Cristiano Calcagno Co-Authored-By: Claude Opus 5.5 --- compiler/ext/ext_array.ml | 47 -------------------- compiler/ext/ext_array.mli | 14 ------ compiler/ext/ext_buffer.ml | 2 - compiler/ext/ext_buffer.mli | 3 -- compiler/ext/ext_char.ml | 9 ---- compiler/ext/ext_char.mli | 2 - compiler/ext/ext_fmt.ml | 2 - compiler/ext/ext_list.ml | 79 ---------------------------------- compiler/ext/ext_list.mli | 17 -------- compiler/ext/ext_obj.ml | 19 -------- compiler/ext/ext_obj.mli | 2 - compiler/ext/ext_pp_scope.ml | 9 ---- compiler/ext/ext_pp_scope.mli | 2 - compiler/ext/ext_string.ml | 22 ---------- compiler/ext/ext_string.mli | 8 ---- compiler/ext/hash_set_poly.ml | 4 -- compiler/ext/hash_set_poly.mli | 8 ---- 17 files changed, 249 deletions(-) diff --git a/compiler/ext/ext_array.ml b/compiler/ext/ext_array.ml index 2535addcb2..57eeb17a86 100644 --- a/compiler/ext/ext_array.ml +++ b/compiler/ext/ext_array.ml @@ -35,8 +35,6 @@ let reverse_range a i len = a.!(i + len - 1 - k) <- t done -let reverse_in_place a = reverse_range a 0 (Array.length a) - let reverse a = let b_len = Array.length a in if b_len = 0 then [||] @@ -60,49 +58,6 @@ let reverse_of_list = function in fill (len - 1) tl -let filter a f = - let arr_len = Array.length a in - let rec aux acc i = - if i = arr_len then reverse_of_list acc - else - let v = Array.unsafe_get a i in - if f v then aux (v :: acc) (i + 1) else aux acc (i + 1) - in - aux [] 0 - -let filter_map a (f : _ -> _ option) = - let arr_len = Array.length a in - let rec aux acc i = - if i = arr_len then reverse_of_list acc - else - let v = Array.unsafe_get a i in - match f v with - | Some v -> aux (v :: acc) (i + 1) - | None -> aux acc (i + 1) - in - aux [] 0 - -let filter_mapi a (f : _ -> _ -> _ option) = - let arr_len = Array.length a in - let rec aux acc i = - if i = arr_len then reverse_of_list acc - else - let v = Array.unsafe_get a i in - match f i v with - | Some v -> aux (v :: acc) (i + 1) - | None -> aux acc (i + 1) - in - aux [] 0 - -let range from to_ = - if from > to_ then invalid_arg "Ext_array.range" - else Array.init (to_ - from + 1) (fun i -> i + from) - -let map2i f a b = - let len = Array.length a in - if len <> Array.length b then invalid_arg "Ext_array.map2i" - else Array.mapi (fun i a -> f i a (Array.unsafe_get b i)) a - let rec tolist_f_aux a f i res = if i < 0 then res else @@ -197,8 +152,6 @@ let exists a p = in loop 0 -let is_empty arr = Array.length arr = 0 - let rec unsafe_loop index len p xs ys = if index >= len then true else diff --git a/compiler/ext/ext_array.mli b/compiler/ext/ext_array.mli index 0f0eb4dfa3..d1942e16c5 100644 --- a/compiler/ext/ext_array.mli +++ b/compiler/ext/ext_array.mli @@ -25,22 +25,10 @@ val reverse_range : 'a array -> int -> int -> unit (** Some utilities for {!Array} operations *) -val reverse_in_place : 'a array -> unit - val reverse : 'a array -> 'a array val reverse_of_list : 'a list -> 'a array -val filter : 'a array -> ('a -> bool) -> 'a array - -val filter_map : 'a array -> ('a -> 'b option) -> 'b array - -val filter_mapi : 'a array -> (int -> 'a -> 'b option) -> 'b array - -val range : int -> int -> int array - -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_acc : 'a array -> 'b list -> ('a -> 'b option) -> 'b list @@ -53,8 +41,6 @@ val find_and_split : 'a array -> ('a -> 'b -> bool) -> 'b -> 'a split val exists : 'a array -> ('a -> bool) -> bool -val is_empty : 'a array -> bool - val for_all2_no_exn : 'a array -> 'b array -> ('a -> 'b -> bool) -> bool val for_alli : 'a array -> (int -> 'a -> bool) -> bool diff --git a/compiler/ext/ext_buffer.ml b/compiler/ext/ext_buffer.ml index 88df4bbcde..1bf4f0dcbc 100644 --- a/compiler/ext/ext_buffer.ml +++ b/compiler/ext/ext_buffer.ml @@ -41,8 +41,6 @@ let length b = b.position let is_empty b = b.position = 0 -let clear b = b.position <- 0 - (* let reset b = b.position <- 0; b.buffer <- b.initial_buffer; b.length <- Bytes.length b.buffer *) diff --git a/compiler/ext/ext_buffer.mli b/compiler/ext/ext_buffer.mli index 0271495642..262b803cac 100644 --- a/compiler/ext/ext_buffer.mli +++ b/compiler/ext/ext_buffer.mli @@ -47,9 +47,6 @@ val length : t -> int val is_empty : t -> bool -val clear : t -> unit -(** Empty the buffer. *) - val add_char : t -> char -> unit (** [add_char b c] appends the character [c] at the end of the buffer [b]. *) diff --git a/compiler/ext/ext_char.ml b/compiler/ext/ext_char.ml index 3754665a69..bfb5def4d8 100644 --- a/compiler/ext/ext_char.ml +++ b/compiler/ext/ext_char.ml @@ -22,15 +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. *) -(** {!Char.escaped} is locale sensitive in 4.02.3, fixed in the trunk, - backport it here -*) - -let valid_hex x = - match x with - | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true - | _ -> false - let is_lower_case c = (c >= 'a' && c <= 'z') || (c >= '\224' && c <= '\246') diff --git a/compiler/ext/ext_char.mli b/compiler/ext/ext_char.mli index bf150c840e..330dcee367 100644 --- a/compiler/ext/ext_char.mli +++ b/compiler/ext/ext_char.mli @@ -24,6 +24,4 @@ (** Extension to Standard char module, avoid locale sensitivity *) -val valid_hex : char -> bool - val is_lower_case : char -> bool diff --git a/compiler/ext/ext_fmt.ml b/compiler/ext/ext_fmt.ml index ea59637c49..7658c4dfd3 100644 --- a/compiler/ext/ext_fmt.ml +++ b/compiler/ext/ext_fmt.ml @@ -6,5 +6,3 @@ let with_file_as_pp filename f = v) let failwithf ~loc fmt = Format.ksprintf (fun s -> failwith (loc ^ s)) fmt - -let invalid_argf fmt = Format.ksprintf invalid_arg fmt diff --git a/compiler/ext/ext_list.ml b/compiler/ext/ext_list.ml index 0217ed5c52..8bcd3a85a1 100644 --- a/compiler/ext/ext_list.ml +++ b/compiler/ext/ext_list.ml @@ -93,20 +93,6 @@ let array_list_filter_map arr l f = let len = Array.length arr in arr_list_filter_map_unasfe arr l 0 len [] f -let rec map_split_opt (xs : 'a list) (f : 'a -> 'b option * 'c option) : - 'b list * 'c list = - match xs with - | [] -> ([], []) - | x :: xs -> ( - let c, d = f x in - let cs, ds = map_split_opt xs f in - ( (match c with - | Some c -> c :: cs - | None -> cs), - match d with - | Some d -> d :: ds - | None -> ds )) - let rec map_snd l f = match l with | [] -> [] @@ -296,41 +282,6 @@ let rec fold_right3 l r last acc f = (f a3 b3 c3 (f a4 b4 c4 (fold_right3 arest brest crest acc f))))) | _, _, _ -> invalid_arg "Ext_list.fold_right2" -let rec map2i l r f = - match (l, r) with - | [], [] -> [] - | [a0], [b0] -> [f 0 a0 b0] - | [a0; a1], [b0; b1] -> - let c0 = f 0 a0 b0 in - let c1 = f 1 a1 b1 in - [c0; c1] - | [a0; a1; a2], [b0; b1; b2] -> - let c0 = f 0 a0 b0 in - let c1 = f 1 a1 b1 in - let c2 = f 2 a2 b2 in - [c0; c1; c2] - | [a0; a1; a2; a3], [b0; b1; b2; b3] -> - let c0 = f 0 a0 b0 in - let c1 = f 1 a1 b1 in - let c2 = f 2 a2 b2 in - let c3 = f 3 a3 b3 in - [c0; c1; c2; c3] - | [a0; a1; a2; a3; a4], [b0; b1; b2; b3; b4] -> - let c0 = f 0 a0 b0 in - let c1 = f 1 a1 b1 in - let c2 = f 2 a2 b2 in - let c3 = f 3 a3 b3 in - let c4 = f 4 a4 b4 in - [c0; c1; c2; c3; c4] - | a0 :: a1 :: a2 :: a3 :: a4 :: arest, b0 :: b1 :: b2 :: b3 :: b4 :: brest -> - let c0 = f 0 a0 b0 in - let c1 = f 1 a1 b1 in - let c2 = f 2 a2 b2 in - let c3 = f 3 a3 b3 in - let c4 = f 4 a4 b4 in - c0 :: c1 :: c2 :: c3 :: c4 :: map2i arest brest f - | _, _ -> invalid_arg "Ext_list.map2" - let rec map2 l r f = match (l, r) with | [], [] -> [] @@ -485,15 +436,6 @@ let filter_mapi xs f = in aux 0 xs -let rec filter_map2 xs ys (f : 'a -> 'b -> 'c option) = - match (xs, ys) with - | [], [] -> [] - | u :: us, v :: vs -> ( - match f u v with - | None -> filter_map2 us vs f (* idea: rec f us vs instead? *) - | Some z -> z :: filter_map2 us vs f) - | _ -> invalid_arg "Ext_list.filter_map2" - let rec rev_map_append l1 l2 f = match l1 with | [] -> l2 @@ -558,14 +500,6 @@ and aux eq (x : 'a) (xss : 'a list list) : 'a list list = let stable_group lst eq = group eq lst |> rev -let rec drop h n = - if n < 0 then invalid_arg "Ext_list.drop" - else if n = 0 then h - else - match h with - | [] -> invalid_arg "Ext_list.drop" - | _ :: tl -> drop tl (n - 1) - let rec find_first x p = match x with | [] -> None @@ -648,14 +582,6 @@ let rec find_opt xs p = | Some _ as v -> v | None -> find_opt l p) -let rec find_def xs p def = - match xs with - | [] -> def - | x :: l -> ( - match p x with - | Some v -> v - | None -> find_def l p def) - let rec split_map l f = match l with | [] -> ([], []) @@ -769,11 +695,6 @@ let singleton_exn xs = | [x] -> x | _ -> assert false -let rec mem_string (xs : string list) (x : string) = - match xs with - | [] -> false - | a :: l -> a = x || mem_string l x - let filter lst p = let rec find ~p accu lst = match lst with diff --git a/compiler/ext/ext_list.mli b/compiler/ext/ext_list.mli index 0fe22de37a..22dd15dcdc 100644 --- a/compiler/ext/ext_list.mli +++ b/compiler/ext/ext_list.mli @@ -30,9 +30,6 @@ val combine_array : 'a array -> 'b list -> ('a -> 'c) -> ('c * 'b) list val has_string : string list -> string -> bool -val map_split_opt : - 'a list -> ('a -> 'b option * 'c option) -> 'b list * 'c list - val mapi : 'a list -> (int -> 'a -> 'b) -> 'b list val mapi_append : 'a list -> (int -> 'a -> 'b) -> 'b list -> 'b list @@ -74,8 +71,6 @@ val fold_right3 : val map2 : 'a list -> 'b list -> ('a -> 'b -> 'c) -> 'c list -val map2i : 'a list -> 'b list -> (int -> 'a -> 'b -> 'c) -> 'c list - val fold_left_with_offset : 'a list -> 'acc -> int -> ('a -> 'acc -> int -> 'acc) -> 'acc @@ -110,8 +105,6 @@ val split_at_last : 'a list -> 'a list * 'a val filter_mapi : 'a list -> ('a -> int -> 'b option) -> 'b list -val filter_map2 : 'a list -> 'b list -> ('a -> 'b -> 'c option) -> 'c list - val length_compare : 'a list -> int -> [`Gt | `Eq | `Lt] val length_ge : 'a list -> int -> bool @@ -153,12 +146,6 @@ val stable_group : 'a list -> ('a -> 'a -> bool) -> 'a list list which could be improved later *) -val drop : 'a list -> int -> 'a list -(** [drop n list] - raise when [n] is negative - raise when list's length is less than [n] -*) - val find_first : 'a list -> ('a -> bool) -> 'a option val find_first_not : 'a list -> ('a -> bool) -> 'a option @@ -174,8 +161,6 @@ val find_first_not : 'a list -> ('a -> bool) -> 'a option val find_opt : 'a list -> ('a -> 'b option) -> 'b option -val find_def : 'a list -> ('a -> 'b option) -> 'b -> 'b - val rev_iter : 'a list -> ('a -> unit) -> unit val iter : 'a list -> ('a -> unit) -> unit @@ -226,8 +211,6 @@ val fold_left : 'a list -> 'b -> ('b -> 'a -> 'b) -> 'b val singleton_exn : 'a list -> 'a -val mem_string : string list -> string -> bool - val filter : 'a list -> ('a -> bool) -> 'a list val array_list_filter_map : diff --git a/compiler/ext/ext_obj.ml b/compiler/ext/ext_obj.ml index ae11db924b..d085671c84 100644 --- a/compiler/ext/ext_obj.ml +++ b/compiler/ext/ext_obj.ml @@ -99,22 +99,3 @@ let rec dump r = | _ -> opaque (Printf.sprintf "unknown: tag %d size %d" t s) let dump v = dump (Obj.repr v) - -let bt () = - let raw_bt = Printexc.backtrace_slots (Printexc.get_raw_backtrace ()) in - match raw_bt with - | None -> () - | Some raw_bt -> - let acc = ref [] in - for i = Array.length raw_bt - 1 downto 0 do - let slot = raw_bt.(i) in - match Printexc.Slot.location slot with - | None -> () - | Some bt -> ( - match !acc with - | [] -> acc := [bt] - | hd :: _ -> if hd <> bt then acc := bt :: !acc) - done; - Ext_list.iter !acc (fun bt -> - Printf.eprintf "File \"%s\", line %d, characters %d-%d\n" bt.filename - bt.line_number bt.start_char bt.end_char) diff --git a/compiler/ext/ext_obj.mli b/compiler/ext/ext_obj.mli index 3dc59084e8..5ec3864c07 100644 --- a/compiler/ext/ext_obj.mli +++ b/compiler/ext/ext_obj.mli @@ -22,5 +22,3 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) val dump : 'a -> string - -val bt : unit -> unit diff --git a/compiler/ext/ext_pp_scope.ml b/compiler/ext/ext_pp_scope.ml index f074a411f0..317d38afb3 100644 --- a/compiler/ext/ext_pp_scope.ml +++ b/compiler/ext/ext_pp_scope.ml @@ -29,15 +29,6 @@ type t = int Map_int.t Map_string.t *) let empty : t = Map_string.empty -let rec print fmt v = - Format.fprintf fmt "@[{"; - Map_string.iter v (fun k m -> - Format.fprintf fmt "%s: @[%a@],@ " k print_int_map m); - Format.fprintf fmt "}@]" - -and print_int_map fmt m = - Map_int.iter m (fun k v -> Format.fprintf fmt "%d - %d" k v) - let add_ident ~mangled:name (stamp : int) (cxt : t) : int * t = match Map_string.find_opt cxt name with | None -> (0, Map_string.add cxt name (Map_int.add Map_int.empty stamp 0)) diff --git a/compiler/ext/ext_pp_scope.mli b/compiler/ext/ext_pp_scope.mli index 460a0354d3..2eae91087f 100644 --- a/compiler/ext/ext_pp_scope.mli +++ b/compiler/ext/ext_pp_scope.mli @@ -33,8 +33,6 @@ type t val empty : t -val print : Format.formatter -> t -> unit - val sub_scope : t -> Set_ident.t -> t val merge : t -> Set_ident.t -> t diff --git a/compiler/ext/ext_string.ml b/compiler/ext/ext_string.ml index 4c62d2e8bf..e5b338ffa4 100644 --- a/compiler/ext/ext_string.ml +++ b/compiler/ext/ext_string.ml @@ -132,14 +132,6 @@ let for_all s (p : char -> bool) = let is_empty s = String.length s = 0 -let repeat n s = - let len = String.length s in - let res = Bytes.create (n * len) in - for i = 0 to pred n do - String.blit s 0 res (i * len) len - done; - Bytes.to_string res - let unsafe_is_sub ~sub i s j ~len = let rec check k = if k = len then true @@ -242,15 +234,8 @@ let rec rindex_rec s i c = else if String.unsafe_get s i = c then i else rindex_rec s (i - 1) c -let rec rindex_rec_opt s i c = - if i < 0 then None - else if String.unsafe_get s i = c then Some i - else rindex_rec_opt s (i - 1) c - let rindex_neg s c = rindex_rec s (String.length s - 1) c -let rindex_opt s c = rindex_rec_opt s (String.length s - 1) c - (** TODO: can be improved to return a positive integer instead *) let rec unsafe_no_char x ch i last_idx = i > last_idx @@ -408,15 +393,8 @@ let capitalize_sub (s : string) len : string = let uncapitalize_ascii = String.uncapitalize_ascii -let lowercase_ascii = String.lowercase_ascii - external ( .![] ) : string -> int -> int = "%string_unsafe_get" -let unsafe_sub x offs len = - let b = Bytes.create len in - Ext_bytes.unsafe_blit_string x offs b 0 len; - Bytes.unsafe_to_string b - let is_valid_hash_number (x : string) = let len = String.length x in len > 0 diff --git a/compiler/ext/ext_string.mli b/compiler/ext/ext_string.mli index 4c568ac100..9be85fea1a 100644 --- a/compiler/ext/ext_string.mli +++ b/compiler/ext/ext_string.mli @@ -66,8 +66,6 @@ val for_all : string -> (char -> bool) -> bool val is_empty : string -> bool -val repeat : int -> string -> string - val equal : string -> string -> bool (** @@ -112,8 +110,6 @@ val tail_from : string -> int -> string val rindex_neg : string -> char -> int (** returns negative number if not found *) -val rindex_opt : string -> char -> int option - val no_slash : string -> bool val no_slash_idx : string -> int @@ -148,10 +144,6 @@ val capitalize_sub : string -> int -> string val uncapitalize_ascii : string -> string -val lowercase_ascii : string -> string - -val unsafe_sub : string -> int -> int -> string - val is_valid_hash_number : string -> bool val hash_number_as_i32_exn : string -> int32 diff --git a/compiler/ext/hash_set_poly.ml b/compiler/ext/hash_set_poly.ml index 441cc88056..6787146e6f 100644 --- a/compiler/ext/hash_set_poly.ml +++ b/compiler/ext/hash_set_poly.ml @@ -27,15 +27,11 @@ let eq_key = ( = ) type 'a t = 'a Hash_set_gen.t let create = Hash_set_gen.create -let clear = Hash_set_gen.clear -let reset = Hash_set_gen.reset (* let copy = Hash_set_gen.copy *) -let iter = Hash_set_gen.iter let length = Hash_set_gen.length (* let stats = Hash_set_gen.stats *) -let to_list = Hash_set_gen.to_list let remove (h : _ Hash_set_gen.t) key = let i = key_index h key in diff --git a/compiler/ext/hash_set_poly.mli b/compiler/ext/hash_set_poly.mli index 1539d3f7bf..050b3bac37 100644 --- a/compiler/ext/hash_set_poly.mli +++ b/compiler/ext/hash_set_poly.mli @@ -26,10 +26,6 @@ type 'a t val create : int -> 'a t -val clear : 'a t -> unit - -val reset : 'a t -> unit - (* val copy : 'a t -> 'a t *) val add : 'a t -> 'a -> unit @@ -38,10 +34,6 @@ val remove : 'a t -> 'a -> unit val mem : 'a t -> 'a -> bool -val iter : 'a t -> ('a -> unit) -> unit - -val to_list : 'a t -> 'a list - val length : 'a t -> int (* val stats: 'a t -> Hashtbl.statistics *) From f4fd6f00c57591a2d7cc71a36887a7e73cff6e41 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 2 Oct 2026 06:56:51 +0200 Subject: [PATCH 03/32] Remove unused functions from Misc Misc.map_left_right, list_remove, log2, chop_extensions and Int_literal_converter.int32/int64 had no caller, qualified or through `open Misc`; typecore.ml uses only Int_literal_converter.int. Signed-off-by: Cristiano Calcagno Co-Authored-By: Claude Opus 5.5 --- compiler/ext/misc.ml | 26 -------------------------- compiler/ext/misc.mli | 20 -------------------- 2 files changed, 46 deletions(-) diff --git a/compiler/ext/misc.ml b/compiler/ext/misc.ml index ce5dcc1207..f483eb4fbe 100644 --- a/compiler/ext/misc.ml +++ b/compiler/ext/misc.ml @@ -54,12 +54,6 @@ let rec map_end f l1 l2 = | [] -> l2 | hd :: tl -> f hd :: map_end f tl l2 -let rec map_left_right f = function - | [] -> [] - | hd :: tl -> - let res = f hd in - res :: map_left_right f tl - let rec for_all2 pred l1 l2 = match (l1, l2) with | [], [] -> true @@ -69,10 +63,6 @@ let rec for_all2 pred l1 l2 = let rec replicate_list elem n = if n <= 0 then [] else elem :: replicate_list elem (n - 1) -let rec list_remove x = function - | [] -> [] - | hd :: tl -> if hd = x then tl else hd :: list_remove x tl - let rec split_last = function | [] -> assert false | [x] -> ([], x) @@ -162,30 +152,14 @@ let output_to_file_via_temporary ?(mode = [Open_text]) filename fn = (* Integer operations *) -let rec log2 n = if n <= 1 then 0 else 1 + log2 (n asr 1) - module Int_literal_converter = struct (* To convert integer literals, allowing max_int + 1 (PR#4210) *) let cvt_int_aux str neg of_string = if String.length str = 0 || str.[0] = '-' then of_string str else neg (of_string ("-" ^ str)) let int s = cvt_int_aux s ( ~- ) int_of_string - let int32 s = cvt_int_aux s Int32.neg Int32.of_string - let int64 s = cvt_int_aux s Int64.neg Int64.of_string end -(* String operations *) - -let chop_extensions file = - let dirname = Filename.dirname file and basename = Filename.basename file in - try - let pos = String.index basename '.' in - let basename = String.sub basename 0 pos in - if Filename.is_implicit file && dirname = Filename.current_dir_name then - basename - else Filename.concat dirname basename - with Not_found -> file - let get_ref r = let v = !r in r := []; diff --git a/compiler/ext/misc.mli b/compiler/ext/misc.mli index b054fb380d..33dcd1bb1d 100644 --- a/compiler/ext/misc.mli +++ b/compiler/ext/misc.mli @@ -23,9 +23,6 @@ val try_finally : (unit -> 'a) -> (unit -> unit) -> 'a val map_end : ('a -> 'b) -> 'a list -> 'b list -> 'b list (* [map_end f l t] is [map f l @ t], just more efficient. *) -val map_left_right : ('a -> 'b) -> 'a list -> 'b list -(* Like [List.map], with guaranteed left-to-right evaluation order *) - val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool (* Same as [List.for_all] but for a binary predicate. In addition, this [for_all2] never fails: given two lists @@ -35,10 +32,6 @@ val replicate_list : 'a -> int -> 'a list (* [replicate_list elem n] is the list with [n] elements all identical to [elem]. *) -val list_remove : 'a -> 'a list -> 'a list -(* [list_remove x l] returns a copy of [l] with the first - element equal to [x] removed. *) - val split_last : 'a list -> 'a list * 'a (* Return the last element and the other elements of the given list. *) @@ -79,23 +72,10 @@ val output_to_file_via_temporary : the channel is closed and the temporary file is renamed to [filename]. *) -val log2 : int -> int -(* [log2 n] returns [s] such that [n = 1 lsl s] - if [n] is a power of 2*) - module Int_literal_converter : sig val int : string -> int - val int32 : string -> int32 - val int64 : string -> int64 end -val chop_extensions : string -> string -(* Return the given file name without its extensions. The extensions - is the longest suffix starting with a period and not including - a directory separator, [.xyz.uvw] for instance. - - Return the given name if it does not contain an extension. *) - 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. *) From e169ec177c4315061049deb225946d6e4968b2ce Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 2 Oct 2026 06:56:51 +0200 Subject: [PATCH 04/32] Remove unused members of Identifiable Ident is the only Identifiable.Make instance, and nothing uses its Map.disjoint_union, union_right, union_left, union_merge, map_keys, of_set, transpose_keys_and_data(_set) or Tbl.memoize; nothing applies the Pair functor. Signed-off-by: Cristiano Calcagno Co-Authored-By: Claude Opus 5.5 --- compiler/ext/identifiable.ml | 91 ----------------------------------- compiler/ext/identifiable.mli | 25 ---------- 2 files changed, 116 deletions(-) diff --git a/compiler/ext/identifiable.ml b/compiler/ext/identifiable.ml index bd6133c87e..807519ccb8 100644 --- a/compiler/ext/identifiable.ml +++ b/compiler/ext/identifiable.ml @@ -42,25 +42,9 @@ module type Map = sig val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t val of_list : (key * 'a) list -> 'a t - val disjoint_union : - ?eq:('a -> 'a -> bool) -> - ?print:(Format.formatter -> 'a -> unit) -> - 'a t -> - 'a t -> - 'a t - - val union_right : 'a t -> 'a t -> 'a t - - val union_left : 'a t -> 'a t -> 'a t - - val union_merge : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t val rename : key t -> key -> key - val map_keys : (key -> key) -> 'a t -> 'a t val keys : 'a t -> Set.Make(T).t val data : 'a t -> 'a list - val of_set : (key -> 'a) -> Set.Make(T).t -> 'a t - val transpose_keys_and_data : key t -> key t - val transpose_keys_and_data_set : key t -> Set.Make(T).t t val print : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit end @@ -78,23 +62,9 @@ module type Tbl = sig val to_map : 'a t -> 'a Map.Make(T).t val of_map : 'a Map.Make(T).t -> 'a t - val memoize : 'a t -> (key -> 'a) -> key -> 'a val map : 'a t -> ('a -> 'b) -> 'b t end -module Pair (A : Thing) (B : Thing) : Thing with type t = A.t * B.t = struct - type t = A.t * B.t - - let compare (a1, b1) (a2, b2) = - let c = A.compare a1 a2 in - if c <> 0 then c else B.compare b1 b2 - - let output oc (a, b) = Printf.fprintf oc " (%a, %a)" A.output a B.output b - let hash (a, b) = Hashtbl.hash (A.hash a, B.hash b) - let equal (a1, b1) (a2, b2) = A.equal a1 a2 && B.equal b1 b2 - let print ppf (a, b) = Format.fprintf ppf " (%a, @ %a)" A.print a B.print b -end - module Make_map (T : Thing) = struct include Map.Make (T) @@ -108,48 +78,8 @@ module Make_map (T : Thing) = struct let of_list l = List.fold_left (fun map (id, v) -> add id v map) empty l - let disjoint_union ?eq ?print m1 m2 = - union - (fun id v1 v2 -> - let ok = - match eq with - | None -> false - | Some eq -> eq v1 v2 - in - if not ok then - let err = - match print with - | None -> Format.asprintf "Map.disjoint_union %a" T.print id - | Some print -> - Format.asprintf "Map.disjoint_union %a => %a <> %a" T.print id - print v1 print v2 - in - Misc.fatal_error err - else Some v1) - m1 m2 - - let union_right m1 m2 = - merge - (fun _id x y -> - match (x, y) with - | None, None -> None - | None, Some v | Some v, None | Some _, Some v -> Some v) - m1 m2 - - let union_left m1 m2 = union_right m2 m1 - - let union_merge f m1 m2 = - let aux _ m1 m2 = - match (m1, m2) with - | None, m | m, None -> m - | Some m1, Some m2 -> Some (f m1 m2) - in - merge aux m1 m2 - let rename m v = try find v m with Not_found -> v - let map_keys f m = of_list (List.map (fun (k, v) -> (f k, v)) (bindings m)) - let print f ppf s = let elts ppf s = iter (fun id v -> Format.fprintf ppf "@ (@[%a@ %a@])" T.print id f v) s @@ -161,20 +91,6 @@ module Make_map (T : Thing) = struct let keys map = fold (fun k _ set -> T_set.add k set) map T_set.empty let data t = List.map snd (bindings t) - - let of_set f set = T_set.fold (fun e map -> add e (f e) map) set empty - - let transpose_keys_and_data map = fold (fun k v m -> add v k m) map empty - let transpose_keys_and_data_set map = - fold - (fun k v m -> - let set = - match find v m with - | exception Not_found -> T_set.singleton k - | set -> T_set.add k set - in - add v set m) - map empty end module Make_set (T : Thing) = struct @@ -219,13 +135,6 @@ module Make_tbl (T : Thing) = struct T_map.iter (fun k v -> add t k v) m; t - let memoize t f key = - try find t key - with Not_found -> - let r = f key in - add t key r; - r - let map t f = of_map (T_map.map f (to_map t)) end diff --git a/compiler/ext/identifiable.mli b/compiler/ext/identifiable.mli index 9dd8defd9e..55ccbc7b3e 100644 --- a/compiler/ext/identifiable.mli +++ b/compiler/ext/identifiable.mli @@ -26,8 +26,6 @@ module type Thing = sig val print : Format.formatter -> t -> unit end -module Pair : functor (A : Thing) (B : Thing) -> Thing with type t = A.t * B.t - module type Set = sig module T : Set.OrderedType include Set.S with type elt = T.t and type t = Set.Make(T).t @@ -46,31 +44,9 @@ module type Map = sig val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t val of_list : (key * 'a) list -> 'a t - val disjoint_union : - ?eq:('a -> 'a -> bool) -> - ?print:(Format.formatter -> 'a -> unit) -> - 'a t -> - 'a t -> - 'a t - (** [disjoint_union m1 m2] contains all bindings from [m1] and - [m2]. If some binding is present in both and the associated - value is not equal, a Fatal_error is raised *) - - val union_right : 'a t -> 'a t -> 'a t - (** [union_right m1 m2] contains all bindings from [m1] and [m2]. If - some binding is present in both, the one from [m2] is taken *) - - val union_left : 'a t -> 'a t -> 'a t - (** [union_left m1 m2 = union_right m2 m1] *) - - val union_merge : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t val rename : key t -> key -> key - val map_keys : (key -> key) -> 'a t -> 'a t val keys : 'a t -> Set.Make(T).t val data : 'a t -> 'a list - val of_set : (key -> 'a) -> Set.Make(T).t -> 'a t - val transpose_keys_and_data : key t -> key t - val transpose_keys_and_data_set : key t -> Set.Make(T).t t val print : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit end @@ -88,7 +64,6 @@ module type Tbl = sig val to_map : 'a t -> 'a Map.Make(T).t val of_map : 'a Map.Make(T).t -> 'a t - val memoize : 'a t -> (key -> 'a) -> key -> 'a val map : 'a t -> ('a -> 'b) -> 'b t end From eca881b2e744b143b7dc68911191f2ba7062f720 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 2 Oct 2026 06:56:52 +0200 Subject: [PATCH 05/32] Remove unused operations from Ordered_hash_map Ordered_hash_map_local_ident, the only instance, is used through create, add, rank, find_value, iter, length and to_sorted_array (lambda_scc.ml and the ounit hashtbl suite). The clear, reset, mem, fold, elements and choose members of Ordered_hash_map_gen.S had no caller; with them go the gen-level clear, reset, fold, elements, the unused bucket_length and the initial_size field that only reset read. Signed-off-by: Cristiano Calcagno Co-Authored-By: Claude Opus 5.5 --- compiler/ext/ordered_hash_map.ml | 7 ---- compiler/ext/ordered_hash_map_gen.ml | 49 ++-------------------------- 2 files changed, 2 insertions(+), 54 deletions(-) diff --git a/compiler/ext/ordered_hash_map.ml b/compiler/ext/ordered_hash_map.ml index 9b7440447b..8a053ddb31 100644 --- a/compiler/ext/ordered_hash_map.ml +++ b/compiler/ext/ordered_hash_map.ml @@ -32,15 +32,10 @@ module Make (H : Hashtbl.HashedType) : open Ordered_hash_map_gen let create = create - let clear = clear - let reset = reset let iter = iter - let fold = fold let length = length - let elements = elements - let choose = choose let to_sorted_array = to_sorted_array let rec small_bucket_mem key lst = @@ -99,8 +94,6 @@ module Make (H : Hashtbl.HashedType) : h.size <- h.size + 1; if h.size > Array.length h.data lsl 1 then resize key_index h) - let mem h key = - small_bucket_mem key (Array.unsafe_get h.data (key_index h key)) let rank h key = small_bucket_rank key (Array.unsafe_get h.data (key_index h key)) diff --git a/compiler/ext/ordered_hash_map_gen.ml b/compiler/ext/ordered_hash_map_gen.ml index b85ce6e96b..4ae5d30506 100644 --- a/compiler/ext/ordered_hash_map_gen.ml +++ b/compiler/ext/ordered_hash_map_gen.ml @@ -33,28 +33,16 @@ module type S = sig val create : int -> 'value t - val clear : 'vaulue t -> unit - - val reset : 'value t -> unit - val add : 'value t -> key -> 'value -> unit - val mem : 'value t -> key -> bool - val rank : 'value t -> key -> int (* -1 if not found*) val find_value : 'value t -> key -> 'value (* raise if not found*) val iter : 'value t -> (key -> 'value -> int -> unit) -> unit - val fold : 'value t -> 'b -> (key -> 'value -> int -> 'b -> 'b) -> 'b - val length : 'value t -> int - val elements : 'value t -> key list - - val choose : 'value t -> key - val to_sorted_array : 'value t -> key array end @@ -67,25 +55,12 @@ type ('a, 'b) bucket = type ('a, 'b) t = { mutable size: int; (* number of entries *) - mutable data: ('a, 'b) bucket array; - (* the buckets *) - initial_size: int; (* initial array size *) + mutable data: ('a, 'b) bucket array; (* the buckets *) } let create initial_size = let s = Ext_util.power_2_above 16 initial_size in - {initial_size = s; size = 0; data = Array.make s Empty} - -let clear h = - h.size <- 0; - let len = Array.length h.data in - for i = 0 to len - 1 do - Array.unsafe_set h.data i Empty - done - -let reset h = - h.size <- 0; - h.data <- Array.make h.initial_size Empty + {size = 0; data = Array.make s Empty} let length h = h.size @@ -138,23 +113,3 @@ let to_sorted_array h = let arr = Array.make h.size v in iter h (fun k _ i -> Array.unsafe_set arr i k); arr - -let fold h init f = - let rec do_bucket b accu = - match b with - | Empty -> accu - | Cons {key; ord; data; next} -> do_bucket next (f key data ord accu) - in - let d = h.data in - let accu = ref init in - for i = 0 to Array.length d - 1 do - accu := do_bucket (Array.unsafe_get d i) !accu - done; - !accu - -let elements set = fold set [] (fun k _ _ acc -> k :: acc) - -let rec bucket_length acc (x : _ bucket) = - match x with - | Empty -> 0 - | Cons rhs -> bucket_length (acc + 1) rhs.next From 74cf1a24011857eea7dad677d60843a872ec4221 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 2 Oct 2026 06:56:52 +0200 Subject: [PATCH 06/32] Remove unused operations from the ext map and set functors No instance of Map_gen.S (Map_int, Map_string, Map_ident, and Handler_map in core) is used through remove or add_list, and nothing calls Map_gen.concat; Map_gen.merge and its min-binding helpers served only remove. No instance of Set_gen.S (Set_int, Set_string, Set_ident) is used through print, so the functor's element print requirement goes too, and nothing calls Set_gen.partition. Signed-off-by: Cristiano Calcagno Co-Authored-By: Claude Opus 5.5 --- compiler/ext/ext_map.ml | 15 +------------- compiler/ext/ext_set.ml | 8 -------- compiler/ext/ext_set.mli | 1 - compiler/ext/map_gen.ml | 40 -------------------------------------- compiler/ext/map_gen.mli | 8 -------- compiler/ext/set_gen.ml | 16 --------------- compiler/ext/set_gen.mli | 4 ---- compiler/ext/set_ident.ml | 1 - compiler/ext/set_int.ml | 1 - compiler/ext/set_string.ml | 1 - 10 files changed, 1 insertion(+), 94 deletions(-) diff --git a/compiler/ext/ext_map.ml b/compiler/ext/ext_map.ml index 9bb91449a8..b513cc4045 100644 --- a/compiler/ext/ext_map.ml +++ b/compiler/ext/ext_map.ml @@ -118,16 +118,6 @@ module Make (Key : OrderedType) = struct let c = compare_key x k in c = 0 || mem (if c < 0 then l else r) x - let rec remove (tree : _ Map_gen.t as 'a) x : 'a = - match tree with - | Empty -> empty - | Leaf leaf -> if eq_key x leaf.k then empty else tree - | Node {l; k; v; r} -> - let c = compare_key x k in - if c = 0 then Map_gen.merge l r - else if c < 0 then bal (remove l x) k v r - else bal l k v (remove r x) - type 'a split = | Yes of {l: (key, 'a) Map_gen.t; r: (key, 'a) Map_gen.t; v: 'a} | No of {l: (key, 'a) Map_gen.t; r: (key, 'a) Map_gen.t} @@ -192,10 +182,7 @@ module Make (Key : OrderedType) = struct (disjoint_merge_exn r s2.r fail) | Yes {v = s1v} -> raise_notrace (fail k s1v s2.v))) - let add_list (xs : _ list) init = - Ext_list.fold_left xs init (fun acc (k, v) -> add acc k v) - - let of_list xs = add_list xs empty + let of_list xs = Ext_list.fold_left xs empty (fun acc (k, v) -> add acc k v) let of_array xs = Ext_array.fold_left xs empty (fun acc (k, v) -> add acc k v) end diff --git a/compiler/ext/ext_set.ml b/compiler/ext/ext_set.ml index f1b70d62e9..f94d28cd29 100644 --- a/compiler/ext/ext_set.ml +++ b/compiler/ext/ext_set.ml @@ -27,7 +27,6 @@ module type OrderedType = sig val compare : t -> t -> int val equal : t -> t -> bool - val print : Format.formatter -> t -> unit end module Make (Elt : OrderedType) = struct @@ -35,7 +34,6 @@ module Make (Elt : OrderedType) = struct let compare_elt = Elt.compare let eq_elt = Elt.equal - let print_elt = Elt.print type 'a t0 = 'a Set_gen.t @@ -198,10 +196,4 @@ module Make (Elt : OrderedType) = struct let invariant t = Set_gen.check t; Set_gen.is_ordered ~cmp:compare_elt t - - let print fmt s = - Format.fprintf fmt "@[{%a}@]@." - (fun fmt s -> - iter s (fun e -> Format.fprintf fmt "@[%a@],@ " print_elt e)) - s end diff --git a/compiler/ext/ext_set.mli b/compiler/ext/ext_set.mli index eca44b0e70..fcb00c6d4f 100644 --- a/compiler/ext/ext_set.mli +++ b/compiler/ext/ext_set.mli @@ -27,7 +27,6 @@ module type OrderedType = sig val compare : t -> t -> int val equal : t -> t -> bool - val print : Format.formatter -> t -> unit end module Make (Elt : OrderedType) : Set_gen.S with type elt = Elt.t diff --git a/compiler/ext/map_gen.ml b/compiler/ext/map_gen.ml index 8e4597a922..a8c73b7290 100644 --- a/compiler/ext/map_gen.ml +++ b/compiler/ext/map_gen.ml @@ -184,28 +184,6 @@ let[@inline] is_empty = function | Empty -> true | _ -> false -let rec min_binding_exn = function - | Empty -> raise Not_found - | Leaf {k; v} -> (k, v) - | Node {l; k; v} -> ( - match l with - | Empty -> (k, v) - | Leaf _ | Node _ -> min_binding_exn l) - -let rec remove_min_binding = function - | Empty -> invalid_arg "Map.remove_min_elt" - | Leaf _ -> empty - | Node {l = Empty; r} -> r - | Node {l; k; v; r} -> bal (remove_min_binding l) k v r - -let merge t1 t2 = - match (t1, t2) with - | Empty, t -> t - | t, Empty -> t - | _, _ -> - let x, d = min_binding_exn t2 in - bal t1 x d (remove_min_binding t2) - let rec iter x f = match x with | Empty -> () @@ -269,18 +247,6 @@ let rec join l v d r = else if rh > lh + 2 then bal (join l v d xr.l) xr.k xr.v xr.r else unsafe_node v d l r (calc_height lh rh)) -(* Merge two trees l and r into one. - All elements of l must precede the elements of r. - No assumption on the heights of l and r. *) - -let concat t1 t2 = - match (t1, t2) with - | Empty, t -> t - | t, Empty -> t - | _, _ -> - let x, d = min_binding_exn t2 in - join t1 x d (remove_min_binding t2) - module type S = sig type key @@ -309,10 +275,6 @@ module type S = sig val singleton : key -> 'a -> 'a t - val remove : 'a t -> key -> 'a t - (** [remove x m] returns a map containing the same bindings as - [m], except for [x] which is unbound in the returned map. *) - (* val merge: 'a t -> 'b t -> (key -> 'a option -> 'b option -> 'c option) -> 'c t *) @@ -402,6 +364,4 @@ module type S = sig val of_list : (key * 'a) list -> 'a t val of_array : (key * 'a) array -> 'a t - - val add_list : (key * 'b) list -> 'b t -> 'b t end diff --git a/compiler/ext/map_gen.mli b/compiler/ext/map_gen.mli index dbed5417c0..1254748890 100644 --- a/compiler/ext/map_gen.mli +++ b/compiler/ext/map_gen.mli @@ -32,8 +32,6 @@ val empty : ('a, 'b) t val is_empty : ('a, 'b) t -> bool -val merge : ('a, 'b) t -> ('a, 'b) t -> ('a, 'b) t - val iter : ('a, 'b) t -> ('a -> 'b -> unit) -> unit val map : ('a, 'b) t -> ('b -> 'c) -> ('a, 'c) t @@ -48,8 +46,6 @@ val exists : ('a, 'b) t -> ('a -> 'b -> bool) -> bool val join : ('a, 'b) t -> 'a -> 'b -> ('a, 'b) t -> ('a, 'b) t -val concat : ('a, 'b) t -> ('a, 'b) t -> ('a, 'b) t - module type S = sig type key @@ -73,8 +69,6 @@ module type S = sig val singleton : key -> 'a -> 'a t - val remove : 'a t -> key -> 'a t - (* val merge : 'a t -> 'b t -> (key -> 'a option -> 'b option -> 'c option) -> 'c t *) val disjoint_merge_exn : 'a t -> 'a t -> (key -> 'a -> 'a -> exn) -> 'a t @@ -109,6 +103,4 @@ module type S = sig val of_list : (key * 'a) list -> 'a t val of_array : (key * 'a) array -> 'a t - - val add_list : (key * 'b) list -> 'b t -> 'b t end diff --git a/compiler/ext/set_gen.ml b/compiler/ext/set_gen.ml index 0fd5e66f41..29897dcae9 100644 --- a/compiler/ext/set_gen.ml +++ b/compiler/ext/set_gen.ml @@ -250,20 +250,6 @@ let internal_concat t1 t2 = | t, Empty -> t | _, _ -> internal_join t1 (min_exn t2) (remove_min_elt t2) -let rec partition x p = - match x with - | Empty -> (empty, empty) - | Leaf v -> - let pv = p v in - if pv then (x, empty) else (empty, x) - | Node {l; v; r} -> - (* call [p] in the expected left-to-right order *) - let lt, lf = partition l p in - let pv = p v in - let rt, rf = partition r p in - if pv then (internal_join lt v rt, internal_concat lf rf) - else (internal_concat lt rt, internal_join lf v rf) - let of_sorted_array l = let rec sub start n l = if n = 0 then empty @@ -357,6 +343,4 @@ module type S = sig val of_sorted_array : elt array -> t val invariant : t -> bool - - val print : Format.formatter -> t -> unit end diff --git a/compiler/ext/set_gen.mli b/compiler/ext/set_gen.mli index f3f39f0191..b0b542e167 100644 --- a/compiler/ext/set_gen.mli +++ b/compiler/ext/set_gen.mli @@ -37,8 +37,6 @@ val internal_join : 'a t -> 'a -> 'a t -> 'a t val internal_concat : 'a t -> 'a t -> 'a t -val partition : 'a t -> ('a -> bool) -> 'a t * 'a t - val of_sorted_array : 'a array -> 'a t val is_ordered : cmp:('a -> 'a -> int) -> 'a t -> bool @@ -87,6 +85,4 @@ module type S = sig val of_sorted_array : elt array -> t val invariant : t -> bool - - val print : Format.formatter -> t -> unit end diff --git a/compiler/ext/set_ident.ml b/compiler/ext/set_ident.ml index bf75cd3be4..483e0ab6bc 100644 --- a/compiler/ext/set_ident.ml +++ b/compiler/ext/set_ident.ml @@ -33,5 +33,4 @@ include Ext_set.Make (struct if name <> 0 then name else Stdlib.compare x.flags y.flags let equal = Ident.same - let print = Ident.print end) diff --git a/compiler/ext/set_int.ml b/compiler/ext/set_int.ml index bd10d7c6b8..91505b5c32 100644 --- a/compiler/ext/set_int.ml +++ b/compiler/ext/set_int.ml @@ -27,5 +27,4 @@ include Ext_set.Make (struct let compare = Ext_int.compare let equal = Ext_int.equal - let print = Format.pp_print_int end) diff --git a/compiler/ext/set_string.ml b/compiler/ext/set_string.ml index be1d2d1fb3..ef7f66fcbf 100644 --- a/compiler/ext/set_string.ml +++ b/compiler/ext/set_string.ml @@ -27,5 +27,4 @@ include Ext_set.Make (struct let compare = Ext_string.compare let equal = Ext_string.equal - let print = Format.pp_print_string end) From 15f53925bd6cf23b68da0297a8c3000798d524dc Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 2 Oct 2026 06:56:53 +0200 Subject: [PATCH 07/32] Fix the cmt_magic_number comment in Config config.mli described cmt_magic_number with the comment copied from cmi_magic_number ("compiled interface files"); the value ("Caml1999T039") heads the typed-tree files that Cmt_format.save_cmt writes (.cmt, .cmti). Signed-off-by: Cristiano Calcagno Co-Authored-By: Claude Opus 5.5 --- compiler/ext/config.mli | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/ext/config.mli b/compiler/ext/config.mli index e96ab299ff..46c246d4f0 100644 --- a/compiler/ext/config.mli +++ b/compiler/ext/config.mli @@ -38,4 +38,4 @@ val ast0_impl_magic_number : string tree, as used on the external-PPX wire *) val cmt_magic_number : string -(* Magic number for compiled interface files *) +(* Magic number for typed-tree files (.cmt, .cmti) *) From 01908526950f1e113faedbdc13ca7c9f20b96ace Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 2 Oct 2026 06:56:53 +0200 Subject: [PATCH 08/32] Remove the unused Bs_loc.merge Nothing calls Bs_loc.merge; its private helper is_ghost and the commented-out none/is_ghost declarations go with it. The frontend uses only the Bs_loc.t alias. bs_loc.mli stays: the common library enables warning 70 (missing interface). Signed-off-by: Cristiano Calcagno Co-Authored-By: Claude Opus 5.5 --- compiler/common/bs_loc.ml | 12 ------------ compiler/common/bs_loc.mli | 4 ---- 2 files changed, 16 deletions(-) diff --git a/compiler/common/bs_loc.ml b/compiler/common/bs_loc.ml index ff7df2bf54..8d84ebebe4 100644 --- a/compiler/common/bs_loc.ml +++ b/compiler/common/bs_loc.ml @@ -27,15 +27,3 @@ type t = Location.t = { loc_end: Lexing.position; loc_ghost: bool; } - -let is_ghost x = x.loc_ghost - -let merge (l : t) (r : t) = - if is_ghost l then r - else if is_ghost r then l - else - match (l, r) with - | {loc_start; _}, {loc_end; _} (* TODO: improve*) -> - {loc_start; loc_end; loc_ghost = false} - -(* let none = Location.none *) diff --git a/compiler/common/bs_loc.mli b/compiler/common/bs_loc.mli index de22c2d980..8d84ebebe4 100644 --- a/compiler/common/bs_loc.mli +++ b/compiler/common/bs_loc.mli @@ -27,7 +27,3 @@ type t = Location.t = { loc_end: Lexing.position; loc_ghost: bool; } - -(* val is_ghost : t -> bool *) -val merge : t -> t -> t -(* val none : t *) From 82376d05fae676e0b811632bdfb2a06c374c988b Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 2 Oct 2026 06:56:53 +0200 Subject: [PATCH 09/32] Fix stale comments in the common library Js_config documented a browser flag it does not define and kept commented-out declarations of package-info accessors that no longer exist; Ext_log's example called an `err` function the module does not export (it exports dwarn); Ml_binary's header described Reason AST reading instead of the Parsetree/Parsetree0 conversion it provides. Signed-off-by: Cristiano Calcagno Co-Authored-By: Claude Opus 5.5 --- compiler/common/ext_log.mli | 5 +++-- compiler/common/js_config.ml | 6 ------ compiler/common/js_config.mli | 14 -------------- compiler/common/ml_binary.mli | 5 ++--- 4 files changed, 5 insertions(+), 25 deletions(-) diff --git a/compiler/common/ext_log.mli b/compiler/common/ext_log.mli index 8881c965b0..74985067f6 100644 --- a/compiler/common/ext_log.mli +++ b/compiler/common/ext_log.mli @@ -25,9 +25,10 @@ (** A Poor man's logging utility Example: - {[ - err __LOC__ "xx" + {[ + dwarn ~__POS__ "unexpected %s" name ]} + prints a warning to stderr when [-debug-ir] is set. *) type 'a logging = ('a, Format.formatter, unit, unit, unit, unit) format6 -> 'a diff --git a/compiler/common/js_config.ml b/compiler/common/js_config.ml index 93df8b3cde..501ca35405 100644 --- a/compiler/common/js_config.ml +++ b/compiler/common/js_config.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. *) -(** Browser is not set via command line only for internal use *) - type jsx_version = Jsx_v4 type jsx_module = React | Generic of {module_name: string} type source_map = No_source_map | Linked | Inline | Hidden @@ -35,10 +33,6 @@ let cross_module_inline = ref false let debug_ir = ref false let check_lam = ref false -(* let (//) = Filename.concat *) - -(* let get_packages_info () = !packages_info *) - let no_builtin_ppx = ref false let tool_name = "ReScript" let check_div_by_zero = ref true diff --git a/compiler/common/js_config.mli b/compiler/common/js_config.mli index c4098918ca..6510961705 100644 --- a/compiler/common/js_config.mli +++ b/compiler/common/js_config.mli @@ -26,26 +26,12 @@ type jsx_version = Jsx_v4 type jsx_module = React | Generic of {module_name: string} type source_map = No_source_map | Linked | Inline | Hidden -(* val get_packages_info : - unit -> Js_packages_info.t *) - val no_version_header : bool ref (** set/get header *) val directives : string list ref (** directives printed verbatims just after the version header *) -(** return [package_name] and [path] - when in script mode: -*) - -(* val get_current_package_name_and_path : - Js_packages_info.module_system -> - Js_packages_info.info_query *) - -(* val set_package_name : string -> unit - val get_package_name : unit -> string option *) - val cross_module_inline : bool ref (** cross module inline option *) diff --git a/compiler/common/ml_binary.mli b/compiler/common/ml_binary.mli index 13ca35c930..01ee113092 100644 --- a/compiler/common/ml_binary.mli +++ b/compiler/common/ml_binary.mli @@ -22,9 +22,8 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* This file was used to read reason ast - and part of parsing binary ast -*) +(* The kind (structure or signature) of an AST, and conversion between + Parsetree and the frozen Parsetree0 that PPX executables read and write *) type _ kind = Ml : Parsetree.structure kind | Mli : Parsetree.signature kind type ast0 = Impl of Parsetree0.structure | Intf of Parsetree0.signature From 3dc9f2e94bc4cbac263b3fdea76d10ef3bd68823 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 2 Oct 2026 06:56:54 +0200 Subject: [PATCH 10/32] Describe the actual -bs-ast file format in Binary_ast The write_ast doc described a { magic number; filename; ast } layout, a "-" stdin filename and a `fan` tool, and pointed to Bsb_depfile_gen; the function writes a length-prefixed dependency block, the source file name and the marshalled AST, and rewatch's get_dep_modules decodes the block. magic_sep_char was exported but used only inside binary_ast.ml. Signed-off-by: Cristiano Calcagno Co-Authored-By: Claude Opus 5.5 --- compiler/depends/binary_ast.ml | 1 - compiler/depends/binary_ast.mli | 25 ++++++++----------------- 2 files changed, 8 insertions(+), 18 deletions(-) diff --git a/compiler/depends/binary_ast.ml b/compiler/depends/binary_ast.ml index 73a9a0c7f9..26be9af9af 100644 --- a/compiler/depends/binary_ast.ml +++ b/compiler/depends/binary_ast.ml @@ -23,7 +23,6 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) module Set_string = Ast_extract.Set_string -(** Synced up with module {!Bsb_helper_depfile_gen} *) type 'a kind = 'a Ml_binary.kind = | Ml : Parsetree.structure kind diff --git a/compiler/depends/binary_ast.mli b/compiler/depends/binary_ast.mli index 97c98cb12b..90b6d4ad0b 100644 --- a/compiler/depends/binary_ast.mli +++ b/compiler/depends/binary_ast.mli @@ -26,21 +26,12 @@ type _ kind = Ml : Parsetree.structure kind | Mli : Parsetree.signature kind val read_ast_exn : fname:string -> 'a kind -> 'a -val magic_sep_char : char - val write_ast : sourcefile:string -> output:string -> 'a kind -> 'a -> unit -(** - Check out {!Bsb_depfile_gen} for set decoding - The [.ml] file can be recognized as an ast directly, the format - is - { - magic number; - filename; - ast - } - when [fname] is "-" it means the file is from an standard input or pipe. - An empty name would marshallized. - - Use case cat - | fan -printer -impl - - redirect the standard input to fan -*) +(** [write_ast ~sourcefile ~output kind ast] writes to [output]: + - the length in bytes of the dependency block ([output_binary_int]); + - the dependency block: a newline, then each module name [ast] refers to + (predefined names excluded), each followed by a newline; + - [sourcefile] and a newline; + - the marshalled [ast]. + [read_ast_exn] skips the dependency block; rewatch reads it in + [get_dep_modules] (rewatch/src/build/deps.rs). *) From eefa2e2bd0561301fed1bdf1947562da53bf7f53 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 2 Oct 2026 06:56:56 +0200 Subject: [PATCH 11/32] Remove the unused -annot type-annotation dump Stypes and Annot recorded type annotations for an -annot dump that bsc never enables: Clflags.annotations was never set to true, Stypes.record returned immediately and Stypes.dump had no caller. The scope arguments threaded through Typecore and Typemod.type_structure fed only those records. Co-Authored-By: Claude Opus 5.5 Signed-off-by: Cristiano Calcagno --- compiler/ml/annot.ml | 23 --- compiler/ml/clflags.ml | 1 - compiler/ml/clflags.mli | 1 - compiler/ml/stypes.ml | 188 ------------------ compiler/ml/stypes.mli | 35 ---- compiler/ml/typecore.ml | 62 ++---- compiler/ml/typecore.mli | 1 - compiler/ml/typemod.ml | 131 +++++------- compiler/ml/typemod.mli | 5 +- tests/ounit_tests/ounit_ast_mapper0_tests.ml | 4 +- .../ounit_constructor_arguments_tests.ml | 1 - .../ounit_lambda_constant_tests.ml | 1 - 12 files changed, 67 insertions(+), 386 deletions(-) delete mode 100644 compiler/ml/annot.ml delete mode 100644 compiler/ml/stypes.ml delete mode 100644 compiler/ml/stypes.mli diff --git a/compiler/ml/annot.ml b/compiler/ml/annot.ml deleted file mode 100644 index 13a586592e..0000000000 --- a/compiler/ml/annot.ml +++ /dev/null @@ -1,23 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Damien Doligez, projet Gallium, INRIA Rocquencourt *) -(* *) -(* Copyright 2007 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(* Data types for annotations (Stypes.ml) *) - -type call = Tail | Stack | Inline - -type ident = - | Iref_internal of Location.t (* defining occurrence *) - | Iref_external - | Idef of Location.t (* scope *) diff --git a/compiler/ml/clflags.ml b/compiler/ml/clflags.ml index 1255d2974f..36b8e0a263 100644 --- a/compiler/ml/clflags.ml +++ b/compiler/ml/clflags.ml @@ -13,7 +13,6 @@ and preprocessor = ref (None : string option) (* -pp *) and all_ppx = ref ([] : string list) (* -ppx *) -let annotations = ref false (* -annot *) let binary_annotations = ref false (* -annot *) and noassert = ref false (* -noassert *) diff --git a/compiler/ml/clflags.mli b/compiler/ml/clflags.mli index e532fd6f7d..ea8be1a6f4 100644 --- a/compiler/ml/clflags.mli +++ b/compiler/ml/clflags.mli @@ -8,7 +8,6 @@ val nopervasives : bool ref val open_modules : string list ref val preprocessor : string option ref val all_ppx : string list ref -val annotations : bool ref val binary_annotations : bool ref val noassert : bool ref val verbose : bool ref diff --git a/compiler/ml/stypes.ml b/compiler/ml/stypes.ml deleted file mode 100644 index 0584b16938..0000000000 --- a/compiler/ml/stypes.ml +++ /dev/null @@ -1,188 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Damien Doligez, projet Moscova, INRIA Rocquencourt *) -(* *) -(* Copyright 2003 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(* Recording and dumping (partial) type information *) - -(* - We record all types in a list as they are created. - This means we can dump type information even if type inference fails, - which is extremely important, since type information is most - interesting in case of errors. -*) - -open Annot -open Lexing -open Location -open Typedtree - -let output_int oc i = output_string oc (string_of_int i) - -type annotation = - | Ti_pat of pattern - | Ti_expr of expression - | Ti_class of unit - | Ti_mod of module_expr - | An_call of Location.t * Annot.call - | An_ident of Location.t * string * Annot.ident - -let get_location ti = - match ti with - | Ti_pat p -> p.pat_loc - | Ti_expr e -> e.exp_loc - | Ti_class () -> assert false - | Ti_mod m -> m.mod_loc - | An_call (l, _k) -> l - | An_ident (l, _s, _k) -> l - -let annotations = ref ([] : annotation list) -let phrases = ref ([] : Location.t list) - -let record ti = - if !Clflags.annotations && not (get_location ti).Location.loc_ghost then - annotations := ti :: !annotations - -let record_phrase loc = if !Clflags.annotations then phrases := loc :: !phrases - -(* comparison order: - the intervals are sorted by order of increasing upper bound - same upper bound -> sorted by decreasing lower bound -*) -let cmp_loc_inner_first loc1 loc2 = - match compare loc1.loc_end.pos_cnum loc2.loc_end.pos_cnum with - | 0 -> compare loc2.loc_start.pos_cnum loc1.loc_start.pos_cnum - | x -> x -let cmp_ti_inner_first ti1 ti2 = - cmp_loc_inner_first (get_location ti1) (get_location ti2) - -let print_position pp pos = - if pos = dummy_pos then output_string pp "--" - else ( - output_char pp '\"'; - output_string pp (String.escaped pos.pos_fname); - output_string pp "\" "; - output_int pp pos.pos_lnum; - output_char pp ' '; - output_int pp pos.pos_bol; - output_char pp ' '; - output_int pp pos.pos_cnum) - -let print_location pp loc = - print_position pp loc.loc_start; - output_char pp ' '; - print_position pp loc.loc_end - -let sort_filter_phrases () = - let ph = List.sort (fun x y -> cmp_loc_inner_first y x) !phrases in - let rec loop accu cur l = - match l with - | [] -> accu - | loc :: t -> - if - cur.loc_start.pos_cnum <= loc.loc_start.pos_cnum - && cur.loc_end.pos_cnum >= loc.loc_end.pos_cnum - then loop accu cur t - else loop (loc :: accu) loc t - in - phrases := loop [] Location.none ph - -let rec printtyp_reset_maybe loc = - match !phrases with - | cur :: t when cur.loc_start.pos_cnum <= loc.loc_start.pos_cnum -> - Printtyp.reset (); - phrases := t; - printtyp_reset_maybe loc - | _ -> () - -let call_kind_string k = - match k with - | Tail -> "tail" - | Stack -> "stack" - | Inline -> "inline" - -let print_ident_annot pp str k = - match k with - | Idef l -> - output_string pp "def "; - output_string pp str; - output_char pp ' '; - print_location pp l; - output_char pp '\n' - | Iref_internal l -> - output_string pp "int_ref "; - output_string pp str; - output_char pp ' '; - print_location pp l; - output_char pp '\n' - | Iref_external -> - output_string pp "ext_ref "; - output_string pp str; - output_char pp '\n' - -(* The format of the annotation file is documented in emacs/caml-types.el. *) - -let print_info pp prev_loc ti = - match ti with - | Ti_class _ | Ti_mod _ -> prev_loc - | Ti_pat {pat_loc = loc; pat_type = typ; pat_env = env} - | Ti_expr {exp_loc = loc; exp_type = typ; exp_env = env} -> - if loc <> prev_loc then ( - print_location pp loc; - output_char pp '\n'); - output_string pp "type(\n"; - printtyp_reset_maybe loc; - Printtyp.mark_loops typ; - Format.pp_print_string Format.str_formatter " "; - Printtyp.wrap_printing_env env (fun () -> - Printtyp.type_sch Format.str_formatter typ); - Format.pp_print_newline Format.str_formatter (); - let s = Format.flush_str_formatter () in - output_string pp s; - output_string pp ")\n"; - loc - | An_call (loc, k) -> - if loc <> prev_loc then ( - print_location pp loc; - output_char pp '\n'); - output_string pp "call(\n "; - output_string pp (call_kind_string k); - output_string pp "\n)\n"; - loc - | An_ident (loc, str, k) -> - if loc <> prev_loc then ( - print_location pp loc; - output_char pp '\n'); - output_string pp "ident(\n "; - print_ident_annot pp str k; - output_string pp ")\n"; - loc - -let get_info () = - let info = List.fast_sort cmp_ti_inner_first !annotations in - annotations := []; - info - -let dump filename = - if !Clflags.annotations then ( - let do_dump _temp_filename pp = - let info = get_info () in - sort_filter_phrases (); - ignore (List.fold_left (print_info pp) Location.none info) - in - (match filename with - | None -> do_dump "" stdout - | Some filename -> - Misc.output_to_file_via_temporary ~mode:[Open_text] filename do_dump); - phrases := []) - else annotations := [] diff --git a/compiler/ml/stypes.mli b/compiler/ml/stypes.mli deleted file mode 100644 index 3182f7eb9a..0000000000 --- a/compiler/ml/stypes.mli +++ /dev/null @@ -1,35 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Damien Doligez, projet Moscova, INRIA Rocquencourt *) -(* *) -(* Copyright 2003 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(* Recording and dumping (partial) type information *) - -(* Clflags.save_types must be true *) - -open Typedtree - -type annotation = - | Ti_pat of pattern - | Ti_expr of expression - | Ti_class of unit - | Ti_mod of module_expr - | An_call of Location.t * Annot.call - | An_ident of Location.t * string * Annot.ident - -val record : annotation -> unit -val record_phrase : Location.t -> unit -val dump : string option -> unit - -val get_location : annotation -> Location.t -val get_info : unit -> annotation list diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 54d4833f68..e1f3f4a132 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -136,11 +136,9 @@ let type_package = ref (fun _ -> assert false) *) let re node = Cmt_format.add_saved_type (Cmt_format.Partial_expression node); - Stypes.record (Stypes.Ti_expr node); node let rp node = Cmt_format.add_saved_type (Cmt_format.Partial_pattern node); - Stypes.record (Stypes.Ti_pat node); node type recarg = Allowed | Required | Rejected @@ -450,13 +448,11 @@ let pattern_variables = : (Ident.t * type_expr * string loc * Location.t * bool (* as-variable *)) list) let pattern_force = ref ([] : (unit -> unit) list) -let pattern_scope = ref (None : Annot.ident option) let allow_modules = ref false let module_variables = ref ([] : (string loc * Location.t) list) -let reset_pattern scope allow = +let reset_pattern allow = pattern_variables := []; pattern_force := []; - pattern_scope := scope; allow_modules := allow; module_variables := [] @@ -472,12 +468,7 @@ let enter_variable ?(is_module = false) ?(is_as_variable = false) loc name ty = (* Note: unpack patterns enter a variable of the same name *) if not !allow_modules then raise (Error (loc, Env.empty, Modules_not_allowed)); - module_variables := (name, loc) :: !module_variables) - else - (* moved to genannot *) - may - (fun s -> Stypes.record (Stypes.An_ident (name.loc, name.txt, s))) - !pattern_scope; + module_variables := (name, loc) :: !module_variables); id let sort_pattern_variables vs = @@ -1789,7 +1780,7 @@ let partial_pred ~lev ?mode ?explode env expected_ty constrs labels p = let env = ref env in let state = save_state env in try - reset_pattern None true; + reset_pattern true; let typed_p = Ctype.with_passive_variants (type_pat ~allow_existentials:true ~lev ~constrs ~labels ?mode ?explode @@ -1837,8 +1828,8 @@ let add_pattern_variables ?check ?check_as env = pv env, get_ref module_variables ) -let type_pattern ~lev env spat scope expected_ty = - reset_pattern scope true; +let type_pattern ~lev env spat expected_ty = + reset_pattern true; let new_env = ref env in let pat = type_pat ~allow_existentials:true ~lev new_env spat expected_ty in let new_env, unpacks = @@ -1848,8 +1839,8 @@ let type_pattern ~lev env spat scope expected_ty = in (pat, new_env, get_ref pattern_force, unpacks) -let type_pattern_list env spatl scope expected_tys allow = - reset_pattern scope allow; +let type_pattern_list env spatl expected_tys allow = + reset_pattern allow; let new_env = ref env in let type_pat (attrs, pat) ty = Builtin_attributes.warning_scope ~ppwarning:false attrs (fun () -> @@ -2461,14 +2452,6 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp | v -> v) env lid.loc lid.txt in - (if !Clflags.annotations then - let dloc = desc.Types.val_loc in - let annot = - if dloc.Location.loc_ghost then Annot.Iref_external - else Annot.Iref_internal dloc - in - let name = Path.name ~paren:Oprint.parenthesized_ident path in - Stypes.record (Stypes.An_ident (loc, name, annot))); let is_recarg = match (repr desc.val_type).desc with | Tconstr (p, _, _) -> Path.is_constructor_typath p @@ -2513,13 +2496,8 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp } ty_expected | Pexp_let (rec_flag, spat_sexp_list, sbody) -> - let scp = - match rec_flag with - | Recursive -> Some (Annot.Idef loc) - | Nonrecursive -> Some (Annot.Idef sbody.pexp_loc) - in let pat_exp_list, new_env, unpacks = - type_let ~context:None env rec_flag spat_sexp_list scp true + type_let ~context:None env rec_flag spat_sexp_list true in let body = type_expect ~context:None new_env (wrap_unpacks sbody unpacks) ty_expected @@ -3822,7 +3800,6 @@ and type_function ~async loc attrs env ty_expected_ let lev, env = if has_gadts then init_env () else (get_current_level (), env) in - let scope = Some (Annot.Idef sbody.pexp_loc) in let rec type_params typed_acc env unpacks_acc defaults_acc (params : (Parsetree.fun_param * Parsetree.value_binding option) list) tys = @@ -3844,7 +3821,7 @@ and type_function ~async loc attrs env ty_expected_ let pat, ext_env, force, unpacks = let partial = if erase_either then Some false else None in let ty_arg_i = instance ?partial env ty_arg_c in - type_pattern ~lev env spat scope ty_arg_i + type_pattern ~lev env spat ty_arg_i in pattern_force := force @ !pattern_force; let ty_arg' = newvar () in @@ -3869,7 +3846,7 @@ and type_function ~async loc attrs env ty_expected_ | Some vb -> let let_env = ext_env in let pat_exp_list, ext_env, let_unpacks = - type_let ~context:None ext_env Nonrecursive [vb] None true + type_let ~context:None ext_env Nonrecursive [vb] true in (* The pattern binds the option carrier under an unspellable name ([*opt_