Apply changes accordingly

Check the output of ocamlobjinfo bsb_helper.cmx make sure unused dependency not pulled in

Author: bobzhang

jscomp/bsb/bsb_ninja_file_groups.ml

@@ -37,7 +37,7 @@ let handle_generators oc
   Ext_list.iter group.generators (fun {output; input; command} -> 
       (*TODO: add a loc for better error message *)
       match String_map.find_opt custom_rules command with 
-      | None -> Ext_pervasives.failwithf ~loc:__LOC__ "custom rule %s used but  not defined" command
+      | None -> Ext_fmt.failwithf ~loc:__LOC__ "custom rule %s used but  not defined" command
       | Some rule -> 
         Bsb_ninja_targets.output_build oc 
           ~outputs:(Ext_list.map  output  map_to_source_dir)

jscomp/bsb_helper/bsb_db_decode.ml

@@ -93,7 +93,9 @@ let read_build_cache ~dir  : t =
     Ext_io.load_file (Filename.concat dir bsbuild_cache) in   
   decode_internal all_content (ref (Ext_digest.length + 1)), all_content
 
-let cmp (a : string) b = String_map.compare_key a b   
+(* Invariant: the same as encoding String_map.compare_key  *)  
+let cmp  =  Ext_string.compare
+    
 
 let rec binarySearchAux (arr : string array) (lo : int) (hi : int) (key : string)  : _ option = 
   let mid = (lo + hi)/2 in 
@@ -129,7 +131,7 @@ let find_opt_aux sorted key  : _ option =
 
 
 type module_info =  {
-  case : Bsb_db.case; 
+  case : bool ; (* which is Bsb_db.case*)
   dir_name : string
 } 
 

jscomp/bsb_helper/bsb_db_decode.mli

@@ -48,7 +48,7 @@ val read_build_cache :
 
 
 type module_info = {
-  case : Bsb_db.case;
+  case : bool (* Bsb_db.case*);
   dir_name : string
 } 
 

jscomp/common/js_config.ml

@@ -30,19 +30,19 @@
 (* let add_npm_package_path s =
   match !packages_info  with
   | Empty ->
-    Ext_pervasives.bad_argf "please set package name first using -bs-package-name ";
+    Ext_arg.bad_argf "please set package name first using -bs-package-name ";
   | NonBrowser(name,  envs) ->
     let env, path =
       match Ext_string.split ~keep_empty:false s ':' with
       | [ package_name; path]  ->
         (match Js_packages_info.module_system_of_string package_name with
          | Some x -> x
          | None ->
-           Ext_pervasives.bad_argf "invalid module system %s" package_name), path
+           Ext_arg.bad_argf "invalid module system %s" package_name), path
       | [path] ->
         NodeJS, path
       | _ ->
-        Ext_pervasives.bad_argf "invalid npm package path: %s" s
+        Ext_arg.bad_argf "invalid npm package path: %s" s
     in
     packages_info := NonBrowser (name,  ((env,path) :: envs)) *)
 (** Browser is not set via command line only for internal use *)

jscomp/core/js_cmj_format.ml

@@ -88,7 +88,7 @@ let digest_length = 16 (*16 chars *)
 let verify_magic_in_beg ic =
   let buffer = really_input_string ic cmj_magic_number_length in 
   if buffer <> cmj_magic_number then
-    Ext_pervasives.failwithf ~loc:__LOC__ 
+    Ext_fmt.failwithf ~loc:__LOC__ 
       "cmj files have incompatible versions, please rebuilt using the new compiler : %s" 
         __LOC__
 
@@ -116,7 +116,7 @@ let from_string s : t =
   if magic_number = cmj_magic_number then 
     Marshal.from_string s  (digest_length + cmj_magic_number_length)
   else 
-    Ext_pervasives.failwithf ~loc:__LOC__ 
+    Ext_fmt.failwithf ~loc:__LOC__ 
       "cmj files have incompatible versions, please rebuilt using the new compiler : %s"
         __LOC__
 

jscomp/core/js_exp_make.ml

@@ -1128,6 +1128,15 @@ let int32_lsl ?comment (e1 : J.expression) (e2 : J.expression) : J.expression =
       expression_desc = Bin (Lsl, e1,e2)
     }
 
+let  is_pos_pow n = 
+  let module M = struct exception E end in 
+  let rec aux c (n : Int32.t) = 
+    if n <= 0l then -2 
+    else if n = 1l then c 
+    else if Int32.logand n 1l =  0l then   
+      aux (c + 1) (Int32.shift_right n 1 )
+    else raise_notrace M.E in 
+  try aux 0 n  with M.E -> -1
 
 let int32_mul ?comment 
     (e1 : J.expression) 
@@ -1144,7 +1153,7 @@ let int32_mul ?comment
   | e , {expression_desc = Number (Int {i = i0} | Uint i0 ); _}
   | {expression_desc = Number (Int {i = i0} | Uint i0 ); _}, e 
     -> 
-    let i =  Ext_pervasives.is_pos_pow i0  in 
+    let i =  is_pos_pow i0  in 
     if i >= 0 then 
       int32_lsl e (small_int i)
     else 

jscomp/core/js_packages_info.ml

@@ -228,23 +228,23 @@ let get_output_dir
 
 let add_npm_package_path (packages_info : t) (s : string)  : t =
   if is_empty packages_info then 
-    Ext_pervasives.bad_argf "please set package name first using -bs-package-name "
+    Ext_arg.bad_argf "please set package name first using -bs-package-name "
   else   
     let module_system, path =
       match Ext_string.split ~keep_empty:false s ':' with
       | [ module_system; path]  ->
         (match module_system_of_string module_system with
          | Some x -> x
          | None ->
-           Ext_pervasives.bad_argf "invalid module system %s" module_system), path
+           Ext_arg.bad_argf "invalid module system %s" module_system), path
       | [path] ->
         NodeJS, path
       | module_system :: path -> 
         (match module_system_of_string module_system with 
         | Some x -> x
-        | None -> Ext_pervasives.bad_argf "invalid module system %s" module_system), (String.concat ":" path)
+        | None -> Ext_arg.bad_argf "invalid module system %s" module_system), (String.concat ":" path)
       | _ ->
-        Ext_pervasives.bad_argf "invalid npm package path: %s" s
+        Ext_arg.bad_argf "invalid npm package path: %s" s
     in
     { packages_info with module_systems = {module_system; path}::packages_info.module_systems}
 

jscomp/core/js_packages_state.ml

@@ -31,7 +31,7 @@ let set_package_name name =
   if Js_packages_info.is_empty !packages_info then 
       packages_info := Js_packages_info.from_name name
   else
-    Ext_pervasives.bad_argf "duplicated flag for -bs-package-name"
+    Ext_arg.bad_argf "duplicated flag for -bs-package-name"
 
 let set_package_map module_name = 
     (* set_package_name name ; 

jscomp/core/lam_compile_main.ml

@@ -213,7 +213,7 @@ let compile
     if Js_config.is_same_file () then
       let f =
         Ext_filename.new_extension !Location.input_name  ".lambda" in
-      Ext_pervasives.with_file_as_pp f begin fun fmt ->
+      Ext_fmt.with_file_as_pp f begin fun fmt ->
         Format.pp_print_list ~pp_sep:Format.pp_print_newline
           (Lam_group.pp_group env) fmt (coerced_input.groups) 
       end;

jscomp/core/lam_convert.ml

@@ -60,7 +60,7 @@ let exception_id_destructed (l : Lam.t) (fv : Ident.t): bool  =
   | Some a -> hit a   
   and hit_list_snd : 'a. ('a * _ ) list -> bool = fun x ->    
     Ext_list.exists_snd  x  hit
-  and hit_list xs = List.exists hit xs 
+  and hit_list xs = Ext_list.exists xs hit 
   and hit (l : Lam.t) =
     match l  with
     | Lprim {primitive = Pintcomp _ ;

jscomp/core/lam_dce.ml

@@ -43,7 +43,7 @@ let transitive_closure
         Ident_hash_set.add visited id;
         match Ident_hashtbl.find_opt ident_freevars id with 
         | None -> 
-          Ext_pervasives.failwithf ~loc:__LOC__ "%s/%d not found"  (Ident.name id) (id.stamp)  
+          Ext_fmt.failwithf ~loc:__LOC__ "%s/%d not found"  (Ident.name id) (id.stamp)  
         | Some e -> Ident_set.iter e dfs
       end  in 
   Ext_list.iter initial_idents dfs;

jscomp/core/lam_hit.ml

@@ -34,7 +34,7 @@ let hit_variables (fv : Ident_set.t) (l : t) : bool  =
   and hit_var (id : Ident.t) = Ident_set.mem fv id 
   and hit_list_snd : 'a. ('a * t ) list -> bool = fun x ->    
     Ext_list.exists_snd x hit
-  and hit_list xs = List.exists hit xs 
+  and hit_list xs = Ext_list.exists xs hit
   and hit (l : t) =
     begin
       match (l : t) with
@@ -93,7 +93,7 @@ let hit_variable (fv : Ident.t) (l : t) : bool  =
   and hit_var (id : Ident.t) = Ident.same id fv   
   and hit_list_snd : 'a. ('a * t ) list -> bool = fun x ->    
     Ext_list.exists_snd x hit
-  and hit_list xs = List.exists hit xs 
+  and hit_list xs = Ext_list.exists xs hit 
   and hit (l : t) =
     begin
       match (l : t) with

jscomp/core/lam_iter.ml

@@ -84,7 +84,7 @@ let inner_exists (l : t) (f : t -> bool) : bool =
   | Lconst (_ : Lam_constant.t) -> false
   | Lapply ({fn; args; loc; status} )  ->
     f fn ||
-    List.exists f args
+    Ext_list.exists args f 
   | Lfunction({body; arity;  params } ) ->
     f body
   | Llet(str, id, arg, body) ->
@@ -104,10 +104,10 @@ let inner_exists (l : t) (f : t -> bool) : bool =
     Ext_option.exists default f     
 
   | Lprim {args; primitive ; loc}  ->
-    List.exists f args;
+    Ext_list.exists args f;
 
   | Lstaticraise (id,args) ->
-    List.exists f args;
+    Ext_list.exists args f;
   | Lstaticcatch(e1, vars , e2) ->
     f e1 ||
     f e2
@@ -125,4 +125,4 @@ let inner_exists (l : t) (f : t -> bool) : bool =
   | Lassign(id, e) ->
     f e
   | Lsend (k, met, obj, args, loc) ->
-    f met || f obj || List.exists f args       
+    f met || f obj || Ext_list.exists args f 

jscomp/core/lam_scc.ml

@@ -39,7 +39,7 @@ let hit_mask ( mask : Hash_set_ident_mask.t) (l : Lam.t) : bool =
     and hit_var (id : Ident.t) = Hash_set_ident_mask.mask_check_all_hit id mask
     and hit_list_snd : 'a. ('a * Lam.t ) list -> bool = fun x ->    
       Ext_list.exists_snd x hit
-    and hit_list xs = List.exists hit xs 
+    and hit_list xs = Ext_list.exists  xs hit
     and hit (l : Lam.t) =
     match l  with
     | Lvar id -> hit_var id

jscomp/ext/ext_buffer.ml

@@ -35,14 +35,14 @@ let to_bytes b = Bytes.sub b.buffer 0 b.position
 
 let sub b ofs len =
   if ofs < 0 || len < 0 || ofs > b.position - len
-  then invalid_arg "Buffer.sub"
+  then invalid_arg "Ext_buffer.sub"
   else Bytes.sub_string b.buffer ofs len
 
 
 let blit src srcoff dst dstoff len =
   if len < 0 || srcoff < 0 || srcoff > src.position - len
              || dstoff < 0 || dstoff > (Bytes.length dst) - len
-  then invalid_arg "Buffer.blit"
+  then invalid_arg "Ext_buffer.blit"
   else
     Bytes.unsafe_blit src.buffer srcoff dst dstoff len
 
@@ -63,7 +63,7 @@ let resize b more =
   if !new_len > Sys.max_string_length then begin
     if b.position + more <= Sys.max_string_length
     then new_len := Sys.max_string_length
-    else failwith "Buffer.add: cannot grow buffer"
+    else failwith "Ext_buffer.add: cannot grow buffer"
   end;
 #end  
   let new_buffer = Bytes.create !new_len in
@@ -81,7 +81,7 @@ let add_char b c =
 
 let add_substring b s offset len =
   if offset < 0 || len < 0 || offset > String.length s - len
-  then invalid_arg "Buffer.add_substring/add_subbytes";
+  then invalid_arg "Ext_buffer.add_substring/add_subbytes";
   let new_position = b.position + len in
   if new_position > b.length then resize b len;
   Bytes.blit_string s offset b.buffer b.position len;
@@ -133,7 +133,7 @@ let add_channel b ic len =
     || len > Sys.max_string_length 
 #end
     then   (* PR#5004 *)
-    invalid_arg "Buffer.add_channel";
+    invalid_arg "Ext_buffer.add_channel";
   if b.position + len > b.length then resize b len;
   really_input ic b.buffer b.position len;
   b.position <- b.position + len

jscomp/ext/ext_js_regex.ml

@@ -31,7 +31,7 @@ let check_from_end al =
       if e < 0 || e > 255 then false
       else (let c = Char.chr e in
             if c = '/' then true
-            else (if List.exists (fun x -> x = c) seen then false (* flag should not be repeated *)
+            else (if Ext_list.exists seen (fun x -> x = c)  then false (* flag should not be repeated *)
                   else (if c = 'i' || c = 'g' || c = 'm' || c = 'y' || c ='u' then aux r (c::seen) 
                         else false)))
   in aux al []

jscomp/ext/ext_namespace.ml

@@ -102,9 +102,9 @@ let is_valid_npm_package_name (s : string) =
 
 let namespace_of_package_name (s : string) : string = 
   let len = String.length s in 
-  let buf = Buffer.create len in 
+  let buf = Ext_buffer.create len in 
   let add capital ch = 
-    Buffer.add_char buf 
+    Ext_buffer.add_char buf 
       (if capital then 
          (Ext_char.uppercase_ascii ch)
        else ch) in    
@@ -125,4 +125,4 @@ let namespace_of_package_name (s : string) : string =
       | _ -> aux capital (off+1) len
   in 
   aux true 0 len ;
-  Buffer.contents buf 
+  Ext_buffer.contents buf 

jscomp/ext/ext_path.ml

@@ -313,7 +313,7 @@ let rec find_root_filename ~cwd filename   =
     if String.length cwd' < String.length cwd then  
       find_root_filename ~cwd:cwd'  filename 
     else 
-      Ext_pervasives.failwithf 
+      Ext_fmt.failwithf 
         ~loc:__LOC__
         "%s not found from %s" filename cwd
 

jscomp/ext/ext_pervasives.ml

@@ -42,32 +42,10 @@ let try_it f  =
 let with_file_as_chan filename f = 
   finally (open_out_bin filename) ~clean:close_out f 
 
-let with_file_as_pp filename f = 
-  finally (open_out_bin filename) ~clean:close_out
-    (fun chan -> 
-      let fmt = Format.formatter_of_out_channel chan in
-      let v = f  fmt in
-      Format.pp_print_flush fmt ();
-      v
-    ) 
-
-
-let  is_pos_pow n = 
-  let module M = struct exception E end in 
-  let rec aux c (n : Int32.t) = 
-    if n <= 0l then -2 
-    else if n = 1l then c 
-    else if Int32.logand n 1l =  0l then   
-      aux (c + 1) (Int32.shift_right n 1 )
-    else raise M.E in 
-  try aux 0 n  with M.E -> -1
-
-let failwithf ~loc fmt = Format.ksprintf (fun s -> failwith (loc ^ s))
-    fmt
-    
-let invalid_argf fmt = Format.ksprintf invalid_arg fmt
-
-let bad_argf fmt = Format.ksprintf (fun x -> raise (Arg.Bad x ) ) fmt
+
+
+
+
 
 external id : 'a -> 'a = "%identity"
 

jscomp/ext/ext_pervasives.mli

@@ -43,15 +43,14 @@ val try_it : (unit -> 'a) ->  unit
 
 val with_file_as_chan : string -> (out_channel -> 'a) -> 'a
 
-val with_file_as_pp : string -> (Format.formatter -> 'a) -> 'a
 
-val is_pos_pow : Int32.t -> int
 
-val failwithf : loc:string -> ('a, unit, string, 'b) format4 -> 'a
 
-val invalid_argf : ('a, unit, string, 'b) format4 -> 'a
 
-val bad_argf : ('a, unit, string, 'b) format4 -> 'a
+
+
+
+
 
 
 

jscomp/ext/ext_string.ml

@@ -116,7 +116,7 @@ let check_suffix_case = ends_with
 let check_suffix_case_then_chop = ends_with_then_chop
 
 let check_any_suffix_case s suffixes = 
-  List.exists (fun x -> check_suffix_case s x) suffixes
+  Ext_list.exists suffixes (fun x -> check_suffix_case s x) 
 
 let check_any_suffix_case_then_chop s suffixes = 
   let rec aux suffixes = 
@@ -260,8 +260,7 @@ let rec index_rec_count s lim i c count =
 let index_count s i c count =     
   let lim = String.length s in 
   if i < 0 || i >= lim || count < 1 then 
-    Ext_pervasives.invalid_argf "index_count: (%d,%d)"  i count;
-
+    invalid_arg ("index_count: ( " ^string_of_int i ^ "," ^string_of_int count ^ ")" );
   index_rec_count s lim i c count 
 
 (* let index_next s i c =