allow disabling warnings on command-line (and have various warnings level)

15 files changed, 319 insertions, 224 deletions

diff --git a/perl_checker.src/Makefile b/perl_checker.src/Makefile
index b639e6c..22a45a6 100644
--- a/perl_checker.src/Makefile
+++ b/perl_checker.src/Makefile
@@ -4,7 +4,7 @@ YFLAGS = -v
 TRASH = parser.output perl_checker.html TAGS
 RESULT  = perl_checker
 BCSUFFIX = _debug
-SOURCES = build.ml common.ml flags.ml config_file.ml types.mli info.ml parser_helper.ml parser.mly lexer.mll tree.ml global_checks.ml perl_checker.ml
+SOURCES = types.mli build.ml common.ml flags.ml config_file.ml info.ml parser_helper.ml parser.mly lexer.mll tree.ml global_checks.ml perl_checker.ml
 LIBS = unix
 VENDORLIB = $(shell dirname `pwd`)
 DEBUG = 1
diff --git a/perl_checker.src/common.ml b/perl_checker.src/common.ml
index 8a0d27e..dd2f6b1 100644
--- a/perl_checker.src/common.ml
+++ b/perl_checker.src/common.ml
@@ -228,6 +228,13 @@ let rec lfix_point f e =
   if e = e' then e :: lfix_point f e' else [e]
 *)
 
+let fluid_let ref value f =
+  let previous_val = !ref in
+  ref := value ;
+  let v = f() in
+  ref := previous_val ;
+  v
+
 let do0_withenv doit f env l =
   let r_env = ref env in
   doit (fun e -> r_env := f !r_env e) l ;
@@ -882,9 +889,7 @@ let rec updir dir nb =
 let (string_of_ref : 'a ref -> string) = fun r ->
   Printf.sprintf "0x%x" (Obj.magic r : int)
 
-let print_endline_flush_quiet = ref false
-let print_endline_flush s = if not !print_endline_flush_quiet then (print_endline s ; flush stdout)
-let print_endline_flush_always s = print_endline s ; flush stdout
+let print_endline_flush s = print_endline s ; flush stdout
 
 let is_int n = n = floor n
 
diff --git a/perl_checker.src/common.mli b/perl_checker.src/common.mli
index 17b0ca5..86a13cd 100644
--- a/perl_checker.src/common.mli
+++ b/perl_checker.src/common.mli
@@ -52,6 +52,7 @@ val fix_point : ('a -> 'a) -> 'a -> 'a
 val fix_point_withenv : ('a -> 'b -> 'b * 'a) -> 'a -> 'b -> 'b * 'a
 val fix_point_ : int -> ('a -> 'a) -> 'a -> 'a * int
 val group_by_2 : 'a list -> ('a * 'a) list
+val fluid_let : 'a ref -> 'a -> (unit -> 'b) -> 'b
 val do0_withenv :
   (('a -> unit) -> 'b -> 'c) -> ('d -> 'a -> 'd) -> 'd -> 'b -> 'd
 val do0_withenv2 :
@@ -219,9 +220,7 @@ val expand_symlinks : string -> string
 val mtime : string -> float
 val updir : string -> int -> string
 val string_of_ref : 'a ref -> string
-val print_endline_flush_quiet : bool ref
 val print_endline_flush : string -> unit
-val print_endline_flush_always : string -> unit
 val is_int : float -> bool
 val compare_lists : ('a -> 'b -> int) -> 'a list -> 'b list -> int
 val compare_best : int -> int -> int
diff --git a/perl_checker.src/flags.ml b/perl_checker.src/flags.ml
index fdedc95..187c140 100644
--- a/perl_checker.src/flags.ml
+++ b/perl_checker.src/flags.ml
@@ -1,8 +1,43 @@
 open Common
+open Types
 
 let verbose = ref false
 let quiet = ref false
 let generate_pot = ref false
 let expand_tabs = ref (Some 8)
-let check_unused_global_vars = ref false
 let no_cache = ref false
+
+let check_unused_global_vars = ref false
+let check_white_space = ref true
+let check_suggest_simpler = ref true
+let check_void = ref true
+let check_context = ref true
+let check_strange = ref true
+let check_traps = ref true
+let check_complex_expressions = ref true
+let normalized_expressions = ref true
+let check_help_perl_checker = ref true
+let suggest_functional = ref true
+let check_prototypes = ref true
+let check_names = ref true
+let check_import_export = ref true
+let allow_MDK_Common = ref true
+
+let is_warning_type_set = function
+  | Warn_white_space -> !check_white_space
+  | Warn_suggest_simpler -> !check_suggest_simpler
+  | Warn_unused_global_vars -> !check_unused_global_vars
+  | Warn_void -> !check_void
+  | Warn_context -> !check_context
+  | Warn_strange -> !check_strange
+  | Warn_traps -> !check_traps
+  | Warn_complex_expressions -> !check_complex_expressions
+  | Warn_normalized_expressions -> !normalized_expressions
+  | Warn_suggest_functional -> !suggest_functional
+  | Warn_prototypes -> !check_prototypes
+  | Warn_names -> !check_names
+  | Warn_import_export -> !check_import_export
+  | Warn_MDK_Common -> !allow_MDK_Common
+  | Warn_help_perl_checker -> !check_help_perl_checker
+
+let are_warning_types_set l = not !quiet && List.for_all is_warning_type_set l
diff --git a/perl_checker.src/flags.mli b/perl_checker.src/flags.mli
index b3d8ffa..2dc3b26 100644
--- a/perl_checker.src/flags.mli
+++ b/perl_checker.src/flags.mli
@@ -2,5 +2,21 @@ val verbose : bool ref
 val quiet : bool ref
 val generate_pot : bool ref
 val expand_tabs : int option ref
-val check_unused_global_vars : bool ref
 val no_cache : bool ref
+val check_unused_global_vars : bool ref
+val check_white_space : bool ref
+val check_suggest_simpler : bool ref
+val check_void : bool ref
+val check_context : bool ref
+val check_strange : bool ref
+val check_traps : bool ref
+val check_complex_expressions : bool ref
+val normalized_expressions : bool ref
+val check_help_perl_checker : bool ref
+val suggest_functional : bool ref
+val check_prototypes : bool ref
+val check_names : bool ref
+val check_import_export : bool ref
+val allow_MDK_Common : bool ref
+val is_warning_type_set : Types.warning -> bool
+val are_warning_types_set : Types.warning list -> bool
diff --git a/perl_checker.src/global_checks.ml b/perl_checker.src/global_checks.ml
index 5875dce..7b24d50 100644
--- a/perl_checker.src/global_checks.ml
+++ b/perl_checker.src/global_checks.ml
@@ -36,7 +36,7 @@ let rec get_imported state current_package (package_name, (imports, pos)) =
 	  try
 	    sndter3 (List.assoc var (get_imports state package_used))
 	  with Not_found ->
-	    warn_with_pos pos (sprintf "name %s is not defined in package %s" (variable2s var) package_name) ;
+	    warn_with_pos [Warn_import_export] pos (sprintf "name %s is not defined in package %s" (variable2s var) package_name) ;
 	    ref Access_various, None
       in
       var, (package_name, b, prototype)
@@ -59,12 +59,12 @@ let rec get_imported state current_package (package_name, (imports, pos)) =
 	    | I_raw, tag -> 
 		(try 
 		  List.assoc tag exports.export_tags
-		with Not_found -> warn_with_pos pos (sprintf "package %s doesn't export tag %s" package_name tag) ; [])
+		with Not_found -> warn_with_pos [Warn_import_export] pos (sprintf "package %s doesn't export tag %s" package_name tag) ; [])
 	    | variable ->
 		if List.mem variable exports.export_ok || List.mem variable exports.export_auto then
 		  [ variable ]
 		else
-		  (warn_with_pos pos (sprintf "package %s doesn't export %s" package_name (variable2s variable)) ; [])
+		  (warn_with_pos [Warn_import_export] pos (sprintf "package %s doesn't export %s" package_name (variable2s variable)) ; [])
 		  ) l
 	in
 	List.map get_var_by_name imports_vars
@@ -99,8 +99,8 @@ let check_para_comply_with_prototype para proto =
   | None -> ()
   | Some(pos, para) -> 
       match do_para_comply_with_prototype para proto with
-      | -1 -> warn_with_pos pos "not enough parameters"
-      |  1 -> warn_with_pos pos "too many parameters"
+      | -1 -> warn_with_pos [Warn_prototypes] pos "not enough parameters"
+      |  1 -> warn_with_pos [Warn_prototypes] pos "too many parameters"
       | _ -> ()
 
 let is_anonymous_variable_name s = String.length s > 1 && s.[0] = '_'
@@ -192,18 +192,18 @@ let is_global_var context ident =
 let check_variable (context, var) vars para = 
   match var with
   | Ident(_, s, pos) when context <> I_func && is_anonymous_variable_name s && s <> "__FILE__" && s <> "__LINE__" ->
-      warn_with_pos pos (sprintf "variable %s must not be used\n  (variable with name _XXX are reserved for unused variables)" (variable2s(context, string_of_Ident var)))
+      warn_with_pos [Warn_normalized_expressions] pos (sprintf "variable %s must not be used\n  (variable with name _XXX are reserved for unused variables)" (variable2s(context, string_of_Ident var)))
   | Ident(Some pkg, _, _) when uses_external_package pkg || List.mem pkg !ignored_packages -> ()
   | Ident(None, ident, pos) ->
       if is_my_declared vars (context, ident) || is_our_declared vars (context, ident) || is_var_declared vars (context, ident) para || is_global_var context ident
       then () 
-      else warn_with_pos pos (if context = I_func then "unknown function " ^ ident else "undeclared variable " ^ variable2s(context, ident))
+      else warn_with_pos [Warn_names] pos (if context = I_func then "unknown function " ^ ident else "undeclared variable " ^ variable2s(context, ident))
   | Ident(Some fq, name, pos) -> 
       if (fq = "CORE") && is_global_var context name || is_global_var_declared vars (context, fq, name) para
       then ()
       else 
 	if context = I_func then 
-	  warn_with_pos pos ("unknown function " ^ string_of_Ident var)
+	  warn_with_pos [Warn_names] pos ("unknown function " ^ string_of_Ident var)
 	else
 	  lpush vars.state.global_vars_used ((context, fq, name), pos)
   | _ -> ()
@@ -216,7 +216,7 @@ let declare_My vars (mys, pos) =
   ) mys in
   let l_pre = List.hd vars.my_vars in
   List.iter (fun v ->
-    if List.mem_assoc v l_pre then warn_with_pos pos (sprintf "redeclared variable %s" (variable2s v))
+    if List.mem_assoc v l_pre then warn_with_pos [Warn_names] pos (sprintf "redeclared variable %s" (variable2s v))
   ) l_new ;
   { vars with my_vars = (List.map (fun v -> v, (pos, ref Access_none, None)) l_new @ l_pre) :: List.tl vars.my_vars }
 
@@ -225,7 +225,7 @@ let declare_Our vars (ours, pos) =
   | [] -> vars (* we're at the toplevel, already declared in vars_declared *)
   | l_pre :: other ->
       List.iter (fun v ->
-	if List.mem_assoc v l_pre && v <> (I_scalar, "_") then warn_with_pos pos (sprintf "redeclared variable %s" (variable2s v))
+	if List.mem_assoc v l_pre && v <> (I_scalar, "_") then warn_with_pos [Warn_names] pos (sprintf "redeclared variable %s" (variable2s v))
       ) ours ;
       { vars with our_vars = (List.map (fun v -> v, (pos, ref Access_none, None)) ours @ l_pre) :: other }
 
@@ -246,11 +246,11 @@ let check_unused_local_variables vars =
       match s with
       | "BEGIN" | "END" | "DESTROY" -> ()
       | "_" when context = I_array ->
-	  warn_with_pos pos "if the function doesn't take any parameters, please use the empty prototype.\nexample \"sub foo() { ... }\""
+	  warn_with_pos [Warn_normalized_expressions] pos "if the function doesn't take any parameters, please use the empty prototype.\nexample \"sub foo() { ... }\""
       | _ ->
 	  if s.[0] != '_' || s = "_" then
 	    let msg = if !used = Access_write_only then sprintf "variable %s assigned, but not read" else sprintf "unused variable %s" in
-	    warn_with_pos pos (msg (variable2s v))
+	    warn_with_pos [Warn_names] pos (msg (variable2s v))
   ) (List.hd vars.my_vars)
 
 let check_variables vars t = 
@@ -287,7 +287,7 @@ let check_variables vars t =
 	(* special warning if @_ is unbound *)
 	check_variable (I_func, ident) vars None ;
 	if not (is_my_declared vars (I_array, "_")) then
-	  warn_with_pos pos (sprintf "replace %s(@_) with &%s" (string_of_Ident ident) (string_of_Ident ident)) ;
+	  warn_with_pos [Warn_suggest_simpler] pos (sprintf "replace %s(@_) with &%s" (string_of_Ident ident) (string_of_Ident ident)) ;
 	Some vars
 
     | Call(Deref(I_func, Ident(None, "require", _)), [Ident _]) -> Some vars
@@ -308,7 +308,7 @@ let check_variables vars t =
 	let vars = check_variables_ vars l in
 	let vars' = { vars with my_vars = [] :: vars.my_vars ; our_vars = [(I_scalar, "_"), (pos, ref Access_various, None)] :: vars.our_vars } in
 	let vars' = check_variables_ vars' expr in
-	if List.hd(vars'.my_vars) <> [] then warn_with_pos pos "you can't declare variables in foreach infix";
+	if List.hd(vars'.my_vars) <> [] then warn_with_pos [Warn_traps] pos "you can't declare variables in foreach postfix";
 	Some vars
 
     | Call_op("foreach my", [my; expr; Block block], _) ->
@@ -379,7 +379,7 @@ let check_variables vars t =
 	(* check e first *)
 	let vars = check_variables_ vars e in
 	List.iter (fun (context, var) ->
-	  if non_scalar_context context then warn_with_pos pos (sprintf "%s takes all the arguments, %s is undef in any case" (variable2s (context, var)) (variable2s (last mys)))
+	  if non_scalar_context context then warn_with_pos [Warn_prototypes] pos (sprintf "%s takes all the arguments, %s is undef in any case" (variable2s (context, var)) (variable2s (last mys)))
 	) (removelast mys) ; (* mys is never empty *)
 	Some(declare_My_our vars (my_or_our, mys, pos))
 
@@ -387,7 +387,7 @@ let check_variables vars t =
     | Call_op(op, List (My_our _ :: _) :: _, pos) 
     | Call_op(op, My_our _ :: _, pos)
     | Call_op(op, Call_op("local", _, _) :: _, pos) ->
-	if op <> "=" then warn_with_pos pos (sprintf "applying %s on a new initialized variable is wrong" op);
+	if op <> "=" then warn_with_pos [Warn_traps] pos (sprintf "applying %s on a new initialized variable is wrong" op);
 	None
 
     | Call_op("=", [ Deref(context, (Ident _ as var)) ; para], _) ->
@@ -429,8 +429,8 @@ let check_variables vars t =
 	in
 	(try
 	  if not (uses_external_package pkg || List.mem pkg !ignored_packages || search pkg || method_ = "bootstrap") then 
-	    warn_with_pos pos (sprintf "unknown method %s starting in package %s" method_ pkg);
-	with Not_found -> warn_with_pos pos (sprintf "unknown package %s" pkg));
+	    warn_with_pos [Warn_import_export] pos (sprintf "unknown method %s starting in package %s" method_ pkg);
+	with Not_found -> warn_with_pos [Warn_import_export] pos (sprintf "unknown package %s" pkg));
 	Some vars
 
     | Method_call(o, Raw_string(method_, pos), para) ->
@@ -443,16 +443,16 @@ let check_variables vars t =
 	    match List.filter (fun (_, n) -> n = 0) l_and with
 	    | [] ->
 		(match uniq (List.map snd l_and) with
-		| [-1] -> warn_with_pos pos "not enough parameters"
-		| [ 1] -> warn_with_pos pos "too many parameters"
-		| _ -> warn_with_pos pos "not enough or too many parameters") ;
+		| [-1] -> warn_with_pos [Warn_prototypes] pos "not enough parameters"
+		| [ 1] -> warn_with_pos [Warn_prototypes] pos "too many parameters"
+		| _ -> warn_with_pos [Warn_prototypes] pos "not enough or too many parameters") ;
 		l_and
 	    | l -> l
 	  in
 	  List.iter (fun (used, _) -> used := Access_various) l_and
 	with Not_found -> 
 	  if not (List.mem method_ [ "isa"; "can" ]) then
-	    warn_with_pos pos ("unknown method " ^ method_)) ;
+	    warn_with_pos [Warn_names] pos ("unknown method " ^ method_)) ;
 	Some vars
 	
     | _ -> None
@@ -462,7 +462,7 @@ let check_variables vars t =
 
 let check_tree state package =
   let vars = { my_vars = [[]]; our_vars = []; locally_imported = []; required_vars = []; current_package = package; state = state; is_toplevel = true; write_only = false } in
-  if !Flags.verbose then print_endline_flush_always ("checking package " ^ package.package_name) ;
+  if !Flags.verbose then print_endline_flush ("checking package " ^ package.package_name) ;
   let vars = check_variables vars package.body in
   check_unused_local_variables vars ;
   ()
@@ -501,7 +501,7 @@ let add_file_to_files per_files file =
 let check_unused_vars package =
   Hashtbl.iter (fun (context, name) (pos, is_used, _proto) ->
     if not (!is_used != Access_various || List.mem name ["BEGIN"; "END"; "DESTROY"; "ISA"; "AUTOLOAD"; "EXPORT"; "EXPORT_OK"; "EXPORT_TAGS"]) then
-      warn_with_pos pos (sprintf "unused %s%s::%s" (if context = I_func then "function " else "variable " ^ context2s context) package.package_name name)
+      warn_with_pos [Warn_unused_global_vars] pos (sprintf "unused %s%s::%s" (if context = I_func then "function " else "variable " ^ context2s context) package.package_name name)
   ) package.vars_declared
 
 let arrange_global_vars_declared global_vars_declared state =
diff --git a/perl_checker.src/lexer.mll b/perl_checker.src/lexer.mll
index 8d6714c..ebd183e 100644
--- a/perl_checker.src/lexer.mll
+++ b/perl_checker.src/lexer.mll
@@ -62,8 +62,8 @@ let pos lexbuf = lexeme_start lexbuf, lexeme_end lexbuf
 let pos2sfull_with start end_ = Info.pos2sfull (!current_file, start, end_)
 let pos2sfull lexbuf = pos2sfull_with (lexeme_start lexbuf) (lexeme_end lexbuf)
 
-let warn_with_pos (start, end_) err = print_endline_flush (pos2sfull_with start end_ ^ err)
-let warn lexbuf err = warn_with_pos (pos lexbuf) err
+let warn_with_pos warn_types (start, end_) err = if Flags.are_warning_types_set warn_types then print_endline_flush (pos2sfull_with start end_ ^ err)
+let warn warn_types lexbuf err = warn_with_pos warn_types (pos lexbuf) err
 let die lexbuf err = failwith (pos2sfull_with (lexeme_start lexbuf) (lexeme_end lexbuf) ^ err)
 
 let rec concat_bareword_paren accu = function
@@ -81,7 +81,7 @@ let rec concat_bareword_paren accu = function
       | BAREWORD("N_", _) :: PAREN(_) :: _ ->
 	  concat_bareword_paren (e :: accu) l
       | _ -> 
-	  warn_with_pos pos "N(...) must follow the #-PO: comment, with nothing in between" ;
+	  warn_with_pos [Warn_MDK_Common] pos "N(...) must follow the #-PO: comment, with nothing in between" ;
 	  concat_bareword_paren accu l)
   | [] -> List.rev accu
   | e :: l -> 
@@ -267,7 +267,7 @@ let current_string_start_line = ref 0
 
 let die_in_string lexbuf err = failwith (pos2sfull_with !current_string_start_pos (lexeme_end lexbuf) ^ err)
 let warn_escape_unneeded lexbuf c = 
-  let s = String.make 1 c in warn lexbuf ("you can replace \\" ^ s ^ " with " ^ s)
+  let s = String.make 1 c in warn [Warn_suggest_simpler] lexbuf ("you can replace \\" ^ s ^ " with " ^ s)
 let next_interpolated toks =
   let r = Stack.top building_current_string in
   Queue.push (!r, toks) (Stack.top building_current_interpolated_string) ;
@@ -301,7 +301,7 @@ let ins_to_string t lexbuf =
     (match !string_escape_useful, s with
     | Right c, [ _, [] ] ->
 	let s = String.make 1 c in
-	warn_with_pos pos ("you can replace \"xxx\\" ^ s ^ "xxx\" with 'xxx" ^ s ^ "xxx', that way you don't need to escape <" ^ s ^ ">")
+	warn_with_pos [Warn_suggest_simpler] pos ("you can replace \"xxx\\" ^ s ^ "xxx\" with 'xxx" ^ s ^ "xxx', that way you don't need to escape <" ^ s ^ ">")
     | _ -> 
 	if !string_quote_escape then
 	  let full_s = String.concat "" (List.map fst s) in
@@ -311,7 +311,7 @@ let ins_to_string t lexbuf =
 	    if c = ')' then nb - 1 else nb
 	  ) 0 full_s in
 	  if nb = 0 then
-	    warn_with_pos pos "you can replace \"xxx\\\"xxx\" with qq(xxx\"xxx), that way you don't need to escape <\">"
+	    warn_with_pos [Warn_suggest_simpler] pos "you can replace \"xxx\\\"xxx\" with qq(xxx\"xxx), that way you don't need to escape <\">"
     );
 
   not_ok_for_match := lexeme_end lexbuf; 
@@ -326,8 +326,8 @@ let next t lexbuf = next_s (lexeme lexbuf) t lexbuf
 let ins_re re_delimited_string lexbuf =
   let s, pos = ins re_delimited_string lexbuf in
   List.iter (fun (s, _) ->
-    if str_contains s "[^\\s]" then warn lexbuf "you can replace [^\\s] with \\S";
-    if str_contains s "[^\\w]" then warn lexbuf "you can replace [^\\w] with \\W"
+    if str_contains s "[^\\s]" then warn [Warn_suggest_simpler] lexbuf "you can replace [^\\s] with \\S";
+    if str_contains s "[^\\w]" then warn [Warn_suggest_simpler] lexbuf "you can replace [^\\w] with \\W"
   ) s ;
   s, pos
 
@@ -404,8 +404,8 @@ let set_delimit_char lexbuf op =
   let c = lexeme_char lexbuf (String.length op) in
   delimit_char := c;
   match c with
-  | '@' -> warn lexbuf ("don't use " ^ op ^ "@...@, replace @ with / ! , or |")
-  | ':' -> warn lexbuf ("don't use " ^ op ^ ":...:, replace : with / ! , or |")
+  | '@' -> warn [Warn_complex_expressions] lexbuf ("don't use " ^ op ^ "@...@, replace @ with / ! , or |")
+  | ':' -> warn [Warn_complex_expressions] lexbuf ("don't use " ^ op ^ ":...:, replace : with / ! , or |")
   | _ -> ()
 
 let set_delimit_char_open lexbuf op =
@@ -417,9 +417,9 @@ let set_delimit_char_open lexbuf op =
     | _ -> internal_error "set_delimit_char_open"
   in
   if op = "qx" then 
-    warn lexbuf (Printf.sprintf "don't use qx%c...%c, use `...` instead" char_open char_close)
+    warn [Warn_complex_expressions] lexbuf (Printf.sprintf "don't use qx%c...%c, use `...` instead" char_open char_close)
   else if char_open = '{' then
-    warn lexbuf ("don't use " ^ op ^ "{...}, use " ^ op ^ "(...) instead");
+    warn [Warn_complex_expressions] lexbuf ("don't use " ^ op ^ "{...}, use " ^ op ^ "(...) instead");
   delimit_char_open := char_open;
   delimit_char_close := char_close
 }
@@ -498,7 +498,7 @@ rule token = parse
 | "=" | "+=" | "-=" | "*=" | ".=" | "|=" | "&=" | "^=" | "||=" | "&&=" { ASSIGN(lexeme lexbuf, pos lexbuf) }
 
 | "<<=" | ">>=" | "**=" { 
-    warn lexbuf (Printf.sprintf "don't use \"%s\", use the expanded version instead" (lexeme lexbuf)) ;
+    warn [Warn_complex_expressions] lexbuf (Printf.sprintf "don't use \"%s\", use the expanded version instead" (lexeme lexbuf)) ;
     ASSIGN(lexeme lexbuf, pos lexbuf) 
   }
 
@@ -634,7 +634,7 @@ rule token = parse
   set_delimit_char lexbuf "qw" ;
   current_string_start_line := !current_file_current_line;
   let s, pos = raw_ins delimited_string lexbuf in
-  warn_with_pos pos (Printf.sprintf "don't use qw%c...%c, use qw(...) instead" !delimit_char !delimit_char) ;
+  warn_with_pos [Warn_complex_expressions] pos (Printf.sprintf "don't use qw%c...%c, use qw(...) instead" !delimit_char !delimit_char) ;
   QUOTEWORDS(s, pos)
 }
 
@@ -918,7 +918,7 @@ and string_escape = parse
     | Qq -> if c <> !delimit_char_open && c <> !delimit_char_close then warn_escape_unneeded lexbuf c
     | Here_doc -> warn_escape_unneeded lexbuf c
     | Delimited -> if c = !delimit_char then 
-          warn lexbuf ("change the delimit character " ^ String.make 1 !delimit_char ^ " to get rid of this escape")
+          warn [Warn_suggest_simpler] lexbuf ("change the delimit character " ^ String.make 1 !delimit_char ^ " to get rid of this escape")
         else warn_escape_unneeded lexbuf c);
     let s = if c = '"' then String.make 1 c else "\\" ^ String.make 1 c in
     next_s s (Stack.pop next_rule) lexbuf 
@@ -938,7 +938,7 @@ and re_string_escape = parse
 | _  {
      let c = lexeme_char lexbuf 0 in 
      if c = !delimit_char then 
-       warn lexbuf ("change the delimit character " ^ String.make 1 !delimit_char ^ " to get rid of this escape")
+       warn [Warn_suggest_simpler] lexbuf ("change the delimit character " ^ String.make 1 !delimit_char ^ " to get rid of this escape")
      else warn_escape_unneeded lexbuf c ;
      next_s ("\\" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf 
   }
@@ -956,7 +956,7 @@ and string_interpolate_scalar = parse
 | ident "->"? '{'
 | '"' { putback lexbuf 1; next_s "$" (Stack.pop next_rule) lexbuf }
 | eof {                   next_s "$" (Stack.pop next_rule) lexbuf }
-| _ { warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); next_s ("$" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf }
+| _ { warn [Warn_strange] lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); next_s ("$" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf }
 
 and delimited_string_interpolate_scalar = parse (* needed for delimited string like m!foo$! where $! should not be taken as is... *)
 | '$' ident
@@ -978,7 +978,7 @@ and delimited_string_interpolate_scalar = parse (* needed for delimited string l
 | eof { next_s "$" (Stack.pop next_rule) lexbuf }
 | _ { 
     let c = lexeme_char lexbuf 0 in
-    if c <> !delimit_char && c <> '|' && c<>')' && c<>'/' && c<>' ' then warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); 
+    if c <> !delimit_char && c <> '|' && c<>')' && c<>'/' && c<>' ' then warn [Warn_strange] lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); 
     putback lexbuf 1;
     next_s "$" (Stack.pop next_rule) lexbuf
   }
@@ -991,7 +991,7 @@ and string_interpolate_array = parse
 | [ '@' '*' '<' '>' ']' '.' '(' ' ' ] { next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf }
 | '"' { putback lexbuf 1; next_s "@" (Stack.pop next_rule) lexbuf }
 | eof {                   next_s "@" (Stack.pop next_rule) lexbuf }
-| _ { warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf }
+| _ { warn [Warn_strange] lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf)); next_s ("@" ^ lexeme lexbuf) (Stack.pop next_rule) lexbuf }
 
 and delimited_string_interpolate_array = parse
 | '$' ident
@@ -1003,7 +1003,7 @@ and delimited_string_interpolate_array = parse
 | eof { next_s "@" (Stack.pop next_rule) lexbuf }
 | _ { 
     let c = lexeme_char lexbuf 0 in
-    if c <> !delimit_char then warn lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf));
+    if c <> !delimit_char then warn [Warn_strange] lexbuf (Printf.sprintf "weird \"%s\" in string" (lexeme lexbuf));
     putback lexbuf 1;
     next_s "@" (Stack.pop next_rule) lexbuf
   }
diff --git a/perl_checker.src/parser.mly b/perl_checker.src/parser.mly
index 4b3f70c..88dca94 100644
--- a/perl_checker.src/parser.mly
+++ b/perl_checker.src/parser.mly
@@ -156,7 +156,7 @@ sideff: /* An expression which may have a side-effect */
 decl:
 | FORMAT BAREWORD ASSIGN {to_Call_op M_none "format" [Raw_string($2.any, get_pos $2) ; to_String false (new_1esp (fst $1.any) $1)] $1 $3}
 | FORMAT ASSIGN {new_esp M_none Too_complex $1 $2}
-| func_decl semi_colon {if snd $1.any = None then die_rule "there is no need to pre-declare in Perl!" else (warn_rule "please don't use prototype pre-declaration" ; new_esp M_special Too_complex $1 $2) }
+| func_decl semi_colon {if snd $1.any = None then die_rule "there is no need to pre-declare in Perl!" else (warn_rule [Warn_normalized_expressions] "please don't use prototype pre-declaration" ; new_esp M_special Too_complex $1 $2) }
 | func_decl BRACKET BRACKET_END {sp_n($2); sp_0_or_cr($3); let name, proto = $1.any in new_esp M_none (sub_declaration (name, proto) [] Real_sub_declaration) $1 $3}
 | func_decl BRACKET lines BRACKET_END {sp_n($2); check_block_sub $3 $4; new_esp M_none (sub_declaration $1.any $3.any Real_sub_declaration) $1 $4}
 | func_decl BRACKET BRACKET expr BRACKET_END            BRACKET_END {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); new_esp M_none (sub_declaration $1.any [hash_ref $4] Real_sub_declaration) $1 $6}
@@ -182,7 +182,7 @@ use_revision:
 
 func_decl:
 | SUB word { new_esp M_none ($2.any, None) $1 $2}
-| SUB BAREWORD_PAREN PAREN PAREN_END { warn_rule "remove carriage return between \"sub\" and the function name"; new_esp M_none (Ident(None, $2.any, get_pos $2), Some "") $1 $4 }
+| SUB BAREWORD_PAREN PAREN PAREN_END { warn_rule [Warn_white_space] "remove carriage return between \"sub\" and the function name"; new_esp M_none (Ident(None, $2.any, get_pos $2), Some "") $1 $4 }
 | FUNC_DECL_WITH_PROTO {new_1esp (Ident(fst3 $1.any, snd3 $1.any, get_pos $1), Some (ter3 $1.any)) $1 }
 
 listexpr: /* Basic list expressions */
@@ -242,15 +242,15 @@ term:
 | term PATTERN_MATCH PATTERN_SUBST {sp_n($2); sp_p($3); check_unneeded_var_dollar_s  ($1); to_Call_op_ (M_mixed[M_none; M_int]) P_expr "s///" ($1.any.expr :: from_PATTERN_SUBST $3) $1 $3}
 | term PATTERN_MATCH_NOT PATTERN_SUBST {die_with_rawpos $2.pos "use =~ instead of !~ and negate the return value"}
 
-| term PATTERN_MATCH     QR_PATTERN {warn $3.pos "use m/.../ or /.../ instead of qr/.../ when you do a pattern matching"; to_Call_op_ M_array P_expr "m//"  ($1.any.expr :: from_PATTERN $3) $1 $3}
-| term PATTERN_MATCH_NOT QR_PATTERN {warn $3.pos "use m/.../ or /.../ instead of qr/.../ when you do a pattern matching"; to_Call_op_ M_int   P_expr "!m//" ($1.any.expr :: from_PATTERN $3) $1 $3}
+| term PATTERN_MATCH     QR_PATTERN {warn [Warn_traps] $3.pos "use m/.../ or /.../ instead of qr/.../ when you do a pattern matching"; to_Call_op_ M_array P_expr "m//"  ($1.any.expr :: from_PATTERN $3) $1 $3}
+| term PATTERN_MATCH_NOT QR_PATTERN {warn [Warn_traps] $3.pos "use m/.../ or /.../ instead of qr/.../ when you do a pattern matching"; to_Call_op_ M_int   P_expr "!m//" ($1.any.expr :: from_PATTERN $3) $1 $3}
 | term PATTERN_MATCH     scalar { new_pesp M_array P_expr (Call(Too_complex, [$1.any.expr ; $3.any ])) $1 $3}
 | term PATTERN_MATCH_NOT scalar { new_pesp M_int   P_expr (Call(Too_complex, [$1.any.expr ; $3.any ])) $1 $3}
 
-| term PATTERN_MATCH     RAW_STRING {warn $3.pos "use a regexp, not a string"; to_Call_op_ M_array P_expr "m//"  [ $1.any.expr; to_Raw_string $3 ] $1 $3}
-| term PATTERN_MATCH_NOT RAW_STRING {warn $3.pos "use a regexp, not a string"; to_Call_op_ M_int   P_expr "!m//" [ $1.any.expr; to_Raw_string $3 ] $1 $3}
-| term PATTERN_MATCH     STRING {warn $3.pos "use a regexp, not a string"; to_Call_op_ M_array P_expr "m//"  [ $1.any.expr; to_String false $3 ] $1 $3}
-| term PATTERN_MATCH_NOT STRING {warn $3.pos "use a regexp, not a string"; to_Call_op_ M_int   P_expr "!m//" [ $1.any.expr; to_String false $3 ] $1 $3}
+| term PATTERN_MATCH     RAW_STRING {warn [Warn_complex_expressions] $3.pos "use a regexp, not a string"; to_Call_op_ M_array P_expr "m//"  [ $1.any.expr; to_Raw_string $3 ] $1 $3}
+| term PATTERN_MATCH_NOT RAW_STRING {warn [Warn_complex_expressions] $3.pos "use a regexp, not a string"; to_Call_op_ M_int   P_expr "!m//" [ $1.any.expr; to_Raw_string $3 ] $1 $3}
+| term PATTERN_MATCH     STRING {warn [Warn_complex_expressions] $3.pos "use a regexp, not a string"; to_Call_op_ M_array P_expr "m//"  [ $1.any.expr; to_String false $3 ] $1 $3}
+| term PATTERN_MATCH_NOT STRING {warn [Warn_complex_expressions] $3.pos "use a regexp, not a string"; to_Call_op_ M_int   P_expr "!m//" [ $1.any.expr; to_String false $3 ] $1 $3}
 
 
 | term QUESTION_MARK term COLON term {sp_p($2); sp_p($3); sp_p($4); sp_p($5); mcontext_check M_bool $1; to_Call_op_ (mcontext_merge $3.mcontext $5.mcontext) P_ternary "?:" (check_ternary_paras(prio_lo P_ternary $1, prio_lo_after P_ternary $3, prio_lo_after P_ternary $5)) $1 $5}
@@ -263,13 +263,13 @@ term:
     sp_0($2); 
     match $1.any with
     | "+" ->
-	warn_rule "don't use unary +" ;
+	warn_rule [Warn_normalized_expressions] "don't use unary +" ;
 	to_Call_op_ (mcontext_float_or_int [$2.mcontext]) P_tight "+ unary" [$2.any.expr] $1 $2
     | "-" ->
 	(match $2.any.expr with
 	| Ident(_, _, pos) when $2.spaces = Space_0 ->
 	    let s = "-" ^ string_of_Ident $2.any.expr in
-	    warn_rule (Printf.sprintf "don't use %s, use '%s' instead" s s);
+	    warn_rule [Warn_complex_expressions] (Printf.sprintf "don't use %s, use '%s' instead" s s);
 	    new_pesp M_string P_tok (Raw_string(s, pos)) $1 $2
 	| _ -> to_Call_op_ (mcontext_float_or_int [$2.mcontext]) P_tight "- unary" [$2.any.expr] $1 $2)
     | _ -> die_rule "syntax error"
@@ -280,7 +280,7 @@ term:
 | DECR term    {sp_0($2); mcontext_check M_int $2; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "--" [$2.any.expr] $1 $2}
 | term INCR    {sp_0($2); mcontext_check M_int $1; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "++ post" [$1.any.expr] $1 $2}
 | term DECR    {sp_0($2); mcontext_check M_int $1; to_Call_op_ (M_mixed [M_int ; M_none]) P_tight "-- post" [$1.any.expr] $1 $2}
-| NOT argexpr  {warn_rule "don't use \"not\", use \"!\" instead"; mcontext_check_unop_l M_bool $2; to_Call_op_ M_bool P_and "not" ($2.any.expr) $1 $2}
+| NOT argexpr  {warn_rule [Warn_normalized_expressions] "don't use \"not\", use \"!\" instead"; mcontext_check_unop_l M_bool $2; to_Call_op_ M_bool P_and "not" ($2.any.expr) $1 $2}
 
 /* Constructors for anonymous data */
 
@@ -340,7 +340,7 @@ term:
 | word BRACKET BRACKET expr BRACKET_END            BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($6); new_pesp M_unknown (if $7.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub None (new_esp (M_ref M_hash) [ hash_ref $4 ] $4 $4) :: $7.any.expr)) $1 $7} /* map { { foo } } @bar */
 | word BRACKET BRACKET expr BRACKET_END semi_colon BRACKET_END listexpr %prec LSTOP {sp_n($2); sp_p($3); sp_p($4); sp_p($5); sp_p($7); new_pesp M_unknown (if $8.any.expr = [] then P_tok else P_call_no_paren) (call(Deref(I_func, $1.any), anonymous_sub None (new_esp (M_ref M_hash) [ hash_ref $4; Semi_colon ] $4 $4) :: $8.any.expr)) $1 $8} /* map { { foo }; } @bar */
 
-| term ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); if $4.any.expr = [] then warn $4.pos "remove these unneeded parentheses"; new_pesp M_unknown P_tok (to_Method_call($1.any.expr, $3.any, $4.any.expr)) $1 $4} /* $foo->bar(list) */
+| term ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); if $4.any.expr = [] then warn [Warn_suggest_simpler] $4.pos "remove these unneeded parentheses"; new_pesp M_unknown P_tok (to_Method_call($1.any.expr, $3.any, $4.any.expr)) $1 $4} /* $foo->bar(list) */
 | term ARROW word_or_scalar {sp_0($2); sp_0($3); new_pesp M_unknown P_tok (to_Method_call($1.any.expr, $3.any, [])) $1 $3} /* $foo->bar */
 
 | NEW word { sp_n($2); new_pesp (M_ref M_unknown) P_expr (to_Method_call ($2.any, Ident(None, "new", get_pos $1), [])) $1 $2} /* new Class */
@@ -405,7 +405,7 @@ restricted_subscripted: /* Some kind of subscripted expression */
 | restricted_subscripted arrayref                 {sp_0($2); new_esp M_unknown_scalar  (to_Deref_with(I_array, I_scalar, $1.any, only_one_array_ref $2)) $1 $2} /* $foo->[$bar][$baz] */
 | restricted_subscripted parenthesized            {sp_0($2); new_esp M_unknown (to_Deref_with(I_func , I_scalar, $1.any, List($2.any.expr))) $1 $2} /* $foo->{bar}(@args) */
 
-| restricted_subscripted ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); if $4.any.expr = [] then warn $4.pos "remove these unneeded parentheses"; new_esp M_unknown (to_Method_call($1.any, $3.any, $4.any.expr)) $1 $4} /* $foo->bar(list) */
+| restricted_subscripted ARROW word_or_scalar parenthesized {sp_0($2); sp_0($3); sp_0($4); if $4.any.expr = [] then warn [Warn_suggest_simpler] $4.pos "remove these unneeded parentheses"; new_esp M_unknown (to_Method_call($1.any, $3.any, $4.any.expr)) $1 $4} /* $foo->bar(list) */
 | restricted_subscripted ARROW word_or_scalar {sp_0($2); sp_0($3); new_esp M_unknown (to_Method_call($1.any, $3.any, [])) $1 $3} /* $foo->bar */
 
 arrayref:
diff --git a/perl_checker.src/parser_helper.ml b/perl_checker.src/parser_helper.ml
index b4afdaf..bc22dd9 100644
--- a/perl_checker.src/parser_helper.ml
+++ b/perl_checker.src/parser_helper.ml
@@ -215,17 +215,16 @@ let rec get_pos_from_expr = function
 
 let msg_with_rawpos (start, end_) msg = Info.pos2sfull_current start end_ ^ msg
 let die_with_rawpos raw_pos msg = failwith (msg_with_rawpos raw_pos msg)
-let warn raw_pos msg = print_endline_flush (msg_with_rawpos raw_pos msg)
+let warn warn_types raw_pos msg = if Flags.are_warning_types_set warn_types then print_endline_flush (msg_with_rawpos raw_pos msg)
 
 let die_rule msg = die_with_rawpos (Parsing.symbol_start(), Parsing.symbol_end()) msg
-let warn_rule msg = warn (Parsing.symbol_start(), Parsing.symbol_end()) msg
-let debug msg = if true then print_endline_flush msg
+let warn_rule warn_types msg = warn warn_types (Parsing.symbol_start(), Parsing.symbol_end()) msg
 
-let warn_verb pos msg = if not !Flags.quiet then warn (pos, pos) msg
-let warn_too_many_space start = warn_verb start "you should have only one space here"
-let warn_no_space	start = warn_verb start "you should have a space here"
-let warn_cr		start = warn_verb start "you should not have a carriage-return (\\n) here"
-let warn_space		start = warn_verb start "you should not have a space here"
+let warn_verb warn_types pos msg = if not !Flags.quiet then warn warn_types (pos, pos) msg
+let warn_too_many_space start = warn_verb [Warn_white_space] start "you should have only one space here"
+let warn_no_space	start = warn_verb [Warn_white_space] start "you should have a space here"
+let warn_cr		start = warn_verb [Warn_white_space] start "you should not have a carriage-return (\\n) here"
+let warn_space		start = warn_verb [Warn_white_space] start "you should not have a space here"
 
 let rec prio_less = function
   | P_none, _ | _, P_none -> internal_error "prio_less"
@@ -285,13 +284,13 @@ let prio_lo_check pri_out pri_in pos expr =
     | P_paren pri_in' ->
 	if pri_in' <> pri_out && 
 	   prio_less(pri_in', pri_out) && not_complex (un_parenthesize expr) then 
-	  warn pos "unneeded parentheses"
+	  warn [Warn_suggest_simpler] pos "unneeded parentheses"
     | _ -> ())
   else 
     (match expr with
     | Call_op ("print", [Deref (I_star, Ident (None, "STDOUT", _)); Deref(I_scalar, ident)], _) -> 
-	 warn pos (sprintf "use parentheses: replace \"print $%s ...\" with \"print($%s ...)\"" (string_of_Ident ident) (string_of_Ident ident))
-    | _ -> warn pos "missing parentheses (needed for clarity)")
+	 warn [Warn_traps] pos (sprintf "use parentheses: replace \"print $%s ...\" with \"print($%s ...)\"" (string_of_Ident ident) (string_of_Ident ident))
+    | _ -> warn [Warn_traps] pos "missing parentheses (needed for clarity)")
 
 let prio_lo pri_out in_ = prio_lo_check pri_out in_.any.priority in_.pos in_.any.expr ; in_.any.expr
 
@@ -347,7 +346,7 @@ let sp_cr esp =
   | Space_none -> ()
   | Space_0
   | Space_1
-  | Space_n -> warn_verb (get_pos_start esp) "you should have a carriage-return (\\n) here"
+  | Space_n -> warn_verb [Warn_white_space] (get_pos_start esp) "you should have a carriage-return (\\n) here"
   | Space_cr -> ()
 
 let sp_same esp1 esp2 =
@@ -393,10 +392,10 @@ let word_alone esp =
 	  Deref(I_func, word)
 	    
       | "hex" | "ref" -> 
-	  warn_rule (sprintf "please use \"%s $_\" instead of \"%s\"" f f) ;
+	  warn_rule [Warn_complex_expressions] (sprintf "please use \"%s $_\" instead of \"%s\"" f f) ;
 	  Call(Deref(I_func, word), [ Raw_string(" ", pos) ; var_dollar_ pos ])
       | "time" | "wantarray" | "fork" | "getppid" | "arch" -> 
-	  warn_rule (sprintf "please use %s() instead of %s" f f) ;
+	  warn_rule [Warn_complex_expressions] (sprintf "please use %s() instead of %s" f f) ;
 	  Deref(I_func, word)
       | _ -> word
       in
@@ -429,9 +428,9 @@ let check_parenthesized_first_argexpr_with_Ident ident esp =
   | Ident(Some _, _, _) ->
       (match esp.any.expr with
       | [e] when is_parenthesized e -> ()
-      | _ -> warn_rule "use parentheses around argument (otherwise it might cause syntax errors if the package is \"require\"d and not \"use\"d")
+      | _ -> warn_rule [Warn_suggest_simpler] "use parentheses around argument (otherwise it might cause syntax errors if the package is \"require\"d and not \"use\"d")
   | Ident(None, word, _) when List.mem word ["ref" ; "readlink"] ->
-      if esp.any.priority <> P_tok then warn_rule "use parentheses around argument"
+      if esp.any.priority <> P_tok then warn_rule [Warn_complex_expressions] "use parentheses around argument"
   | _ -> ());
   check_parenthesized_first_argexpr (string_of_Ident ident) esp
 
@@ -442,19 +441,19 @@ let check_hash_subscript esp =
 	char_is_alpha s.[0] && (String.length s = 1 || string_forall_with char_is_alphanumerical_ 1 s)
   in
   match esp.any.expr with
-  | List [String ([(s, List [])], _)] when can_be_raw_string s -> warn esp.pos (sprintf "{\"%s\"} can be written {%s}" s s)
-  | List [Raw_string(s, _)] when can_be_raw_string s -> warn esp.pos (sprintf "{'%s'} can be written {%s}" s s)
+  | List [String ([(s, List [])], _)] when can_be_raw_string s -> warn [Warn_suggest_simpler] esp.pos (sprintf "{\"%s\"} can be written {%s}" s s)
+  | List [Raw_string(s, _)] when can_be_raw_string s -> warn [Warn_suggest_simpler] esp.pos (sprintf "{'%s'} can be written {%s}" s s)
   | _ -> ()
 
 let check_arrow_needed esp1 esp2 =
   match esp1.any.expr with
   | Deref_with(I_array, I_scalar, List [List [Call _]], _) -> () (* "->" needed for (f())[0]->{XX} *)
-  | Deref_with _ -> warn esp2.pos "the arrow \"->\" is unneeded"
+  | Deref_with _ -> warn [Warn_suggest_simpler] esp2.pos "the arrow \"->\" is unneeded"
   | _ -> ()
 
 let check_scalar_subscripted esp =
   match esp.any with
-  | Deref(I_scalar, Deref _) -> warn_rule "for complex dereferencing, use \"->\""
+  | Deref(I_scalar, Deref _) -> warn_rule [Warn_complex_expressions] "for complex dereferencing, use \"->\""
   | _ -> ()
 
 let negatable_ops = collect (fun (a, b) -> [ a, b ; b, a ]) [
@@ -465,13 +464,13 @@ let negatable_ops = collect (fun (a, b) -> [ a, b ; b, a ]) [
 let check_negatable_expr esp =
   match un_parenthesize_full esp.any.expr with
   | Call_op("m//", var :: _, _) when not (is_var_dollar_ var) ->
-      warn_rule "!($var =~ /.../) is better written $var !~ /.../"
+      warn_rule [Warn_suggest_simpler] "!($var =~ /.../) is better written $var !~ /.../"
   | Call_op("!m//", var :: _, _) when not (is_var_dollar_ var) ->
-      warn_rule "!($var !~ /.../) is better written $var =~ /.../"
+      warn_rule [Warn_suggest_simpler] "!($var !~ /.../) is better written $var =~ /.../"
   | Call_op(op, _, _) ->
       (try
 	let neg_op = List.assoc op negatable_ops in
-        warn_rule (Printf.sprintf "!($foo %s $bar) is better written $foo %s $bar" op neg_op)
+        warn_rule [Warn_suggest_simpler] (Printf.sprintf "!($foo %s $bar) is better written $foo %s $bar" op neg_op)
       with Not_found -> ())
   | _ -> ()
 
@@ -495,42 +494,42 @@ let check_ternary_paras(cond, a, b) =
     | e -> dont_need_short_circuit_rec e
   in
   let check_ternary_para = function
-    | List [] -> warn_rule "you may use if_() here\n  beware that the short-circuit semantic of ?: is not kept\n  if you want to keep the short-circuit behaviour, replace () with @{[]} and there will be no warning anymore"
+    | List [] -> warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you may use if_() here\n  beware that the short-circuit semantic of ?: is not kept\n  if you want to keep the short-circuit behaviour, replace () with @{[]} and there will be no warning anymore"
     | _ -> ()
   in
   if dont_need_short_circuit a || is_same_fromparser cond a then check_ternary_para b;
   if dont_need_short_circuit b || is_same_fromparser cond b then check_ternary_para a;
-  if is_same_fromparser cond a && is_a_scalar a && is_a_scalar b then warn_rule "you can replace \"$foo ? $foo : $bar\" with \"$foo || $bar\"";
+  if is_same_fromparser cond a && is_a_scalar a && is_a_scalar b then warn_rule [Warn_suggest_simpler] "you can replace \"$foo ? $foo : $bar\" with \"$foo || $bar\"";
   [ cond; a; b ]
 
 let check_unneeded_var_dollar_ esp =
-  if is_var_dollar_ esp.any.expr then warn esp.pos "\"$_ =~ /regexp/\" can be written \"/regexp/\"" else
-  if is_var_number_match esp.any.expr then warn esp.pos "do not use the result of a match (eg: $1) to match another pattern"
+  if is_var_dollar_ esp.any.expr then warn [Warn_suggest_simpler] esp.pos "\"$_ =~ /regexp/\" can be written \"/regexp/\"" else
+  if is_var_number_match esp.any.expr then warn [Warn_complex_expressions] esp.pos "do not use the result of a match (eg: $1) to match another pattern"
 let check_unneeded_var_dollar_not esp =
-  if is_var_dollar_ esp.any.expr then warn esp.pos "\"$_ !~ /regexp/\" can be written \"!/regexp/\"" else
-  if is_var_number_match esp.any.expr then warn esp.pos "do not use the result of a match (eg: $1) to match another pattern"
+  if is_var_dollar_ esp.any.expr then warn [Warn_suggest_simpler] esp.pos "\"$_ !~ /regexp/\" can be written \"!/regexp/\"" else
+  if is_var_number_match esp.any.expr then warn [Warn_complex_expressions] esp.pos "do not use the result of a match (eg: $1) to match another pattern"
 let check_unneeded_var_dollar_s esp = 
   let expr = esp.any.expr in
-  if is_var_dollar_ expr then warn esp.pos "\"$_ =~ s/regexp/.../\" can be written \"s/regexp/.../\"" else
-  if is_var_number_match expr then die_with_rawpos esp.pos "do not modify the result of a match (eg: $1)" else
+  if is_var_dollar_ expr then warn [Warn_suggest_simpler] esp.pos "\"$_ =~ s/regexp/.../\" can be written \"s/regexp/.../\"" else
+  if is_var_number_match expr then warn [Warn_traps] esp.pos "do not modify the result of a match (eg: $1)" else
   let expr = match expr with
   | List [List [Call_op("=", [ expr; _], _)]] -> expr (* check $xx in ($xx = ...) =~ ... *)
   | _ -> expr in
-  if is_a_string expr || not (is_a_scalar expr) then warn esp.pos "you can only use s/// on a variable"
+  if is_a_string expr || not (is_a_scalar expr) then warn [Warn_complex_expressions] esp.pos "you can only use s/// on a variable"
 
 let check_my esp = if esp.any <> "my" then die_rule "syntax error"
-let check_foreach esp = if esp.any = "for"     then warn esp.pos "write \"foreach\" instead of \"for\""
-let check_for     esp = if esp.any = "foreach" then warn esp.pos "write \"for\" instead of \"foreach\""
+let check_foreach esp = if esp.any = "for"     then warn [Warn_normalized_expressions] esp.pos "write \"foreach\" instead of \"for\""
+let check_for     esp = if esp.any = "foreach" then warn [Warn_normalized_expressions] esp.pos "write \"for\" instead of \"foreach\""
 let check_for_foreach esp arg =
   match arg.any.expr with
   | List [ Deref(I_scalar, _) ] ->
-      if esp.any = "foreach" then warn esp.pos "you are using the special fpons trick to locally set $_ with a value, for this please use \"for\" instead of \"foreach\""
+      if esp.any = "foreach" then warn [Warn_normalized_expressions] esp.pos "you are using the special trick to locally set $_ with a value, for this please use \"for\" instead of \"foreach\""
   | List [ Deref_with(context, I_scalar, _, _) ] when context <> I_func -> 
-      if esp.any = "foreach" then warn esp.pos "you are using the special fpons trick to locally set $_ with a value, for this please use \"for\" instead of \"foreach\""
+      if esp.any = "foreach" then warn [Warn_normalized_expressions] esp.pos "you are using the special trick to locally set $_ with a value, for this please use \"for\" instead of \"foreach\""
   | List [ Deref(I_hash, _) ] ->
-      warn esp.pos "foreach with a hash is usually an error"
+      warn [Warn_traps] esp.pos "foreach with a hash is usually an error"
   | _ -> 
-      if esp.any = "for" then warn esp.pos "write \"foreach\" instead of \"for\""
+      if esp.any = "for" then warn [Warn_normalized_expressions] esp.pos "write \"foreach\" instead of \"for\""
 
 let check_block_sub esp_lines esp_BRACKET_END =
   match esp_lines.any with
@@ -541,7 +540,7 @@ let check_block_sub esp_lines esp_BRACKET_END =
       sp_p esp_BRACKET_END ;
 
       if esp_BRACKET_END.spaces <> Space_cr then
-	(if last l = Semi_colon then warn_verb (get_pos_end esp_lines) "spurious \";\" before closing block")
+	(if last l = Semi_colon then warn_verb [Warn_white_space] (get_pos_end esp_lines) "spurious \";\" before closing block")
 
 let check_block_ref esp_lines esp_BRACKET_END =
   let l = esp_lines.any in
@@ -550,11 +549,11 @@ let check_block_ref esp_lines esp_BRACKET_END =
   else sp_same esp_lines esp_BRACKET_END ;
 
   if esp_BRACKET_END.spaces <> Space_cr then
-    (if l <> [] && last l = Semi_colon then warn_verb (get_pos_end esp_lines) "spurious \";\" before closing block")
+    (if l <> [] && last l = Semi_colon then warn_verb [Warn_white_space] (get_pos_end esp_lines) "spurious \";\" before closing block")
 
 let check_unless_else elsif else_ =
-  if elsif.any <> [] then warn elsif.pos "don't use \"elsif\" with \"unless\" (replace \"unless\" with \"if\")";
-  if else_.any <> [] then warn else_.pos "don't use \"else\" with \"unless\" (replace \"unless\" with \"if\")"
+  if elsif.any <> [] then warn [Warn_complex_expressions] elsif.pos "don't use \"elsif\" with \"unless\" (replace \"unless\" with \"if\")";
+  if else_.any <> [] then warn [Warn_complex_expressions] else_.pos "don't use \"else\" with \"unless\" (replace \"unless\" with \"if\")"
 
 let check_my_our_paren { any = ((comma_closed, _), l) } after_esp = 
   (if l = [] then sp_0 else sp_1) after_esp ; 
@@ -566,7 +565,7 @@ let check_simple_pattern = function
 	st.[0] = '^' && st.[String.length st - 1] = '$' then
 	let st = skip_n_char_ 1 1 st in
 	if string_forall_with char_is_alphanumerical_ 0 st then
-	  warn_rule (sprintf "\"... =~ /^%s$/\" is better written \"... eq '%s'\"" st st)
+	  warn_rule [Warn_suggest_simpler] (sprintf "\"... =~ /^%s$/\" is better written \"... eq '%s'\"" st st)
   | _ -> ()
 
 let rec only_one esp =
@@ -580,7 +579,7 @@ let only_one_array_ref esp =
   let e = only_one esp in
   (match e with
   | Call_op("last_array_index", [Deref(I_array, e)], _) ->
-      warn esp.pos (sprintf "you can replace $#%s with -1" (string_of_Ident e))
+      warn [Warn_suggest_simpler] esp.pos (sprintf "you can replace $#%s with -1" (string_of_Ident e))
   | _ -> ());
   e
 
@@ -610,7 +609,7 @@ let deref_raw context e =
       let fq, ident = split_name_or_fq_name s in
       Ident(fq, ident, pos)
   | Deref(I_scalar, (Ident _ as ident)) ->
-      warn_rule (sprintf "%s{$%s} can be written %s$%s" (context2s context) (string_of_Ident ident) (context2s context) (string_of_Ident ident));
+      warn_rule [Warn_suggest_simpler] (sprintf "%s{$%s} can be written %s$%s" (context2s context) (string_of_Ident ident) (context2s context) (string_of_Ident ident));
       e
   | _ -> e
   in Deref(context, e)
@@ -623,7 +622,7 @@ let to_Method_call (object_, method_, para) =
   | Ident(Some _, _, _) -> Call(Deref(I_func, method_), maybe_to_Raw_string object_ :: para)
   | _ -> Method_call(maybe_to_Raw_string object_, maybe_to_Raw_string method_, para)
 let to_Deref_with(from_context, to_context, ref_, para) =
-  if is_not_a_scalar ref_ then warn_rule "bad deref";
+  if is_not_a_scalar ref_ then warn_rule [] "bad deref";
   Deref_with(from_context, to_context, ref_, para)
 
   
@@ -660,73 +659,73 @@ let remove_call_with_same_para_special = function
 
 let check_My_under_condition msg = function
   | List [ My_our("my", _, _) ] ->
-      warn_rule "this is stupid"
+      warn_rule [Warn_traps] "this is stupid"
   | List [ Call_op("=", [ My_our("my", _, _); _ ], _) ] ->
-      warn_rule msg
+      warn_rule [Warn_traps] msg
   | _ -> ()
 
 let cook_call_op op para pos =
   (match op with
   | "le" | "ge" | "eq" | "ne" | "gt" | "lt" | "cmp" ->
       if List.exists (function Num _ -> true | _ -> false) para then
-	warn_rule (sprintf "you should use a number operator, not the string operator \"%s\" (or replace the number with a string)" op)
+	warn_rule [Warn_traps] (sprintf "you should use a number operator, not the string operator \"%s\" (or replace the number with a string)" op)
   | "." ->
       if List.exists (function Call(Deref(I_func, Ident(None, "N_", _)), _) -> true | _ -> false) para then
-	warn_rule "N_(\"xxx\") . \"yyy\" is dumb since the string \"xxx\" will never get translated"
+	warn_rule [Warn_MDK_Common; Warn_traps] "N_(\"xxx\") . \"yyy\" is dumb since the string \"xxx\" will never get translated"
   | _ -> ());
 
   (match op, para with
   | "if", List [Call_op ("=", [ _; e ], _)] :: _ when is_always_true e || is_always_false e -> 
-      warn_rule "are you sure you did not mean \"==\" instead of \"=\"?"
+      warn_rule [Warn_traps] "are you sure you did not mean \"==\" instead of \"=\"?"
 
   | "foreach", [ _; Block [ expr ; Semi_colon ] ]
   | "foreach", [ _; Block [ expr ] ] -> 
       (match expr with
       | Call_op("if infix", [ List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, (Ident _ as l)) ; Deref(I_scalar, Ident(None, "_", _)) ]) ] ; _ ], _) ->
 	  let l = string_of_Ident l in
-	  warn_rule (sprintf "use \"push @%s, grep { ... } ...\" instead of \"foreach (...) { push @%s, $_ if ... }\"\n  or sometimes \"@%s = grep { ... } ...\"" l l l) 
+	  warn_rule [Warn_suggest_functional] (sprintf "use \"push @%s, grep { ... } ...\" instead of \"foreach (...) { push @%s, $_ if ... }\"\n  or sometimes \"@%s = grep { ... } ...\"" l l l) 
       | Call_op("if infix", [ List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, (Ident _ as l)); _ ]) ] ; _ ], _) ->
 	  let l = string_of_Ident l in
-	  warn_rule (sprintf "use \"push @%s, map { ... ? ... : () } ...\" instead of \"foreach (...) { push @%s, ... if ... }\"\n  or sometimes \"@%s = map { ... ? ... : () } ...\"\n  or sometimes \"@%s = map { if_(..., ...) } ...\"" l l l l)
+	  warn_rule [Warn_suggest_functional] (sprintf "use \"push @%s, map { ... ? ... : () } ...\" instead of \"foreach (...) { push @%s, ... if ... }\"\n  or sometimes \"@%s = map { ... ? ... : () } ...\"\n  or sometimes \"@%s = map { if_(..., ...) } ...\"" l l l l)
       | List [ Call(Deref(I_func, Ident(None, "push", _)), [ Deref(I_array, (Ident _ as l)); _ ]) ] ->
 	  let l = string_of_Ident l in
-	  warn_rule (sprintf "use \"push @%s, map { ... } ...\" instead of \"foreach (...) { push @%s, ... }\"\n  or sometimes \"@%s = map { ... } ...\"" l l l)
+	  warn_rule [Warn_suggest_functional] (sprintf "use \"push @%s, map { ... } ...\" instead of \"foreach (...) { push @%s, ... }\"\n  or sometimes \"@%s = map { ... } ...\"" l l l)
       | _ -> ())
 
   | "=", [My_our _; Ident(None, "undef", _)] -> 
-      warn pos "no need to initialize variable, it's done by default"
+      warn [Warn_suggest_simpler] pos "no need to initialize variable, it's done by default"
   | "=", [My_our _; List[]] -> 
-      if Info.is_on_same_line_current pos then warn pos "no need to initialize variables, it's done by default"
+      if Info.is_on_same_line_current pos then warn [Warn_suggest_simpler] pos "no need to initialize variables, it's done by default"
 
   | "=", [ Deref_with(I_array, I_scalar, id, Deref(I_array, id_)); _ ] when is_same_fromparser id id_ ->
-      warn_rule "\"$a[@a] = ...\" is better written \"push @a, ...\""
+      warn_rule [Warn_suggest_simpler] "\"$a[@a] = ...\" is better written \"push @a, ...\""
 
   | "=", [ Deref(I_star, String ([(sf1, List [])], _)); _ ] ->
-      warn_rule (sprintf "write *{'%s'} instead of *{\"%s\"}" sf1 sf1)
+      warn_rule [Warn_help_perl_checker] (sprintf "write *{'%s'} instead of *{\"%s\"}" sf1 sf1)
 
   | "||=", List [ List _ ] :: _
-  | "&&=", List [ List _ ] :: _ -> warn_rule "remove the parentheses"
+  | "&&=", List [ List _ ] :: _ -> warn_rule [Warn_complex_expressions] "remove the parentheses"
   | "||=", e :: _
-  | "&&=", e :: _ -> if is_not_a_scalar e then warn_rule (sprintf "\"%s\" is only useful with a scalar" op)
+  | "&&=", e :: _ -> if is_not_a_scalar e then warn_rule [Warn_traps] (sprintf "\"%s\" is only useful with a scalar" op)
 
   | "==", [Call_op("last_array_index", _, _); Num(n, _)] ->
-      warn_rule (sprintf "$#x == %s is better written @x == %d" n (1 + int_of_string n))
+      warn_rule [Warn_suggest_simpler] (sprintf "$#x == %s is better written @x == %d" n (1 + int_of_string n))
   | "==", [Call_op("last_array_index", _, _); Call_op("- unary", [Num (n, _)], _)] ->
-      warn_rule (sprintf "$#x == -%s is better written @x == %d" n (1 - int_of_string n))
+      warn_rule [Warn_suggest_simpler] (sprintf "$#x == -%s is better written @x == %d" n (1 - int_of_string n))
 
 
-  | "||", e :: _ when is_always_true  e -> warn_rule "<constant> || ... is the same as <constant>"
-  | "&&", e :: _ when is_always_false e -> warn_rule "<constant> && ... is the same as <constant>"
-  | "||", e :: _ when is_always_false e -> warn_rule "<constant> || ... is the same as ..."
-  | "&&", e :: _ when is_always_true  e -> warn_rule "<constant> && ... is the same as ..."
+  | "||", e :: _ when is_always_true  e -> warn_rule [Warn_strange] "<constant> || ... is the same as <constant>"
+  | "&&", e :: _ when is_always_false e -> warn_rule [Warn_strange] "<constant> && ... is the same as <constant>"
+  | "||", e :: _ when is_always_false e -> warn_rule [Warn_strange] "<constant> || ... is the same as ..."
+  | "&&", e :: _ when is_always_true  e -> warn_rule [Warn_strange] "<constant> && ... is the same as ..."
 
-  | "or",  e :: _ when is_always_true  (un_parenthesize_full e) -> warn_rule "<constant> or ... is the same as <constant>"
-  | "and", e :: _ when is_always_false (un_parenthesize_full e) -> warn_rule "<constant> and ... is the same as <constant>"
-  | "or",  e :: _ when is_always_false (un_parenthesize_full e) -> warn_rule "<constant> or ... is the same as ..."
-  | "and", e :: _ when is_always_true  (un_parenthesize_full e) -> warn_rule "<constant> and ... is the same as ..."
+  | "or",  e :: _ when is_always_true  (un_parenthesize_full e) -> warn_rule [Warn_strange] "<constant> or ... is the same as <constant>"
+  | "and", e :: _ when is_always_false (un_parenthesize_full e) -> warn_rule [Warn_strange] "<constant> and ... is the same as <constant>"
+  | "or",  e :: _ when is_always_false (un_parenthesize_full e) -> warn_rule [Warn_strange] "<constant> or ... is the same as ..."
+  | "and", e :: _ when is_always_true  (un_parenthesize_full e) -> warn_rule [Warn_strange] "<constant> and ... is the same as ..."
 
   | "or", [ List [ Deref(I_scalar, id) ]; List [ Call_op("=", [ Deref(I_scalar, id_); _], _) ] ] when is_same_fromparser id id_ ->
-      warn_rule "\"$foo or $foo = ...\" can be written \"$foo ||= ...\""
+      warn_rule [Warn_suggest_simpler] "\"$foo or $foo = ...\" can be written \"$foo ||= ...\""
 
   | "and", [ _cond ; expr ] -> check_My_under_condition "replace \"<cond> and my $foo = ...\" with \"my $foo = <cond> && ...\"" expr
   | "or",  [ _cond ; expr ] -> check_My_under_condition "replace \"<cond> or my $foo = ...\" with \"my $foo = !<cond> && ...\"" expr
@@ -736,11 +735,11 @@ let cook_call_op op para pos =
   match op, para with
   | "=", [ Deref(I_star, (Ident _ as f1)); Deref(I_star, (Ident _ as f2)) ] ->
       let s1, s2 = string_of_Ident f1, string_of_Ident f2 in
-      warn pos (sprintf "\"*%s = *%s\" is better written \"*%s = \\&%s\"" s1 s2 s1 s2) ;
+      warn [Warn_complex_expressions] pos (sprintf "\"*%s = *%s\" is better written \"*%s = \\&%s\"" s1 s2 s1 s2) ;
       sub_declaration (f1, None) [ call_with_same_para_special(Deref(I_func, f2)) ] Glob_assign
   | "=", [ Deref(I_star, Raw_string(sf1, pos_f1)); Deref(I_star, (Ident _ as f2)) ] ->
       let s2 = string_of_Ident f2 in
-      warn pos (sprintf "\"*{'%s'} = *%s\" is better written \"*{'%s'} = \\&%s\"" sf1 s2 sf1 s2) ;
+      warn [Warn_help_perl_checker] pos (sprintf "\"*{'%s'} = *%s\" is better written \"*{'%s'} = \\&%s\"" sf1 s2 sf1 s2) ;
       sub_declaration (Ident(None, sf1, pos_f1), None) [ call_with_same_para_special(Deref(I_func, f2)) ] Glob_assign
 
   | "=", [ Deref(I_star, (Ident _ as f1)); Ref(I_scalar, Deref(I_func, (Ident _ as f2))) ] ->
@@ -760,7 +759,7 @@ let to_Call_op_ mcontext prio op para esp_start esp_end =
   let pos = raw_pos_range esp_start esp_end in
   new_any mcontext { priority = prio ; expr = cook_call_op op para pos } esp_start.spaces pos
 let to_Call_assign_op_ mcontext prio op left right esp_left esp_end = 
-  if not (is_lvalue left) then warn esp_left.pos "invalid lvalue";
+  if not (is_lvalue left) then warn [Warn_strange] esp_left.pos "invalid lvalue";
   to_Call_op_ mcontext prio op [ left ; right ] esp_left esp_end
 
 let followed_by_comma expr true_comma =
@@ -784,10 +783,10 @@ let check_format_a_la_printf s pos =
 	  | '%' -> contexts
 	  | 'd' -> M_int :: contexts
 	  | 's' | 'c' -> M_string :: contexts
-	  | c -> warn (pos + i', pos + i') (sprintf "invalid command %%%c" c); contexts
+	  | c -> warn [Warn_strange] (pos + i', pos + i') (sprintf "invalid command %%%c" c); contexts
 	in
 	check_format_a_la_printf_ contexts (i' + 2)
-      with Invalid_argument _ -> warn (pos + i', pos + i') "invalid command %" ; contexts
+      with Invalid_argument _ -> warn [Warn_strange] (pos + i', pos + i') "invalid command %" ; contexts
     with Not_found -> contexts
   in check_format_a_la_printf_ [] 0
   
@@ -851,18 +850,18 @@ let check_system_call = function
       let has_p = List.exists (str_begins_with "-p") l in
       let has_m = List.exists (str_begins_with "-m") l in
       if has_p && has_m then ()
-      else if has_p then warn_rule "you can replace system(\"mkdir -p ...\") with mkdir_p(...)"
-      else if has_m then warn_rule "you can replace system(\"mkdir -m <mode> ...\") with mkdir(..., <mode>)"
-      else warn_rule "you can replace system(\"mkdir ...\") with mkdir(...)"
+      else if has_p then warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace system(\"mkdir -p ...\") with mkdir_p(...)"
+      else if has_m then warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace system(\"mkdir -m <mode> ...\") with mkdir(..., <mode>)"
+      else warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace system(\"mkdir ...\") with mkdir(...)"
   | _ -> ()
 
 let call_raw force_non_builtin_func (e, para) =
   let check_anonymous_block f = function
   | [ Anonymous_sub _ ; Deref (I_hash, _) ] ->
-      warn_rule ("a hash is not a valid parameter to function " ^ f)
+      warn_rule [Warn_strange] ("a hash is not a valid parameter to function " ^ f)
 
   | Anonymous_sub _ :: _ -> ()
-  | _ -> warn_rule (sprintf "always use \"%s\" with a block (eg: %s { ... } @list)" f f)
+  | _ -> warn_rule [Warn_complex_expressions] (sprintf "always use \"%s\" with a block (eg: %s { ... } @list)" f f)
   in
 
   match e with
@@ -870,21 +869,21 @@ let call_raw force_non_builtin_func (e, para) =
       (match f with
       | "join" ->
 	  (match un_parenthesize_full_l para with
-	  | e :: _ when not (is_a_scalar e) -> warn_rule "first argument of join() must be a scalar";
-	  | [_] -> warn_rule "not enough parameters"
-	  | [_; e] when is_a_scalar e -> warn_rule "join('...', $foo) is the same as $foo"
+	  | e :: _ when not (is_a_scalar e) -> warn_rule [Warn_traps] "first argument of join() must be a scalar";
+	  | [_] -> warn_rule [Warn_traps] "not enough parameters"
+	  | [_; e] when is_a_scalar e -> warn_rule [Warn_traps] "join('...', $foo) is the same as $foo"
 	  | _ -> ())
 
       | "length" ->
-	  if para = [] then warn_rule "length() with no parameter !?" else
-	  if is_not_a_scalar (List.hd para) then warn_rule "never use \"length @l\", it returns the length of the string int(@l)" ;
+	  if para = [] then warn_rule [Warn_complex_expressions] (sprintf "please use \"%s $_\" instead of \"%s\"" f f) else
+	  if is_not_a_scalar (List.hd para) then warn_rule [Warn_traps] "never use \"length @l\", it returns the length of the string int(@l)" ;
 
       | "open" ->
 	  (match para with
 	  | [ List(Ident(None, name, _) :: _) ]
 	  | Ident(None, name, _) :: _ ->
 	      if not (List.mem name [ "STDIN" ; "STDOUT" ; "STDERR" ]) then
-		warn_rule (sprintf "use a scalar instead of a bareword (eg: occurrences of %s with $%s)" name name)
+		warn_rule [Warn_complex_expressions] (sprintf "use a scalar instead of a bareword (eg: occurrences of %s with $%s)" name name)
 	  | _ -> ())
 
       | "N" | "N_" ->
@@ -897,9 +896,9 @@ let call_raw force_non_builtin_func (e, para) =
 	      let contexts = check_format_a_la_printf s pos_offset in
 	      if f = "N" then
 		if List.length para < List.length contexts then
-		  warn_rule "not enough parameters"
+		  warn_rule [Warn_traps; Warn_MDK_Common] "not enough parameters"
 		else if List.length para > List.length contexts then
-		  warn_rule "too many parameters" ;
+		  warn_rule [Warn_traps; Warn_MDK_Common] "too many parameters" ;
 	      (*if String.contains s '\t' then warn_rule "tabulation in translated string must be written \\\\t";*)
 	      (*if count_matching_char s '\n' > 10 then warn_rule "long string";*)
 	  | [ List(String _ :: _) ] -> die_rule "don't use interpolated translated string, use %s or %d instead"
@@ -907,7 +906,7 @@ let call_raw force_non_builtin_func (e, para) =
 
       | "if_" ->
 	  (match para with
-	  | [ List [ _ ] ] -> warn_rule "not enough parameters";
+	  | [ List [ _ ] ] -> warn_rule [Warn_traps; Warn_MDK_Common] "not enough parameters";
 	  | _ -> ())
 
       | "map" ->
@@ -915,15 +914,15 @@ let call_raw force_non_builtin_func (e, para) =
 
 	  | Anonymous_sub(None, Block [ List [ Call(Deref(I_func, Ident(None, "if_", _)),
 						    [ List [ _ ; Deref(I_scalar, Ident(None, "_", _)) ] ]) ] ], _) :: _ ->
-						      warn_rule "you can replace \"map { if_(..., $_) }\" with \"grep { ... }\""
+						      warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"map { if_(..., $_) }\" with \"grep { ... }\""
 	  | _ -> check_anonymous_block f para)
 
       | "grep" ->
 	  (match para with
 	  | [ Anonymous_sub(None, Block [ List [ Call_op("not", [ Call(Deref(I_func, Ident(None, "member", _)), [ List(Deref(I_scalar, Ident(None, "_", _)) :: _) ]) ], _) ] ], _); _ ] ->
-	      warn_rule "you can replace \"grep { !member($_, ...) } @l\" with \"difference2([ @l ], [ ... ])\""
+	      warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"grep { !member($_, ...) } @l\" with \"difference2([ @l ], [ ... ])\""
 	  | [ Anonymous_sub(None, Block [ List [ Call(Deref(I_func, Ident(None, "member", _)), [ List(Deref(I_scalar, Ident(None, "_", _)) :: _) ]) ] ], _); _ ] ->
-	      warn_rule "you can replace \"grep { member($_, ...) } @l\" with \"intersection([ @l ], [ ... ])\""
+	      warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"grep { member($_, ...) } @l\" with \"intersection([ @l ], [ ... ])\""
 	  | _ -> check_anonymous_block f para)
 
       | "any" ->
@@ -931,7 +930,7 @@ let call_raw force_non_builtin_func (e, para) =
 	    [Anonymous_sub (None, Block 
 			      [ List [ Call_op("eq", [Deref(I_scalar, Ident(None, "_", _)); _ ], _) ] ], 
 			    _); _ ] ->
-	      warn_rule "you can replace \"any { $_ eq ... } @l\" with \"member(..., @l)\""
+	      warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"any { $_ eq ... } @l\" with \"member(..., @l)\""
 	  | _ -> check_anonymous_block f para)		
 
       | "grep_index" | "map_index" | "partition" | "uniq_"
@@ -943,7 +942,7 @@ let call_raw force_non_builtin_func (e, para) =
       | "member" ->
 	  (match para with
 	    [ List [ _; Call(Deref(I_func, Ident(None, "keys", _)), _) ] ] ->
-	      warn_rule "you can replace \"member($xxx, keys %yyy)\" with \"exists $yyy{$xxx}\""
+	      warn_rule [Warn_suggest_simpler; Warn_MDK_Common] "you can replace \"member($xxx, keys %yyy)\" with \"exists $yyy{$xxx}\""
 	  | _ -> ())
 
       | "pop" | "shift" ->
@@ -951,14 +950,14 @@ let call_raw force_non_builtin_func (e, para) =
 	  | [] 
 	  | [ Deref(I_array, _) ] 
 	  | [ List [ Deref(I_array, _) ] ] -> ()
-	  | _ -> warn_rule (f ^ " is expecting an array and nothing else"))
+	  | _ -> warn_rule [Warn_traps] (f ^ " is expecting an array and nothing else"))
 
       | "push" | "unshift" ->
 	  (match para with
 	  | Deref(I_array, _) :: l 
 	  | [ List (Deref(I_array, _) :: l) ] -> 
-	      if l = [] then warn_rule ("you must give some arguments to " ^ f)
-	  | _ -> warn_rule (f ^ " is expecting an array"))
+	      if l = [] then warn_rule [Warn_traps] ("you must give some arguments to " ^ f)
+	  | _ -> warn_rule [Warn_traps] (f ^ " is expecting an array"))
 
       | "system" ->
 	  (match un_parenthesize_full_l para with
@@ -967,7 +966,7 @@ let call_raw force_non_builtin_func (e, para) =
 	      | Some s ->
 		  if List.exists (String.contains s) [ '\'' ; char_quote ] &&
 	            not (List.exists (String.contains s) [ '<' ; '>' ; '&' ; ';']) then
-		    warn_rule "instead of quoting parameters you should give a list of arguments";
+		    warn_rule [Warn_complex_expressions] "instead of quoting parameters you should give a list of arguments";
 		  check_system_call (split_at ' ' s)
 	      | None -> ())
 	  | l -> 
@@ -1037,7 +1036,7 @@ let call_one_scalar_para { any = e ; pos = pos } para esp_start esp_end =
 	  if e = "shift" || e = "pop" then 
 	    [] (* can't decide here *)
 	  else
-	    (if not (List.mem e [ "length" ]) then warn_rule (sprintf "please use \"%s $_\" instead of \"%s\"" e e) ;
+	    (if not (List.mem e [ "length" ]) then warn_rule [Warn_complex_expressions] (sprintf "please use \"%s $_\" instead of \"%s\"" e e) ;
 	     [var_dollar_ (raw_pos2pos pos)])
     | _ -> para
   in
@@ -1072,13 +1071,13 @@ let to_String parse strict { any = l ; pos = pos } =
   let l' = parse_interpolated parse l in
   (match l' with
   | [ "", List [Deref(I_scalar, Ident(None, ident, _))]] -> 
-      if ident <> "!" && strict then warn pos (sprintf "%s is better written without the double quotes" (variable2s(I_scalar, ident)))
+      if ident <> "!" && strict then warn [Warn_suggest_simpler] pos (sprintf "%s is better written without the double quotes" (variable2s(I_scalar, ident)))
   | [ "", List [Deref(I_hash, _)]] -> 
-      warn pos "don't use a hash in string context"
+      warn [Warn_traps] pos "don't use a hash in string context"
   | [ "", List [Deref(I_array, _)]] -> 
       ()
   | [("", _)] -> 
-      if strict then warn pos "double quotes are unneeded"
+      if strict then warn [Warn_suggest_simpler] pos "double quotes are unneeded"
   | _ -> ());
   String(l', raw_pos2pos pos)
 
@@ -1087,9 +1086,9 @@ let from_PATTERN parse { any = (s, opts) ; pos = pos } =
   (match List.rev re with
   | (s, List []) :: _ ->
       if str_ends_with s ".*" then
-	warn_rule (sprintf "you can remove \"%s\" at the end of your regexp" ".*")
+	warn_rule [Warn_suggest_simpler] (sprintf "you can remove \"%s\" at the end of your regexp" ".*")
       else if str_ends_with s ".*$" then
-	warn_rule (sprintf "you can remove \"%s\" at the end of your regexp" ".*$")
+	warn_rule [Warn_suggest_simpler] (sprintf "you can remove \"%s\" at the end of your regexp" ".*$")
   | _ -> ());
   let pattern = [ String(re, raw_pos2pos pos) ; Raw_string(opts, raw_pos2pos pos) ] in
   check_simple_pattern pattern;
@@ -1213,7 +1212,7 @@ let mcontext_lmaybe esp = if esp.any = [] then [] else [esp.mcontext]
 
 let mcontext_check_raw wanted_mcontext mcontext =
   if not (mcontext_lower mcontext wanted_mcontext) then
-    warn_rule (sprintf "context %s is not compatible with context %s" (mcontext2s mcontext) (mcontext2s wanted_mcontext))
+    warn_rule [Warn_context] (sprintf "context %s is not compatible with context %s" (mcontext2s mcontext) (mcontext2s wanted_mcontext))
 
 let mcontext_check wanted_mcontext esp =
   (match wanted_mcontext with
@@ -1221,7 +1220,7 @@ let mcontext_check wanted_mcontext esp =
   | _ ->
     match un_parenthesize_full esp.any.expr with
     | Call(Deref(I_func, Ident(None, "grep", _)), _) -> 
-	warn_rule (if wanted_mcontext = M_bool then
+	warn_rule [Warn_suggest_simpler; Warn_help_perl_checker] (if wanted_mcontext = M_bool then
 	  "in boolean context, use \"any\" instead of \"grep\"" else
 	  "you may use \"find\" instead of \"grep\"")
     | _ -> ());
@@ -1231,7 +1230,7 @@ let mcontext_check_unop_l wanted_mcontext esp =
   mcontext_check wanted_mcontext { esp with any = { esp.any with expr = List esp.any.expr  } }
 
 let mcontext_check_non_none esp =
-  if esp.mcontext = M_none then warn_rule "() context not accepted here"
+  if esp.mcontext = M_none then warn_rule [Warn_context] "() context not accepted here"
 
 let mcontext_check_none msg expr esp =
   let rec mcontext_check_none_rec msg expr = function
@@ -1253,8 +1252,8 @@ let mcontext_check_none msg expr esp =
 	match expr with
 	| [List [Num("1", _)]; Semi_colon] -> () (* allow "1;" for package return value. It would be much better to check we are at toplevel, but hell i don't want to wire this information up to here *)
 	| [List [Call_op ("<>", [Ident (None, "STDIN", _)], _)]; Semi_colon] -> () (* allow <STDIN> to ask "press return" *)
-	| [List [Call(Deref(I_func, Ident(None, "map", _)), _)]; Semi_colon] -> warn_rule "if you don't use the return value, use \"foreach\" instead of \"map\""
-	| _ -> warn esp.pos msg
+	| [List [Call(Deref(I_func, Ident(None, "map", _)), _)]; Semi_colon] -> warn_rule [Warn_void] "if you don't use the return value, use \"foreach\" instead of \"map\""
+	| _ -> warn [Warn_void] esp.pos msg
   in
   mcontext_check_none_rec msg expr esp.mcontext
 
@@ -1298,7 +1297,7 @@ let call_op_if_infix left right esp_start esp_end =
   | List [Call_op("=", [Deref(context, _); _], _)], _ when non_scalar_context context -> ()
   | List [Call_op("=", [v; _], _)],
     List [Call_op("not", [v'], _)] when is_same_fromparser v v' ->
-      warn_rule "\"$foo = ... if !$foo\" can be written \"$foo ||= ...\""
+      warn_rule [Warn_suggest_simpler] "\"$foo = ... if !$foo\" can be written \"$foo ||= ...\""
   | _ -> ());
 
   mcontext_check_none "value is dropped" [left] esp_start;
@@ -1313,12 +1312,12 @@ let call_op_unless_infix left right esp_start esp_end =
   (match left, right with
   | List [Call_op("=", [Deref(context, _); _], _)], _ when non_scalar_context context -> ()
   | List [Call_op("=", [v; _], _)], List [v'] when is_same_fromparser v v' ->
-      warn_rule "\"$foo = ... unless $foo\" can be written \"$foo ||= ...\""
+      warn_rule [Warn_suggest_simpler] "\"$foo = ... unless $foo\" can be written \"$foo ||= ...\""
   | _ -> ());
   (match right with
   | List [Call_op(op, _, _)] ->
       (match op with
-      | "&&" | "||" | "not" | "ne" | "?:" -> warn_rule "don't use \"unless\" when the condition is complex, use \"if\" instead"
+      | "&&" | "||" | "not" | "ne" | "?:" -> warn_rule [Warn_complex_expressions] "don't use \"unless\" when the condition is complex, use \"if\" instead"
       | _ -> ());
   | _ -> ());
 
@@ -1337,7 +1336,7 @@ let symops pri para_context return_context op_str left op right =
   in
   if op_str <> "==" && op_str <> "!=" && para_context = M_float then
     (match un_parenthesize_full left.any.expr with
-    | Call_op("last_array_index", _, _) -> warn_rule "change your expression to use @xxx instead of $#xxx"
+    | Call_op("last_array_index", _, _) -> warn_rule [Warn_complex_expressions] "change your expression to use @xxx instead of $#xxx"
     | _ -> ());
 
   if not skip_context_check then
diff --git a/perl_checker.src/parser_helper.mli b/perl_checker.src/parser_helper.mli
index ecd5095..952963a 100644
--- a/perl_checker.src/parser_helper.mli
+++ b/perl_checker.src/parser_helper.mli
@@ -57,11 +57,10 @@ val from_array : Types.fromparser Types.any_spaces_pos -> Types.fromparser
 val get_pos_from_expr : Types.fromparser -> Types.pos
 val msg_with_rawpos : int * int -> string -> string
 val die_with_rawpos : int * int -> string -> 'a
-val warn : int * int -> string -> unit
+val warn : Types.warning list -> int * int -> string -> unit
 val die_rule : string -> 'a
-val warn_rule : string -> unit
-val debug : string -> unit
-val warn_verb : int -> string -> unit
+val warn_rule : Types.warning list -> string -> unit
+val warn_verb : Types.warning list -> int -> string -> unit
 val warn_too_many_space : int -> unit
 val warn_no_space : int -> unit
 val warn_cr : int -> unit
@@ -167,6 +166,7 @@ val anonymous_sub :
   Types.fromparser list Types.any_spaces_pos -> Types.fromparser
 val call_with_same_para_special : Types.fromparser -> Types.fromparser
 val remove_call_with_same_para_special : Types.fromparser -> Types.fromparser
+val check_My_under_condition : string -> Types.fromparser -> unit
 val cook_call_op :
   string -> Types.fromparser list -> int * int -> Types.fromparser
 val to_Call_op :
@@ -199,6 +199,9 @@ val po_comments : string list ref
 val po_comment : string Types.any_spaces_pos -> unit
 val check_format_a_la_printf : string -> int -> Types.maybe_context list
 val generate_pot : string -> unit
+val fake_string_from_String_l : (string * 'a) list -> string
+val fake_string_option_from_expr : Types.fromparser -> string option
+val check_system_call : string list -> unit
 val call_raw :
   bool -> Types.fromparser * Types.fromparser list -> Types.fromparser
 val call : Types.fromparser * Types.fromparser list -> Types.fromparser
@@ -230,16 +233,6 @@ val call_one_scalar_para :
   'a Types.any_spaces_pos ->
   'b Types.any_spaces_pos ->
   Types.fromparser Types.prio_anyexpr Types.any_spaces_pos
-val call_op_if_infix :
-  Types.fromparser ->
-  Types.fromparser ->
-  'a Types.any_spaces_pos ->
-  'b Types.any_spaces_pos -> Types.fromparser Types.any_spaces_pos
-val call_op_unless_infix :
-  Types.fromparser ->
-  Types.fromparser ->
-  'a Types.any_spaces_pos ->
-  'b Types.any_spaces_pos -> Types.fromparser Types.any_spaces_pos
 val current_lexbuf : Lexing.lexbuf option ref
 val list2tokens : ((int * int) * 'a) list -> Lexing.lexbuf -> 'a
 val parse_tokens :
@@ -292,6 +285,16 @@ val mcontext_op_assign :
   Types.maybe_context
 val mtuple_context_concat :
   Types.maybe_context -> Types.maybe_context -> Types.maybe_context
+val call_op_if_infix :
+  Types.fromparser ->
+  Types.fromparser ->
+  'a Types.any_spaces_pos ->
+  'b Types.any_spaces_pos -> Types.fromparser Types.any_spaces_pos
+val call_op_unless_infix :
+  Types.fromparser ->
+  Types.fromparser ->
+  'a Types.any_spaces_pos ->
+  'b Types.any_spaces_pos -> Types.fromparser Types.any_spaces_pos
 val symops :
   Types.priority ->
   Types.maybe_context ->
diff --git a/perl_checker.src/perl_checker.ml b/perl_checker.src/perl_checker.ml
index cc75816..98664e0 100644
--- a/perl_checker.src/perl_checker.ml
+++ b/perl_checker.src/perl_checker.ml
@@ -22,7 +22,7 @@ let set_basedir per_files file =
 
 let rec parse_file from_basedir require_name per_files file =
   try
-    if !Flags.verbose then print_endline_flush_always ("parsing " ^ file) ;
+    if !Flags.verbose then print_endline_flush ("parsing " ^ file) ;
     let build_time = Unix.time() in
     let command = 
       match !Flags.expand_tabs with
@@ -42,7 +42,7 @@ let rec parse_file from_basedir require_name per_files file =
       let required_packages = collect (fun package -> package.required_packages) per_file.packages in
       required_packages, per_files
     with Failure s -> (
-      print_endline_flush_always s ;
+      print_endline_flush s ;
       exit 1
      )
   with 
@@ -67,7 +67,7 @@ and parse_package_if_needed per_files (package_name, pos) =
     | Some required_packages -> required_packages, per_files
     | None -> parse_file (dir = !basedir) (Some package_name) per_files file
   with Not_found -> 
-    warn_with_pos_always pos (Printf.sprintf "can't find package %s" package_name) ;
+    print_endline_flush (Info.pos2sfull pos ^ Printf.sprintf "can't find package %s" package_name) ;
     [], per_files
 
 let rec parse_required_packages state already_done = function
@@ -94,12 +94,33 @@ let parse_options =
     "-v", Arg.Set Flags.verbose, "  be verbose" ;
     "-q", Arg.Set Flags.quiet, "  be quiet" ;
     "-t", Arg.Int (fun i -> Flags.expand_tabs := Some i), "  set the tabulation width (default is 8)" ;
-    "--check-unused", Arg.Set Flags.check_unused_global_vars, "  check unused global functions & variables" ;
     "--restrict-to-files", Arg.Set restrict_to_files, "  only display warnings concerning the file(s) given on command line" ;
     "--no-cache", Arg.Set Flags.no_cache, "  do not use cache" ;
-    "--generate-pot", Arg.String generate_pot_chosen, "" ;
+    "--generate-pot", Arg.String generate_pot_chosen, 
+    "\n" ;
+
+    "--check-unused-global-vars", Arg.Set Flags.check_unused_global_vars, "  disable unused global functions & variables check" ^
+    "\nBasic warnings:";
+    "--no-check-white-space", Arg.Clear Flags.check_white_space, "  disable white space check" ;
+    "--no-suggest-simpler", Arg.Clear Flags.check_suggest_simpler, "  disable simpler code suggestion" ;
+    "--no-suggest-functional", Arg.Clear Flags.suggest_functional, "  disable Functional Programming suggestions" ^
+    "\nNormalisation warnings:";
+    "--no-check-strange", Arg.Clear Flags.check_strange, "  disable strange code check" ;
+    "--no-check-complex-expressions", Arg.Clear Flags.check_complex_expressions, "  disable complex expressions check" ;
+    "--no-check-normalized-expressions", Arg.Clear Flags.normalized_expressions, "  don't warn about non normalized expressions" ;
+    "--no-help-perl-checker", Arg.Clear Flags.check_help_perl_checker, "  beware, perl_checker doesn't understand all perl expressions, so those warnings *are* important" ^
+    "\nCommon warnings:";
+    "--no-check-void", Arg.Clear Flags.check_void, "  disable dropped value check" ;
+    "--no-check-names", Arg.Clear Flags.check_names, "  disable variable & function usage check" ;
+    "--no-check-prototypes", Arg.Clear Flags.check_prototypes, "  disable prototypes check" ;
+    "--no-check-import-export", Arg.Clear Flags.check_import_export, "  disable inter modules check" ^
+    "\nImportant warnings:";
+    "--no-check-context", Arg.Clear Flags.check_context, "  disable context check" ;
+    "--no-check-traps", Arg.Clear Flags.check_traps, "  disable traps (errors) check" ^
+    "\n";
+
   ] in
-  let usage = "Usage: perl_checker [-v] [-q] <files>\nOptions are:" in
+  let usage = "Usage: perl_checker [<options>] <files>\nOptions are:" in
   Arg.parse options (lpush args_r) usage;
 
   let files = if !args_r = [] && Build.debugging then ["../t.pl"] else !args_r in
@@ -110,10 +131,11 @@ let parse_options =
 
   if !Flags.generate_pot then Parser_helper.generate_pot !pot_file else (
 
-  if !restrict_to_files then Common.print_endline_flush_quiet := true ;
-  let per_files, required_packages = parse_required_packages per_files [] required_packages in
+  let per_files, required_packages = 
+    fluid_let Flags.quiet (!restrict_to_files || !Flags.quiet)
+      (fun () ->
+	parse_required_packages per_files [] required_packages) in
   let l_required_packages = List.map fst required_packages in
-  if !restrict_to_files then Common.print_endline_flush_quiet := false ;
 
   write_packages_cache per_files !basedir ;
 
@@ -133,7 +155,8 @@ let parse_options =
     let package_name_to_file_name = hashtbl_collect (fun _ per_file -> List.map (fun pkg -> pkg.package_name, per_file.file_name) per_file.packages) per_files in
     Hashtbl.iter (fun _ pkg -> 
       let file_name = List.assoc pkg.package_name package_name_to_file_name in
-      get_vars_declaration global_vars_declared file_name pkg
+      fluid_let Flags.quiet (!restrict_to_files || !Flags.quiet)
+	(fun () -> get_vars_declaration global_vars_declared file_name pkg)
     ) state.per_packages ;
     arrange_global_vars_declared global_vars_declared state
   in
diff --git a/perl_checker.src/test/syntax_restrictions.t b/perl_checker.src/test/syntax_restrictions.t
index 6641b7b..eb186d8 100644
--- a/perl_checker.src/test/syntax_restrictions.t
+++ b/perl_checker.src/test/syntax_restrictions.t
@@ -34,7 +34,7 @@ foreach ($xxx = 0; $xxx < 9; $xxx++) {}  write "for" instead of "foreach"
 
 foreach $xxx (@l) {}                     don't use for without "my"ing the iteration variable
 
-foreach ($xxx) {}                        you are using the special fpons trick to locally set $_ with a value, for this please use "for" instead of "foreach"
+foreach ($xxx) {}                        you are using the special trick to locally set $_ with a value, for this please use "for" instead of "foreach"
 
 unless ($xxx) {} else {}                 don't use "else" with "unless" (replace "unless" with "if")
 
diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml
index 2d630c1..dd62174 100644
--- a/perl_checker.src/tree.ml
+++ b/perl_checker.src/tree.ml
@@ -51,8 +51,7 @@ let ignore_package pkg =
   lpush ignored_packages pkg
 
 let die_with_pos pos msg = failwith (Info.pos2sfull pos ^ msg)
-let warn_with_pos pos msg = print_endline_flush (Info.pos2sfull pos ^ msg)
-let warn_with_pos_always pos msg = print_endline_flush_always (Info.pos2sfull pos ^ msg)
+let warn_with_pos warn_types pos msg = if Flags.are_warning_types_set warn_types then print_endline_flush (Info.pos2sfull pos ^ msg)
 
 let s2context s = 
   match s.[0] with
@@ -77,13 +76,13 @@ let get_current_package t =
       in
       bundled_packages [] (string_of_Ident ident) [] body
   | _ -> 
-      if str_ends_with !Info.current_file ".pm" then warn_with_pos (!Info.current_file, 0, 0) (sprintf "module %s does not have \"package xxxx;\" on its first line" (Info.absolute_file_to_file !Info.current_file)) ;
+      if str_ends_with !Info.current_file ".pm" then warn_with_pos [Warn_normalized_expressions] (!Info.current_file, 0, 0) (sprintf "module %s does not have \"package xxxx;\" on its first line" (Info.absolute_file_to_file !Info.current_file)) ;
       [ None, t ]
 
 let from_qw_raw = function
   | String([s, List []], pos) -> [ s, pos ]
   | String(_, pos) ->
-      warn_with_pos pos "not recognised yet" ;
+      warn_with_pos [] pos "not recognised yet" ;
       []
   | Raw_string(s, pos) ->
       [ s, pos ]
@@ -93,9 +92,9 @@ let from_qw_raw = function
 	| String([s, List []], pos)
 	| Raw_string(s, pos) -> Some(s, pos)
 	| Ident(_, _, pos) as ident -> Some(string_of_Ident ident, pos)
-	| e -> warn_with_pos (get_pos_from_expr e) "not recognised yet"; None
+	| e -> warn_with_pos [] (get_pos_from_expr e) "not recognised yet"; None
       ) l)) []
-  | e -> warn_with_pos (get_pos_from_expr e) "not recognised yet"; []
+  | e -> warn_with_pos [] (get_pos_from_expr e) "not recognised yet"; []
 
 let from_qw e =
   List.map (fun (s, pos) -> 
@@ -103,7 +102,7 @@ let from_qw e =
     let context =
       match context with
       | I_raw -> if s'.[0] = ':' then I_raw else I_func
-      | I_func -> warn_with_pos pos "weird, exported name with a function context especially given"; I_func
+      | I_func -> warn_with_pos [Warn_import_export] pos "weird, exported name with a function context especially given"; I_func
       | _ -> context 
     in context, s'
   ) (from_qw_raw e)
@@ -113,12 +112,12 @@ let get_exported t =
     match e with
     | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT", _)); Call _ ], pos) ]
     | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT")], _);  Call _ ], pos) ] ->
-	if exports.special_export = None then warn_with_pos pos "unrecognised @EXPORT" ;
+	if exports.special_export = None then warn_with_pos [Warn_import_export] pos "unrecognised @EXPORT" ;
 	exports
 
     | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT", _)); v ], pos)]
     | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT")], _); v ], pos)] ->
-	if exports.export_auto <> [] then warn_with_pos pos "weird, @EXPORT set twice" ;
+	if exports.export_auto <> [] then warn_with_pos [Warn_import_export] pos "weird, @EXPORT set twice" ;
 	{ exports with export_auto = from_qw v }
 
     | Perl_checker_comment("RE-EXPORT-ALL", _) -> { exports with special_export = Some Re_export_all }
@@ -126,7 +125,7 @@ let get_exported t =
 
     | List [ Call_op("=", [ Deref(I_array, Ident(None, "EXPORT_OK", _)); v ], pos)]
     | List [ Call_op("=", [ My_our("our", [(I_array, "EXPORT_OK")], _);  v ], pos)] ->
-	if exports.export_ok <> [] then warn_with_pos pos "weird, @EXPORT_OK set twice" ;
+	if exports.export_ok <> [] then warn_with_pos [Warn_import_export] pos "weird, @EXPORT_OK set twice" ;
 	(match v with
 	| Call(Deref(I_func, Ident(None, "map", _)), 
 	       [ Anonymous_sub(_, Block [List [Deref(I_array, Deref(I_scalar, Ident (None, "_", _)))]], _);
@@ -152,10 +151,10 @@ let get_exported t =
 	        ) (group_by_2 l)
 	    | _ -> raise Not_found
 	  in
-	  if exports.export_tags <> [] then warn_with_pos pos "weird, %EXPORT_TAGS set twice" ;
+	  if exports.export_tags <> [] then warn_with_pos [Warn_import_export] pos "weird, %EXPORT_TAGS set twice" ;
 	  { exports with export_tags = export_tags }
 	with _ ->
-	  warn_with_pos pos "unrecognised %EXPORT_TAGS" ;
+	  warn_with_pos [Warn_import_export] pos "unrecognised %EXPORT_TAGS" ;
 	  exports)
 
       (* $EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ]; *)
@@ -280,8 +279,8 @@ let get_proto perl_proto body =
   map_option (fun (mys, pos, _) ->
     let scalars, others = break_at (fun (context, _) -> context <> I_scalar) mys in
     (match others with
-    | (I_array, _) :: _ :: _ -> warn_with_pos pos "an array must be the last variable in a prototype"
-    | (I_hash, _) :: _ :: _ -> warn_with_pos pos "an hash must be the last variable in a prototype"
+    | (I_array, _) :: _ :: _ -> warn_with_pos [Warn_prototypes] pos "an array must be the last variable in a prototype"
+    | (I_hash, _) :: _ :: _ -> warn_with_pos [Warn_prototypes] pos "an hash must be the last variable in a prototype"
     | _ -> ());
     let is_optional (_, s) = 
       String.length s > 2 &&                (s.[0] = 'o' || s.[0] = 'b') && s.[1] = '_' ||
@@ -289,7 +288,7 @@ let get_proto perl_proto body =
     in
     let must_have, optional = break_at is_optional scalars in
     if not (List.for_all is_optional optional) then
-      warn_with_pos pos "an non-optional argument must not follow an optional argument";
+      warn_with_pos [Warn_prototypes] pos "an non-optional argument must not follow an optional argument";
     let min = List.length must_have in    
     { proto_nb_min = min; proto_nb_max = if others = [] then Some(min + List.length optional) else None }
   ) (has_proto perl_proto body)
@@ -315,7 +314,7 @@ let get_vars_declaration global_vars_declared file_name package =
 
     | List [ Method_call(Raw_string(pkg, pos), Raw_string("bootstrap", _), _) ] ->
 	if pkg <> package.package_name then
-	  warn_with_pos pos "strange bootstrap (the package name is not the same as the current package)"
+	  warn_with_pos [Warn_import_export] pos "strange bootstrap (the package name is not the same as the current package)"
 	else
 	  if not (read_xs_extension_from_c global_vars_declared file_name package pos) then 
 	    if not (read_xs_extension_from_so global_vars_declared package pos) then
@@ -388,9 +387,9 @@ let get_global_info_from_package from_basedir require_name build_time t =
     let isa, exporter = get_isa t in
     (match exporter with
     | None ->
-	if exporting_something() then warn_with_pos (!Info.current_file, 0, 0) "you must have \"@ISA = qw(Exporter)\" to EXPORT something"
+	if exporting_something() then warn_with_pos [Warn_import_export] (!Info.current_file, 0, 0) "you must have \"@ISA = qw(Exporter)\" to EXPORT something"
     | Some pos ->
-	if not (exporting_something()) then warn_with_pos pos "Inheritating from Exporter without EXPORTing anything");
+	if not (exporting_something()) then warn_with_pos [Warn_import_export] pos "Inheritating from Exporter without EXPORTing anything");
 
     let uses = List.rev (get_uses t) in
     let required_packages = List.map (fun (s, (_, pos)) -> s, pos) uses in
diff --git a/perl_checker.src/tree.mli b/perl_checker.src/tree.mli
index 60edc37..3cdf219 100644
--- a/perl_checker.src/tree.mli
+++ b/perl_checker.src/tree.mli
@@ -51,8 +51,7 @@ val has_proto : string option -> fromparser -> ((context * string) list * pos *
 val get_vars_declaration : (context * string * string, pos * prototype option) Hashtbl.t -> string -> per_package -> unit
 
 val die_with_pos : string * int * int -> string -> 'a
-val warn_with_pos : string * int * int -> string -> unit
-val warn_with_pos_always : string * int * int -> string -> unit
+val warn_with_pos : Types.warning list -> string * int * int -> string -> unit
 
 val fold_tree : ('a -> fromparser -> 'a option) -> 'a -> fromparser -> 'a
 val from_qw : fromparser -> (context * string) list
diff --git a/perl_checker.src/types.mli b/perl_checker.src/types.mli
index 0a5e62b..15f97cd 100644
--- a/perl_checker.src/types.mli
+++ b/perl_checker.src/types.mli
@@ -105,3 +105,20 @@ type 'a prio_anyexpr = {
 
 type prio_expr_spaces_pos = fromparser prio_anyexpr any_spaces_pos
 type prio_lexpr_spaces_pos = fromparser list prio_anyexpr any_spaces_pos
+
+type warning =
+  | Warn_white_space
+  | Warn_suggest_simpler
+  | Warn_unused_global_vars
+  | Warn_void
+  | Warn_context
+  | Warn_strange
+  | Warn_traps
+  | Warn_complex_expressions
+  | Warn_normalized_expressions
+  | Warn_suggest_functional
+  | Warn_prototypes
+  | Warn_import_export
+  | Warn_names
+  | Warn_MDK_Common
+  | Warn_help_perl_checker