make warnings switch applicable to bucklescript internal ppx transform

note that ideally the check should be done in the parsing phase which makes more sense, but it is not done
since it only benefits ocaml syntax and requires more work to do

Author: bobzhang

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

@@ -69,9 +69,6 @@ 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 

jscomp/main/js_main.ml

@@ -201,9 +201,9 @@ let buckle_script_flags : (string * Arg.spec * string) list =
   ("-bs-D", Arg.String define_variable,
      " Define conditional variable e.g, -D DEBUG=true"
   )
-  :: 
-  ("-bs-quiet", Arg.Set Clflags.bs_quiet,
-    " Quiet mode (no warnings printed)"
+  ::
+  ("-bs-quiet", Arg.Unit (fun _ -> ()),
+    " (Deprecated using -w a) Quiet mode (no warnings printed)"
   )
   ::
   ("-bs-list-conditionals",
@@ -294,8 +294,8 @@ let buckle_script_flags : (string * Arg.spec * string) list =
    " set npm-output-path: [opt_module]:path, for example: 'lib/cjs', 'amdjs:lib/amdjs', 'es6:lib/es6' ")
   ::
   ("-bs-no-warn-unimplemented-external",
-    Arg.Set Js_config.no_warn_unimplemented_external,
-    " disable warnings on unimplmented c externals"
+    Arg.Unit (fun _ -> ()),
+    " Deprecated: use warning 106"
   )
   ::
   ("-bs-no-builtin-ppx-ml", 

jscomp/syntax/bs_ast_invariant.ml

@@ -145,7 +145,30 @@ let emit_external_warnings : iterator=
       end 
   }
 
-let emit_external_warnings_on_structure  (stru : Parsetree.structure) = 
+let rec iter_warnings_on_stru (stru : Parsetree.structure) = 
+  match stru with 
+  | [] -> ()  
+  | head :: rest -> 
+    begin match head.pstr_desc with 
+      | Pstr_attribute attr -> 
+        Builtin_attributes.warning_attribute attr;
+        iter_warnings_on_stru rest 
+      |  _ -> ()
+    end
+
+let rec iter_warnings_on_sigi (stru : Parsetree.signature) = 
+  match stru with 
+  | [] -> ()  
+  | head :: rest -> 
+    begin match head.psig_desc with 
+      | Psig_attribute attr -> 
+        Builtin_attributes.warning_attribute attr;
+        iter_warnings_on_sigi rest 
+      |  _ -> ()
+    end
+
+
+let emit_external_warnings_on_structure  (stru : Parsetree.structure) =   
   if Warnings.is_active dummy_unused_attribute then 
     emit_external_warnings.structure emit_external_warnings stru
 

jscomp/syntax/bs_ast_invariant.mli

@@ -34,6 +34,13 @@ val warn_discarded_unused_attributes :
   Parsetree.attributes -> unit 
 (** Ast invariant checking for detecting errors *)
 
+
+val iter_warnings_on_stru:
+  Parsetree.structure -> unit 
+
+val iter_warnings_on_sigi: 
+  Parsetree.signature -> unit 
+  
 val emit_external_warnings_on_structure:
   Parsetree.structure -> unit 
 

jscomp/syntax/bs_builtin_ppx.ml

@@ -382,6 +382,7 @@ let signature_config_table : action_table =
 
 
 let rewrite_signature (x : Parsetree.signature) =  
+  Bs_ast_invariant.iter_warnings_on_sigi x;  
   let result = 
     match x with
     | {psig_desc = Psig_attribute ({txt = "ocaml.ppx.context"},_)}
@@ -399,7 +400,8 @@ let rewrite_signature (x : Parsetree.signature) =
   result
 
 (* Note we also drop attributes like [@@@bs.deriving ] for convenience*)    
-let rewrite_implementation (x : Parsetree.structure) =  
+let rewrite_implementation (x : Parsetree.structure) = 
+  Bs_ast_invariant.iter_warnings_on_stru x ;   
   let result =
     match x with
     | {pstr_desc = Pstr_attribute ({txt = "ocaml.ppx.context"},_)}