Merge pull request #4122 from BuckleScript/move_bs_only_to_config

make @warning switch applicable to bucklescript warnings, remove customized warnings to use ocaml's own warning number

Author: bobzhang

jscomp/bsb/bsb_build_schemas.ml

@@ -23,7 +23,7 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
-let files = "files"
+(* let files = "files" *)
 let version = "version"
 let name = "name"
 (* let ocaml_config = "ocaml-config" *)

jscomp/bsb/bsb_file.ml

@@ -38,7 +38,7 @@ let install_if_exists ~destdir input_name =
     if Sys.file_exists input_name then 
       let output_name = (Filename.concat destdir (Filename.basename input_name)) in
       match Unix.stat output_name , Unix.stat input_name with
-      | {st_mtime = output_stamp}, {st_mtime = input_stamp} when input_stamp <= output_stamp 
+      | {st_mtime = output_stamp;_}, {st_mtime = input_stamp;_} when input_stamp <= output_stamp 
         -> false
       | _ -> copy_with_permission input_name output_name; true 
       | exception _ -> copy_with_permission input_name output_name; true

jscomp/bsb/bsb_global_paths.mli

@@ -35,8 +35,6 @@ val vendor_bsdep : string
 
 val vendor_bsppx : string
 
-val vendor_bsppx : string
-
 val ocaml_dir : string
 
 val ocaml_lib_dir : string

jscomp/bsb/bsb_ninja_gen.ml

@@ -36,11 +36,10 @@ let dash_i = "-I"
 
 
 let get_bsc_flags 
-    ~(toplevel : bool)     
     (bsc_flags : string list)
   : string =       
-  String.concat Ext_string.single_space 
-    (if toplevel then bsc_flags else "-bs-quiet" :: bsc_flags )
+  String.concat Ext_string.single_space bsc_flags
+
 
 
 let emit_bsc_lib_includes 
@@ -160,7 +159,7 @@ let output_ninja_and_namespace_map
         (* The path to [bsb_heler.exe] *)
         Bsb_ninja_global_vars.bsdep, (Ext_filename.maybe_quote Bsb_global_paths.vendor_bsdep) ;
         Bsb_ninja_global_vars.warnings, Bsb_warning.to_bsb_string ~toplevel warning ;
-        Bsb_ninja_global_vars.bsc_flags, (get_bsc_flags ~toplevel  bsc_flags) ;
+        Bsb_ninja_global_vars.bsc_flags, (get_bsc_flags bsc_flags) ;
         Bsb_ninja_global_vars.ppx_flags, ppx_flags;
 
         Bsb_ninja_global_vars.g_dpkg_incls, 

jscomp/bsb/bsb_warning.ml

@@ -86,23 +86,26 @@ let from_map (m : Ext_json_types.t Map_string.t) =
     in
     Some {number; error }
 
-let to_bsb_string ~toplevel warning =
-  match warning with
-  | None -> Ext_string.empty
-  | Some warning ->     
-    (match warning.number with
-     | None ->
-       Ext_string.empty
-     | Some x ->
-       prepare_warning_concat ~beg:true x  
-    ) ^
-    if toplevel then 
-      match warning.error with
-      | Warn_error_true ->
-        " -warn-error A"
-      | Warn_error_number y ->
-        " -warn-error " ^ y
-      | Warn_error_false ->
-        Ext_string.empty
-    else Ext_string.empty     
 
+let to_bsb_string ~toplevel warning =
+  if toplevel then
+    match warning with
+    | None -> Ext_string.empty
+    | Some warning ->     
+      (match warning.number with
+       | None ->
+         Ext_string.empty
+       | Some x ->
+         prepare_warning_concat ~beg:true x  
+      ) ^
+      (
+        match warning.error with
+        | Warn_error_true ->
+          " -warn-error A"
+        | Warn_error_number y ->
+          " -warn-error " ^ y
+        | Warn_error_false ->
+          Ext_string.empty
+      )
+  else " -w a" 
+  (* TODO: this is the current default behavior *)

jscomp/bsb_helper/bsb_helper_arg.ml

@@ -13,7 +13,7 @@ type spec =
   | Set_int of int ref         
 
 exception Bad of string
-exception Help of string
+(* exception Help of string *)
 
 type error =
   | Unknown of string
@@ -29,14 +29,14 @@ type t = (string * spec * string) list
 let rec assoc3 (x : string) (l : t) =
   match l with
   | [] -> None
-  | (y1, y2, y3) :: t when y1 = x -> Some y2
+  | (y1, y2, _y3) :: _t when y1 = x -> Some y2
   | _ :: t -> assoc3 x t
 ;;
 
 
 
 let usage_b (buf : Ext_buffer.t) speclist errmsg =
-  let print_spec buf (key, spec, doc) =
+  let print_spec buf (key, _spec, doc) =
     if  doc <> "" then begin 
       Ext_buffer.add_string buf "  ";
       Ext_buffer.add_string_char buf key ' ';  
@@ -100,7 +100,7 @@ let parse_exn  (speclist : t) anonfun errmsg =
         | None -> stop_raise (Unknown s)
       in
       begin try
-        let rec treat_action = function
+        let treat_action = function
         | Unit f -> f ();
         | Set r -> r := true;
         | String f when !current + 1 < l ->

jscomp/common/bs_loc.ml

@@ -35,7 +35,7 @@ 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; _} (* TODO: improve*)
     -> 
     {loc_start ;loc_end; loc_ghost = false}
 

jscomp/common/bs_warnings.ml

@@ -39,92 +39,25 @@ let to_string t =
     -> 
     "Here a OCaml polymorphic variant type passed into JS, probably you forgot annotations like `[@bs.int]` or `[@bs.string]`  "
 
-let warning_formatter = Format.err_formatter
-
-let print_string_warning (loc : Location.t) x =   
-  if loc.loc_ghost then 
-    Format.fprintf warning_formatter "File %s@."  !Location.input_name      
-  else 
-    Location.print warning_formatter loc ; 
-  Format.fprintf warning_formatter "@{<error>Warning@}: %s@." x 
 
 let prerr_bs_ffi_warning loc x =  
-    Location.prerr_warning loc (Warnings.Bs_ffi_warning (to_string x))
-
-let unimplemented_primitive = "Unimplemented primitive used:" 
-type error = 
-  | Uninterpreted_delimiters of string
-  | Unimplemented_primitive of string 
-exception  Error of Location.t * error
-
-let pp_error fmt x =
-  match x with 
-  | Unimplemented_primitive str -> 
-    Format.pp_print_string fmt unimplemented_primitive;
-    Format.pp_print_string fmt str
-  
-  | Uninterpreted_delimiters str -> 
-    Format.pp_print_string fmt "Uninterpreted delimiters" ;
-    Format.pp_print_string fmt str
-
-
+    Location.prerr_warning loc (Bs_ffi_warning (to_string x))
 
-let () = 
-  Location.register_error_of_exn (function 
-      | Error (loc,err) -> 
-        Some (Location.error_of_printer loc pp_error err)
-      | _ -> None
-    )
 
 
 
 
-let warn_missing_primitive loc txt =      
-  if not !Js_config.no_warn_unimplemented_external && not !Clflags.bs_quiet then
-    begin 
-      print_string_warning loc ( unimplemented_primitive ^ txt ^ " \n" );
-      Format.pp_print_flush warning_formatter ()
-    end
+let warn_missing_primitive loc txt =  
+  Location.prerr_warning loc (Bs_unimplemented_primitive txt)      
 
 let warn_literal_overflow loc = 
-  if not !Clflags.bs_quiet then
-  begin 
-    print_string_warning loc 
-      "Integer literal exceeds the range of representable integers of type int";
-    Format.pp_print_flush warning_formatter ()  
-  end 
+  Location.prerr_warning loc Bs_integer_literal_overflow
 
 
 
 let error_unescaped_delimiter loc txt = 
-  raise (Error(loc, Uninterpreted_delimiters txt))
-
-
-
-
-
-
-(**
-   Note the standard way of reporting error in compiler:
-
-   val Location.register_error_of_exn : (exn -> Location.error option) -> unit 
-   val Location.error_of_printer : Location.t ->
-   (Format.formatter -> error -> unit) -> error -> Location.error
-
-   Define an error type
-
-   type error 
-   exception Error of Location.t * error 
+  Location.prerr_warning loc (Bs_uninterpreted_delimiters txt)
+  
 
-   Provide a printer to error
 
-   {[
-     let () = 
-       Location.register_error_of_exn
-         (function 
-           | Error(loc,err) -> 
-             Some (Location.error_of_printer loc pp_error err)
-           | _ -> None
-         )
-   ]}
-*)
+  

jscomp/common/js_config.ml

@@ -61,17 +61,14 @@ let diagnose = ref false
 let get_diagnose () = !diagnose
 let set_diagnose b = diagnose := b
 
-let (//) = Filename.concat
+(* let (//) = Filename.concat *)
 
 (* let get_packages_info () = !packages_info *)
 
 let no_builtin_ppx_ml = ref false
 let no_builtin_ppx_mli = ref false
 
 
-(** TODO: will flip the option when it is ready *)
-let no_warn_unimplemented_external = ref false 
-
 let debug_file = ref ""
 
 

jscomp/common/js_config.mli

@@ -63,7 +63,7 @@ val no_builtin_ppx_mli : bool ref
 
 
 
-val no_warn_unimplemented_external : bool ref 
+
 
 (** check-div-by-zero option *)
 val check_div_by_zero : bool ref