~npalix/coccinelle/upstream

open Common
module FC = Flag_cocci

(*****************************************************************************)
(* Flags *)
(*****************************************************************************)

(* In addition to flags that can be tweaked via -xxx options (cf the
 * full list of options in "the spatch options" section below), the
 * spatch program also depends on external files, described in
 * globals/config.ml, mainly a standard.h and standard.iso file *)

let cocci_file = ref ""

let output_file = ref ""
let inplace_modif = ref false  (* but keeps nothing *)
let backup_suffix =
  ref (None : string option) (* suffix for backup if one is desired *)
let outplace_modif = ref false (* generates a .cocci_res  *)
let preprocess = ref false     (* run the C preprocessor before cocci *)
let compat_mode = ref false
let ignore_unknown_opt = ref false

(* somehow obsolete now *)
let dir = ref false

let kbuild_info = ref ""

let macro_file = ref ""

(* test mode *)
let test_mode = ref false
let test_all = ref false
let test_okfailed = ref false
let test_regression_okfailed = ref false
let expected_score_file = ref ""
let allow_update_score_file = ref true

(* action mode *)
let action = ref ""

(* works with -test but also in "normal" spatch mode *)
let compare_with_expected = ref false

let distrib_index = ref (None : int option)
let distrib_max   = ref (None : int option)
let mod_distrib   = ref false

(*****************************************************************************)
(* Profiles *)
(*****************************************************************************)

(* pair of  (list of flags to set true, list of flags to set false *)
let very_quiet_profile = (
  [
  ],
  [
    (* FC.show_diff;   just leave this as it is *)

    Common.print_to_stderr;
    Flag.show_misc;
    Flag.show_trying;
    Flag.show_transinfo;

    FC.show_c;
    FC.show_cocci;
    FC.show_flow;
    FC.show_before_fixed_flow;
    FC.show_ctl_tex;
    FC.show_ctl_text;
    FC.show_binding_in_out;

    FC.verbose_cocci;

    Flag_parsing_c.show_parsing_error;

    Flag_parsing_c.verbose_lexing;
    Flag_parsing_c.verbose_parsing;
    Flag_parsing_c.verbose_type;
    Flag_parsing_c.verbose_cfg;
    Flag_parsing_c.verbose_unparsing;
    Flag_parsing_c.verbose_visit;
    Flag_parsing_c.verbose_cpp_ast;

    Flag_matcher.verbose_matcher;
    Flag_matcher.debug_engine;

    Flag_parsing_c.debug_unparsing;

    Flag_parsing_cocci.show_SP;
    Flag_parsing_cocci.show_iso_failures;

    Flag_ctl.verbose_ctl_engine;
    Flag_ctl.verbose_match;


  ])

let quiet_profile = (
  [
    Common.print_to_stderr
  ],
  [
    (* FC.show_diff;   just leave this as it is *)

    Flag.show_misc;
    Flag.show_trying;
    Flag.show_transinfo;

    FC.show_c;
    FC.show_cocci;
    FC.show_flow;
    FC.show_before_fixed_flow;
    FC.show_ctl_tex;
    FC.show_ctl_text;
    FC.show_binding_in_out;

    FC.verbose_cocci;

    Flag_parsing_c.show_parsing_error;

    Flag_parsing_c.verbose_lexing;
    Flag_parsing_c.verbose_parsing;
    Flag_parsing_c.verbose_type;
    Flag_parsing_c.verbose_cfg;
    Flag_parsing_c.verbose_unparsing;
    Flag_parsing_c.verbose_visit;
    Flag_parsing_c.verbose_cpp_ast;

    Flag_matcher.verbose_matcher;
    Flag_matcher.debug_engine;

    Flag_parsing_c.debug_unparsing;

    Flag_parsing_cocci.show_SP;
    Flag_parsing_cocci.show_iso_failures;

    Flag_ctl.verbose_ctl_engine;
    Flag_ctl.verbose_match;


  ])

(* some information that is useful in seeing why a semantic patch doesn't
work properly *)
let debug_profile = (
  [
    Common.print_to_stderr;
    Flag.show_misc;
    Flag.show_transinfo;

    FC.show_diff;
    FC.show_cocci;
    FC.show_binding_in_out;
    FC.show_dependencies;

    Flag_parsing_cocci.keep_ml_script;
    Flag_parsing_cocci.show_iso_failures;

    FC.verbose_cocci;

    Flag_parsing_c.verbose_cfg;
    Flag_parsing_c.verbose_unparsing;
    Flag_parsing_c.verbose_visit;

    Flag_matcher.verbose_matcher;

    Flag_parsing_c.show_parsing_error;
  ],
  [

    Flag.show_misc;

    FC.show_c;
    FC.show_flow;
    FC.show_before_fixed_flow;
    FC.show_ctl_tex;
    FC.show_ctl_text;

    Flag_parsing_cocci.show_SP;
    Flag_ctl.verbose_ctl_engine;
    Flag_ctl.verbose_match;
    Flag_matcher.debug_engine;
    Flag_parsing_c.debug_unparsing;
    Flag_parsing_c.verbose_type;
    Flag_parsing_c.verbose_parsing;
  ])

let pad_profile = (
  [
    FC.show_diff;
    Common.print_to_stderr;
  ],
  [

    Flag.show_misc;
    Flag.show_transinfo;

    FC.show_c;
    FC.show_cocci;
    FC.show_flow;
    FC.show_before_fixed_flow;
    FC.show_ctl_tex;
    FC.show_ctl_text;
    FC.show_binding_in_out;

    Flag_parsing_cocci.show_SP;
    Flag_parsing_cocci.show_iso_failures;
    Flag_ctl.verbose_ctl_engine;
    Flag_ctl.verbose_match;
    Flag_matcher.debug_engine;
    Flag_parsing_c.debug_unparsing;
    Flag_parsing_c.verbose_type;
    Flag_parsing_c.verbose_parsing;
  ])

let run_profile p =
  let (set_to_true, set_to_false) = p in
  List.iter (fun x -> x := false) set_to_false;
  List.iter (fun x -> x := true) set_to_true

(*****************************************************************************)
(* The spatch options *)
(*****************************************************************************)

let usage_msg =
  "Usage: " ^ basename Sys.argv.(0) ^
    " --sp-file <SP> <infile> [-o <outfile>] [--iso-file <iso>] [options]" ^
    "\n" ^ "Options are:"

(* forward reference trick *)
let short_usage_func = ref (fun () -> ())
let long_usage_func  = ref (fun () -> ())


(* The short_options are user-oriented. The other options are for
 * the developers of coccinelle or advanced-users that know
 * quite well the underlying semantics of coccinelle.
 *)


(* will be printed when use only ./spatch. For the rest you have to
 * use -longhelp to see them.
 *)
let short_options = [
  "--sp-file",  Arg.Set_string cocci_file,
  " <file> the semantic patch file";

  "-o", Arg.Set_string output_file,
  "   <file> the output file";
  "--in-place", Arg.Set inplace_modif,
  "   do the modification on the file directly";
  "--backup-suffix", Arg.String (function s -> backup_suffix := Some s),
  "   suffix to use when making a backup for inplace";
  "--out-place", Arg.Set outplace_modif,
  "   store modifications in a .cocci_res file";
  "--reverse", Arg.Set Flag_parsing_cocci.interpret_inverted,
  "  invert the semantic patch before applying it";

  "-U", Arg.Int (fun n -> Flag_parsing_c.diff_lines := Some (i_to_s n)),
  "  set number of diff context lines";
  "--partial-match",        Arg.Set Flag_ctl.partial_match,
  "    report partial matches of the SP on the C file";

  "--iso-file", Arg.Set_string Config.std_iso,
  " <file> (default=" ^ !Config.std_iso ^")";
  "--macro-file", Arg.Set_string macro_file,
  " <file>";
  "--macro-file-builtins", Arg.Set_string Config.std_h,
  " <file> (default=" ^ !Config.std_h ^ ")";

  "--recursive-includes",
  Arg.Unit (function _ -> FC.include_options := FC.I_REALLY_ALL_INCLUDES),
  "  causes all available include files, both those included in the C file(s) and those included in header files, to be used";
  "--all-includes",
  Arg.Unit (function _ -> FC.include_options := FC.I_ALL_INCLUDES),
  "  causes all available include files included in the C file(s) to be used";
  "--no-includes",
  Arg.Unit (function _ -> FC.include_options := FC.I_NO_INCLUDES),
  "  causes not even local include files to be used";
  "--local-includes",
  Arg.Unit (function _ -> FC.include_options := FC.I_NORMAL_INCLUDES),
  "  causes local include files to be used";
  "--ignore-unknown-options", Arg.Set ignore_unknown_opt,
  "    For integration in a toolchain (must be set before the first unknown option)";
  "--include-headers", Arg.Set Flag.include_headers,
  "    process header files independently";
  "-I",   Arg.String (fun x -> FC.include_path:= x::!FC.include_path),
  "  <dir> containing the header files";
  "--include", Arg.String (fun x -> FC.extra_includes:=x::!FC.extra_includes),
  "  file to consider as being included";

  "--preprocess", Arg.Set preprocess,
  " run the C preprocessor before applying the semantic match";

  "-c", Arg.Set compat_mode, " gcc/cpp compatibility mode";

  "--dir", Arg.Set dir,
  "    <dir> process all files in directory recursively";

  "--no-scanner", Arg.Unit (function _ -> Flag.scanner := Flag.NoScanner),
  "    no indexing";
  "--use-glimpse", Arg.Unit (function _ -> Flag.scanner := Flag.Glimpse),
  "    works with -dir, use info generated by glimpseindex";
  "--use-idutils",
  Arg.String (function s -> Flag_parsing_cocci.id_utils_index := s;
    Flag.scanner := Flag.IdUtils),
  "    find relevant files using id-utils";
  "--use-coccigrep",
  Arg.Unit (function _ -> Flag.scanner := Flag.CocciGrep),
  "    find relevant files using cocci grep";
  "--patch",
    Arg.String (function s -> Flag.patch := Some (Cocci.normalize_path s)),
  ("    <dir> path name with respect to which a patch should be created\n"^
   "    \"\" for a file in the current directory");
  "--kbuild-info", Arg.Set_string kbuild_info,
  "    <file> improve -dir by grouping related c files";
  "--pyoutput", Arg.Set_string Flag.pyoutput,
  "    Sets output routine: Standard values: <coccilib.output.Gtk|coccilib.output.Console>";


  "--version",   Arg.Unit (fun () ->
    let withpython = if Pycocci.python_support then "with" else "without" in
    let whichregexp =
      if !Regexp.pcre_support then "with PCRE support"
      else "with Str regexp support "
    in
    Printf.printf "spatch version %s %s Python support and %s\n"
      Config.version withpython whichregexp;
    exit 0;
  ),
    "  guess what";

  "--date",   Arg.Unit (fun () ->
    Printf.printf "version: $Date$";
    raise (Common.UnixExit 0)
    ),
  "   guess what";

  "--shorthelp", Arg.Unit (fun () ->
    !short_usage_func();
    raise (Common.UnixExit 0)
  ),
  "    see short list of options";
  "--longhelp", Arg.Unit (fun () ->
    !long_usage_func();
    raise (Common.UnixExit 0)
    ),
  "    see all the available options in different categories";
  "-help", Arg.Unit (fun () ->
    !long_usage_func();
    raise (Common.UnixExit 0)
  ),
  " ";
  "--help", Arg.Unit (fun () ->
    !long_usage_func();
    raise (Common.UnixExit 0)
  ),
  " ";
]

(* the format is a list of triples:
 *  (title of section * (optional) explanation of sections * option list)
 *)
let other_options = [
  "aliases and obsolete options",
  "",
  [
    "--sp", Arg.Unit (function _ -> failwith "impossible"),
    " command line semantic patch";
    "--iso", Arg.Set_string Config.std_iso,   " short option of --iso-file";

    "--cocci-file", Arg.Set_string cocci_file,
    "   <file> the semantic patch file";
(*     "-c", Arg.Set_string cocci_file,     " short option of -sp_file"; *)
  ];

  "most useful show options",
  "",
  [
    "--show-diff"           , Arg.Set FC.show_diff, " ";
    "--no-show-diff"           , Arg.Clear FC.show_diff, " ";
    "--force-diff"           , Arg.Set FC.force_diff,
       "show diff even if only spacing changes";
    "--show-flow"              , Arg.Set FC.show_flow,        " ";
    (* works in conjunction with -show_ctl_text *)
    "--ctl-inline-let",
    Arg.Unit
    (function _ -> FC.show_ctl_text := true; FC.inline_let_ctl := true), " ";
    "--ctl-show-mcodekind",
    Arg.Unit
    (function _ -> FC.show_ctl_text := true; FC.show_mcodekind_in_ctl := true),
    " ";
    "--show-bindings",        Arg.Set FC.show_binding_in_out, " ";
    "--show-transinfo",    Arg.Set Flag.show_transinfo, " ";
    "--show-misc",         Arg.Set Flag.show_misc, " ";
    "--show-trying",          Arg.Set Flag.show_trying,
    " show the name of each function being processed";
    "--show-dependencies",
    Arg.Unit (function _ -> FC.show_dependencies := true;
      FC.show_binding_in_out := true),
    " show the dependencies related to each rule";
  ];

  "verbose subsystems options",
  "",
  [
    "--verbose-ctl-engine",
    Arg.Unit (function _ ->
      Flag_ctl.verbose_ctl_engine := true; FC.show_ctl_text := true) , " ";
    "--verbose-match",        Arg.Set Flag_ctl.verbose_match, " ";
    "--verbose-engine",       Arg.Set Flag_matcher.debug_engine,    " ";
    "--graphical-trace",      Arg.Set Flag_ctl.graphical_trace, "  generate a pdf file representing the matching process";
    "--gt-without-label",
     Arg.Unit (function _ ->
       Flag_ctl.graphical_trace := true; Flag_ctl.gt_without_label := true),
       "  remove graph label (requires option -graphical-trace)";

    "--parse-error-msg", Arg.Set Flag_parsing_c.show_parsing_error, " ";
    "--verbose-parsing",
       Arg.Unit (fun _ -> Flag_parsing_c.verbose_parsing := true;
	 Flag_parsing_c.show_parsing_error := true), " ";
    "--type-error-msg",  Arg.Set Flag_parsing_c.verbose_type, " ";
    (* could also use Flag_parsing_c.options_verbose *)
  ];

  "other show options",
  "",
  [
    "--show-c"                 , Arg.Set FC.show_c,           " ";
    "--show-cocci"             , Arg.Set FC.show_cocci,       " ";
    "--show-before-fixed-flow" , Arg.Set FC.show_before_fixed_flow,  " ";
    "--show-ctl-tex"           , Arg.Set FC.show_ctl_tex,     " ";
    "--show-ctl-text"          , Arg.Set FC.show_ctl_text,     " ";
    "--show-SP"             ,    Arg.Set Flag_parsing_cocci.show_SP,  " ";
  ];


  "debug C parsing/unparsing",
  "",
  [
    "--debug-cpp",          Arg.Set  Flag_parsing_c.debug_cpp, " ";
    "--debug-lexer",        Arg.Set  Flag_parsing_c.debug_lexer , " ";
    "--debug-etdt",         Arg.Set  Flag_parsing_c.debug_etdt , "  ";
    "--debug-typedef",      Arg.Set  Flag_parsing_c.debug_typedef, "  ";

    "--filter-msg",         Arg.Set  Flag_parsing_c.filter_msg ,
    "  filter some cpp message when the macro is a \"known\" cpp construct";
    "--filter-define-error",     Arg.Set Flag_parsing_c.filter_define_error,"  ";
    "--filter-msg-define-error", Arg.Set Flag_parsing_c.filter_msg_define_error,
    "  filter the error msg";
    "--filter-passed-level",     Arg.Set_int Flag_parsing_c.filter_passed_level,"  ";
(*  debug cfg doesn't seem to have any effect, so drop it as an option *)
(*  "--debug_cfg",          Arg.Set Flag_parsing_c.debug_cfg , "  "; *)
    "--debug-unparsing",         Arg.Set  Flag_parsing_c.debug_unparsing, "  ";

  ];
  (* could use Flag_parsing_c.options_debug_with_title instead *)


  "shortcut for enabling/disabling a set of debugging options at once",
  "",
  [
    (* todo: other profile ? *)
    "--quiet",   Arg.Unit (fun () -> run_profile quiet_profile), " ";
    "--very-quiet",   Arg.Unit (fun () -> run_profile very_quiet_profile), " ";
    "--debug",   Arg.Unit (fun () -> run_profile debug_profile), " ";
    "--pad",     Arg.Unit (fun () -> run_profile pad_profile),   " ";

  ];

  "bench options",
  "",
  [
    "--profile", Arg.Unit (function () -> Common.profile := Common.PALL) ,
    "   gather timing information about the main coccinelle functions";
    "--bench", Arg.Int (function x -> Flag_ctl.bench := x),
    "   <level> for profiling the CTL engine";
    "--timeout", Arg.Int (fun x -> FC.timeout := Some x),
    "   <sec> timeout in seconds";
    "--steps", Arg.Int (fun x -> Flag_ctl.steps := Some x),
    "   max number of model checking steps per code unit";
    "--iso-limit", Arg.Int (fun x -> Flag_parsing_cocci.iso_limit := Some x),
    "   max depth of iso application";
    "--no-iso-limit", Arg.Unit (fun _ -> Flag_parsing_cocci.iso_limit := None),
    "   disable limit on max depth of iso application";
    "--track-iso", Arg.Set Flag.track_iso_usage,
    "   gather information about isomorphism usage";
    "--disable-iso",
    Arg.String
    (fun s -> Flag_parsing_cocci.disabled_isos :=
      s :: !Flag_parsing_cocci.disabled_isos),
    "   disable a specific isomorphism";
    "--profile-iso",
    Arg.Unit
    (function () ->
      Common.profile :=
	(*post_engine not included, because it doesn't use isos*)
	PSOME ["parse cocci";"mysat";"asttoctl2";"pre_engine";"full_engine"]),
    "   gather information about the cost of isomorphism usage"
  ];



  "change of algorithm options",
  "",
  [
(*    "--popl", Arg.Set FC.popl,
    "    simplified SmPL, for the popl paper";

    "--popl_mark_all",
    Arg.Unit
    (function _ -> FC.popl := true; Flag_popl.mark_all := true),
    "    simplified SmPL, for the popl paper";

    "--popl_keep_all_wits",
    Arg.Unit
    (function _ -> FC.popl := true; Flag_popl.keep_all_wits := true),
    "    simplified SmPL, for the popl paper";

    "--hrule", Arg.String
    (function s ->
      Flag.make_hrule := Some s; FC.include_options := FC.I_NO_INCLUDES),
    "    semantic patch generation";
*)
    "--keep-comments", Arg.Set Flag_parsing_c.keep_comments,
    "   keep comments around removed code";

    "--loop",              Arg.Set Flag_ctl.loop_in_src_code,    " ";
    "--no-loops",          Arg.Set Flag_parsing_c.no_loops,
    "   drop all back edges derived from looping constructs - unsafe";
    "--no-gotos",          Arg.Set Flag_parsing_c.no_gotos,
    "   drop all jumps derived from gotos - unsafe";
    "--no-saved-typedefs", Arg.Clear Flag_cocci.use_saved_typedefs,
    "   drop all inferred typedefs from one parse of some code to the next";

    "--ocaml-regexps", Arg.Clear Regexp.pcre_support,
    "   use OCaml Str regular expressions for constraints";

    "--l1",                Arg.Clear Flag_parsing_c.label_strategy_2, " ";
    "--ifdef-to-if",       Arg.Set FC.ifdef_to_if,
    "   convert ifdef to if (experimental)";
    "--no-ifdef-to-if",              Arg.Clear FC.ifdef_to_if,
    "   convert ifdef to if (experimental)";

    "--disable-multi-pass", Arg.Set Flag_parsing_c.disable_multi_pass, " ";

    "--noif0-passing",      Arg.Clear Flag_parsing_c.if0_passing, " ";
    "--defined", Arg.String (Flag_parsing_c.add Flag_parsing_c.defined), " ";
    "--undefined", Arg.String
        (Flag_parsing_c.add Flag_parsing_c.undefined), " ";
    "--noadd-typedef-root", Arg.Clear Flag_parsing_c.add_typedef_root, " ";
    (* could use Flag_parsing_c.options_algo instead *)


    "--disallow-nested-exps", Arg.Set Flag_matcher.disallow_nested_exps,
       " disallow an expresion pattern from matching a term and its subterm";
    "--disable-worth-trying-opt", Arg.Clear Flag.worth_trying_opt,
    "  ";
    "--selected-only", Arg.Set FC.selected_only, "  only show selected files";
    "--only-return-is-error-exit",
    Arg.Set Flag_matcher.only_return_is_error_exit,
    "if this flag is not set, then break and continue are also error exits";
    (* the following is a hack to make it easier to add code in sgrep-like
       code, essentially to compensate for the fact that we don't have
       any way of printing things out *)
    "--allow-inconsistent-paths",
    Arg.Set Flag_matcher.allow_inconsistent_paths,
    "   if this flag is set don't check for inconsistent paths; dangerous";
    "--no-safe-expressions",
    Arg.Set Flag_matcher.no_safe_expressions,
    "  make an expression disjunction not prioritise the topmost disjunct";
    "--int-bits", Arg.Int Flag_parsing_c.set_int_bits,
    "  the number of bits in an unsigned int";
    "--long-bits", Arg.Int Flag_parsing_c.set_long_bits,
    "  the number of bits in an unsigned long";
    "--linux-spacing", Arg.Unit Flag_parsing_c.set_linux_spacing,
    "  spacing of + code follows the conventions of Linux";
    "--smpl-spacing", Arg.Unit Flag_parsing_c.set_smpl_spacing,
    "  spacing of + code follows the semantic patch";
    "-D", Arg.String Flag.set_defined_virtual_rules,
    "  indicate that a virtual rule should be considered to be matched";
    "--c++", Arg.Set Flag.c_plus_plus,
    "  make a small attempt to parse C++ files";
    "--ibm", Arg.Set Flag.ibm,
    "  make a small attempt to parse IBM C files";
  ];

  "misc options",
  "",
  [
    "--debugger",           Arg.Set Common.debugger,
    "   option to set if launch spatch in ocamldebug";
    "--disable-once",       Arg.Set Common.disable_pr2_once,
    "   to print more messages";
    "--show-trace-profile", Arg.Set Common.show_trace_profile,
    "   show trace";
    "--save-tmp-files",     Arg.Set Common.save_tmp_files,   " ";
    "--external-analysis-file", Arg.String
      (Externalanalysis.load_external_results),
    "  import results from an external analysis";
  ];

  "concurrency",
  "",
  [
    "--index",       Arg.Int (function x -> distrib_index := Some x) ,
    "   the processor to use for this run of spatch";
    "--max",         Arg.Int (function x -> distrib_max := Some x) ,
    "   the number of processors available";
    "--mod-distrib", Arg.Set mod_distrib,
    "   use mod to distribute files among the processors";
  ];

  "pad options",
  "",
  [
    "--use-cache", Arg.Set Flag_parsing_c.use_cache,
    "   use .ast_raw pre-parsed cached C file";
    "--cache-prefix",
    Arg.String (function s ->
      Flag_parsing_c.cache_prefix := Some s;
      Flag_parsing_c.use_cache := true),
    "   directory of cached ASTs, sets --use-cache";
    (* could use Flag_parsing_c.options_pad instead *)
    "--cache-limit",
      Arg.Int (function n ->
	Flag_parsing_c.cache_limit := Some n;
	Flag_parsing_c.use_cache := true),
    "   maximum number of cached ASTs, sets --use-cache";
  ];



  "test mode and test options (works with tests/ or .ok files)",
  "The test options don't work with the --sp-file and so on.",
  [
    "--test",    Arg.Set test_mode,
    "   <file> launch spatch on tests/file.[c,cocci]";
    "--testall", Arg.Set test_all,
    "   launch spatch on all files in tests/ having a .res";
    "--test-okfailed", Arg.Set test_okfailed,
    "    generates .{ok,failed,spatch_ok} files using .res files";
    "--test-regression-okfailed", Arg.Set test_regression_okfailed,
    "    process the .{ok,failed,spatch_ok} files in current dir";

    "--compare-with-expected", Arg.Set compare_with_expected,
    "   use also file.res";
    "--expected-score-file", Arg.Set_string expected_score_file,
    "   which score file to compare with in -testall";
    "--no-update-score-file", Arg.Clear allow_update_score_file,
    "   do not update the score file when -testall succeeds";
    "--relax-include-path", Arg.Set FC.relax_include_path,
    " ";
  ];

  "action mode",
  ("The action options don't work with the --sp-file and so on." ^ "\n" ^
   "It's for the other (internal) uses of the spatch program."
  ),

    (* -token_c, -parse_c, etc  *)
  ((Common.options_of_actions action (Test_parsing_c.actions())) ++
    [
    (let s = "--parse-cocci"  in s, Arg.Unit (fun () -> action := s),
    "   <file>");
    (let s = "--compare-c"  in s, Arg.Unit (fun () -> action := s),
    "   <file1> <file2>");
    ]);
]


let all_options =
  short_options ++ List.concat (List.map Common.thd3 other_options)

(* I don't want the -help and --help that are appended by Arg.align *)
let arg_align2 xs =
  Arg.align xs +> List.rev +> Common.drop 2 +> List.rev

(*
  Ignore unknown option

  This simplifies the integration of Coccinelle in toolchain.  For
  instance, spatch can then be used as a checker in the Linux build
  system.

*)
let check_include_path () =
  let opt = Array.get Sys.argv !Arg.current in
  let is_include_re = Str.regexp "-I\\(.*\\)" in
  if Str.string_match is_include_re opt 0 then
    let path = Str.matched_group 1 opt in
	FC.include_path:= path::!FC.include_path
  else ()

let rec arg_parse_no_fail l f msg =
  try
    check_include_path ();
    Arg.parse_argv Sys.argv l f msg;
  with
    | Arg.Bad emsg ->
	arg_parse_no_fail l f msg
    | Arg.Help msg -> (* printf "%s" msg; exit 0; *)
	raise (Impossible 165)  (* -help is specified in speclist *)

(* copy paste of Arg.parse. Don't want the default -help msg *)
let arg_parse2 l f msg argv =
  (try
    Arg.parse_argv argv l f msg;
  with
  | Arg.Bad emsg -> (* eprintf "%s" msg; exit 2; *)
      if not !ignore_unknown_opt then
	begin
	  let xs = Common.lines emsg in
	    (* take only head, it's where the error msg is *)
	    pr2 (List.hd xs);
	    !short_usage_func();
	    raise (Common.UnixExit (2))
	end
      else
	arg_parse_no_fail l f msg;
  | Arg.Help msg -> (* printf "%s" msg; exit 0; *)
      raise (Impossible 166)  (* -help is specified in speclist *)
  )


let short_usage () =
 begin
  Common.short_usage usage_msg short_options;
  pr2 "";
  pr2 "Example of use:";
  pr2 "  ./spatch --sp-file foo.cocci foo.c -o /tmp/newfoo.c";
  pr2 "";
 end


let long_usage () =
  Common.long_usage usage_msg short_options other_options

let _ = short_usage_func := short_usage
let _ = long_usage_func := long_usage

(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)

(* for fresh identifier information *)
let adjust_stdin cfiles k =
  match cfiles with
    [] -> failwith "not possible"
  | cfile::_ ->
      let newin =
	try
          let (dir, base, ext) = Common.dbe_of_filename cfile in
          let varfile = Common.filename_of_dbe (dir, base, "var") in
          if ext =$= "c" && Common.lfile_exists varfile
          then Some varfile
          else None
	with Invalid_argument("Filename.chop_extension") -> None in
      Common.redirect_stdin_opt newin k

let glimpse_filter2 (_,query,_,_) dir =
  match query with
    None -> pr2 "no inferred glimpse keywords"; None
  | Some queries ->
      let suffixes = if !Flag.include_headers then ["c";"h"] else ["c"] in
      let rec loop = function
	  [] -> None (* error, eg due to pattern too big *)
	| query::queries ->
	    Printf.fprintf stderr "%s\n" ("glimpse request = " ^ query);
	    let command = spf "glimpse -y -H %s -N -W -w '%s'" dir query in
	    let (glimpse_res,stat) = Common.cmd_to_list_and_status command in
	    match stat with
	      Unix.WEXITED(0) | Unix.WEXITED(1) ->
		Some
		  (glimpse_res +>
		   List.filter
		     (fun file -> List.mem (Common.filesuffix file) suffixes))
	    |	_ -> loop queries (* error, eg due to pattern too big *) in
      loop queries

let glimpse_filter a b  =
  Common.profile_code "glimpse_filter" (fun () -> glimpse_filter2 a b)

let coccigrep_filter2 (_,_,query,_) dir =
  match query with
    None -> pr2 "no inferred keywords"; None
  | Some query ->
      Some
	(Test_parsing_c.get_files dir +>
	 List.filter (Cocci_grep.interpret query))

let coccigrep_filter a b  =
  Common.profile_code "coccigrep_filter" (fun () -> coccigrep_filter2 a b)

let idutils_filter (_,_,_,query) dir =
  match query with
    None -> pr2 "no inferred idutils keywords"; None
  | Some query ->
      let suffixes = if !Flag.include_headers then ["c";"h"] else ["c"] in
      let files = Id_utils.interpret dir query in
      Some
	(files +>
	 List.filter (fun file -> List.mem (Common.filesuffix file) suffixes))

(*****************************************************************************)
(* Main action *)
(*****************************************************************************)

let rec main_action xs =
  let (cocci_files,xs) =
    List.partition (function nm -> Filename.check_suffix nm ".cocci") xs in
  (match (!cocci_file,cocci_files) with
    "",[fl] -> cocci_file := fl
  | _,[] -> ()
  | _ -> failwith "only one .cocci file allowed");
  Iteration.base_file_list := xs;
  let rec toploop = function
      [] -> failwith "no C files provided"
    | x::xs ->
      (* a more general solution would be to use
       * Common.files_of_dir_or_files (x::xs)
       * as some elements in xs may also be directories, or individual
       * files.
       *)
	  dir := (Common.is_directory x);
	
          if !cocci_file =$= ""
          then failwith "I need a cocci file,  use --sp-file <file>";
	  
	  if !dir && !Flag.patch =*= None
	  then
	    (match xs with
	    | [] -> Flag.patch := Some (Cocci.normalize_path x)
	    | _ ->
		pr2
		  ("warning: patch output can only be created when only one\n"^
		   "directory is specified or when the -patch flag is used")
		  );
	  Flag.dir := x;

	let (cocci_infos,constants) =
	  Cocci.pre_engine (!cocci_file, !Config.std_iso) in

        let infiles =
            Common.profile_code "Main.infiles computation" (fun () ->
	      match !dir, !kbuild_info, !Flag.scanner, xs with
            (* glimpse *)
              | false, _, _, _ -> [x::xs]
              | true, s, (Flag.Glimpse|Flag.IdUtils|Flag.CocciGrep), _
		when s <> "" ->
                  failwith "--use-xxx filters do not work with --kbuild"
              | true, "", Flag.Glimpse, [] ->
                  (*if not (null xs)
                  then failwith "--use-glimpse can accept only one dir"*)
		  
                  let files =
		    match glimpse_filter constants x with
		      None -> Test_parsing_c.get_files x
		    | Some files -> files in
                  files +> List.map (fun x -> [x])
              | true, "", Flag.IdUtils, [] ->
                  (*if not (null xs)
                  then failwith "--id-utils can accept only one dir"*)
		  
                  let files =
		    match idutils_filter constants x with
		      None -> Test_parsing_c.get_files x
		    | Some files -> files in
                  files +> List.map (fun x -> [x])
              | true, "", Flag.CocciGrep, [] ->
                  (*if not (null xs)
                  then failwith "--id-utils can accept only one dir"*)
		  
                  let files =
		    match coccigrep_filter constants x with
		      None -> Test_parsing_c.get_files x
		    | Some files -> files in
                  files +> List.map (fun x -> [x])
                  (* normal *)
	      | true, "", _, _ ->
		  Test_parsing_c.get_files 
		    (join " " (x::xs)) +> List.map (fun x -> [x])
		    
            (* kbuild *)
	      | true, kbuild_info_file,_,_ ->
		  let dirs =
                    Common.cmd_to_list ("find "^(join " " (x::xs))^" -type d")
                  in
		  let info = Kbuild.parse_kbuild_info kbuild_info_file in
		  let groups = Kbuild.files_in_dirs dirs info in
		  
		  groups +> List.map (function Kbuild.Group xs -> xs)
		    )
          in

	  (* make cache unique in parallel case *)
	  (match (!distrib_index,!Flag_parsing_c.cache_prefix) with
	    (Some index,Some str) ->
	      Flag_parsing_c.cache_prefix :=
		Some (Printf.sprintf "%s/d%d" str index)
	  | _ -> ());

	  let infiles =
	    match (!distrib_index,!distrib_max) with
	      (None,None) -> infiles
	    | (Some index,Some max) ->
		(if index >= max
		then
		  failwith "index starts at 0, and so must be less than max");
		if !mod_distrib
		then
		  let rec loop ct = function
		      [] -> []
		    | x::xs ->
			if (ct mod max) =|= index
			then x::(loop (ct+1) xs)
			else loop (ct+1) xs in
		  loop 0 infiles
		else
		  begin
		    let all_files = List.length infiles in
		    let regions = (all_files + (max - 1)) / max in
		    let this_min = index * regions in
		    let this_max = (index+1) * regions in
		    let rec loop ct = function
			[] -> []
		      | x::xs ->
			  if this_min <= ct && ct < this_max
			  then x::(loop (ct+1) xs)
			  else loop (ct+1) xs in
		    loop 0 infiles
		  end
	    | _ -> failwith "inconsistent distribution information" in

          let outfiles =
            Common.profile_code "Main.outfiles computation" (fun () ->
	      let res =
		infiles +> List.fold_left (fun prev cfiles ->
		  if (not !Flag.worth_trying_opt) or
		    Cocci.worth_trying cfiles constants
		      then
		    begin
		  pr2 ("HANDLING: " ^ (join " " cfiles));
		  (*pr2 (List.hd(Common.cmd_to_list "free -m | grep Mem"));*)
		  flush stderr;
		    
		  Common.timeout_function_opt !FC.timeout (fun () ->
  	            Common.report_if_take_time 10 (join " " cfiles) (fun () ->
                      try
			let optfile =
			  if !output_file <> "" && !compat_mode then
			    Some !output_file
			  else
			    None
			in
			List.rev
			(adjust_stdin cfiles (fun () ->
			  Common.redirect_stdout_opt optfile (fun () ->
			  (* this is the main call *)
			    Cocci.full_engine cocci_infos cfiles
			))) @ prev
		      with
		      | Common.UnixExit x -> raise (Common.UnixExit x)
		      |	Pycocci.Pycocciexception ->
			  raise Pycocci.Pycocciexception
		      | e ->
			  if !dir
			  then begin
			    pr2 ("EXN:" ^ Printexc.to_string e);
			    prev (* *)
			  end
			  else raise e))
			end
		  else prev)
	      [] in res) in
	  let outfiles = List.rev outfiles in
	  (match Iteration.get_pending_instance() with
	    None ->
	      (x,xs,cocci_infos,outfiles)
	  | Some (files,virt_rules,virt_ids) ->
	      if outfiles = [] or outfiles = [] or not !FC.show_diff
		  or !inplace_modif
	      then
		begin
		  (if !inplace_modif then generate_outfiles outfiles x xs);
		  Flag.defined_virtual_rules := virt_rules;
		  Flag.defined_virtual_env := virt_ids;
		  Common.erase_temp_files();
		  Common.clear_pr2_once();
		  distrib_index := None;
		  distrib_max := None;
		  toploop files
		end
	      else
		begin
		  Common.pr2
		    "Out of place transformation not compatible with iteration. Aborting.\n consider using -no_show_diff or -in_place";
		  (x,xs,cocci_infos,outfiles)
		end) in
      let (x,xs,cocci_infos,outfiles) = toploop xs in

      Cocci.post_engine cocci_infos;
      Common.profile_code "Main.result analysis" (fun () ->
	Ctlcocci_integration.print_bench();
	generate_outfiles outfiles x xs;
        if !compare_with_expected
        then Testing.compare_with_expected outfiles)

and generate_outfiles outfiles x (* front file *) xs (* other files *) =
  let outfiles = Cocci.check_duplicate_modif outfiles in
  outfiles +> List.iter (fun (infile, outopt) ->
    outopt +> Common.do_option (fun outfile ->
      if !inplace_modif
      then begin
	(match !backup_suffix with
	  Some backup_suffix ->
	    Common.command2 ("cp "^infile^" "^infile^backup_suffix)
	| None -> ());
        Common.command2 ("cp "^outfile^" "^infile);
      end;
      
      if !outplace_modif
      then Common.command2 ("cp "^outfile^" "^infile^".cocci_res")
      
	      (* potential source of security pb if the /tmp/ file is
		 * a symlink, so simpler to not produce any regular file
		 * (files created by Common.new_temp_file are still ok)
		 * anymore in /tmp.
              *)
              (*
	         if !output_file =$= ""
	         then begin
                 let tmpfile = "/tmp/"^Common.basename infile in
                 pr2 (spf "One file modified. Result is here: %s" tmpfile);
                 Common.command2 ("cp "^outfile^" "^tmpfile);
	         end
              *)
	    ));
  if !output_file <> "" && not !compat_mode then
    (match outfiles with
    | [infile, Some outfile] when infile =$= x && null xs ->
        Common.command2 ("cp " ^outfile^ " " ^ !output_file)
    | [infile, None] when infile =$= x && null xs ->
        Common.command2 ("cp " ^infile^ " " ^ !output_file)
    | _ ->
        failwith
          ("-o can not be applied because there are multiple " ^
           "modified files"))

let fix_chars s =
  if (String.length s) > 2 && String.get s 0 = '-'
      && not (String.get s 1 = '-')
  then "-"^(String.concat "-" (Str.split (Str.regexp_string "_") s))
  else s

let rec fix_idutils = function
    [] -> []
  | ["--use-idutils"] -> ["--use-idutils";".id-utils.index"]
  | "--use-idutils"::second::rest
    when String.length second > 0 && String.get second 0 = '-' ->
       "--use-idutils"::".id-utils.index" :: (fix_idutils (second :: rest))
  | x :: rest -> x :: (fix_idutils rest)

(*****************************************************************************)
(* The coccinelle main entry point *)
(*****************************************************************************)
let main () =
  begin
    let arglist = Array.to_list Sys.argv in
    let arglist = Command_line.command_line arglist in
    let arglist = List.map fix_chars arglist in
    let arglist = fix_idutils arglist in

    let contains_cocci =
      (* rather a hack... don't want to think about all possible options *)
      List.exists
	(function x -> Filename.check_suffix x ".cocci")
	arglist &&
      not (List.mem "--parse-cocci" arglist) in
    if not (null (Common.inter_set arglist
	            ["--cocci-file";"--sp-file";"--sp";"--test";"--testall";
                      "--test-okfailed";"--test-regression-okfailed"]))
	or contains_cocci
    then run_profile quiet_profile;
    
    let args = ref [] in
    
    (* Gc.set {(Gc.get ()) with Gc.stack_limit = 1024 * 1024};*)
    
    (* this call can set up many global flag variables via the cmd line *)
    arg_parse2 (Arg.align all_options) (fun x -> args := x::!args) usage_msg
      (Array.of_list arglist);
    args :=
      List.filter
	(function arg ->
	  if Filename.check_suffix arg ".cocci"
	  then
	    begin
	      (if !cocci_file = ""
	      then cocci_file := arg
	      else failwith "only one .cocci file allowed");
	      false
	    end
	  else true)
	!args;
    (match (!Flag_parsing_c.cache_prefix,!distrib_index) with
      (Some cp,Some n) ->
	Flag_parsing_c.cache_prefix :=
	  Some (Printf.sprintf "%s_%d" cp n)
    | _ -> ());
    
    (* julia hack so that one can override directories specified on
       * the command line. *)
    (if !dir
    then
      let chosen_dir =
	if List.length !args > 1
	then
	  begin
	    let chosen = List.hd !args in
	    Flag.dir := chosen;
	    pr2 ("ignoring all but the last specified directory: "^chosen);
	    args := [chosen];
	    chosen
	  end
	else List.hd !args in
      if !FC.include_path =*= []
      then FC.include_path := [Filename.concat chosen_dir "include"]);

    args := List.rev !args;

    if !cocci_file <> "" && (not (!cocci_file =~ ".*\\.\\(sgrep\\|spatch\\)$"))
    then cocci_file := Common.adjust_ext_if_needed !cocci_file ".cocci";

    if !Config.std_iso <> ""
    then Config.std_iso := Common.adjust_ext_if_needed !Config.std_iso ".iso";
    if !Config.std_h <> ""
    then Config.std_h := Common.adjust_ext_if_needed !Config.std_h ".h";

    if !Config.std_h <> ""
    then Parse_c.init_defs_builtins !Config.std_h;

    if !macro_file <> ""
    then Parse_c.init_defs_macros !macro_file;


    (* must be done after Arg.parse, because Common.profile is set by it *)
    Common.profile_code "Main total" (fun () ->

    let all_actions = Test_parsing_c.actions() in

    (match (!args) with

    (* --------------------------------------------------------- *)
    (* The test framework. Works with tests/ or .ok and .failed  *)
    (* --------------------------------------------------------- *)
    | [x] when !test_mode    ->
	begin
	  let prefix = "tests/" in
	  let testfile = x ^ ".cocci" in
	    if Sys.file_exists (prefix ^ testfile) then
	      begin
		(if !FC.include_path = []
		then FC.include_path := [prefix^"include"]);
		Testing.testone prefix x !compare_with_expected
	      end
	    else
	      if Sys.file_exists testfile then
		begin
		  (if !FC.include_path = []
		  then FC.include_path := ["include"]);
		  Testing.testone "" x !compare_with_expected
		end
	      else
		Printf.fprintf stderr
		  "ERROR: File %s does not exist\n" testfile
	end

    | []  when !test_all ->
        (if !FC.include_path = []
	then FC.include_path := ["tests/include"]);
        let score_file = if !expected_score_file <> ""
                         then !expected_score_file
                         else "tests/SCORE_expected.sexp" in
        Testing.testall score_file !allow_update_score_file

    | [] when !test_regression_okfailed ->
        Testing.test_regression_okfailed ()

    | ((x::xs) as cfiles) when !test_okfailed ->
        (* do its own timeout on FC.timeout internally *)
        FC.relax_include_path := true;
	adjust_stdin cfiles (fun () ->
          Testing.test_okfailed !cocci_file cfiles
        )

    (* --------------------------------------------------------- *)
    (* Actions, useful to debug subpart of coccinelle *)
    (* --------------------------------------------------------- *)

    | xs when List.mem !action (Common.action_list all_actions) ->
        Common.do_action !action xs all_actions

    | [] when !action =$= "--parse-cocci" ->
	Testing.test_parse_cocci !cocci_file

     (* I think this is used by some scripts in some Makefile for our
      * big-tests. So don't remove.
      *)
    | [file1;file2] when !action =$= "--compare-c" ->
       Test_parsing_c.test_compare_c file1 file2 (* result = unix code *)

    (* could add the Test_parsing_c.test_actions such as -parse_c & co *)


    (* --------------------------------------------------------- *)
    (* This is the main entry *)
    (* --------------------------------------------------------- *)
    | x::xs -> main_action (x::xs)

    (* --------------------------------------------------------- *)
    (* empty entry *)
    (* --------------------------------------------------------- *)
    | [] -> short_usage()
  ));
    if !Pycocci.initialised && (Pycocci.py_isinitialized ()) != 0 then begin
      ignore(Pycocci.pyrun_simplestring "cocci.finalise()");
      if !Flag.show_misc
      then Common.pr2 "Finalizing python\n";
      Pycocci.py_finalize ();
    end
  end


let main_with_better_error_report () =
  if !Common.debugger then main ()
  else
    try
      main ()
    with
    | Unix.Unix_error (e, "stat", filename) ->
        Printf.fprintf stderr "ERROR: File %s does not exist: %s\n"
	  filename (Unix.error_message e);
        raise (UnixExit (-1))
    | Parse_cocci.Bad_virt s ->
	Printf.fprintf stderr "virtual rule %s not supported\n" s;
        raise (UnixExit (-1))

(*****************************************************************************)
let start =
  Common.main_boilerplate (fun () ->
    main_with_better_error_report ();
    Ctlcocci_integration.print_bench();
  )