(*
 * Copyright (c) 2016 - present Facebook, Inc.
 * All rights reserved.
 *
 * This source code is licensed under the BSD style license found in the
 * LICENSE file in the root directory of this source tree. An additional grant
 * of patent rights can be found in the PATENTS file in the same directory.
 *)

(** Definition and parsing of command line arguments *)

open! Utils

module F = Format
module YBU = Yojson.Basic.Util


(** Each command line option may appear in the --help list of any executable, these tags are used to
    specify which executables for which an option will be documented. *)
type exe = Analyze | BuckCompilationDatabase | Clang | Interactive | Java | Llvm | Print |
           StatsAggregator | Toplevel


let exes = [
  ("InferBuckCompilationDatabase", BuckCompilationDatabase);
  ("InferAnalyze", Analyze);
  ("InferClang", Clang);
  ("InferJava", Java);
  ("InferLLVM", Llvm);
  ("InferPrint", Print);
  ("InferStatsAggregator", StatsAggregator);
  ("infer", Toplevel);
  ("interactive", Interactive);
]

let all_exes = IList.map snd exes

let frontend_exes = [Clang; Java; Llvm]

let current_exe =
  if !Sys.interactive then Interactive
  else
    try IList.assoc string_equal (Filename.basename Sys.executable_name) exes
    with Not_found -> Toplevel

type desc = {
  long: string; short: string; meta: string; doc: string; spec: Arg.spec;
  (** how to go from an option in the json config file to a list of command-line options *)
  decode_json: Yojson.Basic.json -> string list ;
}

let dashdash long =
  match long with
  | "" | "--" -> long
  | _ -> "--" ^ long

let short_meta {short; meta; spec} =
  String.concat " "
    ((if short = "" then [] else ["| -" ^ short]) @
     (match spec with
      | Arg.Symbol (symbols, _) ->
          ["{ " ^ (String.concat " | " symbols) ^ " }" ^ meta]
      | _ ->
          if meta = "" then [] else ["<" ^ meta ^ ">"]))

let left_length long short_meta =
  (String.length (dashdash long)) + (String.length short_meta)

let max_left_length limit current ({long; spec} as desc) =
  let short_meta =
    match spec with
    | Arg.Symbol _ -> short_meta {desc with spec = Arg.Unit (fun () -> ())}
    | _ -> short_meta desc in
  let length = left_length long short_meta in
  if length > limit then current else max current length

let xdesc {long; short; spec; doc} =
  let key long short =
    match long, short with
    | "", "" -> ""
    | "--", _ -> "--"
    | "", _ -> "-" ^ short
    | _ -> "--" ^ long
  in
  let xspec long spec =
    match spec with
    (* translate Symbol to String for better formatting of --help messages *)
    | Arg.Symbol (symbols, action) ->
        Arg.String (fun arg ->
            if IList.mem ( = ) arg symbols then
              action arg
            else
              raise (Arg.Bad (F.sprintf "wrong argument '%s'; option '%s' expects one of: %s"
                                arg (dashdash long) (String.concat " | " symbols)))
          )
    | _ ->
        spec
  in
  (key long short, xspec long spec, doc)

let wrap_line indent_string wrap_length line =
  let indent_length = String.length indent_string in
  let word_sep = " " in
  let words = Str.split (Str.regexp_string word_sep) line in
  let add_word_to_paragraph (rev_lines, non_empty, line, line_length) word =
    let word_length = String.length word in
    let new_length = line_length + (String.length word_sep) + word_length in
    let new_non_empty = non_empty || word <> "" in
    if new_length > wrap_length && non_empty then
      (line::rev_lines, true, indent_string ^ word, indent_length + word_length)
    else
      let sep = if line_length = indent_length then "" else word_sep in
      let new_line = line ^ sep ^ word in
      if new_length > wrap_length && new_non_empty then
        (new_line::rev_lines, false, indent_string, indent_length)
      else
        (rev_lines, new_non_empty, new_line, String.length new_line) in
  let (rev_lines, _, line, _) = IList.fold_left add_word_to_paragraph ([], false, "", 0) words in
  IList.rev (line::rev_lines)

let pad_and_xform doc_width left_width desc =
  match desc with
  | {doc = ""} ->
      xdesc desc
  | {long; doc} ->
      let indent_doc doc =
        (* 2 blank columns before option + 2 columns of gap between flag and doc *)
        let left_indent = 4 + left_width in
        (* align every line after the first one of [doc] *)
        let doc = Str.global_replace (Str.regexp_string "\n")
            ("\n" ^ String.make left_indent ' ') doc in
        (* align the first line of [doc] *)
        let short_meta = short_meta desc in
        let gap = left_width - (left_length long short_meta) in
        if gap < 0 then
          short_meta ^ "\n" ^ (String.make left_indent ' ') ^ doc
        else
          short_meta ^ (String.make (gap + 1) ' ') ^ doc
      in
      let wrapped_lines =
        let lines = Str.split (Str.regexp_string "\n") doc in
        let wrap_line s =
          if String.length s > doc_width then
            wrap_line "" doc_width s
          else [s] in
        IList.map wrap_line lines in
      let doc = indent_doc (String.concat "\n" (IList.flatten wrapped_lines)) in
      xdesc {desc with doc}

let align desc_list =
  let min_term_width = 80 in
  (* Try to prevent `tput` from complaining about $TERM not being set as it pollutes stderr. We
     cannot redirect stderr as `tput` needs access to the tty and we are already redirecting stdout
     to read the result from `tput`. *)
  (try Unix.getenv "TERM" |> ignore
   with Not_found -> Unix.putenv "TERM" "ansi");
  let cur_term_width = try with_process_in "tput cols" input_line |> fst |> int_of_string
    with
    | End_of_file (* tput is unhappy *)
    | Failure "int_of_string" (* not sure if possible *) -> min_term_width in
  (* 2 blank columns before option + 2 columns of gap between flag and doc *)
  let extra_space = 4 in
  let min_left_width = 15 in
  let max_left_width = 49 in
  let doc_width term_width left_width = term_width - extra_space - left_width in
  let term_width doc_width left_width = left_width + extra_space + doc_width in
  let max_doc_width = 100 in
  let max_term_width = term_width max_left_width max_doc_width in
  (* how many columns to reserve for the option names
     NOTE: this doesn't take into account "--help | -h" nor "--help-full", but fortunately these
     have short names *)
  let left_width =
    let opt_left_width = IList.fold_left (max_left_length max_left_width) 0 desc_list in
    let (--) a b = float_of_int a -. float_of_int b in
    let multiplier = (max_left_width -- min_left_width) /. (max_term_width -- min_term_width) in
    (* at 80 columns use min_left_width then use extra columns until opt_left_width *)
    let cols_after_min_width = float_of_int (max 0 (cur_term_width - min_term_width)) in
    min (int_of_float (cols_after_min_width *. multiplier) + min_left_width) opt_left_width in
  let doc_width = min max_doc_width (doc_width cur_term_width left_width) in
  (IList.map (pad_and_xform doc_width left_width) desc_list, (doc_width, left_width))


let check_no_duplicates desc_list =
  let rec check_for_duplicates_ = function
    | [] | [_] ->
        true
    | (x, _, _) :: (y, _, _) :: _ when x <> "" && x = y ->
        failwith ("Multiple definitions of command line option: " ^ x)
    | _ :: tl ->
        check_for_duplicates_ tl
  in
  check_for_duplicates_ (IList.sort (fun (x, _, _) (y, _, _) -> String.compare x y) desc_list)


let full_desc_list = ref []

let exe_desc_lists = IList.map (fun (_, exe) -> (exe, ref [])) exes

(** add desc to all desc_lists for the purposes of parsing, include desc in --help only for exes *)
let add exes desc =
  full_desc_list := desc :: !full_desc_list ;
  IList.iter (fun (exe, desc_list) ->
      let desc =
        if IList.mem ( = ) exe exes then
          desc
        else
          {desc with meta = ""; doc = ""} in
      desc_list := desc :: !desc_list
    ) exe_desc_lists

let mk ?(deprecated=[]) ?(exes=[])
    ~long ?(short="") ~default ~meta doc ~default_to_string ~decode_json ~mk_setter ~mk_spec =
  let variable = ref default in
  let closure = mk_setter variable in
  let setter str =
    try closure str
    with exc ->
      raise (Arg.Bad ("bad value " ^ str ^ " for flag " ^ long
                      ^ " (" ^ (Printexc.to_string exc) ^ ")")) in
  let spec = mk_spec setter in
  let doc =
    let default_string = default_to_string default in
    if default_string = "" then doc
    else doc ^ " (default: " ^ default_string ^ ")" in
  let desc = {long; short; meta; doc; spec; decode_json} in
  (* add desc for long option, with documentation (which includes any short option) for exes *)
  add exes desc ;
  (* add desc for short option only for parsing, without documentation *)
  if short <> "" then
    add [] {desc with long = ""; meta = ""; doc = ""} ;
  (* add desc for deprecated options only for parsing, without documentation *)
  IList.iter (fun deprecated ->
      add [] {desc with long = ""; short = deprecated; meta = ""; doc = ""}
    ) deprecated ;
  variable

type 'a t =
  ?deprecated:string list -> long:Arg.key -> ?short:Arg.key ->
  ?exes:exe list -> ?meta:string -> Arg.doc ->
  'a

let string_json_decoder ~long json = [dashdash long; YBU.to_string json]

let list_json_decoder json_decoder json = IList.flatten (YBU.convert_each json_decoder json)

let mk_set var value ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  let setter () = var := value in
  ignore(
    mk ~deprecated ~long ?short ~default:() ?exes ~meta doc
      ~default_to_string:(fun () -> "")
      ~decode_json:(string_json_decoder ~long)
      ~mk_setter:(fun _ _ -> setter ())
      ~mk_spec:(fun _ -> Arg.Unit setter) )

let mk_option ?(default=None) ?(default_to_string=fun _ -> "") ~f
    ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  mk ~deprecated ~long ?short ~default ?exes ~meta doc
    ~default_to_string
    ~decode_json:(string_json_decoder ~long)
    ~mk_setter:(fun var str -> var := f str)
    ~mk_spec:(fun set -> Arg.String set)

let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b)
    ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  let nolong =
    let len = String.length long in
    if len > 3 && String.sub long 0 3 = "no-" then
      String.sub long 3 (len - 3)
    else
      "no-" ^ long
  and noshort =
    Option.map (fun short ->
        let len = String.length short in
        if len > 1 && String.sub short 0 1 = "n" then
          String.sub short 1 (len - 1)
        else
          "n" ^ short
      ) short
  in
  let doc nolong =
    match noshort with
    | Some noshort -> doc ^ " (Conversely: --" ^ nolong ^ " | -" ^ noshort ^ ")"
    | None         -> doc ^ " (Conversely: --" ^ nolong ^ ")"
  in
  let doc, nodoc =
    if not default then
      ("Activates: " ^ doc nolong, "")
    else
      ("", "Deactivates: " ^ doc long) in
  let default_to_string _ = "" in
  let mk_spec set = Arg.Unit (fun () -> set "") in
  let var =
    mk ~long ?short ~deprecated ~default ?exes
      ~meta doc ~default_to_string ~mk_setter:(fun var _ -> var := f true)
      ~decode_json:(fun json ->
          [dashdash (if YBU.to_bool json then long else nolong)])
      ~mk_spec in
  ignore(
    mk ~long:nolong ?short:noshort ~deprecated:deprecated_no ~default:(not default) ?exes
      ~meta nodoc ~default_to_string ~mk_setter:(fun _ _ -> var := f false)
      ~decode_json:(fun json ->
          [dashdash (if YBU.to_bool json then nolong else long)])
      ~mk_spec );
  var

let mk_bool_group ?(deprecated_no=[]) ?(default=false)
    ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc children =
  let f b =
    IList.iter (fun child -> child := b) children ;
    b
  in
  mk_bool ~deprecated ~deprecated_no ~default ~long ?short ~f ?exes ~meta doc

let mk_int ~default ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  mk ~deprecated ~long ?short ~default ?exes ~meta doc
    ~default_to_string:string_of_int
    ~mk_setter:(fun var str -> var := (int_of_string str))
    ~decode_json:(string_json_decoder ~long)
    ~mk_spec:(fun set -> Arg.String set)

let mk_float ~default ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  mk ~deprecated ~long ?short ~default ?exes ~meta doc
    ~default_to_string:string_of_float
    ~mk_setter:(fun var str -> var := (float_of_string str))
    ~decode_json:(string_json_decoder ~long)
    ~mk_spec:(fun set -> Arg.String set)

let mk_string ~default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  mk ~deprecated ~long ?short ~default ?exes ~meta doc
    ~default_to_string:(fun s -> s)
    ~mk_setter:(fun var str -> var := f str)
    ~decode_json:(string_json_decoder ~long)
    ~mk_spec:(fun set -> Arg.String set)

let mk_string_opt ?default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  let default_to_string = function Some s -> s | None -> "" in
  let f s = Some (f s) in
  mk_option ~deprecated ~long ?short ~default ~default_to_string ~f ?exes ~meta doc

let mk_string_list ?(default=[]) ?(f=fun s -> s)
    ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  mk ~deprecated ~long ?short ~default ?exes ~meta doc
    ~default_to_string:(String.concat ", ")
    ~mk_setter:(fun var str -> var := (f str) :: !var)
    ~decode_json:(list_json_decoder (string_json_decoder ~long))
    ~mk_spec:(fun set -> Arg.String set)

let mk_symbol ~default ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  let strings = IList.map fst symbols in
  let sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in
  let of_string str = IList.assoc string_equal str symbols in
  let to_string sym = IList.assoc ( = ) sym sym_to_str in
  mk ~deprecated ~long ?short ~default ?exes ~meta doc
    ~default_to_string:(fun s -> to_string s)
    ~mk_setter:(fun var str -> var := of_string str)
    ~decode_json:(string_json_decoder ~long)
    ~mk_spec:(fun set -> Arg.Symbol (strings, set))

let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  let strings = IList.map fst symbols in
  let of_string str = IList.assoc string_equal str symbols in
  mk ~deprecated ~long ?short ~default:None ?exes ~meta doc
    ~default_to_string:(fun _ -> "")
    ~mk_setter:(fun var str -> var := Some (of_string str))
    ~decode_json:(string_json_decoder ~long)
    ~mk_spec:(fun set -> Arg.Symbol (strings, set))

let mk_symbol_seq ?(default=[]) ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
  let sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in
  let of_string str = IList.assoc string_equal str symbols in
  let to_string sym = IList.assoc ( = ) sym sym_to_str in
  mk ~deprecated ~long ?short ~default ?exes ~meta:(",-separated sequence" ^ meta) doc
    ~default_to_string:(fun syms -> String.concat " " (IList.map to_string syms))
    ~mk_setter:(fun var str_seq ->
        var := IList.map of_string (Str.split (Str.regexp_string ",") str_seq))
    ~decode_json:(fun json ->
        [dashdash long;
         String.concat "," (YBU.convert_each YBU.to_string json)])
    ~mk_spec:(fun set -> Arg.String set)

let mk_set_from_json ~default ~default_to_string ~f
    ?(deprecated=[]) ~long ?short ?exes ?(meta="json") doc =
  mk ~deprecated ~long ?short ?exes ~meta doc
    ~default ~default_to_string
    ~mk_setter:(fun var json -> var := f (Yojson.Basic.from_string json))
    ~decode_json:(fun json -> [dashdash long; Yojson.Basic.to_string json])
    ~mk_spec:(fun set -> Arg.String set)

(** A ref to a function used during argument parsing to process anonymous arguments. By default,
    anonymous arguments are rejected. *)
let anon_fun = ref (fun arg -> raise (Arg.Bad ("unexpected anonymous argument: " ^ arg)))

(** Clients declare that anonymous arguments are acceptable by calling [mk_anon], which returns a
    ref storing the anonymous arguments. *)
let mk_anon () =
  let anon = ref [] in
  anon_fun := (fun arg -> anon := arg :: !anon) ;
  anon

let mk_rest ?(exes=[]) doc =
  let rest = ref [] in
  let spec = Arg.Rest (fun arg -> rest := arg :: !rest) in
  add exes {long = "--"; short = ""; meta = ""; doc; spec; decode_json = fun _ -> []} ;
  rest

let decode_inferconfig_to_argv path =
  let json = match read_optional_json_file path with
    | Ok json ->
        json
    | Error msg ->
        F.eprintf "WARNING: Could not read or parse Infer config in %s:@\n%s@." path msg ;
        `Assoc [] in
  let desc_list = !(IList.assoc ( = ) current_exe exe_desc_lists) in
  let json_config = YBU.to_assoc json in
  let one_config_item result (key, json_val) =
    try
      let {decode_json} =
        IList.find
          (fun {long; short} ->
             string_equal key long || (* for deprecated options *) string_equal key short)
          desc_list in
      decode_json json_val @ result
    with
    | Not_found ->
        F.eprintf "WARNING: while reading config file %s:@\nUnknown option %s@." path key ;
        result
    | YBU.Type_error (msg, json) ->
        F.eprintf "WARNING: while reading config file %s:@\nIll-formed value %s for option %s: %s@."
          path (Yojson.Basic.to_string json) key msg ;
        result in
  IList.fold_left one_config_item [] json_config


(** [sep_char] is used to separate elements of argv when encoded into environment variables *)
let sep_char = '^'

let encode_argv_to_env argv =
  String.concat (String.make 1 sep_char)
    (IList.filter (fun arg ->
         not (String.contains arg sep_char)
         || (
           F.eprintf "Ignoring unsupported option containing '%c' character: %s@\n" sep_char arg ;
           false
         )
       ) argv)

let decode_env_to_argv env =
  Str.split (Str.regexp_string (String.make 1 sep_char)) env

let prepend_to_argv args =
  let cl_args = match Array.to_list Sys.argv with _ :: tl -> tl | [] -> [] in
  args @ cl_args

(** [prefix_before_rest (prefix @ ["--" :: rest])] is [prefix] where "--" is not in [prefix]. *)
let prefix_before_rest args =
  let rec prefix_before_rest_ rev_keep = function
    | [] | "--" :: _ -> IList.rev rev_keep
    | keep :: args -> prefix_before_rest_ (keep :: rev_keep) args in
  prefix_before_rest_ [] args


let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file env_var exe_usage =
  let curr_speclist = ref []
  and full_speclist = ref []
  in
  let usage_msg = exe_usage current_exe
  in
  let curr_usage status =
    Arg.usage !curr_speclist usage_msg ;
    exit status
  and full_usage status =
    Arg.usage !full_speclist usage_msg ;
    exit status
  in
  (* "-help" and "--help" are automatically recognized by Arg.parse, so we have to give them special
     treatment *)
  let add_or_suppress_help (speclist, (doc_width,left_width)) =
    let unknown opt =
      (opt, Arg.Unit (fun () -> raise (Arg.Bad ("unknown option '" ^ opt ^ "'"))), "") in
    let mk_spec ~long ?(short="") spec doc =
      pad_and_xform doc_width left_width { long; short; meta=""; spec; doc;
                                           decode_json=fun _ -> raise (Arg.Bad long)} in
    if incomplete then
      speclist @ [
        (unknown "--help") ;
        (unknown "-help")
      ]
    else
      speclist @ [
        mk_spec ~long:"help" ~short:"h"
          (Arg.Unit (fun () -> curr_usage 0))
          "Display this list of options";
        mk_spec ~long:"help-full"
          (Arg.Unit (fun () -> full_usage 0))
          "Display the full list of options, including internal and experimental options";
        (unknown "-help")
      ]
  in
  let normalize speclist =
    let norm k =
      let remove_no s =
        let len = String.length k in
        if len > 3 && String.sub s 0 3 = "no-" then String.sub s 3 (len - 3) else s in
      let remove_weird_chars = Str.global_replace (Str.regexp "[^a-z0-9-]") "" in
      remove_weird_chars @@ String.lowercase @@ remove_no k in
    let compare_specs {long = x} {long = y} =
      match x, y with
      | "--", "--" -> 0
      | "--", _ -> 1
      | _, "--" -> -1
      | _ ->
          let lower_norm s = String.lowercase @@ norm s in
          String.compare (lower_norm x) (lower_norm y) in
    let sort speclist = IList.sort compare_specs speclist in
    align (sort speclist)
  in
  let add_to_curr_speclist ?(add_help=false) ?header exe =
    let mk_header_spec heading =
      ("", Arg.Unit (fun () -> ()), "\n  " ^ heading ^ "\n") in
    let exe_descs = IList.assoc ( = ) exe exe_desc_lists in
    let (exe_speclist, widths) = normalize !exe_descs in
    let exe_speclist = if add_help
      then add_or_suppress_help (exe_speclist, widths)
      else exe_speclist in
    (* Return false if the same option appears in [speclist], unless [doc] is non-empty and the
       documentation in [speclist] is empty. The goal is to keep only one instance of each option,
       and that instance is the one that has a non-empty docstring if there is one. *)
    let is_not_dup_with_doc speclist (opt, _, doc) =
      opt = "" ||
      IList.for_all (fun (opt', _, doc') ->
          (doc <> "" && doc' = "") || (not (string_equal opt opt'))) speclist in
    let unique_exe_speclist = IList.filter (is_not_dup_with_doc !curr_speclist) exe_speclist in
    curr_speclist := IList.filter (is_not_dup_with_doc unique_exe_speclist) !curr_speclist @
                     (match header with
                      | Some s -> mk_header_spec s:: unique_exe_speclist
                      | None -> unique_exe_speclist)
  in
  (* speclist includes args for current exe with docs, and all other args without docs, so
     that all args can be parsed, but --help and parse failures only show external args for
     current exe *)
  if current_exe = Toplevel then
    add_to_curr_speclist ~add_help:true ~header:"Toplevel options" current_exe
  else
    add_to_curr_speclist ~add_help:true current_exe
  ;
  if current_exe = Toplevel then (
    add_to_curr_speclist ~header:"Analysis (backend) options" Analyze;
    add_to_curr_speclist ~header:"Clang frontend options" Clang;
    add_to_curr_speclist ~header:"Java frontend options" Java;
  )
  ;
  assert( check_no_duplicates !curr_speclist )
  ;
  full_speclist := add_or_suppress_help (normalize !full_desc_list)
  ;
  let env_args = decode_env_to_argv (try Unix.getenv env_var with Not_found -> "") in
  (* begin transitional support for INFERCLANG_ARGS *)
  let c_args =
    Str.split (Str.regexp_string (String.make 1 ':'))
      (try Unix.getenv "INFERCLANG_ARGS" with Not_found -> "") in
  let env_args = c_args @ env_args in
  (* end transitional support for INFERCLANG_ARGS *)
  let exe_name = Sys.executable_name in
  let env_cl_args = match current_exe with
    | Interactive -> env_args
    | _ -> prepend_to_argv env_args in
  let all_args = match config_file with
    | None -> env_cl_args
    | Some path ->
        let json_args = decode_inferconfig_to_argv path in
        (* read .inferconfig first, as both env vars and command-line options overwrite it *)
        json_args @ env_cl_args in
  let argv = Array.of_list (exe_name :: all_args) in
  let current = ref 0 in
  (* tests if msg indicates an unknown option, as opposed to a known option with bad argument *)
  let is_unknown msg =
    let prefix = exe_name ^ ": unknown option" in
    prefix = (String.sub msg 0 (String.length prefix)) in
  let rec parse_loop () =
    try
      Arg.parse_argv_dynamic ~current argv curr_speclist !anon_fun usage_msg
    with
    | Arg.Bad _ when incomplete -> parse_loop ()
    | Arg.Bad msg when accept_unknown && is_unknown msg -> !anon_fun argv.(!current) ; parse_loop ()
    | Arg.Bad usage_msg -> Pervasives.prerr_string usage_msg; exit 2
    | Arg.Help usage_msg -> Pervasives.print_string usage_msg; exit 0
  in
  parse_loop ();
  if not incomplete then
    Unix.putenv env_var (encode_argv_to_env (prefix_before_rest all_args)) ;
  curr_usage
