Move the code for attr_warning in ppx_deriving

Author: Thomas Braibant

src/ppx_deriving.ml

@@ -161,6 +161,11 @@ let attr ~deriver name attrs =
   try Some (List.find (fun ({ txt }, _) -> txt = name) attrs)
   with Not_found -> None
 
+let attr_warning expr =
+  let loc = !default_loc in
+  let structure = {pstr_desc = Pstr_eval (expr, []); pstr_loc = loc} in
+  {txt = "ocaml.warning"; loc}, PStr [structure]
+
 let fold_left_type_params fn accum params =
   List.fold_left (fun accum (param, _) ->
       match param with

src/ppx_deriving.mli

@@ -159,6 +159,9 @@ val mangle_lid : ?fixpoint:string ->
     or [\[\@attr\]] otherwise. *)
 val attr : deriver:string -> string -> attributes -> attribute option
 
+(** [attr_warning expr] builds the attribute [@ocaml.warning expr] *)
+val attr_warning: expression -> attribute
+
 (** [free_vars_in_core_type typ] returns unique free variables in [typ] in
     lexical order. *)
 val free_vars_in_core_type : core_type -> string list
@@ -239,7 +242,7 @@ val seq_reduce : ?sep:expression -> expression -> expression -> expression
 (** [binop_reduce] ≡ [fun x a b -> [%expr [%e x] [%e a] [%e b]]]. *)
 val binop_reduce : expression -> expression -> expression -> expression
 
-(** [strong_type_of_type ty] transform a type ty to 
+(** [strong_type_of_type ty] transform a type ty to
     [freevars . ty], giving a strong polymorphic type *)
 val strong_type_of_type: core_type -> core_type
 

src_plugins/ppx_deriving_ord.ml

@@ -46,14 +46,9 @@ let wildcard_case int_cases =
     let to_int = [%e Exp.function_ int_cases] in
     Pervasives.compare (to_int lhs) (to_int rhs)]
 
-let attr_warning expr =
-  let loc = !default_loc in
-  let structure = {pstr_desc = Pstr_eval (expr, []); pstr_loc = loc} in
-  {txt = "ocaml.warning"; loc}, PStr [structure]
-
 (* deactivate warning 4 in code that uses [wildcard_case] *)
 let warning_minus_4 =
-  attr_warning [%expr "-4"]
+  Ppx_deriving.attr_warning [%expr "-4"]
 
 let pattn side typs =
   List.mapi (fun i _ -> pvar (argn side i)) typs