Fix (or disable) warnings when building compiler

Author: cknitt

jscomp/core/polyvar_pattern_match.ml

@@ -33,7 +33,7 @@ type output = (hash_names * lam) list
 module Coll = Hash.Make (struct
   type t = lam
 
-  let equal = Pervasives.( = )
+  let equal = Stdlib.( = )
 
   let hash = Hashtbl.hash
 end)

jscomp/ext/ext_int.ml

@@ -24,7 +24,7 @@
 
 type t = int
 
-let compare (x : t) (y : t) = Pervasives.compare x y
+let compare (x : t) (y : t) = Stdlib.compare x y
 
 let equal (x : t) (y : t) = x = y
 

jscomp/ext/ext_js_file_kind.ml

@@ -23,6 +23,6 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 type case = Upper | Little
 
-type t = { case : case; suffix : Ext_js_suffix.t }
+type [@warning "-69"] t = { case : case; suffix : Ext_js_suffix.t }
 
 let any_runtime_kind = { case = Little; suffix = Ext_js_suffix.Js }

jscomp/ext/misc.ml

@@ -274,7 +274,7 @@ let string_of_file ic =
   in copy()
 
 let output_to_bin_file_directly filename fn =  
-  let oc = Pervasives.open_out_bin filename in 
+  let oc = open_out_bin filename in 
   match fn filename oc with 
   | v -> close_out oc ; v 
   | exception e -> close_out oc ; raise e
@@ -593,12 +593,12 @@ module Color = struct
   (* map a tag to a style, if the tag is known.
      @raise Not_found otherwise *)
   let style_of_tag s = match s with
-    | "error" -> (!cur_styles).error
-    | "warning" -> (!cur_styles).warning
-    | "loc" -> (!cur_styles).loc
-    | "info" -> [Bold; FG Yellow]
-    | "dim" -> [Dim]
-    | "filename" -> [FG Cyan]
+    | Format.String_tag "error" -> (!cur_styles).error
+    | Format.String_tag "warning" -> (!cur_styles).warning
+    | Format.String_tag "loc" -> (!cur_styles).loc
+    | Format.String_tag "info" -> [Bold; FG Yellow]
+    | Format.String_tag "dim" -> [Dim]
+    | Format.String_tag "filename" -> [FG Cyan]
     | _ -> raise Not_found
 
   let color_enabled = ref true
@@ -619,13 +619,13 @@ module Color = struct
   (* add color handling to formatter [ppf] *)
   let set_color_tag_handling ppf =
     let open Format in
-    let functions = pp_get_formatter_tag_functions ppf () in
+    let functions = pp_get_formatter_stag_functions ppf () in
     let functions' = {functions with
-      mark_open_tag=(mark_open_tag ~or_else:functions.mark_open_tag);
-      mark_close_tag=(mark_close_tag ~or_else:functions.mark_close_tag);
+      mark_open_stag=(mark_open_tag ~or_else:functions.mark_open_stag);
+      mark_close_stag=(mark_close_tag ~or_else:functions.mark_close_stag);
     } in
     pp_set_mark_tags ppf true; (* enable tags *)
-    pp_set_formatter_tag_functions ppf functions';
+    pp_set_formatter_stag_functions ppf functions';
     (* also setup margins *)
     pp_set_margin ppf (pp_get_margin std_formatter());
     ()

jscomp/ext/set.cppo.ml

@@ -31,12 +31,12 @@ let print_elt = Format.pp_print_string
 #elif defined TYPE_IDENT
 type elt = Ident.t
 let compare_elt (x : elt) (y : elt) = 
-  let a =  Pervasives.compare (x.stamp : int) y.stamp in 
+  let a =  Stdlib.compare (x.stamp : int) y.stamp in 
   if a <> 0 then a 
   else 
-    let b = Pervasives.compare (x.name : string) y.name in 
+    let b = Stdlib.compare (x.name : string) y.name in 
     if b <> 0 then b 
-    else Pervasives.compare (x.flags : int) y.flags     
+    else Stdlib.compare (x.flags : int) y.flags     
 let [@inline] eq_elt (x : elt) y = Ident.same x y
 let print_elt = Ident.print
 #elif defined TYPE_INT

jscomp/js_parser/flow_sedlexing.ml

@@ -19,7 +19,7 @@ exception MalFormed
 
 type apos = int
 
-type lexbuf = {
+type [@warning "-69"] lexbuf = {
   mutable buf: int array;
   mutable len: int;
   mutable offset: apos;

jscomp/js_parser/parse_error.ml

@@ -167,7 +167,7 @@ type t =
   | ThisParamBannedInArrowFunctions
   | ThisParamBannedInConstructor
 
-let compare (x : t) (y : t) = Pervasives.compare x y
+let compare (x : t) (y : t) = Stdlib.compare x y
 
 exception Error of (Loc.t * t) list
 

jscomp/ml/env.ml

@@ -635,7 +635,7 @@ let current_unit = ref ""
 
 (* Persistent structure descriptions *)
 
-type pers_struct =
+type [@warning "-69"] pers_struct =
   { ps_name: string;
     ps_sig: signature Lazy.t;
     ps_comps: module_components;

jscomp/ml/matching.ml

@@ -475,7 +475,7 @@ module StoreExp =
     (struct
       type t = lambda
       type key = lambda
-      let compare_key = Pervasives.compare
+      let compare_key = compare
       let make_key = Lambda.make_key
     end)
 

jscomp/ml/parmatch.ml

@@ -263,10 +263,10 @@ let is_absent_pat p = match p.pat_desc with
 let const_compare x y =
   match x,y with
   | Const_float f1, Const_float f2 ->
-      Pervasives.compare (float_of_string f1) (float_of_string f2)
+      compare (float_of_string f1) (float_of_string f2)
   | Const_string (s1, _), Const_string (s2, _) ->
       String.compare s1 s2
-  | _, _ -> Pervasives.compare x y
+  | _, _ -> compare x y
 
 let records_args l1 l2 =
   (* Invariant: fields are already sorted by Typecore.type_label_a_list *)

jscomp/ml/parmatch.mli

@@ -37,7 +37,7 @@ val le_pat : pattern -> pattern -> bool
 val le_pats : pattern list -> pattern list -> bool
 
 (* Exported compatibility functor, abstracted over constructor equality *)
-module Compat :
+module [@warning "-67"] Compat :
   functor
     (Constr: sig
       val equal :

jscomp/ml/parser.ml

@@ -372,7 +372,7 @@ type let_binding =
     lb_text: text Lazy.t;
     lb_loc: Location.t; }
 
-type let_bindings =
+type [@warning "-69"] let_bindings =
   { lbs_bindings: let_binding list;
     lbs_rec: rec_flag;
     lbs_extension: string Asttypes.loc option;

jscomp/ml/parser.mly

@@ -266,7 +266,7 @@ type let_binding =
     lb_text: text Lazy.t;
     lb_loc: Location.t; }
 
-type let_bindings =
+type [@warning "-69"] let_bindings =
   { lbs_bindings: let_binding list;
     lbs_rec: rec_flag;
     lbs_extension: string Asttypes.loc option;

jscomp/ml/printtyp.ml

@@ -1579,20 +1579,21 @@ let report_unification_error ppf env ?(unif=true)
 
 
 let super_type_expansion ~tag t ppf t' =
+  let tag = Format.String_tag tag in
   if same_path t t' then begin
-    Format.pp_open_tag ppf tag;
+    Format.pp_open_stag ppf tag;
     type_expr ppf t;
-    Format.pp_close_tag ppf ();
+    Format.pp_close_stag ppf ();
   end else begin
     let t' = if proxy t == proxy t' then unalias t' else t' in
     fprintf ppf "@[<2>";
-    Format.pp_open_tag ppf tag;
+    Format.pp_open_stag ppf tag;
     fprintf ppf "%a" type_expr t;
-    Format.pp_close_tag ppf ();
+    Format.pp_close_stag ppf ();
     fprintf ppf "@ @{<dim>(defined as@}@ ";
-    Format.pp_open_tag ppf tag;
+    Format.pp_open_stag ppf tag;
     fprintf ppf "%a" type_expr t';
-    Format.pp_close_tag ppf ();
+    Format.pp_close_stag ppf ();
     fprintf ppf "@{<dim>)@}";
     fprintf ppf "@]";
   end

jscomp/ml/typecore.ml

@@ -436,7 +436,7 @@ let enter_variable ?(is_module=false) ?(is_as_variable=false) loc name ty =
 let sort_pattern_variables vs =
   List.sort
     (fun (x,_,_,_,_) (y,_,_,_,_) ->
-      Pervasives.compare (Ident.name x) (Ident.name y))
+      compare (Ident.name x) (Ident.name y))
     vs
 
 let enter_orpat_variables loc env  p1_vs p2_vs =

jscomp/ml/typedtreeIter.mli

@@ -73,7 +73,7 @@ module type IteratorArgument = sig
 
 end
 
-module MakeIterator :
+module [@warning "-67"] MakeIterator :
   functor (Iter : IteratorArgument) ->
     sig
       val iter_structure : structure -> unit

jscomp/super_errors/super_typecore.ml

@@ -13,11 +13,6 @@ let super_report_unification_error = Printtyp.super_report_unification_error
 let reset_and_mark_loops = Printtyp.reset_and_mark_loops
 let type_expr = Printtyp.type_expr
 
-let tagged tag fn ppf arg =
-  Format.pp_open_tag ppf tag;
-  fn ppf arg;
-  Format.pp_close_tag ppf ()
-
 let rec bottom_aliases = function
   | (_, one) :: (_, two) :: rest -> begin match bottom_aliases rest with
       | Some types -> Some types

lib/4.06.1/rescript.ml

@@ -7413,7 +7413,7 @@ module Ext_js_file_kind
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 type case = Upper | Little
 
-type t = { case : case; suffix : Ext_js_suffix.t }
+type [@warning "-69"] t = { case : case; suffix : Ext_js_suffix.t }
 
 let any_runtime_kind = { case = Little; suffix = Ext_js_suffix.Js }
 

lib/4.06.1/unstable/all_ounit_tests.ml

@@ -3042,7 +3042,7 @@ end = struct
 
 type t = int
 
-let compare (x : t) (y : t) = Pervasives.compare x y
+let compare (x : t) (y : t) = Stdlib.compare x y
 
 let equal (x : t) (y : t) = x = y
 
@@ -8639,7 +8639,7 @@ let string_of_file ic =
   in copy()
 
 let output_to_bin_file_directly filename fn =  
-  let oc = Pervasives.open_out_bin filename in 
+  let oc = open_out_bin filename in 
   match fn filename oc with 
   | v -> close_out oc ; v 
   | exception e -> close_out oc ; raise e
@@ -8958,12 +8958,12 @@ module Color = struct
   (* map a tag to a style, if the tag is known.
      @raise Not_found otherwise *)
   let style_of_tag s = match s with
-    | "error" -> (!cur_styles).error
-    | "warning" -> (!cur_styles).warning
-    | "loc" -> (!cur_styles).loc
-    | "info" -> [Bold; FG Yellow]
-    | "dim" -> [Dim]
-    | "filename" -> [FG Cyan]
+    | Format.String_tag "error" -> (!cur_styles).error
+    | Format.String_tag "warning" -> (!cur_styles).warning
+    | Format.String_tag "loc" -> (!cur_styles).loc
+    | Format.String_tag "info" -> [Bold; FG Yellow]
+    | Format.String_tag "dim" -> [Dim]
+    | Format.String_tag "filename" -> [FG Cyan]
     | _ -> raise Not_found
 
   let color_enabled = ref true
@@ -8984,13 +8984,13 @@ module Color = struct
   (* add color handling to formatter [ppf] *)
   let set_color_tag_handling ppf =
     let open Format in
-    let functions = pp_get_formatter_tag_functions ppf () in
+    let functions = pp_get_formatter_stag_functions ppf () in
     let functions' = {functions with
-      mark_open_tag=(mark_open_tag ~or_else:functions.mark_open_tag);
-      mark_close_tag=(mark_close_tag ~or_else:functions.mark_close_tag);
+      mark_open_stag=(mark_open_tag ~or_else:functions.mark_open_stag);
+      mark_close_stag=(mark_close_tag ~or_else:functions.mark_close_stag);
     } in
     pp_set_mark_tags ppf true; (* enable tags *)
-    pp_set_formatter_tag_functions ppf functions';
+    pp_set_formatter_stag_functions ppf functions';
     (* also setup margins *)
     pp_set_margin ppf (pp_get_margin std_formatter());
     ()
@@ -15011,7 +15011,7 @@ type let_binding =
     lb_text: text Lazy.t;
     lb_loc: Location.t; }
 
-type let_bindings =
+type [@warning "-69"] let_bindings =
   { lbs_bindings: let_binding list;
     lbs_rec: rec_flag;
     lbs_extension: string Asttypes.loc option;
@@ -38389,7 +38389,7 @@ module Ext_js_file_kind
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 type case = Upper | Little
 
-type t = { case : case; suffix : Ext_js_suffix.t }
+type [@warning "-69"] t = { case : case; suffix : Ext_js_suffix.t }
 
 let any_runtime_kind = { case = Little; suffix = Ext_js_suffix.Js }